diff --git a/src/Data/Abstract/ModuleTable.hs b/src/Data/Abstract/ModuleTable.hs index 773efad03..a79843c43 100644 --- a/src/Data/Abstract/ModuleTable.hs +++ b/src/Data/Abstract/ModuleTable.hs @@ -47,9 +47,9 @@ keys :: ModuleTable a -> [ModulePath] keys = Map.keys . unModuleTable -- | Construct a 'ModuleTable' from a non-empty list of 'Module's. -fromModules :: [Module term] -> ModuleTable (NonEmpty (Module term)) -fromModules modules = ModuleTable (Map.fromListWith (<>) (map toEntry modules)) - where toEntry m = (modulePath (moduleInfo m), m:|[]) +fromModules :: [Module term] -> ModuleTable (Module term) +fromModules = ModuleTable . Map.fromList . map toEntry + where toEntry m = (modulePath (moduleInfo m), m) toPairs :: ModuleTable a -> [(ModulePath, a)] toPairs = Map.toList . unModuleTable diff --git a/src/Data/Abstract/Package.hs b/src/Data/Abstract/Package.hs index d5cfd349b..6a7093130 100644 --- a/src/Data/Abstract/Package.hs +++ b/src/Data/Abstract/Package.hs @@ -25,7 +25,7 @@ data PackageInfo = PackageInfo -- | A package represents the unit of dependency, i.e. something which can depend upon, or be depended upon by, other packages. Packages have modules and may have entry points from which evaluation can proceed. data Package term = Package { packageInfo :: PackageInfo - , packageModules :: ModuleTable (NonEmpty (Module term)) + , packageModules :: ModuleTable (Module term) } deriving (Eq, Functor, Ord, Show) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 1cff4515b..8dbd65ffc 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -157,7 +157,7 @@ runImportGraphToModuleInfos :: ( Declarations term -> Package term -> Eff m (Graph ControlFlowVertex) runImportGraphToModuleInfos lang (package :: Package term) = runImportGraph lang package allModuleInfos - where allModuleInfos info = maybe (vertex (unknownModuleVertex info)) (foldMap (vertex . moduleVertex . moduleInfo)) (ModuleTable.lookup (modulePath info) (packageModules package)) + where allModuleInfos info = vertex (maybe (unknownModuleVertex info) (moduleVertex . moduleInfo) (ModuleTable.lookup (modulePath info) (packageModules package))) runImportGraphToModules :: ( Declarations term , Evaluatable (Base term) @@ -173,7 +173,7 @@ runImportGraphToModules :: ( Declarations term -> Package term -> Eff m (Graph (Module term)) runImportGraphToModules lang (package :: Package term) = runImportGraph lang package resolveOrLowerBound - where resolveOrLowerBound info = maybe lowerBound (foldMap vertex) (ModuleTable.lookup (modulePath info) (packageModules package)) + where resolveOrLowerBound info = maybe lowerBound vertex (ModuleTable.lookup (modulePath info) (packageModules package)) runImportGraph :: ( Declarations term , Evaluatable (Base term) @@ -210,7 +210,7 @@ runImportGraph lang (package :: Package term) f . raiseHandler (runReader (lowerBound @Span)) . raiseHandler (runState (lowerBound @(ScopeGraph (Hole (Maybe Name) Precise)))) . runAllocator - $ evaluate lang (graphingModuleInfo (runDomainEffects (evalTerm id))) (ModuleTable.toPairs ( packageModules package) >>= toList . snd) + $ evaluate lang (graphingModuleInfo (runDomainEffects (evalTerm id))) (snd <$> ModuleTable.toPairs (packageModules package)) runHeap :: (Carrier sig m, Effect sig) => Evaluator term address value (StateC (Heap address address value) (Eff m)) a diff --git a/src/Semantic/REPL.hs b/src/Semantic/REPL.hs index 808996cb1..ab0447650 100644 --- a/src/Semantic/REPL.hs +++ b/src/Semantic/REPL.hs @@ -92,7 +92,7 @@ repl proxy parser paths = defaultConfig debugOptions >>= \ config -> runM . runD . raiseHandler (runReader (packageInfo package)) . raiseHandler (runState (lowerBound @Span)) . raiseHandler (runReader (lowerBound @Span)) - $ evaluate proxy (runDomainEffects (evalTerm (withTermSpans . step (fmap (\ (x:|_) -> moduleBody x) <$> ModuleTable.toPairs (packageModules (fst <$> package)))))) modules + $ evaluate proxy (runDomainEffects (evalTerm (withTermSpans . step (fmap moduleBody <$> ModuleTable.toPairs (packageModules (fst <$> package)))))) modules -- TODO: REPL for typechecking/abstract semantics -- TODO: drive the flow from within the REPL instead of from without