github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 22:31:36 +03:00
Code Issues Projects Releases Wiki Activity

Stub in part of a MonadValue instance for now

Browse Source
This commit is contained in:
Rob Rix 2018-03-29 10:04:43 -04:00
parent fc262873f3
commit 9a36f7979f
1 changed files with 20 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/Data/Abstract/Located.hs
View File

@ -2,10 +2,14 @@
module Data.Abstract.Located where module Data.Abstract.Located where
import Control.Abstract.Evaluator import Control.Abstract.Evaluator
import Control.Abstract.Value
import Data.Abstract.Address import Data.Abstract.Address
import Data.Bifunctor
import Data.Range import Data.Range
import Data.Record import Data.Record
import Data.Span import Data.Span
import Prelude hiding (null)
import Prologue hiding (hash, null)
-- TODO: Dependencies -- TODO: Dependencies
type Provenance = Record '[Range, Span] type Provenance = Record '[Range, Span]
@ -23,3 +27,19 @@ newtype LocatedValue value = LocatedValue { unLocatedValue :: value }
instance AbstractValue (LocatedValue value) where instance AbstractValue (LocatedValue value) where
type LocationFor (LocatedValue value) = Located (LocationFor value) type LocationFor (LocatedValue value) = Located (LocationFor value)
instance MonadValue value m => MonadValue (LocatedValue value) m where
unit = LocatedValue <$> unit
null = LocatedValue <$> null
integer = fmap LocatedValue . integer
float = fmap LocatedValue . float
rational = fmap LocatedValue . rational
boolean = fmap LocatedValue . boolean
multiple = fmap LocatedValue . multiple . map unLocatedValue
string = fmap LocatedValue . string
symbol = fmap LocatedValue . symbol
array = fmap LocatedValue . array . map unLocatedValue
hash = fmap LocatedValue . hash . map (bimap unLocatedValue unLocatedValue)
ifthenelse = ifthenelse . unLocatedValue
kvPair = fmap (fmap LocatedValue) . (kvPair `on` unLocatedValue)
-- klass name vals env = LocatedValue <$> klass name (map unLocatedValue vals) (fmap unLocatedValue env)