From 05a7fc5fbb6a0a8b853977d054a09b32d2fc238c Mon Sep 17 00:00:00 2001 From: Nathaniel Wesley Filardo Date: Wed, 3 Jul 2013 00:59:28 -0400 Subject: [PATCH] Stop collecting update handlers by functar It seems much more profitable, going forward, to collect most things by rules. If we want to get into fusion later, that's fine, but for the moment... --- src/Dyna/Analysis/RuleMode.hs | 41 +---------------------- src/Dyna/Backend/BackendDefn.hs | 9 +++-- src/Dyna/Backend/Python/Backend.hs | 10 +++--- src/Dyna/Main/Driver.hs | 53 ++++++++++++++++++++++-------- 4 files changed, 50 insertions(+), 63 deletions(-) diff --git a/src/Dyna/Analysis/RuleMode.hs b/src/Dyna/Analysis/RuleMode.hs index 0dffa4d..99de641 100644 --- a/src/Dyna/Analysis/RuleMode.hs +++ b/src/Dyna/Analysis/RuleMode.hs @@ -60,7 +60,6 @@ import Dyna.Term.SurfaceSyntax import Dyna.Main.Exception import Dyna.XXX.DataUtils(argmin,mapInOrCons,mapMinRepView) import Dyna.XXX.MonadContext -import Dyna.XXX.Trifecta (prettySpanLoc) -- import Dyna.XXX.TrifectaTest import Text.PrettyPrint.Free @@ -348,6 +347,7 @@ pp_liveVars :: PartialPlan fbs -> S.Set DVar pp_liveVars p = allCruxVars (pp_cruxes p) -- XXX This certainly belongs elsewhere +renderPartialPlan :: (Actions t -> Doc e) -> PartialPlan t -> Doc e renderPartialPlan rd (PP crs bs c pl) = vcat [ text "cost=" <> pretty c , text "pendingCruxes:" indent 2 (renderCruxes crs) @@ -665,45 +665,6 @@ planBackchain bp bc (f,qm) r = tf = nHide IFree -------------------------------------------------------------------------}}} --- Update plan combination {{{ - -type UpdateEvalMap fbs = M.Map (Maybe DFunctAr) - [(Rule, Int, Cost, DVar, DVar, Actions fbs)] - --- | Return all plans for each functor/arity --- --- XXX This may still belong elsewhere. --- --- XXX This guy wants span information; he's got it now use it. --- --- timv: might want to fuse these into one circuit --- -combineUpdatePlans :: [(Rule,[( Int, - Either a (Cost, DVar, DVar, Actions fbs))])] - -> UpdateEvalMap fbs -combineUpdatePlans = go (M.empty) - where - go m [] = m - go m ((fr,cmca):xs) = go' xs fr cmca m - - go' xs _ [] m = go m xs - go' xs fr ((n,mca):ys) m = - case mca of - Left _ -> dynacUserErr - $ "No update plan for" - <+> maybe "indirection" - (\(f,a) -> pretty f <> char '/' <> pretty a) - fa - <+> "in rule at" - <> line <> indent 2 (prettySpanLoc $ r_span fr) - Right (c,v1,v2,a) -> go' xs fr ys $ mapInOrCons fa (fr,n,c,v1,v2,a) m - where - fa = evalCruxFA ev - ev = maybe (dynacPanic $ "Eval index without eval crux in rule:" - (renderANF fr)) - id - (IM.lookup n (r_ecruxes fr)) ------------------------------------------------------------------------}}} -- Adorned Queries {{{ diff --git a/src/Dyna/Backend/BackendDefn.hs b/src/Dyna/Backend/BackendDefn.hs index 1e82a02..ef87f95 100644 --- a/src/Dyna/Backend/BackendDefn.hs +++ b/src/Dyna/Backend/BackendDefn.hs @@ -11,9 +11,7 @@ import qualified Data.Set as S import Dyna.Analysis.Aggregation (AggMap) import Dyna.Analysis.ANF (Rule) import Dyna.Analysis.DOpAMine (BackendRenderDopIter) -import Dyna.Analysis.RuleMode ( - Actions, BackendPossible, Cost, - UpdateEvalMap {-, QueryEvalMap -}) +import Dyna.Analysis.RuleMode (Actions, BackendPossible, Cost) import Dyna.Term.TTerm (DFunctAr,DVar) import System.IO (Handle) import qualified Text.PrettyPrint.Free as PP @@ -23,8 +21,9 @@ import qualified Text.PrettyPrint.Free as PP -- plans, but that's not really how we should be doing it. The right -- answer, of course, is to use update mode information, once we have it. -type BackendDriver bs = AggMap -- ^ Aggregation - -> UpdateEvalMap bs -- ^ Rule update +type BackendDriver bs = AggMap -- ^ Aggregation + -> [(Rule,[(Int,Maybe DFunctAr -- ^ Rule update + , Cost, DVar, DVar, Actions bs)])] -> [(Rule,Cost,Actions bs)] -- ^ Initializers -> S.Set DFunctAr -- ^ Ground backchains -> [(DFunctAr,Rule,([DVar],(Cost,Actions bs)))] -- ^ GBC plans diff --git a/src/Dyna/Backend/Python/Backend.hs b/src/Dyna/Backend/Python/Backend.hs index dd0be56..e088919 100644 --- a/src/Dyna/Backend/Python/Backend.hs +++ b/src/Dyna/Backend/Python/Backend.hs @@ -417,7 +417,7 @@ printQuery fh bc (f,a) rule vs cost dope = do -- Driver {{{ driver :: BackendDriver PyDopeBS -driver am um is bc qp pr fh = do +driver am ups is bc qp pr fh = do hPutStrLn fh "from __future__ import division" hPutStrLn fh "from stdlib import *" @@ -445,11 +445,11 @@ driver am um is bc qp pr fh = do hPutStrLn fh "" hPutStrLn fh $ "# ==Updates==" - -- plans aggregated by functor/arity - forM_ (M.toList um) $ \(fa, ps) -> do + forM_ ups $ \(r,rps) -> do hPutStrLn fh "" - hPutStrLn fh $ "# " ++ show fa - forM_ ps $ \(r,n,c,vi,vo,act) -> do + hPutStrLn fh $ "# rix=" ++ (show $ r_index r) + forM_ rps $ \(n,fa,c,vi,vo,act) -> do + hPutStrLn fh $ "# " ++ show fa printUpdate fh bc r c n fa (vi,vo) act hPutStrLn fh "" diff --git a/src/Dyna/Main/Driver.hs b/src/Dyna/Main/Driver.hs index 93f028d..c331298 100644 --- a/src/Dyna/Main/Driver.hs +++ b/src/Dyna/Main/Driver.hs @@ -19,6 +19,7 @@ import Control.Exception import qualified Data.ByteString.UTF8 as BU import Data.Either import qualified Data.Map as M +import qualified Data.IntMap as IM import qualified Data.Maybe as MA import qualified Data.Set as S import Data.String @@ -257,9 +258,11 @@ procArgs argv = do renderDop :: BackendRenderDopIter bs e -> Actions bs -> Doc e renderDop ddi dop = vsep $ map (renderDOpAMine ddi) dop -renderDopUpds :: BackendRenderDopIter bs e -> UpdateEvalMap bs -> Doc e -renderDopUpds ddi um = vsep $ flip map (M.toList um) $ \(fa,ps) -> - vsep $ flip map ps $ \(r,n,c,vi,vo,act) -> +renderDopUpds :: BackendRenderDopIter bs e + -> [(Rule,[(Int,Maybe DFunctAr,Cost,DVar,DVar,Actions bs)])] + -> Doc e +renderDopUpds ddi us = vsep $ flip map us $ \(r,ps) -> + vsep $ flip map ps $ \(n,fa,c,vi,vo,act) -> planHeader r fa n c (vi,vo) `above` indent 2 (renderDop ddi act) where planHeader r (fa :: Maybe DFunctAr) n c (vi,vo) = @@ -376,8 +379,6 @@ processFile fileName = bracket openOut hClose go uPlans = map (\x -> (x, planEachEval be_b gbcs be_c x)) fcrules - cuPlans = combineUpdatePlans uPlans - qPlans = map (\(fa@(f,a),r) -> (fa,r, planBackchain be_b gbcs (f,mkqm a) r)) bcrules @@ -391,12 +392,12 @@ processFile fileName = bracket openOut hClose go where check (f,r,Right p) = (f,r,p) check (_,r,Left _) = dynacUserErr $ - "Unable to plan backchaining for rule" - (prettySpanLoc (r_span r)) - <> dot + "Unable to plan backchaining for rule" + (prettySpanLoc (r_span r)) + <> dot in do - -- Do this before forcing cInitializers, cuPlans, etc., + -- Do this before forcing cInitializers, uPlans, etc., -- as those will panic and stop the pipeline. dump DumpFailedPlans $ let rend = renderDop be_ddi @@ -420,8 +421,8 @@ processFile fileName = bracket openOut hClose go -- Force evaluation of a lot of the work of the compiler, -- even if the backend and dump flags won't do it for us. - cInitializers' <- evaluate $ cInitializers - cuPlans' <- evaluate $ cuPlans + cInitializers' <- mapM evaluate cInitializers + uPlans' <- evaluate (forceUpdatePlans uPlans) let noInitErrGbcs = filter (\(r,_) -> maybe True @@ -435,10 +436,10 @@ processFile fileName = bracket openOut hClose go map (prettySpanLoc . r_span . fst) xs) dump DumpDopIni (renderDopInis be_ddi cInitializers') - dump DumpDopUpd (renderDopUpds be_ddi cuPlans') + dump DumpDopUpd (renderDopUpds be_ddi uPlans') -- Invoke the backend code generator - be_d aggm cuPlans' cInitializers' gbcs cqPlans pp out + be_d aggm uPlans' cInitializers' gbcs cqPlans pp out parse aggs = do pr <- T.parseFromFileEx (P.oneshotDynaParser aggs <* T.eof) fileName @@ -446,6 +447,32 @@ processFile fileName = bracket openOut hClose go TR.Failure td -> dynacParseErr $ PPA.align td TR.Success rs -> return rs + forceUpdatePlans :: [(Rule,[(Int, + Either a (Cost, DVar, DVar, Actions fbs))])] + -> [(Rule,[(Int, + Maybe DFunctAr, Cost, DVar, DVar, Actions fbs)])] + + forceUpdatePlans = map goRule + where + goRule (r,l) = let mps = map (goEvalix r) l in mps `seq` (r,mps) + + goEvalix r (i,efp) = fa `seq` c `seq` (i,fa,c,ii,iv,p) + where + (c,ii,iv,p) = case efp of + Left _ -> dynacUserErr + $ "No update plan for" + <+> maybe "indirection" + (\(f,a) -> pretty f <> char '/' <> pretty a) + fa + <+> "in rule at" + <> line <> indent 2 (prettySpanLoc $ r_span r) + Right x -> x + + fa = evalCruxFA ev + ev = maybe (dynacPanic $ "Eval index without eval crux in rule:" + (renderANF r)) + id + (IM.lookup i (r_ecruxes r)) ------------------------------------------------------------------------}}} -- Main {{{ -- 2.50.1