demos: more syntax
parent
50bf308b98
commit
040dfce0c4
|
@ -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$
|
||||
column$are$separated$by$at$least$one$space.
|
||||
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 )
|
||||
"\n" split [ "$" split harvest ] map
|
||||
|
|
|
@ -29,10 +29,10 @@ in: rosetta-code.arithmetic-evaluation
|
|||
! * Addition/Subtraction (left to right)
|
||||
|
||||
TUPLE: operator left right ;
|
||||
TUPLE: add < operator ; C: <add> add
|
||||
TUPLE: sub < operator ; C: <sub> sub
|
||||
TUPLE: mul < operator ; C: <mul> mul
|
||||
TUPLE: div < operator ; C: <div> div
|
||||
TUPLE: add < operator ; C: <add> add ;
|
||||
TUPLE: sub < operator ; C: <sub> sub ;
|
||||
TUPLE: mul < operator ; C: <mul> mul ;
|
||||
TUPLE: div < operator ; C: <div> div ;
|
||||
|
||||
EBNF: expr-ast
|
||||
spaces = [\n\t ]*
|
||||
|
|
|
@ -26,7 +26,7 @@ in: rosetta-code.balanced-brackets
|
|||
t :> ok!
|
||||
str [
|
||||
{
|
||||
{ char: [ [ 1 ] }
|
||||
{ char: \[ [ 1 ] }
|
||||
{ char: ] [ -1 ] }
|
||||
[ drop 0 ]
|
||||
} case counter + counter!
|
||||
|
|
|
@ -20,7 +20,7 @@ in: rosetta-code.haversine-formula
|
|||
! International Airport (LAX) in Los Angeles, CA, USA: N 33°56.4',
|
||||
! 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 / ;
|
||||
|
||||
|
|
|
@ -35,7 +35,7 @@ CONSTANT: data
|
|||
{ "waw" 1/10.0 }
|
||||
{ "zayin" 1/11.0 }
|
||||
{ "heth" f }
|
||||
}
|
||||
} ;
|
||||
|
||||
MACRO: case-probas ( data -- quot )
|
||||
[ first2 [ 1quotation ] dip [ swap 2array ] when* ] map 1quotation ;
|
||||
|
|
|
@ -45,7 +45,7 @@ CONSTANT: example-tree
|
|||
}
|
||||
f
|
||||
}
|
||||
}
|
||||
} ;
|
||||
|
||||
: preorder ( node quot: ( data -- ) -- )
|
||||
[ [ data>> ] dip call ]
|
||||
|
|
|
@ -26,14 +26,14 @@ M: ast-name compile-ast name>> swap lookup-reader ;
|
|||
[ compile-arguments ] 2bi
|
||||
[ new ] 3append ;
|
||||
|
||||
: compile-ifTrue:ifFalse: ( lexenv ast -- quot )
|
||||
: compile-ifTrue:ifFalse ( lexenv ast -- quot )
|
||||
[ receiver>> compile-ast ]
|
||||
[ compile-arguments ] 2bi
|
||||
[ if ] 3append ;
|
||||
|
||||
M: ast-message-send compile-ast
|
||||
dup selector>> {
|
||||
{ "ifTrue:ifFalse:" [ compile-ifTrue:ifFalse: ] }
|
||||
{ "ifTrue:ifFalse:" [ compile-ifTrue:ifFalse ] }
|
||||
{ "new" [ compile-new ] }
|
||||
[
|
||||
drop
|
||||
|
|
|
@ -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-nth
|
|||
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 ;
|
||||
|
|
|
@ -26,3 +26,4 @@ SYMBOLS: unary binary keyword ;
|
|||
bi define-simple-generic ;
|
||||
|
||||
SYNTAX: SELECTOR: scan-token selector>generic drop ;
|
||||
SYNTAX: selector: scan-token selector>generic drop ;
|
||||
|
|
|
@ -45,7 +45,7 @@ CONSTANT: chicago-slides
|
|||
"alias analysis, value numbering, write barrier elimination"
|
||||
"linear scan register allocation"
|
||||
}
|
||||
}
|
||||
} ;
|
||||
|
||||
: chicago-talk ( -- )
|
||||
chicago-slides "Chicago talk" slides-window ;
|
||||
|
|
|
@ -305,7 +305,7 @@ CONSTANT: galois-slides
|
|||
"Factor has many cool things that I didn't talk about"
|
||||
"Questions?"
|
||||
}
|
||||
}
|
||||
} ;
|
||||
|
||||
: galois-talk ( -- ) galois-slides "Galois talk" slides-window ;
|
||||
|
||||
|
|
|
@ -350,7 +350,7 @@ CONSTANT: jvm-summit-slides
|
|||
"Display control flow graph"
|
||||
"Display dominator tree"
|
||||
}
|
||||
}
|
||||
} ;
|
||||
|
||||
: jvm-summit-talk ( -- )
|
||||
jvm-summit-slides "JVM Summit talk" slides-window ;
|
||||
|
|
|
@ -175,7 +175,7 @@ CONSTANT: minneapolis-slides
|
|||
"Mailing list: factor-talk@lists.sf.net"
|
||||
}
|
||||
{ $slide "Questions?" }
|
||||
}
|
||||
} ;
|
||||
|
||||
: minneapolis-talk ( -- )
|
||||
minneapolis-slides "Minneapolis talk" slides-window ;
|
||||
|
|
|
@ -334,7 +334,7 @@ var price = (order == null ? null : order.price);" }
|
|||
"Factor has many cool things that I didn't talk about"
|
||||
"Questions?"
|
||||
}
|
||||
}
|
||||
} ;
|
||||
|
||||
: otug-talk ( -- )
|
||||
otug-slides "OTUG talk" slides-window ;
|
||||
|
|
|
@ -527,7 +527,7 @@ xyz
|
|||
}
|
||||
{ $slide "Questions?"
|
||||
}
|
||||
}
|
||||
} ;
|
||||
|
||||
: tc-lisp-talk ( -- )
|
||||
tc-lisp-slides "TC Lisp talk" slides-window ;
|
||||
|
|
|
@ -485,7 +485,7 @@ CONSTANT: vpri-slides
|
|||
"Factor has many cool things that I didn't talk about"
|
||||
"Questions?"
|
||||
}
|
||||
}
|
||||
} ;
|
||||
|
||||
: vpri-talk ( -- ) vpri-slides "VPRI talk" slides-window ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue