1
1
mirror of https://github.com/github/semantic.git synced 2024-12-28 09:21:35 +03:00

Use the Heap effect in Typecheck.

This commit is contained in:
Rob Rix 2019-11-04 13:50:04 -05:00
parent 6199c15436
commit 29d6654f1a
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7

View File

@ -9,6 +9,7 @@ module Analysis.Typecheck
import Analysis.Analysis import Analysis.Analysis
import Analysis.Carrier.Env.Monovariant import Analysis.Carrier.Env.Monovariant
import qualified Analysis.Carrier.Heap.Monovariant as A
import Analysis.File import Analysis.File
import Analysis.FlowInsensitive import Analysis.FlowInsensitive
import Control.Applicative (Alternative (..)) import Control.Applicative (Alternative (..))
@ -17,13 +18,12 @@ import Control.Effect.Carrier
import Control.Effect.Fresh as Fresh import Control.Effect.Fresh as Fresh
import Control.Effect.Reader hiding (Local) import Control.Effect.Reader hiding (Local)
import Control.Effect.State import Control.Effect.State
import Control.Monad ((>=>), unless) import Control.Monad (unless)
import Data.Foldable (for_) import Data.Foldable (for_)
import Data.Function (fix) import Data.Function (fix)
import Data.Functor (($>)) import Data.Functor (($>))
import qualified Data.IntMap as IntMap import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet import qualified Data.IntSet as IntSet
import Data.List.NonEmpty (nonEmpty)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Maybe (fromJust, fromMaybe) import Data.Maybe (fromJust, fromMaybe)
import Data.Proxy import Data.Proxy
@ -150,6 +150,7 @@ runFile eval file = traverse run file
bs <- m bs <- m
v <$ for_ bs (unify v)) v <$ for_ bs (unify v))
. runNonDetM Set.singleton . runNonDetM Set.singleton
. A.runHeap @name @(Type name)
. convergeTerm (Proxy @name) (fix (cacheTerm . eval typecheckingAnalysis)) . convergeTerm (Proxy @name) (fix (cacheTerm . eval typecheckingAnalysis))
typecheckingAnalysis typecheckingAnalysis
@ -158,14 +159,14 @@ typecheckingAnalysis
, Carrier sig m , Carrier sig m
, Member (Env name name) sig , Member (Env name name) sig
, Member Fresh sig , Member Fresh sig
, Member (A.Heap name (Type name)) sig
, Member (State (Set.Set (Constraint name))) sig , Member (State (Set.Set (Constraint name))) sig
, Member (State (Heap name (Type name))) sig
, Ord name , Ord name
) )
=> Analysis term name name (Type name) m => Analysis term name name (Type name) m
typecheckingAnalysis = Analysis{..} typecheckingAnalysis = Analysis{..}
where deref addr = gets (Map.lookup addr >=> nonEmpty . Set.toList) >>= maybe (pure Nothing) (foldMapA (pure . Just)) where deref = A.deref
assign addr ty = modify (Map.insertWith (<>) addr (Set.singleton ty)) assign = A.assign
abstract eval name body = do abstract eval name body = do
-- FIXME: construct the associated scope -- FIXME: construct the associated scope
addr <- alloc @name @name name addr <- alloc @name @name name