[all sorts of new stuff dealing with combinator conversion
John Meacham <john@repetae.net>**20080229095315] hunk ./E/FromHs.hs 158
-getMainFunction :: Monad m => DataTable -> Name -> (Map.Map Name (TVr,E)) -> m (Name,TVr,E)
+getMainFunction :: Monad m => DataTable -> Name -> (Map.Map Name (TVr,E)) -> m (TVr,E)
hunk ./E/FromHs.hs 166
-nameToEntryPoint :: Monad m => DataTable -> TVr -> Name -> Maybe FfiExport -> FuncNames E -> m (Name,TVr,E)
+nameToEntryPoint :: Monad m => DataTable -> TVr -> Name -> Maybe FfiExport -> FuncNames E -> m (TVr,E)
hunk ./E/FromHs.hs 184
-        return (cname, tvrInfo_u (case ffi of Just ffi -> Info.insert ffi; Nothing -> id) $ setProperty prop_EXPORTED theMainTvr,ne)
+        return (tvrInfo_u (case ffi of Just ffi -> Info.insert ffi; Nothing -> id) $ setProperty prop_EXPORTED theMainTvr,ne)
hunk ./E/TypeAnalysis.hs 359
-        isBodyRule Rule { ruleBody = e } | (EVar vv,_) <- fromAp e, getProperty prop_INSTANCE vv = True
+        isBodyRule Rule { ruleType = RuleSpecialization } = True
hunk ./Main.hs 2
-module Main(main,compileModEnv') where
+module Main(main) where
hunk ./Main.hs 12
-import qualified List(group)
+import qualified List(group,union)
hunk ./Main.hs 134
-    compileModEnv' =<< parseFiles fs processInitialHo processDecls
+    compileModEnv =<< parseFiles fs processInitialHo processDecls
hunk ./Main.hs 142
-barendregtProg prog = transformProgram transBarendregt prog
+--barendregtProg prog = transformProgram transBarendregt prog
+barendregtProg prog = return prog
hunk ./Main.hs 175
-    let finalVarMap = mappend (fromList [(tvrIdent tvr,Just $ EVar tvr) | tvr <- newTVrs ]) (choVarMap accumho)
+    let Rules rm = hoRules $ hoBuild aho
hunk ./Main.hs 177
-    let choCombinators = fromList [ (combIdent c,c) | c <- runIdentity $ annotateCombs (choVarMap accumho) (\_ -> return) letann lamann combs]
-        combs = [ (emptyComb { combHead = t, combBody = e }) | (t,e) <- hoEs (hoBuild aho) ]
-        (mod:_) = Map.keys $ hoExports $ hoExp aho
+        (_,orphans) = mpartitionWithKey (\k _ -> k `elem` map tvrIdent newTVrs) rm
+
+    let fakeEntry = emptyComb { combRules = concat $ melems orphans }
+        combs =  fakeEntry:[ (emptyComb { combHead = t, combBody = e, combRules = mfindWithDefault [] (tvrIdent t) rm }) | (t,e) <- hoEs (hoBuild aho) ]
+
+    -- extract new combinators and processed rules
+    let choCombinators' = fromList [ (combIdent c,c) | c <- runIdentity $ annotateCombs (choVarMap accumho) (\_ -> return) letann lamann combs]
+        nrules = combRules $ mfindWithDefault emptyComb emptyId choCombinators'
+        reRule :: Comb -> Comb
+        reRule comb = combRules_u f comb where
+            f rs = List.union  rs [ x | x <- nrules, ruleHead x == combHead comb]
hunk ./Main.hs 189
+    let finalVarMap = mappend (fromList [(tvrIdent tvr,Just $ EVar tvr) | tvr <- map combHead $ melems choCombs ]) (choVarMap accumho)
+        choCombs = mfilterWithKey (\k _ -> k /= emptyId) choCombinators'
+        (mod:_) = Map.keys $ hoExports $ hoExp aho
hunk ./Main.hs 194
-        choExternalNames = fromList . map tvrIdent $ newTVrs,
-        choCombinators = choCombinators,
-        --choHoMap = Map.singleton (show mod) $ hoBuild_u (hoEs_s ds') aho
-        choHoMap = Map.singleton (show mod) aho
-        } `mappend` accumho
+        choExternalNames = choExternalNames accumho `mappend` (fromList . map tvrIdent $ newTVrs),
+        choCombinators = choCombs `mappend` fmap reRule (choCombinators accumho),
+        choHoMap = Map.singleton (show mod) aho `mappend` choHoMap accumho
+        }
hunk ./Main.hs 370
-        mprog <- return $ etaAnnotateProgram mprog
+        mprog <- evaluate $ etaAnnotateProgram mprog
hunk ./Main.hs 495
-programPruneUnreachable prog = programSetDs ds' prog where
-    ds' = reachable (newGraph (programDs prog) (tvrIdent . fst) (\ (t,e) -> idSetToList $ bindingFreeVars t e)) (map tvrIdent $ progEntryPoints prog)
+programPruneUnreachable prog = progCombinators_s ds' prog where
+    ds' = reachable (newGraph (progCombinators prog) combIdent freeVars) (map tvrIdent $ progEntryPoints prog)
hunk ./Main.hs 526
-compileModEnv' cho = do
+compileModEnv cho = do
hunk ./Main.hs 530
-        rules = choRules cho
hunk ./Main.hs 535
+        rules' = Rules $ fromList [ (combIdent x,combRules x) | x <- melems (choCombinators cho), not $ null (combRules x) ]
+    --forM_  (melems $ choCombinators cho) $ \comb -> do
+    --    unless (null $ combRules comb) $ print (combHead comb,combRules comb)
hunk ./Main.hs 547
-    wdump FD.Rules $ putStrLn "  ---- user rules ---- " >> printRules RuleUser rules
-    wdump FD.Rules $ putStrLn "  ---- user catalysts ---- " >> printRules RuleCatalyst rules
-    wdump FD.RulesSpec $ putStrLn "  ---- specializations ---- " >> printRules RuleSpecialization rules
+    wdump FD.Rules $ putStrLn "  ---- user rules ---- " >> printRules RuleUser rules'
+    wdump FD.Rules $ putStrLn "  ---- user catalysts ---- " >> printRules RuleCatalyst rules'
+    wdump FD.RulesSpec $ putStrLn "  ---- specializations ---- " >> printRules RuleSpecialization rules'
hunk ./Main.hs 562
-    (_,main,mainv) <- getMainFunction dataTable mainFunc esmap
+    (main,mainv) <- getMainFunction dataTable mainFunc esmap
hunk ./Main.hs 568
-                          progCombinators = emptyComb { combHead = main, combBody = mainv }:map (combHead_u (unsetProperty prop_EXPORTED)) (progCombinators prog)
+                          progCombinators = emptyComb { combHead = main, combBody = mainv }:map (unsetProperty prop_EXPORTED) (progCombinators prog)
hunk ./Main.hs 592
-        let es' = concatMap expandPlaceholder (programDs prog)
-        es' <- return [ (y,floatInward z) |  (y,z) <- es' ]
+        let es' = concatMap expandPlaceholder (progCombinators prog)
+        es' <- return [ combBody_u floatInward e |  e <- es' ]
hunk ./Main.hs 595
-            sequence_ [ printCheckName' dataTable y z |  (y,z) <- es']
+            sequence_ [ printCheckName' dataTable (combHead x) (combBody x) |  x <- es']
hunk ./Main.hs 598
-    prog <- evaluate $ programSetDs ([ (t,e) | (t,e) <- programDs prog, t `notElem` fsts cmethods] ++ cmethods) prog
+    prog <- evaluate $ progCombinators_s ([ p | p <- progCombinators prog, combHead p `notElem` map combHead cmethods] ++ cmethods) prog