Use serialized modules

src/Data/SortedMap.newt

@@ -195,6 +195,13 @@ toList {k} {v} (MapOf smap) = reverse $ go smap Nil
     go (Node3 t1 k1 t2 k2 t3) acc = go t3 $ go t2 $ go t1 acc
 toList _ = Nil
 
+mapFromList : ∀ k v. {{Ord k}} {{Eq k}} → List (k × v) → SortedMap k v
+mapFromList {k} {v} stuff = foldl go EmptyMap stuff
+  where
+    go : SortedMap k v → k × v → SortedMap k v
+    go map (k, v) = updateMap k v map
+
+
 foldMap : ∀ a b. {{Ord a}} → (b → b → b) → SortedMap a b → List (a × b) → SortedMap a b
 foldMap f m Nil = m
 foldMap f m ((a,b) :: xs) = case lookupMap a m of

src/Lib/Compile.newt

@@ -381,6 +381,7 @@ eraseEntries = do
 process : QName → M (List Doc)
 process name = do
   let wat = QN ("Prelude" :: Nil) "arrayToList"
+  top <- getTop
   entries <- getEntries EmptyMap name
 
   -- Maybe move this dance into liftWhere

src/Lib/Types.newt

@@ -334,6 +334,7 @@ instance Show TopEntry where
 
 record ModContext where
   constructor MkModCtx
+  csum : String
   modDefs : SortedMap QName TopEntry
   -- Do we need this if everything solved is zonked?
   modMetaCtx : MetaContext
@@ -348,8 +349,8 @@ record ModContext where
 -- expand these during normalization?
 
 -- A placeholder while walking through dependencies of a module
-emptyModCtx : ModContext
-emptyModCtx = MkModCtx EmptyMap (MC EmptyMap 0 NoCheck) EmptyMap
+emptyModCtx : String → ModContext
+emptyModCtx csum = MkModCtx csum EmptyMap (MC EmptyMap 0 NoCheck) EmptyMap
 
 record TopContext where
   constructor MkTop

src/Main.newt

@@ -79,6 +79,15 @@ parseDecls fn ops toks@(first :: _) acc =
       then (tok :: toks)
       else recover toks
 
+moduleHash : String → List (List String) → M String
+moduleHash src imports = do
+  srcHash <- liftIO $ checksum src
+  top <- getTop
+  let mods = mapMaybe (\x => lookupMap' x top.modules) imports
+  let modHashes = map (\x => x.csum) mods
+  liftIO $ checksum $ fastConcat $ srcHash :: modHashes
+
+
 -- New style loader, one def at a time
 processModule : FC -> String -> List String -> QName -> M String
 processModule importFC base stk qn@(QN ns nm) = do
@@ -87,7 +96,8 @@ processModule importFC base stk qn@(QN ns nm) = do
   let modns = (snoc ns nm)
   let name = joinBy "." modns
   let (Nothing) = lookupMap modns top.modules | _ => pure ""
-  modifyTop (\ top => MkTop (updateMap modns emptyModCtx top.modules) top.imported top.ns top.defs top.metaCtx top.verbose top.errors top.ops)
+  -- dummy entry for processing
+  modifyTop (\ top => MkTop (updateMap modns (emptyModCtx "") top.modules) top.imported top.ns top.defs top.metaCtx top.verbose top.errors top.ops)
   let fn = (joinBy "/" (base :: ns)) ++ "/" ++ nm ++ ".newt"
   (Right src) <- liftIO {M} $ readFile fn
     | Left err => exitFailure "ERROR at \{show importFC}: error reading \{fn}: \{show err}"
@@ -118,8 +128,22 @@ processModule importFC base stk qn@(QN ns nm) = do
       pure $ split name' "."
 
   let imported = snoc imported primNS
+  srcSum <- liftIO $ checksum src
+  csum <- moduleHash srcSum imported
 
   putStrLn "module \{modName}"
+  top <- getTop
+  (Nothing) <- loadModule qn csum
+    | Just mod => do
+      let modules = updateMap modns mod top.modules
+
+      modifyTop (\ top =>
+        -- FIXME - we don't want stray operators in a module.
+        -- inject module ops into top
+        let ops = foldMap const top.ops $ toList mod.ctxOps
+        in MkTop modules top.imported top.ns top.defs top.metaCtx top.verbose top.errors ops)
+      pure src  -- why am I returning this?
+
   log 1 $ \ _ => "MODNS " ++ show modns
   top <- getTop
   (decls, ops) <- parseDecls fn top.ops toks Lin
@@ -135,11 +159,10 @@ processModule importFC base stk qn@(QN ns nm) = do
   top <- getTop
   mc <- readIORef top.metaCtx
 
-  let mod = MkModCtx top.defs mc top.ops
-  dumpModule qn src mod
+  let mod = MkModCtx csum top.defs mc top.ops
+  if stk == Nil then pure MkUnit else dumpModule qn src mod
 
   let modules = updateMap modns mod top.modules
-  freshMC <- newIORef (MC EmptyMap 0 CheckAll)
   modifyTop (\ top => MkTop modules top.imported top.ns top.defs top.metaCtx top.verbose top.errors top.ops)
 
   (Nil) <- liftIO {M} $ readIORef top.errors
@@ -202,7 +225,7 @@ processFile fn = do
   processDecl primNS (PType emptyFC "Char" Nothing)
 
   top <- getTop
-  let modules = updateMap primNS (MkModCtx top.defs (MC EmptyMap 0 CheckAll) top.ops) top.modules
+  let modules = updateMap primNS (MkModCtx "" top.defs (MC EmptyMap 0 CheckAll) top.ops) top.modules
   modifyTop (\ top => MkTop modules (primNS :: Nil) Nil EmptyMap top.metaCtx top.verbose top.errors top.ops)
 
   src <- processModule emptyFC base Nil qn

src/Serialize.newt

@@ -6,10 +6,21 @@ import Lib.Common
 import Lib.Types
 import Data.SortedMap
 
+ModFile : U
+ModFile = (String × List TopEntry × List (String × OpDef) × List (QName × MetaEntry))
+
+pfunc checksum uses (MkIORes) : String → IO String := `(a) => (w) => {
+  const arr = new TextEncoder().encode(a);
+  // djb2 hash
+  let val = 5381
+  for (let i = 0; i < arr.length; i++) {
+    val = ((val * 33) + arr[i]) | 0
+  }
+  return Prelude_MkIORes(null, ""+val, w);
+}`
+
 -- this was an experiment, prepping for dumping module information
--- it ends up with out of memory dumping defs of some of the files.
--- Prelude is 114MB pretty-printed... gzip to 1M
-pfunc dumpObject uses (MkIORes MkUnit): ∀ a. String → a → IO Unit := `(_,fn,a) => (w) => {
+pfunc dumpModFile uses (MkIORes MkUnit): String → ModFile → IO Unit := `(fn,a) => (w) => {
   let fs = require('fs')
   try {
     let {EncFile} = require('./serializer')
@@ -19,11 +30,39 @@ pfunc dumpObject uses (MkIORes MkUnit): ∀ a. String → a → IO Unit := `(_,f
   return Prelude_MkIORes(null, Prelude_MkUnit, w)
 }`
 
+
 -- for now, include src and use that to see if something changed
 dumpModule : QName → String → ModContext → M Unit
 dumpModule qn src mod = do
   let fn = "build/\{show qn}.newtmod"
+  let csum = mod.csum
   let defs = listValues mod.modDefs
   let ops = toList mod.ctxOps
   let mctx = toList mod.modMetaCtx.metas
-  liftIO $ dumpObject fn (src,defs,ops,mctx)
+  liftIO $ dumpModFile fn (csum,defs,ops,mctx)
+
+pfunc readModFile uses (MkIORes Just Nothing): String → IO (Maybe ModFile) := `(fn) => (w) => {
+  let fs = require('fs')
+  try {
+    let {DecFile} = require('./serializer')
+    let data = fs.readFileSync(fn)
+    let dec = DecFile.decode(data)
+    return Prelude_MkIORes(null, Prelude_Just(null, dec), w)
+  } catch (e) {
+    return Prelude_MkIORes(null, Prelude_Nothing, w)
+  }
+}`
+
+loadModule : QName → String → M (Maybe ModContext)
+loadModule qn src = do
+  let fn = "build/\{show qn}.newtmod"
+  (Just (csum, defs, ops, mctx)) <- liftIO {M} $ readModFile fn
+     | _ => pure Nothing
+
+  let ops = mapFromList ops
+  let defs = mapFromList $ map (\ entry => (entry.name, entry)) defs
+      -- REVIEW can we ignore those last two inside a module
+  let mctx = MC (mapFromList mctx) 0 NoCheck
+  if csum == src
+    then pure $ Just $ MkModCtx csum defs mctx ops
+    else pure Nothing