Smalltalk parser work in progress

db4
Slava Pestov 2009-03-31 22:30:13 -05:00
parent 15cb926afb
commit d0921b1d2d
4 changed files with 41 additions and 33 deletions

View File

@ -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

View File

@ -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

View File

@ -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 ]]

View File

@ -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