Merge branch 'modular-mechanics' into great-exportations

Author: robrix

semantic-analysis/src/Analysis/Carrier/Statement/State.hs

@@ -24,7 +24,7 @@ import           Data.Text (Text)
 
 -- Messages
 
-data Message
+newtype Message
   = Import (NonEmpty Text)
   deriving (Eq, Ord, Show)
 

semantic-analysis/src/Analysis/Effect/Statement.hs

@@ -1,5 +1,10 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
+{- |
+The @'Statement'@ effect is designed to provide instrumentation for source-level interactions we need visibility into which are nevertheless not (currently) modelled by expressions: e.g. statements, declarations, certain directives, etc.
+
+Currently this is limited to imports, where the value-level semantics are (for many languages) essentially the unit value, but where the effect of bringing an environment and entire subset of the store into scope are essential to track for modular interpretation.
+-}
 module Analysis.Effect.Statement
 ( -- * Statement effect
   simport

semantic-analysis/src/Analysis/Module.hs

@@ -22,6 +22,6 @@ instance Semigroup (ModuleSet a) where
   m1 <> m2 = ModuleSet ((link m2 <$> getModuleSet m1) <> (link m1 <$> getModuleSet m2))
 
 link :: ModuleSet a -> Module a -> Module a
-link (ModuleSet ms) m = Module b' (imports m Set.\\ Map.keysSet ms) (exports m) u' where
-  (u', b') = foldl' (\ (u, b) -> resolve u b . exports) (unknown m, body m) (Map.restrictKeys ms (imports m))
-  resolve u b e = (u Set.\\ Map.keysSet e, b . mappend (Map.restrictKeys e u))
+link (ModuleSet ms) m = Module body' (imports m Set.\\ Map.keysSet ms) (exports m) unknown' where
+  (unknown', body') = foldl' (uncurry resolveSymbolsInModule) (unknown m, body m) (Map.restrictKeys ms (imports m))
+  resolveSymbolsInModule unknown body m = (unknown Set.\\ Map.keysSet (exports m), body . mappend (Map.restrictKeys (exports m) unknown))

semantic-analysis/src/Analysis/Syntax.hs

@@ -10,8 +10,6 @@ module Analysis.Syntax
   -- * Abstract interpretation
 , eval0
 , eval
-, evalModule0
-, evalModule
   -- * Macro-expressible syntax
 , let'
 , letrec
@@ -26,7 +24,6 @@ import           Analysis.Effect.Domain
 import           Analysis.Effect.Env (Env, bind, lookupEnv)
 import           Analysis.Effect.Store
 import           Analysis.File
-import           Analysis.Module
 import           Analysis.Name (Name, name, nameI)
 import           Analysis.Reference as Ref
 import           Control.Applicative (Alternative (..), liftA3)
@@ -43,12 +40,10 @@ import           Data.Foldable (fold)
 import           Data.Function (fix)
 import qualified Data.IntMap as IntMap
 import           Data.List (sortOn)
-import           Data.List.NonEmpty (NonEmpty, fromList, toList)
+import           Data.List.NonEmpty (NonEmpty, fromList)
 import           Data.Monoid (First (..))
-import qualified Data.Set as Set
 import           Data.String (IsString (..))
-import           Data.Text (Text, pack)
-import qualified Data.Text as Text
+import           Data.Text (Text)
 import qualified Data.Vector as V
 import qualified System.Path as Path
 
@@ -91,15 +86,6 @@ eval eval = \case
     foldr (\ (p, a) m -> let' p a m) (eval b) (zip ps as)))
 
 
-evalModule0 :: (Has (Env addr) sig m, HasLabelled Store (Store addr val) sig m, Has (Dom val) sig m) => Term -> m (Module val)
-evalModule0 = evalModule eval0
-
-evalModule :: (Has (Env addr) sig m, HasLabelled Store (Store addr val) sig m, Has (Dom val) sig m) => (Term -> S.StatementC m val) -> (Term -> m (Module val))
-evalModule f i = S.runStatement mk (eval f i) where
-  mk msgs b = pure (Module (const b) (Set.fromList (map formatImport msgs)) mempty mempty)
-  formatImport (S.Import cs) = name (Text.intercalate (pack ".") (toList cs))
-
-
 -- Macro-expressible syntax
 
 let' :: (Has (Env addr) sig m, HasLabelled Store (Store addr val) sig m) => Name -> val -> m a -> m a