demos: more syntax

locals-and-roots
Doug Coleman 2016-06-05 13:59:11 -07:00
parent 50bf308b98
commit 040dfce0c4
16 changed files with 52 additions and 51 deletions

View File

@ -41,7 +41,7 @@ are$delineated$by$a$single$'dollar'$character,$write$a$program
that$aligns$each$column$of$fields$by$ensuring$that$words$in$each$ that$aligns$each$column$of$fields$by$ensuring$that$words$in$each$
column$are$separated$by$at$least$one$space. column$are$separated$by$at$least$one$space.
Further,$allow$for$each$word$in$a$column$to$be$either$left$ Further,$allow$for$each$word$in$a$column$to$be$either$left$
justified,$right$justified,$or$center$justified$within$its$column." justified,$right$justified,$or$center$justified$within$its$column." ;
: split-and-pad ( text -- lines ) : split-and-pad ( text -- lines )
"\n" split [ "$" split harvest ] map "\n" split [ "$" split harvest ] map

View File

@ -29,10 +29,10 @@ in: rosetta-code.arithmetic-evaluation
! * Addition/Subtraction (left to right) ! * Addition/Subtraction (left to right)
TUPLE: operator left right ; TUPLE: operator left right ;
TUPLE: add < operator ; C: <add> add TUPLE: add < operator ; C: <add> add ;
TUPLE: sub < operator ; C: <sub> sub TUPLE: sub < operator ; C: <sub> sub ;
TUPLE: mul < operator ; C: <mul> mul TUPLE: mul < operator ; C: <mul> mul ;
TUPLE: div < operator ; C: <div> div TUPLE: div < operator ; C: <div> div ;
EBNF: expr-ast EBNF: expr-ast
spaces = [\n\t ]* spaces = [\n\t ]*

View File

@ -26,7 +26,7 @@ in: rosetta-code.balanced-brackets
t :> ok! t :> ok!
str [ str [
{ {
{ char: [ [ 1 ] } { char: \[ [ 1 ] }
{ char: ] [ -1 ] } { char: ] [ -1 ] }
[ drop 0 ] [ drop 0 ]
} case counter + counter! } case counter + counter!

View File

@ -20,7 +20,7 @@ in: rosetta-code.haversine-formula
! International Airport (LAX) in Los Angeles, CA, USA: N 33°56.4', ! International Airport (LAX) in Los Angeles, CA, USA: N 33°56.4',
! W 118°24.0' (33.94, -118.40). ! W 118°24.0' (33.94, -118.40).
CONSTANT: R_earth 6372.8 ! in kilometers ; CONSTANT: R_earth 6372.8 ; ! in kilometers
: haversin ( x -- y ) cos 1 swap - 2 / ; : haversin ( x -- y ) cos 1 swap - 2 / ;

View File

@ -35,7 +35,7 @@ CONSTANT: data
{ "waw" 1/10.0 } { "waw" 1/10.0 }
{ "zayin" 1/11.0 } { "zayin" 1/11.0 }
{ "heth" f } { "heth" f }
} } ;
MACRO: case-probas ( data -- quot ) MACRO: case-probas ( data -- quot )
[ first2 [ 1quotation ] dip [ swap 2array ] when* ] map 1quotation ; [ first2 [ 1quotation ] dip [ swap 2array ] when* ] map 1quotation ;

View File

@ -45,7 +45,7 @@ CONSTANT: example-tree
} }
f f
} }
} } ;
: preorder ( node quot: ( data -- ) -- ) : preorder ( node quot: ( data -- ) -- )
[ [ data>> ] dip call ] [ [ data>> ] dip call ]

View File

@ -26,14 +26,14 @@ M: ast-name compile-ast name>> swap lookup-reader ;
[ compile-arguments ] 2bi [ compile-arguments ] 2bi
[ new ] 3append ; [ new ] 3append ;
: compile-ifTrue:ifFalse: ( lexenv ast -- quot ) : compile-ifTrue:ifFalse ( lexenv ast -- quot )
[ receiver>> compile-ast ] [ receiver>> compile-ast ]
[ compile-arguments ] 2bi [ compile-arguments ] 2bi
[ if ] 3append ; [ if ] 3append ;
M: ast-message-send compile-ast M: ast-message-send compile-ast
dup selector>> { dup selector>> {
{ "ifTrue:ifFalse:" [ compile-ifTrue:ifFalse: ] } { "ifTrue:ifFalse:" [ compile-ifTrue:ifFalse ] }
{ "new" [ compile-new ] } { "new" [ compile-new ] }
[ [
drop drop

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

@ -26,3 +26,4 @@ SYMBOLS: unary binary keyword ;
bi define-simple-generic ; bi define-simple-generic ;
SYNTAX: SELECTOR: scan-token selector>generic drop ; SYNTAX: SELECTOR: scan-token selector>generic drop ;
SYNTAX: selector: scan-token selector>generic drop ;

View File

@ -45,7 +45,7 @@ CONSTANT: chicago-slides
"alias analysis, value numbering, write barrier elimination" "alias analysis, value numbering, write barrier elimination"
"linear scan register allocation" "linear scan register allocation"
} }
} } ;
: chicago-talk ( -- ) : chicago-talk ( -- )
chicago-slides "Chicago talk" slides-window ; chicago-slides "Chicago talk" slides-window ;

View File

@ -305,7 +305,7 @@ CONSTANT: galois-slides
"Factor has many cool things that I didn't talk about" "Factor has many cool things that I didn't talk about"
"Questions?" "Questions?"
} }
} } ;
: galois-talk ( -- ) galois-slides "Galois talk" slides-window ; : galois-talk ( -- ) galois-slides "Galois talk" slides-window ;

View File

@ -350,7 +350,7 @@ CONSTANT: jvm-summit-slides
"Display control flow graph" "Display control flow graph"
"Display dominator tree" "Display dominator tree"
} }
} } ;
: jvm-summit-talk ( -- ) : jvm-summit-talk ( -- )
jvm-summit-slides "JVM Summit talk" slides-window ; jvm-summit-slides "JVM Summit talk" slides-window ;

View File

@ -175,7 +175,7 @@ CONSTANT: minneapolis-slides
"Mailing list: factor-talk@lists.sf.net" "Mailing list: factor-talk@lists.sf.net"
} }
{ $slide "Questions?" } { $slide "Questions?" }
} } ;
: minneapolis-talk ( -- ) : minneapolis-talk ( -- )
minneapolis-slides "Minneapolis talk" slides-window ; minneapolis-slides "Minneapolis talk" slides-window ;

View File

@ -334,7 +334,7 @@ var price = (order == null ? null : order.price);" }
"Factor has many cool things that I didn't talk about" "Factor has many cool things that I didn't talk about"
"Questions?" "Questions?"
} }
} } ;
: otug-talk ( -- ) : otug-talk ( -- )
otug-slides "OTUG talk" slides-window ; otug-slides "OTUG talk" slides-window ;

View File

@ -527,7 +527,7 @@ xyz
} }
{ $slide "Questions?" { $slide "Questions?"
} }
} } ;
: tc-lisp-talk ( -- ) : tc-lisp-talk ( -- )
tc-lisp-slides "TC Lisp talk" slides-window ; tc-lisp-slides "TC Lisp talk" slides-window ;

View File

@ -485,7 +485,7 @@ CONSTANT: vpri-slides
"Factor has many cool things that I didn't talk about" "Factor has many cool things that I didn't talk about"
"Questions?" "Questions?"
} }
} } ;
: vpri-talk ( -- ) vpri-slides "VPRI talk" slides-window ; : vpri-talk ( -- ) vpri-slides "VPRI talk" slides-window ;