smalltalk: fix smalltalk.

locals-and-roots
Doug Coleman 2016-06-27 21:17:46 -07:00
parent 34db513942
commit 3de3a0804c
4 changed files with 38 additions and 38 deletions

View File

@ -5,31 +5,31 @@ math.order fry tools.time locals smalltalk.selectors
smalltalk.ast smalltalk.classes ; smalltalk.ast smalltalk.classes ;
IN: smalltalk.library IN: smalltalk.library
selector\ print SELECTOR: \ print
selector\ asString SELECTOR: \ asString
M: object selector-print dup present print ; M: object selector-print dup present print ;
M: object selector-asString present ; M: object selector-asString present ;
selector\ print: SELECTOR: \ print:
selector\ nextPutAll: SELECTOR: \ nextPutAll:
selector\ tab SELECTOR: \ tab
selector\ nl SELECTOR: \ nl
M: object \ selector-print: [ present ] dip stream-print nil ; M: object \ selector-print: [ present ] dip stream-print nil ;
M: object \ selector-nextPutAll: selector-print: ; M: object \ selector-nextPutAll: selector-print: ;
M: object selector-tab " " swap selector-print: ; M: object selector-tab " " swap selector-print: ;
M: object selector-nl stream-nl nil ; M: object selector-nl stream-nl nil ;
selector\ + SELECTOR: \ +
selector\ - SELECTOR: \ -
selector\ * SELECTOR: \ *
selector\ / SELECTOR: \ /
selector\ < SELECTOR: \ <
selector\ > SELECTOR: \ >
selector\ <= SELECTOR: \ <=
selector\ >= SELECTOR: \ >=
selector\ = SELECTOR: \ =
M: object selector-+ swap + ; M: object selector-+ swap + ;
M: object selector-- swap - ; M: object selector-- swap - ;
@ -41,26 +41,26 @@ M: object selector-<= swap <= ;
M: object selector->= swap >= ; M: object selector->= swap >= ;
M: object selector-= swap = ; M: object selector-= swap = ;
selector\ min: SELECTOR: \ min:
selector\ max: SELECTOR: \ max:
M: object \ selector-min: min ; M: object \ selector-min: min ;
M: object \ selector-max: max ; M: object \ selector-max: max ;
selector\ ifTrue: SELECTOR: \ ifTrue:
selector\ ifFalse: SELECTOR: \ ifFalse:
selector\ ifTrue:ifFalse: SELECTOR: \ ifTrue:ifFalse:
M: object \ selector-ifTrue: [ call( -- result ) ] [ drop nil ] if ; M: object \ selector-ifTrue: [ call( -- result ) ] [ drop nil ] if ;
M: object \ selector-ifFalse: [ drop nil ] [ call( -- result ) ] if ; M: object \ selector-ifFalse: [ drop nil ] [ call( -- result ) ] if ;
M: object \ selector-ifTrue:ifFalse: [ drop call( -- result ) ] [ nip call( -- result ) ] if ; M: object \ selector-ifTrue:ifFalse: [ drop call( -- result ) ] [ nip call( -- result ) ] if ;
selector\ isNil SELECTOR: \ isNil
M: object selector-isNil nil eq? ; M: object selector-isNil nil eq? ;
selector\ at: SELECTOR: \ at:
selector\ at:put: SELECTOR: \ at:put:
M: sequence \ selector-at: nth ; M: sequence \ selector-at: nth ;
M: sequence \ selector-at:put: ( key value receiver -- receiver ) [ swapd set-nth ] keep ; M: sequence \ selector-at:put: ( key value receiver -- receiver ) [ swapd set-nth ] keep ;
@ -68,23 +68,23 @@ M: sequence \ selector-at:put: ( key value receiver -- receiver ) [ swapd set-nt
M: assoc \ selector-at: at ; M: assoc \ selector-at: at ;
M: assoc \ selector-at:put: ( key value receiver -- receiver ) [ swapd set-at ] keep ; M: assoc \ selector-at:put: ( key value receiver -- receiver ) [ swapd set-at ] keep ;
selector\ do: SELECTOR: \ do:
M:: object \ selector-do: ( quot receiver -- nil ) M:: object \ selector-do: ( quot receiver -- nil )
receiver [ quot call( elt -- result ) drop ] each nil ; receiver [ quot call( elt -- result ) drop ] each nil ;
selector\ to: SELECTOR: \ to:
selector\ to:do: SELECTOR: \ to:do:
M: object \ selector-to: swap [a,b] ; M: object \ selector-to: swap [a,b] ;
M:: object \ selector-to:do: ( to quot from -- nil ) M:: object \ selector-to:do: ( to quot from -- nil )
from to [a,b] [ quot call( i -- result ) drop ] each nil ; from to [a,b] [ quot call( i -- result ) drop ] each nil ;
selector\ value SELECTOR: \ value
selector\ value: SELECTOR: \ value:
selector\ value:value: SELECTOR: \ value:value:
selector\ value:value:value: SELECTOR: \ value:value:value:
selector\ value:value:value:value: SELECTOR: \ value:value:value:value:
M: object selector-value call( -- result ) ; M: object selector-value call( -- result ) ;
M: object \ selector-value: call( input -- result ) ; M: object \ selector-value: call( input -- result ) ;
@ -92,10 +92,10 @@ M: object \ selector-value:value: call( input input -- result ) ;
M: object \ selector-value:value:value: call( input input input -- result ) ; M: object \ selector-value:value:value: call( input input input -- result ) ;
M: object \ selector-value:value:value:value: call( input input input input -- result ) ; M: object \ selector-value:value:value:value: call( input input input input -- result ) ;
selector\ new SELECTOR: \ new
M: object selector-new new ; M: object selector-new new ;
selector\ time SELECTOR: \ time
M: object selector-time $[ _ call( -- result ) ] time ; M: object selector-time $[ _ call( -- result ) ] time ;

View File

@ -276,7 +276,7 @@ test = <foreign parse-smalltalk LocalVariableDeclarationList>
} }
} }
} }
[ "class Test |[a|]" parse-smalltalk ] unit-test [ "class Test [|a|]" parse-smalltalk ] unit-test
{ {
T{ ast-sequence f { } T{ ast-sequence f { }
@ -295,7 +295,7 @@ test = <foreign parse-smalltalk LocalVariableDeclarationList>
} }
} }
} }
[ "class Test1 |[a|]. class Test2 extends Test1 |[b|]" parse-smalltalk ] unit-test [ "class Test1 [|a|]. class Test2 extends Test1 [|b|]" parse-smalltalk ] unit-test
{ } [ "class Foo []. Tests blah " parse-smalltalk drop ] unit-test { } [ "class Foo []. Tests blah " parse-smalltalk drop ] unit-test

View File

@ -20,7 +20,7 @@ WhitespaceCharacter = [ \t\n\r]
DecimalDigit = [0-9] DecimalDigit = [0-9]
Letter = [A-Za-z] Letter = [A-Za-z]
CommentCharacter = [^"] | '""' => [[ char: " ]] CommentCharacter = [^"] | '""' => [[ char: \" ]]
Comment = '"' (CommentCharacter)*:s '"' => [[ s >string ast-comment boa ]] Comment = '"' (CommentCharacter)*:s '"' => [[ s >string ast-comment boa ]]
OptionalWhiteSpace = (WhitespaceCharacter | Comment)* OptionalWhiteSpace = (WhitespaceCharacter | Comment)*

View File

@ -1,7 +1,7 @@
! Copyright (C) 2009, 2010 Slava Pestov. ! Copyright (C) 2009, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays combinators effects generic generic.standard USING: arrays combinators effects generic generic.standard
kernel sequences words lexer ; kernel sequences words lexer parser ;
IN: smalltalk.selectors IN: smalltalk.selectors
SYMBOLS: unary binary keyword ; SYMBOLS: unary binary keyword ;
@ -25,4 +25,4 @@ SYMBOLS: unary binary keyword ;
[ selector>effect ] [ selector>effect ]
bi define-simple-generic ; bi define-simple-generic ;
SYNTAX: \ selector\ scan-token selector>generic drop ; SYNTAX: \ SELECTOR: scan-escaped-word-string selector>generic drop ;