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

View File

@ -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 ]*

View File

@ -26,7 +26,7 @@ in: rosetta-code.balanced-brackets
t :> ok!
str [
{
{ char: [ [ 1 ] }
{ char: \[ [ 1 ] }
{ char: ] [ -1 ] }
[ drop 0 ]
} 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',
! 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 / ;

View File

@ -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 ;

View File

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

View File

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

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

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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 ;

View File

@ -175,7 +175,7 @@ CONSTANT: minneapolis-slides
"Mailing list: factor-talk@lists.sf.net"
}
{ $slide "Questions?" }
}
} ;
: minneapolis-talk ( -- )
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"
"Questions?"
}
}
} ;
: otug-talk ( -- )
otug-slides "OTUG talk" slides-window ;

View File

@ -527,7 +527,7 @@ xyz
}
{ $slide "Questions?"
}
}
} ;
: tc-lisp-talk ( -- )
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"
"Questions?"
}
}
} ;
: vpri-talk ( -- ) vpri-slides "VPRI talk" slides-window ;