Move runAllocator and moduleInfo reader to evalModule from runInModule

So we can initialize scopes and frames for modules in evalModule

Co-Authored-By: Rick Winfrey <rick.winfrey@gmail.com>
Co-Authored-By: Rob Rix <rob.rix@github.com>

src/Semantic/Analysis.hs

@@ -63,6 +63,9 @@ evaluate :: ( AbstractValue term address value (ValueC term address value inner)
             , Member (Resumable (BaseError (UnspecializedError value))) innerSig
             , Member (State (Heap address address value)) innerSig
             , Member (State (ScopeGraph address)) innerSig
+            , Member (State (Heap address address value)) outerSig
+            , Member (State (ScopeGraph address)) outerSig
+            , Member (Reader (address, address)) innerSig
             , Member (Resumable (BaseError (HeapError address))) innerSig
             , Member (Resumable (BaseError (ScopeError address))) innerSig
             , Member Trace innerSig
@@ -78,23 +81,23 @@ evaluate :: ( AbstractValue term address value (ValueC term address value inner)
          -> Evaluator term address value outer (ModuleTable (NonEmpty (Module (ModuleResult address value))))
 evaluate lang perModule runTerm modules = do
   let prelude = Module moduleInfoFromCallStack (Left lang)
-  (preludeScopeAddress, (preludeFrameAddress, _)) <- evalModule lowerBound lowerBound prelude
-  foldr (run preludeScopeAddress heap . fmap Right) ask modules
+  (preludeScopeAddress, (preludeFrameAddress, _)) <- evalModule Nothing Nothing prelude
+  foldr (run preludeScopeAddress preludeFrameAddress . fmap Right) ask modules
   where run preludeScopeAddress preludeFrameAddress m rest = do
-          evaluated <- evalModule preludeScopeAddress preludeFrameAddress m
+          evaluated <- evalModule (Just preludeScopeAddress) (Just preludeFrameAddress) m
           -- FIXME: this should be some sort of Monoidal insert à la the Heap to accommodate multiple Go files being part of the same module.
           local (ModuleTable.insert (modulePath (moduleInfo m)) ((evaluated <$ m) :| [])) rest
 
-        evalModule parentScopeAddress parentFrameAddress m = do
-          let (scopeEdges, frameLinks) = (Map.singleton Lexical [ parentScopeAddress ], Map.singleton Lexical (Map.singleton parentScopeAddress parentFrameAddress))
+        evalModule parentScope parentFrame m = raiseHandler (runReader (moduleInfo m)) . runAllocator $ do
+          let (scopeEdges, frameLinks) = case (parentScope, parentFrame) of
+                (Just parentScope, Just parentFrame) -> (Map.singleton Lexical [ parentScope ], Map.singleton Lexical (Map.singleton parentScope parentFrame))
+                _ -> mempty
           scopeAddress <- newScope scopeEdges
           frameAddress <- newFrame scopeAddress frameLinks
           val <- runInModule scopeAddress frameAddress (perModule (runValueEffects . moduleBody) m)
           pure (scopeAddress, (frameAddress, val))
           where runInModule scopeAddress frameAddress
-                  = raiseHandler (runReader (moduleInfo m))
-                  . runAllocator
-                  . runDeref
+                  = runDeref
                   . raiseHandler (runReader (scopeAddress, frameAddress))
                   . runReturn
                   . runLoopControl
@@ -128,6 +131,7 @@ evalTerm :: ( Carrier sig m
             , Member (Resumable (BaseError ResolutionError)) sig
             , Member (State (Heap address address value)) sig
             , Member (State (ScopeGraph address)) sig
+            , Member (Reader (address, address)) sig
             , Member (State Span) sig
             , Member (While address value) sig
             , Member Fresh sig

src/Semantic/Graph.hs

@@ -10,6 +10,7 @@ module Semantic.Graph
 , ControlFlowVertex
 , style
 , runHeap
+, runScopeGraph
 , runModuleTable
 , parsePackage
 , parsePythonPackage
@@ -115,9 +116,8 @@ runCallGraph lang includePackages modules package
   . runEvaluator
   . graphing @_ @_ @_ @(Hole (Maybe Name) (Located Monovariant)) @Abstract
   . runHeap
+  . runScopeGraph
   . caching
-  . raiseHandler (runState (lowerBound @(ScopeGraph (Hole (Maybe Name) (Located Monovariant)))))
-  . raiseHandler (runState (lowerBound @(Heap (Hole (Maybe Name) (Located Monovariant)) (Hole (Maybe Name) (Located Monovariant)) Abstract)))
   . raiseHandler runFresh
   . resumingLoadError
   . resumingUnspecialized
@@ -133,7 +133,6 @@ runCallGraph lang includePackages modules package
   . providingLiveSet
   . runModuleTable
   . runModules (ModuleTable.modulePaths (packageModules package))
-  . runAllocator
   $ evaluate lang perModule perTerm modules
   where perTerm = evalTerm (withTermSpans . graphingTerms . cachingTerms)
         perModule = (if includePackages then graphingPackages else id) . convergingModules . graphingModules
@@ -218,6 +217,11 @@ runHeap :: (Carrier sig m, Effect sig)
         -> Evaluator term address value m (Heap address address value, a)
 runHeap = raiseHandler (runState lowerBound)
 
+runScopeGraph :: (Carrier sig m, Effect sig, Ord address)
+        => Evaluator term address value (StateC (ScopeGraph address) (Eff m)) a
+        -> Evaluator term address value m (ScopeGraph address, a)
+runScopeGraph = raiseHandler (runState lowerBound)
+
 -- | Parse a list of files into a 'Package'.
 parsePackage :: (Member Distribute sig, Member (Error SomeException) sig, Member Resolution sig, Member Task sig, Member Trace sig, Carrier sig m, Monad m)
              => Parser term -- ^ A parser.

src/Semantic/REPL.hs

@@ -76,6 +76,7 @@ repl proxy parser paths = defaultConfig debugOptions >>= \ config -> runM . runD
     . id @(Evaluator _ Precise (Value _ Precise) _ _)
     . raiseHandler runTraceByPrinting
     . runHeap
+    . runScopeGraph
     . raiseHandler runFresh
     . fmap reassociate
     . runLoadError

src/Semantic/Util.hs

@@ -41,6 +41,8 @@ justEvaluating
   = runM
   . runEvaluator
   . raiseHandler runTraceByPrinting
+  . runHeap
+  . runScopeGraph
   . raiseHandler runFresh
   . fmap reassociate
   . runLoadError
@@ -57,6 +59,7 @@ checking
   . runEvaluator
   . raiseHandler runTraceByPrinting
   . runHeap
+  . runScopeGraph
   . raiseHandler runFresh
   . caching
   . providingLiveSet