From 5737e8430d43b3b5bd448f761cd2f3c35707a174 Mon Sep 17 00:00:00 2001 From: Rose Hogenson Date: Sun, 28 Apr 2024 15:06:43 -0700 Subject: Add case over int. --- elab.sml | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) (limited to 'elab.sml') diff --git a/elab.sml b/elab.sml index cc73c98..f6f2e38 100644 --- a/elab.sml +++ b/elab.sml @@ -39,17 +39,23 @@ struct val v = Gensym.new () val env' = case pat of - Syntax.PWild => env - | Syntax.PVar name => StringMap.insert name v env + Syntax.PVar name => StringMap.insert name v env + | _ => env in Syntax.LFn (v, elab env' body) end | Syntax.ECase (expr, []) => raise Fail "nonexhaustive match" - | Syntax.ECase (expr, (pat, body) :: rest) => - if not (null rest) then raise Fail "redundant match" else - let val v = Gensym.new () in - case pat of - Syntax.PWild => Syntax.LApp (Syntax.LFn (v, elab env body), elab env expr) - | Syntax.PVar name => Syntax.LApp (Syntax.LFn (v, elab (StringMap.insert name v env) body), elab env expr) + | Syntax.ECase (expr, arms) => + let + fun go [] _ = raise Fail "nonexhaustive match" + | go ((Syntax.PWild, body) :: []) acc = Syntax.LSwitch (elab env expr, rev acc, elab env body) + | go ((Syntax.PVar name, body) :: []) acc = + let val v = Gensym.new () in + Syntax.LApp (Syntax.LFn (v, Syntax.LSwitch (Syntax.LVar v, rev acc, elab (StringMap.insert name v env) body)), elab env expr) + end + | go ((Syntax.PInt i, body) :: rest) acc = + go rest ((i, elab env body) :: acc) + | go _ _ = raise Fail "redundant match" + in go arms [] end fun elaborate (p : Syntax.expr) : Syntax.lexp = elab StringMap.empty p -- cgit v1.3.1