smalltalk: fix various things in the parser, add temporary variable support, clean up compiler
Slava Pestov
parent
86cf94260c
commit
9f01e819e8
|
|
@ -1,12 +1,12 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: strings arrays memoize kernel sequences accessors ;
|
||||
USING: strings arrays memoize kernel sequences accessors combinators ;
|
||||
IN: smalltalk.ast
|
||||
|
||||
SINGLETONS: nil self super ;
|
||||
|
||||
TUPLE: ast-comment { string string } ;
|
||||
TUPLE: ast-block { arguments array } { body array } ;
|
||||
TUPLE: ast-block { arguments array } { temporaries array } { body array } ;
|
||||
TUPLE: ast-message-send receiver { selector string } { arguments array } ;
|
||||
TUPLE: ast-message { selector string } { arguments array } ;
|
||||
TUPLE: ast-cascade receiver { messages array } ;
|
||||
|
|
@ -17,8 +17,28 @@ TUPLE: ast-local-variables { names array } ;
|
|||
TUPLE: ast-method { name string } { body ast-block } ;
|
||||
TUPLE: ast-class { name string } { superclass string } { ivars array } { methods array } ;
|
||||
TUPLE: ast-foreign { class string } { name string } ;
|
||||
TUPLE: ast-sequence { statements array } ;
|
||||
TUPLE: ast-sequence { temporaries array } { body array } ;
|
||||
|
||||
! We treat a sequence of statements like a block in a few places to
|
||||
! simplify handling of top-level forms
|
||||
M: ast-sequence arguments>> drop { } ;
|
||||
|
||||
: unclip-temporaries ( statements -- temporaries statements' )
|
||||
{
|
||||
{ [ dup empty? ] [ { } ] }
|
||||
{ [ dup first ast-local-variables? not ] [ { } ] }
|
||||
[ unclip names>> ]
|
||||
} cond swap ;
|
||||
|
||||
: <ast-block> ( arguments body -- block )
|
||||
unclip-temporaries ast-block boa ;
|
||||
|
||||
: <ast-sequence> ( body -- block )
|
||||
unclip-temporaries ast-sequence boa ;
|
||||
|
||||
! The parser parses normal message sends as cascades with one message, but
|
||||
! we represent them differently in the AST to simplify generated code in
|
||||
! the common case
|
||||
: <ast-cascade> ( receiver messages -- ast )
|
||||
dup length 1 =
|
||||
[ first [ selector>> ] [ arguments>> ] bi ast-message-send boa ]
|
||||
|
|
|
|||
|
|
@ -1,10 +1,13 @@
|
|||
USING: smalltalk.compiler tools.test prettyprint smalltalk.ast
|
||||
smalltalk.compiler.lexenv stack-checker locals.rewrite.closures
|
||||
kernel accessors compiler.units sequences ;
|
||||
kernel accessors compiler.units sequences arrays ;
|
||||
IN: smalltalk.compiler.tests
|
||||
|
||||
: test-compilation ( ast -- quot )
|
||||
[ compile-smalltalk [ call ] append ] with-compilation-unit ;
|
||||
[
|
||||
1array ast-sequence new swap >>body
|
||||
compile-smalltalk [ call ] append
|
||||
] with-compilation-unit ;
|
||||
|
||||
: test-inference ( ast -- in# out# )
|
||||
test-compilation infer [ in>> ] [ out>> ] bi ;
|
||||
|
|
@ -46,6 +49,7 @@ IN: smalltalk.compiler.tests
|
|||
|
||||
[ 0 1 ] [
|
||||
T{ ast-block f
|
||||
{ }
|
||||
{ }
|
||||
{
|
||||
T{ ast-message-send
|
||||
|
|
@ -76,6 +80,7 @@ IN: smalltalk.compiler.tests
|
|||
|
||||
[ "a" ] [
|
||||
T{ ast-block f
|
||||
{ }
|
||||
{ }
|
||||
{ { T{ ast-block { body { "a" } } } } }
|
||||
} test-compilation call first call
|
||||
|
|
|
|||
|
|
@ -2,77 +2,12 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays assocs combinators.short-circuit
|
||||
continuations fry kernel namespaces quotations sequences sets
|
||||
generalizations slots locals.types generalizations splitting math
|
||||
locals.rewrite.closures generic words combinators smalltalk.ast
|
||||
smalltalk.compiler.lexenv smalltalk.selectors
|
||||
smalltalk.classes ;
|
||||
generalizations slots locals.types splitting math
|
||||
locals.rewrite.closures generic words combinators locals smalltalk.ast
|
||||
smalltalk.compiler.lexenv smalltalk.compiler.assignment
|
||||
smalltalk.compiler.return smalltalk.selectors smalltalk.classes ;
|
||||
IN: smalltalk.compiler
|
||||
|
||||
SYMBOL: return-continuation
|
||||
|
||||
GENERIC: need-return-continuation? ( ast -- ? )
|
||||
|
||||
M: ast-return need-return-continuation? drop t ;
|
||||
|
||||
M: ast-block need-return-continuation? body>> need-return-continuation? ;
|
||||
|
||||
M: ast-message-send need-return-continuation?
|
||||
{
|
||||
[ receiver>> need-return-continuation? ]
|
||||
[ arguments>> need-return-continuation? ]
|
||||
} 1&& ;
|
||||
|
||||
M: ast-cascade need-return-continuation?
|
||||
{
|
||||
[ receiver>> need-return-continuation? ]
|
||||
[ messages>> need-return-continuation? ]
|
||||
} 1&& ;
|
||||
|
||||
M: ast-message need-return-continuation?
|
||||
arguments>> need-return-continuation? ;
|
||||
|
||||
M: ast-assignment need-return-continuation?
|
||||
value>> need-return-continuation? ;
|
||||
|
||||
M: ast-sequence need-return-continuation?
|
||||
statements>> need-return-continuation? ;
|
||||
|
||||
M: array need-return-continuation? [ need-return-continuation? ] any? ;
|
||||
|
||||
M: object need-return-continuation? drop f ;
|
||||
|
||||
GENERIC: assigned-locals ( ast -- seq )
|
||||
|
||||
M: ast-return assigned-locals value>> assigned-locals ;
|
||||
|
||||
M: ast-block assigned-locals
|
||||
[ body>> assigned-locals ] [ arguments>> ] bi diff ;
|
||||
|
||||
M: ast-message-send assigned-locals
|
||||
[ receiver>> assigned-locals ]
|
||||
[ arguments>> assigned-locals ]
|
||||
bi append ;
|
||||
|
||||
M: ast-cascade assigned-locals
|
||||
[ arguments>> assigned-locals ]
|
||||
[ messages>> assigned-locals ]
|
||||
bi append ;
|
||||
|
||||
M: ast-message assigned-locals
|
||||
arguments>> assigned-locals ;
|
||||
|
||||
M: ast-assignment assigned-locals
|
||||
[ name>> dup ast-name? [ name>> 1array ] [ drop { } ] if ]
|
||||
[ value>> assigned-locals ] bi append ;
|
||||
|
||||
M: ast-sequence assigned-locals
|
||||
statements>> assigned-locals ;
|
||||
|
||||
M: array assigned-locals
|
||||
[ assigned-locals ] map concat ;
|
||||
|
||||
M: object assigned-locals drop f ;
|
||||
|
||||
GENERIC: compile-ast ( lexenv ast -- quot )
|
||||
|
||||
M: object compile-ast nip 1quotation ;
|
||||
|
|
@ -108,11 +43,39 @@ M: ast-return compile-ast
|
|||
value>> compile-ast
|
||||
[ return-continuation get continue-with ] append ;
|
||||
|
||||
: compile-sequence ( lexenv asts -- quot )
|
||||
[ drop [ nil ] ] [ [ compile-ast ] with map [ drop ] join ] if-empty ;
|
||||
: (compile-sequence) ( lexenv asts -- quot )
|
||||
[ drop [ nil ] ] [
|
||||
[ compile-ast ] with map [ drop ] join
|
||||
] if-empty ;
|
||||
|
||||
: block-lexenv ( block -- lexenv )
|
||||
[ [ arguments>> ] [ temporaries>> ] bi append ]
|
||||
[ body>> [ assigned-locals ] map concat unique ] bi
|
||||
'[
|
||||
dup dup _ key?
|
||||
[ <local-reader> ]
|
||||
[ <local> ]
|
||||
if
|
||||
] H{ } map>assoc
|
||||
dup
|
||||
[ nip local-reader? ] assoc-filter
|
||||
[ <local-writer> ] assoc-map
|
||||
<lexenv> swap >>local-writers swap >>local-readers ;
|
||||
|
||||
: lookup-block-vars ( vars lexenv -- seq )
|
||||
local-readers>> '[ _ at ] map ;
|
||||
|
||||
: make-temporaries ( block lexenv -- quot )
|
||||
[ temporaries>> ] dip lookup-block-vars
|
||||
[ <def> [ f ] swap suffix ] map [ ] join ;
|
||||
|
||||
:: compile-sequence ( lexenv block -- vars quot )
|
||||
lexenv block block-lexenv lexenv-union :> lexenv
|
||||
block arguments>> lexenv lookup-block-vars
|
||||
lexenv block body>> (compile-sequence) block lexenv make-temporaries prepend ;
|
||||
|
||||
M: ast-sequence compile-ast
|
||||
statements>> compile-sequence ;
|
||||
compile-sequence nip ;
|
||||
|
||||
GENERIC: contains-blocks? ( obj -- ? )
|
||||
|
||||
|
|
@ -135,48 +98,12 @@ M: ast-name compile-assignment name>> swap lookup-writer ;
|
|||
M: ast-assignment compile-ast
|
||||
[ value>> compile-ast [ dup ] ] [ name>> compile-assignment ] 2bi 3append ;
|
||||
|
||||
: block-lexenv ( block -- lexenv )
|
||||
[ arguments>> ] [ body>> [ assigned-locals ] map concat unique ] bi
|
||||
'[
|
||||
dup dup _ key?
|
||||
[ <local-reader> ]
|
||||
[ <local> ]
|
||||
if
|
||||
] { } map>assoc
|
||||
dup
|
||||
[ nip local-reader? ] assoc-filter
|
||||
[ <local-writer> ] assoc-map
|
||||
<lexenv> swap >>local-writers swap >>local-readers ;
|
||||
|
||||
: compile-block ( lexenv block -- vars body )
|
||||
[
|
||||
block-lexenv
|
||||
[ nip local-readers>> values ]
|
||||
[ lexenv-union ] 2bi
|
||||
] [ body>> ] bi
|
||||
compile-sequence ;
|
||||
|
||||
M: ast-block compile-ast
|
||||
compile-block <lambda> '[ _ ] ;
|
||||
compile-sequence <lambda> '[ _ ] ;
|
||||
|
||||
: make-return ( quot n block -- quot )
|
||||
need-return-continuation? [
|
||||
'[
|
||||
[
|
||||
_ _ ncurry
|
||||
[ return-continuation set ] prepose callcc1
|
||||
] with-scope
|
||||
]
|
||||
] [ drop ] if
|
||||
rewrite-closures first ;
|
||||
|
||||
GENERIC: compile-smalltalk ( ast -- quot )
|
||||
|
||||
M: object compile-smalltalk ( statement -- quot )
|
||||
[ [ empty-lexenv ] dip compile-ast 0 ] keep make-return ;
|
||||
|
||||
: (compile-method-body) ( lexenv block -- lambda )
|
||||
[ drop self>> ] [ compile-block ] 2bi [ swap suffix ] dip <lambda> ;
|
||||
:: (compile-method-body) ( lexenv block -- lambda )
|
||||
lexenv block compile-sequence
|
||||
[ lexenv self>> suffix ] dip <lambda> ;
|
||||
|
||||
: compile-method-body ( lexenv block -- quot )
|
||||
[ [ (compile-method-body) ] [ arguments>> length 1+ ] bi ] keep
|
||||
|
|
@ -190,7 +117,8 @@ M: object compile-smalltalk ( statement -- quot )
|
|||
: <class-lexenv> ( class -- lexenv )
|
||||
<lexenv> swap >>class "self" <local-reader> >>self ;
|
||||
|
||||
M: ast-class compile-smalltalk ( ast-class -- quot )
|
||||
M: ast-class compile-ast
|
||||
nip
|
||||
[
|
||||
[ name>> ] [ superclass>> ] [ ivars>> ] tri
|
||||
define-class <class-lexenv>
|
||||
|
|
@ -201,7 +129,12 @@ M: ast-class compile-smalltalk ( ast-class -- quot )
|
|||
|
||||
ERROR: no-word name ;
|
||||
|
||||
M: ast-foreign compile-smalltalk
|
||||
M: ast-foreign compile-ast
|
||||
nip
|
||||
[ class>> dup ":" split1 lookup [ ] [ no-word ] ?if ]
|
||||
[ name>> ] bi define-foreign
|
||||
[ nil ] ;
|
||||
|
||||
: compile-smalltalk ( statement -- quot )
|
||||
[ [ empty-lexenv ] dip compile-sequence nip 0 ]
|
||||
keep make-return ;
|
||||
|
|
@ -5,3 +5,5 @@ USING: smalltalk.eval tools.test io.streams.string ;
|
|||
[ "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
|
||||
[ 5 ] [ "|x| x:=5. x" eval-smalltalk ] unit-test
|
||||
[ 11 ] [ "[:i| |x| x:=5. i+x] value: 6" eval-smalltalk ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,8 +1,12 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: compiler.units smalltalk.parser smalltalk.compiler ;
|
||||
USING: io.files io.encodings.utf8
|
||||
compiler.units smalltalk.parser smalltalk.compiler ;
|
||||
IN: smalltalk.eval
|
||||
|
||||
: eval-smalltalk ( string -- result )
|
||||
[ parse-smalltalk compile-smalltalk ] with-compilation-unit
|
||||
call( -- result ) ;
|
||||
|
||||
: eval-smalltalk-file ( path -- result )
|
||||
utf8 file-contents eval-smalltalk ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel present io math sequences assocs math.ranges fry
|
||||
tools.time locals smalltalk.selectors smalltalk.ast smalltalk.classes ;
|
||||
USING: kernel present io math sequences assocs math.ranges
|
||||
math.order fry tools.time locals smalltalk.selectors
|
||||
smalltalk.ast smalltalk.classes ;
|
||||
IN: smalltalk.library
|
||||
|
||||
SELECTOR: print
|
||||
|
|
@ -10,6 +11,16 @@ SELECTOR: asString
|
|||
M: object selector-print dup present print ;
|
||||
M: object selector-asString present ;
|
||||
|
||||
SELECTOR: print:
|
||||
SELECTOR: nextPutAll:
|
||||
SELECTOR: tab
|
||||
SELECTOR: nl
|
||||
|
||||
M: object selector-print: [ present ] dip stream-print nil ;
|
||||
M: object selector-nextPutAll: selector-print: ;
|
||||
M: object selector-tab " " swap selector-print: ;
|
||||
M: object selector-nl stream-nl nil ;
|
||||
|
||||
SELECTOR: +
|
||||
SELECTOR: -
|
||||
SELECTOR: *
|
||||
|
|
@ -30,6 +41,12 @@ M: object selector-<= swap <= ;
|
|||
M: object selector->= swap >= ;
|
||||
M: object selector-= swap = ;
|
||||
|
||||
SELECTOR: min:
|
||||
SELECTOR: max:
|
||||
|
||||
M: object selector-min: min ;
|
||||
M: object selector-max: max ;
|
||||
|
||||
SELECTOR: ifTrue:
|
||||
SELECTOR: ifFalse:
|
||||
SELECTOR: ifTrue:ifFalse:
|
||||
|
|
@ -38,6 +55,10 @@ M: object selector-ifTrue: [ call( -- result ) ] [ drop nil ] if ;
|
|||
M: object selector-ifFalse: [ drop nil ] [ call( -- result ) ] if ;
|
||||
M: object selector-ifTrue:ifFalse: [ drop call( -- result ) ] [ nip call( -- result ) ] if ;
|
||||
|
||||
SELECTOR: isNil
|
||||
|
||||
M: object selector-isNil nil eq? ;
|
||||
|
||||
SELECTOR: at:
|
||||
SELECTOR: at:put:
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel prettyprint io io.styles colors.constants compiler.units
|
||||
fry debugger sequences locals.rewrite.closures smalltalk.ast
|
||||
smalltalk.eval smalltalk.printer ;
|
||||
smalltalk.eval smalltalk.printer smalltalk.listener ;
|
||||
IN: smalltalk.listener
|
||||
|
||||
: eval-interactively ( string -- )
|
||||
|
|
|
|||
|
|
@ -49,9 +49,9 @@ test = <foreign parse-smalltalk Literal>
|
|||
[ B{ 1 2 3 4 } ] [ "#[1 2 3 4]" test-Literal ] unit-test
|
||||
[ { nil t f } ] [ "#(nil true false)" test-Literal ] unit-test
|
||||
[ { nil { t f } } ] [ "#(nil (true false))" test-Literal ] unit-test
|
||||
[ T{ ast-block f { } { } } ] [ "[]" test-Literal ] unit-test
|
||||
[ T{ ast-block f { "x" } { T{ ast-return f T{ ast-name f "x" } } } } ] [ "[ :x|^x]" test-Literal ] unit-test
|
||||
[ T{ ast-block f { } { T{ ast-return f self } } } ] [ "[^self]" test-Literal ] unit-test
|
||||
[ T{ ast-block f { } { } { } } ] [ "[]" test-Literal ] unit-test
|
||||
[ T{ ast-block f { "x" } { } { T{ ast-return f T{ ast-name f "x" } } } } ] [ "[ :x|^x]" test-Literal ] unit-test
|
||||
[ T{ ast-block f { } { } { T{ ast-return f self } } } ] [ "[^self]" test-Literal ] unit-test
|
||||
|
||||
[
|
||||
T{ ast-block
|
||||
|
|
@ -190,6 +190,19 @@ test = <foreign parse-smalltalk Expression>
|
|||
]
|
||||
[ "12 sqrt + 1; + 2" test-Expression ] unit-test
|
||||
|
||||
[
|
||||
T{ ast-cascade
|
||||
{ receiver T{ ast-message-send f 12 "squared" } }
|
||||
{ messages
|
||||
{
|
||||
T{ ast-message f "to:" { 100 } }
|
||||
T{ ast-message f "sqrt" }
|
||||
}
|
||||
}
|
||||
}
|
||||
]
|
||||
[ "12 squared to: 100; sqrt" test-Expression ] unit-test
|
||||
|
||||
[
|
||||
T{ ast-message-send f
|
||||
T{ ast-message-send f 1 "+" { 2 } }
|
||||
|
|
@ -228,12 +241,8 @@ test = <foreign parse-smalltalk LocalVariableDeclarationList>
|
|||
[ T{ ast-local-variables f { "i" "j" } } ] [ " | i j |" test-LocalVariableDeclarationList ] unit-test
|
||||
|
||||
|
||||
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-MessageSend ] unit-test
|
||||
[ "x foo:1 bar:2" test-Expression ] unit-test
|
||||
|
||||
[
|
||||
T{ ast-message-send
|
||||
|
|
@ -247,12 +256,14 @@ test = <foreign parse-smalltalk MessageSend>
|
|||
{ 10 100 }
|
||||
}
|
||||
]
|
||||
[ "3 factorial + 4 factorial between: 10 and: 100" test-MessageSend ] unit-test
|
||||
[ "3 factorial + 4 factorial between: 10 and: 100" test-Expression ] unit-test
|
||||
|
||||
[ T{ ast-sequence f { 1 2 } } ] [ "1. 2" parse-smalltalk ] unit-test
|
||||
[ T{ ast-sequence f { } { 1 2 } } ] [ "1. 2" parse-smalltalk ] unit-test
|
||||
|
||||
[ T{ ast-sequence f { } { 1 2 } } ] [ "1. 2." parse-smalltalk ] unit-test
|
||||
|
||||
[
|
||||
T{ ast-sequence f
|
||||
T{ ast-sequence f { }
|
||||
{
|
||||
T{ ast-class
|
||||
{ name "Test" }
|
||||
|
|
@ -265,7 +276,7 @@ test = <foreign parse-smalltalk MessageSend>
|
|||
[ "class Test [|a|]" parse-smalltalk ] unit-test
|
||||
|
||||
[
|
||||
T{ ast-sequence f
|
||||
T{ ast-sequence f { }
|
||||
{
|
||||
T{ ast-class
|
||||
{ name "Test1" }
|
||||
|
|
|
|||
|
|
@ -105,7 +105,7 @@ BlockLiteral = "["
|
|||
=> [[ args ]]
|
||||
)?:args
|
||||
ExecutableCode:body
|
||||
"]" => [[ args >array body ast-block boa ]]
|
||||
"]" => [[ args >array body <ast-block> ]]
|
||||
|
||||
Literal = (ConstantReference
|
||||
| FloatingPointLiteral
|
||||
|
|
@ -129,7 +129,7 @@ UnaryMessage = OptionalWhiteSpace
|
|||
BinaryMessage = OptionalWhiteSpace
|
||||
BinaryMessageSelector:selector
|
||||
OptionalWhiteSpace
|
||||
(MessageSend | Operand):rhs
|
||||
(UnaryMessageSend | Operand):rhs
|
||||
=> [[ selector { rhs } ast-message boa ]]
|
||||
|
||||
KeywordMessageSegment = Keyword:k OptionalWhiteSpace (BinaryMessageSend | UnaryMessageSend | Operand):arg => [[ { k arg } ]]
|
||||
|
|
@ -140,13 +140,13 @@ KeywordMessage = OptionalWhiteSpace
|
|||
|
||||
Message = BinaryMessage | UnaryMessage | KeywordMessage
|
||||
|
||||
UnaryMessageSend = (MessageSend | Operand):lhs
|
||||
Message:h
|
||||
UnaryMessageSend = (UnaryMessageSend | Operand):lhs
|
||||
UnaryMessage:h
|
||||
(OptionalWhiteSpace ";" Message:m => [[ m ]])*:t
|
||||
=> [[ lhs t h prefix >array <ast-cascade> ]]
|
||||
|
||||
BinaryMessageSend = (MessageSend | Operand):lhs
|
||||
Message:h
|
||||
BinaryMessageSend = (BinaryMessageSend | UnaryMessageSend | Operand):lhs
|
||||
BinaryMessage:h
|
||||
(OptionalWhiteSpace ";" Message:m => [[ m ]])*:t
|
||||
=> [[ lhs t h prefix >array <ast-cascade> ]]
|
||||
|
||||
|
|
@ -155,10 +155,8 @@ KeywordMessageSend = (BinaryMessageSend | UnaryMessageSend | Operand):lhs
|
|||
(OptionalWhiteSpace ";" Message:m => [[ m ]])*:t
|
||||
=> [[ lhs t h prefix >array <ast-cascade> ]]
|
||||
|
||||
MessageSend = BinaryMessageSend | UnaryMessageSend | KeywordMessageSend
|
||||
|
||||
Expression = OptionalWhiteSpace
|
||||
(MessageSend | Operand):e
|
||||
(KeywordMessageSend | BinaryMessageSend | UnaryMessageSend | Operand):e
|
||||
=> [[ e ]]
|
||||
|
||||
AssignmentOperation = OptionalWhiteSpace BindableIdentifier:i
|
||||
|
|
@ -176,13 +174,15 @@ LocalVariableDeclarationList = OptionalWhiteSpace "|" OptionalWhiteSpace
|
|||
=> [[ t h prefix ]]
|
||||
)?:b OptionalWhiteSpace "|" => [[ b >array ast-local-variables boa ]]
|
||||
|
||||
ExecutableCode = (LocalVariableDeclarationList)?:locals
|
||||
((Statement:s OptionalWhiteSpace "." => [[ s ]])*:h
|
||||
FinalStatement:t (".")? => [[ h t suffix ]])?:body
|
||||
OptionalWhiteSpace
|
||||
=> [[ body locals [ suffix ] when* >array ]]
|
||||
EndStatement = "."
|
||||
|
||||
TopLevelForm = ExecutableCode => [[ ast-sequence boa ]]
|
||||
ExecutableCode = (LocalVariableDeclarationList)?:locals
|
||||
(Statement:s OptionalWhiteSpace EndStatement => [[ s ]])*:h
|
||||
(FinalStatement:t (EndStatement)? => [[ t ]])?:t
|
||||
OptionalWhiteSpace
|
||||
=> [[ h t [ suffix ] when* locals [ prefix ] when* >array ]]
|
||||
|
||||
TopLevelForm = ExecutableCode => [[ <ast-sequence> ]]
|
||||
|
||||
UnaryMethodHeader = UnaryMessageSelector:selector
|
||||
=> [[ { selector { } } ]]
|
||||
|
|
@ -200,7 +200,7 @@ MethodDeclaration = OptionalWhiteSpace "method" OptionalWhiteSpace MethodHeader:
|
|||
OptionalWhiteSpace "["
|
||||
ExecutableCode:code
|
||||
"]"
|
||||
=> [[ header first2 code ast-block boa ast-method boa ]]
|
||||
=> [[ header first2 code <ast-block> ast-method boa ]]
|
||||
|
||||
ClassDeclaration = OptionalWhiteSpace "class" OptionalWhiteSpace Identifier:name
|
||||
OptionalWhiteSpace
|
||||
|
|
@ -209,9 +209,9 @@ ClassDeclaration = OptionalWhiteSpace "class" OptionalWhiteSpace Identifier:name
|
|||
(OptionalWhiteSpace LocalVariableDeclarationList:l => [[ l names>> ]])?:ivars
|
||||
(MethodDeclaration:h
|
||||
(OptionalWhiteSpace
|
||||
"."
|
||||
EndStatement
|
||||
OptionalWhiteSpace
|
||||
MethodDeclaration:m => [[ m ]])*:t (".")?
|
||||
MethodDeclaration:m => [[ m ]])*:t (EndStatement)?
|
||||
=> [[ t h prefix ]]
|
||||
)?:methods
|
||||
OptionalWhiteSpace "]"
|
||||
|
|
|
|||
|
|
@ -32,8 +32,8 @@ class TreeNode extends Object [
|
|||
nextPutAll: ' check: '; print: longLivedTree itemCheck; nl
|
||||
].
|
||||
|
||||
method binarytrees [
|
||||
self binarytrees: self arg to: self stdout.
|
||||
method binarytrees: arg [
|
||||
self binarytrees: arg to: self stdout.
|
||||
^''
|
||||
].
|
||||
|
||||
|
|
@ -63,4 +63,3 @@ class TreeNode extends Object [
|
|||
]
|
||||
].
|
||||
|
||||
Tests binarytrees
|
||||
|
|
|
|||
Loading…
Reference in New Issue