[WIP] Multi-chain repl support

pact/Pact/Core/Builtin.hs

@@ -728,6 +728,8 @@ data ReplBuiltins
   | RPactVersion
   | REnforcePactVersionMin
   | REnforcePactVersionRange
+  | RLoad
+  | RLoadReset
   deriving (Show, Enum, Bounded, Eq, Generic)
 
 
@@ -772,6 +774,8 @@ instance IsBuiltin ReplBuiltins where
     RPactVersion -> 0
     REnforcePactVersionMin -> 1
     REnforcePactVersionRange -> 2
+    RLoad -> 1
+    RLoadReset -> 2
 
     -- RLoad -> 1
     -- RLoadWithEnv -> 2
@@ -851,6 +855,8 @@ replBuiltinsToText = \case
   RPactVersion -> "pact-version"
   REnforcePactVersionMin -> "enforce-pact-version"
   REnforcePactVersionRange -> "enforce-pact-version-range"
+  RLoad -> "load"
+  RLoadReset -> "load-with-reset"
 
 replBuiltinToText :: (t -> Text) -> ReplBuiltin t -> Text
 replBuiltinToText f = \case

pact/Pact/Core/Repl.hs

@@ -40,10 +40,9 @@ import Pact.Core.Serialise
 runRepl :: IO ()
 runRepl = do
   pdb <- mockPactDb serialisePact_repl_spaninfo
-  g <- newIORef mempty
-  evalLog <- newIORef Nothing
   ee <- defaultEvalEnv pdb replCoreBuiltinMap
-  ref <- newIORef (ReplState mempty pdb def ee g evalLog defaultSrc mempty mempty Nothing)
+  rs <- mkReplState pdb ee (loadPactReplFile' display')
+  ref <- newIORef rs
   runReplT ref (runInputT replSettings loop) >>= \case
     Left err -> do
       putStrLn "Exited repl session with error:"
@@ -69,8 +68,8 @@ runRepl = do
     RBuiltinDoc doc -> outputStrLn (show $ pretty doc)
     RUserDoc qn doc -> outputStrLn $ show $
       vsep [pretty qn, "Docs:", maybe mempty pretty doc]
+  display' rcv = runInputT replSettings (displayOutput rcv)
   catch' ma = catchAll ma (\e -> outputStrLn (show e) *> loop)
-  defaultSrc = SourceCode "(interactive)" mempty
   loop = do
     minput <- fmap T.pack <$> getInputLine "pact>"
     case minput of
@@ -94,7 +93,6 @@ runRepl = do
             outputStrLn $ unwords ["Remove all debug flags"]
             loop
           RAExecuteExpr src -> catch' $ do
-            let display' rcv = runInputT replSettings (displayOutput rcv)
             lift (replCurrSource .= defaultSrc{_scPayload=src})
             eout <- lift (tryError (interpretReplProgramSmallStep (SourceCode "(interactive)" src) display'))
             case eout of

pact/Pact/Core/Repl/Compile.hs

@@ -12,6 +12,8 @@ module Pact.Core.Repl.Compile
  ( ReplCompileValue(..)
  , interpretReplProgram
  , interpretReplProgramSmallStep
+ , loadPactReplFile
+ , loadPactReplFile'
  ) where
 
 import Control.Lens
@@ -65,17 +67,24 @@ data ReplCompileValue
   | RUserDoc (EvalDef ReplCoreBuiltin SpanInfo) (Maybe Text)
   deriving Show
 
-loadFile
+loadPactReplFile
   :: (CEKEval step ReplCoreBuiltin SpanInfo Repl)
-  => FilePath
-  -> BuiltinEnv step ReplCoreBuiltin SpanInfo Repl
+  => BuiltinEnv step ReplCoreBuiltin SpanInfo Repl
   -> (ReplCompileValue -> ReplM ReplCoreBuiltin ())
+  -> FilePath
   -> ReplM ReplCoreBuiltin [ReplCompileValue]
-loadFile loc rEnv display = do
+loadPactReplFile rEnv display loc = do
   source <- SourceCode loc <$> liftIO (T.readFile loc)
   replCurrSource .= source
   interpretReplProgram' rEnv source display
 
+-- Todo: this name sucks.
+loadPactReplFile'
+  :: (ReplCompileValue -> ReplM ReplCoreBuiltin ())
+  -> FilePath
+  -> ReplM ReplCoreBuiltin ()
+loadPactReplFile' display fp =
+  () <$ loadPactReplFile (replBuiltinEnv @CEKSmallStep) display fp
 
 interpretReplProgram
   :: SourceCode
@@ -119,7 +128,7 @@ interpretReplProgram' replEnv (SourceCode _ source) display = do
           replEvalEnv .= ee
         fp <- mangleFilePath (T.unpack txt)
         when (isPactFile fp) $ esLoaded . loToplevel .= mempty
-        out <- loadFile fp replEnv display
+        out <- loadPactReplFile replEnv display fp
         replCurrSource .= oldSrc
         unless reset $ do
           replEvalEnv .= oldEE

pact/Pact/Core/Repl/Runtime/ReplBuiltin.hs

@@ -12,6 +12,7 @@ import Control.Monad.IO.Class(liftIO)
 import Data.Default
 import Data.Text(Text)
 import Data.ByteString.Short(toShort)
+import System.FilePath.Posix
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Map.Strict as M
@@ -482,6 +483,38 @@ coreEnforceVersion info b cont handler _env = \case
         Left _msg -> throwExecutionError info (EnforcePactVersionParseFailure s)
         Right li -> pure (V.makeVersion li)
 
+coreLoad  :: ReplCEKEval step => NativeFunction step ReplCoreBuiltin SpanInfo (ReplM ReplCoreBuiltin)
+coreLoad info b cont handler _env = \case
+  [VString file] -> loadFile file False
+  [VString file, VBool clear] -> loadFile file clear
+  args -> argsError info b args
+  where
+  mangleFilePath fp = do
+    (SourceCode currFile _) <- use replCurrSource
+    case currFile of
+      "(interactive)" -> pure fp
+      _ | isAbsolute fp -> pure fp
+        | takeFileName currFile == currFile -> pure fp
+        | otherwise -> pure $ combine (takeDirectory currFile) fp
+  loadFile filePath reset = do
+    display <- use replDisplay
+    -- let loading = RCompileValue (InterpretValue (PString ("Loading " <> txt <> "...")) i)
+    display $ T.unpack ("Loading " <> filePath <> "...")
+    -- display loading
+    oldSrc <- use replCurrSource
+    pactdb <- liftIO (mockPactDb serialisePact_repl_spaninfo)
+    oldEE <- use replEvalEnv
+    when reset $ do
+      ee <- liftIO (defaultEvalEnv pactdb replCoreBuiltinMap)
+      evalState .= def
+      replEvalEnv .= ee
+    fp <- mangleFilePath (T.unpack txt)
+    when (isPactFile fp) $ esLoaded . loToplevel .= mempty
+    out <- loadPactReplFile replEnv display fp
+    replCurrSource .= oldSrc
+    unless reset $ do
+      replEvalEnv .= oldEE
+    pure out
 
 
 replBuiltinEnv

pact/Pact/Core/Repl/Utils.hs

@@ -17,7 +17,9 @@ module Pact.Core.Repl.Utils
  , runReplT
  , ReplState(..)
  , replFlags
- , replPactDb
+--  , replPactDb
+ , replPactDbs
+ , replEvaluate
  , replGas
  , replEvalLog
  , replEvalEnv
@@ -35,6 +37,10 @@ module Pact.Core.Repl.Utils
  , prettyReplFlag
  , replError
  , SourceCode(..)
+ , validReplChainIds
+ , defaultSrc
+ , mkReplState
+ , replDisplay
  ) where
 
 import Control.Lens
@@ -46,6 +52,7 @@ import Control.Monad.Except
 
 import Data.Void
 import Data.IORef
+import Data.Default
 import Data.Set(Set)
 import Data.Text(Text)
 import Data.List(isPrefixOf)
@@ -120,23 +127,69 @@ instance MonadState (ReplState b) (ReplM b)  where
 data ReplState b
   = ReplState
   { _replFlags :: Set ReplDebugFlag
-  , _replPactDb :: PactDb b SpanInfo
+  -- ^ The set of repl debug flags
   , _replEvalState :: EvalState b SpanInfo
+  -- ^ Interpretation evalstate
   , _replEvalEnv :: EvalEnv b SpanInfo
+  -- ^ interpretation evalenv
   , _replGas :: IORef Gas
+  -- ^ the gas ref for the repl
   , _replEvalLog :: IORef (Maybe [(Text, Gas)])
+  -- ^ Gaslog, from the POV of the repl
   , _replCurrSource :: SourceCode
+  -- ^ The current source file being evaluated,
+  -- or just interactive input
   , _replUserDocs :: Map QualifiedName Text
   -- ^ Used by Repl and LSP Server, reflects the user
   --   annotated @doc string.
   , _replTLDefPos :: Map QualifiedName SpanInfo
   -- ^ Used by LSP Server, reflects the span information
   --   of the TL definitions for the qualified name.
   , _replTx :: Maybe (TxId, Maybe Text)
+  -- ^ The current repl transaction, and tx descriptor
+  , _replEvaluate :: FilePath -> ReplM b ()
+  -- ^ a knot tie for the `load` native
+  , _replPactDbs :: Map ChainId (PactDb b SpanInfo)
+  -- ^ The list of pact dbs correspnding to a particular chain
+  , _replDisplay :: String -> ReplM b ()
+  -- ^ our "output to console". The only reason this is not necessarily
+  -- just `liftIO . putStrLn` is because of reasons such as piping to something else
+  -- (e.g some sort of logging structure) or a library such as haskeline.
   }
 
 makeLenses ''ReplState
 
+defaultSrc :: SourceCode
+defaultSrc = SourceCode "(interactive)" mempty
+
+mkReplState
+  :: PactDb b SpanInfo
+  -> EvalEnv b SpanInfo
+  -> (FilePath -> ReplM b ())
+  -> (String -> ReplM b ())
+  -> IO (ReplState b)
+mkReplState pdb ee loadFn displayFn = do
+  g <- newIORef mempty
+  evalLog <- newIORef Nothing
+  let chain0Pactdb = M.singleton (ChainId "0") pdb
+  pure $ ReplState
+    { _replFlags = mempty
+    , _replEvalState = def
+    , _replEvalEnv = ee
+    , _replGas = g
+    , _replEvalLog = evalLog
+    , _replCurrSource = defaultSrc
+    , _replUserDocs = mempty
+    , _replTLDefPos = mempty
+    , _replTx = Nothing
+    , _replEvaluate = loadFn
+    , _replPactDbs = chain0Pactdb
+    , _replDisplay = displayFn
+    }
+
+validReplChainIds :: [ChainId]
+validReplChainIds = ChainId . T.pack . show <$> [(0 :: Int)..19]
+
 instance MonadEvalEnv b SpanInfo (ReplM b) where
   readEnv = use replEvalEnv
 

pact/Pact/Core/Syntax/Lexer.x

@@ -62,7 +62,7 @@ tokens :-
 
     and          { token TokenAnd }
     or           { token TokenOr }
-    load         { token TokenLoad }
+    -- load         { token TokenLoad }
     \@doc        { token TokenDocAnn }
     \@model      { token TokenModelAnn}
     \@event      { token TokenEventAnn }

pact/Pact/Core/Syntax/Parser.y

@@ -64,7 +64,7 @@ import Pact.Core.Syntax.LexUtils
   progn      { PosToken TokenBlockIntro _ }
   try        { PosToken TokenTry _ }
   suspend    { PosToken TokenSuspend _ }
-  load       { PosToken TokenLoad _ }
+  -- load       { PosToken TokenLoad _ }
   docAnn     { PosToken TokenDocAnn _ }
   modelAnn   { PosToken TokenModelAnn _ }
   eventAnn   { PosToken TokenEventAnn _ }
@@ -119,17 +119,17 @@ TopLevel :: { ParsedTopLevel }
 
 RTL :: { ReplSpecialTL SpanInfo }
   : ReplTopLevel { RTL $1 }
-  | '(' ReplSpecial ')' { RTLReplSpecial  ($2 (combineSpan (_ptInfo $1) (_ptInfo $3))) }
+  -- | '(' ReplSpecial ')' { RTLReplSpecial  ($2 (combineSpan (_ptInfo $1) (_ptInfo $3))) }
 
 ReplTopLevel :: { ParsedReplTopLevel }
   : TopLevel { RTLTopLevel $1 }
   | '(' Defun ')' { RTLDefun ($2 (combineSpan (_ptInfo $1) (_ptInfo $3))) }
   | '(' DefConst ')' { RTLDefConst ($2 (combineSpan (_ptInfo $1) (_ptInfo $3))) }
 
 
-ReplSpecial :: { SpanInfo -> ReplSpecialForm SpanInfo }
-  : load STR BOOLEAN { ReplLoad (getStr $2) $3 }
-  | load STR { ReplLoad (getStr $2) False }
+-- ReplSpecial :: { SpanInfo -> ReplSpecialForm SpanInfo }
+--   : load STR BOOLEAN { ReplLoad (getStr $2) $3 }
+--   | load STR { ReplLoad (getStr $2) False }
 
 Governance :: { Governance ParsedName }
   : StringRaw { KeyGov (KeySetName $1 Nothing) }