From: Nathaniel Wesley Filardo Date: Wed, 9 Jan 2013 19:55:04 +0000 (-0500) Subject: Refactor planner; initial work towards backward chaining X-Git-Url: https://hydra-www.ietfng.org/gitweb/?a=commitdiff_plain;h=b78bb1547b869fd812fb158da91c884eaeb294c6;p=dyna2 Refactor planner; initial work towards backward chaining --- diff --git a/Makefile b/Makefile index 164707e..9b6d20b 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ # -*- indent-tabs-mode:t; -*- -all: deps +all: build upstream: git submodule init @@ -41,6 +41,8 @@ run-parser: .PHONY: clean veryclean clean: - rm -rf examples/*.dyna.plan examples/*.dyna.d + rm -rf examples/*.dyna.plan \ + examples/*.dyna.*.out \ + examples/*.dyna.d veryclean: clean rm -rf dist diff --git a/src/Dyna/Analysis/ANF.hs b/src/Dyna/Analysis/ANF.hs index 754368b..3516db0 100644 --- a/src/Dyna/Analysis/ANF.hs +++ b/src/Dyna/Analysis/ANF.hs @@ -16,14 +16,16 @@ -- unless explicitly evaluated, or 3) prefer to be evaluated unless -- explicitly quoted. -- --- In short, explicit marks are always obeyed; absent one, the functor's --- self disposition is obeyed; if the functor has no preference, the outer --- functor's argument disposition is used as a last resort. There is, --- however, one important caveat: /variables/ and /primitive terms/ (e.g. --- numerics, strings, literal dynabases, foreign terms, ...) have self --- dispositions of preferring structural interpretation. Variables may be --- meaningfully explicitly evaluated, with the effect of evaluating their --- bindings. Attempting to evaluate a primitive is an error. +-- In short, explicit marks ('ECExplicit') are always obeyed; absent one, +-- ('ECFunctor') the functor's self disposition ('SDQuote' or 'SDEval') is +-- obeyed; if the functor has no preference ('SDInherit'), the outer +-- functor's argument disposition is used as a last resort ('ADQuote' or +-- 'ADEval'). There is, however, one important caveat: /variables/ and +-- /primitive terms/ (e.g. numerics, strings, literal dynabases, foreign +-- terms, ...) have self dispositions of preferring structural +-- interpretation. Variables may be meaningfully explicitly evaluated, with +-- the effect of evaluating their bindings. Attempting to evaluate a +-- primitive is an error. -- -- Note that in rules, the head is by default not evaluated (regardless of -- the disposition of their outer functor), while the body is interpreted as @@ -47,9 +49,6 @@ -- FIXME: "str" is the same a constant str. --- TODO: ANF Normalizer should return *flat terms* so that we have type-safety --- can a lint checker can verify we have exhaustive pattern matching... etc. - -- timv: should there ever be more than one side condition? shouldn't it be -- a single result variable after normalization? I see that if I use comma -- to combine my conditions I get mutliple variables but should side @@ -195,6 +194,7 @@ dynaFunctorArgDispositions x = case x of ("and", 2) -> [ADEval, ADEval] ("or", 2) -> [ADEval, ADEval] ("not", 1) -> [ADEval] + ("=",2) -> [ADQuote,ADQuote] (name, arity) -> -- If it starts with a nonalpha, it prefers to evaluate arguments let d = if C.isAlphaNum $ head $ BU.toString name @@ -263,6 +263,14 @@ normTerm_ c ss (P.TString s) = do _ -> return () return $ NTString s +-- Annotations +-- +-- XXX this is probably the wrong thing to do +normTerm_ c ss (P.TAnnot a (t T.:~ st)) = do + v <- normTerm_ c (st:ss) t >>= newAssignNT "_a" + newAnnot v a + return (NTVar v) + -- Quote makes the context explicitly a quoting one normTerm_ _ ss (P.TFunctor "&" [t T.:~ st]) = do normTerm_ (ECExplicit,ADQuote) (st:ss) t @@ -295,14 +303,6 @@ normTerm_ c ss (P.TFunctor "is" [x T.:~ sx, v T.:~ sv]) = do _ -> do NTVar `fmap` newAssign "_u" (Right ("is",[nx,nv])) --- Annotations --- --- XXX this is probably the wrong thing to do -normTerm_ c ss (P.TAnnot a (t T.:~ st)) = do - v <- normTerm_ c (st:ss) t >>= newAssignNT "_a" - newAnnot v a - return (NTVar v) - -- Functors have both top-down and bottom-up dispositions on -- their handling. normTerm_ c ss (P.TFunctor f as) = do @@ -348,7 +348,7 @@ normTerm c (t T.:~ s) = normTerm_ (ECFunctor,if c then ADEval else ADQuote) -- Normalize a Rule {{{ data Rule = Rule { r_index :: Int - , r_functor :: DVar + , r_head :: DVar , r_aggregator :: DAgg , r_side :: [DVar] , r_result :: DVar @@ -371,7 +371,7 @@ normRule (P.Rule i h a es r T.:~ span) = uncurry ($) $ runNormalize $ do -- | Run the normalization routine. -- --- Use as @runNormalize nRule +-- Use as @runNormalize nRule@ runNormalize :: ReaderT ANFDict (State ANFState) a -> (a, ANFState) runNormalize = flip runState (AS 0 M.empty M.empty [] M.empty []) . diff --git a/src/Dyna/Analysis/Base.hs b/src/Dyna/Analysis/Base.hs index 609927c..3e89479 100644 --- a/src/Dyna/Analysis/Base.hs +++ b/src/Dyna/Analysis/Base.hs @@ -4,18 +4,18 @@ -- Much of this is pending rework once we get to the mode system of Mercury. module Dyna.Analysis.Base ( - -- * Normalized Term Representations - NT(..), FDT, NTV, ENF, EVF, + -- * Normalized Term Representations + NT(..), FDT, NTV, ENF, EVF, - -- * Modes - Mode(..), Moded(..), modeOf, isBound, isFree, + -- * Modes + Mode(..), Moded(..), modeOf, isBound, isFree, ModedVar, varOfMV, ModedNT, evnOfMNT, ntvOfMNT, - -- * DOpAMine + -- * DOpAMine DOpAMine(..), - -- * Determinism - Det(..), detOfDop, + -- * Determinism + Det(..), detOfDop, ) where import qualified Data.ByteString as B @@ -28,7 +28,8 @@ import qualified Text.PrettyPrint.Free as PP -- | A Normalized Term, parametric in the variable case -- -- The Ord instance is solely for Data.Set's use -data NT v = NTNumeric (Either Integer Double) +data NT v = NTBool Bool + | NTNumeric (Either Integer Double) | NTString B.ByteString | NTVar v deriving (Eq,Ord,Show) @@ -111,12 +112,23 @@ data DOpAMine fbs -- live and learn. | OPCkne DVar DVar -- ++ + -- | Check that the input dvar is an interned representation + -- of the given functor (and arity as computed from the list + -- length) and if so, unpack its arguments into those dvars. | OPPeel [DVar] DVar DFunct -- -+ + + -- | The reverse of OPPeel | OPWrap DVar [DVar] DFunct -- -+ + -- | Perform a query | OPIter (ModedVar) [ModedVar] DFunct -- ?? Det (Maybe fbs) + + -- | Perform an arbitrary evaluation query. Semantically, + -- + -- @OPWrap x ys f ; OPIndr z x@ is indistinguishable from + -- @OPIter (MF z) (map MB ys) f DetSemi Nothing@. | OPIndr DVar DVar -- -+ deriving (Eq,Ord,Show) diff --git a/src/Dyna/Analysis/RuleMode.hs b/src/Dyna/Analysis/RuleMode.hs index 9c0a894..21da04b 100644 --- a/src/Dyna/Analysis/RuleMode.hs +++ b/src/Dyna/Analysis/RuleMode.hs @@ -6,19 +6,27 @@ -- XXX Gotta start somewhere. -- Header material {{{ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} module Dyna.Analysis.RuleMode ( Mode(..), Moded(..), ModedNT, isBound, isFree, Crux(..), - Action, Cost, Det(..), planInitializer, - BackendPossible, planEachEval, + Action, Cost, Det(..), + BackendPossible, + + planInitializer, planEachEval, planGroundBackchain, - EvalMap, combinePlans, + UpdateEvalMap, combineUpdatePlans, + + QueryEvalMap, combineQueryPlans, adornedQueries ) where @@ -42,7 +50,7 @@ import Dyna.XXX.TrifectaTest import Text.PrettyPrint.Free ------------------------------------------------------------------------}}} --- Modes {{{ +-- Bindings {{{ -- | What things have thus far been bound under the plan? type BindChart = S.Set DVar @@ -63,44 +71,47 @@ modedNT _ (NTNumeric x) = NTNumeric x ------------------------------------------------------------------------}}} -- Cruxes {{{ -data Crux v n = CFCall v [v] DFunct - | CFStruct v [v] DFunct - | CFUnif v v - | CFAssign v n - | CFEval v v +data EvalCrux v = CFCall v [v] DFunct + | CFEval v v + deriving (Eq,Ord,Show) + +data UnifCrux v n = CFStruct v [v] DFunct + | CFAssign v n deriving (Eq,Ord,Show) +type Crux v n = Either (EvalCrux v) (UnifCrux v n) + +cruxIsEval (Left _) = True +cruxIsEval (Right _) = False + cruxMode :: BindChart -> Crux DVar NTV -> Crux (ModedVar) (ModedNT) -cruxMode c cr = case cr of - CFCall o is f -> CFCall (mv o) (map mv is) f - CFStruct o is f -> CFStruct (mv o) (map mv is) f - CFAssign o i -> CFAssign (mv o) (modedNT c i) - CFEval o i -> CFEval (mv o) (mv i) - CFUnif o i -> CFUnif (mv o) (mv i) +cruxMode c cr = either (Left . evalMode) (Right . unifMode) cr where + evalMode ec = case ec of + CFCall o is f -> CFCall (mv o) (map mv is) f + CFEval o i -> CFEval (mv o) (mv i) + unifMode uc = case uc of + CFStruct o is f -> CFStruct (mv o) (map mv is) f + CFAssign o i -> CFAssign (mv o) (modedNT c i) mv = modedVar c cruxVars :: Crux DVar NTV -> S.Set DVar -cruxVars cr = case cr of - CFCall o is _ -> S.fromList (o:is) - CFStruct o is _ -> S.fromList (o:is) - CFAssign o (NTVar i) -> S.fromList [o,i] - CFAssign o _ -> S.singleton o - CFEval o i -> S.fromList [o,i] - CFUnif o i -> S.fromList [o,i] - -cruxIsEval :: Crux a b -> Bool -cruxIsEval (CFEval _ _) = True -cruxIsEval (CFCall _ _ _) = True -cruxIsEval _ = False +cruxVars = either evalVars unifVars + where + evalVars cr = case cr of + CFCall o is _ -> S.fromList (o:is) + CFEval o i -> S.fromList [o,i] + unifVars cr = case cr of + CFStruct o is _ -> S.fromList (o:is) + CFAssign o (NTVar i) -> S.fromList [o,i] + CFAssign o _ -> S.singleton o ------------------------------------------------------------------------}}} -- Actions {{{ type Action fbs = [DOpAMine fbs] --- XXX Is this really the right type? Maybe we'd rather that this be a --- function rather than a map? +-- XXX Is this really the right type? -- -- Note that there's a big wad of complexity here: we want to announce, for -- example, that predicates may support generation (full-minus moding) but @@ -110,9 +121,10 @@ type Action fbs = [DOpAMine fbs] -- run +/2 and then check the output, for example). Right now, the backend -- is responsible for dealing with the check insertions. That might be -- wrong. -type BackendPossible fbs = (DFunct,[Mode],Mode) -> Either Bool (Det,fbs) +type BackendPossible fbs = (DFunct,[ModedVar],ModedVar) + -> Either Bool (Action fbs) -type Possible fbs = Crux (ModedVar) (ModedNT) -> [Action fbs] +type Possible fbs = (Crux (ModedVar) (ModedNT)) -> Maybe (Action fbs) {- mapMaybeModeCompat mis mo = @@ -126,31 +138,31 @@ mapMaybeModeCompat mis mo = possible :: BackendPossible fbs -> Possible fbs possible fp cr = case cr of -- XXX Indirect evaluation is not yet supported - CFEval _ _ -> [] + Left (CFEval _ _) -> dynacSorry "Indir eval" -- Assign or check - CFAssign o i -> let ni = ntvOfMNT i in - case (evnOfMNT i, o) of - (Left _, MF _) -> [] - (Right _, MB o') -> let chk = "_chk" in - [[ OPAsgn chk ni - , OPCheq chk o']] - (Left i', MB o') -> [[OPAsgn i' (NTVar o')]] - (Right _, MF o') -> [[OPAsgn o' ni]] + Right (CFAssign o i) -> + let ni = ntvOfMNT i in + case (evnOfMNT i, o) of + (Left _, MF _) -> Nothing + (Right _, MB o') -> let chk = "_chk" in + Just [ OPAsgn chk ni + , OPCheq chk o'] + (Left i', MB o') -> Just [OPAsgn i' (NTVar o')] + (Right _, MF o') -> Just [OPAsgn o' ni] -- Structure building - CFStruct o is funct -> + Right (CFStruct o is funct) -> case o of -- If the output is free, the only supported case is when all -- inputs are known. MF o' -> if all isBound is - then [[OPWrap o' (map varOfMV is) funct]] - else [] + then Just [OPWrap o' (map varOfMV is) funct] + else Nothing -- On the other hand, if the output is known, then any subset -- of the inputs may be known and will be checked. - MB o' -> [ (OPPeel is' o' funct) - : map (\(c,x) -> (OPCheq c x)) cis - ] + MB o' -> Just $ (OPPeel is' o' funct) + : map (\(c,x) -> (OPCheq c x)) cis where mkChks _ (MF i) = (i, Nothing) mkChks n (MB v) = let chk = BC.pack $ "_chk_" ++ (show n) @@ -159,53 +171,28 @@ possible fp cr = case cr of (is',mcis) = unzip $ zipWith mkChks [0::Int ..] is cis = MA.catMaybes mcis - -- Unification - CFUnif (MF _) (MF _) -> [] - CFUnif (MB x) (MB y) -> [[OPCheq x y]] - CFUnif (MB x) (MF y) -> [[OPAsgn y (NTVar x)]] - CFUnif (MF y) (MB x) -> [[OPAsgn y (NTVar x)]] - - CFCall o is funct -> case fp (funct,map modeOf is, modeOf o) of - Left False -> [[OPIter o is funct DetNon Nothing ]] - Left True -> [] - Right (d,f) -> [[OPIter o is funct d (Just f)]] - - where -{- - -- XXX this really ought to be done some other way - inv :: DFunct -> [ModedVar] -> ModedVar -> [Action] - inv "+" [(MB x), (MF y)] (MB o) - = [[ OPCall y [o,x] "-" ]] - - inv "+" [(MF x), (MB y)] (MB o) - = [[ OPCall x [o,y] "-" ]] - - inv "-" [(MB x),(MF y)] (MB o) - = [[ OPCall y [x,o] "-" ]] - - inv "-" [(MF x),(MB y)] (MB o) - = [[ OPCall x [o,y] "+" ]] - - inv _ _ _ = [] --} + Left (CFCall o is funct) -> + case fp (funct,is,o) of + Left False -> Just [OPIter o is funct DetNon Nothing ] + Left True -> Nothing + Right a -> Just a ------------------------------------------------------------------------}}} -- ANF to Cruxes {{{ -eval_cruxes :: ANFState -> [Crux DVar NTV] +eval_cruxes :: ANFState -> [EvalCrux DVar] eval_cruxes = M.foldrWithKey (\o i -> (crux o i :)) [] . as_evals where - crux :: DVar -> EVF -> Crux DVar NTV + crux :: DVar -> EVF -> EvalCrux DVar crux o (Left v) = CFEval o v crux o (Right (f,as)) = CFCall o as f - -- XXX Missing cases -unif_cruxes :: ANFState -> [Crux DVar NTV] +unif_cruxes :: ANFState -> [UnifCrux DVar NTV] unif_cruxes (AS { as_assgn = assigns, as_unifs = unifs }) = M.foldrWithKey (\o i -> (crux o i :)) [] assigns - ++ map (uncurry CFUnif) unifs + ++ map (\(v1,v2) -> CFAssign v1 (NTVar v2)) unifs where - crux :: DVar -> ENF -> Crux DVar NTV + crux :: DVar -> ENF -> UnifCrux DVar NTV crux o (Left (NTString s)) = CFAssign o $ NTString s crux o (Left (NTNumeric n)) = CFAssign o $ NTNumeric n crux o (Left (NTVar i)) = CFAssign o $ NTVar i @@ -250,6 +237,35 @@ simpleCost (PP { pp_score = osc, pp_plan = pfx }) act = ------------------------------------------------------------------------}}} -- Planning {{{ +-- $dupcrux +-- +-- Consider a rule like @a += b(X) * b(Y).@ This desugars into an ANF with +-- two separate evaluations of @b(_)@. This is problematic, since we will +-- plan each evaluation separately. (Note that CSE won't help; we really do +-- mean to compute the cross-product in this case, but not double-count the +-- diagonal!) The workaround here is to /order/ the evaluations (by their +-- ANF temporary variables, for the moment). +-- +-- For replacement updates, the correct action is to @continue@ the +-- evaluation loop when an eariler (by the intrinsic ordering) iterator +-- within a update to a later (by the intrinsic ordering) evaluation +-- lands at the same position. +-- +-- For delta updates, the ordering is used for the Blatz-Eisner update +-- propagation strategy -- new values are used in earlier evaluations (than +-- the one being updated) and old values are used in later evaluations. +-- +-- When backward chaining, we get to ignore all of this, since we only +-- produce one backward chaining plan. +-- +-- XXX It's unclear that this is really the right solution. Maybe we should +-- be planning a single stream of instructions for each dfuctar, rather than +-- each evalution arc, but it's not quite clear that there's a nice +-- graphical story to be told in that case? +-- +-- XXX What do we do in the CFEval case?? We need to check every evaluation +-- inside a CFEval update? + data PartialPlan fbs = PP { pp_cruxes :: S.Set (Crux DVar NTV) , pp_binds :: BindChart , pp_restrictSearch :: Bool @@ -267,13 +283,8 @@ stepPartialPlan :: -- | The 'DFunctAr', intern representation, and -- result variable of the -- initial /evaluation/ crux, if any. This is used to - -- avoid double-counting during updates. - -- - -- Cruxes are implicitly ordered by the name of their - -- evaluation variable, so we can easily look to see if - -- a given crux is "before" or "after" the initial one - -- in this ordering. - -> Maybe (DFunctAr, DVar, DVar) + -- avoid double-counting during updates. See $dupcrux + -> Maybe (Maybe DFunctAr, DVar, DVar) -> PartialPlan fbs -> Either (Cost, Action fbs) [PartialPlan fbs] stepPartialPlan steps score mic p = @@ -297,32 +308,37 @@ stepPartialPlan steps score mic p = xs -> [argmin (flip score []) xs] else step rc where - step = S.fold (\crux ps -> ( + step = S.fold (\crux ps -> let bc = pp_binds p pl = pp_plan p - plans = steps (cruxMode bc crux) + plan = steps (cruxMode bc crux) bc' = bc `S.union` cruxVars crux rc' = S.delete crux (pp_cruxes p) r' = (not $ cruxIsEval crux) || (pp_restrictSearch p) - in map (\act -> let act' = handleConflictors act - in PP rc' bc' r' (score p act') (pl ++ act')) - plans - ) ++ ps + in maybe ps + (\act -> let act' = handleConflictors act + in PP rc' bc' r' (score p act') (pl ++ act') + : ps) + plan ) [] handleConflictors = case mic of Nothing -> id - Just ((f,a),i,ov) -> concatMap $ \dop -> + Just (mfa,i,ov) -> concatMap $ \dop -> case dop of - OPIter ov' ivs' f' _ _ | f' == f - && length ivs' == a - && ov > varOfMV ov' - -> let cv = "_chk" - in [ dop - , OPWrap cv (map varOfMV ivs') f' - , OPCkne i cv - ] + OPIter ov' ivs' f' _ _ | + -- We must insert checks whenever this step involves + -- an evaluation. As an easy optimisation, if we know + -- the 'DFunctAr' being updated, we can elide this check + -- when we're evaluating a different 'DFunctAr'. + (maybe True (== (f',length ivs')) mfa) + && ov > varOfMV ov' + -> let cv = "_chk" + in [ dop + , OPWrap cv (map varOfMV ivs') f' + , OPCkne i cv + ] _ -> [dop] stepAgenda st sc mic = go [] . (\x -> [x]) @@ -330,76 +346,114 @@ stepAgenda st sc mic = go [] . (\x -> [x]) go [] [] = [] go (r:rs) [] = go rs r go rs (p:ps) = case stepPartialPlan st sc mic p of - Left df -> (\(c,a) -> (c,fmap (\(_,x,y) -> (x,y)) mic,a)) df - : (go rs ps) + Left df -> df : (go rs ps) Right ps' -> go (ps':rs) ps --- XXX we're going to need to initially plan a unification crux as part of --- backward chaining, but we don't yet. -initializeForCrux :: (Crux DVar a) - -> ((DFunctAr, DVar, DVar), Action fbs) -initializeForCrux cr = case cr of - CFCall o is f -> ( ((f,length is), _hi, o) - , [ OPPeel is _hi f ]) - _ -> dynacSorry "Don't know how to initially plan !CFCall" +planner_ :: -- | Available steps + Possible fbs + -- | Scoring function + -> (PartialPlan fbs -> Action fbs -> Cost) + -- | Cruxes to be planned over + -> S.Set (Crux DVar NTV) + -- | Maybe the updated evaluation crux, the interned + -- representation of the term being updated, and + -- result variable. + -> Maybe (EvalCrux DVar, DVar, DVar) + -- | Any variables bound on the way in, in addition to + -- the two given for an initial crux + -> S.Set DVar + -- | Plans and their costs + -> [(Cost, Action fbs)] +planner_ st sc cr mic bv = stepAgenda st sc mic' + $ PP { pp_cruxes = cr + , pp_binds = S.union bv $ + maybe S.empty (\(_,i,o) -> S.fromList [i,o]) mic + , pp_restrictSearch = False + , pp_score = 0 + , pp_plan = ip + } where - _hi = "_i" + -- XREF:INITPLAN + (ip,mic') = case mic of + Nothing -> ([],Nothing) + Just (CFCall o is f, hi, ho) -> ( [ OPPeel is hi f + , OPAsgn o (NTVar ho)] + , Just (Just (f,length is),o,hi)) + Just (CFEval o i, hi, ho) -> ( [ OPAsgn i (NTVar hi) + , OPAsgn o (NTVar ho)] + , Just (Nothing,o,i)) + +anfPlanner_ st sc anf mic bv = planner_ st sc cruxes mic bv + where + cruxes = S.fromList (map Left (eval_cruxes anf)) + `S.union` S.fromList (map Right (unif_cruxes anf)) + +bestPlan [] = Nothing +bestPlan plans = Just $ argmin fst plans --- | Given a normalized form and an initial crux, saturate the graph and --- get a plan for doing so. +-- | Given a normalized form and, optionally, an initial crux, +-- saturate the graph and get all the plans for doing so. -- -- XXX This has no idea what to do about non-range-restricted rules. -plan_ :: Possible fbs -- ^ Available steps - -> (PartialPlan fbs -> Action fbs -> Cost) -- ^ Scoring function - -> ANFState -- ^ Normal form - -> Maybe (Crux DVar NTV) -- ^ Initial crux - -> [(Cost, Maybe (DVar,DVar), Action fbs)] -- ^ If there's a plan... -plan_ st sc anf mi = - let cruxes = eval_cruxes anf - ++ unif_cruxes anf - (mic,ip) = maybe (Nothing, []) (first Just . initializeForCrux) mi - initPlan = PP { pp_cruxes = maybe id S.delete mi $ S.fromList cruxes - , pp_binds = maybe S.empty cruxVars mi - , pp_restrictSearch = False - , pp_score = 0 - , pp_plan = ip - } - in stepAgenda st sc mic initPlan - -plan :: Possible fbs - -> (PartialPlan fbs -> Action fbs -> Cost) - -> ANFState - -> Maybe (Crux DVar NTV) - -> Maybe (Cost, Maybe (DVar,DVar), Action fbs) -plan st sc anf mi = - (\x -> case x of - [] -> Nothing - plans -> Just $ argmin (\(c,_,_) -> c) plans) - $ plan_ st sc anf mi +planUpdate_ :: BackendPossible fbs -- ^ Available steps + -> (PartialPlan fbs -> Action fbs -> Cost) -- ^ Scoring function + -> ANFState -- ^ Normal form + -> Maybe (EvalCrux DVar, DVar, DVar) -- ^ Initial eval crux + -> [(Cost, Action fbs)] -- ^ If there's a plan... +planUpdate_ bp sc anf mic = anfPlanner_ (possible bp) sc anf mic S.empty + +planUpdate :: BackendPossible fbs + -> (PartialPlan fbs -> Action fbs -> Cost) + -> ANFState + -> Maybe (EvalCrux DVar, DVar, DVar) + -> Maybe (Cost, Action fbs) +planUpdate bp sc anf mi = + bestPlan $ planUpdate_ bp sc anf mi planInitializer :: BackendPossible fbs -> Rule -> Maybe (Cost, Action fbs) planInitializer bp (Rule { r_anf = anf }) = - fmap (\(c,m,a) -> case m of - Nothing -> (c,a) - Just _ -> dynacPanic "Initializer wants input variables?") - $ plan (possible bp) simpleCost anf Nothing + planUpdate bp simpleCost anf Nothing planEachEval :: BackendPossible fbs -- ^ The backend's primitive support -> (DFunctAr -> Bool) -- ^ Indicator for constant function -> Rule - -> [(DFunctAr, Maybe (Cost, Maybe (DVar, DVar), Action fbs))] + -> [(Maybe DFunctAr, Maybe (Cost, DVar, DVar, Action fbs))] planEachEval bp cs (Rule { r_anf = anf }) = - map (\(c,fa) -> (fa, plan (possible bp) simpleCost anf $ Just c)) - $ MA.mapMaybe (\c -> case c of - CFCall _ is f | cs (f,length is) - -> Just $ (c,(f,length is)) - _ -> Nothing ) - $ eval_cruxes anf + map (\(mfa,cr) -> (mfa, varify $ planUpdate bp simpleCost anf $ Just $ mic cr)) + -- Filter out non-constant evaluations + $ MA.mapMaybe (\ec -> case ec of + CFCall _ is f | not (cs (f,length is)) + -> Just (Just (f,length is), ec) + CFCall _ _ _ -> Nothing + CFEval o i -> Just (Nothing,ec)) + + -- Grab all evaluations + $ eval_cruxes anf + where + -- XXX I am not terribly happy about these, but it'll do for the moment. + -- + -- If the mechanism of feeding updates into these plans is to change, + -- please ensure that XREF:INITPLAN also changes appropriately. + varify = fmap $ \(c,a) -> (c,varHead,varVal,a) + mic x = (x,varHead,varVal) + varHead = "__i" + varVal = "__v" + +planGroundBackchain :: BackendPossible fbs + -> Rule + -> Maybe (Cost, DVar, Action fbs) +planGroundBackchain bp (Rule { r_anf = anf, r_head = h }) = + varify + $ bestPlan + $ anfPlanner_ (possible bp) simpleCost anf Nothing (S.singleton h) + where + varify = fmap $ \(c,a) -> (c,h,a) ------------------------------------------------------------------------}}} --- Plan combination {{{ +-- Update plan combination {{{ -type EvalMap fbs = M.Map DFunctAr [(Rule, Cost, Maybe (DVar,DVar), Action fbs)] +type UpdateEvalMap fbs = M.Map (Maybe DFunctAr) + [(Rule, Cost, DVar, DVar, Action fbs)] -- | Return all plans for each functor/arity -- @@ -409,9 +463,10 @@ type EvalMap fbs = M.Map DFunctAr [(Rule, Cost, Maybe (DVar,DVar), Action fbs)] -- -- timv: might want to fuse these into one circuit -- -combinePlans :: [(Rule,[(DFunctAr, Maybe (Cost, Maybe (DVar, DVar), Action fbs))])] - -> EvalMap fbs -combinePlans = go (M.empty) +combineUpdatePlans :: [(Rule,[( Maybe DFunctAr, + Maybe (Cost, DVar, DVar, Action fbs))])] + -> UpdateEvalMap fbs +combineUpdatePlans = go (M.empty) where go m [] = m go m ((fr,cmca):xs) = go' xs fr cmca m @@ -424,7 +479,39 @@ combinePlans = go (M.empty) <+> (pretty fa) <+> "in rule at" <+> (prettySpanLoc $ r_span fr) - Just (c,mv,a) -> go' xs fr ys $ mapInOrApp fa (fr,c,mv,a) m + Just (c,v1,v2,a) -> go' xs fr ys $ mapInOrApp fa (fr,c,v1,v2,a) m + +------------------------------------------------------------------------}}} +-- Backward chaining plan combination {{{ + +type QueryEvalMap fbs = M.Map (Maybe DFunctAr) + [(Rule, Cost, DVar, Action fbs)] + +combineQueryPlans :: [(Rule, Maybe (Cost, DVar, Action fbs))] + -> QueryEvalMap fbs +combineQueryPlans = go (M.empty) + where + go m [] = m + go m ((fr,mcva):xs) = go' xs fr mcva m + + go' xs fr Nothing m = dynacUserErr + $ "No query plan for rule at" + <+> (prettySpanLoc $ r_span fr) + go' xs fr (Just (c,v,a)) m = go (mapInOrApp (findHeadFA fr) + (fr,c,v,a) + m) + xs + + -- XXX This is unforunate and wrong, but our ANF is not quite right to + -- let us do this right. See also Dyna.Backend.Python's use of this + -- function. + findHeadFA (Rule _ h _ _ _ _ (AS { as_assgn = as })) = + case M.lookup h as of + Nothing -> error "No unification for head variable?" + Just (Left _) -> error "NTVar head?" + Just (Right (f,a)) -> Just (f, length a) + + ------------------------------------------------------------------------}}} -- Adorned Queries {{{ diff --git a/src/Dyna/Backend/Python.hs b/src/Dyna/Backend/Python.hs index caebedb..292c91d 100644 --- a/src/Dyna/Backend/Python.hs +++ b/src/Dyna/Backend/Python.hs @@ -40,33 +40,30 @@ import qualified Text.Trifecta as T ------------------------------------------------------------------------}}} -- DOpAMine Backend Information {{{ -data PyDopeBS = PDBAsIs - | PDBRewrite (([ModedVar],ModedVar) -> [DOpAMine PyDopeBS]) +-- At the moment, we pass through a @Maybe ()@ to indicate whether or not +-- we're making a call. See the call to pycall in pdope_ below. +type PyDopeBS = () +builtins :: BackendPossible PyDopeBS builtins (f,is,o) = case () of - _ | all (== MBound) is && S.member (f,length is) constants - -> case o of - MFree -> Right (Det,PDBAsIs) - MBound -> Right (DetSemi, - PDBRewrite $ \(is,o) -> let chkv = "_chk" in - [ OPIter (MF chkv) is f Det $ Just PDBAsIs - , OPCheq chkv (varOfMV o) - ]) + _ | all isBound is && S.member (f,length is) constants + -> case modeOf o of + MFree -> Right [OPIter o is f Det (Just ())] + MBound -> let chkv = "_chk" + in Right $ [ OPIter (MF chkv) is f Det (Just ()) + , OPCheq chkv (varOfMV o) + ] _ | f == "+" -> case (is,o) of - ([MBound,MFree],MBound) -> Right (Det, - PDBRewrite $ \([x,y],o) -> [OPIter y [o,x] "-" Det $ Just PDBAsIs]) - ([MFree,MBound],MBound) -> Right (Det, - PDBRewrite $ \([x,y],o) -> [OPIter x [o,y] "-" Det $ Just PDBAsIs]) + ([x@(MB _),y@(MF _)],MB _) -> Right [OPIter y [o,x] "-" Det $ Just ()] + ([x@(MF _),y@(MB _)],MB _) -> Right [OPIter x [o,y] "-" Det $ Just ()] _ -> Left True _ | f == "-" -> case (is,o) of - ([MBound,MFree],MBound) -> Right (Det, - PDBRewrite $ \([x,y],o) -> [OPIter y [x,o] "-" Det $ Just PDBAsIs]) - ([MFree,MBound],MBound) -> Right (Det, - PDBRewrite $ \([x,y],o) -> [OPIter x [o,y] "+" Det $ Just PDBAsIs]) + ([x@(MB _),y@(MF _)],MB _) -> Right [OPIter y [x,o] "-" Det $ Just ()] + ([x@(MF _),y@(MB _)],MB _) -> Right [OPIter x [o,y] "+" Det $ Just ()] _ -> Left True _ | S.member (f,length is) constants -> Left True @@ -106,53 +103,27 @@ constants = S.fromList ------------------------------------------------------------------------}}} -- DOpAMine Printout {{{ -pdope :: DOpAMine PyDopeBS -> Either [DOpAMine PyDopeBS] (Doc e) -pdope (OPIndr _ _) = dynacSorry "indirect evaluation not implemented" -pdope (OPAsgn v val) = Right $ pretty v <+> equals <+> pretty val -pdope (OPCheq v val) = Right $ "if" <+> pretty v <+> "!=" <+> pretty val <> ": continue" -pdope (OPCkne v val) = Right $ "if" <+> pretty v <+> "==" <+> pretty val <> ": continue" -pdope (OPPeel vs id f) = Right $ - - "try:" `above` (indent 4 $ - tupledOrUnderscore vs - <+> equals <> " " - <> "peel" <> (parens $ fa f vs <> comma <> pretty id) - ) - - `above` "except (TypeError, AssertionError): continue" -- you'll get a "TypeError: 'NoneType' is not iterable." +-- | Print functor and arity based on argument list +pfas f args = dquotes $ pretty f <> "/" <> (pretty $ length args) +pfa f n = parens $ dquotes $ pretty f <> "/" <> pretty n -pdope (OPWrap v vs f) = Right $ pretty v <+> equals - <+> "build" <> (parens $ fa f vs <> comma <> (sepBy "," $ map pretty vs)) +-- pf f vs = pretty f <> (tupled $ map pretty vs) -pdope (OPIter v vs f _ (Just b)) = - case b of - PDBAsIs -> Right $ pretty (varOfMV v) - <+> equals - <+> pycall "call" f vs - - PDBRewrite rf -> Left $ rf (vs,v) - - -pdope (OPIter o m f _ Nothing) = Right $ - let mo = m ++ [o] in - "for" <+> (tupledOrUnderscore $ filterBound mo) - <+> "in" <+> functorIndirect "chart" f m <> pslice mo <> colon - -fa f a = dquotes $ pretty f <> "/" <> (text $ show $ length a) +functorIndirect table f vs = table <> (brackets $ pfas f vs) -- this comes up because can't assign to () -tupledOrUnderscore vs = if length vs > 0 then parens ((sepBy "," $ map pretty vs) <> ",") else text "_" - -pslice vs = brackets $ - sepBy "," (map (\x -> case x of (MF v) -> ":" ; (MB v) -> pretty v) vs) - <> "," -- add a list comma to ensure getitem is always passed a tuple. +tupledOrUnderscore vs = if length vs > 0 + then parens ((sepBy "," $ map pretty vs) <> ",") + else text "_" filterBound = map (\(MF v) -> pretty v) . filter (not.isBound) -functorIndirect table f vs = table <> (brackets $ dquotes $ (pretty f <> "/" <> (text $ show $ length vs))) +pslice vs = brackets $ + sepBy "," (map (\x -> case x of (MF _) -> ":" ; (MB v) -> pretty v) vs) + <> "," -- add a list comma to ensure getitem is always passed a tuple. -pycall table f vs = case (f, length vs) of +pycall f vs = case (f, length vs) of ( "*", 2) -> infixOp " * " ( "+", 2) -> infixOp " + " ( "-", 2) -> infixOp " - " @@ -184,88 +155,150 @@ pycall table f vs = case (f, length vs) of -- TODO: add useful error message. -- _ -> functorIndirect "call" f vs <> (tupled $ pretty_vs) + where pretty_vs = map (pretty . varOfMV) vs call name = name <> (parens $ sepBy ", " $ pretty_vs) infixOp op = sepBy op $ pretty_vs -pf f vs = pretty f <> (tupled $ map pretty vs) -py (f,a) mu (Rule _ h _ _ r span _) dope = - case mu of - Just (hv,v) -> - "@register" - <> pfsa - `above` "def" <+> char '_' - <> tupled (map pretty [hv,v]) - <+> colon - Nothing -> "@initializer" <> pfsa - `above` "def _():" - `above` (indent 4 $ "for _ in [None]:") - `above` (indent 8 $ go dope emit) +-- | Render a single dopamine opcode or its surrogate +pdope_ :: DOpAMine PyDopeBS -> Doc e +pdope_ (OPIndr _ _) = dynacSorry "indirect evaluation not implemented" +pdope_ (OPAsgn v val) = pretty v <+> equals <+> pretty val +pdope_ (OPCheq v val) = "if" <+> pretty v <+> "!=" + <+> pretty val <> ": continue" +pdope_ (OPCkne v val) = "if" <+> pretty v <+> "==" + <+> pretty val <> ": continue" +pdope_ (OPPeel vs i f) = + "try:" `above` (indent 4 $ + tupledOrUnderscore vs + <+> equals <> " " + <> "peel" <> (parens $ pfas f vs <> comma <> pretty i) + ) + -- you'll get a "TypeError: 'NoneType' is not iterable." + `above` "except (TypeError, AssertionError): continue" +pdope_ (OPWrap v vs f) = pretty v + <+> equals + <+> "build" + <> (parens $ pfas f vs <> comma + <> (sepBy "," $ map pretty vs)) + +pdope_ (OPIter v vs f _ (Just ())) = pretty (varOfMV v) + <+> equals + <+> pycall f vs + +pdope_ (OPIter o m f _ Nothing) = + let mo = m ++ [o] in + "for" <+> (tupledOrUnderscore $ filterBound mo) + <+> "in" <+> functorIndirect "chart" f m <> pslice mo <> colon +-- | Render a dopamine sequence's checks and loops above a (indended) core. +pdope :: [DOpAMine PyDopeBS] -> Doc e -> Doc e +pdope _d _e = (indent 4 $ "for _ in [None]:") + `above` (indent 8 $ go _d _e) where - pfsa = (parens $ dquotes $ - pretty f <> "/" <> (text $ show a)) - - go [] = id - go (x:xs) = let indents = case x of OPIter _ _ _ d _ -> d /= Det ; _ -> False - in - case pdope x of - Left rw -> go (rw++xs) - Right px -> above px - . (if indents then indent 4 else id) - . go xs + go [] = id + go (x:xs) = let indents = case x of OPIter _ _ _ d _ -> d /= Det ; _ -> False + in above (pdope_ x) + . (if indents then indent 4 else id) + . go xs + +py mfa mu (Rule _ h _ _ r span _) dope = + case mu of + Just (hv,v) -> case mfa of + Nothing -> dynacSorry "Can't register indir eval" + Nothing -> case mfa of + Nothing -> dynacPanic "Initializer without head" + `above` pdope dope emit + where emit = "emit" <> tupled [pretty h, pretty r] -printPlan :: Handle - -> (DFunct,Int) -- ^ Functor & arity - -- | rule, cost, input variables, and plan - -> (Rule, Cost, Maybe (DVar, DVar), Action PyDopeBS) - -> IO () -printPlan fh fa (r, cost, mu, dope) = do -- display plan - hPutStrLn fh $ "# --" - displayIO fh $ prefixSD "# " $ renderPretty 1.0 100 - $ (prettySpanLoc $ r_span r) <> line - hPutStrLn fh $ "# Cost: " ++ (show cost) +printPlanHeader :: Handle -> Rule -> Cost -> IO () +printPlanHeader h r c = do + hPutStrLn h $ "# --" + -- XXX This "prefixSD" thing is the only real reason we're doing this in + -- IO; it'd be great if wl-pprint-extras understood how to prefix each + -- line it was laying out. + displayIO h $ prefixSD "# " $ renderPretty 1.0 100 + $ (prettySpanLoc $ r_span r) <> line + hPutStrLn h $ "# Cost: " ++ (show c) + +-- XXX This is unforunate and wrong, but our ANF is not quite right to +-- let us do this right. See also Dyna.Analysis.RuleMode's use of this +-- function. +findHeadFA (Rule _ h _ _ _ _ (AS { as_assgn = as })) = + case M.lookup h as of + Nothing -> error "No unification for head variable?" + Just (Left _) -> error "NTVar head?" + Just (Right (f,a)) -> Just (f, length a) + +printInitializer :: Handle -> Rule -> Action PyDopeBS -> IO () +printInitializer fh rule@(Rule _ h _ _ r _ _) dope = do displayIO fh $ renderPretty 1.0 100 - $ py fa mu r dope <> line - hPutStrLn fh "" + $ "@initializer" <> parens (uncurry pfa $ MA.fromJust $ findHeadFA rule) + `above` "def" <+> char '_' <> tupled [] <+> colon + `above` pdope dope emit + <> line + where + emit = "emit" <> tupled [pretty h, pretty r] + +-- XXX INDIR EVAL +printUpdate :: Handle -> Rule -> Maybe DFunctAr -> (DVar, DVar) -> Action PyDopeBS -> IO () +printUpdate fh rule@(Rule _ h _ _ r _ _) (Just (f,a)) (hv,v) dope = do + displayIO fh $ renderPretty 1.0 100 + $ "@register" <> parens (pfa f a) + `above` "def" <+> char '_' <> tupled (map pretty [hv,v]) <+> colon + `above` pdope dope emit + <> line + where + emit = "emit" <> tupled [pretty h, pretty r] ------------------------------------------------------------------------}}} -- Driver {{{ -driver am em is fh = do +driver :: BackendDriver PyDopeBS +driver am um qm is fh = do -- Aggregation mapping hPutStrLn fh $ "agg_decl = {}" - forM (M.toList am) $ \((f,a),v) -> do + forM_ (M.toList am) $ \((f,a),v) -> do hPutStrLn fh $ show $ "agg_decl" <> brackets (dquotes $ pretty f <> "/" <> pretty a) <+> equals <+> (dquotes $ pretty v) + hPutStrLn fh "" + hPutStrLn fh $ "# ==Updates==" + -- plans aggregated by functor/arity - forM_ (M.toList em) $ \(fa, ps) -> do + forM_ (M.toList um) $ \(fa, ps) -> do hPutStrLn fh "" - hPutStrLn fh $ "# ==============" hPutStrLn fh $ "# " ++ show fa - forM_ ps $ printPlan fh fa + forM_ ps $ \(r,c,vi,vo,act) -> do + printPlanHeader fh r c + printUpdate fh r fa (vi,vo) act hPutStrLn fh "" - hPutStrLn fh $ "# ==============" - hPutStrLn fh $ "# Initializers" + hPutStrLn fh $ "# ==Initializers==" + forM_ is $ \(r,c,a) -> do + printPlanHeader fh r c + printInitializer fh r a - forM_ is $ \(f,c,a) -> printPlan fh (findHeadFA f) (f,c,Nothing,a) + hPutStrLn fh $ "# ==Queries==" + + forM_ (M.toList qm) $ \(fa, ps) -> do + hPutStrLn fh $ "# " ++ show fa + forM_ ps $ \(r,c,qv,a) -> do + printPlanHeader fh r c + hPutStrLn fh $ "# " ++ show qv + -- XXX + -- displayIO fh $ renderPretty 1.0 100 $ pdope a "XXX" + hPutStrLn fh "" - where - findHeadFA (Rule _ h _ _ _ _ (AS { as_assgn = as })) = - case M.lookup h as of - Nothing -> error "No unification for head variable?" - Just (Left _) -> error "NTVar head?" - Just (Right (f,a)) -> (f, length a) ------------------------------------------------------------------------}}} -- Export {{{ +pythonBackend :: Backend pythonBackend = Backend builtins constants driver ------------------------------------------------------------------------}}} diff --git a/src/Dyna/Backend/Python/Selftest.hs b/src/Dyna/Backend/Python/Selftest.hs index 96a4d46..7e4b3c4 100644 --- a/src/Dyna/Backend/Python/Selftest.hs +++ b/src/Dyna/Backend/Python/Selftest.hs @@ -6,7 +6,6 @@ module Dyna.Backend.Python.Selftest where import Control.Exception (throw) -import qualified Data.ByteString.Lazy as BL import System.Exit (ExitCode(..)) import System.IO import System.Process @@ -16,25 +15,24 @@ import Test.Golden ------------------------------------------------------------------------}}} -- Run Backend {{{ -runDynaPy :: String -> IO BL.ByteString -runDynaPy f = do +runDynaPy :: String -> String -> IO () +runDynaPy f out = do devnull <- openFile "/dev/null" ReadWriteMode - (Nothing,Just so,Nothing,ph) <- createProcess $ CreateProcess + (Nothing,Nothing,Nothing,ph) <- createProcess $ CreateProcess { cmdspec = RawCommand "/usr/bin/env" - ["python", "bin/interpreter.py", "-o", "-", f] + ["python", "bin/interpreter.py", "-o", out, f] , cwd = Nothing , env = Nothing , std_in = UseHandle devnull - , std_out = CreatePipe + , std_out = UseHandle devnull , std_err = UseHandle devnull , close_fds = True , create_group = False } - bs <- BL.hGetContents so ec <- waitForProcess ph case ec of - ExitSuccess -> return bs + ExitSuccess -> return () ExitFailure _ -> throw ec ------------------------------------------------------------------------}}} @@ -42,9 +40,10 @@ runDynaPy f = do mkExample :: String -> TF.Test mkExample name = - let (dy,ex) = names in goldenVsString dy ex (runDynaPy dy) + let (dy,out,ex) = names in goldenVsFile dy ex out (runDynaPy dy out) where - names = ( "examples/" ++ name ++ ".dyna" + names = ( "examples/" ++ name ++ ".dyna" + , "examples/" ++ name ++ ".dyna.py.out" , "examples/expected/" ++ name ++ ".py.out") goldens :: TF.Test diff --git a/src/Dyna/Main/BackendDefn.hs b/src/Dyna/Main/BackendDefn.hs index 48a9047..b6756ad 100644 --- a/src/Dyna/Main/BackendDefn.hs +++ b/src/Dyna/Main/BackendDefn.hs @@ -9,7 +9,8 @@ module Dyna.Main.BackendDefn where import qualified Data.Set as S import Dyna.Analysis.Aggregation (AggMap) import Dyna.Analysis.ANF (Rule) -import Dyna.Analysis.RuleMode (Action, BackendPossible, Cost, EvalMap) +import Dyna.Analysis.RuleMode (Action, BackendPossible, Cost, + UpdateEvalMap, QueryEvalMap) import Dyna.Term.TTerm (DFunctAr) import System.IO (Handle) @@ -18,6 +19,13 @@ import System.IO (Handle) -- 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 + -> QueryEvalMap bs -- ^ Rule query + -> [(Rule,Cost,Action bs)] -- ^ Initializers + -> Handle -- ^ Output + -> IO () + data Backend = forall bs . Backend { -- | Builtin support hook for mode planning. Options are -- to return @@ -34,9 +42,5 @@ data Backend = forall bs . Backend , be_constants :: S.Set DFunctAr -- | Backend driver - , be_driver :: AggMap -- ^ Aggregation - -> EvalMap bs -- ^ Rules - -> [(Rule,Cost,Action bs)] -- ^ Initializers - -> Handle -- ^ Output - -> IO () + , be_driver :: BackendDriver bs } diff --git a/src/Dyna/Main/Driver.hs b/src/Dyna/Main/Driver.hs index 064974b..88dab1a 100644 --- a/src/Dyna/Main/Driver.hs +++ b/src/Dyna/Main/Driver.hs @@ -69,8 +69,8 @@ noBackend :: Backend noBackend = Backend { be_builtin = \_ -> Left False , be_constants = S.empty - , be_driver = \_ _ _ _ -> hPutStrLn stderr - "No backend specified; stopping" + , be_driver = \_ _ _ _ _ -> hPutStrLn stderr + "No backend specified; stopping" } parseBackend :: String -> Backend @@ -110,6 +110,9 @@ options :: [OptDescr Opt] options = [ Option ['h'] ["help"] (NoArg OptHelp) "display this help message" , Option ['V'] ["version"] (NoArg OptVersion) "display version and exit" + -- This is an excellent idea we might consider, taken from the 'pi' + -- program of http://www.ginac.de/CLN/ + -- , Option [] ["bibliography"] (NoArg OptBiblio) "relevant papers" ] ++ [ Option ['B'] ["backend"] (ReqArg obe "BE") @@ -196,11 +199,16 @@ processFile fileName = bracket openOut hClose go $ map (\x -> (x, planInitializer be_b x)) frs - cPlans = combinePlans + cPlans = combineUpdatePlans $ map (\x -> (x, planEachEval be_b - (not . flip S.member be_c) x)) + (flip S.member be_c) x)) frs - in be_d aggm cPlans initializers out + + qPlans = combineQueryPlans + $ map (\x -> (x, planGroundBackchain be_b x)) + frs + + in be_d aggm cPlans qPlans initializers out parse = do pr <- T.parseFromFileEx (P.dlines <* T.eof) fileName