diff options
Diffstat (limited to 'cps.sml')
| -rw-r--r-- | cps.sml | 53 |
1 files changed, 53 insertions, 0 deletions
@@ -57,6 +57,59 @@ struct toCPS expr (fn v => go exprs (v :: vars)) in go exprs [] end + | Syntax.LSwitch (expr, arms, otherwise) => + let + val sortedArms = Sort.sort (fn ((x, _), (y, _)) => Int.compare (x, y)) arms + val addr = Gensym.new () + val arg = Gensym.new () + fun go _ [] cont = toCPS otherwise cont + | go v [(x, arm)] cont = + let val b = Gensym.new () + in + Syntax.CPrimop + ( Syntax.PEq + , [v, Syntax.VInt x] + , [b] + , [ Syntax.CPrimop + ( Syntax.PIf + , [Syntax.VVar b] + , [] + , [toCPS arm cont, toCPS otherwise cont] + ) + ] + ) + end + | go v arms cont = + let + val b = Gensym.new () + val h = length arms div 2 + val half1 = List.take (arms, h) + val half2 = List.drop (arms, h) + val (x, _) = hd half2 + in + Syntax.CPrimop + ( Syntax.PLess + , [v, Syntax.VInt x] + , [b] + , [ Syntax.CPrimop + ( Syntax.PIf + , [Syntax.VVar b] + , [] + , [go v half1 cont, go v half2 cont] + ) + ] + ) + end + in + Syntax.CFix + ( [(addr, [arg], cont (Syntax.VVar arg))] + , toCPS expr + (fn v => + go v sortedArms + (fn x => + Syntax.CApp (Syntax.VVar addr, [x]))) + ) + end | _ => raise Fail ("malformed expression " ^ Syntax.lexpToString e) fun hoist (expr : Syntax.cexp) : Syntax.cexp = |