mirror of
https://github.com/anoma/juvix.git
synced 2024-12-13 11:16:48 +03:00
a9995b8e1c
This PR adds an parser, pretty printer, evaluator, repl and quasi-quoter for Nock terms. ## Parser / Pretty Printer The parser and pretty printer handle both standard Nock terms and 'pretty' Nock terms (where op codes and paths can be named). Standard and pretty Nock forms can be mixed in the same term. For example instead of `[0 2]` you can write `[@ L]`. Seea6028b0d92/src/Juvix/Compiler/Nockma/Language.hs (L79)for the correspondence between pretty Nock and Nock operators. In pretty Nock, paths are represented as strings of `L` (for head) and `R` (for tail) instead of the number encoding in standard nock. The character `S` is used to refer to the whole subject, i.e it is sugar for `1` in standard Nock. Seea6028b0d92/src/Juvix/Compiler/Nockma/Language.hs (L177)for the correspondence between pretty Nock path and standard Nock position. ## Quasi-quoter A quasi-quoter is added so Nock terms can be included in the source, e.g `[nock| [@ LL] |]`. ## REPL Launch the repl with `juvix dev nockma repl`. A Nock `[subject formula]` cell is input as `subject / formula` , e.g: ``` nockma> [1 0] / [@ L] 1 ``` The subject can be set using `:set-stack`. ``` nockma> :set-stack [1 0] nockma> [@ L] 1 ``` The subject can be viewed using `:get-stack`. ``` nockma> :set-stack [1 0] nockma> :get-stack [1 0] ``` You can assign a Nock term to a variable and use it in another expression: ``` nockma> r := [@ L] nockma> [1 0] / r 1 ``` A list of assignments can be read from a file: ``` $ cat stack.nock r := [@ L] $ juvix dev nockma repl nockma> :load stack.nock nockma> [1 0] / r 1 ``` * Closes https://github.com/anoma/juvix/issues/2557 --------- Co-authored-by: Jan Mas Rovira <janmasrovira@gmail.com> Co-authored-by: Lukasz Czajka <lukasz@heliax.dev>
118 lines
3.4 KiB
Haskell
118 lines
3.4 KiB
Haskell
module Base
|
|
( module Test.Tasty,
|
|
module Test.Tasty.HUnit,
|
|
module Juvix.Prelude,
|
|
module Base,
|
|
module Juvix.Extra.Paths,
|
|
module Juvix.Prelude.Env,
|
|
module Juvix.Compiler.Pipeline.Run,
|
|
module Juvix.Compiler.Pipeline.EntryPoint.IO,
|
|
)
|
|
where
|
|
|
|
import Control.Monad.Extra as Monad
|
|
import Data.Algorithm.Diff
|
|
import Data.Algorithm.DiffOutput
|
|
import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.Termination
|
|
import Juvix.Compiler.Pipeline.EntryPoint.IO
|
|
import Juvix.Compiler.Pipeline.Loader.PathResolver
|
|
import Juvix.Compiler.Pipeline.Run
|
|
import Juvix.Data.Effect.TaggedLock
|
|
import Juvix.Extra.Paths hiding (rootBuildDir)
|
|
import Juvix.Prelude hiding (assert)
|
|
import Juvix.Prelude.Env
|
|
import Test.Tasty
|
|
import Test.Tasty.HUnit hiding (assertFailure)
|
|
import Test.Tasty.HUnit qualified as HUnit
|
|
|
|
data AssertionDescr
|
|
= Single Assertion
|
|
| Steps ((String -> IO ()) -> Assertion)
|
|
|
|
data TestDescr = TestDescr
|
|
{ _testName :: String,
|
|
_testRoot :: Path Abs Dir,
|
|
-- | relative to root
|
|
_testAssertion :: AssertionDescr
|
|
}
|
|
|
|
newtype WASMInfo = WASMInfo
|
|
{ _wasmInfoActual :: Path Abs File -> IO Text
|
|
}
|
|
|
|
makeLenses ''TestDescr
|
|
|
|
data StdlibMode
|
|
= StdlibInclude
|
|
| StdlibExclude
|
|
deriving stock (Show, Eq)
|
|
|
|
data CompileMode
|
|
= WASI StdlibMode
|
|
| WASM WASMInfo
|
|
|
|
mkTest :: TestDescr -> TestTree
|
|
mkTest TestDescr {..} = case _testAssertion of
|
|
Single assertion -> testCase _testName (withCurrentDir _testRoot assertion)
|
|
Steps steps -> testCaseSteps _testName (withCurrentDir _testRoot . steps)
|
|
|
|
assertEqDiffText :: String -> Text -> Text -> Assertion
|
|
assertEqDiffText = assertEqDiff unpack
|
|
|
|
assertEqDiff :: (Eq a) => (a -> String) -> String -> a -> a -> Assertion
|
|
assertEqDiff show_ msg a b
|
|
| a == b = return ()
|
|
| otherwise = do
|
|
putStrLn (pack $ ppDiff (getGroupedDiff pa pb))
|
|
putStrLn "End diff"
|
|
Monad.fail msg
|
|
where
|
|
pa = lines $ show_ a
|
|
pb = lines $ show_ b
|
|
|
|
assertEqDiffShow :: (Eq a, Show a) => String -> a -> a -> Assertion
|
|
assertEqDiffShow = assertEqDiff show
|
|
|
|
assertCmdExists :: Path Rel File -> Assertion
|
|
assertCmdExists cmd =
|
|
assertBool ("Command: " <> toFilePath cmd <> " is not present on $PATH")
|
|
. isJust
|
|
=<< findExecutable cmd
|
|
|
|
testTaggedLockedToIO :: Sem PipelineAppEffects a -> IO a
|
|
testTaggedLockedToIO =
|
|
runFinal
|
|
. resourceToIOFinal
|
|
. embedToFinal @IO
|
|
. runTaggedLock LockModeExclusive
|
|
|
|
testRunIO ::
|
|
forall a.
|
|
EntryPoint ->
|
|
Sem (PipelineEff PipelineAppEffects) a ->
|
|
IO (ResolverState, PipelineResult a)
|
|
testRunIO e = testTaggedLockedToIO . runIO defaultGenericOptions e
|
|
|
|
testDefaultEntryPointIO :: Path Abs Dir -> Path Abs File -> IO EntryPoint
|
|
testDefaultEntryPointIO cwd mainFile = testTaggedLockedToIO (defaultEntryPointIO cwd mainFile)
|
|
|
|
testDefaultEntryPointNoFileIO :: Path Abs Dir -> IO EntryPoint
|
|
testDefaultEntryPointNoFileIO cwd = testTaggedLockedToIO (defaultEntryPointNoFileIO cwd)
|
|
|
|
testRunIOEither ::
|
|
EntryPoint ->
|
|
Sem (PipelineEff PipelineAppEffects) a ->
|
|
IO (Either JuvixError (ResolverState, PipelineResult a))
|
|
testRunIOEither entry = testTaggedLockedToIO . runIOEither entry
|
|
|
|
testRunIOEitherTermination ::
|
|
EntryPoint ->
|
|
Sem (Termination ': PipelineEff PipelineAppEffects) a ->
|
|
IO (Either JuvixError (ResolverState, PipelineResult a))
|
|
testRunIOEitherTermination entry =
|
|
testRunIOEither entry
|
|
. evalTermination iniTerminationState
|
|
|
|
assertFailure :: (MonadIO m) => String -> m a
|
|
assertFailure = liftIO . HUnit.assertFailure
|