From 2f0577e021c3e8da2fad51625b7bd762d261f63a Mon Sep 17 00:00:00 2001 From: Nathaniel Wesley Filardo Date: Thu, 10 Jan 2013 23:50:06 -0500 Subject: [PATCH] Parser has a new idea of expressions; planner fix - Move handling of the ','/2 and whenever/2 operators into the ANF processor, next to '*'/1, '&'/1, and is/2, rather than the parser. - Remove the side-condition field in rule forms - Fallout from this exposed a really, really bad initialization bug in the rule planner, which is now hopefully corrected. --- bin/prototype.py | 6 +- bin/utils.py | 3 +- src/Dyna/Analysis/ANF.hs | 28 +++++--- src/Dyna/Analysis/Aggregation.hs | 2 +- src/Dyna/Analysis/RuleMode.hs | 33 +++++---- src/Dyna/Backend/Python.hs | 8 +-- src/Dyna/ParserHS/Parser.hs | 115 ++++++++++++++++++++----------- src/Dyna/ParserHS/Selftest.hs | 68 +++++++----------- 8 files changed, 148 insertions(+), 115 deletions(-) diff --git a/bin/prototype.py b/bin/prototype.py index 1580c9b..430404f 100644 --- a/bin/prototype.py +++ b/bin/prototype.py @@ -154,7 +154,7 @@ def isvar(x): def circuit(anf): - (agg, head, side, evals, unifs, result) = anf + (agg, head, evals, unifs, result) = anf g = Hypergraph() for var, op, args in evals: @@ -165,7 +165,6 @@ def circuit(anf): g.head = head g.result = result - g.side = side g.inputs = [x for x in g.nodes if not g.incoming[x]] g.outputs = [x for x in g.nodes if not g.outgoing[x]] @@ -192,9 +191,6 @@ def graph_styles(g): if isvar(x): # input variables are bold sty[x].update({'penwidth': '3'}) - if x in g.side: - sty[x].update({'style': 'filled', 'fillcolor': 'olivedrab2'}) - # distinguish circuit head and result sty[g.head].update({'style': 'filled', 'fillcolor': 'lightblue'}) sty[g.result].update({'style': 'filled', 'fillcolor': 'salmon'}) diff --git a/bin/utils.py b/bin/utils.py index f5363cf..82cdb9a 100644 --- a/bin/utils.py +++ b/bin/utils.py @@ -62,10 +62,9 @@ def read_anf(e): def g(x): return list(_g(x)) - for (agg, head, side, evals, unifs, [_,result]) in x: + for (agg, head, evals, unifs, [_,result]) in x: yield (agg, head, - side[1:], g(evals[1:]), g(unifs[1:]), result) diff --git a/src/Dyna/Analysis/ANF.hs b/src/Dyna/Analysis/ANF.hs index 3516db0..3d7b707 100644 --- a/src/Dyna/Analysis/ANF.hs +++ b/src/Dyna/Analysis/ANF.hs @@ -168,8 +168,7 @@ newAnnot v a = do newAssignNT :: (MonadState ANFState m) => String -> NTV -> m DVar newAssignNT _ (NTVar x) = return x -newAssignNT pfx (NTString x) = newAssign pfx (Left $ NTString x) -newAssignNT pfx (NTNumeric x) = newAssign pfx (Left $ NTNumeric x) +newAssignNT pfx x = newAssign pfx $ Left x doUnif :: (MonadState ANFState m) => DVar -> DVar -> m () doUnif v w = if v == w @@ -303,6 +302,22 @@ normTerm_ c ss (P.TFunctor "is" [x T.:~ sx, v T.:~ sv]) = do _ -> do NTVar `fmap` newAssign "_u" (Right ("is",[nx,nv])) +-- ",/2" and "whenever/2" are also reserved words of the language and get +-- handled here. XXX This may be wrong, too, of course. +-- +-- These cases both discard their side-conditions and simply transparently +-- return the normalization of their values +normTerm_ (_,ADEval) ss (P.TFunctor "whenever" [r T.:~ sr, i T.:~ si]) = do + _ <- normTerm_ (ECFunctor, ADEval) (si:ss) i + nv <- normTerm_ (ECFunctor, ADEval) (sr:ss) r >>= newAssign "_c" . Left + return $ NTVar nv + +normTerm_ (_,ADEval) ss (P.TFunctor "," [i T.:~ si, r T.:~ sr]) = do + _ <- normTerm_ (ECFunctor, ADEval) (si:ss) i + nv <- normTerm_ (ECFunctor, ADEval) (sr:ss) r >>= newAssign "_c" . Left + return $ NTVar nv + + -- Functors have both top-down and bottom-up dispositions on -- their handling. normTerm_ c ss (P.TFunctor f as) = do @@ -350,7 +365,6 @@ normTerm c (t T.:~ s) = normTerm_ (ECFunctor,if c then ADEval else ADQuote) data Rule = Rule { r_index :: Int , r_head :: DVar , r_aggregator :: DAgg - , r_side :: [DVar] , r_result :: DVar , r_span :: T.Span , r_anf :: ANFState @@ -360,11 +374,10 @@ data Rule = Rule { r_index :: Int -- XXX normRule :: T.Spanned P.Rule -- ^ Term to digest -> Rule -normRule (P.Rule i h a es r T.:~ span) = uncurry ($) $ runNormalize $ do +normRule (P.Rule i h a r T.:~ span) = uncurry ($) $ runNormalize $ do nh <- normTerm False h >>= newAssignNT "_h" nr <- normTerm True r >>= newAssignNT "_r" - nes <- mapM (\e -> normTerm True e >>= newAssignNT "_c") es - return $ Rule i nh a nes nr span + return $ Rule i nh a nr span ------------------------------------------------------------------------}}} -- Run the normalizer {{{ @@ -381,7 +394,7 @@ runNormalize = -- Pretty Printer {{{ printANF :: Rule -> Doc e -printANF (Rule i h a s result span +printANF (Rule i h a result span (AS {as_evals = evals, as_assgn = assgn, as_unifs = unifs})) = text ";;" <+> prettySpanLoc span `above` @@ -389,7 +402,6 @@ printANF (Rule i h a s result span `above` ( parens $ (pretty a) <+> valign [ (pretty h) - , parens $ text "side" <+> (valign $ map pretty s) , parens $ text "evals" <+> pev , parens $ text "unifs" <+> pun , parens $ text "result" <+> (pretty result) diff --git a/src/Dyna/Analysis/Aggregation.hs b/src/Dyna/Analysis/Aggregation.hs index 09f0ec0..aa0e996 100644 --- a/src/Dyna/Analysis/Aggregation.hs +++ b/src/Dyna/Analysis/Aggregation.hs @@ -29,7 +29,7 @@ type AggMap = M.Map DFunctAr DAgg -- could report which line of the source caused an error. procANF :: Rule -> Either String (DFunctAr, DAgg) -procANF (Rule _ h a _ _ _ (AS { as_assgn = as })) = +procANF (Rule _ h a _ _ (AS { as_assgn = as })) = case M.lookup h as of Nothing -> Left $ "I can't process head-variables" Just t -> case t of diff --git a/src/Dyna/Analysis/RuleMode.hs b/src/Dyna/Analysis/RuleMode.hs index 21da04b..912eed9 100644 --- a/src/Dyna/Analysis/RuleMode.hs +++ b/src/Dyna/Analysis/RuleMode.hs @@ -17,7 +17,7 @@ module Dyna.Analysis.RuleMode ( Mode(..), Moded(..), ModedNT, isBound, isFree, - Crux(..), + Crux, EvalCrux(..), UnifCrux(..), Action, Cost, Det(..), BackendPossible, @@ -31,7 +31,6 @@ module Dyna.Analysis.RuleMode ( adornedQueries ) where -import Control.Arrow (first) import Control.Monad import qualified Data.ByteString.Char8 as BC import qualified Data.List as L @@ -65,6 +64,7 @@ modedVar b x = case varMode b x of modedNT :: BindChart -> NTV -> ModedNT modedNT b (NTVar v) = NTVar $ modedVar b v +modedNT _ (NTBool b) = NTBool b modedNT _ (NTString s) = NTString s modedNT _ (NTNumeric x) = NTNumeric x @@ -193,9 +193,7 @@ unif_cruxes (AS { as_assgn = assigns, as_unifs = unifs }) = ++ map (\(v1,v2) -> CFAssign v1 (NTVar v2)) unifs where 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 + crux o (Left x) = CFAssign o x crux o (Right (f,as)) = CFStruct o as f ------------------------------------------------------------------------}}} @@ -288,6 +286,7 @@ stepPartialPlan :: -> PartialPlan fbs -> Either (Cost, Action fbs) [PartialPlan fbs] stepPartialPlan steps score mic p = + -- XT.traceShow ("SPP", mic, pp_binds p, pp_cruxes p) $ if S.null (pp_cruxes p) then Left $ (pp_score p, pp_plan p) else Right $ @@ -366,27 +365,30 @@ planner_ :: -- | Available steps -> [(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_binds = S.union bv bi , pp_restrictSearch = False , pp_score = 0 , pp_plan = ip } where -- XREF:INITPLAN - (ip,mic') = case mic of - Nothing -> ([],Nothing) + (ip,bi,mic') = case mic of + Nothing -> ([],S.empty,Nothing) Just (CFCall o is f, hi, ho) -> ( [ OPPeel is hi f , OPAsgn o (NTVar ho)] + , S.fromList $ o:is , Just (Just (f,length is),o,hi)) Just (CFEval o i, hi, ho) -> ( [ OPAsgn i (NTVar hi) , OPAsgn o (NTVar ho)] + , S.fromList $ [o,i] , 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)) + cruxes = S.fromList (map Right $ unif_cruxes anf) + `S.union` ( S.map Left + $ maybe id (\(ic,_,_) -> S.delete ic) mic + $ S.fromList $ eval_cruxes anf) bestPlan [] = Nothing bestPlan plans = Just $ argmin fst plans @@ -449,6 +451,13 @@ planGroundBackchain bp (Rule { r_anf = anf, r_head = h }) = where varify = fmap $ \(c,a) -> (c,h,a) +{- +planBackchains :: BackendPossible fbs + -> Rule + -> M.Map [Mode] (Cost, [DVar], Action fbs) +planBackchains bp (Rule { r_anf = anf, r_head = h }) +-} + ------------------------------------------------------------------------}}} -- Update plan combination {{{ @@ -505,7 +514,7 @@ combineQueryPlans = go (M.empty) -- 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 })) = + 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?" diff --git a/src/Dyna/Backend/Python.hs b/src/Dyna/Backend/Python.hs index 292c91d..51a6d56 100644 --- a/src/Dyna/Backend/Python.hs +++ b/src/Dyna/Backend/Python.hs @@ -204,7 +204,7 @@ pdope _d _e = (indent 4 $ "for _ in [None]:") . go xs -py mfa mu (Rule _ h _ _ r span _) dope = +py mfa mu (Rule _ h _ r span _) dope = case mu of Just (hv,v) -> case mfa of Nothing -> dynacSorry "Can't register indir eval" @@ -227,14 +227,14 @@ printPlanHeader h r c = do -- 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 })) = +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 +printInitializer fh rule@(Rule _ h _ r _ _) dope = do displayIO fh $ renderPretty 1.0 100 $ "@initializer" <> parens (uncurry pfa $ MA.fromJust $ findHeadFA rule) `above` "def" <+> char '_' <> tupled [] <+> colon @@ -245,7 +245,7 @@ printInitializer fh rule@(Rule _ h _ _ r _ _) dope = do -- 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 +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 diff --git a/src/Dyna/ParserHS/Parser.hs b/src/Dyna/ParserHS/Parser.hs index 475debf..de827a7 100644 --- a/src/Dyna/ParserHS/Parser.hs +++ b/src/Dyna/ParserHS/Parser.hs @@ -35,7 +35,7 @@ {-# LANGUAGE UndecidableInstances #-} module Dyna.ParserHS.Parser ( - Term(..), dterm, dtexpr, + Term(..), dterm, -- dtlexpr, dtfexpr, Rule(..), drule, Line(..), dline, dlines ) where @@ -76,14 +76,13 @@ type RuleIx = Int -- 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 -- risk of parsing ambiguity. -data Rule = Rule !RuleIx !(Spanned Term) !B.ByteString ![Spanned Term] !(Spanned Term) +data Rule = Rule !RuleIx !(Spanned Term) !B.ByteString !(Spanned Term) deriving (Eq,Show) -- | Smart constructor for building a rule with index rule :: (Functor f, MonadState RuleIx f) => f ( Spanned Term -> B.ByteString - -> [Spanned Term] -> Spanned Term -> Rule) rule = Rule <$> incState @@ -113,12 +112,14 @@ bsf = fmap BU.fromString -- | The full laundry list of punctuation symbols we "usually" mean. usualpunct :: CS.CharSet -usualpunct = CS.fromList "!#$%&*+/<=>?@\\^|-~:." +usualpunct = CS.fromList "!#$%&*+/<=>?@\\^|-~:.," --- | Dot operators +-- | Dot or comma operators +-- +-- Note that these are only safe to use in combination with 'thenAny'. dynaDotOperStyle :: TokenParsing m => IdentifierStyle m dynaDotOperStyle = IdentifierStyle - { _styleName = "Dot Operator" + { _styleName = "Dot-Operator" , _styleStart = char '.' , _styleLetter = oneOfSet $ usualpunct , _styleReserved = mempty @@ -126,6 +127,17 @@ dynaDotOperStyle = IdentifierStyle , _styleReservedHighlight = ReservedOperator } +-- | Comma operators +dynaCommaOperStyle :: TokenParsing m => IdentifierStyle m +dynaCommaOperStyle = IdentifierStyle + { _styleName = "Comma-Operator" + , _styleStart = char ',' + , _styleLetter = oneOfSet $ usualpunct + , _styleReserved = mempty + , _styleHighlight = Operator + , _styleReservedHighlight = ReservedOperator + } + -- | Prefix operators -- -- Dot is handled specially elsewhere due to its @@ -136,7 +148,7 @@ dynaDotOperStyle = IdentifierStyle dynaPfxOperStyle :: TokenParsing m => IdentifierStyle m dynaPfxOperStyle = IdentifierStyle { _styleName = "Prefix Operator" - , _styleStart = oneOfSet $ usualpunct CS.\\ CS.fromList ".:" + , _styleStart = oneOfSet $ usualpunct CS.\\ CS.fromList ".:," , _styleLetter = oneOfSet $ usualpunct , _styleReserved = mempty , _styleHighlight = Operator @@ -147,10 +159,12 @@ dynaPfxOperStyle = IdentifierStyle -- -- Dot is handled specially elsewhere due to its -- dual purpose as an operator and rule separator. +-- Comma similarly has special handling due to its +-- nature as term and subgoal separator. dynaOperStyle :: TokenParsing m => IdentifierStyle m dynaOperStyle = IdentifierStyle { _styleName = "Infix Operator" - , _styleStart = oneOfSet $ CS.delete '.' usualpunct + , _styleStart = oneOfSet $ usualpunct CS.\\ CS.fromList ".," , _styleLetter = oneOfSet $ usualpunct , _styleReserved = mempty , _styleHighlight = Operator @@ -160,7 +174,7 @@ dynaOperStyle = IdentifierStyle dynaAggStyle :: TokenParsing m => IdentifierStyle m dynaAggStyle = IdentifierStyle { _styleName = "Aggregator" - , _styleStart = (oneOfSet $ CS.delete '.' usualpunct) + , _styleStart = (oneOfSet $ usualpunct CS.\\ CS.fromList ".,") <|> lower , _styleLetter = (oneOfSet $ usualpunct) <|> alphaNum @@ -241,7 +255,7 @@ nullaryStar = spanned $ flip TFunctor [] <$> (bsf $ string "*") term :: DeltaParsing m => m (Spanned Term) term = token $ choice - [ parens texpr + [ parens tfexpr , spanned $ TVar <$> (bsf $ ident dynaVarStyle) , spanned $ mkta <$> (colon *> term) <* whiteSpace <*> term @@ -260,26 +274,30 @@ term = token $ choice functor = highlight Identifier atom "Functor" parenfunc = TFunctor <$> functor - <*> parens (texpr `sepBy` symbolic ',') + <*> parens (tlexpr `sepBy` symbolic ',') mkta ty te = TAnnot (AnnType ty) te --- | The dot operator is required to have not-a-space following (to avoid --- confusion with the end-of-rule marker, which is taken to be "dot space" --- or "dot eof"). --- --- XXX dotAny is also likely useful when we get dynabase handling, but we're --- not there yet. -dotAny :: (TokenParsing m, Monad m) => m Char -dotAny = char '.' -- is a dot - <* lookAhead (notFollowedBy someSpace) -- not followed by space - <* lookAhead anyChar -- and not follwed by EOF +-- | Sometimes we require that a character not be followed by whitespace +-- and satisfy some additional predicate before we pass it off to some other parser. +thenAny :: (TokenParsing m, Monad m) => m a -> m Char +thenAny p = anyChar -- some character + <* lookAhead (notFollowedBy someSpace) -- not followed by space + <* lookAhead p -- and not follwed by the request -- | A "dot operator" is a dot followed immediately by something that looks -- like a typical operator. We 'lookAhead' here to avoid the case of a dot --- by itself as being counted as an operator. +-- by itself as being counted as an operator; the dot operator is required +-- to have not-a-space following (to avoid confusion with the end-of-rule +-- marker, which is taken to be "dot space" or "dot eof"). dotOper :: (Monad m, TokenParsing m) => m [Char] -dotOper = try (lookAhead dotAny *> identNL dynaDotOperStyle) +dotOper = try (lookAhead (thenAny anyChar) *> identNL dynaDotOperStyle) + +-- | A "comma operator" is a comma necessarily followed by something that +-- would continue to be an operator (i.e. punctuation). +commaOper :: (Monad m, TokenParsing m) => m [Char] +commaOper = try ( lookAhead (thenAny $ _styleLetter dynaCommaOperStyle) + *> identNL dynaCommaOperStyle) uf :: (Monad m, Applicative m) => m (Spanned B.ByteString) @@ -322,26 +340,30 @@ termETable = [ [ Prefix $ uf (spanned $ bsf $ symbol "new") ] , [ Prefix $ uf (spanned $ bsf $ ident dynaPfxOperStyle) ] , [ Infix (bf (spanned $ bsf $ ident dynaOperStyle)) AssocLeft ] , [ Infix (bf (spanned $ bsf $ dotOper)) AssocRight ] - -- XXX "is" belongs only in the full expression parser, not - -- in the term table - , [ Infix (bf (spanned $ bsf $ symbol "is")) AssocNone ] + , [ Infix (bf (spanned $ bsf $ commaOper)) AssocRight ] ] --- fullETable = termETable ++ --- [ [ Infix (bf (spanned $ bsf $ symbol "is")) AssocNone ] --- , [ Infix (bf (spanned $ bsf $ symbol ",")) AssocRight ] --- ] +tlexpr :: DeltaParsing m => m (Spanned Term) +tlexpr = buildExpressionParser termETable term "Limited Expression" -texpr :: DeltaParsing m => m (Spanned Term) -texpr = buildExpressionParser termETable term "Expression" -dterm, dtexpr :: DeltaParsing m => m (Spanned Term) -dterm = unDL term -dtexpr = unDL texpr +fullETable = [ [ Infix (bf (spanned $ bsf $ symbol "is" )) AssocNone ] + , [ Infix (bf (spanned $ bsf $ symbol "," )) AssocRight ] + , [ Infix (bf (spanned $ bsf $ symbol "whenever")) AssocNone ] + ] + +tfexpr :: DeltaParsing m => m (Spanned Term) +tfexpr = buildExpressionParser fullETable tlexpr "Expression" + +dterm, dtlexpr, dtfexpr :: DeltaParsing m => m (Spanned Term) +dterm = unDL term +dtlexpr = unDL tlexpr +dtfexpr = unDL tfexpr ------------------------------------------------------------------------}}} -- Rules {{{ +{- -- | Grab the head (term!) and aggregation operator from a line that -- we hope is a rule. rulepfx :: (MonadState RuleIx m, DeltaParsing m) @@ -349,19 +371,28 @@ rulepfx :: (MonadState RuleIx m, DeltaParsing m) rulepfx = rule <*> term <* whiteSpace <*> (bsf $ ident dynaAggStyle "Aggregator") +-} parseRule :: (MonadState RuleIx m, DeltaParsing m) => m Rule parseRule = choice [ + +{- -- HEAD OP= RESULTEXPR whenever EXPRS . (try (liftA flip rulepfx - <*> texpr + <*> tlexpr <* hrss "whenever")) - <*> (texpr `sepBy1` symbolic ',') + <*> (tlexpr `sepBy1` symbolic ',') -- HEAD OP= EXPRS, RESULTEXPR . , try (rulepfx - <*> many (try (texpr <* symbolic ',')) - <*> texpr) + <*> many (try (tlexpr <* symbolic ',')) + <*> tlexpr) +-} + + try $ rule <*> term + <* whiteSpace + <*> (bsf $ ident dynaAggStyle "Aggregator") + <*> tfexpr -- HEAD . -- timv: using ':-' as the "default" aggregator for facts is @@ -370,7 +401,7 @@ parseRule = choice [ , do h@(_ :~ s) <- term ix <- get - return $ Rule ix h ":-" [] (TFunctor "true" [] :~ s) + return $ Rule ix h ":-" (TFunctor "true" [] :~ s) ] <* optional (char '.') where @@ -385,7 +416,7 @@ drule = evalStateT (unDL (spanned parseRule)) 0 dpragma :: DeltaParsing m => m (Spanned Term) dpragma = symbol ":-" *> whiteSpace - *> texpr + *> tlexpr <* whiteSpace <* optional (char '.') @@ -398,6 +429,8 @@ progline = whiteSpace dline :: (DeltaParsing m) => m (Spanned Line) dline = evalStateT (unDL (progline <* optional whiteSpace)) 0 +-- XXX This is not prepared for parser-altering pragmas. We will have to +-- fix that. dlines :: DeltaParsing m => m [Spanned Line] dlines = evalStateT (unDL (many (progline <* optional whiteSpace))) 0 diff --git a/src/Dyna/ParserHS/Selftest.hs b/src/Dyna/ParserHS/Selftest.hs index 914ae08..68cd8fa 100644 --- a/src/Dyna/ParserHS/Selftest.hs +++ b/src/Dyna/ParserHS/Selftest.hs @@ -170,7 +170,6 @@ case_ruleFact = e @=? (progline sr) where e = LRule (Rule 0 (TFunctor "goal" [] :~ Span (Columns 0 0) (Columns 4 4) sr) ":-" - [] (TFunctor "true" [] :~ Span (Columns 0 0) (Columns 4 4) sr) :~ ts) :~ ts @@ -182,7 +181,6 @@ case_ruleSimple = e @=? (progline sr) where e = LRule (Rule 0 (TFunctor "goal" [] :~ Span (Columns 0 0) (Columns 5 5) sr) "+=" - [] (TNumeric (Left 1) :~ Span (Columns 8 8) (Columns 9 9) sr) :~ ts) :~ ts @@ -208,7 +206,6 @@ case_ruleExpr = e @=? (progline sr) where e = LRule (Rule 0 (TFunctor "goal" [] :~ Span (Columns 0 0) (Columns 5 5) sr) "+=" - [] (TFunctor "+" [TFunctor "foo" [] :~ Span (Columns 8 8) (Columns 12 12) sr ,TFunctor "bar" [] :~ Span (Columns 14 14) (Columns 18 18) sr @@ -225,7 +222,6 @@ case_ruleDotExpr = e @=? (progline sr) where e = LRule (Rule 0 (TFunctor "goal" [] :~ Span (Columns 0 0) (Columns 5 5) sr) "+=" - [] (TFunctor "." [TFunctor "foo" [] :~ Span (Columns 8 8) (Columns 11 11) sr ,TFunctor "bar" [] :~ Span (Columns 12 12) (Columns 15 15) sr @@ -240,44 +236,38 @@ case_ruleDotExpr = e @=? (progline sr) case_ruleComma :: Assertion case_ruleComma = e @=? (progline sr) where - e = LRule (Rule 0 (TFunctor "foo" [] :~ Span (Columns 0 0) (Columns 4 4) sr) - "+=" - [TFunctor "bar" - [TVar "X" :~ Span (Columns 11 11) (Columns 12 12) sr] - :~ Span (Columns 7 7) (Columns 13 13) sr - ,TFunctor "baz" - [TVar "X" :~ Span (Columns 19 19) (Columns 20 20) sr] - :~ Span (Columns 15 15) (Columns 21 21) sr - ] - (TVar "X" :~ Span (Columns 23 23) (Columns 24 24) sr) - :~ ts) - :~ ts + e = LRule (Rule 0 (TFunctor "foo" [] :~ Span (Columns 0 0) (Columns 4 4) sr) + "+=" + (TFunctor "," [TFunctor "bar" [TVar "X" :~ Span (Columns 11 11) (Columns 12 12) sr] + :~ Span (Columns 7 7) (Columns 13 13) sr + ,TFunctor "," [TFunctor "baz" [TVar "X" :~ Span (Columns 19 19) (Columns 20 20) sr] + :~ Span (Columns 15 15) (Columns 21 21) sr + ,TVar "X" :~ Span (Columns 23 23) (Columns 24 24) sr] + :~ Span (Columns 15 15) (Columns 24 24) sr] + :~ Span (Columns 7 7) (Columns 24 24) sr) + :~ ts) + :~ ts ts = Span (Columns 0 0) (Columns 25 25) sr sr = "foo += bar(X), baz(X), X." case_ruleKeywordsComma :: Assertion case_ruleKeywordsComma = e @=? (progline sr) where - e = LRule (Rule 0 (TFunctor "foo" [] :~ Span (Columns 0 0) (Columns 4 4) sr) - "=" - [TFunctor "is" - [TVar "X" :~ Span (Columns 21 21) (Columns 23 23) sr - ,TFunctor "baz" - [TVar "Y" :~ Span (Columns 30 30) (Columns 31 31) sr] - :~ Span (Columns 26 26) (Columns 32 32) sr - ] - :~ Span (Columns 21 21) (Columns 32 32) sr - ,TFunctor "is" - [TVar "Y" :~ Span (Columns 34 34) (Columns 36 36) sr - ,TNumeric (Left 3) :~ Span (Columns 39 39) (Columns 41 41) sr - ] - :~ Span (Columns 34 34) (Columns 41 41) sr - ] - (TFunctor "new" - [TVar "X" :~ Span (Columns 10 10) (Columns 12 12) sr] - :~ Span (Columns 6 6) (Columns 12 12) sr) - :~ ts) - :~ ts + e = LRule (Rule 0 (TFunctor "foo" [] :~ Span (Columns 0 0) (Columns 4 4) sr) + "=" + (TFunctor "whenever" [TFunctor "new" [TVar "X" :~ Span (Columns 10 10) (Columns 12 12) sr] + :~ Span (Columns 6 6) (Columns 12 12) sr + ,TFunctor "," [TFunctor "is" [TVar "X" :~ Span (Columns 21 21) (Columns 23 23) sr + ,TFunctor "baz" [TVar "Y" :~ Span (Columns 30 30) (Columns 31 31) sr] + :~ Span (Columns 26 26) (Columns 32 32) sr] + :~ Span (Columns 21 21) (Columns 32 32) sr + ,TFunctor "is" [TVar "Y" :~ Span (Columns 34 34) (Columns 36 36) sr + ,TNumeric (Left 3) :~ Span (Columns 39 39) (Columns 41 41) sr] + :~ Span (Columns 34 34) (Columns 41 41) sr] + :~ Span (Columns 21 21) (Columns 41 41) sr] -- End "whenever" + :~ Span (Columns 6 6) (Columns 41 41) sr) -- End expression + :~ ts) -- End rule + :~ ts ts = Span (Columns 0 0) (Columns 42 42) sr sr = "foo = new X whenever X is baz(Y), Y is 3 ." @@ -286,13 +276,11 @@ case_rules = e @=? (proglines sr) where e = [ LRule (Rule 0 (TFunctor "goal" [] :~ Span (Columns 0 0) (Columns 5 5) sr) "+=" - [] (TNumeric (Left 1) :~ Span (Columns 8 8) (Columns 10 10) sr) :~ s1) :~ s1 , LRule (Rule 1 (TFunctor "goal" [] :~ Span (Columns 12 12) (Columns 17 17) sr) "+=" - [] (TNumeric (Left 2) :~ Span (Columns 20 20) (Columns 22 22) sr) :~ s2) :~ s2 @@ -306,13 +294,11 @@ case_rulesWhitespace = e @=? (proglines sr) where e = [ LRule (Rule 0 (TFunctor "goal" [] :~ Span (Columns 2 2) (Lines 1 1 16 1) l0) "+=" - [] (TNumeric (Left 1) :~ Span (Lines 1 4 19 4) (Lines 1 6 21 6) l1) :~ s1) :~ s1 , LRule (Rule 1 (TFunctor "goal" [] :~ Span (Lines 3 1 31 1) (Lines 3 6 36 6) l3) "+=" - [] (TNumeric (Left 2) :~ Span (Lines 3 9 39 9) (Lines 3 11 41 11) l3) :~ s2) :~ s2 @@ -331,7 +317,6 @@ case_rulesDotExpr = e @=? (proglines sr) where e = [ LRule (Rule 0 (TFunctor "goal" [] :~ Span (Columns 0 0) (Columns 5 5) sr) "+=" - [] (TFunctor "." [TFunctor "foo" [] :~ Span (Columns 8 8) (Columns 11 11) sr ,TFunctor "bar" [] :~ Span (Columns 12 12) (Columns 15 15) sr @@ -342,7 +327,6 @@ case_rulesDotExpr = e @=? (proglines sr) :~ s1 , LRule (Rule 1 (TFunctor "goal" [] :~ Span (Columns 17 17) (Columns 22 22) sr) "+=" - [] (TNumeric (Left 1) :~ Span (Columns 25 25) (Columns 27 27) sr) :~ s2) :~ s2 -- 2.50.1