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 ;
IN: smalltalk.library
selector\ print
selector\ asString
SELECTOR: \ print
SELECTOR: \ asString
M: object selector-print dup present print ;
M: object selector-asString present ;
selector\ print:
selector\ nextPutAll:
selector\ tab
selector\ nl
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\ *
selector\ /
selector\ <
selector\ >
selector\ <=
selector\ >=
selector\ =
SELECTOR: \ +
SELECTOR: \ -
SELECTOR: \ *
SELECTOR: \ /
SELECTOR: \ <
SELECTOR: \ >
SELECTOR: \ <=
SELECTOR: \ >=
SELECTOR: \ =
M: object selector-+ swap + ;
M: object selector-- swap - ;
@ -41,26 +41,26 @@ M: object selector-<= swap <= ;
M: object selector->= swap >= ;
M: object selector-= swap = ;
selector\ min:
selector\ max:
SELECTOR: \ min:
SELECTOR: \ max:
M: object \ selector-min: min ;
M: object \ selector-max: max ;
selector\ ifTrue:
selector\ ifFalse:
selector\ ifTrue:ifFalse:
SELECTOR: \ ifTrue:
SELECTOR: \ ifFalse:
SELECTOR: \ ifTrue:ifFalse:
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
SELECTOR: \ isNil
M: object selector-isNil nil eq? ;
selector\ at:
selector\ at:put:
SELECTOR: \ at:
SELECTOR: \ at:put:
M: sequence \ selector-at: nth ;
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:put: ( key value receiver -- receiver ) [ swapd set-at ] keep ;
selector\ do:
SELECTOR: \ do:
M:: object \ selector-do: ( quot receiver -- nil )
receiver [ quot call( elt -- result ) drop ] each nil ;
selector\ to:
selector\ to:do:
SELECTOR: \ to:
SELECTOR: \ to:do:
M: object \ selector-to: swap [a,b] ;
M:: object \ selector-to:do: ( to quot from -- nil )
from to [a,b] [ quot call( i -- result ) drop ] each nil ;
selector\ value
selector\ value:
selector\ value:value:
selector\ value:value:value:
selector\ value:value:value:value:
SELECTOR: \ value
SELECTOR: \ value:
SELECTOR: \ value:value:
SELECTOR: \ value:value:value:
SELECTOR: \ value:value:value:value:
M: object selector-value call( -- 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:value: call( input input input input -- result ) ;
selector\ new
SELECTOR: \ new
M: object selector-new new ;
selector\ time
SELECTOR: \ 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 { }
@ -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

View File

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

View File

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