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

Remove the heap fields from Analysis.

Browse Source
This commit is contained in:
Rob Rix 2019-11-04 14:04:03 -05:00
parent a667c656a1
commit a55972ef88
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
5 changed files with 16 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
semantic-analysis/src/Analysis/Analysis.hs
View File

@ -11,9 +11,7 @@ import GHC.Generics (Generic1)
--
-- This is intended to be replaced with a selection of algebraic effects providing these interfaces and carriers providing reusable implementations.
data Analysis term name address value m = Analysis
{ deref :: address -> m (Maybe value)
, assign :: address -> value -> m ()
, abstract :: (term name -> m value) -> name -> term name -> m value
{ abstract :: (term name -> m value) -> name -> term name -> m value
, apply :: (term name -> m value) -> value -> value -> m value
, unit :: m value
, bool :: Bool -> m value

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

@ -118,7 +118,8 @@ runFile eval file = traverse run file
. fix (eval concreteAnalysis)
concreteAnalysis
:: ( Carrier sig m
:: forall term name m sig
. ( Carrier sig m
, Foldable term
, IsString name
, Member (A.Env name Precise) sig
@ -134,9 +135,7 @@ concreteAnalysis
)
=> Analysis term name Precise (Concrete term name) m
concreteAnalysis = Analysis{..}
where deref = A.deref
assign = A.assign
abstract _ name body = do
where abstract _ name body = do
path <- ask
span <- ask
env <- asks (flip Map.restrictKeys (Set.delete name (foldMap Set.singleton body)))
@ -144,7 +143,7 @@ concreteAnalysis = Analysis{..}
apply eval (Closure path span name body env) a = do
local (const path) . local (const span) $ do
addr <- A.alloc name
assign addr a
A.assign addr a
local (const (Map.insert name addr env)) (eval body)
apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
unit = pure Unit
@ -157,11 +156,11 @@ concreteAnalysis = Analysis{..}
record fields = do
fields' <- for fields $ \ (name, value) -> do
addr <- A.alloc name
assign addr value
A.assign addr value
pure (name, addr)
pure (Record (Map.fromList fields'))
addr ... n = do
val <- deref addr
val <- A.deref @Precise @(Concrete term name) addr
heap <- get
pure (val >>= lookupConcrete heap n)

8
semantic-analysis/src/Analysis/ImportGraph.hs
View File

@ -107,15 +107,13 @@ importGraphAnalysis
)
=> Analysis term name name (Value term name) m
importGraphAnalysis = Analysis{..}
where deref = A.deref
assign = A.assign
abstract _ name body = do
where abstract _ name body = do
path <- ask
span <- ask
pure (Value (Closure path span name body) mempty)
apply eval (Value (Closure path span name body) _) a = local (const path) . local (const span) $ do
addr <- alloc @name @name name
assign addr a
A.assign addr a
bind name addr (eval body)
apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
unit = pure mempty
@ -127,6 +125,6 @@ importGraphAnalysis = Analysis{..}
record fields = do
for_ fields $ \ (k, v) -> do
addr <- alloc @name @name k
assign addr v
A.assign addr v
pure (Value Abstract (foldMap (valueGraph . snd) fields))
_ ... m = pure (Just m)

8
semantic-analysis/src/Analysis/ScopeGraph.hs
View File

@ -104,11 +104,9 @@ scopeGraphAnalysis
)
=> Analysis term name name (ScopeGraph name) m
scopeGraphAnalysis = Analysis{..}
where deref = A.deref
assign = A.assign
abstract eval name body = do
where abstract eval name body = do
addr <- alloc @name @name name
assign name mempty
A.assign @name @(ScopeGraph name) name mempty
bind name addr (eval body)
apply _ f a = pure (f <> a)
unit = pure mempty
@ -122,6 +120,6 @@ scopeGraphAnalysis = Analysis{..}
path <- ask
span <- ask
let v' = ScopeGraph (Map.singleton (Decl k path span) mempty) <> v
(k, v') <$ assign addr v'
(k, v') <$ A.assign @name addr v'
pure (foldMap snd fields')
_ ... m = pure (Just m)

8
semantic-analysis/src/Analysis/Typecheck.hs
View File

@ -163,13 +163,11 @@ typecheckingAnalysis
)
=> Analysis term name name (Type name) m
typecheckingAnalysis = Analysis{..}
where deref = A.deref
assign = A.assign
abstract eval name body = do
where abstract eval name body = do
-- FIXME: construct the associated scope
addr <- alloc @name @name name
arg <- meta
assign addr arg
A.assign addr arg
ty <- eval body
pure (Alg (Arr arg ty))
apply _ f a = do
@ -186,7 +184,7 @@ typecheckingAnalysis = Analysis{..}
record fields = do
fields' <- for fields $ \ (k, v) -> do
addr <- alloc @name @name k
(k, v) <$ assign addr v
(k, v) <$ A.assign addr v
-- FIXME: should records reference types by address instead?
pure (Alg (Record (Map.fromList fields')))
_ ... m = pure (Just m)