github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 14:21:31 +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
import Control.Abstract.Evaluator
import Control.Abstract.Value
import Data.Abstract.Address
import Data.Bifunctor
import Data.Range
import Data.Record
import Data.Span
import Prelude hiding (null)
import Prologue hiding (hash, null)
-- TODO: Dependencies
type Provenance = Record '[Range, Span]
@ -23,3 +27,19 @@ newtype LocatedValue value = LocatedValue { unLocatedValue :: value }
instance AbstractValue (LocatedValue value) where
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)