diff options
Diffstat (limited to 'Sjit/Compile.icl')
| -rw-r--r-- | Sjit/Compile.icl | 43 |
1 files changed, 29 insertions, 14 deletions
diff --git a/Sjit/Compile.icl b/Sjit/Compile.icl index 527676f..b5ea1bf 100644 --- a/Sjit/Compile.icl +++ b/Sjit/Compile.icl @@ -98,13 +98,10 @@ where Pop n -> 0-n Call _ -> 0 Jmp _ -> 0 - JmpTrue _ -> 0 + JmpCond c _ -> if (c=:CTrue) -1 -2 Ret -> -1 Halt -> -2 - IAdd -> -1 - IMul -> -1 - ISub -> -1 - IDiv -> -1 + Op _ -> -1 PlaceHolder _ n -> n reserve :: !Int !CompileState -> m (!Int, !CompileState) | Monad m @@ -152,20 +149,38 @@ where # args = if (args=:[]) [Int 0] args = foldM (flip expr) cs (reverse args) >>= \cs -> case get f cs.funs of Nothing -> case f of - "+" -> gen [IAdd] cs - "-" -> gen [ISub] cs - "*" -> gen [IMul] cs - "/" -> gen [IDiv] cs - _ -> Left ("undefined function '" +++ toString f +++ "'") + "+" -> gen [Op OAdd] cs + "-" -> gen [Op OSub] cs + "*" -> gen [Op OMul] cs + "/" -> gen [Op ODiv] cs + _ -> Left ("undefined function '" +++ toString f +++ "'") Just f -> case length args of 1 -> gen [Call f] cs n -> gen [Pop (n-1),Call f] cs + expr (If (App cond [a,b]) t e) cs | isJust condop = + expr a cs >>= + expr b >>= + reserve -2 >>= \(jmpcond,cs=:{sp=orgsp}) -> + expr e cs >>= + reserve 0 >>= \(jmpend,cs) -> + fillPlaceHolder jmpcond (JmpCond (fromJust condop) cs.pc) {cs & sp=orgsp} >>= + expr t >>= \cs -> + fillPlaceHolder jmpend (Jmp cs.pc) cs + where + condop = case cond of + "==" -> Just CEq + "<>" -> Just CNe + "<" -> Just CLt + "<=" -> Just CLe + ">" -> Just CGt + ">=" -> Just CGe + _ -> Nothing expr (If b t e) cs = expr b cs >>= - reserve -1 >>= \(jmptrue,cs=:{sp=orgsp}) -> + reserve -1 >>= \(jmpcond,cs=:{sp=orgsp}) -> expr e cs >>= reserve 0 >>= \(jmpend,cs) -> - fillPlaceHolder jmptrue (JmpTrue cs.pc) {cs & sp=orgsp} >>= + fillPlaceHolder jmpcond (JmpCond CTrue cs.pc) {cs & sp=orgsp} >>= expr t >>= \cs -> fillPlaceHolder jmpend (Jmp cs.pc) cs @@ -198,8 +213,8 @@ gEncode{|EITHER|} _ fr (RIGHT r) i arr = fr r i arr gEncode{|CONS of {gcd_index}|} fx (CONS x) i arr = fx x (i+1) {arr & [i]=gcd_index} gEncode{|OBJECT|} fx (OBJECT x) i arr = fx x i arr -derive gEncodedSize Instr -derive gEncode Instr +derive gEncodedSize Cond, Op, Instr +derive gEncode Cond, Op, Instr encode :: !a -> *{#Int} | gEncodedSize{|*|}, gEncode{|*|} a encode x |