github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-03 13:02:37 +03:00
Code Issues Projects Releases Wiki Activity

Pass the symbol in a record.

Browse Source
This commit is contained in:
Rob Rix 2017-04-21 09:52:23 -04:00
parent b5575d7298
commit 2f696ef88d
2 changed files with 10 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,4 +1,4 @@
{-# LANGUAGE GADTs, TypeFamilies #-} {-# LANGUAGE DataKinds, GADTs, TypeFamilies #-}
module Data.Syntax.Assignment module Data.Syntax.Assignment
( Assignment ( Assignment
, symbol , symbol
@ -14,6 +14,7 @@ module Data.Syntax.Assignment
import Control.Monad.Free.Freer import Control.Monad.Free.Freer
import Data.Functor.Classes import Data.Functor.Classes
import Data.Functor.Foldable import Data.Functor.Foldable
import Data.Record
import Data.Text (unpack) import Data.Text (unpack)
import Prologue hiding (Alt) import Prologue hiding (Alt)
import Source (Source()) import Source (Source())
@ -58,7 +59,7 @@ data Result a = Result a | Error [Text]
-- | Run an assignment of nodes in a grammar onto terms in a syntax, discarding any unparsed nodes. -- | Run an assignment of nodes in a grammar onto terms in a syntax, discarding any unparsed nodes.
assignAll :: (Symbol grammar, Eq grammar, Show grammar) => Assignment grammar a -> Source -> [Rose grammar] -> Result a assignAll :: (Symbol grammar, Eq grammar, Show grammar) => Assignment grammar a -> Source -> [Rose (Record '[grammar])] -> Result a
assignAll assignment source nodes = case runAssignment assignment source nodes of assignAll assignment source nodes = case runAssignment assignment source nodes of
Result (rest, a) -> case dropAnonymous rest of Result (rest, a) -> case dropAnonymous rest of
[] -> Result a [] -> Result a
@ -66,11 +67,11 @@ assignAll assignment source nodes = case runAssignment assignment source nodes o
Error e -> Error e Error e -> Error e
-- | Run an assignment of nodes in a grammar onto terms in a syntax. -- | Run an assignment of nodes in a grammar onto terms in a syntax.
runAssignment :: (Symbol grammar, Eq grammar, Show grammar) => Assignment grammar a -> Source -> [Rose grammar] -> Result ([Rose grammar], a) runAssignment :: (Symbol grammar, Eq grammar, Show grammar) => Assignment grammar a -> Source -> [Rose (Record '[grammar])] -> Result ([Rose (Record '[grammar])], a)
runAssignment = iterFreer (\ assignment yield source nodes -> case (assignment, dropAnonymous nodes) of runAssignment = iterFreer (\ assignment yield source nodes -> case (assignment, dropAnonymous nodes) of
-- 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. -- 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, nodes) -> yield a source nodes <|> yield b source nodes -- FIXME: Symbol `Alt` Symbol `Alt` Symbol is inefficient, should build and match against an IntMap instead. (Alt a b, nodes) -> yield a source nodes <|> yield b source nodes -- FIXME: Symbol `Alt` Symbol `Alt` Symbol is inefficient, should build and match against an IntMap instead.
(assignment, node@(Rose nodeSymbol children) : rest) -> case assignment of (assignment, node@(Rose (nodeSymbol :. _) children) : rest) -> case assignment of
Symbol symbol -> guard (symbol == nodeSymbol) >> yield () source nodes Symbol symbol -> guard (symbol == nodeSymbol) >> yield () source nodes
Source -> yield "" source rest Source -> yield "" source rest
Children childAssignment -> do Children childAssignment -> do
@ -83,8 +84,8 @@ runAssignment = iterFreer (\ assignment yield source nodes -> case (assignment,
_ -> Error ["No rule to match at end of input."]) _ -> Error ["No rule to match at end of input."])
. fmap (\ a _ rest -> Result (rest, a)) . fmap (\ a _ rest -> Result (rest, a))
dropAnonymous :: Symbol grammar => [Rose grammar] -> [Rose grammar] dropAnonymous :: Symbol grammar => [Rose (Record '[grammar])] -> [Rose (Record '[grammar])]
dropAnonymous = dropWhile ((/= Regular) . symbolType . roseValue) dropAnonymous = dropWhile ((/= Regular) . symbolType . rhead . roseValue)
instance Alternative (Assignment symbol) where instance Alternative (Assignment symbol) where

6
src/TreeSitter.hs
View File

@ -49,7 +49,7 @@ treeSitterParser language grammar blob = do
-- | Parse Ruby to AST. Intended for use in ghci, e.g.: -- | Parse Ruby to AST. Intended for use in ghci, e.g.:
-- --
-- > Source.readAndTranscodeFile "/Users/rob/Desktop/test.rb" >>= parseRubyToAST >>= pure . uncurry (assignAll assignment) . second pure -- > Source.readAndTranscodeFile "/Users/rob/Desktop/test.rb" >>= parseRubyToAST >>= pure . uncurry (assignAll assignment) . second pure
parseRubyToAST :: Source -> IO (Source, A.Rose Ruby.Grammar) parseRubyToAST :: Source -> IO (Source, A.Rose (Record '[Ruby.Grammar]))
parseRubyToAST source = do parseRubyToAST source = do
document <- ts_document_new document <- ts_document_new
ts_document_set_language document Ruby.tree_sitter_ruby ts_document_set_language document Ruby.tree_sitter_ruby
@ -64,13 +64,13 @@ parseRubyToAST source = do
ts_document_free document ts_document_free document
pure (source, ast) pure (source, ast)
where toAST :: Node -> IO (A.RoseF Ruby.Grammar Node) where toAST :: Node -> IO (A.RoseF (Record '[Ruby.Grammar]) Node)
toAST Node{..} = do toAST Node{..} = do
let count = fromIntegral nodeChildCount let count = fromIntegral nodeChildCount
children <- allocaArray count $ \ childNodesPtr -> do children <- allocaArray count $ \ childNodesPtr -> do
_ <- with nodeTSNode (\ nodePtr -> ts_node_copy_child_nodes nullPtr nodePtr childNodesPtr (fromIntegral count)) _ <- with nodeTSNode (\ nodePtr -> ts_node_copy_child_nodes nullPtr nodePtr childNodesPtr (fromIntegral count))
peekArray count childNodesPtr peekArray count childNodesPtr
pure $ A.RoseF (toEnum (fromIntegral nodeSymbol)) children pure $ A.RoseF (toEnum (fromIntegral nodeSymbol) :. Nil) children
anaM :: (Corecursive t, Monad m, Traversable (Base t)) => (a -> m (Base t a)) -> a -> m t anaM :: (Corecursive t, Monad m, Traversable (Base t)) => (a -> m (Base t a)) -> a -> m t
anaM g = a where a = pure . embed <=< traverse a <=< g anaM g = a where a = pure . embed <=< traverse a <=< g