Issue 191: pull => bug in function reconcile_unwindings (1.0.7)

Title	pull => bug in function reconcile_unwindings (1.0.7)
Priority	urgent	Status	resolved
Milestone		Resolved in
Superseder	pull => bug in function reconcile_unwindings ( minimal test case ) View: 194	Nosy List	darcs-devel, dmitry.kurochkin, jch, kowey, markstos, simonmar, simonpj, thorkilnaur, tommy
Assigned To	droundy	Topics	Conflicts

Created on 2006-07-03.13:28:52 by simonmar, last changed 2009-10-23.23:36:14 by admin.

Files
File name	Uploaded	Type	Edit	Remove
ghc_hack_patch	droundy, 2006-07-04.12:59:05	text/plain

Messages
msg715 (view)	Author: simonmar	Date: 2006-07-03.13:28:45
From: Simon Peyton-Jones Sent: 03 July 2006 09:22 To: bugs@darcs.net Cc: Simon Peyton-Jones Subject: Another darcs crash OK. To reproduce the bug below, upload http://research.microsoft.com/~simonpj/tmp/fc-branch-new.zip and try to do darcs pull -p 'the unlifted kind' Pulling just this one patch elicits the bug. 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[D[D[D[D[D[D[D[D[D[D[D[C 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$
msg763 (view)	Author: droundy	Date: 2006-07-04.11:33:05
> From: Simon Peyton-Jones > > OK. To reproduce the bug below, upload > http://research.microsoft.com/~simonpj/tmp/fc-branch-new.zip > and try to do > darcs pull -p 'the unlifted kind' > > Pulling just this one patch elicits the bug. I've been taking a look at your repositories. My understanding is that fc-branch-new is the "variant" repository, so I've been looking into this from the backwards direction, trying to pull information from there into the mainline one. There seems to be a problematic sequence of 62 patches, which taken together conflict with that one "unlifted kind" patch in a way that darcs can't handle. Actually, the 62 have some sort of conflict, but only 59 have a conflict to the point where they can't be merged. :( Below is a listing of the 59 problematic patches. If this history isn't important to you, the simplest thing is to drop this history, create a patch with diff -u and apply it to a copy of the mainline repository. It's ugly, and loses information, but it's pretty easy. While you're at it, you could also drop the three patches: Thu May 25 08:57:21 EDT 2006 simonpj@microsoft.com * coercionTyCon^[[D^[[D^[[D^[[D^[[D^[[D^[[D^[[D^[[D^[[D^[[D^[[C Fri May 19 11:05:19 EDT 2006 simonpj@microsoft.com * Result of Simon/Kevin discussion Fri May 19 10:07:23 EDT 2006 kevind@bu.edu * Kind preliminarily Typified, doesn't compile yet which also have a conflict (but one that darcs could handle). The problem patch sequence is: Pulling from "../ghc_resolved"... Would pull the following changes: Mon May 22 10:11:37 EDT 2006 kevind@bu.edu * Kinds are now Types (may not yet compile, but close) Mon May 22 11:43:31 EDT 2006 simonpj@microsoft.com * minor changes Tue May 23 04:58:02 EDT 2006 kevind@bu.edu * Closer Tue May 23 08:21:17 EDT 2006 kevind@bu.edu * Kinds are Types, and things compile Wed May 24 12:10:39 EDT 2006 kevind@bu.edu * Some fixes, still won't compile library Wed May 24 13:02:34 EDT 2006 kevind@bu.edu * Fixed typeKind to work right for kinds Fri May 26 08:55:28 EDT 2006 simonpj@microsoft.com * Fix typeKind silliness Mon Jun 5 04:21:13 EDT 2006 kevind@bu.edu * coercions in, adding cast Mon Jun 5 05:48:46 EDT 2006 simonpj@microsoft.com * Minor edits (Kevin and Simon together) Tue Jun 6 10:40:17 EDT 2006 kevind@bu.edu * more cast Tue Jun 6 11:20:15 EDT 2006 simonpj@microsoft.com * simon and kevin discussion Wed Jun 7 06:36:00 EDT 2006 kevind@bu.edu * more Wed Jun 7 07:30:52 EDT 2006 simonpj@microsoft.com * Stuff from Simon: EqPred, plus hole_ty in SimplUtils Wed Jun 7 07:45:50 EDT 2006 simonpj@microsoft.com * Comments Wed Jun 7 10:54:37 EDT 2006 kevind@bu.edu * towards compiling Wed Jun 7 11:44:26 EDT 2006 kevind@bu.edu * It's Alive! Wed Jun 7 12:21:08 EDT 2006 kevind@bu.edu * external core fix Thu Jun 8 05:17:24 EDT 2006 kevind@bu.edu * removed some commented out Coerce code, fixed a bug swapping direction of coercion Thu Jun 8 05:44:33 EDT 2006 simonpj@microsoft.com * Comments only Thu Jun 8 06:40:31 EDT 2006 simonpj@microsoft.com * Comments only Thu Jun 8 06:42:05 EDT 2006 simonpj@microsoft.com * nt_co is a TyCOn now Thu Jun 8 08:28:05 EDT 2006 simonpj@microsoft.com * First steps towards GADTs with FC Thu Jun 8 10:12:12 EDT 2006 simonpj@microsoft.com * more from simion Thu Jun 8 10:42:42 EDT 2006 kevind@bu.edu * newtype stuff Thu Jun 8 11:02:43 EDT 2006 simonpj@microsoft.com * Minor changes Thu Jun 8 13:05:32 EDT 2006 kevind@bu.edu * little things Wed Jun 14 05:22:13 EDT 2006 simonpj@microsoft.com * Steps towards mkNewTyConRhs Wed Jun 14 10:52:32 EDT 2006 kevind@bu.edu * Fixed BuildTyCls, not compiling yet Wed Jun 14 11:13:25 EDT 2006 kevind@bu.edu * some changes Thu Jun 15 05:34:27 EDT 2006 kevind@bu.edu * adding stubs Thu Jun 15 06:14:59 EDT 2006 simonpj@microsoft.com * Wibbles Thu Jun 15 09:33:46 EDT 2006 kevind@bu.edu * fixes Thu Jun 15 10:48:37 EDT 2006 kevind@bu.edu * More wibbles Thu Jun 15 11:12:31 EDT 2006 kevind@bu.edu * now it compiles (some) libraries Fri Jun 16 05:35:48 EDT 2006 kevind@bu.edu * fixes Fri Jun 16 11:04:19 EDT 2006 kevind@bu.edu * badness here Mon Jun 19 08:26:37 EDT 2006 simonpj@microsoft.com * Substitutions, plus numerous small things Tue Jun 20 10:18:44 EDT 2006 simonpj@microsoft.com * Conflict resolution Tue Jun 20 10:35:56 EDT 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! Wed Jun 21 03:51:54 EDT 2006 simonpj@microsoft.com * Missing imports Mon Jun 19 11:04:21 EDT 2006 kevind@bu.edu * Squashed a couple more Tue Jun 20 09:50:53 EDT 2006 kevind@bu.edu * minor changes Wed Jun 21 08:48:51 EDT 2006 kevind@bu.edu * Substitution in binder types/kinds in CoreLint Wed Jun 21 12:47:00 EDT 2006 kevind@bu.edu * corelint fixes, still some type substitution strangeness Thu Jun 22 06:20:00 EDT 2006 kevind@bu.edu * Linting going wrong Thu Jun 22 07:00:27 EDT 2006 simonpj@microsoft.com * Fix Linting of type applications, and add coments Thu Jun 22 10:00:42 EDT 2006 kevind@bu.edu * fix core lint for let bindings Thu Jun 22 10:14:55 EDT 2006 kevind@bu.edu * some refactoring with decomposeCo Tue Jun 27 06:16:22 EDT 2006 kevind@bu.edu * fixed a few bugs, put coercions for all newtypes, killed some assertions that things are recursive newtypes Tue Jun 27 06:59:09 EDT 2006 kevind@bu.edu * stop simplifier from throwing out newtype coercions Wed Jun 28 06:47:23 EDT 2006 kevind@bu.edu * bug fix Wed Jun 28 08:38:15 EDT 2006 simonpj@microsoft.com * Wibbles, esp getting CoTyCon into the implicitTyThings of a newtype Wed Jun 28 12:45:54 EDT 2006 simonpj@microsoft.com * Make sure that nt_rhs uses the tycon tyvars Thu Jun 29 06:05:16 EDT 2006 kevind@bu.edu * reboxing bug traces Thu Jun 29 06:39:21 EDT 2006 kevind@bu.edu * Flip coercionKind and coercionKindPair Thu Jun 29 09:56:57 EDT 2006 kevind@bu.edu * sym coercion smart constructors, removed debugging outputs Thu Jun 29 10:57:58 EDT 2006 simonpj@microsoft.com * Half-baked fix to unpacking code Fri Jun 30 06:19:02 EDT 2006 kevind@bu.edu * fixes for reconstructing newtypes Fri Jun 30 08:13:08 EDT 2006 simonpj@microsoft.com * Tidy up selector generation code; no change in behaviour Making no changes: this is a dry run.
msg764 (view)	Author: droundy	Date: 2006-07-04.11:40:11
On Tue, Jul 04, 2006 at 11:33:09AM +0000, David Roundy wrote: > Below is a listing of the 59 problematic patches. If this history > isn't important to you, the simplest thing is to drop this history, > create a patch with diff -u and apply it to a copy of the mainline > repository. It's ugly, and loses information, but it's pretty easy. > While you're at it, you could also drop the three patches: I'm not sure I made clear: if you can afford to merge these patches into one big one, I'll be happy to help you do so. If you want to keep this history, then I'll help figure out a way to do that, but it'll be trickier. -- David Roundy
msg775 (view)	Author: simonpj	Date: 2006-07-04.12:16:44
\| I've been taking a look at your repositories. My understanding is \| that fc-branch-new is the "variant" repository, That's correct. \| so I've been looking \| into this from the backwards direction, trying to pull information \| from there into the mainline one. The trouble is we're not ready to do that. I was pulling patches from the mainline repository into the variant, so that subsequent further development in the variant would be less likely to conflict when it is ultimately pulled into the mainline one. Do you see what I mean? Kind of keeping up to date with the mainline. Later, we'll suck the variant into the mainline, and kill the variant. This is just the kind of application I think Darcs is meant for. I'm not unduly worried about maintaining patch history of the variant. I think we do want to maintain patch history for the mainline. So a brutal approach is this, I believe. I'll call the main repository "HEAD" and the variant "variant". 1 Start a new repository "fresh-variant", based on "HEAD". 2 Somehow (not quite sure how) make a big patch that gives all the patches in 'variant' that are not in "HEAD". 3 Apply this patch manually to "fresh-variant", and resolve conflicts 4 Record the result as one big patch in "fresh-variant". 5 Abandon "variant". 6 Repeat the exercise whenever we want to catch up with HEAD. This is what I did last time, I think. (Which is why the variant is called "fc-branch-new"!) A possible alternative to steps (2-4) might be this. I'm not sure if that'd work. 2-4* Sit in "fresh-variant" and pull patches from "variant". Simon
msg777 (view)	Author: droundy	Date: 2006-07-04.12:44:54
On Tue, Jul 04, 2006 at 01:16:32PM +0100, Simon Peyton-Jones wrote: > \| so I've been looking into this from the backwards direction, > \| trying to pull information from there into the mainline one. > > The trouble is we're not ready to do that. I was pulling patches > from the mainline repository into the variant, so that subsequent > further development in the variant would be less likely to conflict > when it is ultimately pulled into the mainline one. Do you see what > I mean? Kind of keeping up to date with the mainline. Right. Will clarify below... we are "in violent agreement"... > Later, we'll suck the variant into the mainline, and kill the > variant. This is just the kind of application I think Darcs is meant > for. Yes, it just doesn't work as well as it ought to... > I'm not unduly worried about maintaining patch history of the > variant. I think we do want to maintain patch history for the > mainline. Great, this is the "easy" situation to work around! > So a brutal approach is this, I believe. I'll call the main > repository "HEAD" and the variant "variant". > > 1 Start a new repository "fresh-variant", based on "HEAD". > > 2 Somehow (not quite sure how) make a big patch that gives all the > patches in 'variant' that are not in "HEAD". > > 3 Apply this patch manually to "fresh-variant", and resolve conflicts > > 4 Record the result as one big patch in "fresh-variant". > > 5 Abandon "variant". > > 6 Repeat the exercise whenever we want to catch up with HEAD. > > This is what I did last time, I think. (Which is why the variant is > called "fc-branch-new"!) :) Okay, I'll help with the creating of the big patch. In the future, when you sit in a variant repository and pull from mainline and get conflicts, when possible you can resolve the conflicts by using amend-record on the variant patches (the ones not in mainline), which will help avoid this sort of scenario. This is tricky, though, if there are many variant patches conflicting with a new mainline patch (as is the case here). I'll send a separate email with a patch bundle to work around this, along with detailed instructions for using it. > A possible alternative to steps (2-4) might be this. I'm not sure if > that'd work. > > 2-4* Sit in "fresh-variant" and pull patches from "variant". This is what I was doing above, when I said I was pulling from variant into mainline. -- David Roundy
msg778 (view)	Author: simonpj	Date: 2006-07-04.12:57:03
\| Okay, I'll help with the creating of the big patch. Actually, I can save you the bother, because I've probably changed files since then! Just sending instructions would be enough. \| In the future, \| when you sit in a variant repository and pull from mainline and get \| conflicts, when possible you can resolve the conflicts by using \| amend-record on the variant patches (the ones not in mainline), which \| will help avoid this sort of scenario. I'm afraid I'll need pretty clear guidance about how to use 'amend-record' (new to me), starting from "I pull a patch from the HEAD and get a conflict". Simon
msg779 (view)	Author: droundy	Date: 2006-07-04.12:59:14
Hi Simons, Okay, here's the patch bundle. You should be able to apply it to a copy of the mainline repository (with darcs apply). It's got all the contents of the variant repository, but the conflicting patches have all been glommed together in one big patch, which avoids the bug. I haven't actually resolved the conflicts, so you'll need to resolve them yourself. After you've done this in your working directory, you should probably amend-record the big patch, so you'll have a conflict-free repository to start fresh with. In fact, you probably would prefer to unrecord the big patch and then record it with a meaningful commit comment, and yourself and/or Kevin as the author. Basically, I got this by running in the variant repository: darcs unrecord [select all conflicting patches] darcs record It was a bit more complicated, because I actually used some tricks to find out which patches conflicted by doing (note: this is shell pseudocode) darcs get mainline mainline-copy [in variant] darcs push mainline-copy [selecting individual patches, to push all that could be pushed without causing conflicts] [in mainline copy] darcs obliterate -p [the mainline problem patch] darcs pull variant [select all, but remember how many were pulled darcs unrecord --last [number of conflicting patches] [select all] darcs record -m [big combined patch] Now mainline-copy is the variant-new. Then what I haven't done, and you need to do is: [in variant-new, aka mainline-copy] darcs pull mainline [will report conflicts] [edit working directory to remove conflict markers and resolve conflicts] darcs amend-record [select big combined patch, and all local changes] I hope this is helpful. And I'm now doubly-motivated to get the conflictor code working. And I'll be in Oregon (this fall I'm starting as an assistant professor at Oregon State), and plan to attend the Haskell Workshop, so hopefully we can talk at some point. Perhaps I should also mention that I'm really looking forward to this fc stuff going into mainline, since as I understand things, it should improve GADT interactions with classes... David Attachments ghc_hack_patch
msg780 (view)	Author: droundy	Date: 2006-07-04.13:12:06
On Tue, Jul 04, 2006 at 01:56:53PM +0100, Simon Peyton-Jones wrote: > \| Okay, I'll help with the creating of the big patch. > > Actually, I can save you the bother, because I've probably changed > files since then! Just sending instructions would be enough. I hope my other email (which included the bundle) has enough instructions. If not, just ask. > \| In the future, when you sit in a variant repository and pull from > \| mainline and get conflicts, when possible you can resolve the > \| conflicts by using amend-record on the variant patches (the ones > \| not in mainline), which will help avoid this sort of scenario. > > I'm afraid I'll need pretty clear guidance about how to use > 'amend-record' (new to me), starting from "I pull a patch from the > HEAD and get a conflict". Okay, the catch is that it only works if there are few enough patches in variant that involve the conflict. Here's the somewhat slow and safe approach. You can skip the "variant-reordered" bit if you know which variant patch is conflicting. [in variant] darcs pull mainline [darcs reports conflict] darcs get mainline variant-reordered [in variant-reordered] darcs pull variant [darcs reports conflicts] [in working directory, fix all conflicts] darcs changes -s [look for variant patchs with exclamation points, these are the conflicting patches. Either there's just one, or there's more than one.] If there's just one conflicting variant patch: darcs amend-record [select the conflicting patch.] You're done! Rename variant-reordered to variant, and make sure anyone with a copy of variant throws it away and starts with a fresh copy (which is why this bug needs to be fixed... this doesn't scale well in number of developers, which is most of darcs' point.) If there are several conflicting variant patches: darcs unrecord [select all the conflicting patches] darcs record All done, as before, but now we've lost some history. We might have been able to get away with less lost history if the patches were independent of each other and separately conflicted, but that's not a terribly common case. Let me know if any this is unclear. I've used a sort of shorthand at times, and may have forgotten something. And (as I'm sure you're aware, but reminders don't hurt) when doing this sort of trickery, keep as many backups as you can of the different branches of the repository. David
msg781 (view)	Author: simonmar	Date: 2006-07-04.13:29:32
On 04 July 2006 14:12, David Roundy wrote: > [in variant] > darcs pull mainline > [darcs reports conflict] > darcs get mainline variant-reordered > [in variant-reordered] > darcs pull variant > [darcs reports conflicts] > [in working directory, fix all conflicts] > darcs changes -s > [look for variant patchs with exclamation points, these are the > conflicting patches. Either there's just one, or there's more than > one.] > > If there's just one conflicting variant patch: > darcs amend-record > [select the conflicting patch.] > You're done! Rename variant-reordered to variant, and make sure anyone > with a copy of variant throws it away and starts with a fresh copy > (which is why this bug needs to be fixed... this doesn't scale well in > number of developers, which is most of darcs' point.) I didn't know about this amend-record trick, it's quite neat. I suppose it makes sense, if you consider amend-record to be a shortcut for unrecord followed by record. This should make it less painful to resolve conflicts by hand, thanks. Cheers, Simon
msg782 (view)	Author: droundy	Date: 2006-07-04.13:36:26
On Tue, Jul 04, 2006 at 02:29:22PM +0100, Simon Marlow wrote: > I didn't know about this amend-record trick, it's quite neat. I suppose > it makes sense, if you consider amend-record to be a shortcut for > unrecord followed by record. This should make it less painful to > resolve conflicts by hand, thanks. You're welcome! But do keep in mind that you shouldn't amend-record patches that other people have gotten copies of... but it's great for working in your own private repository. :) David
msg1993 (view)	Author: kowey	Date: 2007-08-03.18:02:43
Marking as a duplicate of issue194, which has the advantage of having a minimal test case. (I'm assuming it's a duplicate because of the error message)
msg2394 (view)	Author: markstos	Date: 2008-01-09.04:31:14
This bug is a duplicate one that is resolved-in-unstable.

History
Date	User	Action	Args
2006-07-03 13:28:52	simonmar	create
2006-07-03 15:26:52	jch	set	status: unread -> unknown nosy: + jch
2006-07-03 20:26:03	droundy	link	issue197 superseder
2006-07-03 20:41:03	droundy	set	nosy: droundy, jch, tommy, simonmar
2006-07-04 11:19:39	droundy	set	nosy: + simonpj
2006-07-04 11:33:09	droundy	set	nosy: droundy, jch, tommy, simonmar, simonpj messages: + msg763
2006-07-04 11:40:15	droundy	set	nosy: droundy, jch, tommy, simonmar, simonpj messages: + msg764
2006-07-04 12:16:45	simonpj	set	nosy: droundy, jch, tommy, simonmar, simonpj messages: + msg775
2006-07-04 12:44:55	droundy	set	nosy: droundy, jch, tommy, simonmar, simonpj messages: + msg777
2006-07-04 12:57:04	simonpj	set	nosy: droundy, jch, tommy, simonmar, simonpj messages: + msg778
2006-07-04 12:59:15	droundy	set	files: + ghc_hack_patch nosy: droundy, jch, tommy, simonmar, simonpj messages: + msg779
2006-07-04 13:12:09	droundy	set	nosy: droundy, jch, tommy, simonmar, simonpj messages: + msg780
2006-07-04 13:29:35	simonmar	set	nosy: droundy, jch, tommy, simonmar, simonpj messages: + msg781
2006-07-04 13:36:30	droundy	set	nosy: droundy, jch, tommy, simonmar, simonpj messages: + msg782
2007-07-23 13:46:10	kowey	set	topic: + Conflicts nosy: + kowey, beschmi
2007-07-23 20:51:48	kowey	set	title: crash in function reconcile_unwindings -> pull => bug in function reconcile_unwindings (1.0.7)
2007-08-03 18:02:44	kowey	set	status: unknown -> duplicate superseder: + pull => bug in function reconcile_unwindings ( minimal test case ) messages: + msg1993
2008-01-09 04:31:16	markstos	set	status: duplicate -> resolved-in-unstable nosy: + markstos messages: + msg2394
2008-09-04 21:28:25	admin	set	status: resolved-in-unstable -> resolved nosy: + dagit
2009-08-06 17:43:53	admin	set	nosy: + jast, Serware, dmitry.kurochkin, darcs-devel, zooko, mornfall, simon, thorkilnaur, - droundy, jch, simonmar, simonpj
2009-08-06 20:40:46	admin	set	nosy: - beschmi
2009-08-10 21:52:11	admin	set	nosy: + simonmar, jch, simonpj, - darcs-devel, zooko, jast, Serware, mornfall
2009-08-10 23:54:33	admin	set	nosy: - dagit
2009-08-25 17:57:01	admin	set	nosy: + darcs-devel, - simon
2009-08-27 14:04:28	admin	set	nosy: jch, tommy, kowey, markstos, darcs-devel, simonmar, simonpj, thorkilnaur, dmitry.kurochkin
2009-10-23 22:37:46	admin	set	nosy: + marlowsd, - simonmar
2009-10-23 23:36:14	admin	set	nosy: + simonmar, - marlowsd

Issue 191 pull => bug in function reconcile_unwindings (1.0.7)

Attachments