From 6a43272eed121ebfdb140056d00806375e8118b4 Mon Sep 17 00:00:00 2001 From: jmcardon Date: Tue, 13 Feb 2024 20:43:38 -0500 Subject: [PATCH] wip load in multichain repl --- pact/Pact/Core/Builtin.hs | 6 +++ pact/Pact/Core/Repl.hs | 8 ++- pact/Pact/Core/Repl/Compile.hs | 19 ++++++-- pact/Pact/Core/Repl/Runtime/ReplBuiltin.hs | 33 +++++++++++++ pact/Pact/Core/Repl/Utils.hs | 57 +++++++++++++++++++++- pact/Pact/Core/Syntax/Lexer.x | 2 +- pact/Pact/Core/Syntax/Parser.y | 10 ++-- 7 files changed, 117 insertions(+), 18 deletions(-) diff --git a/pact/Pact/Core/Builtin.hs b/pact/Pact/Core/Builtin.hs index 00b795b0c..320f05d5b 100644 --- a/pact/Pact/Core/Builtin.hs +++ b/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 diff --git a/pact/Pact/Core/Repl.hs b/pact/Pact/Core/Repl.hs index c8b12a472..45bcaf23e 100644 --- a/pact/Pact/Core/Repl.hs +++ b/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 diff --git a/pact/Pact/Core/Repl/Compile.hs b/pact/Pact/Core/Repl/Compile.hs index 64f41c1a9..451d9fd38 100644 --- a/pact/Pact/Core/Repl/Compile.hs +++ b/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 diff --git a/pact/Pact/Core/Repl/Runtime/ReplBuiltin.hs b/pact/Pact/Core/Repl/Runtime/ReplBuiltin.hs index 3fdf1f8dd..08dcceec6 100644 --- a/pact/Pact/Core/Repl/Runtime/ReplBuiltin.hs +++ b/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 diff --git a/pact/Pact/Core/Repl/Utils.hs b/pact/Pact/Core/Repl/Utils.hs index 36b9e2df9..248953a4a 100644 --- a/pact/Pact/Core/Repl/Utils.hs +++ b/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,12 +127,18 @@ 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. @@ -133,10 +146,50 @@ data ReplState b -- ^ 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 diff --git a/pact/Pact/Core/Syntax/Lexer.x b/pact/Pact/Core/Syntax/Lexer.x index f050fa759..f586d0108 100644 --- a/pact/Pact/Core/Syntax/Lexer.x +++ b/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 } diff --git a/pact/Pact/Core/Syntax/Parser.y b/pact/Pact/Core/Syntax/Parser.y index 61ebdc05f..57dec6f5c 100644 --- a/pact/Pact/Core/Syntax/Parser.y +++ b/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,7 +119,7 @@ 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 } @@ -127,9 +127,9 @@ ReplTopLevel :: { ParsedReplTopLevel } | '(' 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) }