[project @ 2001-11-29 13:47:09 by simonpj]

------------------------------
	Add linear implicit parameters
	------------------------------

Linear implicit parameters are an idea developed by Koen Claessen,
Mark Shields, and Simon PJ, last week.  They address the long-standing
problem that monads seem over-kill for certain sorts of problem, notably:

	* distributing a supply of unique names
	* distributing a suppply of random numbers
	* distributing an oracle (as in QuickCheck)


Linear implicit parameters are just like ordinary implicit parameters,
except that they are "linear" -- that is, they cannot be copied, and
must be explicitly "split" instead.  Linear implicit parameters are
written '%x' instead of '?x'.  (The '/' in the '%' suggests the
split!)

For example:

    data NameSupply = ...

    splitNS :: NameSupply -> (NameSupply, NameSupply)
    newName :: NameSupply -> Name

    instance PrelSplit.Splittable NameSupply where
	split = splitNS


    f :: (%ns :: NameSupply) => Env -> Expr -> Expr
    f env (Lam x e) = Lam x' (f env e)
		    where
		      x'   = newName %ns
		      env' = extend env x x'
    ...more equations for f...

Notice that the implicit parameter %ns is consumed
	once by the call to newName
	once by the recursive call to f

So the translation done by the type checker makes
the parameter explicit:

    f :: NameSupply -> Env -> Expr -> Expr
    f ns env (Lam x e) = Lam x' (f ns1 env e)
		       where
	 		 (ns1,ns2) = splitNS ns
			 x' = newName ns2
			 env = extend env x x'

Notice the call to 'split' introduced by the type checker.
How did it know to use 'splitNS'?  Because what it really did
was to introduce a call to the overloaded function 'split',
ndefined by

	class Splittable a where
	  split :: a -> (a,a)

The instance for Splittable NameSupply tells GHC how to implement
split for name supplies.  But we can simply write

	g x = (x, %ns, %ns)

and GHC will infer

	g :: (Splittable a, %ns :: a) => b -> (b,a,a)

The Splittable class is built into GHC.  It's defined in PrelSplit,
and exported by GlaExts.

Other points:

* '?x' and '%x' are entirely distinct implicit parameters: you
  can use them together and they won't intefere with each other.

* You can bind linear implicit parameters in 'with' clauses.

* You cannot have implicit parameters (whether linear or not)
  in the context of a class or instance declaration.


Warnings
~~~~~~~~
The monomorphism restriction is even more important than usual.
Consider the example above:

    f :: (%ns :: NameSupply) => Env -> Expr -> Expr
    f env (Lam x e) = Lam x' (f env e)
		    where
		      x'   = newName %ns
		      env' = extend env x x'

If we replaced the two occurrences of x' by (newName %ns), which is
usually a harmless thing to do, we get:

    f :: (%ns :: NameSupply) => Env -> Expr -> Expr
    f env (Lam x e) = Lam (newName %ns) (f env e)
		    where
		      env' = extend env x (newName %ns)

But now the name supply is consumed in *three* places
(the two calls to newName,and the recursive call to f), so
the result is utterly different.  Urk!  We don't even have
the beta rule.

Well, this is an experimental change.  With implicit
parameters we have already lost beta reduction anyway, and
(as John Launchbury puts it) we can't sensibly reason about
Haskell programs without knowing their typing.

Of course, none of this is throughly tested, either.

22 files changed, 528 insertions, 243 deletions

diff --git a/ghc/compiler/basicTypes/BasicTypes.lhs b/ghc/compiler/basicTypes/BasicTypes.lhs
index 35522d3739..696a4c1307 100644
--- a/ghc/compiler/basicTypes/BasicTypes.lhs
+++ b/ghc/compiler/basicTypes/BasicTypes.lhs
@@ -23,6 +23,8 @@ module BasicTypes(
 	Fixity(..), FixityDirection(..),
 	defaultFixity, maxPrecedence, negateFixity, negatePrecedence,
 
+	IPName(..), ipNameName, mapIPName,
+
 	NewOrData(..), 
 
 	RecFlag(..), isRec, isNonRec,
@@ -100,6 +102,33 @@ initialVersion = 1
 
 %************************************************************************
 %*									*
+\subsection{Implicit parameter identity}
+%*									*
+%************************************************************************
+
+The @IPName@ type is here because it is used in TypeRep (i.e. very
+early in the hierarchy), but also in HsSyn.
+
+\begin{code}
+data IPName name
+  = Dupable   name	-- ?x: you can freely duplicate this implicit parameter
+  | Linear name		-- %x: you must use the splitting function to duplicate it
+  deriving( Eq, Ord )	-- Ord is used in the IP name cache finite map
+			--	(used in HscTypes.OrigIParamCache)
+
+
+ipNameName :: IPName name -> name
+ipNameName (Dupable n) = n
+ipNameName (Linear  n) = n
+
+mapIPName :: (a->b) -> IPName a -> IPName b
+mapIPName f (Dupable n) = Dupable (f n)
+mapIPName f (Linear  n) = Linear  (f n)
+\end{code}
+
+		
+%************************************************************************
+%*									*
 \subsection[Fixity]{Fixity info}
 %*									*
 %************************************************************************
diff --git a/ghc/compiler/deSugar/DsExpr.lhs b/ghc/compiler/deSugar/DsExpr.lhs
index 7173a9a8a1..6d8df6547e 100644
--- a/ghc/compiler/deSugar/DsExpr.lhs
+++ b/ghc/compiler/deSugar/DsExpr.lhs
@@ -45,10 +45,9 @@ import PrelInfo		( rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID )
 import DataCon		( DataCon, dataConWrapId, dataConFieldLabels, dataConInstOrigArgTys )
 import DataCon		( isExistentialDataCon )
 import Literal		( Literal(..) )
-import Type		( ipNameName )
 import TyCon		( tyConDataCons )
 import TysWiredIn	( tupleCon, listTyCon, charDataCon, intDataCon )
-import BasicTypes	( RecFlag(..), Boxity(..) )
+import BasicTypes	( RecFlag(..), Boxity(..), ipNameName )
 import Maybes		( maybeToBool )
 import PrelNames	( hasKey, ratioTyConKey )
 import Util		( zipEqual, zipWithEqual )
diff --git a/ghc/compiler/hsSyn/HsExpr.lhs b/ghc/compiler/hsSyn/HsExpr.lhs
index e552866735..91ddad3b9a 100644
--- a/ghc/compiler/hsSyn/HsExpr.lhs
+++ b/ghc/compiler/hsSyn/HsExpr.lhs
@@ -21,11 +21,11 @@ import Name		( Name )
 import ForeignCall	( Safety )
 import Outputable	
 import PprType		( pprParendType )
-import Type		( Type, IPName  )
+import Type		( Type  )
 import Var		( TyVar )
 import DataCon		( DataCon )
 import CStrings		( CLabelString, pprCLabelString )
-import BasicTypes	( Boxity, tupleParens )
+import BasicTypes	( IPName, Boxity, tupleParens )
 import SrcLoc		( SrcLoc )
 \end{code}
 
diff --git a/ghc/compiler/hsSyn/HsTypes.lhs b/ghc/compiler/hsSyn/HsTypes.lhs
index 46dc78ec6c..6976ff2ab3 100644
--- a/ghc/compiler/hsSyn/HsTypes.lhs
+++ b/ghc/compiler/hsSyn/HsTypes.lhs
@@ -30,7 +30,7 @@ module HsTypes (
 #include "HsVersions.h"
 
 import Class		( FunDep )
-import TcType		( Type, Kind, ThetaType, SourceType(..), IPName,
+import TcType		( Type, Kind, ThetaType, SourceType(..), 
 			  tcSplitSigmaTy, liftedTypeKind, eqKind, tcEqType
 			)
 import TypeRep		( Type(..), TyNote(..) )	-- toHsType sees the representation
@@ -41,7 +41,7 @@ import OccName		( NameSpace, tvName )
 import Var		( TyVar, tyVarKind )
 import Subst		( substTyWith )
 import PprType		( {- instance Outputable Kind -}, pprParendKind )
-import BasicTypes	( Boxity(..), Arity, tupleParens )
+import BasicTypes	( Boxity(..), Arity, IPName, tupleParens )
 import PrelNames	( mkTupConRdrName, listTyConKey, usOnceTyConKey, usManyTyConKey, hasKey,
 			  usOnceTyConName, usManyTyConName
 			)
diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs
index 762e315652..319898a159 100644
--- a/ghc/compiler/main/HscTypes.lhs
+++ b/ghc/compiler/main/HscTypes.lhs
@@ -64,12 +64,11 @@ import InstEnv		( InstEnv, ClsInstEnv, DFunId )
 import Rules		( RuleBase )
 import CoreSyn		( CoreBind )
 import Id		( Id )
-import Type		( IPName )
 import Class		( Class, classSelIds )
 import TyCon		( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataConsIfAvailable )
 import DataCon		( dataConId, dataConWrapId )
 
-import BasicTypes	( Version, initialVersion, Fixity )
+import BasicTypes	( Version, initialVersion, Fixity, IPName )
 
 import HsSyn		( DeprecTxt, tyClDeclName, ifaceRuleDeclName )
 import RdrHsSyn		( RdrNameInstDecl, RdrNameRuleDecl, RdrNameTyClDecl )
diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index 37aa1738bb..a55b392482 100644
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.78 2001/11/26 10:30:15 simonpj Exp $
+$Id: Parser.y,v 1.79 2001/11/29 13:47:10 simonpj Exp $
 
 Haskell grammar.
 
@@ -13,7 +13,6 @@ module Parser ( parseModule, parseStmt, parseIdentifier ) where
 
 import HsSyn
 import HsTypes		( mkHsTupCon )
-import TypeRep          ( IPName(..) )
 
 import RdrHsSyn
 import Lex
@@ -29,7 +28,7 @@ import OccName		( UserFS, varName, tcName, dataName, tcClsName, tvName )
 import SrcLoc		( SrcLoc )
 import Module
 import CmdLineOpts	( opt_SccProfilingOn )
-import BasicTypes	( Boxity(..), Fixity(..), FixityDirection(..), 
+import BasicTypes	( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
 			  NewOrData(..), StrictnessMark(..), Activation(..) )
 import Panic
 
@@ -972,8 +971,8 @@ qvar 	:: { RdrName }
 -- *after* we see the close paren.
 
 ipvar	:: { IPName RdrName }
-	: IPDUPVARID		{ Dupable   (mkUnqual varName $1) }
-	| IPSPLITVARID		{ MustSplit (mkUnqual varName $1) }
+	: IPDUPVARID		{ Dupable (mkUnqual varName $1) }
+	| IPSPLITVARID		{ Linear  (mkUnqual varName $1) }
 
 qcon	:: { RdrName }
 	: qconid		{ $1 }
diff --git a/ghc/compiler/prelude/PrelNames.lhs b/ghc/compiler/prelude/PrelNames.lhs
index c2da0aa38c..d79bd241b6 100644
--- a/ghc/compiler/prelude/PrelNames.lhs
+++ b/ghc/compiler/prelude/PrelNames.lhs
@@ -95,7 +95,7 @@ knownKeyNames :: [Name]
 knownKeyNames
  =  [
 	-- Type constructors (synonyms especially)
-	ioTyConName,
+	ioTyConName, ioDataConName,
 	mainName,
 	orderingTyConName,
 	rationalTyConName,
@@ -190,7 +190,8 @@ knownKeyNames
 	eqStringName,
 	assertName,
 	runSTRepName,
-	printName
+	printName,
+	splitIdName, fstIdName, sndIdName	-- Used by splittery
     ]
 \end{code}
 
@@ -220,6 +221,7 @@ pREL_ARR_Name     = mkModuleName "PrelArr"
 pREL_BYTEARR_Name = mkModuleName "PrelByteArr"
 pREL_FOREIGN_Name = mkModuleName "PrelForeign"
 pREL_STABLE_Name  = mkModuleName "PrelStable"
+pREL_SPLIT_Name   = mkModuleName "PrelSplit"
 pREL_ADDR_Name    = mkModuleName "PrelAddr"
 pREL_PTR_Name     = mkModuleName "PrelPtr"
 pREL_ERR_Name     = mkModuleName "PrelErr"
@@ -234,6 +236,8 @@ pREL_WORD_Name	  = mkModuleName "PrelWord"
 fOREIGNOBJ_Name	  = mkModuleName "ForeignObj"
 aDDR_Name	  = mkModuleName "Addr"
 
+gLA_EXTS_Name   = mkModuleName "GlaExts"
+
 pREL_GHC     	= mkPrelModule pREL_GHC_Name
 pREL_BASE    	= mkPrelModule pREL_BASE_Name
 pREL_ADDR    	= mkPrelModule pREL_ADDR_Name
@@ -358,6 +362,10 @@ listTyConName	  = tcQual   pREL_BASE_Name SLIT("[]") listTyConKey
 nilDataConName 	  = dataQual pREL_BASE_Name SLIT("[]") nilDataConKey
 consDataConName	  = dataQual pREL_BASE_Name SLIT(":") consDataConKey
 
+-- PrelTup
+fstIdName	  = varQual pREL_TUP_Name SLIT("fst") fstIdKey
+sndIdName	  = varQual pREL_TUP_Name SLIT("snd") sndIdKey
+
 -- Generics
 crossTyConName     = tcQual   pREL_BASE_Name SLIT(":*:") crossTyConKey
 crossDataConName   = dataQual pREL_BASE_Name SLIT(":*:") crossDataConKey
@@ -506,6 +514,9 @@ errorName	   = varQual pREL_ERR_Name SLIT("error") errorIdKey
 assertName         = varQual pREL_GHC_Name SLIT("assert") assertIdKey
 getTagName	   = varQual pREL_GHC_Name SLIT("getTag#") getTagIdKey
 runSTRepName	   = varQual pREL_ST_Name  SLIT("runSTRep") runSTRepIdKey
+
+-- The "split" Id for splittable implicit parameters
+splitIdName = varQual pREL_SPLIT_Name SLIT("split") splitIdKey
 \end{code}
 
 %************************************************************************
@@ -848,6 +859,9 @@ failIOIdKey		      = mkPreludeMiscIdUnique 44
 unpackCStringListIdKey	      = mkPreludeMiscIdUnique 45
 nullAddrIdKey		      = mkPreludeMiscIdUnique 46
 voidArgIdKey		      = mkPreludeMiscIdUnique 47
+splitIdKey		      = mkPreludeMiscIdUnique 48
+fstIdKey		      = mkPreludeMiscIdUnique 49
+sndIdKey		      = mkPreludeMiscIdUnique 50
 \end{code}
 
 Certain class operations from Prelude classes.  They get their own
diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y
index 6468bdc576..ac0a7a3e60 100644
--- a/ghc/compiler/rename/ParseIface.y
+++ b/ghc/compiler/rename/ParseIface.y
@@ -39,11 +39,10 @@ import HsCore
 import Literal		( Literal(..), mkMachInt, mkMachInt64, mkMachWord, mkMachWord64 )
 import BasicTypes	( Fixity(..), FixityDirection(..), StrictnessMark(..),
 			  NewOrData(..), Version, initialVersion, Boxity(..),
-                          Activation(..)
+                          Activation(..), IPName(..)
 			)
 import CostCentre       ( CostCentre(..), IsCafCC(..), IsDupdCC(..) )
 import Type		( Kind, mkArrowKind, liftedTypeKind, openTypeKind, usageTypeKind )
-import TypeRep          ( IPName(..) )
 import ForeignCall	( ForeignCall(..), CCallConv(..), CCallSpec(..), CCallTarget(..) )
 import Lex		
 
@@ -629,8 +628,8 @@ qvar_name	:  var_name		{ $1 }
 		|  QVARID	      	{ mkIfaceOrig varName $1 }
 
 ipvar_name	:: { IPName RdrName }
-	        : IPDUPVARID		{ Dupable   (mkRdrUnqual (mkSysOccFS varName $1)) }
-	        | IPSPLITVARID		{ MustSplit (mkRdrUnqual (mkSysOccFS varName $1)) }
+	        : IPDUPVARID		{ Dupable (mkRdrUnqual (mkSysOccFS varName $1)) }
+	        | IPSPLITVARID		{ Linear  (mkRdrUnqual (mkSysOccFS varName $1)) }
 
 qvar_names1	:: { [RdrName] }
 qvar_names1	: qvar_name		{ [$1] }
diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 9f4172b439..c258f82773 100644
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -25,7 +25,6 @@ import HscTypes		( Provenance(..), pprNameProvenance, hasBetterProv,
 			  Deprecations(..), lookupDeprec,
 			  extendLocalRdrEnv
 			)
-import Type		( mapIPName )
 import RnMonad
 import Name		( Name, 
 			  getSrcLoc, nameIsLocalOrFrom,
@@ -54,6 +53,7 @@ import SrcLoc		( SrcLoc, noSrcLoc )
 import Outputable
 import ListSetOps	( removeDups, equivClasses )
 import Util		( sortLt )
+import BasicTypes	( mapIPName )
 import List		( nub )
 import UniqFM		( lookupWithDefaultUFM )
 import CmdLineOpts
diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs
index cd354890fc..846812df39 100644
--- a/ghc/compiler/rename/RnExpr.lhs
+++ b/ghc/compiler/rename/RnExpr.lhs
@@ -28,13 +28,14 @@ import RnTypes		( rnHsTypeFVs )
 import RnHiFiles	( lookupFixityRn )
 import CmdLineOpts	( DynFlag(..), opt_IgnoreAsserts )
 import Literal		( inIntRange, inCharRange )
-import BasicTypes	( Fixity(..), FixityDirection(..), defaultFixity, negateFixity )
+import BasicTypes	( Fixity(..), FixityDirection(..), IPName(..), defaultFixity, negateFixity )
 import PrelNames	( hasKey, assertIdKey, 
-			  eqClass_RDR, foldr_RDR, build_RDR, eqString_RDR,
-			  cCallableClass_RDR, cReturnableClass_RDR, 
-			  monadClass_RDR, enumClass_RDR, ordClass_RDR,
-			  ratioDataCon_RDR, assertErr_RDR,
-			  ioDataCon_RDR, plusInteger_RDR, timesInteger_RDR,
+			  eqClassName, foldrName, buildName, eqStringName,
+			  cCallableClassName, cReturnableClassName, 
+			  monadClassName, enumClassName, ordClassName,
+			  ratioDataConName, splitIdName, fstIdName, sndIdName,
+			  ioDataConName, plusIntegerName, timesIntegerName,
+			  assertErr_RDR
 			)
 import TysPrim		( charPrimTyCon, addrPrimTyCon, intPrimTyCon, 
 			  floatPrimTyCon, doublePrimTyCon
@@ -79,8 +80,7 @@ rnPat (SigPatIn pat ty)
     doc = text "a pattern type-signature"
     
 rnPat (LitPatIn s@(HsString _)) 
-  = lookupOrigName eqString_RDR		`thenRn` \ eq ->
-    returnRn (LitPatIn s, unitFV eq)
+  = returnRn (LitPatIn s, unitFV eqStringName)
 
 rnPat (LitPatIn lit) 
   = litFVs lit		`thenRn` \ fvs ->
@@ -88,15 +88,13 @@ rnPat (LitPatIn lit)
 
 rnPat (NPatIn lit) 
   = rnOverLit lit			`thenRn` \ (lit', fvs1) ->
-    lookupOrigName eqClass_RDR		`thenRn` \ eq   ->	-- Needed to find equality on pattern
-    returnRn (NPatIn lit', fvs1 `addOneFV` eq)
+    returnRn (NPatIn lit', fvs1 `addOneFV` eqClassName)	-- Needed to find equality on pattern
 
 rnPat (NPlusKPatIn name lit minus)
   = rnOverLit lit			`thenRn` \ (lit', fvs) ->
-    lookupOrigName ordClass_RDR		`thenRn` \ ord ->
     lookupBndrRn name			`thenRn` \ name' ->
     lookupSyntaxName minus		`thenRn` \ minus' ->
-    returnRn (NPlusKPatIn name' lit' minus', fvs `addOneFV` ord `addOneFV` minus')
+    returnRn (NPlusKPatIn name' lit' minus', fvs `addOneFV` ordClassName `addOneFV` minus')
 
 rnPat (LazyPatIn pat)
   = rnPat pat		`thenRn` \ (pat', fvs) ->
@@ -278,7 +276,12 @@ rnExpr (HsVar v)
 
 rnExpr (HsIPVar v)
   = newIPName v			`thenRn` \ name ->
-    returnRn (HsIPVar name, emptyFVs)
+    let 
+	fvs = case name of
+		Linear _  -> mkFVs [splitIdName, fstIdName, sndIdName]
+		Dupable _ -> emptyFVs 
+    in   
+    returnRn (HsIPVar name, fvs)
 
 rnExpr (HsLit lit) 
   = litFVs lit		`thenRn` \ fvs -> 
@@ -341,12 +344,12 @@ rnExpr section@(SectionR op expr)
 
 rnExpr (HsCCall fun args may_gc is_casm _)
 	-- Check out the comment on RnIfaces.getNonWiredDataDecl about ccalls
-  = lookupOrigNames [cCallableClass_RDR, 
-			  cReturnableClass_RDR, 
-			  ioDataCon_RDR]	`thenRn` \ implicit_fvs ->
+  = lookupOrigNames []	`thenRn` \ implicit_fvs ->
     rnExprs args				`thenRn` \ (args', fvs_args) ->
     returnRn (HsCCall fun args' may_gc is_casm placeHolderType, 
-	      fvs_args `plusFV` implicit_fvs)
+	      fvs_args `plusFV` mkFVs [cCallableClassName, 
+				       cReturnableClassName, 
+				       ioDataConName])
 
 rnExpr (HsSCC lbl expr)
   = rnExpr expr	 	`thenRn` \ (expr', fvs_expr) ->
@@ -370,7 +373,6 @@ rnExpr (HsWith expr binds)
 
 rnExpr e@(HsDo do_or_lc stmts src_loc)
   = pushSrcLocRn src_loc $
-    lookupOrigNames implicit_rdr_names	`thenRn` \ implicit_fvs ->
     rnStmts stmts			`thenRn` \ ((_, stmts'), fvs) ->
 	-- check the statement list ends in an expression
     case last stmts' of {
@@ -379,7 +381,7 @@ rnExpr e@(HsDo do_or_lc stmts src_loc)
     }					`thenRn_`
     returnRn (HsDo do_or_lc stmts' src_loc, fvs `plusFV` implicit_fvs)
   where
-    implicit_rdr_names = [foldr_RDR, build_RDR, monadClass_RDR]
+    implicit_fvs = mkFVs [foldrName, buildName, monadClassName]
 	-- Monad stuff should not be necessary for a list comprehension
 	-- but the typechecker looks up the bind and return Ids anyway
 	-- Oh well.
@@ -424,9 +426,8 @@ rnExpr (HsType a)
     doc = text "renaming a type pattern"
 
 rnExpr (ArithSeqIn seq)
-  = lookupOrigName enumClass_RDR	`thenRn` \ enum ->
-    rn_seq seq	 			`thenRn` \ (new_seq, fvs) ->
-    returnRn (ArithSeqIn new_seq, fvs `addOneFV` enum)
+  = rn_seq seq	 			`thenRn` \ (new_seq, fvs) ->
+    returnRn (ArithSeqIn new_seq, fvs `addOneFV` enumClassName)
   where
     rn_seq (From expr)
      = rnExpr expr 	`thenRn` \ (expr', fvExpr) ->
@@ -811,8 +812,7 @@ litFVs (HsInt i)	      = returnRn (unitFV (getName intTyCon))
 litFVs (HsIntPrim i)          = returnRn (unitFV (getName intPrimTyCon))
 litFVs (HsFloatPrim f)        = returnRn (unitFV (getName floatPrimTyCon))
 litFVs (HsDoublePrim d)       = returnRn (unitFV (getName doublePrimTyCon))
-litFVs (HsLitLit l bogus_ty)  = lookupOrigName cCallableClass_RDR	`thenRn` \ cc ->   
-				returnRn (unitFV cc)
+litFVs (HsLitLit l bogus_ty)  = returnRn (unitFV cCallableClassName)
 litFVs lit		      = pprPanic "RnExpr.litFVs" (ppr lit)	-- HsInteger and HsRat only appear 
 									-- in post-typechecker translations
 
@@ -820,18 +820,20 @@ rnOverLit (HsIntegral i from_integer_name)
   = lookupSyntaxName from_integer_name	`thenRn` \ from_integer_name' ->
     if inIntRange i then
 	returnRn (HsIntegral i from_integer_name', unitFV from_integer_name')
-    else
-	lookupOrigNames [plusInteger_RDR, timesInteger_RDR]	`thenRn` \ ns ->
+    else let
+	fvs = mkFVs [plusIntegerName, timesIntegerName]
 	-- Big integer literals are built, using + and *, 
 	-- out of small integers (DsUtils.mkIntegerLit)
 	-- [NB: plusInteger, timesInteger aren't rebindable... 
 	--	they are used to construct the argument to fromInteger, 
 	--	which is the rebindable one.]
-    returnRn (HsIntegral i from_integer_name', ns `addOneFV` from_integer_name')
+    in
+    returnRn (HsIntegral i from_integer_name', fvs `addOneFV` from_integer_name')
 
 rnOverLit (HsFractional i from_rat_name)
   = lookupSyntaxName from_rat_name						`thenRn` \ from_rat_name' ->
-    lookupOrigNames [ratioDataCon_RDR, plusInteger_RDR, timesInteger_RDR]	`thenRn` \ ns ->
+    let
+	fvs = mkFVs [ratioDataConName, plusIntegerName, timesIntegerName]
 	-- We have to make sure that the Ratio type is imported with
 	-- its constructor, because literals of type Ratio t are
 	-- built with that constructor.
@@ -839,7 +841,8 @@ rnOverLit (HsFractional i from_rat_name)
 	-- when fractionalClass does.
 	-- The plus/times integer operations may be needed to construct the numerator
 	-- and denominator (see DsUtils.mkIntegerLit)
-    returnRn (HsFractional i from_rat_name', ns `addOneFV` from_rat_name')
+    in
+    returnRn (HsFractional i from_rat_name', fvs `addOneFV` from_rat_name')
 \end{code}
 
 %************************************************************************
diff --git a/ghc/compiler/rename/RnHiFiles.lhs b/ghc/compiler/rename/RnHiFiles.lhs
index dd4baca37b..0a11bfea95 100644
--- a/ghc/compiler/rename/RnHiFiles.lhs
+++ b/ghc/compiler/rename/RnHiFiles.lhs
@@ -322,6 +322,7 @@ loadDecl mod (version_map, decls_map) (version, decl)
 
 	new_version_map = extendNameEnv version_map main_name version
     in
+    traceRn (text "Loading" <+> ppr full_avail) `thenRn_`
     returnRn (new_version_map, new_decls_map)
 
 -----------------------------------------------------
diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index b74e3e77a4..c03839a35d 100644
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -37,8 +37,8 @@ import DataCon		( dataConId )
 import Name		( Name, NamedThing(..) )
 import NameSet
 import PrelInfo		( derivableClassKeys )
-import PrelNames	( deRefStablePtr_RDR, newStablePtr_RDR,
-			  bindIO_RDR, returnIO_RDR
+import PrelNames	( deRefStablePtrName, newStablePtrName,
+			  bindIOName, returnIOName
 			)
 import TysWiredIn	( tupleCon )
 import List		( partition )
@@ -131,19 +131,18 @@ rnSourceDecl (DefD (DefaultDecl tys src_loc))
 rnHsForeignDecl (ForeignImport name ty spec src_loc)
   = pushSrcLocRn src_loc 		$
     lookupTopBndrRn name	        `thenRn` \ name' ->
-    rnHsTypeFVs (fo_decl_msg name) ty	`thenRn` \ (ty', fvs1) ->
-    lookupOrigNames (extras spec)	`thenRn` \ fvs2 ->
-    returnRn (ForeignImport name' ty' spec src_loc, fvs1 `plusFV` fvs2)
+    rnHsTypeFVs (fo_decl_msg name) ty	`thenRn` \ (ty', fvs) ->
+    returnRn (ForeignImport name' ty' spec src_loc, fvs `plusFV` extras spec)
   where
-    extras (CDynImport _) = [newStablePtr_RDR, deRefStablePtr_RDR, bindIO_RDR, returnIO_RDR]
-    extras other	  = []
+    extras (CDynImport _) = mkFVs [newStablePtrName, deRefStablePtrName, bindIOName, returnIOName]
+    extras other	  = emptyFVs
 
 rnHsForeignDecl (ForeignExport name ty spec src_loc)
   = pushSrcLocRn src_loc 			$
     lookupOccRn name		        	`thenRn` \ name' ->
-    rnHsTypeFVs (fo_decl_msg name) ty  		`thenRn` \ (ty', fvs1) ->
-    lookupOrigNames [bindIO_RDR, returnIO_RDR]	`thenRn` \ fvs2 ->
-    returnRn (ForeignExport name' ty' spec src_loc, fvs1 `plusFV` fvs2)
+    rnHsTypeFVs (fo_decl_msg name) ty  		`thenRn` \ (ty', fvs) ->
+    returnRn (ForeignExport name' ty' spec src_loc, 
+	      mkFVs [bindIOName, returnIOName] `plusFV` fvs)
 
 fo_decl_msg name = ptext SLIT("The foreign declaration for") <+> ppr name
 \end{code}
diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs
index b537647004..6144532c94 100644
--- a/ghc/compiler/typecheck/Inst.lhs
+++ b/ghc/compiler/typecheck/Inst.lhs
@@ -11,9 +11,9 @@ module Inst (
 	Inst, 
 	pprInst, pprInsts, pprInstsInFull, tidyInsts, tidyMoreInsts,
 
-	newDictsFromOld, newDicts, 
-	newMethod, newMethodWithGivenTy, newOverloadedLit,
-	newIPDict, tcInstId,
+	newDictsFromOld, newDicts, cloneDict,
+	newMethod, newMethodWithGivenTy, newMethodAtLoc,
+	newOverloadedLit, newIPDict, tcInstId,
 
 	tyVarsOfInst, tyVarsOfInsts, tyVarsOfLIE, 
 	ipNamesOfInst, ipNamesOfInsts, predsOfInst, predsOfInsts,
@@ -21,7 +21,7 @@ module Inst (
 
 	lookupInst, lookupSimpleInst, LookupInstResult(..),
 
-	isDict, isClassDict, isMethod, 
+	isDict, isClassDict, isMethod, isLinearInst, linearInstType,
 	isTyVarDict, isStdClassTyVarDict, isMethodFor, 
 	instBindingRequired, instCanBeGeneralised,
 
@@ -54,12 +54,11 @@ import TcType	( Type, TcType, TcThetaType, TcPredType, TcTauType, TcTyVarSet,
 		  isClassPred, isTyVarClassPred, 
 		  getClassPredTys, getClassPredTys_maybe, mkPredName,
 		  tidyType, tidyTypes, tidyFreeTyVars,
-		  tcCmpType, tcCmpTypes, tcCmpPred,
-		  IPName, mapIPName, ipNameName
+		  tcCmpType, tcCmpTypes, tcCmpPred
 		)
 import CoreFVs	( idFreeTyVars )
 import Class	( Class )
-import Id	( Id, idName, idType, mkUserLocal, mkSysLocal, mkLocalId )
+import Id	( Id, idName, idType, mkUserLocal, mkSysLocal, mkLocalId, setIdUnique )
 import PrelInfo	( isStandardClass, isCcallishClass, isNoDictClass )
 import Name	( Name, mkMethodOcc, getOccName )
 import PprType	( pprPred )	
@@ -72,6 +71,8 @@ import VarSet	( elemVarSet, emptyVarSet, unionVarSet )
 import TysWiredIn ( floatDataCon, doubleDataCon )
 import PrelNames( fromIntegerName, fromRationalName )
 import Util	( thenCmp, equalLength )
+import BasicTypes( IPName(..), mapIPName, ipNameName )
+
 import Bag
 import Outputable
 \end{code}
@@ -262,6 +263,22 @@ isMethodFor :: TcIdSet -> Inst -> Bool
 isMethodFor ids (Method uniq id tys _ _ loc) = id `elemVarSet` ids
 isMethodFor ids inst			     = False
 
+isLinearInst :: Inst -> Bool
+isLinearInst (Dict _ pred _) = isLinearPred pred
+isLinearInst other	     = False
+	-- We never build Method Insts that have
+	-- linear implicit paramters in them.
+	-- Hence no need to look for Methods
+	-- See Inst.tcInstId 
+
+isLinearPred :: TcPredType -> Bool
+isLinearPred (IParam (Linear n) _) = True
+isLinearPred other		   = False
+
+linearInstType :: Inst -> TcType	-- %x::t  -->  t
+linearInstType (Dict _ (IParam _ ty) _) = ty
+
+
 isStdClassTyVarDict (Dict _ pred _) = case getClassPredTys_maybe pred of
 					Just (clas, [ty]) -> isStandardClass clas && tcIsTyVarTy ty
 					other		  -> False
@@ -297,6 +314,10 @@ newDicts orig theta
   = tcGetInstLoc orig		`thenNF_Tc` \ loc ->
     newDictsAtLoc loc theta
 
+cloneDict :: Inst -> NF_TcM Inst
+cloneDict (Dict id ty loc) = tcGetUnique	`thenNF_Tc` \ uniq ->
+			     returnNF_Tc (Dict (setIdUnique id uniq) ty loc)
+
 newDictsFromOld :: Inst -> TcThetaType -> NF_TcM [Inst]
 newDictsFromOld (Dict _ _ loc) theta = newDictsAtLoc loc theta
 
@@ -360,35 +381,36 @@ This gets a bit less sharing, but
 \begin{code}
 tcInstId :: Id -> NF_TcM (TcExpr, LIE, TcType)
 tcInstId fun
-  | opt_NoMethodSharing  = loop_noshare (HsVar fun) (idType fun)
-  | otherwise		 = loop_share fun
+  = loop (HsVar fun) emptyLIE (idType fun)
   where
     orig = OccurrenceOf fun
-    loop_noshare fun fun_ty
-      = tcInstType fun_ty		`thenNF_Tc` \ (tyvars, theta, tau) ->
-	let 
-	    ty_app = mkHsTyApp fun (mkTyVarTys tyvars)
-	in
-        if null theta then 		-- Is it overloaded?
-	    returnNF_Tc (ty_app, emptyLIE, tau)
-	else
-	    newDicts orig theta						`thenNF_Tc` \ dicts ->
-	    loop_noshare (mkHsDictApp ty_app (map instToId dicts)) tau	`thenNF_Tc` \ (expr, lie, final_tau) ->
-	    returnNF_Tc (expr, mkLIE dicts `plusLIE` lie, final_tau)
-
-    loop_share fun
-      = tcInstType (idType fun)		`thenNF_Tc` \ (tyvars, theta, tau) ->
-	let 
-	    arg_tys = mkTyVarTys tyvars
-	in
-        if null theta then	 	-- Is it overloaded?
-	    returnNF_Tc (mkHsTyApp (HsVar fun) arg_tys, emptyLIE, tau)
-	else
-		-- Yes, it's overloaded
-	    newMethodWithGivenTy orig fun arg_tys theta tau	`thenNF_Tc` \ meth ->
-	    loop_share (instToId meth) 				`thenNF_Tc` \ (expr, lie, final_tau) ->
-	    returnNF_Tc (expr, unitLIE meth `plusLIE` lie, final_tau)
-
+    loop fun lie fun_ty = tcInstType fun_ty		`thenNF_Tc` \ (tyvars, theta, tau) ->
+			  loop_help fun lie (mkTyVarTys tyvars) theta tau
+
+    loop_help fun lie arg_tys [] tau	-- Not overloaded
+	= returnNF_Tc (mkHsTyApp fun arg_tys, lie, tau)
+
+    loop_help (HsVar fun_id) lie arg_tys theta tau
+	| can_share theta		-- Sharable method binding
+	= newMethodWithGivenTy orig fun_id arg_tys theta tau	`thenNF_Tc` \ meth ->
+	  loop (HsVar (instToId meth)) 
+	       (unitLIE meth `plusLIE` lie) tau
+
+    loop_help fun lie arg_tys theta tau	-- The general case
+ 	= newDicts orig theta					`thenNF_Tc` \ dicts ->
+	  loop (mkHsDictApp (mkHsTyApp fun arg_tys) (map instToId dicts)) 
+	       (mkLIE dicts `plusLIE` lie) tau
+
+    can_share theta | opt_NoMethodSharing = False
+		    | otherwise		  = not (any isLinearPred theta)
+	-- This is a slight hack.
+	-- If 	f :: (%x :: T) => Int -> Int
+	-- Then if we have two separate calls, (f 3, f 4), we cannot
+	-- make a method constraint that then gets shared, thus:
+	--	let m = f %x in (m 3, m 4)
+	-- because that loses the linearity of the constraint.
+	-- The simplest thing to do is never to construct a method constraint
+	-- in the first place that has a linear implicit parameter in it.
 
 newMethod :: InstOrigin
 	  -> TcId
diff --git a/ghc/compiler/typecheck/TcHsSyn.lhs b/ghc/compiler/typecheck/TcHsSyn.lhs
index 07cd86596a..fb6634a2d4 100644
--- a/ghc/compiler/typecheck/TcHsSyn.lhs
+++ b/ghc/compiler/typecheck/TcHsSyn.lhs
@@ -47,8 +47,7 @@ import DataCon	( dataConWrapId )
 import TcEnv	( tcLookupGlobal_maybe, tcExtendGlobalValEnv, TcEnv, TcId )
 
 import TcMonad
-import TypeRep    ( IPName(..) )	-- For zonking
-import Type	  ( Type, ipNameName )
+import Type	  ( Type )
 import TcType	  ( TcType )
 import TcMType	  ( zonkTcTypeToType, zonkTcTyVarToTyVar, zonkTcType, zonkTcSigTyVars )
 import TysPrim	  ( charPrimTy, intPrimTy, floatPrimTy,
@@ -58,7 +57,7 @@ import TysWiredIn ( charTy, stringTy, intTy, integerTy,
 		    mkListTy, mkTupleTy, unitTy )
 import CoreSyn    ( Expr )
 import Var	  ( isId )
-import BasicTypes ( RecFlag(..), Boxity(..) )
+import BasicTypes ( RecFlag(..), Boxity(..), IPName(..), ipNameName )
 import Bag
 import Outputable
 import HscTypes	( TyThing(..) )
@@ -632,8 +631,8 @@ zonkRbinds rbinds
 
 -------------------------------------------------------------------------
 mapIPNameTc :: (a -> NF_TcM b) -> IPName a -> NF_TcM (IPName b)
-mapIPNameTc f (Dupable   n) = f n  `thenNF_Tc` \ r -> returnNF_Tc (Dupable r)
-mapIPNameTc f (MustSplit n) = f n  `thenNF_Tc` \ r -> returnNF_Tc (MustSplit r)
+mapIPNameTc f (Dupable n) = f n  `thenNF_Tc` \ r -> returnNF_Tc (Dupable r)
+mapIPNameTc f (Linear  n) = f n  `thenNF_Tc` \ r -> returnNF_Tc (Linear r)
 \end{code}
 
 
diff --git a/ghc/compiler/typecheck/TcMonad.lhs b/ghc/compiler/typecheck/TcMonad.lhs
index 6241d1c3b7..2aee9fb47f 100644
--- a/ghc/compiler/typecheck/TcMonad.lhs
+++ b/ghc/compiler/typecheck/TcMonad.lhs
@@ -44,7 +44,7 @@ import {-# SOURCE #-} TcEnv  ( TcEnv )
 
 import HsLit		( HsOverLit )
 import RnHsSyn		( RenamedPat, RenamedArithSeqInfo, RenamedHsExpr )
-import TcType		( Type, Kind, TyVarDetails, IPName )
+import TcType		( Type, Kind, TyVarDetails )
 import ErrUtils		( addShortErrLocLine, addShortWarnLocLine, ErrMsg, Message, WarnMsg )
 
 import Bag		( Bag, emptyBag, isEmptyBag,
@@ -57,6 +57,7 @@ import UniqSupply	( UniqSupply, uniqFromSupply, uniqsFromSupply,
 			  splitUniqSupply, mkSplitUniqSupply,
 			  UniqSM, initUs_ )
 import SrcLoc		( SrcLoc, noSrcLoc )
+import BasicTypes	( IPName )
 import UniqFM		( emptyUFM )
 import Unique		( Unique )
 import CmdLineOpts
diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index 348c50f885..8af99244fd 100644
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -27,33 +27,35 @@ import TcHsSyn		( TcExpr, TcId,
 import TcMonad
 import Inst		( lookupInst, lookupSimpleInst, LookupInstResult(..),
 			  tyVarsOfInst, predsOfInsts, predsOfInst,
-			  isDict, isClassDict, 
-			  isStdClassTyVarDict, isMethodFor,
-			  instToId, tyVarsOfInsts, 
+			  isDict, isClassDict, isLinearInst, linearInstType,
+			  isStdClassTyVarDict, isMethodFor, isMethod,
+			  instToId, tyVarsOfInsts,  cloneDict,
 			  ipNamesOfInsts, ipNamesOfInst,
 			  instBindingRequired, instCanBeGeneralised,
-			  newDictsFromOld, 
+			  newDictsFromOld, newMethodAtLoc,
 			  getDictClassTys, isTyVarDict,
 			  instLoc, pprInst, zonkInst, tidyInsts, tidyMoreInsts,
 			  Inst, LIE, pprInsts, pprInstsInFull,
 			  mkLIE, lieToList
 			)
-import TcEnv		( tcGetGlobalTyVars, tcGetInstEnv )
+import TcEnv		( tcGetGlobalTyVars, tcGetInstEnv, tcLookupGlobalId )
 import InstEnv		( lookupInstEnv, classInstEnv, InstLookupResult(..) )
 import TcMType		( zonkTcTyVarsAndFV, tcInstTyVars )
 import TcType		( TcTyVar, TcTyVarSet, ThetaType, PredType, 
-			  mkClassPred, isOverloadedTy,
+			  mkClassPred, isOverloadedTy, mkTyConApp,
 			  mkTyVarTy, tcGetTyVar, isTyVarClassPred,
 			  tyVarsOfPred, getClassPredTys_maybe, isClassPred, isIPPred,
 			  inheritablePred, predHasFDs )
-import Id		( idType )
+import Id		( idType, mkUserLocal )
+import Name		( getOccName, getSrcLoc )
 import NameSet		( NameSet, mkNameSet, elemNameSet )
 import Class		( classBigSig )
 import FunDeps		( oclose, grow, improve, pprEquationDoc )
-import PrelInfo		( isNumericClass, isCreturnableClass, isCcallishClass )
+import PrelInfo		( isNumericClass, isCreturnableClass, isCcallishClass, 
+			  splitIdName, fstIdName, sndIdName )
 
 import Subst		( mkTopTyVarSubst, substTheta, substTy )
-import TysWiredIn	( unitTy )
+import TysWiredIn	( unitTy, pairTyCon )
 import VarSet
 import FiniteMap
 import Outputable
@@ -1025,17 +1027,16 @@ data WantSCs = NoSCs | AddSCs	-- Tells whether we should add the superclasses
 
 
 \begin{code}
-type RedState = (Avails,	-- What's available
-		 [Inst])	-- Insts for which try_me returned Free
-
 type Avails = FiniteMap Inst Avail
 
 data Avail
-  = Irred		-- Used for irreducible dictionaries,
+  = IsFree		-- Used for free Insts
+  | Irred		-- Used for irreducible dictionaries,
 			-- which are going to be lambda bound
 
-  | BoundTo TcId	-- Used for dictionaries for which we have a binding
+  | Given TcId 		-- Used for dictionaries for which we have a binding
 			-- e.g. those "given" in a signature
+	  Bool		-- True <=> actually consumed (splittable IPs only)
 
   | NoRhs 		-- Used for Insts like (CCallable f)
 			-- where no witness is required.
@@ -1044,16 +1045,31 @@ data Avail
 	TcExpr	 	-- The RHS
 	[Inst]		-- Insts free in the RHS; we need these too
 
+  | Linear 		-- Splittable Insts only.
+	Int		-- The Int is always 2 or more; indicates how
+			-- many copies are required
+	Inst 		-- The splitter
+	Avail		-- Where the "master copy" is
+
+  | LinRhss		-- Splittable Insts only; this is used only internally
+			-- 	by extractResults, where a Linear 
+			--	is turned into an LinRhss
+	[TcExpr]	-- A supply of suitable RHSs
+
 pprAvails avails = vcat [ppr inst <+> equals <+> pprAvail avail
 			| (inst,avail) <- fmToList avails ]
 
 instance Outputable Avail where
     ppr = pprAvail
 
-pprAvail NoRhs	      = text "<no rhs>"
-pprAvail Irred	      = text "Irred"
-pprAvail (BoundTo x)  = text "Bound to" <+> ppr x
-pprAvail (Rhs rhs bs) = ppr rhs <+> braces (ppr bs)
+pprAvail NoRhs	       	= text "<no rhs>"
+pprAvail IsFree	       	= text "Free"
+pprAvail Irred	       	= text "Irred"
+pprAvail (Given x b)   	= text "Given" <+> ppr x <+> 
+		 	  if b then text "(used)" else empty
+pprAvail (Rhs rhs bs)   = text "Rhs" <+> ppr rhs <+> braces (ppr bs)
+pprAvail (Linear n i a) = text "Linear" <+> ppr n <+> braces (ppr i) <+> ppr a
+pprAvail (LinRhss rhss) = text "LinRhss" <+> ppr rhss
 \end{code}
 
 Extracting the bindings from a bunch of Avails.
@@ -1063,42 +1079,129 @@ dependency analyser can sort them out later
 
 The loop startes
 \begin{code}
-bindsAndIrreds :: Avails
+extractResults :: Avails
 	       -> [Inst]		-- Wanted
-	       -> (TcDictBinds, 	-- Bindings
-		   [Inst])		-- Irreducible ones
+	       -> NF_TcM (TcDictBinds, 	-- Bindings
+			  [Inst],	-- Irreducible ones
+			  [Inst])	-- Free ones
 
-bindsAndIrreds avails wanteds
-  = go avails EmptyMonoBinds [] wanteds
+extractResults avails wanteds
+  = go avails EmptyMonoBinds [] [] wanteds
   where
-    go avails binds irreds [] = (binds, irreds)
+    go avails binds irreds frees [] 
+      = returnNF_Tc (binds, irreds, frees)
 
-    go avails binds irreds (w:ws)
+    go avails binds irreds frees (w:ws)
       = case lookupFM avails w of
-	  Nothing    -> -- Free guys come out here
-			-- (If we didn't do addFree we could use this as the
-			--  criterion for free-ness, and pick up the free ones here too)
-			go avails binds irreds ws
+	  Nothing    -> pprTrace "Urk: extractResults" (ppr w) $
+			go avails binds irreds frees ws
 
-	  Just NoRhs -> go avails binds irreds ws
+	  Just NoRhs  -> go avails		 binds irreds     frees     ws
+	  Just IsFree -> go (add_free avails w)  binds irreds     (w:frees) ws
+	  Just Irred  -> go (add_given avails w) binds (w:irreds) frees     ws
 
-	  Just Irred -> go (addToFM avails w (BoundTo (instToId w))) binds (w:irreds) ws
-
-	  Just (BoundTo id) -> go avails new_binds irreds ws
+	  Just (Given id _) -> go avails new_binds irreds frees ws
 			    where
-				-- For implicit parameters, all occurrences share the same
-				-- Id, so there is no need for synonym bindings
-				-- ** BUT THIS TEST IS NEEDED FOR DICTS TOO ** (not sure why)
-			       new_binds | new_id == id = binds
-					 | otherwise	= addBind binds new_id (HsVar id)
-			       new_id   = instToId w
-
-	  Just (Rhs rhs ws') -> go avails' (addBind binds id rhs) irreds (ws' ++ ws)
-			     where
-				id	 = instToId w
-				avails'  = addToFM avails w (BoundTo id)
+			       new_binds | id == instToId w = binds
+					 | otherwise        = addBind binds w (HsVar id)
+		-- The sought Id can be one of the givens, via a superclass chain
+		-- and then we definitely don't want to generate an x=x binding!
 
-addBind binds id rhs = binds `AndMonoBinds` VarMonoBind id rhs
+	  Just (Rhs rhs ws') -> go (add_given avails w) new_binds irreds frees (ws' ++ ws)
+			     where
+				new_binds = addBind binds w rhs
+
+	  Just (LinRhss (rhs:rhss))	-- Consume one of the Rhss
+		-> go new_avails new_binds irreds frees ws
+		where		
+		   new_binds  = addBind binds w rhs
+		   new_avails = addToFM avails w (LinRhss rhss)
+
+	  Just (Linear n split_inst avail)
+	    -> split n (instToId split_inst) avail w	`thenNF_Tc` \ (binds', (rhs:rhss), irreds') ->
+	       go (addToFM avails w (LinRhss rhss))
+		  (binds `AndMonoBinds` addBind binds' w rhs)
+		  (irreds' ++ irreds) frees (split_inst:ws)
+
+
+    add_given avails w 
+	| instBindingRequired w = addToFM avails w (Given (instToId w) True)
+	| otherwise		= addToFM avails w NoRhs
+	-- NB: make sure that CCallable/CReturnable use NoRhs rather
+	--	than Given, else we end up with bogus bindings.
+
+    add_free avails w | isMethod w = avails
+		      | otherwise  = add_given avails w
+	-- NB: Hack alert!  
+	-- Do *not* replace Free by Given if it's a method.
+	-- The following situation shows why this is bad:
+	--	truncate :: forall a. RealFrac a => forall b. Integral b => a -> b
+	-- From an application (truncate f i) we get
+	--	t1 = truncate at f
+	--	t2 = t1 at i
+	-- If we have also have a second occurrence of truncate, we get
+	--	t3 = truncate at f
+	--	t4 = t3 at i
+	-- When simplifying with i,f free, we might still notice that
+	--   t1=t3; but alas, the binding for t2 (which mentions t1)
+	--   will continue to float out!
+	-- (split n i a) returns: n rhss
+	--			  auxiliary bindings
+	--			  1 or 0 insts to add to irreds
+
+
+split :: Int -> TcId -> Avail -> Inst 
+      -> NF_TcM (TcDictBinds, [TcExpr], [Inst])
+-- (split n split_id avail wanted) returns
+--	* a list of 'n' expressions, all of which witness 'avail'
+--	* a bunch of auxiliary bindings to support these expressions
+--	* one or zero insts needed to witness the whole lot
+--	  (maybe be zero if the initial Inst is a Given)
+split n split_id avail wanted
+  = go n
+  where
+    ty  = linearInstType wanted
+    pair_ty = mkTyConApp pairTyCon [ty,ty]
+    id  = instToId wanted
+    occ = getOccName id
+    loc = getSrcLoc id
+
+    go 1 = case avail of
+	     Given id _ -> returnNF_Tc (EmptyMonoBinds, [HsVar id], [])
+	     Irred      -> cloneDict wanted		`thenNF_Tc` \ w' ->
+			   returnNF_Tc (EmptyMonoBinds, [HsVar (instToId w')], [w'])
+
+    go n = go ((n+1) `div` 2)		`thenNF_Tc` \ (binds1, rhss, irred) ->
+	   expand n rhss		`thenNF_Tc` \ (binds2, rhss') ->
+	   returnNF_Tc (binds1 `AndMonoBinds` binds2, rhss', irred)
+
+	-- (expand n rhss) 
+	-- Given ((n+1)/2) rhss, make n rhss, using auxiliary bindings
+	--  e.g.  expand 3 [rhs1, rhs2]
+	--	  = ( { x = split rhs1 },
+	--	      [fst x, snd x, rhs2] )
+    expand n rhss
+	| n `rem` 2 == 0 = go rhss 	-- n is even
+	| otherwise  	 = go (tail rhss)	`thenNF_Tc` \ (binds', rhss') ->
+			   returnNF_Tc (binds', head rhss : rhss')
+	where
+	  go rhss = mapAndUnzipNF_Tc do_one rhss	`thenNF_Tc` \ (binds', rhss') ->
+		    returnNF_Tc (andMonoBindList binds', concat rhss')
+
+	  do_one rhs = tcGetUnique 			`thenNF_Tc` \ uniq -> 
+		       tcLookupGlobalId fstIdName	`thenNF_Tc` \ fst_id -> 
+		       tcLookupGlobalId sndIdName	`thenNF_Tc` \ snd_id -> 
+		       let 
+			  x = mkUserLocal occ uniq pair_ty loc
+		       in
+		       returnNF_Tc (VarMonoBind x (mk_app split_id rhs),
+				    [mk_fs_app fst_id ty x, mk_fs_app snd_id ty x])
+
+mk_fs_app id ty var = HsVar id `TyApp` [ty,ty] `HsApp` HsVar var
+
+mk_app id rhs = HsApp (HsVar id) rhs
+
+addBind binds inst rhs = binds `AndMonoBinds` VarMonoBind (instToId inst) rhs
 \end{code}
 
 
@@ -1155,15 +1258,17 @@ reduceContext doc try_me givens wanteds
 	     ]))					`thenNF_Tc_`
 
         -- Build the Avail mapping from "givens"
-    foldlNF_Tc addGiven (emptyFM, []) givens		`thenNF_Tc` \ init_state ->
+    foldlNF_Tc addGiven emptyFM givens			`thenNF_Tc` \ init_state ->
 
         -- Do the real work
-    reduceList (0,[]) try_me wanteds init_state		`thenNF_Tc` \ state@(avails, frees) ->
+    reduceList (0,[]) try_me wanteds init_state		`thenNF_Tc` \ avails ->
 
 	-- Do improvement, using everything in avails
 	-- In particular, avails includes all superclasses of everything
     tcImprove avails					`thenTc` \ no_improvement ->
 
+    extractResults avails wanteds			`thenNF_Tc` \ (binds, irreds, frees) ->
+
     traceTc (text "reduceContext end" <+> (vcat [
 	     text "----------------------",
 	     doc,
@@ -1175,10 +1280,8 @@ reduceContext doc try_me givens wanteds
 	     text "no_improvement =" <+> ppr no_improvement,
 	     text "----------------------"
 	     ])) 					`thenNF_Tc_`
-     let
-	(binds, irreds) = bindsAndIrreds avails wanteds
-     in
-     returnTc (no_improvement, frees, binds, irreds)
+
+    returnTc (no_improvement, frees, binds, irreds)
 
 tcImprove avails
  =  tcGetInstEnv 				`thenTc` \ inst_env ->
@@ -1216,8 +1319,8 @@ reduceList :: (Int,[Inst])		-- Stack (for err msgs)
 					-- along with its depth
        	   -> (Inst -> WhatToDo)
        	   -> [Inst]
-       	   -> RedState
-       	   -> TcM RedState
+       	   -> Avails
+       	   -> TcM Avails
 \end{code}
 
 @reduce@ is passed
@@ -1227,10 +1330,10 @@ reduceList :: (Int,[Inst])		-- Stack (for err msgs)
 		  Free	       return this in "frees"
 
      wanteds:	The list of insts to reduce
-     state:	An accumulating parameter of type RedState
+     state:	An accumulating parameter of type Avails
 		that contains the state of the algorithm
 
-  It returns a RedState.
+  It returns a Avails.
 
 The (n,stack) pair is just used for error reporting.
 n is always the depth of the stack.
@@ -1258,8 +1361,12 @@ reduceList (n,stack) try_me wanteds state
     -- Base case: we're done!
 reduce stack try_me wanted state
     -- It's the same as an existing inst, or a superclass thereof
-  | isAvailable state wanted
-  = returnTc state
+  | Just avail <- isAvailable state wanted
+  = if isLinearInst wanted then
+	addLinearAvailable state avail wanted	`thenNF_Tc` \ (state', wanteds') ->
+	reduceList stack try_me wanteds' state'
+    else
+	returnTc state		-- No op for non-linear things
 
   | otherwise
   = case try_me wanted of {
@@ -1296,14 +1403,34 @@ reduce stack try_me wanted state
 
 
 \begin{code}
-isAvailable :: RedState -> Inst -> Bool
-isAvailable (avails, _) wanted = wanted `elemFM` avails
-	-- NB: the Ord instance of Inst compares by the class/type info
+-------------------------
+isAvailable :: Avails -> Inst -> Maybe Avail
+isAvailable avails wanted = lookupFM avails wanted
+	-- NB 1: the Ord instance of Inst compares by the class/type info
 	-- *not* by unique.  So
 	--	d1::C Int ==  d2::C Int
 
+addLinearAvailable :: Avails -> Avail -> Inst -> NF_TcM (Avails, [Inst])
+addLinearAvailable avails avail wanted
+  | need_split avail
+  = tcLookupGlobalId splitIdName		`thenNF_Tc` \ split_id ->
+    newMethodAtLoc (instLoc wanted) split_id 
+		   [linearInstType wanted]	`thenNF_Tc` \ (split_inst,_) ->
+    returnNF_Tc (addToFM avails wanted (Linear 2 split_inst avail), [split_inst])
+
+  | otherwise
+  = returnNF_Tc (addToFM avails wanted avail', [])
+  where
+    avail' = case avail of
+		Given id _   -> Given id True
+		Linear n i a -> Linear (n+1) i a 
+
+    need_split Irred	      = True
+    need_split (Given _ used) = used
+    need_split (Linear _ _ _) = False
+
 -------------------------
-addFree :: RedState -> Inst -> NF_TcM RedState
+addFree :: Avails -> Inst -> NF_TcM Avails
 	-- When an Inst is tossed upstairs as 'free' we nevertheless add it
 	-- to avails, so that any other equal Insts will be commoned up right
 	-- here rather than also being tossed upstairs.  This is really just
@@ -1316,33 +1443,10 @@ addFree :: RedState -> Inst -> NF_TcM RedState
 	-- but a is not bound here, then we *don't* want to derive
 	-- dn from df here lest we lose sharing.
 	--
-	-- NB2: do *not* add the Inst to avails at all if it's a method.
-	-- The following situation shows why this is bad:
-	--	truncate :: forall a. RealFrac a => forall b. Integral b => a -> b
-	-- From an application (truncate f i) we get
-	--	t1 = truncate at f
-	--	t2 = t1 at i
-	-- If we have also have a second occurrence of truncate, we get
-	--	t3 = truncate at f
-	--	t4 = t3 at i
-	-- When simplifying with i,f free, we might still notice that
-	--   t1=t3; but alas, the binding for t2 (which mentions t1)
-	--   will continue to float out!
-	-- Solution: never put methods in avail till they are captured
-	-- in which case addFree isn't used
-	--
-	-- NB3: make sure that CCallable/CReturnable use NoRhs rather
-	--	than BoundTo, else we end up with bogus bindings.
-	--	c.f. instBindingRequired in addWanted
-addFree (avails, frees) free
-  | isDict free = returnNF_Tc (addToFM avails free avail, free:frees)
-  | otherwise   = returnNF_Tc (avails,			  free:frees)
-  where
-    avail | instBindingRequired free = BoundTo (instToId free)
-	  | otherwise		     = NoRhs
+addFree avails free = returnNF_Tc (addToFM avails free IsFree)
 
-addWanted :: RedState -> Inst -> TcExpr -> [Inst] -> NF_TcM RedState
-addWanted state@(avails, frees) wanted rhs_expr wanteds
+addWanted :: Avails -> Inst -> TcExpr -> [Inst] -> NF_TcM Avails
+addWanted avails wanted rhs_expr wanteds
 -- Do *not* add superclasses as well.  Here's an example of why not
 -- 	class Eq a => Foo a b
 --	instance Eq a => Foo [a] a
@@ -1353,27 +1457,21 @@ addWanted state@(avails, frees) wanted rhs_expr wanteds
 -- 	ToDo: this isn't entirely unsatisfactory, because
 --	      we may also lose some entirely-legitimate sharing this way
 
-  = ASSERT( not (isAvailable state wanted) )
-    returnNF_Tc (addToFM avails wanted avail, frees)
+  = ASSERT( not (wanted `elemFM` avails) )
+    returnNF_Tc (addToFM avails wanted avail)
   where
     avail | instBindingRequired wanted = Rhs rhs_expr wanteds
 	  | otherwise		       = ASSERT( null wanteds ) NoRhs
 
-addGiven :: RedState -> Inst -> NF_TcM RedState
-addGiven state given = addAvailAndSCs state given (BoundTo (instToId given))
-
-addIrred :: WantSCs -> RedState -> Inst -> NF_TcM RedState
-addIrred NoSCs  (avails,frees) irred = returnNF_Tc (addToFM avails irred Irred, frees)
-addIrred AddSCs state	       irred = addAvailAndSCs state irred Irred
+addGiven :: Avails -> Inst -> NF_TcM Avails
+addGiven state given = addAvailAndSCs state given (Given (instToId given) False)
 
-addAvailAndSCs :: RedState -> Inst -> Avail -> NF_TcM RedState
-addAvailAndSCs (avails, frees) wanted avail
-  = add_avail_and_scs avails wanted avail	`thenNF_Tc` \ avails' ->
-    returnNF_Tc (avails', frees)
+addIrred :: WantSCs -> Avails -> Inst -> NF_TcM Avails
+addIrred NoSCs  state irred = returnNF_Tc (addToFM state irred Irred)
+addIrred AddSCs state irred = addAvailAndSCs state irred Irred
 
----------------------
-add_avail_and_scs :: Avails -> Inst -> Avail -> NF_TcM Avails
-add_avail_and_scs avails wanted avail
+addAvailAndSCs :: Avails -> Inst -> Avail -> NF_TcM Avails
+addAvailAndSCs avails wanted avail
   = add_scs (addToFM avails wanted avail) wanted
 
 add_scs :: Avails -> Inst -> NF_TcM Avails
@@ -1394,8 +1492,8 @@ add_scs avails dict
 
     add_sc avails (sc_dict, sc_sel)	-- Add it, and its superclasses
       = case lookupFM avails sc_dict of
-	  Just (BoundTo _) -> returnNF_Tc avails	-- See Note [SUPER] below
-	  other		   -> add_avail_and_scs avails sc_dict avail
+	  Just (Given _ _) -> returnNF_Tc avails	-- See Note [SUPER] below
+	  other		   -> addAvailAndSCs avails sc_dict avail
       where
 	sc_sel_rhs = DictApp (TyApp (HsVar sc_sel) tys) [instToId dict]
 	avail      = Rhs sc_sel_rhs [dict]
@@ -1410,7 +1508,7 @@ and want to deduce (d2:C [a]) where
 Then we'll use the instance decl to deduce C [a] and then add the
 superclasses of C [a] to avails.  But we must not overwrite the binding
 for d1:Ord a (which is given) with a superclass selection or we'll just
-build a loop!  Hence looking for BoundTo.  Crudely, BoundTo is cheaper
+build a loop!  Hence looking for Given.  Crudely, Given is cheaper
 than a selection.
 
 
@@ -1816,11 +1914,11 @@ warnDefault dicts default_ty
 		      pprInstsInFull tidy_dicts]
 
 complainCheck doc givens irreds
-  = mapNF_Tc zonkInst given_dicts			 	  `thenNF_Tc` \ givens' ->
+  = mapNF_Tc zonkInst given_dicts_and_ips		 	  `thenNF_Tc` \ givens' ->
     mapNF_Tc (addNoInstanceErrs doc givens') (groupInsts irreds)  `thenNF_Tc_`
     returnNF_Tc ()
   where
-    given_dicts = filter isDict givens
+    given_dicts_and_ips = filter (not . isMethod) givens
 	-- Filter out methods, which are only added to
 	-- the given set as an optimisation
 
diff --git a/ghc/compiler/typecheck/TcType.lhs b/ghc/compiler/typecheck/TcType.lhs
index b1e52a92cb..88973ba82c 100644
--- a/ghc/compiler/typecheck/TcType.lhs
+++ b/ghc/compiler/typecheck/TcType.lhs
@@ -84,8 +84,6 @@ module TcType (
   superBoxity, liftedBoxity, hasMoreBoxityInfo, defaultKind, superKind,
   isTypeKind,
 
-  IPName, ipNameName, mapIPName,
-
   Type, SourceType(..), PredType, ThetaType, 
   mkForAllTy, mkForAllTys, 
   mkFunTy, mkFunTys, zipFunTys, 
@@ -114,7 +112,7 @@ import Type		( mkUTyM, unUTy )	-- Used locally
 
 import Type		(	-- Re-exports
 			  tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
-			  IPName, Kind, Type, SourceType(..), PredType, ThetaType, 
+			  Kind, Type, SourceType(..), PredType, ThetaType, 
 			  unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds,
 			  mkForAllTy, mkForAllTys, defaultKind, isTypeKind,
 			  mkFunTy, mkFunTys, zipFunTys, 
@@ -124,8 +122,7 @@ import Type		(	-- Re-exports
 			  splitNewType_maybe, splitTyConApp_maybe,
 			  tidyTopType, tidyType, tidyPred, tidyTypes, tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
 			  tidyTyVarBndr, tidyOpenTyVar, tidyOpenTyVars, eqKind, eqUsage,
-			  hasMoreBoxityInfo, liftedBoxity, superBoxity, typeKind, superKind,
-			  ipNameName, mapIPName
+			  hasMoreBoxityInfo, liftedBoxity, superBoxity, typeKind, superKind
 			)
 import TyCon		( TyCon, isUnLiftedTyCon )
 import Class		( classHasFDs, Class )
@@ -141,6 +138,7 @@ import OccName		( OccName, mkDictOcc )
 import NameSet
 import PrelNames	-- Lots (e.g. in isFFIArgumentTy)
 import TysWiredIn	( ptrTyCon, funPtrTyCon, addrTyCon, unitTyCon )
+import BasicTypes	( ipNameName )
 import Unique		( Unique, Uniquable(..) )
 import SrcLoc		( SrcLoc )
 import Util		( cmpList, thenCmp, equalLength )
diff --git a/ghc/compiler/types/PprType.lhs b/ghc/compiler/types/PprType.lhs
index 24cbb404b6..24a4bb3e93 100644
--- a/ghc/compiler/types/PprType.lhs
+++ b/ghc/compiler/types/PprType.lhs
@@ -18,10 +18,10 @@ module PprType(
 
 -- friends:
 -- (PprType can see all the representations it's trying to print)
-import TypeRep		( Type(..), TyNote(..), IPName(..), 
+import TypeRep		( Type(..), TyNote(..), 
 			  Kind, liftedTypeKind ) -- friend
 import Type		( SourceType(..), isUTyVar, eqKind )
-import TcType		( ThetaType, PredType, ipNameName,
+import TcType		( ThetaType, PredType,
 			  tcSplitSigmaTy, isPredTy, isDictTy,
 			  tcSplitTyConApp_maybe, tcSplitFunTy_maybe
 			) 
@@ -39,7 +39,7 @@ import Name		( getOccString, getOccName )
 import Outputable
 import Unique		( Uniquable(..) )
 import Util             ( lengthIs )
-import BasicTypes	( tupleParens )
+import BasicTypes	( IPName(..), tupleParens, ipNameName )
 import PrelNames		-- quite a few *Keys
 \end{code}
 
@@ -84,8 +84,8 @@ instance Outputable SourceType where
     ppr = pprPred
 
 instance Outputable name => Outputable (IPName name) where
-    ppr (Dupable n)   = char '?' <> ppr n -- Ordinary implicit parameters
-    ppr (MustSplit n) = char '%' <> ppr n -- Splittable implicit parameters
+    ppr (Dupable n) = char '?' <> ppr n -- Ordinary implicit parameters
+    ppr (Linear  n) = char '%' <> ppr n -- Splittable implicit parameters
 \end{code}
 
 
diff --git a/ghc/compiler/types/Type.lhs b/ghc/compiler/types/Type.lhs
index 84d1594879..056316d6fb 100644
--- a/ghc/compiler/types/Type.lhs
+++ b/ghc/compiler/types/Type.lhs
@@ -7,7 +7,7 @@
 module Type (
         -- re-exports from TypeRep:
 	Type, PredType, ThetaType,
-	Kind, TyVarSubst, IPName,
+	Kind, TyVarSubst, 
 
 	superKind, superBoxity,				-- KX and BX respectively
 	liftedBoxity, unliftedBoxity, 			-- :: BX
@@ -50,7 +50,6 @@ module Type (
 
 	-- Source types
 	SourceType(..), sourceTypeRep, mkPredTy, mkPredTys,
-	ipNameName, mapIPName,
 
 	-- Newtypes
 	splitNewType_maybe,
@@ -662,16 +661,6 @@ newTypeRep new_tycon tys = case newTyConRep new_tycon of
 			     (tvs, rep_ty) -> substTyWith tvs tys rep_ty
 \end{code}
 
-\begin{code}
-ipNameName :: IPName name -> name
-ipNameName (Dupable n)   = n
-ipNameName (MustSplit n) = n
-
-mapIPName :: (a->b) -> IPName a -> IPName b
-mapIPName f (Dupable n)   = Dupable (f n)
-mapIPName f (MustSplit n) = MustSplit (f n)
-\end{code}
-
 
 %************************************************************************
 %*									*
diff --git a/ghc/compiler/types/TypeRep.lhs b/ghc/compiler/types/TypeRep.lhs
index 8e2002c24a..bb0a7f01b4 100644
--- a/ghc/compiler/types/TypeRep.lhs
+++ b/ghc/compiler/types/TypeRep.lhs
@@ -6,7 +6,7 @@
 \begin{code}
 module TypeRep (
 	Type(..), TyNote(..), 		-- Representation visible 
-	SourceType(..), IPName(..),	-- to friends
+	SourceType(..), 		-- to friends
 	
  	Kind, PredType, ThetaType,		-- Synonyms
 	TyVarSubst,
@@ -29,13 +29,13 @@ module TypeRep (
 #include "HsVersions.h"
 
 -- friends:
-import Var	( TyVar )
-import VarEnv
-import VarSet
-
-import Name	( Name )
-import TyCon	( TyCon, KindCon, mkFunTyCon, mkKindCon, mkSuperKindCon )
-import Class	( Class )
+import Var	  ( TyVar )
+import VarEnv     ( TyVarEnv )
+import VarSet     ( TyVarSet )
+import Name	  ( Name )
+import BasicTypes ( IPName )
+import TyCon	  ( TyCon, KindCon, mkFunTyCon, mkKindCon, mkSuperKindCon )
+import Class	  ( Class )
 
 -- others
 import PrelNames	( superKindName, superBoxityName, liftedConName, 
@@ -213,13 +213,6 @@ data SourceType
   | NType TyCon [Type]		-- A *saturated*, *non-recursive* newtype application
 				-- [See notes at top about newtypes]
 
-data IPName name
-  = Dupable   name	-- ?x: you can freely duplicate this implicit parameter
-  | MustSplit name	-- %x: you must use the splitting function to duplicate it
-  deriving( Eq, Ord )	-- Ord is used in the IP name cache finite map
-			--	(used in HscTypes.OrigIParamCache)
-	-- I sometimes thisnk this type should be in BasicTypes
-		
 type PredType  = SourceType	-- A subtype for predicates
 type ThetaType = [PredType]
 \end{code}
diff --git a/ghc/docs/users_guide/glasgow_exts.sgml b/ghc/docs/users_guide/glasgow_exts.sgml
index 20d164d16f..3669baab39 100644
--- a/ghc/docs/users_guide/glasgow_exts.sgml
+++ b/ghc/docs/users_guide/glasgow_exts.sgml
@@ -60,6 +60,13 @@ Executive summary of our extensions:
 	  </varlistentry>
 
 	  <varlistentry>
+	    <term>Linear implicit parameters:</term>
+	    <listitem>
+	      <para><xref LinkEnd="linear-implicit-parameters"></para>
+	    </listitem>
+	  </varlistentry>
+
+	  <varlistentry>
 	    <term>Local universal quantification:</term>
 	    <listitem>
 	      <para><xref LinkEnd="universal-quantification"></para>
@@ -1209,6 +1216,133 @@ Easiest thing is to outlaw the offending types.</para>
 
 </sect1>
 
+<sect1 id="linear-implicit-parameters">
+<title>Linear implicit parameters
+</title>
+<para>
+Linear implicit parameters are an idea developed by Koen Claessen,
+Mark Shields, and Simon PJ.  They address the long-standing
+problem that monads seem over-kill for certain sorts of problem, notably:
+</para>
+<itemizedlist>
+<listitem> <para> distributing a supply of unique names </para> </listitem>
+<listitem> <para> distributing a suppply of random numbers </para> </listitem>
+<listitem> <para> distributing an oracle (as in QuickCheck) </para> </listitem>
+</itemizedlist>
+
+<para>
+Linear implicit parameters are just like ordinary implicit parameters,
+except that they are "linear" -- that is, they cannot be copied, and
+must be explicitly "split" instead.  Linear implicit parameters are
+written '<literal>%x</literal>' instead of '<literal>?x</literal>'.  
+(The '/' in the '%' suggests the split!)
+</para>
+<para>
+For example:
+<programlisting>
+    data NameSupply = ...
+    
+    splitNS :: NameSupply -> (NameSupply, NameSupply)
+    newName :: NameSupply -> Name
+
+    instance PrelSplit.Splittable NameSupply where
+	split = splitNS
+
+
+    f :: (%ns :: NameSupply) => Env -> Expr -> Expr
+    f env (Lam x e) = Lam x' (f env e)
+		    where
+		      x'   = newName %ns
+		      env' = extend env x x'
+    ...more equations for f...
+</programlisting>
+Notice that the implicit parameter %ns is consumed 
+<itemizedlist>
+<listitem> <para> once by the call to <literal>newName</literal> </para> </listitem>
+<listitem> <para> once by the recursive call to <literal>f</literal> </para></listitem>
+</itemizedlist>
+</para>
+<para>
+So the translation done by the type checker makes
+the parameter explicit:
+<programlisting>
+    f :: NameSupply -> Env -> Expr -> Expr
+    f ns env (Lam x e) = Lam x' (f ns1 env e)
+		       where
+	 		 (ns1,ns2) = splitNS ns
+			 x' = newName ns2
+			 env = extend env x x'
+</programlisting>
+Notice the call to 'split' introduced by the type checker.
+How did it know to use 'splitNS'?  Because what it really did
+was to introduce a call to the overloaded function 'split',
+defined by
+<programlisting>
+	class Splittable a where
+	  split :: a -> (a,a)
+</programlisting>
+The instance for <literal>Splittable NameSupply</literal> tells GHC how to implement
+split for name supplies.  But we can simply write
+<programlisting>
+	g x = (x, %ns, %ns)
+</programlisting>
+and GHC will infer
+<programlisting>
+	g :: (Splittable a, %ns :: a) => b -> (b,a,a)
+</programlisting>
+The <literal>Splittable</literal> class is built into GHC.  It's defined in <literal>PrelSplit</literal>,
+and exported by <literal>GlaExts</literal>.
+</para>
+<para>
+Other points:
+<itemizedlist>
+<listitem> <para> '<literal>?x</literal>' and '<literal>%x</literal>' 
+are entirely distinct implicit parameters: you 
+  can use them together and they won't intefere with each other. </para>
+</listitem>
+
+<listitem> <para> You can bind linear implicit parameters in 'with' clauses. </para> </listitem>
+
+<listitem> <para>You cannot have implicit parameters (whether linear or not)
+  in the context of a class or instance declaration. </para></listitem>
+</itemizedlist>
+</para>
+
+<sect2><title>Warnings</title>
+
+<para>
+The monomorphism restriction is even more important than usual.
+Consider the example above:
+<programlisting>
+    f :: (%ns :: NameSupply) => Env -> Expr -> Expr
+    f env (Lam x e) = Lam x' (f env e)
+		    where
+		      x'   = newName %ns
+		      env' = extend env x x'
+</programlisting>
+If we replaced the two occurrences of x' by (newName %ns), which is
+usually a harmless thing to do, we get:
+<programlisting>
+    f :: (%ns :: NameSupply) => Env -> Expr -> Expr
+    f env (Lam x e) = Lam (newName %ns) (f env e)
+		    where
+		      env' = extend env x (newName %ns)
+</programlisting>
+But now the name supply is consumed in <emphasis>three</emphasis> places
+(the two calls to newName,and the recursive call to f), so
+the result is utterly different.  Urk!  We don't even have 
+the beta rule.
+</para>
+<para>
+Well, this is an experimental change.  With implicit
+parameters we have already lost beta reduction anyway, and
+(as John Launchbury puts it) we can't sensibly reason about
+Haskell programs without knowing their typing.
+</para>
+
+</sect2>
+
+</sect1>
 
 <sect1 id="functional-dependencies">
 <title>Functional dependencies
diff --git a/ghc/lib/std/PrelSplit.lhs b/ghc/lib/std/PrelSplit.lhs
new file mode 100644
index 0000000000..7fd3d6b51e
--- /dev/null
+++ b/ghc/lib/std/PrelSplit.lhs
@@ -0,0 +1,9 @@
+\begin{code}
+module PrelSplit( Splittable( split ) ) where
+
+-- The Splittable class for the linear implicit parameters
+-- Can't put it in PrelBase, because of the use of (,)
+
+class Splittable t where
+  split :: t -> (t,t)
+\end{code}