summaryrefslogtreecommitdiffstats
path: root/cps.sml
diff options
context:
space:
mode:
Diffstat (limited to 'cps.sml')
-rw-r--r--cps.sml44
1 files changed, 25 insertions, 19 deletions
diff --git a/cps.sml b/cps.sml
index 894c57e..83d07f7 100644
--- a/cps.sml
+++ b/cps.sml
@@ -67,23 +67,26 @@ struct
val contAddr = Gensym.new ()
val otherwiseAddr = Gensym.new ()
val arg = Gensym.new ()
- fun go _ [] cont = toCPS otherwise cont
+ fun go _ [] cont = Syntax.CApp (Syntax.VVar otherwiseAddr, [])
| 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, Syntax.CApp (Syntax.VVar otherwiseAddr, [])]
- )
- ]
- )
- end
+ (case otherwise of
+ NONE => toCPS arm cont
+ | SOME _ =>
+ 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, Syntax.CApp (Syntax.VVar otherwiseAddr, [])]
+ )
+ ]
+ )
+ end)
| go v arms cont =
let
val b = Gensym.new ()
@@ -106,11 +109,14 @@ struct
)
end
fun contFunc x = Syntax.CApp (Syntax.VVar contAddr, [x])
+ val fixFuncs = [(contAddr, [arg], cont (Syntax.VVar arg))]
+ val fixFuncs =
+ case otherwise of
+ NONE => fixFuncs
+ | SOME otherwise => (otherwiseAddr, [], toCPS otherwise contFunc) :: fixFuncs
in
Syntax.CFix
- ( [ (contAddr, [arg], cont (Syntax.VVar arg))
- , (otherwiseAddr, [], toCPS otherwise contFunc)
- ]
+ ( fixFuncs
, toCPS expr (fn v => go v sortedArms contFunc)
)
end