1
1
mirror of https://github.com/github/semantic.git synced 2024-12-25 07:55:12 +03:00

tokenizing for Ruby blocks (functions)

This commit is contained in:
Timothy Clem 2018-08-21 13:17:13 -07:00
parent 9e0e56479e
commit 1a9200b783
6 changed files with 46 additions and 17 deletions

View File

@ -49,6 +49,8 @@ data Context
| THash | THash
| TPair | TPair
| TMethod | TMethod
| TFunction
| TCall
| TParams | TParams
| Infix Operator | Infix Operator
| Imperative | Imperative

View File

@ -32,6 +32,14 @@ instance Evaluatable Function where
pure (Rval addr) pure (Rval addr)
where paramNames = foldMap (maybeToList . declaredName . subterm) where paramNames = foldMap (maybeToList . declaredName . subterm)
instance Tokenize Function where
tokenize Function{..} = within TFunction $ do
yield TOpen
functionName
surround_ TParams (sep functionParameters)
functionBody
yield TClose
instance Declarations1 Function where instance Declarations1 Function where
liftDeclaredName declaredName = declaredName . functionName liftDeclaredName declaredName = declaredName . functionName

View File

@ -51,7 +51,7 @@ type MiniSyntax = '[
Literal.Integer Literal.Integer
, Comment.Comment , Comment.Comment
, Declaration.Method , Declaration.Method
-- , Declaration.Function , Declaration.Function
-- , Expression.Call -- , Expression.Call
, Ruby.Syntax.Send , Ruby.Syntax.Send
-- , Ruby.Syntax.Load -- , Ruby.Syntax.Load
@ -73,11 +73,12 @@ miniAssignment = handleError $ makeTerm <$> symbol Program <*> children (Stateme
expression = term . handleError $ expression = term . handleError $
choice [ number choice [ number
, identifier , identifier
, method ] , method
-- , methodCall ] , methodCall ]
-- NOTE: Important that we don't flatten out the Imperative for single item lists
expressions :: Assignment MiniTerm expressions :: Assignment MiniTerm
expressions = makeTerm'' <$> location <*> many expression expressions = makeTerm <$> location <*> many expression
number :: Assignment MiniTerm number :: Assignment MiniTerm
number = makeTerm <$> symbol Grammar.Integer <*> (Literal.Integer <$> source) number = makeTerm <$> symbol Grammar.Integer <*> (Literal.Integer <$> source)
@ -152,7 +153,7 @@ miniAssignment = handleError $ makeTerm <$> symbol Program <*> children (Stateme
methodCall :: Assignment MiniTerm methodCall :: Assignment MiniTerm
methodCall = makeTerm' <$> symbol MethodCall <*> children send -- (require <|> load <|> send) methodCall = makeTerm' <$> symbol MethodCall <*> children send -- (require <|> load <|> send)
where where
send = inject <$> ((regularCall <|> funcCall <|> scopeCall <|> dotCall) <*> pure Nothing {- optional block -}) send = inject <$> ((regularCall <|> funcCall <|> scopeCall <|> dotCall) <*> optional block)
funcCall = Ruby.Syntax.Send Nothing <$> selector <*> args funcCall = Ruby.Syntax.Send Nothing <$> selector <*> args
regularCall = symbol Call *> children (Ruby.Syntax.Send <$> (Just <$> expression) <*> selector) <*> args regularCall = symbol Call *> children (Ruby.Syntax.Send <$> (Just <$> expression) <*> selector) <*> args
@ -173,12 +174,12 @@ miniAssignment = handleError $ makeTerm <$> symbol Program <*> children (Stateme
args :: Assignment [MiniTerm] args :: Assignment [MiniTerm]
args = (symbol ArgumentList <|> symbol ArgumentListWithParens) *> children (many expression) <|> many expression args = (symbol ArgumentList <|> symbol ArgumentListWithParens) *> children (many expression) <|> many expression
-- block :: Assignment MiniTerm block :: Assignment MiniTerm
-- block = makeTerm <$> symbol DoBlock <*> scopedBlockChildren block = makeTerm <$> symbol DoBlock <*> scopedBlockChildren
-- <|> makeTerm <$> symbol Block <*> scopedBlockChildren <|> makeTerm <$> symbol Block <*> scopedBlockChildren
-- where scopedBlockChildren = withExtendedScope blockChildren where scopedBlockChildren = withExtendedScope blockChildren
-- blockChildren = children (Declaration.Function [] <$> emptyTerm <*> params <*> expressions) blockChildren = children (Declaration.Function [] <$> emptyTerm <*> params <*> expressions)
-- params = symbol BlockParameters *> children (many parameter) <|> pure [] params = symbol BlockParameters *> children (many parameter) <|> pure []
comment :: Assignment MiniTerm comment :: Assignment MiniTerm
comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source) comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)

View File

@ -13,6 +13,7 @@ import qualified Data.Text as T
import Diffing.Algorithm import Diffing.Algorithm
import Prologue import Prologue
import Proto3.Suite.Class import Proto3.Suite.Class
import Reprinting.Tokenize
import System.FilePath.Posix import System.FilePath.Posix
@ -65,6 +66,13 @@ instance Evaluatable Send where
args <- traverse subtermAddress sendArgs args <- traverse subtermAddress sendArgs
Rval <$> call func recv args -- TODO pass through sendBlock Rval <$> call func recv args -- TODO pass through sendBlock
instance Tokenize Send where
tokenize Send{..} = within TCall $ do
maybe (pure ()) (\r -> r *> yield TSep) sendReceiver
fromMaybe (pure ()) sendSelector
surround_ TParams (sep sendArgs)
fromMaybe (pure ()) sendBlock
data Require a = Require { requireRelative :: Bool, requirePath :: !a } data Require a = Require { requireRelative :: Bool, requirePath :: !a }
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1) deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)

View File

@ -16,9 +16,15 @@ step s@(Unhandled el cs) = case (el, cs) of
(TOpen, TMethod:_) -> emit "def" <> layout Space (TOpen, TMethod:_) -> emit "def" <> layout Space
(TClose, TMethod:xs) -> endContext (depth xs) <> emit "end" (TClose, TMethod:xs) -> endContext (depth xs) <> emit "end"
(TOpen, TParams:TMethod:_) -> emit "(" -- TODO: do..end vs {..} should be configurable.
(TSep, TParams:TMethod:_) -> emit "," <> layout Space (TOpen, TFunction:_) -> layout Space <> emit "do" <> layout Space
(TClose, TParams:TMethod:_) -> emit ")" (TOpen, TParams:TFunction:_) -> emit "|"
(TClose, TParams:TFunction:_) -> emit "|"
(TClose, TFunction:xs) -> endContext (depth xs) <> emit "end"
(TOpen, TParams:_) -> emit "("
(TSep, TParams:_) -> emit "," <> layout Space
(TClose, TParams:_) -> emit ")"
(TOpen, Imperative:[]) -> mempty (TOpen, Imperative:[]) -> mempty
(TOpen, Imperative:xs) -> layout HardWrap <> indent (depth xs) (TOpen, Imperative:xs) -> layout HardWrap <> indent (depth xs)
@ -26,6 +32,8 @@ step s@(Unhandled el cs) = case (el, cs) of
(TClose, Imperative:[]) -> layout HardWrap (TClose, Imperative:[]) -> layout HardWrap
(TClose, Imperative:xs) -> indent (pred (depth xs)) (TClose, Imperative:xs) -> indent (pred (depth xs))
(TSep, TCall:_) -> emit "."
_ -> pure s _ -> pure s
where where

View File

@ -1,5 +1,7 @@
def foo(x, y) def foo(x)
def bar(); end
x x
5 end
5.times do |i|
i
end end