[rename free variables in rules pragrams to be unique. properly collect all free type variables that should be unified against
John Meacham <john@repetae.net>**20060210012432] hunk ./E/FromHs.hs 18
+import Data.Monoid
hunk ./E/FromHs.hs 49
+import FrontEnd.Rename(unRename)
hunk ./E/FromHs.hs 247
+instance GenName String where
+   genNames i = map (('x':) . show) [i..]
+
hunk ./E/FromHs.hs 256
-        cs <- mapM ce [ HsVar v | v <- hsDeclFreeVars pr ]
-        return [(hsDeclString pr,[ v | ~(EVar v) <- cs],e1,e2)]
+        (ts,cs) <- runNameMT $ do
+            ts <- flip mapM (filter (sortStarLike . getType) $ freeVars e1) $ \tvr -> do
+                --return (tvrIdent tvr,tvr)
+                nn <- newNameFrom (map (:[]) ['a' ..])
+                return (tvrIdent tvr,tvr { tvrIdent = toId (toName TypeVal nn) })
+            cs <- flip mapM [toTVr assumps (toName Val v) | v <- hsDeclFreeVars pr ] $ \tvr -> do
+                let ur = show $ unRename $ nameName (toUnqualified $ runIdentity $ fromId (tvrIdent tvr))
+                nn <- newNameFrom (ur:map (\v -> ur ++ show v) [1 ::Int ..])
+                return (tvrIdent tvr,tvr { tvrIdent = toId (toName Val nn) })
+            return (ts,cs)
+        let smt = substMap $ Map.fromList [ (x,EVar y)| (x,y) <- ts ]
+            sma = substMap $ Map.fromList [ (x,EVar y)| (x,y) <- cs' ]
+            cs' =  [ (x,(tvrType_u smt y))| (x,y) <- cs ]
+        return [(hsDeclString pr,( snds (cs' ++ ts) ),smt $ sma e1,smt $ sma e2)]
hunk ./Main.hs 186
-        putStrLn n
-        print vs
-        printCheckName' fullDataTable tvr e1
-        printCheckName' fullDataTable tvr e2
+        let p v = parens $ pprint v <> text "::" <> pprint (getType v)
+        putStrLn $ render $  (tshow n) <+> text "forall" <+> hsep (map p vs) <+> text "." <> text "\n"
+        let ty = case inferType dataTable [] e1 of
+                Left err -> vcat $ map text (intersperse "---" $ tail err)
+                Right ty -> pprint ty
+        let ty2 = case inferType dataTable [] e2 of
+                Left err -> vcat $ map text (intersperse "---" $ tail err)
+                Right ty -> pprint ty
+        putStrLn (render $ indent 2 (pprint e1))
+        putStrLn $ text " ====>"
+        putStrLn (render $ indent 2 (pprint e2))
+        putStrLn (render $ indent 2 (text "::" <+> ty))
+        putStrLn (render $ indent 2 (text "::" <+> ty2))