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.

1 files changed, 16 insertions, 16 deletions

diff --git a/compiler/deSugar/DsCCall.hs b/compiler/deSugar/DsCCall.hs
index f7bfa7b581..9a3fe5a220 100644
--- a/compiler/deSugar/DsCCall.hs
+++ b/compiler/deSugar/DsCCall.hs
@@ -21,16 +21,16 @@ module DsCCall
 import CoreSyn
 
 import DsMonad
-import DsUtils( mkCastDs )
 import CoreUtils
 import MkCore
-import Var
 import MkId
 import ForeignCall
 import DataCon
+import DsUtils
 
 import TcType
 import Type
+import Id   ( Id )
 import Coercion
 import PrimOp
 import TysPrim
@@ -101,8 +101,8 @@ dsCCall lbl args may_gc result_ty
        return (foldr ($) (res_wrapper the_prim_app) arg_wrappers)
 
 mkFCall :: DynFlags -> Unique -> ForeignCall
-        -> [CoreExpr]   -- Args
-        -> Type         -- Result type
+        -> [CoreExpr]     -- Args
+        -> Type           -- Result type
         -> CoreExpr
 -- Construct the ccall.  The only tricky bit is that the ccall Id should have
 -- no free vars, so if any of the arg tys do we must give it a polymorphic type.
@@ -114,12 +114,13 @@ mkFCall :: DynFlags -> Unique -> ForeignCall
 --      (ccallid::(forall a b.  StablePtr (a -> b) -> Addr -> Char -> IO Addr))
 --                      a b s x c
 mkFCall dflags uniq the_fcall val_args res_ty
-  = mkApps (mkVarApps (Var the_fcall_id) tyvars) val_args
+  = ASSERT( all isTyVar tyvars )  -- this must be true because the type is top-level
+    mkApps (mkVarApps (Var the_fcall_id) tyvars) val_args
   where
     arg_tys = map exprType val_args
     body_ty = (mkFunTys arg_tys res_ty)
-    tyvars  = tyVarsOfTypeList body_ty
-    ty      = mkForAllTys tyvars body_ty
+    tyvars  = tyCoVarsOfTypeWellScoped body_ty
+    ty      = mkInvForAllTys tyvars body_ty
     the_fcall_id = mkFCallId dflags uniq the_fcall ty
 
 unboxArg :: CoreExpr                    -- The supplied argument
@@ -226,9 +227,9 @@ boxResult result_ty
                      _ -> []
 
               return_result state anss
-                = mkCoreConApps (tupleDataCon Unboxed (2 + length extra_result_tys))
-                                (map Type (realWorldStatePrimTy : io_res_ty : extra_result_tys)
-                                 ++ (state : anss))
+                = mkCoreUbxTup
+                    (realWorldStatePrimTy : io_res_ty : extra_result_tys)
+                    (state : anss)
 
         ; (ccall_res_ty, the_alt) <- mk_alt return_result res
 
@@ -274,8 +275,8 @@ mk_alt return_result (Nothing, wrap_result)
              the_rhs = return_result (Var state_id)
                                      [wrap_result (panic "boxResult")]
 
-             ccall_res_ty = mkTyConApp unboxedSingletonTyCon [realWorldStatePrimTy]
-             the_alt      = (DataAlt unboxedSingletonDataCon, [state_id], the_rhs)
+             ccall_res_ty = mkTupleTy Unboxed [realWorldStatePrimTy]
+             the_alt      = (DataAlt (tupleDataCon Unboxed 1), [state_id], the_rhs)
 
        return (ccall_res_ty, the_alt)
 
@@ -290,8 +291,7 @@ mk_alt return_result (Just prim_res_ty, wrap_result)
     let
         the_rhs = return_result (Var state_id)
                                 (wrap_result (Var result_id) : map Var as)
-        ccall_res_ty = mkTyConApp (tupleTyCon Unboxed arity)
-                                  (realWorldStatePrimTy : ls)
+        ccall_res_ty = mkTupleTy Unboxed (realWorldStatePrimTy : ls)
         the_alt      = ( DataAlt (tupleDataCon Unboxed arity)
                        , (state_id : args_ids)
                        , the_rhs
@@ -304,8 +304,8 @@ mk_alt return_result (Just prim_res_ty, wrap_result)
     let
         the_rhs = return_result (Var state_id)
                                 [wrap_result (Var result_id)]
-        ccall_res_ty = mkTyConApp unboxedPairTyCon [realWorldStatePrimTy, prim_res_ty]
-        the_alt      = (DataAlt unboxedPairDataCon, [state_id, result_id], the_rhs)
+        ccall_res_ty = mkTupleTy Unboxed [realWorldStatePrimTy, prim_res_ty]
+        the_alt      = (DataAlt (tupleDataCon Unboxed 2), [state_id, result_id], the_rhs)
     return (ccall_res_ty, the_alt)