[find loopbreakers for recursive newtypes and insert explicit coercions for them
John Meacham <john@repetae.net>**20061012011810] hunk ./DataConstructors.hs 43
-import Info.Types
+import FrontEnd.Syn.Traverse
hunk ./DataConstructors.hs 46
+import Info.Types
hunk ./DataConstructors.hs 394
-    f decl@HsNewTypeDecl {  hsDeclCon = c } = dt decl True  [c]
-    f decl@HsDataDecl {  hsDeclCons = cs } = dt decl False  cs
+    newtypeLoopBreakers = map fst $ fst $  G.findLoopBreakers (const 0) (const True) (G.newGraph newtypeDeps fst snd) where
+        newtypeDeps = [ (n,concatMap (fm . hsBangType) $ hsConDeclArgs c) | HsNewTypeDecl { hsDeclName = n, hsDeclCon = c } <- ds  ]
+        fm t = execWriter $ f t
+        f HsTyCon { hsTypeName = n } = tell [n]
+        f t = traverseHsType_ f t
+    f decl@HsNewTypeDecl {  hsDeclName = nn, hsDeclCon = c } = dt decl (if nn `elem` newtypeLoopBreakers then RecursiveAlias else ErasedAlias)  [c]
+    f decl@HsDataDecl {  hsDeclCons = cs } = dt decl NotAlias  cs
hunk ./DataConstructors.hs 402
-    dt decl False cs@(_:_:_) | all null (map hsConDeclArgs cs) = do
-        let virtualCons'@(fc:_) = map (makeData False typeInfo) cs
+    dt decl NotAlias cs@(_:_:_) | all null (map hsConDeclArgs cs) = do
+        let virtualCons'@(fc:_) = map (makeData NotAlias typeInfo) cs
hunk ./DataConstructors.hs 429
-            conAlias = if alias then ErasedAlias else NotAlias,
+            conAlias = alias,
hunk ./DataConstructors.hs 484
+    | RecursiveAlias <- conAlias mc = let var' = var { tvrType = st } in ELam var' (prim_unsafeCoerce (EVar var') typ)
hunk ./DataConstructors.hs 486
+    ~[st] = slotTypes dataTable n typ
hunk ./E/FromHs.hs 800
+        Identity Constructor { conAlias = alias } = getConstructor n dataTable
+    f ECase { eCaseScrutinee = e, eCaseAlts =  ((Alt (LitCons n [v] t) z):_) } | alias == RecursiveAlias = eLet v (prim_unsafeCoerce (f e) (getType v)) (f z) where