diff options
Diffstat (limited to 'Sjit')
| -rw-r--r-- | Sjit/Compile.dcl | 13 | ||||
| -rw-r--r-- | Sjit/Compile.icl | 72 |
2 files changed, 51 insertions, 34 deletions
diff --git a/Sjit/Compile.dcl b/Sjit/Compile.dcl index 166b5c4..7cb74e3 100644 --- a/Sjit/Compile.dcl +++ b/Sjit/Compile.dcl @@ -23,12 +23,13 @@ from Sjit.Syntax import :: Function :: Program :== {!Instr} :: CompileState = - { vars :: !Map String Int - , funs :: !Map String Int - , sp :: !Int - , pc :: !Int - , blocks :: ![!Program!] - , jitst :: !JITState + { vars :: !Map String Int + , funs :: !Map String Int + , sp :: !Int + , pc :: !Int + , blocks :: ![!Program!] + , new_block :: ![!Instr!] + , jitst :: !JITState } :: JITState = diff --git a/Sjit/Compile.icl b/Sjit/Compile.icl index 96db7f2..4f10096 100644 --- a/Sjit/Compile.icl +++ b/Sjit/Compile.icl @@ -40,12 +40,13 @@ bootstrap # is = {i \\ i <- flatten [is \\ (_,is) <- header]} = ( is, - { vars = newMap - , funs = fromList bs_funs - , sp = 0 - , pc = len_bs - , blocks = [!is!] - , jitst = appendProgram False is (initJITState 1000) + { vars = newMap + , funs = fromList bs_funs + , sp = 0 + , pc = len_bs + , blocks = [!is!] + , new_block = [!!] + , jitst = appendProgram False is (initJITState 1000) }) where bootstrap_funs :: (!Int, ![(String, Int)]) @@ -83,6 +84,29 @@ where ccall init_jit "II:Vpp" } +class toInstrs a :: !a -> [Instr] +instance toInstrs Instr where toInstrs i = [i] +instance toInstrs [a] | toInstrs a where toInstrs xs = [i \\ x <- xs, i <- toInstrs x] + +gen :: !newis !CompileState -> m CompileState | Monad m & toInstrs newis +gen newis cs = pure (foldr add cs (toInstrs newis)) +where + add i cs = {cs & new_block=[!i:cs.new_block!], sp=sp, pc=cs.pc+1} + where + sp = cs.sp + case i of + PushRef _ -> 1 + PushI _ -> 1 + Put _ -> -1 + Pop n -> 0-n + Call _ -> 1 + JmpRelTrue _ -> 0 + Ret -> -1 + Halt -> -2 + IAddRet -> -1 + IMulRet -> -1 + ISubRet -> -1 + IDivRet -> -1 + compile :: !Function !CompileState -> Either String CompileState compile f cs # cs & funs = put f.fun_name cs.pc cs.funs @@ -90,36 +114,28 @@ compile f cs # cs & vars = foldr (uncurry put) cs.vars [(v,sp) \\ v <- f.fun_args & sp <- [cs.sp+1..]] = case expr f.fun_expr cs of Left e -> Left e - Right (is,cs) - # is = {i \\ i <- reverse [Ret:Put (max 1 (length f.fun_args)+1):is]} + Right cs + # is = {i \\ i <|- Reverse [!Ret:Put (max 1 (length f.fun_args)+1):cs.new_block!]} -> Right { cs - & vars = vars - , pc = cs.pc+2 - , blocks = cs.blocks ++| [!is!] - , jitst = appendProgram (f.fun_name == "main") is cs.jitst + & vars = vars + , pc = cs.pc+2 + , blocks = cs.blocks ++| [!is!] + , new_block = [!!] + , jitst = appendProgram (f.fun_name == "main") is cs.jitst } where - expr :: !Expr !CompileState -> Either String (![Instr], !CompileState) - expr (Int i) cs = Right ([PushI i], {cs & sp=cs.sp+1, pc=cs.pc+1}) - expr (Bool b) cs = Right ([PushI (if b 1 0)], {cs & sp=cs.sp+1, pc=cs.pc+1}) + expr :: !Expr !CompileState -> Either String CompileState + expr (Int i) cs = gen (PushI i) cs + expr (Bool b) cs = gen (PushI (if b 1 0)) cs expr (Var v) cs = case get v cs.vars of - Just i -> Right ([PushRef (i-cs.sp)], {cs & sp=cs.sp+1, pc=cs.pc+1}) + Just i -> gen (PushRef (i-cs.sp)) cs Nothing -> Left ("undefined variable '" +++ v +++ "'") expr (App f args) cs # args = if (args=:[]) [Int 0] args - = case mapStM expr args {cs & sp=cs.sp+1} of - Left e -> Left e - Right (iss,cs) -> case get f cs.funs of - Just f -> Right - ( [Pop (length args-1):Call f:flatten iss] - , {cs & sp=cs.sp+2-length args, pc=cs.pc+2} - ) - Nothing -> Left ("undefined function '" +++ toString f +++ "'") - - mapStM :: !(a st -> m (b, st)) ![a] !st -> m ([b], st) | Monad m - mapStM _ [] st = pure ([], st) - mapStM f [x:xs] st = f x st >>= \(y,st) -> mapStM f xs st >>= \(ys,st) -> pure ([y:ys],st) + = foldM (flip expr) {cs & sp=cs.sp+1} (reverse args) >>= \cs -> case get f cs.funs of + Nothing -> Left ("undefined function '" +++ toString f +++ "'") + Just f -> gen [Pop (length args-1),Call f] cs generic gEncodedSize a :: !a -> Int gEncodedSize{|Int|} _ = 1 |