diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 98c13f9a3..8274ede16 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -26,7 +26,7 @@ env: SKIP: ormolu,format-juvix-files,typecheck-juvix-examples VAMPIRREPO: anoma/vamp-ir VAMPIRVERSION: v0.1.3 - CAIRO_VM_VERSION: 42e04161de82d7e5381258def4b65087c8944660 + CAIRO_VM_VERSION: ae06ba04f3b6864546b6baeeebf1b0735ddccb5d jobs: pre-commit: @@ -127,7 +127,7 @@ jobs: id: cache-cairo-vm uses: actions/cache@v4 with: - path: ${{ env.HOME }}/.local/bin/cairo-vm-cli + path: ${{ env.HOME }}/.local/bin/juvix-cairo-vm key: ${{ runner.os }}-cairo-vm-${{ env.CAIRO_VM_VERSION }} - name: Install Rust toolchain @@ -138,17 +138,17 @@ jobs: uses: actions/checkout@v4 if: steps.cache-cairo-vm.outputs.cache-hit != 'true' with: - repository: lambdaclass/cairo-vm - path: cairo-vm + repository: anoma/juvix-cairo-vm + path: juvix-cairo-vm ref: ${{ env.CAIRO_VM_VERSION }} - name: Install Cairo VM if: steps.cache-cairo-vm.outputs.cache-hit != 'true' shell: bash run: | - cd cairo-vm + cd juvix-cairo-vm cargo build --release - cp target/release/cairo-vm-cli $HOME/.local/bin/cairo-vm-cli + cp target/release/juvix-cairo-vm $HOME/.local/bin/juvix-cairo-vm - name: Install run_cairo_vm.sh shell: bash @@ -323,7 +323,7 @@ jobs: id: cache-cairo-vm uses: actions/cache@v4 with: - path: ${{ env.HOME }}/.local/bin/cairo-vm-cli + path: ${{ env.HOME }}/.local/bin/juvix-cairo-vm key: ${{ runner.os }}-cairo-vm-${{ env.CAIRO_VM_VERSION }} - name: Install Rust toolchain @@ -334,24 +334,22 @@ jobs: uses: actions/checkout@v4 if: steps.cache-cairo-vm.outputs.cache-hit != 'true' with: - repository: lambdaclass/cairo-vm - path: cairo-vm + repository: anoma/juvix-cairo-vm + path: juvix-cairo-vm ref: ${{ env.CAIRO_VM_VERSION }} - name: Install Cairo VM if: steps.cache-cairo-vm.outputs.cache-hit != 'true' shell: bash run: | - cd cairo-vm + cd juvix-cairo-vm cargo build --release - cp -a target/release/cairo-vm-cli $HOME/.local/bin/cairo-vm-cli - chmod a+x $HOME/.local/bin/cairo-vm-cli + cp -a target/release/juvix-cairo-vm $HOME/.local/bin/juvix-cairo-vm - name: Install run_cairo_vm.sh shell: bash run: | cp -a main/scripts/run_cairo_vm.sh $HOME/.local/bin/run_cairo_vm.sh - chmod a+x $HOME/.local/bin/run_cairo_vm.sh - name: Make runtime run: | diff --git a/app/Commands/Dev/Casm/Run.hs b/app/Commands/Dev/Casm/Run.hs index 4771ba536..a9177324f 100644 --- a/app/Commands/Dev/Casm/Run.hs +++ b/app/Commands/Dev/Casm/Run.hs @@ -2,6 +2,7 @@ module Commands.Dev.Casm.Run where import Commands.Base import Commands.Dev.Casm.Run.Options +import Juvix.Compiler.Casm.Extra.InputInfo qualified as Casm import Juvix.Compiler.Casm.Interpreter qualified as Casm import Juvix.Compiler.Casm.Translation.FromSource qualified as Casm import Juvix.Compiler.Casm.Validate qualified as Casm @@ -9,13 +10,15 @@ import Juvix.Compiler.Casm.Validate qualified as Casm runCommand :: forall r. (Members '[EmbedIO, App] r) => CasmRunOptions -> Sem r () runCommand opts = do afile :: Path Abs File <- fromAppPathFile file + dfile :: Maybe (Path Abs File) <- maybe (return Nothing) (fromAppPathFile >=> return . Just) (opts ^. casmRunDataFile) + inputInfo <- liftIO (Casm.readInputInfo dfile) s <- readFile afile case Casm.runParser afile s of Left err -> exitJuvixError (JuvixError err) Right (labi, code) -> case Casm.validate labi code of Left err -> exitJuvixError (JuvixError err) - Right () -> print (Casm.runCode labi code) + Right () -> print (Casm.runCode inputInfo labi code) where file :: AppPath File file = opts ^. casmRunInputFile diff --git a/app/Commands/Dev/Casm/Run/Options.hs b/app/Commands/Dev/Casm/Run/Options.hs index 06293bc2b..b02174e6a 100644 --- a/app/Commands/Dev/Casm/Run/Options.hs +++ b/app/Commands/Dev/Casm/Run/Options.hs @@ -2,8 +2,9 @@ module Commands.Dev.Casm.Run.Options where import CommonOptions -newtype CasmRunOptions = CasmRunOptions - { _casmRunInputFile :: AppPath File +data CasmRunOptions = CasmRunOptions + { _casmRunInputFile :: AppPath File, + _casmRunDataFile :: Maybe (AppPath File) } deriving stock (Data) @@ -12,4 +13,5 @@ makeLenses ''CasmRunOptions parseCasmRunOptions :: Parser CasmRunOptions parseCasmRunOptions = do _casmRunInputFile <- parseInputFile FileExtCasm + _casmRunDataFile <- optional parseProgramInputFile pure CasmRunOptions {..} diff --git a/app/CommonOptions.hs b/app/CommonOptions.hs index 46e5f244e..e05b3c1e2 100644 --- a/app/CommonOptions.hs +++ b/app/CommonOptions.hs @@ -51,6 +51,19 @@ parseInputFiles exts' = do parseInputFile :: FileExt -> Parser (AppPath File) parseInputFile = parseInputFiles . NonEmpty.singleton +parseProgramInputFile :: Parser (AppPath File) +parseProgramInputFile = do + _pathPath <- + option + somePreFileOpt + ( long "program_input" + <> metavar "JSON_FILE" + <> help "Path to program input json file" + <> completer (extCompleter FileExtJson) + <> action "file" + ) + pure AppPath {_pathIsInput = True, ..} + parseGenericInputFile :: Parser (AppPath File) parseGenericInputFile = do _pathPath <- diff --git a/package.yaml b/package.yaml index 4b54576e7..a69ab6058 100644 --- a/package.yaml +++ b/package.yaml @@ -84,6 +84,7 @@ dependencies: - primitive == 0.8.* - process == 1.6.* - safe == 0.3.* + - scientific == 0.3.* - singletons == 3.0.* - singletons-base == 3.3.* - singletons-th == 3.3.* diff --git a/scripts/run_cairo_vm.sh b/scripts/run_cairo_vm.sh index 462597f82..5b2dd09b2 100755 --- a/scripts/run_cairo_vm.sh +++ b/scripts/run_cairo_vm.sh @@ -2,4 +2,4 @@ BASE=`basename "$1" .json` -cairo-vm-cli "$1" --print_output --proof_mode --trace_file ${BASE}.trace --air_public_input=${BASE}_public_input.json --air_private_input=${BASE}_private_input.json --memory_file=${BASE}_memory.mem --layout=small +juvix-cairo-vm "$@" --print_output --proof_mode --trace_file ${BASE}.trace --air_public_input=${BASE}_public_input.json --air_private_input=${BASE}_private_input.json --memory_file=${BASE}_memory.mem --layout=small diff --git a/src/Juvix/Compiler/Backend/Cairo/Data/Result.hs b/src/Juvix/Compiler/Backend/Cairo/Data/Result.hs index cef7d03a5..ba735b34f 100644 --- a/src/Juvix/Compiler/Backend/Cairo/Data/Result.hs +++ b/src/Juvix/Compiler/Backend/Cairo/Data/Result.hs @@ -1,6 +1,8 @@ module Juvix.Compiler.Backend.Cairo.Data.Result where import Data.Aeson as Aeson hiding (Result) +import Data.Aeson.Types hiding (Result) +import Data.Vector qualified as V import Juvix.Prelude hiding ((.=)) data Result = Result @@ -8,6 +10,7 @@ data Result = Result _resultStart :: Int, _resultEnd :: Int, _resultMain :: Int, + _resultHints :: [(Int, Text)], _resultBuiltins :: [Text] } @@ -19,7 +22,7 @@ instance ToJSON Result where [ "data" .= toJSON _resultData, "attributes" .= Array mempty, "builtins" .= toJSON _resultBuiltins, - "hints" .= object [], + "hints" .= object (map mkHint _resultHints), "identifiers" .= object [ "__main__.__start__" @@ -46,3 +49,21 @@ instance ToJSON Result where [ "references" .= Array mempty ] ] + where + mkHint :: (Int, Text) -> Pair + mkHint (pc, hintCode) = (fromString (show pc), Array $ V.fromList [hint]) + where + hint = + object + [ "accessible_scopes" .= Array mempty, + "code" .= hintCode, + "flow_tracking_data" + .= object + [ "ap_tracking" + .= object + [ "group" .= Number 0, + "offset" .= Number 0 + ], + "reference_ids" .= object [] + ] + ] diff --git a/src/Juvix/Compiler/Backend/Cairo/Extra/Serialization.hs b/src/Juvix/Compiler/Backend/Cairo/Extra/Serialization.hs index 3cd381ce1..9ec5fd6bd 100644 --- a/src/Juvix/Compiler/Backend/Cairo/Extra/Serialization.hs +++ b/src/Juvix/Compiler/Backend/Cairo/Extra/Serialization.hs @@ -16,9 +16,21 @@ serialize elems = _resultStart = 0, _resultEnd = length initializeOutput + length elems + length finalizeOutput, _resultMain = 0, + _resultHints = hints, _resultBuiltins = ["output"] } where + hints :: [(Int, Text)] + hints = catMaybes $ zipWith mkHint elems [0 ..] + + pcShift :: Int + pcShift = length initializeOutput + + mkHint :: Element -> Int -> Maybe (Int, Text) + mkHint el pc = case el of + ElementHint Hint {..} -> Just (pc + pcShift, _hintCode) + _ -> Nothing + toHexText :: Natural -> Text toHexText n = "0x" <> fromString (showHex n "") @@ -48,6 +60,12 @@ serialize' = map goElement goElement = \case ElementInstruction i -> goInstr i ElementImmediate f -> fieldToNatural f + ElementHint h -> goHint h + + goHint :: Hint -> Natural + goHint Hint {..} + | _hintIncAp = 0x481280007fff8000 + | otherwise = 0x401280007fff8000 goInstr :: Instruction -> Natural goInstr Instruction {..} = diff --git a/src/Juvix/Compiler/Backend/Cairo/Language.hs b/src/Juvix/Compiler/Backend/Cairo/Language.hs index 594b475e4..18587290f 100644 --- a/src/Juvix/Compiler/Backend/Cairo/Language.hs +++ b/src/Juvix/Compiler/Backend/Cairo/Language.hs @@ -22,6 +22,12 @@ import Juvix.Data.Field data Element = ElementInstruction Instruction | ElementImmediate FField + | ElementHint Hint + +data Hint = Hint + { _hintCode :: Text, + _hintIncAp :: Bool + } data Instruction = Instruction { _instrOffDst :: Offset, @@ -80,3 +86,4 @@ defaultInstruction = } makeLenses ''Instruction +makeLenses ''Hint diff --git a/src/Juvix/Compiler/Backend/Cairo/Translation/FromCasm.hs b/src/Juvix/Compiler/Backend/Cairo/Translation/FromCasm.hs index fb95f23aa..70d5741e1 100644 --- a/src/Juvix/Compiler/Backend/Cairo/Translation/FromCasm.hs +++ b/src/Juvix/Compiler/Backend/Cairo/Translation/FromCasm.hs @@ -42,6 +42,7 @@ fromCasm instrs0 = Casm.Call x -> goCall x Casm.Return -> goReturn Casm.Alloc x -> goAlloc x + Casm.Hint x -> goHint x Casm.Trace {} -> [] Casm.Label {} -> [] Casm.Nop -> [] @@ -228,3 +229,8 @@ fromCasm instrs0 = . updateOps False _instrAllocSize . set instrApUpdate ApUpdateAdd $ defaultInstruction + + goHint :: Casm.Hint -> [Element] + goHint = \case + Casm.HintInput var -> [ElementHint (Hint ("Input(" <> var <> ")") True)] + Casm.HintAlloc size -> [ElementHint (Hint ("Alloc(" <> show size <> ")") True)] diff --git a/src/Juvix/Compiler/Casm/Data/InputInfo.hs b/src/Juvix/Compiler/Casm/Data/InputInfo.hs new file mode 100644 index 000000000..36e299b1c --- /dev/null +++ b/src/Juvix/Compiler/Casm/Data/InputInfo.hs @@ -0,0 +1,38 @@ +module Juvix.Compiler.Casm.Data.InputInfo where + +import Data.Aeson +import Data.Aeson.Key +import Data.Aeson.KeyMap qualified as KeyMap +import Data.Aeson.Types +import Data.HashMap.Strict qualified as HashMap +import Data.Scientific +import Juvix.Data.Field +import Juvix.Prelude + +newtype InputInfo = InputInfo + { _inputInfoMap :: HashMap Text FField + } + deriving stock (Generic, Show) + +makeLenses ''InputInfo + +instance FromJSON InputInfo where + parseJSON = \case + Object obj -> do + lst <- + forM (KeyMap.toList obj) $ \(k, v) -> do + v' <- parseFField v + return (toText k, v') + return + . InputInfo + . HashMap.fromList + $ lst + v -> typeMismatch "Object" v + where + parseFField :: Value -> Parser FField + parseFField = \case + Number x + | isInteger x -> + return $ fieldFromInteger cairoFieldSize (fromRight 0 $ floatingOrInteger @Double x) + v -> + typeMismatch "Integer" v diff --git a/src/Juvix/Compiler/Casm/Extra/InputInfo.hs b/src/Juvix/Compiler/Casm/Extra/InputInfo.hs new file mode 100644 index 000000000..eda44cd25 --- /dev/null +++ b/src/Juvix/Compiler/Casm/Extra/InputInfo.hs @@ -0,0 +1,12 @@ +module Juvix.Compiler.Casm.Extra.InputInfo where + +import Juvix.Compiler.Casm.Data.InputInfo +import Juvix.Prelude +import Juvix.Prelude.Aeson + +readInputInfo :: Maybe (Path Abs File) -> IO InputInfo +readInputInfo inputFile = case inputFile of + Just file -> + fromJust <$> readJSONFile (toFilePath file) + Nothing -> + return $ InputInfo mempty diff --git a/src/Juvix/Compiler/Casm/Interpreter.hs b/src/Juvix/Compiler/Casm/Interpreter.hs index 5bec3933c..36fb56a63 100644 --- a/src/Juvix/Compiler/Casm/Interpreter.hs +++ b/src/Juvix/Compiler/Casm/Interpreter.hs @@ -11,6 +11,7 @@ import Data.HashMap.Strict qualified as HashMap import Data.Vector qualified as Vec import Data.Vector.Mutable qualified as MV import GHC.IO qualified as GHC +import Juvix.Compiler.Casm.Data.InputInfo import Juvix.Compiler.Casm.Data.LabelInfo import Juvix.Compiler.Casm.Error import Juvix.Compiler.Casm.Interpreter.Error @@ -19,12 +20,12 @@ import Juvix.Data.Field type Memory s = MV.MVector s (Maybe FField) -runCode :: LabelInfo -> [Instruction] -> FField +runCode :: InputInfo -> LabelInfo -> [Instruction] -> FField runCode = hRunCode stderr -- | Runs Cairo Assembly. Returns the value of `[ap - 1]` at program exit. -hRunCode :: Handle -> LabelInfo -> [Instruction] -> FField -hRunCode hout (LabelInfo labelInfo) instrs0 = runST goCode +hRunCode :: Handle -> InputInfo -> LabelInfo -> [Instruction] -> FField +hRunCode hout inputInfo (LabelInfo labelInfo) instrs0 = runST goCode where instrs :: Vec.Vector Instruction instrs = Vec.fromList instrs0 @@ -61,6 +62,7 @@ hRunCode hout (LabelInfo labelInfo) instrs0 = runST goCode Return -> goReturn pc ap fp mem Alloc x -> goAlloc x pc ap fp mem Trace x -> goTrace x pc ap fp mem + Hint x -> goHint x pc ap fp mem Label {} -> go (pc + 1) ap fp mem Nop -> go (pc + 1) ap fp mem @@ -241,6 +243,18 @@ hRunCode hout (LabelInfo labelInfo) instrs0 = runST goCode GHC.unsafePerformIO (hPrint hout v >> return (pure ())) go (pc + 1) ap fp mem + goHint :: Hint -> Address -> Address -> Address -> Memory s -> ST s FField + goHint hint pc ap fp mem = case hint of + HintInput var -> do + let val = + fromMaybe (throwRunError "invalid input") $ + HashMap.lookup var (inputInfo ^. inputInfoMap) + mem' <- writeMem mem ap val + go (pc + 1) (ap + 1) fp mem' + HintAlloc size -> do + mem' <- writeMem mem ap (fieldFromInteger fsize (fromIntegral ap + 1)) + go (pc + 1) (ap + size + 1) fp mem' + goFinish :: Address -> Memory s -> ST s FField goFinish ap mem = do checkGaps mem diff --git a/src/Juvix/Compiler/Casm/Language.hs b/src/Juvix/Compiler/Casm/Language.hs index 9f91faef4..fd4618f0a 100644 --- a/src/Juvix/Compiler/Casm/Language.hs +++ b/src/Juvix/Compiler/Casm/Language.hs @@ -74,6 +74,10 @@ data ExtraOpcode | -- | Sets the result to zero if arg1 < arg2, or to non-zero otherwise IntLt +data Hint + = HintInput Text + | HintAlloc Int + data Instruction = Assign InstrAssign | -- | Extra binary operation not directly available in Cairo Assembly bytecode, @@ -85,6 +89,7 @@ data Instruction | Return | Alloc InstrAlloc | Trace InstrTrace + | Hint Hint | Label LabelRef | Nop diff --git a/src/Juvix/Compiler/Casm/Pretty/Base.hs b/src/Juvix/Compiler/Casm/Pretty/Base.hs index 9dd35fdac..186970cb8 100644 --- a/src/Juvix/Compiler/Casm/Pretty/Base.hs +++ b/src/Juvix/Compiler/Casm/Pretty/Base.hs @@ -96,6 +96,11 @@ instance PrettyCode LoadValue where src' <- ppWithOffset _loadValueOff src return $ brackets src' +instance PrettyCode Hint where + ppCode = \case + HintInput var -> return $ "%{ Input(" <> pretty var <> ") %}" + HintAlloc size -> return $ "%{ Alloc(" <> show size <> ") %}" + instance PrettyCode InstrAssign where ppCode InstrAssign {..} = do v <- ppCode _instrAssignValue @@ -163,5 +168,6 @@ instance PrettyCode Instruction where Return -> return Str.ret Alloc x -> ppCode x Trace x -> ppCode x + Hint x -> ppCode x Label x -> (<> colon) <$> ppCode x Nop -> return Str.nop diff --git a/src/Juvix/Compiler/Casm/Translation/FromReg.hs b/src/Juvix/Compiler/Casm/Translation/FromReg.hs index ea7f13a8e..a1aad774c 100644 --- a/src/Juvix/Compiler/Casm/Translation/FromReg.hs +++ b/src/Juvix/Compiler/Casm/Translation/FromReg.hs @@ -18,7 +18,11 @@ import Juvix.Data.Field fromReg :: Reg.InfoTable -> Result fromReg tab = uncurry Result $ run $ runLabelInfoBuilderWithNextId (Reg.getNextSymbolId tab) $ do - let initialOffset :: Int = 2 + let mainSym = fromJust $ tab ^. Reg.infoMainFunction + mainInfo = fromJust (HashMap.lookup mainSym (tab ^. Reg.infoFunctions)) + mainName = mainInfo ^. Reg.functionName + mainArgs = getInputArgs (mainInfo ^. Reg.functionArgsNum) (mainInfo ^. Reg.functionArgNames) + initialOffset = length mainArgs + 2 (blts, binstrs) <- addStdlibBuiltins initialOffset let cinstrs = concatMap (mkFunCall . fst) $ sortOn snd $ HashMap.toList (info ^. Reg.extraInfoFUIDs) endSym <- freshSymbol @@ -28,15 +32,20 @@ fromReg tab = uncurry Result $ run $ runLabelInfoBuilderWithNextId (Reg.getNextS eassert (addr == length instrs + length cinstrs + length binstrs + initialOffset) registerLabelName endSym endName registerLabelAddress endSym addr - let mainSym = fromJust $ tab ^. Reg.infoMainFunction - mainName = fromJust (HashMap.lookup mainSym (tab ^. Reg.infoFunctions)) ^. Reg.functionName - callInstr = mkCallRel (Lab $ LabelRef mainSym (Just mainName)) + let callInstr = mkCallRel (Lab $ LabelRef mainSym (Just mainName)) jmpInstr = mkJumpRel (Val $ Lab endLab) - return $ callInstr : jmpInstr : binstrs ++ cinstrs ++ instrs ++ [Label endLab] + margs = reverse $ map (Hint . HintInput) mainArgs + return $ margs ++ callInstr : jmpInstr : binstrs ++ cinstrs ++ instrs ++ [Label endLab] where info :: Reg.ExtraInfo info = Reg.computeExtraInfo tab + getInputArgs :: Int -> [Maybe Text] -> [Text] + getInputArgs n argnames = zipWith fromMaybe args (argnames ++ repeat Nothing) + where + args :: [Text] + args = if n == 1 then ["in"] else map (\k -> "in" <> show k) [1 .. n] + mkFunCall :: Symbol -> [Instruction] mkFunCall sym = [ mkCallRel $ Lab $ LabelRef sym (Just $ quoteName $ Reg.lookupFunInfo tab sym ^. Reg.functionName), diff --git a/src/Juvix/Compiler/Casm/Translation/FromSource.hs b/src/Juvix/Compiler/Casm/Translation/FromSource.hs index 861fc6ba5..bc63630c8 100644 --- a/src/Juvix/Compiler/Casm/Translation/FromSource.hs +++ b/src/Juvix/Compiler/Casm/Translation/FromSource.hs @@ -68,7 +68,33 @@ label addr = P.try $ do instruction :: (Member LabelInfoBuilder r) => ParsecS r Instruction instruction = - parseNop <|> parseAlloc <|> parseJump <|> parseCall <|> parseReturn <|> parseTrace <|> parseAssign + parseHint + <|> parseNop + <|> parseAlloc + <|> parseJump + <|> parseCall + <|> parseReturn + <|> parseTrace + <|> parseAssign + +parseHint :: ParsecS r Instruction +parseHint = do + symbol "%{" + h <- parseHintInput <|> parseHintAlloc + symbol "%}" + return $ Hint h + +parseHintInput :: ParsecS r Hint +parseHintInput = do + symbol "Input" + var <- parens identifier + return $ HintInput var + +parseHintAlloc :: ParsecS r Hint +parseHintAlloc = do + symbol "Alloc" + (size, _) <- parens integer + return $ HintAlloc (fromInteger size) parseNop :: ParsecS r Instruction parseNop = do diff --git a/src/Juvix/Compiler/Casm/Validate.hs b/src/Juvix/Compiler/Casm/Validate.hs index d3d0535a8..69f36dc8e 100644 --- a/src/Juvix/Compiler/Casm/Validate.hs +++ b/src/Juvix/Compiler/Casm/Validate.hs @@ -19,6 +19,7 @@ validate labi instrs = mapM_ go instrs Return -> return () Alloc x -> goAlloc x Trace x -> goTrace x + Hint {} -> return () Label {} -> return () Nop -> return () diff --git a/src/Juvix/Compiler/Core/Extra/Base.hs b/src/Juvix/Compiler/Core/Extra/Base.hs index e9eb54abe..32277346c 100644 --- a/src/Juvix/Compiler/Core/Extra/Base.hs +++ b/src/Juvix/Compiler/Core/Extra/Base.hs @@ -249,6 +249,11 @@ isTypeInteger = \case NPrim (TypePrim _ (PrimInteger _)) -> True _ -> False +isTypeField :: Type -> Bool +isTypeField = \case + NPrim (TypePrim _ PrimField) -> True + _ -> False + isTypeBool :: Type -> Bool isTypeBool = \case NPrim (TypePrim _ (PrimBool _)) -> True diff --git a/src/Juvix/Compiler/Core/Transformation/Check/Cairo.hs b/src/Juvix/Compiler/Core/Transformation/Check/Cairo.hs index f449ce26d..03d708188 100644 --- a/src/Juvix/Compiler/Core/Transformation/Check/Cairo.hs +++ b/src/Juvix/Compiler/Core/Transformation/Check/Cairo.hs @@ -4,10 +4,32 @@ import Juvix.Compiler.Core.Error import Juvix.Compiler.Core.Extra import Juvix.Compiler.Core.Transformation.Base import Juvix.Compiler.Core.Transformation.Check.Base +import Juvix.Data.PPOutput checkCairo :: forall r. (Member (Error CoreError) r) => Module -> Sem r Module checkCairo md = do checkMainExists md + checkMainType checkNoAxioms md mapAllNodesM checkNoIO md mapAllNodesM (checkBuiltins' [OpStrConcat, OpStrToInt, OpShow] [PrimString]) md + where + checkMainType :: Sem r () + checkMainType = + unless (checkType (ii ^. identifierType)) $ + throw + CoreError + { _coreErrorMsg = ppOutput "for this target the arguments and the result of the `main` function must be numbers or field elements", + _coreErrorLoc = fromMaybe defaultLoc (ii ^. identifierLocation), + _coreErrorNode = Nothing + } + where + ii = lookupIdentifierInfo md (fromJust (getInfoMain md)) + + checkType :: Node -> Bool + checkType ty = + let (tyargs, tgt) = unfoldPi' ty + in all isPrimIntegerOrField (tgt : tyargs) + where + isPrimIntegerOrField ty' = + isTypeInteger ty' || isTypeField ty' || isDynamic ty' diff --git a/src/Juvix/Compiler/Tree/Translation/FromSource/Base.hs b/src/Juvix/Compiler/Tree/Translation/FromSource/Base.hs index a92cc9444..88e7cf8f5 100644 --- a/src/Juvix/Compiler/Tree/Translation/FromSource/Base.hs +++ b/src/Juvix/Compiler/Tree/Translation/FromSource/Base.hs @@ -142,8 +142,6 @@ statementFunction = do 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 @d ec <- lift $ emptyCode @t @e @d ee <- lift $ emptyExtra @t @e @d diff --git a/src/Juvix/Prelude/Aeson.hs b/src/Juvix/Prelude/Aeson.hs index d1d42f81e..d33959149 100644 --- a/src/Juvix/Prelude/Aeson.hs +++ b/src/Juvix/Prelude/Aeson.hs @@ -8,9 +8,15 @@ where import Data.Aeson import Data.Aeson.KeyMap qualified as KeyMap import Data.Aeson.Text +import Data.ByteString.Lazy qualified as BS import Data.Text.Lazy qualified as Lazy import Juvix.Prelude.Base +readJSONFile :: (FromJSON a) => FilePath -> IO (Maybe a) +readJSONFile f = do + bs <- BS.readFile f + return $ decode bs + encodeToText :: (ToJSON a) => a -> Text encodeToText = Lazy.toStrict . encodeToLazyText diff --git a/test/Casm/Compilation/Base.hs b/test/Casm/Compilation/Base.hs index 3d7814fbf..80b503b14 100644 --- a/test/Casm/Compilation/Base.hs +++ b/test/Casm/Compilation/Base.hs @@ -42,4 +42,4 @@ compileAssertionEntry adjustEntry root' bRunVM optLevel mainFile expectedFile st step "Pretty print" writeFileEnsureLn tmpFile (toPlainText $ ppProgram _resultCode) ) - casmRunAssertion' bRunVM _resultLabelInfo _resultCode expectedFile step + casmRunAssertion' bRunVM _resultLabelInfo _resultCode Nothing expectedFile step diff --git a/test/Casm/Reg/Base.hs b/test/Casm/Reg/Base.hs index 220569743..b4791afd1 100644 --- a/test/Casm/Reg/Base.hs +++ b/test/Casm/Reg/Base.hs @@ -4,25 +4,31 @@ import Base import Casm.Run.Base qualified as Run import Data.Aeson import Juvix.Compiler.Casm.Data.Result +import Juvix.Compiler.Casm.Error import Juvix.Compiler.Casm.Interpreter import Juvix.Compiler.Reg.Data.InfoTable qualified as Reg import Juvix.Data.PPOutput import Reg.Run.Base qualified as Reg -compileAssertion' :: Path Abs Dir -> Path Abs File -> Symbol -> Reg.InfoTable -> (String -> IO ()) -> Assertion -compileAssertion' _ outputFile _ tab step = do +compileAssertion' :: Maybe (Path Abs File) -> Path Abs Dir -> Path Abs File -> Symbol -> Reg.InfoTable -> (String -> IO ()) -> Assertion +compileAssertion' inputFile _ outputFile _ tab step = do step "Translate to CASM" case run $ runError @JuvixError $ regToCasm tab of Left err -> assertFailure (show (pretty (fromJuvixError @GenericError err))) Right Result {..} -> do step "Interpret" hout <- openFile (toFilePath outputFile) WriteMode - let v = hRunCode hout _resultLabelInfo _resultCode - hPrint hout v - hClose hout + rv <- Run.doRun hout _resultLabelInfo _resultCode inputFile + case rv of + Left e -> do + hClose hout + assertFailure (show (pretty (fromJuvixError @GenericError (JuvixError @CasmError e)))) + Right v -> do + hPrint hout v + hClose hout -cairoAssertion' :: Path Abs Dir -> Path Abs File -> Symbol -> Reg.InfoTable -> (String -> IO ()) -> Assertion -cairoAssertion' dirPath outputFile _ tab step = do +cairoAssertion' :: Maybe (Path Abs File) -> Path Abs Dir -> Path Abs File -> Symbol -> Reg.InfoTable -> (String -> IO ()) -> Assertion +cairoAssertion' inputFile dirPath outputFile _ tab step = do step "Translate to Cairo" case run $ runError @JuvixError $ regToCairo tab of Left err -> assertFailure (show (pretty (fromJuvixError @GenericError err))) @@ -30,13 +36,13 @@ cairoAssertion' dirPath outputFile _ tab step = do step "Serialize to Cairo bytecode" encodeFile (toFilePath outputFile) res step "Execute in Cairo VM" - actualOutput <- Run.casmRunVM' dirPath outputFile + actualOutput <- Run.casmRunVM' dirPath outputFile inputFile writeFileEnsureLn outputFile actualOutput -regToCasmAssertion :: Path Abs File -> Path Abs File -> (String -> IO ()) -> Assertion -regToCasmAssertion mainFile expectedFile step = - Reg.regRunAssertionParam compileAssertion' mainFile expectedFile [] (const (return ())) step +regToCasmAssertion :: Path Abs File -> Maybe (Path Abs File) -> Path Abs File -> (String -> IO ()) -> Assertion +regToCasmAssertion mainFile inputFile expectedFile step = + Reg.regRunAssertionParam (compileAssertion' inputFile) mainFile expectedFile [] (const (return ())) step -regToCairoAssertion :: Path Abs File -> Path Abs File -> (String -> IO ()) -> Assertion -regToCairoAssertion mainFile expectedFile step = - Reg.regRunAssertionParam cairoAssertion' mainFile expectedFile [] (const (return ())) step +regToCairoAssertion :: Path Abs File -> Maybe (Path Abs File) -> Path Abs File -> (String -> IO ()) -> Assertion +regToCairoAssertion mainFile inputFile expectedFile step = + Reg.regRunAssertionParam (cairoAssertion' inputFile) mainFile expectedFile [] (const (return ())) step diff --git a/test/Casm/Reg/Cairo.hs b/test/Casm/Reg/Cairo.hs index 53035f466..31e363933 100644 --- a/test/Casm/Reg/Cairo.hs +++ b/test/Casm/Reg/Cairo.hs @@ -9,10 +9,11 @@ testDescr P.PosTest {..} = let tRoot = P.root _relDir file' = tRoot _file expected' = tRoot _expectedFile + input' = fmap (tRoot ) _inputFile in TestDescr { _testName = _name, _testRoot = tRoot, - _testAssertion = Steps $ regToCairoAssertion file' expected' + _testAssertion = Steps $ regToCairoAssertion file' input' expected' } allTests :: TestTree diff --git a/test/Casm/Reg/Positive.hs b/test/Casm/Reg/Positive.hs index 670f59c25..34cb5981b 100644 --- a/test/Casm/Reg/Positive.hs +++ b/test/Casm/Reg/Positive.hs @@ -7,7 +7,8 @@ data PosTest = PosTest { _name :: String, _relDir :: Path Rel Dir, _file :: Path Rel File, - _expectedFile :: Path Rel File + _expectedFile :: Path Rel File, + _inputFile :: Maybe (Path Rel File) } root :: Path Abs Dir @@ -18,10 +19,11 @@ testDescr PosTest {..} = let tRoot = root _relDir file' = tRoot _file expected' = tRoot _expectedFile + input' = fmap (tRoot ) _inputFile in TestDescr { _testName = _name, _testRoot = tRoot, - _testAssertion = Steps $ regToCasmAssertion file' expected' + _testAssertion = Steps $ regToCasmAssertion file' input' expected' } filterOutTests :: [String] -> [PosTest] -> [PosTest] @@ -39,150 +41,186 @@ tests = "Test001: Arithmetic opcodes" $(mkRelDir ".") $(mkRelFile "test001.jvr") - $(mkRelFile "out/test001.out"), + $(mkRelFile "out/test001.out") + Nothing, PosTest "Test002: Direct call" $(mkRelDir ".") $(mkRelFile "test002.jvr") - $(mkRelFile "out/test002.out"), + $(mkRelFile "out/test002.out") + Nothing, PosTest "Test003: Indirect call" $(mkRelDir ".") $(mkRelFile "test003.jvr") - $(mkRelFile "out/test003.out"), + $(mkRelFile "out/test003.out") + Nothing, PosTest "Test004: Tail calls" $(mkRelDir ".") $(mkRelFile "test004.jvr") - $(mkRelFile "out/test004.out"), + $(mkRelFile "out/test004.out") + Nothing, PosTest "Test008: Branch" $(mkRelDir ".") $(mkRelFile "test008.jvr") - $(mkRelFile "out/test008.out"), + $(mkRelFile "out/test008.out") + Nothing, PosTest "Test009: Case" $(mkRelDir ".") $(mkRelFile "test009.jvr") - $(mkRelFile "out/test009.out"), + $(mkRelFile "out/test009.out") + Nothing, PosTest "Test010: Recursion" $(mkRelDir ".") $(mkRelFile "test010.jvr") - $(mkRelFile "out/test010.out"), + $(mkRelFile "out/test010.out") + Nothing, PosTest "Test011: Tail recursion" $(mkRelDir ".") $(mkRelFile "test011.jvr") - $(mkRelFile "out/test011.out"), + $(mkRelFile "out/test011.out") + Nothing, PosTest "Test012: Temporary stack" $(mkRelDir ".") $(mkRelFile "test012.jvr") - $(mkRelFile "out/test012.out"), + $(mkRelFile "out/test012.out") + Nothing, PosTest "Test013: Fibonacci numbers in linear time" $(mkRelDir ".") $(mkRelFile "test013.jvr") - $(mkRelFile "out/test013.out"), + $(mkRelFile "out/test013.out") + Nothing, PosTest "Test014: Trees" $(mkRelDir ".") $(mkRelFile "test014.jvr") - $(mkRelFile "out/test014.out"), + $(mkRelFile "out/test014.out") + Nothing, PosTest "Test015: Functions returning functions" $(mkRelDir ".") $(mkRelFile "test015.jvr") - $(mkRelFile "out/test015.out"), + $(mkRelFile "out/test015.out") + Nothing, PosTest "Test016: Arithmetic" $(mkRelDir ".") $(mkRelFile "test016.jvr") - $(mkRelFile "out/test016.out"), + $(mkRelFile "out/test016.out") + Nothing, PosTest "Test017: Closures as arguments" $(mkRelDir ".") $(mkRelFile "test017.jvr") - $(mkRelFile "out/test017.out"), + $(mkRelFile "out/test017.out") + Nothing, PosTest "Test018: Closure extension" $(mkRelDir ".") $(mkRelFile "test018.jvr") - $(mkRelFile "out/test018.out"), + $(mkRelFile "out/test018.out") + Nothing, PosTest "Test019: Recursion through higher-order functions" $(mkRelDir ".") $(mkRelFile "test019.jvr") - $(mkRelFile "out/test019.out"), + $(mkRelFile "out/test019.out") + Nothing, PosTest "Test020: Tail recursion through higher-order functions" $(mkRelDir ".") $(mkRelFile "test020.jvr") - $(mkRelFile "out/test020.out"), + $(mkRelFile "out/test020.out") + Nothing, PosTest "Test021: Higher-order functions and recursion" $(mkRelDir ".") $(mkRelFile "test021.jvr") - $(mkRelFile "out/test021.out"), + $(mkRelFile "out/test021.out") + Nothing, PosTest "Test023: McCarthy's 91 function" $(mkRelDir ".") $(mkRelFile "test023.jvr") - $(mkRelFile "out/test023.out"), + $(mkRelFile "out/test023.out") + Nothing, PosTest "Test024: Higher-order recursive functions" $(mkRelDir ".") $(mkRelFile "test024.jvr") - $(mkRelFile "out/test024.out"), + $(mkRelFile "out/test024.out") + Nothing, PosTest "Test026: Currying & uncurrying" $(mkRelDir ".") $(mkRelFile "test026.jvr") - $(mkRelFile "out/test026.out"), + $(mkRelFile "out/test026.out") + Nothing, PosTest "Test027: Fast exponentiation" $(mkRelDir ".") $(mkRelFile "test027.jvr") - $(mkRelFile "out/test027.out"), + $(mkRelFile "out/test027.out") + Nothing, PosTest "Test028: Lists" $(mkRelDir ".") $(mkRelFile "test028.jvr") - $(mkRelFile "out/test028.out"), + $(mkRelFile "out/test028.out") + Nothing, PosTest "Test030: Mutual recursion" $(mkRelDir ".") $(mkRelFile "test030.jvr") - $(mkRelFile "out/test030.out"), + $(mkRelFile "out/test030.out") + Nothing, PosTest "Test031: Temporary stack with branching" $(mkRelDir ".") $(mkRelFile "test031.jvr") - $(mkRelFile "out/test031.out"), + $(mkRelFile "out/test031.out") + Nothing, PosTest "Test033: Ackermann function" $(mkRelDir ".") $(mkRelFile "test033.jvr") - $(mkRelFile "out/test033.out"), + $(mkRelFile "out/test033.out") + Nothing, PosTest "Test034: Higher-order function composition" $(mkRelDir ".") $(mkRelFile "test034.jvr") - $(mkRelFile "out/test034.out"), + $(mkRelFile "out/test034.out") + Nothing, PosTest "Test036: Streams without memoization" $(mkRelDir ".") $(mkRelFile "test036.jvr") - $(mkRelFile "out/test036.out"), + $(mkRelFile "out/test036.out") + Nothing, PosTest "Test038: Apply & argsnum" $(mkRelDir ".") $(mkRelFile "test038.jvr") - $(mkRelFile "out/test038.out"), + $(mkRelFile "out/test038.out") + Nothing, PosTest "Test039: Calls in a branch" $(mkRelDir ".") $(mkRelFile "test039.jvr") $(mkRelFile "out/test039.out") + Nothing, + PosTest + "Test040: Input" + $(mkRelDir ".") + $(mkRelFile "test040.jvr") + $(mkRelFile "out/test040.out") + (Just $(mkRelFile "in/test040.json")) ] diff --git a/test/Casm/Run/Base.hs b/test/Casm/Run/Base.hs index f815e9938..07a4ee866 100644 --- a/test/Casm/Run/Base.hs +++ b/test/Casm/Run/Base.hs @@ -4,6 +4,7 @@ import Base import Data.Aeson import Juvix.Compiler.Casm.Data.Result qualified as Casm import Juvix.Compiler.Casm.Error +import Juvix.Compiler.Casm.Extra.InputInfo import Juvix.Compiler.Casm.Interpreter import Juvix.Compiler.Casm.Translation.FromSource import Juvix.Compiler.Casm.Validate @@ -12,13 +13,13 @@ import Juvix.Data.PPOutput import Juvix.Parser.Error import Runtime.Base qualified as R -casmRunVM' :: Path Abs Dir -> Path Abs File -> IO Text -casmRunVM' dirPath outputFile = do - out0 <- R.readProcessCwd (toFilePath dirPath) "run_cairo_vm.sh" [toFilePath outputFile] "" - return $ fromString $ unlines $ drop 1 $ lines (fromText out0) +casmRunVM' :: Path Abs Dir -> Path Abs File -> Maybe (Path Abs File) -> IO Text +casmRunVM' dirPath outputFile inputFile = do + let args = maybe [] (\f -> ["--program_input", toFilePath f]) inputFile + R.readProcessCwd (toFilePath dirPath) "run_cairo_vm.sh" (toFilePath outputFile : args) "" -casmRunVM :: LabelInfo -> Code -> Path Abs File -> (String -> IO ()) -> Assertion -casmRunVM labi instrs expectedFile step = do +casmRunVM :: LabelInfo -> Code -> Maybe (Path Abs File) -> Path Abs File -> (String -> IO ()) -> Assertion +casmRunVM labi instrs inputFile expectedFile step = do step "Check run_cairo_vm.sh is on path" assertCmdExists $(mkRelFile "run_cairo_vm.sh") withTempDir' @@ -28,14 +29,14 @@ casmRunVM labi instrs expectedFile step = do outputFile = dirPath $(mkRelFile "out.json") encodeFile (toFilePath outputFile) res step "Run Cairo VM" - actualOutput <- casmRunVM' dirPath outputFile + actualOutput <- casmRunVM' dirPath outputFile inputFile step "Compare expected and actual program output" expected <- readFile expectedFile assertEqDiffText ("Check: RUN output = " <> toFilePath expectedFile) actualOutput expected ) -casmRunAssertion' :: Bool -> LabelInfo -> Code -> Path Abs File -> (String -> IO ()) -> Assertion -casmRunAssertion' bRunVM labi instrs expectedFile step = +casmRunAssertion' :: Bool -> LabelInfo -> Code -> Maybe (Path Abs File) -> Path Abs File -> (String -> IO ()) -> Assertion +casmRunAssertion' bRunVM labi instrs inputFile expectedFile step = case validate labi instrs of Left err -> do assertFailure (show (pretty err)) @@ -45,7 +46,7 @@ casmRunAssertion' bRunVM labi instrs expectedFile step = let outputFile = dirPath $(mkRelFile "out.out") step "Interpret" hout <- openFile (toFilePath outputFile) WriteMode - r' <- doRun hout labi instrs + r' <- doRun hout labi instrs inputFile case r' of Left err -> do hClose hout @@ -59,15 +60,15 @@ casmRunAssertion' bRunVM labi instrs expectedFile step = assertEqDiffText ("Check: RUN output = " <> toFilePath expectedFile) actualOutput expected ) when bRunVM $ - casmRunVM labi instrs expectedFile step + casmRunVM labi instrs inputFile expectedFile step -casmRunAssertion :: Bool -> Path Abs File -> Path Abs File -> (String -> IO ()) -> Assertion -casmRunAssertion bRunVM mainFile expectedFile step = do +casmRunAssertion :: Bool -> Path Abs File -> Maybe (Path Abs File) -> Path Abs File -> (String -> IO ()) -> Assertion +casmRunAssertion bRunVM mainFile inputFile expectedFile step = do step "Parse" r <- parseFile mainFile case r of Left err -> assertFailure (show (pretty err)) - Right (labi, instrs) -> casmRunAssertion' bRunVM labi instrs expectedFile step + Right (labi, instrs) -> casmRunAssertion' bRunVM labi instrs inputFile expectedFile step casmRunErrorAssertion :: Path Abs File -> (String -> IO ()) -> Assertion casmRunErrorAssertion mainFile step = do @@ -81,7 +82,7 @@ casmRunErrorAssertion mainFile step = do Left {} -> assertBool "" True Right () -> do step "Interpret" - r' <- doRun stderr labi instrs + r' <- doRun stderr labi instrs Nothing case r' of Left _ -> assertBool "" True Right _ -> assertFailure "no error" @@ -95,5 +96,8 @@ doRun :: Handle -> LabelInfo -> Code -> + Maybe (Path Abs File) -> IO (Either CasmError FField) -doRun hout labi instrs = catchRunErrorIO (hRunCode hout labi instrs) +doRun hout labi instrs inputFile = do + inputInfo <- readInputInfo inputFile + catchRunErrorIO (hRunCode hout inputInfo labi instrs) diff --git a/test/Casm/Run/Positive.hs b/test/Casm/Run/Positive.hs index e2cd16f2c..70ced320a 100644 --- a/test/Casm/Run/Positive.hs +++ b/test/Casm/Run/Positive.hs @@ -8,7 +8,8 @@ data PosTest = PosTest _runVM :: Bool, _relDir :: Path Rel Dir, _file :: Path Rel File, - _expectedFile :: Path Rel File + _expectedFile :: Path Rel File, + _inputFile :: Maybe (Path Rel File) } root :: Path Abs Dir @@ -19,10 +20,11 @@ testDescr PosTest {..} = let tRoot = root _relDir file' = tRoot _file expected' = tRoot _expectedFile + input' = fmap (tRoot ) _inputFile in TestDescr { _testName = _name, _testRoot = tRoot, - _testAssertion = Steps $ casmRunAssertion _runVM file' expected' + _testAssertion = Steps $ casmRunAssertion _runVM file' input' expected' } filterTests :: [String] -> [PosTest] -> [PosTest] @@ -41,83 +43,104 @@ tests = True $(mkRelDir ".") $(mkRelFile "test001.casm") - $(mkRelFile "out/test001.out"), + $(mkRelFile "out/test001.out") + Nothing, PosTest "Test002: Factorial" True $(mkRelDir ".") $(mkRelFile "test002.casm") - $(mkRelFile "out/test002.out"), + $(mkRelFile "out/test002.out") + Nothing, PosTest "Test003: Direct call" True $(mkRelDir ".") $(mkRelFile "test003.casm") - $(mkRelFile "out/test003.out"), + $(mkRelFile "out/test003.out") + Nothing, PosTest "Test004: Indirect call" True $(mkRelDir ".") $(mkRelFile "test004.casm") - $(mkRelFile "out/test004.out"), + $(mkRelFile "out/test004.out") + Nothing, PosTest "Test005: Exp function" True $(mkRelDir ".") $(mkRelFile "test005.casm") - $(mkRelFile "out/test005.out"), + $(mkRelFile "out/test005.out") + Nothing, PosTest "Test006: Branch" True $(mkRelDir ".") $(mkRelFile "test006.casm") - $(mkRelFile "out/test006.out"), + $(mkRelFile "out/test006.out") + Nothing, PosTest "Test007: Closure extension" True $(mkRelDir ".") $(mkRelFile "test007.casm") - $(mkRelFile "out/test007.out"), + $(mkRelFile "out/test007.out") + Nothing, PosTest "Test008: Integer arithmetic" False -- integer division not yet supported $(mkRelDir ".") $(mkRelFile "test008.casm") - $(mkRelFile "out/test008.out"), + $(mkRelFile "out/test008.out") + Nothing, PosTest "Test009: Recursion" True $(mkRelDir ".") $(mkRelFile "test009.casm") - $(mkRelFile "out/test009.out"), + $(mkRelFile "out/test009.out") + Nothing, PosTest "Test010: Functions returning functions" True $(mkRelDir ".") $(mkRelFile "test010.casm") - $(mkRelFile "out/test010.out"), + $(mkRelFile "out/test010.out") + Nothing, PosTest "Test011: Lists" True $(mkRelDir ".") $(mkRelFile "test011.casm") - $(mkRelFile "out/test011.out"), + $(mkRelFile "out/test011.out") + Nothing, PosTest "Test012: Recursion through higher-order functions" True $(mkRelDir ".") $(mkRelFile "test012.casm") - $(mkRelFile "out/test012.out"), + $(mkRelFile "out/test012.out") + Nothing, PosTest "Test013: Currying and uncurrying" True $(mkRelDir ".") $(mkRelFile "test013.casm") - $(mkRelFile "out/test013.out"), + $(mkRelFile "out/test013.out") + Nothing, PosTest "Test014: Field arithmetic" True $(mkRelDir ".") $(mkRelFile "test014.casm") $(mkRelFile "out/test014.out") + Nothing, + PosTest + "Test015: Input" + True + $(mkRelDir ".") + $(mkRelFile "test015.casm") + $(mkRelFile "out/test015.out") + (Just $(mkRelFile "in/test015.json")) ] diff --git a/tests/Casm/Reg/positive/in/test040.json b/tests/Casm/Reg/positive/in/test040.json new file mode 100644 index 000000000..3006739e4 --- /dev/null +++ b/tests/Casm/Reg/positive/in/test040.json @@ -0,0 +1,4 @@ +{ + "x": 12, + "y": 2 +} diff --git a/tests/Casm/Reg/positive/out/test040.out b/tests/Casm/Reg/positive/out/test040.out new file mode 100644 index 000000000..871727de1 --- /dev/null +++ b/tests/Casm/Reg/positive/out/test040.out @@ -0,0 +1 @@ +84 diff --git a/tests/Casm/Reg/positive/test040.jvr b/tests/Casm/Reg/positive/test040.jvr new file mode 100644 index 000000000..82ed00219 --- /dev/null +++ b/tests/Casm/Reg/positive/test040.jvr @@ -0,0 +1,23 @@ +-- input + +function sum(field) : field { + tmp[0] = eq arg[0] 0; + br tmp[0] { + true: { + ret 0; + }; + false: { + tmp[1] = fsub arg[0] 1; + tmp[2] = call sum (tmp[1]); + tmp[3] = fadd tmp[2] arg[0]; + ret tmp[3]; + }; + }; +} + +function main(x : field, y : field) : field { + tmp[0] = fdiv arg[0] arg[1]; + tmp[1] = call sum (arg[0]); + tmp[2] = fadd tmp[0] tmp[1]; + ret tmp[2]; +} diff --git a/tests/Casm/positive/in/test015.json b/tests/Casm/positive/in/test015.json new file mode 100644 index 000000000..8f2a9b98f --- /dev/null +++ b/tests/Casm/positive/in/test015.json @@ -0,0 +1,4 @@ +{ + "X": 7, + "Y": 983 +} diff --git a/tests/Casm/positive/out/test015.out b/tests/Casm/positive/out/test015.out new file mode 100644 index 000000000..9ab4b905e --- /dev/null +++ b/tests/Casm/positive/out/test015.out @@ -0,0 +1 @@ +990 diff --git a/tests/Casm/positive/test015.casm b/tests/Casm/positive/test015.casm new file mode 100644 index 000000000..8fa3eaf0f --- /dev/null +++ b/tests/Casm/positive/test015.casm @@ -0,0 +1,5 @@ +-- input hints + +%{ Input(X) %} +%{ Input(Y) %} +[ap] = [ap - 1] + [ap - 2]; ap++