Merge remote-tracking branch 'origin/module-exports' into direct-builtins

src/Control/Abstract/Primitive.hs

@@ -79,3 +79,21 @@ builtInPrint :: ( AbstractValue address value effects
                 )
              => Evaluator address value effects value
 builtInPrint = lambda (\ v -> variable v >>= deref >>= asString >>= trace . unpack >> box unit)
+
+builtInExport :: ( AbstractValue address value effects
+                 , HasCallStack
+                 , Member (Allocator address value) effects
+                 , Member (Env address) effects
+                 , Member Fresh effects
+                 , Member (Reader ModuleInfo) effects
+                 , Member (Reader Span) effects
+                 , Member (Resumable (EnvironmentError address)) effects
+                 )
+              => Evaluator address value effects value
+builtInExport = lambda (\ v -> do
+  var <- variable v >>= deref
+  (k, value) <- asPair var
+  sym <- asString k
+  addr <- box value
+  export (name sym) (name sym) (Just addr)
+  box unit)

src/Data/Abstract/Evaluatable.hs

@@ -6,6 +6,8 @@ module Data.Abstract.Evaluatable
 , traceResolve
 -- * Preludes
 , HasPrelude(..)
+-- * Postludes
+, HasPostlude(..)
 -- * Effects
 , EvalError(..)
 , throwEvalError
@@ -63,7 +65,7 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where
           )
        => SubtermAlgebra constr term (Evaluator address value effects (ValueRef address))
   eval expr = do
-    void $ traverse_ subtermValue expr
+    traverse_ subtermValue expr
     v <- throwResumable (Unspecialized ("Eval unspecialized for " <> liftShowsPrec (const (const id)) (const id) 0 expr ""))
     rvalBox v
 
@@ -75,6 +77,7 @@ evaluate :: ( AbstractValue address value inner
             , Evaluatable (Base term)
             , Foldable (Cell address)
             , FreeVariables term
+            , HasPostlude lang
             , HasPrelude lang
             , Member Fresh effects
             , Member (Modules address) effects
@@ -107,11 +110,13 @@ evaluate lang analyzeModule analyzeTerm modules = do
           evaluated <- coerce
             (runInModule preludeEnv (moduleInfo m))
             (analyzeModule (subtermRef . moduleBody)
-            (evalTerm <$> m))
+            (evalModuleBody <$> 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
 
-        evalTerm term = Subterm term (foldSubterms (analyzeTerm (TermEvaluator . eval . fmap (second runTermEvaluator))) term >>= TermEvaluator . address)
+        evalModuleBody term = Subterm term (do
+          result <- foldSubterms (analyzeTerm (TermEvaluator . eval . fmap (second runTermEvaluator))) term >>= TermEvaluator . address
+          result <$ TermEvaluator (postlude lang))
 
         runInModule preludeEnv info
           = runReader info
@@ -168,6 +173,35 @@ instance HasPrelude 'JavaScript where
     defineNamespace "console" $ do
       define "log" builtInPrint
 
+-- Postludes
+
+class HasPostlude (language :: Language) where
+  postlude :: ( AbstractValue address value effects
+              , HasCallStack
+              , Member (Allocator address value) effects
+              , Member (Env address) effects
+              , Member Fresh effects
+              , Member (Reader ModuleInfo) effects
+              , Member (Reader Span) effects
+              , Member (Resumable (EnvironmentError address)) effects
+              , Member Trace effects
+              )
+           => proxy language
+           -> Evaluator address value effects ()
+  postlude _ = pure ()
+
+instance HasPostlude 'Go
+instance HasPostlude 'Haskell
+instance HasPostlude 'Java
+instance HasPostlude 'PHP
+instance HasPostlude 'Python
+instance HasPostlude 'Ruby
+instance HasPostlude 'TypeScript
+
+instance HasPostlude 'JavaScript where
+  postlude _ = trace "JS postlude"
+
+
 -- Effects
 
 -- | The type of error thrown when failing to evaluate a term.

src/Data/Abstract/Exports.hs

@@ -21,8 +21,9 @@ null :: Exports address -> Bool
 null = Map.null . unExports
 
 toBindings :: Exports address -> Bindings address
-toBindings exports = unpairs (mapMaybe sequenceA (toList (unExports exports)))
+toBindings = unpairs . mapMaybe sequenceA . toList . unExports
 
+-- TODO: Should inserts overwrite an existing value for a given name?
 insert :: Name -> Name -> Maybe address -> Exports address -> Exports address
 insert name alias address = Exports . Map.insert name (alias, address) . unExports
 

src/Parsing/Parser.hs

@@ -29,7 +29,7 @@ module Parsing.Parser
 import           Assigning.Assignment
 import qualified Assigning.Assignment.Deterministic as Deterministic
 import qualified CMarkGFM
-import           Data.Abstract.Evaluatable (HasPrelude)
+import           Data.Abstract.Evaluatable (HasPrelude, HasPostlude)
 import           Data.AST
 import           Data.Kind
 import           Data.Language
@@ -68,6 +68,7 @@ data SomeAnalysisParser typeclasses ann where
   SomeAnalysisParser :: ( ApplyAll' typeclasses fs
                         , Element Syntax.Identifier fs
                         , HasPrelude lang
+                        , HasPostlude lang
                         )
                      => Parser (Term (Sum fs) ann) -- ^ A parser.
                      -> Proxy lang

src/Semantic/Graph.hs

@@ -108,6 +108,7 @@ runImportGraph :: forall effs lang term.
                   , Evaluatable (Base term)
                   , FreeVariables term
                   , HasPrelude lang
+                  , HasPostlude lang
                   , Member Trace effs
                   , Recursive term
                   , Effects effs