diff options
| author |  Adam Chlipala <adam@chlipala.net> | 2016-02-07 19:59:10 -0500 |
|---|---|---|
| committer | Adam Chlipala <adam@chlipala.net> | 2016-02-07 19:59:10 -0500 |
| commit | 5579b84a97cb942fdfd4c4898793f9de95bc03d1 (patch) | |
| tree | 2fd60da2fe681fa69d712efdeb36b720c72b9820 /src/elaborate.sml | |
| parent | a777dd13f4075418ec883f4eb42e5de1739d50d1 (diff) | |
Merge PVar and PWild, to get more reasonable type-class resolution
Diffstat (limited to 'src/elaborate.sml')
| -rw-r--r-- | src/elaborate.sml | 22 |
1 files changed, 10 insertions, 12 deletions
diff --git a/src/elaborate.sml b/src/elaborate.sml index 2dfbf5b2..9765b090 100644 --- a/src/elaborate.sml +++ b/src/elaborate.sml @@ -1526,8 +1526,8 @@ fun elabPat (pAll as (p, loc), (env, bound)) = let - val perror = (L'.PWild, loc) val terror = (L'.CError, loc) + val perror = (L'.PVar ("_", terror), loc) val pterror = (perror, terror) val rerror = (pterror, (env, bound)) @@ -1563,9 +1563,7 @@ fun elabPat (pAll as (p, loc), (env, bound)) = end in case p of - L.PWild => (((L'.PWild, loc), cunif env (loc, (L'.KType, loc))), - (env, bound)) - | L.PVar x => + L.PVar x => let val t = if SS.member (bound, x) then (expError env (DuplicatePatternVariable (loc, x)); @@ -1642,6 +1640,8 @@ fun elabPat (pAll as (p, loc), (env, bound)) = (* This exhaustiveness checking follows Luc Maranget's paper "Warnings for pattern matching." *) fun exhaustive (env, t, ps, loc) = let + val pwild = L'.PVar ("_", t) + fun fail n = raise Fail ("Elaborate.exhaustive: Impossible " ^ Int.toString n) fun patConNum pc = @@ -1683,7 +1683,7 @@ fun exhaustive (env, t, ps, loc) = val loc = #2 p1 fun wild () = - SOME (map (fn _ => (L'.PWild, loc)) args @ ps) + SOME (map (fn _ => (pwild, loc)) args @ ps) in case #1 p1 of L'.PPrim _ => NONE @@ -1704,9 +1704,8 @@ fun exhaustive (env, t, ps, loc) = SOME p else NONE) xpts of - NONE => (L'.PWild, loc) + NONE => (pwild, loc) | SOME p => p) args @ ps) - | L'.PWild => wild () | L'.PVar _ => wild () end) P @@ -1716,8 +1715,7 @@ fun exhaustive (env, t, ps, loc) = (fn [] => fail 2 | (p1, _) :: ps => case p1 of - L'.PWild => SOME ps - | L'.PVar _ => SOME ps + L'.PVar _ => SOME ps | L'.PPrim _ => NONE | L'.PCon _ => NONE | L'.PRecord _ => NONE) @@ -1847,8 +1845,8 @@ fun exhaustive (env, t, ps, loc) = | SOME ps => let val p = case cons of - [] => L'.PWild - | (0, _) :: _ => L'.PWild + [] => pwild + | (0, _) :: _ => pwild | _ => case IS.find (fn _ => true) unused of NONE => fail 6 @@ -1861,7 +1859,7 @@ fun exhaustive (env, t, ps, loc) = SOME (n, []) => L'.PCon (L'.Default, nameOfNum (#1 t1, n), [], NONE) | SOME (n, [_]) => - L'.PCon (L'.Default, nameOfNum (#1 t1, n), [], SOME (L'.PWild, loc)) + L'.PCon (L'.Default, nameOfNum (#1 t1, n), [], SOME (pwild, loc)) | _ => fail 7 in SOME ((p, loc) :: ps) |