summaryrefslogtreecommitdiff
path: root/compiler/deSugar/Match.hs
diff options
context:
space:
mode:
authorRichard Eisenberg <eir@cis.upenn.edu>2015-12-11 18:19:53 -0500
committerRichard Eisenberg <eir@cis.upenn.edu>2015-12-11 18:23:12 -0500
commit6746549772c5cc0ac66c0fce562f297f4d4b80a2 (patch)
tree96869fcfb5757651462511d64d99a3712f09e7fb /compiler/deSugar/Match.hs
parent6e56ac58a6905197412d58e32792a04a63b94d7e (diff)
downloadhaskell-6746549772c5cc0ac66c0fce562f297f4d4b80a2.tar.gz
Add kind equalities to GHC.
This implements the ideas originally put forward in "System FC with Explicit Kind Equality" (ICFP'13). There are several noteworthy changes with this patch: * We now have casts in types. These change the kind of a type. See new constructor `CastTy`. * All types and all constructors can be promoted. This includes GADT constructors. GADT pattern matches take place in type family equations. In Core, types can now be applied to coercions via the `CoercionTy` constructor. * Coercions can now be heterogeneous, relating types of different kinds. A coercion proving `t1 :: k1 ~ t2 :: k2` proves both that `t1` and `t2` are the same and also that `k1` and `k2` are the same. * The `Coercion` type has been significantly enhanced. The documentation in `docs/core-spec/core-spec.pdf` reflects the new reality. * The type of `*` is now `*`. No more `BOX`. * Users can write explicit kind variables in their code, anywhere they can write type variables. For backward compatibility, automatic inference of kind-variable binding is still permitted. * The new extension `TypeInType` turns on the new user-facing features. * Type families and synonyms are now promoted to kinds. This causes trouble with parsing `*`, leading to the somewhat awkward new `HsAppsTy` constructor for `HsType`. This is dispatched with in the renamer, where the kind `*` can be told apart from a type-level multiplication operator. Without `-XTypeInType` the old behavior persists. With `-XTypeInType`, you need to import `Data.Kind` to get `*`, also known as `Type`. * The kind-checking algorithms in TcHsType have been significantly rewritten to allow for enhanced kinds. * The new features are still quite experimental and may be in flux. * TODO: Several open tickets: #11195, #11196, #11197, #11198, #11203. * TODO: Update user manual. Tickets addressed: #9017, #9173, #7961, #10524, #8566, #11142. Updates Haddock submodule.
Diffstat (limited to 'compiler/deSugar/Match.hs')
-rw-r--r--compiler/deSugar/Match.hs20
1 files changed, 7 insertions, 13 deletions
diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs
index 3910250bc7..6ffa25dbc9 100644
--- a/compiler/deSugar/Match.hs
+++ b/compiler/deSugar/Match.hs
@@ -35,6 +35,7 @@ import PatSyn
import MatchCon
import MatchLit
import Type
+import Coercion ( eqCoercion )
import TcType ( toTcTypeBag )
import TyCon( isNewTyCon )
import TysWiredIn
@@ -246,7 +247,8 @@ matchCoercion :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
-- Apply the coercion to the match variable and then match that
matchCoercion (var:vars) ty (eqns@(eqn1:_))
= do { let CoPat co pat _ = firstPat eqn1
- ; var' <- newUniqueId var (hsPatType pat)
+ ; let pat_ty' = hsPatType pat
+ ; var' <- newUniqueId var pat_ty'
; match_result <- match (var':vars) ty $
map (decomposeFirstPat getCoPat) eqns
; rhs' <- dsHsWrapper co (Var var)
@@ -261,7 +263,8 @@ matchView (var:vars) ty (eqns@(eqn1:_))
-- to figure out the type of the fresh variable
let ViewPat viewExpr (L _ pat) _ = firstPat eqn1
-- do the rest of the compilation
- ; var' <- newUniqueId var (hsPatType pat)
+ ; let pat_ty' = hsPatType pat
+ ; var' <- newUniqueId var pat_ty'
; match_result <- match (var':vars) ty $
map (decomposeFirstPat getViewPat) eqns
-- compile the view expressions
@@ -930,7 +933,7 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
wrap WpHole WpHole = True
wrap (WpCompose w1 w2) (WpCompose w1' w2') = wrap w1 w1' && wrap w2 w2'
wrap (WpFun w1 w2 _ _) (WpFun w1' w2' _ _) = wrap w1 w1' && wrap w2 w2'
- wrap (WpCast co) (WpCast co') = co `eq_co` co'
+ wrap (WpCast co) (WpCast co') = co `eqCoercion` co'
wrap (WpEvApp et1) (WpEvApp et2) = et1 `ev_term` et2
wrap (WpTyApp t) (WpTyApp t') = eqType t t'
-- Enhancement: could implement equality for more wrappers
@@ -940,7 +943,7 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
---------
ev_term :: EvTerm -> EvTerm -> Bool
ev_term (EvId a) (EvId b) = a==b
- ev_term (EvCoercion a) (EvCoercion b) = a `eq_co` b
+ ev_term (EvCoercion a) (EvCoercion b) = a `eqCoercion` b
ev_term _ _ = False
---------
@@ -950,15 +953,6 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
eq_list _ (_:_) [] = False
eq_list eq (x:xs) (y:ys) = eq x y && eq_list eq xs ys
- ---------
- eq_co :: TcCoercion -> TcCoercion -> Bool
- -- Just some simple cases (should the r1 == r2 rather be an ASSERT?)
- eq_co (TcRefl r1 t1) (TcRefl r2 t2) = r1 == r2 && eqType t1 t2
- eq_co (TcCoVarCo v1) (TcCoVarCo v2) = v1==v2
- eq_co (TcSymCo co1) (TcSymCo co2) = co1 `eq_co` co2
- eq_co (TcTyConAppCo r1 tc1 cos1) (TcTyConAppCo r2 tc2 cos2) = r1 == r2 && tc1==tc2 && eq_list eq_co cos1 cos2
- eq_co _ _ = False
-
patGroup :: DynFlags -> Pat Id -> PatGroup
patGroup _ (WildPat {}) = PgAny
patGroup _ (BangPat {}) = PgBang