smalltalk: fix smalltalk.
parent
34db513942
commit
3de3a0804c
|
@ -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 ;
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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)*
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
Loading…
Reference in New Issue