summaryrefslogtreecommitdiff
path: root/compiler/deSugar/Check.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/deSugar/Check.hs')
-rw-r--r--compiler/deSugar/Check.hs15
1 files changed, 11 insertions, 4 deletions
diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs
index 0c653da2b2..1495280f94 100644
--- a/compiler/deSugar/Check.hs
+++ b/compiler/deSugar/Check.hs
@@ -2118,15 +2118,22 @@ pmcheckHd (p@(PmLit l)) ps guards
-- no information is lost
-- LitCon
-pmcheckHd (PmLit l) ps guards (va@(PmCon {})) (ValVec vva delta)
+pmcheckHd p@PmLit{} ps guards va@PmCon{} (ValVec vva delta)
= do y <- liftD $ mkPmId (pmPatType va)
- let tm_state = extendSubst y (PmExprLit l) (delta_tm_cs delta)
+ -- Analogous to the ConVar case, we have to case split the value
+ -- abstraction on possible literals. We do so by introducing a fresh
+ -- variable that is equated to the constructor. LitVar will then take
+ -- care of the case split by resorting to NLit.
+ let tm_state = extendSubst y (vaToPmExpr va) (delta_tm_cs delta)
delta' = delta { delta_tm_cs = tm_state }
- pmcheckHdI (PmVar y) ps guards va (ValVec vva delta')
+ pmcheckHdI p ps guards (PmVar y) (ValVec vva delta')
-- ConLit
-pmcheckHd (p@(PmCon {})) ps guards (PmLit l) (ValVec vva delta)
+pmcheckHd p@PmCon{} ps guards (PmLit l) (ValVec vva delta)
= do y <- liftD $ mkPmId (pmPatType p)
+ -- This desugars to the ConVar case by introducing a fresh variable that
+ -- is equated to the literal via a constraint. ConVar will then properly
+ -- case split on all possible constructors.
let tm_state = extendSubst y (PmExprLit l) (delta_tm_cs delta)
delta' = delta { delta_tm_cs = tm_state }
pmcheckHdI p ps guards (PmVar y) (ValVec vva delta')