[Makes the class deriving mechanism more robust:
jcpetruzza@gmail.com**20120216214017
 Ignore-this: 6d93691849d255c310b2af7098572ea8
  - the names of the classes to be derived may be given qualified. 
  - the functions from the Prelude internally used need not be in scope
    and won't clash with other bindings.
] hunk ./src/DataConstructors.hs 797
-slotTypesHs _ n e = error $ "slotTypes: error in " ++ show n ++ ": " ++ show e
+slotTypesHs _ n e = error $ "slotTypesHs: error in " ++ show n ++ ": " ++ show e
hunk ./src/DerivingDrift/DataP.hs 3
+import Name.Name(Name)
hunk ./src/DerivingDrift/DataP.hs 24
-type Name = String
hunk ./src/DerivingDrift/Drift.hs 1
-module DerivingDrift.Drift(driftDerive) where
+module DerivingDrift.Drift(driftDerive,driftResolvedNames) where
hunk ./src/DerivingDrift/Drift.hs 13
-import Options
hunk ./src/DerivingDrift/Drift.hs 14
-import Util.Gen
-import qualified FlagDump as FD
hunk ./src/DerivingDrift/Drift.hs 15
-driftDerive :: HsModule -> IO HsModule
-driftDerive hsModule = ans where
-    ans | null ss = return hsModule
-        | otherwise = do
-            wdump FD.Derived $ do
-                print $ hsModuleName hsModule
-                mapM_ putErrLn ss
-            return hsMod'
-    hsMod' = hsModule { hsModuleDecls = hsModuleDecls hsModule ++ ndcls }
+driftDerive :: HsModule -> [HsDecl]
+driftDerive hsModule = if null ss then [] else hsModuleDecls hsMod
+  where
hunk ./src/DerivingDrift/Drift.hs 22
-    ndcls = hsModuleDecls hsMod
hunk ./src/DerivingDrift/Drift.hs 26
-        let d = toData  name args condecls derives
+        let d = unrenameTyVars $ toData  name args condecls derives
hunk ./src/DerivingDrift/Drift.hs 31
-        let d =  toData  name args [condecl] derives
+        let d =  unrenameTyVars $ toData  name args [condecl] derives
hunk ./src/DerivingDrift/Drift.hs 37
+unrenameTyVars :: Data -> Data
+unrenameTyVars d = d{
+    vars = map (m Map.!) (vars d),
+    constraints = map (\(c,v) -> (c, m Map.! v)) (constraints d)
+  }
+ where m = Map.fromList $ zip (vars d) tyVars
+       tyVars = map (('a':) . show) [1::Int ..]
+
hunk ./src/DerivingDrift/Drift.hs 47
-    f c = Body { constructor = pp (show $ hsConDeclName c), types = hsConDeclArgs c, labels = lb c }
+    f c = Body { constructor = pp (getIdent $ hsConDeclName c), types = hsConDeclArgs c, labels = lb c }
hunk ./src/DerivingDrift/Drift.hs 51
-    lb r = concat [map show xs | (xs,_) <- hsConDeclRecArg r ]
-    ans = D { statement = DataStmt, vars = map show args, constraints = [], name = show name,  derives = map show derives, body = map f cons }
+    lb  r = concatMap fst (hsConDeclRecArg r)
+    ans = D { statement = DataStmt, vars = map show args, constraints = [], name = name,  derives = map show derives, body = map f cons }
+
+derive True d wh | wh `elem` enumDerivableClasses ++ map toUnqualified enumDerivableClasses = "-- generated instance  " ++ show wh ++ " " ++ getIdent (name d)
+derive _ d wh | Just fn <- Map.lookup wh standardRules = render $ fn d
+              | Just _  <- Map.lookup (show wh) shortRuleNames = error (msg ++ " " ++ show wh ++ " not in scope.")
+              | otherwise  = error msg
+  where msg = "Can't make a derived instance '" ++ show wh ++ " " ++ getIdent (name d) ++ "'."
hunk ./src/DerivingDrift/Drift.hs 60
-derive True d (toName ClassName -> wh) | wh `elem` enumDerivableClasses ++ map toUnqualified enumDerivableClasses = "-- generated instance  " ++ show wh ++ " " ++ name d
-derive _ d wh | Just fn <- Map.lookup (toName ClassName wh) (Map.mapKeys (nameName . toUnqualified) standardRules) = render $ fn d
-              | otherwise  = error ("derive: Tried to use non-existing rule "++show wh++" for "++name d)
+shortRuleNames = Map.mapKeys getIdent standardRules
hunk ./src/DerivingDrift/RuleUtils.hs 8
+import Name.Name(getIdent)
hunk ./src/DerivingDrift/RuleUtils.hs 59
-		, opt1 (texts (name d : vars d)) parenSpace id]
+		, opt1 (texts (getIdent (name d) : vars d)) parenSpace id]
hunk ./src/DerivingDrift/StandardRules.hs 1
-module DerivingDrift.StandardRules (standardRules) where
+module DerivingDrift.StandardRules (standardRules,driftResolvedNames) where
hunk ./src/DerivingDrift/StandardRules.hs 17
+-- this list is to be feeded to the renamer in the
+-- renaming phase of the derived instances
+driftResolvedNames :: [(Name.Name.Name,[Name.Name.Name])]
+driftResolvedNames = map unkn stdCls ++ map self stdCls ++ map self stdVals
+  where unkn n  = (toName UnknownType (q n), [n])
+        self n  = (n,[n])
+        stdCls  = Map.keys standardRules
+        stdVals = [v_sub,v_compose,
+                   dc_True,dc_False,v_and,
+                   dc_EQ,v_equals,v_geq,v_gt,v_compare,
+                   dc_Pair,
+                   dc_EmptyList,dc_Cons,v_foldl,v_cat,v_drop,
+                   v_showsPrec,v_showParen,v_showChar,v_showString,
+                   v_readsPrec,v_readParen,v_lex,
+                   v_fromEnum,v_toEnum,v_enumFrom,v_enumFromThen,
+                   v_minBound,v_maxBound]
+
+-- short for qualified and unqualified
+q,u :: Name.Name.Name -> String
+q = snd . fromName
+u = getIdent
+
hunk ./src/DerivingDrift/StandardRules.hs 44
-eqfn = instanceSkeleton "Eq" [(makeEq,defaultEq)]
+eqfn = instanceSkeleton (q class_Eq) [(makeEq,defaultEq)]
hunk ./src/DerivingDrift/StandardRules.hs 48
-	| null types = hsep $ texts [constructor,"==",constructor, "=", "True"]
+	| null types = hsep $ texts [constructor,u v_equals,constructor, "=", q dc_True]
hunk ./src/DerivingDrift/StandardRules.hs 53
-	head = [ text "==", d v', text "="]
-	body = sepWith (text "&&") $
-		zipWith (\x y -> (x <+> text "==" <+> y)) v v'
+	head = [ text (u v_equals), d v', text "="]
+	body = sepWith (text $ q v_and) $
+		zipWith (\x y -> (x <+> text (q v_equals) <+> y)) v v'
hunk ./src/DerivingDrift/StandardRules.hs 58
-defaultEq = hsep $ texts ["_", "==", "_", "=" ,"False"]
+defaultEq = hsep $ texts ["_", u v_equals, "_", "=" ,q dc_False]
hunk ./src/DerivingDrift/StandardRules.hs 70
-	| null (types b) = text "compare" <+>
+	| null (types b) = text (u v_compare) <+>
hunk ./src/DerivingDrift/StandardRules.hs 78
-		      one x y = fsep [text "compare",x,y]
+		      one x y = fsep [text (q v_compare),x,y]
hunk ./src/DerivingDrift/StandardRules.hs 80
-		      list xs ys = fsep [text "foldl", parens fn, text "EQ",
+		      list xs ys = fsep [text (q v_foldl), parens fn, text (q dc_EQ),
hunk ./src/DerivingDrift/StandardRules.hs 82
-		      fn = fsep $ texts  ["\\x y", "->", "if", "x", "==","EQ",
-			   "then", "compare", "y", "EQ", "else", "x"]
+		      fn = fsep $ texts  ["\\x y", "->", "if", "x", q v_equals, q dc_EQ,
+			   "then", q v_compare, "y", q dc_EQ, "else", "x"]
hunk ./src/DerivingDrift/StandardRules.hs 85
-		    text "compare" <+> fsep [head,
+		    text (u v_compare) <+> fsep [head,
hunk ./src/DerivingDrift/StandardRules.hs 87
-		   else  text "compare" <+> fsep [head,text (cmp n n')]
-    in simpleInstance "Ord" d <+> text "where" $$ block ifn
+		   else  text (u v_compare) <+> fsep [head,text (cmp n n')]
+    in simpleInstance (q class_Ord) d <+> text "where" $$ block ifn
hunk ./src/DerivingDrift/StandardRules.hs 98
-showfn = instanceSkeleton "Show" [(makeShow,empty)]
+showfn = instanceSkeleton (q class_Show) [(makeShow,empty)]
hunk ./src/DerivingDrift/StandardRules.hs 106
-	fnName = text "showsPrec"
+	fnName = text (u v_showsPrec)
hunk ./src/DerivingDrift/StandardRules.hs 108
-	bodyStart = fsep [text "showParen",parens (text "d >= 10")]
+	bodyStart = fsep [text (q v_showParen),parens $ fsep [text "d",text (q v_geq),text "10"]]
hunk ./src/DerivingDrift/StandardRules.hs 113
-	b = map (\x -> fsep[text "showsPrec", text "10", x]) (varNames types)
+	b = map (\x -> fsep[text (q v_showsPrec), text "10", x]) (varNames types)
hunk ./src/DerivingDrift/StandardRules.hs 115
-			            b labels
+			            b (map getIdent labels)
hunk ./src/DerivingDrift/StandardRules.hs 118
-	showChar c = fsep [text "showChar", text ('\'':c:"\'")]
-	showString s = fsep[ text "showString", doubleQuotes $ text s]
-	comp = char '.'
+	showChar c = fsep [text (q v_showChar), text ('\'':c:"\'")]
+	showString s = fsep [text (q v_showString), doubleQuotes $ text s]
+	comp = text (q v_compose)
hunk ./src/DerivingDrift/StandardRules.hs 124
-readfn d = simpleInstance "Read" d <+> text "where" $$ readsPrecFn d
+readfn d = simpleInstance (q class_Read) d <+> text "where" $$ readsPrecFn d
hunk ./src/DerivingDrift/StandardRules.hs 127
-	fnName = text "readsPrec"
-	bodies = vcat $ sepWith (text "++") (map makeRead (body d))
+	fnName = text (u v_readsPrec)
+	bodies = vcat $ sepWith (text $ q v_cat) (map makeRead (body d))
hunk ./src/DerivingDrift/StandardRules.hs 137
-	headfn = fsep [text "readParen", parens (text "d > 9")]
+	headfn = fsep [text (q v_readParen), parens (text $ unwords ["d",q v_gt,"9"])]
hunk ./src/DerivingDrift/StandardRules.hs 165
-	tup x y = parens $ fsep [x, char ',',y]
-	lex = fsep[from,text "lex",ip]
-	readsPrec = fsep [text "readsPrec",text "10"]
+	tup x y = parens $ fsep [text (u dc_Pair), x, y]
+	lex = fsep[from,text (q v_lex),ip]
+	readsPrec = fsep [text (q v_readsPrec),text "10"]
hunk ./src/DerivingDrift/StandardRules.hs 181
-				<+> text (name d)
-	   else simpleInstance "Enum" d <+> text "where"
+				<+> text (getIdent $ name d)
+	   else simpleInstance (q class_Enum) d <+> text "where"
hunk ./src/DerivingDrift/StandardRules.hs 188
-	f (Body{constructor=constructor},n) = text "fromEnum" <+> (fsep $
-		texts [constructor , "=", show n])
+	f (Body{constructor=constructor},x) = text (u v_fromEnum) <+> (fsep $
+		texts [constructor , "=", show x])
hunk ./src/DerivingDrift/StandardRules.hs 194
-	f (Body{constructor=constructor},n) = text "toEnum" <+> (fsep $
-		texts [show n , "=", constructor])
+	f (Body{constructor=constructor},x) = text (u v_toEnum) <+> (fsep $
+		texts [show x , "=", constructor])
hunk ./src/DerivingDrift/StandardRules.hs 200
-	bodydoc = fsep [char 'e', char '=', text "drop",
-		parens (text "fromEnum" <+> char 'e'), conList]
-	in text "enumFrom" <+> bodydoc
+	bodydoc = fsep [char 'e', char '=', text (q v_drop),
+		parens (text (q v_fromEnum) <+> char 'e'), conList]
+	in text (u v_enumFrom) <+> bodydoc
hunk ./src/DerivingDrift/StandardRules.hs 207
-		 "enumFrom", "i", ")"]
-	eq1 = text "enumFromThen\'" <+> fsep (texts ["_","_","[]","=","[]"])
-	eq2 = text "enumFromThen\'" <+> fsep ( texts ["i","j","(x:xs)","=",
-		"let","d","=","fromEnum","j","-","fromEnum","i","in",
-		"x",":","enumFromThen\'","i","j","(","drop","(d-1)","xs",")"])
-	in text "enumFromThen" <+> wrapper $$ block [text "where",eq1,eq2]
+		 q v_enumFrom, "i", ")"]
+	eq1 = text "enumFromThen\'"
+                <+> fsep (texts ["_","_",u dc_EmptyList,"=",u dc_EmptyList])
+	eq2 = text "enumFromThen\'"
+                <+> fsep (texts ["i","j","(x",u dc_Cons,"xs)","="])
+                <+> fsep [hsep $ texts [
+                           "let", "d", "=",
+                                q v_fromEnum,"j",q v_sub,q v_fromEnum,"i"],
+                          text "in" <+> fsep (texts [
+                             "x",u dc_Cons,"enumFromThen\'","i","j","(", q v_drop]
+                                ++ [parens . hsep $ texts ["d",q v_sub,"1"]]
+                                ++ [text "xs",text ")"])]
+	in text (q v_enumFromThen) <+> wrapper $$ block [text "where",eq1,eq2]
hunk ./src/DerivingDrift/StandardRules.hs 229
-			<+> text name
+			<+> (text $ getIdent name)
hunk ./src/DerivingDrift/StandardRules.hs 233
-	in simpleInstance "Bounded" d <+> text "where" $$ block [
-		hsep (texts[ "minBound","=",f]),
-		hsep (texts[ "maxBound","=",l])]
+	in simpleInstance (q class_Bounded) d <+> text "where" $$ block [
+		hsep (texts [u v_minBound,"=",f]),
+		hsep (texts [u v_maxBound,"=",l])]
hunk ./src/DerivingDrift/StandardRules.hs 238
-	in simpleInstance "Bounded" d <+> text "where" $$ block [
-		hsep . texts $ [ "minBound","=",constructor f] ++
-			replicate (length (types f)) "minBound",
-		hsep . texts $ [ "maxBound","=",constructor f] ++
-			replicate (length (types f)) "maxBound"]
+	in simpleInstance (q class_Bounded) d <+> text "where" $$ block [
+		hsep . texts $ [u v_minBound,"=",constructor f] ++
+			replicate (length (types f)) (q v_minBound),
+		hsep . texts $ [u v_maxBound,"=",constructor f] ++
+			replicate (length (types f)) (q v_maxBound)]
hunk ./src/FrontEnd/Rename.hs 23
-import FrontEnd.Desugar (doToExp,listCompToExp)
+import DerivingDrift.Drift
+import FrontEnd.Desugar (desugarHsModule,doToExp,listCompToExp)
hunk ./src/FrontEnd/Rename.hs 29
-import FrontEnd.Utils
hunk ./src/FrontEnd/Rename.hs 103
-runRename :: MonadWarn m => (a -> RM a) -> Opt -> Module -> FieldMap -> [(Name,[Name])] -> a -> m (a,Map.Map Name Name)
+runRename :: MonadWarn m => (a -> RM b) -> Opt -> Module -> FieldMap -> [(Name,[Name])] -> a -> m (b,Map.Map Name Name)
hunk ./src/FrontEnd/Rename.hs 119
-renameModule :: MonadWarn m => Opt -> FieldMap -> [(Name,[Name])] -> HsModule -> m (HsModule, Map.Map Name Name)
-renameModule opt fls ns m = runRename renameDecls opt (hsModuleName m) fls ns m
+renameModule :: MonadWarn m => Opt -> FieldMap -> [(Name,[Name])] -> HsModule -> m ((HsModule,[HsDecl]),Map.Map Name Name)
+renameModule opt fls ns m = runRename go opt (hsModuleName m) fls (ns ++ driftResolvedNames) m
+  where go mod = do
+          let renDesugared = renameDecls . desugarHsModule
+          rmod <- renDesugared mod
+          inst <- hsModuleDecls `fmap` renDesugared mod{hsModuleDecls = driftDerive rmod}
+          return (hsModuleDecls_u (++ inst) rmod,inst)
+
hunk ./src/FrontEnd/Tc/Module.hs 17
-import FrontEnd.Desugar
hunk ./src/FrontEnd/Tc/Module.hs 76
-    -- driftDerive only uses IO to print the derived instances.
-    zmod' <- driftDerive (modInfoHsModule m)
-    let mod = desugarHsModule (zmod')
-    let ((mod',rmap),errs) = runWriter $
-            renameModule (modInfoOptions m) defs (modInfoImport m)  mod
-    when (dump FD.Renamed) $ do
+    let mod = modInfoHsModule m
+    let imp = modInfoImport m
+    let (((mod',inst),rmap),errs) = runWriter $ renameModule (modInfoOptions m) defs imp mod
+    when (dump FD.Derived && (not $ null inst)) $ do
+        putStrLn " \n ---- derived instances ---- \n"
+        putStrLn $ HsPretty.render $ HsPretty.ppHsDecls $ inst
+    wdump FD.Renamed $ do
hunk ./src/FrontEnd/Tc/Module.hs 85
-    return $ (m { modInfoReverseMap = rmap, modInfoHsModule = mod' },errs)
+    return (m { modInfoReverseMap = rmap,
+                modInfoImport = imp ++ driftResolvedNames,
+                modInfoHsModule = mod' }, errs)
hunk ./src/data/names.txt 99
+Pair       Jhc.Prim.Prim.(,)
hunk ./src/data/names.txt 101
+True       Jhc.Prim.Prim.True
+False      Jhc.Prim.Prim.True
+EQ         Jhc.Prim.Prim.EQ
hunk ./src/data/names.txt 144
-and              Jhc.Class.Ord.&&
+and              Jhc.Order.&&
hunk ./src/data/names.txt 146
+foldl            Jhc.Basics.foldl
+drop             Jhc.List.drop
+cat              Jhc.Basics.++
+compose          Jhc.Basics..
hunk ./src/data/names.txt 157
+sub                  Jhc.Class.Num.-
hunk ./src/data/names.txt 160
+compare              Jhc.Class.Ord.compare
hunk ./src/data/names.txt 174
+minBound             Jhc.Enum.minBound
+maxBound             Jhc.Enum.maxBound
+showsPrec            Jhc.Show.showsPrec
+showParen            Jhc.Show.showParen
+showChar             Jhc.Show.showChar
+showString           Jhc.Show.showString
+readsPrec            Jhc.Text.Read.readsPrec
+readParen            Jhc.Text.Read.readParen
+lex                  Jhc.Text.Read.lex
hunk ./utils/op_names.prl 69
-    /^([_A-Za-z0-9]+)\s+(([0-9_A-Za-z.@]+)\.)?([-0-9*!)(#&|><=\/A-Za-z%:_\[\]]+)\s*$/ or die "unrecognized line $_";
+    /^([_A-Za-z0-9]+)\s+(([0-9_A-Za-z.@]+)\.)?([-0-9*!)(#&|><=\/\+\.\,A-Za-z%:_\[\]]+)\s*$/ or die "unrecognized line $_";