Skip to content

Commit

Permalink
Separate repl into separate project, fix REPL docs output
Browse files Browse the repository at this point in the history
  • Loading branch information
jmcardon committed Nov 4, 2024
1 parent c0c1861 commit 419b807
Show file tree
Hide file tree
Showing 17 changed files with 98 additions and 54 deletions.
4 changes: 2 additions & 2 deletions docs/builtins/General/enforce.md
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,7 @@ Use the following arguments to specify the test expression and error message for

| Argument | Type | Description |
|----------|--------|------------------------------------------------|
| `expression` | bool | Specifies the expression to evaluate. |
| expression | bool | Specifies the expression to evaluate. |
| `message` | string | Specifies the error message to display if the `expression` evaluates as false. |

### Return values
Expand All @@ -34,7 +34,7 @@ pact> (enforce (= (+ 2 2) 4) "All is well")
true
```

Because the specified expression (`2 + 2 = 4`) is true, the function returns true and the transaction continues.
Because the specified expression (`2 + 2 = 4`) is true, the function returns true and the transaction continues.

The following example demonstrates how to use the `enforce` function to evaluate the expression `(2 + 2) != 4`:

Expand Down
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
Original file line number Diff line number Diff line change
Expand Up @@ -9,11 +9,14 @@ import Language.Haskell.TH.Syntax
import System.Directory
import System.FilePath

import Data.Default
import Control.Monad
import Control.Monad.IO.Class
import qualified Data.Text.IO as T
import qualified Data.Text as T
import qualified Data.Map.Strict as M
import Data.Functor
import Text.Pandoc hiding (runIO)

listBuiltinDocs :: IO [FilePath]
listBuiltinDocs = do
Expand Down Expand Up @@ -41,10 +44,20 @@ mkBuiltinDocs = embedIO action
files <- listBuiltinDocs
cnt <- forM files $ \f -> do
let bname = takeBaseName f
content <- T.readFile f
content <- runIOorExplode $
writeANSI writerOpts =<< readMarkdown readerOpts =<< liftIO (T.readFile f)
pure (normalizedNameToBuiltin $ T.pack bname, MarkdownDoc content)
pure $ M.fromList cnt

readerOpts :: ReaderOptions
readerOpts = def
{ readerExtensions = pandocExtensions
}

writerOpts :: WriterOptions
writerOpts = def
{ writerExtensions = pandocExtensions
}

builtinToNormalizedName :: T.Text -> T.Text
builtinToNormalizedName = \case
Expand Down
File renamed without changes.
File renamed without changes.
File renamed without changes.
23 changes: 23 additions & 0 deletions pact/Pact/Core/Repl/Utils.hs → pact-repl/Pact/Core/Repl/Utils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DataKinds #-}
{-# OPTIONS_GHC -Wno-orphans #-}


module Pact.Core.Repl.Utils
Expand Down Expand Up @@ -68,6 +69,7 @@ import Pact.Core.Environment
import Pact.Core.Type
import Pact.Core.Builtin
import Pact.Core.PactValue
import Pact.Core.Debug
import qualified Pact.Core.IR.Term as Term

import System.Console.Haskeline.Completion
Expand Down Expand Up @@ -246,3 +248,24 @@ replPrintLn' :: Text -> EvalM 'ReplRuntime b SpanInfo ()
replPrintLn' p = do
r <- getReplState
_replOutputLine r p

-- This orphan instance allows us to separate
-- the repl declaration out, as ugly as it is
instance DebugPrintable 'ReplRuntime (ReplBuiltin CoreBuiltin) where
debugPrint dp term =
ask >>= \case
ReplEnv _ -> do
case dp of
DPLexer -> whenReplFlagSet ReplDebugLexer $ liftIO $ do
putStrLn "----------- Lexer output -----------------"
print (pretty term)
DPParser -> whenReplFlagSet ReplDebugParser $
liftIO $ do
putStrLn "----------- Parser output ----------------"
print (pretty term)
DPDesugar -> whenReplFlagSet ReplDebugDesugar $ case term of
Term.TLTerm t ->
liftIO $ do
putStrLn "----------- Desugar output ---------------"
print (pretty t)
_ -> pure ()
48 changes: 35 additions & 13 deletions pact-tng.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -246,7 +246,6 @@ library
Pact.Core.Evaluate
Pact.Core.Scheme
Pact.Core.SPV
Pact.Core.Repl
Pact.Core.SizeOf
Pact.Core.SizeOf.Deriving
Pact.Core.StackFrame
Expand All @@ -267,11 +266,6 @@ library
Pact.Core.IR.Term
Pact.Core.IR.Desugar

Pact.Core.IR.Eval.Direct.Evaluator
Pact.Core.IR.Eval.Direct.CoreBuiltin
Pact.Core.IR.Eval.Direct.ReplBuiltin
Pact.Core.IR.Eval.Direct.Types

-- Core IR Evaluator modules
Pact.Core.IR.Eval.Runtime
Pact.Core.IR.Eval.Runtime.Types
Expand All @@ -287,12 +281,13 @@ library
Pact.Core.Version

-- Repl
Pact.Core.Repl.Utils
Pact.Core.Repl.Runtime.ReplBuiltin
Pact.Core.Repl.Compile
Pact.Core.Repl.BuiltinDocs
Pact.Core.Repl.BuiltinDocs.Internal
Pact.Core.Repl.UserDocs
-- Pact.Core.Repl
-- Pact.Core.Repl.Utils
-- Pact.Core.Repl.Runtime.ReplBuiltin
-- Pact.Core.Repl.Compile
-- Pact.Core.Repl.BuiltinDocs
-- Pact.Core.Repl.BuiltinDocs.Internal
-- Pact.Core.Repl.UserDocs

-- Serialization
Pact.Core.Serialise
Expand All @@ -311,6 +306,30 @@ library

extra-libraries: mpfr

library pact-repl
import: pact-common
hs-source-dirs: pact-repl

exposed-modules:
Pact.Core.Repl
Pact.Core.Repl.Utils
Pact.Core.Repl.Runtime.ReplBuiltin
Pact.Core.Repl.Compile
Pact.Core.Repl.BuiltinDocs
Pact.Core.Repl.BuiltinDocs.Internal
Pact.Core.Repl.UserDocs

Pact.Core.IR.Eval.Direct.Evaluator
Pact.Core.IR.Eval.Direct.CoreBuiltin
Pact.Core.IR.Eval.Direct.ReplBuiltin
Pact.Core.IR.Eval.Direct.Types

build-depends:
, pact-tng
, pact-tng:pact-crypto
, filepath
, pandoc

library pact-lsp
import: pact-common
hs-source-dirs: pact-lsp
Expand All @@ -322,6 +341,7 @@ library pact-lsp

build-depends:
, pact-tng
, pact-tng:pact-repl
, lsp
, lsp-types
, filepath
Expand Down Expand Up @@ -369,10 +389,11 @@ executable profile-tx

executable pact
import: pact-common
main-is: repl/Main.hs
main-is: pact-repl/Main.hs

build-depends: base
, pact-tng
, pact-tng:pact-repl
, pact-tng:pact-lsp
, optparse-applicative
, pact-tng:pact-request-api
Expand Down Expand Up @@ -523,6 +544,7 @@ test-suite core-tests
, semirings
, neat-interpolation
, pact-tng:pact-request-api
, pact-tng:pact-repl
, pact-tng:pact-lsp
, pact-tng:test-utils
, pact-tng:unsafe
Expand Down
4 changes: 2 additions & 2 deletions pact/Pact/Core/Compile.hs
Original file line number Diff line number Diff line change
Expand Up @@ -153,7 +153,7 @@ evalModuleGovernance interpreter tl = do

compileDesugarOnly
:: forall e b i
. (HasCompileEnv b i)
. (HasCompileEnv b i, DebugPrintable e b)
=> Interpreter e b i
-> Lisp.TopLevel i
-> EvalM e b i (EvalTopLevel b i, S.Set ModuleName)
Expand All @@ -169,7 +169,7 @@ compileDesugarOnly interpreter tl = do

interpretTopLevel
:: forall e b i
. (HasCompileEnv b i)
. (HasCompileEnv b i, DebugPrintable e b)
=> Interpreter e b i
-> RawCode
-> Lisp.TopLevel i
Expand Down
32 changes: 9 additions & 23 deletions pact/Pact/Core/Debug.hs
Original file line number Diff line number Diff line change
@@ -1,22 +1,23 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FunctionalDependencies #-}

module Pact.Core.Debug
( DebugFlag(..)
, DebugPrint(..)
, debugPrint
, DebugPrintable(..)
) where

import Control.Monad.Reader
import Pact.Core.Type
import Pact.Core.Names
import Pact.Core.Syntax.LexUtils(PosToken)
import Pact.Core.Environment
import qualified Pact.Core.Syntax.ParseTree as Syntax
import qualified Pact.Core.IR.Term as Term
import Pact.Core.Repl.Utils
import Pact.Core.Pretty
import Pact.Core.Builtin (CoreBuiltin)

data DebugPrint b i term where
DPLexer :: DebugPrint b i [PosToken]
Expand All @@ -29,23 +30,8 @@ data DebugFlag
| DFDesugar
deriving (Show, Eq, Ord, Enum, Bounded)

debugPrint :: (Pretty b) => DebugPrint b i term -> term -> EvalM e b i ()
debugPrint dp term =
ask >>= \case
ExecEnv _ -> pure ()
ReplEnv _ -> do
case dp of
DPLexer -> whenReplFlagSet ReplDebugLexer $ liftIO $ do
putStrLn "----------- Lexer output -----------------"
print (pretty term)
DPParser -> whenReplFlagSet ReplDebugParser $
liftIO $ do
putStrLn "----------- Parser output ----------------"
print (pretty term)
DPDesugar -> whenReplFlagSet ReplDebugDesugar $ case term of
Term.TLTerm t ->
liftIO $ do
putStrLn "----------- Desugar output ---------------"
print (pretty t)
_ -> pure ()
class DebugPrintable (e :: RuntimeMode) b | e -> b where
debugPrint :: DebugPrint b i term -> term -> EvalM e b i ()

instance DebugPrintable 'ExecRuntime CoreBuiltin where
debugPrint _ _ = pure ()
26 changes: 13 additions & 13 deletions pact/Pact/Core/Evaluate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@ module Pact.Core.Evaluate
, Eval
, EvalBuiltinEnv
, allModuleExports
, evalDirectInterpreter
-- , evalDirectInterpreter
, evalInterpreter
, EvalInput
, EnableGasLogs(..)
Expand Down Expand Up @@ -64,8 +64,8 @@ import Pact.Core.Info
import Pact.Core.Signer
import Pact.Core.IR.Eval.CEK.CoreBuiltin
import qualified Pact.Core.IR.Eval.CEK.Evaluator as CEK
import qualified Pact.Core.IR.Eval.Direct.Evaluator as Direct
import qualified Pact.Core.IR.Eval.Direct.CoreBuiltin as Direct
-- import qualified Pact.Core.IR.Eval.Direct.Evaluator as Direct
-- import qualified Pact.Core.IR.Eval.Direct.CoreBuiltin as Direct
import qualified Pact.Core.Syntax.Lexer as Lisp
import qualified Pact.Core.Syntax.Parser as Lisp
import qualified Pact.Core.Syntax.ParseTree as Lisp
Expand Down Expand Up @@ -118,16 +118,16 @@ evalInterpreter =
cekEnv :: CEK.BuiltinEnv ExecRuntime CoreBuiltin Info
cekEnv = coreBuiltinEnv @ExecRuntime

evalDirectInterpreter :: Interpreter ExecRuntime CoreBuiltin Info
evalDirectInterpreter =
Interpreter runGuard runTerm resume evalWithCap
where
runTerm purity term = Direct.eval purity env term
runGuard info g = Direct.interpretGuard info env g
resume info defPact = Direct.evalResumePact info env defPact
evalWithCap info purity ct term =
Direct.evalWithinCap info purity env ct term
env = Direct.coreBuiltinEnv
-- evalDirectInterpreter :: Interpreter ExecRuntime CoreBuiltin Info
-- evalDirectInterpreter =
-- Interpreter runGuard runTerm resume evalWithCap
-- where
-- runTerm purity term = Direct.eval purity env term
-- runGuard info g = Direct.interpretGuard info env g
-- resume info defPact = Direct.evalResumePact info env defPact
-- evalWithCap info purity ct term =
-- Direct.evalWithinCap info purity env ct term
-- env = Direct.coreBuiltinEnv

-- | Transaction-payload related environment data.
data MsgData = MsgData
Expand Down

0 comments on commit 419b807

Please sign in to comment.