[have E.ToHs insert unsafeCoerce#s at appropriate points for polymorphic functions to type properly
John Meacham <john@repetae.net>**20061113011446] hunk ./E/ToHs.hs 11
+import C.Prims
+import DataConstructors
hunk ./E/ToHs.hs 15
-import DataConstructors
-import C.Prims
-import E.Subst
hunk ./E/ToHs.hs 16
+import E.Subst
+import E.Traverse
hunk ./E/ToHs.hs 19
-import Support.CanType
+import Name.Id
hunk ./E/ToHs.hs 27
+import Support.CanType
hunk ./E/ToHs.hs 29
+import Util.SetLike
hunk ./E/ToHs.hs 103
-data Environment = Env { envParen :: Bool, envType :: Bool }
-emptyEnvironment = Env { envParen = False, envType = False }
+data Environment = Env {
+    envParen  :: Bool,
+    envType   :: Bool,
+    envCoerce :: IdSet
+    }
+
+emptyEnvironment = Env {
+    envParen  = False,
+    envType   = False,
+    envCoerce = mempty
+    }
hunk ./E/ToHs.hs 162
+transType e | typeLike e = return $ text "Type"
hunk ./E/ToHs.hs 173
-transType (ESort EStar) = return $ text "Type"
hunk ./E/ToHs.hs 175
+typeLike (ESort EStar) = True
+typeLike (EPi TVr { tvrType = a } b) = typeLike a && typeLike b
+typeLike _ = False
+
hunk ./E/ToHs.hs 192
-transE (EVar tvr) = transTVr tvr
+transE (EVar tvr) = do
+    env <- asks envCoerce
+    t <- transTVr tvr
+    case tvrIdent tvr `member` env of
+        False -> return t
+        True -> mparen $ return $ text "unsafeCoerce#" <+> t
hunk ./E/ToHs.hs 202
---transE ELetRec { eDefs = [(t,d)], eBody = e } | (d,bs) <- fromLam d = mparen $ noParens $ do
---    t <- transTVr t
---    bs <- mapM transTVr bs
---    d <- transE d
---    e <- transE e
---    return (text "let {" <+> hsep (t:bs) <+> text "=" <+> d <+> text " } in" <+> e)
hunk ./E/ToHs.hs 203
+    local (\e -> e { envCoerce = envCoerce e `mappend` fromList [ tvrIdent t | (t,_) <- ds, hasBoxes (tvrType t)] }) $ do
hunk ./E/ToHs.hs 261
-op2Table (op,rt) = lookup rt table >>= lookup op where
-    table = [ ("int",intTable)]
+hasBoxes e = or $ execWriter (f e) where
+    f e | e == tBox = tell [True] >> return e
+    f e = emapEGH f f f e
+
+op2Table (op,rt) = lookup (showCType rt) table >>= lookup op where
+    table = [ ("Int#",intTable)]
hunk ./test/Primes.hs 23
-	[arg] <- getArgs
-	print $ primes !! (read arg)
+	--[arg] <- getArgs
+	print $ primes !! 2000 -- (read arg)