Preserve interpreter state across invocations

Author: HeinrichApfelmus

src/Eval.hs

@@ -1,7 +1,8 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeApplications #-}
 module Eval
-    ( initDisco
+    ( RefRepl
+    , initDisco
     , eval
     ) where
 
@@ -13,10 +14,6 @@ import Disco.Module
 import Disco.Names
     ( ModuleProvenance
     )
-import Disco.Parser
-    ( term
-    , runParser
-    )
 import Polysemy
     ( Embed
     , Sem
@@ -26,30 +23,37 @@ import System.Environment
 
 import Interpreter
     ( Repl
-    , initial
     , execute
+    , initial
     )
+import Data.IORef
 
 {-----------------------------------------------------------------------------
     Rendering Logic
 ------------------------------------------------------------------------------}
-eval :: String -> IO String
-eval command = fst <$> execute command initial
+type RefRepl = IORef Repl
 
-parseTest :: String -> String
-parseTest = show . runParser term "<interactive>"
+eval :: RefRepl -> String -> IO String
+eval ref command = do
+    repl0 <- readIORef ref
+    (result, repl1) <- execute command repl0
+    writeIORef ref repl1
+    pure result
 
 resolveModule'
     :: Resolver -> String
     -> Sem '[Embed IO] (Maybe (FilePath, ModuleProvenance))
 resolveModule' = resolveModule
 
-initDisco :: IO ()
+initDisco :: IO RefRepl
 initDisco = do
     -- NOTE: We set path environment variables here,
     -- because processing the .wasm module with `wizer` may bake
     -- them into the code.
     setEnv "disco_datadir" "stdlib"
 
+    -- Debug output
     s <- runM $ resolveModule' FromStdlib "num"
     print s
+
+    newIORef initial

src/Interpreter.hs

@@ -11,6 +11,7 @@ module Interpreter
     , execute
     ) where
 
+import Disco.AST.Surface (emptyModule)
 import Disco.Context hiding (filter)
 import Disco.Error
 import Disco.Eval
@@ -21,9 +22,11 @@ import Disco.Interactive.Commands
     )
 import Disco.Messages
 import Disco.Module
+import Disco.Names (ModuleName (REPLModule))
 import Disco.Pretty
 import Disco.Value
 
+import Control.Monad (void)
 import Control.Lens
     ( makeLenses
     , toListOf
@@ -79,6 +82,14 @@ initTopInfo = TopInfo
     , _discoConfig = initDiscoConfig
     }
 
+-- | Load the standard library.
+-- TODO: Doesn't work yet.
+loadStdlib :: Repl -> IO Repl
+loadStdlib =
+    fmap snd
+    . runDiscoEffects
+        (loadParsedDiscoModule True FromStdlib REPLModule emptyModule)
+
 -- | Interpreter command
 type Command = String
 
@@ -91,7 +102,7 @@ execute command = runDiscoEffects (runCommand command)
 
 -- | Run a top-level computation.
 runDiscoEffects
-    :: (forall r. Members DiscoEffects r => Sem r ())
+    :: (forall r. Members DiscoEffects r => Sem r a)
     -> Repl
     -> IO (Result, Repl)
 runDiscoEffects action Repl{topInfo,mem} = do
@@ -110,7 +121,7 @@ runDiscoEffects action Repl{topInfo,mem} = do
         . mapError EvalErr -- Embed runtime errors into top-level error type
         . failToError Panic -- Turn pattern-match failures into a Panic error
         . runReader (view topEnv topInfo) -- Keep track of current Env
-        $ action
+        . void $ action
     let repl' = Repl topInfo' mem'
     pure (showOutputs outputs, repl')
   where

src/Main.hs

@@ -3,7 +3,7 @@ module Main where
 import Control.Concurrent
 import GHC.Wasm.Prim
 
-import Eval (eval, initDisco)
+import Eval (RefRepl, eval, initDisco)
 
 {-----------------------------------------------------------------------------
     JavaScript Imports
@@ -40,20 +40,20 @@ foreign export javascript "setup" setup :: IO ()
 -- | Main entrypoint.
 setup :: IO ()
 setup = do
+    ref <- initDisco
+    
     -- Register callback for button click.
     evalButton <- js_document_getElementById (toJSString "eval")
-    onEvalButtonCallback <- asEventListener onEvalButtonClick
+    onEvalButtonCallback <- asEventListener (onEvalButtonClick ref)
     js_addEventListener evalButton (toJSString "click") onEvalButtonCallback
 
-    initDisco
-
 -- | Handle button clicks.
-onEvalButtonClick :: JSVal -> IO ()
-onEvalButtonClick event = do
+onEvalButtonClick :: RefRepl -> JSVal -> IO ()
+onEvalButtonClick ref event = do
     module_ <- fromJSString <$> js_view_state_doc_toString
     exprIn  <- js_document_getElementById (toJSString "expr")
     expr    <- fromJSString <$> js_input_value exprIn
 
-    result <- eval expr
+    result <- eval ref expr
     outDiv <- js_document_getElementById (toJSString "out")
     js_element_setInnerHtml outDiv (toJSString result)