From 1c81048cc5e8156714beefad4ce739472c68a482 Mon Sep 17 00:00:00 2001 From: Nathaniel Wesley Filardo Date: Sat, 1 Jun 2013 18:24:48 -0400 Subject: [PATCH] Make emissions explicit in DOpAMine Change the world so that the planner generates OPEmit verbs rather than emissions being magical bits of the backend. Expand the notion of an emission to include the rule index (required for :=) and a set of variables for hyper-edge identification. (Currently, we emit all of them, but later we will want to trim this down to only nondeterministic variables.) This change is the code-generator mate of timv's changes in 6abdc37. --- src/Dyna/Analysis/ANF.hs | 3 ++- src/Dyna/Analysis/DOpAMine.hs | 16 +++++++++++++- src/Dyna/Analysis/RuleMode.hs | 25 +++++++++++---------- src/Dyna/Backend/Python/Backend.hs | 35 ++++++++++++++++++++---------- src/Dyna/Main/Defns.hs | 13 +++++++++++ src/Dyna/ParserHS/Parser.hs | 5 ++--- 6 files changed, 69 insertions(+), 28 deletions(-) create mode 100644 src/Dyna/Main/Defns.hs diff --git a/src/Dyna/Analysis/ANF.hs b/src/Dyna/Analysis/ANF.hs index d875c81..d8d2186 100644 --- a/src/Dyna/Analysis/ANF.hs +++ b/src/Dyna/Analysis/ANF.hs @@ -97,6 +97,7 @@ import qualified Data.Maybe as MA import qualified Data.IntMap as IM import qualified Data.Set as S -- import qualified Debug.Trace as XT +import Dyna.Main.Defns import qualified Dyna.ParserHS.Parser as P import Dyna.Term.TTerm import Dyna.Term.Normalized @@ -389,7 +390,7 @@ normTerm c (t T.:~ s) = normTerm_ (ECFunctor,if c then ADEval else ADQuote) ------------------------------------------------------------------------}}} -- Normalize a Rule {{{ -data Rule = Rule { r_index :: Int +data Rule = Rule { r_index :: RuleIx , r_head :: DVar , r_aggregator :: DAgg , r_result :: DVar diff --git a/src/Dyna/Analysis/DOpAMine.hs b/src/Dyna/Analysis/DOpAMine.hs index 1000771..0d4f681 100644 --- a/src/Dyna/Analysis/DOpAMine.hs +++ b/src/Dyna/Analysis/DOpAMine.hs @@ -4,12 +4,14 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE Rank2Types #-} +{-# OPTIONS_GHC -Wall #-} module Dyna.Analysis.DOpAMine where import Control.Lens import Dyna.Analysis.Mode.Det import Dyna.Analysis.Mode.Execution.NamedInst +import Dyna.Main.Defns import Dyna.Term.Normalized import Dyna.Term.TTerm import Text.PrettyPrint.Free @@ -64,10 +66,17 @@ data DOpAMine bscg -- @OPWrap x ys f ; OPIndr z x@ is indistinguishable from -- @OPIter (MF z) (map MB ys) f DetSemi Nothing@. | OPIndr DVar DVar -- -+ + + -- | Emit (i.e. yield) an answer. Parameters are the + -- head, value, rule index, and a list of variables + -- guaranteed to uniquely (together with the rule index) + -- identify this particular answer. + | OPEmit DVar DVar RuleIx [DVar] + deriving (Show) {- XXX Move DOpAMine to being more functional, rather than a list of - - opcodes? + - opcodes! - - OPBlock [DOpAMine bscg] - OPOrElse [DOpAMine bscg] -- choice points! @@ -100,6 +109,7 @@ detOfDop x = case x of OPWrap _ _ _ -> Det OPIndr _ _ -> DetSemi OPIter _ _ _ d _ -> d + OPEmit _ _ _ _ -> Det ------------------------------------------------------------------------}}} -- Rendering {{{ @@ -133,5 +143,9 @@ renderDOpAMine = r <> maybe empty ((space <>) . braces . e v vs f d) b + r _ (OPEmit h v i vs) = text "OPEmit" <+> pretty h + <+> pretty v + <+> pretty i + <+> pretty vs ------------------------------------------------------------------------}}} diff --git a/src/Dyna/Analysis/RuleMode.hs b/src/Dyna/Analysis/RuleMode.hs index 91098f4..18b7d96 100644 --- a/src/Dyna/Analysis/RuleMode.hs +++ b/src/Dyna/Analysis/RuleMode.hs @@ -33,6 +33,7 @@ module Dyna.Analysis.RuleMode {- ( adornedQueries ) -} where +import Control.Arrow (second) import Control.Lens ((^.)) import Control.Monad import Control.Monad.Error.Class @@ -311,6 +312,7 @@ simpleCost (PP { pp_score = osc, pp_plan = pfx }) act = - 1 DetMulti -> 2 OPIndr _ _ -> 100 + OPEmit _ _ _ _ -> 0 loops = fromIntegral . length . filter isLoop @@ -440,20 +442,19 @@ bestPlan :: [(Cost, a)] -> Maybe (Cost, a) bestPlan [] = Nothing bestPlan plans = Just $ argmin fst (take 1000 plans) -{- +-- | Add the last Emit verb to a string of actions from the planner. +-- +-- XXX This is certainly the wrong answer for a number of reasons, not the +-- least of which is that it adds all variables to the identification set, +-- when really we just want the nondeterministic set. +finalizePlan :: Rule -> Actions fbs -> Actions fbs +finalizePlan r d = d ++ [OPEmit (r_head r) (r_result r) (r_index r) + $ S.toList $ allCruxVars (r_cruxes r)] + -- | 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. -planUpdate_ :: BackendPossible fbs -- ^ Available steps - -> (PartialPlan fbs -> Actions fbs -> Cost) -- ^ Scoring function - -> S.Set (Crux DVar TBase) -- ^ Normal form - -> (EvalCrux DVar, DVar, DVar) -- ^ Initial eval crux - -> S.Set DVar - -> [(Cost, Actions fbs)] -- ^ If there's a plan... -planUpdate_ bp sc anf mic fv = planner_ (possible bp) sc anf (Just mic) S.empty fv --} - planUpdate :: BackendPossible fbs -> Rule -> (PartialPlan fbs -> Actions fbs -> Cost) @@ -461,11 +462,11 @@ planUpdate :: BackendPossible fbs -> (EvalCrux DVar, DVar, DVar) -> SIMCtx DVar -> Maybe (Cost, Actions fbs) -planUpdate bp r sc anf mi ictx = +planUpdate bp r sc anf mi ictx = fmap (second (finalizePlan r)) $ bestPlan $ planner_ (possible bp r) sc anf (Just mi) ictx planInitializer :: BackendPossible fbs -> Rule -> Maybe (Cost, Actions fbs) -planInitializer bp r = +planInitializer bp r = fmap (second (finalizePlan r)) $ let cruxes = r_cruxes r in bestPlan $ planner_ (possible bp r) simpleCost cruxes Nothing (allFreeSIMCtx $ S.toList $ allCruxVars cruxes) diff --git a/src/Dyna/Backend/Python/Backend.hs b/src/Dyna/Backend/Python/Backend.hs index 77cb235..c71a0ae 100644 --- a/src/Dyna/Backend/Python/Backend.hs +++ b/src/Dyna/Backend/Python/Backend.hs @@ -136,6 +136,9 @@ constants = M.fromList ,(("log",1) , PDBS $ call "log" ) ,(("exp",1) , PDBS $ call "exp" ) ,(("eval",1) , PDBS $ call "None;exec " ) + -- XXX not quite what we want, but something like this might + -- be nice to have. + -- ,(("pair",2) , PDBS $ call "" ) ] where nullary v _ _ = v @@ -196,16 +199,30 @@ pdope_ (OPIter o m f _ Nothing) = "for" <+> (tupledOrUnderscore $ filterGround mo) <+> "in" <+> functorIndirect "chart" f m <> pslice mo <> colon + -- XXX Ought to make i and vs conditional on... doing debugging or the + -- aggregator for this head caring. The latter is a good bit more + -- advanced than we are right now. +pdope_ (OPEmit h r i vs) = + "emit" <> tupled [ pretty h + , pretty r + , pretty i + , varmap + ] + where + -- A python map of variable name to value + varmap = encloseSep lbrace rbrace comma + $ map (\v -> let v' = pretty v in dquotes v' <+> colon <+> v') vs + -- | Render a dopamine sequence's checks and loops above a (indended) core. -pdope :: Actions PyDopeBS -> Doc e -> Doc e -pdope _d _e = (indent 4 $ "for _ in [None]:") - `above` (indent 8 $ go _d _e) +pdope :: Actions PyDopeBS -> Doc e +pdope _d = (indent 4 $ "for _ in [None]:") + `above` (indent 8 $ go _d) where - go [] = id + go [] = empty 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 + $ go xs printPlanHeader :: Handle -> Rule -> Cost -> Maybe Int -> IO () @@ -224,10 +241,8 @@ printInitializer fh rule@(Rule _ h _ r _ _ ucruxes _) dope = do displayIO fh $ renderPretty 1.0 100 $ "@initializer" <> parens (uncurry pfa $ MA.fromJust $ findHeadFA h ucruxes) `above` "def" <+> char '_' <> tupled [] <+> colon - `above` pdope dope emit + `above` pdope dope <> line - where - emit = "emit" <> tupled [pretty h, pretty r] -- XXX INDIR EVAL printUpdate :: Handle -> Rule -> Maybe DFunctAr -> (DVar, DVar) -> Actions PyDopeBS -> IO () @@ -235,10 +250,8 @@ 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 + `above` pdope dope <> line - where - emit = "emit" <> tupled [pretty h, pretty r] ------------------------------------------------------------------------}}} -- Driver {{{ diff --git a/src/Dyna/Main/Defns.hs b/src/Dyna/Main/Defns.hs new file mode 100644 index 0000000..0ca8478 --- /dev/null +++ b/src/Dyna/Main/Defns.hs @@ -0,0 +1,13 @@ +--------------------------------------------------------------------------- +-- | Common defintions that seem not to have a better home. + +-- Header material {{{ +-- +module Dyna.Main.Defns where + +------------------------------------------------------------------------}}} +-- Types {{{ + +type RuleIx = Integer + +------------------------------------------------------------------------}}} diff --git a/src/Dyna/ParserHS/Parser.hs b/src/Dyna/ParserHS/Parser.hs index c6e6e28..9006b39 100644 --- a/src/Dyna/ParserHS/Parser.hs +++ b/src/Dyna/ParserHS/Parser.hs @@ -61,6 +61,7 @@ import Data.Semigroup ((<>)) import Data.Monoid (mempty) import Dyna.Analysis.Mode.Inst import Dyna.Analysis.Mode.Uniq +import Dyna.Main.Defns import Dyna.Main.Exception import Dyna.Term.TTerm (Annotation(..), TBase(..), DFunct, DFunctAr, DVar) @@ -86,8 +87,6 @@ data Term = TFunctor B.ByteString | TBase TBase deriving (D.Data,D.Typeable,Eq,Ord,Show) -type RuleIx = Int - -- | Rules are not just terms because we want to make it very syntactically -- explicit about the head being a term (though that's not an expressivity -- concern -- just use the parenthesized texpr case) so that there is no @@ -200,7 +199,7 @@ data PCS = -- XXX add arity to key? , _pcs_opertab :: EOT , _pcs_operspec :: M.Map B.ByteString () -- XXX - , _pcs_ruleix :: Int + , _pcs_ruleix :: RuleIx } $(makeLenses ''PCS) -- 2.50.1