github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-30 10:27:45 +03:00
Code Issues Projects Releases Wiki Activity

Construct a Choose node from a list of Choose nodes.

Browse Source
This commit is contained in:
Rob Rix 2017-08-31 11:02:18 -04:00
parent 90ea2e5193
commit 0715f8a0b2
1 changed files with 8 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
src/Data/Syntax/Assignment.hs
View File

@ -75,7 +75,7 @@ module Data.Syntax.Assignment
, source
, children
, advance
, choose
, choice
, token
, while
, until
@ -119,7 +119,7 @@ import GHC.Stack
import qualified Info
import Prelude hiding (until)
import Term (runCofree)
import Text.Parser.Combinators as Parsers
import Text.Parser.Combinators as Parsers hiding (choice)
import TreeSitter.Language
-- | Assignment from an AST with some set of 'symbol's onto some other value.
@ -179,8 +179,12 @@ children child = tracing (Children child) `Then` return
advance :: HasCallStack => Assignment ast grammar ()
advance = tracing Advance `Then` return
choose :: (Bounded grammar, Ix grammar, HasCallStack) => [(grammar, Assignment ast grammar a)] -> Assignment ast grammar a
choose choices = tracing (Choose (fmap fst choices) (IntMap.fromList (fmap (first toIndex) choices)) Nothing) `Then` id
choice :: (Bounded grammar, Ix grammar, HasCallStack) => [Assignment ast grammar a] -> Assignment ast grammar a
choice alternatives = tracing (Choose symbols (IntMap.fromList choices) (asum (fmap Just atEnd))) `Then` id
where (symbols, choices, atEnd) = foldr (<>) ([], [], []) (fmap toChoices alternatives)
toChoices rule = case rule of
Tracing _ (Choose s c a) `Then` continue -> (s, IntMap.toList (fmap continue c), toList (fmap continue a))
_ -> ([], [], [rule])
-- | Match and advance past a node with the given symbol.
token :: (Bounded grammar, Ix grammar, HasCallStack) => grammar -> Assignment ast grammar (Record Location)