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

Generalize runFile over the term type.

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

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

@ -1,4 +1,4 @@
{-# LANGUAGE DerivingVia, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, RecordWildCards, TypeOperators, UndecidableInstances #-}
{-# LANGUAGE DerivingVia, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, RankNTypes, RecordWildCards, TypeOperators, UndecidableInstances #-}
module Analysis.Concrete
( Concrete(..)
, concrete
@ -74,16 +74,25 @@ concrete
= run
. runFresh
. runHeap
. traverse runFile
. traverse (runFile eval)
runFile :: ( Carrier sig m
, Effect sig
, Member Fresh sig
, Member (State (Heap (Term (Core.Ann :+: Core.Core) User))) sig
)
=> File (Term (Core.Ann :+: Core.Core) User)
-> m (File (Either (Loc, String) (Concrete (Term (Core.Ann :+: Core.Core) User))))
runFile file = traverse run file
runFile
:: ( Carrier sig m
, Effect sig
, Foldable term
, Member Fresh sig
, Member (State (Heap (term User))) sig
, 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)
-> m (File (Either (Loc, String) (Concrete (term User))))
runFile eval file = traverse run file
where run = runReader (fileLoc file)
. runFailWithLoc
. runReader (mempty :: Env)