[add type annotations to rule free variables
John Meacham <john@repetae.net>**20060302071940] hunk ./E/FromHs.hs 306
-                nn <- newNameFrom (map (:[]) ['a' ..])
+                nn <- newNameFrom (map (:'\'':[]) ['a' ..])
hunk ./FrontEnd/HsParser.ly 307
-> mfreevars :: { [HsName] }
+> mfreevars :: { [(HsName,Maybe HsType)] }
hunk ./FrontEnd/HsParser.ly 311
-> vbinds :: { [HsName] }
->       : vbinds var                  { $2 : $1 }
->       | var                         { [$1] }
+> vbinds :: { [(HsName,Maybe HsType)] }
+>       : vbinds '(' var '::' type ')' { ($3,Just $5) : $1 }
+>       | vbinds var                   { ($2,Nothing) : $1 }
+>       |                              { [] }
hunk ./FrontEnd/HsPretty.hs 256
+ppHsTName (n,Nothing) = ppHsName n
+ppHsTName (n,Just t) = parens (ppHsName n <+> text "::" <+> ppHsType t)
hunk ./FrontEnd/HsPretty.hs 262
-    vars = hsep (map ppHsName $ hsDeclFreeVars prules)
+    vars = hsep (map ppHsTName $ hsDeclFreeVars prules)
hunk ./FrontEnd/HsSyn.hs 175
-	 | HsPragmaRules { hsDeclUniq :: (Module,Int), hsDeclSrcLoc :: SrcLoc, hsDeclString :: String, hsDeclFreeVars :: [HsName], hsDeclLeftExpr :: HsExp, hsDeclRightExpr :: HsExp }
+	 | HsPragmaRules { hsDeclUniq :: (Module,Int), hsDeclSrcLoc :: SrcLoc, hsDeclString :: String, hsDeclFreeVars :: [(HsName,Maybe HsType)], hsDeclLeftExpr :: HsExp, hsDeclRightExpr :: HsExp }
hunk ./FrontEnd/Rename.hs 74
+import Maybe
hunk ./FrontEnd/Rename.hs 415
-    subTable' <- updateSubTableWithHsNames subTable fvs
-    fvs' <- renameHsNames fvs subTable'
+    subTable' <- updateSubTableWithHsNames subTable (fsts fvs)
+    subTable'' <- updateSubTableWithHsTypes subTable (catMaybes $ snds fvs)
+    fvs' <- sequence [ liftM2 (,) (renameAny x subTable') (renameAny y subTable'')| (x,y) <- fvs]
hunk ./FrontEnd/Rename.hs 537
+instance (RenameAny a,RenameAny b) => RenameAny (a,b) where
+    renameAny (a,b) t = liftM2 (,) (renameAny a t) (renameAny b t)
+
+instance RenameAny a => RenameAny (Maybe a) where
+    renameAny Nothing _ = return Nothing
+    renameAny (Just x) t = liftM Just (renameAny x t)
+
hunk ./FrontEnd/Rename.hs 1167
+updateSubTableWithHsTypes :: SubTable -> [HsType] -> ScopeSM (SubTable)
+updateSubTableWithHsTypes subTable hsType = do
+      let hsNames = nub $ concatMap getHsNamesFromHsType hsType
+      subTable' <- clobberHsNames hsNames subTable
+      return (subTable')
hunk ./FrontEnd/TI/Main.hs 440
-        dv n = do
+        dv (n,Nothing) = do
hunk ./FrontEnd/TI/Main.hs 443
+        dv _ = fail "old typechecker can't handle type annotated rules"
hunk ./FrontEnd/Tc/Module.hs 230
+    when (dump FD.Types) $ do
+        putStrLn " ---- the coersions of identifiers ---- "
+        mapM_ putStrLn [ show n ++  " --> " ++ show s |  (n,s) <- Map.toList coercions]
hunk ./FrontEnd/Tc/Monad.hs 405
+        tt <- flattenType tt
hunk ./FrontEnd/Tc/Type.hs 343
-composeCoerce (CTFun a) (CTFun b) = ctFun (a `composeCoerce` b)
+--composeCoerce (CTFun a) (CTFun b) = ctFun (a `composeCoerce` b)
hunk ./FrontEnd/Tc/Type.hs 346
-composeCoerce (CTAbs ts) (CTAbs ts') = CTAbs (ts ++ ts')
-composeCoerce (CTAp ts) (CTAp ts') = CTAp (ts ++ ts')
+--composeCoerce (CTAbs ts) (CTAbs ts') = CTAbs (ts ++ ts')
+--composeCoerce (CTAp ts) (CTAp ts') = CTAp (ts ++ ts')
hunk ./FrontEnd/TypeSyns.hs 5
+import Data.FunctorM
hunk ./FrontEnd/TypeSyns.hs 151
+    fvs' <- sequence [ fmapM (`renameHsType` subTable) t  >>= return . (,) n | (n,t) <- fvs]
hunk ./FrontEnd/TypeSyns.hs 154
-    return prules {  hsDeclLeftExpr = e1', hsDeclRightExpr = e2' }
+    return prules {  hsDeclFreeVars = fvs', hsDeclLeftExpr = e1', hsDeclRightExpr = e2' }