1
1
mirror of https://github.com/anoma/juvix.git synced 2024-08-16 03:30:37 +03:00

Support Cairo VM input hints (#2709)

* Closes #2687 
* Adds hint support in CASM. The supported hints are `Input(var)` and
`Alloc(size)`. These are the hints currently implemented in
[juvix-cairo-vm](https://github.com/anoma/juvix-cairo-vm).
* Adds the `--program_input` option to the `juvix dev casm run` command.
* Enables private inputs via `main` arguments. In generated CASM/Cairo
code, the arguments to `main` are fetched using the `Input` hint.
* Modifies the CI to use
[juvix-cairo-vm](https://github.com/anoma/juvix-cairo-vm)
This commit is contained in:
Łukasz Czajka 2024-04-09 11:43:57 +02:00 committed by GitHub
parent 279db701c1
commit 651875ec89
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
34 changed files with 428 additions and 107 deletions

View File

@ -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: |

View File

@ -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

View File

@ -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 {..}

View File

@ -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 <-

View File

@ -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.*

View File

@ -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

View File

@ -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 []
]
]

View File

@ -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 {..} =

View File

@ -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

View File

@ -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)]

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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),

View File

@ -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

View File

@ -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 ()

View File

@ -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

View File

@ -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'

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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"))
]

View File

@ -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)

View File

@ -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"))
]

View File

@ -0,0 +1,4 @@
{
"x": 12,
"y": 2
}

View File

@ -0,0 +1 @@
84

View File

@ -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];
}

View File

@ -0,0 +1,4 @@
{
"X": 7,
"Y": 983
}

View File

@ -0,0 +1 @@
990

View File

@ -0,0 +1,5 @@
-- input hints
%{ Input(X) %}
%{ Input(Y) %}
[ap] = [ap - 1] + [ap - 2]; ap++