From 4cdac7763387b1497d2e8fa05ed1959d6672e187 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Wed, 19 Jul 2017 14:02:07 -0700 Subject: [PATCH 01/16] Test out catchError --- src/Data/Syntax/Assignment.hs | 2 +- test/Data/Syntax/Assignment/Spec.hs | 86 ++++++++++++++++++++++++++++- 2 files changed, 85 insertions(+), 3 deletions(-) diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs index 4044052a5..e8bd55c1b 100644 --- a/src/Data/Syntax/Assignment.hs +++ b/src/Data/Syntax/Assignment.hs @@ -276,7 +276,7 @@ runAssignment toNode = iterFreer run . fmap ((pure .) . (,)) choiceSymbols choices = (toEnum :: Int -> grammar) <$> IntMap.keys choices runMany :: Assignment ast grammar v -> AssignmentState ast grammar -> ([v], AssignmentState ast grammar) runMany rule state = case runAssignment toNode rule state of - Left e -> ([], state { stateError = Just e }) + Left err -> ([], state { stateError = Just err }) Right (a, state') -> let (as, state'') = runMany rule state' in as `seq` (a : as, state'') {-# INLINE run #-} diff --git a/test/Data/Syntax/Assignment/Spec.hs b/test/Data/Syntax/Assignment/Spec.hs index 6220e44e3..f8857280b 100644 --- a/test/Data/Syntax/Assignment/Spec.hs +++ b/test/Data/Syntax/Assignment/Spec.hs @@ -52,6 +52,88 @@ spec = do let initialState = makeState "hi" [ node Red 0 2 [] ] in snd <$> runAssignment headF (symbol Red) initialState `shouldBe` Right initialState + describe "without catchError" $ do + it "assignment returns UnexpectedSymbol" $ + runAssignment headF + red + (makeState "A" [node Green 0 1 []]) + `shouldBe` + Left (Error (Info.Pos 1 1) (UnexpectedSymbol [Red] Green)) + + it "assignment returns UnexpectedEndOfInput" $ + runAssignment headF + (symbol Green *> children (some red)) + (makeState "A" [node Green 0 1 []]) + `shouldBe` + Left (Error (Info.Pos 1 1) (UnexpectedEndOfInput [Red])) + + describe "catchError" $ do + it "handler that always matches" $ + runAssignment headF + (red `catchError` (\ _ -> OutError <$ location <*> source)) + (makeState "A" [node Green 0 1 []]) + `shouldBe` + Right (OutError "A", AssignmentState 1 (Info.Pos 1 2) Nothing "A" []) + + it "handler that matches" $ + runAssignment headF + (red `catchError` const green) + (makeState "A" [node Green 0 1 []]) + `shouldBe` + Right (Out "A", AssignmentState 1 (Info.Pos 1 2) Nothing "A" []) + + it "handler that doesn't match produces error" $ + runAssignment headF + (red `catchError` const blue) + (makeState "A" [node Green 0 1 []]) + `shouldBe` + Left (Error (Info.Pos 1 1) (UnexpectedSymbol [Blue] Green)) + + describe "in many" $ do + let err = Just (Error (Info.Pos 1 3) (UnexpectedEndOfInput [])) + it "handler that always matches" $ + runAssignment headF + (symbol Palatte *> children ( + many (red `catchError` (\ _ -> OutError <$ location <*> source)) + )) + (makeState "PG" [node Palatte 0 1 [node Green 1 2 []]]) + `shouldBe` + Right ([OutError "G"], AssignmentState 1 (Info.Pos 1 2) err "PG" []) + + let err = Just (Error (Info.Pos 1 3) (UnexpectedEndOfInput [Green])) + it "handler that matches" $ + runAssignment headF + (symbol Palatte *> children ( many (red `catchError` const green) )) + (makeState "PG" [node Palatte 0 1 [node Green 1 2 []]]) + `shouldBe` + Right ([Out "G"], AssignmentState 1 (Info.Pos 1 2) err "PG" []) + + it "handler that doesn't match produces error" $ + runAssignment headF + (symbol Palatte *> children ( many (red `catchError` const blue) )) + (makeState "PG" [node Palatte 0 1 [node Green 1 2 []]]) + `shouldBe` + Left (Error (Info.Pos 1 2) (UnexpectedSymbol [Blue] Green)) + + it "handler that always matches with apply consumes and then errors" $ + runAssignment headF + (symbol Palatte *> children ( + (,) <$> many (red `catchError` (\ _ -> OutError <$ location <*> source)) <*> green + )) + (makeState "PG" [node Palatte 0 1 [node Green 1 2 []]]) + `shouldBe` + Left (Error (Info.Pos 1 3) (UnexpectedEndOfInput [Green])) + + let err = Just (Error (Info.Pos 1 2) (UnexpectedSymbol [Blue] Green)) + it "handler that doesn't match with apply" $ + runAssignment headF + (symbol Palatte *> children ( + (,) <$> many (red `catchError` (\ _ -> blue)) <*> green + )) + (makeState "PG" [node Palatte 0 1 [node Green 1 2 []]]) + `shouldBe` + Right (([], Out "G"), AssignmentState 1 (Info.Pos 1 2) err "PG" []) + describe "source" $ do it "produces the node’s source" $ assignBy headF source "hi" (node Red 0 2 []) `shouldBe` Right "hi" @@ -106,14 +188,14 @@ spec = do node :: symbol -> Int -> Int -> [AST symbol] -> AST symbol node symbol start end children = cofree $ Node symbol (Range start end) (Info.Span (Info.Pos 1 (succ start)) (Info.Pos 1 (succ end))) :< children -data Grammar = Red | Green | Blue | Magenta +data Grammar = Palatte | Red | Green | Blue | Magenta deriving (Enum, Eq, Show) instance Symbol Grammar where symbolType Magenta = Anonymous symbolType _ = Regular -data Out = Out ByteString +data Out = Out ByteString | OutError ByteString deriving (Eq, Show) red :: Assignment (AST Grammar) Grammar Out From 0b23bf901ffcb4b1fde452b24728d3d637de6474 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Wed, 19 Jul 2017 14:20:03 -0700 Subject: [PATCH 02/16] Use const --- test/Data/Syntax/Assignment/Spec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Data/Syntax/Assignment/Spec.hs b/test/Data/Syntax/Assignment/Spec.hs index f8857280b..ddfa99b11 100644 --- a/test/Data/Syntax/Assignment/Spec.hs +++ b/test/Data/Syntax/Assignment/Spec.hs @@ -128,7 +128,7 @@ spec = do it "handler that doesn't match with apply" $ runAssignment headF (symbol Palatte *> children ( - (,) <$> many (red `catchError` (\ _ -> blue)) <*> green + (,) <$> many (red `catchError` const blue) <*> green )) (makeState "PG" [node Palatte 0 1 [node Green 1 2 []]]) `shouldBe` From ee0fb33a949069ce1fd0cab5085a2d745dd79a86 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Wed, 19 Jul 2017 14:20:17 -0700 Subject: [PATCH 03/16] Demonstrate infinite loop with many (pure x) --- test/Data/Syntax/Assignment/Spec.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/test/Data/Syntax/Assignment/Spec.hs b/test/Data/Syntax/Assignment/Spec.hs index ddfa99b11..bd1f65905 100644 --- a/test/Data/Syntax/Assignment/Spec.hs +++ b/test/Data/Syntax/Assignment/Spec.hs @@ -134,6 +134,14 @@ spec = do `shouldBe` Right (([], Out "G"), AssignmentState 1 (Info.Pos 1 2) err "PG" []) + describe "many" $ do + it "should not infinite loop if nothing matches" $ + runAssignment headF + (symbol Palatte *> children ( many (pure (Out "always")) )) + (makeState "A" [node Palatte 0 1 [node Green 1 2 []]]) + `shouldBe` + Left (Error (Info.Pos 1 1) (UnexpectedSymbol [Red] Green)) + describe "source" $ do it "produces the node’s source" $ assignBy headF source "hi" (node Red 0 2 []) `shouldBe` Right "hi" From 6b1a3b0efd830593e5f42ddd303b81d64d534ee6 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Thu, 20 Jul 2017 09:32:09 -0700 Subject: [PATCH 04/16] Fix zero width repetitions infinite loop Introduces a stateCounter to detect progress and accepts one and only one zero width match. Refactored tests a bit to not assert internal state unless specifically necessary. --- src/Data/Syntax/Assignment.hs | 22 ++++---- test/Data/Syntax/Assignment/Spec.hs | 83 ++++++++++++++--------------- 2 files changed, 53 insertions(+), 52 deletions(-) diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs index e8bd55c1b..463ca363b 100644 --- a/src/Data/Syntax/Assignment.hs +++ b/src/Data/Syntax/Assignment.hs @@ -246,16 +246,15 @@ assignAllFrom toNode assignment state = runAssignment toNode assignment state >> runAssignment :: forall grammar a ast. (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Node grammar) -> Assignment ast grammar a -> AssignmentState ast grammar -> Either (Error grammar) (a, AssignmentState ast grammar) runAssignment toNode = iterFreer run . fmap ((pure .) . (,)) where run :: AssignmentF ast grammar x -> (x -> AssignmentState ast grammar -> Either (Error grammar) (a, AssignmentState ast grammar)) -> AssignmentState ast grammar -> Either (Error grammar) (a, AssignmentState ast grammar) - run assignment yield initialState = case (assignment, stateNodes) of + run assignment yield initialState = case (assignment, stateNodes state) of (Location, node : _) -> yield (nodeLocation (toNode (F.project node))) state - (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.Span statePos statePos :. Nil) state + (Location, []) -> yield (Info.Range (stateOffset state) (stateOffset state) :. Info.Span (statePos state) (statePos state) :. Nil) state (Project projection, node : _) -> yield (projection (F.project node)) state - (Source, node : _) -> yield (Source.sourceBytes (Source.slice (nodeByteRange (toNode (F.project node))) stateSource)) (advanceState toNode state) + (Source, node : _) -> yield (Source.sourceBytes (Source.slice (nodeByteRange (toNode (F.project node))) (stateSource state))) (advanceState toNode state) (Children childAssignment, node : _) -> do (a, state') <- assignAllFrom toNode childAssignment state { stateNodes = toList (F.project node) } - yield a (advanceState toNode state' { stateNodes = stateNodes }) + yield a (advanceState toNode state' { stateNodes = stateNodes state }) (Choose choices, node : _) | Node symbol _ _ <- toNode (F.project node), Just a <- IntMap.lookup (fromEnum symbol) choices -> yield a state - (Many _, []) -> yield [] state (Many rule, _) -> uncurry yield (runMany rule state) -- Nullability: some rules, e.g. @pure a@ and @many a@, should match at the end of input. Either side of an alternation may be nullable, ergo Alt can match at the end of input. (Alt a b, _) -> case yield a state of @@ -265,9 +264,9 @@ runAssignment toNode = iterFreer run . fmap ((pure .) . (,)) (Catch during handler, _) -> case yield during state of Left err -> yield (handler err) state Right (a, state') -> Right (a, state') - (_, []) -> Left (Error statePos (UnexpectedEndOfInput expectedSymbols)) + (_, []) -> Left (Error (statePos state) (UnexpectedEndOfInput expectedSymbols)) (_, ast:_) -> let Node symbol _ (Info.Span spanStart _) = toNode (F.project ast) in Left (Error spanStart (UnexpectedSymbol expectedSymbols symbol)) - where state@AssignmentState{..} = case assignment of + where state = case assignment of Choose choices | all ((== Regular) . symbolType) (choiceSymbols choices) -> dropAnonymous toNode initialState _ -> initialState expectedSymbols = case assignment of @@ -277,7 +276,9 @@ runAssignment toNode = iterFreer run . fmap ((pure .) . (,)) runMany :: Assignment ast grammar v -> AssignmentState ast grammar -> ([v], AssignmentState ast grammar) runMany rule state = case runAssignment toNode rule state of Left err -> ([], state { stateError = Just err }) - Right (a, state') -> let (as, state'') = runMany rule state' in as `seq` (a : as, state'') + Right (a, state') -> if ((/=) `on` stateCounter) state state' + then let (as, state'') = runMany rule state' in as `seq` (a : as, state'') + else ([a], state') {-# INLINE run #-} dropAnonymous :: (Symbol grammar, Recursive ast) => (forall x. Base ast x -> Node grammar) -> AssignmentState ast grammar -> AssignmentState ast grammar @@ -287,7 +288,7 @@ dropAnonymous toNode state = state { stateNodes = dropWhile ((/= Regular) . symb advanceState :: Recursive ast => (forall x. Base ast x -> Node grammar) -> AssignmentState ast grammar -> AssignmentState ast grammar advanceState toNode state@AssignmentState{..} | node : rest <- stateNodes - , Node{..} <- toNode (F.project node) = AssignmentState (Info.end nodeByteRange) (Info.spanEnd nodeSpan) stateError stateSource rest + , Node{..} <- toNode (F.project node) = AssignmentState (Info.end nodeByteRange) (Info.spanEnd nodeSpan) stateError (succ stateCounter) stateSource rest | otherwise = state -- | State kept while running 'Assignment's. @@ -295,13 +296,14 @@ data AssignmentState ast grammar = AssignmentState { stateOffset :: Int -- ^ The offset into the Source thus far reached, measured in bytes. , statePos :: Info.Pos -- ^ The (1-indexed) line/column position in the Source thus far reached. , stateError :: Maybe (Error grammar) + , stateCounter :: Int -- ^ Always incrementing counter that tracks how many nodes have been visited. , stateSource :: Source.Source -- ^ The remaining Source. Equal to dropping 'stateOffset' bytes off the original input Source. , stateNodes :: [ast] -- ^ The remaining nodes to assign. Note that 'children' rules recur into subterms, and thus this does not necessarily reflect all of the terms remaining to be assigned in the overall algorithm, only those “in scope.” } deriving (Eq, Show) makeState :: Source.Source -> [ast] -> AssignmentState ast grammar -makeState = AssignmentState 0 (Info.Pos 1 1) Nothing +makeState = AssignmentState 0 (Info.Pos 1 1) Nothing 0 -- Instances diff --git a/test/Data/Syntax/Assignment/Spec.hs b/test/Data/Syntax/Assignment/Spec.hs index bd1f65905..73d0a8e08 100644 --- a/test/Data/Syntax/Assignment/Spec.hs +++ b/test/Data/Syntax/Assignment/Spec.hs @@ -13,36 +13,28 @@ spec :: Spec spec = do describe "Applicative" $ it "matches in sequence" $ - runAssignment headF ((,) <$> red <*> red) (makeState "helloworld" [node Red 0 5 [], node Red 5 10 []]) + fst <$> runAssignment headF ((,) <$> red <*> red) (makeState "helloworld" [node Red 0 5 [], node Red 5 10 []]) `shouldBe` - Right ((Out "hello", Out "world"), AssignmentState 10 (Info.Pos 1 11) Nothing "helloworld" []) + Right (Out "hello", Out "world") describe "Alternative" $ do it "attempts multiple alternatives" $ - runAssignment headF (green <|> red) (makeState "hello" [node Red 0 5 []]) + fst <$> runAssignment headF (green <|> red) (makeState "hello" [node Red 0 5 []]) `shouldBe` - Right (Out "hello", AssignmentState 5 (Info.Pos 1 6) Nothing "hello" []) + Right (Out "hello") it "matches repetitions" $ let s = "colourless green ideas sleep furiously" w = words s (_, nodes) = foldl (\ (i, prev) word -> (i + B.length word + 1, prev <> [node Red i (i + B.length word) []])) (0, []) w in - runAssignment headF (many red) (makeState (fromBytes s) nodes) + fst <$> runAssignment headF (many red) (makeState (fromBytes s) nodes) `shouldBe` - Right (Out <$> w, AssignmentState (B.length s) - (Info.Pos 1 (succ (B.length s))) - (Just (Error (Info.Pos 1 39) (UnexpectedEndOfInput [Red]))) - (fromBytes s) - []) + Right (Out <$> w) it "matches one-or-more repetitions against one or more input nodes" $ - runAssignment headF (some red) (makeState "hello" [node Red 0 5 []]) + fst <$> runAssignment headF (some red) (makeState "hello" [node Red 0 5 []]) `shouldBe` - Right ([Out "hello"], AssignmentState 5 - (Info.Pos 1 6) - (Just (Error (Info.Pos 1 6) (UnexpectedEndOfInput [Red]))) - "hello" - []) + Right [Out "hello"] describe "symbol" $ do it "matches nodes with the same symbol" $ @@ -69,18 +61,18 @@ spec = do describe "catchError" $ do it "handler that always matches" $ - runAssignment headF + fst <$> runAssignment headF (red `catchError` (\ _ -> OutError <$ location <*> source)) (makeState "A" [node Green 0 1 []]) `shouldBe` - Right (OutError "A", AssignmentState 1 (Info.Pos 1 2) Nothing "A" []) + Right (OutError "A") it "handler that matches" $ - runAssignment headF + fst <$> runAssignment headF (red `catchError` const green) (makeState "A" [node Green 0 1 []]) `shouldBe` - Right (Out "A", AssignmentState 1 (Info.Pos 1 2) Nothing "A" []) + Right (Out "A") it "handler that doesn't match produces error" $ runAssignment headF @@ -92,21 +84,21 @@ spec = do describe "in many" $ do let err = Just (Error (Info.Pos 1 3) (UnexpectedEndOfInput [])) it "handler that always matches" $ - runAssignment headF + fst <$> runAssignment headF (symbol Palatte *> children ( many (red `catchError` (\ _ -> OutError <$ location <*> source)) )) (makeState "PG" [node Palatte 0 1 [node Green 1 2 []]]) `shouldBe` - Right ([OutError "G"], AssignmentState 1 (Info.Pos 1 2) err "PG" []) + Right [OutError "G"] let err = Just (Error (Info.Pos 1 3) (UnexpectedEndOfInput [Green])) it "handler that matches" $ - runAssignment headF + fst <$> runAssignment headF (symbol Palatte *> children ( many (red `catchError` const green) )) (makeState "PG" [node Palatte 0 1 [node Green 1 2 []]]) `shouldBe` - Right ([Out "G"], AssignmentState 1 (Info.Pos 1 2) err "PG" []) + Right [Out "G"] it "handler that doesn't match produces error" $ runAssignment headF @@ -126,32 +118,33 @@ spec = do let err = Just (Error (Info.Pos 1 2) (UnexpectedSymbol [Blue] Green)) it "handler that doesn't match with apply" $ - runAssignment headF + fst <$> runAssignment headF (symbol Palatte *> children ( (,) <$> many (red `catchError` const blue) <*> green )) (makeState "PG" [node Palatte 0 1 [node Green 1 2 []]]) `shouldBe` - Right (([], Out "G"), AssignmentState 1 (Info.Pos 1 2) err "PG" []) + Right ([], Out "G") describe "many" $ do - it "should not infinite loop if nothing matches" $ - runAssignment headF - (symbol Palatte *> children ( many (pure (Out "always")) )) - (makeState "A" [node Palatte 0 1 [node Green 1 2 []]]) + let err = Just (Error (Info.Pos 1 2) (UnexpectedEndOfInput [Green])) + it "takes ones and only one zero width repetition" $ + fst <$> runAssignment headF + (symbol Palatte *> children ( many (green <|> pure (Out "always")) )) + (makeState "PGG" [node Palatte 0 1 [node Green 1 2 [], node Green 2 3 []]]) `shouldBe` - Left (Error (Info.Pos 1 1) (UnexpectedSymbol [Red] Green)) + Right [Out "G", Out "G", Out "always"] describe "source" $ do it "produces the node’s source" $ assignBy headF source "hi" (node Red 0 2 []) `shouldBe` Right "hi" it "advances past the current node" $ - snd <$> runAssignment headF source (makeState "hi" [ node Red 0 2 [] ]) `shouldBe` Right (AssignmentState 2 (Info.Pos 1 3) Nothing "hi" []) + snd <$> runAssignment headF source (makeState "hi" [ node Red 0 2 [] ]) `shouldBe` Right (AssignmentState 2 (Info.Pos 1 3) Nothing 1 "hi" []) describe "children" $ do it "advances past the current node" $ - snd <$> runAssignment headF (children (pure (Out ""))) (makeState "a" [node Red 0 1 []]) `shouldBe` Right (AssignmentState 1 (Info.Pos 1 2) Nothing "a" []) + snd <$> runAssignment headF (children (pure (Out ""))) (makeState "a" [node Red 0 1 []]) `shouldBe` Right (AssignmentState 1 (Info.Pos 1 2) Nothing 1 "a" []) it "matches if its subrule matches" $ () <$ runAssignment headF (children red) (makeState "a" [node Blue 0 1 [node Red 0 1 []]]) `shouldBe` Right () @@ -160,38 +153,44 @@ spec = do runAssignment headF (children red) (makeState "a" [node Blue 0 1 [node Green 0 1 []]]) `shouldBe` Left (Error (Info.Pos 1 1) (UnexpectedSymbol [Red] Green)) it "matches nested children" $ - runAssignment headF + fst <$> runAssignment headF (symbol Red *> children (symbol Green *> children (symbol Blue *> source))) (makeState "1" [ node Red 0 1 [ node Green 0 1 [ node Blue 0 1 [] ] ] ]) `shouldBe` - Right ("1", AssignmentState 1 (Info.Pos 1 2) Nothing "1" []) + Right "1" it "continues after children" $ - runAssignment headF + fst <$> runAssignment headF (many (symbol Red *> children (symbol Green *> source) <|> symbol Blue *> source)) (makeState "BC" [ node Red 0 1 [ node Green 0 1 [] ] , node Blue 1 2 [] ]) `shouldBe` - Right (["B", "C"], AssignmentState 2 (Info.Pos 1 3) (Just (Error (Info.Pos 1 3) (UnexpectedEndOfInput [Red, Blue]))) "BC" []) + Right ["B", "C"] it "matches multiple nested children" $ - runAssignment headF + fst <$> runAssignment headF (symbol Red *> children (many (symbol Green *> children (symbol Blue *> source)))) (makeState "12" [ node Red 0 2 [ node Green 0 1 [ node Blue 0 1 [] ] , node Green 1 2 [ node Blue 1 2 [] ] ] ]) `shouldBe` - Right (["1", "2"], AssignmentState 2 (Info.Pos 1 3) (Just (Error (Info.Pos 1 3) (UnexpectedEndOfInput [Green]))) "12" []) + Right ["1", "2"] describe "runAssignment" $ do it "drops anonymous nodes before matching symbols" $ - runAssignment headF red (makeState "magenta red" [node Magenta 0 7 [], node Red 8 11 []]) `shouldBe` Right (Out "red", AssignmentState 11 (Info.Pos 1 12) Nothing "magenta red" []) + fst <$> runAssignment headF red (makeState "magenta red" [node Magenta 0 7 [], node Red 8 11 []]) + `shouldBe` + Right (Out "red") it "does not drop anonymous nodes after matching" $ - runAssignment headF red (makeState "red magenta" [node Red 0 3 [], node Magenta 4 11 []]) `shouldBe` Right (Out "red", AssignmentState 3 (Info.Pos 1 4) Nothing "red magenta" [node Magenta 4 11 []]) + stateNodes . snd <$> runAssignment headF red (makeState "red magenta" [node Red 0 3 [], node Magenta 4 11 []]) + `shouldBe` + Right [node Magenta 4 11 []] it "does not drop anonymous nodes when requested" $ - runAssignment headF ((,) <$> magenta <*> red) (makeState "magenta red" [node Magenta 0 7 [], node Red 8 11 []]) `shouldBe` Right ((Out "magenta", Out "red"), AssignmentState 11 (Info.Pos 1 12) Nothing "magenta red" []) + fst <$> runAssignment headF ((,) <$> magenta <*> red) (makeState "magenta red" [node Magenta 0 7 [], node Red 8 11 []]) + `shouldBe` + Right (Out "magenta", Out "red") node :: symbol -> Int -> Int -> [AST symbol] -> AST symbol node symbol start end children = cofree $ Node symbol (Range start end) (Info.Span (Info.Pos 1 (succ start)) (Info.Pos 1 (succ end))) :< children From 1183c0265ad7219e209bcdccd201d2d8d06d8fb5 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Thu, 20 Jul 2017 09:36:41 -0700 Subject: [PATCH 05/16] err no longer used in these specs --- test/Data/Syntax/Assignment/Spec.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/test/Data/Syntax/Assignment/Spec.hs b/test/Data/Syntax/Assignment/Spec.hs index 73d0a8e08..2c90ed302 100644 --- a/test/Data/Syntax/Assignment/Spec.hs +++ b/test/Data/Syntax/Assignment/Spec.hs @@ -82,7 +82,6 @@ spec = do Left (Error (Info.Pos 1 1) (UnexpectedSymbol [Blue] Green)) describe "in many" $ do - let err = Just (Error (Info.Pos 1 3) (UnexpectedEndOfInput [])) it "handler that always matches" $ fst <$> runAssignment headF (symbol Palatte *> children ( @@ -92,7 +91,6 @@ spec = do `shouldBe` Right [OutError "G"] - let err = Just (Error (Info.Pos 1 3) (UnexpectedEndOfInput [Green])) it "handler that matches" $ fst <$> runAssignment headF (symbol Palatte *> children ( many (red `catchError` const green) )) @@ -116,7 +114,6 @@ spec = do `shouldBe` Left (Error (Info.Pos 1 3) (UnexpectedEndOfInput [Green])) - let err = Just (Error (Info.Pos 1 2) (UnexpectedSymbol [Blue] Green)) it "handler that doesn't match with apply" $ fst <$> runAssignment headF (symbol Palatte *> children ( @@ -127,7 +124,6 @@ spec = do Right ([], Out "G") describe "many" $ do - let err = Just (Error (Info.Pos 1 2) (UnexpectedEndOfInput [Green])) it "takes ones and only one zero width repetition" $ fst <$> runAssignment headF (symbol Palatte *> children ( many (green <|> pure (Out "always")) )) From 2880052c15e90cf77763effb554336285734646f Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Thu, 20 Jul 2017 10:23:21 -0700 Subject: [PATCH 06/16] Remove sourceState from AssignmentState --- src/Data/Syntax/Assignment.hs | 49 ++++++++++----- test/Data/Syntax/Assignment/Spec.hs | 96 ++++++++++++++++------------- 2 files changed, 87 insertions(+), 58 deletions(-) diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs index 463ca363b..183c6dba9 100644 --- a/src/Data/Syntax/Assignment.hs +++ b/src/Data/Syntax/Assignment.hs @@ -228,14 +228,28 @@ showPos :: Maybe FilePath -> Info.Pos -> ShowS showPos path Info.Pos{..} = maybe (showParen True (showString "interactive")) showString path . showChar ':' . shows posLine . showChar ':' . shows posColumn -- | Run an assignment over an AST exhaustively. -assign :: (HasField fields Info.Range, HasField fields Info.Span, HasField fields grammar, Symbol grammar, Enum grammar, Eq grammar, Traversable f, HasCallStack) => Assignment (Cofree f (Record fields)) grammar a -> Source.Source -> Cofree f (Record fields) -> Either (Error grammar) a +assign :: (HasField fields Info.Range, HasField fields Info.Span, HasField fields grammar, Symbol grammar, Enum grammar, Eq grammar, Traversable f, HasCallStack) + => Assignment (Cofree f (Record fields)) grammar a + -> Source.Source + -> Cofree f (Record fields) + -> Either (Error grammar) a assign = assignBy (\ (r :< _) -> Node (getField r) (getField r) (getField r)) -assignBy :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Node grammar) -> Assignment ast grammar a -> Source.Source -> ast -> Either (Error grammar) a -assignBy toNode assignment source = fmap fst . assignAllFrom toNode assignment . makeState source . pure +assignBy :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) + => (forall x. Base ast x -> Node grammar) + -> Assignment ast grammar a + -> Source.Source + -> ast + -> Either (Error grammar) a +assignBy toNode assignment source = fmap fst . assignAllFrom source toNode assignment . makeState . pure -assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Node grammar) -> Assignment ast grammar a -> AssignmentState ast grammar -> Either (Error grammar) (a, AssignmentState ast grammar) -assignAllFrom toNode assignment state = runAssignment toNode assignment state >>= go +assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) + => Source.Source + -> (forall x. Base ast x -> Node grammar) + -> Assignment ast grammar a + -> AssignmentState ast grammar + -> Either (Error grammar) (a, AssignmentState ast grammar) +assignAllFrom source toNode assignment state = runAssignment source toNode assignment state >>= go where go (a, state) = case stateNodes (dropAnonymous toNode state) of [] -> Right (a, state) @@ -243,16 +257,21 @@ assignAllFrom toNode assignment state = runAssignment toNode assignment state >> Left $ fromMaybe (Error spanStart (UnexpectedSymbol [] nodeSymbol)) (stateError state) -- | Run an assignment of nodes in a grammar onto terms in a syntax. -runAssignment :: forall grammar a ast. (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Node grammar) -> Assignment ast grammar a -> AssignmentState ast grammar -> Either (Error grammar) (a, AssignmentState ast grammar) -runAssignment toNode = iterFreer run . fmap ((pure .) . (,)) +runAssignment :: forall grammar a ast. (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) + => Source.Source + -> (forall x. Base ast x -> Node grammar) + -> Assignment ast grammar a + -> AssignmentState ast grammar + -> Either (Error grammar) (a, AssignmentState ast grammar) +runAssignment source toNode = iterFreer run . fmap ((pure .) . (,)) where run :: AssignmentF ast grammar x -> (x -> AssignmentState ast grammar -> Either (Error grammar) (a, AssignmentState ast grammar)) -> AssignmentState ast grammar -> Either (Error grammar) (a, AssignmentState ast grammar) run assignment yield initialState = case (assignment, stateNodes state) of (Location, node : _) -> yield (nodeLocation (toNode (F.project node))) state (Location, []) -> yield (Info.Range (stateOffset state) (stateOffset state) :. Info.Span (statePos state) (statePos state) :. Nil) state (Project projection, node : _) -> yield (projection (F.project node)) state - (Source, node : _) -> yield (Source.sourceBytes (Source.slice (nodeByteRange (toNode (F.project node))) (stateSource state))) (advanceState toNode state) + (Source, node : _) -> yield (Source.sourceBytes (Source.slice (nodeByteRange (toNode (F.project node))) source)) (advanceState toNode state) (Children childAssignment, node : _) -> do - (a, state') <- assignAllFrom toNode childAssignment state { stateNodes = toList (F.project node) } + (a, state') <- assignAllFrom source toNode childAssignment state { stateNodes = toList (F.project node) } yield a (advanceState toNode state' { stateNodes = stateNodes state }) (Choose choices, node : _) | Node symbol _ _ <- toNode (F.project node), Just a <- IntMap.lookup (fromEnum symbol) choices -> yield a state (Many rule, _) -> uncurry yield (runMany rule state) @@ -274,7 +293,7 @@ runAssignment toNode = iterFreer run . fmap ((pure .) . (,)) _ -> [] choiceSymbols choices = (toEnum :: Int -> grammar) <$> IntMap.keys choices runMany :: Assignment ast grammar v -> AssignmentState ast grammar -> ([v], AssignmentState ast grammar) - runMany rule state = case runAssignment toNode rule state of + runMany rule state = case runAssignment source toNode rule state of Left err -> ([], state { stateError = Just err }) Right (a, state') -> if ((/=) `on` stateCounter) state state' then let (as, state'') = runMany rule state' in as `seq` (a : as, state'') @@ -284,11 +303,14 @@ runAssignment toNode = iterFreer run . fmap ((pure .) . (,)) dropAnonymous :: (Symbol grammar, Recursive ast) => (forall x. Base ast x -> Node grammar) -> AssignmentState ast grammar -> AssignmentState ast grammar dropAnonymous toNode state = state { stateNodes = dropWhile ((/= Regular) . symbolType . nodeSymbol . toNode . F.project) (stateNodes state) } --- | Advances the state past the current (head) node (if any), dropping it off stateNodes & its corresponding bytes off of stateSource, and updating stateOffset & statePos to its end. Exhausted 'AssignmentState's (those without any remaining nodes) are returned unchanged. +-- | Advances the state past the current (head) node (if any), dropping it off +-- stateNodes & its corresponding bytes off of source, and updating stateOffset & +-- statePos to its end. Exhausted 'AssignmentState's (those without any +-- remaining nodes) are returned unchanged. advanceState :: Recursive ast => (forall x. Base ast x -> Node grammar) -> AssignmentState ast grammar -> AssignmentState ast grammar advanceState toNode state@AssignmentState{..} | node : rest <- stateNodes - , Node{..} <- toNode (F.project node) = AssignmentState (Info.end nodeByteRange) (Info.spanEnd nodeSpan) stateError (succ stateCounter) stateSource rest + , Node{..} <- toNode (F.project node) = AssignmentState (Info.end nodeByteRange) (Info.spanEnd nodeSpan) stateError (succ stateCounter) rest | otherwise = state -- | State kept while running 'Assignment's. @@ -297,12 +319,11 @@ data AssignmentState ast grammar = AssignmentState , statePos :: Info.Pos -- ^ The (1-indexed) line/column position in the Source thus far reached. , stateError :: Maybe (Error grammar) , stateCounter :: Int -- ^ Always incrementing counter that tracks how many nodes have been visited. - , stateSource :: Source.Source -- ^ The remaining Source. Equal to dropping 'stateOffset' bytes off the original input Source. , stateNodes :: [ast] -- ^ The remaining nodes to assign. Note that 'children' rules recur into subterms, and thus this does not necessarily reflect all of the terms remaining to be assigned in the overall algorithm, only those “in scope.” } deriving (Eq, Show) -makeState :: Source.Source -> [ast] -> AssignmentState ast grammar +makeState :: [ast] -> AssignmentState ast grammar makeState = AssignmentState 0 (Info.Pos 1 1) Nothing 0 diff --git a/test/Data/Syntax/Assignment/Spec.hs b/test/Data/Syntax/Assignment/Spec.hs index 2c90ed302..ea8f8b456 100644 --- a/test/Data/Syntax/Assignment/Spec.hs +++ b/test/Data/Syntax/Assignment/Spec.hs @@ -13,13 +13,13 @@ spec :: Spec spec = do describe "Applicative" $ it "matches in sequence" $ - fst <$> runAssignment headF ((,) <$> red <*> red) (makeState "helloworld" [node Red 0 5 [], node Red 5 10 []]) + fst <$> runAssignment "helloworld" headF ((,) <$> red <*> red) (makeState [node Red 0 5 [], node Red 5 10 []]) `shouldBe` Right (Out "hello", Out "world") describe "Alternative" $ do it "attempts multiple alternatives" $ - fst <$> runAssignment headF (green <|> red) (makeState "hello" [node Red 0 5 []]) + fst <$> runAssignment "hello" headF (green <|> red) (makeState [node Red 0 5 []]) `shouldBe` Right (Out "hello") @@ -27,107 +27,107 @@ spec = do let s = "colourless green ideas sleep furiously" w = words s (_, nodes) = foldl (\ (i, prev) word -> (i + B.length word + 1, prev <> [node Red i (i + B.length word) []])) (0, []) w in - fst <$> runAssignment headF (many red) (makeState (fromBytes s) nodes) + fst <$> runAssignment (fromBytes s) headF (many red) (makeState nodes) `shouldBe` Right (Out <$> w) it "matches one-or-more repetitions against one or more input nodes" $ - fst <$> runAssignment headF (some red) (makeState "hello" [node Red 0 5 []]) + fst <$> runAssignment "hello" headF (some red) (makeState [node Red 0 5 []]) `shouldBe` Right [Out "hello"] describe "symbol" $ do it "matches nodes with the same symbol" $ - fst <$> runAssignment headF red (makeState "hello" [node Red 0 5 []]) `shouldBe` Right (Out "hello") + fst <$> runAssignment "hello" headF red (makeState [node Red 0 5 []]) `shouldBe` Right (Out "hello") it "does not advance past the current node" $ - let initialState = makeState "hi" [ node Red 0 2 [] ] in - snd <$> runAssignment headF (symbol Red) initialState `shouldBe` Right initialState + let initialState = makeState [ node Red 0 2 [] ] in + snd <$> runAssignment "hi" headF (symbol Red) initialState `shouldBe` Right initialState describe "without catchError" $ do it "assignment returns UnexpectedSymbol" $ - runAssignment headF + runAssignment "A" headF red - (makeState "A" [node Green 0 1 []]) + (makeState [node Green 0 1 []]) `shouldBe` Left (Error (Info.Pos 1 1) (UnexpectedSymbol [Red] Green)) it "assignment returns UnexpectedEndOfInput" $ - runAssignment headF + runAssignment "A" headF (symbol Green *> children (some red)) - (makeState "A" [node Green 0 1 []]) + (makeState [node Green 0 1 []]) `shouldBe` Left (Error (Info.Pos 1 1) (UnexpectedEndOfInput [Red])) describe "catchError" $ do it "handler that always matches" $ - fst <$> runAssignment headF + fst <$> runAssignment "A" headF (red `catchError` (\ _ -> OutError <$ location <*> source)) - (makeState "A" [node Green 0 1 []]) + (makeState [node Green 0 1 []]) `shouldBe` Right (OutError "A") it "handler that matches" $ - fst <$> runAssignment headF + fst <$> runAssignment "A" headF (red `catchError` const green) - (makeState "A" [node Green 0 1 []]) + (makeState [node Green 0 1 []]) `shouldBe` Right (Out "A") it "handler that doesn't match produces error" $ - runAssignment headF + runAssignment "A" headF (red `catchError` const blue) - (makeState "A" [node Green 0 1 []]) + (makeState [node Green 0 1 []]) `shouldBe` Left (Error (Info.Pos 1 1) (UnexpectedSymbol [Blue] Green)) describe "in many" $ do it "handler that always matches" $ - fst <$> runAssignment headF + fst <$> runAssignment "PG" headF (symbol Palatte *> children ( many (red `catchError` (\ _ -> OutError <$ location <*> source)) )) - (makeState "PG" [node Palatte 0 1 [node Green 1 2 []]]) + (makeState [node Palatte 0 1 [node Green 1 2 []]]) `shouldBe` Right [OutError "G"] it "handler that matches" $ - fst <$> runAssignment headF + fst <$> runAssignment "PG" headF (symbol Palatte *> children ( many (red `catchError` const green) )) - (makeState "PG" [node Palatte 0 1 [node Green 1 2 []]]) + (makeState [node Palatte 0 1 [node Green 1 2 []]]) `shouldBe` Right [Out "G"] it "handler that doesn't match produces error" $ - runAssignment headF + runAssignment "PG" headF (symbol Palatte *> children ( many (red `catchError` const blue) )) - (makeState "PG" [node Palatte 0 1 [node Green 1 2 []]]) + (makeState [node Palatte 0 1 [node Green 1 2 []]]) `shouldBe` Left (Error (Info.Pos 1 2) (UnexpectedSymbol [Blue] Green)) it "handler that always matches with apply consumes and then errors" $ - runAssignment headF + runAssignment "PG" headF (symbol Palatte *> children ( (,) <$> many (red `catchError` (\ _ -> OutError <$ location <*> source)) <*> green )) - (makeState "PG" [node Palatte 0 1 [node Green 1 2 []]]) + (makeState [node Palatte 0 1 [node Green 1 2 []]]) `shouldBe` Left (Error (Info.Pos 1 3) (UnexpectedEndOfInput [Green])) it "handler that doesn't match with apply" $ - fst <$> runAssignment headF + fst <$> runAssignment "PG" headF (symbol Palatte *> children ( (,) <$> many (red `catchError` const blue) <*> green )) - (makeState "PG" [node Palatte 0 1 [node Green 1 2 []]]) + (makeState [node Palatte 0 1 [node Green 1 2 []]]) `shouldBe` Right ([], Out "G") describe "many" $ do it "takes ones and only one zero width repetition" $ - fst <$> runAssignment headF + fst <$> runAssignment "PGG" headF (symbol Palatte *> children ( many (green <|> pure (Out "always")) )) - (makeState "PGG" [node Palatte 0 1 [node Green 1 2 [], node Green 2 3 []]]) + (makeState [node Palatte 0 1 [node Green 1 2 [], node Green 2 3 []]]) `shouldBe` Right [Out "G", Out "G", Out "always"] @@ -136,55 +136,63 @@ spec = do assignBy headF source "hi" (node Red 0 2 []) `shouldBe` Right "hi" it "advances past the current node" $ - snd <$> runAssignment headF source (makeState "hi" [ node Red 0 2 [] ]) `shouldBe` Right (AssignmentState 2 (Info.Pos 1 3) Nothing 1 "hi" []) + snd <$> runAssignment "hi" headF source (makeState [ node Red 0 2 [] ]) + `shouldBe` + Right (AssignmentState 2 (Info.Pos 1 3) Nothing 1 []) describe "children" $ do it "advances past the current node" $ - snd <$> runAssignment headF (children (pure (Out ""))) (makeState "a" [node Red 0 1 []]) `shouldBe` Right (AssignmentState 1 (Info.Pos 1 2) Nothing 1 "a" []) + snd <$> runAssignment "a" headF (children (pure (Out ""))) (makeState [node Red 0 1 []]) + `shouldBe` + Right (AssignmentState 1 (Info.Pos 1 2) Nothing 1 []) it "matches if its subrule matches" $ - () <$ runAssignment headF (children red) (makeState "a" [node Blue 0 1 [node Red 0 1 []]]) `shouldBe` Right () + () <$ runAssignment "a" headF (children red) (makeState [node Blue 0 1 [node Red 0 1 []]]) + `shouldBe` + Right () it "does not match if its subrule does not match" $ - runAssignment headF (children red) (makeState "a" [node Blue 0 1 [node Green 0 1 []]]) `shouldBe` Left (Error (Info.Pos 1 1) (UnexpectedSymbol [Red] Green)) + runAssignment "a" headF (children red) (makeState [node Blue 0 1 [node Green 0 1 []]]) + `shouldBe` + Left (Error (Info.Pos 1 1) (UnexpectedSymbol [Red] Green)) it "matches nested children" $ - fst <$> runAssignment headF + fst <$> runAssignment "1" headF (symbol Red *> children (symbol Green *> children (symbol Blue *> source))) - (makeState "1" [ node Red 0 1 [ node Green 0 1 [ node Blue 0 1 [] ] ] ]) + (makeState [ node Red 0 1 [ node Green 0 1 [ node Blue 0 1 [] ] ] ]) `shouldBe` Right "1" it "continues after children" $ - fst <$> runAssignment headF + fst <$> runAssignment "BC" headF (many (symbol Red *> children (symbol Green *> source) <|> symbol Blue *> source)) - (makeState "BC" [ node Red 0 1 [ node Green 0 1 [] ] - , node Blue 1 2 [] ]) + (makeState [ node Red 0 1 [ node Green 0 1 [] ] + , node Blue 1 2 [] ]) `shouldBe` Right ["B", "C"] it "matches multiple nested children" $ - fst <$> runAssignment headF + fst <$> runAssignment "12" headF (symbol Red *> children (many (symbol Green *> children (symbol Blue *> source)))) - (makeState "12" [ node Red 0 2 [ node Green 0 1 [ node Blue 0 1 [] ] - , node Green 1 2 [ node Blue 1 2 [] ] ] ]) + (makeState [ node Red 0 2 [ node Green 0 1 [ node Blue 0 1 [] ] + , node Green 1 2 [ node Blue 1 2 [] ] ] ]) `shouldBe` Right ["1", "2"] describe "runAssignment" $ do it "drops anonymous nodes before matching symbols" $ - fst <$> runAssignment headF red (makeState "magenta red" [node Magenta 0 7 [], node Red 8 11 []]) + fst <$> runAssignment "magenta red" headF red (makeState [node Magenta 0 7 [], node Red 8 11 []]) `shouldBe` Right (Out "red") it "does not drop anonymous nodes after matching" $ - stateNodes . snd <$> runAssignment headF red (makeState "red magenta" [node Red 0 3 [], node Magenta 4 11 []]) + stateNodes . snd <$> runAssignment "red magenta" headF red (makeState [node Red 0 3 [], node Magenta 4 11 []]) `shouldBe` Right [node Magenta 4 11 []] it "does not drop anonymous nodes when requested" $ - fst <$> runAssignment headF ((,) <$> magenta <*> red) (makeState "magenta red" [node Magenta 0 7 [], node Red 8 11 []]) + fst <$> runAssignment "magenta red" headF ((,) <$> magenta <*> red) (makeState [node Magenta 0 7 [], node Red 8 11 []]) `shouldBe` Right (Out "magenta", Out "red") From 19eb8f27068105b507c55b0b1bd00c74681954b6 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Thu, 20 Jul 2017 11:06:34 -0700 Subject: [PATCH 07/16] Try to take some source for EmptyStatement --- src/Language/Ruby/Syntax.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index 4ca9cc310..e4d23b24e 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -382,7 +382,7 @@ conditional :: Assignment conditional = makeTerm <$> symbol Conditional <*> children (Statement.If <$> statement <*> statement <*> statement) emptyStatement :: Assignment -emptyStatement = makeTerm <$> symbol EmptyStatement <*> pure Syntax.Empty +emptyStatement = makeTerm <$> symbol EmptyStatement <*> (Syntax.Empty <$ source <|> pure Syntax.Empty) -- Helper functions From 2c00461f23f230010e6bb3f529e9eb3b71a4de8e Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Thu, 20 Jul 2017 11:15:47 -0700 Subject: [PATCH 08/16] Allow assignment of <> operator in Python --- src/Language/Python/Syntax.hs | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index 70c272bbe..ec95fb524 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -253,14 +253,15 @@ ellipsis = makeTerm <$> symbol Grammar.Ellipsis <*> (Language.Python.Syntax.Elli comparisonOperator :: Assignment comparisonOperator = symbol ComparisonOperator >>= \ loc -> children (expression >>= \ lexpression -> makeComparison loc lexpression) where - makeComparison loc lexpression = makeTerm loc <$ symbol AnonLAngle <*> (Expression.LessThan lexpression <$> expression) - <|> makeTerm loc <$ symbol AnonLAngleEqual <*> (Expression.LessThanEqual lexpression <$> expression) - <|> makeTerm loc <$ symbol AnonRAngle <*> (Expression.GreaterThan lexpression <$> expression) - <|> makeTerm loc <$ symbol AnonRAngleEqual <*> (Expression.GreaterThanEqual lexpression <$> expression) - <|> makeTerm loc <$ symbol AnonEqualEqual <*> (Expression.Equal lexpression <$> expression) - <|> makeTerm loc <$ symbol AnonBangEqual <*> (Expression.Not <$> (makeTerm <$> location <*> (Expression.Equal lexpression <$> expression))) - <|> makeTerm loc <$ symbol AnonNot <*> (Expression.Not <$> (makeTerm <$> location <*> (Expression.Member lexpression <$> expression))) - <|> makeTerm loc <$ symbol AnonIn <*> (Expression.Member lexpression <$> expression) + makeComparison loc lexpression = makeTerm loc <$ symbol AnonLAngle <*> (Expression.LessThan lexpression <$> expression) + <|> makeTerm loc <$ symbol AnonLAngleEqual <*> (Expression.LessThanEqual lexpression <$> expression) + <|> makeTerm loc <$ symbol AnonRAngle <*> (Expression.GreaterThan lexpression <$> expression) + <|> makeTerm loc <$ symbol AnonRAngleEqual <*> (Expression.GreaterThanEqual lexpression <$> expression) + <|> makeTerm loc <$ symbol AnonEqualEqual <*> (Expression.Equal lexpression <$> expression) + <|> makeTerm loc <$ symbol AnonBangEqual <*> (Expression.Not <$> (makeTerm <$> location <*> (Expression.Equal lexpression <$> expression))) + <|> makeTerm loc <$ symbol AnonLAngleRAngle <*> (Expression.Not <$> (makeTerm <$> location <*> (Expression.Equal lexpression <$> expression))) + <|> makeTerm loc <$ symbol AnonNot <*> (Expression.Not <$> (makeTerm <$> location <*> (Expression.Member lexpression <$> expression))) + <|> makeTerm loc <$ symbol AnonIn <*> (Expression.Member lexpression <$> expression) -- source is used here to push the cursor to the next node to enable matching against `AnonNot` <|> symbol AnonIs *> source *> (symbol AnonNot *> (makeTerm loc <$> Expression.Not <$> (makeTerm <$> location <*> (Expression.Equal lexpression <$> expression))) <|> (makeTerm loc <$> Expression.Equal lexpression <$> expression)) From 2ca5412769d369ff056ad2255774834f195ee6d1 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Thu, 20 Jul 2017 11:26:26 -0700 Subject: [PATCH 09/16] Python ExpressionStatement can have one or more declarations --- src/Language/Python/Syntax.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index ec95fb524..cdf316b61 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -146,7 +146,7 @@ literal = boolean <|> parseError expressionStatement :: Assignment -expressionStatement = symbol ExpressionStatement *> children declaration +expressionStatement = makeTerm <$> symbol ExpressionStatement <*> children (some declaration) expression :: Assignment expression = argument From 996b8fbf30004d0fa4c79919a547e7253abda22d Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Thu, 20 Jul 2017 11:39:07 -0700 Subject: [PATCH 10/16] Fix python assignment for multiple statements in if body --- src/Language/Python/Syntax.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index cdf316b61..911a2eff0 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -133,6 +133,9 @@ statement = assertStatement <|> withStatement <|> parseError +statements :: Assignment +statements = makeTerm <$> location <*> many statement + literal :: Assignment literal = boolean <|> concatenatedString @@ -400,7 +403,7 @@ raiseStatement :: Assignment raiseStatement = makeTerm <$> symbol RaiseStatement <*> children (Statement.Throw <$> (makeTerm <$> location <*> many expression)) ifStatement :: Assignment -ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> expression <*> statement <*> (flip (foldr makeElif) <$> many elifClause <*> optionalElse)) +ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> expression <*> statements <*> (flip (foldr makeElif) <$> many elifClause <*> optionalElse)) where elseClause = symbol ElseClause *> children statement elifClause = (,) <$ symbol ElifClause <*> location <*> children (Statement.If <$> expression <*> statement) optionalElse = fromMaybe <$> emptyTerm <*> optional elseClause From 6bf440d2402a450040947f1c138e03eb02d801aa Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Thu, 20 Jul 2017 11:42:56 -0700 Subject: [PATCH 11/16] Python elif and else need to take multiple statements too --- src/Language/Python/Syntax.hs | 4 ++-- test/fixtures/python/if-statement.A.py | 6 ++++++ 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index 911a2eff0..812054167 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -404,8 +404,8 @@ raiseStatement = makeTerm <$> symbol RaiseStatement <*> children (Statement.Thro ifStatement :: Assignment ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> expression <*> statements <*> (flip (foldr makeElif) <$> many elifClause <*> optionalElse)) - where elseClause = symbol ElseClause *> children statement - elifClause = (,) <$ symbol ElifClause <*> location <*> children (Statement.If <$> expression <*> statement) + where elseClause = symbol ElseClause *> children statements + elifClause = (,) <$ symbol ElifClause <*> location <*> children (Statement.If <$> expression <*> statements) optionalElse = fromMaybe <$> emptyTerm <*> optional elseClause makeElif (loc, makeIf) rest = makeTerm loc (makeIf rest) diff --git a/test/fixtures/python/if-statement.A.py b/test/fixtures/python/if-statement.A.py index 5a82ed280..609f4c22e 100644 --- a/test/fixtures/python/if-statement.A.py +++ b/test/fixtures/python/if-statement.A.py @@ -1,3 +1,9 @@ if a: b c +elif d: + a + b +else: + x + y From fc9851334f244d1655abd7642c222c7052107fcb Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Thu, 20 Jul 2017 11:54:41 -0700 Subject: [PATCH 12/16] Introduce expressions and declarations to Python assignment to cleanup code --- src/Language/Python/Syntax.hs | 30 ++++++++++++++++++------------ 1 file changed, 18 insertions(+), 12 deletions(-) diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index 812054167..0d3b36885 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -108,6 +108,9 @@ declaration = classDefinition <|> statement <|> parseError +declarations :: Assignment +declarations = makeTerm <$> location <*> many declaration + statement :: Assignment statement = assertStatement <|> assignment' @@ -176,6 +179,9 @@ expression = argument <|> unaryOperator <|> parseError +expressions :: Assignment +expressions = makeTerm <$> location <*> many expression + argument :: Assignment argument = makeTerm <$> symbol ListSplatArgument <*> (Syntax.Identifier <$> source) <|> makeTerm <$> symbol DictionarySplatArgument <*> (Syntax.Identifier <$> source) @@ -202,33 +208,33 @@ withStatement :: Assignment withStatement = makeTerm <$> symbol WithStatement <*> children (uncurry Statement.Let . swap <$> (symbol WithItem *> children ((,) <$> identifier <*> identifier)) <*> expression) forStatement :: Assignment -forStatement = symbol ForStatement >>= \ loc -> children (make loc <$> (makeTerm <$> symbol Variables <*> children (many expression)) <*> expressionList <*> (makeTerm <$> location <*> many expression) <*> (optional (makeTerm <$> symbol ElseClause <*> children (many declaration)))) +forStatement = symbol ForStatement >>= \ loc -> children (make loc <$> (makeTerm <$> symbol Variables <*> children (many expression)) <*> expressionList <*> expressions <*> optional (makeTerm <$> symbol ElseClause <*> children (many declaration))) where make loc variables expressionList forBody forElseClause = case forElseClause of Nothing -> makeTerm loc (Statement.ForEach variables expressionList forBody) Just a -> makeTerm loc (Statement.Else (makeTerm loc $ Statement.ForEach variables expressionList forBody) a) whileStatement :: Assignment -whileStatement = symbol WhileStatement >>= \ loc -> children (make loc <$> expression <*> (makeTerm <$> location <*> many expression) <*> (optional (makeTerm <$> symbol ElseClause <*> children (many declaration)))) +whileStatement = symbol WhileStatement >>= \ loc -> children (make loc <$> expression <*> expressions <*> optional (makeTerm <$> symbol ElseClause <*> children (many declaration))) where make loc whileCondition whileBody whileElseClause = case whileElseClause of Nothing -> makeTerm loc (Statement.While whileCondition whileBody) Just a -> makeTerm loc (Statement.Else (makeTerm loc $ Statement.While whileCondition whileBody) a) tryStatement :: Assignment -tryStatement = makeTerm <$> symbol TryStatement <*> children (Statement.Try <$> expression <*> (many (expression <|> elseClause))) - where elseClause = makeTerm <$> symbol ElseClause <*> children (Statement.Else <$> emptyTerm <*> (makeTerm <$> location <*> (many expression))) +tryStatement = makeTerm <$> symbol TryStatement <*> children (Statement.Try <$> expression <*> many (expression <|> elseClause)) + where elseClause = makeTerm <$> symbol ElseClause <*> children (Statement.Else <$> emptyTerm <*> (makeTerm <$> location <*> many expression)) exceptClause :: Assignment exceptClause = makeTerm <$> symbol ExceptClause <*> children (Statement.Catch <$> ((makeTerm <$> location <*> (uncurry Statement.Let . swap <$> ((,) <$> identifier <* symbol AnonAs <*> identifier) <*> emptyTerm)) - <|> (makeTerm <$> location <*> (many identifier))) - <*> (makeTerm <$> location <*> (many expression))) + <|> makeTerm <$> location <*> many identifier) + <*> expressions) functionDefinition :: Assignment -functionDefinition = (symbol FunctionDefinition >>= \ loc -> children (makeFunctionDeclaration loc <$> identifier <*> (symbol Parameters *> children (many expression)) <*> (optional (symbol Type *> children expression)) <*> (makeTerm <$> location <*> many declaration))) - <|> (symbol AsyncFunctionDefinition >>= \ loc -> children (makeAsyncFunctionDeclaration loc <$> async' <*> identifier <*> (symbol Parameters *> children (many expression)) <*> (optional (symbol Type *> children expression)) <*> (makeTerm <$> location <*> many declaration))) - <|> (symbol Lambda >>= \ loc -> children (makeFunctionDeclaration loc <$> (makeTerm <$> symbol AnonLambda <*> (Syntax.Identifier <$> source)) <*> ((symbol LambdaParameters *> children (many expression)) <|> (pure [])) <*> (optional (symbol Type *> children expression)) <*> (makeTerm <$> location <*> many declaration))) +functionDefinition = (symbol FunctionDefinition >>= \ loc -> children (makeFunctionDeclaration loc <$> identifier <*> (symbol Parameters *> children (many expression)) <*> optional (symbol Type *> children expression) <*> declarations)) + <|> (symbol AsyncFunctionDefinition >>= \ loc -> children (makeAsyncFunctionDeclaration loc <$> async' <*> identifier <*> (symbol Parameters *> children (many expression)) <*> optional (symbol Type *> children expression) <*> declarations)) + <|> (symbol Lambda >>= \ loc -> children (makeFunctionDeclaration loc <$> (makeTerm <$> symbol AnonLambda <*> (Syntax.Identifier <$> source)) <*> ((symbol LambdaParameters *> children (many expression)) <|> pure []) <*> optional (symbol Type *> children expression) <*> declarations)) where makeFunctionDeclaration loc functionName' functionParameters ty functionBody = makeTerm loc $ Type.Annotation (makeTerm loc $ Declaration.Function functionName' functionParameters functionBody) (maybe (makeTerm loc Syntax.Empty) identity ty) makeAsyncFunctionDeclaration loc async' functionName' functionParameters ty functionBody = makeTerm loc $ Type.Annotation (makeTerm loc $ Type.Annotation (makeTerm loc $ Declaration.Function functionName' functionParameters functionBody) (maybe (makeTerm loc Syntax.Empty) identity ty)) async' @@ -237,7 +243,7 @@ async' :: Assignment async' = makeTerm <$> symbol AnonAsync <*> (Syntax.Identifier <$> source) classDefinition :: Assignment -classDefinition = makeTerm <$> symbol ClassDefinition <*> children (Declaration.Class <$> identifier <*> argumentList <*> (many declaration)) +classDefinition = makeTerm <$> symbol ClassDefinition <*> children (Declaration.Class <$> identifier <*> argumentList <*> many declaration) where argumentList = symbol ArgumentList *> children (many expression) <|> pure [] @@ -276,7 +282,7 @@ keyword :: Assignment keyword = makeTerm <$> symbol KeywordIdentifier <*> children (Syntax.Identifier <$> source) tuple :: Assignment -tuple = makeTerm <$> symbol Tuple <*> children (Literal.Tuple <$> (many expression)) +tuple = makeTerm <$> symbol Tuple <*> children (Literal.Tuple <$> many expression) -- TODO: Consider flattening single element lists expressionList :: Assignment @@ -400,7 +406,7 @@ deleteStatement = makeTerm <$> symbol DeleteStatement <*> children (Expression.C where deleteIdentifier = makeTerm <$> symbol AnonDel <*> (Syntax.Identifier <$> source) raiseStatement :: Assignment -raiseStatement = makeTerm <$> symbol RaiseStatement <*> children (Statement.Throw <$> (makeTerm <$> location <*> many expression)) +raiseStatement = makeTerm <$> symbol RaiseStatement <*> children (Statement.Throw <$> expressions) ifStatement :: Assignment ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> expression <*> statements <*> (flip (foldr makeElif) <$> many elifClause <*> optionalElse)) From cf268a3ce3e700c31e500aecd3e6af8bf1190df3 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Thu, 20 Jul 2017 15:10:12 -0700 Subject: [PATCH 13/16] Make Ruby assignment lenient: everything is an expression --- src/Language/Ruby/Syntax.hs | 149 ++++++++++++++++++------------------ 1 file changed, 73 insertions(+), 76 deletions(-) diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index e4d23b24e..417c39383 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -76,10 +76,10 @@ type Assignment = HasCallStack => Assignment.Assignment (AST Grammar) Grammar Te -- | Assignment from AST in Ruby’s grammar onto a program in Ruby’s syntax. assignment :: Assignment -assignment = makeTerm <$> symbol Program <*> children (many statement) <|> parseError +assignment = makeTerm <$> symbol Program <*> children (many expression) <|> parseError -statement :: Assignment -statement = +expression :: Assignment +expression = beginBlock <|> endBlock <|> comment @@ -120,10 +120,10 @@ statement = <|> block <|> heredoc <|> parseError - where mk s construct = makeTerm <$> symbol s <*> children ((construct .) . fromMaybe <$> emptyTerm <*> optional (symbol ArgumentList *> children statement)) + where mk s construct = makeTerm <$> symbol s <*> children ((construct .) . fromMaybe <$> emptyTerm <*> optional (symbol ArgumentList *> children expression)) -statements :: Assignment -statements = makeTerm <$> location <*> many statement +expressions :: Assignment +expressions = makeTerm <$> location <*> many expression identifier :: Assignment identifier = @@ -148,8 +148,8 @@ literal = <|> makeTerm <$> symbol Grammar.Float <*> (Literal.Float <$> source) <|> makeTerm <$> symbol Grammar.Nil <*> (Literal.Null <$ source) -- TODO: Do we want to represent the difference between .. and ... - <|> makeTerm <$> symbol Range <*> children (Expression.Enumeration <$> statement <*> statement <*> emptyTerm) - <|> makeTerm <$> symbol Array <*> children (Literal.Array <$> many statement) + <|> makeTerm <$> symbol Range <*> children (Expression.Enumeration <$> expression <*> expression <*> emptyTerm) + <|> makeTerm <$> symbol Array <*> children (Literal.Array <$> many expression) <|> makeTerm <$> symbol Hash <*> children (Literal.Hash <$> many pair) -- TODO: Give subshell it's own literal and allow interpolation <|> makeTerm <$> symbol Subshell <*> (Literal.TextElement <$> source) @@ -174,26 +174,23 @@ keyword = where mk s = makeTerm <$> symbol s <*> (Syntax.Identifier <$> source) beginBlock :: Assignment -beginBlock = makeTerm <$> symbol BeginBlock <*> children (Statement.ScopeEntry <$> many statement) +beginBlock = makeTerm <$> symbol BeginBlock <*> children (Statement.ScopeEntry <$> many expression) endBlock :: Assignment -endBlock = makeTerm <$> symbol EndBlock <*> children (Statement.ScopeExit <$> many statement) - -methodName :: Assignment -methodName = identifier <|> literal +endBlock = makeTerm <$> symbol EndBlock <*> children (Statement.ScopeExit <$> many expression) class' :: Assignment -class' = makeTerm <$> symbol Class <*> children (Declaration.Class <$> (identifier <|> scopeResolution) <*> (superclass <|> pure []) <*> many statement) - where superclass = pure <$ symbol Superclass <*> children identifier +class' = makeTerm <$> symbol Class <*> children (Declaration.Class <$> expression <*> (superclass <|> pure []) <*> many expression) + where superclass = pure <$ symbol Superclass <*> children expression singletonClass :: Assignment -singletonClass = makeTerm <$> symbol SingletonClass <*> children (Declaration.Class <$> statement <*> pure [] <*> many statement) +singletonClass = makeTerm <$> symbol SingletonClass <*> children (Declaration.Class <$> expression <*> pure [] <*> many expression) module' :: Assignment -module' = makeTerm <$> symbol Module <*> children (Declaration.Module <$> (identifier <|> scopeResolution) <*> many statement) +module' = makeTerm <$> symbol Module <*> children (Declaration.Module <$> expression <*> many expression) scopeResolution :: Assignment -scopeResolution = makeTerm <$> symbol ScopeResolution <*> children (Expression.ScopeResolution <$> many statement) +scopeResolution = makeTerm <$> symbol ScopeResolution <*> children (Expression.ScopeResolution <$> many expression) parameter :: Assignment parameter = @@ -203,79 +200,80 @@ parameter = <|> mk KeywordParameter <|> mk OptionalParameter <|> makeTerm <$> symbol DestructuredParameter <*> children (many parameter) - <|> statement + <|> expression + <|> parseError where mk s = makeTerm <$> symbol s <*> (Syntax.Identifier <$> source) method :: Assignment -method = makeTerm <$> symbol Method <*> children (Declaration.Method <$> emptyTerm <*> methodName <*> params <*> statements) +method = makeTerm <$> symbol Method <*> children (Declaration.Method <$> emptyTerm <*> expression <*> params <*> expressions) where params = symbol MethodParameters *> children (many parameter) <|> pure [] singletonMethod :: Assignment -singletonMethod = makeTerm <$> symbol SingletonMethod <*> children (Declaration.Method <$> statement <*> methodName <*> params <*> statements) +singletonMethod = makeTerm <$> symbol SingletonMethod <*> children (Declaration.Method <$> expression <*> expression <*> params <*> expressions) where params = symbol MethodParameters *> children (many parameter) <|> pure [] lambda :: Assignment lambda = symbol Lambda >>= \ loc -> children $ do name <- makeTerm loc <$> (Syntax.Identifier <$> source) params <- (symbol BlockParameters <|> symbol LambdaParameters) *> children (many parameter) <|> pure [] - body <- statements + body <- expressions pure $ makeTerm loc (Declaration.Function name params body) block :: Assignment -block = makeTerm <$> symbol DoBlock <*> children (Declaration.Function <$> emptyTerm <*> params <*> statements) - <|> makeTerm <$> symbol Block <*> children (Declaration.Function <$> emptyTerm <*> params <*> statements) +block = makeTerm <$> symbol DoBlock <*> children (Declaration.Function <$> emptyTerm <*> params <*> expressions) + <|> makeTerm <$> symbol Block <*> children (Declaration.Function <$> emptyTerm <*> params <*> expressions) where params = (symbol BlockParameters) *> children (many parameter) <|> pure [] comment :: Assignment comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source) alias :: Assignment -alias = makeTerm <$> symbol Alias <*> children (Expression.Call <$> name <*> some methodName <*> emptyTerm) +alias = makeTerm <$> symbol Alias <*> children (Expression.Call <$> name <*> some expression <*> emptyTerm) where name = makeTerm <$> location <*> (Syntax.Identifier <$> source) undef :: Assignment -undef = makeTerm <$> symbol Undef <*> children (Expression.Call <$> name <*> some methodName <*> emptyTerm) +undef = makeTerm <$> symbol Undef <*> children (Expression.Call <$> name <*> some expression <*> emptyTerm) where name = makeTerm <$> location <*> (Syntax.Identifier <$> source) if' :: Assignment if' = ifElsif If - <|> makeTerm <$> symbol IfModifier <*> children (flip Statement.If <$> statement <*> statement <*> emptyTerm) - where ifElsif s = makeTerm <$> symbol s <*> children (Statement.If <$> statement <*> statements <*> (fromMaybe <$> emptyTerm <*> optional (ifElsif Elsif <|> else'))) + <|> makeTerm <$> symbol IfModifier <*> children (flip Statement.If <$> expression <*> expression <*> emptyTerm) + where ifElsif s = makeTerm <$> symbol s <*> children (Statement.If <$> expression <*> expressions <*> (fromMaybe <$> emptyTerm <*> optional (ifElsif Elsif <|> else'))) else' :: Assignment -else' = makeTerm <$> symbol Else <*> children (many statement) +else' = makeTerm <$> symbol Else <*> children (many expression) unless :: Assignment unless = - makeTerm <$> symbol Unless <*> children (Statement.If <$> invert statement <*> statements <*> (fromMaybe <$> emptyTerm <*> optional else')) - <|> makeTerm <$> symbol UnlessModifier <*> children (flip Statement.If <$> statement <*> invert statement <*> emptyTerm) + makeTerm <$> symbol Unless <*> children (Statement.If <$> invert expression <*> expressions <*> (fromMaybe <$> emptyTerm <*> optional else')) + <|> makeTerm <$> symbol UnlessModifier <*> children (flip Statement.If <$> expression <*> invert expression <*> emptyTerm) while' :: Assignment while' = - makeTerm <$> symbol While <*> children (Statement.While <$> statement <*> statements) - <|> makeTerm <$> symbol WhileModifier <*> children (flip Statement.While <$> statement <*> statement) + makeTerm <$> symbol While <*> children (Statement.While <$> expression <*> expressions) + <|> makeTerm <$> symbol WhileModifier <*> children (flip Statement.While <$> expression <*> expression) until' :: Assignment until' = - makeTerm <$> symbol Until <*> children (Statement.While <$> invert statement <*> statements) - <|> makeTerm <$> symbol UntilModifier <*> children (flip Statement.While <$> statement <*> invert statement) + makeTerm <$> symbol Until <*> children (Statement.While <$> invert expression <*> expressions) + <|> makeTerm <$> symbol UntilModifier <*> children (flip Statement.While <$> expression <*> invert expression) for :: Assignment -for = makeTerm <$> symbol For <*> children (Statement.ForEach <$> vars <*> statement <*> statements) - where vars = makeTerm <$> location <*> some identifier +for = makeTerm <$> symbol For <*> children (Statement.ForEach <$> vars <*> expression <*> expressions) + where vars = makeTerm <$> location <*> some expression case' :: Assignment -case' = makeTerm <$> symbol Case <*> children (Statement.Match <$> statement <*> when) +case' = makeTerm <$> symbol Case <*> children (Statement.Match <$> expression <*> when') where - when = makeTerm <$> symbol When <*> children (Statement.Pattern <$> (makeTerm <$> location <*> some pattern) <*> (when <|> else' <|> statements)) - pattern = symbol Pattern *> children ((symbol SplatArgument *> children statement) <|> statement) + when' = makeTerm <$> symbol When <*> children (Statement.Pattern <$> (makeTerm <$> location <*> some pattern) <*> (when' <|> else' <|> expressions)) + pattern = symbol Pattern *> children ((symbol SplatArgument *> children expression) <|> expression) subscript :: Assignment -subscript = makeTerm <$> symbol ElementReference <*> children (Expression.Subscript <$> statement <*> many argument) +subscript = makeTerm <$> symbol ElementReference <*> children (Expression.Subscript <$> expression <*> many argument) pair :: Assignment -pair = makeTerm <$> symbol Pair <*> children (Literal.KeyValue <$> statement <*> statement) +pair = makeTerm <$> symbol Pair <*> children (Literal.KeyValue <$> expression <*> expression) argument :: Assignment argument = @@ -283,49 +281,48 @@ argument = <|> mk HashSplatArgument <|> mk BlockArgument <|> pair - <|> statement + <|> expression where mk s = makeTerm <$> symbol s <*> (Syntax.Identifier <$> source) methodCall :: Assignment -methodCall = makeTerm <$> symbol MethodCall <*> children (Expression.Call <$> name <*> args <*> (block <|> emptyTerm)) +methodCall = makeTerm <$> symbol MethodCall <*> children (Expression.Call <$> expression <*> args <*> (block <|> emptyTerm)) where - name = identifier <|> scopeResolution <|> call args = (symbol ArgumentList <|> symbol ArgumentListWithParens) *> children (many argument) <|> pure [] call :: Assignment -call = makeTerm <$> symbol Call <*> children (Expression.MemberAccess <$> statement <*> statement) +call = makeTerm <$> symbol Call <*> children (Expression.MemberAccess <$> expression <*> expression) rescue :: Assignment rescue = rescue' - <|> makeTerm <$> symbol RescueModifier <*> children (Statement.Try <$> statement <*> many (makeTerm <$> location <*> (Statement.Catch <$> statement <*> emptyTerm))) - <|> makeTerm <$> symbol Ensure <*> children (Statement.Finally <$> statements) - <|> makeTerm <$> symbol Else <*> children (Statement.Else <$> emptyTerm <*> statements) + <|> makeTerm <$> symbol RescueModifier <*> children (Statement.Try <$> expression <*> many (makeTerm <$> location <*> (Statement.Catch <$> expression <*> emptyTerm))) + <|> makeTerm <$> symbol Ensure <*> children (Statement.Finally <$> expressions) + <|> makeTerm <$> symbol Else <*> children (Statement.Else <$> emptyTerm <*> expressions) where - rescue' = makeTerm <$> symbol Rescue <*> children (Statement.Catch <$> exceptions <*> (rescue' <|> statements)) + rescue' = makeTerm <$> symbol Rescue <*> children (Statement.Catch <$> exceptions <*> (rescue' <|> expressions)) exceptions = makeTerm <$> location <*> many ex - ex = makeTerm <$> symbol Exceptions <*> children (many identifier) - <|> makeTerm <$> symbol ExceptionVariable <*> children (many identifier) + ex = makeTerm <$> symbol Exceptions <*> children (many expression) + <|> makeTerm <$> symbol ExceptionVariable <*> children (many expression) begin :: Assignment -begin = makeTerm <$> symbol Begin <*> children (Statement.Try <$> statements <*> many rescue) +begin = makeTerm <$> symbol Begin <*> children (Statement.Try <$> expressions <*> many rescue) assignment' :: Assignment assignment' = makeTerm <$> symbol Assignment <*> children (Statement.Assignment <$> lhs <*> rhs) <|> makeTerm <$> symbol OperatorAssignment <*> children (lhs >>= \ var -> Statement.Assignment var <$> - (makeTerm <$> symbol AnonPlusEqual <*> (Expression.Plus var <$> statement) - <|> makeTerm <$> symbol AnonMinusEqual <*> (Expression.Minus var <$> statement) - <|> makeTerm <$> symbol AnonStarEqual <*> (Expression.Times var <$> statement) - <|> makeTerm <$> symbol AnonStarStarEqual <*> (Expression.Power var <$> statement) - <|> makeTerm <$> symbol AnonSlashEqual <*> (Expression.DividedBy var <$> statement) - <|> makeTerm <$> symbol AnonPipePipeEqual <*> (Expression.And var <$> statement) - <|> makeTerm <$> symbol AnonPipeEqual <*> (Expression.BOr var <$> statement) - <|> makeTerm <$> symbol AnonAmpersandAmpersandEqual <*> (Expression.And var <$> statement) - <|> makeTerm <$> symbol AnonAmpersandEqual <*> (Expression.BAnd var <$> statement) - <|> makeTerm <$> symbol AnonPercentEqual <*> (Expression.Modulo var <$> statement) - <|> makeTerm <$> symbol AnonRAngleRAngleEqual <*> (Expression.RShift var <$> statement) - <|> makeTerm <$> symbol AnonLAngleLAngleEqual <*> (Expression.LShift var <$> statement) - <|> makeTerm <$> symbol AnonCaretEqual <*> (Expression.BXOr var <$> statement))) + (makeTerm <$> symbol AnonPlusEqual <*> (Expression.Plus var <$> expression) + <|> makeTerm <$> symbol AnonMinusEqual <*> (Expression.Minus var <$> expression) + <|> makeTerm <$> symbol AnonStarEqual <*> (Expression.Times var <$> expression) + <|> makeTerm <$> symbol AnonStarStarEqual <*> (Expression.Power var <$> expression) + <|> makeTerm <$> symbol AnonSlashEqual <*> (Expression.DividedBy var <$> expression) + <|> makeTerm <$> symbol AnonPipePipeEqual <*> (Expression.And var <$> expression) + <|> makeTerm <$> symbol AnonPipeEqual <*> (Expression.BOr var <$> expression) + <|> makeTerm <$> symbol AnonAmpersandAmpersandEqual <*> (Expression.And var <$> expression) + <|> makeTerm <$> symbol AnonAmpersandEqual <*> (Expression.BAnd var <$> expression) + <|> makeTerm <$> symbol AnonPercentEqual <*> (Expression.Modulo var <$> expression) + <|> makeTerm <$> symbol AnonRAngleRAngleEqual <*> (Expression.RShift var <$> expression) + <|> makeTerm <$> symbol AnonLAngleLAngleEqual <*> (Expression.LShift var <$> expression) + <|> makeTerm <$> symbol AnonCaretEqual <*> (Expression.BXOr var <$> expression))) where lhs = makeTerm <$> symbol LeftAssignmentList <*> children (many expr) <|> expr rhs = makeTerm <$> symbol RightAssignmentList <*> children (many expr) <|> expr @@ -336,15 +333,15 @@ assignment' unary :: Assignment unary = symbol Unary >>= \ location -> - makeTerm location . Expression.Complement <$> children ( symbol AnonTilde *> statement ) - <|> makeTerm location . Expression.Not <$> children ( symbol AnonBang *> statement ) - <|> makeTerm location . Expression.Not <$> children ( symbol AnonNot *> statement ) - <|> makeTerm location <$> children (Expression.Call <$> (makeTerm <$> symbol AnonDefinedQuestion <*> (Syntax.Identifier <$> source)) <*> some statement <*> emptyTerm) - <|> children ( symbol AnonPlus *> statement ) - <|> makeTerm location . Expression.Negate <$> children identifier -- Unary minus (e.g. `-a`). HiddenUnaryMinus nodes are hidden, so we can't match on the symbol. + makeTerm location . Expression.Complement <$> children ( symbol AnonTilde *> expression ) + <|> makeTerm location . Expression.Not <$> children ( symbol AnonBang *> expression ) + <|> makeTerm location . Expression.Not <$> children ( symbol AnonNot *> expression ) + <|> makeTerm location <$> children (Expression.Call <$> (makeTerm <$> symbol AnonDefinedQuestion <*> (Syntax.Identifier <$> source)) <*> some expression <*> emptyTerm) + <|> children ( symbol AnonPlus *> expression ) + <|> makeTerm location . Expression.Negate <$> children expression -- Unary minus (e.g. `-a`). HiddenUnaryMinus nodes are hidden, so we can't match on the symbol. binary :: Assignment -binary = symbol Binary >>= \ loc -> children $ statement >>= \ lexpression -> go loc lexpression +binary = symbol Binary >>= \ loc -> children $ expression >>= \ lexpression -> go loc lexpression where go loc lexpression = mk AnonAnd Expression.And @@ -375,11 +372,11 @@ binary = symbol Binary >>= \ loc -> children $ statement >>= \ lexpression -> go <|> mk AnonSlash Expression.DividedBy <|> mk AnonPercent Expression.Modulo <|> mk AnonStarStar Expression.Power - where mk s constr = makeTerm loc <$> (symbol s *> (constr lexpression <$> statement)) - mkNot s constr = makeTerm loc <$ symbol s <*> (Expression.Not <$> (makeTerm <$> location <*> (constr lexpression <$> statement))) + where mk s constr = makeTerm loc <$> (symbol s *> (constr lexpression <$> expression)) + mkNot s constr = makeTerm loc <$ symbol s <*> (Expression.Not <$> (makeTerm <$> location <*> (constr lexpression <$> expression))) conditional :: Assignment -conditional = makeTerm <$> symbol Conditional <*> children (Statement.If <$> statement <*> statement <*> statement) +conditional = makeTerm <$> symbol Conditional <*> children (Statement.If <$> expression <*> expression <*> expression) emptyStatement :: Assignment emptyStatement = makeTerm <$> symbol EmptyStatement <*> (Syntax.Empty <$ source <|> pure Syntax.Empty) From 20905f6e6517d2499d7028579f7ca91dcf48c864 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Fri, 21 Jul 2017 08:59:36 -0700 Subject: [PATCH 14/16] Write this as guards instead --- src/Data/Syntax/Assignment.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs index 463ca363b..cc8f63f76 100644 --- a/src/Data/Syntax/Assignment.hs +++ b/src/Data/Syntax/Assignment.hs @@ -276,9 +276,10 @@ runAssignment toNode = iterFreer run . fmap ((pure .) . (,)) runMany :: Assignment ast grammar v -> AssignmentState ast grammar -> ([v], AssignmentState ast grammar) runMany rule state = case runAssignment toNode rule state of Left err -> ([], state { stateError = Just err }) - Right (a, state') -> if ((/=) `on` stateCounter) state state' - then let (as, state'') = runMany rule state' in as `seq` (a : as, state'') - else ([a], state') + Right (a, state') | ((/=) `on` stateCounter) state state' -> + let (as, state'') = runMany rule state' + in as `seq` (a : as, state'') + | otherwise -> ([a], state') {-# INLINE run #-} dropAnonymous :: (Symbol grammar, Recursive ast) => (forall x. Base ast x -> Node grammar) -> AssignmentState ast grammar -> AssignmentState ast grammar From b934b97f27aa6b31f2ada5d87c0fc2fe57663290 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Fri, 21 Jul 2017 09:00:30 -0700 Subject: [PATCH 15/16] s/Palatte/Palette --- test/Data/Syntax/Assignment/Spec.hs | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/test/Data/Syntax/Assignment/Spec.hs b/test/Data/Syntax/Assignment/Spec.hs index 2c90ed302..95f796388 100644 --- a/test/Data/Syntax/Assignment/Spec.hs +++ b/test/Data/Syntax/Assignment/Spec.hs @@ -84,50 +84,50 @@ spec = do describe "in many" $ do it "handler that always matches" $ fst <$> runAssignment headF - (symbol Palatte *> children ( + (symbol Palette *> children ( many (red `catchError` (\ _ -> OutError <$ location <*> source)) )) - (makeState "PG" [node Palatte 0 1 [node Green 1 2 []]]) + (makeState "PG" [node Palette 0 1 [node Green 1 2 []]]) `shouldBe` Right [OutError "G"] it "handler that matches" $ fst <$> runAssignment headF - (symbol Palatte *> children ( many (red `catchError` const green) )) - (makeState "PG" [node Palatte 0 1 [node Green 1 2 []]]) + (symbol Palette *> children ( many (red `catchError` const green) )) + (makeState "PG" [node Palette 0 1 [node Green 1 2 []]]) `shouldBe` Right [Out "G"] it "handler that doesn't match produces error" $ runAssignment headF - (symbol Palatte *> children ( many (red `catchError` const blue) )) - (makeState "PG" [node Palatte 0 1 [node Green 1 2 []]]) + (symbol Palette *> children ( many (red `catchError` const blue) )) + (makeState "PG" [node Palette 0 1 [node Green 1 2 []]]) `shouldBe` Left (Error (Info.Pos 1 2) (UnexpectedSymbol [Blue] Green)) it "handler that always matches with apply consumes and then errors" $ runAssignment headF - (symbol Palatte *> children ( + (symbol Palette *> children ( (,) <$> many (red `catchError` (\ _ -> OutError <$ location <*> source)) <*> green )) - (makeState "PG" [node Palatte 0 1 [node Green 1 2 []]]) + (makeState "PG" [node Palette 0 1 [node Green 1 2 []]]) `shouldBe` Left (Error (Info.Pos 1 3) (UnexpectedEndOfInput [Green])) it "handler that doesn't match with apply" $ fst <$> runAssignment headF - (symbol Palatte *> children ( + (symbol Palette *> children ( (,) <$> many (red `catchError` const blue) <*> green )) - (makeState "PG" [node Palatte 0 1 [node Green 1 2 []]]) + (makeState "PG" [node Palette 0 1 [node Green 1 2 []]]) `shouldBe` Right ([], Out "G") describe "many" $ do it "takes ones and only one zero width repetition" $ fst <$> runAssignment headF - (symbol Palatte *> children ( many (green <|> pure (Out "always")) )) - (makeState "PGG" [node Palatte 0 1 [node Green 1 2 [], node Green 2 3 []]]) + (symbol Palette *> children ( many (green <|> pure (Out "always")) )) + (makeState "PGG" [node Palette 0 1 [node Green 1 2 [], node Green 2 3 []]]) `shouldBe` Right [Out "G", Out "G", Out "always"] @@ -191,7 +191,7 @@ spec = do node :: symbol -> Int -> Int -> [AST symbol] -> AST symbol node symbol start end children = cofree $ Node symbol (Range start end) (Info.Span (Info.Pos 1 (succ start)) (Info.Pos 1 (succ end))) :< children -data Grammar = Palatte | Red | Green | Blue | Magenta +data Grammar = Palette | Red | Green | Blue | Magenta deriving (Enum, Eq, Show) instance Symbol Grammar where From 9f20e57740f387e25be5b62eb5cda1a7b1fc5143 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Fri, 21 Jul 2017 09:08:57 -0700 Subject: [PATCH 16/16] Spacing --- test/Data/Syntax/Assignment/Spec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Data/Syntax/Assignment/Spec.hs b/test/Data/Syntax/Assignment/Spec.hs index d2d715c2b..8f2d0083c 100644 --- a/test/Data/Syntax/Assignment/Spec.hs +++ b/test/Data/Syntax/Assignment/Spec.hs @@ -176,7 +176,7 @@ spec = do fst <$> runAssignment "12" headF (symbol Red *> children (many (symbol Green *> children (symbol Blue *> source)))) (makeState [ node Red 0 2 [ node Green 0 1 [ node Blue 0 1 [] ] - , node Green 1 2 [ node Blue 1 2 [] ] ] ]) + , node Green 1 2 [ node Blue 1 2 [] ] ] ]) `shouldBe` Right ["1", "2"]