[clear arity information after type analysis and specialization
John Meacham <john@repetae.net>**20060317054850] hunk ./E/Eta.hs 5
+    deleteArity,
hunk ./E/Eta.hs 8
+    etaExpandProgram,
hunk ./E/Eta.hs 26
+import E.Inline
hunk ./E/Eta.hs 38
-    deriving(Eq,Ord,Show,Typeable)
+    deriving(Eq,Ord,Typeable)
+
+instance Show ArityType where
+    showsPrec _ ATop = ("ArT" ++)
+    showsPrec _ ABottom = ("ArB" ++)
+    showsPrec _ (AFun False r) = ('\\':) . shows r
+    showsPrec _ (AFun True r) = ("\\o" ++) . shows r
hunk ./E/Eta.hs 87
+-- delety any arity information
+deleteArity nfo = Info.delete  (undefined :: Arity) $ Info.delete (undefined :: Arity) nfo
hunk ./E/Eta.hs 146
+
+-- this annotates what it can, but only expands top-level definitions
+etaExpandProgram :: MonadStats m => Program -> m Program
+etaExpandProgram prog = programMapRecGroups mempty pass letann pass f prog where
+    pass = \_ -> return
+    letann = (\e nfo -> return $ annotateArity e nfo)
+    f (False,[(t,e)]) = do
+        te <- etaExpandDef' (progDataTable prog) t e
+        return [te]
+    f (True,ts) = do
+        ts' <- mapM z ts
+        g ts' (length ts + 2)
+    g ts 0 = return ts
+    g ts n = do
+        ts' <- annotateDs mempty pass letann pass ts
+        ts'' <- mapM z ts'
+        g ts'' (n - 1)
+    z (t,e) = etaExpandDef' (progDataTable prog) t e
+
+
+
+
+
hunk ./E/Eta.hs 186
-    Nothing -> return (t,e)
+    Nothing -> return (tvrInfo_u (annotateArity e) t,e)
hunk ./E/TypeAnalysis.hs 21
+import E.Eta
hunk ./E/TypeAnalysis.hs 63
-    prog <- annotateProgram mempty lambind (\_ -> return) (\_ -> return) prog
+    prog <- annotateProgram mempty lambind (\_ -> return . deleteArity) (\_ -> return) prog
hunk ./Main.hs 164
-    return ho { hoEs = Map.fromList [ (runIdentity $ fromId (tvrIdent v),d) |  d@(v,_) <- ds ] }
+        Identity ds' = annotateDs mempty (\_ nfo -> return nfo) letann lamann ds
+        Identity ds'' = annotateDs mempty (\_ nfo -> return nfo) letann lamann ds'
+    return ho { hoEs = Map.fromList [ (runIdentity $ fromId (tvrIdent v),d) |  d@(v,_) <- ds'' ] }
hunk ./Main.hs 333
+    prog <- Stats.runStatIO stats (etaExpandProgram prog)
hunk ./Main.hs 447
-    prog <- annotateProgram mempty (\_ nfo -> return $ unsetProperty prop_INSTANCE nfo) (\_ nfo -> return nfo) (\_ nfo -> return nfo) prog
+    prog <- annotateProgram mempty (\_ nfo -> return $ unsetProperty prop_INSTANCE nfo) letann (\_ nfo -> return nfo) prog
hunk ./Main.hs 450
+    st <- Stats.new
+    prog <- Stats.runStatIO st (etaExpandProgram prog)
+    Stats.print "eta" st
+
hunk ./Main.hs 464
-    -- make sure properties and rules are attached everywhere
+    -- make sure properties and are attached everywhere
hunk ./Main.hs 480
-
hunk ./Main.hs 482
+    st <- Stats.new
+    prog <- Stats.runStatIO st (etaExpandProgram prog)
+    Stats.print "eta" st
+
hunk ./Main.hs 489
-
hunk ./Main.hs 491
+    prog <- return $ programSetE lc prog
+
hunk ./Main.hs 495
-    lc <- annotate mempty (\_ nfo -> return $ Info.delete (mempty :: ARules) nfo) (\_ -> return) (\_ -> return) lc
+
+    -- delete rules
+    prog <- return $ runIdentity $ annotateProgram mempty (\_ nfo -> return $ Info.delete (mempty :: ARules) nfo) letann (\_ -> return) prog
+
hunk ./Main.hs 504
-
+    lc <- return $ programE prog
hunk ./Main.hs 775
-    wdump FD.EInfo $ putErrLn (show $ tvrInfo tvr)
+    when (dump FD.EInfo || verbose2) $ putErrLn (show $ tvrInfo tvr)