diff --git a/app/Commands/Compile.hs b/app/Commands/Compile.hs index f36970fb4..cf0dfee62 100644 --- a/app/Commands/Compile.hs +++ b/app/Commands/Compile.hs @@ -29,6 +29,7 @@ runCommand opts@CompileOptions {..} = do TargetReg -> Compile.runRegPipeline arg TargetNockma -> Compile.runNockmaPipeline arg TargetAnoma -> Compile.runAnomaPipeline arg + TargetCasm -> Compile.runCasmPipeline arg writeCoreFile :: (Members '[EmbedIO, App, TaggedLock] r) => Compile.PipelineArg -> Sem r () writeCoreFile pa@Compile.PipelineArg {..} = do diff --git a/app/Commands/Dev/Asm/Compile.hs b/app/Commands/Dev/Asm/Compile.hs index 7b110f6ad..c49073c7b 100644 --- a/app/Commands/Dev/Asm/Compile.hs +++ b/app/Commands/Dev/Asm/Compile.hs @@ -6,7 +6,10 @@ import Commands.Extra.Compile qualified as Compile import Juvix.Compiler.Asm.Translation.FromSource qualified as Asm import Juvix.Compiler.Backend qualified as Backend import Juvix.Compiler.Backend.C qualified as C +import Juvix.Compiler.Casm.Data.Result qualified as Casm +import Juvix.Compiler.Casm.Pretty qualified as Casm import Juvix.Compiler.Reg.Pretty qualified as Reg +import Juvix.Prelude.Pretty runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock] r) => AsmCompileOptions -> Sem r () runCommand opts = do @@ -34,6 +37,15 @@ runCommand opts = do tab' <- getRight r let code = Reg.ppPrint tab' tab' writeFileEnsureLn regFile code + TargetCasm -> do + casmFile <- Compile.outputFile opts file + r <- + runReader entryPoint + . runError @JuvixError + . asmToCasm + $ tab + Casm.Result {..} <- getRight r + writeFileEnsureLn casmFile (toPlainText $ Casm.ppProgram _resultCode) _ -> case run $ runReader entryPoint $ runError $ asmToMiniC tab of Left err -> exitJuvixError err @@ -57,6 +69,7 @@ runCommand opts = do TargetWasm32Wasi -> return Backend.TargetCWasm32Wasi TargetNative64 -> return Backend.TargetCNative64 TargetReg -> return Backend.TargetReg + TargetCasm -> return Backend.TargetCairo TargetNockma -> err "Nockma" TargetAnoma -> err "Anoma" TargetTree -> err "JuvixTree" diff --git a/app/Commands/Dev/Asm/Compile/Options.hs b/app/Commands/Dev/Asm/Compile/Options.hs index ab234bb45..4165d9ed5 100644 --- a/app/Commands/Dev/Asm/Compile/Options.hs +++ b/app/Commands/Dev/Asm/Compile/Options.hs @@ -15,7 +15,8 @@ asmSupportedTargets = NonEmpty.fromList [ TargetWasm32Wasi, TargetNative64, - TargetReg + TargetReg, + TargetCasm ] parseAsmCompileOptions :: Parser AsmCompileOptions diff --git a/app/Commands/Dev/Core/Compile.hs b/app/Commands/Dev/Core/Compile.hs index 6384ea5d8..9455c0c89 100644 --- a/app/Commands/Dev/Core/Compile.hs +++ b/app/Commands/Dev/Core/Compile.hs @@ -23,6 +23,7 @@ runCommand opts = do TargetTree -> runTreePipeline arg TargetNockma -> runNockmaPipeline arg TargetAnoma -> runAnomaPipeline arg + TargetCasm -> runCasmPipeline arg where getFile :: Sem r (Path Abs File) getFile = getMainFile (opts ^. compileInputFile) diff --git a/app/Commands/Dev/Core/Compile/Base.hs b/app/Commands/Dev/Core/Compile/Base.hs index 8bde3be72..27c21d65e 100644 --- a/app/Commands/Dev/Core/Compile/Base.hs +++ b/app/Commands/Dev/Core/Compile/Base.hs @@ -8,11 +8,14 @@ import Juvix.Compiler.Backend qualified as Backend import Juvix.Compiler.Backend.C qualified as C import Juvix.Compiler.Backend.Geb qualified as Geb import Juvix.Compiler.Backend.VampIR.Translation qualified as VampIR +import Juvix.Compiler.Casm.Data.Result qualified as Casm +import Juvix.Compiler.Casm.Pretty qualified as Casm import Juvix.Compiler.Core.Data.Module qualified as Core import Juvix.Compiler.Core.Data.TransformationId qualified as Core import Juvix.Compiler.Nockma.Pretty qualified as Nockma import Juvix.Compiler.Reg.Pretty qualified as Reg import Juvix.Compiler.Tree.Pretty qualified as Tree +import Juvix.Prelude.Pretty import System.FilePath (takeBaseName) data PipelineArg = PipelineArg @@ -45,6 +48,7 @@ getEntry PipelineArg {..} = do TargetTree -> Backend.TargetTree TargetNockma -> Backend.TargetNockma TargetAnoma -> Backend.TargetAnoma + TargetCasm -> Backend.TargetCairo defaultOptLevel :: Int defaultOptLevel @@ -168,3 +172,15 @@ runAnomaPipeline pa@PipelineArg {..} = do tab' <- getRight r let code = Nockma.ppSerialize tab' writeFileEnsureLn nockmaFile code + +runCasmPipeline :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r () +runCasmPipeline pa@PipelineArg {..} = do + entryPoint <- getEntry pa + casmFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile + r <- + runReader entryPoint + . runError @JuvixError + . coreToCasm + $ _pipelineArgModule + Casm.Result {..} <- getRight r + writeFileEnsureLn casmFile (toPlainText $ Casm.ppProgram _resultCode) diff --git a/app/Commands/Dev/Core/Compile/Options.hs b/app/Commands/Dev/Core/Compile/Options.hs index 73298a730..ee8d40c95 100644 --- a/app/Commands/Dev/Core/Compile/Options.hs +++ b/app/Commands/Dev/Core/Compile/Options.hs @@ -19,7 +19,8 @@ coreSupportedTargets = TargetVampIR, TargetTree, TargetAsm, - TargetReg + TargetReg, + TargetCasm ] parseCoreCompileOptions :: Parser CoreCompileOptions diff --git a/app/Commands/Dev/Reg.hs b/app/Commands/Dev/Reg.hs index a06f6fca6..2791e12de 100644 --- a/app/Commands/Dev/Reg.hs +++ b/app/Commands/Dev/Reg.hs @@ -1,11 +1,13 @@ module Commands.Dev.Reg where import Commands.Base +import Commands.Dev.Reg.Compile as Compile import Commands.Dev.Reg.Options import Commands.Dev.Reg.Read as Read import Commands.Dev.Reg.Run as Run runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock] r) => RegCommand -> Sem r () runCommand = \case + Compile opts -> Compile.runCommand opts Run opts -> Run.runCommand opts Read opts -> Read.runCommand opts diff --git a/app/Commands/Dev/Reg/Compile.hs b/app/Commands/Dev/Reg/Compile.hs new file mode 100644 index 000000000..d9ab12c49 --- /dev/null +++ b/app/Commands/Dev/Reg/Compile.hs @@ -0,0 +1,79 @@ +module Commands.Dev.Reg.Compile where + +import Commands.Base +import Commands.Dev.Reg.Compile.Options +import Commands.Extra.Compile qualified as Compile +import Juvix.Compiler.Backend qualified as Backend +import Juvix.Compiler.Backend.C qualified as C +import Juvix.Compiler.Casm.Data.Result qualified as Casm +import Juvix.Compiler.Casm.Pretty qualified as Casm +import Juvix.Compiler.Reg.Translation.FromSource qualified as Reg +import Juvix.Prelude.Pretty + +runCommand :: forall r. (Members '[EmbedIO, App, TaggedLock] r) => CompileOptions -> Sem r () +runCommand opts = do + file <- getFile + s <- readFile file + case Reg.runParser file s of + Left err -> exitJuvixError (JuvixError err) + Right tab -> do + ep <- getEntryPoint (AppPath (preFileFromAbs file) True) + tgt <- getTarget (opts ^. compileTarget) + let entryPoint :: EntryPoint + entryPoint = + ep + { _entryPointTarget = tgt, + _entryPointDebug = opts ^. compileDebug + } + case opts ^. compileTarget of + TargetCasm -> do + casmFile <- Compile.outputFile opts file + r <- + runReader entryPoint + . runError @JuvixError + . regToCasm + $ tab + Casm.Result {..} <- getRight r + writeFileEnsureLn casmFile (toPlainText $ Casm.ppProgram _resultCode) + _ -> + case run $ runReader entryPoint $ runError $ regToMiniC tab of + Left err -> exitJuvixError err + Right C.MiniCResult {..} -> do + buildDir <- askBuildDir + ensureDir buildDir + cFile <- inputCFile file + writeFileEnsureLn cFile _resultCCode + outfile <- Compile.outputFile opts file + Compile.runCommand + opts + { _compileInputFile = Just (AppPath (preFileFromAbs cFile) False), + _compileOutputFile = Just (AppPath (preFileFromAbs outfile) False) + } + where + getFile :: Sem r (Path Abs File) + getFile = getMainFile (opts ^. compileInputFile) + + getTarget :: CompileTarget -> Sem r Backend.Target + getTarget = \case + TargetWasm32Wasi -> return Backend.TargetCWasm32Wasi + TargetNative64 -> return Backend.TargetCNative64 + TargetCasm -> return Backend.TargetCairo + TargetReg -> err "JuvixReg" + TargetNockma -> err "Nockma" + TargetAnoma -> err "Anoma" + TargetTree -> err "JuvixTree" + TargetGeb -> err "GEB" + TargetVampIR -> err "VampIR" + TargetCore -> err "JuvixCore" + TargetAsm -> err "JuvixAsm" + where + err :: Text -> Sem r a + err tgt = exitMsg (ExitFailure 1) ("error: " <> tgt <> " target not supported for JuvixReg") + +inputCFile :: (Members '[App] r) => Path Abs File -> Sem r (Path Abs File) +inputCFile inputFileCompile = do + buildDir <- askBuildDir + return (buildDir outputMiniCFile) + where + outputMiniCFile :: Path Rel File + outputMiniCFile = replaceExtension' ".c" (filename inputFileCompile) diff --git a/app/Commands/Dev/Reg/Compile/Options.hs b/app/Commands/Dev/Reg/Compile/Options.hs new file mode 100644 index 000000000..652617505 --- /dev/null +++ b/app/Commands/Dev/Reg/Compile/Options.hs @@ -0,0 +1,23 @@ +module Commands.Dev.Reg.Compile.Options + ( module Commands.Dev.Reg.Compile.Options, + module Commands.Extra.Compile.Options, + ) +where + +import Commands.Extra.Compile.Options +import CommonOptions +import Data.List.NonEmpty qualified as NonEmpty + +regSupportedTargets :: NonEmpty CompileTarget +regSupportedTargets = + NonEmpty.fromList + [ TargetWasm32Wasi, + TargetNative64, + TargetCasm + ] + +parseRegCompileOptions :: Parser CompileOptions +parseRegCompileOptions = + parseCompileOptions + regSupportedTargets + (parseInputFile FileExtJuvixReg) diff --git a/app/Commands/Dev/Reg/Options.hs b/app/Commands/Dev/Reg/Options.hs index 53472072a..ba96b5b34 100644 --- a/app/Commands/Dev/Reg/Options.hs +++ b/app/Commands/Dev/Reg/Options.hs @@ -1,11 +1,13 @@ module Commands.Dev.Reg.Options where +import Commands.Dev.Reg.Compile.Options import Commands.Dev.Reg.Read.Options import Commands.Dev.Reg.Run.Options import CommonOptions data RegCommand - = Run RegRunOptions + = Compile CompileOptions + | Run RegRunOptions | Read RegReadOptions deriving stock (Data) @@ -13,16 +15,26 @@ parseRegCommand :: Parser RegCommand parseRegCommand = hsubparser $ mconcat - [ commandRun, + [ commandCompile, + commandRun, commandRead ] where + commandCompile :: Mod CommandFields RegCommand + commandCompile = command "compile" compileInfo + commandRun :: Mod CommandFields RegCommand commandRun = command "run" runInfo commandRead :: Mod CommandFields RegCommand commandRead = command "read" readInfo + compileInfo :: ParserInfo RegCommand + compileInfo = + info + (Compile <$> parseRegCompileOptions) + (progDesc "Compile a JuvixReg file") + runInfo :: ParserInfo RegCommand runInfo = info diff --git a/app/Commands/Dev/Tree/Compile.hs b/app/Commands/Dev/Tree/Compile.hs index 1fc6aa008..b8ca4577f 100644 --- a/app/Commands/Dev/Tree/Compile.hs +++ b/app/Commands/Dev/Tree/Compile.hs @@ -22,6 +22,7 @@ runCommand opts = do TargetTree -> return () TargetNockma -> runNockmaPipeline arg TargetAnoma -> runAnomaPipeline arg + TargetCasm -> runCasmPipeline arg where getFile :: Sem r (Path Abs File) getFile = getMainFile (opts ^. compileInputFile) diff --git a/app/Commands/Dev/Tree/Compile/Base.hs b/app/Commands/Dev/Tree/Compile/Base.hs index 588003829..5cd339176 100644 --- a/app/Commands/Dev/Tree/Compile/Base.hs +++ b/app/Commands/Dev/Tree/Compile/Base.hs @@ -6,9 +6,12 @@ import Commands.Extra.Compile qualified as Compile import Juvix.Compiler.Asm.Pretty qualified as Asm import Juvix.Compiler.Backend qualified as Backend import Juvix.Compiler.Backend.C qualified as C +import Juvix.Compiler.Casm.Data.Result qualified as Casm +import Juvix.Compiler.Casm.Pretty qualified as Casm import Juvix.Compiler.Nockma.Pretty qualified as Nockma import Juvix.Compiler.Reg.Pretty qualified as Reg import Juvix.Compiler.Tree.Data.InfoTable qualified as Tree +import Juvix.Prelude.Pretty data PipelineArg = PipelineArg { _pipelineArgOptions :: CompileOptions, @@ -40,6 +43,7 @@ getEntry PipelineArg {..} = do TargetTree -> Backend.TargetTree TargetNockma -> Backend.TargetNockma TargetAnoma -> Backend.TargetAnoma + TargetCasm -> Backend.TargetCairo defaultOptLevel :: Int defaultOptLevel @@ -125,3 +129,15 @@ runAnomaPipeline pa@PipelineArg {..} = do tab' <- getRight r let code = Nockma.ppSerialize tab' writeFileEnsureLn nockmaFile code + +runCasmPipeline :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r () +runCasmPipeline pa@PipelineArg {..} = do + entryPoint <- getEntry pa + casmFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile + r <- + runReader entryPoint + . runError @JuvixError + . treeToCasm + $ _pipelineArgTable + Casm.Result {..} <- getRight r + writeFileEnsureLn casmFile (toPlainText $ Casm.ppProgram _resultCode) diff --git a/app/Commands/Dev/Tree/Compile/Options.hs b/app/Commands/Dev/Tree/Compile/Options.hs index b7ea41107..ccb3b71b6 100644 --- a/app/Commands/Dev/Tree/Compile/Options.hs +++ b/app/Commands/Dev/Tree/Compile/Options.hs @@ -14,7 +14,8 @@ treeSupportedTargets = TargetNative64, TargetAsm, TargetReg, - TargetNockma + TargetNockma, + TargetCasm ] parseTreeCompileOptions :: Parser CompileOptions diff --git a/app/Commands/Extra/Compile.hs b/app/Commands/Extra/Compile.hs index 79822222b..9bb2b91e5 100644 --- a/app/Commands/Extra/Compile.hs +++ b/app/Commands/Extra/Compile.hs @@ -37,6 +37,7 @@ runCompile inputFile o = do TargetTree -> return (Right ()) TargetNockma -> return (Right ()) TargetAnoma -> return (Right ()) + TargetCasm -> return (Right ()) prepareRuntime :: forall r. (Members '[App, EmbedIO] r) => Path Abs Dir -> CompileOptions -> Sem r () prepareRuntime buildDir o = do @@ -56,6 +57,7 @@ prepareRuntime buildDir o = do TargetTree -> return () TargetNockma -> return () TargetAnoma -> return () + TargetCasm -> return () where wasiReleaseRuntime :: BS.ByteString wasiReleaseRuntime = $(FE.makeRelativeToProject "runtime/_build.wasm32-wasi/libjuvix.a" >>= FE.embedFile) @@ -121,6 +123,8 @@ outputFile opts inputFile = replaceExtension' nockmaFileExt baseOutputFile TargetAnoma -> replaceExtension' nockmaFileExt baseOutputFile + TargetCasm -> + replaceExtension' casmFileExt baseOutputFile clangNativeCompile :: forall r. diff --git a/app/Commands/Extra/Compile/Options.hs b/app/Commands/Extra/Compile/Options.hs index d47776d6b..dbcdba6c8 100644 --- a/app/Commands/Extra/Compile/Options.hs +++ b/app/Commands/Extra/Compile/Options.hs @@ -15,6 +15,7 @@ data CompileTarget | TargetTree | TargetNockma | TargetAnoma + | TargetCasm deriving stock (Eq, Data, Bounded, Enum) instance Show CompileTarget where @@ -29,6 +30,7 @@ instance Show CompileTarget where TargetTree -> "tree" TargetNockma -> "nockma" TargetAnoma -> "anoma" + TargetCasm -> "casm" data CompileOptions = CompileOptions { _compileDebug :: Bool, diff --git a/cntlines.sh b/cntlines.sh index ea310b9e2..57686e0af 100755 --- a/cntlines.sh +++ b/cntlines.sh @@ -11,8 +11,9 @@ function count_ext () { RUNTIME_C=$(count runtime/src/juvix) RUNTIME_VAMPIR=$(count_ext '*.pir' runtime/src/vampir) RUNTIME_JVT=$(count_ext '*.jvt' runtime/src/tree) +RUNTIME_CASM=$(count_ext '*.casm' runtime/src/casm) -RUNTIME=$((RUNTIME_C+RUNTIME_VAMPIR+RUNTIME_JVT)) +RUNTIME=$((RUNTIME_C+RUNTIME_VAMPIR+RUNTIME_JVT+RUNTIME_CASM)) BACKENDC=$(count src/Juvix/Compiler/Backend/C/) CAIRO=$(count src/Juvix/Compiler/Backend/Cairo/) @@ -62,6 +63,7 @@ echo " JuvixCore: $CORE LOC" echo "Runtime: $RUNTIME LOC" echo " C runtime: $RUNTIME_C LOC" echo " JuvixTree runtime: $RUNTIME_JVT LOC" +echo " Cairo assembly runtime: $RUNTIME_CASM LOC" echo " VampIR runtime: $RUNTIME_VAMPIR LOC" echo "Other: $OTHER LOC" echo " Application: $APP LOC" @@ -72,4 +74,4 @@ echo " Data: $DATA LOC" echo " Prelude: $PRELUDE LOC" echo "Tests: $TESTS LOC" echo "" -echo "Total: $TOTAL Haskell LOC + $RUNTIME_C C LOC + $RUNTIME_JVT JuvixTree LOC + $RUNTIME_VAMPIR VampIR LOC" +echo "Total: $TOTAL Haskell LOC + $RUNTIME_C C LOC + $RUNTIME_JVT JuvixTree LOC + $RUNTIME_CASM CASM LOC + $RUNTIME_VAMPIR VampIR LOC" diff --git a/package.yaml b/package.yaml index 45e0365ad..1b17e4f0e 100644 --- a/package.yaml +++ b/package.yaml @@ -40,6 +40,7 @@ extra-source-files: - runtime/**/*.a - runtime/src/tree/*.jvt - runtime/src/vampir/*.pir + - runtime/src/casm/*.casm dependencies: - aeson-better-errors == 0.9.* diff --git a/runtime/src/casm/stdlib.casm b/runtime/src/casm/stdlib.casm new file mode 100644 index 000000000..fd376eccc --- /dev/null +++ b/runtime/src/casm/stdlib.casm @@ -0,0 +1,99 @@ +-- Juvix runtime for Cairo assembly + +-- Closure layout: [ addr | 9 - sargs | 9 - argsnum | arguments... ] +-- sargs -- number of arguments stored in the closure +-- argsnum -- number of arguments left +-- sargs + argsnum = total numer of arguments for the function +-- Maximum number of function arguments: 8 + +-- after calling juvix_get_regs: +-- [ap - 4] == fp +-- [ap - 3] == pc +-- [ap - 2] == ap - 2 +juvix_get_regs: + call juvix_get_ap_reg + ret +juvix_get_ap_reg: + ret + +-- [fp - 3]: closure; [fp - 3 - k]: argument k to closure call +juvix_call_closure: + ap += 1 + -- closure addr + [fp] = [[fp - 3]] + -- jmp rel (9 - argsnum) + jmp rel [[fp - 3] + 2] + [ap] = [fp - 11]; ap++ + [ap] = [fp - 10]; ap++ + [ap] = [fp - 9]; ap++ + [ap] = [fp - 8]; ap++ + [ap] = [fp - 7]; ap++ + [ap] = [fp - 6]; ap++ + [ap] = [fp - 5]; ap++ + [ap] = [fp - 4]; ap++ + -- jmp rel (9 - sargs) + jmp rel [[fp - 3] + 1] + [ap] = [[fp - 3] + 10]; ap++ + [ap] = [[fp - 3] + 9]; ap++ + [ap] = [[fp - 3] + 8]; ap++ + [ap] = [[fp - 3] + 7]; ap++ + [ap] = [[fp - 3] + 6]; ap++ + [ap] = [[fp - 3] + 5]; ap++ + [ap] = [[fp - 3] + 4]; ap++ + [ap] = [[fp - 3] + 3]; ap++ + call [fp] + ret + +-- [fp - 3]: closure +-- [fp - 4]: n = the number of arguments to extend with +-- [fp - 4 - k]: argument n - k - 1 (reverse order!) +juvix_extend_closure: + ap += 6 + -- 9 - sargs + [fp + 1] = [[fp - 3] + 1] + -- 9 - argsnum (expected) + [fp + 2] = [[fp - 3] + 2] + [fp + 3] = 9 + -- [fp + 4] = sargs + [fp + 4] = [fp + 3] - [fp + 1] + -- [fp + 5] = 9 - n + [fp + 5] = [fp + 3] - [fp - 4] + -- copy stored args reversing them + jmp rel [fp + 1] + [ap] = [[fp - 3] + 10]; ap++ + [ap] = [[fp - 3] + 9]; ap++ + [ap] = [[fp - 3] + 8]; ap++ + [ap] = [[fp - 3] + 7]; ap++ + [ap] = [[fp - 3] + 6]; ap++ + [ap] = [[fp - 3] + 5]; ap++ + [ap] = [[fp - 3] + 4]; ap++ + [ap] = [[fp - 3] + 3]; ap++ + call juvix_get_regs + [fp] = [ap - 2] + 2 + -- closure header + [ap] = [[fp - 3]]; ap++ + [ap] = [fp + 1] - [fp - 4]; ap++ + [ap] = [fp + 2] + [fp - 4]; ap++ + -- copy stored args: jmp rel (9 - sargs) + jmp rel [fp + 1] + [ap] = [fp + 13]; ap++ + [ap] = [fp + 12]; ap++ + [ap] = [fp + 11]; ap++ + [ap] = [fp + 10]; ap++ + [ap] = [fp + 9]; ap++ + [ap] = [fp + 8]; ap++ + [ap] = [fp + 7]; ap++ + [ap] = [fp + 6]; ap++ + -- copy extra args: jmp rel (9 - extra args num) + jmp rel [fp + 5] + [ap] = [fp - 12]; ap++ + [ap] = [fp - 11]; ap++ + [ap] = [fp - 10]; ap++ + [ap] = [fp - 9]; ap++ + [ap] = [fp - 8]; ap++ + [ap] = [fp - 7]; ap++ + [ap] = [fp - 6]; ap++ + [ap] = [fp - 5]; ap++ + -- return value + [ap] = [fp]; ap++ + ret diff --git a/src/Juvix/Compiler/Asm/Interpreter.hs b/src/Juvix/Compiler/Asm/Interpreter.hs index bd08890e8..30cff7420 100644 --- a/src/Juvix/Compiler/Asm/Interpreter.hs +++ b/src/Juvix/Compiler/Asm/Interpreter.hs @@ -156,18 +156,9 @@ runCodeR infoTable funInfo = goCode (funInfo ^. functionCode) >> popLastValueSta goUnop :: (Member Runtime r) => (Val -> Either Text Val) -> Sem r () goUnop op = goUnop' (eitherToError . op) - getConstantVal :: Constant -> Val - getConstantVal = \case - ConstInt i -> ValInteger i - ConstField f -> ValField f - ConstBool b -> ValBool b - ConstString s -> ValString s - ConstUnit -> ValUnit - ConstVoid -> ValVoid - getVal :: (Member Runtime r) => Value -> Sem r Val getVal = \case - Constant c -> return (getConstantVal c) + Constant c -> return (constantToValue c) Ref r -> getMemVal r getMemVal :: forall r. (Member Runtime r) => MemRef -> Sem r Val diff --git a/src/Juvix/Compiler/Backend.hs b/src/Juvix/Compiler/Backend.hs index c6f6c224e..1e5c6c95c 100644 --- a/src/Juvix/Compiler/Backend.hs +++ b/src/Juvix/Compiler/Backend.hs @@ -14,6 +14,7 @@ data Target | TargetTree | TargetNockma | TargetAnoma + | TargetCairo deriving stock (Data, Eq, Show) data Limits = Limits @@ -97,6 +98,21 @@ getLimits tgt debug = case tgt of defaultLimits TargetAnoma -> defaultLimits + TargetCairo -> + Limits + { _limitsMaxConstrs = 1048568, + _limitsMaxConstrArgs = 255, + _limitsMaxFunctionArgs = 8, + _limitsMaxLocalVars = 2048, + _limitsMaxClosureSize = 8 + 3, + _limitsClosureHeadSize = 3, + _limitsMaxStringSize = 0, + _limitsMaxStackDelta = 0, -- irrelevant + _limitsMaxFunctionAlloc = 0, -- irrelevant + _limitsDispatchStackSize = 0, -- irrelevant + _limitsBuiltinUIDsNum = 8, + _limitsSpecialisedApply = 3 + } defaultLimits :: Limits defaultLimits = diff --git a/src/Juvix/Compiler/Casm/Data/LabelInfoBuilder.hs b/src/Juvix/Compiler/Casm/Data/LabelInfoBuilder.hs index 62b2c94eb..58d68dcda 100644 --- a/src/Juvix/Compiler/Casm/Data/LabelInfoBuilder.hs +++ b/src/Juvix/Compiler/Casm/Data/LabelInfoBuilder.hs @@ -29,6 +29,11 @@ emptyBuilderState = _stateIdents = mempty } +runLabelInfoBuilderWithNextId :: Word -> Sem (LabelInfoBuilder ': r) a -> Sem r (LabelInfo, a) +runLabelInfoBuilderWithNextId nextSymId = + fmap (first (^. stateLabelInfo)) + . runLabelInfoBuilder' emptyBuilderState {_stateNextSymbolId = nextSymId} + runLabelInfoBuilder :: Sem (LabelInfoBuilder ': r) a -> Sem r (LabelInfo, a) runLabelInfoBuilder = fmap (first (^. stateLabelInfo)) . runLabelInfoBuilder' emptyBuilderState diff --git a/src/Juvix/Compiler/Casm/Data/Limits.hs b/src/Juvix/Compiler/Casm/Data/Limits.hs new file mode 100644 index 000000000..7e67870af --- /dev/null +++ b/src/Juvix/Compiler/Casm/Data/Limits.hs @@ -0,0 +1,16 @@ +module Juvix.Compiler.Casm.Data.Limits where + +import Juvix.Compiler.Backend +import Juvix.Compiler.Casm.Language + +casmMaxFunctionArgs :: Int +casmMaxFunctionArgs = getLimits TargetCairo False ^. limitsMaxFunctionArgs + +casmClosureAddrOffset :: Offset +casmClosureAddrOffset = 0 + +casmClosureStoredArgsOffset :: Offset +casmClosureStoredArgsOffset = 1 + +casmClosureArgsNumOffset :: Offset +casmClosureArgsNumOffset = 2 diff --git a/src/Juvix/Compiler/Casm/Data/Result.hs b/src/Juvix/Compiler/Casm/Data/Result.hs new file mode 100644 index 000000000..3310e521d --- /dev/null +++ b/src/Juvix/Compiler/Casm/Data/Result.hs @@ -0,0 +1,11 @@ +module Juvix.Compiler.Casm.Data.Result where + +import Juvix.Compiler.Casm.Data.LabelInfo +import Juvix.Compiler.Casm.Language + +data Result = Result + { _resultLabelInfo :: LabelInfo, + _resultCode :: [Instruction] + } + +makeLenses ''Result diff --git a/src/Juvix/Compiler/Casm/Extra/Base.hs b/src/Juvix/Compiler/Casm/Extra/Base.hs new file mode 100644 index 000000000..86efbb4cd --- /dev/null +++ b/src/Juvix/Compiler/Casm/Extra/Base.hs @@ -0,0 +1,107 @@ +module Juvix.Compiler.Casm.Extra.Base where + +import Juvix.Compiler.Casm.Data.Limits +import Juvix.Compiler.Casm.Language + +toOffset :: (Show a, Integral a) => a -> Offset +toOffset x + | fromIntegral v == x = v + | otherwise = error ("invalid offset: " <> show x) + where + v = fromIntegral x + +adjustAp :: Int16 -> MemRef -> MemRef +adjustAp idx mr@MemRef {..} = case _memRefReg of + Ap -> MemRef Ap (_memRefOff - idx) + Fp -> mr + +mkExtraBinop :: ExtraOpcode -> MemRef -> MemRef -> Value -> Instruction +mkExtraBinop op res arg1 arg2 = + ExtraBinop + InstrExtraBinop + { _instrExtraBinopOpcode = op, + _instrExtraBinopResult = res, + _instrExtraBinopArg1 = arg1, + _instrExtraBinopArg2 = arg2, + _instrExtraBinopIncAp = False + } + +mkNativeBinop :: Opcode -> MemRef -> MemRef -> Value -> Instruction +mkNativeBinop op res arg1 arg2 = + Assign + InstrAssign + { _instrAssignResult = res, + _instrAssignValue = + Binop + BinopValue + { _binopValueOpcode = op, + _binopValueArg1 = arg1, + _binopValueArg2 = arg2 + }, + _instrAssignIncAp = False + } + +mkEq :: MemRef -> MemRef -> Value -> Instruction +mkEq res arg1 arg2 = mkExtraBinop FieldSub res arg1 arg2 + +mkIntLe :: MemRef -> MemRef -> Value -> [Instruction] +mkIntLe res arg1 arg2 = case arg2 of + Imm v -> + [mkExtraBinop IntLt res arg1 (Imm (v + 1))] + Ref mref -> + [inc, mkExtraBinop IntLt res (adjustAp 1 arg1) (Ref $ MemRef Ap (-1))] + where + inc = + Assign + InstrAssign + { _instrAssignResult = MemRef Ap 0, + _instrAssignValue = + Binop + BinopValue + { _binopValueArg1 = mref, + _binopValueArg2 = Imm 1, + _binopValueOpcode = FieldAdd + }, + _instrAssignIncAp = True + } + Lab {} -> impossible + +mkAssign :: MemRef -> RValue -> Instruction +mkAssign mr rv = + Assign + InstrAssign + { _instrAssignResult = mr, + _instrAssignValue = rv, + _instrAssignIncAp = False + } + +mkAssignAp :: RValue -> Instruction +mkAssignAp v = + Assign + InstrAssign + { _instrAssignResult = MemRef Ap 0, + _instrAssignValue = v, + _instrAssignIncAp = True + } + +mkOpArgsNum :: MemRef -> MemRef -> [Instruction] +mkOpArgsNum res v = + [ mkAssignAp (Val $ Imm $ fromIntegral casmMaxFunctionArgs + 1), + mkAssignAp (Load $ LoadValue (adjustAp 1 v) casmClosureArgsNumOffset), + mkExtraBinop FieldSub res (MemRef Ap (-2)) (Ref $ MemRef Ap (-1)) + ] + +mkCall :: Value -> Instruction +mkCall = Call . InstrCall + +mkJump :: RValue -> Instruction +mkJump tgt = Jump (InstrJump tgt False False) + +mkJumpIf :: Value -> MemRef -> Instruction +mkJumpIf tgt v = JumpIf (InstrJumpIf tgt v False False) + +mkJumpRel :: RValue -> Instruction +mkJumpRel tgt = Jump (InstrJump tgt True False) + +mkJumpRelIf :: Value -> MemRef -> Instruction +mkJumpRelIf tgt v = JumpIf (InstrJumpIf tgt v True False) diff --git a/src/Juvix/Compiler/Casm/Extra/Stdlib.hs b/src/Juvix/Compiler/Casm/Extra/Stdlib.hs new file mode 100644 index 000000000..c15593281 --- /dev/null +++ b/src/Juvix/Compiler/Casm/Extra/Stdlib.hs @@ -0,0 +1,32 @@ +module Juvix.Compiler.Casm.Extra.Stdlib where + +import Data.FileEmbed qualified as FE +import Data.Text.Encoding +import Juvix.Compiler.Casm.Data.LabelInfoBuilder +import Juvix.Compiler.Casm.Language +import Juvix.Compiler.Casm.Translation.FromSource + +data StdlibBuiltins = StdlibBuiltins + { _stdlibGetRegs :: Symbol, + _stdlibCallClosure :: Symbol, + _stdlibExtendClosure :: Symbol, + _stdlibGetRegsName :: Text, + _stdlibCallClosureName :: Text, + _stdlibExtendClosureName :: Text + } + +makeLenses ''StdlibBuiltins + +addStdlibBuiltins :: (Member LabelInfoBuilder r) => Address -> Sem r (StdlibBuiltins, [Instruction]) +addStdlibBuiltins addr = do + instrs <- + fmap (fromRight impossible) $ + runParser' addr "stdlib.casm" $ + decodeUtf8 $(FE.makeRelativeToProject "runtime/src/casm/stdlib.casm" >>= FE.embedFile) + let _stdlibGetRegsName :: Text = "juvix_get_regs" + _stdlibCallClosureName :: Text = "juvix_call_closure" + _stdlibExtendClosureName :: Text = "juvix_extend_closure" + _stdlibGetRegs <- fromJust <$> getIdent _stdlibGetRegsName + _stdlibCallClosure <- fromJust <$> getIdent _stdlibCallClosureName + _stdlibExtendClosure <- fromJust <$> getIdent _stdlibExtendClosureName + return (StdlibBuiltins {..}, instrs) diff --git a/src/Juvix/Compiler/Casm/Interpreter.hs b/src/Juvix/Compiler/Casm/Interpreter.hs index 103425997..7841f3535 100644 --- a/src/Juvix/Compiler/Casm/Interpreter.hs +++ b/src/Juvix/Compiler/Casm/Interpreter.hs @@ -19,9 +19,12 @@ import Juvix.Data.Field type Memory s = MV.MVector s (Maybe FField) --- | Runs Cairo Assembly. Returns the value of `[ap - 1]` at program exit. runCode :: LabelInfo -> [Instruction] -> FField -runCode (LabelInfo labelInfo) instrs0 = runST goCode +runCode = hRunCode stderr + +-- | Runs Cairo Assembly. Returns the value of `[ap - 1]` at program exit. +hRunCode :: Handle -> LabelInfo -> [Instruction] -> FField +hRunCode hout (LabelInfo labelInfo) instrs0 = runST goCode where instrs :: Vec.Vector Instruction instrs = Vec.fromList instrs0 @@ -48,6 +51,8 @@ runCode (LabelInfo labelInfo) instrs0 = runST goCode when (Vec.length instrs < pc) $ throwRunError ("invalid program counter: " <> show pc) checkGaps mem + when (ap == 0) $ + throwRunError "nothing to return" readMem mem (ap - 1) | otherwise = case instrs Vec.! pc of @@ -55,7 +60,6 @@ runCode (LabelInfo labelInfo) instrs0 = runST goCode ExtraBinop x -> goExtraBinop x pc ap fp mem Jump x -> goJump x pc ap fp mem JumpIf x -> goJumpIf x pc ap fp mem - JumpRel x -> goJumpRel x pc ap fp mem Call x -> goCall x pc ap fp mem Return -> goReturn pc ap fp mem Alloc x -> goAlloc x pc ap fp mem @@ -182,7 +186,7 @@ runCode (LabelInfo labelInfo) instrs0 = runST goCode IntMod -> fieldFromInteger fsize (fieldToInt x `rem` fieldToInt y) IntLt -> fieldFromInteger fsize $ - if fieldToInt x < fieldToInt y then 1 else 0 + if fieldToInt x < fieldToInt y then 0 else 1 fieldToInt :: FField -> Integer fieldToInt f @@ -192,20 +196,17 @@ runCode (LabelInfo labelInfo) instrs0 = runST goCode v = fieldToInteger f goJump :: InstrJump -> Address -> Address -> Address -> Memory s -> ST s FField - goJump InstrJump {..} _ ap fp mem = do - tgt <- readValue ap fp mem _instrJumpTarget - go (fromInteger (fieldToInteger tgt)) (ap + fromEnum _instrJumpIncAp) fp mem + goJump InstrJump {..} pc ap fp mem = do + tgt <- readRValue ap fp mem _instrJumpTarget + let off = if _instrJumpRel then pc else 0 + go (off + fromInteger (fieldToInteger tgt)) (ap + fromEnum _instrJumpIncAp) fp mem goJumpIf :: InstrJumpIf -> Address -> Address -> Address -> Memory s -> ST s FField goJumpIf InstrJumpIf {..} pc ap fp mem = do tgt <- readValue ap fp mem _instrJumpIfTarget v <- readMemRef ap fp mem _instrJumpIfValue - go (if fieldToInteger v /= 0 then fromInteger (fieldToInteger tgt) else pc + 1) (ap + fromEnum _instrJumpIfIncAp) fp mem - - goJumpRel :: InstrJumpRel -> Address -> Address -> Address -> Memory s -> ST s FField - goJumpRel InstrJumpRel {..} pc ap fp mem = do - tgt <- readRValue ap fp mem _instrJumpRelTarget - go (pc + fromInteger (fieldToInteger tgt)) (ap + fromEnum _instrJumpRelIncAp) fp mem + let off = if _instrJumpIfRel then pc else 0 + go (if fieldToInteger v /= 0 then off + fromInteger (fieldToInteger tgt) else pc + 1) (ap + fromEnum _instrJumpIfIncAp) fp mem goCall :: InstrCall -> Address -> Address -> Address -> Memory s -> ST s FField goCall InstrCall {..} pc ap fp mem = do @@ -228,7 +229,7 @@ runCode (LabelInfo labelInfo) instrs0 = runST goCode goTrace :: InstrTrace -> Address -> Address -> Address -> Memory s -> ST s FField goTrace InstrTrace {..} pc ap fp mem = do v <- readRValue ap fp mem _instrTraceValue - GHC.unsafePerformIO (print v >> return (pure ())) + GHC.unsafePerformIO (hPrint hout v >> return (pure ())) go (pc + 1) ap fp mem catchRunErrorIO :: a -> IO (Either CasmError a) diff --git a/src/Juvix/Compiler/Casm/Language.hs b/src/Juvix/Compiler/Casm/Language.hs index 6d78172b3..06100250f 100644 --- a/src/Juvix/Compiler/Casm/Language.hs +++ b/src/Juvix/Compiler/Casm/Language.hs @@ -7,10 +7,11 @@ where {- This module defines data structures for an extended subset of the Cairo Assembly -language, following Section 5 of [1]. Except the `ExtraBinop` instruction, all -instructions correspond to the instructions from [1]. The parser and pretty -printer implemented in `Juvix.Compiler.Casm.Translation.FromSource` and -`Juvix.Compiler.Casm.Pretty` follow the syntax of [1, Section 5]. +language, following Section 5 of [1]. Except for the `ExtraBinop` instruction +and absolute conditional jumps, all instructions correspond to the instructions +from [1]. The parser and pretty printer implemented in +`Juvix.Compiler.Casm.Translation.FromSource` and `Juvix.Compiler.Casm.Pretty` +follow the syntax of [1, Section 5]. [1] Goldberg, Papini, Riabzev: "Cairo – a Turing-complete STARK-friendly CPU architecture" (https://ia.cr/2021/1063) @@ -78,7 +79,7 @@ data ExtraOpcode | IntMul | IntDiv | IntMod - | -- | Sets the result to 1 if arg1 < arg2, or to 0 otherwise + | -- | Sets the result to zero if arg1 < arg2, or to non-zero otherwise IntLt data Instruction @@ -88,7 +89,6 @@ data Instruction ExtraBinop InstrExtraBinop | Jump InstrJump | JumpIf InstrJumpIf - | JumpRel InstrJumpRel | Call InstrCall | Return | Alloc InstrAlloc @@ -110,22 +110,20 @@ data InstrExtraBinop = InstrExtraBinop } data InstrJump = InstrJump - { _instrJumpTarget :: Value, + { _instrJumpTarget :: RValue, + _instrJumpRel :: Bool, _instrJumpIncAp :: Bool } --- | Jump if value is nonzero +-- | Jump if value is nonzero. Boolean true is translated to zero, false to +-- non-zero. data InstrJumpIf = InstrJumpIf { _instrJumpIfTarget :: Value, _instrJumpIfValue :: MemRef, + _instrJumpIfRel :: Bool, _instrJumpIfIncAp :: Bool } -data InstrJumpRel = InstrJumpRel - { _instrJumpRelTarget :: RValue, - _instrJumpRelIncAp :: Bool - } - newtype InstrCall = InstrCall { _instrCallTarget :: Value } @@ -148,7 +146,6 @@ makeLenses ''InstrAssign makeLenses ''InstrExtraBinop makeLenses ''InstrJump makeLenses ''InstrJumpIf -makeLenses ''InstrJumpRel makeLenses ''InstrCall makeLenses ''InstrAlloc makeLenses ''InstrTrace diff --git a/src/Juvix/Compiler/Casm/Pretty/Base.hs b/src/Juvix/Compiler/Casm/Pretty/Base.hs index 14c3d460b..ab079b616 100644 --- a/src/Juvix/Compiler/Casm/Pretty/Base.hs +++ b/src/Juvix/Compiler/Casm/Pretty/Base.hs @@ -116,20 +116,16 @@ instance PrettyCode InstrJump where ppCode InstrJump {..} = do tgt <- ppCode _instrJumpTarget incAp <- ppIncAp _instrJumpIncAp - return $ Str.jmp <+> tgt <> incAp + let rel = if _instrJumpRel then Str.rel <> space else mempty + return $ Str.jmp <+> rel <> tgt <> incAp instance PrettyCode InstrJumpIf where ppCode InstrJumpIf {..} = do tgt <- ppCode _instrJumpIfTarget v <- ppCode _instrJumpIfValue incAp <- ppIncAp _instrJumpIfIncAp - return $ Str.jmp <+> tgt <+> Str.if_ <+> v <+> Str.notequal <+> annotate AnnLiteralInteger "0" <> incAp - -instance PrettyCode InstrJumpRel where - ppCode InstrJumpRel {..} = do - tgt <- ppCode _instrJumpRelTarget - incAp <- ppIncAp _instrJumpRelIncAp - return $ Str.jmp <+> Str.rel <+> tgt <> incAp + let rel = if _instrJumpIfRel then Str.rel <> space else mempty + return $ Str.jmp <+> rel <> tgt <+> Str.if_ <+> v <+> Str.notequal <+> annotate AnnLiteralInteger "0" <> incAp instance PrettyCode InstrCall where ppCode InstrCall {..} = do @@ -152,7 +148,6 @@ instance PrettyCode Instruction where ExtraBinop x -> ppCode x Jump x -> ppCode x JumpIf x -> ppCode x - JumpRel x -> ppCode x Call x -> ppCode x Return -> return Str.ret Alloc x -> ppCode x diff --git a/src/Juvix/Compiler/Casm/Translation/FromReg.hs b/src/Juvix/Compiler/Casm/Translation/FromReg.hs index 3703e399d..b3261e665 100644 --- a/src/Juvix/Compiler/Casm/Translation/FromReg.hs +++ b/src/Juvix/Compiler/Casm/Translation/FromReg.hs @@ -1 +1,377 @@ module Juvix.Compiler.Casm.Translation.FromReg where + +import Data.HashMap.Strict qualified as HashMap +import Data.HashSet qualified as HashSet +import Juvix.Compiler.Backend +import Juvix.Compiler.Casm.Data.LabelInfoBuilder +import Juvix.Compiler.Casm.Data.Limits +import Juvix.Compiler.Casm.Data.Result +import Juvix.Compiler.Casm.Extra.Base +import Juvix.Compiler.Casm.Extra.Stdlib +import Juvix.Compiler.Casm.Language +import Juvix.Compiler.Reg.Data.InfoTable qualified as Reg +import Juvix.Compiler.Reg.Extra.Info qualified as Reg +import Juvix.Compiler.Reg.Language qualified as Reg +import Juvix.Compiler.Tree.Evaluator.Builtins qualified as Reg +import Juvix.Data.Field + +fromReg :: Reg.InfoTable -> Result +fromReg tab = uncurry Result $ run $ runLabelInfoBuilderWithNextId (Reg.getNextSymbolId tab) $ do + let initialOffset :: Int = 2 + (blts, binstrs) <- addStdlibBuiltins initialOffset + endSym <- freshSymbol + let endName :: Text = "__juvix_end" + endLab = LabelRef endSym (Just endName) + (addr, instrs) <- second (concat . reverse) <$> foldM (goFun blts endLab) (initialOffset + length binstrs, []) (tab ^. Reg.infoFunctions) + eassert (addr == length instrs + length binstrs + initialOffset) + registerLabelName endSym endName + registerLabelAddress endSym addr + let mainSym = fromJust $ tab ^. Reg.infoMainFunction + mainName = fromJust (HashMap.lookup mainSym (tab ^. Reg.infoFunctions)) ^. Reg.functionName + callInstr = Call $ InstrCall $ Lab $ LabelRef mainSym (Just mainName) + jmpInstr = mkJump (Val $ Lab endLab) + return $ callInstr : jmpInstr : binstrs ++ instrs ++ [Label endLab] + where + info :: Reg.ExtraInfo + info = Reg.computeExtraInfo (getLimits TargetCairo False) tab + + getTagId :: Tag -> Int + getTagId tag = + 1 + fromJust (HashMap.lookup tag (info ^. Reg.extraInfoCIDs)) + + goFun :: forall r. (Member LabelInfoBuilder r) => StdlibBuiltins -> LabelRef -> (Address, [[Instruction]]) -> Reg.FunctionInfo -> Sem r (Address, [[Instruction]]) + goFun blts failLab (addr0, acc) funInfo = do + let sym = funInfo ^. Reg.functionSymbol + funName = funInfo ^. Reg.functionName + registerLabelName sym funName + registerLabelAddress sym addr0 + let lab = Label $ LabelRef sym (Just funName) + code = funInfo ^. Reg.functionCode + n = fromJust $ HashMap.lookup (funInfo ^. Reg.functionSymbol) (info ^. Reg.extraInfoLocalVarsNum) + i1 = Alloc $ InstrAlloc $ Val $ Imm $ fromIntegral n + pre = [lab, i1] + addr1 = addr0 + length pre + instrs <- goCode addr1 code + return (addr1 + length instrs, (pre ++ instrs) : acc) + where + unsupported :: Text -> a + unsupported what = error ("Cairo backend: unsupported: " <> what) + + goCode :: Address -> Reg.Code -> Sem r [Instruction] + goCode addr code = concat . reverse . snd <$> foldM go' (addr, []) code + where + go' :: (Address, [[Instruction]]) -> Reg.Instruction -> Sem r (Address, [[Instruction]]) + go' (addr', acc') i = do + is <- goInstr addr' i + return (addr' + length is, is : acc') + + goInstr :: Address -> Reg.Instruction -> Sem r [Instruction] + goInstr addr = \case + Reg.Binop x -> goBinop addr x + Reg.Unop x -> goUnop addr x + Reg.Assign x -> goAssign addr x + Reg.Alloc x -> goAlloc addr x + Reg.AllocClosure x -> goAllocClosure addr x + Reg.ExtendClosure x -> goExtendClosure addr x + Reg.Call x -> goCall addr x + Reg.TailCall x -> goTailCall addr x + Reg.CallClosures {} -> impossible + Reg.TailCallClosures {} -> impossible + Reg.Return x -> goReturn addr x + Reg.Branch x -> goBranch addr x + Reg.Case x -> goCase addr x + Reg.Trace x -> goTrace addr x + Reg.Dump -> unsupported "dump" + Reg.Failure x -> goFail addr x + Reg.Prealloc {} -> return [] + Reg.Nop -> return [] + Reg.Block x -> goBlock addr x + + goConst :: Reg.Constant -> Integer + goConst = \case + Reg.ConstInt x -> x + Reg.ConstBool True -> 0 + Reg.ConstBool False -> 1 + Reg.ConstField f -> fieldToInteger f + Reg.ConstUnit -> 0 + Reg.ConstVoid -> 0 + Reg.ConstString {} -> unsupported "strings" + + goConstrField :: Reg.ConstrField -> RValue + goConstrField Reg.ConstrField {..} = + Load $ LoadValue (goVarRef _constrFieldRef) (toOffset _constrFieldIndex + 1) + + goVarRef :: Reg.VarRef -> MemRef + goVarRef Reg.VarRef {..} = case _varRefGroup of + Reg.VarGroupArgs -> + MemRef Fp (-3 - toOffset _varRefIndex) + Reg.VarGroupLocal -> + MemRef Fp (toOffset _varRefIndex) + + goValue :: Reg.Value -> ([Instruction], Value) + goValue = \case + Reg.Const c -> ([], Imm $ goConst c) + Reg.CRef x -> ([mkAssignAp (goConstrField x)], Ref $ MemRef Ap (-1)) + Reg.VRef x -> ([], Ref $ goVarRef x) + + goRValue :: Reg.Value -> RValue + goRValue = \case + Reg.Const c -> Val $ Imm $ goConst c + Reg.CRef x -> goConstrField x + Reg.VRef x -> Val $ Ref $ goVarRef x + + goLoad :: Reg.Value -> Offset -> ([Instruction], RValue) + goLoad v off = case goRValue v of + Val (Ref r) -> ([], Load $ LoadValue r off) + v' -> ([mkAssignAp v'], Load $ LoadValue (MemRef Ap (-1)) off) + + goAssignValue :: MemRef -> Reg.Value -> Instruction + goAssignValue res = mkAssign res . goRValue + + goAssignApValue :: Reg.Value -> Instruction + goAssignApValue = mkAssignAp . goRValue + + mkBinop :: Reg.BinaryOp -> MemRef -> MemRef -> Value -> [Instruction] + mkBinop op res arg1 arg2 = case op of + Reg.OpIntAdd -> + [mkExtraBinop IntAdd res arg1 arg2] + Reg.OpIntSub -> + [mkExtraBinop IntSub res arg1 arg2] + Reg.OpIntMul -> + [mkExtraBinop IntMul res arg1 arg2] + Reg.OpIntDiv -> + [mkExtraBinop IntDiv res arg1 arg2] + Reg.OpIntMod -> + [mkExtraBinop IntMod res arg1 arg2] + Reg.OpIntLt -> + [mkExtraBinop IntLt res arg1 arg2] + Reg.OpIntLe -> + mkIntLe res arg1 arg2 + Reg.OpFieldAdd -> + [mkNativeBinop FieldAdd res arg1 arg2] + Reg.OpFieldSub -> + [mkExtraBinop FieldSub res arg1 arg2] + Reg.OpFieldMul -> + [mkNativeBinop FieldMul res arg1 arg2] + Reg.OpFieldDiv -> + [mkExtraBinop FieldDiv res arg1 arg2] + Reg.OpEq -> + [mkEq res arg1 arg2] + Reg.OpStrConcat -> + unsupported "strings" + + goBinop :: Address -> Reg.InstrBinop -> Sem r [Instruction] + goBinop addr x@Reg.InstrBinop {..} = case _instrBinopArg1 of + Reg.Const c1 -> case _instrBinopArg2 of + Reg.Const c2 -> case Reg.evalBinop' _instrBinopOpcode c1 c2 of + Left err -> error err + Right c -> + return [mkAssign res (Val $ Imm $ goConst c)] + _ -> + goBinop + addr + x + { Reg._instrBinopArg1 = _instrBinopArg2, + Reg._instrBinopArg2 = _instrBinopArg1 + } + Reg.CRef ctr1 -> + case _instrBinopArg2 of + Reg.CRef {} -> + return $ i : is2 ++ mkBinop _instrBinopOpcode res (MemRef Ap (-2)) (Ref $ MemRef Ap (-1)) + _ -> do + eassert (null is2) + return $ i : mkBinop _instrBinopOpcode res (MemRef Ap (-1)) v2 + where + i = mkAssignAp (goConstrField ctr1) + Reg.VRef var1 -> + return $ is2 ++ mkBinop _instrBinopOpcode res (goVarRef var1) v2 + where + res = goVarRef _instrBinopResult + (is2, v2) = goValue _instrBinopArg2 + + goUnop :: Address -> Reg.InstrUnop -> Sem r [Instruction] + goUnop _ Reg.InstrUnop {..} = case _instrUnopOpcode of + Reg.OpShow -> unsupported "strings" + Reg.OpStrToInt -> unsupported "strings" + Reg.OpFieldToInt -> return [goAssignValue res _instrUnopArg] + Reg.OpIntToField -> return [goAssignValue res _instrUnopArg] + Reg.OpArgsNum -> case v of + Ref mr -> + return $ is ++ mkOpArgsNum res mr + Imm {} -> impossible + Lab {} -> impossible + where + res = goVarRef _instrUnopResult + (is, v) = goValue _instrUnopArg + + goAssign :: Address -> Reg.InstrAssign -> Sem r [Instruction] + goAssign _ Reg.InstrAssign {..} = + return [goAssignValue res _instrAssignValue] + where + res = goVarRef _instrAssignResult + + mkAllocCall :: MemRef -> [Instruction] + mkAllocCall res = + [ mkCall $ Lab $ LabelRef (blts ^. stdlibGetRegs) (Just (blts ^. stdlibGetRegsName)), + mkNativeBinop FieldAdd res (MemRef Ap (-2)) (Imm 2) + ] + + goAlloc :: Address -> Reg.InstrAlloc -> Sem r [Instruction] + goAlloc _ Reg.InstrAlloc {..} = + return $ + mkAllocCall res + ++ [ mkAssignAp (Val $ Imm $ fromIntegral tagId) + ] + ++ map goAssignApValue _instrAllocArgs + where + res = goVarRef _instrAllocResult + tagId = getTagId _instrAllocTag + + goAllocClosure :: Address -> Reg.InstrAllocClosure -> Sem r [Instruction] + goAllocClosure _ Reg.InstrAllocClosure {..} = + return $ + mkAllocCall res + ++ [ mkAssignAp (Val $ Lab $ LabelRef _instrAllocClosureSymbol (Just funName)), + mkAssignAp (Val $ Imm $ fromIntegral $ casmMaxFunctionArgs + 1 - storedArgsNum), + mkAssignAp (Val $ Imm $ fromIntegral $ casmMaxFunctionArgs + 1 - leftArgsNum) + ] + ++ map goAssignApValue _instrAllocClosureArgs + where + res = goVarRef _instrAllocClosureResult + funName = Reg.lookupFunInfo tab _instrAllocClosureSymbol ^. Reg.functionName + storedArgsNum = length _instrAllocClosureArgs + leftArgsNum = _instrAllocClosureExpectedArgsNum - storedArgsNum + + goExtendClosure :: Address -> Reg.InstrExtendClosure -> Sem r [Instruction] + goExtendClosure _ Reg.InstrExtendClosure {..} = + return $ + map goAssignApValue _instrExtendClosureArgs + ++ [ mkAssignAp (Val $ Imm $ fromIntegral $ length _instrExtendClosureArgs), + mkAssignAp (Val $ Ref val), + mkCall $ Lab $ LabelRef (blts ^. stdlibExtendClosure) (Just (blts ^. stdlibExtendClosureName)), + mkAssign res (Val $ Ref $ MemRef Ap (-1)) + ] + where + res = goVarRef _instrExtendClosureResult + val = goVarRef _instrExtendClosureValue + + goCall' :: Instruction -> Reg.CallType -> [Reg.Value] -> [Instruction] + goCall' saveOrRet ct args = case ct of + Reg.CallFun sym -> + args' + ++ [ mkCall $ Lab $ LabelRef sym (Just funName), + saveOrRet + ] + where + funName = Reg.lookupFunInfo tab sym ^. Reg.functionName + Reg.CallClosure cl -> + args' + ++ [ mkAssignAp (Val $ Ref $ goVarRef cl), + mkCall $ Lab $ LabelRef (blts ^. stdlibCallClosure) (Just (blts ^. stdlibCallClosureName)), + saveOrRet + ] + where + args' = map goAssignApValue (reverse args) + + goCall :: Address -> Reg.InstrCall -> Sem r [Instruction] + goCall _ Reg.InstrCall {..} = + return $ + goCall' (mkAssign res (Val $ Ref $ MemRef Ap (-1))) _instrCallType _instrCallArgs + where + res = goVarRef _instrCallResult + + -- There is no way to make "proper" tail calls in Cairo, because + -- the only way to set the `fp` register is via the `call` instruction. + -- So we just translate tail calls into `call` followed by `ret`. + goTailCall :: Address -> Reg.InstrTailCall -> Sem r [Instruction] + goTailCall _ Reg.InstrTailCall {..} = + return $ + goCall' Return _instrTailCallType _instrTailCallArgs + + goReturn :: Address -> Reg.InstrReturn -> Sem r [Instruction] + goReturn _ Reg.InstrReturn {..} = + return $ + [ goAssignApValue _instrReturnValue, + Return + ] + + goBranch :: Address -> Reg.InstrBranch -> Sem r [Instruction] + goBranch addr Reg.InstrBranch {..} = case v of + Imm c + | c == 0 -> goCode addr _instrBranchTrue + | otherwise -> goCode addr _instrBranchFalse + Ref r -> do + symFalse <- freshSymbol + symEnd <- freshSymbol + let labFalse = LabelRef symFalse Nothing + labEnd = LabelRef symEnd Nothing + addr1 = addr + length is + 1 + codeTrue <- goCode addr1 _instrBranchTrue + let addr2 = addr1 + length codeTrue + 1 + registerLabelAddress symFalse addr2 + codeFalse <- goCode (addr2 + 1) _instrBranchFalse + registerLabelAddress symEnd (addr2 + 1 + length codeFalse) + return $ + is + ++ [mkJumpIf (Lab labFalse) r] + ++ codeTrue + ++ [ mkJump (Val $ Lab labEnd), + Label labFalse + ] + ++ codeFalse + ++ [Label labEnd] + Lab {} -> impossible + where + (is, v) = goValue _instrBranchValue + + goCase :: Address -> Reg.InstrCase -> Sem r [Instruction] + goCase addr Reg.InstrCase {..} = do + syms <- replicateM (length tags) freshSymbol + symEnd <- freshSymbol + let symMap = HashMap.fromList $ zip tags syms + labs = map (flip LabelRef Nothing) syms + labEnd = LabelRef symEnd Nothing + jmps = map (mkJump . Val . Lab) labs + addr1 = addr + length is + 1 + length jmps + (addr2, instrs) <- second (concat . reverse) <$> foldM (goCaseBranch symMap labEnd) (addr1, []) _instrCaseBranches + (addr3, instrs') <- second reverse <$> foldM (goDefaultLabel symMap) (addr2, []) defaultTags + instrs'' <- maybe (return []) (goCode addr3) _instrCaseDefault + let addr4 = addr3 + length instrs'' + registerLabelAddress symEnd addr4 + return $ is ++ mkJumpRel v : jmps ++ instrs ++ instrs' ++ instrs'' ++ [Label labEnd] + where + (is, v) = goLoad _instrCaseValue 0 + tags = Reg.lookupInductiveInfo tab _instrCaseInductive ^. Reg.inductiveConstructors + ctrTags = HashSet.fromList $ map (^. Reg.caseBranchTag) _instrCaseBranches + defaultTags = filter (not . flip HashSet.member ctrTags) tags + + goCaseBranch :: HashMap Tag Symbol -> LabelRef -> (Address, [[Instruction]]) -> Reg.CaseBranch -> Sem r (Address, [[Instruction]]) + goCaseBranch symMap labEnd (addr', acc') Reg.CaseBranch {..} = do + let sym = fromJust $ HashMap.lookup _caseBranchTag symMap + lab = LabelRef sym Nothing + registerLabelAddress sym addr' + instrs <- goCode (addr' + 1) _caseBranchCode + let instrs' = Label lab : instrs ++ [mkJump (Val $ Lab labEnd)] + return (addr' + length instrs', instrs' : acc') + + goDefaultLabel :: HashMap Tag Symbol -> (Address, [Instruction]) -> Reg.Tag -> Sem r (Address, [Instruction]) + goDefaultLabel symMap (addr', acc') tag = do + let sym = fromJust $ HashMap.lookup tag symMap + lab = LabelRef sym Nothing + registerLabelAddress sym addr' + return (addr' + 1, Label lab : acc') + + goTrace :: Address -> Reg.InstrTrace -> Sem r [Instruction] + goTrace _ Reg.InstrTrace {..} = + return [Trace (InstrTrace (goRValue _instrTraceValue))] + + goFail :: Address -> Reg.InstrFailure -> Sem r [Instruction] + goFail _ Reg.InstrFailure {..} = + return + [ Trace (InstrTrace (goRValue _instrFailureValue)), + mkJump (Val $ Lab failLab) + ] + + goBlock :: Address -> Reg.InstrBlock -> Sem r [Instruction] + goBlock addr Reg.InstrBlock {..} = + goCode addr _instrBlockCode diff --git a/src/Juvix/Compiler/Casm/Translation/FromSource.hs b/src/Juvix/Compiler/Casm/Translation/FromSource.hs index 65aa3e3aa..5788eee1c 100644 --- a/src/Juvix/Compiler/Casm/Translation/FromSource.hs +++ b/src/Juvix/Compiler/Casm/Translation/FromSource.hs @@ -14,13 +14,20 @@ parseText = runParser noFile runParser :: Path Abs File -> Text -> Either MegaparsecError (LabelInfo, [Instruction]) runParser fileName input_ = - case run . runLabelInfoBuilder $ P.runParserT parseToplevel (toFilePath fileName) input_ of - (_, Left err) -> Left (MegaparsecError err) + case run . runLabelInfoBuilder $ runParser' 0 (toFilePath fileName) input_ of + (_, Left err) -> Left err (li, Right instrs) -> Right (li, instrs) -parseToplevel :: (Member LabelInfoBuilder r) => ParsecS r [Instruction] -parseToplevel = do - instrs <- statements 0 +runParser' :: (Member LabelInfoBuilder r) => Address -> FilePath -> Text -> Sem r (Either MegaparsecError [Instruction]) +runParser' addr fileName input_ = do + e <- P.runParserT (parseToplevel addr) fileName input_ + return $ case e of + Left err -> Left (MegaparsecError err) + Right instrs -> Right instrs + +parseToplevel :: (Member LabelInfoBuilder r) => Address -> ParsecS r [Instruction] +parseToplevel addr = do + instrs <- statements addr P.eof return instrs @@ -160,44 +167,38 @@ parseIncAp = (kw delimSemicolon >> kw kwApPlusPlus >> return True) <|> return Fa parseJump :: forall r. (Member LabelInfoBuilder r) => ParsecS r Instruction parseJump = do kw kwJmp - relJmp <|> jmp + P.try jmpIf <|> jmp where - relJmp :: ParsecS r Instruction - relJmp = do - kw kwRel - tgt <- parseRValue + jmpIf :: ParsecS r Instruction + jmpIf = do + isRel <- isJust <$> optional (kw kwRel) + tgt <- parseValue + kw kwIf + v <- parseMemRef + kw kwNotEq + symbol "0" incAp <- parseIncAp return $ - JumpRel $ - InstrJumpRel - { _instrJumpRelTarget = tgt, - _instrJumpRelIncAp = incAp + JumpIf $ + InstrJumpIf + { _instrJumpIfTarget = tgt, + _instrJumpIfValue = v, + _instrJumpIfRel = isRel, + _instrJumpIfIncAp = incAp } jmp :: ParsecS r Instruction jmp = do - tgt <- parseValue - mv <- optional if_ + isRel <- isJust <$> optional (kw kwRel) + tgt <- parseRValue incAp <- parseIncAp - case mv of - Nothing -> - return $ Jump $ InstrJump {_instrJumpTarget = tgt, _instrJumpIncAp = incAp} - Just v -> - return $ - JumpIf $ - InstrJumpIf - { _instrJumpIfTarget = tgt, - _instrJumpIfValue = v, - _instrJumpIfIncAp = incAp - } - where - if_ :: ParsecS r MemRef - if_ = do - kw kwIf - v <- parseMemRef - kw kwNotEq - symbol "0" - return v + return $ + Jump $ + InstrJump + { _instrJumpTarget = tgt, + _instrJumpRel = isRel, + _instrJumpIncAp = incAp + } parseCall :: (Member LabelInfoBuilder r) => ParsecS r Instruction parseCall = do diff --git a/src/Juvix/Compiler/Casm/Validate.hs b/src/Juvix/Compiler/Casm/Validate.hs index a972c3554..e80cb5af3 100644 --- a/src/Juvix/Compiler/Casm/Validate.hs +++ b/src/Juvix/Compiler/Casm/Validate.hs @@ -15,7 +15,6 @@ validate labi instrs = mapM_ go instrs ExtraBinop x -> goExtraBinop x Jump x -> goJump x JumpIf x -> goJumpIf x - JumpRel x -> goJumpRel x Call x -> goCall x Return -> return () Alloc x -> goAlloc x @@ -52,14 +51,11 @@ validate labi instrs = mapM_ go instrs goExtraBinop InstrExtraBinop {..} = goValue _instrExtraBinopArg2 goJump :: InstrJump -> Either CasmError () - goJump InstrJump {..} = goValue _instrJumpTarget + goJump InstrJump {..} = goRValue _instrJumpTarget goJumpIf :: InstrJumpIf -> Either CasmError () goJumpIf InstrJumpIf {..} = goValue _instrJumpIfTarget - goJumpRel :: InstrJumpRel -> Either CasmError () - goJumpRel InstrJumpRel {..} = goRValue _instrJumpRelTarget - goCall :: InstrCall -> Either CasmError () goCall InstrCall {..} = goValue _instrCallTarget diff --git a/src/Juvix/Compiler/Core/Data/TransformationId.hs b/src/Juvix/Compiler/Core/Data/TransformationId.hs index c73c15866..e35264e0a 100644 --- a/src/Juvix/Compiler/Core/Data/TransformationId.hs +++ b/src/Juvix/Compiler/Core/Data/TransformationId.hs @@ -25,6 +25,7 @@ data TransformationId | CheckExec | CheckVampIR | CheckAnoma + | CheckCairo | Normalize | LetFolding | LambdaFolding @@ -99,6 +100,7 @@ instance TransformationId' TransformationId where CheckExec -> strCheckExec CheckVampIR -> strCheckVampIR CheckAnoma -> strCheckAnoma + CheckCairo -> strCheckCairo Normalize -> strNormalize LetFolding -> strLetFolding LambdaFolding -> strLambdaFolding diff --git a/src/Juvix/Compiler/Core/Data/TransformationId/Strings.hs b/src/Juvix/Compiler/Core/Data/TransformationId/Strings.hs index 20a3a61e0..35b5a4559 100644 --- a/src/Juvix/Compiler/Core/Data/TransformationId/Strings.hs +++ b/src/Juvix/Compiler/Core/Data/TransformationId/Strings.hs @@ -83,6 +83,9 @@ strCheckVampIR = "check-vampir" strCheckAnoma :: Text strCheckAnoma = "check-anoma" +strCheckCairo :: Text +strCheckCairo = "check-cairo" + strNormalize :: Text strNormalize = "normalize" diff --git a/src/Juvix/Compiler/Core/Transformation.hs b/src/Juvix/Compiler/Core/Transformation.hs index 396d8eef0..a868de3cc 100644 --- a/src/Juvix/Compiler/Core/Transformation.hs +++ b/src/Juvix/Compiler/Core/Transformation.hs @@ -14,6 +14,7 @@ import Juvix.Compiler.Core.Error import Juvix.Compiler.Core.Options import Juvix.Compiler.Core.Transformation.Base import Juvix.Compiler.Core.Transformation.Check.Anoma +import Juvix.Compiler.Core.Transformation.Check.Cairo import Juvix.Compiler.Core.Transformation.Check.Exec import Juvix.Compiler.Core.Transformation.Check.Geb import Juvix.Compiler.Core.Transformation.Check.VampIR @@ -77,6 +78,7 @@ applyTransformations ts tbl = foldM (flip appTrans) tbl ts CheckExec -> mapError (JuvixError @CoreError) . checkExec CheckVampIR -> mapError (JuvixError @CoreError) . checkVampIR CheckAnoma -> mapError (JuvixError @CoreError) . checkAnoma + CheckCairo -> mapError (JuvixError @CoreError) . checkCairo Normalize -> normalize LetFolding -> return . letFolding LambdaFolding -> return . lambdaFolding diff --git a/src/Juvix/Compiler/Core/Transformation/Check/Cairo.hs b/src/Juvix/Compiler/Core/Transformation/Check/Cairo.hs new file mode 100644 index 000000000..f449ce26d --- /dev/null +++ b/src/Juvix/Compiler/Core/Transformation/Check/Cairo.hs @@ -0,0 +1,13 @@ +module Juvix.Compiler.Core.Transformation.Check.Cairo where + +import Juvix.Compiler.Core.Error +import Juvix.Compiler.Core.Extra +import Juvix.Compiler.Core.Transformation.Base +import Juvix.Compiler.Core.Transformation.Check.Base + +checkCairo :: forall r. (Member (Error CoreError) r) => Module -> Sem r Module +checkCairo md = do + checkMainExists md + checkNoAxioms md + mapAllNodesM checkNoIO md + mapAllNodesM (checkBuiltins' [OpStrConcat, OpStrToInt, OpShow] [PrimString]) md diff --git a/src/Juvix/Compiler/Pipeline.hs b/src/Juvix/Compiler/Pipeline.hs index 47a12957b..c4522599c 100644 --- a/src/Juvix/Compiler/Pipeline.hs +++ b/src/Juvix/Compiler/Pipeline.hs @@ -16,6 +16,8 @@ import Juvix.Compiler.Backend qualified as Backend import Juvix.Compiler.Backend.C qualified as C import Juvix.Compiler.Backend.Geb qualified as Geb import Juvix.Compiler.Backend.VampIR.Translation qualified as VampIR +import Juvix.Compiler.Casm.Data.Result qualified as Casm +import Juvix.Compiler.Casm.Translation.FromReg qualified as Casm import Juvix.Compiler.Concrete.Data.Highlight.Input import Juvix.Compiler.Concrete.Language import Juvix.Compiler.Concrete.Translation.FromParsed qualified as Scoper @@ -42,6 +44,7 @@ import Juvix.Compiler.Tree qualified as Tree import Juvix.Data.Effect.Git import Juvix.Data.Effect.Process import Juvix.Data.Effect.TaggedLock +import Juvix.Data.Field type PipelineAppEffects = '[TaggedLock, EmbedIO, Resource, Final IO] @@ -101,6 +104,12 @@ upToAsm :: upToAsm = upToStoredCore >>= \Core.CoreResult {..} -> storedCoreToAsm _coreResultModule +upToCasm :: + (Members '[HighlightBuilder, Reader Parser.ParserResult, Reader EntryPoint, Reader Store.ModuleTable, Files, NameIdGen, Error JuvixError, GitClone, PathResolver] r) => + Sem r Casm.Result +upToCasm = + upToStoredCore >>= \Core.CoreResult {..} -> storedCoreToCasm _coreResultModule + upToMiniC :: (Members '[HighlightBuilder, Reader Parser.ParserResult, Reader EntryPoint, Reader Store.ModuleTable, Files, NameIdGen, Error JuvixError, GitClone, PathResolver] r) => Sem r C.MiniCResult @@ -153,6 +162,9 @@ storedCoreToReg = storedCoreToAsm >=> asmToReg storedCoreToMiniC :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module -> Sem r C.MiniCResult storedCoreToMiniC = storedCoreToAsm >=> asmToMiniC +storedCoreToCasm :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module -> Sem r Casm.Result +storedCoreToCasm = local (set entryPointFieldSize cairoFieldSize) . storedCoreToTree Core.CheckCairo >=> treeToCasm + storedCoreToGeb :: (Members '[Error JuvixError, Reader EntryPoint] r) => Geb.ResultSpec -> Core.Module -> Sem r Geb.Result storedCoreToGeb spec = Core.toGeb >=> return . uncurry (Geb.toResult spec) . Geb.fromCore . Core.computeCombinedInfoTable @@ -175,6 +187,9 @@ coreToAsm = Core.toStored >=> storedCoreToAsm coreToReg :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module -> Sem r Reg.InfoTable coreToReg = Core.toStored >=> storedCoreToReg +coreToCasm :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module -> Sem r Casm.Result +coreToCasm = Core.toStored >=> storedCoreToCasm + coreToNockma :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module -> Sem r (Nockma.Cell Natural) coreToNockma = coreToTree Core.CheckAnoma >=> treeToNockma @@ -200,6 +215,9 @@ coreToVampIR' = Core.toStored' >=> storedCoreToVampIR' treeToAsm :: (Member (Error JuvixError) r) => Tree.InfoTable -> Sem r Asm.InfoTable treeToAsm = Tree.toAsm >=> return . Asm.fromTree +treeToCairoAsm :: (Member (Error JuvixError) r) => Tree.InfoTable -> Sem r Asm.InfoTable +treeToCairoAsm = Tree.toCairoAsm >=> return . Asm.fromTree + treeToReg :: (Members '[Error JuvixError, Reader EntryPoint] r) => Tree.InfoTable -> Sem r Reg.InfoTable treeToReg = treeToAsm >=> asmToReg @@ -212,9 +230,15 @@ treeToAnoma = Tree.toNockma >=> mapReader NockmaTree.fromEntryPoint . NockmaTree treeToMiniC :: (Members '[Error JuvixError, Reader EntryPoint] r) => Tree.InfoTable -> Sem r C.MiniCResult treeToMiniC = treeToAsm >=> asmToMiniC +treeToCasm :: (Members '[Error JuvixError, Reader EntryPoint] r) => Tree.InfoTable -> Sem r Casm.Result +treeToCasm = treeToCairoAsm >=> asmToCasm + asmToReg :: (Members '[Error JuvixError, Reader EntryPoint] r) => Asm.InfoTable -> Sem r Reg.InfoTable asmToReg = Asm.toReg >=> return . Reg.fromAsm +asmToCasm :: (Members '[Error JuvixError, Reader EntryPoint] r) => Asm.InfoTable -> Sem r Casm.Result +asmToCasm = asmToReg >=> regToCasm + asmToMiniC :: (Members '[Error JuvixError, Reader EntryPoint] r) => Asm.InfoTable -> Sem r C.MiniCResult asmToMiniC = asmToReg >=> regToMiniC @@ -224,6 +248,9 @@ regToMiniC tab = do e <- ask return $ C.fromReg (Backend.getLimits (e ^. entryPointTarget) (e ^. entryPointDebug)) tab' +regToCasm :: Reg.InfoTable -> Sem r Casm.Result +regToCasm = Reg.toCasm >=> return . Casm.fromReg + treeToNockma' :: (Members '[Error JuvixError, Reader NockmaTree.CompilerOptions] r) => Tree.InfoTable -> Sem r (Nockma.Cell Natural) treeToNockma' = Tree.toNockma >=> NockmaTree.fromTreeTable NockmaTree.ProgramCallingConventionJuvix diff --git a/src/Juvix/Compiler/Reg/Data/TransformationId.hs b/src/Juvix/Compiler/Reg/Data/TransformationId.hs index b06807306..2383029ca 100644 --- a/src/Juvix/Compiler/Reg/Data/TransformationId.hs +++ b/src/Juvix/Compiler/Reg/Data/TransformationId.hs @@ -12,7 +12,7 @@ data TransformationId deriving stock (Data, Bounded, Enum, Show) data PipelineId - = PipelineCairo + = PipelineCasm | PipelineC deriving stock (Data, Bounded, Enum) @@ -21,8 +21,8 @@ type TransformationLikeId = TransformationLikeId' TransformationId PipelineId toCTransformations :: [TransformationId] toCTransformations = [Cleanup] -toCairoTransformations :: [TransformationId] -toCairoTransformations = [Cleanup, SSA, InitBranchVars] +toCasmTransformations :: [TransformationId] +toCasmTransformations = [Cleanup, SSA, InitBranchVars] instance TransformationId' TransformationId where transformationText :: TransformationId -> Text @@ -36,9 +36,9 @@ instance PipelineId' TransformationId PipelineId where pipelineText :: PipelineId -> Text pipelineText = \case PipelineC -> strCPipeline - PipelineCairo -> strCairoPipeline + PipelineCasm -> strCasmPipeline pipeline :: PipelineId -> [TransformationId] pipeline = \case PipelineC -> toCTransformations - PipelineCairo -> toCairoTransformations + PipelineCasm -> toCasmTransformations diff --git a/src/Juvix/Compiler/Reg/Data/TransformationId/Strings.hs b/src/Juvix/Compiler/Reg/Data/TransformationId/Strings.hs index fe54ffb95..4d0ae8c18 100644 --- a/src/Juvix/Compiler/Reg/Data/TransformationId/Strings.hs +++ b/src/Juvix/Compiler/Reg/Data/TransformationId/Strings.hs @@ -5,8 +5,8 @@ import Juvix.Prelude strCPipeline :: Text strCPipeline = "pipeline-c" -strCairoPipeline :: Text -strCairoPipeline = "pipeline-cairo" +strCasmPipeline :: Text +strCasmPipeline = "pipeline-casm" strIdentity :: Text strIdentity = "identity" diff --git a/src/Juvix/Compiler/Reg/Extra/Info.hs b/src/Juvix/Compiler/Reg/Extra/Info.hs index 9a61ae13a..321dfc677 100644 --- a/src/Juvix/Compiler/Reg/Extra/Info.hs +++ b/src/Juvix/Compiler/Reg/Extra/Info.hs @@ -196,8 +196,13 @@ computeLocalVarsNum = maximum . map go data ExtraInfo = ExtraInfo { _extraInfoTable :: InfoTable, + -- | Globally unique IDs for constructor tags _extraInfoUIDs :: HashMap Tag Int, + -- | Globally unique IDs for function symbols _extraInfoFUIDs :: HashMap Symbol Int, + -- | IDs for constructor tags, consecutive starting from 0 for each + -- inductive type separately + _extraInfoCIDs :: HashMap Tag Int, _extraInfoStringMap :: HashMap Text Int, _extraInfoMaxStackHeight :: HashMap Symbol Int, _extraInfoLocalVarsNum :: HashMap Symbol Int, @@ -226,12 +231,19 @@ computeFUIDs tab = (HashMap.elems (tab ^. infoFunctions)) [0 ..] +computeCIDs :: InfoTable -> HashMap Tag Int +computeCIDs tab = HashMap.fromList $ concatMap go (tab ^. infoInductives) + where + go :: InductiveInfo -> [(Tag, Int)] + go InductiveInfo {..} = zip _inductiveConstructors [0 ..] + computeExtraInfo :: Limits -> InfoTable -> ExtraInfo computeExtraInfo lims tab = ExtraInfo { _extraInfoTable = tab, _extraInfoUIDs = computeUIDs lims tab, _extraInfoFUIDs = computeFUIDs tab, + _extraInfoCIDs = computeCIDs tab, _extraInfoStringMap = foldr (\fi mp -> computeStringMap mp (fi ^. functionCode)) diff --git a/src/Juvix/Compiler/Reg/Interpreter.hs b/src/Juvix/Compiler/Reg/Interpreter.hs index 1263d8486..692b4427e 100644 --- a/src/Juvix/Compiler/Reg/Interpreter.hs +++ b/src/Juvix/Compiler/Reg/Interpreter.hs @@ -65,15 +65,6 @@ runFunction hout infoTable args0 info0 = do [] -> return $ ValVoid - readConst :: Constant -> Val - readConst = \case - ConstInt i -> ValInteger i - ConstField f -> ValField f - ConstBool b -> ValBool b - ConstString s -> ValString s - ConstUnit -> ValUnit - ConstVoid -> ValVoid - readVarRef :: Args -> Vars s -> VarRef -> ST s Val readVarRef args tmps VarRef {..} = case _varRefGroup of VarGroupArgs -> return $ args Vec.! _varRefIndex @@ -97,7 +88,7 @@ runFunction hout infoTable args0 info0 = do readValue :: Args -> Vars s -> Value -> ST s Val readValue args tmps = \case - Const c -> return $ readConst c + Const c -> return $ constantToValue c CRef r -> readConstrRef args tmps r VRef r -> readVarRef args tmps r diff --git a/src/Juvix/Compiler/Reg/Language.hs b/src/Juvix/Compiler/Reg/Language.hs index bc8f6632d..eeeb1df5d 100644 --- a/src/Juvix/Compiler/Reg/Language.hs +++ b/src/Juvix/Compiler/Reg/Language.hs @@ -19,6 +19,7 @@ data ConstrField = ConstrField _constrFieldMemRep :: MemRep, -- | Location where the data is stored. _constrFieldRef :: VarRef, + -- | Index of the constructor argument being referenced. _constrFieldIndex :: Index } diff --git a/src/Juvix/Compiler/Reg/Pipeline.hs b/src/Juvix/Compiler/Reg/Pipeline.hs index f9eee0859..00282214a 100644 --- a/src/Juvix/Compiler/Reg/Pipeline.hs +++ b/src/Juvix/Compiler/Reg/Pipeline.hs @@ -11,6 +11,7 @@ import Juvix.Compiler.Reg.Transformation toC :: InfoTable -> Sem r InfoTable toC = applyTransformations toCTransformations --- | Perform transformations on JuvixReg necessary before the translation to Cairo -toCairo :: InfoTable -> Sem r InfoTable -toCairo = applyTransformations toCairoTransformations +-- | Perform transformations on JuvixReg necessary before the translation to +-- Cairo assembly +toCasm :: InfoTable -> Sem r InfoTable +toCasm = applyTransformations toCasmTransformations diff --git a/src/Juvix/Compiler/Tree/Data/TransformationId.hs b/src/Juvix/Compiler/Tree/Data/TransformationId.hs index 6cd45861d..afbe62c2e 100644 --- a/src/Juvix/Compiler/Tree/Data/TransformationId.hs +++ b/src/Juvix/Compiler/Tree/Data/TransformationId.hs @@ -17,6 +17,7 @@ data TransformationId data PipelineId = PipelineNockma | PipelineAsm + | PipelineCairoAsm deriving stock (Data, Bounded, Enum) type TransformationLikeId = TransformationLikeId' TransformationId PipelineId @@ -27,6 +28,9 @@ toNockmaTransformations = [Validate, Apply, FilterUnreachable, TempHeight] toAsmTransformations :: [TransformationId] toAsmTransformations = [Validate] +toCairoAsmTransformations :: [TransformationId] +toCairoAsmTransformations = [Validate, Apply, FilterUnreachable] + instance TransformationId' TransformationId where transformationText :: TransformationId -> Text transformationText = \case @@ -43,8 +47,10 @@ instance PipelineId' TransformationId PipelineId where pipelineText = \case PipelineNockma -> strNockmaPipeline PipelineAsm -> strAsmPipeline + PipelineCairoAsm -> strCairoAsmPipeline pipeline :: PipelineId -> [TransformationId] pipeline = \case PipelineNockma -> toNockmaTransformations PipelineAsm -> toAsmTransformations + PipelineCairoAsm -> toCairoAsmTransformations diff --git a/src/Juvix/Compiler/Tree/Data/TransformationId/Strings.hs b/src/Juvix/Compiler/Tree/Data/TransformationId/Strings.hs index 41ed6a397..1e8aa131f 100644 --- a/src/Juvix/Compiler/Tree/Data/TransformationId/Strings.hs +++ b/src/Juvix/Compiler/Tree/Data/TransformationId/Strings.hs @@ -8,6 +8,9 @@ strNockmaPipeline = "pipeline-nockma" strAsmPipeline :: Text strAsmPipeline = "pipeline-asm" +strCairoAsmPipeline :: Text +strCairoAsmPipeline = "pipeline-cairo-asm" + strIdentity :: Text strIdentity = "identity" diff --git a/src/Juvix/Compiler/Tree/Evaluator.hs b/src/Juvix/Compiler/Tree/Evaluator.hs index e27e8d43a..47b65c261 100644 --- a/src/Juvix/Compiler/Tree/Evaluator.hs +++ b/src/Juvix/Compiler/Tree/Evaluator.hs @@ -81,13 +81,7 @@ hEval hout tab = eval' [] mempty goTrace v = unsafePerformIO (hPutStrLn hout (printValue tab v) >> return v) goConstant :: NodeConstant -> Value - goConstant NodeConstant {..} = case _nodeConstant of - ConstInt i -> ValInteger i - ConstField f -> ValField f - ConstBool b -> ValBool b - ConstString s -> ValString s - ConstUnit -> ValUnit - ConstVoid -> ValVoid + goConstant NodeConstant {..} = constantToValue _nodeConstant goMemRef :: NodeMemRef -> Value goMemRef NodeMemRef {..} = case _nodeMemRef of diff --git a/src/Juvix/Compiler/Tree/Evaluator/Builtins.hs b/src/Juvix/Compiler/Tree/Evaluator/Builtins.hs index 71e1af8ef..6c73426c6 100644 --- a/src/Juvix/Compiler/Tree/Evaluator/Builtins.hs +++ b/src/Juvix/Compiler/Tree/Evaluator/Builtins.hs @@ -1,12 +1,12 @@ module Juvix.Compiler.Tree.Evaluator.Builtins where import Juvix.Compiler.Tree.Data.InfoTable.Base +import Juvix.Compiler.Tree.Language.Base import Juvix.Compiler.Tree.Language.Builtins import Juvix.Compiler.Tree.Language.Value import Juvix.Compiler.Tree.Pretty.Base import Juvix.Data.Field import Juvix.Data.PPOutput -import Juvix.Prelude import Text.Read qualified as T type ErrorMsg = Text @@ -104,3 +104,32 @@ printValue :: InfoTable' t e -> Value -> Text printValue tab = \case ValString s -> s v -> toPlainText . mkAnsiText . PPOutput . doc (defaultOptions tab) $ v + +constantToValue :: Constant -> Value +constantToValue = \case + ConstInt i -> ValInteger i + ConstField f -> ValField f + ConstBool b -> ValBool b + ConstString s -> ValString s + ConstUnit -> ValUnit + ConstVoid -> ValVoid + +valueToConstant :: Value -> Constant +valueToConstant = \case + ValInteger i -> ConstInt i + ValField f -> ConstField f + ValBool b -> ConstBool b + ValString s -> ConstString s + ValUnit -> ConstUnit + ValVoid -> ConstVoid + _ -> impossible + +evalBinop' :: BinaryOp -> Constant -> Constant -> Either ErrorMsg Constant +evalBinop' op arg1 arg2 = + mapRight valueToConstant $ + evalBinop op (constantToValue arg1) (constantToValue arg2) + +evalUnop' :: InfoTable' t e -> UnaryOp -> Constant -> Either ErrorMsg Constant +evalUnop' tab op v = + mapRight valueToConstant $ + evalUnop tab op (constantToValue v) diff --git a/src/Juvix/Compiler/Tree/EvaluatorEff.hs b/src/Juvix/Compiler/Tree/EvaluatorEff.hs index 22787e6bb..34ead890b 100644 --- a/src/Juvix/Compiler/Tree/EvaluatorEff.hs +++ b/src/Juvix/Compiler/Tree/EvaluatorEff.hs @@ -77,13 +77,7 @@ eval tab = E.runReader emptyEvalCtx . eval' goTrace v = E.output v $> v goConstant :: NodeConstant -> Value - goConstant NodeConstant {..} = case _nodeConstant of - ConstInt i -> ValInteger i - ConstField f -> ValField f - ConstBool b -> ValBool b - ConstString s -> ValString s - ConstUnit -> ValUnit - ConstVoid -> ValVoid + goConstant NodeConstant {..} = constantToValue _nodeConstant askTemp :: Eff r' (BL.BinderList Value) askTemp = E.asks (^. evalCtxTemp) diff --git a/src/Juvix/Compiler/Tree/EvaluatorSem.hs b/src/Juvix/Compiler/Tree/EvaluatorSem.hs index 2831f70b1..f4f982f1a 100644 --- a/src/Juvix/Compiler/Tree/EvaluatorSem.hs +++ b/src/Juvix/Compiler/Tree/EvaluatorSem.hs @@ -75,13 +75,7 @@ eval tab = runReader emptyEvalCtx . eval' goTrace v = output v $> v goConstant :: NodeConstant -> Value - goConstant NodeConstant {..} = case _nodeConstant of - ConstInt i -> ValInteger i - ConstField f -> ValField f - ConstBool b -> ValBool b - ConstString s -> ValString s - ConstUnit -> ValUnit - ConstVoid -> ValVoid + goConstant NodeConstant {..} = constantToValue _nodeConstant askTemp :: Sem r' (BL.BinderList Value) askTemp = asks (^. evalCtxTemp) diff --git a/src/Juvix/Compiler/Tree/Pipeline.hs b/src/Juvix/Compiler/Tree/Pipeline.hs index 96ce8beca..749c35170 100644 --- a/src/Juvix/Compiler/Tree/Pipeline.hs +++ b/src/Juvix/Compiler/Tree/Pipeline.hs @@ -12,3 +12,6 @@ toNockma = applyTransformations toNockmaTransformations toAsm :: (Member (Error JuvixError) r) => InfoTable -> Sem r InfoTable toAsm = applyTransformations toAsmTransformations + +toCairoAsm :: (Member (Error JuvixError) r) => InfoTable -> Sem r InfoTable +toCairoAsm = applyTransformations toCairoAsmTransformations diff --git a/test/Casm.hs b/test/Casm.hs index 085c77307..fb4d7c6e1 100644 --- a/test/Casm.hs +++ b/test/Casm.hs @@ -1,7 +1,9 @@ module Casm where import Base +import Casm.Compilation qualified as Compile +import Casm.Reg qualified as Reg import Casm.Run qualified as Run allTests :: TestTree -allTests = testGroup "CASM tests" [Run.allTests] +allTests = testGroup "CASM tests" [Run.allTests, Reg.allTests, Compile.allTests] diff --git a/test/Casm/Compilation.hs b/test/Casm/Compilation.hs new file mode 100644 index 000000000..b17cd49c0 --- /dev/null +++ b/test/Casm/Compilation.hs @@ -0,0 +1,7 @@ +module Casm.Compilation where + +import Base +import Casm.Compilation.Positive qualified as P + +allTests :: TestTree +allTests = testGroup "Juvix to CASM compilation" [P.allTests, P.allTestsNoOptimize] diff --git a/test/Casm/Compilation/Base.hs b/test/Casm/Compilation/Base.hs new file mode 100644 index 000000000..6ec3b78b0 --- /dev/null +++ b/test/Casm/Compilation/Base.hs @@ -0,0 +1,52 @@ +module Casm.Compilation.Base where + +import Base +import Juvix.Compiler.Casm.Data.Result +import Juvix.Compiler.Casm.Interpreter +import Juvix.Compiler.Casm.Pretty +import Juvix.Compiler.Core qualified as Core +import Juvix.Data.Field +import Juvix.Data.PPOutput + +compileAssertion :: + Path Abs Dir -> + Int -> + Path Abs File -> + Path Abs File -> + (String -> IO ()) -> + Assertion +compileAssertion = compileAssertionEntry (\e -> e {_entryPointFieldSize = cairoFieldSize}) + +compileAssertionEntry :: + (EntryPoint -> EntryPoint) -> + Path Abs Dir -> + Int -> + Path Abs File -> + Path Abs File -> + (String -> IO ()) -> + Assertion +compileAssertionEntry adjustEntry root' optLevel mainFile expectedFile step = do + step "Translate to JuvixCore" + entryPoint <- adjustEntry <$> testDefaultEntryPointIO root' mainFile + PipelineResult {..} <- snd <$> testRunIO entryPoint upToStoredCore + step "Translate to CASM" + let entryPoint' = entryPoint {_entryPointOptimizationLevel = optLevel} + case run $ runError @JuvixError $ runReader entryPoint' $ storedCoreToCasm (_pipelineResult ^. Core.coreResultModule) of + Left err -> assertFailure (show (pretty (fromJuvixError @GenericError err))) + Right Result {..} -> do + withTempDir' + ( \dirPath -> do + let outputFile = dirPath $(mkRelFile "out.out") + let tmpFile = dirPath $(mkRelFile "tmp.out") + step "Serialize" + writeFileEnsureLn tmpFile (toPlainText $ ppProgram _resultCode) + hout <- openFile (toFilePath outputFile) WriteMode + step "Interpret" + let v = hRunCode hout _resultLabelInfo _resultCode + hPutStrLn hout (show v) + hClose hout + actualOutput <- readFile outputFile + step "Compare expected and actual program output" + expected <- readFile expectedFile + assertEqDiffText ("Check: RUN output = " <> toFilePath expectedFile) actualOutput expected + ) diff --git a/test/Casm/Compilation/Positive.hs b/test/Casm/Compilation/Positive.hs new file mode 100644 index 000000000..b31b28360 --- /dev/null +++ b/test/Casm/Compilation/Positive.hs @@ -0,0 +1,353 @@ +module Casm.Compilation.Positive where + +import Base +import Casm.Compilation.Base +import Data.HashSet qualified as HashSet + +data PosTest = PosTest + { _name :: String, + _dir :: Path Abs Dir, + _file :: Path Abs File, + _expectedFile :: Path Abs File + } + +makeLenses ''PosTest + +root :: Path Abs Dir +root = relToProject $(mkRelDir "tests/Casm/Compilation/positive/") + +toTestDescr :: Int -> PosTest -> TestDescr +toTestDescr optLevel PosTest {..} = + let tRoot = _dir + file' = _file + expected' = _expectedFile + in TestDescr + { _testName = _name, + _testRoot = tRoot, + _testAssertion = Steps $ compileAssertion _dir optLevel file' expected' + } + +allTests :: TestTree +allTests = + testGroup + "Juvix to CASM positive tests" + (map (mkTest . toTestDescr 3) tests) + +allTestsNoOptimize :: TestTree +allTestsNoOptimize = + testGroup + "Juvix to CASM positive tests (no optimization)" + (map (mkTest . toTestDescr 0) tests) + +posTest :: String -> Path Rel Dir -> Path Rel File -> Path Rel File -> PosTest +posTest _name rdir rfile routfile = + let _dir = root rdir + _file = _dir rfile + _expectedFile = root routfile + in PosTest {..} + +isIgnored :: PosTest -> Bool +isIgnored t = HashSet.member (t ^. name) ignored + +ignored :: HashSet String +ignored = + HashSet.fromList + [ -- strings not supported (Partial trait) + "Test026: Functional queues" + ] + +tests :: [PosTest] +tests = + filter + (not . isIgnored) + [ posTest + "Test001: Arithmetic operators" + $(mkRelDir ".") + $(mkRelFile "test001.juvix") + $(mkRelFile "out/test001.out"), + posTest + "Test002: Arithmetic operators inside lambdas" + $(mkRelDir ".") + $(mkRelFile "test002.juvix") + $(mkRelFile "out/test002.out"), + posTest + "Test003: Integer arithmetic" + $(mkRelDir ".") + $(mkRelFile "test003.juvix") + $(mkRelFile "out/test003.out"), + posTest + "Test005: Higher-order functions" + $(mkRelDir ".") + $(mkRelFile "test005.juvix") + $(mkRelFile "out/test005.out"), + posTest + "Test006: If-then-else and lazy boolean operators" + $(mkRelDir ".") + $(mkRelFile "test006.juvix") + $(mkRelFile "out/test006.out"), + posTest + "Test007: Pattern matching and lambda-case" + $(mkRelDir ".") + $(mkRelFile "test007.juvix") + $(mkRelFile "out/test007.out"), + posTest + "Test008: Recursion" + $(mkRelDir ".") + $(mkRelFile "test008.juvix") + $(mkRelFile "out/test008.out"), + posTest + "Test009: Tail recursion" + $(mkRelDir ".") + $(mkRelFile "test009.juvix") + $(mkRelFile "out/test009.out"), + posTest + "Test010: Let" + $(mkRelDir ".") + $(mkRelFile "test010.juvix") + $(mkRelFile "out/test010.out"), + posTest + "Test013: Functions returning functions with variable capture" + $(mkRelDir ".") + $(mkRelFile "test013.juvix") + $(mkRelFile "out/test013.out"), + posTest + "Test014: Arithmetic" + $(mkRelDir ".") + $(mkRelFile "test014.juvix") + $(mkRelFile "out/test014.out"), + posTest + "Test015: Local functions with free variables" + $(mkRelDir ".") + $(mkRelFile "test015.juvix") + $(mkRelFile "out/test015.out"), + posTest + "Test016: Recursion through higher-order functions" + $(mkRelDir ".") + $(mkRelFile "test016.juvix") + $(mkRelFile "out/test016.out"), + posTest + "Test017: Tail recursion through higher-order functions" + $(mkRelDir ".") + $(mkRelFile "test017.juvix") + $(mkRelFile "out/test017.out"), + posTest + "Test018: Higher-order functions and recursion" + $(mkRelDir ".") + $(mkRelFile "test018.juvix") + $(mkRelFile "out/test018.out"), + posTest + "Test019: Self-application" + $(mkRelDir ".") + $(mkRelFile "test019.juvix") + $(mkRelFile "out/test019.out"), + posTest + "Test020: Recursive functions: McCarthy's 91 function, subtraction by increments" + $(mkRelDir ".") + $(mkRelFile "test020.juvix") + $(mkRelFile "out/test020.out"), + posTest + "Test021: Fast exponentiation" + $(mkRelDir ".") + $(mkRelFile "test021.juvix") + $(mkRelFile "out/test021.out"), + posTest + "Test022: Lists" + $(mkRelDir ".") + $(mkRelFile "test022.juvix") + $(mkRelFile "out/test022.out"), + posTest + "Test023: Mutual recursion" + $(mkRelDir ".") + $(mkRelFile "test023.juvix") + $(mkRelFile "out/test023.out"), + posTest + "Test024: Nested binders with variable capture" + $(mkRelDir ".") + $(mkRelFile "test024.juvix") + $(mkRelFile "out/test024.out"), + posTest + "Test025: Euclid's algorithm" + $(mkRelDir ".") + $(mkRelFile "test025.juvix") + $(mkRelFile "out/test025.out"), + posTest + "Test026: Functional queues" + $(mkRelDir ".") + $(mkRelFile "test026.juvix") + $(mkRelFile "out/test026.out"), + posTest + "Test028: Streams without memoization" + $(mkRelDir ".") + $(mkRelFile "test028.juvix") + $(mkRelFile "out/test028.out"), + posTest + "Test029: Ackermann function" + $(mkRelDir ".") + $(mkRelFile "test029.juvix") + $(mkRelFile "out/test029.out"), + posTest + "Test030: Ackermann function (higher-order definition)" + $(mkRelDir ".") + $(mkRelFile "test030.juvix") + $(mkRelFile "out/test030.out"), + posTest + "Test032: Merge sort" + $(mkRelDir ".") + $(mkRelFile "test032.juvix") + $(mkRelFile "out/test032.out"), + posTest + "Test033: Eta-expansion of builtins and constructors" + $(mkRelDir ".") + $(mkRelFile "test033.juvix") + $(mkRelFile "out/test033.out"), + posTest + "Test034: Recursive let" + $(mkRelDir ".") + $(mkRelFile "test034.juvix") + $(mkRelFile "out/test034.out"), + posTest + "Test035: Pattern matching" + $(mkRelDir ".") + $(mkRelFile "test035.juvix") + $(mkRelFile "out/test035.out"), + posTest + "Test036: Eta-expansion" + $(mkRelDir ".") + $(mkRelFile "test036.juvix") + $(mkRelFile "out/test036.out"), + posTest + "Test037: Applications with lets and cases in function position" + $(mkRelDir ".") + $(mkRelFile "test037.juvix") + $(mkRelFile "out/test037.out"), + posTest + "Test038: Simple case expression" + $(mkRelDir ".") + $(mkRelFile "test038.juvix") + $(mkRelFile "out/test038.out"), + posTest + "Test039: Mutually recursive let expression" + $(mkRelDir ".") + $(mkRelFile "test039.juvix") + $(mkRelFile "out/test039.out"), + posTest + "Test040: Pattern matching nullary constructor" + $(mkRelDir ".") + $(mkRelFile "test040.juvix") + $(mkRelFile "out/test040.out"), + posTest + "Test045: Implicit builtin bool" + $(mkRelDir ".") + $(mkRelFile "test045.juvix") + $(mkRelFile "out/test045.out"), + posTest + "Test046: Polymorphic type arguments" + $(mkRelDir ".") + $(mkRelFile "test046.juvix") + $(mkRelFile "out/test046.out"), + posTest + "Test047: Local Modules" + $(mkRelDir ".") + $(mkRelFile "test047.juvix") + $(mkRelFile "out/test047.out"), + posTest + "Test050: Pattern matching with integers" + $(mkRelDir ".") + $(mkRelFile "test050.juvix") + $(mkRelFile "out/test050.out"), + posTest + "Test053: Inlining" + $(mkRelDir ".") + $(mkRelFile "test053.juvix") + $(mkRelFile "out/test053.out"), + posTest + "Test054: Iterators" + $(mkRelDir ".") + $(mkRelFile "test054.juvix") + $(mkRelFile "out/test054.out"), + posTest + "Test056: Argument specialization" + $(mkRelDir ".") + $(mkRelFile "test056.juvix") + $(mkRelFile "out/test056.out"), + posTest + "Test057: Case folding" + $(mkRelDir ".") + $(mkRelFile "test057.juvix") + $(mkRelFile "out/test057.out"), + posTest + "Test058: Ranges" + $(mkRelDir ".") + $(mkRelFile "test058.juvix") + $(mkRelFile "out/test058.out"), + posTest + "Test059: Builtin list" + $(mkRelDir ".") + $(mkRelFile "test059.juvix") + $(mkRelFile "out/test059.out"), + posTest + "Test060: Record update" + $(mkRelDir ".") + $(mkRelFile "test060.juvix") + $(mkRelFile "out/test060.out"), + posTest + "Test062: Overapplication" + $(mkRelDir ".") + $(mkRelFile "test062.juvix") + $(mkRelFile "out/test062.out"), + posTest + "Test064: Constant folding" + $(mkRelDir ".") + $(mkRelFile "test064.juvix") + $(mkRelFile "out/test064.out"), + posTest + "Test065: Arithmetic simplification" + $(mkRelDir ".") + $(mkRelFile "test065.juvix") + $(mkRelFile "out/test065.out"), + posTest + "Test066: Import function with a function call in default argument" + $(mkRelDir "test066") + $(mkRelFile "M.juvix") + $(mkRelFile "out/test066.out"), + posTest + "Test067: Dependent default values inserted during translation FromConcrete" + $(mkRelDir ".") + $(mkRelFile "test067.juvix") + $(mkRelFile "out/test067.out"), + posTest + "Test068: Dependent default values inserted in the arity checker" + $(mkRelDir ".") + $(mkRelFile "test068.juvix") + $(mkRelFile "out/test068.out"), + posTest + "Test069: Dependent default values for Ord trait" + $(mkRelDir ".") + $(mkRelFile "test069.juvix") + $(mkRelFile "out/test069.out"), + posTest + "Test070: Nested default values and named arguments" + $(mkRelDir ".") + $(mkRelFile "test070.juvix") + $(mkRelFile "out/test070.out"), + posTest + "Test071: Named application (Ord instance with default cmp)" + $(mkRelDir ".") + $(mkRelFile "test071.juvix") + $(mkRelFile "out/test071.out"), + posTest + "Test072: Monad transformers (ReaderT + StateT + Identity)" + $(mkRelDir "test072") + $(mkRelFile "ReaderT.juvix") + $(mkRelFile "out/test072.out"), + posTest + "Test073: Import and use a syntax alias" + $(mkRelDir "test073") + $(mkRelFile "test073.juvix") + $(mkRelFile "out/test073.out"), + posTest + "Test074: Fields" + $(mkRelDir ".") + $(mkRelFile "test074.juvix") + $(mkRelFile "out/test074.out") + ] diff --git a/test/Casm/Reg.hs b/test/Casm/Reg.hs new file mode 100644 index 000000000..14a9fb667 --- /dev/null +++ b/test/Casm/Reg.hs @@ -0,0 +1,7 @@ +module Casm.Reg where + +import Base +import Casm.Reg.Positive qualified as P + +allTests :: TestTree +allTests = testGroup "CASM from JuvixReg translation" [P.allTests] diff --git a/test/Casm/Reg/Base.hs b/test/Casm/Reg/Base.hs new file mode 100644 index 000000000..a69c57efd --- /dev/null +++ b/test/Casm/Reg/Base.hs @@ -0,0 +1,20 @@ +module Casm.Reg.Base where + +import Base +import Juvix.Compiler.Casm.Data.Result +import Juvix.Compiler.Casm.Interpreter +import Juvix.Compiler.Reg.Data.InfoTable qualified as Reg +import Juvix.Data.PPOutput +import Reg.Run.Base qualified as Reg + +compileAssertion' :: Handle -> Symbol -> Reg.InfoTable -> IO () +compileAssertion' hout _ tab = do + case run $ runError @JuvixError $ regToCasm tab of + Left err -> assertFailure (show (pretty (fromJuvixError @GenericError err))) + Right Result {..} -> do + let v = hRunCode hout _resultLabelInfo _resultCode + hPutStrLn hout (show v) + +regToCasmAssertion :: Path Abs File -> Path Abs File -> (String -> IO ()) -> Assertion +regToCasmAssertion mainFile expectedFile step = + Reg.regRunAssertionParam compileAssertion' mainFile expectedFile [] (const (return ())) step diff --git a/test/Casm/Reg/Positive.hs b/test/Casm/Reg/Positive.hs new file mode 100644 index 000000000..a70ae13ab --- /dev/null +++ b/test/Casm/Reg/Positive.hs @@ -0,0 +1,183 @@ +module Casm.Reg.Positive where + +import Base +import Casm.Reg.Base + +data PosTest = PosTest + { _name :: String, + _relDir :: Path Rel Dir, + _file :: Path Rel File, + _expectedFile :: Path Rel File + } + +root :: Path Abs Dir +root = relToProject $(mkRelDir "tests/Casm/Reg/positive") + +testDescr :: PosTest -> TestDescr +testDescr PosTest {..} = + let tRoot = root _relDir + file' = tRoot _file + expected' = tRoot _expectedFile + in TestDescr + { _testName = _name, + _testRoot = tRoot, + _testAssertion = Steps $ regToCasmAssertion file' expected' + } + +filterTests :: [String] -> [PosTest] -> [PosTest] +filterTests incl = filter (\PosTest {..} -> _name `elem` incl) + +allTests :: TestTree +allTests = + testGroup + "CASM from JuvixReg translation positive tests" + (map (mkTest . testDescr) tests) + +tests :: [PosTest] +tests = + [ PosTest + "Test001: Arithmetic opcodes" + $(mkRelDir ".") + $(mkRelFile "test001.jvr") + $(mkRelFile "out/test001.out"), + PosTest + "Test002: Direct call" + $(mkRelDir ".") + $(mkRelFile "test002.jvr") + $(mkRelFile "out/test002.out"), + PosTest + "Test003: Indirect call" + $(mkRelDir ".") + $(mkRelFile "test003.jvr") + $(mkRelFile "out/test003.out"), + PosTest + "Test004: Tail calls" + $(mkRelDir ".") + $(mkRelFile "test004.jvr") + $(mkRelFile "out/test004.out"), + PosTest + "Test008: Branch" + $(mkRelDir ".") + $(mkRelFile "test008.jvr") + $(mkRelFile "out/test008.out"), + PosTest + "Test009: Case" + $(mkRelDir ".") + $(mkRelFile "test009.jvr") + $(mkRelFile "out/test009.out"), + PosTest + "Test010: Recursion" + $(mkRelDir ".") + $(mkRelFile "test010.jvr") + $(mkRelFile "out/test010.out"), + PosTest + "Test011: Tail recursion" + $(mkRelDir ".") + $(mkRelFile "test011.jvr") + $(mkRelFile "out/test011.out"), + PosTest + "Test012: Temporary stack" + $(mkRelDir ".") + $(mkRelFile "test012.jvr") + $(mkRelFile "out/test012.out"), + PosTest + "Test013: Fibonacci numbers in linear time" + $(mkRelDir ".") + $(mkRelFile "test013.jvr") + $(mkRelFile "out/test013.out"), + PosTest + "Test014: Trees" + $(mkRelDir ".") + $(mkRelFile "test014.jvr") + $(mkRelFile "out/test014.out"), + PosTest + "Test015: Functions returning functions" + $(mkRelDir ".") + $(mkRelFile "test015.jvr") + $(mkRelFile "out/test015.out"), + PosTest + "Test016: Arithmetic" + $(mkRelDir ".") + $(mkRelFile "test016.jvr") + $(mkRelFile "out/test016.out"), + PosTest + "Test017: Closures as arguments" + $(mkRelDir ".") + $(mkRelFile "test017.jvr") + $(mkRelFile "out/test017.out"), + PosTest + "Test018: Closure extension" + $(mkRelDir ".") + $(mkRelFile "test018.jvr") + $(mkRelFile "out/test018.out"), + PosTest + "Test019: Recursion through higher-order functions" + $(mkRelDir ".") + $(mkRelFile "test019.jvr") + $(mkRelFile "out/test019.out"), + PosTest + "Test020: Tail recursion through higher-order functions" + $(mkRelDir ".") + $(mkRelFile "test020.jvr") + $(mkRelFile "out/test020.out"), + PosTest + "Test021: Higher-order functions and recursion" + $(mkRelDir ".") + $(mkRelFile "test021.jvr") + $(mkRelFile "out/test021.out"), + PosTest + "Test023: McCarthy's 91 function" + $(mkRelDir ".") + $(mkRelFile "test023.jvr") + $(mkRelFile "out/test023.out"), + PosTest + "Test024: Higher-order recursive functions" + $(mkRelDir ".") + $(mkRelFile "test024.jvr") + $(mkRelFile "out/test024.out"), + PosTest + "Test026: Currying & uncurrying" + $(mkRelDir ".") + $(mkRelFile "test026.jvr") + $(mkRelFile "out/test026.out"), + PosTest + "Test027: Fast exponentiation" + $(mkRelDir ".") + $(mkRelFile "test027.jvr") + $(mkRelFile "out/test027.out"), + PosTest + "Test028: Lists" + $(mkRelDir ".") + $(mkRelFile "test028.jvr") + $(mkRelFile "out/test028.out"), + PosTest + "Test030: Mutual recursion" + $(mkRelDir ".") + $(mkRelFile "test030.jvr") + $(mkRelFile "out/test030.out"), + PosTest + "Test031: Temporary stack with branching" + $(mkRelDir ".") + $(mkRelFile "test031.jvr") + $(mkRelFile "out/test031.out"), + PosTest + "Test033: Ackermann function" + $(mkRelDir ".") + $(mkRelFile "test033.jvr") + $(mkRelFile "out/test033.out"), + PosTest + "Test034: Higher-order function composition" + $(mkRelDir ".") + $(mkRelFile "test034.jvr") + $(mkRelFile "out/test034.out"), + PosTest + "Test036: Streams without memoization" + $(mkRelDir ".") + $(mkRelFile "test036.jvr") + $(mkRelFile "out/test036.out"), + PosTest + "Test038: Apply & argsnum" + $(mkRelDir ".") + $(mkRelFile "test038.jvr") + $(mkRelFile "out/test038.out") + ] diff --git a/test/Casm/Run.hs b/test/Casm/Run.hs index 2ab05e888..102ffbd47 100644 --- a/test/Casm/Run.hs +++ b/test/Casm/Run.hs @@ -1,7 +1,5 @@ module Casm.Run where --- import Casm.Run.Negative qualified as RunN - import Base import Casm.Run.Negative qualified as RunN import Casm.Run.Positive qualified as RunP diff --git a/tests/Asm/positive/out/test018.out b/tests/Asm/positive/out/test018.out index 5ebe23636..d3c70f908 100644 --- a/tests/Asm/positive/out/test018.out +++ b/tests/Asm/positive/out/test018.out @@ -1,3 +1,4 @@ 11 9 10 +11 diff --git a/tests/Asm/positive/test018.jva b/tests/Asm/positive/test018.jva index 3e83049d2..3c2bd829c 100644 --- a/tests/Asm/positive/test018.jva +++ b/tests/Asm/positive/test018.jva @@ -40,6 +40,17 @@ function mult(integer, integer) : integer { ret; } +function g(integer, integer, integer, integer) : integer { + push arg[1]; + push arg[0]; + sub; + push arg[2]; + add; + push arg[3]; + mul; + ret; +} + function main() { calloc plus 0; call f; @@ -53,6 +64,12 @@ function main() { call f; trace; -- 10 pop; + push 2; + push 3; + calloc g 2; + call f; + trace; -- 11 + pop; push void; ret; } diff --git a/tests/Casm/Compilation/positive/out/test001.out b/tests/Casm/Compilation/positive/out/test001.out new file mode 100644 index 000000000..b4de39476 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test001.out @@ -0,0 +1 @@ +11 diff --git a/tests/Casm/Compilation/positive/out/test002.out b/tests/Casm/Compilation/positive/out/test002.out new file mode 100644 index 000000000..b4de39476 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test002.out @@ -0,0 +1 @@ +11 diff --git a/tests/Casm/Compilation/positive/out/test003.out b/tests/Casm/Compilation/positive/out/test003.out new file mode 100644 index 000000000..b4de39476 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test003.out @@ -0,0 +1 @@ +11 diff --git a/tests/Casm/Compilation/positive/out/test005.out b/tests/Casm/Compilation/positive/out/test005.out new file mode 100644 index 000000000..1e8b31496 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test005.out @@ -0,0 +1 @@ +6 diff --git a/tests/Casm/Compilation/positive/out/test006.out b/tests/Casm/Compilation/positive/out/test006.out new file mode 100644 index 000000000..00750edc0 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test006.out @@ -0,0 +1 @@ +3 diff --git a/tests/Casm/Compilation/positive/out/test007.out b/tests/Casm/Compilation/positive/out/test007.out new file mode 100644 index 000000000..1e8b31496 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test007.out @@ -0,0 +1 @@ +6 diff --git a/tests/Casm/Compilation/positive/out/test008.out b/tests/Casm/Compilation/positive/out/test008.out new file mode 100644 index 000000000..b9d569380 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test008.out @@ -0,0 +1 @@ +50005000 diff --git a/tests/Casm/Compilation/positive/out/test009.out b/tests/Casm/Compilation/positive/out/test009.out new file mode 100644 index 000000000..094058575 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test009.out @@ -0,0 +1 @@ +532635520 diff --git a/tests/Casm/Compilation/positive/out/test010.out b/tests/Casm/Compilation/positive/out/test010.out new file mode 100644 index 000000000..f5c89552b --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test010.out @@ -0,0 +1 @@ +32 diff --git a/tests/Casm/Compilation/positive/out/test013.out b/tests/Casm/Compilation/positive/out/test013.out new file mode 100644 index 000000000..45a4fb75d --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test013.out @@ -0,0 +1 @@ +8 diff --git a/tests/Casm/Compilation/positive/out/test014.out b/tests/Casm/Compilation/positive/out/test014.out new file mode 100644 index 000000000..cd5b02527 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test014.out @@ -0,0 +1 @@ +92 diff --git a/tests/Casm/Compilation/positive/out/test015.out b/tests/Casm/Compilation/positive/out/test015.out new file mode 100644 index 000000000..a01f8275a --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test015.out @@ -0,0 +1 @@ +771 diff --git a/tests/Casm/Compilation/positive/out/test016.out b/tests/Casm/Compilation/positive/out/test016.out new file mode 100644 index 000000000..c3f407c09 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test016.out @@ -0,0 +1 @@ +55 diff --git a/tests/Casm/Compilation/positive/out/test017.out b/tests/Casm/Compilation/positive/out/test017.out new file mode 100644 index 000000000..b9d569380 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test017.out @@ -0,0 +1 @@ +50005000 diff --git a/tests/Casm/Compilation/positive/out/test018.out b/tests/Casm/Compilation/positive/out/test018.out new file mode 100644 index 000000000..b4de39476 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test018.out @@ -0,0 +1 @@ +11 diff --git a/tests/Casm/Compilation/positive/out/test019.out b/tests/Casm/Compilation/positive/out/test019.out new file mode 100644 index 000000000..7f8f011eb --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test019.out @@ -0,0 +1 @@ +7 diff --git a/tests/Casm/Compilation/positive/out/test020.out b/tests/Casm/Compilation/positive/out/test020.out new file mode 100644 index 000000000..c4fa14144 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test020.out @@ -0,0 +1 @@ +4876 diff --git a/tests/Casm/Compilation/positive/out/test021.out b/tests/Casm/Compilation/positive/out/test021.out new file mode 100644 index 000000000..350e63263 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test021.out @@ -0,0 +1 @@ +48830320 diff --git a/tests/Casm/Compilation/positive/out/test022.out b/tests/Casm/Compilation/positive/out/test022.out new file mode 100644 index 000000000..3fb224413 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test022.out @@ -0,0 +1 @@ +100010000 diff --git a/tests/Casm/Compilation/positive/out/test023.out b/tests/Casm/Compilation/positive/out/test023.out new file mode 100644 index 000000000..1fa666edc --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test023.out @@ -0,0 +1 @@ +6386010 diff --git a/tests/Casm/Compilation/positive/out/test024.out b/tests/Casm/Compilation/positive/out/test024.out new file mode 100644 index 000000000..f7bd8cc28 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test024.out @@ -0,0 +1 @@ +6688 diff --git a/tests/Casm/Compilation/positive/out/test025.out b/tests/Casm/Compilation/positive/out/test025.out new file mode 100644 index 000000000..84df3526d --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test025.out @@ -0,0 +1 @@ +87 diff --git a/tests/Casm/Compilation/positive/out/test026.out b/tests/Casm/Compilation/positive/out/test026.out new file mode 100644 index 000000000..c3ac783e7 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test026.out @@ -0,0 +1 @@ +5050 diff --git a/tests/Casm/Compilation/positive/out/test028.out b/tests/Casm/Compilation/positive/out/test028.out new file mode 100644 index 000000000..a8629432c --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test028.out @@ -0,0 +1 @@ +2040 diff --git a/tests/Casm/Compilation/positive/out/test029.out b/tests/Casm/Compilation/positive/out/test029.out new file mode 100644 index 000000000..8e14edce9 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test029.out @@ -0,0 +1 @@ +78 diff --git a/tests/Casm/Compilation/positive/out/test030.out b/tests/Casm/Compilation/positive/out/test030.out new file mode 100644 index 000000000..40c4a2ca3 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test030.out @@ -0,0 +1 @@ +2247 diff --git a/tests/Casm/Compilation/positive/out/test032.out b/tests/Casm/Compilation/positive/out/test032.out new file mode 100644 index 000000000..6bb2f98fb --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test032.out @@ -0,0 +1 @@ +195 diff --git a/tests/Casm/Compilation/positive/out/test033.out b/tests/Casm/Compilation/positive/out/test033.out new file mode 100644 index 000000000..e85087aff --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test033.out @@ -0,0 +1 @@ +31 diff --git a/tests/Casm/Compilation/positive/out/test034.out b/tests/Casm/Compilation/positive/out/test034.out new file mode 100644 index 000000000..3f891345c --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test034.out @@ -0,0 +1 @@ +50006027 diff --git a/tests/Casm/Compilation/positive/out/test035.out b/tests/Casm/Compilation/positive/out/test035.out new file mode 100644 index 000000000..e61273a90 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test035.out @@ -0,0 +1 @@ +34422 diff --git a/tests/Casm/Compilation/positive/out/test036.out b/tests/Casm/Compilation/positive/out/test036.out new file mode 100644 index 000000000..3c032078a --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test036.out @@ -0,0 +1 @@ +18 diff --git a/tests/Casm/Compilation/positive/out/test037.out b/tests/Casm/Compilation/positive/out/test037.out new file mode 100644 index 000000000..ec635144f --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test037.out @@ -0,0 +1 @@ +9 diff --git a/tests/Casm/Compilation/positive/out/test038.out b/tests/Casm/Compilation/positive/out/test038.out new file mode 100644 index 000000000..d00491fd7 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test038.out @@ -0,0 +1 @@ +1 diff --git a/tests/Casm/Compilation/positive/out/test039.out b/tests/Casm/Compilation/positive/out/test039.out new file mode 100644 index 000000000..d00491fd7 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test039.out @@ -0,0 +1 @@ +1 diff --git a/tests/Casm/Compilation/positive/out/test040.out b/tests/Casm/Compilation/positive/out/test040.out new file mode 100644 index 000000000..d00491fd7 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test040.out @@ -0,0 +1 @@ +1 diff --git a/tests/Casm/Compilation/positive/out/test045.out b/tests/Casm/Compilation/positive/out/test045.out new file mode 100644 index 000000000..b8626c4cf --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test045.out @@ -0,0 +1 @@ +4 diff --git a/tests/Casm/Compilation/positive/out/test046.out b/tests/Casm/Compilation/positive/out/test046.out new file mode 100644 index 000000000..7f8f011eb --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test046.out @@ -0,0 +1 @@ +7 diff --git a/tests/Casm/Compilation/positive/out/test047.out b/tests/Casm/Compilation/positive/out/test047.out new file mode 100644 index 000000000..e250077b1 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test047.out @@ -0,0 +1 @@ +660 diff --git a/tests/Casm/Compilation/positive/out/test050.out b/tests/Casm/Compilation/positive/out/test050.out new file mode 100644 index 000000000..b4de39476 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test050.out @@ -0,0 +1 @@ +11 diff --git a/tests/Casm/Compilation/positive/out/test053.out b/tests/Casm/Compilation/positive/out/test053.out new file mode 100644 index 000000000..aabe6ec39 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test053.out @@ -0,0 +1 @@ +21 diff --git a/tests/Casm/Compilation/positive/out/test054.out b/tests/Casm/Compilation/positive/out/test054.out new file mode 100644 index 000000000..6c412452b --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test054.out @@ -0,0 +1 @@ +189 diff --git a/tests/Casm/Compilation/positive/out/test056.out b/tests/Casm/Compilation/positive/out/test056.out new file mode 100644 index 000000000..b5489e5e5 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test056.out @@ -0,0 +1 @@ +69 diff --git a/tests/Casm/Compilation/positive/out/test057.out b/tests/Casm/Compilation/positive/out/test057.out new file mode 100644 index 000000000..45a4fb75d --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test057.out @@ -0,0 +1 @@ +8 diff --git a/tests/Casm/Compilation/positive/out/test058.out b/tests/Casm/Compilation/positive/out/test058.out new file mode 100644 index 000000000..8a1c3eb60 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test058.out @@ -0,0 +1 @@ +7550 diff --git a/tests/Casm/Compilation/positive/out/test059.out b/tests/Casm/Compilation/positive/out/test059.out new file mode 100644 index 000000000..b4de39476 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test059.out @@ -0,0 +1 @@ +11 diff --git a/tests/Casm/Compilation/positive/out/test060.out b/tests/Casm/Compilation/positive/out/test060.out new file mode 100644 index 000000000..d81cc0710 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test060.out @@ -0,0 +1 @@ +42 diff --git a/tests/Casm/Compilation/positive/out/test062.out b/tests/Casm/Compilation/positive/out/test062.out new file mode 100644 index 000000000..d00491fd7 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test062.out @@ -0,0 +1 @@ +1 diff --git a/tests/Casm/Compilation/positive/out/test064.out b/tests/Casm/Compilation/positive/out/test064.out new file mode 100644 index 000000000..81b5c5d06 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test064.out @@ -0,0 +1 @@ +37 diff --git a/tests/Casm/Compilation/positive/out/test065.out b/tests/Casm/Compilation/positive/out/test065.out new file mode 100644 index 000000000..d81cc0710 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test065.out @@ -0,0 +1 @@ +42 diff --git a/tests/Casm/Compilation/positive/out/test066.out b/tests/Casm/Compilation/positive/out/test066.out new file mode 100644 index 000000000..573541ac9 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test066.out @@ -0,0 +1 @@ +0 diff --git a/tests/Casm/Compilation/positive/out/test067.out b/tests/Casm/Compilation/positive/out/test067.out new file mode 100644 index 000000000..64bb6b746 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test067.out @@ -0,0 +1 @@ +30 diff --git a/tests/Casm/Compilation/positive/out/test068.out b/tests/Casm/Compilation/positive/out/test068.out new file mode 100644 index 000000000..64bb6b746 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test068.out @@ -0,0 +1 @@ +30 diff --git a/tests/Casm/Compilation/positive/out/test069.out b/tests/Casm/Compilation/positive/out/test069.out new file mode 100644 index 000000000..d00491fd7 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test069.out @@ -0,0 +1 @@ +1 diff --git a/tests/Casm/Compilation/positive/out/test070.out b/tests/Casm/Compilation/positive/out/test070.out new file mode 100644 index 000000000..e9bae3d88 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test070.out @@ -0,0 +1 @@ +1463 diff --git a/tests/Casm/Compilation/positive/out/test071.out b/tests/Casm/Compilation/positive/out/test071.out new file mode 100644 index 000000000..9030a57f2 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test071.out @@ -0,0 +1 @@ +1528 diff --git a/tests/Casm/Compilation/positive/out/test072.out b/tests/Casm/Compilation/positive/out/test072.out new file mode 100644 index 000000000..f599e28b8 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test072.out @@ -0,0 +1 @@ +10 diff --git a/tests/Casm/Compilation/positive/out/test073.out b/tests/Casm/Compilation/positive/out/test073.out new file mode 100644 index 000000000..b4de39476 --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test073.out @@ -0,0 +1 @@ +11 diff --git a/tests/Casm/Compilation/positive/out/test074.out b/tests/Casm/Compilation/positive/out/test074.out new file mode 100644 index 000000000..2c8b00b0f --- /dev/null +++ b/tests/Casm/Compilation/positive/out/test074.out @@ -0,0 +1 @@ +2532951952066291849588125948166549073936175050732117689981164439295110414326 diff --git a/tests/Casm/Compilation/positive/test001.juvix b/tests/Casm/Compilation/positive/test001.juvix new file mode 100644 index 000000000..c52a9268c --- /dev/null +++ b/tests/Casm/Compilation/positive/test001.juvix @@ -0,0 +1,5 @@ +module test001; + +import Stdlib.Prelude open; + +main : Nat := 5 + 2 * 3; diff --git a/tests/Casm/Compilation/positive/test002.juvix b/tests/Casm/Compilation/positive/test002.juvix new file mode 100644 index 000000000..59485b0ea --- /dev/null +++ b/tests/Casm/Compilation/positive/test002.juvix @@ -0,0 +1,5 @@ +module test002; + +import Stdlib.Prelude open; + +main : Nat := \ {x y z := z + x * y} 2 3 5; diff --git a/tests/Casm/Compilation/positive/test003.juvix b/tests/Casm/Compilation/positive/test003.juvix new file mode 100644 index 000000000..535c11912 --- /dev/null +++ b/tests/Casm/Compilation/positive/test003.juvix @@ -0,0 +1,14 @@ +-- Integer arithmetic +module test003; + +{- + +Multiline comment + +{- nested comments work -} + +-} + +import Stdlib.Prelude open; + +main : Nat := mod 3 2 + div 18 4 + mod 18 4 + div 16 4 + mod 16 4; diff --git a/tests/Casm/Compilation/positive/test005.juvix b/tests/Casm/Compilation/positive/test005.juvix new file mode 100644 index 000000000..4747cdbde --- /dev/null +++ b/tests/Casm/Compilation/positive/test005.juvix @@ -0,0 +1,19 @@ +-- Higher-order functions +module test005; + +import Stdlib.Prelude open; + +S {A B C} (x : A → B → C) (y : A → B) (z : A) : C := + x z (y z); + +K {A B} (x : A) (_ : B) : A := x; + +I {A} : A → A := S K (K {_} {Bool}); + +main : Nat := + I 1 + + I I 1 + + I (I 1) + + I I I 1 + + I (I I) I (I I I) 1 + + I I I (I I I (I I)) I (I I) I I I 1; diff --git a/tests/Casm/Compilation/positive/test006.juvix b/tests/Casm/Compilation/positive/test006.juvix new file mode 100644 index 000000000..2032d091a --- /dev/null +++ b/tests/Casm/Compilation/positive/test006.juvix @@ -0,0 +1,13 @@ +-- if-then-else and lazy boolean operators +module test006; + +import Stdlib.Prelude open; + +terminating +loop : Nat := loop; + +main : Nat := + if (3 > 0) 1 loop + + if (2 < 1) loop (if (7 >= 8) loop 1) + + if (2 > 0 || loop == 0) 1 0 + + if (2 < 0 && loop == 0) 1 0; diff --git a/tests/Casm/Compilation/positive/test007.juvix b/tests/Casm/Compilation/positive/test007.juvix new file mode 100644 index 000000000..998b804c0 --- /dev/null +++ b/tests/Casm/Compilation/positive/test007.juvix @@ -0,0 +1,20 @@ +-- pattern matching and lambda-case +module test007; + +import Stdlib.Prelude open; + +map' {A B} (f : A → B) : List A → List B := + \ { + | nil := nil + | (h :: t) := f h :: map' f t + }; + +lst : List Nat := 0 :: 1 :: nil; + +main : Nat := + if (null lst) 1 0 + + if (null (nil {Nat})) 1 0 + + head 1 lst + + head 0 (tail lst) + + head 0 (tail (map ((+) 1) lst)) + + head 0 (tail (map' ((+) 1) lst)); diff --git a/tests/Casm/Compilation/positive/test008.juvix b/tests/Casm/Compilation/positive/test008.juvix new file mode 100644 index 000000000..11290705b --- /dev/null +++ b/tests/Casm/Compilation/positive/test008.juvix @@ -0,0 +1,10 @@ +-- recursion +module test008; + +import Stdlib.Prelude open; + +sum : Nat → Nat + | zero := 0 + | (suc x) := suc x + sum x; + +main : Nat := sum 10000; diff --git a/tests/Casm/Compilation/positive/test009.juvix b/tests/Casm/Compilation/positive/test009.juvix new file mode 100644 index 000000000..7f5600e9d --- /dev/null +++ b/tests/Casm/Compilation/positive/test009.juvix @@ -0,0 +1,18 @@ +-- tail recursion +module test009; + +import Stdlib.Prelude open; + +sum' (acc : Nat) : Nat → Nat + | zero := acc + | (suc x) := sum' (suc x + acc) x; + +sum : Nat → Nat := sum' 0; + +fact' (acc : Nat) : Nat → Nat + | zero := acc + | (suc x) := fact' (acc * suc x) x; + +fact : Nat → Nat := fact' 1; + +main : Nat := sum 10000 + fact 5 + fact 10 + fact 12; diff --git a/tests/Casm/Compilation/positive/test010.juvix b/tests/Casm/Compilation/positive/test010.juvix new file mode 100644 index 000000000..63f91b399 --- /dev/null +++ b/tests/Casm/Compilation/positive/test010.juvix @@ -0,0 +1,22 @@ +-- let +module test010; + +import Stdlib.Prelude open; + +main : Nat := + let + x : Nat := 1; + in let + x1 : + Nat := + x + + let + x2 : Nat := 2; + in x2; + in let + x3 : Nat := x1 * x1; + in let + y : Nat := x3 + 2; + in let + z : Nat := x3 + y; + in x + y + z; diff --git a/tests/Casm/Compilation/positive/test013.juvix b/tests/Casm/Compilation/positive/test013.juvix new file mode 100644 index 000000000..b0d63c9a8 --- /dev/null +++ b/tests/Casm/Compilation/positive/test013.juvix @@ -0,0 +1,16 @@ +-- functions returning functions with variable capture +module test013; + +import Stdlib.Prelude open; + +f : Nat → Nat → Nat + | x := + if + (x == 6) + λ {_ := 0} + (if + (x == 5) + λ {_ := 1} + (if (x == 10) λ {_ := λ {x := x} 2} λ {x := x})); + +main : Nat := f 5 6 + f 6 5 + f 10 5 + f 11 5; diff --git a/tests/Casm/Compilation/positive/test014.juvix b/tests/Casm/Compilation/positive/test014.juvix new file mode 100644 index 000000000..0ad36179a --- /dev/null +++ b/tests/Casm/Compilation/positive/test014.juvix @@ -0,0 +1,36 @@ +-- arithmetic +module test014; + +import Stdlib.Prelude open; + +f (x y : Nat) : Nat := x + y; + +g (x y : Nat) : Nat := sub (x + 21) (y * 7); + +h (f : Nat → Nat → Nat) (y z : Nat) : Nat := f y y * z; + +x : Nat := 5; + +y : Nat := 17; + +func (x : Nat) : Nat := x + 4; + +z : Nat := 0; + +vx : Nat := 30; + +vy : Nat := 7; + +main : Nat := + func (div y x) + + -- 17 div 5 + 4 = 7 + (y + + x * z) + + -- 17 + (vx + + vy * (z + 1)) + + -- 37 + f + (h g 2 3) + 4; +-- (g 2 2) * 3 + 4 = (2+21-2*7)*3 + 4 = 9*3 + 4 = 27+4 = 31 diff --git a/tests/Casm/Compilation/positive/test015.juvix b/tests/Casm/Compilation/positive/test015.juvix new file mode 100644 index 000000000..6c6486d62 --- /dev/null +++ b/tests/Casm/Compilation/positive/test015.juvix @@ -0,0 +1,43 @@ +-- local functions with free variables +module test015; + +import Stdlib.Prelude open; + +terminating +f : Nat → Nat → Nat + | x := + let + g (y : Nat) : Nat := x + y; + in if + (x == 0) + (f 10) + (if (x < 10) λ {y := g (f (sub x 1) y)} g); + +g (x : Nat) (h : Nat → Nat) : Nat := x + h x; + +terminating +h : Nat → Nat + | zero := 0 + | (suc x) := g x h; + +main : Nat := + f 100 500 + + -- 600 + f + 5 + 0 + + -- 25 + f + 5 + 5 + + -- 30 + h + 10 + + -- 45 + g + 10 + h + + -- 55 + g + 3 + (f 10); diff --git a/tests/Casm/Compilation/positive/test016.juvix b/tests/Casm/Compilation/positive/test016.juvix new file mode 100644 index 000000000..dc6af7985 --- /dev/null +++ b/tests/Casm/Compilation/positive/test016.juvix @@ -0,0 +1,14 @@ +-- recursion through higher-order functions +module test016; + +import Stdlib.Prelude open; + +g (f : Nat → Nat) : Nat → Nat + | zero := 0 + | (suc x) := f x; + +terminating +f (x : Nat) : Nat := x + g f x; + +main : Nat := f 10; +-- 55 diff --git a/tests/Casm/Compilation/positive/test017.juvix b/tests/Casm/Compilation/positive/test017.juvix new file mode 100644 index 000000000..3e9d8a7b3 --- /dev/null +++ b/tests/Casm/Compilation/positive/test017.juvix @@ -0,0 +1,15 @@ +-- tail recursion through higher-order functions +module test017; + +import Stdlib.Prelude open; + +sumb (acc : Nat) (f : Nat → Nat → Nat) : Nat → Nat + | zero := acc + | (suc x) := f acc x; + +terminating +sum' (acc x : Nat) : Nat := sumb (x + acc) sum' x; + +sum : Nat → Nat := sum' 0; + +main : Nat := sum 10000; diff --git a/tests/Casm/Compilation/positive/test018.juvix b/tests/Casm/Compilation/positive/test018.juvix new file mode 100644 index 000000000..081f17492 --- /dev/null +++ b/tests/Casm/Compilation/positive/test018.juvix @@ -0,0 +1,16 @@ +-- higher-order functions & recursion +module test018; + +import Stdlib.Prelude open; + +f : (Nat → Nat) → Nat + | g := g 5; + +h : Nat → Nat → Nat + | x z := x + z; + +u : Nat → Nat + | x := f (h 4) + x; + +main : Nat := u 2; + diff --git a/tests/Casm/Compilation/positive/test019.juvix b/tests/Casm/Compilation/positive/test019.juvix new file mode 100644 index 000000000..2f8313399 --- /dev/null +++ b/tests/Casm/Compilation/positive/test019.juvix @@ -0,0 +1,11 @@ +-- self-application +module test019; + +import Stdlib.Prelude open; + +-- change this to a lambda once we have type annotations for lambdas +app : ({A : Type} → A → A) → {A : Type} → A → A + | x := x x; + +main : Nat := app id (3 + 4); + diff --git a/tests/Casm/Compilation/positive/test020.juvix b/tests/Casm/Compilation/positive/test020.juvix new file mode 100644 index 000000000..4cd552d22 --- /dev/null +++ b/tests/Casm/Compilation/positive/test020.juvix @@ -0,0 +1,25 @@ +-- recursive functions +module test020; + +import Stdlib.Prelude open; + +-- McCarthy's 91 function +terminating +f91 : Nat → Nat + | n := if (n > 100) (sub n 10) (f91 (f91 (n + 11))); + +-- subtraction by increments +terminating +subp : Nat → Nat → Nat + | i j := if (i == j) 0 (subp i (j + 1) + 1); + +main : Nat := + f91 101 + + f91 95 + + f91 16 + + f91 5 + + subp 101 1 + + subp 11 5 + + subp 10 4 + + subp 1000 600 + + subp 10000 6000; diff --git a/tests/Casm/Compilation/positive/test021.juvix b/tests/Casm/Compilation/positive/test021.juvix new file mode 100644 index 000000000..63ebdbaf3 --- /dev/null +++ b/tests/Casm/Compilation/positive/test021.juvix @@ -0,0 +1,23 @@ +-- fast exponentiation +module test021; + +import Stdlib.Prelude open; + +terminating +power' : Nat → Nat → Nat → Nat + | acc a b := + if + (b == 0) + acc + (if + (mod b 2 == 0) + (power' acc (a * a) (div b 2)) + (power' (acc * a) (a * a) (div b 2))); + +power : Nat → Nat → Nat := power' 1; + +main : Nat := + power 2 3 + + (power 3 7) + + (power 5 11); + diff --git a/tests/Casm/Compilation/positive/test022.juvix b/tests/Casm/Compilation/positive/test022.juvix new file mode 100644 index 000000000..adafdf5b4 --- /dev/null +++ b/tests/Casm/Compilation/positive/test022.juvix @@ -0,0 +1,16 @@ +-- lists +module test022; + +import Stdlib.Prelude open; + +gen : Nat → List Nat + | zero := nil + | n@(suc m) := n :: gen m; + +sum : Nat → Nat + | n := foldl (+) 0 (gen n); + +sum' : Nat → Nat + | n := foldr (+) 0 (gen n); + +main : Nat := sum 10000 + sum' 10000; diff --git a/tests/Casm/Compilation/positive/test023.juvix b/tests/Casm/Compilation/positive/test023.juvix new file mode 100644 index 000000000..26cb5429a --- /dev/null +++ b/tests/Casm/Compilation/positive/test023.juvix @@ -0,0 +1,19 @@ +-- mutual recursion +module test023; + +import Stdlib.Prelude open; + +terminating +f : Nat → Nat + + | x := if (x < 1) 1 (2 * x + g (sub x 1)); + +terminating +g : Nat → Nat + | x := if (x < 1) 1 (x + h (sub x 1)); + +terminating +h : Nat → Nat + | x := if (x < 1) 1 (x * f (sub x 1)); + +main : Nat := f 5 + f 10 + f 20; diff --git a/tests/Casm/Compilation/positive/test024.juvix b/tests/Casm/Compilation/positive/test024.juvix new file mode 100644 index 000000000..b036114d6 --- /dev/null +++ b/tests/Casm/Compilation/positive/test024.juvix @@ -0,0 +1,46 @@ +-- nested binders with variable capture +module test024; + +import Stdlib.Prelude open; + +type Tree := + | leaf : Tree + | node : Tree → Tree → Tree; + +gen : Nat → Tree + | zero := leaf + | (suc zero) := node leaf leaf + | (suc (suc n')) := node (gen n') (gen (suc n')); + +g : Tree → Tree + + | leaf := leaf + | (node l r) := if (isNode l) r (node r l); + +terminating +f : Tree → Nat + | leaf := 1 + | (node l' r') := + let + l : Tree := g l'; + r : Tree := g r'; + terminating + a : + Nat := + case l + | leaf := 1 + | node l r := f l + f r; + terminating + b : + Nat := + case r + | node l r := f l + f r + | _ := 2; + in a * b; + +isNode : Tree → Bool + | (node _ _) := true + | leaf := false; + +main : Nat := f (gen 10); + diff --git a/tests/Casm/Compilation/positive/test025.juvix b/tests/Casm/Compilation/positive/test025.juvix new file mode 100644 index 000000000..ceb84cd31 --- /dev/null +++ b/tests/Casm/Compilation/positive/test025.juvix @@ -0,0 +1,16 @@ +-- Euclid's algorithm +module test025; + +import Stdlib.Prelude open; + +terminating +gcd : Nat → Nat → Nat + | a b := + if (a > b) (gcd b a) (if (a == 0) b (gcd (mod b a) a)); + +main : Nat := + gcd (3 * 7 * 2) (7 * 2 * 11) + + gcd (3 * 7 * 2 * 11 * 5) (7 * 2 * 5) + + gcd 3 7 + + gcd 7 3 + + gcd (11 * 7 * 3) (2 * 5 * 13); diff --git a/tests/Casm/Compilation/positive/test026.juvix b/tests/Casm/Compilation/positive/test026.juvix new file mode 100644 index 000000000..3a27c46b2 --- /dev/null +++ b/tests/Casm/Compilation/positive/test026.juvix @@ -0,0 +1,58 @@ +-- functional queues +module test026; + +import Stdlib.Prelude open; + +type Queue (A : Type) := + | queue : List A → List A → Queue A; + +qfst : {A : Type} → Queue A → List A + | (queue x _) := x; + +qsnd : {A : Type} → Queue A → List A + | (queue _ x) := x; + +front {{Partial}} : {A : Type} → Queue A → A + | q := phead (qfst q); + +pop_front : {A : Type} → Queue A → Queue A + | {A} q := + let + q' : Queue A := queue (tail (qfst q)) (qsnd q); + in case qfst q' + | nil := queue (reverse (qsnd q')) nil + | _ := q'; + +push_back : {A : Type} → Queue A → A → Queue A + | q x := + case qfst q + | nil := queue (x :: nil) (qsnd q) + | q' := queue q' (x :: qsnd q); + +is_empty : {A : Type} → Queue A → Bool + | q := + case qfst q + | nil := + (case qsnd q + | nil := true + | _ := false) + | _ := false; + +empty : {A : Type} → Queue A := queue nil nil; + +terminating +g {{Partial}} : List Nat → Queue Nat → List Nat + | acc q := + if (is_empty q) acc (g (front q :: acc) (pop_front q)); + +-- TODO: remove `terminating` after fixing https://github.com/anoma/juvix/issues/2414 +terminating +f {{Partial}} : Nat → Queue Nat → List Nat + | zero q := g nil q + | n@(suc n') q := f n' (push_back q n); + +sum : List Nat → Nat + | nil := 0 + | (h :: t) := h + sum t; + +main : Nat := sum (runPartial (λ {{{_}} := f 100 empty})); diff --git a/tests/Casm/Compilation/positive/test028.juvix b/tests/Casm/Compilation/positive/test028.juvix new file mode 100644 index 000000000..c014a3a58 --- /dev/null +++ b/tests/Casm/Compilation/positive/test028.juvix @@ -0,0 +1,46 @@ +-- streams without memoization +module test028; + +import Stdlib.Prelude open; + +type Stream := cons : Nat → (Unit → Stream) → Stream; + +force : (Unit → Stream) → Stream + | f := f unit; + +terminating +sfilter : (Nat → Bool) → (Unit → Stream) → Unit → Stream + | p s unit := + case force s of {cons h t := + if (p h) (cons h (sfilter p t)) (force (sfilter p t))}; + +shead : Stream → Nat + | (cons h _) := h; + +stail : Stream → Unit → Stream + | (cons _ t) := t; + +snth : Nat → (Unit → Stream) → Nat + | zero s := shead (force s) + | (suc n) s := snth n (stail (force s)); + +terminating +numbers : Nat → Unit → Stream + | n unit := cons n (numbers (suc n)); + +indivisible : Nat → Nat → Bool + | n x := not (mod x n == 0); + +terminating +eratostenes : (Unit → Stream) → Unit → Stream + | s unit := + case force s of {cons n t := + cons n (eratostenes (sfilter (indivisible n) t))}; + +primes : Unit → Stream := eratostenes (numbers 2); + +main : Nat := + snth 10 primes + + snth 50 primes + + snth 100 primes + + snth 200 primes; diff --git a/tests/Casm/Compilation/positive/test029.juvix b/tests/Casm/Compilation/positive/test029.juvix new file mode 100644 index 000000000..43cd0299e --- /dev/null +++ b/tests/Casm/Compilation/positive/test029.juvix @@ -0,0 +1,16 @@ +-- Ackermann function +module test029; + +import Stdlib.Prelude open; + +ack : Nat → Nat → Nat + | zero n := n + 1 + | (suc m) zero := ack m 1 + | (suc m) (suc n) := ack m (ack (suc m) n); + +main : Nat := + ack 0 7 + + ack 1 7 + + ack 1 13 + + ack 2 7 + + ack 2 13; diff --git a/tests/Casm/Compilation/positive/test030.juvix b/tests/Casm/Compilation/positive/test030.juvix new file mode 100644 index 000000000..b5434b9b2 --- /dev/null +++ b/tests/Casm/Compilation/positive/test030.juvix @@ -0,0 +1,23 @@ +-- Ackermann function (higher-order definition) +module test030; + +import Stdlib.Prelude open hiding {iterate}; + +iterate : {A : Type} → (A → A) → Nat → A → A + -- clauses with differing number of patterns not yet supported + -- iterate f zero x := x; + | f zero := id + | f (suc n) := f ∘ iterate f n; + +plus : Nat → Nat → Nat := iterate suc; + +mult : Nat → Nat → Nat + | m n := iterate (plus n) m 0; + +exp : Nat → Nat → Nat + | m n := iterate (mult m) n 1; + +ackermann : Nat → Nat → Nat + | m := iterate λ {f n := iterate f (suc n) 1} m suc; + +main : Nat := plus 3 7 + mult 3 7 + exp 3 7 + ackermann 2 13; diff --git a/tests/Casm/Compilation/positive/test032.juvix b/tests/Casm/Compilation/positive/test032.juvix new file mode 100644 index 000000000..eb6fe5259 --- /dev/null +++ b/tests/Casm/Compilation/positive/test032.juvix @@ -0,0 +1,58 @@ +-- merge sort +module test032; + +import Stdlib.Prelude open; + +split : {A : Type} → Nat → List A → List A × List A + | zero xs := nil, xs + | (suc n) nil := nil, nil + | (suc n) (x :: xs) := + case split n xs of {l1, l2 := x :: l1, l2}; + +terminating +merge' : List Nat → List Nat → List Nat + | nil ys := ys + | xs nil := xs + | xs@(x :: xs') ys@(y :: ys') := + if (x <= y) (x :: merge' xs' ys) (y :: merge' xs ys'); + +terminating +sort : List Nat → List Nat + | xs := + let + n : Nat := length xs; + in if + (n <= 1) + xs + case split (div n 2) xs of {l1, l2 := + merge' (sort l1) (sort l2)}; + +terminating +uniq : List Nat → List Nat + | nil := nil + | (x :: nil) := x :: nil + | (x :: xs@(x' :: _)) := + if (x == x') (uniq xs) (x :: uniq xs); + +gen : List Nat → Nat → (Nat → Nat) → List Nat + | acc zero f := acc + | acc (suc n) f := gen (f (suc n) :: acc) n f; + +gen2 : List (List Nat) → Nat → Nat → List (List Nat) + | acc m zero := acc + | acc m (suc n) := + gen2 (gen nil m ((+) (suc n)) :: acc) m n; + +printListNatLn : List Nat → IO + | nil := printStringLn "nil" + | (x :: xs) := + printNat x >> printString " :: " >> printListNatLn xs; + +sum : List Nat → Nat + | nil := 0 + | (h :: t) := h + sum t; + +main : Nat := + sum (take 10 (uniq (sort (flatten (gen2 nil 6 40))))) + + sum (take 10 (uniq (sort (flatten (gen2 nil 9 80))))) + + sum (take 10 (uniq (sort (flatten (gen2 nil 6 80))))); diff --git a/tests/Casm/Compilation/positive/test033.juvix b/tests/Casm/Compilation/positive/test033.juvix new file mode 100644 index 000000000..e2be0043f --- /dev/null +++ b/tests/Casm/Compilation/positive/test033.juvix @@ -0,0 +1,35 @@ +-- eta-expansion of builtins and constructors +module test033; + +import Stdlib.Prelude open; + +f : (Nat → Nat) → Nat + | g := g 2; + +f' : Nat → Nat + | x := f ((+) x); + +g : (Nat → Nat × Nat) → Nat × Nat + | f := f 2; + +g' : Nat → Nat × Nat + | x := g ((,) x); + +f1' : Nat → Nat → Nat + | x y := f ((+) (div x y)); + +g1' : Nat → Nat → Nat × Nat + | x y := g ((,) (div x y)); + +h : (Nat → Nat → Nat × Nat) → Nat × Nat + | f := f 1 2; + +main : Nat := + f' 7 + + fst (g' 7) + + snd (g' 7) + + f1' 7 2 + + fst (g1' 7 2) + + snd (g1' 7 2) + + fst (h (,)) + + snd (h (,)); diff --git a/tests/Casm/Compilation/positive/test034.juvix b/tests/Casm/Compilation/positive/test034.juvix new file mode 100644 index 000000000..7176d15b5 --- /dev/null +++ b/tests/Casm/Compilation/positive/test034.juvix @@ -0,0 +1,25 @@ +-- recursive let +module test034; + +import Stdlib.Prelude open; + +sum : Nat → Nat := + let + sum' : Nat → Nat := + λ { + zero := zero + | (suc n) := suc n + sum' n + }; + in sum'; + +mutrec : Nat := + let + terminating + f (x : Nat) : Nat := if (x < 1) 1 (g (sub x 1) + 2 * x); + terminating + g (x : Nat) : Nat := if (x < 1) 1 (x + h (sub x 1)); + terminating + h (x : Nat) : Nat := if (x < 1) 1 (x * f (sub x 1)); + in f 5 + f 10 + g 5 + h 5; + +main : Nat := sum 10000 + mutrec; diff --git a/tests/Casm/Compilation/positive/test035.juvix b/tests/Casm/Compilation/positive/test035.juvix new file mode 100644 index 000000000..75a9d3ffe --- /dev/null +++ b/tests/Casm/Compilation/positive/test035.juvix @@ -0,0 +1,58 @@ +-- pattern matching +module test035; + +import Stdlib.Prelude open; + +lgen : Nat → List Nat + | zero := nil + | (suc n) := suc n :: lgen n; + +sum2 : List Nat → List Nat + | (x :: y :: xs) := x + y :: sum2 (y :: xs) + | xs := xs; + +type Tree := + | leaf : Tree + | node : Tree -> Tree -> Tree; + +gen : Nat → Tree + | zero := leaf + | (suc zero) := node leaf leaf + | (suc (suc n)) := node (gen n) (gen (suc n)); + +terminating +f : Tree → Nat + | leaf := 1 + | (node l r) := + case g l, g r of { + | leaf, leaf := 3 + | node l r, leaf := mod ((f l + f r) * 2) 20000 + | node l1 r1, node l2 r2 := + mod ((f l1 + f r1) * (f l2 + f r2)) 20000 + | _, node l r := mod (f l + f r) 20000 + }; + +g : Tree → Tree + | leaf := leaf + | (node (node _ _) r) := r + | (node l r) := node r l; + +h : Nat -> Nat + | (suc (suc (suc (suc n)))) := n + | _ := 0; + +printListNatLn : List Nat → IO + | nil := printStringLn "nil" + | (x :: xs) := + printNat x >> printString " :: " >> printListNatLn xs; + +main : Nat := + head 0 (sum2 (lgen 5)) + + f (gen 10) + + f (gen 15) + + f (gen 16) + + f (gen 17) + + f (gen 18) + + f (gen 20) + + h 5 + + h 3; diff --git a/tests/Casm/Compilation/positive/test036.juvix b/tests/Casm/Compilation/positive/test036.juvix new file mode 100644 index 000000000..540f26bed --- /dev/null +++ b/tests/Casm/Compilation/positive/test036.juvix @@ -0,0 +1,24 @@ +-- eta-expansion +module test036; + +import Stdlib.Prelude open; + +expand : {A : Type} → A → Nat → A + | f x := f; + +f : Nat → Nat := suc; + +g : Nat → Nat → Nat + | z := f ∘ flip sub z; + +g' : Nat → Nat → Nat + | z := f ∘ λ {x := sub x z}; + +h : Nat → Nat := f ∘ g 3; + +j : Nat → Nat → Nat := g'; + +k : Nat → Nat → Nat → Nat := expand j; + +main : Nat := h 13 + j 2 3 + k 9 4 7; + diff --git a/tests/Casm/Compilation/positive/test037.juvix b/tests/Casm/Compilation/positive/test037.juvix new file mode 100644 index 000000000..92ba7034d --- /dev/null +++ b/tests/Casm/Compilation/positive/test037.juvix @@ -0,0 +1,23 @@ +-- Applications with lets and cases in function position +module test037; + +import Stdlib.Prelude open; + +f (l : List ((Nat → Nat) → Nat → Nat)) : Nat := + case l of { + | x :: _ := x + | nil := id + } + (let + y : Nat → Nat := id; + in (let + z : (Nat → Nat) → Nat → Nat := id; + in case l of { + | _ :: _ := id + | _ := id + } + z) + y) + 7; + +main : Nat := f (λ {| x y := x y + 2} :: nil); diff --git a/tests/Casm/Compilation/positive/test038.juvix b/tests/Casm/Compilation/positive/test038.juvix new file mode 100644 index 000000000..56d57bbe3 --- /dev/null +++ b/tests/Casm/Compilation/positive/test038.juvix @@ -0,0 +1,11 @@ +-- Simple case expression +module test038; + +import Stdlib.Prelude open; + +main : Nat := + case 1, 2 of { + | suc _, zero := 0 + | suc _, suc x := x + | _ := 19 + }; diff --git a/tests/Casm/Compilation/positive/test039.juvix b/tests/Casm/Compilation/positive/test039.juvix new file mode 100644 index 000000000..76d471bd2 --- /dev/null +++ b/tests/Casm/Compilation/positive/test039.juvix @@ -0,0 +1,17 @@ +-- Mutually recursive let expressions +module test039; + +import Stdlib.Prelude open; + +main : Nat := + let + Ty : Type := Nat; + odd : _ + | zero := false + | (suc n) := not (even n); + unused : _ := 123; + even : _ + | zero := true + | (suc n) := not (odd n); + plusOne (n : Ty) : Ty := n + 1; + in if (odd (plusOne 13)) 1 0 + if (even (plusOne 12)) 1 0; diff --git a/tests/Casm/Compilation/positive/test040.juvix b/tests/Casm/Compilation/positive/test040.juvix new file mode 100644 index 000000000..2d5fb89f2 --- /dev/null +++ b/tests/Casm/Compilation/positive/test040.juvix @@ -0,0 +1,17 @@ +-- pattern matching nullary constructor +module test040; + +import Stdlib.System.IO open; +import Stdlib.Data.Bool open; +import Stdlib.Data.Nat open; + +type Unit := + | unit : Unit; + +type Foo (A : Type) := + | foo : Unit -> A -> Foo A; + +f : {A : Type} -> Foo A -> A + | (foo unit a) := a; + +main : Nat := if (f (foo unit true)) 1 0; diff --git a/tests/Casm/Compilation/positive/test045.juvix b/tests/Casm/Compilation/positive/test045.juvix new file mode 100644 index 000000000..2768de61d --- /dev/null +++ b/tests/Casm/Compilation/positive/test045.juvix @@ -0,0 +1,19 @@ +-- implicit builtin bool +-- Builtin nat requires builtin bool when translated to integers, because +-- matching is translated to comparison operators and cases on booleans. +module test045; + +builtin nat +type Nat := + | zero : Nat + | suc : Nat → Nat; + +syntax fixity additive := binary {assoc := left}; + +syntax operator + additive; + ++ : Nat → Nat → Nat + | zero b := b + | (suc a) b := suc (a + b); + +main : Nat := suc zero + suc (suc (suc zero)); diff --git a/tests/Casm/Compilation/positive/test046.juvix b/tests/Casm/Compilation/positive/test046.juvix new file mode 100644 index 000000000..ff692742f --- /dev/null +++ b/tests/Casm/Compilation/positive/test046.juvix @@ -0,0 +1,17 @@ +-- polymorphic type arguments +module test046; + +import Stdlib.Data.Nat open; +import Stdlib.Function open; + +Ty : Type := {B : Type} -> B -> B; + +id' : Ty + | {_} x := x; + +-- In PR https://github.com/anoma/juvix/pull/2545 we had to slightly modify +-- the `fun` definition. The previous version is kept here as a comment. +-- fun : {A : Type} → A → Ty := id λ {_ := id'}; +fun {A : Type} : A → Ty := id { _ -> {C : Type} → C → C } λ {_ := id'}; + +main : Nat := fun 5 {Nat} 7; diff --git a/tests/Casm/Compilation/positive/test047.juvix b/tests/Casm/Compilation/positive/test047.juvix new file mode 100644 index 000000000..90ee620a6 --- /dev/null +++ b/tests/Casm/Compilation/positive/test047.juvix @@ -0,0 +1,43 @@ +-- local modules +module test047; + +import Stdlib.Prelude open; + +module Local; + t : Nat := 2; + + module Nested; + t : Nat := 3; + + -- module shadowing + module Nested; + t : Nat := 5; + end; + + module Nested2; + t : Nat := 7; + + -- module shadowing + module Nested; + t : Nat := 11; + end; + end; + end; +end; + +open Local; + +module Public; + open Nested public; +end; + +tt : Nat := t; + +x : Nat := + t + * Local.t + * Local.Nested.t + * Nested.Nested2.Nested.t + * Public.Nested.t; + +main : Nat := x; diff --git a/tests/Casm/Compilation/positive/test050.juvix b/tests/Casm/Compilation/positive/test050.juvix new file mode 100644 index 000000000..0543155f0 --- /dev/null +++ b/tests/Casm/Compilation/positive/test050.juvix @@ -0,0 +1,11 @@ +-- Pattern matching with integers +module test050; + +import Stdlib.Prelude open; + +f : Int -> Int + | (negSuc zero) := ofNat 0 + | (negSuc m@(suc n)) := ofNat n + ofNat m + | (ofNat n) := neg (ofNat n - ofNat 7); + +main : Int := f -10 - f 1 + f -1; diff --git a/tests/Casm/Compilation/positive/test053.juvix b/tests/Casm/Compilation/positive/test053.juvix new file mode 100644 index 000000000..ef4dbfc0f --- /dev/null +++ b/tests/Casm/Compilation/positive/test053.juvix @@ -0,0 +1,36 @@ +-- Inlining +module test053; + +import Stdlib.Prelude open; + +{-# inline: 2 #-} +mycompose : {A B C : Type} -> (B -> C) -> (A -> B) -> A -> C + | f g x := f (g x); + +{-# inline: true #-} +myconst : {A B : Type} -> A -> B -> A + | x _ := x; + +{-# inline: 1 #-} +myflip : {A B C : Type} -> (A -> B -> C) -> B -> A -> C + | f b a := f a b; + +rumpa : {A : Type} -> (A -> A) -> A -> A + | {A} f a := + let + {-# inline: 1 #-} + go : Nat -> A -> A + | zero a := a + | (suc _) a := f a; + + {-# inline: false #-} + h (g : A -> A) : A := g a; + in h (go 10); + +main : Nat := + let + f : Nat -> Nat := mycompose λ {x := x + 1} λ {x := x * 2}; + g : Nat -> Nat -> Nat := myflip myconst; + {-# inline: false #-} + myid : Nat -> Nat := λ {x := x}; + in myid (f 3 + g 7 9 + rumpa myid 5); diff --git a/tests/Casm/Compilation/positive/test054.juvix b/tests/Casm/Compilation/positive/test054.juvix new file mode 100644 index 000000000..aae917428 --- /dev/null +++ b/tests/Casm/Compilation/positive/test054.juvix @@ -0,0 +1,59 @@ +-- Iterators +module test054; + +import Stdlib.Prelude open; + +syntax iterator myfor; +myfor : {A B : Type} → (A → B → A) → A → List B → A := + foldl {_} {_}; + +syntax iterator mymap {init := 0}; +mymap : {A B : Type} → (A → B) → List A → List B + | f nil := nil + | f (x :: xs) := f x :: mymap f xs; + +sum : List Nat → Nat + | xs := myfor (acc := 0) (x in xs) {acc + x}; + +sum' : List Nat → Nat + | xs := myfor λ {acc x := acc + x} 0 xs; + +lst : List Nat := 1 :: 2 :: 3 :: 4 :: 5 :: nil; + +syntax iterator myfor2 {init := 1; range := 2}; +myfor2 + : {A B C : Type} + → (A → B → C → A) + → A + → List B + → List C + → A + | f acc xs ys := + myfor (acc' := acc) (x in xs) + myfor (acc'' := acc') (y in ys) + f acc'' x y; + +syntax iterator myzip2 {init := 2; range := 2}; +myzip2 + : {A A' B C : Type} + → (A → A' → B → C → A × A') + → A + → A' + → List B + → List C + → A × A' + | f a b xs ys := + myfor (acc, acc' := a, b) (x, y in zip xs ys) + f acc acc' x y; + +main : Nat := + sum lst + + sum' lst + + fst (myfor (a, b := 0, 0) (x in lst) b + x, a) + + (myfor2 (acc := 0) (x in lst; y in 1 :: 2 :: nil) + acc + x + y) + + fst + (myzip2 (a := 0; b := 0) (x in lst; y in reverse lst) + a + x * y, b + y) + + myfor (a := 0) (x, y in mymap (x in lst) {x, x + 1}) + a + x * y; diff --git a/tests/Casm/Compilation/positive/test056.juvix b/tests/Casm/Compilation/positive/test056.juvix new file mode 100644 index 000000000..2981ae3b5 --- /dev/null +++ b/tests/Casm/Compilation/positive/test056.juvix @@ -0,0 +1,71 @@ +-- argument specialization +module test056; + +import Stdlib.Prelude open; + +{-# specialize: [f] #-} +mymap {A B} (f : A -> B) : List A -> List B + | nil := nil + | (x :: xs) := f x :: mymap f xs; + +{-# specialize: [2, 5], inline: false #-} +myf + : {A B : Type} + -> A + -> (A -> A -> B) + -> A + -> B + -> Bool + -> B + | a0 f a b true := f a0 a + | a0 f a b false := b; + +{-# inline: false #-} +myf' + : {A B : Type} -> A -> (A -> A -> A -> B) -> A -> B -> B + | a0 f a b := myf a0 (f a0) a b true; + +sum : List Nat -> Nat + | xs := for (acc := 0) (x in xs) {x + acc}; + +funa : {A : Type} -> (A -> A) -> A -> A + | {A} f a := + let + {-# specialize-by: [f] #-} + go : Nat -> A + | zero := a + | (suc n) := f (go n); + in go 10; + +{-# specialize: true #-} +type Additive A := mkAdditive {add : A -> A -> A}; + +type Multiplicative A := + mkMultiplicative {mul : A -> A -> A}; + +addNat : Additive Nat := mkAdditive (+); + +{-# specialize: true #-} +mulNat : Multiplicative Nat := mkMultiplicative (*); + +{-# inline: false #-} +fadd {A} (a : Additive A) (x y : A) : A := + Additive.add a x y; + +{-# inline: false #-} +fmul {A} (m : Multiplicative A) (x y : A) : A := + Multiplicative.mul m x y; + +main : Nat := + sum (mymap λ {x := x + 3} (1 :: 2 :: 3 :: 4 :: nil)) + + sum + (flatten + (mymap + (mymap λ {x := x + 2}) + ((1 :: nil) :: (2 :: 3 :: nil) :: nil))) + + myf 3 (*) 2 5 true + + myf 1 (+) 2 0 false + + myf' 7 (const (+)) 2 0 + + funa ((+) 1) 5 + + fadd addNat 1 2 + + fmul mulNat 1 2; diff --git a/tests/Casm/Compilation/positive/test057.juvix b/tests/Casm/Compilation/positive/test057.juvix new file mode 100644 index 000000000..978c2eefa --- /dev/null +++ b/tests/Casm/Compilation/positive/test057.juvix @@ -0,0 +1,13 @@ +-- case folding +module test057; + +import Stdlib.Prelude open; + +myfun : {A : Type} -> (A -> A -> A) -> A -> List A -> A + | f x xs := + case x :: xs + | nil := x + | y :: nil := y + | y :: z :: _ := f y z; + +main : Nat := myfun (+) 1 (7 :: 3 :: nil); diff --git a/tests/Casm/Compilation/positive/test058.juvix b/tests/Casm/Compilation/positive/test058.juvix new file mode 100644 index 000000000..662cdcd3f --- /dev/null +++ b/tests/Casm/Compilation/positive/test058.juvix @@ -0,0 +1,13 @@ +-- ranges +module test058; + +import Stdlib.Prelude open hiding {for}; +import Stdlib.Data.Range open; + +sum (x : Nat) : Nat := + for (acc := 0) (n in 1 to x) {acc + n}; + +sum' (x : Nat) : Nat := + for (acc := 0) (n in 1 to x step 2) {acc + n}; + +main : Nat := sum 100 + sum' 100; diff --git a/tests/Casm/Compilation/positive/test059.juvix b/tests/Casm/Compilation/positive/test059.juvix new file mode 100644 index 000000000..03a5be832 --- /dev/null +++ b/tests/Casm/Compilation/positive/test059.juvix @@ -0,0 +1,15 @@ +-- builtin list +module test059; + +import Stdlib.Prelude open hiding {head}; + +mylist : List Nat := [1; 2; 3 + 1]; + +mylist2 : List (List Nat) := [[10]; [2]; 3 + 1 :: nil]; + +head : {a : Type} -> a -> List a -> a + | a [] := a + | a [x; _] := x + | _ (h :: _) := h; + +main : Nat := head 50 mylist + head 50 (head [] mylist2); diff --git a/tests/Casm/Compilation/positive/test060.juvix b/tests/Casm/Compilation/positive/test060.juvix new file mode 100644 index 000000000..6e306a394 --- /dev/null +++ b/tests/Casm/Compilation/positive/test060.juvix @@ -0,0 +1,48 @@ +-- record updates and record patterns +module test060; + +import Stdlib.Prelude open hiding {fst}; + +type Triple (A B C : Type) := + mkTriple { + fst : A; + snd : B; + thd : C + }; + +type Pair (A B : Type) := + mkPair { + fst : A; + snd : B + }; + +sum : Triple Nat Nat Nat → Nat + | mkTriple@{fst; snd; thd} := fst + snd + thd; + +mf : Pair (Pair Bool (List Nat)) (List Nat) → Bool + | mkPair@{fst := mkPair@{fst; snd := nil}; + snd := zero :: _} := fst + | x := case x of {_ := false}; + +main : Nat := + let + p : Triple Nat Nat Nat := mkTriple 2 2 2; + p' : Triple Nat Nat Nat := + p@Triple{ + fst := fst + 1; + snd := snd * 3 + thd + fst + }; + f : Triple Nat Nat Nat -> Triple Nat Nat Nat := + (@Triple{fst := fst * 10}); + in sum $ if + (mf + mkPair@{ + fst := mkPair true nil; + snd := 0 :: nil + }) + (f p') + mkTriple@{ + fst := 0; + thd := 0; + snd := 0 + }; diff --git a/tests/Casm/Compilation/positive/test062.juvix b/tests/Casm/Compilation/positive/test062.juvix new file mode 100644 index 000000000..bc3f65a0b --- /dev/null +++ b/tests/Casm/Compilation/positive/test062.juvix @@ -0,0 +1,12 @@ +-- Overapplication +module test062; + +import Stdlib.Data.Nat open; + +{-# inline: false #-} +I {A} (x : A) : A := x; + +{-# inline: false #-} +I' {A} (x : A) : A := x; + +main : Nat := I' (I I I I 1); diff --git a/tests/Casm/Compilation/positive/test064.juvix b/tests/Casm/Compilation/positive/test064.juvix new file mode 100644 index 000000000..c3674c273 --- /dev/null +++ b/tests/Casm/Compilation/positive/test064.juvix @@ -0,0 +1,42 @@ +-- Constant folding +module test064; + +import Stdlib.Prelude open; +import Stdlib.Debug.Fail as Debug; + +{-# inline: false #-} +f (x y : Nat) : Nat := x + y; + +{-# inline: false #-} +g (x : Bool) : Bool := if x false true; + +{-# inline: false #-} +h (x : Bool) : Bool := if (g x) false true; + +{-# inline: false, eval: false #-} +j (x : Nat) : Nat := x + 0; + +sum : Nat -> Nat + | zero := 0 + | k@(suc n) := k + sum n; + +even : Nat -> Bool + | zero := true + | (suc n) := odd n; + +odd : Nat -> Bool + | zero := false + | (suc n) := even n; + +terminating +loop : Nat := loop; + +{-# inline: false #-} +even' : Nat -> Bool := even; + +main : Nat := + sum 3 + + case even' 6 || g true || h true of { + | true := if (g false) (f 1 2 + sum 7 + j 0) 0 + | false := f (3 + 4) (f 0 8) + loop + }; diff --git a/tests/Casm/Compilation/positive/test065.juvix b/tests/Casm/Compilation/positive/test065.juvix new file mode 100644 index 000000000..29bc0b2fb --- /dev/null +++ b/tests/Casm/Compilation/positive/test065.juvix @@ -0,0 +1,15 @@ +-- Arithmetic simplification +module test065; + +import Stdlib.Prelude open; + +{-# inline: false #-} +f (x : Int) : Int := + (x + fromNat 1 - fromNat 1) * fromNat 1 + + fromNat 0 * x + + (fromNat 10 + (x - fromNat 10)) + + (fromNat 10 + x - fromNat 10) + + (fromNat 11 + (fromNat 11 - x)) + + fromNat 1 * x * fromNat 0 * fromNat 1; + +main : Int := f (fromNat 10); diff --git a/tests/Casm/Compilation/positive/test066/M.juvix b/tests/Casm/Compilation/positive/test066/M.juvix new file mode 100644 index 000000000..8d1f10f57 --- /dev/null +++ b/tests/Casm/Compilation/positive/test066/M.juvix @@ -0,0 +1,6 @@ +module M; + +import Stdlib.Prelude open; +import N open; + +main : Nat := f; diff --git a/tests/Casm/Compilation/positive/test066/N.juvix b/tests/Casm/Compilation/positive/test066/N.juvix new file mode 100644 index 000000000..e23c0ca29 --- /dev/null +++ b/tests/Casm/Compilation/positive/test066/N.juvix @@ -0,0 +1,7 @@ +module N; + +import Stdlib.Prelude open; + +mkNat (n : Nat) : Nat := n; + +f {a : Nat := mkNat 0} : Nat := a; diff --git a/tests/Casm/Compilation/positive/test066/Package.juvix b/tests/Casm/Compilation/positive/test066/Package.juvix new file mode 100644 index 000000000..5b60fc4da --- /dev/null +++ b/tests/Casm/Compilation/positive/test066/Package.juvix @@ -0,0 +1,5 @@ +module Package; + +import PackageDescription.Basic open; + +package : Package := basicPackage; diff --git a/tests/Casm/Compilation/positive/test067.juvix b/tests/Casm/Compilation/positive/test067.juvix new file mode 100644 index 000000000..c9fb065f9 --- /dev/null +++ b/tests/Casm/Compilation/positive/test067.juvix @@ -0,0 +1,8 @@ +-- Default values inserted in the translation FromConcrete +module test067; + +import Stdlib.Data.Nat open; + +f {a : Nat := 2} {b : Nat := a + 1} {c : Nat} : Nat := a * b * c; + +main : Nat := f {c := 5}; diff --git a/tests/Casm/Compilation/positive/test068.juvix b/tests/Casm/Compilation/positive/test068.juvix new file mode 100644 index 000000000..44cc2b7ff --- /dev/null +++ b/tests/Casm/Compilation/positive/test068.juvix @@ -0,0 +1,9 @@ +-- Default values inserted in the arity checker +module test068; + +import Stdlib.Data.Nat open; + +f {a : Nat := 2} {b : Nat := 3} {c : Nat := 5} : Nat := + a * b * c; + +main : Nat := f; diff --git a/tests/Casm/Compilation/positive/test069.juvix b/tests/Casm/Compilation/positive/test069.juvix new file mode 100644 index 000000000..ac9dda3ab --- /dev/null +++ b/tests/Casm/Compilation/positive/test069.juvix @@ -0,0 +1,31 @@ +-- Default values inserted in the arity checker +module test069; + +import Stdlib.Data.Nat open hiding {Ord; mkOrd}; +import Stdlib.Data.Nat.Ord as Ord; +import Stdlib.Data.Product as Ord; +import Stdlib.Data.Bool.Base open; +import Stdlib.Trait.Ord open using {Ordering; LT; EQ; GT; isLT; isGT}; + +trait +type Ord A := + mkOrd { + cmp : A -> A -> Ordering; + lt : A -> A -> Bool; + ge : A -> A -> Bool + }; + +mkOrdHelper + {A} + (cmp : A -> A -> Ordering) + {lt : A -> A -> Bool := λ {a b := isLT (cmp a b)}} + {gt : A -> A -> Bool := λ {a b := isGT (cmp a b)}} + : Ord A := + mkOrd cmp lt gt; + +ordNatNamed : Ord Nat := mkOrdHelper (cmp := Ord.compare); + +instance +ordNat : Ord Nat := mkOrdHelper Ord.compare; + +main : Nat := if (Ord.lt 1 2) 1 0; diff --git a/tests/Casm/Compilation/positive/test070.juvix b/tests/Casm/Compilation/positive/test070.juvix new file mode 100644 index 000000000..171cf12e8 --- /dev/null +++ b/tests/Casm/Compilation/positive/test070.juvix @@ -0,0 +1,10 @@ +-- Nested named application with default values +module test070; + +import Stdlib.Data.Nat open; + +fun {a : Nat := 1} {b : Nat := a + 1} {c : Nat := b + a + 1} + : Nat := a * b + c; + +main : Nat := + fun {a := fun; b := fun {b := 3} * fun {b := fun {2}}}; diff --git a/tests/Casm/Compilation/positive/test071.juvix b/tests/Casm/Compilation/positive/test071.juvix new file mode 100644 index 000000000..84f4d5100 --- /dev/null +++ b/tests/Casm/Compilation/positive/test071.juvix @@ -0,0 +1,43 @@ +-- Named application +module test071; + +import Stdlib.Data.Nat open hiding {Ord; mkOrd}; +import Stdlib.Data.Nat.Ord as Ord; +import Stdlib.Data.Product as Ord; +import Stdlib.Data.Bool.Base open; +import Stdlib.Trait.Ord open using {Ordering; LT; EQ; GT; isLT; isGT}; + +trait +type Ord A := + mkOrd { + cmp : A -> A -> Ordering; + lt : A -> A -> Bool; + ge : A -> A -> Bool + }; + +mkOrdHelper + {A} + (cmp : A -> A -> Ordering) + {lt : A -> A -> Bool := λ {a b := isLT (cmp a b)}} + {gt : A -> A -> Bool := λ {a b := isGT (cmp a b)}} + : Ord A := + mkOrd cmp lt gt; + +instance +ordNat : Ord Nat := mkOrdHelper@{ + cmp (x y : Nat) : Ordering := Ord.compare x y +}; + +fun {a : Nat := 1} {b : Nat := a + 1} {c : Nat := b + a + 1} + : Nat := a * b + c; + +f {a : Nat := 2} {b : Nat := a + 1} {c : Nat} : Nat := a * b * c; + +g {a : Nat := 2} {b : Nat := a + 1} (c : Nat) : Nat := a * b * c; + +h {a : Nat := 2} (b c : Nat) {d : Nat := 3} : Nat := a * b + c * d; + +main : Nat := + fun@{a := fun; b := fun@{b := 3} * fun@{b := fun {2}}} + + f@{c := 5} + g@?{b := 4} 3 + if (Ord.lt 1 0) 1 0 + + h@?{b := 4} 1; diff --git a/tests/Casm/Compilation/positive/test072/Functor.juvix b/tests/Casm/Compilation/positive/test072/Functor.juvix new file mode 100644 index 000000000..76f31dbb8 --- /dev/null +++ b/tests/Casm/Compilation/positive/test072/Functor.juvix @@ -0,0 +1,10 @@ +module Functor; + +syntax fixity fmap := binary {assoc := left}; + +trait +type Functor (f : Type -> Type) := + mkFunctor { + syntax operator <$> fmap; + <$> : {A B : Type} -> (A -> B) -> f A -> f B + }; diff --git a/tests/Casm/Compilation/positive/test072/Identity.juvix b/tests/Casm/Compilation/positive/test072/Identity.juvix new file mode 100644 index 000000000..1d84c8fad --- /dev/null +++ b/tests/Casm/Compilation/positive/test072/Identity.juvix @@ -0,0 +1,25 @@ +module Identity; + +import Monad open; +import Functor open; + +type Identity (a : Type) := mkIdentity {runIdentity : a}; + +open Identity public; + +instance +Identity-Functor : Functor Identity := + mkFunctor@{ + <$> {A B : Type} (f : A -> B) : Identity A -> Identity B + | (mkIdentity a) := mkIdentity (f a) + }; + +instance +Identity-Monad : Monad Identity := + mkMonad@{ + functor := Identity-Functor; + return {A : Type} (a : A) : Identity A := mkIdentity a; + >>= {A B : Type} + : Identity A -> (A -> Identity B) -> Identity B + | (mkIdentity a) f := f a + }; diff --git a/tests/Casm/Compilation/positive/test072/Monad.juvix b/tests/Casm/Compilation/positive/test072/Monad.juvix new file mode 100644 index 000000000..81a4dfb96 --- /dev/null +++ b/tests/Casm/Compilation/positive/test072/Monad.juvix @@ -0,0 +1,21 @@ +module Monad; + +import Functor open; +import Stdlib.Data.Fixity open; + +syntax fixity bind := binary {assoc := left}; + +trait +type Monad (f : Type -> Type) := + mkMonad { + functor : Functor f; + return : {A : Type} -> A -> f A; + syntax operator >>= bind; + >>= : {A B : Type} -> f A -> (A -> f B) -> f B + }; + +open Monad public; + +syntax operator >> bind; +>> {M : Type → Type} {A B : Type} {{Monad M}} (x : M + A) (y : M B) : M B := x >>= λ {_ := y}; diff --git a/tests/Casm/Compilation/positive/test072/MonadReader.juvix b/tests/Casm/Compilation/positive/test072/MonadReader.juvix new file mode 100644 index 000000000..8aeda8fd8 --- /dev/null +++ b/tests/Casm/Compilation/positive/test072/MonadReader.juvix @@ -0,0 +1,14 @@ +module MonadReader; + +import Monad open; +import Stdlib.Data.Unit open; + +trait +type MonadReader (S : Type) (M : Type -> Type) := + mkMonadReader { + monad : Monad M; + ask : M S; + reader : {A : Type} → (S → A) → M A + }; + +open MonadReader public; diff --git a/tests/Casm/Compilation/positive/test072/MonadState.juvix b/tests/Casm/Compilation/positive/test072/MonadState.juvix new file mode 100644 index 000000000..fc9eb31de --- /dev/null +++ b/tests/Casm/Compilation/positive/test072/MonadState.juvix @@ -0,0 +1,18 @@ +module MonadState; + +import Monad open; +import Stdlib.Data.Unit open; + +trait +type MonadState (S : Type) (M : Type -> Type) := + mkMonadState { + monad : Monad M; + get : M S; + put : S -> M Unit + }; + +open MonadState public; + +modify {S : Type} {M : Type → Type} {{Monad M}} {{MonadState + S + M}} (f : S → S) : M Unit := get >>= λ {s := put (f s)}; diff --git a/tests/Casm/Compilation/positive/test072/Package.juvix b/tests/Casm/Compilation/positive/test072/Package.juvix new file mode 100644 index 000000000..d86c37598 --- /dev/null +++ b/tests/Casm/Compilation/positive/test072/Package.juvix @@ -0,0 +1,5 @@ +module Package; + +import PackageDescription.V2 open; + +package : Package := defaultPackage {name := "monads"}; diff --git a/tests/Casm/Compilation/positive/test072/Reader.juvix b/tests/Casm/Compilation/positive/test072/Reader.juvix new file mode 100644 index 000000000..7e89040ff --- /dev/null +++ b/tests/Casm/Compilation/positive/test072/Reader.juvix @@ -0,0 +1,28 @@ +module Reader; + +import Monad open; +import Functor open; +import Stdlib.Function open; + +type Reader (r a : Type) := mkReader {runReader : r -> a}; + +instance +Reader-Functor {R : Type} : Functor (Reader R) := + mkFunctor@{ + <$> {A B : Type} (f : A -> B) : Reader R A -> Reader R B + | (mkReader ra) := mkReader (f ∘ ra) + }; + +instance +Reader-Monad {R : Type} : Monad (Reader R) := + mkMonad@{ + functor := Reader-Functor; + return {A : Type} (a : A) : Reader R A := + mkReader (const a); + >>= {A B : Type} + : Reader R A -> (A -> Reader R B) -> Reader R B + | (mkReader ra) arb := + let + open Reader; + in mkReader λ {r := runReader (arb (ra r)) r} + }; diff --git a/tests/Casm/Compilation/positive/test072/ReaderT.juvix b/tests/Casm/Compilation/positive/test072/ReaderT.juvix new file mode 100644 index 000000000..95d4d7d3d --- /dev/null +++ b/tests/Casm/Compilation/positive/test072/ReaderT.juvix @@ -0,0 +1,92 @@ +module ReaderT; + +import Monad open; +import Monad open using {module Monad as MMonad}; +import Functor open; +import Functor open using {module Functor as MFunctor}; + +type ReaderT (S : Type) (M : Type → Type) (A : Type) := + mkReaderT {runReaderT : S → M A}; + +runReader {S A : Type} {M : Type + → Type} (r : S) (m : ReaderT S M A) : M A := + ReaderT.runReaderT m r; + +instance +ReaderT-Functor {S : Type} {M : Type + → Type} {{func : Functor M}} : Functor (ReaderT S M) := + mkFunctor@{ + <$> {A B : Type} (f : A → B) + : ReaderT S M A → ReaderT S M B + | (mkReaderT g) := + -- NOTE we cannot use unqualified <$> or the scoper gets confused + let + open MFunctor; + in mkReaderT λ {s := λ {a := f a} MFunctor.<$> g s} + }; + +instance +ReaderT-Monad {S : Type} {M : Type → Type} {{mon : Monad M}} + : Monad (ReaderT S M) := + mkMonad@{ + functor := + ReaderT-Functor@{ + func := MMonad.functor + }; + return {A : Type} (a : A) : ReaderT S M A := + mkReaderT λ {s := MMonad.return a}; + >>= {A B : Type} (x : ReaderT S M A) (f : A → ReaderT S M B) + : ReaderT S M B := + mkReaderT + λ {s := runReader s x MMonad.>>= λ {a := runReader s (f a)}} + }; + +import MonadReader open; +import Stdlib.Data.Unit open; +import Stdlib.Function open; + +instance +ReaderT-MonadReader {S : Type} {M : Type → Type} {{Monad M}} + : MonadReader S (ReaderT S M) := + mkMonadReader@{ + monad := ReaderT-Monad; + ask : ReaderT S M S := mkReaderT λ {s := MMonad.return s}; + reader {A : Type} (f : S → A) : ReaderT S M A := + mkReaderT (MMonad.return ∘ f) + }; + +import MonadState open; +import StateT open; +import Identity open; +import Stdlib.Data.Product open; + +liftReaderT {R A : Type} {M : Type → Type} (m : M A) + : ReaderT R M A := mkReaderT (const m); + +liftStateT {S A : Type} {M : Type → Type} {{Monad M}} (m : M + A) : StateT S M A := + mkStateT + λ {s := m MMonad.>>= λ {a := MMonad.return (a, s)}}; + +import Stdlib.Data.Nat open; + +askNat {M : Type → Type} {{Monad M}} : ReaderT Nat M Nat := + ask; + +monadic : ReaderT Nat (StateT Nat Identity) Nat := + askNat + >>= λ {n := + liftReaderT (modify λ {m := m * n}) >> liftReaderT get}; + +main : Nat := + runIdentity (evalState 2 (runReader 5 monadic)); + +-- FIXME fails instance termination +-- instance +-- StateT-MonadReader {R S : Type} {M : Type +-- → Type} {{mreader : MonadReader R M}} : MonadReader R (StateT S M) := +-- mkMonadReader@{ +-- monad := StateT-Monad@{mon := MonadReader.monad {{mreader}}}; +-- reader {A : Type} : (R → A) → StateT S M A := liftStateT ∘ MonadReader.reader; +-- ask : StateT S M R := liftStateT MonadReader.ask; +-- }; diff --git a/tests/Casm/Compilation/positive/test072/State.juvix b/tests/Casm/Compilation/positive/test072/State.juvix new file mode 100644 index 000000000..2e7fadc12 --- /dev/null +++ b/tests/Casm/Compilation/positive/test072/State.juvix @@ -0,0 +1,42 @@ +module State; + +import Monad open; +import Functor open; +import Stdlib.Data.Product open; + +type State (S A : Type) := mkState {runState : S -> A × S}; + +instance +State-Functor {S : Type} : Functor (State S) := + mkFunctor@{ + <$> {A B : Type} (f : A -> B) : State S A -> State S B + | (mkState S→A×S) := + mkState λ {s := case S→A×S s of {a, s := f a, s}} + }; + +instance +State-Monad {S : Type} : Monad (State S) := + mkMonad@{ + functor := State-Functor; + return {A : Type} (a : A) : State S A := + mkState λ {s := a, s}; + >>= {A B : Type} + : State S A -> (A -> State S B) -> State S B + | (mkState s→s×a) a→Ss×b := + mkState + λ {s := + case s→s×a s of { + a, s1 := case a→Ss×b a of {mkState s→s×b := s→s×b s1} + }} + }; + +import MonadState open; +import Stdlib.Data.Unit open; + +instance +State-MonadState {S : Type} : MonadState S (State S) := + mkMonadState@{ + monad := State-Monad; + get : State S S := mkState λ {s := s, s}; + put (s : S) : State S Unit := mkState λ {_ := unit, s} + }; diff --git a/tests/Casm/Compilation/positive/test072/StateT.juvix b/tests/Casm/Compilation/positive/test072/StateT.juvix new file mode 100644 index 000000000..f804233f3 --- /dev/null +++ b/tests/Casm/Compilation/positive/test072/StateT.juvix @@ -0,0 +1,63 @@ +module StateT; + +import Monad open; +import Monad open using {module Monad as MMonad}; +import Functor open; +import Functor open using {module Functor as MFunctor}; +import Stdlib.Data.Product open; + +type StateT (S : Type) (M : Type → Type) (A : Type) := + mkStateT {runStateT : S → M (A × S)}; + +runState {S A : Type} {M : Type → Type} (s : S) (m : StateT + S + M + A) : M (A × S) := StateT.runStateT m s; + +evalState {S A : Type} {M : Type → Type} {{Functor + M}} (s : S) (m : StateT S M A) : M A := + fst Functor.<$> runState s m; + +instance +StateT-Functor {S : Type} {M : Type → Type} {{func : Functor + M}} : Functor (StateT S M) := + mkFunctor@{ + <$> {A B : Type} (f : A → B) : StateT S M A → StateT S M B + | (mkStateT S→M⟨A×S⟩) := + let + open MFunctor; + in mkStateT + λ {s := λ {(a, s') := f a, s'} MFunctor.<$> S→M⟨A×S⟩ s} + }; + +instance +StateT-Monad {S : Type} {M : Type → Type} {{mon : Monad M}} + : Monad (StateT S M) := + mkMonad@{ + functor := + StateT-Functor@{ + func := MMonad.functor + }; + return {A : Type} (a : A) : StateT S M A := + mkStateT λ {s := MMonad.return (a, s)}; + >>= {A B : Type} (x : StateT S M A) (f : A → StateT S M B) + : StateT S M B := + mkStateT + λ {s := + StateT.runStateT x s + MMonad.>>= λ {(a, s') := StateT.runStateT (f a) s'}} + }; + +import MonadState open; +import Stdlib.Data.Unit open; + +instance +StateT-MonadState {S : Type} {M : Type → Type} {{Monad M}} + : MonadState S (StateT S M) := + mkMonadState@{ + monad := StateT-Monad; + get : StateT S M S := + mkStateT λ {s := MMonad.return (s, s)}; + put (s : S) : StateT S M Unit := + mkStateT λ {_ := MMonad.return (unit, s)} + }; diff --git a/tests/Casm/Compilation/positive/test073/Package.juvix b/tests/Casm/Compilation/positive/test073/Package.juvix new file mode 100644 index 000000000..905b22a80 --- /dev/null +++ b/tests/Casm/Compilation/positive/test073/Package.juvix @@ -0,0 +1,5 @@ +module Package; + +import PackageDescription.V2 open; + +package : Package := defaultPackage {name := "test073"}; diff --git a/tests/Casm/Compilation/positive/test073/SyntaxAlias.juvix b/tests/Casm/Compilation/positive/test073/SyntaxAlias.juvix new file mode 100644 index 000000000..1231cd99f --- /dev/null +++ b/tests/Casm/Compilation/positive/test073/SyntaxAlias.juvix @@ -0,0 +1,5 @@ +module SyntaxAlias; + +import Stdlib.Prelude open; + +syntax alias MyNat := Nat; diff --git a/tests/Casm/Compilation/positive/test073/test073.juvix b/tests/Casm/Compilation/positive/test073/test073.juvix new file mode 100644 index 000000000..f314df5de --- /dev/null +++ b/tests/Casm/Compilation/positive/test073/test073.juvix @@ -0,0 +1,5 @@ +module test073; + +import SyntaxAlias open; + +main : MyNat := 11; diff --git a/tests/Casm/Compilation/positive/test074.juvix b/tests/Casm/Compilation/positive/test074.juvix new file mode 100644 index 000000000..25dace84d --- /dev/null +++ b/tests/Casm/Compilation/positive/test074.juvix @@ -0,0 +1,8 @@ +-- Fields +module test074; + +import Stdlib.Prelude open; + +f (x y : Field) : Field := 0 - (x + y * (1 / x)); + +main : Field := f 10 7; diff --git a/tests/Casm/Reg/positive/out/test001.out b/tests/Casm/Reg/positive/out/test001.out new file mode 100644 index 000000000..b4de39476 --- /dev/null +++ b/tests/Casm/Reg/positive/out/test001.out @@ -0,0 +1 @@ +11 diff --git a/tests/Casm/Reg/positive/out/test002.out b/tests/Casm/Reg/positive/out/test002.out new file mode 100644 index 000000000..b4de39476 --- /dev/null +++ b/tests/Casm/Reg/positive/out/test002.out @@ -0,0 +1 @@ +11 diff --git a/tests/Casm/Reg/positive/out/test003.out b/tests/Casm/Reg/positive/out/test003.out new file mode 100644 index 000000000..b4de39476 --- /dev/null +++ b/tests/Casm/Reg/positive/out/test003.out @@ -0,0 +1 @@ +11 diff --git a/tests/Casm/Reg/positive/out/test004.out b/tests/Casm/Reg/positive/out/test004.out new file mode 100644 index 000000000..b4de39476 --- /dev/null +++ b/tests/Casm/Reg/positive/out/test004.out @@ -0,0 +1 @@ +11 diff --git a/tests/Casm/Reg/positive/out/test008.out b/tests/Casm/Reg/positive/out/test008.out new file mode 100644 index 000000000..0cfbf0888 --- /dev/null +++ b/tests/Casm/Reg/positive/out/test008.out @@ -0,0 +1 @@ +2 diff --git a/tests/Casm/Reg/positive/out/test009.out b/tests/Casm/Reg/positive/out/test009.out new file mode 100644 index 000000000..1e8b31496 --- /dev/null +++ b/tests/Casm/Reg/positive/out/test009.out @@ -0,0 +1 @@ +6 diff --git a/tests/Casm/Reg/positive/out/test010.out b/tests/Casm/Reg/positive/out/test010.out new file mode 100644 index 000000000..837e12b40 --- /dev/null +++ b/tests/Casm/Reg/positive/out/test010.out @@ -0,0 +1 @@ +500500 diff --git a/tests/Casm/Reg/positive/out/test011.out b/tests/Casm/Reg/positive/out/test011.out new file mode 100644 index 000000000..bd6049b87 --- /dev/null +++ b/tests/Casm/Reg/positive/out/test011.out @@ -0,0 +1 @@ +483131020 diff --git a/tests/Casm/Reg/positive/out/test012.out b/tests/Casm/Reg/positive/out/test012.out new file mode 100644 index 000000000..425151f3a --- /dev/null +++ b/tests/Casm/Reg/positive/out/test012.out @@ -0,0 +1 @@ +40 diff --git a/tests/Casm/Reg/positive/out/test013.out b/tests/Casm/Reg/positive/out/test013.out new file mode 100644 index 000000000..89585cd31 --- /dev/null +++ b/tests/Casm/Reg/positive/out/test013.out @@ -0,0 +1 @@ +22356037 diff --git a/tests/Casm/Reg/positive/out/test014.out b/tests/Casm/Reg/positive/out/test014.out new file mode 100644 index 000000000..7579c8900 --- /dev/null +++ b/tests/Casm/Reg/positive/out/test014.out @@ -0,0 +1,156 @@ +1 +3 +2 +0 +0 +2 +0 +0 +2 +0 +0 +666 +2 +1 +3 +2 +1 +3 +2 +0 +0 +2 +0 +0 +2 +0 +0 +1 +3 +2 +0 +0 +2 +0 +0 +2 +0 +0 +2 +1 +3 +2 +0 +0 +2 +0 +0 +2 +0 +0 +1 +3 +2 +0 +0 +2 +0 +0 +2 +0 +0 +2 +1 +3 +2 +0 +0 +2 +0 +0 +2 +0 +0 +1 +3 +2 +0 +0 +2 +0 +0 +2 +0 +0 +1 +3 +2 +1 +3 +2 +0 +0 +2 +0 +0 +2 +0 +0 +1 +3 +2 +0 +0 +2 +0 +0 +2 +0 +0 +2 +1 +3 +2 +0 +0 +2 +0 +0 +2 +0 +0 +1 +3 +2 +0 +0 +2 +0 +0 +2 +0 +0 +2 +1 +3 +2 +0 +0 +2 +0 +0 +2 +0 +0 +1 +3 +2 +0 +0 +2 +0 +0 +2 +0 +0 +777 diff --git a/tests/Casm/Reg/positive/out/test015.out b/tests/Casm/Reg/positive/out/test015.out new file mode 100644 index 000000000..45a4fb75d --- /dev/null +++ b/tests/Casm/Reg/positive/out/test015.out @@ -0,0 +1 @@ +8 diff --git a/tests/Casm/Reg/positive/out/test016.out b/tests/Casm/Reg/positive/out/test016.out new file mode 100644 index 000000000..f5c89552b --- /dev/null +++ b/tests/Casm/Reg/positive/out/test016.out @@ -0,0 +1 @@ +32 diff --git a/tests/Casm/Reg/positive/out/test017.out b/tests/Casm/Reg/positive/out/test017.out new file mode 100644 index 000000000..a01f8275a --- /dev/null +++ b/tests/Casm/Reg/positive/out/test017.out @@ -0,0 +1 @@ +771 diff --git a/tests/Casm/Reg/positive/out/test018.out b/tests/Casm/Reg/positive/out/test018.out new file mode 100644 index 000000000..87523dd7a --- /dev/null +++ b/tests/Casm/Reg/positive/out/test018.out @@ -0,0 +1 @@ +41 diff --git a/tests/Casm/Reg/positive/out/test019.out b/tests/Casm/Reg/positive/out/test019.out new file mode 100644 index 000000000..c3f407c09 --- /dev/null +++ b/tests/Casm/Reg/positive/out/test019.out @@ -0,0 +1 @@ +55 diff --git a/tests/Casm/Reg/positive/out/test020.out b/tests/Casm/Reg/positive/out/test020.out new file mode 100644 index 000000000..837e12b40 --- /dev/null +++ b/tests/Casm/Reg/positive/out/test020.out @@ -0,0 +1 @@ +500500 diff --git a/tests/Casm/Reg/positive/out/test021.out b/tests/Casm/Reg/positive/out/test021.out new file mode 100644 index 000000000..b4de39476 --- /dev/null +++ b/tests/Casm/Reg/positive/out/test021.out @@ -0,0 +1 @@ +11 diff --git a/tests/Casm/Reg/positive/out/test023.out b/tests/Casm/Reg/positive/out/test023.out new file mode 100644 index 000000000..9c6f0c3e0 --- /dev/null +++ b/tests/Casm/Reg/positive/out/test023.out @@ -0,0 +1 @@ +364 diff --git a/tests/Casm/Reg/positive/out/test024.out b/tests/Casm/Reg/positive/out/test024.out new file mode 100644 index 000000000..b49e18fc4 --- /dev/null +++ b/tests/Casm/Reg/positive/out/test024.out @@ -0,0 +1,25 @@ +6 +4 +7 +9 +40 +6 +3 +7 +9 +30 +6 +2 +7 +9 +20 +6 +1 +7 +9 +10 +6 +0 +7 +666 +0 diff --git a/tests/Casm/Reg/positive/out/test026.out b/tests/Casm/Reg/positive/out/test026.out new file mode 100644 index 000000000..d6b24041c --- /dev/null +++ b/tests/Casm/Reg/positive/out/test026.out @@ -0,0 +1 @@ +19 diff --git a/tests/Casm/Reg/positive/out/test027.out b/tests/Casm/Reg/positive/out/test027.out new file mode 100644 index 000000000..350e63263 --- /dev/null +++ b/tests/Casm/Reg/positive/out/test027.out @@ -0,0 +1 @@ +48830320 diff --git a/tests/Casm/Reg/positive/out/test028.out b/tests/Casm/Reg/positive/out/test028.out new file mode 100644 index 000000000..c98c52b6a --- /dev/null +++ b/tests/Casm/Reg/positive/out/test028.out @@ -0,0 +1 @@ +1501500 diff --git a/tests/Casm/Reg/positive/out/test030.out b/tests/Casm/Reg/positive/out/test030.out new file mode 100644 index 000000000..6577aefcb --- /dev/null +++ b/tests/Casm/Reg/positive/out/test030.out @@ -0,0 +1 @@ +151636490 diff --git a/tests/Casm/Reg/positive/out/test031.out b/tests/Casm/Reg/positive/out/test031.out new file mode 100644 index 000000000..755f433b6 --- /dev/null +++ b/tests/Casm/Reg/positive/out/test031.out @@ -0,0 +1 @@ +10273 diff --git a/tests/Casm/Reg/positive/out/test033.out b/tests/Casm/Reg/positive/out/test033.out new file mode 100644 index 000000000..b34c321e9 --- /dev/null +++ b/tests/Casm/Reg/positive/out/test033.out @@ -0,0 +1 @@ +171 diff --git a/tests/Casm/Reg/positive/out/test034.out b/tests/Casm/Reg/positive/out/test034.out new file mode 100644 index 000000000..4f2946337 --- /dev/null +++ b/tests/Casm/Reg/positive/out/test034.out @@ -0,0 +1 @@ +2218 diff --git a/tests/Casm/Reg/positive/out/test036.out b/tests/Casm/Reg/positive/out/test036.out new file mode 100644 index 000000000..10b0c0dbc --- /dev/null +++ b/tests/Casm/Reg/positive/out/test036.out @@ -0,0 +1 @@ +264 diff --git a/tests/Casm/Reg/positive/out/test038.out b/tests/Casm/Reg/positive/out/test038.out new file mode 100644 index 000000000..7ed6ff82d --- /dev/null +++ b/tests/Casm/Reg/positive/out/test038.out @@ -0,0 +1 @@ +5 diff --git a/tests/Casm/Reg/positive/test001.jvr b/tests/Casm/Reg/positive/test001.jvr new file mode 100644 index 000000000..1abbd6baa --- /dev/null +++ b/tests/Casm/Reg/positive/test001.jvr @@ -0,0 +1,21 @@ + +function main() : *; + +function main() : * { + tmp[0] = 12; + tmp[1] = 5; + tmp[2] = 3; + tmp[3] = 2; + tmp[2] = mul tmp[3] tmp[2]; + tmp[1] = add tmp[2] tmp[1]; + tmp[2] = 15; + tmp[1] = sub tmp[2] tmp[1]; + tmp[2] = 9; + tmp[1] = div tmp[2] tmp[1]; + tmp[2] = 7; + tmp[1] = mul tmp[2] tmp[1]; + tmp[2] = 25; + tmp[1] = sub tmp[2] tmp[1]; + tmp[0] = mod tmp[1] tmp[0]; + ret tmp[0]; +} diff --git a/tests/Casm/Reg/positive/test002.jvr b/tests/Casm/Reg/positive/test002.jvr new file mode 100644 index 000000000..85af8ebd2 --- /dev/null +++ b/tests/Casm/Reg/positive/test002.jvr @@ -0,0 +1,20 @@ + +function calculate(integer, integer, integer) : integer; +function main() : *; + +function calculate(integer, integer, integer) : integer { + tmp[0] = arg[0]; + tmp[1] = arg[1]; + tmp[2] = arg[2]; + tmp[1] = mul tmp[2] tmp[1]; + tmp[0] = add tmp[1] tmp[0]; + ret tmp[0]; +} + +function main() : * { + tmp[0] = 2; + tmp[1] = 3; + tmp[2] = 5; + tmp[0] = call calculate (tmp[2], tmp[1], tmp[0]); + ret tmp[0]; +} diff --git a/tests/Casm/Reg/positive/test003.jvr b/tests/Casm/Reg/positive/test003.jvr new file mode 100644 index 000000000..9f585704c --- /dev/null +++ b/tests/Casm/Reg/positive/test003.jvr @@ -0,0 +1,22 @@ + +function calculate(integer, integer, integer) : integer; +function main() : *; + +function calculate(integer, integer, integer) : integer { + tmp[0] = arg[0]; + tmp[1] = arg[1]; + tmp[2] = arg[2]; + tmp[1] = mul tmp[2] tmp[1]; + tmp[0] = add tmp[1] tmp[0]; + ret tmp[0]; +} + +function main() : * { + prealloc 4; + tmp[0] = 2; + tmp[1] = 3; + tmp[2] = 5; + tmp[1] = calloc calculate (tmp[2], tmp[1]); + tmp[0] = call tmp[1] (tmp[0]); + ret tmp[0]; +} diff --git a/tests/Casm/Reg/positive/test004.jvr b/tests/Casm/Reg/positive/test004.jvr new file mode 100644 index 000000000..6483fcefa --- /dev/null +++ b/tests/Casm/Reg/positive/test004.jvr @@ -0,0 +1,36 @@ + +function multiply(integer, integer) : integer; +function plus(integer, integer) : integer; +function calculate(integer, integer, integer) : integer; +function main() : *; + +function multiply(integer, integer) : integer { + tmp[0] = arg[0]; + tmp[1] = arg[1]; + tmp[0] = mul tmp[1] tmp[0]; + ret tmp[0]; +} + +function plus(integer, integer) : integer { + tmp[0] = arg[0]; + tmp[1] = arg[1]; + tmp[0] = add tmp[1] tmp[0]; + ret tmp[0]; +} + +function calculate(integer, integer, integer) : integer { + tmp[0] = arg[0]; + tmp[1] = arg[1]; + tmp[2] = arg[2]; + tmp[1] = call multiply (tmp[2], tmp[1]), live: (tmp[0], arg[0], arg[1], arg[2]); + tcall plus (tmp[1], tmp[0]); +} + +function main() : * { + prealloc 4; + tmp[0] = 2; + tmp[1] = 3; + tmp[2] = 5; + tmp[1] = calloc calculate (tmp[2], tmp[1]); + tcall tmp[1] (tmp[0]); +} diff --git a/tests/Casm/Reg/positive/test008.jvr b/tests/Casm/Reg/positive/test008.jvr new file mode 100644 index 000000000..efd6facd3 --- /dev/null +++ b/tests/Casm/Reg/positive/test008.jvr @@ -0,0 +1,45 @@ +-- branch + +function loop() : *; +function main() : *; + +function loop() : * { + tcall loop (); +} + +function main() : * { + tmp[0] = 3; + tmp[1] = 0; + tmp[0] = lt tmp[1] tmp[0]; + br tmp[0], out: tmp[0] { + true: { + tmp[0] = 1; + }; + false: { + tmp[0] = call loop (); + }; + }; + tmp[1] = 1; + tmp[2] = 2; + tmp[1] = le tmp[2] tmp[1]; + br tmp[1], out: tmp[1] { + true: { + tmp[1] = call loop (), live: (tmp[0]); + }; + false: { + tmp[1] = 7; + tmp[2] = 8; + tmp[1] = le tmp[2] tmp[1]; + br tmp[1], out: tmp[1] { + true: { + tmp[1] = call loop (), live: (tmp[0]); + }; + false: { + tmp[1] = 1; + }; + }; + }; + }; + tmp[0] = add tmp[1] tmp[0]; + ret tmp[0]; +} diff --git a/tests/Casm/Reg/positive/test009.jvr b/tests/Casm/Reg/positive/test009.jvr new file mode 100644 index 000000000..323dfaa05 --- /dev/null +++ b/tests/Casm/Reg/positive/test009.jvr @@ -0,0 +1,124 @@ +type list { + nil : list; + cons : (*, list) → list; +} + +function hd(list) : *; +function tl(list) : list; +function null(list) : bool; +function map(* → *, list) : list; +function map'(* → *, list) : list; +function add_one(integer) : integer; +function main() : *; + +function hd(list) : * { + tmp[0] = arg[0].cons[0]; + ret tmp[0]; +} + +function tl(list) : list { + tmp[0] = arg[0].cons[1]; + ret tmp[0]; +} + +function null(list) : integer { + case[list] arg[0] { + nil: { + ret 1; + }; + default: { + ret 0; + }; + }; +} + +function map(* → *, list) : list { + tmp[1] = arg[1]; + case[list] tmp[1] { + nil: { + ret tmp[1]; + }; + cons: { + { + tmp[0] = tmp[1]; + tmp[1] = tmp[0].cons[1]; + tmp[2] = arg[0]; + tmp[1] = call map (tmp[2], tmp[1]), live: (tmp[0], arg[0], arg[1]); + tmp[2] = tmp[0].cons[0]; + tmp[3] = arg[0]; + tmp[2] = call tmp[3] (tmp[2]), live: (tmp[0], tmp[1], arg[0], arg[1]); + prealloc 3, live: (tmp[0], tmp[1], tmp[2], arg[0], arg[1]); + tmp[1] = alloc cons (tmp[2], tmp[1]); + ret tmp[1]; + }; + }; + }; +} + +function map'(* → *, list) : list { + tmp[0] = arg[1]; + tmp[0] = call null (tmp[0]), live: (arg[0], arg[1]); + tmp[0] = eq tmp[0] 1; + br tmp[0] { + true: { + prealloc 1, live: (arg[0], arg[1]); + tmp[0] = alloc nil (); + ret tmp[0]; + }; + false: { + tmp[0] = arg[1]; + tmp[0] = call tl (tmp[0]), live: (arg[0], arg[1]); + tmp[1] = arg[0]; + tmp[0] = call map' (tmp[1], tmp[0]), live: (arg[0], arg[1]); + tmp[1] = arg[1]; + tmp[1] = call hd (tmp[1]), live: (tmp[0], arg[0], arg[1]); + tmp[2] = arg[0]; + tmp[1] = call tmp[2] (tmp[1]), live: (tmp[0], arg[0], arg[1]); + prealloc 3, live: (tmp[0], tmp[1], arg[0], arg[1]); + tmp[0] = alloc cons (tmp[1], tmp[0]); + ret tmp[0]; + }; + }; +} + +function add_one(integer) : integer { + tmp[0] = arg[0]; + tmp[1] = 1; + tmp[0] = add tmp[1] tmp[0]; + ret tmp[0]; +} + +function main() : * { + tmp[1] = alloc nil (); + tmp[2] = 1; + tmp[1] = alloc cons (tmp[2], tmp[1]); + tmp[2] = 0; + tmp[1] = alloc cons (tmp[2], tmp[1]); + tmp[0] = tmp[1]; + tmp[1] = tmp[0]; + tmp[1] = call null (tmp[1]); + tmp[3] = tmp[1]; + tmp[1] = alloc nil (); + tmp[1] = call null (tmp[1]); + tmp[3] = add tmp[3] tmp[1]; + tmp[1] = tmp[0]; + tmp[1] = call hd (tmp[1]); + tmp[3] = add tmp[3] tmp[1]; + tmp[1] = tmp[0]; + tmp[1] = call tl (tmp[1]); + tmp[1] = call hd (tmp[1]); + tmp[3] = add tmp[3] tmp[1]; + tmp[1] = tmp[0]; + tmp[2] = calloc add_one (); + tmp[1] = call map (tmp[2], tmp[1]); + tmp[1] = call tl (tmp[1]); + tmp[1] = call hd (tmp[1]); + tmp[3] = add tmp[3] tmp[1]; + tmp[1] = tmp[0]; + tmp[2] = calloc add_one (); + tmp[1] = call map' (tmp[2], tmp[1]); + tmp[1] = call tl (tmp[1]); + tmp[1] = call hd (tmp[1]); + tmp[3] = add tmp[3] tmp[1]; + ret tmp[3]; +} diff --git a/tests/Casm/Reg/positive/test010.jvr b/tests/Casm/Reg/positive/test010.jvr new file mode 100644 index 000000000..c6c253583 --- /dev/null +++ b/tests/Casm/Reg/positive/test010.jvr @@ -0,0 +1,28 @@ + +function sum(integer) : integer; +function main() : *; + +function sum(integer) : integer { + tmp[0] = arg[0]; + tmp[1] = 0; + tmp[0] = eq tmp[1] tmp[0]; + br tmp[0], out: tmp[0] { + true: { + tmp[0] = 0; + }; + false: { + tmp[0] = 1; + tmp[1] = arg[0]; + tmp[0] = sub tmp[1] tmp[0]; + tmp[0] = call sum (tmp[0]), live: (arg[0]); + tmp[1] = arg[0]; + tmp[0] = add tmp[1] tmp[0]; + }; + }; + ret tmp[0]; +} + +function main() : * { + tmp[0] = 1000; + tcall sum (tmp[0]); +} diff --git a/tests/Casm/Reg/positive/test011.jvr b/tests/Casm/Reg/positive/test011.jvr new file mode 100644 index 000000000..7e8dfb845 --- /dev/null +++ b/tests/Casm/Reg/positive/test011.jvr @@ -0,0 +1,76 @@ + +function sum'(integer, integer) : integer; +function sum(integer) : integer; +function fact'(integer, integer) : integer; +function fact(integer) : integer; +function main() : *; + +function sum'(integer, integer) : integer { + tmp[0] = arg[0]; + tmp[1] = 0; + tmp[0] = eq tmp[1] tmp[0]; + br tmp[0] { + true: { + tmp[0] = arg[1]; + ret tmp[0]; + }; + false: { + tmp[0] = arg[1]; + tmp[1] = arg[0]; + tmp[0] = add tmp[1] tmp[0]; + tmp[1] = 1; + tmp[2] = arg[0]; + tmp[1] = sub tmp[2] tmp[1]; + tcall sum' (tmp[1], tmp[0]); + }; + }; +} + +function sum(integer) : integer { + tmp[0] = 0; + tmp[1] = arg[0]; + tcall sum' (tmp[1], tmp[0]); +} + +function fact'(integer, integer) : integer { + tmp[0] = arg[0]; + tmp[1] = 0; + tmp[0] = eq tmp[1] tmp[0]; + br tmp[0] { + true: { + tmp[0] = arg[1]; + ret tmp[0]; + }; + false: { + tmp[0] = arg[0]; + tmp[1] = arg[1]; + tmp[0] = mul tmp[1] tmp[0]; + tmp[1] = 1; + tmp[2] = arg[0]; + tmp[1] = sub tmp[2] tmp[1]; + tcall fact' (tmp[1], tmp[0]); + }; + }; +} + +function fact(integer) : integer { + tmp[0] = 1; + tmp[1] = arg[0]; + tcall fact' (tmp[1], tmp[0]); +} + +function main() : * { + tmp[0] = 1000; + tmp[0] = call sum (tmp[0]); + tmp[1] = tmp[0]; + tmp[0] = 5; + tmp[0] = call fact (tmp[0]); + tmp[1] = add tmp[1] tmp[0]; + tmp[0] = 10; + tmp[0] = call fact (tmp[0]); + tmp[1] = add tmp[1] tmp[0]; + tmp[0] = 12; + tmp[0] = call fact (tmp[0]); + tmp[1] = add tmp[1] tmp[0]; + ret tmp[1]; +} diff --git a/tests/Casm/Reg/positive/test012.jvr b/tests/Casm/Reg/positive/test012.jvr new file mode 100644 index 000000000..8cd49218e --- /dev/null +++ b/tests/Casm/Reg/positive/test012.jvr @@ -0,0 +1,43 @@ + +function main() : *; + +function main() : * { + tmp[5] = 1; + { + tmp[0] = tmp[5]; + tmp[5] = 2; + { + tmp[1] = tmp[5]; + tmp[5] = tmp[1]; + }; + tmp[6] = tmp[0]; + tmp[5] = add tmp[6] tmp[5]; + { + tmp[1] = tmp[5]; + tmp[5] = tmp[1]; + tmp[6] = tmp[1]; + tmp[5] = mul tmp[6] tmp[5]; + { + tmp[2] = tmp[5]; + tmp[5] = tmp[2]; + tmp[6] = 2; + tmp[5] = add tmp[6] tmp[5]; + { + tmp[3] = tmp[5]; + tmp[5] = tmp[2]; + tmp[6] = tmp[3]; + tmp[5] = add tmp[6] tmp[5]; + { + tmp[4] = tmp[5]; + tmp[5] = tmp[2]; + tmp[6] = tmp[3]; + tmp[7] = tmp[4]; + tmp[6] = add tmp[7] tmp[6]; + tmp[5] = add tmp[6] tmp[5]; + ret tmp[5]; + }; + }; + }; + }; + }; +} diff --git a/tests/Casm/Reg/positive/test013.jvr b/tests/Casm/Reg/positive/test013.jvr new file mode 100644 index 000000000..f123e9fc7 --- /dev/null +++ b/tests/Casm/Reg/positive/test013.jvr @@ -0,0 +1,48 @@ + +function fib'(integer, integer, integer) : integer; +function fib(integer) : integer; +function main() : *; + +function fib'(integer, integer, integer) : integer { + tmp[0] = arg[0]; + tmp[1] = 0; + tmp[0] = eq tmp[1] tmp[0]; + br tmp[0] { + true: { + tmp[0] = arg[1]; + ret tmp[0]; + }; + false: { + tmp[0] = 16777216; + tmp[1] = arg[2]; + tmp[2] = arg[1]; + tmp[1] = add tmp[2] tmp[1]; + tmp[0] = mod tmp[1] tmp[0]; + tmp[1] = arg[2]; + tmp[2] = 1; + tmp[3] = arg[0]; + tmp[2] = sub tmp[3] tmp[2]; + tcall fib' (tmp[2], tmp[1], tmp[0]); + }; + }; +} + +function fib(integer) : integer { + tmp[0] = 1; + tmp[1] = 0; + tmp[2] = arg[0]; + tcall fib' (tmp[2], tmp[1], tmp[0]); +} + +function main() : * { + tmp[0] = 10; + tmp[0] = call fib (tmp[0]); + tmp[1] = tmp[0]; + tmp[0] = 100; + tmp[0] = call fib (tmp[0]); + tmp[1] = add tmp[1] tmp[0]; + tmp[0] = 1000; + tmp[0] = call fib (tmp[0]); + tmp[1] = add tmp[1] tmp[0]; + ret tmp[1]; +} diff --git a/tests/Casm/Reg/positive/test014.jvr b/tests/Casm/Reg/positive/test014.jvr new file mode 100644 index 000000000..932fb19e6 --- /dev/null +++ b/tests/Casm/Reg/positive/test014.jvr @@ -0,0 +1,142 @@ +type tree { + node1 : tree → tree; + node2 : (tree, tree) → tree; + node3 : (tree, tree, tree) → tree; + leaf : tree; +} + +function gen(integer) : tree; +function preorder(tree) : *; +function main() : *; + +function gen(integer) : tree { + tmp[2] = arg[0]; + tmp[3] = 0; + tmp[2] = eq tmp[3] tmp[2]; + br tmp[2] { + true: { + prealloc 1, live: (arg[0]); + tmp[2] = alloc leaf (); + ret tmp[2]; + }; + false: { + tmp[2] = 3; + tmp[3] = arg[0]; + tmp[2] = mod tmp[3] tmp[2]; + { + tmp[0] = tmp[2]; + tmp[2] = tmp[0]; + tmp[3] = 0; + tmp[2] = eq tmp[3] tmp[2]; + br tmp[2] { + true: { + tmp[2] = 1; + tmp[3] = arg[0]; + tmp[2] = sub tmp[3] tmp[2]; + tmp[2] = call gen (tmp[2]), live: (tmp[0], arg[0]); + prealloc 2, live: (tmp[0], tmp[2], arg[0]); + tmp[2] = alloc node1 (tmp[2]); + ret tmp[2]; + }; + false: { + tmp[2] = tmp[0]; + tmp[3] = 1; + tmp[2] = eq tmp[3] tmp[2]; + br tmp[2] { + true: { + tmp[2] = 1; + tmp[3] = arg[0]; + tmp[2] = sub tmp[3] tmp[2]; + { + tmp[1] = tmp[2]; + tmp[2] = tmp[1]; + tmp[2] = call gen (tmp[2]), live: (tmp[0], tmp[1], arg[0]); + tmp[3] = tmp[1]; + tmp[3] = call gen (tmp[3]), live: (tmp[0], tmp[1], tmp[2], arg[0]); + prealloc 3, live: (tmp[0], tmp[1], tmp[2], tmp[3], arg[0]); + tmp[2] = alloc node2 (tmp[3], tmp[2]); + ret tmp[2]; + }; + }; + false: { + tmp[2] = 1; + tmp[3] = arg[0]; + tmp[2] = sub tmp[3] tmp[2]; + { + tmp[1] = tmp[2]; + tmp[2] = tmp[1]; + tmp[2] = call gen (tmp[2]), live: (tmp[0], tmp[1], arg[0]); + tmp[3] = tmp[1]; + tmp[3] = call gen (tmp[3]), live: (tmp[0], tmp[1], tmp[2], arg[0]); + tmp[4] = tmp[1]; + tmp[4] = call gen (tmp[4]), live: (tmp[0], tmp[1], tmp[2], tmp[3], arg[0]); + prealloc 4, live: (tmp[0], tmp[1], tmp[2], tmp[3], tmp[4], arg[0]); + tmp[2] = alloc node3 (tmp[4], tmp[3], tmp[2]); + ret tmp[2]; + }; + }; + }; + }; + }; + }; + }; + }; +} + +function preorder(tree) : * { + tmp[0] = arg[0]; + case[tree] tmp[0] { + node1: { + nop; + tmp[0] = 1; + trace tmp[0]; + nop; + tmp[0] = arg[0].node1[0]; + tcall preorder (tmp[0]); + }; + node2: { + nop; + tmp[0] = 2; + trace tmp[0]; + nop; + tmp[0] = arg[0].node2[0]; + tmp[0] = call preorder (tmp[0]), live: (arg[0]); + nop; + tmp[0] = arg[0].node2[1]; + tcall preorder (tmp[0]); + }; + node3: { + nop; + tmp[0] = 3; + trace tmp[0]; + nop; + tmp[0] = arg[0].node3[0]; + tmp[0] = call preorder (tmp[0]), live: (arg[0]); + nop; + tmp[0] = arg[0].node3[1]; + tmp[0] = call preorder (tmp[0]), live: (arg[0]); + nop; + tmp[0] = arg[0].node3[2]; + tcall preorder (tmp[0]); + }; + leaf: { + nop; + tmp[0] = 0; + trace tmp[0]; + nop; + tmp[0] = 777; + ret tmp[0]; + }; + }; +} + +function main() : * { + tmp[0] = 3; + tmp[0] = call gen (tmp[0]); + tmp[0] = call preorder (tmp[0]); + tmp[0] = 666; + trace tmp[0]; + tmp[0] = 7; + tmp[0] = call gen (tmp[0]); + tcall preorder (tmp[0]); +} diff --git a/tests/Casm/Reg/positive/test015.jvr b/tests/Casm/Reg/positive/test015.jvr new file mode 100644 index 000000000..c6531bbb5 --- /dev/null +++ b/tests/Casm/Reg/positive/test015.jvr @@ -0,0 +1,89 @@ + +function id(*) : *; +function const(*, *) : *; +function g(*) : integer; +function f(integer) : integer → integer; +function main() : *; + +function id(*) : * { + tmp[0] = arg[0]; + ret tmp[0]; +} + +function const(*, *) : * { + tmp[0] = arg[0]; + ret tmp[0]; +} + +function g(*) : integer { + tmp[0] = 2; + tcall id (tmp[0]); +} + +function f(integer) : integer → integer { + tmp[0] = arg[0]; + tmp[1] = 6; + tmp[0] = eq tmp[1] tmp[0]; + br tmp[0] { + true: { + prealloc 3, live: (arg[0]); + tmp[0] = 0; + tmp[0] = calloc const (tmp[0]); + ret tmp[0]; + }; + false: { + tmp[0] = arg[0]; + tmp[1] = 5; + tmp[0] = eq tmp[1] tmp[0]; + br tmp[0] { + true: { + prealloc 3, live: (arg[0]); + tmp[0] = 1; + tmp[0] = calloc const (tmp[0]); + ret tmp[0]; + }; + false: { + tmp[0] = arg[0]; + tmp[1] = 10; + tmp[0] = eq tmp[1] tmp[0]; + br tmp[0] { + true: { + prealloc 2, live: (arg[0]); + tmp[0] = calloc g (); + ret tmp[0]; + }; + false: { + prealloc 2, live: (arg[0]); + tmp[0] = calloc id (); + ret tmp[0]; + }; + }; + }; + }; + }; + }; +} + +function main() : * { + tmp[0] = 6; + tmp[1] = 5; + tmp[1] = call f (tmp[1]); + tmp[0] = call tmp[1] (tmp[0]); + tmp[2] = tmp[0]; + tmp[0] = 5; + tmp[1] = 6; + tmp[1] = call f (tmp[1]); + tmp[0] = call tmp[1] (tmp[0]); + tmp[2] = add tmp[2] tmp[0]; + tmp[0] = 5; + tmp[1] = 10; + tmp[1] = call f (tmp[1]); + tmp[0] = call tmp[1] (tmp[0]); + tmp[2] = add tmp[2] tmp[0]; + tmp[0] = 5; + tmp[1] = 11; + tmp[1] = call f (tmp[1]); + tmp[0] = call tmp[1] (tmp[0]); + tmp[2] = add tmp[2] tmp[0]; + ret tmp[2]; +} diff --git a/tests/Casm/Reg/positive/test016.jvr b/tests/Casm/Reg/positive/test016.jvr new file mode 100644 index 000000000..e8fc56bb7 --- /dev/null +++ b/tests/Casm/Reg/positive/test016.jvr @@ -0,0 +1,71 @@ + +function f(integer, integer) : *; +function g(integer, integer) : integer; +function h((integer, integer) → integer, integer, integer) : integer; +function func(integer) : integer; +function main() : *; + +function f(integer, integer) : * { + tmp[0] = arg[0]; + tmp[1] = arg[1]; + tmp[0] = add tmp[1] tmp[0]; + ret tmp[0]; +} + +function g(integer, integer) : integer { + tmp[0] = arg[1]; + tmp[1] = 7; + tmp[0] = mul tmp[1] tmp[0]; + tmp[1] = arg[0]; + tmp[2] = 1; + tmp[1] = add tmp[2] tmp[1]; + tmp[0] = sub tmp[1] tmp[0]; + ret tmp[0]; +} + +function h((integer, integer) → integer, integer, integer) : integer { + tmp[0] = arg[2]; + tmp[1] = arg[1]; + tmp[2] = arg[1]; + tmp[3] = arg[0]; + tmp[1] = call tmp[3] (tmp[2], tmp[1]), live: (tmp[0], arg[0], arg[1], arg[2]); + tmp[0] = mul tmp[1] tmp[0]; + ret tmp[0]; +} + +function func(integer) : integer { + tmp[0] = 4; + tmp[1] = arg[0]; + tmp[0] = add tmp[1] tmp[0]; + ret tmp[0]; +} + +function main() : * { + tmp[0] = 5; + tmp[1] = 17; + tmp[0] = div tmp[1] tmp[0]; + tmp[0] = call func (tmp[0]); + tmp[4] = tmp[0]; + tmp[0] = 17; + tmp[1] = 5; + tmp[2] = 0; + tmp[1] = mul tmp[2] tmp[1]; + tmp[0] = add tmp[1] tmp[0]; + tmp[4] = add tmp[4] tmp[0]; + tmp[0] = 1; + tmp[1] = 0; + tmp[0] = add tmp[1] tmp[0]; + tmp[1] = 7; + tmp[0] = mul tmp[1] tmp[0]; + tmp[1] = 30; + tmp[0] = add tmp[1] tmp[0]; + tmp[4] = add tmp[4] tmp[0]; + tmp[0] = 4; + tmp[1] = 3; + tmp[2] = 2; + tmp[3] = calloc g (); + tmp[1] = call h (tmp[3], tmp[2], tmp[1]); + tmp[0] = call f (tmp[1], tmp[0]); + tmp[4] = add tmp[4] tmp[0]; + ret tmp[4]; +} diff --git a/tests/Casm/Reg/positive/test017.jvr b/tests/Casm/Reg/positive/test017.jvr new file mode 100644 index 000000000..936b98dab --- /dev/null +++ b/tests/Casm/Reg/positive/test017.jvr @@ -0,0 +1,121 @@ + +function g(integer, integer) : integer; +function h(integer → integer, integer → integer, integer) : integer; +function f(integer) : integer → integer; +function g'(integer, integer → integer) : integer; +function h'(integer) : integer; +function main() : *; + +function g(integer, integer) : integer { + tmp[0] = arg[0]; + tmp[1] = arg[1]; + tmp[0] = add tmp[1] tmp[0]; + ret tmp[0]; +} + +function h(integer → integer, integer → integer, integer) : integer { + tmp[0] = arg[2]; + tmp[1] = arg[1]; + tmp[0] = call tmp[1] (tmp[0]), live: (arg[0], arg[1], arg[2]); + tmp[1] = arg[0]; + tcall tmp[1] (tmp[0]); +} + +function f(integer) : integer → integer { + prealloc 3, live: (arg[0]); + tmp[1] = arg[0]; + tmp[1] = calloc g (tmp[1]); + { + tmp[0] = tmp[1]; + tmp[1] = arg[0]; + tmp[2] = 0; + tmp[1] = eq tmp[2] tmp[1]; + br tmp[1] { + true: { + tmp[1] = 10; + tcall f (tmp[1]); + }; + false: { + tmp[1] = 10; + tmp[2] = arg[0]; + tmp[1] = lt tmp[2] tmp[1]; + br tmp[1] { + true: { + tmp[1] = 1; + tmp[2] = arg[0]; + tmp[1] = sub tmp[2] tmp[1]; + tmp[1] = call f (tmp[1]), live: (tmp[0], arg[0]); + prealloc 4, live: (tmp[0], tmp[1], arg[0]); + tmp[2] = tmp[0]; + tmp[1] = calloc h (tmp[2], tmp[1]); + ret tmp[1]; + }; + false: { + tmp[1] = tmp[0]; + ret tmp[1]; + }; + }; + }; + }; + }; +} + +function g'(integer, integer → integer) : integer { + tmp[0] = arg[0]; + tmp[1] = arg[1]; + tmp[0] = call tmp[1] (tmp[0]), live: (arg[0], arg[1]); + tmp[1] = arg[0]; + tmp[0] = add tmp[1] tmp[0]; + ret tmp[0]; +} + +function h'(integer) : integer { + tmp[0] = arg[0]; + tmp[1] = 0; + tmp[0] = eq tmp[1] tmp[0]; + br tmp[0] { + true: { + tmp[0] = 0; + ret tmp[0]; + }; + false: { + prealloc 2, live: (arg[0]); + tmp[0] = calloc h' (); + tmp[1] = 1; + tmp[2] = arg[0]; + tmp[1] = sub tmp[2] tmp[1]; + tcall g' (tmp[1], tmp[0]); + }; + }; +} + +function main() : * { + tmp[0] = 500; + tmp[1] = 100; + tmp[1] = call f (tmp[1]); + tmp[0] = call tmp[1] (tmp[0]); + tmp[2] = tmp[0]; + tmp[0] = 0; + tmp[1] = 5; + tmp[1] = call f (tmp[1]); + tmp[0] = call tmp[1] (tmp[0]); + tmp[2] = add tmp[2] tmp[0]; + tmp[0] = 5; + tmp[1] = 5; + tmp[1] = call f (tmp[1]); + tmp[0] = call tmp[1] (tmp[0]); + tmp[2] = add tmp[2] tmp[0]; + tmp[0] = 10; + tmp[0] = call h' (tmp[0]); + tmp[2] = add tmp[2] tmp[0]; + tmp[0] = calloc h' (); + tmp[1] = 10; + tmp[0] = call g' (tmp[1], tmp[0]); + tmp[2] = add tmp[2] tmp[0]; + tmp[0] = 10; + tmp[0] = call f (tmp[0]); + tmp[1] = 3; + tmp[0] = call g' (tmp[1], tmp[0]); + tmp[2] = add tmp[2] tmp[0]; + ret tmp[2]; +} diff --git a/tests/Casm/Reg/positive/test018.jvr b/tests/Casm/Reg/positive/test018.jvr new file mode 100644 index 000000000..990b354f7 --- /dev/null +++ b/tests/Casm/Reg/positive/test018.jvr @@ -0,0 +1,78 @@ + +function ext_10((integer, integer) → integer) : integer → integer; +function app_0(integer → integer) : integer; +function f((integer, integer) → integer) : integer; +function plus(integer, integer) : integer; +function minus(integer, integer) : integer; +function mult(integer, integer) : integer; +function g(integer, integer, integer, integer) : integer; +function main() : *; + +function ext_10((integer, integer) → integer) : integer → integer { + tmp[0] = 10; + tmp[1] = arg[0]; + tmp[0] = cextend tmp[1] (tmp[0]); + ret tmp[0]; +} + +function app_0(integer → integer) : integer { + tmp[0] = 1; + tmp[1] = arg[0]; + tcall tmp[1] (tmp[0]); +} + +function f((integer, integer) → integer) : integer { + tmp[0] = arg[0]; + tmp[0] = call ext_10 (tmp[0]), live: (arg[0]); + tcall app_0 (tmp[0]); +} + +function plus(integer, integer) : integer { + tmp[0] = arg[1]; + tmp[1] = arg[0]; + tmp[0] = add tmp[1] tmp[0]; + ret tmp[0]; +} + +function minus(integer, integer) : integer { + tmp[0] = arg[1]; + tmp[1] = arg[0]; + tmp[0] = sub tmp[1] tmp[0]; + ret tmp[0]; +} + +function mult(integer, integer) : integer { + tmp[0] = arg[1]; + tmp[1] = arg[0]; + tmp[0] = mul tmp[1] tmp[0]; + ret tmp[0]; +} + +function g(integer, integer, integer, integer) : integer { + tmp[0] = arg[1]; + tmp[1] = arg[0]; + tmp[0] = sub tmp[1] tmp[0]; + tmp[1] = arg[2]; + tmp[0] = add tmp[1] tmp[0]; + tmp[1] = arg[3]; + tmp[0] = mul tmp[1] tmp[0]; + ret tmp[0]; +} + +function main() : * { + tmp[0] = calloc plus (); + tmp[0] = call f (tmp[0]); + tmp[2] = tmp[0]; + tmp[0] = calloc minus (); + tmp[0] = call f (tmp[0]); + tmp[2] = add tmp[2] tmp[0]; + tmp[0] = calloc mult (); + tmp[0] = call f (tmp[0]); + tmp[2] = add tmp[2] tmp[0]; + tmp[0] = 2; + tmp[1] = 3; + tmp[0] = calloc g (tmp[1], tmp[0]); + tmp[0] = call f (tmp[0]); + tmp[2] = add tmp[2] tmp[0]; + ret tmp[2]; +} diff --git a/tests/Casm/Reg/positive/test019.jvr b/tests/Casm/Reg/positive/test019.jvr new file mode 100644 index 000000000..6a81367d3 --- /dev/null +++ b/tests/Casm/Reg/positive/test019.jvr @@ -0,0 +1,38 @@ + +function g(integer → integer, integer) : integer; +function f(integer) : integer; +function main() : *; + +function g(integer → integer, integer) : integer { + tmp[0] = arg[1]; + tmp[1] = 0; + tmp[0] = eq tmp[1] tmp[0]; + br tmp[0] { + true: { + tmp[0] = 0; + ret tmp[0]; + }; + false: { + tmp[0] = 1; + tmp[1] = arg[1]; + tmp[0] = sub tmp[1] tmp[0]; + tmp[1] = arg[0]; + tcall tmp[1] (tmp[0]); + }; + }; +} + +function f(integer) : integer { + prealloc 2, live: (arg[0]); + tmp[0] = arg[0]; + tmp[1] = calloc f (); + tmp[0] = call g (tmp[1], tmp[0]), live: (arg[0]); + tmp[1] = arg[0]; + tmp[0] = add tmp[1] tmp[0]; + ret tmp[0]; +} + +function main() : * { + tmp[0] = 10; + tcall f (tmp[0]); +} diff --git a/tests/Casm/Reg/positive/test020.jvr b/tests/Casm/Reg/positive/test020.jvr new file mode 100644 index 000000000..cbde2bd0d --- /dev/null +++ b/tests/Casm/Reg/positive/test020.jvr @@ -0,0 +1,46 @@ + +function sumb((integer, integer) → integer, integer, integer) : integer; +function sum'(integer, integer) : integer; +function sum(integer) : integer; +function main() : *; + +function sumb((integer, integer) → integer, integer, integer) : integer { + tmp[0] = arg[1]; + tmp[1] = 0; + tmp[0] = eq tmp[1] tmp[0]; + br tmp[0] { + true: { + tmp[0] = arg[2]; + ret tmp[0]; + }; + false: { + tmp[0] = arg[2]; + tmp[1] = 1; + tmp[2] = arg[1]; + tmp[1] = sub tmp[2] tmp[1]; + tmp[2] = arg[0]; + tcall tmp[2] (tmp[1], tmp[0]); + }; + }; +} + +function sum'(integer, integer) : integer { + prealloc 2, live: (arg[0], arg[1]); + tmp[0] = arg[1]; + tmp[1] = arg[0]; + tmp[0] = add tmp[1] tmp[0]; + tmp[1] = arg[0]; + tmp[2] = calloc sum' (); + tcall sumb (tmp[2], tmp[1], tmp[0]); +} + +function sum(integer) : integer { + tmp[0] = 0; + tmp[1] = arg[0]; + tcall sum' (tmp[1], tmp[0]); +} + +function main() : * { + tmp[0] = 1000; + tcall sum (tmp[0]); +} diff --git a/tests/Casm/Reg/positive/test021.jvr b/tests/Casm/Reg/positive/test021.jvr new file mode 100644 index 000000000..cedc32e50 --- /dev/null +++ b/tests/Casm/Reg/positive/test021.jvr @@ -0,0 +1,33 @@ + +function f(integer → integer) : integer; +function h(integer, integer) : integer; +function u(integer) : integer; +function main() : *; + +function f(integer → integer) : integer { + tmp[0] = 5; + tmp[1] = arg[0]; + tcall tmp[1] (tmp[0]); +} + +function h(integer, integer) : integer { + tmp[0] = arg[1]; + tmp[1] = arg[0]; + tmp[0] = add tmp[1] tmp[0]; + ret tmp[0]; +} + +function u(integer) : integer { + prealloc 3, live: (arg[0]); + tmp[0] = arg[0]; + tmp[1] = 4; + tmp[1] = calloc h (tmp[1]); + tmp[1] = call f (tmp[1]), live: (tmp[0], arg[0]); + tmp[0] = add tmp[1] tmp[0]; + ret tmp[0]; +} + +function main() : * { + tmp[0] = 2; + tcall u (tmp[0]); +} diff --git a/tests/Casm/Reg/positive/test023.jvr b/tests/Casm/Reg/positive/test023.jvr new file mode 100644 index 000000000..8d8aa504a --- /dev/null +++ b/tests/Casm/Reg/positive/test023.jvr @@ -0,0 +1,40 @@ + +function f91(integer) : integer; +function main() : *; + +function f91(integer) : integer { + tmp[0] = arg[0]; + tmp[1] = 100; + tmp[0] = lt tmp[1] tmp[0]; + br tmp[0] { + true: { + tmp[0] = 10; + tmp[1] = arg[0]; + tmp[0] = sub tmp[1] tmp[0]; + ret tmp[0]; + }; + false: { + tmp[0] = 11; + tmp[1] = arg[0]; + tmp[0] = add tmp[1] tmp[0]; + tmp[0] = call f91 (tmp[0]), live: (arg[0]); + tcall f91 (tmp[0]); + }; + }; +} + +function main() : * { + tmp[0] = 101; + tmp[0] = call f91 (tmp[0]); + tmp[1] = tmp[0]; + tmp[0] = 95; + tmp[0] = call f91 (tmp[0]); + tmp[1] = add tmp[1] tmp[0]; + tmp[0] = 16; + tmp[0] = call f91 (tmp[0]); + tmp[1] = add tmp[1] tmp[0]; + tmp[0] = 5; + tmp[0] = call f91 (tmp[0]); + tmp[1] = add tmp[1] tmp[0]; + ret tmp[1]; +} diff --git a/tests/Casm/Reg/positive/test024.jvr b/tests/Casm/Reg/positive/test024.jvr new file mode 100644 index 000000000..3b0d45cf9 --- /dev/null +++ b/tests/Casm/Reg/positive/test024.jvr @@ -0,0 +1,60 @@ + +function f((*, integer → integer, integer) → *, integer → integer, integer) : *; +function g(integer) : integer; +function main() : *; + +function f((*, integer → integer, integer) → *, integer → integer, integer) : * { + tmp[0] = 6; + trace tmp[0]; + nop; + tmp[0] = arg[2]; + trace tmp[0]; + nop; + tmp[0] = 7; + trace tmp[0]; + nop; + tmp[0] = arg[2]; + tmp[1] = 0; + tmp[0] = eq tmp[1] tmp[0]; + br tmp[0] { + true: { + tmp[0] = 666; + trace tmp[0]; + nop; + tmp[0] = 0; + ret tmp[0]; + }; + false: { + tmp[0] = 9; + trace tmp[0]; + nop; + tmp[0] = arg[2]; + tmp[1] = arg[1]; + tmp[0] = call tmp[1] (tmp[0]), live: (arg[0], arg[1], arg[2]); + tmp[1] = arg[1]; + tmp[2] = arg[0]; + tmp[3] = arg[0]; + tcall tmp[3] (tmp[2], tmp[1], tmp[0]); + }; + }; +} + +function g(integer) : integer { + tmp[0] = arg[0]; + tmp[1] = 10; + tmp[0] = mul tmp[1] tmp[0]; + trace tmp[0]; + nop; + tmp[0] = 1; + tmp[1] = arg[0]; + tmp[0] = sub tmp[1] tmp[0]; + ret tmp[0]; +} + +function main() : * { + prealloc 4; + tmp[0] = 4; + tmp[1] = calloc g (); + tmp[2] = calloc f (); + tcall f (tmp[2], tmp[1], tmp[0]); +} diff --git a/tests/Casm/Reg/positive/test026.jvr b/tests/Casm/Reg/positive/test026.jvr new file mode 100644 index 000000000..c1bcf4786 --- /dev/null +++ b/tests/Casm/Reg/positive/test026.jvr @@ -0,0 +1,90 @@ + +function app(* → *, *) : *; +function app'((integer → integer, integer) → integer, integer → integer, integer) : integer; +function inc(integer) : integer; +function h((* → *, *) → *) : *; +function capp((*, *) → *, *) : * → *; +function curry((*, *) → *) : * → * → *; +function uapp(* → * → *, *, *) : *; +function uncurry(* → * → *) : (*, *) → *; +function main() : *; + +function app(* → *, *) : * { + tmp[0] = arg[1]; + tmp[1] = arg[0]; + tcall tmp[1] (tmp[0]); +} + +function app'((integer → integer, integer) → integer, integer → integer, integer) : integer { + tmp[0] = arg[2]; + tmp[1] = arg[1]; + tmp[2] = arg[0]; + tcall tmp[2] (tmp[1], tmp[0]); +} + +function inc(integer) : integer { + tmp[0] = arg[0]; + tmp[1] = 1; + tmp[0] = add tmp[1] tmp[0]; + ret tmp[0]; +} + +function h((* → *, *) → *) : * { + prealloc 7, live: (arg[0]); + tmp[0] = calloc inc (); + tmp[1] = arg[0]; + tmp[0] = cextend tmp[1] (tmp[0]); + ret tmp[0]; +} + +function capp((*, *) → *, *) : * → * { + prealloc 5, live: (arg[0], arg[1]); + tmp[0] = arg[1]; + tmp[1] = arg[0]; + tmp[0] = cextend tmp[1] (tmp[0]); + ret tmp[0]; +} + +function curry((*, *) → *) : * → * → * { + prealloc 3, live: (arg[0]); + tmp[0] = arg[0]; + tmp[0] = calloc capp (tmp[0]); + ret tmp[0]; +} + +function uapp(* → * → *, *, *) : * { + tmp[0] = arg[2]; + tmp[1] = arg[1]; + tmp[2] = arg[0]; + tmp[1] = call tmp[2] (tmp[1]), live: (tmp[0], arg[0], arg[1], arg[2]); + tcall tmp[1] (tmp[0]); +} + +function uncurry(* → * → *) : (*, *) → * { + prealloc 3, live: (arg[0]); + tmp[0] = arg[0]; + tmp[0] = calloc uapp (tmp[0]); + ret tmp[0]; +} + +function main() : * { + prealloc 4; + tmp[0] = 5; + tmp[1] = calloc inc (); + tmp[2] = calloc app (); + tmp[0] = call app' (tmp[2], tmp[1], tmp[0]); + tmp[3] = tmp[0]; + tmp[0] = 4; + tmp[1] = calloc app (); + tmp[1] = call h (tmp[1]), live: (tmp[0]); + tmp[0] = call tmp[1] (tmp[0]); + tmp[3] = add tmp[3] tmp[0]; + tmp[0] = 7; + tmp[1] = calloc inc (); + tmp[2] = calloc app (); + tmp[2] = call curry (tmp[2]), live: (tmp[0], tmp[1]); + tmp[2] = call uncurry (tmp[2]), live: (tmp[0], tmp[1]); + tmp[0] = call tmp[2] (tmp[1], tmp[0]); + tmp[3] = add tmp[3] tmp[0]; + ret tmp[3]; +} diff --git a/tests/Casm/Reg/positive/test027.jvr b/tests/Casm/Reg/positive/test027.jvr new file mode 100644 index 000000000..d584bc8d0 --- /dev/null +++ b/tests/Casm/Reg/positive/test027.jvr @@ -0,0 +1,70 @@ + +function power'(integer, integer, integer) : integer; +function power(integer, integer) : integer; +function main() : *; + +function power'(integer, integer, integer) : integer { + tmp[0] = arg[1]; + tmp[1] = 0; + tmp[0] = eq tmp[1] tmp[0]; + br tmp[0] { + true: { + tmp[0] = arg[2]; + ret tmp[0]; + }; + false: { + tmp[0] = 2; + tmp[1] = arg[1]; + tmp[0] = mod tmp[1] tmp[0]; + tmp[1] = 0; + tmp[0] = eq tmp[1] tmp[0]; + br tmp[0] { + true: { + tmp[0] = arg[2]; + tmp[1] = 2; + tmp[2] = arg[1]; + tmp[1] = div tmp[2] tmp[1]; + tmp[2] = arg[0]; + tmp[3] = arg[0]; + tmp[2] = mul tmp[3] tmp[2]; + tcall power' (tmp[2], tmp[1], tmp[0]); + }; + false: { + tmp[0] = arg[2]; + tmp[1] = arg[0]; + tmp[0] = mul tmp[1] tmp[0]; + tmp[1] = 2; + tmp[2] = arg[1]; + tmp[1] = div tmp[2] tmp[1]; + tmp[2] = arg[0]; + tmp[3] = arg[0]; + tmp[2] = mul tmp[3] tmp[2]; + tcall power' (tmp[2], tmp[1], tmp[0]); + }; + }; + }; + }; +} + +function power(integer, integer) : integer { + tmp[0] = 1; + tmp[1] = arg[1]; + tmp[2] = arg[0]; + tcall power' (tmp[2], tmp[1], tmp[0]); +} + +function main() : * { + tmp[0] = 3; + tmp[1] = 2; + tmp[0] = call power (tmp[1], tmp[0]); + tmp[2] = tmp[0]; + tmp[0] = 7; + tmp[1] = 3; + tmp[0] = call power (tmp[1], tmp[0]); + tmp[2] = add tmp[2] tmp[0]; + tmp[0] = 11; + tmp[1] = 5; + tmp[0] = call power (tmp[1], tmp[0]); + tmp[2] = add tmp[2] tmp[0]; + ret tmp[2]; +} diff --git a/tests/Casm/Reg/positive/test028.jvr b/tests/Casm/Reg/positive/test028.jvr new file mode 100644 index 000000000..b813812ef --- /dev/null +++ b/tests/Casm/Reg/positive/test028.jvr @@ -0,0 +1,189 @@ +type list { + nil : list; + cons : (*, list) → list; +} + +function head(list) : *; +function tail(list) : list; +function null(list) : *; +function foldl((*, *) → *, *, list) : *; +function foldr((*, *) → *, *, list) : *; +function gen(integer) : list; +function plus(integer, integer) : integer; +function sum(integer) : integer; +function sum'(integer) : integer; +function foldl'((*, *) → *, *, list) : *; +function sum''(integer) : integer; +function main() : *; + +function head(list) : * { + tmp[0] = arg[0]; + case[list] tmp[0] { + cons: { + nop; + tmp[0] = arg[0].cons[0]; + ret tmp[0]; + }; + }; +} + +function tail(list) : list { + tmp[0] = arg[0]; + case[list] tmp[0] { + cons: { + nop; + tmp[0] = arg[0].cons[1]; + ret tmp[0]; + }; + }; +} + +function null(list) : * { + tmp[0] = arg[0]; + case[list] tmp[0] { + nil: { + nop; + tmp[0] = true; + ret tmp[0]; + }; + cons: { + nop; + tmp[0] = false; + ret tmp[0]; + }; + }; +} + +function foldl((*, *) → *, *, list) : * { + tmp[0] = arg[2]; + case[list] tmp[0] { + nil: { + nop; + tmp[0] = arg[1]; + ret tmp[0]; + }; + cons: { + nop; + tmp[0] = arg[2].cons[1]; + tmp[1] = arg[2].cons[0]; + tmp[2] = arg[1]; + tmp[3] = arg[0]; + tmp[1] = call tmp[3] (tmp[2], tmp[1]), live: (tmp[0], arg[0], arg[1], arg[2]); + tmp[2] = arg[0]; + tcall foldl (tmp[2], tmp[1], tmp[0]); + }; + }; +} + +function foldr((*, *) → *, *, list) : * { + tmp[0] = arg[2]; + case[list] tmp[0] { + nil: { + nop; + tmp[0] = arg[1]; + ret tmp[0]; + }; + cons: { + nop; + tmp[0] = arg[2].cons[1]; + tmp[1] = arg[1]; + tmp[2] = arg[0]; + tmp[0] = call foldr (tmp[2], tmp[1], tmp[0]), live: (arg[0], arg[1], arg[2]); + tmp[1] = arg[2].cons[0]; + tmp[2] = arg[0]; + tcall tmp[2] (tmp[1], tmp[0]); + }; + }; +} + +function gen(integer) : list { + tmp[0] = arg[0]; + tmp[1] = 0; + tmp[0] = eq tmp[1] tmp[0]; + br tmp[0] { + true: { + prealloc 1, live: (arg[0]); + tmp[0] = alloc nil (); + ret tmp[0]; + }; + false: { + tmp[0] = 1; + tmp[1] = arg[0]; + tmp[0] = sub tmp[1] tmp[0]; + tmp[0] = call gen (tmp[0]), live: (arg[0]); + prealloc 3, live: (tmp[0], arg[0]); + tmp[1] = arg[0]; + tmp[0] = alloc cons (tmp[1], tmp[0]); + ret tmp[0]; + }; + }; +} + +function plus(integer, integer) : integer { + tmp[0] = arg[1]; + tmp[1] = arg[0]; + tmp[0] = add tmp[1] tmp[0]; + ret tmp[0]; +} + +function sum(integer) : integer { + tmp[0] = arg[0]; + tmp[0] = call gen (tmp[0]), live: (arg[0]); + prealloc 2, live: (tmp[0], arg[0]); + tmp[1] = 0; + tmp[2] = calloc plus (); + tcall foldl (tmp[2], tmp[1], tmp[0]); +} + +function sum'(integer) : integer { + tmp[0] = arg[0]; + tmp[0] = call gen (tmp[0]), live: (arg[0]); + prealloc 2, live: (tmp[0], arg[0]); + tmp[1] = 0; + tmp[2] = calloc plus (); + tcall foldr (tmp[2], tmp[1], tmp[0]); +} + +function foldl'((*, *) → *, *, list) : * { + tmp[0] = arg[2]; + tmp[0] = call null (tmp[0]), live: (arg[0], arg[1], arg[2]); + br tmp[0] { + true: { + tmp[0] = arg[1]; + ret tmp[0]; + }; + false: { + tmp[0] = arg[2]; + tmp[0] = call tail (tmp[0]), live: (arg[0], arg[1], arg[2]); + tmp[1] = arg[2]; + tmp[1] = call head (tmp[1]), live: (tmp[0], arg[0], arg[1], arg[2]); + tmp[2] = arg[1]; + tmp[3] = arg[0]; + tmp[1] = call tmp[3] (tmp[2], tmp[1]), live: (tmp[0], arg[0], arg[1], arg[2]); + tmp[2] = arg[0]; + tcall foldl' (tmp[2], tmp[1], tmp[0]); + }; + }; +} + +function sum''(integer) : integer { + tmp[0] = arg[0]; + tmp[0] = call gen (tmp[0]), live: (arg[0]); + prealloc 2, live: (tmp[0], arg[0]); + tmp[1] = 0; + tmp[2] = calloc plus (); + tcall foldl' (tmp[2], tmp[1], tmp[0]); +} + +function main() : * { + tmp[0] = 1000; + tmp[0] = call sum (tmp[0]); + tmp[1] = tmp[0]; + tmp[0] = 1000; + tmp[0] = call sum' (tmp[0]); + tmp[1] = add tmp[1] tmp[0]; + tmp[0] = 1000; + tmp[0] = call sum'' (tmp[0]); + tmp[1] = add tmp[1] tmp[0]; + ret tmp[1]; +} diff --git a/tests/Casm/Reg/positive/test030.jvr b/tests/Casm/Reg/positive/test030.jvr new file mode 100644 index 000000000..3a203a2ce --- /dev/null +++ b/tests/Casm/Reg/positive/test030.jvr @@ -0,0 +1,89 @@ + +function f(integer) : integer; +function g(integer) : integer; +function h(integer) : integer; +function main() : *; + +function f(integer) : integer { + tmp[0] = 1; + tmp[1] = arg[0]; + tmp[0] = lt tmp[1] tmp[0]; + br tmp[0] { + true: { + tmp[0] = 1; + ret tmp[0]; + }; + false: { + tmp[0] = 268435456; + tmp[1] = 1; + tmp[2] = arg[0]; + tmp[1] = sub tmp[2] tmp[1]; + tmp[1] = call g (tmp[1]), live: (tmp[0], arg[0]); + tmp[2] = arg[0]; + tmp[3] = 2; + tmp[2] = mul tmp[3] tmp[2]; + tmp[1] = add tmp[2] tmp[1]; + tmp[0] = mod tmp[1] tmp[0]; + ret tmp[0]; + }; + }; +} + +function g(integer) : integer { + tmp[0] = 1; + tmp[1] = arg[0]; + tmp[0] = lt tmp[1] tmp[0]; + br tmp[0] { + true: { + tmp[0] = 1; + ret tmp[0]; + }; + false: { + tmp[0] = 268435456; + tmp[1] = 1; + tmp[2] = arg[0]; + tmp[1] = sub tmp[2] tmp[1]; + tmp[1] = call h (tmp[1]), live: (tmp[0], arg[0]); + tmp[2] = arg[0]; + tmp[1] = add tmp[2] tmp[1]; + tmp[0] = mod tmp[1] tmp[0]; + ret tmp[0]; + }; + }; +} + +function h(integer) : integer { + tmp[0] = 1; + tmp[1] = arg[0]; + tmp[0] = lt tmp[1] tmp[0]; + br tmp[0] { + true: { + tmp[0] = 1; + ret tmp[0]; + }; + false: { + tmp[0] = 268435456; + tmp[1] = 1; + tmp[2] = arg[0]; + tmp[1] = sub tmp[2] tmp[1]; + tmp[1] = call f (tmp[1]), live: (tmp[0], arg[0]); + tmp[2] = arg[0]; + tmp[1] = mul tmp[2] tmp[1]; + tmp[0] = mod tmp[1] tmp[0]; + ret tmp[0]; + }; + }; +} + +function main() : * { + tmp[0] = 5; + tmp[0] = call f (tmp[0]); + tmp[1] = tmp[0]; + tmp[0] = 10; + tmp[0] = call f (tmp[0]); + tmp[1] = add tmp[1] tmp[0]; + tmp[0] = 100; + tmp[0] = call f (tmp[0]); + tmp[1] = add tmp[1] tmp[0]; + ret tmp[1]; +} diff --git a/tests/Casm/Reg/positive/test031.jvr b/tests/Casm/Reg/positive/test031.jvr new file mode 100644 index 000000000..dc286c080 --- /dev/null +++ b/tests/Casm/Reg/positive/test031.jvr @@ -0,0 +1,203 @@ +type tree { + leaf : tree; + node : (tree, tree) → tree; +} + +function gen(integer) : tree; +function f(tree) : integer; +function isNode(tree) : bool; +function isLeaf(tree) : bool; +function g(tree) : tree; +function main() : *; + +function gen(integer) : tree { + tmp[0] = 0; + tmp[1] = arg[0]; + tmp[0] = le tmp[1] tmp[0]; + br tmp[0] { + true: { + prealloc 1, live: (arg[0]); + tmp[0] = alloc leaf (); + ret tmp[0]; + }; + false: { + tmp[0] = 1; + tmp[1] = arg[0]; + tmp[0] = sub tmp[1] tmp[0]; + tmp[0] = call gen (tmp[0]), live: (arg[0]); + tmp[1] = 2; + tmp[2] = arg[0]; + tmp[1] = sub tmp[2] tmp[1]; + tmp[1] = call gen (tmp[1]), live: (tmp[0], arg[0]); + prealloc 3, live: (tmp[0], tmp[1], arg[0]); + tmp[0] = alloc node (tmp[1], tmp[0]); + ret tmp[0]; + }; + }; +} + +function f(tree) : integer { + tmp[5] = arg[0]; + case[tree] tmp[5] { + leaf: { + nop; + tmp[5] = 1; + ret tmp[5]; + }; + node: { + { + tmp[0] = tmp[5]; + tmp[5] = tmp[0].node[0]; + tmp[5] = call g (tmp[5]), live: (tmp[0], arg[0]); + { + tmp[1] = tmp[5]; + tmp[5] = tmp[0].node[1]; + tmp[5] = call g (tmp[5]), live: (tmp[0], tmp[1], arg[0]); + { + tmp[2] = tmp[5]; + tmp[5] = tmp[1]; + case[tree] tmp[5], out: tmp[5] { + leaf: { + nop; + tmp[5] = 3; + tmp[6] = 0; + tmp[5] = sub tmp[6] tmp[5]; + }; + node: { + { + tmp[3] = tmp[5]; + tmp[5] = 32768; + tmp[6] = tmp[3].node[1]; + tmp[6] = call f (tmp[6]), live: (tmp[0], tmp[1], tmp[2], tmp[3], tmp[5], arg[0]); + tmp[7] = tmp[3].node[0]; + tmp[7] = call f (tmp[7]), live: (tmp[0], tmp[1], tmp[2], tmp[3], tmp[5], tmp[6], arg[0]); + tmp[6] = add tmp[7] tmp[6]; + tmp[5] = mod tmp[6] tmp[5]; + }; + }; + }; + { + tmp[3] = tmp[5]; + tmp[5] = tmp[2]; + case[tree] tmp[5], out: tmp[5] { + node: { + { + tmp[4] = tmp[5]; + tmp[5] = 32768; + tmp[6] = tmp[4].node[1]; + tmp[6] = call f (tmp[6]), live: (tmp[0], tmp[1], tmp[2], tmp[3], tmp[4], tmp[5], arg[0]); + tmp[7] = tmp[4].node[0]; + tmp[7] = call f (tmp[7]), live: (tmp[0], tmp[1], tmp[2], tmp[3], tmp[4], tmp[5], tmp[6], arg[0]); + tmp[6] = add tmp[7] tmp[6]; + tmp[5] = mod tmp[6] tmp[5]; + }; + }; + default: { + nop; + tmp[5] = 2; + }; + }; + { + tmp[4] = tmp[5]; + tmp[5] = 32768; + tmp[6] = tmp[3]; + tmp[7] = tmp[4]; + tmp[6] = mul tmp[7] tmp[6]; + tmp[5] = mod tmp[6] tmp[5]; + ret tmp[5]; + }; + }; + }; + }; + }; + }; + }; +} + +function isNode(tree) : bool { + tmp[0] = arg[0]; + case[tree] tmp[0] { + node: { + nop; + tmp[0] = true; + ret tmp[0]; + }; + default: { + nop; + tmp[0] = false; + ret tmp[0]; + }; + }; +} + +function isLeaf(tree) : bool { + tmp[0] = arg[0]; + case[tree] tmp[0] { + leaf: { + nop; + tmp[0] = true; + ret tmp[0]; + }; + default: { + nop; + tmp[0] = false; + ret tmp[0]; + }; + }; +} + +function g(tree) : tree { + tmp[1] = arg[0]; + tmp[1] = call isLeaf (tmp[1]), live: (arg[0]); + br tmp[1] { + true: { + tmp[1] = arg[0]; + ret tmp[1]; + }; + false: { + tmp[1] = arg[0]; + case[tree] tmp[1] { + node: { + { + tmp[0] = tmp[1]; + tmp[1] = tmp[0].node[0]; + tmp[1] = call isNode (tmp[1]), live: (tmp[0], arg[0]); + br tmp[1] { + true: { + tmp[1] = tmp[0].node[1]; + ret tmp[1]; + }; + false: { + prealloc 3, live: (tmp[0], arg[0]); + tmp[1] = tmp[0].node[1]; + tmp[2] = tmp[0].node[0]; + tmp[1] = alloc node (tmp[2], tmp[1]); + ret tmp[1]; + }; + }; + }; + }; + }; + }; + }; +} + +function main() : * { + tmp[0] = 10; + tmp[0] = call gen (tmp[0]); + tmp[0] = call f (tmp[0]); + tmp[1] = tmp[0]; + tmp[0] = 15; + tmp[0] = call gen (tmp[0]); + tmp[0] = call f (tmp[0]); + tmp[1] = add tmp[1] tmp[0]; + tmp[0] = 16; + tmp[0] = call gen (tmp[0]); + tmp[0] = call f (tmp[0]); + tmp[1] = add tmp[1] tmp[0]; + tmp[0] = 17; + tmp[0] = call gen (tmp[0]); + tmp[0] = call f (tmp[0]); + tmp[1] = add tmp[1] tmp[0]; + ret tmp[1]; +} diff --git a/tests/Casm/Reg/positive/test033.jvr b/tests/Casm/Reg/positive/test033.jvr new file mode 100644 index 000000000..70335f2b4 --- /dev/null +++ b/tests/Casm/Reg/positive/test033.jvr @@ -0,0 +1,70 @@ + +function ack(integer, integer) : integer; +function main() : *; + +function ack(integer, integer) : integer { + tmp[0] = 0; + tmp[1] = arg[0]; + tmp[0] = eq tmp[1] tmp[0]; + br tmp[0] { + true: { + tmp[0] = 1; + tmp[1] = arg[1]; + tmp[0] = add tmp[1] tmp[0]; + ret tmp[0]; + }; + false: { + tmp[0] = 0; + tmp[1] = arg[1]; + tmp[0] = eq tmp[1] tmp[0]; + br tmp[0] { + true: { + tmp[0] = 1; + tmp[1] = 1; + tmp[2] = arg[0]; + tmp[1] = sub tmp[2] tmp[1]; + tcall ack (tmp[1], tmp[0]); + }; + false: { + tmp[0] = 1; + tmp[1] = arg[1]; + tmp[0] = sub tmp[1] tmp[0]; + tmp[1] = arg[0]; + tmp[0] = call ack (tmp[1], tmp[0]), live: (arg[0], arg[1]); + tmp[1] = 1; + tmp[2] = arg[0]; + tmp[1] = sub tmp[2] tmp[1]; + tcall ack (tmp[1], tmp[0]); + }; + }; + }; + }; +} + +function main() : * { + tmp[0] = 7; + tmp[1] = 0; + tmp[0] = call ack (tmp[1], tmp[0]); + tmp[2] = tmp[0]; + tmp[0] = 7; + tmp[1] = 1; + tmp[0] = call ack (tmp[1], tmp[0]); + tmp[2] = add tmp[2] tmp[0]; + tmp[0] = 13; + tmp[1] = 1; + tmp[0] = call ack (tmp[1], tmp[0]); + tmp[2] = add tmp[2] tmp[0]; + tmp[0] = 7; + tmp[1] = 2; + tmp[0] = call ack (tmp[1], tmp[0]); + tmp[2] = tmp[0]; + tmp[0] = 13; + tmp[1] = 2; + tmp[0] = call ack (tmp[1], tmp[0]); + tmp[2] = add tmp[2] tmp[0]; + tmp[0] = 4; + tmp[1] = 3; + tmp[0] = call ack (tmp[1], tmp[0]); + tmp[2] = add tmp[2] tmp[0]; + ret tmp[2]; +} diff --git a/tests/Casm/Reg/positive/test034.jvr b/tests/Casm/Reg/positive/test034.jvr new file mode 100644 index 000000000..237e53af2 --- /dev/null +++ b/tests/Casm/Reg/positive/test034.jvr @@ -0,0 +1,98 @@ + +function compose(* → *, * → *, *) : *; +function id(*) : *; +function iterate(* → *, integer) : * → *; +function inc(integer) : integer; +function plus(integer, integer) : integer; +function mult(integer, integer) : integer; +function exp(integer, integer) : integer; +function main() : *; + +function compose(* → *, * → *, *) : * { + tmp[0] = arg[2]; + tmp[1] = arg[1]; + tmp[0] = call tmp[1] (tmp[0]), live: (arg[0], arg[1], arg[2]); + tmp[1] = arg[0]; + tcall tmp[1] (tmp[0]); +} + +function id(*) : * { + tmp[0] = arg[0]; + ret tmp[0]; +} + +function iterate(* → *, integer) : * → * { + tmp[0] = 0; + tmp[1] = arg[1]; + tmp[0] = eq tmp[1] tmp[0]; + br tmp[0] { + true: { + prealloc 2, live: (arg[0], arg[1]); + tmp[0] = calloc id (); + ret tmp[0]; + }; + false: { + tmp[0] = 1; + tmp[1] = arg[1]; + tmp[0] = sub tmp[1] tmp[0]; + tmp[1] = arg[0]; + tmp[0] = call iterate (tmp[1], tmp[0]), live: (arg[0], arg[1]); + prealloc 4, live: (tmp[0], arg[0], arg[1]); + tmp[1] = arg[0]; + tmp[0] = calloc compose (tmp[1], tmp[0]); + ret tmp[0]; + }; + }; +} + +function inc(integer) : integer { + tmp[0] = 1; + tmp[1] = arg[0]; + tmp[0] = add tmp[1] tmp[0]; + ret tmp[0]; +} + +function plus(integer, integer) : integer { + prealloc 2, live: (arg[0], arg[1]); + tmp[0] = arg[1]; + tmp[1] = arg[0]; + tmp[2] = calloc inc (); + tmp[1] = call iterate (tmp[2], tmp[1]), live: (tmp[0], arg[0], arg[1]); + tcall tmp[1] (tmp[0]); +} + +function mult(integer, integer) : integer { + prealloc 3, live: (arg[0], arg[1]); + tmp[0] = 0; + tmp[1] = arg[0]; + tmp[2] = arg[1]; + tmp[2] = calloc plus (tmp[2]); + tmp[1] = call iterate (tmp[2], tmp[1]), live: (tmp[0], arg[0], arg[1]); + tcall tmp[1] (tmp[0]); +} + +function exp(integer, integer) : integer { + prealloc 3, live: (arg[0], arg[1]); + tmp[0] = 1; + tmp[1] = arg[1]; + tmp[2] = arg[0]; + tmp[2] = calloc mult (tmp[2]); + tmp[1] = call iterate (tmp[2], tmp[1]), live: (tmp[0], arg[0], arg[1]); + tcall tmp[1] (tmp[0]); +} + +function main() : * { + tmp[0] = 7; + tmp[1] = 3; + tmp[0] = call plus (tmp[1], tmp[0]); + tmp[2] = tmp[0]; + tmp[0] = 7; + tmp[1] = 3; + tmp[0] = call mult (tmp[1], tmp[0]); + tmp[2] = add tmp[2] tmp[0]; + tmp[0] = 7; + tmp[1] = 3; + tmp[0] = call exp (tmp[1], tmp[0]); + tmp[2] = add tmp[2] tmp[0]; + ret tmp[2]; +} diff --git a/tests/Casm/Reg/positive/test036.jvr b/tests/Casm/Reg/positive/test036.jvr new file mode 100644 index 000000000..25adfc28f --- /dev/null +++ b/tests/Casm/Reg/positive/test036.jvr @@ -0,0 +1,136 @@ +type stream { + cons : (integer, unit → stream) → stream; +} + +function force(unit → stream) : stream; +function filter(integer → bool, unit → stream, unit) : stream; +function nth(integer, unit → stream) : integer; +function numbers(integer, unit) : stream; +function indivisible(integer, integer) : bool; +function eratostenes(unit → stream, unit) : stream; +function primes(unit) : stream; +function main() : *; + +function force(f : unit → stream) : stream { + tmp[0] = unit; + tmp[1] = f; + tcall tmp[1] (tmp[0]); +} + +function filter(f : integer → bool, s : unit → stream, unit) : stream { + tmp[1] = s; + tmp[1] = call force (tmp[1]), live: (arg[0], arg[1], arg[2]); + { + s1 = tmp[1]; + tmp[1] = s1.cons[0]; + tmp[2] = f; + tmp[1] = call tmp[2] (tmp[1]), live: (tmp[0], arg[0], arg[1], arg[2]); + br tmp[1] { + true: { + prealloc 7, live: (tmp[0], arg[0], arg[1], arg[2]); + tmp[1] = s1.cons[1]; + tmp[2] = f; + tmp[1] = calloc filter (tmp[2], tmp[1]); + tmp[2] = s1.cons[0]; + tmp[1] = alloc cons (tmp[2], tmp[1]); + ret tmp[1]; + }; + false: { + tmp[1] = unit; + tmp[2] = s1.cons[1]; + tmp[3] = f; + tcall filter (tmp[3], tmp[2], tmp[1]); + }; + }; + }; +} + +function nth(n : integer, s : unit → stream) : integer { + tmp[1] = s; + tmp[1] = call force (tmp[1]), live: (arg[0], arg[1]); + { + s1 = tmp[1]; + tmp[1] = n; + tmp[2] = 0; + tmp[1] = eq tmp[2] tmp[1]; + br tmp[1] { + true: { + tmp[1] = s1.cons[0]; + ret tmp[1]; + }; + false: { + tmp[1] = s1.cons[1]; + tmp[2] = 1; + tmp[3] = n; + tmp[2] = sub tmp[3] tmp[2]; + tcall nth (tmp[2], tmp[1]); + }; + }; + }; +} + +function numbers(n : integer, unit) : stream { + prealloc 6, live: (arg[0], arg[1]); + tmp[0] = n; + tmp[1] = 1; + tmp[0] = add tmp[1] tmp[0]; + tmp[0] = calloc numbers (tmp[0]); + tmp[1] = n; + tmp[0] = alloc cons (tmp[1], tmp[0]); + ret tmp[0]; +} + +function indivisible(n : integer, m : integer) : bool { + tmp[0] = n; + tmp[1] = m; + tmp[0] = mod tmp[1] tmp[0]; + tmp[1] = 0; + tmp[0] = eq tmp[1] tmp[0]; + br tmp[0] { + true: { + tmp[0] = false; + ret tmp[0]; + }; + false: { + tmp[0] = true; + ret tmp[0]; + }; + }; +} + +function eratostenes(s : unit → stream, unit) : stream { + tmp[1] = s; + tmp[1] = call force (tmp[1]), live: (arg[0], arg[1]); + prealloc 13, live: (tmp[1], arg[0], arg[1]); + { + s1 = tmp[1]; + tmp[1] = s1.cons[1]; + tmp[2] = s1.cons[0]; + tmp[2] = calloc indivisible (tmp[2]); + tmp[1] = calloc filter (tmp[2], tmp[1]); + tmp[1] = calloc eratostenes (tmp[1]); + tmp[2] = s1.cons[0]; + tmp[1] = alloc cons (tmp[2], tmp[1]); + ret tmp[1]; + }; +} + +function primes() : unit → stream { + prealloc 6; + tmp[0] = 2; + tmp[0] = calloc numbers (tmp[0]); + tmp[0] = calloc eratostenes (tmp[0]); + ret tmp[0]; +} + +function main() : * { + tmp[0] = call primes (); + tmp[1] = 10; + tmp[0] = call nth (tmp[1], tmp[0]); + tmp[2] = tmp[0]; + tmp[0] = call primes (); + tmp[1] = 50; + tmp[0] = call nth (tmp[1], tmp[0]); + tmp[2] = add tmp[2] tmp[0]; + ret tmp[2]; +} diff --git a/tests/Casm/Reg/positive/test038.jvr b/tests/Casm/Reg/positive/test038.jvr new file mode 100644 index 000000000..9b9027ba8 --- /dev/null +++ b/tests/Casm/Reg/positive/test038.jvr @@ -0,0 +1,274 @@ + +function apply_1(*, *) : *; +function apply_2(*, *, *) : *; +function apply_3(*, *, *, *) : *; +function apply_4(*, *, *, *, *) : *; +function S(*, *, *) : *; +function K(*, *) : *; +function I(*) : *; +function f3(integer, integer, integer) : integer; +function main() : *; + +function apply_1(*, *) : * { + tmp[0] = arg[0]; + tmp[0] = argsnum tmp[0]; + tmp[1] = 1; + tmp[0] = eq tmp[1] tmp[0]; + br tmp[0] { + true: { + tmp[0] = arg[1]; + tmp[1] = arg[0]; + tcall tmp[1] (tmp[0]); + }; + false: { + prealloc 7, live: (arg[0], arg[1]); + tmp[0] = arg[1]; + tmp[1] = arg[0]; + tmp[0] = cextend tmp[1] (tmp[0]); + ret tmp[0]; + }; + }; +} + +function apply_2(*, *, *) : * { + tmp[1] = arg[0]; + tmp[1] = argsnum tmp[1]; + { + n = tmp[1]; + tmp[1] = n; + tmp[2] = 2; + tmp[1] = eq tmp[2] tmp[1]; + br tmp[1] { + true: { + tmp[1] = arg[2]; + tmp[2] = arg[1]; + tmp[3] = arg[0]; + tcall tmp[3] (tmp[2], tmp[1]); + }; + false: { + tmp[1] = n; + tmp[2] = 1; + tmp[1] = eq tmp[2] tmp[1]; + br tmp[1] { + true: { + tmp[1] = arg[2]; + tmp[2] = arg[1]; + tmp[3] = arg[0]; + tmp[2] = call tmp[3] (tmp[2]), live: (tmp[0], tmp[1], arg[0], arg[1], arg[2]); + tcall apply_1 (tmp[2], tmp[1]); + }; + false: { + prealloc 7, live: (tmp[0], arg[0], arg[1], arg[2]); + tmp[1] = arg[2]; + tmp[2] = arg[1]; + tmp[3] = arg[0]; + tmp[1] = cextend tmp[3] (tmp[2], tmp[1]); + ret tmp[1]; + }; + }; + }; + }; + }; +} + +function apply_3(*, *, *, *) : * { + tmp[1] = arg[0]; + tmp[1] = argsnum tmp[1]; + { + n = tmp[1]; + tmp[1] = n; + tmp[2] = 3; + tmp[1] = eq tmp[2] tmp[1]; + br tmp[1] { + true: { + tmp[1] = arg[3]; + tmp[2] = arg[2]; + tmp[3] = arg[1]; + tmp[4] = arg[0]; + tcall tmp[4] (tmp[3], tmp[2], tmp[1]); + }; + false: { + tmp[1] = n; + tmp[2] = 3; + tmp[1] = lt tmp[2] tmp[1]; + br tmp[1] { + true: { + prealloc 7, live: (tmp[0], arg[0], arg[1], arg[2], arg[3]); + tmp[1] = arg[3]; + tmp[2] = arg[2]; + tmp[3] = arg[1]; + tmp[4] = arg[0]; + tmp[1] = cextend tmp[4] (tmp[3], tmp[2], tmp[1]); + ret tmp[1]; + }; + false: { + tmp[1] = n; + tmp[2] = 2; + tmp[1] = eq tmp[2] tmp[1]; + br tmp[1] { + true: { + tmp[1] = arg[3]; + tmp[2] = arg[2]; + tmp[3] = arg[1]; + tmp[4] = arg[0]; + tmp[2] = call tmp[4] (tmp[3], tmp[2]), live: (tmp[0], tmp[1], arg[0], arg[1], arg[2], arg[3]); + tcall apply_1 (tmp[2], tmp[1]); + }; + false: { + tmp[1] = arg[3]; + tmp[2] = arg[2]; + tmp[3] = arg[1]; + tmp[4] = arg[0]; + tmp[3] = call tmp[4] (tmp[3]), live: (tmp[0], tmp[1], tmp[2], arg[0], arg[1], arg[2], arg[3]); + tcall apply_2 (tmp[3], tmp[2], tmp[1]); + }; + }; + }; + }; + }; + }; + }; +} + +function apply_4(*, *, *, *, *) : * { + tmp[1] = arg[0]; + tmp[1] = argsnum tmp[1]; + { + n = tmp[1]; + tmp[1] = n; + tmp[2] = 4; + tmp[1] = eq tmp[2] tmp[1]; + br tmp[1] { + true: { + tmp[1] = arg[4]; + tmp[2] = arg[3]; + tmp[3] = arg[2]; + tmp[4] = arg[1]; + tmp[5] = arg[0]; + tcall tmp[5] (tmp[4], tmp[3], tmp[2], tmp[1]); + }; + false: { + tmp[1] = n; + tmp[2] = 4; + tmp[1] = lt tmp[2] tmp[1]; + br tmp[1] { + true: { + prealloc 7, live: (tmp[0], arg[0], arg[1], arg[2], arg[3], arg[4]); + tmp[1] = arg[4]; + tmp[2] = arg[3]; + tmp[3] = arg[2]; + tmp[4] = arg[1]; + tmp[5] = arg[0]; + tmp[1] = cextend tmp[5] (tmp[4], tmp[3], tmp[2], tmp[1]); + ret tmp[1]; + }; + false: { + tmp[1] = n; + tmp[2] = 3; + tmp[1] = eq tmp[2] tmp[1]; + br tmp[1] { + true: { + tmp[1] = arg[4]; + tmp[2] = arg[3]; + tmp[3] = arg[2]; + tmp[4] = arg[1]; + tmp[5] = arg[0]; + tmp[2] = call tmp[5] (tmp[4], tmp[3], tmp[2]), live: (tmp[0], tmp[1], arg[0], arg[1], arg[2], arg[3], arg[4]); + tcall apply_1 (tmp[2], tmp[1]); + }; + false: { + tmp[1] = n; + tmp[2] = 2; + tmp[1] = eq tmp[2] tmp[1]; + br tmp[1] { + true: { + tmp[1] = arg[4]; + tmp[2] = arg[3]; + tmp[3] = arg[2]; + tmp[4] = arg[1]; + tmp[5] = arg[0]; + tmp[3] = call tmp[5] (tmp[4], tmp[3]), live: (tmp[0], tmp[1], tmp[2], arg[0], arg[1], arg[2], arg[3], arg[4]); + tcall apply_2 (tmp[3], tmp[2], tmp[1]); + }; + false: { + tmp[1] = arg[4]; + tmp[2] = arg[3]; + tmp[3] = arg[2]; + tmp[4] = arg[1]; + tmp[5] = arg[0]; + tmp[4] = call tmp[5] (tmp[4]), live: (tmp[0], tmp[1], tmp[2], tmp[3], arg[0], arg[1], arg[2], arg[3], arg[4]); + tcall apply_3 (tmp[4], tmp[3], tmp[2], tmp[1]); + }; + }; + }; + }; + }; + }; + }; + }; + }; +} + +function S(*, *, *) : * { + tmp[0] = arg[2]; + tmp[1] = arg[1]; + tmp[0] = call apply_1 (tmp[1], tmp[0]), live: (arg[0], arg[1], arg[2]); + tmp[1] = arg[2]; + tmp[2] = arg[0]; + tcall apply_2 (tmp[2], tmp[1], tmp[0]); +} + +function K(*, *) : * { + tmp[0] = arg[0]; + ret tmp[0]; +} + +function I(*) : * { + prealloc 4, live: (arg[0]); + tmp[0] = arg[0]; + tmp[1] = calloc K (); + tmp[2] = calloc K (); + tcall S (tmp[2], tmp[1], tmp[0]); +} + +function f3(integer, integer, integer) : integer { + tmp[0] = arg[2]; + tmp[1] = arg[1]; + tmp[2] = arg[0]; + tmp[1] = add tmp[2] tmp[1]; + tmp[0] = mul tmp[1] tmp[0]; + ret tmp[0]; +} + +function main() : * { + prealloc 14; + tmp[0] = 7; + tmp[1] = 1; + tmp[2] = calloc I (); + tmp[3] = calloc I (); + tmp[4] = calloc I (); + tmp[5] = calloc I (); + tmp[6] = calloc I (); + tmp[7] = calloc I (); + tmp[8] = calloc I (); + tmp[4] = call apply_4 (tmp[8], tmp[7], tmp[6], tmp[5], tmp[4]), live: (tmp[0], tmp[1], tmp[2], tmp[3]); + tmp[1] = call apply_3 (tmp[4], tmp[3], tmp[2], tmp[1]), live: (tmp[0]); + prealloc 6, live: (tmp[0], tmp[1]); + tmp[2] = 2; + tmp[3] = calloc I (); + tmp[4] = calloc I (); + tmp[5] = calloc I (); + tmp[2] = call apply_3 (tmp[5], tmp[4], tmp[3], tmp[2]), live: (tmp[0], tmp[1]); + prealloc 6, live: (tmp[0], tmp[1], tmp[2]); + tmp[3] = 3; + tmp[4] = calloc I (); + tmp[5] = calloc I (); + tmp[6] = calloc I (); + tmp[3] = call apply_3 (tmp[6], tmp[5], tmp[4], tmp[3]), live: (tmp[0], tmp[1], tmp[2]); + prealloc 2, live: (tmp[0], tmp[1], tmp[2], tmp[3]); + tmp[4] = calloc f3 (); + tmp[1] = call apply_3 (tmp[4], tmp[3], tmp[2], tmp[1]), live: (tmp[0]); + prealloc 2, live: (tmp[0], tmp[1]); + tmp[2] = calloc K (); + tcall apply_2 (tmp[2], tmp[1], tmp[0]); +} diff --git a/tests/Casm/positive/out/test007.out b/tests/Casm/positive/out/test007.out index 64bb6b746..87523dd7a 100644 --- a/tests/Casm/positive/out/test007.out +++ b/tests/Casm/positive/out/test007.out @@ -1 +1 @@ -30 +41 diff --git a/tests/Casm/positive/test007.casm b/tests/Casm/positive/test007.casm index 1f8b08b7f..a7243c1d0 100644 --- a/tests/Casm/positive/test007.casm +++ b/tests/Casm/positive/test007.casm @@ -34,8 +34,14 @@ mult: [ap] = [fp - 3] * [fp - 4]; ap++ ret +g: + [ap] = [fp - 3] - [fp - 4]; ap++ + [ap] = [ap - 1] + [fp - 5]; ap++ + [ap] = [ap - 1] * [fp - 6]; ap++ + ret + main: - ap += 2 + ap += 3 -- calloc plus 0 call get_regs [ap] = plus; ap++ @@ -63,9 +69,21 @@ main: call f -- 10 [ap] = [ap - 1] + [fp]; ap++ - [ap] = [ap - 1] + [fp + 1]; ap++ + [fp + 2] = [ap - 1] + [fp + 1] + -- [fp + 2] = 30 + -- calloc g 2 + call get_regs + [ap] = g; ap++ + [ap] = 7; ap++ + [ap] = 7; ap++ + [ap] = 3; ap++ + [ap] = 2; ap++ + [ap] = [ap - 7] + 2; ap++ + call f + -- 11 + [ap] = [fp + 2] + [ap - 1]; ap++ ret - -- result: 30 + -- result: 41 get_regs: call get_ap_reg @@ -103,17 +121,15 @@ call_closure: -- [fp - 3]: closure; [fp - 4]: argument extend_closure_1: - ap += 3 - call get_regs - [fp] = [ap - 2] + 2 + ap += 5 -- 9 - sargs [fp + 1] = [[fp - 3] + 1] -- 9 - argsnum (expected) [fp + 2] = [[fp - 3] + 2] - [ap] = [[fp - 3]]; ap++ - [ap] = [fp + 1] - 1; ap++ - [ap] = [fp + 2] + 1; ap++ - -- jmp rel (9 - sargs) + [fp + 3] = 9 + -- [fp + 4] = sargs + [fp + 4] = [fp + 3] - [fp + 1] + -- copy stored args reversing them jmp rel [fp + 1] [ap] = [[fp - 3] + 10]; ap++ [ap] = [[fp - 3] + 9]; ap++ @@ -123,6 +139,21 @@ extend_closure_1: [ap] = [[fp - 3] + 5]; ap++ [ap] = [[fp - 3] + 4]; ap++ [ap] = [[fp - 3] + 3]; ap++ + call get_regs + [fp] = [ap - 2] + 2 + [ap] = [[fp - 3]]; ap++ + [ap] = [fp + 1] - 1; ap++ + [ap] = [fp + 2] + 1; ap++ + -- jmp rel (9 - sargs) + jmp rel [fp + 1] + [ap] = [fp + 11]; ap++ + [ap] = [fp + 10]; ap++ + [ap] = [fp + 9]; ap++ + [ap] = [fp + 8]; ap++ + [ap] = [fp + 8]; ap++ + [ap] = [fp + 7]; ap++ + [ap] = [fp + 6]; ap++ + [ap] = [fp + 5]; ap++ -- extra args [ap] = [fp - 4]; ap++ [ap] = [fp]; ap++ diff --git a/tests/Casm/positive/test008.casm b/tests/Casm/positive/test008.casm index 6b0a3097e..e33e8ba47 100644 --- a/tests/Casm/positive/test008.casm +++ b/tests/Casm/positive/test008.casm @@ -18,12 +18,13 @@ main: [ap] = 5; ap++ [ap] = 0; ap++ [ap] = [ap - 1] imul [ap - 2]; ap++ - [fp + 1] = [ap - 1] ilt 1 -- 1 + [fp + 1] = [ap - 1] ilt 1 -- true = 0 [ap] = [fp] imul 7; ap++ [ap] = [ap - 1] idiv 3; ap++ [ap] = [ap - 1] iadd 2; ap++ [ap] = [ap - 1] iadd [fp]; ap++ [ap] = [ap - 1] iadd [fp + 1]; ap++ + [ap] = [ap - 1] iadd 1; ap++ ret end: diff --git a/tests/Casm/positive/test013.casm b/tests/Casm/positive/test013.casm index 4c6e6479c..9e4d38a9f 100644 --- a/tests/Casm/positive/test013.casm +++ b/tests/Casm/positive/test013.casm @@ -149,17 +149,15 @@ call_closure: -- [fp - 3]: closure; [fp - 4]: argument extend_closure_1: - ap += 3 - call get_regs - [fp] = [ap - 2] + 2 + ap += 5 -- 9 - sargs [fp + 1] = [[fp - 3] + 1] -- 9 - argsnum (expected) [fp + 2] = [[fp - 3] + 2] - [ap] = [[fp - 3]]; ap++ - [ap] = [fp + 1] - 1; ap++ - [ap] = [fp + 2] + 1; ap++ - -- jmp rel (9 - sargs) + [fp + 3] = 9 + -- [fp + 4] = sargs + [fp + 4] = [fp + 3] - [fp + 1] + -- copy stored args reversing them jmp rel [fp + 1] [ap] = [[fp - 3] + 10]; ap++ [ap] = [[fp - 3] + 9]; ap++ @@ -169,6 +167,21 @@ extend_closure_1: [ap] = [[fp - 3] + 5]; ap++ [ap] = [[fp - 3] + 4]; ap++ [ap] = [[fp - 3] + 3]; ap++ + call get_regs + [fp] = [ap - 2] + 2 + [ap] = [[fp - 3]]; ap++ + [ap] = [fp + 1] - 1; ap++ + [ap] = [fp + 2] + 1; ap++ + -- jmp rel (9 - sargs) + jmp rel [fp + 1] + [ap] = [fp + 11]; ap++ + [ap] = [fp + 10]; ap++ + [ap] = [fp + 9]; ap++ + [ap] = [fp + 8]; ap++ + [ap] = [fp + 8]; ap++ + [ap] = [fp + 7]; ap++ + [ap] = [fp + 6]; ap++ + [ap] = [fp + 5]; ap++ -- extra args [ap] = [fp - 4]; ap++ [ap] = [fp]; ap++ diff --git a/tests/Reg/positive/out/test018.out b/tests/Reg/positive/out/test018.out index 5ebe23636..d3c70f908 100644 --- a/tests/Reg/positive/out/test018.out +++ b/tests/Reg/positive/out/test018.out @@ -1,3 +1,4 @@ 11 9 10 +11 diff --git a/tests/Reg/positive/test018.jvr b/tests/Reg/positive/test018.jvr index 899fbb018..c0d849d75 100644 --- a/tests/Reg/positive/test018.jvr +++ b/tests/Reg/positive/test018.jvr @@ -5,10 +5,11 @@ function f((integer, integer) → integer) : integer; function plus(integer, integer) : integer; function minus(integer, integer) : integer; function mult(integer, integer) : integer; +function g(integer, integer, integer, integer) : integer; function main() : *; function ext_10((integer, integer) → integer) : integer → integer { - prealloc 4, live: (arg[0]); + prealloc 6, live: (arg[0]); tmp[0] = 10; tmp[1] = arg[0]; tmp[0] = cextend tmp[1] (tmp[0]); @@ -48,6 +49,17 @@ function mult(integer, integer) : integer { ret tmp[0]; } +function g(integer, integer, integer, integer) : integer { + tmp[0] = arg[1]; + tmp[1] = arg[0]; + tmp[0] = sub tmp[1] tmp[0]; + tmp[1] = arg[2]; + tmp[0] = add tmp[1] tmp[0]; + tmp[1] = arg[3]; + tmp[0] = mul tmp[1] tmp[0]; + ret tmp[0]; +} + function main() : * { prealloc 2; tmp[0] = calloc plus (); @@ -62,6 +74,13 @@ function main() : * { nop; tmp[0] = calloc mult (); tmp[0] = call f (tmp[0]); + prealloc 4, live: (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 2; + tmp[1] = 3; + tmp[0] = calloc g (tmp[1], tmp[0]); + tmp[0] = call f (tmp[0]); trace tmp[0]; nop; tmp[0] = void; diff --git a/tests/Tree/positive/out/test018.out b/tests/Tree/positive/out/test018.out index 5ebe23636..d3c70f908 100644 --- a/tests/Tree/positive/out/test018.out +++ b/tests/Tree/positive/out/test018.out @@ -1,3 +1,4 @@ 11 9 10 +11 diff --git a/tests/Tree/positive/test018.jvt b/tests/Tree/positive/test018.jvt index 3bb21d19b..c548ca2aa 100644 --- a/tests/Tree/positive/test018.jvt +++ b/tests/Tree/positive/test018.jvt @@ -5,6 +5,7 @@ function f((integer, integer) → integer) : integer; function plus(integer, integer) : integer; function minus(integer, integer) : integer; function mult(integer, integer) : integer; +function g(integer, integer, integer, integer) : integer; function main() : *; function ext_10((integer, integer) → integer) : integer → integer { @@ -31,12 +32,18 @@ function mult(integer, integer) : integer { mul(arg[0], arg[1]) } +function g(integer, integer, integer, integer) : integer { + mul(arg[3], add(arg[2], sub(arg[0], arg[1]))) +} + function main() : * { - seq(seq(seq(save(call[f](calloc[plus]())) { + seq(seq(seq(seq(save(call[f](calloc[plus]())) { seq(trace(tmp[0]), tmp[0]) }, save(call[f](calloc[minus]())) { seq(trace(tmp[0]), tmp[0]) }), save(call[f](calloc[mult]())) { seq(trace(tmp[0]), tmp[0]) + }), save(call[f](calloc[g](3, 2))) { + seq(trace(tmp[0]), tmp[0]) }), void) }