From ed15e57d8a58bf9f0a5ee55f7cd146df41dd6035 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C5=81ukasz=20Czajka?= <62751+lukaszcz@users.noreply.github.com> Date: Fri, 9 Feb 2024 12:19:29 +0100 Subject: [PATCH] JuvixReg parser and pretty printer (#2617) * Closes #2578 * Implements JuvixReg parser and pretty printer. * Adds the `juvix dev reg read file.jvr` command. * Adds the `reg` target to the `compile` commands. * Adds tests for the JuvixReg parser. --- app/Commands/Compile.hs | 1 + app/Commands/Dev.hs | 2 + app/Commands/Dev/Asm/Compile.hs | 40 +- app/Commands/Dev/Asm/Compile/Options.hs | 2 +- app/Commands/Dev/Core/Compile.hs | 1 + app/Commands/Dev/Core/Compile/Base.hs | 15 + app/Commands/Dev/Core/Compile/Options.hs | 3 +- app/Commands/Dev/Options.hs | 10 + app/Commands/Dev/Reg.hs | 9 + app/Commands/Dev/Reg/Options.hs | 24 + app/Commands/Dev/Reg/Read.hs | 19 + app/Commands/Dev/Reg/Read/Options.hs | 15 + app/Commands/Dev/Tree/Compile.hs | 1 + app/Commands/Dev/Tree/Compile/Base.hs | 15 + app/Commands/Dev/Tree/Compile/Options.hs | 1 + app/Commands/Extra/Compile.hs | 4 + app/Commands/Extra/Compile/Options.hs | 2 + src/Juvix/Compiler/Asm/Pretty/Base.hs | 47 +- .../Compiler/Asm/Translation/FromSource.hs | 21 +- src/Juvix/Compiler/Backend.hs | 16 + src/Juvix/Compiler/Backend/C/Language.hs | 2 +- .../Compiler/Backend/C/Translation/FromReg.hs | 59 ++- .../Backend/C/Translation/FromReg/Base.hs | 3 + src/Juvix/Compiler/Pipeline.hs | 14 +- src/Juvix/Compiler/Reg/Data/InfoTable.hs | 55 +- .../Compiler/Reg/Data/InfoTableBuilder.hs | 43 ++ src/Juvix/Compiler/Reg/Extra.hs | 79 ++- src/Juvix/Compiler/Reg/Keywords.hs | 47 ++ src/Juvix/Compiler/Reg/Language.hs | 71 ++- src/Juvix/Compiler/Reg/Language/Base.hs | 2 + src/Juvix/Compiler/Reg/Pretty.hs | 28 + src/Juvix/Compiler/Reg/Pretty/Base.hs | 285 ++++++++++ src/Juvix/Compiler/Reg/Pretty/Options.hs | 6 + src/Juvix/Compiler/Reg/Translation/FromAsm.hs | 132 +++-- .../Compiler/Reg/Translation/FromSource.hs | 489 ++++++++++++++++++ .../Reg/Translation/FromSource/Lexer.hs | 25 + .../Tree/Data/InfoTableBuilder/Base.hs | 4 + src/Juvix/Compiler/Tree/Language/Base.hs | 6 + src/Juvix/Compiler/Tree/Language/Rep.hs | 5 + src/Juvix/Compiler/Tree/Pretty/Base.hs | 40 +- src/Juvix/Compiler/Tree/Pretty/Extra.hs | 37 ++ .../Compiler/Tree/Translation/FromSource.hs | 21 +- .../Tree/Translation/FromSource/Base.hs | 185 +++---- .../Tree/Translation/FromSource/Sig.hs | 40 +- src/Juvix/Data/FileExt.hs | 14 + src/Juvix/Data/Keyword/All.hs | 21 + src/Juvix/Extra/Strings.hs | 15 + test/Main.hs | 2 + test/Reg.hs | 7 + test/Reg/Parse.hs | 7 + test/Reg/Parse/Base.hs | 32 ++ test/Reg/Parse/Positive.hs | 227 ++++++++ tests/Reg/positive/out/test001.out | 1 + tests/Reg/positive/out/test002.out | 1 + tests/Reg/positive/out/test003.out | 1 + tests/Reg/positive/out/test004.out | 1 + tests/Reg/positive/out/test005.out | 6 + tests/Reg/positive/out/test006.out | 2 + tests/Reg/positive/out/test007.out | 1 + tests/Reg/positive/out/test008.out | 1 + tests/Reg/positive/out/test009.out | 7 + tests/Reg/positive/out/test010.out | 1 + tests/Reg/positive/out/test011.out | 4 + tests/Reg/positive/out/test012.out | 1 + tests/Reg/positive/out/test013.out | 3 + tests/Reg/positive/out/test014.out | 155 ++++++ tests/Reg/positive/out/test015.out | 4 + tests/Reg/positive/out/test016.out | 5 + tests/Reg/positive/out/test017.out | 6 + tests/Reg/positive/out/test018.out | 3 + tests/Reg/positive/out/test019.out | 1 + tests/Reg/positive/out/test020.out | 1 + tests/Reg/positive/out/test021.out | 1 + tests/Reg/positive/out/test022.out | 1 + tests/Reg/positive/out/test023.out | 4 + tests/Reg/positive/out/test024.out | 24 + tests/Reg/positive/out/test025.out | 3 + tests/Reg/positive/out/test026.out | 3 + tests/Reg/positive/out/test027.out | 3 + tests/Reg/positive/out/test028.out | 7 + tests/Reg/positive/out/test029.out | 7 + tests/Reg/positive/out/test030.out | 3 + tests/Reg/positive/out/test031.out | 4 + tests/Reg/positive/out/test032.out | 7 + tests/Reg/positive/out/test033.out | 6 + tests/Reg/positive/out/test034.out | 3 + tests/Reg/positive/out/test035.out | 2 + tests/Reg/positive/out/test036.out | 2 + tests/Reg/positive/out/test037.out | 1 + tests/Reg/positive/out/test038.out | 1 + tests/Reg/positive/test001.jvr | 21 + tests/Reg/positive/test002.jvr | 20 + tests/Reg/positive/test003.jvr | 22 + tests/Reg/positive/test004.jvr | 36 ++ tests/Reg/positive/test005.jvr | 21 + tests/Reg/positive/test006.jvr | 65 +++ tests/Reg/positive/test007.jvr | 65 +++ tests/Reg/positive/test008.jvr | 44 ++ tests/Reg/positive/test009.jvr | 138 +++++ tests/Reg/positive/test010.jvr | 28 + tests/Reg/positive/test011.jvr | 77 +++ tests/Reg/positive/test012.jvr | 43 ++ tests/Reg/positive/test013.jvr | 52 ++ tests/Reg/positive/test014.jvr | 144 ++++++ tests/Reg/positive/test015.jvr | 94 ++++ tests/Reg/positive/test016.jvr | 78 +++ tests/Reg/positive/test017.jvr | 129 +++++ tests/Reg/positive/test018.jvr | 69 +++ tests/Reg/positive/test019.jvr | 38 ++ tests/Reg/positive/test020.jvr | 46 ++ tests/Reg/positive/test021.jvr | 33 ++ tests/Reg/positive/test022.jvr | 23 + tests/Reg/positive/test023.jvr | 45 ++ tests/Reg/positive/test024.jvr | 60 +++ tests/Reg/positive/test025.jvr | 73 +++ tests/Reg/positive/test026.jvr | 96 ++++ tests/Reg/positive/test027.jvr | 74 +++ tests/Reg/positive/test028.jvr | 305 +++++++++++ tests/Reg/positive/test029.jvr | 67 +++ tests/Reg/positive/test030.jvr | 93 ++++ tests/Reg/positive/test031.jvr | 208 ++++++++ tests/Reg/positive/test032.jvr | 263 ++++++++++ tests/Reg/positive/test033.jvr | 77 +++ tests/Reg/positive/test034.jvr | 102 ++++ tests/Reg/positive/test035.jvr | 105 ++++ tests/Reg/positive/test036.jvr | 139 +++++ tests/Reg/positive/test037.jvr | 15 + tests/Reg/positive/test038.jvr | 274 ++++++++++ 128 files changed, 5433 insertions(+), 387 deletions(-) create mode 100644 app/Commands/Dev/Reg.hs create mode 100644 app/Commands/Dev/Reg/Options.hs create mode 100644 app/Commands/Dev/Reg/Read.hs create mode 100644 app/Commands/Dev/Reg/Read/Options.hs create mode 100644 src/Juvix/Compiler/Reg/Data/InfoTableBuilder.hs create mode 100644 src/Juvix/Compiler/Reg/Keywords.hs create mode 100644 src/Juvix/Compiler/Reg/Pretty.hs create mode 100644 src/Juvix/Compiler/Reg/Pretty/Base.hs create mode 100644 src/Juvix/Compiler/Reg/Pretty/Options.hs create mode 100644 src/Juvix/Compiler/Reg/Translation/FromSource.hs create mode 100644 src/Juvix/Compiler/Reg/Translation/FromSource/Lexer.hs create mode 100644 src/Juvix/Compiler/Tree/Pretty/Extra.hs create mode 100644 test/Reg.hs create mode 100644 test/Reg/Parse.hs create mode 100644 test/Reg/Parse/Base.hs create mode 100644 test/Reg/Parse/Positive.hs create mode 100644 tests/Reg/positive/out/test001.out create mode 100644 tests/Reg/positive/out/test002.out create mode 100644 tests/Reg/positive/out/test003.out create mode 100644 tests/Reg/positive/out/test004.out create mode 100644 tests/Reg/positive/out/test005.out create mode 100644 tests/Reg/positive/out/test006.out create mode 100644 tests/Reg/positive/out/test007.out create mode 100644 tests/Reg/positive/out/test008.out create mode 100644 tests/Reg/positive/out/test009.out create mode 100644 tests/Reg/positive/out/test010.out create mode 100644 tests/Reg/positive/out/test011.out create mode 100644 tests/Reg/positive/out/test012.out create mode 100644 tests/Reg/positive/out/test013.out create mode 100644 tests/Reg/positive/out/test014.out create mode 100644 tests/Reg/positive/out/test015.out create mode 100644 tests/Reg/positive/out/test016.out create mode 100644 tests/Reg/positive/out/test017.out create mode 100644 tests/Reg/positive/out/test018.out create mode 100644 tests/Reg/positive/out/test019.out create mode 100644 tests/Reg/positive/out/test020.out create mode 100644 tests/Reg/positive/out/test021.out create mode 100644 tests/Reg/positive/out/test022.out create mode 100644 tests/Reg/positive/out/test023.out create mode 100644 tests/Reg/positive/out/test024.out create mode 100644 tests/Reg/positive/out/test025.out create mode 100644 tests/Reg/positive/out/test026.out create mode 100644 tests/Reg/positive/out/test027.out create mode 100644 tests/Reg/positive/out/test028.out create mode 100644 tests/Reg/positive/out/test029.out create mode 100644 tests/Reg/positive/out/test030.out create mode 100644 tests/Reg/positive/out/test031.out create mode 100644 tests/Reg/positive/out/test032.out create mode 100644 tests/Reg/positive/out/test033.out create mode 100644 tests/Reg/positive/out/test034.out create mode 100644 tests/Reg/positive/out/test035.out create mode 100644 tests/Reg/positive/out/test036.out create mode 100644 tests/Reg/positive/out/test037.out create mode 100644 tests/Reg/positive/out/test038.out create mode 100644 tests/Reg/positive/test001.jvr create mode 100644 tests/Reg/positive/test002.jvr create mode 100644 tests/Reg/positive/test003.jvr create mode 100644 tests/Reg/positive/test004.jvr create mode 100644 tests/Reg/positive/test005.jvr create mode 100644 tests/Reg/positive/test006.jvr create mode 100644 tests/Reg/positive/test007.jvr create mode 100644 tests/Reg/positive/test008.jvr create mode 100644 tests/Reg/positive/test009.jvr create mode 100644 tests/Reg/positive/test010.jvr create mode 100644 tests/Reg/positive/test011.jvr create mode 100644 tests/Reg/positive/test012.jvr create mode 100644 tests/Reg/positive/test013.jvr create mode 100644 tests/Reg/positive/test014.jvr create mode 100644 tests/Reg/positive/test015.jvr create mode 100644 tests/Reg/positive/test016.jvr create mode 100644 tests/Reg/positive/test017.jvr create mode 100644 tests/Reg/positive/test018.jvr create mode 100644 tests/Reg/positive/test019.jvr create mode 100644 tests/Reg/positive/test020.jvr create mode 100644 tests/Reg/positive/test021.jvr create mode 100644 tests/Reg/positive/test022.jvr create mode 100644 tests/Reg/positive/test023.jvr create mode 100644 tests/Reg/positive/test024.jvr create mode 100644 tests/Reg/positive/test025.jvr create mode 100644 tests/Reg/positive/test026.jvr create mode 100644 tests/Reg/positive/test027.jvr create mode 100644 tests/Reg/positive/test028.jvr create mode 100644 tests/Reg/positive/test029.jvr create mode 100644 tests/Reg/positive/test030.jvr create mode 100644 tests/Reg/positive/test031.jvr create mode 100644 tests/Reg/positive/test032.jvr create mode 100644 tests/Reg/positive/test033.jvr create mode 100644 tests/Reg/positive/test034.jvr create mode 100644 tests/Reg/positive/test035.jvr create mode 100644 tests/Reg/positive/test036.jvr create mode 100644 tests/Reg/positive/test037.jvr create mode 100644 tests/Reg/positive/test038.jvr diff --git a/app/Commands/Compile.hs b/app/Commands/Compile.hs index 4ac419d4d..5e185f9b0 100644 --- a/app/Commands/Compile.hs +++ b/app/Commands/Compile.hs @@ -26,6 +26,7 @@ runCommand opts@CompileOptions {..} = do TargetCore -> writeCoreFile arg TargetTree -> Compile.runTreePipeline arg TargetAsm -> Compile.runAsmPipeline arg + TargetReg -> Compile.runRegPipeline arg TargetNockma -> Compile.runNockmaPipeline arg writeCoreFile :: (Members '[Embed IO, App, TaggedLock] r) => Compile.PipelineArg -> Sem r () diff --git a/app/Commands/Dev.hs b/app/Commands/Dev.hs index bceffea5b..76fdacfe5 100644 --- a/app/Commands/Dev.hs +++ b/app/Commands/Dev.hs @@ -16,6 +16,7 @@ import Commands.Dev.MigrateJuvixYaml qualified as MigrateJuvixYaml import Commands.Dev.Nockma qualified as Nockma import Commands.Dev.Options import Commands.Dev.Parse qualified as Parse +import Commands.Dev.Reg qualified as Reg import Commands.Dev.Runtime qualified as Runtime import Commands.Dev.Scope qualified as Scope import Commands.Dev.Termination qualified as Termination @@ -32,6 +33,7 @@ runCommand = \case Core opts -> Core.runCommand opts Geb opts -> Geb.runCommand opts Asm opts -> Asm.runCommand opts + Reg opts -> Reg.runCommand opts Tree opts -> Tree.runCommand opts Casm opts -> Casm.runCommand opts Runtime opts -> Runtime.runCommand opts diff --git a/app/Commands/Dev/Asm/Compile.hs b/app/Commands/Dev/Asm/Compile.hs index f8f2628d9..c2f4dc305 100644 --- a/app/Commands/Dev/Asm/Compile.hs +++ b/app/Commands/Dev/Asm/Compile.hs @@ -6,6 +6,7 @@ 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.Reg.Pretty qualified as Reg runCommand :: forall r. (Members '[Embed IO, App, TaggedLock] r) => AsmCompileOptions -> Sem r () runCommand opts = do @@ -22,19 +23,31 @@ runCommand opts = do { _entryPointTarget = tgt, _entryPointDebug = opts ^. compileDebug } - case run $ runReader entryPoint $ runError $ asmToMiniC tab of - Left err -> exitJuvixError err - Right C.MiniCResult {..} -> do - buildDir <- askBuildDir - ensureDir buildDir - cFile <- inputCFile file - embed @IO $ writeFileEnsureLn cFile _resultCCode - outfile <- Compile.outputFile opts file - Compile.runCommand - opts - { _compileInputFile = Just (AppPath (preFileFromAbs cFile) False), - _compileOutputFile = Just (AppPath (preFileFromAbs outfile) False) - } + case opts ^. compileTarget of + TargetReg -> do + regFile <- Compile.outputFile opts file + r <- + runReader entryPoint + . runError @JuvixError + . asmToReg + $ tab + tab' <- getRight r + let code = Reg.ppPrint tab' tab' + embed @IO $ writeFileEnsureLn regFile code + _ -> + case run $ runReader entryPoint $ runError $ asmToMiniC tab of + Left err -> exitJuvixError err + Right C.MiniCResult {..} -> do + buildDir <- askBuildDir + ensureDir buildDir + cFile <- inputCFile file + embed @IO $ 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) @@ -43,6 +56,7 @@ runCommand opts = do getTarget = \case TargetWasm32Wasi -> return Backend.TargetCWasm32Wasi TargetNative64 -> return Backend.TargetCNative64 + TargetReg -> return Backend.TargetReg TargetNockma -> err "Nockma" TargetTree -> err "JuvixTree" TargetGeb -> err "GEB" diff --git a/app/Commands/Dev/Asm/Compile/Options.hs b/app/Commands/Dev/Asm/Compile/Options.hs index 0c3d016c8..ab234bb45 100644 --- a/app/Commands/Dev/Asm/Compile/Options.hs +++ b/app/Commands/Dev/Asm/Compile/Options.hs @@ -15,7 +15,7 @@ asmSupportedTargets = NonEmpty.fromList [ TargetWasm32Wasi, TargetNative64, - TargetNockma + TargetReg ] parseAsmCompileOptions :: Parser AsmCompileOptions diff --git a/app/Commands/Dev/Core/Compile.hs b/app/Commands/Dev/Core/Compile.hs index f904eb1e3..7d0910028 100644 --- a/app/Commands/Dev/Core/Compile.hs +++ b/app/Commands/Dev/Core/Compile.hs @@ -19,6 +19,7 @@ runCommand opts = do TargetVampIR -> runVampIRPipeline arg TargetCore -> return () TargetAsm -> runAsmPipeline arg + TargetReg -> runRegPipeline arg TargetTree -> runTreePipeline arg TargetNockma -> runNockmaPipeline arg where diff --git a/app/Commands/Dev/Core/Compile/Base.hs b/app/Commands/Dev/Core/Compile/Base.hs index 4de135a7f..9460f33e7 100644 --- a/app/Commands/Dev/Core/Compile/Base.hs +++ b/app/Commands/Dev/Core/Compile/Base.hs @@ -10,6 +10,7 @@ import Juvix.Compiler.Backend.Geb qualified as Geb import Juvix.Compiler.Backend.VampIR.Translation qualified as VampIR import Juvix.Compiler.Core.Data.Module 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 System.FilePath (takeBaseName) @@ -39,6 +40,7 @@ getEntry PipelineArg {..} = do TargetVampIR -> Backend.TargetVampIR TargetCore -> Backend.TargetCore TargetAsm -> Backend.TargetAsm + TargetReg -> Backend.TargetReg TargetTree -> Backend.TargetTree TargetNockma -> Backend.TargetNockma @@ -113,6 +115,19 @@ runAsmPipeline pa@PipelineArg {..} = do let code = Asm.ppPrint tab' tab' embed @IO $ writeFileEnsureLn asmFile code +runRegPipeline :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r () +runRegPipeline pa@PipelineArg {..} = do + entryPoint <- getEntry pa + regFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile + r <- + runReader entryPoint + . runError @JuvixError + . coreToReg + $ _pipelineArgModule + tab' <- getRight r + let code = Reg.ppPrint tab' tab' + embed @IO $ writeFileEnsureLn regFile code + runTreePipeline :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r () runTreePipeline pa@PipelineArg {..} = do entryPoint <- getEntry pa diff --git a/app/Commands/Dev/Core/Compile/Options.hs b/app/Commands/Dev/Core/Compile/Options.hs index 7d461182b..73298a730 100644 --- a/app/Commands/Dev/Core/Compile/Options.hs +++ b/app/Commands/Dev/Core/Compile/Options.hs @@ -17,8 +17,9 @@ coreSupportedTargets = TargetNative64, TargetGeb, TargetVampIR, + TargetTree, TargetAsm, - TargetTree + TargetReg ] parseCoreCompileOptions :: Parser CoreCompileOptions diff --git a/app/Commands/Dev/Options.hs b/app/Commands/Dev/Options.hs index ddd2c382d..b70b45c59 100644 --- a/app/Commands/Dev/Options.hs +++ b/app/Commands/Dev/Options.hs @@ -22,6 +22,7 @@ import Commands.Dev.Internal.Options import Commands.Dev.MigrateJuvixYaml.Options import Commands.Dev.Nockma.Options import Commands.Dev.Parse.Options +import Commands.Dev.Reg.Options import Commands.Dev.Repl.Options import Commands.Dev.Runtime.Options import Commands.Dev.Scope.Options @@ -37,6 +38,7 @@ data DevCommand | Core CoreCommand | Geb GebCommand | Asm AsmCommand + | Reg RegCommand | Tree TreeCommand | Casm CasmCommand | Runtime RuntimeCommand @@ -57,6 +59,7 @@ parseDevCommand = commandCore, commandGeb, commandAsm, + commandReg, commandTree, commandCasm, commandRuntime, @@ -105,6 +108,13 @@ commandAsm = (Asm <$> parseAsmCommand) (progDesc "Subcommands related to JuvixAsm") +commandReg :: Mod CommandFields DevCommand +commandReg = + command "reg" $ + info + (Reg <$> parseRegCommand) + (progDesc "Subcommands related to JuvixReg") + commandTree :: Mod CommandFields DevCommand commandTree = command "tree" $ diff --git a/app/Commands/Dev/Reg.hs b/app/Commands/Dev/Reg.hs new file mode 100644 index 000000000..fb2b69d25 --- /dev/null +++ b/app/Commands/Dev/Reg.hs @@ -0,0 +1,9 @@ +module Commands.Dev.Reg where + +import Commands.Base +import Commands.Dev.Reg.Options +import Commands.Dev.Reg.Read as Read + +runCommand :: forall r. (Members '[Embed IO, App, TaggedLock] r) => RegCommand -> Sem r () +runCommand = \case + Read opts -> Read.runCommand opts diff --git a/app/Commands/Dev/Reg/Options.hs b/app/Commands/Dev/Reg/Options.hs new file mode 100644 index 000000000..a2b6f2760 --- /dev/null +++ b/app/Commands/Dev/Reg/Options.hs @@ -0,0 +1,24 @@ +module Commands.Dev.Reg.Options where + +import Commands.Dev.Reg.Read.Options +import CommonOptions + +newtype RegCommand + = Read RegReadOptions + deriving stock (Data) + +parseRegCommand :: Parser RegCommand +parseRegCommand = + hsubparser $ + mconcat + [ commandRead + ] + where + commandRead :: Mod CommandFields RegCommand + commandRead = command "read" readInfo + + readInfo :: ParserInfo RegCommand + readInfo = + info + (Read <$> parseRegReadOptions) + (progDesc "Parse a JuvixReg file and pretty print it") diff --git a/app/Commands/Dev/Reg/Read.hs b/app/Commands/Dev/Reg/Read.hs new file mode 100644 index 000000000..6891082f7 --- /dev/null +++ b/app/Commands/Dev/Reg/Read.hs @@ -0,0 +1,19 @@ +module Commands.Dev.Reg.Read where + +import Commands.Base +import Commands.Dev.Reg.Read.Options +import Juvix.Compiler.Reg.Pretty qualified as Reg +import Juvix.Compiler.Reg.Translation.FromSource qualified as Reg + +runCommand :: forall r. (Members '[Embed IO, App] r) => RegReadOptions -> Sem r () +runCommand opts = do + afile :: Path Abs File <- fromAppPathFile file + s <- readFile (toFilePath afile) + case Reg.runParser (toFilePath afile) s of + Left err -> + exitJuvixError (JuvixError err) + Right tab -> + renderStdOut (Reg.ppOutDefault tab tab) + where + file :: AppPath File + file = opts ^. regReadInputFile diff --git a/app/Commands/Dev/Reg/Read/Options.hs b/app/Commands/Dev/Reg/Read/Options.hs new file mode 100644 index 000000000..b211325e4 --- /dev/null +++ b/app/Commands/Dev/Reg/Read/Options.hs @@ -0,0 +1,15 @@ +module Commands.Dev.Reg.Read.Options where + +import CommonOptions + +newtype RegReadOptions = RegReadOptions + { _regReadInputFile :: AppPath File + } + deriving stock (Data) + +makeLenses ''RegReadOptions + +parseRegReadOptions :: Parser RegReadOptions +parseRegReadOptions = do + _regReadInputFile <- parseInputFile FileExtJuvixAsm + pure RegReadOptions {..} diff --git a/app/Commands/Dev/Tree/Compile.hs b/app/Commands/Dev/Tree/Compile.hs index 0073b25ff..2da574274 100644 --- a/app/Commands/Dev/Tree/Compile.hs +++ b/app/Commands/Dev/Tree/Compile.hs @@ -18,6 +18,7 @@ runCommand opts = do TargetVampIR -> return () TargetCore -> return () TargetAsm -> runAsmPipeline arg + TargetReg -> runRegPipeline arg TargetTree -> return () TargetNockma -> runNockmaPipeline arg where diff --git a/app/Commands/Dev/Tree/Compile/Base.hs b/app/Commands/Dev/Tree/Compile/Base.hs index 449c70991..550c5fde5 100644 --- a/app/Commands/Dev/Tree/Compile/Base.hs +++ b/app/Commands/Dev/Tree/Compile/Base.hs @@ -7,6 +7,7 @@ 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.Nockma.Pretty qualified as Nockma +import Juvix.Compiler.Reg.Pretty qualified as Reg import Juvix.Compiler.Tree.Data.InfoTable qualified as Tree data PipelineArg = PipelineArg @@ -35,6 +36,7 @@ getEntry PipelineArg {..} = do TargetVampIR -> Backend.TargetVampIR TargetCore -> Backend.TargetCore TargetAsm -> Backend.TargetAsm + TargetReg -> Backend.TargetReg TargetTree -> Backend.TargetTree TargetNockma -> Backend.TargetNockma @@ -84,6 +86,19 @@ runAsmPipeline pa@PipelineArg {..} = do let code = Asm.ppPrint tab' tab' embed @IO $ writeFileEnsureLn asmFile code +runRegPipeline :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r () +runRegPipeline pa@PipelineArg {..} = do + entryPoint <- getEntry pa + regFile <- Compile.outputFile _pipelineArgOptions _pipelineArgFile + r <- + runReader entryPoint + . runError @JuvixError + . treeToReg + $ _pipelineArgTable + tab' <- getRight r + let code = Reg.ppPrint tab' tab' + embed @IO $ writeFileEnsureLn regFile code + runNockmaPipeline :: (Members '[Embed IO, App, TaggedLock] r) => PipelineArg -> Sem r () runNockmaPipeline pa@PipelineArg {..} = do entryPoint <- getEntry pa diff --git a/app/Commands/Dev/Tree/Compile/Options.hs b/app/Commands/Dev/Tree/Compile/Options.hs index 29c97a565..b7ea41107 100644 --- a/app/Commands/Dev/Tree/Compile/Options.hs +++ b/app/Commands/Dev/Tree/Compile/Options.hs @@ -13,6 +13,7 @@ treeSupportedTargets = [ TargetWasm32Wasi, TargetNative64, TargetAsm, + TargetReg, TargetNockma ] diff --git a/app/Commands/Extra/Compile.hs b/app/Commands/Extra/Compile.hs index 27267b70d..755837b89 100644 --- a/app/Commands/Extra/Compile.hs +++ b/app/Commands/Extra/Compile.hs @@ -33,6 +33,7 @@ runCompile inputFile o = do TargetVampIR -> return (Right ()) TargetCore -> return (Right ()) TargetAsm -> return (Right ()) + TargetReg -> return (Right ()) TargetTree -> return (Right ()) TargetNockma -> return (Right ()) @@ -50,6 +51,7 @@ prepareRuntime buildDir o = do TargetVampIR -> return () TargetCore -> return () TargetAsm -> return () + TargetReg -> return () TargetTree -> return () TargetNockma -> return () where @@ -109,6 +111,8 @@ outputFile opts inputFile = replaceExtension' juvixCoreFileExt baseOutputFile TargetAsm -> replaceExtension' juvixAsmFileExt baseOutputFile + TargetReg -> + replaceExtension' juvixRegFileExt baseOutputFile TargetTree -> replaceExtension' juvixTreeFileExt baseOutputFile TargetNockma -> diff --git a/app/Commands/Extra/Compile/Options.hs b/app/Commands/Extra/Compile/Options.hs index 55f21bd3c..b6622d46b 100644 --- a/app/Commands/Extra/Compile/Options.hs +++ b/app/Commands/Extra/Compile/Options.hs @@ -11,6 +11,7 @@ data CompileTarget | TargetVampIR | TargetCore | TargetAsm + | TargetReg | TargetTree | TargetNockma deriving stock (Eq, Data, Bounded, Enum) @@ -23,6 +24,7 @@ instance Show CompileTarget where TargetVampIR -> "vampir" TargetCore -> "core" TargetAsm -> "asm" + TargetReg -> "reg" TargetTree -> "tree" TargetNockma -> "nockma" diff --git a/src/Juvix/Compiler/Asm/Pretty/Base.hs b/src/Juvix/Compiler/Asm/Pretty/Base.hs index 16470ca3e..16629ac33 100644 --- a/src/Juvix/Compiler/Asm/Pretty/Base.hs +++ b/src/Juvix/Compiler/Asm/Pretty/Base.hs @@ -11,6 +11,7 @@ import Juvix.Compiler.Asm.Interpreter.RuntimeState import Juvix.Compiler.Asm.Pretty.Options import Juvix.Compiler.Internal.Data.Name import Juvix.Compiler.Tree.Pretty.Base qualified as Tree +import Juvix.Compiler.Tree.Pretty.Extra import Juvix.Data.CodeAnn import Juvix.Extra.Strings qualified as Str @@ -135,7 +136,7 @@ instance PrettyCode CaseBranch where ppCode CaseBranch {..} = do name <- Tree.ppConstrName _caseBranchTag br <- ppCodeCode _caseBranchCode - return $ name <> colon <+> braces' br + return $ name <> colon <+> braces' br <> semi instance PrettyCode Command where ppCode :: (Member (Reader Options) r) => Command -> Sem r (Doc Ann) @@ -149,10 +150,11 @@ instance PrettyCode Command where <+> braces' ( constr Str.true_ <> colon <+> braces' br1 + <> semi <> line <> constr Str.false_ <> colon - <+> braces' br2 + <+> braces' br2 <> semi ) Case CmdCase {..} -> do name <- Tree.ppIndName _cmdCaseInductive @@ -161,7 +163,7 @@ instance PrettyCode Command where Just def -> do d <- ( ppCodeCode - >=> (\x -> return $ primitive Str.default_ <> colon <+> braces' x) + >=> (\x -> return $ primitive Str.default_ <> colon <+> braces' x <> semi) ) def return $ brs ++ [d] @@ -185,42 +187,3 @@ instance PrettyCode ConstructorInfo where instance PrettyCode InfoTable where ppCode = Tree.ppInfoTable ppCodeCode - -{--------------------------------------------------------------------------------} -{- helper functions -} - -braces' :: Doc Ann -> Doc Ann -braces' d = braces (line <> indent' d <> line) - -integer :: (Pretty a) => a -> Doc Ann -integer i = annotate AnnLiteralInteger (pretty i) - -constr :: Text -> Doc Ann -constr a = annotate (AnnKind KNameConstructor) (pretty a) - -variable :: Text -> Doc Ann -variable a = annotate (AnnKind KNameLocal) (pretty a) - -ppRightExpression :: - (PrettyCode a, HasAtomicity a, Member (Reader Options) r) => - Fixity -> - a -> - Sem r (Doc Ann) -ppRightExpression = ppLRExpression isRightAssoc - -ppLeftExpression :: - (PrettyCode a, HasAtomicity a, Member (Reader Options) r) => - Fixity -> - a -> - Sem r (Doc Ann) -ppLeftExpression = ppLRExpression isLeftAssoc - -ppLRExpression :: - (HasAtomicity a, PrettyCode a, Member (Reader Options) r) => - (Fixity -> Bool) -> - Fixity -> - a -> - Sem r (Doc Ann) -ppLRExpression associates fixlr e = - parensIf (atomParens associates (atomicity e) fixlr) - <$> ppCode e diff --git a/src/Juvix/Compiler/Asm/Translation/FromSource.hs b/src/Juvix/Compiler/Asm/Translation/FromSource.hs index 55b76ad13..9d7e95480 100644 --- a/src/Juvix/Compiler/Asm/Translation/FromSource.hs +++ b/src/Juvix/Compiler/Asm/Translation/FromSource.hs @@ -17,13 +17,16 @@ import Juvix.Compiler.Tree.Translation.FromSource.Sig qualified as S import Juvix.Parser.Error import Text.Megaparsec qualified as P -type ParserSig = S.ParserSig Code (Maybe FunctionInfoExtra) +type ParserSig = S.ParserSig Code (Maybe FunctionInfoExtra) DirectRef + +type LocalParams = LocalParams' DirectRef parseAsmSig :: ParserSig parseAsmSig = S.ParserSig { _parserSigBareIdentifier = bareIdentifier, _parserSigParseCode = parseCode, + _parserSigArgRef = \x y -> ArgRef (OffsetRef x y), _parserSigEmptyCode = [], _parserSigEmptyExtra = mempty } @@ -88,7 +91,7 @@ command = do "argsnum" -> return $ mkInstr' loc ArgsNum "alloc" -> - mkInstr' loc . AllocConstr <$> constrTag @Code @(Maybe FunctionInfoExtra) + mkInstr' loc . AllocConstr <$> constrTag @Code @(Maybe FunctionInfoExtra) @DirectRef "calloc" -> mkInstr' loc . AllocClosure <$> instrAllocClosure "cextend" -> @@ -110,7 +113,7 @@ command = do rbrace return $ Branch $ CmdBranch (CommandInfo loc) br1 br2 "case" -> do - sym <- indSymbol @Code @(Maybe FunctionInfoExtra) + sym <- indSymbol @Code @(Maybe FunctionInfoExtra) @DirectRef lbrace brs <- P.many caseBranch def <- optional defaultBranch @@ -130,10 +133,10 @@ parseSave :: ParsecS r Command parseSave loc isTail = do mn <- optional identifier - tmpNum <- lift $ gets (^. localParamsTempIndex) - let updateNames :: LocalNameMap -> LocalNameMap + tmpNum <- lift $ gets @LocalParams (^. localParamsTempIndex) + let updateNames :: LocalNameMap DirectRef -> LocalNameMap DirectRef updateNames mp = maybe mp (\n -> HashMap.insert n (mkTempRef (OffsetRef tmpNum (Just n))) mp) mn - c <- braces (localS (over localParamsTempIndex (+ 1)) $ localS (over localParamsNameMap updateNames) parseCode) + c <- braces (localS @LocalParams (over localParamsTempIndex (+ 1)) $ localS @LocalParams (over localParamsNameMap updateNames) parseCode) return $ Save ( CmdSave @@ -153,7 +156,7 @@ instrAllocClosure :: (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => ParsecS r InstrAllocClosure instrAllocClosure = do - sym <- funSymbol @Code @(Maybe FunctionInfoExtra) + sym <- funSymbol @Code @(Maybe FunctionInfoExtra) @DirectRef (argsNum, _) <- integer return $ InstrAllocClosure sym (fromInteger argsNum) @@ -179,7 +182,7 @@ instrCall = do parseCallType :: (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => ParsecS r CallType -parseCallType = (kw kwDollar $> CallClosure) <|> (CallFun <$> funSymbol @Code @(Maybe FunctionInfoExtra)) +parseCallType = (kw kwDollar $> CallClosure) <|> (CallFun <$> funSymbol @Code @(Maybe FunctionInfoExtra) @DirectRef) instrCallClosures :: ParsecS r InstrCallClosures instrCallClosures = do @@ -213,7 +216,7 @@ caseBranch :: (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => ParsecS r CaseBranch caseBranch = do - tag <- P.try $ constrTag @Code @(Maybe FunctionInfoExtra) + tag <- P.try $ constrTag @Code @(Maybe FunctionInfoExtra) @DirectRef kw kwColon c <- CaseBranch tag <$> branchCode kw delimSemicolon diff --git a/src/Juvix/Compiler/Backend.hs b/src/Juvix/Compiler/Backend.hs index 1a94401b7..862e781c5 100644 --- a/src/Juvix/Compiler/Backend.hs +++ b/src/Juvix/Compiler/Backend.hs @@ -10,6 +10,7 @@ data Target | TargetVampIR | TargetCore | TargetAsm + | TargetReg | TargetTree | TargetNockma deriving stock (Data, Eq, Show) @@ -74,6 +75,21 @@ getLimits tgt debug = case tgt of defaultLimits TargetAsm -> defaultLimits + TargetReg -> + Limits + { _limitsMaxConstrs = 1048568, + _limitsMaxConstrArgs = 255, + _limitsMaxFunctionArgs = 253, + _limitsMaxLocalVars = 2048, + _limitsMaxClosureSize = 253 + 3, + _limitsClosureHeadSize = 2, + _limitsMaxStringSize = 255 + 1, + _limitsMaxStackDelta = 16368, + _limitsMaxFunctionAlloc = 16368, + _limitsDispatchStackSize = 4, + _limitsBuiltinUIDsNum = 8, + _limitsSpecialisedApply = 3 + } TargetTree -> defaultLimits TargetNockma -> diff --git a/src/Juvix/Compiler/Backend/C/Language.hs b/src/Juvix/Compiler/Backend/C/Language.hs index ebd1eefdc..77c129dcc 100644 --- a/src/Juvix/Compiler/Backend/C/Language.hs +++ b/src/Juvix/Compiler/Backend/C/Language.hs @@ -14,7 +14,7 @@ data CCode | Verbatim Text -------------------------------------------------------------------------------- --- Prepreocessor Directives +-- Preprocessor Directives -------------------------------------------------------------------------------- data Cpp diff --git a/src/Juvix/Compiler/Backend/C/Translation/FromReg.hs b/src/Juvix/Compiler/Backend/C/Translation/FromReg.hs index fa1e402b0..a2a742000 100644 --- a/src/Juvix/Compiler/Backend/C/Translation/FromReg.hs +++ b/src/Juvix/Compiler/Backend/C/Translation/FromReg.hs @@ -171,7 +171,7 @@ fromReg lims tab = fromRegFunction :: (Member CBuilder r) => Reg.ExtraInfo -> Reg.FunctionInfo -> Sem r [Statement] fromRegFunction info funInfo = do body <- fromRegCode bNoStack info (funInfo ^. Reg.functionCode) - let tmpDecls = mkDecls "DECL_TMP" (funInfo ^. Reg.functionLocalVarsNum) + let tmpDecls = mkDecls "DECL_TMP" localVarsNum return [closureDecl, functionDecl, StatementCompound (tmpDecls ++ body)] where @@ -184,6 +184,9 @@ fromRegFunction info funInfo = do maxStackHeight :: Int maxStackHeight = getMaxStackHeight info sym + localVarsNum :: Int + localVarsNum = getLocalVarsNum info sym + bNoStack :: Bool bNoStack = maxStackHeight == 0 @@ -240,14 +243,12 @@ fromRegInstr bNoStack info = \case return $ fromAllocClosure x Reg.ExtendClosure x -> return $ fromExtendClosure x - Reg.Call x@Reg.InstrCall {..} - | _instrCallIsTail -> - return $ fromTailCall x + Reg.TailCall x -> + return $ fromTailCall x Reg.Call x -> fromCall x - Reg.CallClosures x@Reg.InstrCallClosures {..} - | _instrCallClosuresIsTail -> - return $ fromTailCallClosures x + Reg.TailCallClosures x -> + return $ fromTailCallClosures x Reg.CallClosures x -> fromCallClosures x Reg.Return x -> @@ -292,12 +293,7 @@ fromRegInstr bNoStack info = \case fromValue :: Reg.Value -> Expression fromValue = \case - Reg.ConstInt x -> macroCall "make_smallint" [integer x] - Reg.ConstBool True -> macroVar "BOOL_TRUE" - Reg.ConstBool False -> macroVar "BOOL_FALSE" - Reg.ConstString x -> macroCall "GET_CONST_CSTRING" [integer (getStringId info x)] - Reg.ConstUnit -> macroVar "OBJ_UNIT" - Reg.ConstVoid -> macroVar "OBJ_VOID" + Reg.Const c -> fromConst c Reg.CRef Reg.ConstrField {..} -> case _constrFieldMemRep of Reg.MemRepConstr -> @@ -312,6 +308,15 @@ fromRegInstr bNoStack info = \case fromVarRef _constrFieldRef Reg.VRef x -> fromVarRef x + fromConst :: Reg.Constant -> Expression + fromConst = \case + Reg.ConstInt x -> macroCall "make_smallint" [integer x] + Reg.ConstBool True -> macroVar "BOOL_TRUE" + Reg.ConstBool False -> macroVar "BOOL_FALSE" + Reg.ConstString x -> macroCall "GET_CONST_CSTRING" [integer (getStringId info x)] + Reg.ConstUnit -> macroVar "OBJ_UNIT" + Reg.ConstVoid -> macroVar "OBJ_VOID" + fromPrealloc :: Reg.InstrPrealloc -> Statement fromPrealloc Reg.InstrPrealloc {..} = StatementExpr $ @@ -382,18 +387,18 @@ fromRegInstr bNoStack info = \case ) : stmtsAssign (fromVarRef _instrExtendClosureResult) (ExpressionVar "juvix_temp_var") - fromTailCall :: Reg.InstrCall -> [Statement] - fromTailCall Reg.InstrCall {..} = - case _instrCallType of + fromTailCall :: Reg.InstrTailCall -> [Statement] + fromTailCall Reg.InstrTailCall {..} = + case _instrTailCallType of Reg.CallFun sym -> - stmtsAssignFunArgs _instrCallArgs + stmtsAssignFunArgs _instrTailCallArgs ++ [ StatementExpr $ macroCall (if bNoStack then "TAIL_CALL_NS" else "TAIL_CALL") [integer (getFUID info sym), exprLabel info sym] ] Reg.CallClosure vr -> - stmtsAssignCArgs vr _instrCallArgs + stmtsAssignCArgs vr _instrTailCallArgs ++ [ StatementExpr $ macroCall (if bNoStack then "TAIL_CALL_CLOSURE_NS" else "TAIL_CALL_CLOSURE") @@ -426,26 +431,26 @@ fromRegInstr bNoStack info = \case ] ++ stmtsPopVars _instrCallLiveVars - fromTailCallClosures :: Reg.InstrCallClosures -> [Statement] - fromTailCallClosures Reg.InstrCallClosures {..} - | argsNum <= 3 = - stmtsAssignCArgs _instrCallClosuresValue _instrCallClosuresArgs + fromTailCallClosures :: Reg.InstrTailCallClosures -> [Statement] + fromTailCallClosures Reg.InstrTailCallClosures {..} + | argsNum <= info ^. Reg.extraInfoSpecialisedApply = + stmtsAssignCArgs _instrTailCallClosuresValue _instrTailCallClosuresArgs ++ [ StatementExpr $ macroCall ("TAIL_APPLY_" <> show argsNum) - [fromVarRef _instrCallClosuresValue] + [fromVarRef _instrTailCallClosuresValue] ] | otherwise = - stmtsAssignCArgs _instrCallClosuresValue _instrCallClosuresArgs + stmtsAssignCArgs _instrTailCallClosuresValue _instrTailCallClosuresArgs ++ [ StatementExpr $ macroCall "TAIL_APPLY" - [ fromVarRef _instrCallClosuresValue, + [ fromVarRef _instrTailCallClosuresValue, integer argsNum ] ] where - argsNum = length _instrCallClosuresArgs + argsNum = length _instrTailCallClosuresArgs fromCallClosures :: Reg.InstrCallClosures -> Sem r [Statement] fromCallClosures Reg.InstrCallClosures {..} = do @@ -461,7 +466,7 @@ fromRegInstr bNoStack info = \case argsNum = length _instrCallClosuresArgs call lab = if - | argsNum <= 3 -> + | argsNum <= info ^. Reg.extraInfoSpecialisedApply -> StatementExpr $ macroCall ("APPLY_" <> show argsNum) diff --git a/src/Juvix/Compiler/Backend/C/Translation/FromReg/Base.hs b/src/Juvix/Compiler/Backend/C/Translation/FromReg/Base.hs index ab06ca2a2..c990d6b18 100644 --- a/src/Juvix/Compiler/Backend/C/Translation/FromReg/Base.hs +++ b/src/Juvix/Compiler/Backend/C/Translation/FromReg/Base.hs @@ -38,6 +38,9 @@ getStringId info txt = fromJust $ HashMap.lookup txt (info ^. Reg.extraInfoStrin getMaxStackHeight :: Reg.ExtraInfo -> Reg.Symbol -> Int getMaxStackHeight info sym = fromJust $ HashMap.lookup sym (info ^. Reg.extraInfoMaxStackHeight) +getLocalVarsNum :: Reg.ExtraInfo -> Reg.Symbol -> Int +getLocalVarsNum info sym = fromJust $ HashMap.lookup sym (info ^. Reg.extraInfoLocalVarsNum) + getLabel :: Reg.ExtraInfo -> Reg.Symbol -> Text getLabel info sym = mkCIdent $ "juvix_function_" <> getFunctionName info sym <> "_" <> show (getFUID info sym) diff --git a/src/Juvix/Compiler/Pipeline.hs b/src/Juvix/Compiler/Pipeline.hs index bdba8ab49..1027eca4d 100644 --- a/src/Juvix/Compiler/Pipeline.hs +++ b/src/Juvix/Compiler/Pipeline.hs @@ -135,6 +135,9 @@ storedCoreToTree = Core.toStripped >=> return . Tree.fromCore . Stripped.fromCor storedCoreToAsm :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module -> Sem r Asm.InfoTable storedCoreToAsm = storedCoreToTree >=> treeToAsm +storedCoreToReg :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module -> Sem r Reg.InfoTable +storedCoreToReg = storedCoreToAsm >=> asmToReg + storedCoreToMiniC :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module -> Sem r C.MiniCResult storedCoreToMiniC = storedCoreToAsm >=> asmToMiniC @@ -157,6 +160,9 @@ coreToTree = Core.toStored >=> storedCoreToTree coreToAsm :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module -> Sem r Asm.InfoTable coreToAsm = Core.toStored >=> storedCoreToAsm +coreToReg :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module -> Sem r Reg.InfoTable +coreToReg = Core.toStored >=> storedCoreToReg + coreToNockma :: (Members '[Error JuvixError, Reader EntryPoint] r) => Core.Module -> Sem r (Nockma.Cell Natural) coreToNockma = coreToTree >=> treeToNockma @@ -179,14 +185,20 @@ coreToVampIR' = Core.toStored' >=> storedCoreToVampIR' treeToAsm :: (Member (Error JuvixError) r) => Tree.InfoTable -> Sem r Asm.InfoTable treeToAsm = Tree.toAsm >=> return . Asm.fromTree +treeToReg :: (Members '[Error JuvixError, Reader EntryPoint] r) => Tree.InfoTable -> Sem r Reg.InfoTable +treeToReg = treeToAsm >=> asmToReg + treeToNockma :: (Members '[Error JuvixError, Reader EntryPoint] r) => Tree.InfoTable -> Sem r (Nockma.Cell Natural) treeToNockma = Tree.toNockma >=> mapReader NockmaTree.fromEntryPoint . NockmaTree.fromTreeTable treeToMiniC :: (Members '[Error JuvixError, Reader EntryPoint] r) => Tree.InfoTable -> Sem r C.MiniCResult treeToMiniC = treeToAsm >=> asmToMiniC +asmToReg :: (Members '[Error JuvixError, Reader EntryPoint] r) => Asm.InfoTable -> Sem r Reg.InfoTable +asmToReg = Asm.toReg >=> return . Reg.fromAsm + asmToMiniC :: (Members '[Error JuvixError, Reader EntryPoint] r) => Asm.InfoTable -> Sem r C.MiniCResult -asmToMiniC = Asm.toReg >=> regToMiniC . Reg.fromAsm +asmToMiniC = asmToReg >=> regToMiniC regToMiniC :: (Member (Reader EntryPoint) r) => Reg.InfoTable -> Sem r C.MiniCResult regToMiniC tab = do diff --git a/src/Juvix/Compiler/Reg/Data/InfoTable.hs b/src/Juvix/Compiler/Reg/Data/InfoTable.hs index 3300e771d..0dc05d931 100644 --- a/src/Juvix/Compiler/Reg/Data/InfoTable.hs +++ b/src/Juvix/Compiler/Reg/Data/InfoTable.hs @@ -1,51 +1,12 @@ -module Juvix.Compiler.Reg.Data.InfoTable where +module Juvix.Compiler.Reg.Data.InfoTable + ( module Juvix.Compiler.Reg.Data.InfoTable, + module Juvix.Compiler.Tree.Data.InfoTable.Base, + ) +where import Juvix.Compiler.Reg.Language +import Juvix.Compiler.Tree.Data.InfoTable.Base -data InfoTable = InfoTable - { _infoFunctions :: HashMap Symbol FunctionInfo, - _infoConstrs :: HashMap Tag ConstructorInfo, - _infoInductives :: HashMap Symbol InductiveInfo, - _infoMainFunction :: Maybe Symbol - } +type InfoTable = InfoTable' Code () -data FunctionInfo = FunctionInfo - { _functionName :: Text, - _functionLocation :: Maybe Location, - _functionSymbol :: Symbol, - _functionArgsNum :: Int, - _functionLocalVarsNum :: Int, - _functionCode :: Code - } - -data ConstructorInfo = ConstructorInfo - { _constructorName :: Text, - _constructorLocation :: Maybe Location, - _constructorTag :: Tag, - _constructorArgsNum :: Int, - _constructorInductive :: Symbol, - _constructorRepresentation :: MemRep, - _constructorFixity :: Maybe Fixity - } - -data InductiveInfo = InductiveInfo - { _inductiveName :: Text, - _inductiveLocation :: Maybe Location, - _inductiveSymbol :: Symbol, - _inductiveConstructors :: [Tag], - _inductiveRepresentation :: IndRep - } - -makeLenses ''InfoTable -makeLenses ''FunctionInfo -makeLenses ''ConstructorInfo -makeLenses ''InductiveInfo - -emptyInfoTable :: InfoTable -emptyInfoTable = - InfoTable - { _infoFunctions = mempty, - _infoConstrs = mempty, - _infoInductives = mempty, - _infoMainFunction = Nothing - } +type FunctionInfo = FunctionInfo' Code () diff --git a/src/Juvix/Compiler/Reg/Data/InfoTableBuilder.hs b/src/Juvix/Compiler/Reg/Data/InfoTableBuilder.hs new file mode 100644 index 000000000..199bc013f --- /dev/null +++ b/src/Juvix/Compiler/Reg/Data/InfoTableBuilder.hs @@ -0,0 +1,43 @@ +module Juvix.Compiler.Reg.Data.InfoTableBuilder + ( module Juvix.Compiler.Reg.Data.InfoTableBuilder, + module Juvix.Compiler.Tree.Data.InfoTableBuilder.Base, + ) +where + +import Juvix.Compiler.Reg.Data.InfoTable +import Juvix.Compiler.Reg.Language +import Juvix.Compiler.Tree.Data.InfoTableBuilder.Base + +type InfoTableBuilder = InfoTableBuilder' Code () + +type BuilderState = BuilderState' Code () + +freshSymbol :: (Member InfoTableBuilder r) => Sem r Symbol +freshSymbol = freshSymbol' @Code @() + +freshTag :: (Member InfoTableBuilder r) => Sem r Tag +freshTag = freshTag' @Code @() + +registerFunction :: (Member InfoTableBuilder r) => FunctionInfo -> Sem r () +registerFunction = registerFunction' @Code @() + +registerConstr :: (Member InfoTableBuilder r) => ConstructorInfo -> Sem r () +registerConstr = registerConstr' @Code @() + +registerInductive :: (Member InfoTableBuilder r) => InductiveInfo -> Sem r () +registerInductive = registerInductive' @Code @() + +registerForward :: (Member InfoTableBuilder r) => Text -> Symbol -> Sem r () +registerForward = registerForward' @Code @() + +registerMain :: (Member InfoTableBuilder r) => Symbol -> Sem r () +registerMain = registerMain' @Code @() + +getIdent :: (Member InfoTableBuilder r) => Text -> Sem r (Maybe IdentKind) +getIdent = getIdent' @Code @() + +getFunctionInfo :: (Member InfoTableBuilder r) => Symbol -> Sem r FunctionInfo +getFunctionInfo = getFunctionInfo' @Code @() + +getConstructorInfo :: (Member InfoTableBuilder r) => Tag -> Sem r ConstructorInfo +getConstructorInfo = getConstructorInfo' @Code @() diff --git a/src/Juvix/Compiler/Reg/Extra.hs b/src/Juvix/Compiler/Reg/Extra.hs index 78e96886f..2740eac58 100644 --- a/src/Juvix/Compiler/Reg/Extra.hs +++ b/src/Juvix/Compiler/Reg/Extra.hs @@ -30,15 +30,14 @@ computeMaxStackHeight lims = maximum . map go Alloc {} -> 0 AllocClosure {} -> 0 ExtendClosure {} -> 0 - Call InstrCall {..} | _instrCallIsTail -> 0 + TailCall {} -> 0 Call InstrCall {..} -> length _instrCallLiveVars + 1 - CallClosures InstrCallClosures {..} - | _instrCallClosuresIsTail -> - length _instrCallClosuresArgs - + 1 - + lims - ^. limitsDispatchStackSize + TailCallClosures InstrTailCallClosures {..} -> + length _instrTailCallClosuresArgs + + 1 + + lims + ^. limitsDispatchStackSize CallClosures InstrCallClosures {..} -> length _instrCallClosuresLiveVars + length _instrCallClosuresArgs @@ -80,9 +79,12 @@ computeMaxCallClosuresArgsNum = maximum . map go Alloc {} -> 0 AllocClosure {} -> 0 ExtendClosure {} -> 0 - Call InstrCall {} -> 0 + Call {} -> 0 + TailCall {} -> 0 CallClosures InstrCallClosures {..} -> length _instrCallClosuresArgs + TailCallClosures InstrTailCallClosures {..} -> + length _instrTailCallClosuresArgs Return {} -> 0 Branch InstrBranch {..} -> max @@ -131,8 +133,12 @@ computeStringMap strs = snd . run . execState (HashMap.size strs, strs) . mapM g mapM_ goVal _instrExtendClosureArgs Call InstrCall {..} -> mapM_ goVal _instrCallArgs + TailCall InstrTailCall {..} -> + mapM_ goVal _instrTailCallArgs CallClosures InstrCallClosures {..} -> mapM_ goVal _instrCallClosuresArgs + TailCallClosures InstrTailCallClosures {..} -> + mapM_ goVal _instrTailCallClosuresArgs Return InstrReturn {..} -> goVal _instrReturnValue Branch InstrBranch {..} -> do @@ -148,7 +154,7 @@ computeStringMap strs = snd . run . execState (HashMap.size strs, strs) . mapM g goVal :: (Member (State (Int, HashMap Text Int)) r) => Value -> Sem r () goVal = \case - ConstString str -> + Const (ConstString str) -> modify' ( \(sid :: Int, sstrs) -> if @@ -157,16 +163,62 @@ computeStringMap strs = snd . run . execState (HashMap.size strs, strs) . mapM g ) _ -> return () +computeLocalVarsNum :: Code -> Int +computeLocalVarsNum = maximum . map go + where + go :: Instruction -> Int + go = \case + Nop -> 0 + Binop BinaryOp {..} -> goVarRef _binaryOpResult + Show InstrShow {..} -> goVarRef _instrShowResult + StrToInt InstrStrToInt {..} -> goVarRef _instrStrToIntResult + Assign InstrAssign {..} -> goVarRef _instrAssignResult + Trace {} -> 0 + Dump -> 0 + Failure {} -> 0 + ArgsNum InstrArgsNum {..} -> goVarRef _instrArgsNumResult + Prealloc InstrPrealloc {} -> 0 + Alloc InstrAlloc {..} -> goVarRef _instrAllocResult + AllocClosure InstrAllocClosure {..} -> goVarRef _instrAllocClosureResult + ExtendClosure InstrExtendClosure {..} -> goVarRef _instrExtendClosureResult + Call InstrCall {..} -> goVarRef _instrCallResult + TailCall {} -> 0 + CallClosures InstrCallClosures {..} -> goVarRef _instrCallClosuresResult + TailCallClosures {} -> 0 + Return {} -> 0 + Branch InstrBranch {..} -> + max + (computeLocalVarsNum _instrBranchTrue) + (computeLocalVarsNum _instrBranchFalse) + Case InstrCase {..} -> + max + ( maximum + ( map + (computeLocalVarsNum . (^. caseBranchCode)) + _instrCaseBranches + ) + ) + (maybe 0 computeLocalVarsNum _instrCaseDefault) + Block InstrBlock {..} -> + computeLocalVarsNum _instrBlockCode + + goVarRef :: VarRef -> Int + goVarRef VarRef {..} = case _varRefGroup of + VarGroupArgs -> 0 + VarGroupLocal -> _varRefIndex + 1 + data ExtraInfo = ExtraInfo { _extraInfoTable :: InfoTable, _extraInfoUIDs :: HashMap Tag Int, _extraInfoFUIDs :: HashMap Symbol Int, _extraInfoStringMap :: HashMap Text Int, _extraInfoMaxStackHeight :: HashMap Symbol Int, + _extraInfoLocalVarsNum :: HashMap Symbol Int, _extraInfoMaxArgsNum :: Int, _extraInfoMaxCallClosuresArgsNum :: Int, _extraInfoConstrsNum :: Int, - _extraInfoFunctionsNum :: Int + _extraInfoFunctionsNum :: Int, + _extraInfoSpecialisedApply :: Int } makeLenses ''ExtraInfo @@ -202,6 +254,10 @@ computeExtraInfo lims tab = HashMap.map (computeMaxStackHeight lims . (^. functionCode)) (tab ^. infoFunctions), + _extraInfoLocalVarsNum = + HashMap.map + (computeLocalVarsNum . (^. functionCode)) + (tab ^. infoFunctions), _extraInfoMaxArgsNum = maximum (map (^. functionArgsNum) (HashMap.elems (tab ^. infoFunctions))), _extraInfoMaxCallClosuresArgsNum = @@ -212,5 +268,6 @@ computeExtraInfo lims tab = _extraInfoConstrsNum = length (userConstrs tab) + lims ^. limitsBuiltinUIDsNum, _extraInfoFunctionsNum = - HashMap.size (tab ^. infoFunctions) + HashMap.size (tab ^. infoFunctions), + _extraInfoSpecialisedApply = lims ^. limitsSpecialisedApply } diff --git a/src/Juvix/Compiler/Reg/Keywords.hs b/src/Juvix/Compiler/Reg/Keywords.hs new file mode 100644 index 000000000..e5b9f401d --- /dev/null +++ b/src/Juvix/Compiler/Reg/Keywords.hs @@ -0,0 +1,47 @@ +module Juvix.Compiler.Reg.Keywords + ( module Juvix.Compiler.Reg.Keywords, + module Juvix.Compiler.Tree.Keywords.Base, + module Juvix.Data.Keyword.All, + ) +where + +import Juvix.Compiler.Tree.Keywords.Base +import Juvix.Data.Keyword.All (kwAdd_, kwAlloc, kwArgsNum, kwAtoi, kwBr, kwCAlloc, kwCCall, kwCCallTail, kwCExtend, kwCall, kwCallTail, kwCase, kwDefault, kwDiv_, kwDollar, kwDump, kwEq, kwEq_, kwFail, kwLe_, kwLive, kwLt_, kwMod_, kwMul_, kwNop, kwPrealloc, kwRet, kwShow, kwStrcat, kwSub_, kwTrace) +import Juvix.Prelude + +allKeywordStrings :: HashSet Text +allKeywordStrings = keywordsStrings allKeywords + +allKeywords :: [Keyword] +allKeywords = + baseKeywords + ++ [ kwNop, + kwAdd_, + kwSub_, + kwMul_, + kwDiv_, + kwMod_, + kwLt_, + kwLe_, + kwEq_, + kwStrcat, + kwEq, + kwShow, + kwAtoi, + kwTrace, + kwDump, + kwPrealloc, + kwAlloc, + kwCAlloc, + kwCExtend, + kwCall, + kwCallTail, + kwLive, + kwCCall, + kwCCallTail, + kwRet, + kwBr, + kwCase, + kwFail, + kwArgsNum + ] diff --git a/src/Juvix/Compiler/Reg/Language.hs b/src/Juvix/Compiler/Reg/Language.hs index d5875ffc6..c15378175 100644 --- a/src/Juvix/Compiler/Reg/Language.hs +++ b/src/Juvix/Compiler/Reg/Language.hs @@ -7,13 +7,10 @@ where import Juvix.Compiler.Reg.Language.Base data Value - = ConstInt Integer - | ConstBool Bool - | ConstString Text - | ConstUnit - | ConstVoid + = Const Constant | CRef ConstrField | VRef VarRef + deriving stock (Eq) type Index = Int @@ -27,13 +24,19 @@ data ConstrField = ConstrField _constrFieldRef :: VarRef, _constrFieldIndex :: Index } + deriving stock (Eq) -data VarGroup = VarGroupArgs | VarGroupLocal +data VarGroup + = VarGroupArgs + | VarGroupLocal + deriving stock (Eq) data VarRef = VarRef { _varRefGroup :: VarGroup, - _varRefIndex :: Index + _varRefIndex :: Index, + _varRefName :: Maybe Text } + deriving stock (Eq) data Instruction = Nop -- no operation @@ -50,11 +53,14 @@ data Instruction | AllocClosure InstrAllocClosure | ExtendClosure InstrExtendClosure | Call InstrCall + | TailCall InstrTailCall | CallClosures InstrCallClosures + | TailCallClosures InstrTailCallClosures | Return InstrReturn | Branch InstrBranch | Case InstrCase | Block InstrBlock + deriving stock (Eq) type Code = [Instruction] @@ -64,6 +70,7 @@ data BinaryOp = BinaryOp _binaryOpArg1 :: Value, _binaryOpArg2 :: Value } + deriving stock (Eq) data Opcode = OpIntAdd @@ -75,39 +82,47 @@ data Opcode | OpIntLe | OpEq | OpStrConcat + deriving stock (Eq) data InstrShow = InstrShow { _instrShowResult :: VarRef, _instrShowValue :: Value } + deriving stock (Eq) data InstrStrToInt = InstrStrToInt { _instrStrToIntResult :: VarRef, _instrStrToIntValue :: Value } + deriving stock (Eq) data InstrAssign = InstrAssign { _instrAssignResult :: VarRef, _instrAssignValue :: Value } + deriving stock (Eq) newtype InstrTrace = InstrTrace { _instrTraceValue :: Value } + deriving stock (Eq) newtype InstrFailure = InstrFailure { _instrFailureValue :: Value } + deriving stock (Eq) data InstrArgsNum = InstrArgsNum { _instrArgsNumResult :: VarRef, _instrArgsNumValue :: Value } + deriving stock (Eq) data InstrPrealloc = InstrPrealloc { _instrPreallocWordsNum :: Int, _instrPreallocLiveVars :: [VarRef] } + deriving stock (Eq) data InstrAlloc = InstrAlloc { _instrAllocResult :: VarRef, @@ -115,6 +130,7 @@ data InstrAlloc = InstrAlloc _instrAllocMemRep :: MemRep, _instrAllocArgs :: [Value] } + deriving stock (Eq) data InstrAllocClosure = InstrAllocClosure { _instrAllocClosureResult :: VarRef, @@ -122,43 +138,61 @@ data InstrAllocClosure = InstrAllocClosure _instrAllocClosureExpectedArgsNum :: Int, _instrAllocClosureArgs :: [Value] } + deriving stock (Eq) data InstrExtendClosure = InstrExtendClosure { _instrExtendClosureResult :: VarRef, _instrExtendClosureValue :: VarRef, _instrExtendClosureArgs :: [Value] } + deriving stock (Eq) -data CallType = CallFun Symbol | CallClosure VarRef +data CallType + = CallFun Symbol + | CallClosure VarRef + deriving stock (Eq) data InstrCall = InstrCall { _instrCallResult :: VarRef, _instrCallType :: CallType, - _instrCallIsTail :: Bool, _instrCallArgs :: [Value], - -- | Variables live at the point of the call. If the call is not - -- tail-recursive, live variables need to be saved before the call and - -- restored after it. + -- | Variables live at the point of the call. Live variables need to be + -- saved before the call and restored after it. _instrCallLiveVars :: [VarRef] } + deriving stock (Eq) + +data InstrTailCall = InstrTailCall + { _instrTailCallType :: CallType, + _instrTailCallArgs :: [Value] + } + deriving stock (Eq) data InstrCallClosures = InstrCallClosures { _instrCallClosuresResult :: VarRef, - _instrCallClosuresIsTail :: Bool, _instrCallClosuresValue :: VarRef, _instrCallClosuresArgs :: [Value], _instrCallClosuresLiveVars :: [VarRef] } + deriving stock (Eq) + +data InstrTailCallClosures = InstrTailCallClosures + { _instrTailCallClosuresValue :: VarRef, + _instrTailCallClosuresArgs :: [Value] + } + deriving stock (Eq) newtype InstrReturn = InstrReturn { _instrReturnValue :: Value } + deriving stock (Eq) data InstrBranch = InstrBranch { _instrBranchValue :: Value, _instrBranchTrue :: Code, _instrBranchFalse :: Code } + deriving stock (Eq) data InstrCase = InstrCase { _instrCaseValue :: Value, @@ -167,6 +201,7 @@ data InstrCase = InstrCase _instrCaseBranches :: [CaseBranch], _instrCaseDefault :: Maybe Code } + deriving stock (Eq) data CaseBranch = CaseBranch { _caseBranchTag :: Tag, @@ -175,10 +210,12 @@ data CaseBranch = CaseBranch _caseBranchArgsNum :: Int, _caseBranchCode :: Code } + deriving stock (Eq) newtype InstrBlock = InstrBlock { _instrBlockCode :: Code } + deriving stock (Eq) makeLenses ''ConstrField makeLenses ''BinaryOp @@ -195,3 +232,11 @@ makeLenses ''InstrBranch makeLenses ''InstrCase makeLenses ''CaseBranch makeLenses ''InstrReturn + +mkVarRef :: VarGroup -> Index -> VarRef +mkVarRef g i = + VarRef + { _varRefGroup = g, + _varRefIndex = i, + _varRefName = Nothing + } diff --git a/src/Juvix/Compiler/Reg/Language/Base.hs b/src/Juvix/Compiler/Reg/Language/Base.hs index 58bcf5ac9..8175d2e24 100644 --- a/src/Juvix/Compiler/Reg/Language/Base.hs +++ b/src/Juvix/Compiler/Reg/Language/Base.hs @@ -1,8 +1,10 @@ module Juvix.Compiler.Reg.Language.Base ( module Juvix.Compiler.Core.Language.Base, + module Juvix.Compiler.Tree.Language.Base, module Juvix.Compiler.Tree.Language.Rep, ) where import Juvix.Compiler.Core.Language.Base hiding (Index) +import Juvix.Compiler.Tree.Language.Base (Constant (..)) import Juvix.Compiler.Tree.Language.Rep diff --git a/src/Juvix/Compiler/Reg/Pretty.hs b/src/Juvix/Compiler/Reg/Pretty.hs new file mode 100644 index 000000000..a977a8af0 --- /dev/null +++ b/src/Juvix/Compiler/Reg/Pretty.hs @@ -0,0 +1,28 @@ +module Juvix.Compiler.Reg.Pretty + ( module Juvix.Compiler.Reg.Pretty, + module Juvix.Compiler.Reg.Pretty.Base, + module Juvix.Compiler.Reg.Pretty.Options, + ) +where + +import Juvix.Compiler.Reg.Data.InfoTable +import Juvix.Compiler.Reg.Pretty.Base +import Juvix.Compiler.Reg.Pretty.Options +import Juvix.Data.PPOutput +import Juvix.Prelude +import Prettyprinter.Render.Terminal qualified as Ansi + +ppOutDefault :: (PrettyCode c) => InfoTable -> c -> AnsiText +ppOutDefault tab = mkAnsiText . PPOutput . doc (defaultOptions tab) + +ppOut :: (PrettyCode c) => Options -> c -> AnsiText +ppOut o = mkAnsiText . PPOutput . doc o + +ppTrace' :: (PrettyCode c) => Options -> c -> Text +ppTrace' opts = Ansi.renderStrict . reAnnotateS stylize . layoutPretty defaultLayoutOptions . doc opts + +ppTrace :: (PrettyCode c) => InfoTable -> c -> Text +ppTrace tab = ppTrace' (defaultOptions tab) + +ppPrint :: (PrettyCode c) => InfoTable -> c -> Text +ppPrint tab = show . ppOutDefault tab diff --git a/src/Juvix/Compiler/Reg/Pretty/Base.hs b/src/Juvix/Compiler/Reg/Pretty/Base.hs new file mode 100644 index 000000000..41de3b2da --- /dev/null +++ b/src/Juvix/Compiler/Reg/Pretty/Base.hs @@ -0,0 +1,285 @@ +module Juvix.Compiler.Reg.Pretty.Base + ( module Juvix.Compiler.Reg.Pretty.Base, + module Juvix.Compiler.Reg.Pretty.Options, + ) +where + +import Data.Foldable +import Juvix.Compiler.Reg.Data.InfoTable +import Juvix.Compiler.Reg.Language +import Juvix.Compiler.Reg.Pretty.Options +import Juvix.Compiler.Tree.Pretty.Base qualified as Tree +import Juvix.Compiler.Tree.Pretty.Extra +import Juvix.Data.CodeAnn +import Juvix.Extra.Strings qualified as Str + +doc :: (PrettyCode c) => Options -> c -> Doc Ann +doc opts = + run + . runReader opts + . ppCode + +class PrettyCode c where + ppCode :: (Member (Reader Options) r) => c -> Sem r (Doc Ann) + +instance PrettyCode VarRef where + ppCode VarRef {..} = case _varRefName of + Just n -> return $ variable (quoteName n) + Nothing -> case _varRefGroup of + VarGroupArgs -> return $ ppRef Str.arg _varRefIndex + VarGroupLocal -> return $ ppRef Str.tmp _varRefIndex + where + ppRef :: Text -> Index -> Doc Ann + ppRef str off = variable str <> brackets (integer off) + +instance PrettyCode ConstrField where + ppCode ConstrField {..} = do + dr <- ppCode _constrFieldRef + ctr <- Tree.ppConstrName _constrFieldTag + return $ dr <> dot <> ctr <> brackets (integer _constrFieldIndex) + +instance PrettyCode Value where + ppCode = \case + Const x -> Tree.ppCode x + CRef x -> ppCode x + VRef x -> ppCode x + +instance PrettyCode Opcode where + ppCode = \case + OpIntAdd -> return $ primitive Str.add_ + OpIntSub -> return $ primitive Str.sub_ + OpIntMul -> return $ primitive Str.mul_ + OpIntDiv -> return $ primitive Str.div_ + OpIntMod -> return $ primitive Str.mod_ + OpIntLt -> return $ primitive Str.lt_ + OpIntLe -> return $ primitive Str.le_ + OpEq -> return $ primitive Str.eq + OpStrConcat -> return $ primitive Str.instrStrConcat + +instance PrettyCode BinaryOp where + ppCode BinaryOp {..} = do + res <- ppCode _binaryOpResult + arg1 <- ppCode _binaryOpArg1 + arg2 <- ppCode _binaryOpArg2 + op <- ppCode _binaryOpCode + return $ res <+> primitive Str.equal <+> op <+> arg1 <+> arg2 + +instance PrettyCode InstrShow where + ppCode InstrShow {..} = do + res <- ppCode _instrShowResult + val <- ppCode _instrShowValue + return $ res <+> primitive Str.equal <+> primitive Str.show_ <+> val + +instance PrettyCode InstrStrToInt where + ppCode InstrStrToInt {..} = do + res <- ppCode _instrStrToIntResult + val <- ppCode _instrStrToIntValue + return $ res <+> primitive Str.equal <+> primitive Str.instrStrToInt <+> val + +instance PrettyCode InstrAssign where + ppCode InstrAssign {..} = do + res <- ppCode _instrAssignResult + val <- ppCode _instrAssignValue + return $ res <+> primitive Str.equal <+> val + +instance PrettyCode InstrTrace where + ppCode InstrTrace {..} = do + val <- ppCode _instrTraceValue + return $ primitive Str.trace_ <+> val + +instance PrettyCode InstrFailure where + ppCode InstrFailure {..} = do + val <- ppCode _instrFailureValue + return $ primitive Str.fail_ <+> val + +instance PrettyCode InstrArgsNum where + ppCode InstrArgsNum {..} = do + res <- ppCode _instrArgsNumResult + val <- ppCode _instrArgsNumValue + return $ res <+> primitive Str.equal <+> primitive Str.argsnum <+> val + +ppLiveVars :: (Member (Reader Options) r) => [VarRef] -> Sem r (Doc Ann) +ppLiveVars vars + | null vars = return mempty + | otherwise = do + vars' <- mapM ppCode vars + return $ comma <+> primitive "live:" <+> arglist vars' + +instance PrettyCode InstrPrealloc where + ppCode InstrPrealloc {..} = do + vars <- ppLiveVars _instrPreallocLiveVars + return $ primitive Str.prealloc <+> integer _instrPreallocWordsNum <> vars + +instance PrettyCode InstrAlloc where + ppCode InstrAlloc {..} = do + res <- ppCode _instrAllocResult + tag <- Tree.ppConstrName _instrAllocTag + args <- mapM ppCode _instrAllocArgs + return $ + res + <+> primitive Str.equal + <+> primitive Str.alloc + <+> tag + <+> arglist args + +instance PrettyCode InstrAllocClosure where + ppCode InstrAllocClosure {..} = do + res <- ppCode _instrAllocClosureResult + fn <- Tree.ppFunName _instrAllocClosureSymbol + args <- mapM ppCode _instrAllocClosureArgs + return $ + res + <+> primitive Str.equal + <+> primitive Str.calloc + <+> fn + <+> arglist args + +instance PrettyCode InstrExtendClosure where + ppCode InstrExtendClosure {..} = do + res <- ppCode _instrExtendClosureResult + fn <- ppCode _instrExtendClosureValue + args <- mapM ppCode _instrExtendClosureArgs + return $ + res + <+> primitive Str.equal + <+> primitive Str.cextend + <+> fn + <+> arglist args + +instance PrettyCode CallType where + ppCode = \case + CallFun sym -> Tree.ppFunName sym + CallClosure cl -> ppCode cl + +instance PrettyCode InstrCall where + ppCode InstrCall {..} = do + res <- ppCode _instrCallResult + fn <- ppCode _instrCallType + args <- mapM ppCode _instrCallArgs + vars <- ppLiveVars _instrCallLiveVars + return $ + res + <+> primitive Str.equal + <+> primitive Str.call + <+> fn + <+> arglist args + <> vars + +instance PrettyCode InstrTailCall where + ppCode InstrTailCall {..} = do + fn <- ppCode _instrTailCallType + args <- mapM ppCode _instrTailCallArgs + return $ + primitive Str.tcall + <+> fn + <+> arglist args + +instance PrettyCode InstrCallClosures where + ppCode InstrCallClosures {..} = do + res <- ppCode _instrCallClosuresResult + fn <- ppCode _instrCallClosuresValue + args <- mapM ppCode _instrCallClosuresArgs + vars <- ppLiveVars _instrCallClosuresLiveVars + return $ + res + <+> primitive Str.equal + <+> primitive Str.ccall + <+> fn + <+> arglist args + <> vars + +instance PrettyCode InstrTailCallClosures where + ppCode InstrTailCallClosures {..} = do + fn <- ppCode _instrTailCallClosuresValue + args <- mapM ppCode _instrTailCallClosuresArgs + return $ + primitive Str.instrTccall + <+> fn + <+> arglist args + +instance PrettyCode InstrReturn where + ppCode InstrReturn {..} = do + val <- ppCode _instrReturnValue + return $ primitive Str.ret <+> val + +instance PrettyCode InstrBranch where + ppCode InstrBranch {..} = do + val <- ppCode _instrBranchValue + br1 <- ppCodeCode _instrBranchTrue + br2 <- ppCodeCode _instrBranchFalse + return $ + primitive Str.br + <+> val + <+> braces' + ( constr Str.true_ <> colon + <+> braces' br1 + <> semi + <> line + <> constr Str.false_ + <> colon + <+> braces' br2 <> semi + ) + +instance PrettyCode CaseBranch where + ppCode CaseBranch {..} = do + tag <- Tree.ppConstrName _caseBranchTag + body <- ppCodeCode _caseBranchCode + return $ tag <> colon <+> braces' body <> semi + +ppDefaultBranch :: (Member (Reader Options) r) => Code -> Sem r (Doc Ann) +ppDefaultBranch cs = do + body <- ppCodeCode cs + return $ constr Str.default_ <> colon <+> braces' body <> semi + +instance PrettyCode InstrCase where + ppCode InstrCase {..} = do + ind <- Tree.ppIndName _instrCaseInductive + val <- ppCode _instrCaseValue + brs <- mapM ppCode _instrCaseBranches + def <- maybe (return Nothing) (fmap Just . ppDefaultBranch) _instrCaseDefault + let brs' = brs ++ catMaybes [def] + return $ primitive Str.case_ <> brackets ind <+> val <+> braces' (vsep brs') + +instance PrettyCode InstrBlock where + ppCode InstrBlock {..} = braces' <$> ppCodeCode _instrBlockCode + +instance PrettyCode Instruction where + ppCode = \case + Nop -> return $ primitive Str.nop + Binop x -> ppCode x + Show x -> ppCode x + StrToInt x -> ppCode x + Assign x -> ppCode x + Trace x -> ppCode x + Dump -> return $ primitive Str.dump + Failure x -> ppCode x + ArgsNum x -> ppCode x + Prealloc x -> ppCode x + Alloc x -> ppCode x + AllocClosure x -> ppCode x + ExtendClosure x -> ppCode x + Call x -> ppCode x + TailCall x -> ppCode x + CallClosures x -> ppCode x + TailCallClosures x -> ppCode x + Return x -> ppCode x + Branch x -> ppCode x + Case x -> ppCode x + Block x -> ppCode x + +ppCodeCode :: (Member (Reader Options) r) => Code -> Sem r (Doc Ann) +ppCodeCode x = do + cs <- mapM ppCode x + return $ vcat $ map (<> semi) cs + +instance PrettyCode FunctionInfo where + ppCode = Tree.ppFunInfo ppCodeCode + +instance PrettyCode ConstructorInfo where + ppCode = Tree.ppCode + +instance PrettyCode InfoTable where + ppCode = Tree.ppInfoTable ppCodeCode + +arglist :: [Doc Ann] -> Doc Ann +arglist args = parens (hsep (punctuate comma args)) diff --git a/src/Juvix/Compiler/Reg/Pretty/Options.hs b/src/Juvix/Compiler/Reg/Pretty/Options.hs new file mode 100644 index 000000000..c734e42df --- /dev/null +++ b/src/Juvix/Compiler/Reg/Pretty/Options.hs @@ -0,0 +1,6 @@ +module Juvix.Compiler.Reg.Pretty.Options + ( module Juvix.Compiler.Tree.Pretty.Options, + ) +where + +import Juvix.Compiler.Tree.Pretty.Options diff --git a/src/Juvix/Compiler/Reg/Translation/FromAsm.hs b/src/Juvix/Compiler/Reg/Translation/FromAsm.hs index 3dc6f5625..d9b50e17e 100644 --- a/src/Juvix/Compiler/Reg/Translation/FromAsm.hs +++ b/src/Juvix/Compiler/Reg/Translation/FromAsm.hs @@ -24,33 +24,17 @@ fromAsm tab = _functionLocation = fi ^. Asm.functionLocation, _functionSymbol = fi ^. Asm.functionSymbol, _functionArgsNum = fi ^. Asm.functionArgsNum, - _functionLocalVarsNum = extra ^. Asm.functionMaxTempStackHeight + extra ^. Asm.functionMaxValueStackHeight, + _functionArgNames = fi ^. Asm.functionArgNames, + _functionType = fi ^. Asm.functionType, + _functionExtra = (), _functionCode = fromAsmFun tab fi } - where - extra = fromJust (fi ^. Asm.functionExtra) convertConstr :: Asm.ConstructorInfo -> ConstructorInfo - convertConstr ci = - ConstructorInfo - { _constructorName = ci ^. Asm.constructorName, - _constructorLocation = ci ^. Asm.constructorLocation, - _constructorTag = ci ^. Asm.constructorTag, - _constructorArgsNum = ci ^. Asm.constructorArgsNum, - _constructorInductive = ci ^. Asm.constructorInductive, - _constructorRepresentation = ci ^. Asm.constructorRepresentation, - _constructorFixity = ci ^. Asm.constructorFixity - } + convertConstr ci = ci convertInductive :: Asm.InductiveInfo -> InductiveInfo - convertInductive ii = - InductiveInfo - { _inductiveName = ii ^. Asm.inductiveName, - _inductiveLocation = ii ^. Asm.inductiveLocation, - _inductiveSymbol = ii ^. Asm.inductiveSymbol, - _inductiveConstructors = ii ^. Asm.inductiveConstructors, - _inductiveRepresentation = ii ^. Asm.inductiveRepresentation - } + convertInductive ii = ii fromAsmFun :: Asm.InfoTable -> @@ -80,14 +64,14 @@ fromAsmInstr :: fromAsmInstr funInfo tab si Asm.CmdInstr {..} = case _cmdInstrInstruction of Asm.Binop op -> return $ mkBinop (mkOpcode op) - Asm.ValShow -> return $ mkShow (VarRef VarGroupLocal (ntmps + n)) (VRef $ VarRef VarGroupLocal (ntmps + n)) - Asm.StrToInt -> return $ mkStrToInt (VarRef VarGroupLocal (ntmps + n)) (VRef $ VarRef VarGroupLocal (ntmps + n)) - Asm.Push val -> return $ mkAssign (VarRef VarGroupLocal (ntmps + n + 1)) (mkValue val) + Asm.ValShow -> return $ mkShow (mkVarRef VarGroupLocal (ntmps + n)) (VRef $ mkVarRef VarGroupLocal (ntmps + n)) + Asm.StrToInt -> return $ mkStrToInt (mkVarRef VarGroupLocal (ntmps + n)) (VRef $ mkVarRef VarGroupLocal (ntmps + n)) + Asm.Push val -> return $ mkAssign (mkVarRef VarGroupLocal (ntmps + n + 1)) (mkValue val) Asm.Pop -> return Nop - Asm.Trace -> return $ Trace $ InstrTrace (VRef $ VarRef VarGroupLocal (ntmps + n)) + Asm.Trace -> return $ Trace $ InstrTrace (VRef $ mkVarRef VarGroupLocal (ntmps + n)) Asm.Dump -> return Dump - Asm.Failure -> return $ Failure $ InstrFailure (VRef $ VarRef VarGroupLocal (ntmps + n)) - Asm.ArgsNum -> return $ mkArgsNum (VarRef VarGroupLocal (ntmps + n)) (VRef $ VarRef VarGroupLocal (ntmps + n)) + Asm.Failure -> return $ Failure $ InstrFailure (VRef $ mkVarRef VarGroupLocal (ntmps + n)) + Asm.ArgsNum -> return $ mkArgsNum (mkVarRef VarGroupLocal (ntmps + n)) (VRef $ mkVarRef VarGroupLocal (ntmps + n)) Asm.Prealloc x -> return $ mkPrealloc x Asm.AllocConstr tag -> return $ mkAlloc tag Asm.AllocClosure x -> return $ mkAllocClosure x @@ -97,7 +81,7 @@ fromAsmInstr funInfo tab si Asm.CmdInstr {..} = Asm.CallClosures x -> return $ mkCallClosures False x Asm.TailCallClosures x -> return $ mkCallClosures True x Asm.Return -> - return $ Return InstrReturn {_instrReturnValue = VRef $ VarRef VarGroupLocal ntmps} + return $ Return InstrReturn {_instrReturnValue = VRef $ mkVarRef VarGroupLocal ntmps} where extraInfo :: Asm.FunctionInfoExtra extraInfo = fromJust (funInfo ^. Asm.functionExtra) @@ -116,21 +100,21 @@ fromAsmInstr funInfo tab si Asm.CmdInstr {..} = -- liveness analysis in JuvixAsm. liveVars :: Int -> [VarRef] liveVars k = - map (VarRef VarGroupLocal) [0 .. si ^. Asm.stackInfoTempStackHeight - 1] - ++ map (VarRef VarGroupLocal) [ntmps .. ntmps + n - k] - ++ map (VarRef VarGroupArgs) [0 .. funInfo ^. Asm.functionArgsNum - 1] + map (mkVarRef VarGroupLocal) [0 .. si ^. Asm.stackInfoTempStackHeight - 1] + ++ map (mkVarRef VarGroupLocal) [ntmps .. ntmps + n - k] + ++ map (mkVarRef VarGroupArgs) [0 .. funInfo ^. Asm.functionArgsNum - 1] getArgs :: Int -> Int -> [Value] - getArgs s k = map (\i -> VRef $ VarRef VarGroupLocal (ntmps + n - i)) [s .. (s + k - 1)] + getArgs s k = map (\i -> VRef $ mkVarRef VarGroupLocal (ntmps + n - i)) [s .. (s + k - 1)] mkBinop :: Opcode -> Instruction mkBinop op = Binop ( BinaryOp { _binaryOpCode = op, - _binaryOpResult = VarRef VarGroupLocal (ntmps + n - 1), - _binaryOpArg1 = VRef $ VarRef VarGroupLocal (ntmps + n), - _binaryOpArg2 = VRef $ VarRef VarGroupLocal (ntmps + n - 1) + _binaryOpResult = mkVarRef VarGroupLocal (ntmps + n - 1), + _binaryOpArg1 = VRef $ mkVarRef VarGroupLocal (ntmps + n), + _binaryOpArg2 = VRef $ mkVarRef VarGroupLocal (ntmps + n - 1) } ) @@ -160,11 +144,7 @@ fromAsmInstr funInfo tab si Asm.CmdInstr {..} = mkValue :: Asm.Value -> Value mkValue = \case - Asm.Constant (Asm.ConstInt v) -> ConstInt v - Asm.Constant (Asm.ConstBool v) -> ConstBool v - Asm.Constant (Asm.ConstString v) -> ConstString v - Asm.Constant Asm.ConstUnit -> ConstUnit - Asm.Constant Asm.ConstVoid -> ConstVoid + Asm.Constant c -> Const c Asm.Ref mv -> case mv of Asm.DRef dref -> VRef $ mkVar dref Asm.ConstrRef Asm.Field {..} -> @@ -180,8 +160,8 @@ fromAsmInstr funInfo tab si Asm.CmdInstr {..} = mkVar :: Asm.DirectRef -> VarRef mkVar = \case - Asm.ArgRef Asm.OffsetRef {..} -> VarRef VarGroupArgs _offsetRefOffset - Asm.TempRef Asm.RefTemp {..} -> VarRef VarGroupLocal (_refTempOffsetRef ^. Asm.offsetRefOffset) + Asm.ArgRef Asm.OffsetRef {..} -> VarRef VarGroupArgs _offsetRefOffset _offsetRefName + Asm.TempRef Asm.RefTemp {..} -> VarRef VarGroupLocal (_refTempOffsetRef ^. Asm.offsetRefOffset) (_refTempOffsetRef ^. Asm.offsetRefName) mkPrealloc :: Asm.InstrPrealloc -> Instruction mkPrealloc Asm.InstrPrealloc {..} = @@ -196,7 +176,7 @@ fromAsmInstr funInfo tab si Asm.CmdInstr {..} = Alloc $ InstrAlloc { _instrAllocTag = tag, - _instrAllocResult = VarRef VarGroupLocal (ntmps + m), + _instrAllocResult = mkVarRef VarGroupLocal (ntmps + m), _instrAllocArgs = getArgs 0 (ci ^. Asm.constructorArgsNum), _instrAllocMemRep = ci ^. Asm.constructorRepresentation } @@ -209,7 +189,7 @@ fromAsmInstr funInfo tab si Asm.CmdInstr {..} = AllocClosure $ InstrAllocClosure { _instrAllocClosureSymbol = fi ^. Asm.functionSymbol, - _instrAllocClosureResult = VarRef VarGroupLocal (ntmps + m), + _instrAllocClosureResult = mkVarRef VarGroupLocal (ntmps + m), _instrAllocClosureExpectedArgsNum = fi ^. Asm.functionArgsNum, _instrAllocClosureArgs = getArgs 0 _allocClosureArgsNum } @@ -221,42 +201,54 @@ fromAsmInstr funInfo tab si Asm.CmdInstr {..} = mkExtendClosure Asm.InstrExtendClosure {..} = ExtendClosure $ InstrExtendClosure - { _instrExtendClosureResult = VarRef VarGroupLocal (ntmps + m), - _instrExtendClosureValue = VarRef VarGroupLocal (ntmps + n), + { _instrExtendClosureResult = mkVarRef VarGroupLocal (ntmps + m), + _instrExtendClosureValue = mkVarRef VarGroupLocal (ntmps + n), _instrExtendClosureArgs = getArgs 1 _extendClosureArgsNum } where m = n - _extendClosureArgsNum mkCall :: Bool -> Asm.InstrCall -> Instruction - mkCall isTail Asm.InstrCall {..} = - Call $ - InstrCall - { _instrCallResult = VarRef VarGroupLocal (ntmps + m), - _instrCallType = ct, - _instrCallIsTail = isTail, - _instrCallArgs = getArgs s _callArgsNum, - _instrCallLiveVars = liveVars (_callArgsNum + s) - } + mkCall isTail Asm.InstrCall {..} + | not isTail = + Call $ + InstrCall + { _instrCallResult = mkVarRef VarGroupLocal (ntmps + m), + _instrCallType = ct, + _instrCallArgs = getArgs s _callArgsNum, + _instrCallLiveVars = liveVars (_callArgsNum + s) + } + | otherwise = + TailCall $ + InstrTailCall + { _instrTailCallType = ct, + _instrTailCallArgs = getArgs s _callArgsNum + } where m = n - _callArgsNum - s + 1 ct = case _callType of Asm.CallFun f -> CallFun f - Asm.CallClosure -> CallClosure (VarRef VarGroupLocal (ntmps + n)) + Asm.CallClosure -> CallClosure (mkVarRef VarGroupLocal (ntmps + n)) s = case _callType of Asm.CallFun {} -> 0 Asm.CallClosure -> 1 mkCallClosures :: Bool -> Asm.InstrCallClosures -> Instruction - mkCallClosures isTail Asm.InstrCallClosures {..} = - CallClosures $ - InstrCallClosures - { _instrCallClosuresResult = VarRef VarGroupLocal (ntmps + m), - _instrCallClosuresValue = VarRef VarGroupLocal (ntmps + n), - _instrCallClosuresIsTail = isTail, - _instrCallClosuresArgs = getArgs 1 _callClosuresArgsNum, - _instrCallClosuresLiveVars = liveVars (_callClosuresArgsNum + 1) - } + mkCallClosures isTail Asm.InstrCallClosures {..} + | not isTail = + CallClosures $ + InstrCallClosures + { _instrCallClosuresResult = mkVarRef VarGroupLocal (ntmps + m), + _instrCallClosuresValue = mkVarRef VarGroupLocal (ntmps + n), + _instrCallClosuresArgs = getArgs 1 _callClosuresArgsNum, + _instrCallClosuresLiveVars = liveVars (_callClosuresArgsNum + 1) + } + | otherwise = + TailCallClosures $ + InstrTailCallClosures + { _instrTailCallClosuresValue = mkVarRef VarGroupLocal (ntmps + n), + _instrTailCallClosuresArgs = getArgs 1 _callClosuresArgsNum + } where -- note: the value (closure) is also on the stack m = n - _callClosuresArgsNum @@ -272,7 +264,7 @@ fromAsmBranch fi si Asm.CmdBranch {} codeTrue codeFalse = return $ Branch $ InstrBranch - { _instrBranchValue = VRef $ VarRef VarGroupLocal (fromJust (fi ^. Asm.functionExtra) ^. Asm.functionMaxTempStackHeight + si ^. Asm.stackInfoValueStackHeight - 1), + { _instrBranchValue = VRef $ mkVarRef VarGroupLocal (fromJust (fi ^. Asm.functionExtra) ^. Asm.functionMaxTempStackHeight + si ^. Asm.stackInfoValueStackHeight - 1), _instrBranchTrue = codeTrue, _instrBranchFalse = codeFalse } @@ -289,7 +281,7 @@ fromAsmCase fi tab si Asm.CmdCase {..} brs def = return $ Case $ InstrCase - { _instrCaseValue = VRef $ VarRef VarGroupLocal (fromJust (fi ^. Asm.functionExtra) ^. Asm.functionMaxTempStackHeight + si ^. Asm.stackInfoValueStackHeight - 1), + { _instrCaseValue = VRef $ mkVarRef VarGroupLocal (fromJust (fi ^. Asm.functionExtra) ^. Asm.functionMaxTempStackHeight + si ^. Asm.stackInfoValueStackHeight - 1), _instrCaseInductive = _cmdCaseInductive, _instrCaseIndRep = ii ^. Asm.inductiveRepresentation, _instrCaseBranches = @@ -321,15 +313,15 @@ fromAsmSave :: Asm.CmdSave -> Code -> Sem r Instruction -fromAsmSave fi si Asm.CmdSave {} block = +fromAsmSave fi si Asm.CmdSave {..} block = return $ Block $ InstrBlock { _instrBlockCode = Assign ( InstrAssign - (VarRef VarGroupLocal (si ^. Asm.stackInfoTempStackHeight)) - (VRef $ VarRef VarGroupLocal (fromJust (fi ^. Asm.functionExtra) ^. Asm.functionMaxTempStackHeight + si ^. Asm.stackInfoValueStackHeight - 1)) + (VarRef VarGroupLocal (si ^. Asm.stackInfoTempStackHeight) _cmdSaveName) + (VRef $ mkVarRef VarGroupLocal (fromJust (fi ^. Asm.functionExtra) ^. Asm.functionMaxTempStackHeight + si ^. Asm.stackInfoValueStackHeight - 1)) ) : block } diff --git a/src/Juvix/Compiler/Reg/Translation/FromSource.hs b/src/Juvix/Compiler/Reg/Translation/FromSource.hs new file mode 100644 index 000000000..28451384e --- /dev/null +++ b/src/Juvix/Compiler/Reg/Translation/FromSource.hs @@ -0,0 +1,489 @@ +module Juvix.Compiler.Reg.Translation.FromSource + ( module Juvix.Compiler.Reg.Translation.FromSource, + module Juvix.Parser.Error, + BuilderState, + ) +where + +import Control.Monad.Trans.Class (lift) +import Data.HashMap.Strict qualified as HashMap +import Juvix.Compiler.Reg.Data.InfoTable +import Juvix.Compiler.Reg.Data.InfoTableBuilder +import Juvix.Compiler.Reg.Language +import Juvix.Compiler.Reg.Translation.FromSource.Lexer +import Juvix.Compiler.Tree.Translation.FromSource.Base +import Juvix.Compiler.Tree.Translation.FromSource.Sig qualified as S +import Juvix.Parser.Error +import Text.Megaparsec qualified as P + +type ParserSig = S.ParserSig Code () VarRef + +type LocalParams = LocalParams' VarRef + +parseRegSig :: ParserSig +parseRegSig = + S.ParserSig + { _parserSigBareIdentifier = bareIdentifier, + _parserSigParseCode = parseCode, + _parserSigArgRef = VarRef VarGroupArgs, + _parserSigEmptyCode = [], + _parserSigEmptyExtra = () + } + +parseText :: Text -> Either MegaparsecError InfoTable +parseText = runParser "" + +parseText' :: BuilderState -> Text -> Either MegaparsecError BuilderState +parseText' bs = runParser' bs "" + +runParser :: FilePath -> Text -> Either MegaparsecError InfoTable +runParser = runParserS parseRegSig + +runParser' :: BuilderState -> FilePath -> Text -> Either MegaparsecError BuilderState +runParser' = runParserS' parseRegSig + +parseCode :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r Code +parseCode = P.sepEndBy instruction (kw delimSemicolon) + +instruction :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r Instruction +instruction = + (instrNop >> return Nop) + <|> (Trace <$> instrTrace) + <|> (instrDump >> return Dump) + <|> (Failure <$> instrFailure) + <|> (Prealloc <$> instrPrealloc) + <|> (TailCall <$> instrTailCall) + <|> (TailCallClosures <$> instrTailCallClosures) + <|> (Return <$> instrReturn) + <|> (Branch <$> instrBranch) + <|> (Case <$> instrCase) + <|> (Block <$> instrBlock) + <|> instrWithResult + +instrWithResult :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r Instruction +instrWithResult = do + vref <- declVarRef + kw kwEq + (Binop <$> instrBinop vref) + <|> (Show <$> instrShow vref) + <|> (StrToInt <$> instrStrToInt vref) + <|> (ArgsNum <$> instrArgsNum vref) + <|> (Alloc <$> instrAlloc vref) + <|> (AllocClosure <$> instrAllocClosure vref) + <|> (ExtendClosure <$> instrExtendClosure vref) + <|> (Call <$> instrCall vref) + <|> (CallClosures <$> instrCallClosures vref) + <|> (Assign <$> instrAssign vref) + +instrNop :: ParsecS r () +instrNop = kw kwNop + +instrBinop :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + VarRef -> + ParsecS r BinaryOp +instrBinop vref = + parseBinaryOp kwAdd_ OpIntAdd vref + <|> parseBinaryOp kwSub_ OpIntSub vref + <|> parseBinaryOp kwMul_ OpIntMul vref + <|> parseBinaryOp kwDiv_ OpIntDiv vref + <|> parseBinaryOp kwMod_ OpIntMod vref + <|> parseBinaryOp kwLt_ OpIntLt vref + <|> parseBinaryOp kwLe_ OpIntLe vref + <|> parseBinaryOp kwEq_ OpEq vref + <|> parseBinaryOp kwStrcat OpStrConcat vref + +parseBinaryOp :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + Keyword -> + Opcode -> + VarRef -> + ParsecS r BinaryOp +parseBinaryOp kwd op vref = do + kw kwd + arg1 <- value + arg2 <- value + return $ + BinaryOp + { _binaryOpCode = op, + _binaryOpResult = vref, + _binaryOpArg1 = arg1, + _binaryOpArg2 = arg2 + } + +instrShow :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + VarRef -> + ParsecS r InstrShow +instrShow vref = do + kw kwShow + val <- value + return + InstrShow + { _instrShowResult = vref, + _instrShowValue = val + } + +instrStrToInt :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + VarRef -> + ParsecS r InstrStrToInt +instrStrToInt vref = do + kw kwAtoi + val <- value + return + InstrStrToInt + { _instrStrToIntResult = vref, + _instrStrToIntValue = val + } + +instrAssign :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + VarRef -> + ParsecS r InstrAssign +instrAssign vref = do + val <- value + return + InstrAssign + { _instrAssignResult = vref, + _instrAssignValue = val + } + +instrTrace :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r InstrTrace +instrTrace = do + kw kwTrace + val <- value + return + InstrTrace + { _instrTraceValue = val + } + +instrDump :: ParsecS r () +instrDump = kw kwDump + +instrFailure :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r InstrFailure +instrFailure = do + kw kwFail + val <- value + return + InstrFailure + { _instrFailureValue = val + } + +instrArgsNum :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + VarRef -> + ParsecS r InstrArgsNum +instrArgsNum vref = do + kw kwArgsNum + val <- value + return + InstrArgsNum + { _instrArgsNumResult = vref, + _instrArgsNumValue = val + } + +instrPrealloc :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r InstrPrealloc +instrPrealloc = do + kw kwPrealloc + n <- int + vars <- fromMaybe [] <$> optional liveVars + return + InstrPrealloc + { _instrPreallocWordsNum = n, + _instrPreallocLiveVars = vars + } + +instrAlloc :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + VarRef -> + ParsecS r InstrAlloc +instrAlloc vref = do + kw kwAlloc + tag <- constrTag @Code @() @VarRef + args <- parseArgs + return + InstrAlloc + { _instrAllocResult = vref, + _instrAllocTag = tag, + _instrAllocArgs = args, + _instrAllocMemRep = MemRepConstr + } + +instrAllocClosure :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + VarRef -> + ParsecS r InstrAllocClosure +instrAllocClosure vref = do + kw kwCAlloc + sym <- funSymbol @Code @() @VarRef + args <- parseArgs + fi <- lift $ getFunctionInfo sym + return + InstrAllocClosure + { _instrAllocClosureResult = vref, + _instrAllocClosureSymbol = sym, + _instrAllocClosureExpectedArgsNum = fi ^. functionArgsNum, + _instrAllocClosureArgs = args + } + +instrExtendClosure :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + VarRef -> + ParsecS r InstrExtendClosure +instrExtendClosure vref = do + kw kwCExtend + cl <- varRef + args <- parseArgs + return + InstrExtendClosure + { _instrExtendClosureResult = vref, + _instrExtendClosureValue = cl, + _instrExtendClosureArgs = args + } + +liveVars :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r [VarRef] +liveVars = do + P.try (comma >> symbol "live:") + parens (P.sepBy varRef comma) + +parseArgs :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r [Value] +parseArgs = do + parens (P.sepBy value comma) + +parseCallType :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r CallType +parseCallType = + (CallFun <$> funSymbol @Code @() @VarRef) + <|> (CallClosure <$> varRef) + +instrCall :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + VarRef -> + ParsecS r InstrCall +instrCall vref = do + kw kwCall + ct <- parseCallType + args <- parseArgs + vars <- fromMaybe [] <$> optional liveVars + return + InstrCall + { _instrCallResult = vref, + _instrCallType = ct, + _instrCallArgs = args, + _instrCallLiveVars = vars + } + +instrCallClosures :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + VarRef -> + ParsecS r InstrCallClosures +instrCallClosures vref = do + kw kwCCall + val <- varRef + args <- parseArgs + vars <- fromMaybe [] <$> optional liveVars + return + InstrCallClosures + { _instrCallClosuresResult = vref, + _instrCallClosuresValue = val, + _instrCallClosuresArgs = args, + _instrCallClosuresLiveVars = vars + } + +instrTailCall :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r InstrTailCall +instrTailCall = do + kw kwCallTail + ct <- parseCallType + args <- parseArgs + return + InstrTailCall + { _instrTailCallType = ct, + _instrTailCallArgs = args + } + +instrTailCallClosures :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r InstrTailCallClosures +instrTailCallClosures = do + kw kwCCallTail + val <- varRef + args <- parseArgs + return + InstrTailCallClosures + { _instrTailCallClosuresValue = val, + _instrTailCallClosuresArgs = args + } + +instrReturn :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r InstrReturn +instrReturn = do + kw kwRet + val <- value + return + InstrReturn + { _instrReturnValue = val + } + +instrBranch :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r InstrBranch +instrBranch = do + kw kwBr + val <- value + (br1, br2) <- braces $ do + symbol "true:" + br1 <- braces parseCode + kw delimSemicolon + symbol "false:" + br2 <- braces parseCode + kw delimSemicolon + return (br1, br2) + return + InstrBranch + { _instrBranchValue = val, + _instrBranchTrue = br1, + _instrBranchFalse = br2 + } + +instrCase :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r InstrCase +instrCase = do + kw kwCase + sym <- brackets (indSymbol @Code @() @VarRef) + val <- value + lbrace + brs <- many caseBranch + def <- optional defaultBranch + rbrace + return + InstrCase + { _instrCaseValue = val, + _instrCaseInductive = sym, + _instrCaseIndRep = IndRepStandard, + _instrCaseBranches = brs, + _instrCaseDefault = def + } + +caseBranch :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r CaseBranch +caseBranch = do + tag <- P.try $ do + tag <- constrTag @Code @() @VarRef + kw kwColon + return tag + body <- braces parseCode + kw delimSemicolon + ci <- lift $ getConstructorInfo tag + return + CaseBranch + { _caseBranchTag = tag, + _caseBranchArgsNum = ci ^. constructorArgsNum, + _caseBranchCode = body, + _caseBranchMemRep = MemRepConstr + } + +defaultBranch :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r Code +defaultBranch = do + symbol "default:" + c <- braces parseCode + kw delimSemicolon + return c + +instrBlock :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r InstrBlock +instrBlock = InstrBlock <$> braces parseCode + +varRef :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r VarRef +varRef = varArg <|> varTmp <|> namedRef @Code @() @VarRef + +declVarRef :: + forall r. + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r VarRef +declVarRef = varArg <|> varTmp <|> namedRef' @Code @() @VarRef decl + where + decl :: Int -> Text -> ParsecS r VarRef + decl _ txt = do + idx <- lift $ gets @LocalParams (^. localParamsTempIndex) + lift $ modify' @LocalParams (over localParamsTempIndex (+ 1)) + let vref = VarRef VarGroupLocal idx (Just txt) + lift $ modify' (over localParamsNameMap (HashMap.insert txt vref)) + return vref + +varArg :: ParsecS r VarRef +varArg = do + kw kwArg + off <- brackets int + return + VarRef + { _varRefGroup = VarGroupArgs, + _varRefIndex = off, + _varRefName = Nothing + } + +varTmp :: ParsecS r VarRef +varTmp = do + kw kwTmp + off <- brackets int + return + VarRef + { _varRefGroup = VarGroupLocal, + _varRefIndex = off, + _varRefName = Nothing + } + +value :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r Value +value = (Const <$> constant) <|> varOrConstrRef + +varOrConstrRef :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + ParsecS r Value +varOrConstrRef = do + r <- varRef + (CRef <$> constrField r) <|> return (VRef r) + +constrField :: + (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => + VarRef -> + ParsecS r ConstrField +constrField ref = do + dot + tag <- constrTag @Code @() @VarRef + off <- brackets int + return + ConstrField + { _constrFieldTag = tag, + _constrFieldMemRep = MemRepConstr, + _constrFieldRef = ref, + _constrFieldIndex = off + } diff --git a/src/Juvix/Compiler/Reg/Translation/FromSource/Lexer.hs b/src/Juvix/Compiler/Reg/Translation/FromSource/Lexer.hs new file mode 100644 index 000000000..fe1d206be --- /dev/null +++ b/src/Juvix/Compiler/Reg/Translation/FromSource/Lexer.hs @@ -0,0 +1,25 @@ +module Juvix.Compiler.Reg.Translation.FromSource.Lexer + ( module Juvix.Compiler.Reg.Translation.FromSource.Lexer, + module Juvix.Compiler.Tree.Translation.FromSource.Lexer.Base, + module Juvix.Compiler.Reg.Keywords, + ) +where + +import Juvix.Compiler.Reg.Keywords +import Juvix.Compiler.Tree.Translation.FromSource.Lexer.Base +import Juvix.Prelude + +int :: ParsecS r Int +int = fst <$> number (-(2 ^ (31 :: Int))) (2 ^ (31 :: Int)) + +smallnat :: ParsecS r Int +smallnat = fst <$> number 0 256 + +identifier :: ParsecS r Text +identifier = lexeme bareIdentifier + +identifierL :: ParsecS r (Text, Interval) +identifierL = lexemeInterval bareIdentifier + +bareIdentifier :: ParsecS r Text +bareIdentifier = rawIdentifier' (`elem` specialSymbols) allKeywordStrings diff --git a/src/Juvix/Compiler/Tree/Data/InfoTableBuilder/Base.hs b/src/Juvix/Compiler/Tree/Data/InfoTableBuilder/Base.hs index bf0cb741d..53b74356e 100644 --- a/src/Juvix/Compiler/Tree/Data/InfoTableBuilder/Base.hs +++ b/src/Juvix/Compiler/Tree/Data/InfoTableBuilder/Base.hs @@ -26,6 +26,7 @@ data InfoTableBuilder' t e m a where RegisterMain' :: Symbol -> InfoTableBuilder' t e m () GetIdent' :: Text -> InfoTableBuilder' t e m (Maybe IdentKind) GetFunctionInfo' :: Symbol -> InfoTableBuilder' t e m (FunctionInfo' t e) + GetConstructorInfo' :: Tag -> InfoTableBuilder' t e m ConstructorInfo makeSem ''InfoTableBuilder' @@ -100,3 +101,6 @@ runInfoTableBuilder' bs = GetFunctionInfo' sym -> do s <- get return (lookupFunInfo (s ^. stateInfoTable) sym) + GetConstructorInfo' tag -> do + s <- get @(BuilderState' t e) + return (lookupConstrInfo (s ^. stateInfoTable) tag) diff --git a/src/Juvix/Compiler/Tree/Language/Base.hs b/src/Juvix/Compiler/Tree/Language/Base.hs index 131e3fd54..602661937 100644 --- a/src/Juvix/Compiler/Tree/Language/Base.hs +++ b/src/Juvix/Compiler/Tree/Language/Base.hs @@ -16,6 +16,7 @@ data Constant | ConstString Text | ConstUnit | ConstVoid + deriving stock (Eq) -- | MemRefs are references to values stored in memory. data MemRef @@ -24,11 +25,13 @@ data MemRef | -- | ConstrRef is an indirect reference to a field (argument) of -- a constructor: field k holds the (k+1)th argument. ConstrRef Field + deriving stock (Eq) data OffsetRef = OffsetRef { _offsetRefOffset :: Offset, _offsetRefName :: Maybe Text } + deriving stock (Eq) -- | DirectRef is a direct memory reference. data DirectRef @@ -39,6 +42,7 @@ data DirectRef -- counted from the _bottom_ of the temporary stack). JVT/JVA code: -- 'tmp[]'. TempRef RefTemp + deriving stock (Eq) mkTempRef :: OffsetRef -> DirectRef mkTempRef o = TempRef (RefTemp o Nothing) @@ -56,6 +60,7 @@ data RefTemp = RefTemp { _refTempOffsetRef :: OffsetRef, _refTempTempHeight :: Maybe Int } + deriving stock (Eq) -- | Constructor field reference. JVT/JVA code: '.[]' data Field = Field @@ -66,6 +71,7 @@ data Field = Field _fieldRef :: DirectRef, _fieldOffset :: Offset } + deriving stock (Eq) makeLenses ''Field makeLenses ''OffsetRef diff --git a/src/Juvix/Compiler/Tree/Language/Rep.hs b/src/Juvix/Compiler/Tree/Language/Rep.hs index e52f81029..44b879a66 100644 --- a/src/Juvix/Compiler/Tree/Language/Rep.hs +++ b/src/Juvix/Compiler/Tree/Language/Rep.hs @@ -1,5 +1,7 @@ module Juvix.Compiler.Tree.Language.Rep where +import Juvix.Prelude + -- | Memory representation of a constructor. data MemRep = -- | Standard representation of a constructor: [tag, field 0, .., field n] @@ -23,6 +25,7 @@ data MemRep -- representing constructors of different inductive types because they have -- no tag). The argument is the representation of the wrapped value. MemRepUnpacked ValRep + deriving stock (Eq) -- | Representation of values. data ValRep @@ -36,6 +39,7 @@ data ValRep ValRepWord | -- | Constructor of an inductive type with a given representation. ValRepInd IndRep + deriving stock (Eq) -- | Representation of an inductive type. data IndRep @@ -64,3 +68,4 @@ data IndRep | -- | The constructors can have any representation as long as there is no -- ambiguity arising from unpacking. IndRepMixed + deriving stock (Eq) diff --git a/src/Juvix/Compiler/Tree/Pretty/Base.hs b/src/Juvix/Compiler/Tree/Pretty/Base.hs index 2641f4342..da6f484c2 100644 --- a/src/Juvix/Compiler/Tree/Pretty/Base.hs +++ b/src/Juvix/Compiler/Tree/Pretty/Base.hs @@ -7,12 +7,12 @@ where import Data.Foldable import Data.HashMap.Strict qualified as HashMap import Data.List.NonEmpty qualified as NonEmpty -import Data.Text qualified as Text import Juvix.Compiler.Core.Pretty.Base qualified as Core import Juvix.Compiler.Internal.Data.Name import Juvix.Compiler.Tree.Data.InfoTable import Juvix.Compiler.Tree.Language import Juvix.Compiler.Tree.Language.Value +import Juvix.Compiler.Tree.Pretty.Extra import Juvix.Compiler.Tree.Pretty.Options import Juvix.Data.CodeAnn import Juvix.Extra.Strings qualified as Str @@ -36,26 +36,6 @@ wrapCore f c = do opts <- ask return $ run $ runReader (toCoreOptions opts) $ f c -quoteName :: Text -> Text -quoteName txt = - foldr - (uncurry Text.replace) - txt - [ ("$", "__dollar__"), - (":", "__colon__"), - ("@", "__at__"), - ("arg", "__arg__"), - ("tmp", "__tmp__") - ] - -quoteFunName :: Text -> Text -quoteFunName txt = - foldr - (uncurry Text.replace) - txt - [ ("readLn", "__readLn__") - ] - ppConstrName :: (Member (Reader Options) r) => Tag -> Sem r (Doc Ann) ppConstrName tag = do tagNames <- asks (^. optTagNames) @@ -393,9 +373,9 @@ ppInductive tab InductiveInfo {..} = do ppInfoTable :: (Member (Reader Options) r) => (t -> Sem r (Doc Ann)) -> InfoTable' t e -> Sem r (Doc Ann) ppInfoTable ppCode' tab@InfoTable {..} = do - inds <- mapM (ppInductive tab) (HashMap.elems (filterOutBuiltins _infoInductives)) - funsigs <- mapM ppFunSig (HashMap.elems _infoFunctions) - funs <- mapM (ppFunInfo ppCode') (HashMap.elems _infoFunctions) + inds <- mapM (ppInductive tab) (sortOn (^. inductiveLocation) $ HashMap.elems (filterOutBuiltins _infoInductives)) + funsigs <- mapM ppFunSig (sortOn (^. functionLocation) $ HashMap.elems _infoFunctions) + funs <- mapM (ppFunInfo ppCode') (sortOn (^. functionLocation) $ HashMap.elems _infoFunctions) return $ vcat (map (<> line) inds) <> line <> vcat funsigs <> line <> line <> vcat (map (<> line) funs) where filterOutBuiltins :: HashMap Symbol InductiveInfo -> HashMap Symbol InductiveInfo @@ -413,18 +393,6 @@ instance PrettyCode InfoTable where {--------------------------------------------------------------------------------} {- helper functions -} -braces' :: Doc Ann -> Doc Ann -braces' d = braces (line <> indent' d <> line) - -integer :: (Pretty a) => a -> Doc Ann -integer i = annotate AnnLiteralInteger (pretty i) - -constr :: Text -> Doc Ann -constr a = annotate (AnnKind KNameConstructor) (pretty a) - -variable :: Text -> Doc Ann -variable a = annotate (AnnKind KNameLocal) (pretty a) - ppRightExpression :: (PrettyCode a, HasAtomicity a, Member (Reader Options) r) => Fixity -> diff --git a/src/Juvix/Compiler/Tree/Pretty/Extra.hs b/src/Juvix/Compiler/Tree/Pretty/Extra.hs new file mode 100644 index 000000000..9d2e53049 --- /dev/null +++ b/src/Juvix/Compiler/Tree/Pretty/Extra.hs @@ -0,0 +1,37 @@ +module Juvix.Compiler.Tree.Pretty.Extra where + +import Data.Text qualified as Text +import Juvix.Data.CodeAnn +import Juvix.Prelude + +braces' :: Doc Ann -> Doc Ann +braces' d = braces (line <> indent' d <> line) + +integer :: (Pretty a) => a -> Doc Ann +integer i = annotate AnnLiteralInteger (pretty i) + +constr :: Text -> Doc Ann +constr a = annotate (AnnKind KNameConstructor) (pretty a) + +variable :: Text -> Doc Ann +variable a = annotate (AnnKind KNameLocal) (pretty a) + +quoteName :: Text -> Text +quoteName txt = + foldr + (uncurry Text.replace) + txt + [ ("$", "__dollar__"), + (":", "__colon__"), + ("@", "__at__"), + ("arg", "__arg__"), + ("tmp", "__tmp__") + ] + +quoteFunName :: Text -> Text +quoteFunName txt = + foldr + (uncurry Text.replace) + txt + [ ("readLn", "__readLn__") + ] diff --git a/src/Juvix/Compiler/Tree/Translation/FromSource.hs b/src/Juvix/Compiler/Tree/Translation/FromSource.hs index 5087c9629..9c3e2f599 100644 --- a/src/Juvix/Compiler/Tree/Translation/FromSource.hs +++ b/src/Juvix/Compiler/Tree/Translation/FromSource.hs @@ -17,13 +17,16 @@ import Juvix.Compiler.Tree.Translation.FromSource.Sig qualified as S import Juvix.Parser.Error import Text.Megaparsec qualified as P -type ParserSig = S.ParserSig Node () +type ParserSig = S.ParserSig Node () DirectRef + +type LocalParams = LocalParams' DirectRef parseTreeSig :: ParserSig parseTreeSig = S.ParserSig { _parserSigBareIdentifier = bareIdentifier, _parserSigParseCode = parseNode, + _parserSigArgRef = \x y -> ArgRef (OffsetRef x y), _parserSigEmptyCode = mkUnop OpFail (mkConst (ConstString "fail")), _parserSigEmptyExtra = () } @@ -131,7 +134,7 @@ parseAlloc :: ParsecS r NodeAllocConstr parseAlloc = do loc <- onlyInterval (kw kwAlloc) - tag <- brackets (constrTag @Node @()) + tag <- brackets (constrTag @Node @() @DirectRef) args <- parseArgs return NodeAllocConstr @@ -145,7 +148,7 @@ parseCAlloc :: ParsecS r NodeAllocClosure parseCAlloc = do loc <- onlyInterval (kw kwCAlloc) - sym <- brackets (funSymbol @Node @()) + sym <- brackets (funSymbol @Node @() @DirectRef) args <- parseArgs return NodeAllocClosure @@ -183,7 +186,7 @@ parseCall = do callDirect :: Location -> ParsecS r NodeCall callDirect loc = do lbracket - sym <- funSymbol @Node @() + sym <- funSymbol @Node @() @DirectRef rbracket args <- parseArgs return @@ -275,7 +278,7 @@ parseCase :: ParsecS r NodeCase parseCase = do loc <- onlyInterval (kw kwCase) - sym <- brackets (indSymbol @Node @()) + sym <- brackets (indSymbol @Node @() @DirectRef) arg <- parens parseNode lbrace brs <- P.many caseBranch @@ -295,7 +298,7 @@ caseBranch :: (Members '[Reader ParserSig, InfoTableBuilder, State LocalParams] r) => ParsecS r CaseBranch caseBranch = do - (tag, loc) <- P.try $ interval (constrTag @Node @()) + (tag, loc) <- P.try $ interval (constrTag @Node @() @DirectRef) kw kwColon (bSave, body) <- saveBranch <|> discardBranch optional (kw delimSemicolon) @@ -332,10 +335,10 @@ parseSave = do loc' <- onlyInterval (kw kwSave) (mname, loc) <- interval $ optional (brackets identifier) arg <- parens parseNode - tmpNum <- lift $ gets (^. localParamsTempIndex) - let updateNames :: LocalNameMap -> LocalNameMap + tmpNum <- lift $ gets @LocalParams (^. localParamsTempIndex) + let updateNames :: LocalNameMap DirectRef -> LocalNameMap DirectRef updateNames mp = maybe mp (\n -> HashMap.insert n (mkTempRef (OffsetRef tmpNum (Just n))) mp) mname - body <- braces (localS (over localParamsTempIndex (+ 1)) $ localS (over localParamsNameMap updateNames) parseNode) + body <- braces (localS @LocalParams (over localParamsTempIndex (+ 1)) $ localS @LocalParams (over localParamsNameMap updateNames) parseNode) return NodeSave { _nodeSaveInfo = NodeInfo (Just loc'), diff --git a/src/Juvix/Compiler/Tree/Translation/FromSource/Base.hs b/src/Juvix/Compiler/Tree/Translation/FromSource/Base.hs index 6d4bdd58e..bf63cb9ba 100644 --- a/src/Juvix/Compiler/Tree/Translation/FromSource/Base.hs +++ b/src/Juvix/Compiler/Tree/Translation/FromSource/Base.hs @@ -7,7 +7,7 @@ module Juvix.Compiler.Tree.Translation.FromSource.Base ( module Juvix.Compiler.Tree.Translation.FromSource.Base, LocalNameMap, - LocalParams (..), + LocalParams' (..), localParamsNameMap, localParamsTempIndex, ) @@ -37,37 +37,30 @@ localS update a = do lift $ put s return a' -runParserS :: ParserSig t e -> FilePath -> Text -> Either MegaparsecError (InfoTable' t e) +runParserS :: ParserSig t e d -> FilePath -> Text -> Either MegaparsecError (InfoTable' t e) runParserS sig fileName input_ = (^. stateInfoTable) <$> runParserS' sig emptyBuilderState fileName input_ -runParserS' :: forall t e. ParserSig t e -> BuilderState' t e -> FilePath -> Text -> Either MegaparsecError (BuilderState' t e) -runParserS' sig bs fileName input_ = case runParserS'' (parseToplevel @t @e) sig bs fileName input_ of +runParserS' :: forall t e d. ParserSig t e d -> BuilderState' t e -> FilePath -> Text -> Either MegaparsecError (BuilderState' t e) +runParserS' sig bs fileName input_ = case runParserS'' (parseToplevel @t @e @d) sig bs fileName input_ of Left e -> Left e Right (bs', ()) -> Right bs' runParserS'' :: - forall t e a. - ParsecS '[NameIdGen, InfoTableBuilder' t e, Reader (ParserSig t e), State LocalParams] a -> - ParserSig t e -> + forall t e d a. + ParsecS '[Reader (ParserSig t e d), InfoTableBuilder' t e, State (LocalParams' d)] a -> + ParserSig t e d -> BuilderState' t e -> FilePath -> Text -> Either MegaparsecError (BuilderState' t e, a) runParserS'' parser sig bs fileName input_ = case run $ - evalState params $ - runReader sig $ - runInfoTableBuilder' bs $ - evalTopNameIdGen defaultModuleId $ - P.runParserT parser fileName input_ of + evalState emptyLocalParams $ + runInfoTableBuilder' bs $ + runReader sig $ + P.runParserT parser fileName input_ of (_, Left err) -> Left (MegaparsecError err) (bs', Right x) -> Right (bs', x) - where - params = - LocalParams - { _localParamsNameMap = mempty, - _localParamsTempIndex = 0 - } createBuiltinConstr :: Symbol -> @@ -116,29 +109,28 @@ declareBuiltins = do lift $ mapM_ (registerConstr' @t @e) constrs parseToplevel :: - forall t e r. - (Members '[Reader (ParserSig t e), InfoTableBuilder' t e, State LocalParams] r) => - ParsecS r () + forall t e d. + ParsecS '[Reader (ParserSig t e d), InfoTableBuilder' t e, State (LocalParams' d)] () parseToplevel = do declareBuiltins @t @e space - P.many $ statement @t @e + P.many $ statement @t @e @d P.eof statement :: - forall t e r. - (Members '[Reader (ParserSig t e), InfoTableBuilder' t e, State LocalParams] r) => + forall t e d r. + (Members '[Reader (ParserSig t e d), InfoTableBuilder' t e, State (LocalParams' d)] r) => ParsecS r () -statement = statementFunction @t @e <|> statementInductive @t @e +statement = statementFunction @t @e @d <|> statementInductive @t @e @d statementFunction :: - forall t e r. - (Members '[Reader (ParserSig t e), InfoTableBuilder' t e, State LocalParams] r) => + forall t e d r. + (Members '[Reader (ParserSig t e d), InfoTableBuilder' t e, State (LocalParams' d)] r) => ParsecS r () statementFunction = do kw kwFun off <- P.getOffset - (txt, i) <- identifierL @t @e + (txt, i) <- identifierL @t @e @d idt <- lift $ getIdent' @t @e txt sym <- case idt of Nothing -> lift $ freshSymbol' @t @e @@ -146,14 +138,14 @@ statementFunction = do _ -> parseFailure off ("duplicate identifier: " ++ fromText txt) when (txt == "main") $ lift (registerMain' @t @e sym) - args <- functionArguments @t @e + args <- functionArguments @t @e @d let argtys = map snd args argnames = map fst args when (txt == "main" && not (null argtys)) $ parseFailure off "the 'main' function must take zero arguments" - mrty <- optional $ typeAnnotation @t @e - ec <- lift $ emptyCode @t @e - ee <- lift $ emptyExtra @t @e + mrty <- optional $ typeAnnotation @t @e @d + ec <- lift $ emptyCode @t @e @d + ee <- lift $ emptyExtra @t @e @d let fi0 = FunctionInfo { _functionName = txt, @@ -166,15 +158,9 @@ statementFunction = do _functionExtra = ee } lift $ registerFunction' @t @e fi0 - let updateNames :: LocalNameMap -> LocalNameMap - updateNames names = - foldr - (\(mn, idx) h -> maybe h (\n -> HashMap.insert n (ArgRef (OffsetRef idx (Just n))) h) mn) - names - (zip argnames [0 ..]) mcode <- (kw delimSemicolon $> Nothing) - <|> optional (braces (localS (over localParamsNameMap updateNames) $ parseCode @t @e)) + <|> optional (braces (functionBody @t @e @d (parseCode @t @e @d) argnames)) let fi = fi0 {_functionCode = fromMaybe ec mcode} case idt of Just (IdentFwd _) -> do @@ -193,13 +179,13 @@ statementFunction = do lift (registerForward' @t @e txt sym) statementInductive :: - forall t e r. - (Members '[Reader (ParserSig t e), InfoTableBuilder' t e] r) => + forall t e d r. + (Members '[Reader (ParserSig t e d), InfoTableBuilder' t e] r) => ParsecS r () statementInductive = do kw kwInductive off <- P.getOffset - (txt, i) <- identifierL @t @e + (txt, i) <- identifierL @t @e @d idt <- lift $ getIdent' @t @e txt when (isJust idt) $ parseFailure off ("duplicate identifier: " ++ fromText txt) @@ -214,32 +200,32 @@ statementInductive = do _inductiveRepresentation = IndRepStandard } lift $ registerInductive' @t @e ii - ctrs <- braces $ P.sepEndBy (constrDecl @t @e sym) (kw delimSemicolon) + ctrs <- braces $ P.sepEndBy (constrDecl @t @e @d sym) (kw delimSemicolon) lift $ registerInductive' @t @e ii {_inductiveConstructors = map (^. constructorTag) ctrs} functionArguments :: - forall t e r. - (Members '[Reader (ParserSig t e), InfoTableBuilder' t e] r) => + forall t e d r. + (Members '[Reader (ParserSig t e d), InfoTableBuilder' t e] r) => ParsecS r [(Maybe Text, Type)] functionArguments = do lparen - args <- P.sepBy (parseArgument @t @e) comma + args <- P.sepBy (parseArgument @t @e @d) comma rparen return args constrDecl :: - forall t e r. - (Members '[Reader (ParserSig t e), InfoTableBuilder' t e] r) => + forall t e d r. + (Members '[Reader (ParserSig t e d), InfoTableBuilder' t e] r) => Symbol -> ParsecS r ConstructorInfo constrDecl symInd = do off <- P.getOffset - (txt, i) <- identifierL @t @e + (txt, i) <- identifierL @t @e @d idt <- lift $ getIdent' @t @e txt when (isJust idt) $ parseFailure off ("duplicate identifier: " ++ fromText txt) tag <- lift $ freshTag' @t @e - ty <- typeAnnotation @t @e + ty <- typeAnnotation @t @e @d let ty' = uncurryType ty argsNum = length (typeArgs ty') ci = @@ -258,66 +244,66 @@ constrDecl symInd = do return ci typeAnnotation :: - forall t e r. - (Members '[Reader (ParserSig t e), InfoTableBuilder' t e] r) => + forall t e d r. + (Members '[Reader (ParserSig t e d), InfoTableBuilder' t e] r) => ParsecS r Type typeAnnotation = do kw kwColon - parseType @t @e + parseType @t @e @d parseArgument :: - forall t e r. - (Members '[Reader (ParserSig t e), InfoTableBuilder' t e] r) => + forall t e d r. + (Members '[Reader (ParserSig t e d), InfoTableBuilder' t e] r) => ParsecS r (Maybe Text, Type) parseArgument = do n <- optional $ P.try $ do - txt <- identifier @t @e + txt <- identifier @t @e @d kw kwColon return txt - ty <- parseType @t @e + ty <- parseType @t @e @d return (n, ty) parseType :: - forall t e r. - (Members '[Reader (ParserSig t e), InfoTableBuilder' t e] r) => + forall t e d r. + (Members '[Reader (ParserSig t e d), InfoTableBuilder' t e] r) => ParsecS r Type parseType = do - tys <- typeArguments @t @e + tys <- typeArguments @t @e @d off <- P.getOffset - typeFun' @t @e tys + typeFun' @t @e @d tys <|> do unless (null (NonEmpty.tail tys)) $ parseFailure off "expected \"->\"" return (head tys) typeFun' :: - forall t e r. - (Members '[Reader (ParserSig t e), InfoTableBuilder' t e] r) => + forall t e d r. + (Members '[Reader (ParserSig t e d), InfoTableBuilder' t e] r) => NonEmpty Type -> ParsecS r Type typeFun' tyargs = do kw kwRightArrow - TyFun . TypeFun tyargs <$> parseType @t @e + TyFun . TypeFun tyargs <$> parseType @t @e @d typeArguments :: - forall t e r. - (Members '[Reader (ParserSig t e), InfoTableBuilder' t e] r) => + forall t e d r. + (Members '[Reader (ParserSig t e d), InfoTableBuilder' t e] r) => ParsecS r (NonEmpty Type) typeArguments = do - parens (P.sepBy1 (parseType @t @e) comma <&> NonEmpty.fromList) + parens (P.sepBy1 (parseType @t @e @d) comma <&> NonEmpty.fromList) <|> (typeDynamic <&> NonEmpty.singleton) - <|> (typeNamed @t @e <&> NonEmpty.singleton) + <|> (typeNamed @t @e @d <&> NonEmpty.singleton) typeDynamic :: ParsecS r Type typeDynamic = kw kwStar $> TyDynamic typeNamed :: - forall t e r. - (Members '[Reader (ParserSig t e), InfoTableBuilder' t e] r) => + forall t e d r. + (Members '[Reader (ParserSig t e d), InfoTableBuilder' t e] r) => ParsecS r Type typeNamed = do off <- P.getOffset - txt <- identifier @t @e + txt <- identifier @t @e @d case txt of "integer" -> return mkTypeInteger "bool" -> return mkTypeBool @@ -353,15 +339,31 @@ unitValue = kw kwUnit $> ConstUnit voidValue :: ParsecS r Constant voidValue = kw kwVoid $> ConstVoid +functionBody :: + forall t e d r. + (Members '[Reader (ParserSig t e d), InfoTableBuilder' t e, State (LocalParams' d)] r) => + ParsecS r t -> + [Maybe Text] -> + ParsecS r t +functionBody parseCode' argnames = do + sig <- lift $ ask @(ParserSig t e d) + let updateNames :: LocalNameMap d -> LocalNameMap d + updateNames names = + foldr + (\(mn, idx) h -> maybe h (\n -> HashMap.insert n ((sig ^. parserSigArgRef) idx (Just n)) h) mn) + names + (zip argnames [0 ..]) + localS (over localParamsNameMap updateNames) parseCode' + memRef :: forall t e r. - (Members '[Reader (ParserSig t e), InfoTableBuilder' t e, State LocalParams] r) => + (Members '[Reader (ParserSig t e DirectRef), InfoTableBuilder' t e, State (LocalParams' DirectRef)] r) => ParsecS r MemRef memRef = do r <- directRef @t @e - parseField @t @e r <|> return (DRef r) + parseField @t @e @DirectRef r <|> return (DRef r) -directRef :: forall t e r. (Members '[Reader (ParserSig t e), State LocalParams] r) => ParsecS r DirectRef +directRef :: forall t e r. (Members '[Reader (ParserSig t e DirectRef), State (LocalParams' DirectRef)] r) => ParsecS r DirectRef directRef = argRef <|> tempRef <|> namedRef @t @e argRef :: ParsecS r DirectRef @@ -376,57 +378,60 @@ tempRef = do (off, _) <- brackets integer return $ mkTempRef (OffsetRef (fromInteger off) Nothing) -namedRef :: forall t e r. (Members '[Reader (ParserSig t e), State LocalParams] r) => ParsecS r DirectRef -namedRef = do +namedRef' :: forall t e d r. (Members '[Reader (ParserSig t e d), State (LocalParams' d)] r) => (Int -> Text -> ParsecS r d) -> ParsecS r d +namedRef' f = do off <- P.getOffset - txt <- identifier @t @e + txt <- identifier @t @e @d mr <- lift $ gets (HashMap.lookup txt . (^. localParamsNameMap)) case mr of Just r -> return r - Nothing -> parseFailure off "undeclared identifier" + Nothing -> f off txt + +namedRef :: forall t e d r. (Members '[Reader (ParserSig t e d), State (LocalParams' d)] r) => ParsecS r d +namedRef = namedRef' @t @e @d (\off _ -> parseFailure off "undeclared identifier") parseField :: - forall t e r. - (Members '[Reader (ParserSig t e), InfoTableBuilder' t e] r) => + forall t e d r. + (Members '[Reader (ParserSig t e d), InfoTableBuilder' t e] r) => DirectRef -> ParsecS r MemRef parseField dref = do dot - tag <- constrTag @t @e + tag <- constrTag @t @e @d (off, _) <- brackets integer return $ ConstrRef (Field Nothing tag dref (fromInteger off)) constrTag :: - forall t e r. - (Members '[Reader (ParserSig t e), InfoTableBuilder' t e] r) => + forall t e d r. + (Members '[Reader (ParserSig t e d), InfoTableBuilder' t e] r) => ParsecS r Tag constrTag = do off <- P.getOffset - txt <- identifier @t @e + txt <- identifier @t @e @d idt <- lift $ getIdent' @t @e txt case idt of Just (IdentConstr tag) -> return tag _ -> parseFailure off "expected a constructor" indSymbol :: - forall t e r. - (Members '[Reader (ParserSig t e), InfoTableBuilder' t e] r) => + forall t e d r. + (Members '[Reader (ParserSig t e d), InfoTableBuilder' t e] r) => ParsecS r Symbol indSymbol = do off <- P.getOffset - txt <- identifier @t @e + txt <- identifier @t @e @d idt <- lift $ getIdent' @t @e txt case idt of Just (IdentInd sym) -> return sym _ -> parseFailure off "expected an inductive type" funSymbol :: - forall t e r. - (Members '[Reader (ParserSig t e), InfoTableBuilder' t e] r) => + forall t e d r. + (Members '[Reader (ParserSig t e d), InfoTableBuilder' t e] r) => ParsecS r Symbol funSymbol = do off <- P.getOffset - txt <- identifier @t @e + txt <- identifier @t @e @d idt <- lift $ getIdent' @t @e txt case idt of Just (IdentFwd sym) -> return sym diff --git a/src/Juvix/Compiler/Tree/Translation/FromSource/Sig.hs b/src/Juvix/Compiler/Tree/Translation/FromSource/Sig.hs index 0a2ede974..2a2012d4f 100644 --- a/src/Juvix/Compiler/Tree/Translation/FromSource/Sig.hs +++ b/src/Juvix/Compiler/Tree/Translation/FromSource/Sig.hs @@ -10,44 +10,52 @@ import Juvix.Compiler.Tree.Data.InfoTableBuilder.Base import Juvix.Compiler.Tree.Language.Base import Juvix.Compiler.Tree.Translation.FromSource.Lexer.Base -type LocalNameMap = HashMap Text DirectRef +type LocalNameMap d = HashMap Text d -data LocalParams = LocalParams - { _localParamsNameMap :: LocalNameMap, +data LocalParams' d = LocalParams + { _localParamsNameMap :: LocalNameMap d, _localParamsTempIndex :: Index } -data ParserSig t e = ParserSig +emptyLocalParams :: LocalParams' d +emptyLocalParams = + LocalParams + { _localParamsNameMap = mempty, + _localParamsTempIndex = 0 + } + +data ParserSig t e d = ParserSig { _parserSigBareIdentifier :: forall r. ParsecS r Text, - _parserSigParseCode :: forall r. (Members '[Reader (ParserSig t e), InfoTableBuilder' t e, State LocalParams] r) => ParsecS r t, + _parserSigParseCode :: forall r. (Members '[Reader (ParserSig t e d), InfoTableBuilder' t e, State (LocalParams' d)] r) => ParsecS r t, + _parserSigArgRef :: Index -> Maybe Text -> d, _parserSigEmptyCode :: t, _parserSigEmptyExtra :: e } makeLenses ''ParserSig -makeLenses ''LocalParams +makeLenses ''LocalParams' -identifier :: forall t e r. (Member (Reader (ParserSig t e)) r) => ParsecS r Text +identifier :: forall t e d r. (Member (Reader (ParserSig t e d)) r) => ParsecS r Text identifier = do - sig <- lift $ ask @(ParserSig t e) + sig <- lift $ ask @(ParserSig t e d) lexeme (sig ^. parserSigBareIdentifier) -identifierL :: forall t e r. (Member (Reader (ParserSig t e)) r) => ParsecS r (Text, Interval) +identifierL :: forall t e d r. (Member (Reader (ParserSig t e d)) r) => ParsecS r (Text, Interval) identifierL = do - sig <- lift $ ask @(ParserSig t e) + sig <- lift $ ask @(ParserSig t e d) lexemeInterval (sig ^. parserSigBareIdentifier) -parseCode :: forall t e r. (Members '[Reader (ParserSig t e), InfoTableBuilder' t e, State LocalParams] r) => ParsecS r t +parseCode :: forall t e d r. (Members '[Reader (ParserSig t e d), InfoTableBuilder' t e, State (LocalParams' d)] r) => ParsecS r t parseCode = do - sig <- lift $ ask @(ParserSig t e) + sig <- lift $ ask @(ParserSig t e d) sig ^. parserSigParseCode -emptyCode :: forall t e r. (Member (Reader (ParserSig t e)) r) => Sem r t +emptyCode :: forall t e d r. (Member (Reader (ParserSig t e d)) r) => Sem r t emptyCode = do - sig <- ask @(ParserSig t e) + sig <- ask @(ParserSig t e d) return $ sig ^. parserSigEmptyCode -emptyExtra :: forall t e r. (Member (Reader (ParserSig t e)) r) => Sem r e +emptyExtra :: forall t e d r. (Member (Reader (ParserSig t e d)) r) => Sem r e emptyExtra = do - sig <- ask @(ParserSig t e) + sig <- ask @(ParserSig t e d) return $ sig ^. parserSigEmptyExtra diff --git a/src/Juvix/Data/FileExt.hs b/src/Juvix/Data/FileExt.hs index 247964f1b..964f9aeb3 100644 --- a/src/Juvix/Data/FileExt.hs +++ b/src/Juvix/Data/FileExt.hs @@ -13,6 +13,7 @@ data FileExt | FileExtJuvixGeb | FileExtJuvixCore | FileExtJuvixAsm + | FileExtJuvixReg | FileExtJuvixTree | FileExtCasm | FileExtVampIR @@ -42,6 +43,9 @@ juvixCoreFileExt = ".jvc" juvixAsmFileExt :: (IsString a) => a juvixAsmFileExt = ".jva" +juvixRegFileExt :: (IsString a) => a +juvixRegFileExt = ".jvr" + juvixTreeFileExt :: (IsString a) => a juvixTreeFileExt = ".jvt" @@ -85,6 +89,7 @@ fileExtToText = \case FileExtJuvixGeb -> juvixGebFileExt FileExtJuvixCore -> juvixCoreFileExt FileExtJuvixAsm -> juvixAsmFileExt + FileExtJuvixReg -> juvixRegFileExt FileExtJuvixTree -> juvixTreeFileExt FileExtCasm -> casmFileExt FileExtVampIR -> vampIRFileExt @@ -105,6 +110,7 @@ toMetavar = \case FileExtJuvixGeb -> "JUVIX_GEB_FILE" FileExtJuvixCore -> "JUVIX_CORE_FILE" FileExtJuvixAsm -> "JUVIX_ASM_FILE" + FileExtJuvixReg -> "JUVIX_REG_FILE" FileExtJuvixTree -> "JUVIX_TREE_FILE" FileExtCasm -> "CASM_FILE" FileExtVampIR -> "VAMPIR_FILE" @@ -153,6 +159,12 @@ isHaloFile = (== Just haloFileExt) . fileExtension isJuvixAsmFile :: Path b File -> Bool isJuvixAsmFile = (== Just juvixAsmFileExt) . fileExtension +isJuvixRegFile :: Path b File -> Bool +isJuvixRegFile = (== Just juvixRegFileExt) . fileExtension + +isJuvixTreeFile :: Path b File -> Bool +isJuvixTreeFile = (== Just juvixTreeFileExt) . fileExtension + isCasmFile :: Path b File -> Bool isCasmFile = (== Just casmFileExt) . fileExtension @@ -181,6 +193,8 @@ toFileExt p | isJuvixGebFile p = Just FileExtJuvixGeb | isJuvixCoreFile p = Just FileExtJuvixCore | isJuvixAsmFile p = Just FileExtJuvixAsm + | isJuvixRegFile p = Just FileExtJuvixReg + | isJuvixTreeFile p = Just FileExtJuvixTree | isCasmFile p = Just FileExtCasm | isVampIRFile p = Just FileExtVampIR | isVampIRParamsFile p = Just FileExtVampIRParams diff --git a/src/Juvix/Data/Keyword/All.hs b/src/Juvix/Data/Keyword/All.hs index 5df6fe73a..c8852e253 100644 --- a/src/Juvix/Data/Keyword/All.hs +++ b/src/Juvix/Data/Keyword/All.hs @@ -103,6 +103,9 @@ kwAssoc = asciiKw Str.assoc kwNone :: Keyword kwNone = asciiKw Str.none +kwNop :: Keyword +kwNop = asciiKw Str.nop + kwRight :: Keyword kwRight = asciiKw Str.right @@ -265,6 +268,12 @@ kwTrace = asciiKw Str.trace_ kwFail :: Keyword kwFail = asciiKw Str.fail_ +kwDump :: Keyword +kwDump = asciiKw Str.dump + +kwPrealloc :: Keyword +kwPrealloc = asciiKw Str.prealloc + kwArgsNum :: Keyword kwArgsNum = asciiKw Str.instrArgsNum @@ -280,12 +289,18 @@ kwCExtend = asciiKw Str.instrCextend kwCCall :: Keyword kwCCall = asciiKw Str.instrCcall +kwCCallTail :: Keyword +kwCCallTail = asciiKw Str.instrTccall + kwBr :: Keyword kwBr = asciiKw Str.instrBr kwSave :: Keyword kwSave = asciiKw Str.save +kwDefault :: Keyword +kwDefault = asciiKw Str.default_ + kwIntAdd :: Keyword kwIntAdd = asciiKw Str.iadd @@ -397,9 +412,15 @@ kwJmp = asciiKw Str.jmp kwCall :: Keyword kwCall = asciiKw Str.call +kwCallTail :: Keyword +kwCallTail = asciiKw Str.tcall + kwRet :: Keyword kwRet = asciiKw Str.ret +kwLive :: Keyword +kwLive = asciiKw Str.live + delimBraceL :: Keyword delimBraceL = mkDelim Str.braceL diff --git a/src/Juvix/Extra/Strings.hs b/src/Juvix/Extra/Strings.hs index 0641c0b95..408356183 100644 --- a/src/Juvix/Extra/Strings.hs +++ b/src/Juvix/Extra/Strings.hs @@ -362,6 +362,12 @@ trace_ = "trace" fail_ :: (IsString s) => s fail_ = "fail" +dump :: (IsString s) => s +dump = "dump" + +prealloc :: (IsString s) => s +prealloc = "prealloc" + argsnum :: (IsString s) => s argsnum = "argsnum" @@ -374,6 +380,9 @@ jmp = "jmp" call :: (IsString s) => s call = "call" +tcall :: (IsString s) => s +tcall = "tcall" + rel :: (IsString s) => s rel = "rel" @@ -536,6 +545,9 @@ le_ = "le" ret :: (IsString s) => s ret = "ret" +live :: (IsString s) => s +live = "live" + dollar :: (IsString s) => s dollar = "$" @@ -896,6 +908,9 @@ same = "same" none :: (IsString s) => s none = "none" +nop :: (IsString s) => s +nop = "nop" + init :: (IsString s) => s init = "init" diff --git a/test/Main.hs b/test/Main.hs index bd7620ebe..b81d3af9e 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -14,6 +14,7 @@ import Internal qualified import Nockma qualified import Package qualified import Parsing qualified +import Reg qualified import Resolver qualified import Runtime qualified import Scope qualified @@ -28,6 +29,7 @@ slowTests = "Juvix slow tests" [ BackendGeb.allTests, Runtime.allTests, + Reg.allTests, Asm.allTests, Tree.allTests, Core.allTests, diff --git a/test/Reg.hs b/test/Reg.hs new file mode 100644 index 000000000..0e82474c0 --- /dev/null +++ b/test/Reg.hs @@ -0,0 +1,7 @@ +module Reg where + +import Base +import Reg.Parse qualified as Parse + +allTests :: TestTree +allTests = testGroup "JuvixReg tests" [Parse.allTests] diff --git a/test/Reg/Parse.hs b/test/Reg/Parse.hs new file mode 100644 index 000000000..6bfad75f2 --- /dev/null +++ b/test/Reg/Parse.hs @@ -0,0 +1,7 @@ +module Reg.Parse where + +import Base +import Reg.Parse.Positive qualified as P + +allTests :: TestTree +allTests = testGroup "JuvixReg parsing" [P.allTests] diff --git a/test/Reg/Parse/Base.hs b/test/Reg/Parse/Base.hs new file mode 100644 index 000000000..4a719382f --- /dev/null +++ b/test/Reg/Parse/Base.hs @@ -0,0 +1,32 @@ +module Reg.Parse.Base where + +import Base +import Juvix.Compiler.Reg.Data.InfoTable +import Juvix.Compiler.Reg.Pretty +import Juvix.Compiler.Reg.Translation.FromSource +import Juvix.Data.PPOutput + +regParseAssertion :: Path Abs File -> (String -> IO ()) -> Assertion +regParseAssertion mainFile step = do + step "Parse" + r <- parseFile mainFile + case r of + Left err -> assertFailure (show (pretty err)) + Right tab -> do + withTempDir' + ( \dirPath -> do + let outputFile = dirPath $(mkRelFile "out.out") + step "Print" + writeFileEnsureLn outputFile (ppPrint tab tab) + step "Parse printed" + r' <- parseFile outputFile + case r' of + Left err -> assertFailure (show (pretty err)) + Right tab' -> do + assertBool ("Check: print . parse = print . parse . print . parse") (ppPrint tab tab == ppPrint tab' tab') + ) + +parseFile :: Path Abs File -> IO (Either MegaparsecError InfoTable) +parseFile f = do + s <- readFile (toFilePath f) + return $ runParser (toFilePath f) s diff --git a/test/Reg/Parse/Positive.hs b/test/Reg/Parse/Positive.hs new file mode 100644 index 000000000..444d99c7c --- /dev/null +++ b/test/Reg/Parse/Positive.hs @@ -0,0 +1,227 @@ +module Reg.Parse.Positive where + +import Base +import Reg.Parse.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/Reg/positive") + +testDescr :: PosTest -> TestDescr +testDescr PosTest {..} = + let tRoot = root _relDir + file' = tRoot _file + in TestDescr + { _testName = _name, + _testRoot = tRoot, + _testAssertion = Steps $ regParseAssertion file' + } + +filterTests :: [String] -> [PosTest] -> [PosTest] +filterTests incl = filter (\PosTest {..} -> _name `elem` incl) + +allTests :: TestTree +allTests = + testGroup + "JuvixReg parsing 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 + "Test005: Tracing IO" + $(mkRelDir ".") + $(mkRelFile "test005.jvr") + $(mkRelFile "out/test005.out"), + PosTest + "Test006: IO builtins" + $(mkRelDir ".") + $(mkRelFile "test006.jvr") + $(mkRelFile "out/test006.out"), + PosTest + "Test007: Higher-order functions" + $(mkRelDir ".") + $(mkRelFile "test007.jvr") + $(mkRelFile "out/test007.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 + "Test022: Self-application" + $(mkRelDir ".") + $(mkRelFile "test022.jvr") + $(mkRelFile "out/test022.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 + "Test025: Dynamic closure extension" + $(mkRelDir ".") + $(mkRelFile "test025.jvr") + $(mkRelFile "out/test025.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 + "Test029: Structural equality" + $(mkRelDir ".") + $(mkRelFile "test029.jvr") + $(mkRelFile "out/test029.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 + "Test032: Church numerals" + $(mkRelDir ".") + $(mkRelFile "test032.jvr") + $(mkRelFile "out/test032.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 + "Test035: Nested lists" + $(mkRelDir ".") + $(mkRelFile "test035.jvr") + $(mkRelFile "out/test035.out"), + PosTest + "Test036: Streams without memoization" + $(mkRelDir ".") + $(mkRelFile "test036.jvr") + $(mkRelFile "out/test036.out"), + PosTest + "Test037: String instructions" + $(mkRelDir ".") + $(mkRelFile "test037.jvr") + $(mkRelFile "out/test037.out"), + PosTest + "Test038: Apply & argsnum" + $(mkRelDir ".") + $(mkRelFile "test038.jvr") + $(mkRelFile "out/test038.out") + ] diff --git a/tests/Reg/positive/out/test001.out b/tests/Reg/positive/out/test001.out new file mode 100644 index 000000000..b4de39476 --- /dev/null +++ b/tests/Reg/positive/out/test001.out @@ -0,0 +1 @@ +11 diff --git a/tests/Reg/positive/out/test002.out b/tests/Reg/positive/out/test002.out new file mode 100644 index 000000000..b4de39476 --- /dev/null +++ b/tests/Reg/positive/out/test002.out @@ -0,0 +1 @@ +11 diff --git a/tests/Reg/positive/out/test003.out b/tests/Reg/positive/out/test003.out new file mode 100644 index 000000000..b4de39476 --- /dev/null +++ b/tests/Reg/positive/out/test003.out @@ -0,0 +1 @@ +11 diff --git a/tests/Reg/positive/out/test004.out b/tests/Reg/positive/out/test004.out new file mode 100644 index 000000000..b4de39476 --- /dev/null +++ b/tests/Reg/positive/out/test004.out @@ -0,0 +1 @@ +11 diff --git a/tests/Reg/positive/out/test005.out b/tests/Reg/positive/out/test005.out new file mode 100644 index 000000000..e3ecc6e7c --- /dev/null +++ b/tests/Reg/positive/out/test005.out @@ -0,0 +1,6 @@ +1 +2 +2 +seven +unit +void diff --git a/tests/Reg/positive/out/test006.out b/tests/Reg/positive/out/test006.out new file mode 100644 index 000000000..740511c2d --- /dev/null +++ b/tests/Reg/positive/out/test006.out @@ -0,0 +1,2 @@ +12 +12345 diff --git a/tests/Reg/positive/out/test007.out b/tests/Reg/positive/out/test007.out new file mode 100644 index 000000000..b8626c4cf --- /dev/null +++ b/tests/Reg/positive/out/test007.out @@ -0,0 +1 @@ +4 diff --git a/tests/Reg/positive/out/test008.out b/tests/Reg/positive/out/test008.out new file mode 100644 index 000000000..0cfbf0888 --- /dev/null +++ b/tests/Reg/positive/out/test008.out @@ -0,0 +1 @@ +2 diff --git a/tests/Reg/positive/out/test009.out b/tests/Reg/positive/out/test009.out new file mode 100644 index 000000000..a4f2b94cf --- /dev/null +++ b/tests/Reg/positive/out/test009.out @@ -0,0 +1,7 @@ +false +true +0 +cons 1 nil +1 +cons 1 (cons 2 nil) +cons 1 (cons 2 nil) diff --git a/tests/Reg/positive/out/test010.out b/tests/Reg/positive/out/test010.out new file mode 100644 index 000000000..837e12b40 --- /dev/null +++ b/tests/Reg/positive/out/test010.out @@ -0,0 +1 @@ +500500 diff --git a/tests/Reg/positive/out/test011.out b/tests/Reg/positive/out/test011.out new file mode 100644 index 000000000..a2ce0eb88 --- /dev/null +++ b/tests/Reg/positive/out/test011.out @@ -0,0 +1,4 @@ +500500 +120 +3628800 +479001600 diff --git a/tests/Reg/positive/out/test012.out b/tests/Reg/positive/out/test012.out new file mode 100644 index 000000000..425151f3a --- /dev/null +++ b/tests/Reg/positive/out/test012.out @@ -0,0 +1 @@ +40 diff --git a/tests/Reg/positive/out/test013.out b/tests/Reg/positive/out/test013.out new file mode 100644 index 000000000..5645fe245 --- /dev/null +++ b/tests/Reg/positive/out/test013.out @@ -0,0 +1,3 @@ +55 +9748419 +12607563 diff --git a/tests/Reg/positive/out/test014.out b/tests/Reg/positive/out/test014.out new file mode 100644 index 000000000..e0c72fe9e --- /dev/null +++ b/tests/Reg/positive/out/test014.out @@ -0,0 +1,155 @@ +1 +3 +2 +0 +0 +2 +0 +0 +2 +0 +0 +X +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 diff --git a/tests/Reg/positive/out/test015.out b/tests/Reg/positive/out/test015.out new file mode 100644 index 000000000..8a49268b3 --- /dev/null +++ b/tests/Reg/positive/out/test015.out @@ -0,0 +1,4 @@ +1 +0 +2 +5 diff --git a/tests/Reg/positive/out/test016.out b/tests/Reg/positive/out/test016.out new file mode 100644 index 000000000..93b91f3ff --- /dev/null +++ b/tests/Reg/positive/out/test016.out @@ -0,0 +1,5 @@ +7 +17 +37 +-29 +-29 diff --git a/tests/Reg/positive/out/test017.out b/tests/Reg/positive/out/test017.out new file mode 100644 index 000000000..0a2b6b13f --- /dev/null +++ b/tests/Reg/positive/out/test017.out @@ -0,0 +1,6 @@ +600 +25 +30 +45 +55 +16 diff --git a/tests/Reg/positive/out/test018.out b/tests/Reg/positive/out/test018.out new file mode 100644 index 000000000..5ebe23636 --- /dev/null +++ b/tests/Reg/positive/out/test018.out @@ -0,0 +1,3 @@ +11 +9 +10 diff --git a/tests/Reg/positive/out/test019.out b/tests/Reg/positive/out/test019.out new file mode 100644 index 000000000..c3f407c09 --- /dev/null +++ b/tests/Reg/positive/out/test019.out @@ -0,0 +1 @@ +55 diff --git a/tests/Reg/positive/out/test020.out b/tests/Reg/positive/out/test020.out new file mode 100644 index 000000000..837e12b40 --- /dev/null +++ b/tests/Reg/positive/out/test020.out @@ -0,0 +1 @@ +500500 diff --git a/tests/Reg/positive/out/test021.out b/tests/Reg/positive/out/test021.out new file mode 100644 index 000000000..b4de39476 --- /dev/null +++ b/tests/Reg/positive/out/test021.out @@ -0,0 +1 @@ +11 diff --git a/tests/Reg/positive/out/test022.out b/tests/Reg/positive/out/test022.out new file mode 100644 index 000000000..7f8f011eb --- /dev/null +++ b/tests/Reg/positive/out/test022.out @@ -0,0 +1 @@ +7 diff --git a/tests/Reg/positive/out/test023.out b/tests/Reg/positive/out/test023.out new file mode 100644 index 000000000..328ff1f98 --- /dev/null +++ b/tests/Reg/positive/out/test023.out @@ -0,0 +1,4 @@ +91 +91 +91 +91 diff --git a/tests/Reg/positive/out/test024.out b/tests/Reg/positive/out/test024.out new file mode 100644 index 000000000..04d888dd9 --- /dev/null +++ b/tests/Reg/positive/out/test024.out @@ -0,0 +1,24 @@ +6 +4 +7 +9 +40 +6 +3 +7 +9 +30 +6 +2 +7 +9 +20 +6 +1 +7 +9 +10 +6 +0 +7 +end diff --git a/tests/Reg/positive/out/test025.out b/tests/Reg/positive/out/test025.out new file mode 100644 index 000000000..7be968cb7 --- /dev/null +++ b/tests/Reg/positive/out/test025.out @@ -0,0 +1,3 @@ +36 +22 +8 diff --git a/tests/Reg/positive/out/test026.out b/tests/Reg/positive/out/test026.out new file mode 100644 index 000000000..ed8fa3977 --- /dev/null +++ b/tests/Reg/positive/out/test026.out @@ -0,0 +1,3 @@ +6 +5 +8 diff --git a/tests/Reg/positive/out/test027.out b/tests/Reg/positive/out/test027.out new file mode 100644 index 000000000..11398b0e7 --- /dev/null +++ b/tests/Reg/positive/out/test027.out @@ -0,0 +1,3 @@ +8 +2187 +48828125 diff --git a/tests/Reg/positive/out/test028.out b/tests/Reg/positive/out/test028.out new file mode 100644 index 000000000..62660ff38 --- /dev/null +++ b/tests/Reg/positive/out/test028.out @@ -0,0 +1,7 @@ +cons 10 (cons 9 (cons 8 (cons 7 (cons 6 (cons 5 (cons 4 (cons 3 (cons 2 (cons 1 nil))))))))) +cons 1 (cons 2 (cons 3 (cons 4 (cons 5 (cons 6 (cons 7 (cons 8 (cons 9 (cons 10 nil))))))))) +cons 10 (cons 9 (cons 8 (cons 7 (cons 6 nil)))) +cons 0 (cons 1 (cons 2 (cons 3 (cons 4 (cons 5 (cons 6 (cons 7 (cons 8 (cons 9 nil))))))))) +500500 +500500 +500500 diff --git a/tests/Reg/positive/out/test029.out b/tests/Reg/positive/out/test029.out new file mode 100644 index 000000000..19d508f5a --- /dev/null +++ b/tests/Reg/positive/out/test029.out @@ -0,0 +1,7 @@ +true +false +true +false +false +false +true diff --git a/tests/Reg/positive/out/test030.out b/tests/Reg/positive/out/test030.out new file mode 100644 index 000000000..89ce91822 --- /dev/null +++ b/tests/Reg/positive/out/test030.out @@ -0,0 +1,3 @@ +32 +869 +151635589 diff --git a/tests/Reg/positive/out/test031.out b/tests/Reg/positive/out/test031.out new file mode 100644 index 000000000..a02158b2a --- /dev/null +++ b/tests/Reg/positive/out/test031.out @@ -0,0 +1,4 @@ +-12096 +-9744 +5181 +26932 diff --git a/tests/Reg/positive/out/test032.out b/tests/Reg/positive/out/test032.out new file mode 100644 index 000000000..a94dbefc6 --- /dev/null +++ b/tests/Reg/positive/out/test032.out @@ -0,0 +1,7 @@ +7 +21 +6 +5 +8 +13 +21 diff --git a/tests/Reg/positive/out/test033.out b/tests/Reg/positive/out/test033.out new file mode 100644 index 000000000..e0fa7441a --- /dev/null +++ b/tests/Reg/positive/out/test033.out @@ -0,0 +1,6 @@ +8 +9 +15 +17 +29 +125 diff --git a/tests/Reg/positive/out/test034.out b/tests/Reg/positive/out/test034.out new file mode 100644 index 000000000..7c791da5d --- /dev/null +++ b/tests/Reg/positive/out/test034.out @@ -0,0 +1,3 @@ +10 +21 +2187 diff --git a/tests/Reg/positive/out/test035.out b/tests/Reg/positive/out/test035.out new file mode 100644 index 000000000..79e9454d7 --- /dev/null +++ b/tests/Reg/positive/out/test035.out @@ -0,0 +1,2 @@ +cons (cons 4 (cons 3 (cons 2 (cons 1 nil)))) (cons (cons 3 (cons 2 (cons 1 nil))) (cons (cons 2 (cons 1 nil)) (cons (cons 1 nil) nil))) +cons 4 (cons 3 (cons 2 (cons 1 (cons 3 (cons 2 (cons 1 (cons 2 (cons 1 (cons 1 nil))))))))) diff --git a/tests/Reg/positive/out/test036.out b/tests/Reg/positive/out/test036.out new file mode 100644 index 000000000..801b73270 --- /dev/null +++ b/tests/Reg/positive/out/test036.out @@ -0,0 +1,2 @@ +31 +233 diff --git a/tests/Reg/positive/out/test037.out b/tests/Reg/positive/out/test037.out new file mode 100644 index 000000000..96ab86aca --- /dev/null +++ b/tests/Reg/positive/out/test037.out @@ -0,0 +1 @@ +143. diff --git a/tests/Reg/positive/out/test038.out b/tests/Reg/positive/out/test038.out new file mode 100644 index 000000000..7ed6ff82d --- /dev/null +++ b/tests/Reg/positive/out/test038.out @@ -0,0 +1 @@ +5 diff --git a/tests/Reg/positive/test001.jvr b/tests/Reg/positive/test001.jvr new file mode 100644 index 000000000..1abbd6baa --- /dev/null +++ b/tests/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/Reg/positive/test002.jvr b/tests/Reg/positive/test002.jvr new file mode 100644 index 000000000..85af8ebd2 --- /dev/null +++ b/tests/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/Reg/positive/test003.jvr b/tests/Reg/positive/test003.jvr new file mode 100644 index 000000000..9f585704c --- /dev/null +++ b/tests/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/Reg/positive/test004.jvr b/tests/Reg/positive/test004.jvr new file mode 100644 index 000000000..6483fcefa --- /dev/null +++ b/tests/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/Reg/positive/test005.jvr b/tests/Reg/positive/test005.jvr new file mode 100644 index 000000000..63bff85e3 --- /dev/null +++ b/tests/Reg/positive/test005.jvr @@ -0,0 +1,21 @@ + +function main() : *; + +function main() : * { + tmp[0] = 1; + trace tmp[0]; + tmp[1] = 2; + trace tmp[1]; + trace tmp[1]; + tmp[2] = "seven"; + trace tmp[2]; + nop; + nop; + nop; + tmp[0] = unit; + trace tmp[0]; + nop; + tmp[0] = void; + trace tmp[0]; + ret tmp[0]; +} diff --git a/tests/Reg/positive/test006.jvr b/tests/Reg/positive/test006.jvr new file mode 100644 index 000000000..fcd236f1d --- /dev/null +++ b/tests/Reg/positive/test006.jvr @@ -0,0 +1,65 @@ + +function const(*, *) : *; +function print(*) : IO; +function sequence(IO, IO) : IO; +function main() : *; + +function const(*, *) : * { + tmp[0] = arg[0]; + ret tmp[0]; +} + +function print(*) : IO { + prealloc 2, live: (arg[0]); + tmp[0] = arg[0]; + tmp[0] = alloc write (tmp[0]); + ret tmp[0]; +} + +function sequence(IO, IO) : IO { + prealloc 6, live: (arg[0], arg[1]); + tmp[0] = arg[1]; + tmp[0] = calloc const (tmp[0]); + tmp[1] = arg[0]; + tmp[0] = alloc bind (tmp[1], tmp[0]); + ret tmp[0]; +} + +function main() : * { + prealloc 6; + tmp[0] = "\n"; + tmp[0] = alloc write (tmp[0]); + tmp[1] = 5; + tmp[1] = alloc write (tmp[1]); + tmp[2] = 4; + tmp[2] = alloc write (tmp[2]); + tmp[1] = call sequence (tmp[2], tmp[1]), live: (tmp[0]); + prealloc 6, live: (tmp[0], tmp[1]); + tmp[2] = 3; + tmp[2] = alloc write (tmp[2]); + tmp[3] = 2; + tmp[3] = alloc write (tmp[3]); + tmp[4] = 1; + tmp[4] = alloc write (tmp[4]); + tmp[3] = call sequence (tmp[4], tmp[3]), live: (tmp[0], tmp[1], tmp[2]); + tmp[2] = call sequence (tmp[3], tmp[2]), live: (tmp[0], tmp[1]); + tmp[1] = call sequence (tmp[2], tmp[1]), live: (tmp[0]); + tmp[0] = call sequence (tmp[1], tmp[0]); + prealloc 14, live: (tmp[0]); + tmp[1] = calloc print (); + tmp[2] = "\n"; + tmp[2] = alloc return (tmp[2]); + tmp[1] = alloc bind (tmp[2], tmp[1]); + tmp[2] = calloc print (); + tmp[3] = 2; + tmp[3] = alloc return (tmp[3]); + tmp[2] = alloc bind (tmp[3], tmp[2]); + tmp[1] = call sequence (tmp[2], tmp[1]), live: (tmp[0]); + prealloc 7, live: (tmp[0], tmp[1]); + tmp[2] = calloc print (); + tmp[3] = 1; + tmp[3] = alloc return (tmp[3]); + tmp[2] = alloc bind (tmp[3], tmp[2]); + tmp[1] = call sequence (tmp[2], tmp[1]), live: (tmp[0]); + tcall sequence (tmp[1], tmp[0]); +} diff --git a/tests/Reg/positive/test007.jvr b/tests/Reg/positive/test007.jvr new file mode 100644 index 000000000..54c8bdd1d --- /dev/null +++ b/tests/Reg/positive/test007.jvr @@ -0,0 +1,65 @@ + +function S(*, *, *) : *; +function K(*, *) : *; +function I(*) : *; +function main() : *; + +function S(*, *, *) : * { + tmp[0] = arg[2]; + tmp[1] = arg[1]; + tmp[0] = ccall tmp[1] (tmp[0]), live: (arg[0], arg[1], arg[2]); + tmp[1] = arg[2]; + tmp[2] = arg[0]; + tccall 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 main() : * { + tmp[0] = 1; + tmp[0] = call I (tmp[0]); + prealloc 2, live: (tmp[0]); + tmp[1] = 1; + tmp[2] = calloc I (); + tmp[2] = call I (tmp[2]), live: (tmp[0], tmp[1]); + tmp[1] = call tmp[2] (tmp[1]), live: (tmp[0]); + prealloc 8, live: (tmp[0], tmp[1]); + tmp[0] = add tmp[1] tmp[0]; + tmp[1] = 1; + tmp[2] = calloc I (); + tmp[3] = calloc I (); + tmp[4] = calloc I (); + tmp[5] = calloc I (); + tmp[5] = call I (tmp[5]), live: (tmp[0], tmp[1], tmp[2], tmp[3], tmp[4]); + tmp[4] = call tmp[5] (tmp[4]), live: (tmp[0], tmp[1], tmp[2], tmp[3]); + tmp[3] = call tmp[4] (tmp[3]), live: (tmp[0], tmp[1], tmp[2]); + tmp[2] = call tmp[3] (tmp[2]), live: (tmp[0], tmp[1]); + tmp[1] = call tmp[2] (tmp[1]), live: (tmp[0]); + prealloc 18, live: (tmp[0], tmp[1]); + tmp[0] = add tmp[1] tmp[0]; + 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[9] = calloc I (); + tmp[10] = calloc I (); + tmp[10] = call I (tmp[10]), live: (tmp[0], tmp[1], tmp[2], tmp[3], tmp[4], tmp[5], tmp[6], tmp[7], tmp[8], tmp[9]); + tmp[1] = ccall tmp[10] (tmp[9], tmp[8], tmp[7], tmp[6], tmp[5], tmp[4], tmp[3], tmp[2], tmp[1]), live: (tmp[0]); + tmp[0] = add tmp[1] tmp[0]; + ret tmp[0]; +} diff --git a/tests/Reg/positive/test008.jvr b/tests/Reg/positive/test008.jvr new file mode 100644 index 000000000..3d1e2b176 --- /dev/null +++ b/tests/Reg/positive/test008.jvr @@ -0,0 +1,44 @@ + +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] { + 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] { + 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] { + 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/Reg/positive/test009.jvr b/tests/Reg/positive/test009.jvr new file mode 100644 index 000000000..b7c4bc627 --- /dev/null +++ b/tests/Reg/positive/test009.jvr @@ -0,0 +1,138 @@ +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) : bool { + tmp[0] = arg[0]; + case[list] tmp[0] { + nil: { + nop; + tmp[0] = true; + ret tmp[0]; + }; + default: { + nop; + tmp[0] = false; + ret tmp[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]); + 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() : * { + prealloc 7; + 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]), live: (tmp[0]); + prealloc 1, live: (tmp[0], tmp[1]); + trace tmp[1]; + nop; + tmp[1] = alloc nil (); + tmp[1] = call null (tmp[1]), live: (tmp[0]); + trace tmp[1]; + nop; + tmp[1] = tmp[0]; + tmp[1] = call hd (tmp[1]), live: (tmp[0]); + trace tmp[1]; + nop; + tmp[1] = tmp[0]; + tmp[1] = call tl (tmp[1]), live: (tmp[0]); + trace tmp[1]; + nop; + tmp[1] = tmp[0]; + tmp[1] = call tl (tmp[1]), live: (tmp[0]); + tmp[1] = call hd (tmp[1]), live: (tmp[0]); + prealloc 2, live: (tmp[0], tmp[1]); + trace tmp[1]; + nop; + tmp[1] = tmp[0]; + tmp[2] = calloc add_one (); + tmp[1] = call map (tmp[2], tmp[1]), live: (tmp[0]); + prealloc 2, live: (tmp[0], tmp[1]); + trace tmp[1]; + nop; + tmp[1] = tmp[0]; + tmp[2] = calloc add_one (); + tmp[1] = call map' (tmp[2], tmp[1]), live: (tmp[0]); + }; + ret tmp[1]; +} diff --git a/tests/Reg/positive/test010.jvr b/tests/Reg/positive/test010.jvr new file mode 100644 index 000000000..80c39cca2 --- /dev/null +++ b/tests/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] { + 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/Reg/positive/test011.jvr b/tests/Reg/positive/test011.jvr new file mode 100644 index 000000000..c30fcb190 --- /dev/null +++ b/tests/Reg/positive/test011.jvr @@ -0,0 +1,77 @@ + +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]); + trace tmp[0]; + nop; + tmp[0] = 5; + tmp[0] = call fact (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 10; + tmp[0] = call fact (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 12; + tcall fact (tmp[0]); +} diff --git a/tests/Reg/positive/test012.jvr b/tests/Reg/positive/test012.jvr new file mode 100644 index 000000000..8cd49218e --- /dev/null +++ b/tests/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/Reg/positive/test013.jvr b/tests/Reg/positive/test013.jvr new file mode 100644 index 000000000..9cb682fab --- /dev/null +++ b/tests/Reg/positive/test013.jvr @@ -0,0 +1,52 @@ + +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]); + trace tmp[0]; + nop; + tmp[0] = 100; + tmp[0] = call fib (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 1000; + tmp[0] = call fib (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = void; + ret tmp[0]; +} diff --git a/tests/Reg/positive/test014.jvr b/tests/Reg/positive/test014.jvr new file mode 100644 index 000000000..2cb2f805c --- /dev/null +++ b/tests/Reg/positive/test014.jvr @@ -0,0 +1,144 @@ +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] = void; + ret tmp[0]; + }; + }; +} + +function main() : * { + tmp[0] = 3; + tmp[0] = call gen (tmp[0]); + tmp[0] = call preorder (tmp[0]); + nop; + tmp[0] = "X"; + trace tmp[0]; + nop; + tmp[0] = 7; + tmp[0] = call gen (tmp[0]); + tcall preorder (tmp[0]); +} diff --git a/tests/Reg/positive/test015.jvr b/tests/Reg/positive/test015.jvr new file mode 100644 index 000000000..1989c7dc7 --- /dev/null +++ b/tests/Reg/positive/test015.jvr @@ -0,0 +1,94 @@ + +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]), live: (tmp[0]); + tmp[0] = call tmp[1] (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 5; + tmp[1] = 6; + tmp[1] = call f (tmp[1]), live: (tmp[0]); + tmp[0] = call tmp[1] (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 5; + tmp[1] = 10; + tmp[1] = call f (tmp[1]), live: (tmp[0]); + tmp[0] = call tmp[1] (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 5; + tmp[1] = 11; + tmp[1] = call f (tmp[1]), live: (tmp[0]); + tmp[0] = call tmp[1] (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = void; + ret tmp[0]; +} diff --git a/tests/Reg/positive/test016.jvr b/tests/Reg/positive/test016.jvr new file mode 100644 index 000000000..3b8d65347 --- /dev/null +++ b/tests/Reg/positive/test016.jvr @@ -0,0 +1,78 @@ + +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]; + trace 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]); + prealloc 2, live: (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 17; + tmp[1] = 5; + tmp[2] = 0; + tmp[1] = mul tmp[2] tmp[1]; + tmp[0] = add tmp[1] tmp[0]; + trace tmp[0]; + nop; + 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]; + trace tmp[0]; + nop; + tmp[0] = 4; + tmp[1] = 3; + tmp[2] = 2; + tmp[3] = calloc g (); + tmp[1] = call h (tmp[3], tmp[2], tmp[1]), live: (tmp[0]); + tmp[0] = call f (tmp[1], tmp[0]); + trace tmp[0]; + nop; + tmp[0] = void; + ret tmp[0]; +} diff --git a/tests/Reg/positive/test017.jvr b/tests/Reg/positive/test017.jvr new file mode 100644 index 000000000..7d2b68f7c --- /dev/null +++ b/tests/Reg/positive/test017.jvr @@ -0,0 +1,129 @@ + +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]), live: (tmp[0]); + tmp[0] = call tmp[1] (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 0; + tmp[1] = 5; + tmp[1] = call f (tmp[1]), live: (tmp[0]); + tmp[0] = call tmp[1] (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 5; + tmp[1] = 5; + tmp[1] = call f (tmp[1]), live: (tmp[0]); + tmp[0] = call tmp[1] (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 10; + tmp[0] = call h' (tmp[0]); + prealloc 2, live: (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = calloc h' (); + tmp[1] = 10; + tmp[0] = call g' (tmp[1], tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 10; + tmp[0] = call f (tmp[0]); + tmp[1] = 3; + tmp[0] = call g' (tmp[1], tmp[0]); + trace tmp[0]; + nop; + tmp[0] = void; + ret tmp[0]; +} diff --git a/tests/Reg/positive/test018.jvr b/tests/Reg/positive/test018.jvr new file mode 100644 index 000000000..899fbb018 --- /dev/null +++ b/tests/Reg/positive/test018.jvr @@ -0,0 +1,69 @@ + +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 main() : *; + +function ext_10((integer, integer) → integer) : integer → integer { + prealloc 4, live: (arg[0]); + 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 main() : * { + prealloc 2; + tmp[0] = calloc plus (); + tmp[0] = call f (tmp[0]); + prealloc 2, live: (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = calloc minus (); + tmp[0] = call f (tmp[0]); + prealloc 2, live: (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = calloc mult (); + tmp[0] = call f (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = void; + ret tmp[0]; +} diff --git a/tests/Reg/positive/test019.jvr b/tests/Reg/positive/test019.jvr new file mode 100644 index 000000000..6a81367d3 --- /dev/null +++ b/tests/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/Reg/positive/test020.jvr b/tests/Reg/positive/test020.jvr new file mode 100644 index 000000000..cbde2bd0d --- /dev/null +++ b/tests/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/Reg/positive/test021.jvr b/tests/Reg/positive/test021.jvr new file mode 100644 index 000000000..cedc32e50 --- /dev/null +++ b/tests/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/Reg/positive/test022.jvr b/tests/Reg/positive/test022.jvr new file mode 100644 index 000000000..7217dcb55 --- /dev/null +++ b/tests/Reg/positive/test022.jvr @@ -0,0 +1,23 @@ + +function sapp(* → *) : *; +function id(*) : *; +function main() : *; + +function sapp(* → *) : * { + tmp[0] = arg[0]; + tmp[1] = arg[0]; + tcall tmp[1] (tmp[0]); +} + +function id(*) : * { + tmp[0] = arg[0]; + ret tmp[0]; +} + +function main() : * { + prealloc 4; + tmp[0] = 7; + tmp[1] = calloc id (); + tmp[2] = calloc sapp (); + tccall tmp[2] (tmp[1], tmp[0]); +} diff --git a/tests/Reg/positive/test023.jvr b/tests/Reg/positive/test023.jvr new file mode 100644 index 000000000..55ed0f80d --- /dev/null +++ b/tests/Reg/positive/test023.jvr @@ -0,0 +1,45 @@ + +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]); + trace tmp[0]; + nop; + tmp[0] = 95; + tmp[0] = call f91 (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 16; + tmp[0] = call f91 (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 5; + tmp[0] = call f91 (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = void; + ret tmp[0]; +} diff --git a/tests/Reg/positive/test024.jvr b/tests/Reg/positive/test024.jvr new file mode 100644 index 000000000..88f3c00d0 --- /dev/null +++ b/tests/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] = "end"; + trace tmp[0]; + nop; + tmp[0] = void; + 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/Reg/positive/test025.jvr b/tests/Reg/positive/test025.jvr new file mode 100644 index 000000000..1f41ccdbb --- /dev/null +++ b/tests/Reg/positive/test025.jvr @@ -0,0 +1,73 @@ + +function f(integer, integer, integer) : integer; +function app(integer → integer, integer) : integer; +function g(*) : *; +function h(*, *) : *; +function inc(integer) : integer; +function main() : *; + +function f(integer, integer, integer) : integer { + tmp[0] = arg[0]; + tmp[1] = arg[1]; + tmp[2] = arg[2]; + tmp[1] = add tmp[2] tmp[1]; + tmp[0] = mul tmp[1] tmp[0]; + ret tmp[0]; +} + +function app(integer → integer, integer) : integer { + tmp[0] = arg[1]; + tmp[1] = arg[0]; + tcall tmp[1] (tmp[0]); +} + +function g(*) : * { + tmp[0] = 1; + tmp[1] = 2; + tmp[2] = arg[0]; + tccall tmp[2] (tmp[1], tmp[0]); +} + +function h(*, *) : * { + tmp[0] = arg[1]; + tmp[1] = arg[0]; + tccall 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 main() : * { + prealloc 2; + tmp[0] = 10; + tmp[1] = 2; + tmp[2] = 3; + tmp[3] = calloc f (); + tmp[1] = ccall tmp[3] (tmp[2], tmp[1]), live: (tmp[0]); + prealloc 2, live: (tmp[0], tmp[1]); + tmp[2] = calloc app (); + tmp[0] = ccall tmp[2] (tmp[1], tmp[0]); + prealloc 4, live: (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 10; + tmp[1] = calloc f (); + tmp[2] = calloc g (); + tmp[0] = ccall tmp[2] (tmp[1], tmp[0]); + prealloc 4, live: (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 7; + tmp[1] = calloc inc (); + tmp[2] = calloc app (); + tmp[1] = call h (tmp[2], tmp[1]), live: (tmp[0]); + tmp[0] = ccall tmp[1] (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = void; + ret tmp[0]; +} diff --git a/tests/Reg/positive/test026.jvr b/tests/Reg/positive/test026.jvr new file mode 100644 index 000000000..a5a10711d --- /dev/null +++ b/tests/Reg/positive/test026.jvr @@ -0,0 +1,96 @@ + +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]); + prealloc 2, live: (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 4; + tmp[1] = calloc app (); + tmp[1] = call h (tmp[1]), live: (tmp[0]); + tmp[0] = call tmp[1] (tmp[0]); + prealloc 4, live: (tmp[0]); + trace tmp[0]; + nop; + 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]); + trace tmp[0]; + nop; + tmp[0] = void; + ret tmp[0]; +} diff --git a/tests/Reg/positive/test027.jvr b/tests/Reg/positive/test027.jvr new file mode 100644 index 000000000..12563e86f --- /dev/null +++ b/tests/Reg/positive/test027.jvr @@ -0,0 +1,74 @@ + +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]); + trace tmp[0]; + nop; + tmp[0] = 7; + tmp[1] = 3; + tmp[0] = call power (tmp[1], tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 11; + tmp[1] = 5; + tmp[0] = call power (tmp[1], tmp[0]); + trace tmp[0]; + nop; + tmp[0] = void; + ret tmp[0]; +} diff --git a/tests/Reg/positive/test028.jvr b/tests/Reg/positive/test028.jvr new file mode 100644 index 000000000..f240de9fd --- /dev/null +++ b/tests/Reg/positive/test028.jvr @@ -0,0 +1,305 @@ +type list { + nil : list; + cons : (*, list) → list; +} + +function head(list) : *; +function tail(list) : list; +function null(list) : *; +function map(* → *, list) : list; +function foldl((*, *) → *, *, list) : *; +function foldr((*, *) → *, *, list) : *; +function filter(* → bool, list) : list; +function flip_cons(list, *) : list; +function rev(list) : 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 gt5(integer) : bool; +function dec(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 map(* → *, list) : list { + tmp[0] = arg[1]; + case[list] tmp[0] { + nil: { + ret tmp[0]; + }; + cons: { + nop; + tmp[0] = arg[1].cons[1]; + tmp[1] = arg[0]; + tmp[0] = call map (tmp[1], tmp[0]), live: (arg[0], arg[1]); + tmp[1] = arg[1].cons[0]; + 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 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 filter(* → bool, list) : list { + tmp[0] = arg[1]; + case[list] tmp[0] { + nil: { + ret tmp[0]; + }; + cons: { + nop; + tmp[0] = arg[1].cons[0]; + tmp[1] = arg[0]; + tmp[0] = call tmp[1] (tmp[0]), live: (arg[0], arg[1]); + br tmp[0] { + true: { + tmp[0] = arg[1].cons[1]; + tmp[1] = arg[0]; + tmp[0] = call filter (tmp[1], tmp[0]), live: (arg[0], arg[1]); + prealloc 3, live: (tmp[0], arg[0], arg[1]); + tmp[1] = arg[1].cons[0]; + tmp[0] = alloc cons (tmp[1], tmp[0]); + ret tmp[0]; + }; + false: { + tmp[0] = arg[1].cons[1]; + tmp[1] = arg[0]; + tcall filter (tmp[1], tmp[0]); + }; + }; + }; + }; +} + +function flip_cons(list, *) : list { + prealloc 3, live: (arg[0], arg[1]); + tmp[0] = arg[0]; + tmp[1] = arg[1]; + tmp[0] = alloc cons (tmp[1], tmp[0]); + ret tmp[0]; +} + +function rev(list) : list { + prealloc 3, live: (arg[0]); + tmp[0] = arg[0]; + tmp[1] = alloc nil (); + tmp[2] = calloc flip_cons (); + tcall foldl (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 gt5(integer) : bool { + tmp[0] = arg[0]; + tmp[1] = 5; + tmp[0] = lt tmp[1] tmp[0]; + ret tmp[0]; +} + +function dec(integer) : integer { + tmp[0] = 1; + tmp[1] = arg[0]; + tmp[0] = sub tmp[1] tmp[0]; + ret tmp[0]; +} + +function main() : * { + tmp[0] = 10; + tmp[0] = call gen (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 10; + tmp[0] = call gen (tmp[0]); + tmp[0] = call rev (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 10; + tmp[0] = call gen (tmp[0]); + prealloc 2, live: (tmp[0]); + tmp[1] = calloc gt5 (); + tmp[0] = call filter (tmp[1], tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 10; + tmp[0] = call gen (tmp[0]); + prealloc 2, live: (tmp[0]); + tmp[1] = calloc dec (); + tmp[0] = call map (tmp[1], tmp[0]); + tmp[0] = call rev (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 1000; + tmp[0] = call sum (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 1000; + tmp[0] = call sum' (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 1000; + tmp[0] = call sum'' (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = void; + ret tmp[0]; +} diff --git a/tests/Reg/positive/test029.jvr b/tests/Reg/positive/test029.jvr new file mode 100644 index 000000000..0cf121cdc --- /dev/null +++ b/tests/Reg/positive/test029.jvr @@ -0,0 +1,67 @@ +type list { + nil : list; + cons : (*, list) → list; +} + +function main() : *; + +function main() : * { + prealloc 40; + tmp[0] = 1; + tmp[1] = 1; + tmp[0] = eq tmp[1] tmp[0]; + trace tmp[0]; + nop; + tmp[0] = 1; + tmp[1] = 0; + tmp[0] = eq tmp[1] tmp[0]; + trace tmp[0]; + nop; + tmp[0] = alloc nil (); + tmp[1] = alloc nil (); + tmp[0] = eq tmp[1] tmp[0]; + trace tmp[0]; + nop; + tmp[0] = alloc nil (); + tmp[1] = alloc nil (); + tmp[2] = 1; + tmp[1] = alloc cons (tmp[2], tmp[1]); + tmp[0] = eq tmp[1] tmp[0]; + trace tmp[0]; + nop; + tmp[0] = alloc nil (); + tmp[1] = 2; + tmp[0] = alloc cons (tmp[1], tmp[0]); + tmp[1] = alloc nil (); + tmp[2] = 1; + tmp[1] = alloc cons (tmp[2], tmp[1]); + tmp[0] = eq tmp[1] tmp[0]; + trace tmp[0]; + nop; + tmp[0] = alloc nil (); + tmp[1] = 2; + tmp[0] = alloc cons (tmp[1], tmp[0]); + tmp[1] = 1; + tmp[0] = alloc cons (tmp[1], tmp[0]); + tmp[1] = alloc nil (); + tmp[2] = 1; + tmp[1] = alloc cons (tmp[2], tmp[1]); + tmp[0] = eq tmp[1] tmp[0]; + trace tmp[0]; + nop; + tmp[0] = alloc nil (); + tmp[1] = 2; + tmp[0] = alloc cons (tmp[1], tmp[0]); + tmp[1] = 1; + tmp[0] = alloc cons (tmp[1], tmp[0]); + tmp[1] = alloc nil (); + tmp[2] = 2; + tmp[1] = alloc cons (tmp[2], tmp[1]); + tmp[2] = 1; + tmp[1] = alloc cons (tmp[2], tmp[1]); + tmp[0] = eq tmp[1] tmp[0]; + trace tmp[0]; + nop; + tmp[0] = void; + ret tmp[0]; +} diff --git a/tests/Reg/positive/test030.jvr b/tests/Reg/positive/test030.jvr new file mode 100644 index 000000000..bc4bfe0d6 --- /dev/null +++ b/tests/Reg/positive/test030.jvr @@ -0,0 +1,93 @@ + +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]); + trace tmp[0]; + nop; + tmp[0] = 10; + tmp[0] = call f (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 100; + tmp[0] = call f (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = void; + ret tmp[0]; +} diff --git a/tests/Reg/positive/test031.jvr b/tests/Reg/positive/test031.jvr new file mode 100644 index 000000000..c24a862d1 --- /dev/null +++ b/tests/Reg/positive/test031.jvr @@ -0,0 +1,208 @@ +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] { + 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] { + 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]); + trace tmp[0]; + nop; + tmp[0] = 15; + tmp[0] = call gen (tmp[0]); + tmp[0] = call f (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 16; + tmp[0] = call gen (tmp[0]); + tmp[0] = call f (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 17; + tmp[0] = call gen (tmp[0]); + tmp[0] = call f (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = void; + ret tmp[0]; +} diff --git a/tests/Reg/positive/test032.jvr b/tests/Reg/positive/test032.jvr new file mode 100644 index 000000000..e2f51bb26 --- /dev/null +++ b/tests/Reg/positive/test032.jvr @@ -0,0 +1,263 @@ +type Pair { + pair : (*, *) → Pair; +} + +function compose(* → *, * → *, *) : *; +function zero(* → *, *) : *; +function num(integer, * → *, *) : *; +function succ((* → *, *) → *, * → *) : * → *; +function cadd((* → *, *) → *, (* → *, *) → *, * → *) : * → *; +function cmul((* → *, *) → *, (* → *, *) → *, * → *) : * → *; +function const(*, *) : *; +function isZero((* → *, *) → *) : bool; +function uncurry(*, * → *, *) : *; +function pred_step(Pair) : Pair; +function pred((* → *, *) → *) : (* → *, *) → *; +function inc(integer) : integer; +function toInt((* → *, *) → *) : integer; +function fib((* → *, *) → *) : (* → *, *) → *; +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 zero(* → *, *) : * { + tmp[0] = arg[1]; + ret tmp[0]; +} + +function num(integer, * → *, *) : * { + tmp[0] = arg[0]; + tmp[1] = 0; + tmp[0] = eq tmp[1] tmp[0]; + br tmp[0] { + true: { + tmp[0] = arg[2]; + tmp[1] = arg[1]; + tcall zero (tmp[1], tmp[0]); + }; + false: { + prealloc 4, live: (arg[0], arg[1], arg[2]); + tmp[0] = arg[2]; + tmp[1] = arg[1]; + tmp[2] = 1; + tmp[3] = arg[0]; + tmp[2] = sub tmp[3] tmp[2]; + tmp[1] = calloc num (tmp[2], tmp[1]); + tmp[2] = arg[1]; + tcall compose (tmp[2], tmp[1], tmp[0]); + }; + }; +} + +function succ((* → *, *) → *, * → *) : * → * { + prealloc 9, live: (arg[0], arg[1]); + tmp[0] = arg[1]; + tmp[1] = arg[0]; + tmp[0] = cextend tmp[1] (tmp[0]); + tmp[1] = arg[1]; + tmp[0] = calloc compose (tmp[1], tmp[0]); + ret tmp[0]; +} + +function cadd((* → *, *) → *, (* → *, *) → *, * → *) : * → * { + prealloc 14, live: (arg[0], arg[1], arg[2]); + tmp[0] = arg[2]; + tmp[1] = arg[1]; + tmp[0] = cextend tmp[1] (tmp[0]); + tmp[1] = arg[2]; + tmp[2] = arg[0]; + tmp[1] = cextend tmp[2] (tmp[1]); + tmp[0] = calloc compose (tmp[1], tmp[0]); + ret tmp[0]; +} + +function cmul((* → *, *) → *, (* → *, *) → *, * → *) : * → * { + prealloc 10, live: (arg[0], arg[1], arg[2]); + tmp[0] = arg[2]; + tmp[1] = arg[1]; + tmp[0] = cextend tmp[1] (tmp[0]); + tmp[1] = arg[0]; + tmp[0] = cextend tmp[1] (tmp[0]); + ret tmp[0]; +} + +function const(*, *) : * { + tmp[0] = arg[0]; + ret tmp[0]; +} + +function isZero((* → *, *) → *) : bool { + prealloc 3, live: (arg[0]); + tmp[0] = true; + tmp[1] = false; + tmp[1] = calloc const (tmp[1]); + tmp[2] = arg[0]; + tcall tmp[2] (tmp[1], tmp[0]); +} + +function uncurry(*, * → *, *) : * { + tmp[0] = arg[2]; + tmp[1] = arg[1]; + tmp[2] = arg[0]; + tccall tmp[2] (tmp[1], tmp[0]); +} + +function pred_step(Pair) : Pair { + tmp[0] = arg[0].pair[1]; + tmp[0] = call isZero (tmp[0]), live: (arg[0]); + br tmp[0] { + true: { + prealloc 9, live: (arg[0]); + tmp[0] = arg[0].pair[1]; + tmp[0] = calloc succ (tmp[0]); + tmp[0] = calloc uncurry (tmp[0]); + tmp[1] = arg[0].pair[0]; + tmp[0] = alloc pair (tmp[1], tmp[0]); + ret tmp[0]; + }; + false: { + prealloc 15, live: (arg[0]); + tmp[0] = arg[0].pair[1]; + tmp[0] = calloc succ (tmp[0]); + tmp[0] = calloc uncurry (tmp[0]); + tmp[1] = arg[0].pair[0]; + tmp[1] = calloc succ (tmp[1]); + tmp[1] = calloc uncurry (tmp[1]); + tmp[0] = alloc pair (tmp[1], tmp[0]); + ret tmp[0]; + }; + }; +} + +function pred((* → *, *) → *) : (* → *, *) → * { + prealloc 9, live: (arg[0]); + tmp[1] = calloc zero (); + tmp[2] = calloc zero (); + tmp[1] = alloc pair (tmp[2], tmp[1]); + tmp[2] = calloc pred_step (); + tmp[3] = arg[0]; + tmp[1] = call tmp[3] (tmp[2], tmp[1]), live: (arg[0]); + { + tmp[0] = tmp[1]; + tmp[1] = tmp[0].pair[0]; + }; + ret tmp[1]; +} + +function inc(integer) : integer { + tmp[0] = arg[0]; + tmp[1] = 1; + tmp[0] = add tmp[1] tmp[0]; + ret tmp[0]; +} + +function toInt((* → *, *) → *) : integer { + prealloc 2, live: (arg[0]); + tmp[0] = 0; + tmp[1] = calloc inc (); + tmp[2] = arg[0]; + tcall tmp[2] (tmp[1], tmp[0]); +} + +function fib((* → *, *) → *) : (* → *, *) → * { + tmp[1] = arg[0]; + tmp[1] = call isZero (tmp[1]), live: (arg[0]); + br tmp[1] { + true: { + prealloc 2, live: (arg[0]); + tmp[1] = calloc zero (); + ret tmp[1]; + }; + false: { + tmp[1] = arg[0]; + tmp[1] = call pred (tmp[1]), live: (arg[0]); + { + tmp[0] = tmp[1]; + tmp[1] = tmp[0]; + tmp[1] = call isZero (tmp[1]), live: (tmp[0], arg[0]); + br tmp[1] { + true: { + prealloc 8, live: (tmp[0], arg[0]); + tmp[1] = calloc zero (); + tmp[1] = calloc succ (tmp[1]); + tmp[1] = calloc uncurry (tmp[1]); + ret tmp[1]; + }; + false: { + tmp[1] = tmp[0]; + tmp[1] = call pred (tmp[1]), live: (tmp[0], arg[0]); + tmp[1] = call fib (tmp[1]), live: (tmp[0], arg[0]); + tmp[2] = tmp[0]; + tmp[2] = call fib (tmp[2]), live: (tmp[0], tmp[1], arg[0]); + prealloc 7, live: (tmp[0], tmp[1], tmp[2], arg[0]); + tmp[1] = calloc cadd (tmp[2], tmp[1]); + tmp[1] = calloc uncurry (tmp[1]); + ret tmp[1]; + }; + }; + }; + }; + }; +} + +function main() : * { + prealloc 3; + tmp[0] = 7; + tmp[0] = calloc num (tmp[0]); + tmp[0] = call toInt (tmp[0]); + prealloc 13, live: (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 3; + tmp[0] = calloc num (tmp[0]); + tmp[1] = 7; + tmp[1] = calloc num (tmp[1]); + tmp[0] = calloc cmul (tmp[1], tmp[0]); + tmp[0] = calloc uncurry (tmp[0]); + tmp[0] = call toInt (tmp[0]); + prealloc 3, live: (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 7; + tmp[0] = calloc num (tmp[0]); + tmp[0] = call pred (tmp[0]); + tmp[0] = call toInt (tmp[0]); + prealloc 3, live: (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 5; + tmp[0] = calloc num (tmp[0]); + tmp[0] = call fib (tmp[0]); + tmp[0] = call toInt (tmp[0]); + prealloc 3, live: (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 6; + tmp[0] = calloc num (tmp[0]); + tmp[0] = call fib (tmp[0]); + tmp[0] = call toInt (tmp[0]); + prealloc 3, live: (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 7; + tmp[0] = calloc num (tmp[0]); + tmp[0] = call fib (tmp[0]); + tmp[0] = call toInt (tmp[0]); + prealloc 3, live: (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 8; + tmp[0] = calloc num (tmp[0]); + tmp[0] = call fib (tmp[0]); + tmp[0] = call toInt (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = void; + ret tmp[0]; +} diff --git a/tests/Reg/positive/test033.jvr b/tests/Reg/positive/test033.jvr new file mode 100644 index 000000000..ee23491ab --- /dev/null +++ b/tests/Reg/positive/test033.jvr @@ -0,0 +1,77 @@ + +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]); + trace tmp[0]; + nop; + tmp[0] = 7; + tmp[1] = 1; + tmp[0] = call ack (tmp[1], tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 13; + tmp[1] = 1; + tmp[0] = call ack (tmp[1], tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 7; + tmp[1] = 2; + tmp[0] = call ack (tmp[1], tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 13; + tmp[1] = 2; + tmp[0] = call ack (tmp[1], tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 4; + tmp[1] = 3; + tmp[0] = call ack (tmp[1], tmp[0]); + trace tmp[0]; + nop; + tmp[0] = void; + ret tmp[0]; +} diff --git a/tests/Reg/positive/test034.jvr b/tests/Reg/positive/test034.jvr new file mode 100644 index 000000000..e05e60701 --- /dev/null +++ b/tests/Reg/positive/test034.jvr @@ -0,0 +1,102 @@ + +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]); + trace tmp[0]; + nop; + tmp[0] = 7; + tmp[1] = 3; + tmp[0] = call mult (tmp[1], tmp[0]); + trace tmp[0]; + nop; + tmp[0] = 7; + tmp[1] = 3; + tmp[0] = call exp (tmp[1], tmp[0]); + trace tmp[0]; + nop; + tmp[0] = void; + ret tmp[0]; +} diff --git a/tests/Reg/positive/test035.jvr b/tests/Reg/positive/test035.jvr new file mode 100644 index 000000000..6d494e0f3 --- /dev/null +++ b/tests/Reg/positive/test035.jvr @@ -0,0 +1,105 @@ +type list { + nil : list; + cons : (*, list) → list; +} + +function mklst(integer) : list; +function mklst2(integer) : list; +function append(list, list) : list; +function flatten(list) : list; +function main() : *; + +function mklst(integer) : list { + tmp[0] = 0; + tmp[1] = arg[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 mklst (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 mklst2(integer) : list { + tmp[0] = 0; + tmp[1] = arg[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 mklst2 (tmp[0]), live: (arg[0]); + tmp[1] = arg[0]; + tmp[1] = call mklst (tmp[1]), live: (tmp[0], arg[0]); + prealloc 3, live: (tmp[0], tmp[1], arg[0]); + tmp[0] = alloc cons (tmp[1], tmp[0]); + ret tmp[0]; + }; + }; +} + +function append(list, list) : list { + tmp[0] = arg[0]; + case[list] tmp[0] { + nil: { + nop; + tmp[0] = arg[1]; + ret tmp[0]; + }; + cons: { + nop; + tmp[0] = arg[1]; + tmp[1] = arg[0].cons[1]; + tmp[0] = call append (tmp[1], tmp[0]), live: (arg[0], arg[1]); + prealloc 3, live: (tmp[0], arg[0], arg[1]); + tmp[1] = arg[0].cons[0]; + tmp[0] = alloc cons (tmp[1], tmp[0]); + ret tmp[0]; + }; + }; +} + +function flatten(list) : list { + tmp[0] = arg[0]; + case[list] tmp[0] { + nil: { + ret tmp[0]; + }; + cons: { + nop; + tmp[0] = arg[0].cons[1]; + tmp[0] = call flatten (tmp[0]), live: (arg[0]); + tmp[1] = arg[0].cons[0]; + tcall append (tmp[1], tmp[0]); + }; + }; +} + +function main() : * { + tmp[0] = 4; + tmp[0] = call mklst2 (tmp[0]); + trace tmp[0]; + tmp[0] = call flatten (tmp[0]); + trace tmp[0]; + nop; + tmp[0] = void; + ret tmp[0]; +} diff --git a/tests/Reg/positive/test036.jvr b/tests/Reg/positive/test036.jvr new file mode 100644 index 000000000..ce959a3ca --- /dev/null +++ b/tests/Reg/positive/test036.jvr @@ -0,0 +1,139 @@ +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]); + trace tmp[0]; + nop; + tmp[0] = call primes (); + tmp[1] = 50; + tmp[0] = call nth (tmp[1], tmp[0]); + trace tmp[0]; + nop; + tmp[0] = void; + ret tmp[0]; +} diff --git a/tests/Reg/positive/test037.jvr b/tests/Reg/positive/test037.jvr new file mode 100644 index 000000000..1b7b1a292 --- /dev/null +++ b/tests/Reg/positive/test037.jvr @@ -0,0 +1,15 @@ + +function main() : *; + +function main() : * { + prealloc 514; + tmp[0] = ".\n"; + tmp[1] = 20; + tmp[2] = "123"; + tmp[2] = atoi tmp[2]; + tmp[1] = add tmp[2] tmp[1]; + tmp[1] = show tmp[1]; + tmp[0] = strcat tmp[1] tmp[0]; + tmp[0] = alloc write (tmp[0]); + ret tmp[0]; +} diff --git a/tests/Reg/positive/test038.jvr b/tests/Reg/positive/test038.jvr new file mode 100644 index 000000000..9b9027ba8 --- /dev/null +++ b/tests/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]); +}