Module caching (#211)

 - The driver now has a "clock", with a major and minor counter.
   - Counters are used to mark places where we expect loaded files to
     change. Otherwise you may have a file change between a call to
     `getSignature` and `getLowered`, which is terribly confusing.
   - Ticks (minor updates), allow non-emitted files to be reloaded if
     they have changed. This means you can reimport erroring files
     within the repl, and we will attempt recompilation.
   - Tocks (major updates), reloads any changed file. This is only
     done when using `:[re]load`, as you need to throw away any existing
     values at the same time.
 - The REPL now keeps the same driver around for the whole session,
   ticking and tocking it where appropriate.
 - Files are considered to have changed if their SHA256 hash has changed,
   or any of their dependencies have changed.

amuletml.cabal

@@ -176,11 +176,13 @@ library
                      , filepath >= 1.4 && < 1.5
                      , hashable >= 1.2 && < 1.4
                      , directory >= 1.3 && < 1.4
+                     , bytestring >= 0.10 && < 0.11
                      , containers >= 0.5 && < 0.7
                      , these-lens >= 1 && < 1.1
                      , transformers >= 0.5 && < 0.6
                      , monad-chronicle >= 1 && < 1.1
                      , template-haskell >= 2.13 && < 2.16
+                     , cryptohash-sha256 >= 0.11 && < 0.12
                      , annotated-wl-pprint >= 0.7 && < 0.8
                      , unordered-containers >= 0.2 && < 0.3
                      , logict >= 0.7 && < 0.8

bin/Amc.hs

@@ -53,7 +53,7 @@ runCompile opt (DoLint lint) dconfig file = do
       flip runNameyT firstName
     . flip runStateT (D.makeDriverWith dconfig)
     $ do
-      (core, errors) <- D.compile path
+      (core, errors) <- D.compiles path
       ~(Just env) <- D.getTypeEnv path
       pure (env, core, errors)
 

bin/Amc/Repl.hs

@@ -119,18 +119,29 @@ defaultState config = do
     { resolveScope = Bi.builtinResolve
     , inferScope   = Bi.builtinEnv
     , emitState    = B.defaultEmitState
-    , lastName     = S.TgName (T.pack "a") 1
     , lowerState   = L.defaultState
-
     , luaState     = state
 
+    , lastName     = S.TgName (T.pack "a") 1
     , driver       = D.makeDriverWith (driverConfig config)
     , config       = config
 
     , currentFile  = Nothing
     , outputHandle = stdout
     }
 
+resetState :: ReplState -> IO ReplState
+resetState state = do
+  lState <- L.newstate
+  L.runWith lState L.openlibs
+  pure state
+    { resolveScope = Bi.builtinResolve
+    , inferScope   = Bi.builtinEnv
+    , emitState    = B.defaultEmitState
+    , lowerState   = L.defaultState
+    , luaState     = lState
+    }
+
 type Listener = Maybe ThreadId
 
 runRepl :: Listener -> InputT (StateT ReplState IO) ()
@@ -212,15 +223,11 @@ parseArgs xs =
 
 loadCommand :: (MonadState ReplState m, MonadIO m) => String -> m ()
 loadCommand arg = case parseArgs arg of
-                    [file] -> loadFile file
+                    [file] -> loadFile (Just file)
                     _ -> outputDoc "Usage `:load [file]`"
 
 reloadCommand :: (MonadState ReplState m, MonadIO m) => m ()
-reloadCommand = do
-  file <- gets currentFile
-  case file of
-    Nothing -> outputDoc "No module to reload"
-    Just file -> loadFile file
+reloadCommand = loadFile =<< gets currentFile
 
 infoCommand :: (MonadState ReplState m, MonadIO m) => String -> m ()
 infoCommand (T.pack . dropWhile isSpace -> input) = do
@@ -266,7 +273,9 @@ typeCommand (dropWhile isSpace -> input) = do
           prog :: [S.Toplevel S.Parsed]
           prog = [ S.LetStmt S.Public [ S.Matching (S.Wildcard ann) parsed ann ] ]
 
-      (infer, es) <- wrapDriver $ D.inferWith (root (config state)) prog (resolveScope state) (inferScope state)
+      (infer, es) <- wrapDriver $ do
+        D.tick
+        D.inferWith (root (config state)) prog (resolveScope state) (inferScope state)
       hReportAll (outputHandle state) files es
       case infer of
         Nothing -> pure ()
@@ -284,7 +293,7 @@ compileCommand (dropWhile isSpace -> path) = do
   case current of
     Just file -> do
       in_p <- liftIO $ canonicalizePath file
-      (core, errors) <- wrapDriver (D.compile in_p)
+      (core, errors) <- wrapDriver $ D.tick >> D.compiles in_p
       handle <- liftIO $ openFile path WriteMode
 
       case core of
@@ -402,8 +411,9 @@ parseCore parser name input = do
             Left s -> s
             Right e -> [S.LetStmt S.Public [S.Binding (S.Name "_") e True (annotation e)]]
 
-      (lower, es) <- wrapDriver $ D.lowerWith (root (config state)) parsed'
-                       (resolveScope state) (inferScope state) (lowerState state)
+      (lower, es) <- wrapDriver $ do
+        D.tick
+        D.lowerWith (root (config state)) parsed' (resolveScope state) (inferScope state) (lowerState state)
       driver_files <- D.fileMap =<< gets driver
       hReportAll (outputHandle state) (files ++ driver_files) es
       case lower of
@@ -433,30 +443,25 @@ emitCore core = do
   pure (luaExpr, luaSyntax)
 
 -- | Reset the environment and load a series of files from environment
-loadFile :: (MonadState ReplState m, MonadIO m) => FilePath -> m ()
+loadFile :: (MonadState ReplState m, MonadIO m) => Maybe FilePath -> m ()
 loadFile file = do
   -- Reset the state
-  config <- gets config
-  handle <- gets outputHandle
-  state' <- liftIO (defaultState config)
-  put state' { currentFile = Just file
-             , outputHandle = handle }
-
-  -- FIXME: This is a little broken, in that if the prelude and the
-  -- loaded file both require the same code, we will execute it
-  -- twice. Ideally we should probably have a 'loadFilsImpl', which loads
-  -- 1..n files, and correctly handles stitching them together.
-  _ <- setupPrelude
-
-  -- Load each file in turn
-  path <- liftIO $ canonicalizePath file
-  exists <- liftIO $ doesFileExist path
-  if not exists
-  then outputDoc ("Cannot open" <+> verbatim file)
-  else do
-    outputDoc $ "Loading:" <+> verbatim file
-    loadFileImpl path $> ()
+  put =<< (liftIO . resetState) =<< get
+  modify (\s ->  s { currentFile = file })
+  wrapDriver D.tock
+
+  -- Determine whether to load the prelude and an additional file.
+  prelude <- gets (toList . prelude . config)
+  load <- case file of
+    Nothing -> pure []
+    Just file -> do
+      path <- liftIO $ canonicalizePath file
+      exists <- liftIO $ doesFileExist path
+      if exists
+      then outputDoc ("Loading:" <+> verbatim file) $> [path]
+      else outputDoc ("Cannot open" <+> verbatim file) $> []
 
+  loadFiles (prelude ++ load) $> ()
 
 outputDoc :: (MonadState ReplState m, MonadIO m) => Doc -> m ()
 outputDoc x = do
@@ -479,35 +484,38 @@ runRemoteReplCommand port command = Net.withSocketsDo $ do
     Left (_ :: SomeException) ->
       putStrLn $ "Failed to connect to server on port " ++ show port
 
-loadFileImpl :: (MonadState ReplState m, MonadIO m) => FilePath -> m Bool
-loadFileImpl path = do
-  (core, es) <- wrapDriver $ D.compile path
+loadFiles :: (MonadState ReplState m, MonadIO m) => [FilePath] -> m Bool
+loadFiles [] = pure True
+loadFiles paths = do
+  (core, es) <- wrapDriver $ D.tick >> D.compile paths
 
   files <- D.fileMap =<< gets driver
   handle <- gets outputHandle
   hReportAll handle files es
   case core of
     Nothing -> pure False
     Just core -> do
-      (sig, env, lEnv) <- wrapDriver $ do
-        ~(Just sig) <- D.getSignature path
-        ~(Just env) <- D.getOpenedTypeEnv path
-        ~(Just lEnv) <- D.getLowerState path
-        pure (sig, env, lEnv)
-
-      modify (\s -> s { resolveScope = resolveScope s <> sig
-                      , inferScope = inferScope s <> env
-                      , lowerState = lowerState s <> lEnv })
+      oldEnv <- gets inferScope
+      for_ paths $ \path -> do
+        (sig, env, lEnv) <- wrapDriver $ do
+          ~(Just sig) <- D.getSignature path
+          ~(Just env) <- D.getOpenedTypeEnv path
+          ~(Just lEnv) <- D.getLowerState path
+          pure (sig, env, lEnv)
+
+        modify (\s -> s { resolveScope = resolveScope s <> sig
+                        , inferScope = inferScope s <> env
+                        , lowerState = lowerState s <> lEnv })
+      newEnv <- gets inferScope
 
       (luaExpr, luaSyntax) <- emitCore core
 
       luaState <- gets luaState
       debug <- gets (debugMode . config)
       liftIO $ do
-        dump debug [] core core luaExpr Bi.builtinEnv env
+        dump debug [] core core luaExpr oldEnv newEnv
         res <- L.runWith luaState $ do
           code <- L.dostring luaSyntax
-
           case code of
             L.OK -> pure (Right ())
             _ -> do
@@ -521,19 +529,12 @@ loadFileImpl path = do
           Left err -> hPutDoc handle err >> pure False
           Right () -> pure True
 
-setupPrelude :: (MonadState ReplState m, MonadIO m) => m Bool
-setupPrelude = do
-  prelude <- gets (prelude . config)
-  case prelude of
-    Nothing -> pure True
-    Just prelude -> loadFileImpl prelude
-
 repl :: ReplConfig -> IO ()
 repl config = replFrom config Nothing
 
 replFrom :: ReplConfig -> Maybe FilePath -> IO ()
 replFrom config file = do
-  state <- execStateT (maybe (setupPrelude $> ()) loadFile file) =<< defaultState config
+  state <- execStateT (loadFile file) =<< defaultState config
   hSetBuffering stdout LineBuffering
 
   ready <- newEmptyMVar

bin/GenExample.hs

@@ -31,7 +31,7 @@ main = do
   (((core, errors), driver), _) <-
       flip runNameyT firstName
     . flip runStateT driver
-    $ compile file
+    $ compiles file
 
   x <- T.readFile file