This is my second major darcs crash.  I have no clue how to work around
it.

darcs.exe: bug in darcs!
in function reconcile_unwindings
Original patch:
merger 0.0 (
merger 0.0 (
merger 0.0 (
merger 0.0 (
hunk ./compiler/types/Kind.lhs 230
....

Full story below

Simon

darcs --exact-version
darcs compiled on May 14 2006, at 15:38:56
# configured Sun May 14 15:29:40 USMST 2006
./configure --disable-mmap

Context:

[TAG 1.0.7
Tommy Pettersson <ptp@lysator.liu.se>**20060513171438] 
sh-2.04$

darcs pull -av
Usage: ssh [options] host [command]
Options:
  -l user     Log in using this user name.
  -n          Redirect input from /dev/null.
  -A          Enable authentication agent forwarding.
  -a          Disable authentication agent forwarding.
  -X          Enable X11 connection forwarding.
  -x          Disable X11 connection forwarding.
  -i file     Identity for public key authentication (default:
~/.ssh/identity)
  -t          Tty; allocate a tty even if command is given.
  -T          Do not allocate a tty.
  -v          Verbose; display verbose debugging messages.
              Multiple -v increases verbosity.
  -V          Display version number only.
  -P          Don't allocate a privileged port.
  -q          Quiet; don't display any warning messages.
  -f          Fork into background after authentication.
  -e char     Set escape character; ``none'' = disable (default: ~).
  -c cipher   Select encryption algorithm: ``3des'', ``blowfish''
  -m macs     Specify MAC algorithms for protocol version 2.
  -p port     Connect to this port.  Server must be on the same port.
  -L listen-port:host:port   Forward local port to remote address
  -R listen-port:host:port   Forward remote port to local address
              These cause ssh to listen for connections on a port, and
              forward them to the other side by connecting to host:port.
  -C          Enable compression.
  -N          Do not execute a shell or command.
  -g          Allow remote hosts to connect to forwarded ports.
  -1          Force protocol version 1.
  -2          Force protocol version 2.
  -4          Use IPv4 only.
  -6          Use IPv6 only.
  -o 'option' Process the option as if it was read from a configuration
file.
  -s          Invoke command (mandatory) as SSH2 subsystem.
Pulling from "http://darcs.haskell.org/ghc"...
This is the GHC darcs repostory (HEAD branch)

For more information, visit the GHC developer wiki at
  http://hackage.haskell.org/trac/ghc
**********************
We have the following new (to them) patches:
Fri Jun 30 13:13:08 GMT Daylight Time 2006  simonpj@microsoft.com
  * Tidy up selector generation code; no change in behaviour
Fri Jun 30 11:19:02 GMT Daylight Time 2006  kevind@bu.edu
  * fixes for reconstructing newtypes
Thu Jun 29 15:57:58 GMT Daylight Time 2006  simonpj@microsoft.com
  * Half-baked fix to unpacking code
Thu Jun 29 14:56:57 GMT Daylight Time 2006  kevind@bu.edu
  * sym coercion smart constructors, removed debugging outputs
Thu Jun 29 11:39:21 GMT Daylight Time 2006  kevind@bu.edu
  * Flip coercionKind and coercionKindPair
Thu Jun 29 11:05:16 GMT Daylight Time 2006  kevind@bu.edu
  * reboxing bug traces
Wed Jun 28 17:45:54 GMT Daylight Time 2006  simonpj@microsoft.com
  * Make sure that nt_rhs uses the *tycon* tyvars
Wed Jun 28 13:38:15 GMT Daylight Time 2006  simonpj@microsoft.com
  * Wibbles, esp getting CoTyCon into the implicitTyThings of a newtype
Wed Jun 28 11:47:23 GMT Daylight Time 2006  kevind@bu.edu
  * bug fix
Tue Jun 27 11:59:09 GMT Daylight Time 2006  kevind@bu.edu
  * stop simplifier from throwing out newtype coercions
Tue Jun 27 11:16:22 GMT Daylight Time 2006  kevind@bu.edu
  * fixed a few bugs, put coercions for all newtypes, killed some
assertions that things are recursive newtypes
Thu Jun 22 15:14:55 GMT Daylight Time 2006  kevind@bu.edu
  * some refactoring with decomposeCo
Thu Jun 22 15:00:42 GMT Daylight Time 2006  kevind@bu.edu
  * fix core lint for let bindings
Thu Jun 22 12:00:27 GMT Daylight Time 2006  simonpj@microsoft.com
  * Fix Linting of type applications, and add coments
Thu Jun 22 11:20:00 GMT Daylight Time 2006  kevind@bu.edu
  * Linting going wrong
Wed Jun 21 17:47:00 GMT Daylight Time 2006  kevind@bu.edu
  * corelint fixes, still some type substitution strangeness
Wed Jun 21 13:48:51 GMT Daylight Time 2006  kevind@bu.edu
  * Substitution in binder types/kinds in CoreLint
Tue Jun 20 14:50:53 GMT Daylight Time 2006  kevind@bu.edu
  * minor changes
Mon Jun 19 16:04:21 GMT Daylight Time 2006  kevind@bu.edu
  * Squashed a couple more
Wed Jun 21 09:36:55 GMT Daylight Time 2006  simonpj@microsoft.com
  * Add missing TcGadt.lhs
Wed Jun 21 09:34:44 GMT Daylight Time 2006  simonpj@microsoft.com
  * Remove compiler from the boring list (how did it get there?)
Wed Jun 21 08:51:54 GMT Daylight Time 2006  simonpj@microsoft.com
  * Missing imports
Tue Jun 20 15:35:56 GMT Daylight Time 2006  simonpj@microsoft.com
  * Take 2: Use FC for GADTs, for the first time

  (The "take 2" part refers to the fact that I got
  into a terrible mess with a Darcs bug the first time
  round.  That patch is not in the repository at all now.)

    This commit deals with equality-evidence generation for GADTs.
    It touches a lot of files.   It probably doesn't work 100%
    yet, but it compiles ok.

    The biggest changes are to the type inference engine, which
    must now generate equality evidence when doing GADT type
    refinement.

    In the rest of the compiler, data contructors are now 
    treated uniformly (instead of have a special case for
    vanilla data cons).  Furthermore, we can remove all the
    type-refinement code from the optimisation passes.
    Hooray!
Tue Jun 20 15:18:44 GMT Daylight Time 2006  simonpj@microsoft.com
  * Conflict resolution
Mon Jun 19 13:26:37 GMT Daylight Time 2006  simonpj@microsoft.com
  * Substitutions, plus numerous small things
Fri Jun 16 16:04:19 GMT Daylight Time 2006  kevind@bu.edu
  * badness here
Fri Jun 16 10:35:48 GMT Daylight Time 2006  kevind@bu.edu
  * fixes
Thu Jun 15 16:12:31 GMT Daylight Time 2006  kevind@bu.edu
  * now it compiles (some) libraries
Thu Jun 15 15:48:37 GMT Daylight Time 2006  kevind@bu.edu
  * More wibbles
Thu Jun 15 14:33:46 GMT Daylight Time 2006  kevind@bu.edu
  * fixes
Thu Jun 15 11:14:59 GMT Daylight Time 2006  simonpj@microsoft.com
  * Wibbles
Thu Jun 15 10:50:36 GMT Daylight Time 2006  kevind@bu.edu
  * compiling
Thu Jun 15 10:34:27 GMT Daylight Time 2006  kevind@bu.edu
  * adding stubs
Wed Jun 14 16:13:25 GMT Daylight Time 2006  kevind@bu.edu
  * some changes
Wed Jun 14 15:52:32 GMT Daylight Time 2006  kevind@bu.edu
  * Fixed BuildTyCls, not compiling yet
Wed Jun 14 10:22:13 GMT Daylight Time 2006  simonpj@microsoft.com
  * Steps towards mkNewTyConRhs
Thu Jun  8 18:05:32 GMT Daylight Time 2006  kevind@bu.edu
  * little things
Thu Jun  8 16:02:43 GMT Daylight Time 2006  simonpj@microsoft.com
  * Minor changes
Thu Jun  8 15:42:42 GMT Daylight Time 2006  kevind@bu.edu
  * newtype stuff
Thu Jun  8 15:12:12 GMT Daylight Time 2006  simonpj@microsoft.com
  * more from simion
Thu Jun  8 13:28:05 GMT Daylight Time 2006  simonpj@microsoft.com
  * First steps towards GADTs with FC
Thu Jun  8 11:42:05 GMT Daylight Time 2006  simonpj@microsoft.com
  * nt_co is a TyCOn now
Thu Jun  8 11:40:31 GMT Daylight Time 2006  simonpj@microsoft.com
  * Comments only
Thu Jun  8 10:44:33 GMT Daylight Time 2006  simonpj@microsoft.com
  * Comments only
Thu Jun  8 10:17:24 GMT Daylight Time 2006  kevind@bu.edu
  * removed some commented out Coerce code, fixed a bug swapping
direction of coercion
Wed Jun  7 17:21:08 GMT Daylight Time 2006  kevind@bu.edu
  * external core fix
Wed Jun  7 16:44:26 GMT Daylight Time 2006  kevind@bu.edu
  * It's Alive!
Wed Jun  7 15:54:37 GMT Daylight Time 2006  kevind@bu.edu
  * towards compiling
Wed Jun  7 12:45:50 GMT Daylight Time 2006  simonpj@microsoft.com
  * Comments
Wed Jun  7 12:30:52 GMT Daylight Time 2006  simonpj@microsoft.com
  * Stuff from Simon: EqPred, plus hole_ty in SimplUtils
Wed Jun  7 11:36:00 GMT Daylight Time 2006  kevind@bu.edu
  * more
Tue Jun  6 16:20:15 GMT Daylight Time 2006  simonpj@microsoft.com
  * simon and kevin discussion
Tue Jun  6 15:40:17 GMT Daylight Time 2006  kevind@bu.edu
  * more cast
Mon Jun  5 10:48:46 GMT Daylight Time 2006  simonpj@microsoft.com
  * Minor edits (Kevin and Simon together)
Mon Jun  5 09:21:13 GMT Daylight Time 2006  kevind@bu.edu
  * coercions in, adding cast
Fri May 26 13:55:28 GMT Daylight Time 2006  simonpj@microsoft.com
  * Fix typeKind silliness
Thu May 25 13:57:21 GMT Daylight Time 2006  simonpj@microsoft.com
  * coercionTyCon
Wed May 24 18:02:34 GMT Daylight Time 2006  kevind@bu.edu
  * Fixed typeKind to work right for kinds
Wed May 24 17:10:39 GMT Daylight Time 2006  kevind@bu.edu
  * Some fixes, still won't compile library
Tue May 23 13:21:17 GMT Daylight Time 2006  kevind@bu.edu
  * Kinds are Types, and things compile
Tue May 23 10:08:22 GMT Daylight Time 2006  kevind@bu.edu
  * test
Tue May 23 09:58:02 GMT Daylight Time 2006  kevind@bu.edu
  * Closer
Mon May 22 16:43:31 GMT Daylight Time 2006  simonpj@microsoft.com
  * minor changes
Mon May 22 15:11:37 GMT Daylight Time 2006  kevind@bu.edu
  * Kinds are now Types (may not yet compile, but close)
Fri May 19 16:05:19 GMT Daylight Time 2006  simonpj@microsoft.com
  * Result of Simon/Kevin discussion
Fri May 19 15:07:23 GMT Daylight Time 2006  kevind@bu.edu
  * Kind preliminarily Typified, doesn't compile yet
Thu May 18 12:49:31 GMT Daylight Time 2006  kevind@bu.edu
  * KindTyCon's added
They have the following patches to pull:
Thu Jun 29 15:06:08 GMT Daylight Time 2006  Simon Marlow
<simonmar@microsoft.com>
  * x86-64: fix a problem exposed by negative offsets in vector tables
  static relative offsets (eg .long l1-l2) are restricted to 32 bits on
  x86-64 due to lack of support in the linker.  The codegen, NCG and
  runtime work around this, using 32-bit offsets instead of 64.
  However, we were missing a workaround for vector tables, and it
  happened to work by accident because the offsets were always positive
  and resolved by the assembler.  The bug was exposed by using the NCG
  to compile the RTS, where the offsets became negative, again by
  accident.
Thu Jun 29 14:58:36 GMT Daylight Time 2006  Simon Marlow
<simonmar@microsoft.com>
  * No longer force -fvia-C for the RTS, it can now be compiled with the
NCG
Thu Jun 29 14:47:26 GMT Daylight Time 2006  Simon Marlow
<simonmar@microsoft.com>
  * Replace inline C functions with C-- macros in .cmm code
  So that we can build the RTS with the NCG.
Thu Jun 29 14:44:05 GMT Daylight Time 2006  Simon Marlow
<simonmar@microsoft.com>
  * remove conditionals from definition of StgRegTable
  so that we can calculate deterministic offsets to some of the fields
  of Capability.
Thu Jun 29 13:22:17 GMT Daylight Time 2006  Simon Marlow
<simonmar@microsoft.com>
  * mpz_foo() functions are really called __gmpz_foo() in GMP
  gmp.h #defines mpz_foo to __gmpz_foo, so the real ABI is __gmpz_foo,
  so that is what we must invoke in order to be portable here.
  Similarly for mpn --> __gmpn.
Thu Jun 29 13:05:26 GMT Daylight Time 2006  Simon Marlow
<simonmar@microsoft.com>
  * use the new "prim %write_barrier()" in .cmm instead of calls to wb()
Thu Jun 29 13:02:10 GMT Daylight Time 2006  Simon Marlow
<simonmar@microsoft.com>
  * fix some problems with the fixup block code
  We weren't handling InBoth properly.  InBoth needs to be expanded to
  appropriate InReg/InMem locations *before* building the interference
  graph, otherwise an InBoth will not be seen to conflict with other
  InReg/InMem locations.
Thu Jun 29 13:00:29 GMT Daylight Time 2006  Simon Marlow
<simonmar@microsoft.com>
  * small optimisation: eliminate more register-to-register moves
Thu Jun 29 12:59:49 GMT Daylight Time 2006  Simon Marlow
<simonmar@microsoft.com>
  * new syntax: "prim %OP (args)"  for using CallishMachOps in .cmm

Thu Jun 29 12:58:37 GMT Daylight Time 2006  Simon Marlow
<simonmar@microsoft.com>
  * add MO_WriteBarrier to CallishMachOps
  This will let us express write barriers in C--
Thu Jun 29 09:29:02 GMT Daylight Time 2006  Simon Marlow
<simonmar@microsoft.com>
  * Use -fno-strict-aliasing for *all* C files in the runtime
  as a precautionary measure.  It is definitely required for GC.c,
  but it may well become necessary for other files in the future due to
  our (mis-)use of the C "type system".
Fri Jun 23 16:26:26 GMT Daylight Time 2006  Simon Marlow
<simonmar@microsoft.com>
  * the unlifted kind
Tue Jun 20 16:19:01 GMT Daylight Time 2006  Simon Marlow
<simonmar@microsoft.com>
  * fix a lint-o
Tue Jun 20 16:17:58 GMT Daylight Time 2006  Simon Marlow
<simonmar@microsoft.com>
  * fix sloppy conditionals
Tue Jun 20 16:10:39 GMT Daylight Time 2006  Simon Marlow
<simonmar@microsoft.com>
  * fix sloppy conditionals
Tue Jun 20 16:06:18 GMT Daylight Time 2006  Simon Marlow
<simonmar@microsoft.com>
  * fix a few sloppy conditionals caught by new test in CmmLint
Tue Jun 20 16:05:20 GMT Daylight Time 2006  Simon Marlow
<simonmar@microsoft.com>
  * flattenCgStmts: fix a case of empty code blocks being generated
Tue Jun 20 15:12:19 GMT Daylight Time 2006  Simon Marlow
<simonmar@microsoft.com>
  * improve a panic message
Tue Jun 20 15:12:04 GMT Daylight Time 2006  Simon Marlow
<simonmar@microsoft.com>
  * check that the argument to CmmCondBranch is really a conditional
Tue Jun 20 15:01:06 GMT Daylight Time 2006  Simon Marlow
<simonmar@microsoft.com>
  * Generate a new unique for each label
Getting and merging the following patches:
[Generate a new unique for each label
Simon Marlow <simonmar@microsoft.com>**20060620140106] 
[check that the argument to CmmCondBranch is really a conditional
Simon Marlow <simonmar@microsoft.com>**20060620141204] 
[improve a panic message
Simon Marlow <simonmar@microsoft.com>**20060620141219] 
[flattenCgStmts: fix a case of empty code blocks being generated
Simon Marlow <simonmar@microsoft.com>**20060620150520] 
[fix a few sloppy conditionals caught by new test in CmmLint
Simon Marlow <simonmar@microsoft.com>**20060620150618] 
[fix sloppy conditionals
Simon Marlow <simonmar@microsoft.com>**20060620151039] 
[fix sloppy conditionals
Simon Marlow <simonmar@microsoft.com>**20060620151758] 
[fix a lint-o
Simon Marlow <simonmar@microsoft.com>**20060620151901] 
[the unlifted kind
Simon Marlow <simonmar@microsoft.com>**20060623152626] 
[Use -fno-strict-aliasing for *all* C files in the runtime
Simon Marlow <simonmar@microsoft.com>**20060629082902
 as a precautionary measure.  It is definitely required for GC.c,
 but it may well become necessary for other files in the future due to
 our (mis-)use of the C "type system".
] 
[add MO_WriteBarrier to CallishMachOps
Simon Marlow <simonmar@microsoft.com>**20060629115837
 This will let us express write barriers in C--
] 
[new syntax: "prim %OP (args)"  for using CallishMachOps in .cmm
Simon Marlow <simonmar@microsoft.com>**20060629115949

] 
[small optimisation: eliminate more register-to-register moves
Simon Marlow <simonmar@microsoft.com>**20060629120029] 
[fix some problems with the fixup block code
Simon Marlow <simonmar@microsoft.com>**20060629120210
 We weren't handling InBoth properly.  InBoth needs to be expanded to
 appropriate InReg/InMem locations *before* building the interference
 graph, otherwise an InBoth will not be seen to conflict with other
 InReg/InMem locations.
] 
[use the new "prim %write_barrier()" in .cmm instead of calls to wb()
Simon Marlow <simonmar@microsoft.com>**20060629120526] 
[mpz_foo() functions are really called __gmpz_foo() in GMP
Simon Marlow <simonmar@microsoft.com>**20060629122217
 gmp.h #defines mpz_foo to __gmpz_foo, so the real ABI is __gmpz_foo,
 so that is what we must invoke in order to be portable here.
 Similarly for mpn --> __gmpn.
] 
[remove conditionals from definition of StgRegTable
Simon Marlow <simonmar@microsoft.com>**20060629134405
 so that we can calculate deterministic offsets to some of the fields
 of Capability.
] 
[Replace inline C functions with C-- macros in .cmm code
Simon Marlow <simonmar@microsoft.com>**20060629134726
 So that we can build the RTS with the NCG.
] 
[No longer force -fvia-C for the RTS, it can now be compiled with the
NCG
Simon Marlow <simonmar@microsoft.com>**20060629135836] 
[x86-64: fix a problem exposed by negative offsets in vector tables
Simon Marlow <simonmar@microsoft.com>**20060629140608
 static relative offsets (eg .long l1-l2) are restricted to 32 bits on
 x86-64 due to lack of support in the linker.  The codegen, NCG and
 runtime work around this, using 32-bit offsets instead of 64.
 However, we were missing a workaround for vector tables, and it
 happened to work by accident because the offsets were always positive
 and resolved by the assembler.  The bug was exposed by using the NCG
 to compile the RTS, where the offsets became negative, again by
 accident.
] 
diffing dir...
darcs.exe: bug in darcs!
in function reconcile_unwindings
Original patch:
merger 0.0 (
merger 0.0 (
merger 0.0 (
merger 0.0 (
hunk ./compiler/types/Kind.lhs 230
-isUbxTupleKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
-  = uniq == ubxTupleKindTyConKey
-isUbxTupleKind other = False
+isUbxTupleKind (TyConApp tc _) = tyConUnique tc == ubxTupleKindTyConKey
+isUbxTupleKind other 	       = False
merger 0.0 (
hunk ./compiler/types/Kind.lhs 221
-isUnliftedTypeKind UnliftedTypeKind = True
-isUnliftedTypeKind other	    = False
+isUnliftedTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
+  | uniq == unliftedTypeKindTyConKey = True
+  | other                            = False
+isUnliftedTypeKind other = False
+
+isFunKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
+  = uniq == funKindTyConKey
+isFunKind other = False
+
+isUbxTupleKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
+  = uniq == ubxTupleKindTyConKey
+isUbxTupleKind other = False
+
+isRealOpenTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))

+  = uniq == openTypeKindTyConKey
+isRealOpenTypeKind other = False
+
+isRealArgTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
+  = uniq == argTypeKindTyConKey
+isRealArgTypeKind other = False
hunk ./compiler/types/Kind.lhs 221
+isUnliftedBoxedTypeKind UnliftedTypeKind = True
+isUnliftedBoxedTypeKind other	    = False
+
)
)
merger 0.0 (
merger 0.0 (
hunk ./compiler/types/Kind.lhs 171
-liftedTypeKind   = LiftedTypeKind
-unliftedTypeKind = UnliftedTypeKind
-openTypeKind     = OpenTypeKind
-argTypeKind      = ArgTypeKind
-ubxTupleKind	 = UbxTupleKind
+kindTyConType :: TyCon -> Type
+kindTyConType kind = TyConApp kind []
+
+liftedTypeKind   = kindTyConType liftedTypeKindTyCon
+unliftedTypeKind = kindTyConType unliftedTypeKindTyCon
+openTypeKind     = kindTyConType openTypeKindTyCon
+argTypeKind      = kindTyConType argTypeKindTyCon
+ubxTupleKind	 = kindTyConType ubxTupleKindTyCon
hunk ./compiler/types/Kind.lhs 172
+unboxedTypeKind  = UnboxedTypeKind
)
merger 0.0 (
hunk ./compiler/types/Kind.lhs 63
-  | OpenTypeKind	-- ?
-  | UnliftedTypeKind	--  #
-  | UbxTupleKind	-- (##)
-  | ArgTypeKind		-- ??
-  | FunKind Kind Kind	-- k1 -> k2
+  | OpenTypeKind	--  ?
+  | UnboxedTypeKind	--  #
+  | UnliftedTypeKind    --  !
+  | UbxTupleKind	--  (##)
+  | ArgTypeKind		--  ??
+  | FunKind Kind Kind	--  k1 -> k2
merger 0.0 (
hunk ./compiler/types/Kind.lhs 48
-	#    [UnliftedTypeKind] means unboxed type
+	#    [UnboxedTypeKind]  means unboxed type
merger 0.0 (
hunk ./compiler/types/Kind.lhs 44
-	     /  \
-            *   #
+	    / | \
+	   *  !  #
merger 0.0 (
hunk ./compiler/types/Kind.lhs 11
-	isLiftedTypeKind, isUnliftedTypeKind, 
+	isLiftedTypeKind, isUnliftedTypeKind, isUnliftedBoxedTypeKind,
merger 0.0 (
hunk ./compiler/types/Kind.lhs 8
-	openTypeKind, liftedTypeKind, unliftedTypeKind, 
+	openTypeKind, liftedTypeKind, unliftedTypeKind, unboxedTypeKind,
hunk ./compiler/types/Kind.lhs 1
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1998
-%
-
-\begin{code}
-module Kind (
-	Kind, SuperKind(..), SimpleKind, 
-	openTypeKind, liftedTypeKind, unliftedTypeKind, 
-	argTypeKind, ubxTupleKind,
-
-	isLiftedTypeKind, isUnliftedTypeKind, 
-	isArgTypeKind, isOpenTypeKind,
-	mkArrowKind, mkArrowKinds,
-
-        isSubKind, defaultKind, 
-	kindFunResult, splitKindFunTys, 
-
-	KindVar, mkKindVar, kindVarRef, kindVarUniq, 
-	kindVarOcc, setKindVarOcc,
-
-	pprKind, pprParendKind
-     ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} TypeRep     ( Type )
-import {-# SOURCE #-} TyCon    ( TyCon )
-import {-# SOURCE #-} TcType   ( MetaDetails, TcTyVarDetails )
-import {-# SOURCE #-} TysWiredIn
-import Unique	( Unique )
-import OccName  ( OccName, mkOccName, tvName )
-import Outputable
-import DATA_IOREF
-\end{code}
-
-Kinds
-~~~~~
-There's a little subtyping at the kind level:  
-
-		 ?
-		/ \
-	       /   \
-	      ??   (#)
-	     /  \
-            *   #
-
-where	*    [LiftedTypeKind]   means boxed type
-	#    [UnliftedTypeKind] means unboxed type
-	(#)  [UbxTupleKind]     means unboxed tuple
-	??   [ArgTypeKind]      is the lub of *,#
-	?    [OpenTypeKind]	means any type at all
-
-In particular:
-
-	error :: forall a:?. String -> a
-	(->)  :: ?? -> ? -> *
-	(\(x::t) -> ...)	Here t::?? (i.e. not unboxed tuple)
-
-\begin{code}
-{- Kinds are now Primitive Type Constructors (PrimTyCon)
-data Kind 
-  = LiftedTypeKind 	--  *
-  | OpenTypeKind	-- ?
-  | UnliftedTypeKind	--  #
-  | UbxTupleKind	-- (##)
-  | ArgTypeKind		-- ??
-  | FunKind Kind Kind	-- k1 -> k2
-  | KindVar KindVar
-  deriving( Eq )
-
-data KindVar = KVar Unique OccName (IORef (Maybe SimpleKind))
-  -- INVARIANT: a KindVar can only be instantiated by a SimpleKind
-
-type SimpleKind = Kind	
-  -- A SimpleKind has no ? or # kinds in it:
-  -- sk ::= * | sk1 -> sk2 | kvar
--}
-
-
-type KindVar = TyVar  -- invariant: KindVar will always be a 
-                      -- TcTyVar with details MetaTv TauTv
-
-{-
-instance Eq KindVar where
-  (KVar u1 _ _) == (KVar u2 _ _) = u1 == u2
--}
-
-mkKindName :: Unique -> Name
-mkKindName unique 
-  = Name { n_sort = System
-         , n_occ  = kind_var_occ
-         , n_uniq = unique
-         , n_loc  = UnhelpfulLoc (mkFastString "Kind Variable,
internal")
-         }
-
-mkKindVar :: Unique -> IORef MetaDetails -> KindVar
-mkKindVar u r 
-  = TcTyVar { varName        = mkKindName u
-            , realUnique     = u
-            , tyVarKind      = boxSuperKindTy  -- not sure this is
right,
-                                               -- do we need kind vars
for
-                                               -- coercions?
-            , tcTyVarDetails = MetaTv TauTv r
-            }
-
-kindVarRef :: KindVar -> IORef MetaDetails
-kindVarRef (TcTyVar{tcTyVarDetails = MetaTv TauTv ref}) = ref
-kindVarRef other                   = pprPanic "kindVarRef" (ppr other)
-
-kindVarUniq :: KindVar -> Unique
-kindVarUniq (TcTyVar{realUnique = uniq}) = uniq
-kindVarUniq other                        = pprPanic "kindVarUniq" (ppr
other)
-
-kindVarOcc :: KindVar -> OccName
-kindVarOcc (TcTyVar{varName = Name {n_occ = occ}}) 
-  = occ
-kindVarOcc other
-  = pprPanic "kindVarOcc" (ppr other)
-
-setKindVarOcc :: KindVar -> OccName -> KindVar
-setKindVarOcc (rec@((TcTyVar {varName = name}))) occ
-  = (rec{ varName = name{ n_occ = occ } })
-setKindVarOcc other occ = pprPanic "setKindVarOcc" (ppr other)
-
-kind_var_occ :: OccName	-- Just one for all KindVars
-			-- They may be jiggled by tidying
-kind_var_occ = mkOccName tvName "k"
-\end{code}
-
-Super Kinds
-~~~~~~~~~~~
-There are two super kinds:
-
-  [] is the super kind of type kinds, ? and all kinds it subsumes have
[] kind
-  <> is the super kind of type coercions
-
-\begin{code}
-data SuperKind 
-  = BoxSuperKind
-  | DiamondSuperKind
-  
-\end{code}
-
-Kind inference
-~~~~~~~~~~~~~~
-During kind inference, a kind variable unifies only with 
-a "simple kind", sk
-	sk ::= * | sk1 -> sk2
-For example 
-	data T a = MkT a (T Int#)
-fails.  We give T the kind (k -> *), and the kind variable k won't
unify
-with # (the kind of Int#).
-
-Type inference
-~~~~~~~~~~~~~~
-When creating a fresh internal type variable, we give it a kind to
express 
-constraints on it.  E.g. in (\x->e) we make up a fresh type variable
for x, 
-with kind ??.  
-
-During unification we only bind an internal type variable to a type
-whose kind is lower in the sub-kind hierarchy than the kind of the
tyvar.
-
-When unifying two internal type variables, we collect their kind
constraints by
-finding the GLB of the two.  Since the partial order is a tree, they
only
-have a glb if one is a sub-kind of the other.  In that case, we bind
the
-less-informative one to the more informative one.  Neat, eh?
-
-
-\begin{code}
-kindTyConType :: TyCon -> Type
-kindTyConType kind = TyConApp kind []
-
-liftedTypeKind   = kindTyConType liftedTypeKindTyCon
-unliftedTypeKind = kindTyConType unliftedTypeKindTyCon
-openTypeKind     = kindTyConType openTypeKindTyCon
-argTypeKind      = kindTyConType argTypeKindTyCon
-ubxTupleKind	 = kindTyConType ubxTupleKindTyCon
-
-mkArrowKind :: Kind -> Kind -> Kind
-mkArrowKind k1 k2 = TyConApp funKindTyCon [k1,k2]
-
-mkArrowKinds :: [Kind] -> Kind -> Kind
-mkArrowKinds arg_kinds result_kind = foldr mkArrowKind result_kind
arg_kinds
-\end{code}
-
-%**********************************************************************
**
-%*
*
-	Functions over Kinds		
-%*
*
-%**********************************************************************
**
-
-\begin{code}
-kindFunResult :: Kind -> Kind
-kindFunResult k = funResultTy k
-
-splitKindFunTys :: Kind -> ([Kind],Kind)
-splitKindFunTys (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == funKindTyConKey =
-      case args of
-        [k1, k2] -> 
-            case splitKindFunTys k2 of
-              (as, r) -> (k1:as, r)
-        other    -> pprPanic "splitKindFunTys" "funKind does not have
two arguments"
-  | otherwise = ([], k)
-splitKindFunTys other = pprPanic "splitKindFunTys" (ppr other)
-
-shallowSplitFunKind :: Kind -> (Kind, Kind)
-shallowSplitFunKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq})
args))
-  | uniq == funKindTyConKey =
-    case args of
-      [k1, k2] -> (k1, k2)
-      other    -> pprPanic "shallowSplitFunKind" "funKind does not have
two arguments"
-  | otherwise = pprPanic "shallowSplitFunKind" (ppr k)
-shallowSplitFunKind other = pprPanic "shallowSplitFunKind" (ppr other)
-
-isLiftedTypeKind, isUnliftedTypeKind, isFunKind, isUbxTupleKind,
isRealOpenTypeKind, isRealArgTypeKind :: Kind -> Bool
-
-isLiftedTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == liftedTypeKindTyConKey = True
-  | other                          = False
-isLiftedTypeKind other = False
-
-isUnliftedTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == unliftedTypeKindTyConKey = True
-  | other                            = False
-isUnliftedTypeKind other = False
-
-isFunKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
-  = uniq == funKindTyConKey
-isFunKind other = False
-
-isUbxTupleKind (TyConApp tc _) = tyConUnique tc == ubxTupleKindTyConKey
-isUbxTupleKind other 	       = False
-
-isRealOpenTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))

-  = uniq == openTypeKindTyConKey
-isRealOpenTypeKind other = False
-
-isRealArgTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
-  = uniq == argTypeKindTyConKey
-isRealArgTypeKind other = False
-
-isArgTypeKind :: Kind -> Bool
--- True of any sub-kind of ArgTypeKind 
-isArgTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == unliftedTypeKindTyConKey = True
-  | uniq == liftedTypeKindTyConKey   = True
-  | uniq == argTypeKindTyConKey      = True
-  | otherwise                        = False
-isArgTypeKind other = False
-
-isOpenTypeKind :: Kind -> Bool
--- True of any sub-kind of OpenTypeKind (i.e. anything except arrow)
-isOpenTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == funKindTyConKey = False
-  | otherwise               = ASSERT( isKind other ) True
-isOpenTypeKind other = ASSERT( isKind other ) False
-         -- This is a conservative answer
-         -- It matters in the call to isSubKind in
-	 -- checkExpectedKind.
-
-isSubKind :: Kind -> Kind -> Bool
--- (k1 `isSubKind` k2) checks that k1 <: k2
-isSubKind (TyConApp kc1 []) (TyConApp kc2 []) = kc1 `isSubKindCon` kc1
-isSubKind (FunTy a1 r1) (FunTy a2 r2)	      = (a2 `isSubKind` a1) &&
(r1 `isSubKind` r2)
-isSubKind k1 		k2 		      = False
-
-isSubKindCon :: KindCon -> KindCon -> Bool
--- (kc1 `isSubKindCon` kc2) checks that kc1 <: kc2
-isSubKindCon kc1 kc2
-  | uniq1 == liftedTypeKindTyConKey && uniq2 == liftedTypeKindTyConKey
= True
-  | uniq1 == unliftedTypeKindTyConKey && uniq2 ==
unliftedTypeKindTyConKey = True
-  | uniq1 == ubxTupleKindTyConKey && uniq2 == ubxTupleKindTyConKey =
True
-  | uniq2 == openTypeKindTyConKey && isOpenTypeKind k1 = True
-  | uniq2 == argTypeKindTyConKey && isArgTypeKind k1 = True
-
-defaultKind :: Kind -> Kind
--- Used when generalising: default kind '?' and '??' to '*'
--- 
--- When we generalise, we make generic type variables whose kind is
--- simple (* or *->* etc).  So generic type variables (other than
--- built-in constants like 'error') always have simple kinds.  This is
important;
--- consider
---	f x = True
--- We want f to get type
---	f :: forall (a::*). a -> Bool
--- Not 
---	f :: forall (a::??). a -> Bool
--- because that would allow a call like (f 3#) as well as (f True),
---and the calling conventions differ.  This defaulting is done in
TcMType.zonkTcTyVarBndr.
-defaultKind k 
-  | isOpenTypeKind k = liftedTypeKind
-  | isArgTypeKind k  = liftedTypeKind
-  | otherwise        = k
-\end{code}
-
-
-%**********************************************************************
**
-%*
*
-		Pretty printing
-%*
*
-%**********************************************************************
**
-
-\begin{code}
-
-pprParendKind :: Kind -> SDoc
-pprParendKind k 
-  | isFunKind k = parens (pprKind k)
-  | otherwise   = pprKind k
-
-pprKind k
-  | isLiftedTypeKind k   = ptext SLIT("*")
-  | isUnliftedTypeKind k = ptext SLIT("#")
-  | isUbxTupleKind k     = ptext SLIT("(#)")
-  | isFunKind k          =
-    let (k1, k2) = shallowSplitFunKind k in
-    sep [ pprParendKind k1, arrow <+> pprKind k2]
-  | isRealOpenTypeKind k     = ptext SLIT("?")
-  | isRealArgTypeKind k      = ptext SLIT("??")
-
-
-\end{code}
)
)
)
)
)
)
)
merger 0.0 (
merger 0.0 (
merger 0.0 (
hunk ./compiler/types/Kind.lhs 221
-isUnliftedTypeKind UnliftedTypeKind = True
-isUnliftedTypeKind other	    = False
+isUnliftedTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
+  | uniq == unliftedTypeKindTyConKey = True
+  | other                            = False
+isUnliftedTypeKind other = False
+
+isFunKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
+  = uniq == funKindTyConKey
+isFunKind other = False
+
+isUbxTupleKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
+  = uniq == ubxTupleKindTyConKey
+isUbxTupleKind other = False
+
+isRealOpenTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))

+  = uniq == openTypeKindTyConKey
+isRealOpenTypeKind other = False
+
+isRealArgTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
+  = uniq == argTypeKindTyConKey
+isRealArgTypeKind other = False
hunk ./compiler/types/Kind.lhs 221
+isUnliftedBoxedTypeKind UnliftedTypeKind = True
+isUnliftedBoxedTypeKind other	    = False
+
)
hunk ./compiler/types/Kind.lhs 230
-isUbxTupleKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
-  = uniq == ubxTupleKindTyConKey
-isUbxTupleKind other = False
+isUbxTupleKind (TyConApp tc _) = tyConUnique tc == ubxTupleKindTyConKey
+isUbxTupleKind other 	       = False
)
merger 0.0 (
merger 0.0 (
hunk ./compiler/types/Kind.lhs 221
+isUnliftedBoxedTypeKind UnliftedTypeKind = True
+isUnliftedBoxedTypeKind other	    = False
+
hunk ./compiler/types/Kind.lhs 221
-isUnliftedTypeKind UnliftedTypeKind = True
-isUnliftedTypeKind other	    = False
+isUnliftedTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
+  | uniq == unliftedTypeKindTyConKey = True
+  | other                            = False
+isUnliftedTypeKind other = False
+
+isFunKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
+  = uniq == funKindTyConKey
+isFunKind other = False
+
+isUbxTupleKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
+  = uniq == ubxTupleKindTyConKey
+isUbxTupleKind other = False
+
+isRealOpenTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))

+  = uniq == openTypeKindTyConKey
+isRealOpenTypeKind other = False
+
+isRealArgTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
+  = uniq == argTypeKindTyConKey
+isRealArgTypeKind other = False
)
hunk ./compiler/types/Kind.lhs 225
+isUnliftedTypeKind UnboxedTypeKind  = True
)
)
)
merger 0.0 (
merger 0.0 (
merger 0.0 (
merger 0.0 (
hunk ./compiler/types/Kind.lhs 171
-liftedTypeKind   = LiftedTypeKind
-unliftedTypeKind = UnliftedTypeKind
-openTypeKind     = OpenTypeKind
-argTypeKind      = ArgTypeKind
-ubxTupleKind	 = UbxTupleKind
+kindTyConType :: TyCon -> Type
+kindTyConType kind = TyConApp kind []
+
+liftedTypeKind   = kindTyConType liftedTypeKindTyCon
+unliftedTypeKind = kindTyConType unliftedTypeKindTyCon
+openTypeKind     = kindTyConType openTypeKindTyCon
+argTypeKind      = kindTyConType argTypeKindTyCon
+ubxTupleKind	 = kindTyConType ubxTupleKindTyCon
hunk ./compiler/types/Kind.lhs 172
+unboxedTypeKind  = UnboxedTypeKind
)
merger 0.0 (
hunk ./compiler/types/Kind.lhs 63
-  | OpenTypeKind	-- ?
-  | UnliftedTypeKind	--  #
-  | UbxTupleKind	-- (##)
-  | ArgTypeKind		-- ??
-  | FunKind Kind Kind	-- k1 -> k2
+  | OpenTypeKind	--  ?
+  | UnboxedTypeKind	--  #
+  | UnliftedTypeKind    --  !
+  | UbxTupleKind	--  (##)
+  | ArgTypeKind		--  ??
+  | FunKind Kind Kind	--  k1 -> k2
merger 0.0 (
hunk ./compiler/types/Kind.lhs 48
-	#    [UnliftedTypeKind] means unboxed type
+	#    [UnboxedTypeKind]  means unboxed type
merger 0.0 (
hunk ./compiler/types/Kind.lhs 44
-	     /  \
-            *   #
+	    / | \
+	   *  !  #
merger 0.0 (
hunk ./compiler/types/Kind.lhs 11
-	isLiftedTypeKind, isUnliftedTypeKind, 
+	isLiftedTypeKind, isUnliftedTypeKind, isUnliftedBoxedTypeKind,
merger 0.0 (
hunk ./compiler/types/Kind.lhs 8
-	openTypeKind, liftedTypeKind, unliftedTypeKind, 
+	openTypeKind, liftedTypeKind, unliftedTypeKind, unboxedTypeKind,
hunk ./compiler/types/Kind.lhs 1
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1998
-%
-
-\begin{code}
-module Kind (
-	Kind, SuperKind(..), SimpleKind, 
-	openTypeKind, liftedTypeKind, unliftedTypeKind, 
-	argTypeKind, ubxTupleKind,
-
-	isLiftedTypeKind, isUnliftedTypeKind, 
-	isArgTypeKind, isOpenTypeKind,
-	mkArrowKind, mkArrowKinds,
-
-        isSubKind, defaultKind, 
-	kindFunResult, splitKindFunTys, 
-
-	KindVar, mkKindVar, kindVarRef, kindVarUniq, 
-	kindVarOcc, setKindVarOcc,
-
-	pprKind, pprParendKind
-     ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} TypeRep     ( Type )
-import {-# SOURCE #-} TyCon    ( TyCon )
-import {-# SOURCE #-} TcType   ( MetaDetails, TcTyVarDetails )
-import {-# SOURCE #-} TysWiredIn
-import Unique	( Unique )
-import OccName  ( OccName, mkOccName, tvName )
-import Outputable
-import DATA_IOREF
-\end{code}
-
-Kinds
-~~~~~
-There's a little subtyping at the kind level:  
-
-		 ?
-		/ \
-	       /   \
-	      ??   (#)
-	     /  \
-            *   #
-
-where	*    [LiftedTypeKind]   means boxed type
-	#    [UnliftedTypeKind] means unboxed type
-	(#)  [UbxTupleKind]     means unboxed tuple
-	??   [ArgTypeKind]      is the lub of *,#
-	?    [OpenTypeKind]	means any type at all
-
-In particular:
-
-	error :: forall a:?. String -> a
-	(->)  :: ?? -> ? -> *
-	(\(x::t) -> ...)	Here t::?? (i.e. not unboxed tuple)
-
-\begin{code}
-{- Kinds are now Primitive Type Constructors (PrimTyCon)
-data Kind 
-  = LiftedTypeKind 	--  *
-  | OpenTypeKind	-- ?
-  | UnliftedTypeKind	--  #
-  | UbxTupleKind	-- (##)
-  | ArgTypeKind		-- ??
-  | FunKind Kind Kind	-- k1 -> k2
-  | KindVar KindVar
-  deriving( Eq )
-
-data KindVar = KVar Unique OccName (IORef (Maybe SimpleKind))
-  -- INVARIANT: a KindVar can only be instantiated by a SimpleKind
-
-type SimpleKind = Kind	
-  -- A SimpleKind has no ? or # kinds in it:
-  -- sk ::= * | sk1 -> sk2 | kvar
--}
-
-
-type KindVar = TyVar  -- invariant: KindVar will always be a 
-                      -- TcTyVar with details MetaTv TauTv
-
-{-
-instance Eq KindVar where
-  (KVar u1 _ _) == (KVar u2 _ _) = u1 == u2
--}
-
-mkKindName :: Unique -> Name
-mkKindName unique 
-  = Name { n_sort = System
-         , n_occ  = kind_var_occ
-         , n_uniq = unique
-         , n_loc  = UnhelpfulLoc (mkFastString "Kind Variable,
internal")
-         }
-
-mkKindVar :: Unique -> IORef MetaDetails -> KindVar
-mkKindVar u r 
-  = TcTyVar { varName        = mkKindName u
-            , realUnique     = u
-            , tyVarKind      = boxSuperKindTy  -- not sure this is
right,
-                                               -- do we need kind vars
for
-                                               -- coercions?
-            , tcTyVarDetails = MetaTv TauTv r
-            }
-
-kindVarRef :: KindVar -> IORef MetaDetails
-kindVarRef (TcTyVar{tcTyVarDetails = MetaTv TauTv ref}) = ref
-kindVarRef other                   = pprPanic "kindVarRef" (ppr other)
-
-kindVarUniq :: KindVar -> Unique
-kindVarUniq (TcTyVar{realUnique = uniq}) = uniq
-kindVarUniq other                        = pprPanic "kindVarUniq" (ppr
other)
-
-kindVarOcc :: KindVar -> OccName
-kindVarOcc (TcTyVar{varName = Name {n_occ = occ}}) 
-  = occ
-kindVarOcc other
-  = pprPanic "kindVarOcc" (ppr other)
-
-setKindVarOcc :: KindVar -> OccName -> KindVar
-setKindVarOcc (rec@((TcTyVar {varName = name}))) occ
-  = (rec{ varName = name{ n_occ = occ } })
-setKindVarOcc other occ = pprPanic "setKindVarOcc" (ppr other)
-
-kind_var_occ :: OccName	-- Just one for all KindVars
-			-- They may be jiggled by tidying
-kind_var_occ = mkOccName tvName "k"
-\end{code}
-
-Super Kinds
-~~~~~~~~~~~
-There are two super kinds:
-
-  [] is the super kind of type kinds, ? and all kinds it subsumes have
[] kind
-  <> is the super kind of type coercions
-
-\begin{code}
-data SuperKind 
-  = BoxSuperKind
-  | DiamondSuperKind
-  
-\end{code}
-
-Kind inference
-~~~~~~~~~~~~~~
-During kind inference, a kind variable unifies only with 
-a "simple kind", sk
-	sk ::= * | sk1 -> sk2
-For example 
-	data T a = MkT a (T Int#)
-fails.  We give T the kind (k -> *), and the kind variable k won't
unify
-with # (the kind of Int#).
-
-Type inference
-~~~~~~~~~~~~~~
-When creating a fresh internal type variable, we give it a kind to
express 
-constraints on it.  E.g. in (\x->e) we make up a fresh type variable
for x, 
-with kind ??.  
-
-During unification we only bind an internal type variable to a type
-whose kind is lower in the sub-kind hierarchy than the kind of the
tyvar.
-
-When unifying two internal type variables, we collect their kind
constraints by
-finding the GLB of the two.  Since the partial order is a tree, they
only
-have a glb if one is a sub-kind of the other.  In that case, we bind
the
-less-informative one to the more informative one.  Neat, eh?
-
-
-\begin{code}
-kindTyConType :: TyCon -> Type
-kindTyConType kind = TyConApp kind []
-
-liftedTypeKind   = kindTyConType liftedTypeKindTyCon
-unliftedTypeKind = kindTyConType unliftedTypeKindTyCon
-openTypeKind     = kindTyConType openTypeKindTyCon
-argTypeKind      = kindTyConType argTypeKindTyCon
-ubxTupleKind	 = kindTyConType ubxTupleKindTyCon
-
-mkArrowKind :: Kind -> Kind -> Kind
-mkArrowKind k1 k2 = TyConApp funKindTyCon [k1,k2]
-
-mkArrowKinds :: [Kind] -> Kind -> Kind
-mkArrowKinds arg_kinds result_kind = foldr mkArrowKind result_kind
arg_kinds
-\end{code}
-
-%**********************************************************************
**
-%*
*
-	Functions over Kinds		
-%*
*
-%**********************************************************************
**
-
-\begin{code}
-kindFunResult :: Kind -> Kind
-kindFunResult k = funResultTy k
-
-splitKindFunTys :: Kind -> ([Kind],Kind)
-splitKindFunTys (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == funKindTyConKey =
-      case args of
-        [k1, k2] -> 
-            case splitKindFunTys k2 of
-              (as, r) -> (k1:as, r)
-        other    -> pprPanic "splitKindFunTys" "funKind does not have
two arguments"
-  | otherwise = ([], k)
-splitKindFunTys other = pprPanic "splitKindFunTys" (ppr other)
-
-shallowSplitFunKind :: Kind -> (Kind, Kind)
-shallowSplitFunKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq})
args))
-  | uniq == funKindTyConKey =
-    case args of
-      [k1, k2] -> (k1, k2)
-      other    -> pprPanic "shallowSplitFunKind" "funKind does not have
two arguments"
-  | otherwise = pprPanic "shallowSplitFunKind" (ppr k)
-shallowSplitFunKind other = pprPanic "shallowSplitFunKind" (ppr other)
-
-isLiftedTypeKind, isUnliftedTypeKind, isFunKind, isUbxTupleKind,
isRealOpenTypeKind, isRealArgTypeKind :: Kind -> Bool
-
-isLiftedTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == liftedTypeKindTyConKey = True
-  | other                          = False
-isLiftedTypeKind other = False
-
-isUnliftedTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == unliftedTypeKindTyConKey = True
-  | other                            = False
-isUnliftedTypeKind other = False
-
-isFunKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
-  = uniq == funKindTyConKey
-isFunKind other = False
-
-isUbxTupleKind (TyConApp tc _) = tyConUnique tc == ubxTupleKindTyConKey
-isUbxTupleKind other 	       = False
-
-isRealOpenTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))

-  = uniq == openTypeKindTyConKey
-isRealOpenTypeKind other = False
-
-isRealArgTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
-  = uniq == argTypeKindTyConKey
-isRealArgTypeKind other = False
-
-isArgTypeKind :: Kind -> Bool
--- True of any sub-kind of ArgTypeKind 
-isArgTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == unliftedTypeKindTyConKey = True
-  | uniq == liftedTypeKindTyConKey   = True
-  | uniq == argTypeKindTyConKey      = True
-  | otherwise                        = False
-isArgTypeKind other = False
-
-isOpenTypeKind :: Kind -> Bool
--- True of any sub-kind of OpenTypeKind (i.e. anything except arrow)
-isOpenTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == funKindTyConKey = False
-  | otherwise               = ASSERT( isKind other ) True
-isOpenTypeKind other = ASSERT( isKind other ) False
-         -- This is a conservative answer
-         -- It matters in the call to isSubKind in
-	 -- checkExpectedKind.
-
-isSubKind :: Kind -> Kind -> Bool
--- (k1 `isSubKind` k2) checks that k1 <: k2
-isSubKind (TyConApp kc1 []) (TyConApp kc2 []) = kc1 `isSubKindCon` kc1
-isSubKind (FunTy a1 r1) (FunTy a2 r2)	      = (a2 `isSubKind` a1) &&
(r1 `isSubKind` r2)
-isSubKind k1 		k2 		      = False
-
-isSubKindCon :: KindCon -> KindCon -> Bool
--- (kc1 `isSubKindCon` kc2) checks that kc1 <: kc2
-isSubKindCon kc1 kc2
-  | uniq1 == liftedTypeKindTyConKey && uniq2 == liftedTypeKindTyConKey
= True
-  | uniq1 == unliftedTypeKindTyConKey && uniq2 ==
unliftedTypeKindTyConKey = True
-  | uniq1 == ubxTupleKindTyConKey && uniq2 == ubxTupleKindTyConKey =
True
-  | uniq2 == openTypeKindTyConKey && isOpenTypeKind k1 = True
-  | uniq2 == argTypeKindTyConKey && isArgTypeKind k1 = True
-
-defaultKind :: Kind -> Kind
--- Used when generalising: default kind '?' and '??' to '*'
--- 
--- When we generalise, we make generic type variables whose kind is
--- simple (* or *->* etc).  So generic type variables (other than
--- built-in constants like 'error') always have simple kinds.  This is
important;
--- consider
---	f x = True
--- We want f to get type
---	f :: forall (a::*). a -> Bool
--- Not 
---	f :: forall (a::??). a -> Bool
--- because that would allow a call like (f 3#) as well as (f True),
---and the calling conventions differ.  This defaulting is done in
TcMType.zonkTcTyVarBndr.
-defaultKind k 
-  | isOpenTypeKind k = liftedTypeKind
-  | isArgTypeKind k  = liftedTypeKind
-  | otherwise        = k
-\end{code}
-
-
-%**********************************************************************
**
-%*
*
-		Pretty printing
-%*
*
-%**********************************************************************
**
-
-\begin{code}
-
-pprParendKind :: Kind -> SDoc
-pprParendKind k 
-  | isFunKind k = parens (pprKind k)
-  | otherwise   = pprKind k
-
-pprKind k
-  | isLiftedTypeKind k   = ptext SLIT("*")
-  | isUnliftedTypeKind k = ptext SLIT("#")
-  | isUbxTupleKind k     = ptext SLIT("(#)")
-  | isFunKind k          =
-    let (k1, k2) = shallowSplitFunKind k in
-    sep [ pprParendKind k1, arrow <+> pprKind k2]
-  | isRealOpenTypeKind k     = ptext SLIT("?")
-  | isRealArgTypeKind k      = ptext SLIT("??")
-
-
-\end{code}
)
)
)
)
)
)
merger 0.0 (
hunk ./compiler/types/Kind.lhs 230
-isUbxTupleKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
-  = uniq == ubxTupleKindTyConKey
-isUbxTupleKind other = False
+isUbxTupleKind (TyConApp tc _) = tyConUnique tc == ubxTupleKindTyConKey
+isUbxTupleKind other 	       = False
merger 0.0 (
hunk ./compiler/types/Kind.lhs 221
-isUnliftedTypeKind UnliftedTypeKind = True
-isUnliftedTypeKind other	    = False
+isUnliftedTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
+  | uniq == unliftedTypeKindTyConKey = True
+  | other                            = False
+isUnliftedTypeKind other = False
+
+isFunKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
+  = uniq == funKindTyConKey
+isFunKind other = False
+
+isUbxTupleKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
+  = uniq == ubxTupleKindTyConKey
+isUbxTupleKind other = False
+
+isRealOpenTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))

+  = uniq == openTypeKindTyConKey
+isRealOpenTypeKind other = False
+
+isRealArgTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
+  = uniq == argTypeKindTyConKey
+isRealArgTypeKind other = False
hunk ./compiler/types/Kind.lhs 221
+isUnliftedBoxedTypeKind UnliftedTypeKind = True
+isUnliftedBoxedTypeKind other	    = False
+
)
)
)
merger 0.0 (
merger 0.0 (
merger 0.0 (
hunk ./compiler/types/Kind.lhs 63
-  | OpenTypeKind	-- ?
-  | UnliftedTypeKind	--  #
-  | UbxTupleKind	-- (##)
-  | ArgTypeKind		-- ??
-  | FunKind Kind Kind	-- k1 -> k2
+  | OpenTypeKind	--  ?
+  | UnboxedTypeKind	--  #
+  | UnliftedTypeKind    --  !
+  | UbxTupleKind	--  (##)
+  | ArgTypeKind		--  ??
+  | FunKind Kind Kind	--  k1 -> k2
merger 0.0 (
hunk ./compiler/types/Kind.lhs 48
-	#    [UnliftedTypeKind] means unboxed type
+	#    [UnboxedTypeKind]  means unboxed type
merger 0.0 (
hunk ./compiler/types/Kind.lhs 44
-	     /  \
-            *   #
+	    / | \
+	   *  !  #
merger 0.0 (
hunk ./compiler/types/Kind.lhs 11
-	isLiftedTypeKind, isUnliftedTypeKind, 
+	isLiftedTypeKind, isUnliftedTypeKind, isUnliftedBoxedTypeKind,
merger 0.0 (
hunk ./compiler/types/Kind.lhs 8
-	openTypeKind, liftedTypeKind, unliftedTypeKind, 
+	openTypeKind, liftedTypeKind, unliftedTypeKind, unboxedTypeKind,
hunk ./compiler/types/Kind.lhs 1
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1998
-%
-
-\begin{code}
-module Kind (
-	Kind, SuperKind(..), SimpleKind, 
-	openTypeKind, liftedTypeKind, unliftedTypeKind, 
-	argTypeKind, ubxTupleKind,
-
-	isLiftedTypeKind, isUnliftedTypeKind, 
-	isArgTypeKind, isOpenTypeKind,
-	mkArrowKind, mkArrowKinds,
-
-        isSubKind, defaultKind, 
-	kindFunResult, splitKindFunTys, 
-
-	KindVar, mkKindVar, kindVarRef, kindVarUniq, 
-	kindVarOcc, setKindVarOcc,
-
-	pprKind, pprParendKind
-     ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} TypeRep     ( Type )
-import {-# SOURCE #-} TyCon    ( TyCon )
-import {-# SOURCE #-} TcType   ( MetaDetails, TcTyVarDetails )
-import {-# SOURCE #-} TysWiredIn
-import Unique	( Unique )
-import OccName  ( OccName, mkOccName, tvName )
-import Outputable
-import DATA_IOREF
-\end{code}
-
-Kinds
-~~~~~
-There's a little subtyping at the kind level:  
-
-		 ?
-		/ \
-	       /   \
-	      ??   (#)
-	     /  \
-            *   #
-
-where	*    [LiftedTypeKind]   means boxed type
-	#    [UnliftedTypeKind] means unboxed type
-	(#)  [UbxTupleKind]     means unboxed tuple
-	??   [ArgTypeKind]      is the lub of *,#
-	?    [OpenTypeKind]	means any type at all
-
-In particular:
-
-	error :: forall a:?. String -> a
-	(->)  :: ?? -> ? -> *
-	(\(x::t) -> ...)	Here t::?? (i.e. not unboxed tuple)
-
-\begin{code}
-{- Kinds are now Primitive Type Constructors (PrimTyCon)
-data Kind 
-  = LiftedTypeKind 	--  *
-  | OpenTypeKind	-- ?
-  | UnliftedTypeKind	--  #
-  | UbxTupleKind	-- (##)
-  | ArgTypeKind		-- ??
-  | FunKind Kind Kind	-- k1 -> k2
-  | KindVar KindVar
-  deriving( Eq )
-
-data KindVar = KVar Unique OccName (IORef (Maybe SimpleKind))
-  -- INVARIANT: a KindVar can only be instantiated by a SimpleKind
-
-type SimpleKind = Kind	
-  -- A SimpleKind has no ? or # kinds in it:
-  -- sk ::= * | sk1 -> sk2 | kvar
--}
-
-
-type KindVar = TyVar  -- invariant: KindVar will always be a 
-                      -- TcTyVar with details MetaTv TauTv
-
-{-
-instance Eq KindVar where
-  (KVar u1 _ _) == (KVar u2 _ _) = u1 == u2
--}
-
-mkKindName :: Unique -> Name
-mkKindName unique 
-  = Name { n_sort = System
-         , n_occ  = kind_var_occ
-         , n_uniq = unique
-         , n_loc  = UnhelpfulLoc (mkFastString "Kind Variable,
internal")
-         }
-
-mkKindVar :: Unique -> IORef MetaDetails -> KindVar
-mkKindVar u r 
-  = TcTyVar { varName        = mkKindName u
-            , realUnique     = u
-            , tyVarKind      = boxSuperKindTy  -- not sure this is
right,
-                                               -- do we need kind vars
for
-                                               -- coercions?
-            , tcTyVarDetails = MetaTv TauTv r
-            }
-
-kindVarRef :: KindVar -> IORef MetaDetails
-kindVarRef (TcTyVar{tcTyVarDetails = MetaTv TauTv ref}) = ref
-kindVarRef other                   = pprPanic "kindVarRef" (ppr other)
-
-kindVarUniq :: KindVar -> Unique
-kindVarUniq (TcTyVar{realUnique = uniq}) = uniq
-kindVarUniq other                        = pprPanic "kindVarUniq" (ppr
other)
-
-kindVarOcc :: KindVar -> OccName
-kindVarOcc (TcTyVar{varName = Name {n_occ = occ}}) 
-  = occ
-kindVarOcc other
-  = pprPanic "kindVarOcc" (ppr other)
-
-setKindVarOcc :: KindVar -> OccName -> KindVar
-setKindVarOcc (rec@((TcTyVar {varName = name}))) occ
-  = (rec{ varName = name{ n_occ = occ } })
-setKindVarOcc other occ = pprPanic "setKindVarOcc" (ppr other)
-
-kind_var_occ :: OccName	-- Just one for all KindVars
-			-- They may be jiggled by tidying
-kind_var_occ = mkOccName tvName "k"
-\end{code}
-
-Super Kinds
-~~~~~~~~~~~
-There are two super kinds:
-
-  [] is the super kind of type kinds, ? and all kinds it subsumes have
[] kind
-  <> is the super kind of type coercions
-
-\begin{code}
-data SuperKind 
-  = BoxSuperKind
-  | DiamondSuperKind
-  
-\end{code}
-
-Kind inference
-~~~~~~~~~~~~~~
-During kind inference, a kind variable unifies only with 
-a "simple kind", sk
-	sk ::= * | sk1 -> sk2
-For example 
-	data T a = MkT a (T Int#)
-fails.  We give T the kind (k -> *), and the kind variable k won't
unify
-with # (the kind of Int#).
-
-Type inference
-~~~~~~~~~~~~~~
-When creating a fresh internal type variable, we give it a kind to
express 
-constraints on it.  E.g. in (\x->e) we make up a fresh type variable
for x, 
-with kind ??.  
-
-During unification we only bind an internal type variable to a type
-whose kind is lower in the sub-kind hierarchy than the kind of the
tyvar.
-
-When unifying two internal type variables, we collect their kind
constraints by
-finding the GLB of the two.  Since the partial order is a tree, they
only
-have a glb if one is a sub-kind of the other.  In that case, we bind
the
-less-informative one to the more informative one.  Neat, eh?
-
-
-\begin{code}
-kindTyConType :: TyCon -> Type
-kindTyConType kind = TyConApp kind []
-
-liftedTypeKind   = kindTyConType liftedTypeKindTyCon
-unliftedTypeKind = kindTyConType unliftedTypeKindTyCon
-openTypeKind     = kindTyConType openTypeKindTyCon
-argTypeKind      = kindTyConType argTypeKindTyCon
-ubxTupleKind	 = kindTyConType ubxTupleKindTyCon
-
-mkArrowKind :: Kind -> Kind -> Kind
-mkArrowKind k1 k2 = TyConApp funKindTyCon [k1,k2]
-
-mkArrowKinds :: [Kind] -> Kind -> Kind
-mkArrowKinds arg_kinds result_kind = foldr mkArrowKind result_kind
arg_kinds
-\end{code}
-
-%**********************************************************************
**
-%*
*
-	Functions over Kinds		
-%*
*
-%**********************************************************************
**
-
-\begin{code}
-kindFunResult :: Kind -> Kind
-kindFunResult k = funResultTy k
-
-splitKindFunTys :: Kind -> ([Kind],Kind)
-splitKindFunTys (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == funKindTyConKey =
-      case args of
-        [k1, k2] -> 
-            case splitKindFunTys k2 of
-              (as, r) -> (k1:as, r)
-        other    -> pprPanic "splitKindFunTys" "funKind does not have
two arguments"
-  | otherwise = ([], k)
-splitKindFunTys other = pprPanic "splitKindFunTys" (ppr other)
-
-shallowSplitFunKind :: Kind -> (Kind, Kind)
-shallowSplitFunKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq})
args))
-  | uniq == funKindTyConKey =
-    case args of
-      [k1, k2] -> (k1, k2)
-      other    -> pprPanic "shallowSplitFunKind" "funKind does not have
two arguments"
-  | otherwise = pprPanic "shallowSplitFunKind" (ppr k)
-shallowSplitFunKind other = pprPanic "shallowSplitFunKind" (ppr other)
-
-isLiftedTypeKind, isUnliftedTypeKind, isFunKind, isUbxTupleKind,
isRealOpenTypeKind, isRealArgTypeKind :: Kind -> Bool
-
-isLiftedTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == liftedTypeKindTyConKey = True
-  | other                          = False
-isLiftedTypeKind other = False
-
-isUnliftedTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == unliftedTypeKindTyConKey = True
-  | other                            = False
-isUnliftedTypeKind other = False
-
-isFunKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
-  = uniq == funKindTyConKey
-isFunKind other = False
-
-isUbxTupleKind (TyConApp tc _) = tyConUnique tc == ubxTupleKindTyConKey
-isUbxTupleKind other 	       = False
-
-isRealOpenTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))

-  = uniq == openTypeKindTyConKey
-isRealOpenTypeKind other = False
-
-isRealArgTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
-  = uniq == argTypeKindTyConKey
-isRealArgTypeKind other = False
-
-isArgTypeKind :: Kind -> Bool
--- True of any sub-kind of ArgTypeKind 
-isArgTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == unliftedTypeKindTyConKey = True
-  | uniq == liftedTypeKindTyConKey   = True
-  | uniq == argTypeKindTyConKey      = True
-  | otherwise                        = False
-isArgTypeKind other = False
-
-isOpenTypeKind :: Kind -> Bool
--- True of any sub-kind of OpenTypeKind (i.e. anything except arrow)
-isOpenTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == funKindTyConKey = False
-  | otherwise               = ASSERT( isKind other ) True
-isOpenTypeKind other = ASSERT( isKind other ) False
-         -- This is a conservative answer
-         -- It matters in the call to isSubKind in
-	 -- checkExpectedKind.
-
-isSubKind :: Kind -> Kind -> Bool
--- (k1 `isSubKind` k2) checks that k1 <: k2
-isSubKind (TyConApp kc1 []) (TyConApp kc2 []) = kc1 `isSubKindCon` kc1
-isSubKind (FunTy a1 r1) (FunTy a2 r2)	      = (a2 `isSubKind` a1) &&
(r1 `isSubKind` r2)
-isSubKind k1 		k2 		      = False
-
-isSubKindCon :: KindCon -> KindCon -> Bool
--- (kc1 `isSubKindCon` kc2) checks that kc1 <: kc2
-isSubKindCon kc1 kc2
-  | uniq1 == liftedTypeKindTyConKey && uniq2 == liftedTypeKindTyConKey
= True
-  | uniq1 == unliftedTypeKindTyConKey && uniq2 ==
unliftedTypeKindTyConKey = True
-  | uniq1 == ubxTupleKindTyConKey && uniq2 == ubxTupleKindTyConKey =
True
-  | uniq2 == openTypeKindTyConKey && isOpenTypeKind k1 = True
-  | uniq2 == argTypeKindTyConKey && isArgTypeKind k1 = True
-
-defaultKind :: Kind -> Kind
--- Used when generalising: default kind '?' and '??' to '*'
--- 
--- When we generalise, we make generic type variables whose kind is
--- simple (* or *->* etc).  So generic type variables (other than
--- built-in constants like 'error') always have simple kinds.  This is
important;
--- consider
---	f x = True
--- We want f to get type
---	f :: forall (a::*). a -> Bool
--- Not 
---	f :: forall (a::??). a -> Bool
--- because that would allow a call like (f 3#) as well as (f True),
---and the calling conventions differ.  This defaulting is done in
TcMType.zonkTcTyVarBndr.
-defaultKind k 
-  | isOpenTypeKind k = liftedTypeKind
-  | isArgTypeKind k  = liftedTypeKind
-  | otherwise        = k
-\end{code}
-
-
-%**********************************************************************
**
-%*
*
-		Pretty printing
-%*
*
-%**********************************************************************
**
-
-\begin{code}
-
-pprParendKind :: Kind -> SDoc
-pprParendKind k 
-  | isFunKind k = parens (pprKind k)
-  | otherwise   = pprKind k
-
-pprKind k
-  | isLiftedTypeKind k   = ptext SLIT("*")
-  | isUnliftedTypeKind k = ptext SLIT("#")
-  | isUbxTupleKind k     = ptext SLIT("(#)")
-  | isFunKind k          =
-    let (k1, k2) = shallowSplitFunKind k in
-    sep [ pprParendKind k1, arrow <+> pprKind k2]
-  | isRealOpenTypeKind k     = ptext SLIT("?")
-  | isRealArgTypeKind k      = ptext SLIT("??")
-
-
-\end{code}
)
)
)
)
)
merger 0.0 (
hunk ./compiler/types/Kind.lhs 171
-liftedTypeKind   = LiftedTypeKind
-unliftedTypeKind = UnliftedTypeKind
-openTypeKind     = OpenTypeKind
-argTypeKind      = ArgTypeKind
-ubxTupleKind	 = UbxTupleKind
+kindTyConType :: TyCon -> Type
+kindTyConType kind = TyConApp kind []
+
+liftedTypeKind   = kindTyConType liftedTypeKindTyCon
+unliftedTypeKind = kindTyConType unliftedTypeKindTyCon
+openTypeKind     = kindTyConType openTypeKindTyCon
+argTypeKind      = kindTyConType argTypeKindTyCon
+ubxTupleKind	 = kindTyConType ubxTupleKindTyCon
hunk ./compiler/types/Kind.lhs 172
+unboxedTypeKind  = UnboxedTypeKind
)
)
merger 0.0 (
merger 0.0 (
merger 0.0 (
hunk ./compiler/types/Kind.lhs 48
-	#    [UnliftedTypeKind] means unboxed type
+	#    [UnboxedTypeKind]  means unboxed type
merger 0.0 (
hunk ./compiler/types/Kind.lhs 44
-	     /  \
-            *   #
+	    / | \
+	   *  !  #
merger 0.0 (
hunk ./compiler/types/Kind.lhs 11
-	isLiftedTypeKind, isUnliftedTypeKind, 
+	isLiftedTypeKind, isUnliftedTypeKind, isUnliftedBoxedTypeKind,
merger 0.0 (
hunk ./compiler/types/Kind.lhs 8
-	openTypeKind, liftedTypeKind, unliftedTypeKind, 
+	openTypeKind, liftedTypeKind, unliftedTypeKind, unboxedTypeKind,
hunk ./compiler/types/Kind.lhs 1
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1998
-%
-
-\begin{code}
-module Kind (
-	Kind, SuperKind(..), SimpleKind, 
-	openTypeKind, liftedTypeKind, unliftedTypeKind, 
-	argTypeKind, ubxTupleKind,
-
-	isLiftedTypeKind, isUnliftedTypeKind, 
-	isArgTypeKind, isOpenTypeKind,
-	mkArrowKind, mkArrowKinds,
-
-        isSubKind, defaultKind, 
-	kindFunResult, splitKindFunTys, 
-
-	KindVar, mkKindVar, kindVarRef, kindVarUniq, 
-	kindVarOcc, setKindVarOcc,
-
-	pprKind, pprParendKind
-     ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} TypeRep     ( Type )
-import {-# SOURCE #-} TyCon    ( TyCon )
-import {-# SOURCE #-} TcType   ( MetaDetails, TcTyVarDetails )
-import {-# SOURCE #-} TysWiredIn
-import Unique	( Unique )
-import OccName  ( OccName, mkOccName, tvName )
-import Outputable
-import DATA_IOREF
-\end{code}
-
-Kinds
-~~~~~
-There's a little subtyping at the kind level:  
-
-		 ?
-		/ \
-	       /   \
-	      ??   (#)
-	     /  \
-            *   #
-
-where	*    [LiftedTypeKind]   means boxed type
-	#    [UnliftedTypeKind] means unboxed type
-	(#)  [UbxTupleKind]     means unboxed tuple
-	??   [ArgTypeKind]      is the lub of *,#
-	?    [OpenTypeKind]	means any type at all
-
-In particular:
-
-	error :: forall a:?. String -> a
-	(->)  :: ?? -> ? -> *
-	(\(x::t) -> ...)	Here t::?? (i.e. not unboxed tuple)
-
-\begin{code}
-{- Kinds are now Primitive Type Constructors (PrimTyCon)
-data Kind 
-  = LiftedTypeKind 	--  *
-  | OpenTypeKind	-- ?
-  | UnliftedTypeKind	--  #
-  | UbxTupleKind	-- (##)
-  | ArgTypeKind		-- ??
-  | FunKind Kind Kind	-- k1 -> k2
-  | KindVar KindVar
-  deriving( Eq )
-
-data KindVar = KVar Unique OccName (IORef (Maybe SimpleKind))
-  -- INVARIANT: a KindVar can only be instantiated by a SimpleKind
-
-type SimpleKind = Kind	
-  -- A SimpleKind has no ? or # kinds in it:
-  -- sk ::= * | sk1 -> sk2 | kvar
--}
-
-
-type KindVar = TyVar  -- invariant: KindVar will always be a 
-                      -- TcTyVar with details MetaTv TauTv
-
-{-
-instance Eq KindVar where
-  (KVar u1 _ _) == (KVar u2 _ _) = u1 == u2
--}
-
-mkKindName :: Unique -> Name
-mkKindName unique 
-  = Name { n_sort = System
-         , n_occ  = kind_var_occ
-         , n_uniq = unique
-         , n_loc  = UnhelpfulLoc (mkFastString "Kind Variable,
internal")
-         }
-
-mkKindVar :: Unique -> IORef MetaDetails -> KindVar
-mkKindVar u r 
-  = TcTyVar { varName        = mkKindName u
-            , realUnique     = u
-            , tyVarKind      = boxSuperKindTy  -- not sure this is
right,
-                                               -- do we need kind vars
for
-                                               -- coercions?
-            , tcTyVarDetails = MetaTv TauTv r
-            }
-
-kindVarRef :: KindVar -> IORef MetaDetails
-kindVarRef (TcTyVar{tcTyVarDetails = MetaTv TauTv ref}) = ref
-kindVarRef other                   = pprPanic "kindVarRef" (ppr other)
-
-kindVarUniq :: KindVar -> Unique
-kindVarUniq (TcTyVar{realUnique = uniq}) = uniq
-kindVarUniq other                        = pprPanic "kindVarUniq" (ppr
other)
-
-kindVarOcc :: KindVar -> OccName
-kindVarOcc (TcTyVar{varName = Name {n_occ = occ}}) 
-  = occ
-kindVarOcc other
-  = pprPanic "kindVarOcc" (ppr other)
-
-setKindVarOcc :: KindVar -> OccName -> KindVar
-setKindVarOcc (rec@((TcTyVar {varName = name}))) occ
-  = (rec{ varName = name{ n_occ = occ } })
-setKindVarOcc other occ = pprPanic "setKindVarOcc" (ppr other)
-
-kind_var_occ :: OccName	-- Just one for all KindVars
-			-- They may be jiggled by tidying
-kind_var_occ = mkOccName tvName "k"
-\end{code}
-
-Super Kinds
-~~~~~~~~~~~
-There are two super kinds:
-
-  [] is the super kind of type kinds, ? and all kinds it subsumes have
[] kind
-  <> is the super kind of type coercions
-
-\begin{code}
-data SuperKind 
-  = BoxSuperKind
-  | DiamondSuperKind
-  
-\end{code}
-
-Kind inference
-~~~~~~~~~~~~~~
-During kind inference, a kind variable unifies only with 
-a "simple kind", sk
-	sk ::= * | sk1 -> sk2
-For example 
-	data T a = MkT a (T Int#)
-fails.  We give T the kind (k -> *), and the kind variable k won't
unify
-with # (the kind of Int#).
-
-Type inference
-~~~~~~~~~~~~~~
-When creating a fresh internal type variable, we give it a kind to
express 
-constraints on it.  E.g. in (\x->e) we make up a fresh type variable
for x, 
-with kind ??.  
-
-During unification we only bind an internal type variable to a type
-whose kind is lower in the sub-kind hierarchy than the kind of the
tyvar.
-
-When unifying two internal type variables, we collect their kind
constraints by
-finding the GLB of the two.  Since the partial order is a tree, they
only
-have a glb if one is a sub-kind of the other.  In that case, we bind
the
-less-informative one to the more informative one.  Neat, eh?
-
-
-\begin{code}
-kindTyConType :: TyCon -> Type
-kindTyConType kind = TyConApp kind []
-
-liftedTypeKind   = kindTyConType liftedTypeKindTyCon
-unliftedTypeKind = kindTyConType unliftedTypeKindTyCon
-openTypeKind     = kindTyConType openTypeKindTyCon
-argTypeKind      = kindTyConType argTypeKindTyCon
-ubxTupleKind	 = kindTyConType ubxTupleKindTyCon
-
-mkArrowKind :: Kind -> Kind -> Kind
-mkArrowKind k1 k2 = TyConApp funKindTyCon [k1,k2]
-
-mkArrowKinds :: [Kind] -> Kind -> Kind
-mkArrowKinds arg_kinds result_kind = foldr mkArrowKind result_kind
arg_kinds
-\end{code}
-
-%**********************************************************************
**
-%*
*
-	Functions over Kinds		
-%*
*
-%**********************************************************************
**
-
-\begin{code}
-kindFunResult :: Kind -> Kind
-kindFunResult k = funResultTy k
-
-splitKindFunTys :: Kind -> ([Kind],Kind)
-splitKindFunTys (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == funKindTyConKey =
-      case args of
-        [k1, k2] -> 
-            case splitKindFunTys k2 of
-              (as, r) -> (k1:as, r)
-        other    -> pprPanic "splitKindFunTys" "funKind does not have
two arguments"
-  | otherwise = ([], k)
-splitKindFunTys other = pprPanic "splitKindFunTys" (ppr other)
-
-shallowSplitFunKind :: Kind -> (Kind, Kind)
-shallowSplitFunKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq})
args))
-  | uniq == funKindTyConKey =
-    case args of
-      [k1, k2] -> (k1, k2)
-      other    -> pprPanic "shallowSplitFunKind" "funKind does not have
two arguments"
-  | otherwise = pprPanic "shallowSplitFunKind" (ppr k)
-shallowSplitFunKind other = pprPanic "shallowSplitFunKind" (ppr other)
-
-isLiftedTypeKind, isUnliftedTypeKind, isFunKind, isUbxTupleKind,
isRealOpenTypeKind, isRealArgTypeKind :: Kind -> Bool
-
-isLiftedTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == liftedTypeKindTyConKey = True
-  | other                          = False
-isLiftedTypeKind other = False
-
-isUnliftedTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == unliftedTypeKindTyConKey = True
-  | other                            = False
-isUnliftedTypeKind other = False
-
-isFunKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
-  = uniq == funKindTyConKey
-isFunKind other = False
-
-isUbxTupleKind (TyConApp tc _) = tyConUnique tc == ubxTupleKindTyConKey
-isUbxTupleKind other 	       = False
-
-isRealOpenTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))

-  = uniq == openTypeKindTyConKey
-isRealOpenTypeKind other = False
-
-isRealArgTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
-  = uniq == argTypeKindTyConKey
-isRealArgTypeKind other = False
-
-isArgTypeKind :: Kind -> Bool
--- True of any sub-kind of ArgTypeKind 
-isArgTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == unliftedTypeKindTyConKey = True
-  | uniq == liftedTypeKindTyConKey   = True
-  | uniq == argTypeKindTyConKey      = True
-  | otherwise                        = False
-isArgTypeKind other = False
-
-isOpenTypeKind :: Kind -> Bool
--- True of any sub-kind of OpenTypeKind (i.e. anything except arrow)
-isOpenTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == funKindTyConKey = False
-  | otherwise               = ASSERT( isKind other ) True
-isOpenTypeKind other = ASSERT( isKind other ) False
-         -- This is a conservative answer
-         -- It matters in the call to isSubKind in
-	 -- checkExpectedKind.
-
-isSubKind :: Kind -> Kind -> Bool
--- (k1 `isSubKind` k2) checks that k1 <: k2
-isSubKind (TyConApp kc1 []) (TyConApp kc2 []) = kc1 `isSubKindCon` kc1
-isSubKind (FunTy a1 r1) (FunTy a2 r2)	      = (a2 `isSubKind` a1) &&
(r1 `isSubKind` r2)
-isSubKind k1 		k2 		      = False
-
-isSubKindCon :: KindCon -> KindCon -> Bool
--- (kc1 `isSubKindCon` kc2) checks that kc1 <: kc2
-isSubKindCon kc1 kc2
-  | uniq1 == liftedTypeKindTyConKey && uniq2 == liftedTypeKindTyConKey
= True
-  | uniq1 == unliftedTypeKindTyConKey && uniq2 ==
unliftedTypeKindTyConKey = True
-  | uniq1 == ubxTupleKindTyConKey && uniq2 == ubxTupleKindTyConKey =
True
-  | uniq2 == openTypeKindTyConKey && isOpenTypeKind k1 = True
-  | uniq2 == argTypeKindTyConKey && isArgTypeKind k1 = True
-
-defaultKind :: Kind -> Kind
--- Used when generalising: default kind '?' and '??' to '*'
--- 
--- When we generalise, we make generic type variables whose kind is
--- simple (* or *->* etc).  So generic type variables (other than
--- built-in constants like 'error') always have simple kinds.  This is
important;
--- consider
---	f x = True
--- We want f to get type
---	f :: forall (a::*). a -> Bool
--- Not 
---	f :: forall (a::??). a -> Bool
--- because that would allow a call like (f 3#) as well as (f True),
---and the calling conventions differ.  This defaulting is done in
TcMType.zonkTcTyVarBndr.
-defaultKind k 
-  | isOpenTypeKind k = liftedTypeKind
-  | isArgTypeKind k  = liftedTypeKind
-  | otherwise        = k
-\end{code}
-
-
-%**********************************************************************
**
-%*
*
-		Pretty printing
-%*
*
-%**********************************************************************
**
-
-\begin{code}
-
-pprParendKind :: Kind -> SDoc
-pprParendKind k 
-  | isFunKind k = parens (pprKind k)
-  | otherwise   = pprKind k
-
-pprKind k
-  | isLiftedTypeKind k   = ptext SLIT("*")
-  | isUnliftedTypeKind k = ptext SLIT("#")
-  | isUbxTupleKind k     = ptext SLIT("(#)")
-  | isFunKind k          =
-    let (k1, k2) = shallowSplitFunKind k in
-    sep [ pprParendKind k1, arrow <+> pprKind k2]
-  | isRealOpenTypeKind k     = ptext SLIT("?")
-  | isRealArgTypeKind k      = ptext SLIT("??")
-
-
-\end{code}
)
)
)
)
hunk ./compiler/types/Kind.lhs 63
-  | OpenTypeKind	-- ?
-  | UnliftedTypeKind	--  #
-  | UbxTupleKind	-- (##)
-  | ArgTypeKind		-- ??
-  | FunKind Kind Kind	-- k1 -> k2
+  | OpenTypeKind	--  ?
+  | UnboxedTypeKind	--  #
+  | UnliftedTypeKind    --  !
+  | UbxTupleKind	--  (##)
+  | ArgTypeKind		--  ??
+  | FunKind Kind Kind	--  k1 -> k2
)
merger 0.0 (
merger 0.0 (
merger 0.0 (
hunk ./compiler/types/Kind.lhs 44
-	     /  \
-            *   #
+	    / | \
+	   *  !  #
merger 0.0 (
hunk ./compiler/types/Kind.lhs 11
-	isLiftedTypeKind, isUnliftedTypeKind, 
+	isLiftedTypeKind, isUnliftedTypeKind, isUnliftedBoxedTypeKind,
merger 0.0 (
hunk ./compiler/types/Kind.lhs 8
-	openTypeKind, liftedTypeKind, unliftedTypeKind, 
+	openTypeKind, liftedTypeKind, unliftedTypeKind, unboxedTypeKind,
hunk ./compiler/types/Kind.lhs 1
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1998
-%
-
-\begin{code}
-module Kind (
-	Kind, SuperKind(..), SimpleKind, 
-	openTypeKind, liftedTypeKind, unliftedTypeKind, 
-	argTypeKind, ubxTupleKind,
-
-	isLiftedTypeKind, isUnliftedTypeKind, 
-	isArgTypeKind, isOpenTypeKind,
-	mkArrowKind, mkArrowKinds,
-
-        isSubKind, defaultKind, 
-	kindFunResult, splitKindFunTys, 
-
-	KindVar, mkKindVar, kindVarRef, kindVarUniq, 
-	kindVarOcc, setKindVarOcc,
-
-	pprKind, pprParendKind
-     ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} TypeRep     ( Type )
-import {-# SOURCE #-} TyCon    ( TyCon )
-import {-# SOURCE #-} TcType   ( MetaDetails, TcTyVarDetails )
-import {-# SOURCE #-} TysWiredIn
-import Unique	( Unique )
-import OccName  ( OccName, mkOccName, tvName )
-import Outputable
-import DATA_IOREF
-\end{code}
-
-Kinds
-~~~~~
-There's a little subtyping at the kind level:  
-
-		 ?
-		/ \
-	       /   \
-	      ??   (#)
-	     /  \
-            *   #
-
-where	*    [LiftedTypeKind]   means boxed type
-	#    [UnliftedTypeKind] means unboxed type
-	(#)  [UbxTupleKind]     means unboxed tuple
-	??   [ArgTypeKind]      is the lub of *,#
-	?    [OpenTypeKind]	means any type at all
-
-In particular:
-
-	error :: forall a:?. String -> a
-	(->)  :: ?? -> ? -> *
-	(\(x::t) -> ...)	Here t::?? (i.e. not unboxed tuple)
-
-\begin{code}
-{- Kinds are now Primitive Type Constructors (PrimTyCon)
-data Kind 
-  = LiftedTypeKind 	--  *
-  | OpenTypeKind	-- ?
-  | UnliftedTypeKind	--  #
-  | UbxTupleKind	-- (##)
-  | ArgTypeKind		-- ??
-  | FunKind Kind Kind	-- k1 -> k2
-  | KindVar KindVar
-  deriving( Eq )
-
-data KindVar = KVar Unique OccName (IORef (Maybe SimpleKind))
-  -- INVARIANT: a KindVar can only be instantiated by a SimpleKind
-
-type SimpleKind = Kind	
-  -- A SimpleKind has no ? or # kinds in it:
-  -- sk ::= * | sk1 -> sk2 | kvar
--}
-
-
-type KindVar = TyVar  -- invariant: KindVar will always be a 
-                      -- TcTyVar with details MetaTv TauTv
-
-{-
-instance Eq KindVar where
-  (KVar u1 _ _) == (KVar u2 _ _) = u1 == u2
--}
-
-mkKindName :: Unique -> Name
-mkKindName unique 
-  = Name { n_sort = System
-         , n_occ  = kind_var_occ
-         , n_uniq = unique
-         , n_loc  = UnhelpfulLoc (mkFastString "Kind Variable,
internal")
-         }
-
-mkKindVar :: Unique -> IORef MetaDetails -> KindVar
-mkKindVar u r 
-  = TcTyVar { varName        = mkKindName u
-            , realUnique     = u
-            , tyVarKind      = boxSuperKindTy  -- not sure this is
right,
-                                               -- do we need kind vars
for
-                                               -- coercions?
-            , tcTyVarDetails = MetaTv TauTv r
-            }
-
-kindVarRef :: KindVar -> IORef MetaDetails
-kindVarRef (TcTyVar{tcTyVarDetails = MetaTv TauTv ref}) = ref
-kindVarRef other                   = pprPanic "kindVarRef" (ppr other)
-
-kindVarUniq :: KindVar -> Unique
-kindVarUniq (TcTyVar{realUnique = uniq}) = uniq
-kindVarUniq other                        = pprPanic "kindVarUniq" (ppr
other)
-
-kindVarOcc :: KindVar -> OccName
-kindVarOcc (TcTyVar{varName = Name {n_occ = occ}}) 
-  = occ
-kindVarOcc other
-  = pprPanic "kindVarOcc" (ppr other)
-
-setKindVarOcc :: KindVar -> OccName -> KindVar
-setKindVarOcc (rec@((TcTyVar {varName = name}))) occ
-  = (rec{ varName = name{ n_occ = occ } })
-setKindVarOcc other occ = pprPanic "setKindVarOcc" (ppr other)
-
-kind_var_occ :: OccName	-- Just one for all KindVars
-			-- They may be jiggled by tidying
-kind_var_occ = mkOccName tvName "k"
-\end{code}
-
-Super Kinds
-~~~~~~~~~~~
-There are two super kinds:
-
-  [] is the super kind of type kinds, ? and all kinds it subsumes have
[] kind
-  <> is the super kind of type coercions
-
-\begin{code}
-data SuperKind 
-  = BoxSuperKind
-  | DiamondSuperKind
-  
-\end{code}
-
-Kind inference
-~~~~~~~~~~~~~~
-During kind inference, a kind variable unifies only with 
-a "simple kind", sk
-	sk ::= * | sk1 -> sk2
-For example 
-	data T a = MkT a (T Int#)
-fails.  We give T the kind (k -> *), and the kind variable k won't
unify
-with # (the kind of Int#).
-
-Type inference
-~~~~~~~~~~~~~~
-When creating a fresh internal type variable, we give it a kind to
express 
-constraints on it.  E.g. in (\x->e) we make up a fresh type variable
for x, 
-with kind ??.  
-
-During unification we only bind an internal type variable to a type
-whose kind is lower in the sub-kind hierarchy than the kind of the
tyvar.
-
-When unifying two internal type variables, we collect their kind
constraints by
-finding the GLB of the two.  Since the partial order is a tree, they
only
-have a glb if one is a sub-kind of the other.  In that case, we bind
the
-less-informative one to the more informative one.  Neat, eh?
-
-
-\begin{code}
-kindTyConType :: TyCon -> Type
-kindTyConType kind = TyConApp kind []
-
-liftedTypeKind   = kindTyConType liftedTypeKindTyCon
-unliftedTypeKind = kindTyConType unliftedTypeKindTyCon
-openTypeKind     = kindTyConType openTypeKindTyCon
-argTypeKind      = kindTyConType argTypeKindTyCon
-ubxTupleKind	 = kindTyConType ubxTupleKindTyCon
-
-mkArrowKind :: Kind -> Kind -> Kind
-mkArrowKind k1 k2 = TyConApp funKindTyCon [k1,k2]
-
-mkArrowKinds :: [Kind] -> Kind -> Kind
-mkArrowKinds arg_kinds result_kind = foldr mkArrowKind result_kind
arg_kinds
-\end{code}
-
-%**********************************************************************
**
-%*
*
-	Functions over Kinds		
-%*
*
-%**********************************************************************
**
-
-\begin{code}
-kindFunResult :: Kind -> Kind
-kindFunResult k = funResultTy k
-
-splitKindFunTys :: Kind -> ([Kind],Kind)
-splitKindFunTys (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == funKindTyConKey =
-      case args of
-        [k1, k2] -> 
-            case splitKindFunTys k2 of
-              (as, r) -> (k1:as, r)
-        other    -> pprPanic "splitKindFunTys" "funKind does not have
two arguments"
-  | otherwise = ([], k)
-splitKindFunTys other = pprPanic "splitKindFunTys" (ppr other)
-
-shallowSplitFunKind :: Kind -> (Kind, Kind)
-shallowSplitFunKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq})
args))
-  | uniq == funKindTyConKey =
-    case args of
-      [k1, k2] -> (k1, k2)
-      other    -> pprPanic "shallowSplitFunKind" "funKind does not have
two arguments"
-  | otherwise = pprPanic "shallowSplitFunKind" (ppr k)
-shallowSplitFunKind other = pprPanic "shallowSplitFunKind" (ppr other)
-
-isLiftedTypeKind, isUnliftedTypeKind, isFunKind, isUbxTupleKind,
isRealOpenTypeKind, isRealArgTypeKind :: Kind -> Bool
-
-isLiftedTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == liftedTypeKindTyConKey = True
-  | other                          = False
-isLiftedTypeKind other = False
-
-isUnliftedTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == unliftedTypeKindTyConKey = True
-  | other                            = False
-isUnliftedTypeKind other = False
-
-isFunKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
-  = uniq == funKindTyConKey
-isFunKind other = False
-
-isUbxTupleKind (TyConApp tc _) = tyConUnique tc == ubxTupleKindTyConKey
-isUbxTupleKind other 	       = False
-
-isRealOpenTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))

-  = uniq == openTypeKindTyConKey
-isRealOpenTypeKind other = False
-
-isRealArgTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
-  = uniq == argTypeKindTyConKey
-isRealArgTypeKind other = False
-
-isArgTypeKind :: Kind -> Bool
--- True of any sub-kind of ArgTypeKind 
-isArgTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == unliftedTypeKindTyConKey = True
-  | uniq == liftedTypeKindTyConKey   = True
-  | uniq == argTypeKindTyConKey      = True
-  | otherwise                        = False
-isArgTypeKind other = False
-
-isOpenTypeKind :: Kind -> Bool
--- True of any sub-kind of OpenTypeKind (i.e. anything except arrow)
-isOpenTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == funKindTyConKey = False
-  | otherwise               = ASSERT( isKind other ) True
-isOpenTypeKind other = ASSERT( isKind other ) False
-         -- This is a conservative answer
-         -- It matters in the call to isSubKind in
-	 -- checkExpectedKind.
-
-isSubKind :: Kind -> Kind -> Bool
--- (k1 `isSubKind` k2) checks that k1 <: k2
-isSubKind (TyConApp kc1 []) (TyConApp kc2 []) = kc1 `isSubKindCon` kc1
-isSubKind (FunTy a1 r1) (FunTy a2 r2)	      = (a2 `isSubKind` a1) &&
(r1 `isSubKind` r2)
-isSubKind k1 		k2 		      = False
-
-isSubKindCon :: KindCon -> KindCon -> Bool
--- (kc1 `isSubKindCon` kc2) checks that kc1 <: kc2
-isSubKindCon kc1 kc2
-  | uniq1 == liftedTypeKindTyConKey && uniq2 == liftedTypeKindTyConKey
= True
-  | uniq1 == unliftedTypeKindTyConKey && uniq2 ==
unliftedTypeKindTyConKey = True
-  | uniq1 == ubxTupleKindTyConKey && uniq2 == ubxTupleKindTyConKey =
True
-  | uniq2 == openTypeKindTyConKey && isOpenTypeKind k1 = True
-  | uniq2 == argTypeKindTyConKey && isArgTypeKind k1 = True
-
-defaultKind :: Kind -> Kind
--- Used when generalising: default kind '?' and '??' to '*'
--- 
--- When we generalise, we make generic type variables whose kind is
--- simple (* or *->* etc).  So generic type variables (other than
--- built-in constants like 'error') always have simple kinds.  This is
important;
--- consider
---	f x = True
--- We want f to get type
---	f :: forall (a::*). a -> Bool
--- Not 
---	f :: forall (a::??). a -> Bool
--- because that would allow a call like (f 3#) as well as (f True),
---and the calling conventions differ.  This defaulting is done in
TcMType.zonkTcTyVarBndr.
-defaultKind k 
-  | isOpenTypeKind k = liftedTypeKind
-  | isArgTypeKind k  = liftedTypeKind
-  | otherwise        = k
-\end{code}
-
-
-%**********************************************************************
**
-%*
*
-		Pretty printing
-%*
*
-%**********************************************************************
**
-
-\begin{code}
-
-pprParendKind :: Kind -> SDoc
-pprParendKind k 
-  | isFunKind k = parens (pprKind k)
-  | otherwise   = pprKind k
-
-pprKind k
-  | isLiftedTypeKind k   = ptext SLIT("*")
-  | isUnliftedTypeKind k = ptext SLIT("#")
-  | isUbxTupleKind k     = ptext SLIT("(#)")
-  | isFunKind k          =
-    let (k1, k2) = shallowSplitFunKind k in
-    sep [ pprParendKind k1, arrow <+> pprKind k2]
-  | isRealOpenTypeKind k     = ptext SLIT("?")
-  | isRealArgTypeKind k      = ptext SLIT("??")
-
-
-\end{code}
)
)
)
hunk ./compiler/types/Kind.lhs 48
-	#    [UnliftedTypeKind] means unboxed type
+	#    [UnboxedTypeKind]  means unboxed type
)
merger 0.0 (
merger 0.0 (
merger 0.0 (
hunk ./compiler/types/Kind.lhs 11
-	isLiftedTypeKind, isUnliftedTypeKind, 
+	isLiftedTypeKind, isUnliftedTypeKind, isUnliftedBoxedTypeKind,
merger 0.0 (
hunk ./compiler/types/Kind.lhs 8
-	openTypeKind, liftedTypeKind, unliftedTypeKind, 
+	openTypeKind, liftedTypeKind, unliftedTypeKind, unboxedTypeKind,
hunk ./compiler/types/Kind.lhs 1
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1998
-%
-
-\begin{code}
-module Kind (
-	Kind, SuperKind(..), SimpleKind, 
-	openTypeKind, liftedTypeKind, unliftedTypeKind, 
-	argTypeKind, ubxTupleKind,
-
-	isLiftedTypeKind, isUnliftedTypeKind, 
-	isArgTypeKind, isOpenTypeKind,
-	mkArrowKind, mkArrowKinds,
-
-        isSubKind, defaultKind, 
-	kindFunResult, splitKindFunTys, 
-
-	KindVar, mkKindVar, kindVarRef, kindVarUniq, 
-	kindVarOcc, setKindVarOcc,
-
-	pprKind, pprParendKind
-     ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} TypeRep     ( Type )
-import {-# SOURCE #-} TyCon    ( TyCon )
-import {-# SOURCE #-} TcType   ( MetaDetails, TcTyVarDetails )
-import {-# SOURCE #-} TysWiredIn
-import Unique	( Unique )
-import OccName  ( OccName, mkOccName, tvName )
-import Outputable
-import DATA_IOREF
-\end{code}
-
-Kinds
-~~~~~
-There's a little subtyping at the kind level:  
-
-		 ?
-		/ \
-	       /   \
-	      ??   (#)
-	     /  \
-            *   #
-
-where	*    [LiftedTypeKind]   means boxed type
-	#    [UnliftedTypeKind] means unboxed type
-	(#)  [UbxTupleKind]     means unboxed tuple
-	??   [ArgTypeKind]      is the lub of *,#
-	?    [OpenTypeKind]	means any type at all
-
-In particular:
-
-	error :: forall a:?. String -> a
-	(->)  :: ?? -> ? -> *
-	(\(x::t) -> ...)	Here t::?? (i.e. not unboxed tuple)
-
-\begin{code}
-{- Kinds are now Primitive Type Constructors (PrimTyCon)
-data Kind 
-  = LiftedTypeKind 	--  *
-  | OpenTypeKind	-- ?
-  | UnliftedTypeKind	--  #
-  | UbxTupleKind	-- (##)
-  | ArgTypeKind		-- ??
-  | FunKind Kind Kind	-- k1 -> k2
-  | KindVar KindVar
-  deriving( Eq )
-
-data KindVar = KVar Unique OccName (IORef (Maybe SimpleKind))
-  -- INVARIANT: a KindVar can only be instantiated by a SimpleKind
-
-type SimpleKind = Kind	
-  -- A SimpleKind has no ? or # kinds in it:
-  -- sk ::= * | sk1 -> sk2 | kvar
--}
-
-
-type KindVar = TyVar  -- invariant: KindVar will always be a 
-                      -- TcTyVar with details MetaTv TauTv
-
-{-
-instance Eq KindVar where
-  (KVar u1 _ _) == (KVar u2 _ _) = u1 == u2
--}
-
-mkKindName :: Unique -> Name
-mkKindName unique 
-  = Name { n_sort = System
-         , n_occ  = kind_var_occ
-         , n_uniq = unique
-         , n_loc  = UnhelpfulLoc (mkFastString "Kind Variable,
internal")
-         }
-
-mkKindVar :: Unique -> IORef MetaDetails -> KindVar
-mkKindVar u r 
-  = TcTyVar { varName        = mkKindName u
-            , realUnique     = u
-            , tyVarKind      = boxSuperKindTy  -- not sure this is
right,
-                                               -- do we need kind vars
for
-                                               -- coercions?
-            , tcTyVarDetails = MetaTv TauTv r
-            }
-
-kindVarRef :: KindVar -> IORef MetaDetails
-kindVarRef (TcTyVar{tcTyVarDetails = MetaTv TauTv ref}) = ref
-kindVarRef other                   = pprPanic "kindVarRef" (ppr other)
-
-kindVarUniq :: KindVar -> Unique
-kindVarUniq (TcTyVar{realUnique = uniq}) = uniq
-kindVarUniq other                        = pprPanic "kindVarUniq" (ppr
other)
-
-kindVarOcc :: KindVar -> OccName
-kindVarOcc (TcTyVar{varName = Name {n_occ = occ}}) 
-  = occ
-kindVarOcc other
-  = pprPanic "kindVarOcc" (ppr other)
-
-setKindVarOcc :: KindVar -> OccName -> KindVar
-setKindVarOcc (rec@((TcTyVar {varName = name}))) occ
-  = (rec{ varName = name{ n_occ = occ } })
-setKindVarOcc other occ = pprPanic "setKindVarOcc" (ppr other)
-
-kind_var_occ :: OccName	-- Just one for all KindVars
-			-- They may be jiggled by tidying
-kind_var_occ = mkOccName tvName "k"
-\end{code}
-
-Super Kinds
-~~~~~~~~~~~
-There are two super kinds:
-
-  [] is the super kind of type kinds, ? and all kinds it subsumes have
[] kind
-  <> is the super kind of type coercions
-
-\begin{code}
-data SuperKind 
-  = BoxSuperKind
-  | DiamondSuperKind
-  
-\end{code}
-
-Kind inference
-~~~~~~~~~~~~~~
-During kind inference, a kind variable unifies only with 
-a "simple kind", sk
-	sk ::= * | sk1 -> sk2
-For example 
-	data T a = MkT a (T Int#)
-fails.  We give T the kind (k -> *), and the kind variable k won't
unify
-with # (the kind of Int#).
-
-Type inference
-~~~~~~~~~~~~~~
-When creating a fresh internal type variable, we give it a kind to
express 
-constraints on it.  E.g. in (\x->e) we make up a fresh type variable
for x, 
-with kind ??.  
-
-During unification we only bind an internal type variable to a type
-whose kind is lower in the sub-kind hierarchy than the kind of the
tyvar.
-
-When unifying two internal type variables, we collect their kind
constraints by
-finding the GLB of the two.  Since the partial order is a tree, they
only
-have a glb if one is a sub-kind of the other.  In that case, we bind
the
-less-informative one to the more informative one.  Neat, eh?
-
-
-\begin{code}
-kindTyConType :: TyCon -> Type
-kindTyConType kind = TyConApp kind []
-
-liftedTypeKind   = kindTyConType liftedTypeKindTyCon
-unliftedTypeKind = kindTyConType unliftedTypeKindTyCon
-openTypeKind     = kindTyConType openTypeKindTyCon
-argTypeKind      = kindTyConType argTypeKindTyCon
-ubxTupleKind	 = kindTyConType ubxTupleKindTyCon
-
-mkArrowKind :: Kind -> Kind -> Kind
-mkArrowKind k1 k2 = TyConApp funKindTyCon [k1,k2]
-
-mkArrowKinds :: [Kind] -> Kind -> Kind
-mkArrowKinds arg_kinds result_kind = foldr mkArrowKind result_kind
arg_kinds
-\end{code}
-
-%**********************************************************************
**
-%*
*
-	Functions over Kinds		
-%*
*
-%**********************************************************************
**
-
-\begin{code}
-kindFunResult :: Kind -> Kind
-kindFunResult k = funResultTy k
-
-splitKindFunTys :: Kind -> ([Kind],Kind)
-splitKindFunTys (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == funKindTyConKey =
-      case args of
-        [k1, k2] -> 
-            case splitKindFunTys k2 of
-              (as, r) -> (k1:as, r)
-        other    -> pprPanic "splitKindFunTys" "funKind does not have
two arguments"
-  | otherwise = ([], k)
-splitKindFunTys other = pprPanic "splitKindFunTys" (ppr other)
-
-shallowSplitFunKind :: Kind -> (Kind, Kind)
-shallowSplitFunKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq})
args))
-  | uniq == funKindTyConKey =
-    case args of
-      [k1, k2] -> (k1, k2)
-      other    -> pprPanic "shallowSplitFunKind" "funKind does not have
two arguments"
-  | otherwise = pprPanic "shallowSplitFunKind" (ppr k)
-shallowSplitFunKind other = pprPanic "shallowSplitFunKind" (ppr other)
-
-isLiftedTypeKind, isUnliftedTypeKind, isFunKind, isUbxTupleKind,
isRealOpenTypeKind, isRealArgTypeKind :: Kind -> Bool
-
-isLiftedTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == liftedTypeKindTyConKey = True
-  | other                          = False
-isLiftedTypeKind other = False
-
-isUnliftedTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == unliftedTypeKindTyConKey = True
-  | other                            = False
-isUnliftedTypeKind other = False
-
-isFunKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
-  = uniq == funKindTyConKey
-isFunKind other = False
-
-isUbxTupleKind (TyConApp tc _) = tyConUnique tc == ubxTupleKindTyConKey
-isUbxTupleKind other 	       = False
-
-isRealOpenTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))

-  = uniq == openTypeKindTyConKey
-isRealOpenTypeKind other = False
-
-isRealArgTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
-  = uniq == argTypeKindTyConKey
-isRealArgTypeKind other = False
-
-isArgTypeKind :: Kind -> Bool
--- True of any sub-kind of ArgTypeKind 
-isArgTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == unliftedTypeKindTyConKey = True
-  | uniq == liftedTypeKindTyConKey   = True
-  | uniq == argTypeKindTyConKey      = True
-  | otherwise                        = False
-isArgTypeKind other = False
-
-isOpenTypeKind :: Kind -> Bool
--- True of any sub-kind of OpenTypeKind (i.e. anything except arrow)
-isOpenTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == funKindTyConKey = False
-  | otherwise               = ASSERT( isKind other ) True
-isOpenTypeKind other = ASSERT( isKind other ) False
-         -- This is a conservative answer
-         -- It matters in the call to isSubKind in
-	 -- checkExpectedKind.
-
-isSubKind :: Kind -> Kind -> Bool
--- (k1 `isSubKind` k2) checks that k1 <: k2
-isSubKind (TyConApp kc1 []) (TyConApp kc2 []) = kc1 `isSubKindCon` kc1
-isSubKind (FunTy a1 r1) (FunTy a2 r2)	      = (a2 `isSubKind` a1) &&
(r1 `isSubKind` r2)
-isSubKind k1 		k2 		      = False
-
-isSubKindCon :: KindCon -> KindCon -> Bool
--- (kc1 `isSubKindCon` kc2) checks that kc1 <: kc2
-isSubKindCon kc1 kc2
-  | uniq1 == liftedTypeKindTyConKey && uniq2 == liftedTypeKindTyConKey
= True
-  | uniq1 == unliftedTypeKindTyConKey && uniq2 ==
unliftedTypeKindTyConKey = True
-  | uniq1 == ubxTupleKindTyConKey && uniq2 == ubxTupleKindTyConKey =
True
-  | uniq2 == openTypeKindTyConKey && isOpenTypeKind k1 = True
-  | uniq2 == argTypeKindTyConKey && isArgTypeKind k1 = True
-
-defaultKind :: Kind -> Kind
--- Used when generalising: default kind '?' and '??' to '*'
--- 
--- When we generalise, we make generic type variables whose kind is
--- simple (* or *->* etc).  So generic type variables (other than
--- built-in constants like 'error') always have simple kinds.  This is
important;
--- consider
---	f x = True
--- We want f to get type
---	f :: forall (a::*). a -> Bool
--- Not 
---	f :: forall (a::??). a -> Bool
--- because that would allow a call like (f 3#) as well as (f True),
---and the calling conventions differ.  This defaulting is done in
TcMType.zonkTcTyVarBndr.
-defaultKind k 
-  | isOpenTypeKind k = liftedTypeKind
-  | isArgTypeKind k  = liftedTypeKind
-  | otherwise        = k
-\end{code}
-
-
-%**********************************************************************
**
-%*
*
-		Pretty printing
-%*
*
-%**********************************************************************
**
-
-\begin{code}
-
-pprParendKind :: Kind -> SDoc
-pprParendKind k 
-  | isFunKind k = parens (pprKind k)
-  | otherwise   = pprKind k
-
-pprKind k
-  | isLiftedTypeKind k   = ptext SLIT("*")
-  | isUnliftedTypeKind k = ptext SLIT("#")
-  | isUbxTupleKind k     = ptext SLIT("(#)")
-  | isFunKind k          =
-    let (k1, k2) = shallowSplitFunKind k in
-    sep [ pprParendKind k1, arrow <+> pprKind k2]
-  | isRealOpenTypeKind k     = ptext SLIT("?")
-  | isRealArgTypeKind k      = ptext SLIT("??")
-
-
-\end{code}
)
)
hunk ./compiler/types/Kind.lhs 44
-	     /  \
-            *   #
+	    / | \
+	   *  !  #
)
merger 0.0 (
merger 0.0 (
merger 0.0 (
hunk ./compiler/types/Kind.lhs 8
-	openTypeKind, liftedTypeKind, unliftedTypeKind, 
+	openTypeKind, liftedTypeKind, unliftedTypeKind, unboxedTypeKind,
hunk ./compiler/types/Kind.lhs 1
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1998
-%
-
-\begin{code}
-module Kind (
-	Kind, SuperKind(..), SimpleKind, 
-	openTypeKind, liftedTypeKind, unliftedTypeKind, 
-	argTypeKind, ubxTupleKind,
-
-	isLiftedTypeKind, isUnliftedTypeKind, 
-	isArgTypeKind, isOpenTypeKind,
-	mkArrowKind, mkArrowKinds,
-
-        isSubKind, defaultKind, 
-	kindFunResult, splitKindFunTys, 
-
-	KindVar, mkKindVar, kindVarRef, kindVarUniq, 
-	kindVarOcc, setKindVarOcc,
-
-	pprKind, pprParendKind
-     ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} TypeRep     ( Type )
-import {-# SOURCE #-} TyCon    ( TyCon )
-import {-# SOURCE #-} TcType   ( MetaDetails, TcTyVarDetails )
-import {-# SOURCE #-} TysWiredIn
-import Unique	( Unique )
-import OccName  ( OccName, mkOccName, tvName )
-import Outputable
-import DATA_IOREF
-\end{code}
-
-Kinds
-~~~~~
-There's a little subtyping at the kind level:  
-
-		 ?
-		/ \
-	       /   \
-	      ??   (#)
-	     /  \
-            *   #
-
-where	*    [LiftedTypeKind]   means boxed type
-	#    [UnliftedTypeKind] means unboxed type
-	(#)  [UbxTupleKind]     means unboxed tuple
-	??   [ArgTypeKind]      is the lub of *,#
-	?    [OpenTypeKind]	means any type at all
-
-In particular:
-
-	error :: forall a:?. String -> a
-	(->)  :: ?? -> ? -> *
-	(\(x::t) -> ...)	Here t::?? (i.e. not unboxed tuple)
-
-\begin{code}
-{- Kinds are now Primitive Type Constructors (PrimTyCon)
-data Kind 
-  = LiftedTypeKind 	--  *
-  | OpenTypeKind	-- ?
-  | UnliftedTypeKind	--  #
-  | UbxTupleKind	-- (##)
-  | ArgTypeKind		-- ??
-  | FunKind Kind Kind	-- k1 -> k2
-  | KindVar KindVar
-  deriving( Eq )
-
-data KindVar = KVar Unique OccName (IORef (Maybe SimpleKind))
-  -- INVARIANT: a KindVar can only be instantiated by a SimpleKind
-
-type SimpleKind = Kind	
-  -- A SimpleKind has no ? or # kinds in it:
-  -- sk ::= * | sk1 -> sk2 | kvar
--}
-
-
-type KindVar = TyVar  -- invariant: KindVar will always be a 
-                      -- TcTyVar with details MetaTv TauTv
-
-{-
-instance Eq KindVar where
-  (KVar u1 _ _) == (KVar u2 _ _) = u1 == u2
--}
-
-mkKindName :: Unique -> Name
-mkKindName unique 
-  = Name { n_sort = System
-         , n_occ  = kind_var_occ
-         , n_uniq = unique
-         , n_loc  = UnhelpfulLoc (mkFastString "Kind Variable,
internal")
-         }
-
-mkKindVar :: Unique -> IORef MetaDetails -> KindVar
-mkKindVar u r 
-  = TcTyVar { varName        = mkKindName u
-            , realUnique     = u
-            , tyVarKind      = boxSuperKindTy  -- not sure this is
right,
-                                               -- do we need kind vars
for
-                                               -- coercions?
-            , tcTyVarDetails = MetaTv TauTv r
-            }
-
-kindVarRef :: KindVar -> IORef MetaDetails
-kindVarRef (TcTyVar{tcTyVarDetails = MetaTv TauTv ref}) = ref
-kindVarRef other                   = pprPanic "kindVarRef" (ppr other)
-
-kindVarUniq :: KindVar -> Unique
-kindVarUniq (TcTyVar{realUnique = uniq}) = uniq
-kindVarUniq other                        = pprPanic "kindVarUniq" (ppr
other)
-
-kindVarOcc :: KindVar -> OccName
-kindVarOcc (TcTyVar{varName = Name {n_occ = occ}}) 
-  = occ
-kindVarOcc other
-  = pprPanic "kindVarOcc" (ppr other)
-
-setKindVarOcc :: KindVar -> OccName -> KindVar
-setKindVarOcc (rec@((TcTyVar {varName = name}))) occ
-  = (rec{ varName = name{ n_occ = occ } })
-setKindVarOcc other occ = pprPanic "setKindVarOcc" (ppr other)
-
-kind_var_occ :: OccName	-- Just one for all KindVars
-			-- They may be jiggled by tidying
-kind_var_occ = mkOccName tvName "k"
-\end{code}
-
-Super Kinds
-~~~~~~~~~~~
-There are two super kinds:
-
-  [] is the super kind of type kinds, ? and all kinds it subsumes have
[] kind
-  <> is the super kind of type coercions
-
-\begin{code}
-data SuperKind 
-  = BoxSuperKind
-  | DiamondSuperKind
-  
-\end{code}
-
-Kind inference
-~~~~~~~~~~~~~~
-During kind inference, a kind variable unifies only with 
-a "simple kind", sk
-	sk ::= * | sk1 -> sk2
-For example 
-	data T a = MkT a (T Int#)
-fails.  We give T the kind (k -> *), and the kind variable k won't
unify
-with # (the kind of Int#).
-
-Type inference
-~~~~~~~~~~~~~~
-When creating a fresh internal type variable, we give it a kind to
express 
-constraints on it.  E.g. in (\x->e) we make up a fresh type variable
for x, 
-with kind ??.  
-
-During unification we only bind an internal type variable to a type
-whose kind is lower in the sub-kind hierarchy than the kind of the
tyvar.
-
-When unifying two internal type variables, we collect their kind
constraints by
-finding the GLB of the two.  Since the partial order is a tree, they
only
-have a glb if one is a sub-kind of the other.  In that case, we bind
the
-less-informative one to the more informative one.  Neat, eh?
-
-
-\begin{code}
-kindTyConType :: TyCon -> Type
-kindTyConType kind = TyConApp kind []
-
-liftedTypeKind   = kindTyConType liftedTypeKindTyCon
-unliftedTypeKind = kindTyConType unliftedTypeKindTyCon
-openTypeKind     = kindTyConType openTypeKindTyCon
-argTypeKind      = kindTyConType argTypeKindTyCon
-ubxTupleKind	 = kindTyConType ubxTupleKindTyCon
-
-mkArrowKind :: Kind -> Kind -> Kind
-mkArrowKind k1 k2 = TyConApp funKindTyCon [k1,k2]
-
-mkArrowKinds :: [Kind] -> Kind -> Kind
-mkArrowKinds arg_kinds result_kind = foldr mkArrowKind result_kind
arg_kinds
-\end{code}
-
-%**********************************************************************
**
-%*
*
-	Functions over Kinds		
-%*
*
-%**********************************************************************
**
-
-\begin{code}
-kindFunResult :: Kind -> Kind
-kindFunResult k = funResultTy k
-
-splitKindFunTys :: Kind -> ([Kind],Kind)
-splitKindFunTys (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == funKindTyConKey =
-      case args of
-        [k1, k2] -> 
-            case splitKindFunTys k2 of
-              (as, r) -> (k1:as, r)
-        other    -> pprPanic "splitKindFunTys" "funKind does not have
two arguments"
-  | otherwise = ([], k)
-splitKindFunTys other = pprPanic "splitKindFunTys" (ppr other)
-
-shallowSplitFunKind :: Kind -> (Kind, Kind)
-shallowSplitFunKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq})
args))
-  | uniq == funKindTyConKey =
-    case args of
-      [k1, k2] -> (k1, k2)
-      other    -> pprPanic "shallowSplitFunKind" "funKind does not have
two arguments"
-  | otherwise = pprPanic "shallowSplitFunKind" (ppr k)
-shallowSplitFunKind other = pprPanic "shallowSplitFunKind" (ppr other)
-
-isLiftedTypeKind, isUnliftedTypeKind, isFunKind, isUbxTupleKind,
isRealOpenTypeKind, isRealArgTypeKind :: Kind -> Bool
-
-isLiftedTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == liftedTypeKindTyConKey = True
-  | other                          = False
-isLiftedTypeKind other = False
-
-isUnliftedTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == unliftedTypeKindTyConKey = True
-  | other                            = False
-isUnliftedTypeKind other = False
-
-isFunKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
-  = uniq == funKindTyConKey
-isFunKind other = False
-
-isUbxTupleKind (TyConApp tc _) = tyConUnique tc == ubxTupleKindTyConKey
-isUbxTupleKind other 	       = False
-
-isRealOpenTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))

-  = uniq == openTypeKindTyConKey
-isRealOpenTypeKind other = False
-
-isRealArgTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
-  = uniq == argTypeKindTyConKey
-isRealArgTypeKind other = False
-
-isArgTypeKind :: Kind -> Bool
--- True of any sub-kind of ArgTypeKind 
-isArgTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == unliftedTypeKindTyConKey = True
-  | uniq == liftedTypeKindTyConKey   = True
-  | uniq == argTypeKindTyConKey      = True
-  | otherwise                        = False
-isArgTypeKind other = False
-
-isOpenTypeKind :: Kind -> Bool
--- True of any sub-kind of OpenTypeKind (i.e. anything except arrow)
-isOpenTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == funKindTyConKey = False
-  | otherwise               = ASSERT( isKind other ) True
-isOpenTypeKind other = ASSERT( isKind other ) False
-         -- This is a conservative answer
-         -- It matters in the call to isSubKind in
-	 -- checkExpectedKind.
-
-isSubKind :: Kind -> Kind -> Bool
--- (k1 `isSubKind` k2) checks that k1 <: k2
-isSubKind (TyConApp kc1 []) (TyConApp kc2 []) = kc1 `isSubKindCon` kc1
-isSubKind (FunTy a1 r1) (FunTy a2 r2)	      = (a2 `isSubKind` a1) &&
(r1 `isSubKind` r2)
-isSubKind k1 		k2 		      = False
-
-isSubKindCon :: KindCon -> KindCon -> Bool
--- (kc1 `isSubKindCon` kc2) checks that kc1 <: kc2
-isSubKindCon kc1 kc2
-  | uniq1 == liftedTypeKindTyConKey && uniq2 == liftedTypeKindTyConKey
= True
-  | uniq1 == unliftedTypeKindTyConKey && uniq2 ==
unliftedTypeKindTyConKey = True
-  | uniq1 == ubxTupleKindTyConKey && uniq2 == ubxTupleKindTyConKey =
True
-  | uniq2 == openTypeKindTyConKey && isOpenTypeKind k1 = True
-  | uniq2 == argTypeKindTyConKey && isArgTypeKind k1 = True
-
-defaultKind :: Kind -> Kind
--- Used when generalising: default kind '?' and '??' to '*'
--- 
--- When we generalise, we make generic type variables whose kind is
--- simple (* or *->* etc).  So generic type variables (other than
--- built-in constants like 'error') always have simple kinds.  This is
important;
--- consider
---	f x = True
--- We want f to get type
---	f :: forall (a::*). a -> Bool
--- Not 
---	f :: forall (a::??). a -> Bool
--- because that would allow a call like (f 3#) as well as (f True),
---and the calling conventions differ.  This defaulting is done in
TcMType.zonkTcTyVarBndr.
-defaultKind k 
-  | isOpenTypeKind k = liftedTypeKind
-  | isArgTypeKind k  = liftedTypeKind
-  | otherwise        = k
-\end{code}
-
-
-%**********************************************************************
**
-%*
*
-		Pretty printing
-%*
*
-%**********************************************************************
**
-
-\begin{code}
-
-pprParendKind :: Kind -> SDoc
-pprParendKind k 
-  | isFunKind k = parens (pprKind k)
-  | otherwise   = pprKind k
-
-pprKind k
-  | isLiftedTypeKind k   = ptext SLIT("*")
-  | isUnliftedTypeKind k = ptext SLIT("#")
-  | isUbxTupleKind k     = ptext SLIT("(#)")
-  | isFunKind k          =
-    let (k1, k2) = shallowSplitFunKind k in
-    sep [ pprParendKind k1, arrow <+> pprKind k2]
-  | isRealOpenTypeKind k     = ptext SLIT("?")
-  | isRealArgTypeKind k      = ptext SLIT("??")
-
-
-\end{code}
)
hunk ./compiler/types/Kind.lhs 11
-	isLiftedTypeKind, isUnliftedTypeKind, 
+	isLiftedTypeKind, isUnliftedTypeKind, isUnliftedBoxedTypeKind,
)
merger 0.0 (
merger 0.0 (
hunk ./compiler/types/Kind.lhs 1
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1998
-%
-
-\begin{code}
-module Kind (
-	Kind, SuperKind(..), SimpleKind, 
-	openTypeKind, liftedTypeKind, unliftedTypeKind, 
-	argTypeKind, ubxTupleKind,
-
-	isLiftedTypeKind, isUnliftedTypeKind, 
-	isArgTypeKind, isOpenTypeKind,
-	mkArrowKind, mkArrowKinds,
-
-        isSubKind, defaultKind, 
-	kindFunResult, splitKindFunTys, 
-
-	KindVar, mkKindVar, kindVarRef, kindVarUniq, 
-	kindVarOcc, setKindVarOcc,
-
-	pprKind, pprParendKind
-     ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} TypeRep     ( Type )
-import {-# SOURCE #-} TyCon    ( TyCon )
-import {-# SOURCE #-} TcType   ( MetaDetails, TcTyVarDetails )
-import {-# SOURCE #-} TysWiredIn
-import Unique	( Unique )
-import OccName  ( OccName, mkOccName, tvName )
-import Outputable
-import DATA_IOREF
-\end{code}
-
-Kinds
-~~~~~
-There's a little subtyping at the kind level:  
-
-		 ?
-		/ \
-	       /   \
-	      ??   (#)
-	     /  \
-            *   #
-
-where	*    [LiftedTypeKind]   means boxed type
-	#    [UnliftedTypeKind] means unboxed type
-	(#)  [UbxTupleKind]     means unboxed tuple
-	??   [ArgTypeKind]      is the lub of *,#
-	?    [OpenTypeKind]	means any type at all
-
-In particular:
-
-	error :: forall a:?. String -> a
-	(->)  :: ?? -> ? -> *
-	(\(x::t) -> ...)	Here t::?? (i.e. not unboxed tuple)
-
-\begin{code}
-{- Kinds are now Primitive Type Constructors (PrimTyCon)
-data Kind 
-  = LiftedTypeKind 	--  *
-  | OpenTypeKind	-- ?
-  | UnliftedTypeKind	--  #
-  | UbxTupleKind	-- (##)
-  | ArgTypeKind		-- ??
-  | FunKind Kind Kind	-- k1 -> k2
-  | KindVar KindVar
-  deriving( Eq )
-
-data KindVar = KVar Unique OccName (IORef (Maybe SimpleKind))
-  -- INVARIANT: a KindVar can only be instantiated by a SimpleKind
-
-type SimpleKind = Kind	
-  -- A SimpleKind has no ? or # kinds in it:
-  -- sk ::= * | sk1 -> sk2 | kvar
--}
-
-
-type KindVar = TyVar  -- invariant: KindVar will always be a 
-                      -- TcTyVar with details MetaTv TauTv
-
-{-
-instance Eq KindVar where
-  (KVar u1 _ _) == (KVar u2 _ _) = u1 == u2
--}
-
-mkKindName :: Unique -> Name
-mkKindName unique 
-  = Name { n_sort = System
-         , n_occ  = kind_var_occ
-         , n_uniq = unique
-         , n_loc  = UnhelpfulLoc (mkFastString "Kind Variable,
internal")
-         }
-
-mkKindVar :: Unique -> IORef MetaDetails -> KindVar
-mkKindVar u r 
-  = TcTyVar { varName        = mkKindName u
-            , realUnique     = u
-            , tyVarKind      = boxSuperKindTy  -- not sure this is
right,
-                                               -- do we need kind vars
for
-                                               -- coercions?
-            , tcTyVarDetails = MetaTv TauTv r
-            }
-
-kindVarRef :: KindVar -> IORef MetaDetails
-kindVarRef (TcTyVar{tcTyVarDetails = MetaTv TauTv ref}) = ref
-kindVarRef other                   = pprPanic "kindVarRef" (ppr other)
-
-kindVarUniq :: KindVar -> Unique
-kindVarUniq (TcTyVar{realUnique = uniq}) = uniq
-kindVarUniq other                        = pprPanic "kindVarUniq" (ppr
other)
-
-kindVarOcc :: KindVar -> OccName
-kindVarOcc (TcTyVar{varName = Name {n_occ = occ}}) 
-  = occ
-kindVarOcc other
-  = pprPanic "kindVarOcc" (ppr other)
-
-setKindVarOcc :: KindVar -> OccName -> KindVar
-setKindVarOcc (rec@((TcTyVar {varName = name}))) occ
-  = (rec{ varName = name{ n_occ = occ } })
-setKindVarOcc other occ = pprPanic "setKindVarOcc" (ppr other)
-
-kind_var_occ :: OccName	-- Just one for all KindVars
-			-- They may be jiggled by tidying
-kind_var_occ = mkOccName tvName "k"
-\end{code}
-
-Super Kinds
-~~~~~~~~~~~
-There are two super kinds:
-
-  [] is the super kind of type kinds, ? and all kinds it subsumes have
[] kind
-  <> is the super kind of type coercions
-
-\begin{code}
-data SuperKind 
-  = BoxSuperKind
-  | DiamondSuperKind
-  
-\end{code}
-
-Kind inference
-~~~~~~~~~~~~~~
-During kind inference, a kind variable unifies only with 
-a "simple kind", sk
-	sk ::= * | sk1 -> sk2
-For example 
-	data T a = MkT a (T Int#)
-fails.  We give T the kind (k -> *), and the kind variable k won't
unify
-with # (the kind of Int#).
-
-Type inference
-~~~~~~~~~~~~~~
-When creating a fresh internal type variable, we give it a kind to
express 
-constraints on it.  E.g. in (\x->e) we make up a fresh type variable
for x, 
-with kind ??.  
-
-During unification we only bind an internal type variable to a type
-whose kind is lower in the sub-kind hierarchy than the kind of the
tyvar.
-
-When unifying two internal type variables, we collect their kind
constraints by
-finding the GLB of the two.  Since the partial order is a tree, they
only
-have a glb if one is a sub-kind of the other.  In that case, we bind
the
-less-informative one to the more informative one.  Neat, eh?
-
-
-\begin{code}
-kindTyConType :: TyCon -> Type
-kindTyConType kind = TyConApp kind []
-
-liftedTypeKind   = kindTyConType liftedTypeKindTyCon
-unliftedTypeKind = kindTyConType unliftedTypeKindTyCon
-openTypeKind     = kindTyConType openTypeKindTyCon
-argTypeKind      = kindTyConType argTypeKindTyCon
-ubxTupleKind	 = kindTyConType ubxTupleKindTyCon
-
-mkArrowKind :: Kind -> Kind -> Kind
-mkArrowKind k1 k2 = TyConApp funKindTyCon [k1,k2]
-
-mkArrowKinds :: [Kind] -> Kind -> Kind
-mkArrowKinds arg_kinds result_kind = foldr mkArrowKind result_kind
arg_kinds
-\end{code}
-
-%**********************************************************************
**
-%*
*
-	Functions over Kinds		
-%*
*
-%**********************************************************************
**
-
-\begin{code}
-kindFunResult :: Kind -> Kind
-kindFunResult k = funResultTy k
-
-splitKindFunTys :: Kind -> ([Kind],Kind)
-splitKindFunTys (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == funKindTyConKey =
-      case args of
-        [k1, k2] -> 
-            case splitKindFunTys k2 of
-              (as, r) -> (k1:as, r)
-        other    -> pprPanic "splitKindFunTys" "funKind does not have
two arguments"
-  | otherwise = ([], k)
-splitKindFunTys other = pprPanic "splitKindFunTys" (ppr other)
-
-shallowSplitFunKind :: Kind -> (Kind, Kind)
-shallowSplitFunKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq})
args))
-  | uniq == funKindTyConKey =
-    case args of
-      [k1, k2] -> (k1, k2)
-      other    -> pprPanic "shallowSplitFunKind" "funKind does not have
two arguments"
-  | otherwise = pprPanic "shallowSplitFunKind" (ppr k)
-shallowSplitFunKind other = pprPanic "shallowSplitFunKind" (ppr other)
-
-isLiftedTypeKind, isUnliftedTypeKind, isFunKind, isUbxTupleKind,
isRealOpenTypeKind, isRealArgTypeKind :: Kind -> Bool
-
-isLiftedTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == liftedTypeKindTyConKey = True
-  | other                          = False
-isLiftedTypeKind other = False
-
-isUnliftedTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == unliftedTypeKindTyConKey = True
-  | other                            = False
-isUnliftedTypeKind other = False
-
-isFunKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
-  = uniq == funKindTyConKey
-isFunKind other = False
-
-isUbxTupleKind (TyConApp tc _) = tyConUnique tc == ubxTupleKindTyConKey
-isUbxTupleKind other 	       = False
-
-isRealOpenTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))

-  = uniq == openTypeKindTyConKey
-isRealOpenTypeKind other = False
-
-isRealArgTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args)) 
-  = uniq == argTypeKindTyConKey
-isRealArgTypeKind other = False
-
-isArgTypeKind :: Kind -> Bool
--- True of any sub-kind of ArgTypeKind 
-isArgTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == unliftedTypeKindTyConKey = True
-  | uniq == liftedTypeKindTyConKey   = True
-  | uniq == argTypeKindTyConKey      = True
-  | otherwise                        = False
-isArgTypeKind other = False
-
-isOpenTypeKind :: Kind -> Bool
--- True of any sub-kind of OpenTypeKind (i.e. anything except arrow)
-isOpenTypeKind (k@(TyConApp (PrimTyCon {tyConUnique = uniq}) args))
-  | uniq == funKindTyConKey = False
-  | otherwise               = ASSERT( isKind other ) True
-isOpenTypeKind other = ASSERT( isKind other ) False
-         -- This is a conservative answer
-         -- It matters in the call to isSubKind in
-	 -- checkExpectedKind.
-
-isSubKind :: Kind -> Kind -> Bool
--- (k1 `isSubKind` k2) checks that k1 <: k2
-isSubKind (TyConApp kc1 []) (TyConApp kc2 []) = kc1 `isSubKindCon` kc1
-isSubKind (FunTy a1 r1) (FunTy a2 r2)	      = (a2 `isSubKind` a1) &&
(r1 `isSubKind` r2)
-isSubKind k1 		k2 		      = False
-
-isSubKindCon :: KindCon -> KindCon -> Bool
--- (kc1 `isSubKindCon` kc2) checks that kc1 <: kc2
-isSubKindCon kc1 kc2
-  | uniq1 == liftedTypeKindTyConKey && uniq2 == liftedTypeKindTyConKey
= True
-  | uniq1 == unliftedTypeKindTyConKey && uniq2 ==
unliftedTypeKindTyConKey = True
-  | uniq1 == ubxTupleKindTyConKey && uniq2 == ubxTupleKindTyConKey =
True
-  | uniq2 == openTypeKindTyConKey && isOpenTypeKind k1 = True
-  | uniq2 == argTypeKindTyConKey && isArgTypeKind k1 = True
-
-defaultKind :: Kind -> Kind
--- Used when generalising: default kind '?' and '??' to '*'
--- 
--- When we generalise, we make generic type variables whose kind is
--- simple (* or *->* etc).  So generic type variables (other than
--- built-in constants like 'error') always have simple kinds.  This is
important;
--- consider
---	f x = True
--- We want f to get type
---	f :: forall (a::*). a -> Bool
--- Not 
---	f :: forall (a::??). a -> Bool
--- because that would allow a call like (f 3#) as well as (f True),
---and the calling conventions differ.  This defaulting is done in
TcMType.zonkTcTyVarBndr.
-defaultKind k 
-  | isOpenTypeKind k = liftedTypeKind
-  | isArgTypeKind k  = liftedTypeKind
-  | otherwise        = k
-\end{code}
-
-
-%**********************************************************************
**
-%*
*
-		Pretty printing
-%*
*
-%**********************************************************************
**
-
-\begin{code}
-
-pprParendKind :: Kind -> SDoc
-pprParendKind k 
-  | isFunKind k = parens (pprKind k)
-  | otherwise   = pprKind k
-
-pprKind k
-  | isLiftedTypeKind k   = ptext SLIT("*")
-  | isUnliftedTypeKind k = ptext SLIT("#")
-  | isUbxTupleKind k     = ptext SLIT("(#)")
-  | isFunKind k          =
-    let (k1, k2) = shallowSplitFunKind k in
-    sep [ pprParendKind k1, arrow <+> pprKind k2]
-  | isRealOpenTypeKind k     = ptext SLIT("?")
-  | isRealArgTypeKind k      = ptext SLIT("??")
-
-
-\end{code}
hunk ./compiler/types/Kind.lhs 8
-	openTypeKind, liftedTypeKind, unliftedTypeKind, 
+	openTypeKind, liftedTypeKind, unliftedTypeKind, unboxedTypeKind,
)
rmfile ./compiler/types/Kind.lhs
)
)
)
)
)
)
)
)
Please report this to bugs@darcs.net
If possible include the output of 'darcs --exact-version'.
sh-2.04$

I'm marking this one resolved, since it's a duplicate of 194.  Not sure the best
way to deal with duplicates, roundup doesn't seem to handle them very well.  :(

This bug is a duplicate one that is resolved-in-unstable.