mirror of
https://github.com/anoma/juvix.git
synced 2024-09-11 08:15:41 +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:
parent
279db701c1
commit
651875ec89
24
.github/workflows/ci.yml
vendored
24
.github/workflows/ci.yml
vendored
@ -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: |
|
||||
|
@ -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
|
||||
|
@ -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 {..}
|
||||
|
@ -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 <-
|
||||
|
@ -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.*
|
||||
|
@ -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
|
||||
|
@ -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 []
|
||||
]
|
||||
]
|
||||
|
@ -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 {..} =
|
||||
|
@ -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
|
||||
|
@ -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)]
|
||||
|
38
src/Juvix/Compiler/Casm/Data/InputInfo.hs
Normal file
38
src/Juvix/Compiler/Casm/Data/InputInfo.hs
Normal 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
|
12
src/Juvix/Compiler/Casm/Extra/InputInfo.hs
Normal file
12
src/Juvix/Compiler/Casm/Extra/InputInfo.hs
Normal 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
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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),
|
||||
|
@ -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
|
||||
|
@ -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 ()
|
||||
|
||||
|
@ -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
|
||||
|
@ -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'
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
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
|
||||
|
@ -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
|
||||
|
@ -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"))
|
||||
]
|
||||
|
@ -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)
|
||||
|
@ -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"))
|
||||
]
|
||||
|
4
tests/Casm/Reg/positive/in/test040.json
Normal file
4
tests/Casm/Reg/positive/in/test040.json
Normal file
@ -0,0 +1,4 @@
|
||||
{
|
||||
"x": 12,
|
||||
"y": 2
|
||||
}
|
1
tests/Casm/Reg/positive/out/test040.out
Normal file
1
tests/Casm/Reg/positive/out/test040.out
Normal file
@ -0,0 +1 @@
|
||||
84
|
23
tests/Casm/Reg/positive/test040.jvr
Normal file
23
tests/Casm/Reg/positive/test040.jvr
Normal 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];
|
||||
}
|
4
tests/Casm/positive/in/test015.json
Normal file
4
tests/Casm/positive/in/test015.json
Normal file
@ -0,0 +1,4 @@
|
||||
{
|
||||
"X": 7,
|
||||
"Y": 983
|
||||
}
|
1
tests/Casm/positive/out/test015.out
Normal file
1
tests/Casm/positive/out/test015.out
Normal file
@ -0,0 +1 @@
|
||||
990
|
5
tests/Casm/positive/test015.casm
Normal file
5
tests/Casm/positive/test015.casm
Normal file
@ -0,0 +1,5 @@
|
||||
-- input hints
|
||||
|
||||
%{ Input(X) %}
|
||||
%{ Input(Y) %}
|
||||
[ap] = [ap - 1] + [ap - 2]; ap++
|
Loading…
Reference in New Issue
Block a user