github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-24 08:54:07 +03:00
Code Issues Projects Releases Wiki Activity

Generalize concrete over the term types.

Browse Source
This commit is contained in:
Rob Rix 2019-07-29 12:55:13 -04:00
parent da0d780f81
commit 15e5731d93
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
1 changed files with 10 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
semantic-core/src/Analysis/Concrete.hs
View File

@ -20,7 +20,6 @@ import Control.Effect.NonDet
import Control.Effect.Reader hiding (Local) import Control.Effect.Reader hiding (Local)
import Control.Effect.State import Control.Effect.State
import Control.Monad ((<=<), guard) import Control.Monad ((<=<), guard)
import qualified Data.Core as Core
import Data.File import Data.File
import Data.Function (fix) import Data.Function (fix)
import qualified Data.IntMap as IntMap import qualified Data.IntMap as IntMap
@ -30,7 +29,6 @@ import qualified Data.Map as Map
import Data.Name import Data.Name
import Data.Semigroup (Last (..)) import Data.Semigroup (Last (..))
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.Term
import Data.Text (Text, pack) import Data.Text (Text, pack)
import Data.Traversable (for) import Data.Traversable (for)
import Prelude hiding (fail) import Prelude hiding (fail)
@ -69,8 +67,17 @@ data Edge = Lexical | Import
-- --
-- >>> map fileBody (snd (concrete [File (Loc "bool" emptySpan) (Core.bool True)])) -- >>> map fileBody (snd (concrete [File (Loc "bool" emptySpan) (Core.bool True)]))
-- [Right (Bool True)] -- [Right (Bool True)]
concrete :: [File (Term (Core.Ann :+: Core.Core) User)] -> (Heap (Term (Core.Ann :+: Core.Core) User), [File (Either (Loc, String) (Concrete (Term (Core.Ann :+: Core.Core) User)))])
concrete concrete
:: (Foldable term, Show (term User))
=> (forall sig m
. (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
=> Analysis (term User) Precise (Concrete (term User)) m
-> (term User -> m (Concrete (term User)))
-> (term User -> m (Concrete (term User)))
)
-> [File (term User)]
-> (Heap (term User), [File (Either (Loc, String) (Concrete (term User)))])
concrete eval
= run = run
. runFresh . runFresh
. runHeap . runHeap