(-.) = binop Sub
(/.) = binop Div
(*.) = binop Mul
- (^.) = binop Pow
--- (^.) l r = freshLabel >>= \lblstart->freshLabel >>= \lblend->
--- l >> r >> instr -- pow (x, y) {
--- [ Str 1
--- , Str 0
--- , Push 1 -- res = 1
--- , Lbl lblstart -- while
--- , Ldr 1 -- (y == 0)
--- , Push 0 --
--- , Neq --
--- , Brf lblend --
--- , Ldr 0 -- res *= x
--- , Mul --
--- , Ldr 1 -- y -= 1
--- , Push 1 --
--- , Sub --
--- , Str 1 --
--- , Bra lblstart --
--- , Lbl lblend --
--- ]
neg = unop Neg
(&.) = binop And
(|.) = binop Or
let g :- m = def (\(a, b, c)->a >> b >> c >> instr [Jsr funlabel])
in liftFunction funlabel 3 (g (instr [Arg 2], instr [Arg 1], instr [Arg 0])) >> unmain m
+instance Function (Compiler a, Compiler b, Compiler c, Compiler d) Compiler where
+ fun def = Main $
+ freshLabel >>= \funlabel->
+ let g :- m = def (\(a, b, c, d)->a >> b >> c >> d >> instr [Jsr funlabel])
+ in liftFunction funlabel 4 (g (instr [Arg 3], instr [Arg 2], instr [Arg 1], instr [Arg 0])) >> unmain m
+
liftFunction :: Int -> Int -> Compiler a -> Compiler ()
liftFunction lbl nargs body = do
is <- snd <$> censor (\_->[]) (listen body)
modify (\s->s { functions=DM.insert lbl instructions $ functions s })
data Instr
- = Push Int | Pop Int -- | Dup | Roll Int Int
- | Add | Sub | Mul | Div | Neg | Pow
+ = Push Int | Pop Int
+ | Add | Sub | Mul | Div | Neg
| And | Or | Not
| Eq | Neq | Le | Ge | Leq | Geq
| Lbl Int | Bra Int | Brf Int
int :: STArray s Int Instr -> STArray s Int Int -> Registers -> ST s (STArray s Int Int)
int program memory registers = do
instruction <- readArray program $ pc registers
- stack <- getElems memory
+-- stack <- getElems memory
let reg = registers { pc = pc registers + 1 }
- case trace ("Interpret: " ++ show instruction ++ " with registers: " ++ show registers ++ " and stack: " ++ show stack) instruction of
--- case instruction of
+-- case trace ("Interpret: " ++ show instruction ++ " with registers: " ++ show registers ++ " and stack: " ++ show stack) instruction of
+ case instruction of
Str r -> do
(reg', v) <- pop memory reg
int program memory $ reg' { gp = DM.insert r v (gp reg')}
Mul -> bop (*) memory reg >>= int program memory
Div -> bop div memory reg >>= int program memory
Neg -> uop negate memory reg >>= int program memory
- Pow -> bop (^) memory reg >>= int program memory
And -> bop ((b2i .) . on (&&) i2b) memory reg >>= int program memory
Or -> bop ((b2i .) . on (||) i2b) memory reg >>= int program memory
Not -> uop (b2i . Prelude.not . i2b) memory reg >>= int program memory