mirror of
https://github.com/anoma/juvix.git
synced 2024-09-11 08:15:41 +03:00
Fix memory access order in the JuvixReg to CASM translation. (#2697)
Cairo VM imposes restrictions on memory access order stricter than described in the documentation, which necessitates changing the compilation concept for local variables. Summary ------------- To ensure that memory is accessed sequentially at all times, we divide instructions into basic blocks. Within each basic block, the `ap` offset (i.e. how much `ap` increased since the beginning of the block) is known at each instruction, which allows to statically associate `fp` offsets to local variables while still generating only sequential assignments to `[ap]` with increasing `ap`. When the `ap` offset can no longer be statically determined for new local variables (e.g. due to an intervening recursive call), we switch to the next basic block by calling it with the `call` instruction. The arguments of the basic block call are the variables live at the beginning of the called block. Note that the `fp` offsets of "old" variables are still statically determined even after the current `ap` offset becomes unknown -- the arbitrary increase of `ap` does not influence the previous variable associations. Hence, we can transfer the needed local variables to the next basic block. Example ----------- The JuvixReg function ``` function f(integer) : integer { tmp[0] = add arg[0] 1; tmp[1] = call g(tmp[0]); tmp[2] = add tmp[1] arg[0]; tmp[3] = mul tmp[2] 2; tmp[4] = call g(tmp[2]); tmp[5] = add tmp[4] tmp[3]; ret tmp[5]; } ``` is compiled to ``` f: -- code for basic block 1 [ap] = [fp - 3] + 1; ap++ -- now [fp] is tmp[0], because fp = ap at function start (ap offset is zero) -- transfer call argument (in this case, could be optimized away) [ap] = [fp]; ap++ call g -- now [ap - 1] contains the result tmp[1] (it is already a call argument now) -- we additionally transfer arg[0] which is live in the next block [ap] = [fp - 3]; ap++ call rel 3 ret nop -- code for basic block 2 -- the above "call rel" jumps here -- [fp - 4] is tmp[1] -- [fp - 3] is arg[0] [ap] = [fp - 4] + [fp - 3]; ap++ -- now [fp] is tmp[2] [ap] = [fp] * 2; ap++ -- now [fp + 1] is tmp[3] [ap] = [fp]; ap++ call g -- now [ap - 1] is tmp[4] [ap] = [fp + 1]; ap++ call rel 3 ret nop -- code for basic block 3 -- [fp - 4] is tmp[4] -- [fp - 3] is tmp[3] [ap] = [fp - 4] + [fp - 3]; ap++ -- now [fp] is tmp[5] -- the next assignment could be optimized away in this case [ap] = [fp]; ap++ ret ``` There are three basic blocks separated by the `call` instructions. In each basic block, we know statically the `ap` offset at each instruction (i.e. how much `ap` increased since the beginning of the block). We can therefore associate the temporary variables with `[fp + k]` for appropriate `k`. At basic block boundaries we transfer live temporary variables as arguments for the call to the next basic block. Checklist ------------ - [x] Divide JuvixReg instructions into [basic blocks](https://en.wikipedia.org/wiki/Basic_block). - [x] Implement liveness analysis for each basic block. - [x] Translate transitions between basic blocks into CASM relative calls with local live variable transfer. - [x] Tests for the translation from JuvixReg to Cairo bytecode executed with the Cairo VM
This commit is contained in:
parent
7d559b1f18
commit
ee2f8aefbc
@ -27,11 +27,11 @@ function juvix_apply_3(*, *, *, *) : * {
|
||||
save[n](argsnum(arg[0])) {
|
||||
br(eq(3, n)) {
|
||||
true: call(arg[0], arg[1], arg[2], arg[3])
|
||||
false: br(lt(3, n)) {
|
||||
true: cextend(arg[0], arg[1], arg[2], arg[3])
|
||||
false: br(eq(2, n)) {
|
||||
true: call[juvix_apply_1](call(arg[0], arg[1], arg[2]), arg[3])
|
||||
false: call[juvix_apply_2](call(arg[0], arg[1]), arg[2], arg[3])
|
||||
false: br(eq(2, n)) {
|
||||
true: call[juvix_apply_1](call(arg[0], arg[1], arg[2]), arg[3])
|
||||
false: br(eq(1, n)) {
|
||||
true: call[juvix_apply_2](call(arg[0], arg[1]), arg[2], arg[3])
|
||||
false: cextend(arg[0], arg[1], arg[2], arg[3])
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -42,13 +42,13 @@ function juvix_apply_4(*, *, *, *, *) : * {
|
||||
save[n](argsnum(arg[0])) {
|
||||
br(eq(4, n)) {
|
||||
true: call(arg[0], arg[1], arg[2], arg[3], arg[4])
|
||||
false: br(lt(4, n)) {
|
||||
true: cextend(arg[0], arg[1], arg[2], arg[3], arg[4])
|
||||
false: br(eq(3, n)) {
|
||||
true: call[juvix_apply_1](call(arg[0], arg[1], arg[2], arg[3]), arg[4])
|
||||
false: br(eq(2, n)) {
|
||||
true: call[juvix_apply_2](call(arg[0], arg[1], arg[2]), arg[3], arg[4])
|
||||
false: call[juvix_apply_3](call(arg[0], arg[1]), arg[2], arg[3], arg[4])
|
||||
false: br(eq(3, n)) {
|
||||
true: call[juvix_apply_1](call(arg[0], arg[1], arg[2], arg[3]), arg[4])
|
||||
false: br(eq(2, n)) {
|
||||
true: call[juvix_apply_2](call(arg[0], arg[1], arg[2]), arg[3], arg[4])
|
||||
false: br(eq(1, n)) {
|
||||
true: call[juvix_apply_3](call(arg[0], arg[1]), arg[2], arg[3], arg[4])
|
||||
false: cextend(arg[0], arg[1], arg[2], arg[3], arg[4])
|
||||
}
|
||||
}
|
||||
}
|
||||
|
@ -1,6 +1,5 @@
|
||||
module Juvix.Compiler.Casm.Extra.Base where
|
||||
|
||||
import Juvix.Compiler.Casm.Data.Limits
|
||||
import Juvix.Compiler.Casm.Language
|
||||
|
||||
toOffset :: (Show a, Integral a) => a -> Offset
|
||||
@ -15,57 +14,6 @@ adjustAp idx mr@MemRef {..} = case _memRefReg of
|
||||
Ap -> MemRef Ap (_memRefOff - idx)
|
||||
Fp -> mr
|
||||
|
||||
mkExtraBinop :: ExtraOpcode -> MemRef -> MemRef -> Value -> Instruction
|
||||
mkExtraBinop op res arg1 arg2 =
|
||||
ExtraBinop
|
||||
InstrExtraBinop
|
||||
{ _instrExtraBinopOpcode = op,
|
||||
_instrExtraBinopResult = res,
|
||||
_instrExtraBinopArg1 = arg1,
|
||||
_instrExtraBinopArg2 = arg2,
|
||||
_instrExtraBinopIncAp = False
|
||||
}
|
||||
|
||||
mkNativeBinop :: Opcode -> MemRef -> MemRef -> Value -> Instruction
|
||||
mkNativeBinop op res arg1 arg2 =
|
||||
Assign
|
||||
InstrAssign
|
||||
{ _instrAssignResult = res,
|
||||
_instrAssignValue =
|
||||
Binop
|
||||
BinopValue
|
||||
{ _binopValueOpcode = op,
|
||||
_binopValueArg1 = arg1,
|
||||
_binopValueArg2 = arg2
|
||||
},
|
||||
_instrAssignIncAp = False
|
||||
}
|
||||
|
||||
mkEq :: MemRef -> MemRef -> Value -> Instruction
|
||||
mkEq res arg1 arg2 = mkExtraBinop FieldSub res arg1 arg2
|
||||
|
||||
mkIntLe :: MemRef -> MemRef -> Value -> [Instruction]
|
||||
mkIntLe res arg1 arg2 = case arg2 of
|
||||
Imm v ->
|
||||
[mkExtraBinop IntLt res arg1 (Imm (v + 1))]
|
||||
Ref mref ->
|
||||
[inc, mkExtraBinop IntLt res (adjustAp 1 arg1) (Ref $ MemRef Ap (-1))]
|
||||
where
|
||||
inc =
|
||||
Assign
|
||||
InstrAssign
|
||||
{ _instrAssignResult = MemRef Ap 0,
|
||||
_instrAssignValue =
|
||||
Binop
|
||||
BinopValue
|
||||
{ _binopValueArg1 = mref,
|
||||
_binopValueArg2 = Imm 1,
|
||||
_binopValueOpcode = FieldAdd
|
||||
},
|
||||
_instrAssignIncAp = True
|
||||
}
|
||||
Lab {} -> impossible
|
||||
|
||||
mkAssign :: MemRef -> RValue -> Instruction
|
||||
mkAssign mr rv =
|
||||
Assign
|
||||
@ -84,13 +32,6 @@ mkAssignAp v =
|
||||
_instrAssignIncAp = True
|
||||
}
|
||||
|
||||
mkOpArgsNum :: MemRef -> MemRef -> [Instruction]
|
||||
mkOpArgsNum res v =
|
||||
[ mkAssignAp (Val $ Imm $ fromIntegral casmMaxFunctionArgs + 1),
|
||||
mkAssignAp (Load $ LoadValue (adjustAp 1 v) casmClosureArgsNumOffset),
|
||||
mkExtraBinop FieldSub res (MemRef Ap (-2)) (Ref $ MemRef Ap (-1))
|
||||
]
|
||||
|
||||
mkCallRel :: Value -> Instruction
|
||||
mkCallRel tgt = Call (InstrCall tgt True)
|
||||
|
||||
|
@ -2,16 +2,16 @@ module Juvix.Compiler.Casm.Translation.FromReg where
|
||||
|
||||
import Data.HashMap.Strict qualified as HashMap
|
||||
import Data.HashSet qualified as HashSet
|
||||
import Juvix.Compiler.Backend
|
||||
import Juvix.Compiler.Casm.Data.LabelInfoBuilder
|
||||
import Juvix.Compiler.Casm.Data.Limits
|
||||
import Juvix.Compiler.Casm.Data.Result
|
||||
import Juvix.Compiler.Casm.Extra.Base
|
||||
import Juvix.Compiler.Casm.Extra.Stdlib
|
||||
import Juvix.Compiler.Casm.Language
|
||||
import Juvix.Compiler.Reg.Data.InfoTable qualified as Reg
|
||||
import Juvix.Compiler.Reg.Extra.Info qualified as Reg
|
||||
import Juvix.Compiler.Reg.Language qualified as Reg
|
||||
import Juvix.Compiler.Casm.Translation.FromReg.CasmBuilder
|
||||
import Juvix.Compiler.Reg.Data.Blocks.InfoTable qualified as Reg
|
||||
import Juvix.Compiler.Reg.Extra.Blocks.Info qualified as Reg
|
||||
import Juvix.Compiler.Reg.Language.Blocks qualified as Reg
|
||||
import Juvix.Compiler.Tree.Evaluator.Builtins qualified as Reg
|
||||
import Juvix.Data.Field
|
||||
|
||||
@ -34,7 +34,7 @@ fromReg tab = uncurry Result $ run $ runLabelInfoBuilderWithNextId (Reg.getNextS
|
||||
return $ callInstr : jmpInstr : binstrs ++ cinstrs ++ instrs ++ [Label endLab]
|
||||
where
|
||||
info :: Reg.ExtraInfo
|
||||
info = Reg.computeExtraInfo (getLimits TargetCairo False) tab
|
||||
info = Reg.computeExtraInfo tab
|
||||
|
||||
mkFunCall :: Symbol -> [Instruction]
|
||||
mkFunCall sym =
|
||||
@ -47,6 +47,9 @@ fromReg tab = uncurry Result $ run $ runLabelInfoBuilderWithNextId (Reg.getNextS
|
||||
getTagId tag =
|
||||
1 + 2 * fromJust (HashMap.lookup tag (info ^. Reg.extraInfoCIDs))
|
||||
|
||||
unsupported :: Text -> a
|
||||
unsupported what = error ("Cairo backend: unsupported: " <> what)
|
||||
|
||||
goFun :: forall r. (Member LabelInfoBuilder r) => StdlibBuiltins -> LabelRef -> (Address, [[Instruction]]) -> Reg.FunctionInfo -> Sem r (Address, [[Instruction]])
|
||||
goFun blts failLab (addr0, acc) funInfo = do
|
||||
let sym = funInfo ^. Reg.functionSymbol
|
||||
@ -54,49 +57,88 @@ fromReg tab = uncurry Result $ run $ runLabelInfoBuilderWithNextId (Reg.getNextS
|
||||
registerLabelName sym funName
|
||||
registerLabelAddress sym addr0
|
||||
let lab = Label $ LabelRef sym (Just funName)
|
||||
code = funInfo ^. Reg.functionCode
|
||||
n = fromJust $ HashMap.lookup (funInfo ^. Reg.functionSymbol) (info ^. Reg.extraInfoLocalVarsNum)
|
||||
i1 = Alloc $ InstrAlloc $ Val $ Imm $ fromIntegral n
|
||||
pre = [lab, i1]
|
||||
block = funInfo ^. Reg.functionCode
|
||||
pre = [lab]
|
||||
addr1 = addr0 + length pre
|
||||
instrs <- goCode addr1 code
|
||||
n = funInfo ^. Reg.functionArgsNum
|
||||
let vars =
|
||||
HashMap.fromList $
|
||||
map (\k -> (Reg.VarRef Reg.VarGroupArgs k Nothing, -3 - k)) [0 .. n - 1]
|
||||
instrs <-
|
||||
fmap fst
|
||||
. runCasmBuilder addr1 vars
|
||||
. runOutputList
|
||||
$ goBlock blts failLab mempty Nothing block
|
||||
return (addr1 + length instrs, (pre ++ instrs) : acc)
|
||||
|
||||
-- To ensure that memory is accessed sequentially at all times, we divide
|
||||
-- instructions into basic blocks. Within each basic block, the `ap` offset
|
||||
-- is known at each instruction, which allows to statically associate `fp`
|
||||
-- offsets to variables while still generating only sequential assignments
|
||||
-- to `[ap]` with increasing `ap`. When the `ap` offset can no longer be
|
||||
-- statically determined for new variables (e.g. due to an intervening
|
||||
-- recursive call), we switch to the next basic block by "calling" it with
|
||||
-- the `call` instruction (see `goCallBlock`). The arguments of the basic
|
||||
-- block call are the variables live at the beginning of the block. Note
|
||||
-- that the `fp` offsets of "old" variables are still statically determined
|
||||
-- even after the current `ap` offset becomes unknown -- the arbitrary
|
||||
-- increase of `ap` does not influence the previous variable associations.
|
||||
goBlock :: forall r. (Members '[LabelInfoBuilder, CasmBuilder, Output Instruction] r) => StdlibBuiltins -> LabelRef -> HashSet Reg.VarRef -> Maybe Reg.VarRef -> Reg.Block -> Sem r ()
|
||||
goBlock blts failLab liveVars0 mout Reg.Block {..} = do
|
||||
mapM_ goInstr _blockBody
|
||||
case _blockNext of
|
||||
Just block' -> do
|
||||
eassert (isJust _blockFinal)
|
||||
goFinalInstr (block' ^. Reg.blockLiveVars) (fromJust _blockFinal)
|
||||
goBlock blts failLab liveVars0 mout block'
|
||||
Nothing -> case _blockFinal of
|
||||
Just instr ->
|
||||
goFinalInstr liveVars0 instr
|
||||
Nothing -> do
|
||||
eassert (isJust mout)
|
||||
eassert (HashSet.member (fromJust mout) liveVars0)
|
||||
goCallBlock Nothing liveVars0
|
||||
where
|
||||
unsupported :: Text -> a
|
||||
unsupported what = error ("Cairo backend: unsupported: " <> what)
|
||||
output'' :: Instruction -> Sem r ()
|
||||
output'' i = do
|
||||
output i
|
||||
incPC 1
|
||||
|
||||
goCode :: Address -> Reg.Code -> Sem r [Instruction]
|
||||
goCode addr code = concat . reverse . snd <$> foldM go' (addr, []) code
|
||||
where
|
||||
go' :: (Address, [[Instruction]]) -> Reg.Instruction -> Sem r (Address, [[Instruction]])
|
||||
go' (addr', acc') i = do
|
||||
is <- goInstr addr' i
|
||||
return (addr' + length is, is : acc')
|
||||
output' :: Int -> Instruction -> Sem r ()
|
||||
output' apOff i = do
|
||||
output'' i
|
||||
incAP apOff
|
||||
|
||||
goInstr :: Address -> Reg.Instruction -> Sem r [Instruction]
|
||||
goInstr addr = \case
|
||||
Reg.Binop x -> goBinop addr x
|
||||
Reg.Unop x -> goUnop addr x
|
||||
Reg.Assign x -> goAssign addr x
|
||||
Reg.Alloc x -> goAlloc addr x
|
||||
Reg.AllocClosure x -> goAllocClosure addr x
|
||||
Reg.ExtendClosure x -> goExtendClosure addr x
|
||||
Reg.Call x -> goCall addr x
|
||||
Reg.TailCall x -> goTailCall addr x
|
||||
Reg.CallClosures {} -> impossible
|
||||
Reg.TailCallClosures {} -> impossible
|
||||
Reg.Return x -> goReturn addr x
|
||||
Reg.Branch x -> goBranch addr x
|
||||
Reg.Case x -> goCase addr x
|
||||
Reg.Trace x -> goTrace addr x
|
||||
Reg.Dump -> unsupported "dump"
|
||||
Reg.Failure x -> goFail addr x
|
||||
Reg.Prealloc {} -> return []
|
||||
Reg.Nop -> return []
|
||||
Reg.Block x -> goBlock addr x
|
||||
goCallBlock :: Maybe Reg.VarRef -> HashSet Reg.VarRef -> Sem r ()
|
||||
goCallBlock outVar liveVars = do
|
||||
let liveVars' = toList (maybe liveVars (flip HashSet.delete liveVars) outVar)
|
||||
n = length liveVars'
|
||||
vars =
|
||||
HashMap.fromList $
|
||||
maybe [] (\var -> [(var, -3 - n)]) outVar
|
||||
++ zipWithExact (\var k -> (var, -3 - k)) liveVars' [0 .. n - 1]
|
||||
mapM_ (mkMemRef >=> goAssignAp . Val . Ref) (reverse liveVars')
|
||||
output'' (mkCallRel $ Imm 3)
|
||||
output'' Return
|
||||
-- we need the Nop instruction to ensure that the relative call offset
|
||||
-- (constant 3) in our CASM interpreter corresponds to the relative
|
||||
-- call offset in the Cairo binary representation
|
||||
output'' Nop
|
||||
setAP 0
|
||||
setVars vars
|
||||
|
||||
goConst :: Reg.Constant -> Integer
|
||||
goConst = \case
|
||||
goLocalBlock :: Int -> HashMap Reg.VarRef Int -> HashSet Reg.VarRef -> Maybe Reg.VarRef -> Reg.Block -> Sem r ()
|
||||
goLocalBlock ap0 vars liveVars mout' block = do
|
||||
setAP ap0
|
||||
setVars vars
|
||||
goBlock blts failLab liveVars mout' block
|
||||
|
||||
----------------------------------------------------------------------
|
||||
-- The mk* functions don't change the builder state, may only read it
|
||||
----------------------------------------------------------------------
|
||||
|
||||
mkConst :: Reg.Constant -> Integer
|
||||
mkConst = \case
|
||||
Reg.ConstInt x -> x
|
||||
Reg.ConstBool True -> 0
|
||||
Reg.ConstBool False -> 1
|
||||
@ -105,235 +147,323 @@ fromReg tab = uncurry Result $ run $ runLabelInfoBuilderWithNextId (Reg.getNextS
|
||||
Reg.ConstVoid -> 0
|
||||
Reg.ConstString {} -> unsupported "strings"
|
||||
|
||||
goConstrField :: Reg.ConstrField -> RValue
|
||||
goConstrField Reg.ConstrField {..} =
|
||||
Load $ LoadValue (goVarRef _constrFieldRef) (toOffset _constrFieldIndex + 1)
|
||||
mkLoad :: Reg.ConstrField -> Sem r RValue
|
||||
mkLoad Reg.ConstrField {..} = do
|
||||
v <- mkMemRef _constrFieldRef
|
||||
return $ Load $ LoadValue v (toOffset _constrFieldIndex + 1)
|
||||
|
||||
goVarRef :: Reg.VarRef -> MemRef
|
||||
goVarRef Reg.VarRef {..} = case _varRefGroup of
|
||||
Reg.VarGroupArgs ->
|
||||
MemRef Fp (-3 - toOffset _varRefIndex)
|
||||
Reg.VarGroupLocal ->
|
||||
MemRef Fp (toOffset _varRefIndex)
|
||||
mkMemRef :: Reg.VarRef -> Sem r MemRef
|
||||
mkMemRef vr = do
|
||||
v <- lookupVar' vr
|
||||
return $ MemRef Fp (toOffset v)
|
||||
|
||||
goValue :: Reg.Value -> ([Instruction], Value)
|
||||
mkRValue :: Reg.Value -> Sem r RValue
|
||||
mkRValue = \case
|
||||
Reg.ValConst c -> return $ Val $ Imm $ mkConst c
|
||||
Reg.CRef x -> mkLoad x
|
||||
Reg.VRef x -> Val . Ref <$> mkMemRef x
|
||||
|
||||
---------------------------------------------------------------------
|
||||
-- Instruction
|
||||
---------------------------------------------------------------------
|
||||
|
||||
goInstr :: Reg.Instruction -> Sem r ()
|
||||
goInstr = \case
|
||||
Reg.Binop x -> goBinop x
|
||||
Reg.Unop x -> goUnop x
|
||||
Reg.Assign x -> goAssign x
|
||||
Reg.Alloc x -> goAlloc x
|
||||
Reg.AllocClosure x -> goAllocClosure x
|
||||
Reg.Trace x -> goTrace x
|
||||
Reg.Dump -> unsupported "dump"
|
||||
Reg.Failure x -> goFail x
|
||||
|
||||
goAssignVar :: Reg.VarRef -> RValue -> Sem r ()
|
||||
goAssignVar vr val = do
|
||||
off <- getAP
|
||||
insertVar vr off
|
||||
goAssignAp val
|
||||
|
||||
goAssignAp :: RValue -> Sem r ()
|
||||
goAssignAp val = do
|
||||
output' 1 (mkAssignAp val)
|
||||
|
||||
goAssignValue :: Reg.VarRef -> Reg.Value -> Sem r ()
|
||||
goAssignValue vr v = mkRValue v >>= goAssignVar vr
|
||||
|
||||
goAssignApValue :: Reg.Value -> Sem r ()
|
||||
goAssignApValue v = mkRValue v >>= goAssignAp
|
||||
|
||||
goValue :: Reg.Value -> Sem r Value
|
||||
goValue = \case
|
||||
Reg.ValConst c -> ([], Imm $ goConst c)
|
||||
Reg.CRef x -> ([mkAssignAp (goConstrField x)], Ref $ MemRef Ap (-1))
|
||||
Reg.VRef x -> ([], Ref $ goVarRef x)
|
||||
Reg.ValConst c -> return $ Imm $ mkConst c
|
||||
Reg.CRef x -> do
|
||||
v <- mkLoad x
|
||||
goAssignAp v
|
||||
return $ Ref $ MemRef Ap (-1)
|
||||
Reg.VRef x -> do
|
||||
v <- Ref <$> mkMemRef x
|
||||
return v
|
||||
|
||||
goRValue :: Reg.Value -> RValue
|
||||
goRValue = \case
|
||||
Reg.ValConst c -> Val $ Imm $ goConst c
|
||||
Reg.CRef x -> goConstrField x
|
||||
Reg.VRef x -> Val $ Ref $ goVarRef x
|
||||
goExtraBinop :: ExtraOpcode -> Reg.VarRef -> MemRef -> Value -> Sem r ()
|
||||
goExtraBinop op res arg1 arg2 = do
|
||||
off <- getAP
|
||||
insertVar res off
|
||||
output' 1 $
|
||||
ExtraBinop
|
||||
InstrExtraBinop
|
||||
{ _instrExtraBinopOpcode = op,
|
||||
_instrExtraBinopResult = MemRef Ap 0,
|
||||
_instrExtraBinopArg1 = arg1,
|
||||
_instrExtraBinopArg2 = arg2,
|
||||
_instrExtraBinopIncAp = True
|
||||
}
|
||||
|
||||
goLoad :: Reg.Value -> Offset -> ([Instruction], RValue)
|
||||
goLoad v off = case goRValue v of
|
||||
Val (Ref r) -> ([], Load $ LoadValue r off)
|
||||
v' -> ([mkAssignAp v'], Load $ LoadValue (MemRef Ap (-1)) off)
|
||||
goNativeBinop :: Opcode -> Reg.VarRef -> MemRef -> Value -> Sem r ()
|
||||
goNativeBinop op res arg1 arg2 = goAssignVar res binop
|
||||
where
|
||||
binop =
|
||||
Binop
|
||||
BinopValue
|
||||
{ _binopValueOpcode = op,
|
||||
_binopValueArg1 = arg1,
|
||||
_binopValueArg2 = arg2
|
||||
}
|
||||
|
||||
goAssignValue :: MemRef -> Reg.Value -> Instruction
|
||||
goAssignValue res = mkAssign res . goRValue
|
||||
goEq :: Reg.VarRef -> MemRef -> Value -> Sem r ()
|
||||
goEq res arg1 arg2 = goExtraBinop FieldSub res arg1 arg2
|
||||
|
||||
goAssignApValue :: Reg.Value -> Instruction
|
||||
goAssignApValue = mkAssignAp . goRValue
|
||||
goIntLe :: Reg.VarRef -> MemRef -> Value -> Sem r ()
|
||||
goIntLe res arg1 arg2 = case arg2 of
|
||||
Imm v ->
|
||||
goExtraBinop IntLt res arg1 (Imm (v + 1))
|
||||
Ref mref -> do
|
||||
output' 1 inc
|
||||
goExtraBinop IntLt res (adjustAp 1 arg1) (Ref $ MemRef Ap (-1))
|
||||
where
|
||||
inc =
|
||||
Assign
|
||||
InstrAssign
|
||||
{ _instrAssignResult = MemRef Ap 0,
|
||||
_instrAssignValue =
|
||||
Binop
|
||||
BinopValue
|
||||
{ _binopValueArg1 = mref,
|
||||
_binopValueArg2 = Imm 1,
|
||||
_binopValueOpcode = FieldAdd
|
||||
},
|
||||
_instrAssignIncAp = True
|
||||
}
|
||||
Lab {} -> impossible
|
||||
|
||||
mkBinop :: Reg.BinaryOp -> MemRef -> MemRef -> Value -> [Instruction]
|
||||
mkBinop op res arg1 arg2 = case op of
|
||||
goOpArgsNum :: Reg.VarRef -> MemRef -> Sem r ()
|
||||
goOpArgsNum res v = do
|
||||
goAssignAp (Val $ Imm $ fromIntegral casmMaxFunctionArgs + 1)
|
||||
goAssignAp (Load $ LoadValue (adjustAp 1 v) casmClosureArgsNumOffset)
|
||||
goExtraBinop FieldSub res (MemRef Ap (-2)) (Ref $ MemRef Ap (-1))
|
||||
|
||||
goBinop' :: Reg.BinaryOp -> Reg.VarRef -> MemRef -> Value -> Sem r ()
|
||||
goBinop' op res arg1 arg2 = case op of
|
||||
Reg.OpIntAdd ->
|
||||
[mkExtraBinop IntAdd res arg1 arg2]
|
||||
goExtraBinop IntAdd res arg1 arg2
|
||||
Reg.OpIntSub ->
|
||||
[mkExtraBinop IntSub res arg1 arg2]
|
||||
goExtraBinop IntSub res arg1 arg2
|
||||
Reg.OpIntMul ->
|
||||
[mkExtraBinop IntMul res arg1 arg2]
|
||||
goExtraBinop IntMul res arg1 arg2
|
||||
Reg.OpIntDiv ->
|
||||
[mkExtraBinop IntDiv res arg1 arg2]
|
||||
goExtraBinop IntDiv res arg1 arg2
|
||||
Reg.OpIntMod ->
|
||||
[mkExtraBinop IntMod res arg1 arg2]
|
||||
goExtraBinop IntMod res arg1 arg2
|
||||
Reg.OpIntLt ->
|
||||
[mkExtraBinop IntLt res arg1 arg2]
|
||||
goExtraBinop IntLt res arg1 arg2
|
||||
Reg.OpIntLe ->
|
||||
mkIntLe res arg1 arg2
|
||||
goIntLe res arg1 arg2
|
||||
Reg.OpFieldAdd ->
|
||||
[mkNativeBinop FieldAdd res arg1 arg2]
|
||||
goNativeBinop FieldAdd res arg1 arg2
|
||||
Reg.OpFieldSub ->
|
||||
[mkExtraBinop FieldSub res arg1 arg2]
|
||||
goExtraBinop FieldSub res arg1 arg2
|
||||
Reg.OpFieldMul ->
|
||||
[mkNativeBinop FieldMul res arg1 arg2]
|
||||
goNativeBinop FieldMul res arg1 arg2
|
||||
Reg.OpFieldDiv ->
|
||||
[mkExtraBinop FieldDiv res arg1 arg2]
|
||||
goExtraBinop FieldDiv res arg1 arg2
|
||||
Reg.OpEq ->
|
||||
[mkEq res arg1 arg2]
|
||||
goEq res arg1 arg2
|
||||
Reg.OpStrConcat ->
|
||||
unsupported "strings"
|
||||
|
||||
goBinop :: Address -> Reg.InstrBinop -> Sem r [Instruction]
|
||||
goBinop addr x@Reg.InstrBinop {..} = case _instrBinopArg1 of
|
||||
goBinop :: Reg.InstrBinop -> Sem r ()
|
||||
goBinop x@Reg.InstrBinop {..} = case _instrBinopArg1 of
|
||||
Reg.ValConst c1 -> case _instrBinopArg2 of
|
||||
Reg.ValConst c2 -> case Reg.evalBinop' _instrBinopOpcode c1 c2 of
|
||||
Left err -> error err
|
||||
Right c ->
|
||||
return [mkAssign res (Val $ Imm $ goConst c)]
|
||||
goAssignVar _instrBinopResult (Val $ Imm $ mkConst c)
|
||||
_ ->
|
||||
goBinop
|
||||
addr
|
||||
x
|
||||
{ Reg._instrBinopArg1 = _instrBinopArg2,
|
||||
Reg._instrBinopArg2 = _instrBinopArg1
|
||||
}
|
||||
Reg.CRef ctr1 ->
|
||||
Reg.CRef ctr1 -> do
|
||||
v1 <- mkLoad ctr1
|
||||
goAssignAp v1
|
||||
v2 <- goValue _instrBinopArg2
|
||||
case _instrBinopArg2 of
|
||||
Reg.CRef {} ->
|
||||
return $ i : is2 ++ mkBinop _instrBinopOpcode res (MemRef Ap (-2)) (Ref $ MemRef Ap (-1))
|
||||
Reg.CRef {} -> do
|
||||
goBinop' _instrBinopOpcode _instrBinopResult (MemRef Ap (-2)) v2
|
||||
_ -> do
|
||||
eassert (null is2)
|
||||
return $ i : mkBinop _instrBinopOpcode res (MemRef Ap (-1)) v2
|
||||
where
|
||||
i = mkAssignAp (goConstrField ctr1)
|
||||
Reg.VRef var1 ->
|
||||
return $ is2 ++ mkBinop _instrBinopOpcode res (goVarRef var1) v2
|
||||
where
|
||||
res = goVarRef _instrBinopResult
|
||||
(is2, v2) = goValue _instrBinopArg2
|
||||
goBinop' _instrBinopOpcode _instrBinopResult (MemRef Ap (-1)) v2
|
||||
Reg.VRef var1 -> do
|
||||
ref <- mkMemRef var1
|
||||
v2 <- goValue _instrBinopArg2
|
||||
goBinop' _instrBinopOpcode _instrBinopResult ref v2
|
||||
|
||||
goUnop :: Address -> Reg.InstrUnop -> Sem r [Instruction]
|
||||
goUnop _ Reg.InstrUnop {..} = case _instrUnopOpcode of
|
||||
goUnop :: Reg.InstrUnop -> Sem r ()
|
||||
goUnop Reg.InstrUnop {..} = case _instrUnopOpcode of
|
||||
Reg.OpShow -> unsupported "strings"
|
||||
Reg.OpStrToInt -> unsupported "strings"
|
||||
Reg.OpFieldToInt -> return [goAssignValue res _instrUnopArg]
|
||||
Reg.OpIntToField -> return [goAssignValue res _instrUnopArg]
|
||||
Reg.OpArgsNum -> case v of
|
||||
Ref mr ->
|
||||
return $ is ++ mkOpArgsNum res mr
|
||||
Imm {} -> impossible
|
||||
Lab {} -> impossible
|
||||
where
|
||||
res = goVarRef _instrUnopResult
|
||||
(is, v) = goValue _instrUnopArg
|
||||
Reg.OpFieldToInt -> goAssignValue _instrUnopResult _instrUnopArg
|
||||
Reg.OpIntToField -> goAssignValue _instrUnopResult _instrUnopArg
|
||||
Reg.OpArgsNum -> do
|
||||
v <- goValue _instrUnopArg
|
||||
case v of
|
||||
Ref mr -> do
|
||||
goOpArgsNum _instrUnopResult mr
|
||||
Imm {} -> impossible
|
||||
Lab {} -> impossible
|
||||
|
||||
goAssign :: Address -> Reg.InstrAssign -> Sem r [Instruction]
|
||||
goAssign _ Reg.InstrAssign {..} =
|
||||
return [goAssignValue res _instrAssignValue]
|
||||
where
|
||||
res = goVarRef _instrAssignResult
|
||||
goAssign :: Reg.InstrAssign -> Sem r ()
|
||||
goAssign Reg.InstrAssign {..} =
|
||||
goAssignValue _instrAssignResult _instrAssignValue
|
||||
|
||||
mkAllocCall :: MemRef -> [Instruction]
|
||||
mkAllocCall res =
|
||||
[ mkCallRel $ Lab $ LabelRef (blts ^. stdlibGetRegs) (Just (blts ^. stdlibGetRegsName)),
|
||||
mkNativeBinop FieldAdd res (MemRef Ap (-2)) (Imm 2)
|
||||
]
|
||||
goAllocCall :: Reg.VarRef -> Sem r ()
|
||||
goAllocCall res = do
|
||||
output' 4 $ mkCallRel $ Lab $ LabelRef (blts ^. stdlibGetRegs) (Just (blts ^. stdlibGetRegsName))
|
||||
goNativeBinop FieldAdd res (MemRef Ap (-2)) (Imm 3)
|
||||
|
||||
goAlloc :: Address -> Reg.InstrAlloc -> Sem r [Instruction]
|
||||
goAlloc _ Reg.InstrAlloc {..} =
|
||||
return $
|
||||
mkAllocCall res
|
||||
++ [ mkAssignAp (Val $ Imm $ fromIntegral tagId)
|
||||
]
|
||||
++ map goAssignApValue _instrAllocArgs
|
||||
goAlloc :: Reg.InstrAlloc -> Sem r ()
|
||||
goAlloc Reg.InstrAlloc {..} = do
|
||||
goAllocCall _instrAllocResult
|
||||
goAssignAp (Val $ Imm $ fromIntegral tagId)
|
||||
mapM_ goAssignApValue _instrAllocArgs
|
||||
where
|
||||
res = goVarRef _instrAllocResult
|
||||
tagId = getTagId _instrAllocTag
|
||||
|
||||
goAllocClosure :: Address -> Reg.InstrAllocClosure -> Sem r [Instruction]
|
||||
goAllocClosure _ Reg.InstrAllocClosure {..} =
|
||||
return $
|
||||
mkAllocCall res
|
||||
++ [ mkAssignAp (Val $ Imm $ fromIntegral $ 1 + 3 * fuid),
|
||||
mkAssignAp (Val $ Imm $ fromIntegral $ casmMaxFunctionArgs + 1 - storedArgsNum),
|
||||
mkAssignAp (Val $ Imm $ fromIntegral $ casmMaxFunctionArgs + 1 - leftArgsNum)
|
||||
]
|
||||
++ map goAssignApValue _instrAllocClosureArgs
|
||||
goAllocClosure :: Reg.InstrAllocClosure -> Sem r ()
|
||||
goAllocClosure Reg.InstrAllocClosure {..} = do
|
||||
goAllocCall _instrAllocClosureResult
|
||||
goAssignAp (Val $ Imm $ fromIntegral $ 1 + 3 * fuid)
|
||||
goAssignAp (Val $ Imm $ fromIntegral $ casmMaxFunctionArgs + 1 - storedArgsNum)
|
||||
goAssignAp (Val $ Imm $ fromIntegral $ casmMaxFunctionArgs + 1 - leftArgsNum)
|
||||
mapM_ goAssignApValue _instrAllocClosureArgs
|
||||
where
|
||||
res = goVarRef _instrAllocClosureResult
|
||||
fuid = fromJust $ HashMap.lookup _instrAllocClosureSymbol (info ^. Reg.extraInfoFUIDs)
|
||||
storedArgsNum = length _instrAllocClosureArgs
|
||||
leftArgsNum = _instrAllocClosureExpectedArgsNum - storedArgsNum
|
||||
|
||||
goExtendClosure :: Address -> Reg.InstrExtendClosure -> Sem r [Instruction]
|
||||
goExtendClosure _ Reg.InstrExtendClosure {..} =
|
||||
return $
|
||||
map goAssignApValue _instrExtendClosureArgs
|
||||
++ [ mkAssignAp (Val $ Imm $ fromIntegral $ length _instrExtendClosureArgs),
|
||||
mkAssignAp (Val $ Ref val),
|
||||
mkCallRel $ Lab $ LabelRef (blts ^. stdlibExtendClosure) (Just (blts ^. stdlibExtendClosureName)),
|
||||
mkAssign res (Val $ Ref $ MemRef Ap (-1))
|
||||
]
|
||||
where
|
||||
res = goVarRef _instrExtendClosureResult
|
||||
val = goVarRef _instrExtendClosureValue
|
||||
goTrace :: Reg.InstrTrace -> Sem r ()
|
||||
goTrace Reg.InstrTrace {..} = do
|
||||
v <- mkRValue _instrTraceValue
|
||||
output' 0 $ Trace (InstrTrace v)
|
||||
|
||||
goCall' :: Instruction -> Reg.CallType -> [Reg.Value] -> [Instruction]
|
||||
goCall' saveOrRet ct args = case ct of
|
||||
Reg.CallFun sym ->
|
||||
args'
|
||||
++ [ mkCallRel $ Lab $ LabelRef sym (Just funName),
|
||||
saveOrRet
|
||||
]
|
||||
goFail :: Reg.InstrFailure -> Sem r ()
|
||||
goFail Reg.InstrFailure {..} = do
|
||||
v <- mkRValue _instrFailureValue
|
||||
output' 0 $ Trace (InstrTrace v)
|
||||
output' 0 $ mkJumpRel (Val $ Lab failLab)
|
||||
|
||||
---------------------------------------------------------------------
|
||||
-- FinalInstruction
|
||||
---------------------------------------------------------------------
|
||||
|
||||
goFinalInstr :: HashSet Reg.VarRef -> Reg.FinalInstruction -> Sem r ()
|
||||
goFinalInstr liveVars = \case
|
||||
Reg.ExtendClosure x -> goExtendClosure liveVars x
|
||||
Reg.Call x -> goCall liveVars x
|
||||
Reg.TailCall x -> goTailCall x
|
||||
Reg.Return x -> goReturn x
|
||||
Reg.Branch x -> goBranch liveVars x
|
||||
Reg.Case x -> goCase liveVars x
|
||||
|
||||
goExtendClosure :: HashSet Reg.VarRef -> Reg.InstrExtendClosure -> Sem r ()
|
||||
goExtendClosure liveVars Reg.InstrExtendClosure {..} = do
|
||||
mapM_ goAssignApValue _instrExtendClosureArgs
|
||||
goAssignAp (Val $ Imm $ fromIntegral $ length _instrExtendClosureArgs)
|
||||
val <- mkMemRef _instrExtendClosureValue
|
||||
goAssignAp (Val $ Ref val)
|
||||
output'' $ mkCallRel $ Lab $ LabelRef (blts ^. stdlibExtendClosure) (Just (blts ^. stdlibExtendClosureName))
|
||||
goCallBlock (Just _instrExtendClosureResult) liveVars
|
||||
|
||||
goCall' :: Reg.CallType -> [Reg.Value] -> Sem r ()
|
||||
goCall' ct args = case ct of
|
||||
Reg.CallFun sym -> do
|
||||
mapM_ goAssignApValue (reverse args)
|
||||
output'' $ mkCallRel $ Lab $ LabelRef sym (Just funName)
|
||||
where
|
||||
funName = Reg.lookupFunInfo tab sym ^. Reg.functionName
|
||||
Reg.CallClosure cl ->
|
||||
args'
|
||||
++ [ mkAssignAp (Val $ Ref $ goVarRef cl),
|
||||
mkCallRel $ Lab $ LabelRef (blts ^. stdlibCallClosure) (Just (blts ^. stdlibCallClosureName)),
|
||||
saveOrRet
|
||||
]
|
||||
where
|
||||
args' = map goAssignApValue (reverse args)
|
||||
Reg.CallClosure cl -> do
|
||||
mapM_ goAssignApValue (reverse args)
|
||||
r <- mkMemRef cl
|
||||
goAssignAp (Val $ Ref r)
|
||||
output'' $ mkCallRel $ Lab $ LabelRef (blts ^. stdlibCallClosure) (Just (blts ^. stdlibCallClosureName))
|
||||
|
||||
goCall :: Address -> Reg.InstrCall -> Sem r [Instruction]
|
||||
goCall _ Reg.InstrCall {..} =
|
||||
return $
|
||||
goCall' (mkAssign res (Val $ Ref $ MemRef Ap (-1))) _instrCallType _instrCallArgs
|
||||
where
|
||||
res = goVarRef _instrCallResult
|
||||
goCall :: HashSet Reg.VarRef -> Reg.InstrCall -> Sem r ()
|
||||
goCall liveVars Reg.InstrCall {..} = do
|
||||
goCall' _instrCallType _instrCallArgs
|
||||
goCallBlock (Just _instrCallResult) liveVars
|
||||
|
||||
-- There is no way to make "proper" tail calls in Cairo, because
|
||||
-- the only way to set the `fp` register is via the `call` instruction.
|
||||
-- So we just translate tail calls into `call` followed by `ret`.
|
||||
goTailCall :: Address -> Reg.InstrTailCall -> Sem r [Instruction]
|
||||
goTailCall _ Reg.InstrTailCall {..} =
|
||||
return $
|
||||
goCall' Return _instrTailCallType _instrTailCallArgs
|
||||
goTailCall :: Reg.InstrTailCall -> Sem r ()
|
||||
goTailCall Reg.InstrTailCall {..} = do
|
||||
goCall' _instrTailCallType _instrTailCallArgs
|
||||
output'' Return
|
||||
|
||||
goReturn :: Address -> Reg.InstrReturn -> Sem r [Instruction]
|
||||
goReturn _ Reg.InstrReturn {..} =
|
||||
return $
|
||||
[ goAssignApValue _instrReturnValue,
|
||||
Return
|
||||
]
|
||||
goReturn :: Reg.InstrReturn -> Sem r ()
|
||||
goReturn Reg.InstrReturn {..} = do
|
||||
goAssignApValue _instrReturnValue
|
||||
output'' Return
|
||||
|
||||
goBranch :: Address -> Reg.InstrBranch -> Sem r [Instruction]
|
||||
goBranch addr Reg.InstrBranch {..} = case v of
|
||||
Imm c
|
||||
| c == 0 -> goCode addr _instrBranchTrue
|
||||
| otherwise -> goCode addr _instrBranchFalse
|
||||
Ref r -> do
|
||||
symFalse <- freshSymbol
|
||||
symEnd <- freshSymbol
|
||||
let labFalse = LabelRef symFalse Nothing
|
||||
labEnd = LabelRef symEnd Nothing
|
||||
addr1 = addr + length is + 1
|
||||
codeTrue <- goCode addr1 _instrBranchTrue
|
||||
let addr2 = addr1 + length codeTrue + 1
|
||||
registerLabelAddress symFalse addr2
|
||||
codeFalse <- goCode (addr2 + 1) _instrBranchFalse
|
||||
registerLabelAddress symEnd (addr2 + 1 + length codeFalse)
|
||||
return $
|
||||
is
|
||||
++ [mkJumpIf (Lab labFalse) r]
|
||||
++ codeTrue
|
||||
++ [ mkJumpRel (Val $ Lab labEnd),
|
||||
Label labFalse
|
||||
]
|
||||
++ codeFalse
|
||||
++ [Label labEnd]
|
||||
Lab {} -> impossible
|
||||
where
|
||||
(is, v) = goValue _instrBranchValue
|
||||
goBranch :: HashSet Reg.VarRef -> Reg.InstrBranch -> Sem r ()
|
||||
goBranch liveVars Reg.InstrBranch {..} = do
|
||||
v <- goValue _instrBranchValue
|
||||
case v of
|
||||
Imm c
|
||||
| c == 0 -> goBlock blts failLab liveVars _instrBranchOutVar _instrBranchTrue
|
||||
| otherwise -> goBlock blts failLab liveVars _instrBranchOutVar _instrBranchFalse
|
||||
Ref r -> do
|
||||
symFalse <- freshSymbol
|
||||
symEnd <- freshSymbol
|
||||
let labFalse = LabelRef symFalse Nothing
|
||||
labEnd = LabelRef symEnd Nothing
|
||||
output'' $ mkJumpIf (Lab labFalse) r
|
||||
ap0 <- getAP
|
||||
vars <- getVars
|
||||
goLocalBlock ap0 vars liveVars _instrBranchOutVar _instrBranchTrue
|
||||
-- _instrBranchOutVar is Nothing iff the branch returns
|
||||
when (isJust _instrBranchOutVar) $
|
||||
output'' (mkJumpRel (Val $ Lab labEnd))
|
||||
addrFalse <- getPC
|
||||
registerLabelAddress symFalse addrFalse
|
||||
output'' $ Label labFalse
|
||||
goLocalBlock ap0 vars liveVars _instrBranchOutVar _instrBranchFalse
|
||||
addrEnd <- getPC
|
||||
registerLabelAddress symEnd addrEnd
|
||||
output'' $ Label labEnd
|
||||
Lab {} -> impossible
|
||||
|
||||
goCase :: Address -> Reg.InstrCase -> Sem r [Instruction]
|
||||
goCase addr Reg.InstrCase {..} = do
|
||||
goLoad :: Reg.Value -> Offset -> Sem r RValue
|
||||
goLoad val off = do
|
||||
v <- mkRValue val
|
||||
case v of
|
||||
Val (Ref r) -> return $ Load $ LoadValue r off
|
||||
_ -> do
|
||||
goAssignAp v
|
||||
return $ Load $ LoadValue (MemRef Ap (-1)) off
|
||||
|
||||
goCase :: HashSet Reg.VarRef -> Reg.InstrCase -> Sem r ()
|
||||
goCase liveVars Reg.InstrCase {..} = do
|
||||
syms <- replicateM (length tags) freshSymbol
|
||||
symEnd <- freshSymbol
|
||||
let symMap = HashMap.fromList $ zip tags syms
|
||||
@ -344,46 +474,39 @@ fromReg tab = uncurry Result $ run $ runLabelInfoBuilderWithNextId (Reg.getNextS
|
||||
-- offsets in our CASM interpreter correspond to the relative jump
|
||||
-- offsets in the Cairo binary representation
|
||||
jmps' = concatMap (\i -> [i, Nop]) jmps
|
||||
addr1 = addr + length is + 1 + length jmps'
|
||||
(addr2, instrs) <- second (concat . reverse) <$> foldM (goCaseBranch symMap labEnd) (addr1, []) _instrCaseBranches
|
||||
(addr3, instrs') <- second reverse <$> foldM (goDefaultLabel symMap) (addr2, []) defaultTags
|
||||
instrs'' <- maybe (return []) (goCode addr3) _instrCaseDefault
|
||||
let addr4 = addr3 + length instrs''
|
||||
registerLabelAddress symEnd addr4
|
||||
return $ is ++ mkJumpRel v : jmps' ++ instrs ++ instrs' ++ instrs'' ++ [Label labEnd]
|
||||
v <- goLoad _instrCaseValue 0
|
||||
output'' (mkJumpRel v)
|
||||
mapM_ output'' jmps'
|
||||
ap0 <- getAP
|
||||
vars <- getVars
|
||||
mapM_ (goCaseBranch ap0 vars symMap labEnd) _instrCaseBranches
|
||||
mapM_ (goDefaultLabel symMap) defaultTags
|
||||
whenJust _instrCaseDefault $
|
||||
goLocalBlock ap0 vars liveVars _instrCaseOutVar
|
||||
addrEnd <- getPC
|
||||
registerLabelAddress symEnd addrEnd
|
||||
output'' $ Label labEnd
|
||||
where
|
||||
(is, v) = goLoad _instrCaseValue 0
|
||||
tags = Reg.lookupInductiveInfo tab _instrCaseInductive ^. Reg.inductiveConstructors
|
||||
ctrTags = HashSet.fromList $ map (^. Reg.caseBranchTag) _instrCaseBranches
|
||||
defaultTags = filter (not . flip HashSet.member ctrTags) tags
|
||||
|
||||
goCaseBranch :: HashMap Tag Symbol -> LabelRef -> (Address, [[Instruction]]) -> Reg.CaseBranch -> Sem r (Address, [[Instruction]])
|
||||
goCaseBranch symMap labEnd (addr', acc') Reg.CaseBranch {..} = do
|
||||
goCaseBranch :: Int -> HashMap Reg.VarRef Int -> HashMap Tag Symbol -> LabelRef -> Reg.CaseBranch -> Sem r ()
|
||||
goCaseBranch ap0 vars symMap labEnd Reg.CaseBranch {..} = do
|
||||
let sym = fromJust $ HashMap.lookup _caseBranchTag symMap
|
||||
lab = LabelRef sym Nothing
|
||||
registerLabelAddress sym addr'
|
||||
instrs <- goCode (addr' + 1) _caseBranchCode
|
||||
let instrs' = Label lab : instrs ++ [mkJumpRel (Val $ Lab labEnd)]
|
||||
return (addr' + length instrs', instrs' : acc')
|
||||
addr <- getPC
|
||||
registerLabelAddress sym addr
|
||||
output'' $ Label lab
|
||||
goLocalBlock ap0 vars liveVars _instrCaseOutVar _caseBranchCode
|
||||
-- _instrCaseOutVar is Nothing iff the branch returns
|
||||
when (isJust _instrCaseOutVar) $
|
||||
output'' (mkJumpRel (Val $ Lab labEnd))
|
||||
|
||||
goDefaultLabel :: HashMap Tag Symbol -> (Address, [Instruction]) -> Reg.Tag -> Sem r (Address, [Instruction])
|
||||
goDefaultLabel symMap (addr', acc') tag = do
|
||||
goDefaultLabel :: HashMap Tag Symbol -> Reg.Tag -> Sem r ()
|
||||
goDefaultLabel symMap tag = do
|
||||
let sym = fromJust $ HashMap.lookup tag symMap
|
||||
lab = LabelRef sym Nothing
|
||||
registerLabelAddress sym addr'
|
||||
return (addr' + 1, Label lab : acc')
|
||||
|
||||
goTrace :: Address -> Reg.InstrTrace -> Sem r [Instruction]
|
||||
goTrace _ Reg.InstrTrace {..} =
|
||||
return [Trace (InstrTrace (goRValue _instrTraceValue))]
|
||||
|
||||
goFail :: Address -> Reg.InstrFailure -> Sem r [Instruction]
|
||||
goFail _ Reg.InstrFailure {..} =
|
||||
return
|
||||
[ Trace (InstrTrace (goRValue _instrFailureValue)),
|
||||
mkJumpRel (Val $ Lab failLab)
|
||||
]
|
||||
|
||||
goBlock :: Address -> Reg.InstrBlock -> Sem r [Instruction]
|
||||
goBlock addr Reg.InstrBlock {..} =
|
||||
goCode addr _instrBlockCode
|
||||
addr <- getPC
|
||||
registerLabelAddress sym addr
|
||||
output'' $ Label lab
|
||||
|
68
src/Juvix/Compiler/Casm/Translation/FromReg/CasmBuilder.hs
Normal file
68
src/Juvix/Compiler/Casm/Translation/FromReg/CasmBuilder.hs
Normal file
@ -0,0 +1,68 @@
|
||||
module Juvix.Compiler.Casm.Translation.FromReg.CasmBuilder where
|
||||
|
||||
import Data.HashMap.Strict qualified as HashMap
|
||||
import Juvix.Compiler.Casm.Language
|
||||
import Juvix.Compiler.Reg.Language.Instrs (VarRef)
|
||||
|
||||
data CasmBuilder :: Effect where
|
||||
IncPC :: Int -> CasmBuilder m ()
|
||||
GetPC :: CasmBuilder m Address
|
||||
IncAP :: Int -> CasmBuilder m ()
|
||||
GetAP :: CasmBuilder m Int
|
||||
SetAP :: Address -> CasmBuilder m ()
|
||||
InsertVar :: VarRef -> Int -> CasmBuilder m ()
|
||||
LookupVar :: VarRef -> CasmBuilder m (Maybe Int)
|
||||
GetVars :: CasmBuilder m (HashMap VarRef Int)
|
||||
SetVars :: HashMap VarRef Int -> CasmBuilder m ()
|
||||
|
||||
makeSem ''CasmBuilder
|
||||
|
||||
data BuilderState = BuilderState
|
||||
{ _statePC :: Address,
|
||||
_stateAP :: Int,
|
||||
_stateVarMap :: HashMap VarRef Int
|
||||
}
|
||||
|
||||
makeLenses ''BuilderState
|
||||
|
||||
mkBuilderState :: Address -> HashMap VarRef Int -> BuilderState
|
||||
mkBuilderState addr vars =
|
||||
BuilderState
|
||||
{ _statePC = addr,
|
||||
_stateAP = 0,
|
||||
_stateVarMap = vars
|
||||
}
|
||||
|
||||
runCasmBuilder :: Address -> HashMap VarRef Int -> Sem (CasmBuilder ': r) a -> Sem r a
|
||||
runCasmBuilder addr vars = fmap snd . runCasmBuilder' (mkBuilderState addr vars)
|
||||
|
||||
runCasmBuilder' :: BuilderState -> Sem (CasmBuilder ': r) a -> Sem r (BuilderState, a)
|
||||
runCasmBuilder' bs = reinterpret (runState bs) interp
|
||||
where
|
||||
interp :: CasmBuilder m a -> Sem (State BuilderState ': r) a
|
||||
interp = \case
|
||||
IncPC i -> do
|
||||
modify' (over statePC (+ i))
|
||||
GetPC -> do
|
||||
gets (^. statePC)
|
||||
IncAP i -> do
|
||||
modify' (over stateAP (+ i))
|
||||
GetAP -> do
|
||||
gets (^. stateAP)
|
||||
SetAP addr -> do
|
||||
modify' (set stateAP addr)
|
||||
InsertVar v i -> do
|
||||
modify' (over stateVarMap (HashMap.insert v i))
|
||||
LookupVar v -> do
|
||||
mp <- gets (^. stateVarMap)
|
||||
return $ HashMap.lookup v mp
|
||||
GetVars -> do
|
||||
gets (^. stateVarMap)
|
||||
SetVars vars -> do
|
||||
modify' (set stateVarMap vars)
|
||||
|
||||
lookupVar' :: (Member CasmBuilder r) => VarRef -> Sem r Int
|
||||
lookupVar' = lookupVar >=> return . fromJust
|
||||
|
||||
hasVar :: (Member CasmBuilder r) => VarRef -> Sem r Bool
|
||||
hasVar = lookupVar >=> return . isJust
|
12
src/Juvix/Compiler/Reg/Data/Blocks/InfoTable.hs
Normal file
12
src/Juvix/Compiler/Reg/Data/Blocks/InfoTable.hs
Normal file
@ -0,0 +1,12 @@
|
||||
module Juvix.Compiler.Reg.Data.Blocks.InfoTable
|
||||
( module Juvix.Compiler.Reg.Data.Blocks.InfoTable,
|
||||
module Juvix.Compiler.Tree.Data.InfoTable.Base,
|
||||
)
|
||||
where
|
||||
|
||||
import Juvix.Compiler.Reg.Language.Blocks
|
||||
import Juvix.Compiler.Tree.Data.InfoTable.Base
|
||||
|
||||
type InfoTable = InfoTable' Block ()
|
||||
|
||||
type FunctionInfo = FunctionInfo' Block ()
|
@ -22,7 +22,7 @@ toCTransformations :: [TransformationId]
|
||||
toCTransformations = [Cleanup]
|
||||
|
||||
toCasmTransformations :: [TransformationId]
|
||||
toCasmTransformations = [Cleanup, SSA, InitBranchVars]
|
||||
toCasmTransformations = [Cleanup, SSA]
|
||||
|
||||
instance TransformationId' TransformationId where
|
||||
transformationText :: TransformationId -> Text
|
||||
|
134
src/Juvix/Compiler/Reg/Extra/Blocks.hs
Normal file
134
src/Juvix/Compiler/Reg/Extra/Blocks.hs
Normal file
@ -0,0 +1,134 @@
|
||||
module Juvix.Compiler.Reg.Extra.Blocks where
|
||||
|
||||
import Juvix.Compiler.Reg.Language.Blocks
|
||||
|
||||
overSubBlocks :: (Block -> Block) -> Block -> Block
|
||||
overSubBlocks f block = block'
|
||||
where
|
||||
block' = over blockFinal (fmap goFinal) block
|
||||
|
||||
goFinal :: FinalInstruction -> FinalInstruction
|
||||
goFinal = \case
|
||||
ExtendClosure x -> ExtendClosure x
|
||||
Call x -> Call x
|
||||
TailCall x -> TailCall x
|
||||
Return x -> Return x
|
||||
Branch x ->
|
||||
Branch $ over instrBranchTrue f $ over instrBranchFalse f x
|
||||
Case x ->
|
||||
Case $
|
||||
over instrCaseDefault (fmap f) $
|
||||
over instrCaseBranches (map (over caseBranchCode f)) x
|
||||
|
||||
getSubBlocks :: Block -> [Block]
|
||||
getSubBlocks block = maybe [] goFinal (block ^. blockFinal)
|
||||
where
|
||||
goFinal :: FinalInstruction -> [Block]
|
||||
goFinal = \case
|
||||
ExtendClosure {} -> []
|
||||
Call {} -> []
|
||||
TailCall {} -> []
|
||||
Return {} -> []
|
||||
Branch x ->
|
||||
[x ^. instrBranchTrue, x ^. instrBranchFalse]
|
||||
Case x ->
|
||||
maybeToList (x ^. instrCaseDefault)
|
||||
++ map (^. caseBranchCode) (x ^. instrCaseBranches)
|
||||
|
||||
getResultVar :: Instruction -> Maybe VarRef
|
||||
getResultVar = \case
|
||||
Binop x -> Just $ x ^. instrBinopResult
|
||||
Unop x -> Just $ x ^. instrUnopResult
|
||||
Assign x -> Just $ x ^. instrAssignResult
|
||||
Alloc x -> Just $ x ^. instrAllocResult
|
||||
AllocClosure x -> Just $ x ^. instrAllocClosureResult
|
||||
_ -> Nothing
|
||||
|
||||
getResultVar' :: FinalInstruction -> Maybe VarRef
|
||||
getResultVar' = \case
|
||||
Call x -> Just $ x ^. instrCallResult
|
||||
ExtendClosure x -> Just $ x ^. instrExtendClosureResult
|
||||
_ -> Nothing
|
||||
|
||||
getOutVar :: FinalInstruction -> Maybe VarRef
|
||||
getOutVar = \case
|
||||
Call x -> Just $ x ^. instrCallResult
|
||||
ExtendClosure x -> Just $ x ^. instrExtendClosureResult
|
||||
Branch x -> x ^. instrBranchOutVar
|
||||
Case x -> x ^. instrCaseOutVar
|
||||
TailCall {} -> Nothing
|
||||
Return {} -> Nothing
|
||||
|
||||
getValueRefs'' :: Value -> [VarRef]
|
||||
getValueRefs'' = \case
|
||||
ValConst {} -> []
|
||||
CRef ConstrField {..} -> [_constrFieldRef]
|
||||
VRef x -> [x]
|
||||
|
||||
getValueRefs :: Instruction -> [VarRef]
|
||||
getValueRefs = \case
|
||||
Binop x -> goBinop x
|
||||
Unop x -> goUnop x
|
||||
Assign x -> goAssign x
|
||||
Alloc x -> goAlloc x
|
||||
AllocClosure x -> goAllocClosure x
|
||||
Trace x -> goTrace x
|
||||
Dump -> []
|
||||
Failure x -> goFailure x
|
||||
where
|
||||
goBinop :: InstrBinop -> [VarRef]
|
||||
goBinop InstrBinop {..} =
|
||||
getValueRefs'' _instrBinopArg1
|
||||
++ getValueRefs'' _instrBinopArg2
|
||||
|
||||
goUnop :: InstrUnop -> [VarRef]
|
||||
goUnop InstrUnop {..} = getValueRefs'' _instrUnopArg
|
||||
|
||||
goAssign :: InstrAssign -> [VarRef]
|
||||
goAssign InstrAssign {..} = getValueRefs'' _instrAssignValue
|
||||
|
||||
goAlloc :: InstrAlloc -> [VarRef]
|
||||
goAlloc InstrAlloc {..} = concatMap getValueRefs'' _instrAllocArgs
|
||||
|
||||
goAllocClosure :: InstrAllocClosure -> [VarRef]
|
||||
goAllocClosure InstrAllocClosure {..} = concatMap getValueRefs'' _instrAllocClosureArgs
|
||||
|
||||
goTrace :: InstrTrace -> [VarRef]
|
||||
goTrace InstrTrace {..} = getValueRefs'' _instrTraceValue
|
||||
|
||||
goFailure :: InstrFailure -> [VarRef]
|
||||
goFailure InstrFailure {..} = getValueRefs'' _instrFailureValue
|
||||
|
||||
getValueRefs' :: FinalInstruction -> [VarRef]
|
||||
getValueRefs' = \case
|
||||
ExtendClosure x -> goExtendClosure x
|
||||
Call x -> goCall x
|
||||
TailCall x -> goTailCall x
|
||||
Return x -> goReturn x
|
||||
Branch x -> goBranch x
|
||||
Case x -> goCase x
|
||||
where
|
||||
goExtendClosure :: InstrExtendClosure -> [VarRef]
|
||||
goExtendClosure InstrExtendClosure {..} =
|
||||
_instrExtendClosureValue : concatMap getValueRefs'' _instrExtendClosureArgs
|
||||
|
||||
goCallType :: CallType -> [VarRef]
|
||||
goCallType = \case
|
||||
CallFun {} -> []
|
||||
CallClosure cl -> [cl]
|
||||
|
||||
goCall :: InstrCall -> [VarRef]
|
||||
goCall InstrCall {..} = goCallType _instrCallType ++ concatMap getValueRefs'' _instrCallArgs
|
||||
|
||||
goTailCall :: InstrTailCall -> [VarRef]
|
||||
goTailCall InstrTailCall {..} =
|
||||
goCallType _instrTailCallType ++ concatMap getValueRefs'' _instrTailCallArgs
|
||||
|
||||
goReturn :: InstrReturn -> [VarRef]
|
||||
goReturn InstrReturn {..} = getValueRefs'' _instrReturnValue
|
||||
|
||||
goBranch :: InstrBranch -> [VarRef]
|
||||
goBranch InstrBranch {..} = getValueRefs'' _instrBranchValue
|
||||
|
||||
goCase :: InstrCase -> [VarRef]
|
||||
goCase InstrCase {..} = getValueRefs'' _instrCaseValue
|
28
src/Juvix/Compiler/Reg/Extra/Blocks/Info.hs
Normal file
28
src/Juvix/Compiler/Reg/Extra/Blocks/Info.hs
Normal file
@ -0,0 +1,28 @@
|
||||
module Juvix.Compiler.Reg.Extra.Blocks.Info
|
||||
( module Juvix.Compiler.Tree.Extra.Info,
|
||||
module Juvix.Compiler.Reg.Extra.Blocks.Info,
|
||||
)
|
||||
where
|
||||
|
||||
import Juvix.Compiler.Reg.Data.Blocks.InfoTable
|
||||
import Juvix.Compiler.Reg.Language.Base
|
||||
import Juvix.Compiler.Tree.Extra.Info
|
||||
|
||||
data ExtraInfo = ExtraInfo
|
||||
{ _extraInfoTable :: InfoTable,
|
||||
-- | Globally unique IDs for function symbols
|
||||
_extraInfoFUIDs :: HashMap Symbol Int,
|
||||
-- | IDs for constructor tags, consecutive starting from 0 for each
|
||||
-- inductive type separately
|
||||
_extraInfoCIDs :: HashMap Tag Int
|
||||
}
|
||||
|
||||
makeLenses ''ExtraInfo
|
||||
|
||||
computeExtraInfo :: InfoTable -> ExtraInfo
|
||||
computeExtraInfo tab =
|
||||
ExtraInfo
|
||||
{ _extraInfoTable = tab,
|
||||
_extraInfoFUIDs = computeFUIDs tab,
|
||||
_extraInfoCIDs = computeCIDs tab
|
||||
}
|
@ -1,14 +1,14 @@
|
||||
module Juvix.Compiler.Reg.Extra.Info where
|
||||
module Juvix.Compiler.Reg.Extra.Info
|
||||
( module Juvix.Compiler.Tree.Extra.Info,
|
||||
module Juvix.Compiler.Reg.Extra.Info,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.HashMap.Strict qualified as HashMap
|
||||
import Juvix.Compiler.Backend
|
||||
import Juvix.Compiler.Reg.Data.InfoTable
|
||||
import Juvix.Compiler.Reg.Language
|
||||
|
||||
userConstrs :: InfoTable -> [ConstructorInfo]
|
||||
userConstrs tab =
|
||||
filter (\ci -> not (isBuiltinTag (ci ^. constructorTag))) $
|
||||
HashMap.elems (tab ^. infoConstrs)
|
||||
import Juvix.Compiler.Tree.Extra.Info
|
||||
|
||||
-- | Compute the maximum runtime stack height
|
||||
computeMaxStackHeight :: Limits -> Code -> Int
|
||||
@ -215,28 +215,6 @@ data ExtraInfo = ExtraInfo
|
||||
|
||||
makeLenses ''ExtraInfo
|
||||
|
||||
computeUIDs :: Limits -> InfoTable -> HashMap Tag Int
|
||||
computeUIDs lims tab =
|
||||
HashMap.fromList $
|
||||
zipWith
|
||||
(\ci uid -> (ci ^. constructorTag, uid))
|
||||
(userConstrs tab)
|
||||
[lims ^. limitsBuiltinUIDsNum ..]
|
||||
|
||||
computeFUIDs :: InfoTable -> HashMap Symbol Int
|
||||
computeFUIDs tab =
|
||||
HashMap.fromList $
|
||||
zipWith
|
||||
(\fi fuid -> (fi ^. functionSymbol, fuid))
|
||||
(HashMap.elems (tab ^. infoFunctions))
|
||||
[0 ..]
|
||||
|
||||
computeCIDs :: InfoTable -> HashMap Tag Int
|
||||
computeCIDs tab = HashMap.fromList $ concatMap go (tab ^. infoInductives)
|
||||
where
|
||||
go :: InductiveInfo -> [(Tag, Int)]
|
||||
go InductiveInfo {..} = zip _inductiveConstructors [0 ..]
|
||||
|
||||
computeExtraInfo :: Limits -> InfoTable -> ExtraInfo
|
||||
computeExtraInfo lims tab =
|
||||
ExtraInfo
|
||||
|
@ -1,55 +1,10 @@
|
||||
module Juvix.Compiler.Reg.Language
|
||||
( module Juvix.Compiler.Reg.Language,
|
||||
module Juvix.Compiler.Reg.Language.Base,
|
||||
module Juvix.Compiler.Reg.Language.Instrs,
|
||||
)
|
||||
where
|
||||
|
||||
import Juvix.Compiler.Reg.Language.Base
|
||||
|
||||
data Value
|
||||
= ValConst Constant
|
||||
| CRef ConstrField
|
||||
| VRef VarRef
|
||||
|
||||
-- | Reference to a constructor field (argument).
|
||||
data ConstrField = ConstrField
|
||||
{ -- | Tag of the constructor being referenced.
|
||||
_constrFieldTag :: Tag,
|
||||
-- | Memory representation of the constructor.
|
||||
_constrFieldMemRep :: MemRep,
|
||||
-- | Location where the data is stored.
|
||||
_constrFieldRef :: VarRef,
|
||||
-- | Index of the constructor argument being referenced.
|
||||
_constrFieldIndex :: Index
|
||||
}
|
||||
|
||||
data VarGroup
|
||||
= VarGroupArgs
|
||||
| VarGroupLocal
|
||||
deriving stock (Eq, Generic)
|
||||
|
||||
instance Hashable VarGroup
|
||||
|
||||
data VarRef = VarRef
|
||||
{ _varRefGroup :: VarGroup,
|
||||
_varRefIndex :: Index,
|
||||
_varRefName :: Maybe Text
|
||||
}
|
||||
|
||||
makeLenses ''VarRef
|
||||
makeLenses ''ConstrField
|
||||
|
||||
instance Hashable VarRef where
|
||||
hashWithSalt salt VarRef {..} = hashWithSalt salt (_varRefGroup, _varRefIndex)
|
||||
|
||||
instance Eq VarRef where
|
||||
vr1 == vr2 =
|
||||
vr1 ^. varRefGroup == vr2 ^. varRefGroup
|
||||
&& vr1 ^. varRefIndex == vr2 ^. varRefIndex
|
||||
|
||||
deriving stock instance (Eq ConstrField)
|
||||
|
||||
deriving stock instance (Eq Value)
|
||||
import Juvix.Compiler.Reg.Language.Instrs
|
||||
|
||||
data Instruction
|
||||
= Binop InstrBinop
|
||||
@ -78,87 +33,12 @@ data Instruction
|
||||
|
||||
type Code = [Instruction]
|
||||
|
||||
data InstrBinop = InstrBinop
|
||||
{ _instrBinopOpcode :: BinaryOp,
|
||||
_instrBinopResult :: VarRef,
|
||||
_instrBinopArg1 :: Value,
|
||||
_instrBinopArg2 :: Value
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
data InstrUnop = InstrUnop
|
||||
{ _instrUnopOpcode :: UnaryOp,
|
||||
_instrUnopResult :: VarRef,
|
||||
_instrUnopArg :: Value
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
data InstrAssign = InstrAssign
|
||||
{ _instrAssignResult :: VarRef,
|
||||
_instrAssignValue :: Value
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
newtype InstrTrace = InstrTrace
|
||||
{ _instrTraceValue :: Value
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
newtype InstrFailure = InstrFailure
|
||||
{ _instrFailureValue :: Value
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
data InstrPrealloc = InstrPrealloc
|
||||
{ _instrPreallocWordsNum :: Int,
|
||||
_instrPreallocLiveVars :: [VarRef]
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
data InstrAlloc = InstrAlloc
|
||||
{ _instrAllocResult :: VarRef,
|
||||
_instrAllocTag :: Tag,
|
||||
_instrAllocMemRep :: MemRep,
|
||||
_instrAllocArgs :: [Value]
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
data InstrAllocClosure = InstrAllocClosure
|
||||
{ _instrAllocClosureResult :: VarRef,
|
||||
_instrAllocClosureSymbol :: Symbol,
|
||||
_instrAllocClosureExpectedArgsNum :: Int,
|
||||
_instrAllocClosureArgs :: [Value]
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
data InstrExtendClosure = InstrExtendClosure
|
||||
{ _instrExtendClosureResult :: VarRef,
|
||||
_instrExtendClosureValue :: VarRef,
|
||||
_instrExtendClosureArgs :: [Value]
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
data CallType
|
||||
= CallFun Symbol
|
||||
| CallClosure VarRef
|
||||
deriving stock (Eq)
|
||||
|
||||
data InstrCall = InstrCall
|
||||
{ _instrCallResult :: VarRef,
|
||||
_instrCallType :: CallType,
|
||||
_instrCallArgs :: [Value],
|
||||
-- | Variables live after the call. Live variables need to be
|
||||
-- saved before the call and restored after it.
|
||||
_instrCallLiveVars :: [VarRef]
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
data InstrTailCall = InstrTailCall
|
||||
{ _instrTailCallType :: CallType,
|
||||
_instrTailCallArgs :: [Value]
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
data InstrCallClosures = InstrCallClosures
|
||||
{ _instrCallClosuresResult :: VarRef,
|
||||
_instrCallClosuresValue :: VarRef,
|
||||
@ -173,66 +53,17 @@ data InstrTailCallClosures = InstrTailCallClosures
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
newtype InstrReturn = InstrReturn
|
||||
{ _instrReturnValue :: Value
|
||||
}
|
||||
deriving stock (Eq)
|
||||
type InstrBranch = InstrBranch' Code
|
||||
|
||||
data InstrBranch = InstrBranch
|
||||
{ _instrBranchValue :: Value,
|
||||
_instrBranchTrue :: Code,
|
||||
_instrBranchFalse :: Code,
|
||||
-- | Output variable storing the result (corresponds to the top of the value
|
||||
-- stack in JuvixAsm after executing the branches)
|
||||
_instrBranchOutVar :: Maybe VarRef
|
||||
}
|
||||
deriving stock (Eq)
|
||||
type InstrCase = InstrCase' Code
|
||||
|
||||
data InstrCase = InstrCase
|
||||
{ _instrCaseValue :: Value,
|
||||
_instrCaseInductive :: Symbol,
|
||||
_instrCaseIndRep :: IndRep,
|
||||
_instrCaseBranches :: [CaseBranch],
|
||||
_instrCaseDefault :: Maybe Code,
|
||||
_instrCaseOutVar :: Maybe VarRef
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
data CaseBranch = CaseBranch
|
||||
{ _caseBranchTag :: Tag,
|
||||
-- | Memory representation of the constructor corresponding to the branch.
|
||||
_caseBranchMemRep :: MemRep,
|
||||
_caseBranchArgsNum :: Int,
|
||||
_caseBranchCode :: Code
|
||||
}
|
||||
deriving stock (Eq)
|
||||
type CaseBranch = CaseBranch' Code
|
||||
|
||||
newtype InstrBlock = InstrBlock
|
||||
{ _instrBlockCode :: Code
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
makeLenses ''InstrBinop
|
||||
makeLenses ''InstrUnop
|
||||
makeLenses ''InstrAssign
|
||||
makeLenses ''InstrTrace
|
||||
makeLenses ''InstrFailure
|
||||
makeLenses ''InstrPrealloc
|
||||
makeLenses ''InstrAlloc
|
||||
makeLenses ''InstrAllocClosure
|
||||
makeLenses ''InstrExtendClosure
|
||||
makeLenses ''InstrCall
|
||||
makeLenses ''InstrCallClosures
|
||||
makeLenses ''InstrBranch
|
||||
makeLenses ''InstrCase
|
||||
makeLenses ''CaseBranch
|
||||
makeLenses ''InstrReturn
|
||||
makeLenses ''InstrTailCall
|
||||
|
||||
mkVarRef :: VarGroup -> Index -> VarRef
|
||||
mkVarRef g i =
|
||||
VarRef
|
||||
{ _varRefGroup = g,
|
||||
_varRefIndex = i,
|
||||
_varRefName = Nothing
|
||||
}
|
||||
makeLenses ''InstrTailCallClosures
|
||||
|
50
src/Juvix/Compiler/Reg/Language/Blocks.hs
Normal file
50
src/Juvix/Compiler/Reg/Language/Blocks.hs
Normal file
@ -0,0 +1,50 @@
|
||||
module Juvix.Compiler.Reg.Language.Blocks
|
||||
( module Juvix.Compiler.Reg.Language.Blocks,
|
||||
module Juvix.Compiler.Reg.Language.Instrs,
|
||||
)
|
||||
where
|
||||
|
||||
import Juvix.Compiler.Reg.Language.Instrs
|
||||
|
||||
data Block = Block
|
||||
{ _blockLiveVars :: HashSet VarRef,
|
||||
_blockBody :: [Instruction],
|
||||
_blockFinal :: Maybe FinalInstruction,
|
||||
_blockNext :: Maybe Block
|
||||
}
|
||||
|
||||
data Instruction
|
||||
= Binop InstrBinop
|
||||
| Unop InstrUnop
|
||||
| Assign InstrAssign
|
||||
| Alloc InstrAlloc
|
||||
| AllocClosure InstrAllocClosure
|
||||
| Trace InstrTrace
|
||||
| Dump
|
||||
| Failure InstrFailure
|
||||
deriving stock (Eq)
|
||||
|
||||
data FinalInstruction
|
||||
= ExtendClosure InstrExtendClosure
|
||||
| Call InstrCall
|
||||
| TailCall InstrTailCall
|
||||
| Return InstrReturn
|
||||
| Branch InstrBranch
|
||||
| Case InstrCase
|
||||
|
||||
type InstrBranch = InstrBranch' Block
|
||||
|
||||
type InstrCase = InstrCase' Block
|
||||
|
||||
type CaseBranch = CaseBranch' Block
|
||||
|
||||
makeLenses ''Block
|
||||
|
||||
emptyBlock :: Block
|
||||
emptyBlock =
|
||||
Block
|
||||
{ _blockLiveVars = mempty,
|
||||
_blockBody = [],
|
||||
_blockFinal = Nothing,
|
||||
_blockNext = Nothing
|
||||
}
|
185
src/Juvix/Compiler/Reg/Language/Instrs.hs
Normal file
185
src/Juvix/Compiler/Reg/Language/Instrs.hs
Normal file
@ -0,0 +1,185 @@
|
||||
module Juvix.Compiler.Reg.Language.Instrs
|
||||
( module Juvix.Compiler.Reg.Language.Instrs,
|
||||
module Juvix.Compiler.Reg.Language.Base,
|
||||
)
|
||||
where
|
||||
|
||||
import Juvix.Compiler.Reg.Language.Base
|
||||
|
||||
data Value
|
||||
= ValConst Constant
|
||||
| CRef ConstrField
|
||||
| VRef VarRef
|
||||
|
||||
-- | Reference to a constructor field (argument).
|
||||
data ConstrField = ConstrField
|
||||
{ -- | Tag of the constructor being referenced.
|
||||
_constrFieldTag :: Tag,
|
||||
-- | Memory representation of the constructor.
|
||||
_constrFieldMemRep :: MemRep,
|
||||
-- | Location where the data is stored.
|
||||
_constrFieldRef :: VarRef,
|
||||
-- | Index of the constructor argument being referenced.
|
||||
_constrFieldIndex :: Index
|
||||
}
|
||||
|
||||
data VarGroup
|
||||
= VarGroupArgs
|
||||
| VarGroupLocal
|
||||
deriving stock (Eq, Generic, Show)
|
||||
|
||||
instance Hashable VarGroup
|
||||
|
||||
data VarRef = VarRef
|
||||
{ _varRefGroup :: VarGroup,
|
||||
_varRefIndex :: Index,
|
||||
_varRefName :: Maybe Text
|
||||
}
|
||||
deriving stock (Show)
|
||||
|
||||
makeLenses ''VarRef
|
||||
makeLenses ''ConstrField
|
||||
|
||||
instance Hashable VarRef where
|
||||
hashWithSalt salt VarRef {..} = hashWithSalt salt (_varRefGroup, _varRefIndex)
|
||||
|
||||
instance Eq VarRef where
|
||||
vr1 == vr2 =
|
||||
vr1 ^. varRefGroup == vr2 ^. varRefGroup
|
||||
&& vr1 ^. varRefIndex == vr2 ^. varRefIndex
|
||||
|
||||
deriving stock instance (Eq ConstrField)
|
||||
|
||||
deriving stock instance (Eq Value)
|
||||
|
||||
data InstrBinop = InstrBinop
|
||||
{ _instrBinopOpcode :: BinaryOp,
|
||||
_instrBinopResult :: VarRef,
|
||||
_instrBinopArg1 :: Value,
|
||||
_instrBinopArg2 :: Value
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
data InstrUnop = InstrUnop
|
||||
{ _instrUnopOpcode :: UnaryOp,
|
||||
_instrUnopResult :: VarRef,
|
||||
_instrUnopArg :: Value
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
data InstrAssign = InstrAssign
|
||||
{ _instrAssignResult :: VarRef,
|
||||
_instrAssignValue :: Value
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
newtype InstrTrace = InstrTrace
|
||||
{ _instrTraceValue :: Value
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
newtype InstrFailure = InstrFailure
|
||||
{ _instrFailureValue :: Value
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
data InstrAlloc = InstrAlloc
|
||||
{ _instrAllocResult :: VarRef,
|
||||
_instrAllocTag :: Tag,
|
||||
_instrAllocMemRep :: MemRep,
|
||||
_instrAllocArgs :: [Value]
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
data InstrAllocClosure = InstrAllocClosure
|
||||
{ _instrAllocClosureResult :: VarRef,
|
||||
_instrAllocClosureSymbol :: Symbol,
|
||||
_instrAllocClosureExpectedArgsNum :: Int,
|
||||
_instrAllocClosureArgs :: [Value]
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
data InstrExtendClosure = InstrExtendClosure
|
||||
{ _instrExtendClosureResult :: VarRef,
|
||||
_instrExtendClosureValue :: VarRef,
|
||||
_instrExtendClosureArgs :: [Value]
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
data CallType
|
||||
= CallFun Symbol
|
||||
| CallClosure VarRef
|
||||
deriving stock (Eq)
|
||||
|
||||
data InstrCall = InstrCall
|
||||
{ _instrCallResult :: VarRef,
|
||||
_instrCallType :: CallType,
|
||||
_instrCallArgs :: [Value],
|
||||
-- | Variables live after the call. Live variables need to be
|
||||
-- saved before the call and restored after it.
|
||||
_instrCallLiveVars :: [VarRef]
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
data InstrTailCall = InstrTailCall
|
||||
{ _instrTailCallType :: CallType,
|
||||
_instrTailCallArgs :: [Value]
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
newtype InstrReturn = InstrReturn
|
||||
{ _instrReturnValue :: Value
|
||||
}
|
||||
deriving stock (Eq)
|
||||
|
||||
data InstrBranch' a = InstrBranch
|
||||
{ _instrBranchValue :: Value,
|
||||
_instrBranchTrue :: a,
|
||||
_instrBranchFalse :: a,
|
||||
-- | Output variable storing the result (corresponds to the top of the value
|
||||
-- stack in JuvixAsm after executing the branches)
|
||||
_instrBranchOutVar :: Maybe VarRef
|
||||
}
|
||||
deriving stock (Eq, Functor)
|
||||
|
||||
data InstrCase' a = InstrCase
|
||||
{ _instrCaseValue :: Value,
|
||||
_instrCaseInductive :: Symbol,
|
||||
_instrCaseIndRep :: IndRep,
|
||||
_instrCaseBranches :: [CaseBranch' a],
|
||||
_instrCaseDefault :: Maybe a,
|
||||
_instrCaseOutVar :: Maybe VarRef
|
||||
}
|
||||
deriving stock (Eq, Functor)
|
||||
|
||||
data CaseBranch' a = CaseBranch
|
||||
{ _caseBranchTag :: Tag,
|
||||
-- | Memory representation of the constructor corresponding to the branch.
|
||||
_caseBranchMemRep :: MemRep,
|
||||
_caseBranchArgsNum :: Int,
|
||||
_caseBranchCode :: a
|
||||
}
|
||||
deriving stock (Eq, Functor)
|
||||
|
||||
makeLenses ''InstrBinop
|
||||
makeLenses ''InstrUnop
|
||||
makeLenses ''InstrAssign
|
||||
makeLenses ''InstrTrace
|
||||
makeLenses ''InstrFailure
|
||||
makeLenses ''InstrAlloc
|
||||
makeLenses ''InstrAllocClosure
|
||||
makeLenses ''InstrExtendClosure
|
||||
makeLenses ''InstrReturn
|
||||
makeLenses ''InstrTailCall
|
||||
makeLenses ''InstrCall
|
||||
makeLenses ''InstrBranch'
|
||||
makeLenses ''InstrCase'
|
||||
makeLenses ''CaseBranch'
|
||||
|
||||
mkVarRef :: VarGroup -> Index -> VarRef
|
||||
mkVarRef g i =
|
||||
VarRef
|
||||
{ _varRefGroup = g,
|
||||
_varRefIndex = i,
|
||||
_varRefName = Nothing
|
||||
}
|
@ -4,8 +4,11 @@ module Juvix.Compiler.Reg.Pipeline
|
||||
)
|
||||
where
|
||||
|
||||
import Juvix.Compiler.Reg.Data.Blocks.InfoTable qualified as Blocks
|
||||
import Juvix.Compiler.Reg.Data.InfoTable
|
||||
import Juvix.Compiler.Reg.Transformation
|
||||
import Juvix.Compiler.Reg.Transformation.Blocks.Liveness qualified as Blocks
|
||||
import Juvix.Compiler.Reg.Translation.Blocks.FromReg qualified as Blocks
|
||||
|
||||
-- | Perform transformations on JuvixReg necessary before the translation to C
|
||||
toC :: InfoTable -> Sem r InfoTable
|
||||
@ -13,5 +16,5 @@ toC = applyTransformations toCTransformations
|
||||
|
||||
-- | Perform transformations on JuvixReg necessary before the translation to
|
||||
-- Cairo assembly
|
||||
toCasm :: InfoTable -> Sem r InfoTable
|
||||
toCasm = applyTransformations toCasmTransformations
|
||||
toCasm :: InfoTable -> Sem r Blocks.InfoTable
|
||||
toCasm = applyTransformations toCasmTransformations >=> return . Blocks.computeLiveness . Blocks.fromReg
|
||||
|
10
src/Juvix/Compiler/Reg/Transformation/Blocks/Base.hs
Normal file
10
src/Juvix/Compiler/Reg/Transformation/Blocks/Base.hs
Normal file
@ -0,0 +1,10 @@
|
||||
module Juvix.Compiler.Reg.Transformation.Blocks.Base
|
||||
( module Juvix.Compiler.Tree.Transformation.Generic.Base,
|
||||
module Juvix.Compiler.Reg.Data.Blocks.InfoTable,
|
||||
module Juvix.Compiler.Reg.Language.Blocks,
|
||||
)
|
||||
where
|
||||
|
||||
import Juvix.Compiler.Reg.Data.Blocks.InfoTable
|
||||
import Juvix.Compiler.Reg.Language.Blocks
|
||||
import Juvix.Compiler.Tree.Transformation.Generic.Base
|
38
src/Juvix/Compiler/Reg/Transformation/Blocks/Liveness.hs
Normal file
38
src/Juvix/Compiler/Reg/Transformation/Blocks/Liveness.hs
Normal file
@ -0,0 +1,38 @@
|
||||
module Juvix.Compiler.Reg.Transformation.Blocks.Liveness where
|
||||
|
||||
import Data.HashSet qualified as HashSet
|
||||
import Juvix.Compiler.Reg.Extra.Blocks
|
||||
import Juvix.Compiler.Reg.Transformation.Blocks.Base
|
||||
|
||||
computeBlockLiveness :: Block -> Block
|
||||
computeBlockLiveness = computeBlockLiveness' mempty
|
||||
|
||||
computeBlockLiveness' :: HashSet VarRef -> Block -> Block
|
||||
computeBlockLiveness' vars block = block'' {_blockLiveVars = vars'}
|
||||
where
|
||||
block' = over blockNext (fmap (computeBlockLiveness' vars)) block
|
||||
varsNext = maybe vars (^. blockLiveVars) (block' ^. blockNext)
|
||||
block'' = overSubBlocks (computeBlockLiveness' varsNext) block'
|
||||
blocks = getSubBlocks block''
|
||||
vars0 = if null blocks then varsNext else HashSet.unions $ map (^. blockLiveVars) blocks
|
||||
vars1 = updateByFinalInstr (block ^. blockFinal) vars0
|
||||
vars' = foldr updateByInstr vars1 (block ^. blockBody)
|
||||
|
||||
updateByFinalInstr :: Maybe FinalInstruction -> HashSet VarRef -> HashSet VarRef
|
||||
updateByFinalInstr mi acc = case mi of
|
||||
Nothing -> acc
|
||||
Just i -> updateBy (getResultVar' i) (getValueRefs' i) acc
|
||||
|
||||
updateByInstr :: Instruction -> HashSet VarRef -> HashSet VarRef
|
||||
updateByInstr i acc = updateBy (getResultVar i) (getValueRefs i) acc
|
||||
|
||||
updateBy :: Maybe VarRef -> [VarRef] -> HashSet VarRef -> HashSet VarRef
|
||||
updateBy mr vs acc = acc2
|
||||
where
|
||||
acc1 = case mr of
|
||||
Nothing -> acc
|
||||
Just x -> HashSet.delete x acc
|
||||
acc2 = HashSet.union acc1 (HashSet.fromList vs)
|
||||
|
||||
computeLiveness :: InfoTable -> InfoTable
|
||||
computeLiveness = mapT (const computeBlockLiveness)
|
43
src/Juvix/Compiler/Reg/Translation/Blocks/FromReg.hs
Normal file
43
src/Juvix/Compiler/Reg/Translation/Blocks/FromReg.hs
Normal file
@ -0,0 +1,43 @@
|
||||
module Juvix.Compiler.Reg.Translation.Blocks.FromReg where
|
||||
|
||||
import Juvix.Compiler.Reg.Data.Blocks.InfoTable
|
||||
import Juvix.Compiler.Reg.Data.InfoTable qualified as Reg
|
||||
import Juvix.Compiler.Reg.Language qualified as Reg
|
||||
import Juvix.Compiler.Reg.Language.Blocks
|
||||
|
||||
fromReg :: Reg.InfoTable -> InfoTable
|
||||
fromReg = over infoFunctions (fmap (over functionCode goCode))
|
||||
where
|
||||
goCode :: Reg.Code -> Block
|
||||
goCode = fromMaybe emptyBlock . goCode'
|
||||
|
||||
goCode' :: Reg.Code -> Maybe Block
|
||||
goCode' = \case
|
||||
[] -> Nothing
|
||||
i : is -> Just $ case i of
|
||||
Reg.Binop x -> over blockBody (Binop x :) (goCode is)
|
||||
Reg.Unop x -> over blockBody (Unop x :) (goCode is)
|
||||
Reg.Assign x -> over blockBody (Assign x :) (goCode is)
|
||||
Reg.Alloc x -> over blockBody (Alloc x :) (goCode is)
|
||||
Reg.AllocClosure x -> over blockBody (AllocClosure x :) (goCode is)
|
||||
Reg.ExtendClosure x -> mkBlock (ExtendClosure x)
|
||||
Reg.Call x -> mkBlock (Call x)
|
||||
Reg.TailCall x -> mkBlock (TailCall x)
|
||||
Reg.Return x -> mkBlock (Return x)
|
||||
Reg.Branch x -> mkBlock (Branch (fmap goCode x))
|
||||
Reg.Case x -> mkBlock (Case (fmap goCode x))
|
||||
Reg.CallClosures {} -> impossible
|
||||
Reg.TailCallClosures {} -> impossible
|
||||
Reg.Trace x -> over blockBody (Trace x :) (goCode is)
|
||||
Reg.Dump -> over blockBody (Dump :) (goCode is)
|
||||
Reg.Failure x -> over blockBody (Failure x :) (goCode is)
|
||||
Reg.Prealloc {} -> goCode is
|
||||
Reg.Nop -> goCode is
|
||||
Reg.Block Reg.InstrBlock {..} -> goCode (_instrBlockCode ++ is)
|
||||
where
|
||||
mkBlock :: FinalInstruction -> Block
|
||||
mkBlock i' =
|
||||
emptyBlock
|
||||
{ _blockFinal = Just i',
|
||||
_blockNext = goCode' is
|
||||
}
|
33
src/Juvix/Compiler/Tree/Extra/Info.hs
Normal file
33
src/Juvix/Compiler/Tree/Extra/Info.hs
Normal file
@ -0,0 +1,33 @@
|
||||
module Juvix.Compiler.Tree.Extra.Info where
|
||||
|
||||
import Data.HashMap.Strict qualified as HashMap
|
||||
import Juvix.Compiler.Backend
|
||||
import Juvix.Compiler.Tree.Data.InfoTable.Base
|
||||
import Juvix.Compiler.Tree.Language.Base
|
||||
|
||||
userConstrs :: InfoTable' a e -> [ConstructorInfo]
|
||||
userConstrs tab =
|
||||
filter (\ci -> not (isBuiltinTag (ci ^. constructorTag))) $
|
||||
HashMap.elems (tab ^. infoConstrs)
|
||||
|
||||
computeUIDs :: Limits -> InfoTable' a e -> HashMap Tag Int
|
||||
computeUIDs lims tab =
|
||||
HashMap.fromList $
|
||||
zipWith
|
||||
(\ci uid -> (ci ^. constructorTag, uid))
|
||||
(userConstrs tab)
|
||||
[lims ^. limitsBuiltinUIDsNum ..]
|
||||
|
||||
computeFUIDs :: InfoTable' a e -> HashMap Symbol Int
|
||||
computeFUIDs tab =
|
||||
HashMap.fromList $
|
||||
zipWith
|
||||
(\fi fuid -> (fi ^. functionSymbol, fuid))
|
||||
(HashMap.elems (tab ^. infoFunctions))
|
||||
[0 ..]
|
||||
|
||||
computeCIDs :: InfoTable' a e -> HashMap Tag Int
|
||||
computeCIDs tab = HashMap.fromList $ concatMap go (tab ^. infoInductives)
|
||||
where
|
||||
go :: InductiveInfo -> [(Tag, Int)]
|
||||
go InductiveInfo {..} = zip _inductiveConstructors [0 ..]
|
@ -10,6 +10,7 @@ import Juvix.Data.PPOutput
|
||||
|
||||
compileAssertion ::
|
||||
Path Abs Dir ->
|
||||
Bool ->
|
||||
Int ->
|
||||
Path Abs File ->
|
||||
Path Abs File ->
|
||||
@ -20,12 +21,13 @@ compileAssertion = compileAssertionEntry (\e -> e {_entryPointFieldSize = cairoF
|
||||
compileAssertionEntry ::
|
||||
(EntryPoint -> EntryPoint) ->
|
||||
Path Abs Dir ->
|
||||
Bool ->
|
||||
Int ->
|
||||
Path Abs File ->
|
||||
Path Abs File ->
|
||||
(String -> IO ()) ->
|
||||
Assertion
|
||||
compileAssertionEntry adjustEntry root' optLevel mainFile expectedFile step = do
|
||||
compileAssertionEntry adjustEntry root' bRunVM optLevel mainFile expectedFile step = do
|
||||
step "Translate to JuvixCore"
|
||||
entryPoint <- adjustEntry <$> testDefaultEntryPointIO root' mainFile
|
||||
PipelineResult {..} <- snd <$> testRunIO entryPoint upToStoredCore
|
||||
@ -37,7 +39,7 @@ compileAssertionEntry adjustEntry root' optLevel mainFile expectedFile step = do
|
||||
withTempDir'
|
||||
( \dirPath -> do
|
||||
let tmpFile = dirPath <//> $(mkRelFile "tmp.out")
|
||||
step "Serialize"
|
||||
step "Pretty print"
|
||||
writeFileEnsureLn tmpFile (toPlainText $ ppProgram _resultCode)
|
||||
)
|
||||
casmRunAssertion' False _resultLabelInfo _resultCode expectedFile step
|
||||
casmRunAssertion' bRunVM _resultLabelInfo _resultCode expectedFile step
|
||||
|
@ -5,7 +5,8 @@ import Casm.Compilation.Base
|
||||
import Data.HashSet qualified as HashSet
|
||||
|
||||
data PosTest = PosTest
|
||||
{ _name :: String,
|
||||
{ _runVM :: Bool,
|
||||
_name :: String,
|
||||
_dir :: Path Abs Dir,
|
||||
_file :: Path Abs File,
|
||||
_expectedFile :: Path Abs File
|
||||
@ -24,7 +25,7 @@ toTestDescr optLevel PosTest {..} =
|
||||
in TestDescr
|
||||
{ _testName = _name,
|
||||
_testRoot = tRoot,
|
||||
_testAssertion = Steps $ compileAssertion _dir optLevel file' expected'
|
||||
_testAssertion = Steps $ compileAssertion _dir _runVM optLevel file' expected'
|
||||
}
|
||||
|
||||
allTests :: TestTree
|
||||
@ -39,8 +40,8 @@ allTestsNoOptimize =
|
||||
"Juvix to CASM positive tests (no optimization)"
|
||||
(map (mkTest . toTestDescr 0) tests)
|
||||
|
||||
posTest :: String -> Path Rel Dir -> Path Rel File -> Path Rel File -> PosTest
|
||||
posTest _name rdir rfile routfile =
|
||||
posTest :: String -> Bool -> Path Rel Dir -> Path Rel File -> Path Rel File -> PosTest
|
||||
posTest _name _runVM rdir rfile routfile =
|
||||
let _dir = root <//> rdir
|
||||
_file = _dir <//> rfile
|
||||
_expectedFile = root <//> routfile
|
||||
@ -62,291 +63,350 @@ tests =
|
||||
(not . isIgnored)
|
||||
[ posTest
|
||||
"Test001: Arithmetic operators"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test001.juvix")
|
||||
$(mkRelFile "out/test001.out"),
|
||||
posTest
|
||||
"Test002: Arithmetic operators inside lambdas"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test002.juvix")
|
||||
$(mkRelFile "out/test002.out"),
|
||||
posTest
|
||||
"Test003: Integer arithmetic"
|
||||
False
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test003.juvix")
|
||||
$(mkRelFile "out/test003.out"),
|
||||
posTest
|
||||
"Test005: Higher-order functions"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test005.juvix")
|
||||
$(mkRelFile "out/test005.out"),
|
||||
posTest
|
||||
"Test006: If-then-else and lazy boolean operators"
|
||||
False
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test006.juvix")
|
||||
$(mkRelFile "out/test006.out"),
|
||||
posTest
|
||||
"Test007: Pattern matching and lambda-case"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test007.juvix")
|
||||
$(mkRelFile "out/test007.out"),
|
||||
posTest
|
||||
"Test008: Recursion"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test008.juvix")
|
||||
$(mkRelFile "out/test008.out"),
|
||||
posTest
|
||||
"Test009: Tail recursion"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test009.juvix")
|
||||
$(mkRelFile "out/test009.out"),
|
||||
posTest
|
||||
"Test010: Let"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test010.juvix")
|
||||
$(mkRelFile "out/test010.out"),
|
||||
posTest
|
||||
"Test013: Functions returning functions with variable capture"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test013.juvix")
|
||||
$(mkRelFile "out/test013.out"),
|
||||
posTest
|
||||
"Test014: Arithmetic"
|
||||
False
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test014.juvix")
|
||||
$(mkRelFile "out/test014.out"),
|
||||
posTest
|
||||
"Test015: Local functions with free variables"
|
||||
False
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test015.juvix")
|
||||
$(mkRelFile "out/test015.out"),
|
||||
posTest
|
||||
"Test016: Recursion through higher-order functions"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test016.juvix")
|
||||
$(mkRelFile "out/test016.out"),
|
||||
posTest
|
||||
"Test017: Tail recursion through higher-order functions"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test017.juvix")
|
||||
$(mkRelFile "out/test017.out"),
|
||||
posTest
|
||||
"Test018: Higher-order functions and recursion"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test018.juvix")
|
||||
$(mkRelFile "out/test018.out"),
|
||||
posTest
|
||||
"Test019: Self-application"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test019.juvix")
|
||||
$(mkRelFile "out/test019.out"),
|
||||
posTest
|
||||
"Test020: Recursive functions: McCarthy's 91 function, subtraction by increments"
|
||||
False
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test020.juvix")
|
||||
$(mkRelFile "out/test020.out"),
|
||||
posTest
|
||||
"Test021: Fast exponentiation"
|
||||
False
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test021.juvix")
|
||||
$(mkRelFile "out/test021.out"),
|
||||
posTest
|
||||
"Test022: Lists"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test022.juvix")
|
||||
$(mkRelFile "out/test022.out"),
|
||||
posTest
|
||||
"Test023: Mutual recursion"
|
||||
False
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test023.juvix")
|
||||
$(mkRelFile "out/test023.out"),
|
||||
posTest
|
||||
"Test024: Nested binders with variable capture"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test024.juvix")
|
||||
$(mkRelFile "out/test024.out"),
|
||||
posTest
|
||||
"Test025: Euclid's algorithm"
|
||||
False
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test025.juvix")
|
||||
$(mkRelFile "out/test025.out"),
|
||||
posTest
|
||||
"Test026: Functional queues"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test026.juvix")
|
||||
$(mkRelFile "out/test026.out"),
|
||||
posTest
|
||||
"Test028: Streams without memoization"
|
||||
False
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test028.juvix")
|
||||
$(mkRelFile "out/test028.out"),
|
||||
posTest
|
||||
"Test029: Ackermann function"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test029.juvix")
|
||||
$(mkRelFile "out/test029.out"),
|
||||
posTest
|
||||
"Test030: Ackermann function (higher-order definition)"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test030.juvix")
|
||||
$(mkRelFile "out/test030.out"),
|
||||
posTest
|
||||
"Test032: Merge sort"
|
||||
False
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test032.juvix")
|
||||
$(mkRelFile "out/test032.out"),
|
||||
posTest
|
||||
"Test033: Eta-expansion of builtins and constructors"
|
||||
False
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test033.juvix")
|
||||
$(mkRelFile "out/test033.out"),
|
||||
posTest
|
||||
"Test034: Recursive let"
|
||||
False
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test034.juvix")
|
||||
$(mkRelFile "out/test034.out"),
|
||||
posTest
|
||||
"Test035: Pattern matching"
|
||||
False
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test035.juvix")
|
||||
$(mkRelFile "out/test035.out"),
|
||||
posTest
|
||||
"Test036: Eta-expansion"
|
||||
False
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test036.juvix")
|
||||
$(mkRelFile "out/test036.out"),
|
||||
posTest
|
||||
"Test037: Applications with lets and cases in function position"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test037.juvix")
|
||||
$(mkRelFile "out/test037.out"),
|
||||
posTest
|
||||
"Test038: Simple case expression"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test038.juvix")
|
||||
$(mkRelFile "out/test038.out"),
|
||||
posTest
|
||||
"Test039: Mutually recursive let expression"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test039.juvix")
|
||||
$(mkRelFile "out/test039.out"),
|
||||
posTest
|
||||
"Test040: Pattern matching nullary constructor"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test040.juvix")
|
||||
$(mkRelFile "out/test040.out"),
|
||||
posTest
|
||||
"Test045: Implicit builtin bool"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test045.juvix")
|
||||
$(mkRelFile "out/test045.out"),
|
||||
posTest
|
||||
"Test046: Polymorphic type arguments"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test046.juvix")
|
||||
$(mkRelFile "out/test046.out"),
|
||||
posTest
|
||||
"Test047: Local Modules"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test047.juvix")
|
||||
$(mkRelFile "out/test047.out"),
|
||||
posTest
|
||||
"Test050: Pattern matching with integers"
|
||||
False
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test050.juvix")
|
||||
$(mkRelFile "out/test050.out"),
|
||||
posTest
|
||||
"Test053: Inlining"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test053.juvix")
|
||||
$(mkRelFile "out/test053.out"),
|
||||
posTest
|
||||
"Test054: Iterators"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test054.juvix")
|
||||
$(mkRelFile "out/test054.out"),
|
||||
posTest
|
||||
"Test056: Argument specialization"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test056.juvix")
|
||||
$(mkRelFile "out/test056.out"),
|
||||
posTest
|
||||
"Test057: Case folding"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test057.juvix")
|
||||
$(mkRelFile "out/test057.out"),
|
||||
posTest
|
||||
"Test058: Ranges"
|
||||
False
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test058.juvix")
|
||||
$(mkRelFile "out/test058.out"),
|
||||
posTest
|
||||
"Test059: Builtin list"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test059.juvix")
|
||||
$(mkRelFile "out/test059.out"),
|
||||
posTest
|
||||
"Test060: Record update"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test060.juvix")
|
||||
$(mkRelFile "out/test060.out"),
|
||||
posTest
|
||||
"Test062: Overapplication"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test062.juvix")
|
||||
$(mkRelFile "out/test062.out"),
|
||||
posTest
|
||||
"Test064: Constant folding"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test064.juvix")
|
||||
$(mkRelFile "out/test064.out"),
|
||||
posTest
|
||||
"Test065: Arithmetic simplification"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test065.juvix")
|
||||
$(mkRelFile "out/test065.out"),
|
||||
posTest
|
||||
"Test066: Import function with a function call in default argument"
|
||||
True
|
||||
$(mkRelDir "test066")
|
||||
$(mkRelFile "M.juvix")
|
||||
$(mkRelFile "out/test066.out"),
|
||||
posTest
|
||||
"Test067: Dependent default values inserted during translation FromConcrete"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test067.juvix")
|
||||
$(mkRelFile "out/test067.out"),
|
||||
posTest
|
||||
"Test068: Dependent default values inserted in the arity checker"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test068.juvix")
|
||||
$(mkRelFile "out/test068.out"),
|
||||
posTest
|
||||
"Test069: Dependent default values for Ord trait"
|
||||
False
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test069.juvix")
|
||||
$(mkRelFile "out/test069.out"),
|
||||
posTest
|
||||
"Test070: Nested default values and named arguments"
|
||||
True
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test070.juvix")
|
||||
$(mkRelFile "out/test070.out"),
|
||||
posTest
|
||||
"Test071: Named application (Ord instance with default cmp)"
|
||||
False
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test071.juvix")
|
||||
$(mkRelFile "out/test071.out"),
|
||||
posTest
|
||||
"Test072: Monad transformers (ReaderT + StateT + Identity)"
|
||||
True
|
||||
$(mkRelDir "test072")
|
||||
$(mkRelFile "ReaderT.juvix")
|
||||
$(mkRelFile "out/test072.out"),
|
||||
posTest
|
||||
"Test073: Import and use a syntax alias"
|
||||
True
|
||||
$(mkRelDir "test073")
|
||||
$(mkRelFile "test073.juvix")
|
||||
$(mkRelFile "out/test073.out"),
|
||||
posTest
|
||||
"Test074: Fields"
|
||||
-- different textual format for "negative" field elements
|
||||
False
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test074.juvix")
|
||||
$(mkRelFile "out/test074.out")
|
||||
|
@ -1,8 +1,8 @@
|
||||
module Casm.Reg where
|
||||
|
||||
import Base
|
||||
-- import Casm.Reg.Cairo qualified as C
|
||||
import Casm.Reg.Cairo qualified as C
|
||||
import Casm.Reg.Positive qualified as P
|
||||
|
||||
allTests :: TestTree
|
||||
allTests = testGroup "JuvixReg to CASM translation" [P.allTests]
|
||||
allTests = testGroup "JuvixReg to CASM translation" [P.allTests, C.allTests]
|
||||
|
@ -15,6 +15,7 @@ compileAssertion' _ outputFile _ tab step = do
|
||||
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
|
||||
|
@ -21,6 +21,17 @@ allTests =
|
||||
"JuvixReg to Cairo translation positive tests"
|
||||
( map (mkTest . testDescr) $
|
||||
P.filterOutTests
|
||||
[]
|
||||
[ "Test001: Arithmetic opcodes",
|
||||
"Test013: Fibonacci numbers in linear time",
|
||||
"Test014: Trees",
|
||||
"Test016: Arithmetic",
|
||||
"Test017: Closures as arguments",
|
||||
"Test023: McCarthy's 91 function",
|
||||
"Test024: Higher-order recursive functions",
|
||||
"Test027: Fast exponentiation",
|
||||
"Test030: Mutual recursion",
|
||||
"Test031: Temporary stack with branching",
|
||||
"Test036: Streams without memoization"
|
||||
]
|
||||
P.tests
|
||||
)
|
||||
|
@ -179,5 +179,10 @@ tests =
|
||||
"Test038: Apply & argsnum"
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test038.jvr")
|
||||
$(mkRelFile "out/test038.out")
|
||||
$(mkRelFile "out/test038.out"),
|
||||
PosTest
|
||||
"Test039: Calls in a branch"
|
||||
$(mkRelDir ".")
|
||||
$(mkRelFile "test039.jvr")
|
||||
$(mkRelFile "out/test039.out")
|
||||
]
|
||||
|
1
tests/Casm/Reg/positive/out/test039.out
Normal file
1
tests/Casm/Reg/positive/out/test039.out
Normal file
@ -0,0 +1 @@
|
||||
14
|
@ -10,18 +10,18 @@ function loop() : * {
|
||||
function main() : * {
|
||||
tmp[0] = 3;
|
||||
tmp[1] = 0;
|
||||
tmp[0] = lt tmp[1] tmp[0];
|
||||
tmp[0] = eq tmp[1] tmp[0];
|
||||
br tmp[0], out: tmp[0] {
|
||||
true: {
|
||||
tmp[0] = 1;
|
||||
tmp[0] = call loop ();
|
||||
};
|
||||
false: {
|
||||
tmp[0] = call loop ();
|
||||
tmp[0] = 1;
|
||||
};
|
||||
};
|
||||
tmp[1] = 1;
|
||||
tmp[2] = 2;
|
||||
tmp[1] = le tmp[2] tmp[1];
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1], out: tmp[1] {
|
||||
true: {
|
||||
tmp[1] = call loop (), live: (tmp[0]);
|
||||
@ -29,7 +29,7 @@ function main() : * {
|
||||
false: {
|
||||
tmp[1] = 7;
|
||||
tmp[2] = 8;
|
||||
tmp[1] = le tmp[2] tmp[1];
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1], out: tmp[1] {
|
||||
true: {
|
||||
tmp[1] = call loop (), live: (tmp[0]);
|
||||
|
@ -33,38 +33,36 @@ function apply_1(*, *) : * {
|
||||
function apply_2(*, *, *) : * {
|
||||
tmp[1] = arg[0];
|
||||
tmp[1] = argsnum tmp[1];
|
||||
{
|
||||
n = tmp[1];
|
||||
tmp[1] = n;
|
||||
tmp[2] = 2;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[2];
|
||||
tmp[2] = arg[1];
|
||||
tmp[3] = arg[0];
|
||||
tcall tmp[3] (tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 1;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[2];
|
||||
tmp[2] = arg[1];
|
||||
tmp[3] = arg[0];
|
||||
tmp[2] = call tmp[3] (tmp[2]), live: (tmp[0], tmp[1], arg[0], arg[1], arg[2]);
|
||||
tcall apply_1 (tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
prealloc 7, live: (tmp[0], arg[0], arg[1], arg[2]);
|
||||
tmp[1] = arg[2];
|
||||
tmp[2] = arg[1];
|
||||
tmp[3] = arg[0];
|
||||
tmp[1] = cextend tmp[3] (tmp[2], tmp[1]);
|
||||
ret tmp[1];
|
||||
};
|
||||
n = tmp[1];
|
||||
tmp[1] = n;
|
||||
tmp[2] = 2;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[2];
|
||||
tmp[2] = arg[1];
|
||||
tmp[3] = arg[0];
|
||||
tcall tmp[3] (tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 1;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[2];
|
||||
tmp[2] = arg[1];
|
||||
tmp[3] = arg[0];
|
||||
tmp[2] = call tmp[3] (tmp[2]), live: (tmp[0], tmp[1], arg[0], arg[1], arg[2]);
|
||||
tcall apply_1 (tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
prealloc 7, live: (tmp[0], arg[0], arg[1], arg[2]);
|
||||
tmp[1] = arg[2];
|
||||
tmp[2] = arg[1];
|
||||
tmp[3] = arg[0];
|
||||
tmp[1] = cextend tmp[3] (tmp[2], tmp[1]);
|
||||
ret tmp[1];
|
||||
};
|
||||
};
|
||||
};
|
||||
@ -74,54 +72,52 @@ function apply_2(*, *, *) : * {
|
||||
function apply_3(*, *, *, *) : * {
|
||||
tmp[1] = arg[0];
|
||||
tmp[1] = argsnum tmp[1];
|
||||
{
|
||||
n = tmp[1];
|
||||
tmp[1] = n;
|
||||
tmp[2] = 3;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[3];
|
||||
tmp[2] = arg[2];
|
||||
tmp[3] = arg[1];
|
||||
tmp[4] = arg[0];
|
||||
tcall tmp[4] (tmp[3], tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 3;
|
||||
tmp[1] = lt tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
prealloc 7, live: (tmp[0], arg[0], arg[1], arg[2], arg[3]);
|
||||
tmp[1] = arg[3];
|
||||
tmp[2] = arg[2];
|
||||
tmp[3] = arg[1];
|
||||
tmp[4] = arg[0];
|
||||
tmp[1] = cextend tmp[4] (tmp[3], tmp[2], tmp[1]);
|
||||
ret tmp[1];
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 2;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[3];
|
||||
tmp[2] = arg[2];
|
||||
tmp[3] = arg[1];
|
||||
tmp[4] = arg[0];
|
||||
tmp[2] = call tmp[4] (tmp[3], tmp[2]), live: (tmp[0], tmp[1], arg[0], arg[1], arg[2], arg[3]);
|
||||
tcall apply_1 (tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = arg[3];
|
||||
tmp[2] = arg[2];
|
||||
tmp[3] = arg[1];
|
||||
tmp[4] = arg[0];
|
||||
tmp[3] = call tmp[4] (tmp[3]), live: (tmp[0], tmp[1], tmp[2], arg[0], arg[1], arg[2], arg[3]);
|
||||
tcall apply_2 (tmp[3], tmp[2], tmp[1]);
|
||||
};
|
||||
n = tmp[1];
|
||||
tmp[1] = n;
|
||||
tmp[2] = 3;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[3];
|
||||
tmp[2] = arg[2];
|
||||
tmp[3] = arg[1];
|
||||
tmp[4] = arg[0];
|
||||
tcall tmp[4] (tmp[3], tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 2;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[3];
|
||||
tmp[2] = arg[2];
|
||||
tmp[3] = arg[1];
|
||||
tmp[4] = arg[0];
|
||||
tmp[2] = call tmp[4] (tmp[3], tmp[2]), live: (tmp[0], tmp[1], arg[0], arg[1], arg[2], arg[3]);
|
||||
tcall apply_1 (tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 1;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[3];
|
||||
tmp[2] = arg[2];
|
||||
tmp[3] = arg[1];
|
||||
tmp[4] = arg[0];
|
||||
tmp[3] = call tmp[4] (tmp[3]), live: (tmp[0], tmp[1], tmp[2], arg[0], arg[1], arg[2], arg[3]);
|
||||
tcall apply_2 (tmp[3], tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
prealloc 7, live: (tmp[0], arg[0], arg[1], arg[2], arg[3]);
|
||||
tmp[1] = arg[3];
|
||||
tmp[2] = arg[2];
|
||||
tmp[3] = arg[1];
|
||||
tmp[4] = arg[0];
|
||||
tmp[1] = cextend tmp[4] (tmp[3], tmp[2], tmp[1]);
|
||||
ret tmp[1];
|
||||
};
|
||||
};
|
||||
};
|
||||
@ -133,72 +129,70 @@ function apply_3(*, *, *, *) : * {
|
||||
function apply_4(*, *, *, *, *) : * {
|
||||
tmp[1] = arg[0];
|
||||
tmp[1] = argsnum tmp[1];
|
||||
{
|
||||
n = tmp[1];
|
||||
tmp[1] = n;
|
||||
tmp[2] = 4;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[4];
|
||||
tmp[2] = arg[3];
|
||||
tmp[3] = arg[2];
|
||||
tmp[4] = arg[1];
|
||||
tmp[5] = arg[0];
|
||||
tcall tmp[5] (tmp[4], tmp[3], tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 4;
|
||||
tmp[1] = lt tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
prealloc 7, live: (tmp[0], arg[0], arg[1], arg[2], arg[3], arg[4]);
|
||||
tmp[1] = arg[4];
|
||||
tmp[2] = arg[3];
|
||||
tmp[3] = arg[2];
|
||||
tmp[4] = arg[1];
|
||||
tmp[5] = arg[0];
|
||||
tmp[1] = cextend tmp[5] (tmp[4], tmp[3], tmp[2], tmp[1]);
|
||||
ret tmp[1];
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 3;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[4];
|
||||
tmp[2] = arg[3];
|
||||
tmp[3] = arg[2];
|
||||
tmp[4] = arg[1];
|
||||
tmp[5] = arg[0];
|
||||
tmp[2] = call tmp[5] (tmp[4], tmp[3], tmp[2]), live: (tmp[0], tmp[1], arg[0], arg[1], arg[2], arg[3], arg[4]);
|
||||
tcall apply_1 (tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 2;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[4];
|
||||
tmp[2] = arg[3];
|
||||
tmp[3] = arg[2];
|
||||
tmp[4] = arg[1];
|
||||
tmp[5] = arg[0];
|
||||
tmp[3] = call tmp[5] (tmp[4], tmp[3]), live: (tmp[0], tmp[1], tmp[2], arg[0], arg[1], arg[2], arg[3], arg[4]);
|
||||
tcall apply_2 (tmp[3], tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = arg[4];
|
||||
tmp[2] = arg[3];
|
||||
tmp[3] = arg[2];
|
||||
tmp[4] = arg[1];
|
||||
tmp[5] = arg[0];
|
||||
tmp[4] = call tmp[5] (tmp[4]), live: (tmp[0], tmp[1], tmp[2], tmp[3], arg[0], arg[1], arg[2], arg[3], arg[4]);
|
||||
tcall apply_3 (tmp[4], tmp[3], tmp[2], tmp[1]);
|
||||
};
|
||||
n = tmp[1];
|
||||
tmp[1] = n;
|
||||
tmp[2] = 4;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[4];
|
||||
tmp[2] = arg[3];
|
||||
tmp[3] = arg[2];
|
||||
tmp[4] = arg[1];
|
||||
tmp[5] = arg[0];
|
||||
tcall tmp[5] (tmp[4], tmp[3], tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 3;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[4];
|
||||
tmp[2] = arg[3];
|
||||
tmp[3] = arg[2];
|
||||
tmp[4] = arg[1];
|
||||
tmp[5] = arg[0];
|
||||
tmp[2] = call tmp[5] (tmp[4], tmp[3], tmp[2]), live: (tmp[0], tmp[1], arg[0], arg[1], arg[2], arg[3], arg[4]);
|
||||
tcall apply_1 (tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 2;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[4];
|
||||
tmp[2] = arg[3];
|
||||
tmp[3] = arg[2];
|
||||
tmp[4] = arg[1];
|
||||
tmp[5] = arg[0];
|
||||
tmp[3] = call tmp[5] (tmp[4], tmp[3]), live: (tmp[0], tmp[1], tmp[2], arg[0], arg[1], arg[2], arg[3], arg[4]);
|
||||
tcall apply_2 (tmp[3], tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 1;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[4];
|
||||
tmp[2] = arg[3];
|
||||
tmp[3] = arg[2];
|
||||
tmp[4] = arg[1];
|
||||
tmp[5] = arg[0];
|
||||
tmp[4] = call tmp[5] (tmp[4]), live: (tmp[0], tmp[1], tmp[2], tmp[3], arg[0], arg[1], arg[2], arg[3], arg[4]);
|
||||
tcall apply_3 (tmp[4], tmp[3], tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
prealloc 7, live: (tmp[0], arg[0], arg[1], arg[2], arg[3], arg[4]);
|
||||
tmp[1] = arg[4];
|
||||
tmp[2] = arg[3];
|
||||
tmp[3] = arg[2];
|
||||
tmp[4] = arg[1];
|
||||
tmp[5] = arg[0];
|
||||
tmp[1] = cextend tmp[5] (tmp[4], tmp[3], tmp[2], tmp[1]);
|
||||
ret tmp[1];
|
||||
};
|
||||
};
|
||||
};
|
||||
|
32
tests/Casm/Reg/positive/test039.jvr
Normal file
32
tests/Casm/Reg/positive/test039.jvr
Normal file
@ -0,0 +1,32 @@
|
||||
-- calls in a branch
|
||||
|
||||
function f(integer) : integer {
|
||||
tmp[0] = add arg[0] 1;
|
||||
ret tmp[0];
|
||||
}
|
||||
|
||||
function main() : integer {
|
||||
tmp[0] = 10;
|
||||
tmp[1] = 1;
|
||||
tmp[2] = eq tmp[0] tmp[1];
|
||||
br tmp[2], out: tmp[4] {
|
||||
true: {
|
||||
tmp[4] = 0;
|
||||
};
|
||||
false: {
|
||||
tmp[3] = call f(tmp[1]);
|
||||
tmp[4] = eq tmp[3] tmp[3];
|
||||
br tmp[4], out: tmp[4] {
|
||||
true: {
|
||||
tmp[4] = call f(tmp[3]);
|
||||
tmp[4] = call f(tmp[4]);
|
||||
};
|
||||
false: {
|
||||
tmp[4] = 1;
|
||||
};
|
||||
};
|
||||
};
|
||||
};
|
||||
tmp[5] = add tmp[4] tmp[0];
|
||||
ret tmp[5];
|
||||
}
|
@ -33,38 +33,36 @@ function apply_1(*, *) : * {
|
||||
function apply_2(*, *, *) : * {
|
||||
tmp[1] = arg[0];
|
||||
tmp[1] = argsnum tmp[1];
|
||||
{
|
||||
n = tmp[1];
|
||||
tmp[1] = n;
|
||||
tmp[2] = 2;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[2];
|
||||
tmp[2] = arg[1];
|
||||
tmp[3] = arg[0];
|
||||
tcall tmp[3] (tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 1;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[2];
|
||||
tmp[2] = arg[1];
|
||||
tmp[3] = arg[0];
|
||||
tmp[2] = call tmp[3] (tmp[2]), live: (tmp[0], tmp[1], arg[0], arg[1], arg[2]);
|
||||
tcall apply_1 (tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
prealloc 7, live: (tmp[0], arg[0], arg[1], arg[2]);
|
||||
tmp[1] = arg[2];
|
||||
tmp[2] = arg[1];
|
||||
tmp[3] = arg[0];
|
||||
tmp[1] = cextend tmp[3] (tmp[2], tmp[1]);
|
||||
ret tmp[1];
|
||||
};
|
||||
n = tmp[1];
|
||||
tmp[1] = n;
|
||||
tmp[2] = 2;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[2];
|
||||
tmp[2] = arg[1];
|
||||
tmp[3] = arg[0];
|
||||
tcall tmp[3] (tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 1;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[2];
|
||||
tmp[2] = arg[1];
|
||||
tmp[3] = arg[0];
|
||||
tmp[2] = call tmp[3] (tmp[2]), live: (tmp[0], tmp[1], arg[0], arg[1], arg[2]);
|
||||
tcall apply_1 (tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
prealloc 7, live: (tmp[0], arg[0], arg[1], arg[2]);
|
||||
tmp[1] = arg[2];
|
||||
tmp[2] = arg[1];
|
||||
tmp[3] = arg[0];
|
||||
tmp[1] = cextend tmp[3] (tmp[2], tmp[1]);
|
||||
ret tmp[1];
|
||||
};
|
||||
};
|
||||
};
|
||||
@ -74,54 +72,52 @@ function apply_2(*, *, *) : * {
|
||||
function apply_3(*, *, *, *) : * {
|
||||
tmp[1] = arg[0];
|
||||
tmp[1] = argsnum tmp[1];
|
||||
{
|
||||
n = tmp[1];
|
||||
tmp[1] = n;
|
||||
tmp[2] = 3;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[3];
|
||||
tmp[2] = arg[2];
|
||||
tmp[3] = arg[1];
|
||||
tmp[4] = arg[0];
|
||||
tcall tmp[4] (tmp[3], tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 3;
|
||||
tmp[1] = lt tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
prealloc 7, live: (tmp[0], arg[0], arg[1], arg[2], arg[3]);
|
||||
tmp[1] = arg[3];
|
||||
tmp[2] = arg[2];
|
||||
tmp[3] = arg[1];
|
||||
tmp[4] = arg[0];
|
||||
tmp[1] = cextend tmp[4] (tmp[3], tmp[2], tmp[1]);
|
||||
ret tmp[1];
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 2;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[3];
|
||||
tmp[2] = arg[2];
|
||||
tmp[3] = arg[1];
|
||||
tmp[4] = arg[0];
|
||||
tmp[2] = call tmp[4] (tmp[3], tmp[2]), live: (tmp[0], tmp[1], arg[0], arg[1], arg[2], arg[3]);
|
||||
tcall apply_1 (tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = arg[3];
|
||||
tmp[2] = arg[2];
|
||||
tmp[3] = arg[1];
|
||||
tmp[4] = arg[0];
|
||||
tmp[3] = call tmp[4] (tmp[3]), live: (tmp[0], tmp[1], tmp[2], arg[0], arg[1], arg[2], arg[3]);
|
||||
tcall apply_2 (tmp[3], tmp[2], tmp[1]);
|
||||
};
|
||||
n = tmp[1];
|
||||
tmp[1] = n;
|
||||
tmp[2] = 3;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[3];
|
||||
tmp[2] = arg[2];
|
||||
tmp[3] = arg[1];
|
||||
tmp[4] = arg[0];
|
||||
tcall tmp[4] (tmp[3], tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 2;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[3];
|
||||
tmp[2] = arg[2];
|
||||
tmp[3] = arg[1];
|
||||
tmp[4] = arg[0];
|
||||
tmp[2] = call tmp[4] (tmp[3], tmp[2]), live: (tmp[0], tmp[1], arg[0], arg[1], arg[2], arg[3]);
|
||||
tcall apply_1 (tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 1;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[3];
|
||||
tmp[2] = arg[2];
|
||||
tmp[3] = arg[1];
|
||||
tmp[4] = arg[0];
|
||||
tmp[3] = call tmp[4] (tmp[3]), live: (tmp[0], tmp[1], tmp[2], arg[0], arg[1], arg[2], arg[3]);
|
||||
tcall apply_2 (tmp[3], tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
prealloc 7, live: (tmp[0], arg[0], arg[1], arg[2], arg[3]);
|
||||
tmp[1] = arg[3];
|
||||
tmp[2] = arg[2];
|
||||
tmp[3] = arg[1];
|
||||
tmp[4] = arg[0];
|
||||
tmp[1] = cextend tmp[4] (tmp[3], tmp[2], tmp[1]);
|
||||
ret tmp[1];
|
||||
};
|
||||
};
|
||||
};
|
||||
@ -133,72 +129,70 @@ function apply_3(*, *, *, *) : * {
|
||||
function apply_4(*, *, *, *, *) : * {
|
||||
tmp[1] = arg[0];
|
||||
tmp[1] = argsnum tmp[1];
|
||||
{
|
||||
n = tmp[1];
|
||||
tmp[1] = n;
|
||||
tmp[2] = 4;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[4];
|
||||
tmp[2] = arg[3];
|
||||
tmp[3] = arg[2];
|
||||
tmp[4] = arg[1];
|
||||
tmp[5] = arg[0];
|
||||
tcall tmp[5] (tmp[4], tmp[3], tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 4;
|
||||
tmp[1] = lt tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
prealloc 7, live: (tmp[0], arg[0], arg[1], arg[2], arg[3], arg[4]);
|
||||
tmp[1] = arg[4];
|
||||
tmp[2] = arg[3];
|
||||
tmp[3] = arg[2];
|
||||
tmp[4] = arg[1];
|
||||
tmp[5] = arg[0];
|
||||
tmp[1] = cextend tmp[5] (tmp[4], tmp[3], tmp[2], tmp[1]);
|
||||
ret tmp[1];
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 3;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[4];
|
||||
tmp[2] = arg[3];
|
||||
tmp[3] = arg[2];
|
||||
tmp[4] = arg[1];
|
||||
tmp[5] = arg[0];
|
||||
tmp[2] = call tmp[5] (tmp[4], tmp[3], tmp[2]), live: (tmp[0], tmp[1], arg[0], arg[1], arg[2], arg[3], arg[4]);
|
||||
tcall apply_1 (tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 2;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[4];
|
||||
tmp[2] = arg[3];
|
||||
tmp[3] = arg[2];
|
||||
tmp[4] = arg[1];
|
||||
tmp[5] = arg[0];
|
||||
tmp[3] = call tmp[5] (tmp[4], tmp[3]), live: (tmp[0], tmp[1], tmp[2], arg[0], arg[1], arg[2], arg[3], arg[4]);
|
||||
tcall apply_2 (tmp[3], tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = arg[4];
|
||||
tmp[2] = arg[3];
|
||||
tmp[3] = arg[2];
|
||||
tmp[4] = arg[1];
|
||||
tmp[5] = arg[0];
|
||||
tmp[4] = call tmp[5] (tmp[4]), live: (tmp[0], tmp[1], tmp[2], tmp[3], arg[0], arg[1], arg[2], arg[3], arg[4]);
|
||||
tcall apply_3 (tmp[4], tmp[3], tmp[2], tmp[1]);
|
||||
};
|
||||
n = tmp[1];
|
||||
tmp[1] = n;
|
||||
tmp[2] = 4;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[4];
|
||||
tmp[2] = arg[3];
|
||||
tmp[3] = arg[2];
|
||||
tmp[4] = arg[1];
|
||||
tmp[5] = arg[0];
|
||||
tcall tmp[5] (tmp[4], tmp[3], tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 3;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[4];
|
||||
tmp[2] = arg[3];
|
||||
tmp[3] = arg[2];
|
||||
tmp[4] = arg[1];
|
||||
tmp[5] = arg[0];
|
||||
tmp[2] = call tmp[5] (tmp[4], tmp[3], tmp[2]), live: (tmp[0], tmp[1], arg[0], arg[1], arg[2], arg[3], arg[4]);
|
||||
tcall apply_1 (tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 2;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[4];
|
||||
tmp[2] = arg[3];
|
||||
tmp[3] = arg[2];
|
||||
tmp[4] = arg[1];
|
||||
tmp[5] = arg[0];
|
||||
tmp[3] = call tmp[5] (tmp[4], tmp[3]), live: (tmp[0], tmp[1], tmp[2], arg[0], arg[1], arg[2], arg[3], arg[4]);
|
||||
tcall apply_2 (tmp[3], tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
tmp[1] = n;
|
||||
tmp[2] = 1;
|
||||
tmp[1] = eq tmp[2] tmp[1];
|
||||
br tmp[1] {
|
||||
true: {
|
||||
tmp[1] = arg[4];
|
||||
tmp[2] = arg[3];
|
||||
tmp[3] = arg[2];
|
||||
tmp[4] = arg[1];
|
||||
tmp[5] = arg[0];
|
||||
tmp[4] = call tmp[5] (tmp[4]), live: (tmp[0], tmp[1], tmp[2], tmp[3], arg[0], arg[1], arg[2], arg[3], arg[4]);
|
||||
tcall apply_3 (tmp[4], tmp[3], tmp[2], tmp[1]);
|
||||
};
|
||||
false: {
|
||||
prealloc 7, live: (tmp[0], arg[0], arg[1], arg[2], arg[3], arg[4]);
|
||||
tmp[1] = arg[4];
|
||||
tmp[2] = arg[3];
|
||||
tmp[3] = arg[2];
|
||||
tmp[4] = arg[1];
|
||||
tmp[5] = arg[0];
|
||||
tmp[1] = cextend tmp[5] (tmp[4], tmp[3], tmp[2], tmp[1]);
|
||||
ret tmp[1];
|
||||
};
|
||||
};
|
||||
};
|
||||
|
@ -32,11 +32,11 @@ function apply_3(*, *, *, *) : * {
|
||||
save[n](argsnum(arg[0])) {
|
||||
br(eq(3, n)) {
|
||||
true: call(arg[0], arg[1], arg[2], arg[3])
|
||||
false: br(lt(3, n)) {
|
||||
true: cextend(arg[0], arg[1], arg[2], arg[3])
|
||||
false: br(eq(2, n)) {
|
||||
true: call[apply_1](call(arg[0], arg[1], arg[2]), arg[3])
|
||||
false: call[apply_2](call(arg[0], arg[1]), arg[2], arg[3])
|
||||
false: br(eq(2, n)) {
|
||||
true: call[apply_1](call(arg[0], arg[1], arg[2]), arg[3])
|
||||
false: br(eq(1, n)) {
|
||||
true: call[apply_2](call(arg[0], arg[1]), arg[2], arg[3])
|
||||
false: cextend(arg[0], arg[1], arg[2], arg[3])
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -47,13 +47,13 @@ function apply_4(*, *, *, *, *) : * {
|
||||
save[n](argsnum(arg[0])) {
|
||||
br(eq(4, n)) {
|
||||
true: call(arg[0], arg[1], arg[2], arg[3], arg[4])
|
||||
false: br(lt(4, n)) {
|
||||
true: cextend(arg[0], arg[1], arg[2], arg[3], arg[4])
|
||||
false: br(eq(3, n)) {
|
||||
true: call[apply_1](call(arg[0], arg[1], arg[2], arg[3]), arg[4])
|
||||
false: br(eq(2, n)) {
|
||||
true: call[apply_2](call(arg[0], arg[1], arg[2]), arg[3], arg[4])
|
||||
false: call[apply_3](call(arg[0], arg[1]), arg[2], arg[3], arg[4])
|
||||
false: br(eq(3, n)) {
|
||||
true: call[apply_1](call(arg[0], arg[1], arg[2], arg[3]), arg[4])
|
||||
false: br(eq(2, n)) {
|
||||
true: call[apply_2](call(arg[0], arg[1], arg[2]), arg[3], arg[4])
|
||||
false: br(eq(1, n)) {
|
||||
true: call[apply_3](call(arg[0], arg[1]), arg[2], arg[3], arg[4])
|
||||
false: cextend(arg[0], arg[1], arg[2], arg[3], arg[4])
|
||||
}
|
||||
}
|
||||
}
|
||||
|
Loading…
Reference in New Issue
Block a user