Smalltalk parser work in progress
parent
15cb926afb
commit
d0921b1d2d
|
@ -1,5 +1,7 @@
|
|||
IN: smalltalk.eval.tests
|
||||
USING: smalltalk.eval tools.test ;
|
||||
USING: smalltalk.eval tools.test io.streams.string ;
|
||||
|
||||
[ 3 ] [ "1+2" eval-smalltalk ] unit-test
|
||||
[ "HAI" ] [ "(1<10) ifTrue:['HAI'] ifFalse:['BAI']" eval-smalltalk ] unit-test
|
||||
[ "HAI" ] [ "(1<10) ifTrue:['HAI'] ifFalse:['BAI']" eval-smalltalk ] unit-test
|
||||
[ 7 ] [ "1+2+3;+4" eval-smalltalk ] unit-test
|
||||
[ 6 "5\n6\n" ] [ [ "[:x|x print] value: 5; value: 6" eval-smalltalk ] with-string-writer ] unit-test
|
|
@ -228,12 +228,12 @@ test = <foreign parse-smalltalk LocalVariableDeclarationList>
|
|||
[ T{ ast-local-variables f { "i" "j" } } ] [ " | i j |" test-LocalVariableDeclarationList ] unit-test
|
||||
|
||||
|
||||
EBNF: test-KeywordMessageSend
|
||||
test = <foreign parse-smalltalk KeywordMessageSend>
|
||||
EBNF: test-MessageSend
|
||||
test = <foreign parse-smalltalk MessageSend>
|
||||
;EBNF
|
||||
|
||||
[ T{ ast-message-send f T{ ast-name f "x" } "foo:bar:" { 1 2 } } ]
|
||||
[ "x foo:1 bar:2" test-KeywordMessageSend ] unit-test
|
||||
[ "x foo:1 bar:2" test-MessageSend ] unit-test
|
||||
|
||||
[
|
||||
T{ ast-message-send
|
||||
|
@ -247,7 +247,7 @@ test = <foreign parse-smalltalk KeywordMessageSend>
|
|||
{ 10 100 }
|
||||
}
|
||||
]
|
||||
[ "3 factorial + 4 factorial between: 10 and: 100" test-KeywordMessageSend ] unit-test
|
||||
[ "3 factorial + 4 factorial between: 10 and: 100" test-MessageSend ] unit-test
|
||||
|
||||
[ T{ ast-sequence f { 1 2 } } ] [ "1. 2" parse-smalltalk ] unit-test
|
||||
|
||||
|
@ -283,4 +283,6 @@ test = <foreign parse-smalltalk KeywordMessageSend>
|
|||
]
|
||||
[ "class Test1 [|a|]. class Test2 extends Test1 [|b|]" parse-smalltalk ] unit-test
|
||||
|
||||
[ ] [ "class Foo []. Tests blah " parse-smalltalk drop ] unit-test
|
||||
|
||||
[ ] [ "vocab:smalltalk/parser/test.st" ascii file-contents parse-smalltalk drop ] unit-test
|
||||
|
|
|
@ -104,7 +104,7 @@ BlockLiteral = "["
|
|||
"|"
|
||||
=> [[ args ]]
|
||||
)?:args
|
||||
ExecutableCode:body OptionalWhiteSpace
|
||||
ExecutableCode:body
|
||||
"]" => [[ args >array body ast-block boa ]]
|
||||
|
||||
Literal = (ConstantReference
|
||||
|
@ -125,41 +125,38 @@ Operand = Literal
|
|||
UnaryMessage = OptionalWhiteSpace
|
||||
UnaryMessageSelector:s !(":")
|
||||
=> [[ s { } ast-message boa ]]
|
||||
UnaryMessageOperand = UnaryMessageSend | Operand
|
||||
UnaryMessageSend = UnaryMessageOperand:receiver
|
||||
UnaryMessage:h
|
||||
(OptionalWhiteSpace ";" UnaryMessage:m => [[ m ]])*:t
|
||||
=> [[ receiver t h prefix >array <ast-cascade> ]]
|
||||
|
||||
BinaryMessage = OptionalWhiteSpace
|
||||
BinaryMessageSelector:selector
|
||||
OptionalWhiteSpace
|
||||
BinaryMessageOperand:rhs
|
||||
(MessageSend | Operand):rhs
|
||||
=> [[ selector { rhs } ast-message boa ]]
|
||||
|
||||
BinaryMessageOperand = BinaryMessageSend | UnaryMessageSend | Operand
|
||||
BinaryMessageSend = (BinaryMessageSend | UnaryMessageSend | Operand):lhs
|
||||
BinaryMessage:h
|
||||
(OptionalWhiteSpace ";" BinaryMessage:m => [[ m ]])*:t
|
||||
=> [[ lhs t h prefix >array <ast-cascade> ]]
|
||||
|
||||
KeywordMessageSegment = Keyword:k OptionalWhiteSpace BinaryMessageOperand:arg => [[ { k arg } ]]
|
||||
KeywordMessageSegment = Keyword:k OptionalWhiteSpace (BinaryMessageSend | UnaryMessageSend | Operand):arg => [[ { k arg } ]]
|
||||
KeywordMessage = OptionalWhiteSpace
|
||||
KeywordMessageSegment:h
|
||||
(OptionalWhiteSpace KeywordMessageSegment:s => [[ s ]])*:t
|
||||
=> [[ t h prefix unzip [ concat ] dip ast-message boa ]]
|
||||
KeywordMessageSend = (BinaryMessageSend | UnaryMessageSend | Operand):receiver
|
||||
OptionalWhiteSpace
|
||||
KeywordMessage:m
|
||||
=> [[ receiver m 1array <ast-cascade> ]]
|
||||
|
||||
Message = BinaryMessage | UnaryMessage | KeywordMessage
|
||||
|
||||
MessageSend = (MessageSend | Operand):lhs
|
||||
UnaryMessageSend = (MessageSend | Operand):lhs
|
||||
Message:h
|
||||
(OptionalWhiteSpace ";" Message:m => [[ m ]])*:t
|
||||
=> [[ lhs t h prefix >array <ast-cascade> ]]
|
||||
|
||||
BinaryMessageSend = (MessageSend | Operand):lhs
|
||||
Message:h
|
||||
(OptionalWhiteSpace ";" Message:m => [[ m ]])*:t
|
||||
=> [[ lhs t h prefix >array <ast-cascade> ]]
|
||||
|
||||
KeywordMessageSend = (BinaryMessageSend | UnaryMessageSend | Operand):lhs
|
||||
KeywordMessage:h
|
||||
(OptionalWhiteSpace ";" Message:m => [[ m ]])*:t
|
||||
=> [[ lhs t h prefix >array <ast-cascade> ]]
|
||||
|
||||
MessageSend = BinaryMessageSend | UnaryMessageSend | KeywordMessageSend
|
||||
|
||||
Expression = OptionalWhiteSpace
|
||||
(MessageSend | Operand):e
|
||||
=> [[ e ]]
|
||||
|
@ -182,6 +179,7 @@ LocalVariableDeclarationList = OptionalWhiteSpace "|" OptionalWhiteSpace
|
|||
ExecutableCode = (LocalVariableDeclarationList)?:locals
|
||||
((Statement:s OptionalWhiteSpace "." => [[ s ]])*:h
|
||||
FinalStatement:t (".")? => [[ h t suffix ]])?:body
|
||||
OptionalWhiteSpace
|
||||
=> [[ body locals [ suffix ] when* >array ]]
|
||||
|
||||
TopLevelForm = ExecutableCode => [[ ast-sequence boa ]]
|
||||
|
@ -201,7 +199,7 @@ MethodHeader = KeywordMethodHeader
|
|||
MethodDeclaration = OptionalWhiteSpace "method" OptionalWhiteSpace MethodHeader:header
|
||||
OptionalWhiteSpace "["
|
||||
ExecutableCode:code
|
||||
OptionalWhiteSpace "]"
|
||||
"]"
|
||||
=> [[ header first2 code ast-block boa ast-method boa ]]
|
||||
|
||||
ClassDeclaration = OptionalWhiteSpace "class" OptionalWhiteSpace Identifier:name
|
||||
|
@ -209,7 +207,13 @@ ClassDeclaration = OptionalWhiteSpace "class" OptionalWhiteSpace Identifier:name
|
|||
("extends" OptionalWhiteSpace Identifier:superclass OptionalWhiteSpace => [[ superclass ]])?:superclass
|
||||
OptionalWhiteSpace "["
|
||||
(OptionalWhiteSpace LocalVariableDeclarationList:l => [[ l names>> ]])?:ivars
|
||||
(MethodDeclaration:h (OptionalWhiteSpace MethodDeclaration:m => [[ m ]])*:t => [[ t h prefix ]])?:methods
|
||||
(MethodDeclaration:h
|
||||
(OptionalWhiteSpace
|
||||
"."
|
||||
OptionalWhiteSpace
|
||||
MethodDeclaration:m => [[ m ]])*:t (".")?
|
||||
=> [[ t h prefix ]]
|
||||
)?:methods
|
||||
OptionalWhiteSpace "]"
|
||||
=> [[ name superclass "Object" or ivars >array methods >array ast-class boa ]]
|
||||
|
||||
|
|
|
@ -30,23 +30,23 @@ class TreeNode extends Object [
|
|||
output
|
||||
nextPutAll: 'long lived tree of depth '; print: maxDepth; tab;
|
||||
nextPutAll: ' check: '; print: longLivedTree itemCheck; nl
|
||||
]
|
||||
].
|
||||
|
||||
method binarytrees [
|
||||
self binarytrees: self arg to: self stdout.
|
||||
^''
|
||||
]
|
||||
].
|
||||
|
||||
method left: leftChild right: rightChild item: anItem [
|
||||
left := leftChild.
|
||||
right := rightChild.
|
||||
item := anItem
|
||||
]
|
||||
].
|
||||
|
||||
method itemCheck [
|
||||
^left isNil
|
||||
ifTrue: [item] ifFalse: [item + (left itemCheck - right itemCheck)]
|
||||
]
|
||||
].
|
||||
|
||||
method bottomUpTree: anItem depth: anInteger [
|
||||
^(anInteger > 0)
|
||||
|
@ -56,11 +56,11 @@ class TreeNode extends Object [
|
|||
right: (self bottomUpTree: 2*anItem depth: anInteger - 1)
|
||||
item: anItem
|
||||
] ifFalse: [self left: nil right: nil item: anItem]
|
||||
]
|
||||
].
|
||||
|
||||
method left: leftChild right: rightChild item: anItem [
|
||||
^(super new) left: leftChild right: rightChild item: anItem
|
||||
]
|
||||
]
|
||||
].
|
||||
|
||||
Tests binarytrees
|
||||
|
|
Loading…
Reference in New Issue