[annotate rules decls with unique identifier, clean up renamer, quantify free type variables in RULES pragmas, collect RULES info in typechecker.
John Meacham <john@repetae.net>**20060225031314] hunk ./FrontEnd/HsSyn.hs 155
-	 | HsPragmaRules { hsDeclSrcLoc :: SrcLoc, hsDeclString :: String, hsDeclFreeVars :: [HsName], hsDeclLeftExpr :: HsExp, hsDeclRightExpr :: HsExp }
+	 | HsPragmaRules { hsDeclUniq :: (Module,Int), hsDeclSrcLoc :: SrcLoc, hsDeclString :: String, hsDeclFreeVars :: [HsName], hsDeclLeftExpr :: HsExp, hsDeclRightExpr :: HsExp }
hunk ./FrontEnd/Rename.hs 88
+import Util.UniqueMonad
hunk ./FrontEnd/Rename.hs 132
+instance UniqueProducer ScopeSM where
+    newUniq = do
+        u <- gets unique
+        modify (\state -> state {unique = (unique state) + 1})
+        return u
hunk ./FrontEnd/Rename.hs 139
-getUnique :: ScopeSM Int
-getUnique = gets unique
-
hunk ./FrontEnd/Rename.hs 149
-incUnique :: ScopeSM ()
-incUnique = modify (\state -> state {unique = (unique state) + 1})
hunk ./FrontEnd/Rename.hs 420
-    return prules {  hsDeclFreeVars = fvs', hsDeclLeftExpr = e1', hsDeclRightExpr = e2' }
+    m <- getCurrentModule
+    i <- newUniq
+    return prules {  hsDeclUniq = (m,i), hsDeclFreeVars = fvs', hsDeclLeftExpr = e1', hsDeclRightExpr = e2' }
hunk ./FrontEnd/Rename.hs 606
-      unique <- getUnique
-      incUnique
+      unique <- newUniq
hunk ./FrontEnd/Rename.hs 686
-    unique <- getUnique
-    incUnique
+    unique <- newUniq
hunk ./FrontEnd/Rename.hs 692
-    unique <- getUnique
-    incUnique
+    unique <- newUniq
hunk ./FrontEnd/Rename.hs 768
-    unique <- getUnique
-    incUnique
+    unique <- newUniq
hunk ./FrontEnd/Rename.hs 1056
-      unique     <- getUnique
+      unique     <- newUniq
hunk ./FrontEnd/Rename.hs 1060
-      incUnique
hunk ./FrontEnd/Tc/Class.hs 186
-        fail $ "Signature too Weak: " ++ pprint ns
+        fail $ "Signature too Weak: " ++ pprint qs ++ " does not imply " ++ pprint ns
hunk ./FrontEnd/Tc/Main.hs 428
-tcPragmaDecl prule@HsPragmaRules { hsDeclFreeVars = vs, hsDeclLeftExpr = e1, hsDeclRightExpr = e2, hsDeclSrcLoc = sloc } =
+tcPragmaDecl spec@HsPragmaSpecialize { hsDeclSrcLoc = sloc, hsDeclName = n, hsDeclType = t } = do
+    withContext (locMsg sloc "in the SPECIALIZE pragma" $ show n) ans where
+    ans = do
+        kt <- getKindEnv
+        t <- hsTypeToType kt t
+        let nn = toName Val n
+        sc <- lookupName nn
+        sc `subsumes` t
+        addRule RuleSpec { ruleName = nn, ruleType = t, ruleSuper = hsDeclBool spec }
+        return [spec]
+
+
+tcPragmaDecl prule@HsPragmaRules { hsDeclUniq = uniq, hsDeclFreeVars = vs, hsDeclLeftExpr = e1, hsDeclRightExpr = e2, hsDeclSrcLoc = sloc } =
hunk ./FrontEnd/Tc/Main.hs 447
-            localEnv (mconcat envs) $ do
-                    (e1,ps) <- listenPreds (tcExpr e1 tr)
-                    ([],rs) <- splitPreds ch [] ps
-                    (e2,ps) <- listenPreds (tcExpr e2 tr)
-                    ([],rs) <- splitPreds ch [] ps
-                    return ()
+            (rs1,rs2) <- localEnv (mconcat envs) $ do
+                    (e1,ps1) <- listenPreds (tcExpr e1 tr)
+                    (e2,ps2) <- listenPreds (tcExpr e2 tr)
+                    ([],rs1) <- splitPreds ch [] ps1
+                    ([],rs2) <- splitPreds ch [] ps2
+                    return (rs1,rs2)
hunk ./FrontEnd/Tc/Main.hs 454
+            vs <- flattenType vs
+            tr <- flattenType tr
+            let mvs = snub $ concatMap freeMetaVars (tr:vs)
+            nvs <- mapM (newVar . metaKind) mvs
+            sequence_ [ varBind mv (TVar v) | v <- nvs |  mv <- mvs ]
+            (rs1,rs2) <- flattenType (rs1,rs2)
+            ch <- getClassHierarchy
+            rs1 <- return $ simplify ch rs1
+            rs2 <- return $ simplify ch rs2
+            assertEntailment rs1 rs2
hunk ./FrontEnd/Tc/Monad.hs 20
+    addRule,
hunk ./FrontEnd/Tc/Monad.hs 87
+    checkedRules     :: [Rule],
hunk ./FrontEnd/Tc/Monad.hs 157
+addRule :: Rule -> Tc ()
+addRule r = tell mempty { checkedRules = [r] }
+
hunk ./FrontEnd/Tc/Type.hs 2
-    fn,
hunk ./FrontEnd/Tc/Type.hs 3
-    Pred(..),
hunk ./FrontEnd/Tc/Type.hs 4
-    followTaus,
hunk ./FrontEnd/Tc/Type.hs 5
-    readMetaVar,
-    tForAll,
-    module FrontEnd.Tc.Type,
+    Pred(..),
+    Preds(),
hunk ./FrontEnd/Tc/Type.hs 10
-    Preds(),
-    tyvar,
+    Tyvar(..),
+    fn,
+    followTaus,
+    module FrontEnd.Tc.Type,
+    readMetaVar,
+    tForAll,
hunk ./FrontEnd/Tc/Type.hs 17
-    Tyvar(..)
+    tyvar
hunk ./FrontEnd/Tc/Type.hs 26
+import Name.Name
hunk ./FrontEnd/Tc/Type.hs 28
-import Support.CanType
-import Support.FreeVars
hunk ./FrontEnd/Tc/Type.hs 30
-import Type(HasKind(..))
+import Support.CanType
+import Support.FreeVars
hunk ./FrontEnd/Tc/Type.hs 33
+import Type(HasKind(..))
hunk ./FrontEnd/Tc/Type.hs 197
+instance (UnVar a,UnVar b) => UnVar (a,b) where
+    unVar' opt (a,b) = do
+        a <- unVar' opt a
+        b <- unVar' opt b
+        return (a,b)
+
hunk ./FrontEnd/Tc/Type.hs 326
+data Rule = RuleSpec {
+    ruleName :: Name,
+    ruleSuper :: Bool,
+    ruleType :: Type
+    } |
+    RuleUser {
+    ruleUniq :: (Module,Int),
+    ruleFreeTVars :: [(Name,Kind)]
+    }
+