Skip to content

Commit

Permalink
wip load in multichain repl
Browse files Browse the repository at this point in the history
  • Loading branch information
jmcardon committed Feb 14, 2024
1 parent b3f2c86 commit 6a43272
Show file tree
Hide file tree
Showing 7 changed files with 117 additions and 18 deletions.
6 changes: 6 additions & 0 deletions pact/Pact/Core/Builtin.hs
Original file line number Diff line number Diff line change
Expand Up @@ -728,6 +728,8 @@ data ReplBuiltins
| RPactVersion
| REnforcePactVersionMin
| REnforcePactVersionRange
| RLoad
| RLoadReset
deriving (Show, Enum, Bounded, Eq, Generic)


Expand Down Expand Up @@ -772,6 +774,8 @@ instance IsBuiltin ReplBuiltins where
RPactVersion -> 0
REnforcePactVersionMin -> 1
REnforcePactVersionRange -> 2
RLoad -> 1
RLoadReset -> 2

-- RLoad -> 1
-- RLoadWithEnv -> 2
Expand Down Expand Up @@ -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
Expand Down
8 changes: 3 additions & 5 deletions pact/Pact/Core/Repl.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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:"
Expand All @@ -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
Expand All @@ -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
Expand Down
19 changes: 14 additions & 5 deletions pact/Pact/Core/Repl/Compile.hs
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,8 @@ module Pact.Core.Repl.Compile
( ReplCompileValue(..)
, interpretReplProgram
, interpretReplProgramSmallStep
, loadPactReplFile
, loadPactReplFile'
) where

import Control.Lens
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
33 changes: 33 additions & 0 deletions pact/Pact/Core/Repl/Runtime/ReplBuiltin.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
57 changes: 55 additions & 2 deletions pact/Pact/Core/Repl/Utils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,9 @@ module Pact.Core.Repl.Utils
, runReplT
, ReplState(..)
, replFlags
, replPactDb
-- , replPactDb
, replPactDbs
, replEvaluate
, replGas
, replEvalLog
, replEvalEnv
Expand All @@ -35,6 +37,10 @@ module Pact.Core.Repl.Utils
, prettyReplFlag
, replError
, SourceCode(..)
, validReplChainIds
, defaultSrc
, mkReplState
, replDisplay
) where

import Control.Lens
Expand All @@ -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)
Expand Down Expand Up @@ -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

Expand Down
2 changes: 1 addition & 1 deletion pact/Pact/Core/Syntax/Lexer.x
Original file line number Diff line number Diff line change
Expand Up @@ -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 }
Expand Down
10 changes: 5 additions & 5 deletions pact/Pact/Core/Syntax/Parser.y
Original file line number Diff line number Diff line change
Expand Up @@ -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 _ }
Expand Down Expand Up @@ -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) }
Expand Down

0 comments on commit 6a43272

Please sign in to comment.