Specialize flow-insensitive caching to Name addresses.

semantic-analysis/src/Analysis/FlowInsensitive.hs

@@ -8,6 +8,7 @@ module Analysis.FlowInsensitive
 , foldMapA
 ) where
 
+import           Analysis.Name
 import           Control.Effect
 import           Control.Effect.Fresh
 import           Control.Effect.NonDet
@@ -21,28 +22,26 @@ import qualified Data.Set as Set
 newtype Cache term value = Cache { unCache :: Map.Map term (Set.Set value) }
   deriving (Eq, Ord, Show)
 
-type Heap address value = Map.Map address (Set.Set value)
+type Heap value = Map.Map Name (Set.Set value)
 
 newtype FrameId name = FrameId { unFrameId :: name }
   deriving (Eq, Ord, Show)
 
 
-convergeTerm :: forall term value address proxy m sig
+convergeTerm :: forall term value m sig
              .  ( Carrier sig m
                 , Effect sig
-                , Eq address
                 , Member Fresh sig
-                , Member (State (Heap address value)) sig
+                , Member (State (Heap value)) sig
                 , Ord term
                 , Ord value
                 )
-             => proxy address
-             -> (term -> NonDetC (ReaderC (Cache term value) (StateC (Cache term value) m)) value)
+             => (term -> NonDetC (ReaderC (Cache term value) (StateC (Cache term value) m)) value)
              -> term
              -> m (Set.Set value)
-convergeTerm _ eval body = do
+convergeTerm eval body = do
   heap <- get
-  (cache, _) <- converge (Cache Map.empty :: Cache term value, heap :: Heap address value) $ \ (prevCache, _) -> runState (Cache Map.empty) . runReader prevCache $ do
+  (cache, _) <- converge (Cache Map.empty :: Cache term value, heap :: Heap value) $ \ (prevCache, _) -> runState (Cache Map.empty) . runReader prevCache $ do
     _ <- resetFresh . runNonDetM Set.singleton $ eval body
     get
   pure (fromMaybe mempty (Map.lookup body (unCache cache)))
@@ -67,7 +66,7 @@ cacheTerm eval term = do
       result <- eval term
       result <$ modify (Cache . Map.insertWith (<>) term (Set.singleton (result :: value)) . unCache)
 
-runHeap :: StateC (Heap address value) m a -> m (Heap address value, a)
+runHeap :: StateC (Heap value) m a -> m (Heap value, a)
 runHeap m = runState Map.empty m
 
 -- | Fold a collection by mapping each element onto an 'Alternative' action.

semantic-analysis/src/Analysis/ImportGraph.hs

@@ -19,7 +19,6 @@ import           Control.Effect.Reader
 import           Data.Foldable (fold, for_)
 import           Data.Function (fix)
 import qualified Data.Map as Map
-import           Data.Proxy
 import qualified Data.Set as Set
 import           Data.Text (Text)
 import           Prelude hiding (fail)
@@ -57,7 +56,7 @@ importGraph
      -> (term Name -> m (Value (term Name)))
      )
   -> [File (term Name)]
-  -> ( Heap Name (Value (term Name))
+  -> ( Heap (Value (term Name))
      , [File (Either (Path.AbsRelFile, Span, String) (Value (term Name)))]
      )
 importGraph eval
@@ -71,7 +70,7 @@ runFile
   .  ( Carrier sig m
      , Effect sig
      , Member Fresh sig
-     , Member (State (Heap Name (Value (term Name)))) sig
+     , Member (State (Heap (Value (term Name)))) sig
      , Ord  (term Name)
      , Show (term Name)
      )
@@ -89,7 +88,7 @@ runFile eval file = traverse run file
             . runEnv @Name
             . runFail
             . fmap fold
-            . convergeTerm (Proxy @Name) (A.runHeap @Name @(Value (term Name)) . fix (cacheTerm . eval importGraphAnalysis))
+            . convergeTerm (A.runHeap @Name @(Value (term Name)) . fix (cacheTerm . eval importGraphAnalysis))
 
 -- FIXME: decompose into a product domain and two atomic domains
 importGraphAnalysis

semantic-analysis/src/Analysis/ScopeGraph.hs

@@ -22,7 +22,6 @@ import           Control.Effect.State
 import           Data.Foldable (fold)
 import           Data.Function (fix)
 import qualified Data.Map as Map
-import           Data.Proxy
 import qualified Data.Set as Set
 import           Data.Traversable (for)
 import           Prelude hiding (fail)
@@ -60,7 +59,7 @@ scopeGraph
      -> (term Name -> m (ScopeGraph Name))
      )
   -> [File (term Name)]
-  -> (Heap Name (ScopeGraph Name), [File (Either (Path.AbsRelFile, Span, String) (ScopeGraph Name))])
+  -> (Heap (ScopeGraph Name), [File (Either (Path.AbsRelFile, Span, String) (ScopeGraph Name))])
 scopeGraph eval
   = run
   . runFresh
@@ -71,7 +70,7 @@ runFile
   :: ( Carrier sig m
      , Effect sig
      , Member Fresh sig
-     , Member (State (Heap Name (ScopeGraph Name))) sig
+     , Member (State (Heap (ScopeGraph Name))) sig
      , Ord (term Name)
      )
   => (forall sig m
@@ -89,7 +88,7 @@ runFile eval file = traverse run file
             . runReader (Map.empty @Name @Ref)
             . runFail
             . fmap fold
-            . convergeTerm (Proxy @Name) (A.runHeap @Name @(ScopeGraph Name) . fix (cacheTerm . eval scopeGraphAnalysis))
+            . convergeTerm (A.runHeap @Name @(ScopeGraph Name) . fix (cacheTerm . eval scopeGraphAnalysis))
 
 scopeGraphAnalysis
   :: ( Alternative m

semantic-analysis/src/Analysis/Typecheck.hs

@@ -27,7 +27,6 @@ import qualified Data.IntMap as IntMap
 import qualified Data.IntSet as IntSet
 import qualified Data.Map as Map
 import           Data.Maybe (fromJust, fromMaybe)
-import           Data.Proxy
 import           Data.Semigroup (Last (..))
 import qualified Data.Set as Set
 import           Data.Traversable (for)
@@ -105,7 +104,7 @@ typecheckingFlowInsensitive
      -> (term Name -> m Type)
      )
   -> [File (term Name)]
-  -> ( Heap Name Type
+  -> ( Heap Type
      , [File (Either (Path.AbsRelFile, Span, String) (Term (Polytype :+: Monotype) Void))]
      )
 typecheckingFlowInsensitive eval
@@ -119,7 +118,7 @@ runFile
   :: ( Carrier sig m
      , Effect sig
      , Member Fresh sig
-     , Member (State (Heap Name Type)) sig
+     , Member (State (Heap Type)) sig
      , Ord (term Name)
      )
   => (forall sig m
@@ -134,7 +133,7 @@ runFile eval file = traverse run file
   where run
           = (\ m -> do
               (subst, t) <- m
-              modify @(Heap Name Type) (fmap (Set.map (substAll subst)))
+              modify @(Heap Type) (fmap (Set.map (substAll subst)))
               pure (substAll subst <$> t))
           . runState @Substitution mempty
           . runReader (filePath file)
@@ -149,7 +148,7 @@ runFile eval file = traverse run file
               v <- meta
               bs <- m
               v <$ for_ bs (unify v))
-          . convergeTerm (Proxy @Name) (A.runHeap @Name @Type . fix (cacheTerm . eval typecheckingAnalysis))
+          . convergeTerm (A.runHeap @Name @Type . fix (cacheTerm . eval typecheckingAnalysis))
 
 typecheckingAnalysis
   :: ( Alternative m