examples working again, needed to resurrect Remote.map builtin

node/src/Container.hs

@@ -1,5 +1,6 @@
 {-# Language BangPatterns #-}
 {-# Language OverloadedStrings #-}
+{-# Language CPP #-}
 
 module Main where
 
@@ -22,7 +23,11 @@ import qualified Data.ByteString.Base64.URL as Base64
 import qualified Data.ByteString.Lazy as LB
 import qualified Data.Bytes.Put as Put
 import qualified Data.Text as Text
+#ifdef leveldb
+import qualified Unison.BlockStore.LevelDbStore as LDBS
+#else
 import qualified Unison.BlockStore.FileBlockStore as FBS
+#endif
 import qualified Unison.NodeContainer as C
 import qualified Unison.NodeProtocol as NP
 import qualified Unison.Remote as R
@@ -32,8 +37,12 @@ import qualified Unison.Typechecker.Components as Components
 main :: IO ()
 main = Mux.uniqueChannel >>= \rand ->
   let
-    fileBS = FBS.make' rand h "blockstore"
     h bytes = BA.convert (hash bytes :: Digest Blake2b_512)
+    #ifdef leveldb
+    blockstore = LDBS.make rand h "blockstore.leveldb"
+    #else
+    blockstore = FBS.make' rand h "blockstore"
+    #endif
     locker _ = pure held
     held = Lock (pure (Just (Lease (pure True) (pure ()))))
     mkNode _ = do -- todo: actually use node params
@@ -55,8 +64,13 @@ main = Mux.uniqueChannel >>= \rand ->
         P.std_in = P.CreatePipe,
         P.std_err = P.CreatePipe }
   in do
-    fileBS <- fileBS
-    send <- C.make fileBS locker protocol mkNode launchNode
+    #ifdef leveldb
+    putStrLn "using leveldb-based block store"
+    #else
+    putStrLn "using file-based block store"
+    #endif
+    blockstore <- blockstore
+    send <- C.make blockstore locker protocol mkNode launchNode
     S.scotty 8081 $ do
       S.middleware logStdoutDev
       S.addroute OPTIONS (S.regex ".*") $ NS.originOptions

node/src/Worker.hs

@@ -4,13 +4,11 @@ module Main where
 
 import Control.Concurrent.STM.TVar
 import Control.Monad
-import System.Directory (doesDirectoryExist)
 import System.IO (stderr)
 import Unison.Hash (Hash)
 import Unison.NodeProtocol.V0 (protocol)
 import Unison.NodeWorker as W
 import Unison.SerializationAndHashing (TermV)
-import qualified Data.Map as Map
 import qualified Control.Concurrent.STM as STM
 import qualified Data.Set as Set
 import qualified Data.Text as Text
@@ -21,7 +19,7 @@ import qualified Unison.Eval.Interpreter as I
 import qualified Unison.Node as Node
 import qualified Unison.Node.BasicNode as BasicNode
 import qualified Unison.Node.Builtin as Builtin
-import qualified Unison.Node.FileStore as Store
+import qualified Unison.Node.MemStore as Store
 import qualified Unison.Note as Note
 import qualified Unison.Parsers as Parsers
 import qualified Unison.Reference as Reference
@@ -40,12 +38,14 @@ main = do
   lang logger crypto blockstore = do
     let b0 = Builtin.makeBuiltins
     b1 <- ExtraBuiltins.makeAPI blockstore crypto
-    store <- Store.make "codestore"
+    store <- Store.make
     backend <- BasicNode.make SAH.hash store (\whnf -> b0 whnf ++ b1 whnf)
+    loadDeclarations "unison-src/base.u" backend
+    loadDeclarations "unison-src/extra.u" backend
     initialized <- STM.atomically $ newTVar False
-    pure $ go backend initialized b0 b1
+    pure $ go backend initialized
     where
-      go backend initialized b0 b1 =
+      go backend initialized =
         let
           lang :: R.Language TermV Hash
           lang = R.Language localDependencies eval apply node unit channel local unRemote remote
@@ -69,13 +69,15 @@ main = do
               Right _ -> pure (Right e')
           initialize = do
             L.info logger "checking if base libraries loaded"
-            alreadyInitialized <- doesDirectoryExist "codestore"
+            let idf = Term.lam' ["x"] (Term.var' "x") :: TermV
+            let Reference.Derived hashIdf = SAH.hash idf
+            alreadyInitialized <- pure False -- not . null <$> R.getHashes codestore (Set.fromList [hashIdf])
             when (not alreadyInitialized) $ do
-              L.info logger "codestore/ directory not found, loading base libraries..."
-              loadDeclarations "unison-src/base.u" backend
-              loadDeclarations "unison-src/extra.u" backend
+              L.info logger "codestore not loaded... inserting"
               hs <- Note.run (Node.allTerms backend)
-              R.saveHashes codestore [ (h,v) | (Reference.Derived h, v) <- hs ]
+              -- todo
+              -- R.saveHashes codestore [ (h,v) | (Reference.Derived h, v) <- hs ]
+              pure ()
             STM.atomically $ writeTVar initialized True
         in (lang, typecheck, initialize)
       apply = Term.app
@@ -89,7 +91,9 @@ main = do
       loadDeclarations path node = do
         txt <- Text.IO.readFile path
         let str = Text.unpack txt
-        L.info logger $ "loading " ++ path
         r <- Note.run $ Node.declare' Term.ref str node
-        L.info logger $ "done loading " ++ path
+        L.info logger $ "loaded " ++ path
+        L.debug' logger $ do
+          ts <- Note.run $ Node.allTermsByVarName Term.ref node
+          pure $ show ts
         pure r

node/unison-node.cabal

@@ -149,6 +149,7 @@ library
 
   if flag(leveldb)
     build-depends: exceptions, leveldb-haskell
+    cpp-options: -Dleveldb
     exposed-modules:
                     Unison.BlockStore.LevelDbStore
 
@@ -190,9 +191,6 @@ executable worker
     unison-shared,
     vector
 
-  if flag(leveldb)
-    build-depends: exceptions, leveldb-haskell
-
 executable container
   main-is: Container.hs
   hs-source-dirs: src
@@ -242,6 +240,7 @@ executable container
 
   if flag(leveldb)
     build-depends: exceptions, leveldb-haskell
+    cpp-options: -Dleveldb
 
 executable node
   main-is: Node.hs

shared/src/Unison/Node/Builtin.hs

@@ -153,13 +153,13 @@ makeBuiltins whnf =
            op [a] = pure $ Term.remote (Remote.Step (Remote.Local (Remote.Pure a)))
            op _ = fail "unpossible"
        in (r, Just (I.Primop 1 op), remoteSignatureOf "Remote.pure", prefix "pure")
-     --, let r = R.Builtin "Remote.map"
-     --      op [f, r] = pure $ Term.builtin "Remote.bind" `Term.app`
-     --        (Term.lam' ["x"] $ Term.remote
-     --          (Remote.Step . Remote.Local . Remote.Pure $ f `Term.app` Term.var' "x"))
-     --        `Term.app` r
-     --      op _ = fail "unpossible"
-     --  in (r, Just (I.Primop 2 op), remoteSignatureOf "Remote.map", prefix "map")
+     , let r = R.Builtin "Remote.map"
+           op [f, r] = pure $ Term.builtin "Remote.bind" `Term.app`
+             (Term.lam' ["x"] $ Term.remote
+               (Remote.Step . Remote.Local . Remote.Pure $ f `Term.app` Term.var' "x"))
+             `Term.app` r
+           op _ = fail "unpossible"
+       in (r, Just (I.Primop 2 op), remoteSignatureOf "Remote.map", prefix "map")
      , let r = R.Builtin "Remote.receiveAsync"
            op [chan, timeout] = do
              Term.Number' seconds <- whnf timeout

unison-src/base.u

@@ -1,3 +1,6 @@
+identity : ∀ a . a -> a;
+identity a = a;
+
 Remote.transfer : Node -> Remote Unit;
 Remote.transfer node = Remote.at node unit;