61 lines
1.8 KiB
Haskell
61 lines
1.8 KiB
Haskell
module Main where
|
|
|
|
bits :: Int
|
|
bits = 64
|
|
|
|
type Assembly = ([String], Int)
|
|
|
|
emitPush :: Int -> Assembly -> Assembly
|
|
emitPush toPush (code, tos) = (code ++ newCode, newTos)
|
|
where newCode = [ "; push"
|
|
, "mov rcx, " ++ show toPush
|
|
, "mov [rsp+" ++ (show $ tos + bits) ++ "], rcx"
|
|
]
|
|
newTos = tos + bits
|
|
|
|
emitAdd :: Assembly -> Assembly
|
|
emitAdd (code, tos) = (code ++ newCode, newTos)
|
|
where newCode = [ "; add"
|
|
, "mov rcx, [rsp+" ++ show tos ++ "]"
|
|
, "add rcx, [rsp+" ++ show newTos ++ "]"
|
|
, "mov [rsp+" ++ show newTos ++ "], rcx"
|
|
]
|
|
newTos = tos - bits
|
|
|
|
emitPrint :: Assembly -> Assembly
|
|
emitPrint (code, tos) = (code ++ newCode, newTos)
|
|
where newCode = [ "; print"
|
|
, "mov rbx, [rsp+" ++ show tos ++ "]"
|
|
, "call p"
|
|
]
|
|
newTos = tos - bits
|
|
|
|
emitDup :: Assembly -> Assembly
|
|
emitDup (code, tos) = (code ++ newCode, newTos)
|
|
where newCode = [ "; dup"
|
|
, "mov rcx, [rsp+" ++ show tos ++ "]"
|
|
, "mov [rsp+" ++ show newTos ++ "], rcx"
|
|
]
|
|
newTos = tos + bits
|
|
|
|
isNumber :: String -> Bool
|
|
isNumber s = case (reads s) :: [(Int, String)] of
|
|
[(_, "")] -> True
|
|
_ -> False
|
|
|
|
emitCode :: String -> Assembly -> Assembly
|
|
emitCode instr asm
|
|
| isNumber instr = emitPush (read instr) asm
|
|
| instr == "+" = emitAdd asm
|
|
| instr == "p" = emitPrint asm
|
|
| instr == "dup" = emitDup asm
|
|
|
|
emitLoop :: [String] -> Assembly -> Assembly
|
|
emitLoop [] asm = asm
|
|
emitLoop instrs asm = emitLoop (tail instrs) $ emitCode (head instrs) asm
|
|
|
|
emitLoopEntry ss = emitLoop ss ([], 0)
|
|
|
|
main = interact $ foldr1 (++) . map (\line -> line ++ "\n") . fst . emitLoopEntry . words
|
|
-- main = undefined
|