Merge branch 'master' of git://github.com/slavapestov/factor
commit
430ace7b7b
|
@ -309,7 +309,7 @@ HELP: time-
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: convert-timezone
|
HELP: convert-timezone
|
||||||
{ $values { "timestamp" timestamp } { "duration" duration } { "timestamp" timestamp } }
|
{ $values { "timestamp" timestamp } { "duration" duration } { "timestamp'" timestamp } }
|
||||||
{ $description "Converts the " { $snippet "timestamp" } "'s " { $snippet "gmt-offset" } " to the GMT offset represented by the " { $snippet "duration" } "." }
|
{ $description "Converts the " { $snippet "timestamp" } "'s " { $snippet "gmt-offset" } " to the GMT offset represented by the " { $snippet "duration" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: accessors calendar prettyprint ;"
|
{ $example "USING: accessors calendar prettyprint ;"
|
||||||
|
@ -319,7 +319,7 @@ HELP: convert-timezone
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: >local-time
|
HELP: >local-time
|
||||||
{ $values { "timestamp" timestamp } { "timestamp" timestamp } }
|
{ $values { "timestamp" timestamp } { "timestamp'" timestamp } }
|
||||||
{ $description "Converts the " { $snippet "timestamp" } " to the timezone of your computer." }
|
{ $description "Converts the " { $snippet "timestamp" } " to the timezone of your computer." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: accessors calendar kernel prettyprint ;"
|
{ $example "USING: accessors calendar kernel prettyprint ;"
|
||||||
|
@ -329,7 +329,7 @@ HELP: >local-time
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: >gmt
|
HELP: >gmt
|
||||||
{ $values { "timestamp" timestamp } { "timestamp" timestamp } }
|
{ $values { "timestamp" timestamp } { "timestamp'" timestamp } }
|
||||||
{ $description "Converts the " { $snippet "timestamp" } " to the GMT timezone." }
|
{ $description "Converts the " { $snippet "timestamp" } " to the GMT timezone." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: accessors calendar kernel prettyprint ;"
|
{ $example "USING: accessors calendar kernel prettyprint ;"
|
||||||
|
|
|
@ -316,15 +316,15 @@ M: duration <=> [ duration>years ] compare ;
|
||||||
|
|
||||||
GENERIC: time- ( time1 time2 -- time3 )
|
GENERIC: time- ( time1 time2 -- time3 )
|
||||||
|
|
||||||
: convert-timezone ( timestamp duration -- timestamp )
|
: convert-timezone ( timestamp duration -- timestamp' )
|
||||||
over gmt-offset>> over = [ drop ] [
|
over gmt-offset>> over = [ drop ] [
|
||||||
[ over gmt-offset>> time- time+ ] keep >>gmt-offset
|
[ over gmt-offset>> time- time+ ] keep >>gmt-offset
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: >local-time ( timestamp -- timestamp )
|
: >local-time ( timestamp -- timestamp' )
|
||||||
gmt-offset-duration convert-timezone ;
|
gmt-offset-duration convert-timezone ;
|
||||||
|
|
||||||
: >gmt ( timestamp -- timestamp )
|
: >gmt ( timestamp -- timestamp' )
|
||||||
instant convert-timezone ;
|
instant convert-timezone ;
|
||||||
|
|
||||||
M: timestamp <=> ( ts1 ts2 -- n )
|
M: timestamp <=> ( ts1 ts2 -- n )
|
||||||
|
|
|
@ -20,7 +20,6 @@ HELP: tiff-lzw-uncompress
|
||||||
|
|
||||||
HELP: lzw-read
|
HELP: lzw-read
|
||||||
{ $values
|
{ $values
|
||||||
{ "lzw" lzw }
|
|
||||||
{ "lzw" lzw } { "n" integer }
|
{ "lzw" lzw } { "n" integer }
|
||||||
}
|
}
|
||||||
{ $description "Read the next LZW code." } ;
|
{ $description "Read the next LZW code." } ;
|
||||||
|
@ -48,7 +47,6 @@ HELP: code-space-full?
|
||||||
HELP: reset-lzw-uncompress
|
HELP: reset-lzw-uncompress
|
||||||
{ $values
|
{ $values
|
||||||
{ "lzw" lzw }
|
{ "lzw" lzw }
|
||||||
{ "lzw" lzw }
|
|
||||||
}
|
}
|
||||||
{ $description "Reset the LZW uncompressor state (either at initialization time or immediately after receiving a Clear Code). " } ;
|
{ $description "Reset the LZW uncompressor state (either at initialization time or immediately after receiving a Clear Code). " } ;
|
||||||
|
|
||||||
|
|
|
@ -42,40 +42,6 @@ IN: concurrency.mailboxes.tests
|
||||||
mailbox-get
|
mailbox-get
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
<mailbox> "m" set
|
|
||||||
|
|
||||||
1 <count-down> "c" set
|
|
||||||
1 <count-down> "d" set
|
|
||||||
|
|
||||||
[
|
|
||||||
"c" get await
|
|
||||||
[ "m" get mailbox-get drop ]
|
|
||||||
[ drop "d" get count-down ] recover
|
|
||||||
] "Mailbox close test" spawn drop
|
|
||||||
|
|
||||||
[ ] [ "c" get count-down ] unit-test
|
|
||||||
[ ] [ "m" get dispose ] unit-test
|
|
||||||
[ ] [ "d" get 5 seconds await-timeout ] unit-test
|
|
||||||
|
|
||||||
[ ] [ "m" get dispose ] unit-test
|
|
||||||
|
|
||||||
<mailbox> "m" set
|
|
||||||
|
|
||||||
1 <count-down> "c" set
|
|
||||||
1 <count-down> "d" set
|
|
||||||
|
|
||||||
[
|
|
||||||
"c" get await
|
|
||||||
"m" get wait-for-close
|
|
||||||
"d" get count-down
|
|
||||||
] "Mailbox close test" spawn drop
|
|
||||||
|
|
||||||
[ ] [ "c" get count-down ] unit-test
|
|
||||||
[ ] [ "m" get dispose ] unit-test
|
|
||||||
[ ] [ "d" get 5 seconds await-timeout ] unit-test
|
|
||||||
|
|
||||||
[ ] [ "m" get dispose ] unit-test
|
|
||||||
|
|
||||||
[ { "foo" "bar" } ] [
|
[ { "foo" "bar" } ] [
|
||||||
<mailbox>
|
<mailbox>
|
||||||
"foo" over mailbox-put
|
"foo" over mailbox-put
|
||||||
|
@ -86,4 +52,3 @@ IN: concurrency.mailboxes.tests
|
||||||
[
|
[
|
||||||
<mailbox> 1 seconds mailbox-get-timeout
|
<mailbox> 1 seconds mailbox-get-timeout
|
||||||
] [ wait-timeout? ] must-fail-with
|
] [ wait-timeout? ] must-fail-with
|
||||||
|
|
||||||
|
|
|
@ -1,17 +1,17 @@
|
||||||
! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.
|
! Copyright (C) 2005, 2010 Chris Double, Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: dlists deques threads sequences continuations
|
USING: dlists deques threads sequences continuations namespaces
|
||||||
destructors namespaces math quotations words kernel
|
math quotations words kernel arrays assocs init system
|
||||||
arrays assocs init system concurrency.conditions accessors
|
concurrency.conditions accessors debugger debugger.threads
|
||||||
debugger debugger.threads locals fry ;
|
locals fry ;
|
||||||
IN: concurrency.mailboxes
|
IN: concurrency.mailboxes
|
||||||
|
|
||||||
TUPLE: mailbox < disposable threads data ;
|
TUPLE: mailbox threads data ;
|
||||||
|
|
||||||
M: mailbox dispose* threads>> notify-all ;
|
|
||||||
|
|
||||||
: <mailbox> ( -- mailbox )
|
: <mailbox> ( -- mailbox )
|
||||||
mailbox new-disposable <dlist> >>threads <dlist> >>data ;
|
mailbox new
|
||||||
|
<dlist> >>threads
|
||||||
|
<dlist> >>data ;
|
||||||
|
|
||||||
: mailbox-empty? ( mailbox -- bool )
|
: mailbox-empty? ( mailbox -- bool )
|
||||||
data>> deque-empty? ;
|
data>> deque-empty? ;
|
||||||
|
@ -24,14 +24,12 @@ M: mailbox dispose* threads>> notify-all ;
|
||||||
[ threads>> ] dip "mailbox" wait ;
|
[ threads>> ] dip "mailbox" wait ;
|
||||||
|
|
||||||
:: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- )
|
:: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- )
|
||||||
mailbox check-disposed
|
|
||||||
mailbox data>> pred dlist-any? [
|
mailbox data>> pred dlist-any? [
|
||||||
mailbox timeout wait-for-mailbox
|
mailbox timeout wait-for-mailbox
|
||||||
mailbox timeout pred block-unless-pred
|
mailbox timeout pred block-unless-pred
|
||||||
] unless ; inline recursive
|
] unless ; inline recursive
|
||||||
|
|
||||||
: block-if-empty ( mailbox timeout -- mailbox )
|
: block-if-empty ( mailbox timeout -- mailbox )
|
||||||
over check-disposed
|
|
||||||
over mailbox-empty? [
|
over mailbox-empty? [
|
||||||
2dup wait-for-mailbox block-if-empty
|
2dup wait-for-mailbox block-if-empty
|
||||||
] [
|
] [
|
||||||
|
|
|
@ -12,6 +12,7 @@ TUPLE: promise mailbox ;
|
||||||
mailbox>> mailbox-empty? not ;
|
mailbox>> mailbox-empty? not ;
|
||||||
|
|
||||||
ERROR: promise-already-fulfilled promise ;
|
ERROR: promise-already-fulfilled promise ;
|
||||||
|
|
||||||
: fulfill ( value promise -- )
|
: fulfill ( value promise -- )
|
||||||
dup promise-fulfilled? [
|
dup promise-fulfilled? [
|
||||||
promise-already-fulfilled
|
promise-already-fulfilled
|
||||||
|
|
|
@ -51,7 +51,7 @@ HELP: <insert-user-assigned-statement>
|
||||||
HELP: <select-by-slots-statement>
|
HELP: <select-by-slots-statement>
|
||||||
{ $values
|
{ $values
|
||||||
{ "tuple" tuple } { "class" class }
|
{ "tuple" tuple } { "class" class }
|
||||||
{ "tuple" tuple } }
|
{ "statement" tuple } }
|
||||||
{ $description "A database-specific hook for generating the SQL for a select statement." } ;
|
{ $description "A database-specific hook for generating the SQL for a select statement." } ;
|
||||||
|
|
||||||
HELP: <update-tuple-statement>
|
HELP: <update-tuple-statement>
|
||||||
|
|
|
@ -14,7 +14,7 @@ HOOK: <insert-db-assigned-statement> db-connection ( class -- object )
|
||||||
HOOK: <insert-user-assigned-statement> db-connection ( class -- object )
|
HOOK: <insert-user-assigned-statement> db-connection ( class -- object )
|
||||||
HOOK: <update-tuple-statement> db-connection ( class -- object )
|
HOOK: <update-tuple-statement> db-connection ( class -- object )
|
||||||
HOOK: <delete-tuples-statement> db-connection ( tuple class -- object )
|
HOOK: <delete-tuples-statement> db-connection ( tuple class -- object )
|
||||||
HOOK: <select-by-slots-statement> db-connection ( tuple class -- tuple )
|
HOOK: <select-by-slots-statement> db-connection ( tuple class -- statement )
|
||||||
HOOK: <count-statement> db-connection ( query -- statement )
|
HOOK: <count-statement> db-connection ( query -- statement )
|
||||||
HOOK: query>statement db-connection ( query -- statement )
|
HOOK: query>statement db-connection ( query -- statement )
|
||||||
HOOK: insert-tuple-set-key db-connection ( tuple statement -- )
|
HOOK: insert-tuple-set-key db-connection ( tuple statement -- )
|
||||||
|
|
|
@ -48,7 +48,7 @@ HELP: dlist-find
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: dlist-filter
|
HELP: dlist-filter
|
||||||
{ $values { "dlist" { $link dlist } } { "quot" quotation } { "dlist" { $link dlist } } }
|
{ $values { "dlist" { $link dlist } } { "quot" quotation } { "dlist'" { $link dlist } } }
|
||||||
{ $description "Applies the quotation to each element of the " { $link dlist } " in turn, removing the corresponding nodes if the quotation returns " { $link f } "." }
|
{ $description "Applies the quotation to each element of the " { $link dlist } " in turn, removing the corresponding nodes if the quotation returns " { $link f } "." }
|
||||||
{ $side-effects { "dlist" } } ;
|
{ $side-effects { "dlist" } } ;
|
||||||
|
|
||||||
|
|
|
@ -157,7 +157,7 @@ M: dlist clear-deque ( dlist -- )
|
||||||
|
|
||||||
: 1dlist ( obj -- dlist ) <dlist> [ push-front ] keep ;
|
: 1dlist ( obj -- dlist ) <dlist> [ push-front ] keep ;
|
||||||
|
|
||||||
: dlist-filter ( dlist quot -- dlist )
|
: dlist-filter ( dlist quot -- dlist' )
|
||||||
over [ '[ dup obj>> @ [ drop ] [ _ delete-node ] if ] dlist-each-node ] keep ; inline
|
over [ '[ dup obj>> @ [ drop ] [ _ delete-node ] if ] dlist-each-node ] keep ; inline
|
||||||
|
|
||||||
M: dlist clone
|
M: dlist clone
|
||||||
|
|
|
@ -94,4 +94,5 @@ M: mouse-state clone
|
||||||
{ [ os windows? ] [ "game.input.xinput" require ] }
|
{ [ os windows? ] [ "game.input.xinput" require ] }
|
||||||
{ [ os macosx? ] [ "game.input.iokit" require ] }
|
{ [ os macosx? ] [ "game.input.iokit" require ] }
|
||||||
{ [ os linux? ] [ "game.input.linux" require ] }
|
{ [ os linux? ] [ "game.input.linux" require ] }
|
||||||
|
[ ]
|
||||||
} cond
|
} cond
|
||||||
|
|
|
@ -1,8 +1,6 @@
|
||||||
! Copyright (C) 2010 Erik Charlebois.
|
! Copyright (C) 2010 Erik Charlebois.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel game.input namespaces classes windows.com.syntax
|
USING: kernel game.input namespaces classes bit-arrays vectors ;
|
||||||
bit-arrays
|
|
||||||
vectors ;
|
|
||||||
IN: game.input.linux
|
IN: game.input.linux
|
||||||
|
|
||||||
SINGLETON: linux-game-input-backend
|
SINGLETON: linux-game-input-backend
|
||||||
|
@ -25,10 +23,10 @@ M: linux-game-input-backend product-string
|
||||||
drop "" ;
|
drop "" ;
|
||||||
|
|
||||||
M: linux-game-input-backend product-id
|
M: linux-game-input-backend product-id
|
||||||
drop GUID: {00000000-0000-0000-0000-000000000000} ;
|
drop f ;
|
||||||
|
|
||||||
M: linux-game-input-backend instance-id
|
M: linux-game-input-backend instance-id
|
||||||
drop GUID: {00000000-0000-0000-0000-000000000000} ;
|
drop f ;
|
||||||
|
|
||||||
M: linux-game-input-backend read-controller
|
M: linux-game-input-backend read-controller
|
||||||
drop controller-state new ;
|
drop controller-state new ;
|
||||||
|
|
|
@ -1 +1,2 @@
|
||||||
|
unportable
|
||||||
games
|
games
|
||||||
|
|
|
@ -33,7 +33,7 @@ SYMBOL: vocab-articles
|
||||||
|
|
||||||
: extract-values ( element -- seq )
|
: extract-values ( element -- seq )
|
||||||
\ $values swap elements dup empty? [
|
\ $values swap elements dup empty? [
|
||||||
first rest [ first ] map prune
|
first rest [ first ] map
|
||||||
] unless ;
|
] unless ;
|
||||||
|
|
||||||
: effect-values ( word -- seq )
|
: effect-values ( word -- seq )
|
||||||
|
|
|
@ -6,14 +6,14 @@ IN: images.normalization
|
||||||
HELP: normalize-image
|
HELP: normalize-image
|
||||||
{ $values
|
{ $values
|
||||||
{ "image" image }
|
{ "image" image }
|
||||||
{ "image" image }
|
{ "image'" image }
|
||||||
}
|
}
|
||||||
{ $description "Converts the image to RGBA with ubyte-components. If the image is upside-down, it will be flipped right side up such that the 1st byte in the bitmap slot's byte array corresponds to the first color component of the pixel in the upper-left corner of the image." } ;
|
{ $description "Converts the image to RGBA with ubyte-components. If the image is upside-down, it will be flipped right side up such that the 1st byte in the bitmap slot's byte array corresponds to the first color component of the pixel in the upper-left corner of the image." } ;
|
||||||
|
|
||||||
HELP: reorder-components
|
HELP: reorder-components
|
||||||
{ $values
|
{ $values
|
||||||
{ "image" image } { "component-order" component-order }
|
{ "image" image } { "component-order" component-order }
|
||||||
{ "image" image }
|
{ "image'" image }
|
||||||
}
|
}
|
||||||
{ $description "Convert the bitmap in " { $snippet "image" } " such that the pixel sample layout corresponds to " { $snippet "component-order" } ". If the destination layout cannot find a corresponding value from the source layout, the value " { $snippet "255" } " will be substituted for that byte." }
|
{ $description "Convert the bitmap in " { $snippet "image" } " such that the pixel sample layout corresponds to " { $snippet "component-order" } ". If the destination layout cannot find a corresponding value from the source layout, the value " { $snippet "255" } " will be substituted for that byte." }
|
||||||
{ $warning "The image's " { $snippet "component-type" } " will be changed to " { $snippet "ubyte-components" } " if it is not already in that format."
|
{ $warning "The image's " { $snippet "component-type" } " will be changed to " { $snippet "ubyte-components" } " if it is not already in that format."
|
||||||
|
|
|
@ -55,7 +55,7 @@ M: ushort-components normalize-component-type*
|
||||||
M: ubyte-components normalize-component-type*
|
M: ubyte-components normalize-component-type*
|
||||||
drop ;
|
drop ;
|
||||||
|
|
||||||
: normalize-scan-line-order ( image -- image )
|
: normalize-scan-line-order ( image -- image' )
|
||||||
dup upside-down?>> [
|
dup upside-down?>> [
|
||||||
dup dim>> first 4 * '[
|
dup dim>> first 4 * '[
|
||||||
_ <groups> reverse concat
|
_ <groups> reverse concat
|
||||||
|
@ -71,14 +71,14 @@ M: ubyte-components normalize-component-type*
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: reorder-components ( image component-order -- image )
|
: reorder-components ( image component-order -- image' )
|
||||||
[
|
[
|
||||||
dup component-type>> '[ _ normalize-component-type* ] change-bitmap
|
dup component-type>> '[ _ normalize-component-type* ] change-bitmap
|
||||||
dup component-order>>
|
dup component-order>>
|
||||||
] dip
|
] dip
|
||||||
validate-request [ (reorder-components) ] keep >>component-order ;
|
validate-request [ (reorder-components) ] keep >>component-order ;
|
||||||
|
|
||||||
: normalize-image ( image -- image )
|
: normalize-image ( image -- image' )
|
||||||
[ >byte-array ] change-bitmap
|
[ >byte-array ] change-bitmap
|
||||||
RGBA reorder-components
|
RGBA reorder-components
|
||||||
normalize-scan-line-order ;
|
normalize-scan-line-order ;
|
||||||
|
|
|
@ -59,7 +59,9 @@ M: linux-monitor dispose* ( monitor -- )
|
||||||
[ inotify>> handle>> handle-fd ] [ wd>> ] bi
|
[ inotify>> handle>> handle-fd ] [ wd>> ] bi
|
||||||
inotify_rm_watch io-error
|
inotify_rm_watch io-error
|
||||||
] if
|
] if
|
||||||
] bi ;
|
]
|
||||||
|
[ call-next-method ]
|
||||||
|
tri ;
|
||||||
|
|
||||||
: ignore-flags? ( mask -- ? )
|
: ignore-flags? ( mask -- ? )
|
||||||
{
|
{
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
! Copyright (C) 2008, 2010 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: io.backend io.monitors
|
USING: io.backend io.monitors
|
||||||
core-foundation.fsevents continuations kernel sequences
|
core-foundation.fsevents continuations kernel sequences
|
||||||
|
@ -16,6 +16,7 @@ M:: macosx (monitor) ( path recursive? mailbox -- monitor )
|
||||||
dup [ enqueue-notifications ] curry
|
dup [ enqueue-notifications ] curry
|
||||||
path 1array 0 0 <event-stream> >>handle ;
|
path 1array 0 0 <event-stream> >>handle ;
|
||||||
|
|
||||||
M: macosx-monitor dispose* handle>> dispose ;
|
M: macosx-monitor dispose*
|
||||||
|
[ handle>> dispose ] [ call-next-method ] bi ;
|
||||||
|
|
||||||
macosx set-io-backend
|
macosx set-io-backend
|
||||||
|
|
|
@ -3,7 +3,7 @@ USING: io.monitors tools.test io.files system sequences
|
||||||
continuations namespaces concurrency.count-downs kernel io
|
continuations namespaces concurrency.count-downs kernel io
|
||||||
threads calendar prettyprint destructors io.timeouts
|
threads calendar prettyprint destructors io.timeouts
|
||||||
io.files.temp io.directories io.directories.hierarchy
|
io.files.temp io.directories io.directories.hierarchy
|
||||||
io.pathnames accessors ;
|
io.pathnames accessors concurrency.promises ;
|
||||||
|
|
||||||
os { winnt linux macosx } member? [
|
os { winnt linux macosx } member? [
|
||||||
[
|
[
|
||||||
|
@ -110,4 +110,23 @@ os { winnt linux macosx } member? [
|
||||||
[ [ t ] [ "m" get next-change drop ] while ] must-fail
|
[ [ t ] [ "m" get next-change drop ] while ] must-fail
|
||||||
[ ] [ "m" get dispose ] unit-test
|
[ ] [ "m" get dispose ] unit-test
|
||||||
] with-monitors
|
] with-monitors
|
||||||
|
|
||||||
|
! Disposing a monitor should throw an error in any threads
|
||||||
|
! waiting on notifications
|
||||||
|
[
|
||||||
|
[ ] [
|
||||||
|
<promise> "p" set
|
||||||
|
"monitor-test" temp-file t <monitor> "m" set
|
||||||
|
10 seconds "m" get set-timeout
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[
|
||||||
|
[ "m" get next-change ] [ ] recover
|
||||||
|
"p" get fulfill
|
||||||
|
] in-thread
|
||||||
|
|
||||||
|
[ ] [ 1 seconds sleep ] unit-test
|
||||||
|
[ ] [ "m" get dispose ] unit-test
|
||||||
|
[ t ] [ "p" get 10 seconds ?promise-timeout already-disposed? ] unit-test
|
||||||
|
] with-monitors
|
||||||
] when
|
] when
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
! Copyright (C) 2008, 2010 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: io.backend kernel continuations destructors namespaces
|
USING: io.backend kernel continuations destructors namespaces
|
||||||
sequences assocs hashtables sorting arrays threads boxes
|
sequences assocs hashtables sorting arrays threads boxes
|
||||||
|
@ -26,6 +26,15 @@ M: monitor timeout timeout>> ;
|
||||||
|
|
||||||
M: monitor set-timeout (>>timeout) ;
|
M: monitor set-timeout (>>timeout) ;
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
SYMBOL: monitor-disposed
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
M: monitor dispose*
|
||||||
|
[ monitor-disposed ] dip queue>> mailbox-put ;
|
||||||
|
|
||||||
: new-monitor ( path mailbox class -- monitor )
|
: new-monitor ( path mailbox class -- monitor )
|
||||||
new-disposable
|
new-disposable
|
||||||
swap >>queue
|
swap >>queue
|
||||||
|
@ -34,8 +43,11 @@ M: monitor set-timeout (>>timeout) ;
|
||||||
TUPLE: file-change path changed monitor ;
|
TUPLE: file-change path changed monitor ;
|
||||||
|
|
||||||
: queue-change ( path changes monitor -- )
|
: queue-change ( path changes monitor -- )
|
||||||
3dup and and
|
3dup and and [
|
||||||
[ [ file-change boa ] keep queue>> mailbox-put ] [ 3drop ] if ;
|
[ check-disposed ] keep
|
||||||
|
[ file-change boa ] keep
|
||||||
|
queue>> mailbox-put
|
||||||
|
] [ 3drop ] if ;
|
||||||
|
|
||||||
HOOK: (monitor) io-backend ( path recursive? mailbox -- monitor )
|
HOOK: (monitor) io-backend ( path recursive? mailbox -- monitor )
|
||||||
|
|
||||||
|
@ -43,7 +55,11 @@ HOOK: (monitor) io-backend ( path recursive? mailbox -- monitor )
|
||||||
<mailbox> (monitor) ;
|
<mailbox> (monitor) ;
|
||||||
|
|
||||||
: next-change ( monitor -- change )
|
: next-change ( monitor -- change )
|
||||||
[ queue>> ] [ timeout ] bi mailbox-get-timeout ;
|
[ check-disposed ]
|
||||||
|
[
|
||||||
|
[ ] [ queue>> ] [ timeout ] tri mailbox-get-timeout
|
||||||
|
dup monitor-disposed eq? [ drop already-disposed ] [ nip ] if
|
||||||
|
] bi ;
|
||||||
|
|
||||||
SYMBOL: +add-file+
|
SYMBOL: +add-file+
|
||||||
SYMBOL: +remove-file+
|
SYMBOL: +remove-file+
|
||||||
|
|
|
@ -39,17 +39,19 @@ DEFER: add-child-monitor
|
||||||
: remove-child-monitor ( monitor -- )
|
: remove-child-monitor ( monitor -- )
|
||||||
monitor tget children>> delete-at* [ dispose ] [ drop ] if ;
|
monitor tget children>> delete-at* [ dispose ] [ drop ] if ;
|
||||||
|
|
||||||
|
SYMBOL: +stop+
|
||||||
|
|
||||||
M: recursive-monitor dispose*
|
M: recursive-monitor dispose*
|
||||||
[ "stop" swap thread>> send-synchronous drop ]
|
[ [ +stop+ ] dip thread>> send ] [ call-next-method ] bi ;
|
||||||
[ queue>> dispose ]
|
|
||||||
bi ;
|
|
||||||
|
|
||||||
: stop-pump ( -- )
|
: stop-pump ( -- )
|
||||||
monitor tget children>> values dispose-each ;
|
monitor tget children>> values dispose-each ;
|
||||||
|
|
||||||
: pump-step ( msg -- )
|
: pump-step ( msg -- )
|
||||||
|
monitor tget disposed>> [ drop ] [
|
||||||
[ [ monitor>> path>> ] [ path>> ] bi append-path ] [ changed>> ] bi
|
[ [ monitor>> path>> ] [ path>> ] bi append-path ] [ changed>> ] bi
|
||||||
monitor tget queue-change ;
|
monitor tget queue-change
|
||||||
|
] if ;
|
||||||
|
|
||||||
: child-added ( path monitor -- )
|
: child-added ( path monitor -- )
|
||||||
path>> prepend-path add-child-monitor ;
|
path>> prepend-path add-child-monitor ;
|
||||||
|
@ -69,8 +71,8 @@ M: recursive-monitor dispose*
|
||||||
] with with each ;
|
] with with each ;
|
||||||
|
|
||||||
: pump-loop ( -- )
|
: pump-loop ( -- )
|
||||||
receive dup synchronous? [
|
receive dup +stop+ eq? [
|
||||||
[ stop-pump t ] dip reply-synchronous
|
drop stop-pump
|
||||||
] [
|
] [
|
||||||
[ '[ _ update-hierarchy ] ignore-errors ] [ pump-step ] bi
|
[ '[ _ update-hierarchy ] ignore-errors ] [ pump-step ] bi
|
||||||
pump-loop
|
pump-loop
|
||||||
|
|
|
@ -100,4 +100,4 @@ M:: winnt (monitor) ( path recursive? mailbox -- monitor )
|
||||||
] with-destructors ;
|
] with-destructors ;
|
||||||
|
|
||||||
M: win32-monitor dispose
|
M: win32-monitor dispose
|
||||||
port>> dispose ;
|
[ port>> dispose ] [ call-next-method ] bi ;
|
||||||
|
|
|
@ -144,7 +144,7 @@ HELP: lcomp
|
||||||
{ $description "Get the cartesian product of the lists in " { $snippet "list" } " and call " { $snippet "quot" } " call with each element from the cartesian product on the stack, the result of which is returned in the final " { $snippet "list" } "." } ;
|
{ $description "Get the cartesian product of the lists in " { $snippet "list" } " and call " { $snippet "quot" } " call with each element from the cartesian product on the stack, the result of which is returned in the final " { $snippet "list" } "." } ;
|
||||||
|
|
||||||
HELP: lcomp*
|
HELP: lcomp*
|
||||||
{ $values { "list" "a list of lists" } { "guards" "a sequence of quotations with stack effect ( seq -- bool )" } { "quot" { $quotation "( seq -- X )" } } { "list" "the resulting list" } { "result" "a list" } }
|
{ $values { "list" "a list of lists" } { "guards" "a sequence of quotations with stack effect ( seq -- bool )" } { "quot" { $quotation "( seq -- X )" } } { "result" "a list" } }
|
||||||
{ $description "Get the cartesian product of the lists in " { $snippet "list" } ", filter it by applying each guard quotation to it and call " { $snippet "quot" } " call with each element from the remaining cartesian product items on the stack, the result of which is returned in the final " { $snippet "list" } "." }
|
{ $description "Get the cartesian product of the lists in " { $snippet "list" } ", filter it by applying each guard quotation to it and call " { $snippet "quot" } " call with each element from the remaining cartesian product items on the stack, the result of which is returned in the final " { $snippet "list" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $code "{ 1 2 3 } >list { 4 5 6 } >list 2list { [ first odd? ] } [ first2 + ] lcomp*" }
|
{ $code "{ 1 2 3 } >list { 4 5 6 } >list 2list { [ first odd? ] } [ first2 + ] lcomp*" }
|
||||||
|
|
|
@ -88,10 +88,10 @@ HELP: bit-count
|
||||||
|
|
||||||
HELP: bitroll-32
|
HELP: bitroll-32
|
||||||
{ $values
|
{ $values
|
||||||
{ "n" integer } { "s" integer }
|
{ "m" integer } { "s" integer }
|
||||||
{ "n'" integer }
|
{ "n" integer }
|
||||||
}
|
}
|
||||||
{ $description "Rolls the number " { $snippet "n" } " by " { $snippet "s" } " bits to the left, wrapping around after 32 bits." }
|
{ $description "Rolls the number " { $snippet "m" } " by " { $snippet "s" } " bits to the left, wrapping around after 32 bits." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: math.bitwise prettyprint ;"
|
{ $example "USING: math.bitwise prettyprint ;"
|
||||||
"HEX: 1 10 bitroll-32 .h"
|
"HEX: 1 10 bitroll-32 .h"
|
||||||
|
@ -105,10 +105,10 @@ HELP: bitroll-32
|
||||||
|
|
||||||
HELP: bitroll-64
|
HELP: bitroll-64
|
||||||
{ $values
|
{ $values
|
||||||
{ "n" integer } { "s" "a shift integer" }
|
{ "m" integer } { "s" "a shift integer" }
|
||||||
{ "n'" integer }
|
{ "n" integer }
|
||||||
}
|
}
|
||||||
{ $description "Rolls the number " { $snippet "n" } " by " { $snippet "s" } " bits to the left, wrapping around after 64 bits." }
|
{ $description "Rolls the number " { $snippet "m" } " by " { $snippet "s" } " bits to the left, wrapping around after 64 bits." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: math.bitwise prettyprint ;"
|
{ $example "USING: math.bitwise prettyprint ;"
|
||||||
"HEX: 1 10 bitroll-64 .h"
|
"HEX: 1 10 bitroll-64 .h"
|
||||||
|
@ -226,10 +226,10 @@ HELP: odd-parity?
|
||||||
|
|
||||||
HELP: on-bits
|
HELP: on-bits
|
||||||
{ $values
|
{ $values
|
||||||
{ "n" integer }
|
|
||||||
{ "m" integer }
|
{ "m" integer }
|
||||||
|
{ "n" integer }
|
||||||
}
|
}
|
||||||
{ $description "Returns an integer with " { $snippet "n" } " bits set." }
|
{ $description "Returns an integer with " { $snippet "m" } " bits set." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: math.bitwise kernel prettyprint ;"
|
{ $example "USING: math.bitwise kernel prettyprint ;"
|
||||||
"6 on-bits .h"
|
"6 on-bits .h"
|
||||||
|
@ -274,7 +274,7 @@ HELP: set-bit
|
||||||
|
|
||||||
HELP: shift-mod
|
HELP: shift-mod
|
||||||
{ $values
|
{ $values
|
||||||
{ "n" integer } { "s" integer } { "w" integer }
|
{ "m" integer } { "s" integer } { "w" integer }
|
||||||
{ "n" integer }
|
{ "n" integer }
|
||||||
}
|
}
|
||||||
{ $description "Calls " { $link shift } " on " { $snippet "n" } " and " { $snippet "s" } ", wrapping the result to " { $snippet "w" } " bits." } ;
|
{ $description "Calls " { $link shift } " on " { $snippet "n" } " and " { $snippet "s" } ", wrapping the result to " { $snippet "w" } " bits." } ;
|
||||||
|
@ -307,8 +307,8 @@ HELP: unmask?
|
||||||
|
|
||||||
HELP: w*
|
HELP: w*
|
||||||
{ $values
|
{ $values
|
||||||
{ "int" integer } { "int" integer }
|
{ "x" integer } { "y" integer }
|
||||||
{ "int" integer }
|
{ "z" integer }
|
||||||
}
|
}
|
||||||
{ $description "Multiplies two integers and wraps the result to 32 bits." }
|
{ $description "Multiplies two integers and wraps the result to 32 bits." }
|
||||||
{ $examples
|
{ $examples
|
||||||
|
@ -320,8 +320,8 @@ HELP: w*
|
||||||
|
|
||||||
HELP: w+
|
HELP: w+
|
||||||
{ $values
|
{ $values
|
||||||
{ "int" integer } { "int" integer }
|
{ "x" integer } { "y" integer }
|
||||||
{ "int" integer }
|
{ "z" integer }
|
||||||
}
|
}
|
||||||
{ $description "Adds two integers and wraps the result to 32 bits." }
|
{ $description "Adds two integers and wraps the result to 32 bits." }
|
||||||
{ $examples
|
{ $examples
|
||||||
|
@ -333,8 +333,8 @@ HELP: w+
|
||||||
|
|
||||||
HELP: w-
|
HELP: w-
|
||||||
{ $values
|
{ $values
|
||||||
{ "int" integer } { "int" integer }
|
{ "x" integer } { "y" integer }
|
||||||
{ "int" integer }
|
{ "z" integer }
|
||||||
}
|
}
|
||||||
{ $description "Subtracts two integers and wraps the result to 32 bits." }
|
{ $description "Subtracts two integers and wraps the result to 32 bits." }
|
||||||
{ $examples
|
{ $examples
|
||||||
|
|
|
@ -17,29 +17,32 @@ IN: math.bitwise
|
||||||
: wrap ( m n -- m' ) 1 - bitand ; inline
|
: wrap ( m n -- m' ) 1 - bitand ; inline
|
||||||
: bits ( m n -- m' ) 2^ wrap ; inline
|
: bits ( m n -- m' ) 2^ wrap ; inline
|
||||||
: mask-bit ( m n -- m' ) 2^ mask ; inline
|
: mask-bit ( m n -- m' ) 2^ mask ; inline
|
||||||
: on-bits ( n -- m ) 2^ 1 - ; inline
|
: on-bits ( m -- n ) 2^ 1 - ; inline
|
||||||
: toggle-bit ( m n -- m' ) 2^ bitxor ; inline
|
: toggle-bit ( m n -- m' ) 2^ bitxor ; inline
|
||||||
|
: >signed ( x n -- y ) 2dup neg 1 + shift 1 = [ 2^ - ] [ drop ] if ;
|
||||||
: shift-mod ( n s w -- n )
|
: >odd ( m -- n ) 0 set-bit ; foldable
|
||||||
[ shift ] dip 2^ wrap ; inline
|
: >even ( m -- n ) 0 clear-bit ; foldable
|
||||||
|
: next-even ( m -- n ) >even 2 + ; foldable
|
||||||
|
: next-odd ( m -- n ) dup even? [ 1 + ] [ 2 + ] if ; foldable
|
||||||
|
: shift-mod ( m s w -- n ) [ shift ] dip 2^ wrap ; inline
|
||||||
|
|
||||||
: bitroll ( x s w -- y )
|
: bitroll ( x s w -- y )
|
||||||
[ wrap ] keep
|
[ wrap ] keep
|
||||||
[ shift-mod ] [ [ - ] keep shift-mod ] 3bi bitor ; inline
|
[ shift-mod ] [ [ - ] keep shift-mod ] 3bi bitor ; inline
|
||||||
|
|
||||||
: bitroll-32 ( n s -- n' ) 32 bitroll ; inline
|
: bitroll-32 ( m s -- n ) 32 bitroll ; inline
|
||||||
|
|
||||||
: bitroll-64 ( n s -- n' ) 64 bitroll ; inline
|
: bitroll-64 ( m s -- n ) 64 bitroll ; inline
|
||||||
|
|
||||||
! 32-bit arithmetic
|
! 32-bit arithmetic
|
||||||
: w+ ( int int -- int ) + 32 bits ; inline
|
: w+ ( x y -- z ) + 32 bits ; inline
|
||||||
: w- ( int int -- int ) - 32 bits ; inline
|
: w- ( x y -- z ) - 32 bits ; inline
|
||||||
: w* ( int int -- int ) * 32 bits ; inline
|
: w* ( x y -- z ) * 32 bits ; inline
|
||||||
|
|
||||||
! 64-bit arithmetic
|
! 64-bit arithmetic
|
||||||
: W+ ( int int -- int ) + 64 bits ; inline
|
: W+ ( x y -- z ) + 64 bits ; inline
|
||||||
: W- ( int int -- int ) - 64 bits ; inline
|
: W- ( x y -- z ) - 64 bits ; inline
|
||||||
: W* ( int int -- int ) * 64 bits ; inline
|
: W* ( x y -- z ) * 64 bits ; inline
|
||||||
|
|
||||||
! flags
|
! flags
|
||||||
MACRO: flags ( values -- )
|
MACRO: flags ( values -- )
|
||||||
|
@ -117,17 +120,6 @@ M: object bit-count
|
||||||
[ >c-ptr ] [ byte-length ] bi <direct-uchar-array>
|
[ >c-ptr ] [ byte-length ] bi <direct-uchar-array>
|
||||||
byte-array-bit-count ;
|
byte-array-bit-count ;
|
||||||
|
|
||||||
: >signed ( x n -- y )
|
|
||||||
2dup neg 1 + shift 1 = [ 2^ - ] [ drop ] if ;
|
|
||||||
|
|
||||||
: >odd ( n -- int ) 0 set-bit ; foldable
|
|
||||||
|
|
||||||
: >even ( n -- int ) 0 clear-bit ; foldable
|
|
||||||
|
|
||||||
: next-even ( m -- n ) >even 2 + ; foldable
|
|
||||||
|
|
||||||
: next-odd ( m -- n ) dup even? [ 1 + ] [ 2 + ] if ; foldable
|
|
||||||
|
|
||||||
: even-parity? ( obj -- ? ) bit-count even? ;
|
: even-parity? ( obj -- ? ) bit-count even? ;
|
||||||
|
|
||||||
: odd-parity? ( obj -- ? ) bit-count odd? ;
|
: odd-parity? ( obj -- ? ) bit-count odd? ;
|
||||||
|
|
|
@ -26,7 +26,7 @@ HELP: nCk
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: permutation
|
HELP: permutation
|
||||||
{ $values { "n" "a non-negative integer" } { "seq" sequence } { "seq" sequence } }
|
{ $values { "n" "a non-negative integer" } { "seq" sequence } { "seq'" sequence } }
|
||||||
{ $description "Outputs the " { $snippet "nth" } " lexicographical permutation of " { $snippet "seq" } "." }
|
{ $description "Outputs the " { $snippet "nth" } " lexicographical permutation of " { $snippet "seq" } "." }
|
||||||
{ $notes "Permutations are 0-based and a bounds error will be thrown if " { $snippet "n" } " is larger than " { $snippet "seq length factorial 1 -" } "." }
|
{ $notes "Permutations are 0-based and a bounds error will be thrown if " { $snippet "n" } " is larger than " { $snippet "seq length factorial 1 -" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
|
@ -37,7 +37,7 @@ HELP: permutation
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: all-permutations
|
HELP: all-permutations
|
||||||
{ $values { "seq" sequence } { "seq" sequence } }
|
{ $values { "seq" sequence } { "seq'" sequence } }
|
||||||
{ $description "Outputs a sequence containing all permutations of " { $snippet "seq" } " in lexicographical order." }
|
{ $description "Outputs a sequence containing all permutations of " { $snippet "seq" } " in lexicographical order." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: math.combinatorics prettyprint ;"
|
{ $example "USING: math.combinatorics prettyprint ;"
|
||||||
|
@ -60,7 +60,7 @@ HELP: inverse-permutation
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: combination
|
HELP: combination
|
||||||
{ $values { "m" "a non-negative integer" } { "seq" sequence } { "k" "a non-negative integer" } { "seq" sequence } }
|
{ $values { "m" "a non-negative integer" } { "seq" sequence } { "k" "a non-negative integer" } { "seq'" sequence } }
|
||||||
{ $description "Outputs the " { $snippet "mth" } " lexicographical combination of " { $snippet "seq" } " choosing " { $snippet "k" } " elements." }
|
{ $description "Outputs the " { $snippet "mth" } " lexicographical combination of " { $snippet "seq" } " choosing " { $snippet "k" } " elements." }
|
||||||
{ $notes "Combinations are 0-based and a bounds error will be thrown if " { $snippet "m" } " is larger than " { $snippet "seq length k nCk" } "." }
|
{ $notes "Combinations are 0-based and a bounds error will be thrown if " { $snippet "m" } " is larger than " { $snippet "seq length k nCk" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
|
@ -71,7 +71,7 @@ HELP: combination
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: all-combinations
|
HELP: all-combinations
|
||||||
{ $values { "seq" sequence } { "k" "a non-negative integer" } { "seq" sequence } }
|
{ $values { "seq" sequence } { "k" "a non-negative integer" } { "seq'" sequence } }
|
||||||
{ $description "Outputs a sequence containing all combinations of " { $snippet "seq" } " choosing " { $snippet "k" } " elements, in lexicographical order." }
|
{ $description "Outputs a sequence containing all combinations of " { $snippet "seq" } " choosing " { $snippet "k" } " elements, in lexicographical order." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: math.combinatorics prettyprint ;"
|
{ $example "USING: math.combinatorics prettyprint ;"
|
||||||
|
|
|
@ -42,10 +42,10 @@ PRIVATE>
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: permutation ( n seq -- seq )
|
: permutation ( n seq -- seq' )
|
||||||
[ permutation-indices ] keep nths ;
|
[ permutation-indices ] keep nths ;
|
||||||
|
|
||||||
: all-permutations ( seq -- seq )
|
: all-permutations ( seq -- seq' )
|
||||||
[ length factorial iota ] keep
|
[ length factorial iota ] keep
|
||||||
'[ _ permutation ] map ;
|
'[ _ permutation ] map ;
|
||||||
|
|
||||||
|
@ -118,10 +118,10 @@ PRIVATE>
|
||||||
: map>assoc-combinations ( seq k quot exemplar -- )
|
: map>assoc-combinations ( seq k quot exemplar -- )
|
||||||
[ combinations-quot ] dip map>assoc ; inline
|
[ combinations-quot ] dip map>assoc ; inline
|
||||||
|
|
||||||
: combination ( m seq k -- seq )
|
: combination ( m seq k -- seq' )
|
||||||
<combo> apply-combination ;
|
<combo> apply-combination ;
|
||||||
|
|
||||||
: all-combinations ( seq k -- seq )
|
: all-combinations ( seq k -- seq' )
|
||||||
[ ] combinations-quot map ;
|
[ ] combinations-quot map ;
|
||||||
|
|
||||||
: reduce-combinations ( seq k identity quot -- result )
|
: reduce-combinations ( seq k identity quot -- result )
|
||||||
|
|
|
@ -36,12 +36,12 @@ HELP: p=
|
||||||
{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 0 1 } { 0 1 0 } p= ." "t" } } ;
|
{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 0 1 } { 0 1 0 } p= ." "t" } } ;
|
||||||
|
|
||||||
HELP: ptrim
|
HELP: ptrim
|
||||||
{ $values { "p" "a polynomial" } { "p" "a polynomial" } }
|
{ $values { "p" "a polynomial" } { "q" "a polynomial" } }
|
||||||
{ $description "Trims excess zeros from a polynomial." }
|
{ $description "Trims excess zeros from a polynomial." }
|
||||||
{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 0 1 0 0 } ptrim ." "{ 0 1 }" } } ;
|
{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 0 1 0 0 } ptrim ." "{ 0 1 }" } } ;
|
||||||
|
|
||||||
HELP: 2ptrim
|
HELP: 2ptrim
|
||||||
{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } }
|
{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "p'" "a polynomial" } { "q'" "a polynomial" } }
|
||||||
{ $description "Trims excess zeros from two polynomials." }
|
{ $description "Trims excess zeros from two polynomials." }
|
||||||
{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 0 1 0 0 } { 1 0 0 } 2ptrim [ . ] bi@" "{ 0 1 }\n{ 1 }" } } ;
|
{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 0 1 0 0 } { 1 0 0 } 2ptrim [ . ] bi@" "{ 0 1 }\n{ 1 }" } } ;
|
||||||
|
|
||||||
|
@ -61,7 +61,7 @@ HELP: n*p
|
||||||
{ $examples { $example "USING: math.polynomials prettyprint ;" "4 { 3 0 1 } n*p ." "{ 12 0 4 }" } } ;
|
{ $examples { $example "USING: math.polynomials prettyprint ;" "4 { 3 0 1 } n*p ." "{ 12 0 4 }" } } ;
|
||||||
|
|
||||||
HELP: pextend-conv
|
HELP: pextend-conv
|
||||||
{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } }
|
{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "p'" "a polynomial" } { "q'" "a polynomial" } }
|
||||||
{ $description "Convulution, extending to " { $snippet "p_m + q_n - 1" } "." }
|
{ $description "Convulution, extending to " { $snippet "p_m + q_n - 1" } "." }
|
||||||
{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } pextend-conv [ . ] bi@" "V{ 1 0 1 0 }\nV{ 0 1 0 0 }" } } ;
|
{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } pextend-conv [ . ] bi@" "V{ 1 0 1 0 }\nV{ 0 1 0 0 }" } } ;
|
||||||
|
|
||||||
|
|
|
@ -20,15 +20,15 @@ PRIVATE>
|
||||||
|
|
||||||
: p= ( p q -- ? ) pextend = ;
|
: p= ( p q -- ? ) pextend = ;
|
||||||
|
|
||||||
: ptrim ( p -- p )
|
: ptrim ( p -- q )
|
||||||
dup length 1 = [ [ zero? ] trim-tail ] unless ;
|
dup length 1 = [ [ zero? ] trim-tail ] unless ;
|
||||||
|
|
||||||
: 2ptrim ( p q -- p q ) [ ptrim ] bi@ ;
|
: 2ptrim ( p q -- p' q' ) [ ptrim ] bi@ ;
|
||||||
: p+ ( p q -- r ) pextend v+ ;
|
: p+ ( p q -- r ) pextend v+ ;
|
||||||
: p- ( p q -- r ) pextend v- ;
|
: p- ( p q -- r ) pextend v- ;
|
||||||
: n*p ( n p -- n*p ) n*v ;
|
: n*p ( n p -- n*p ) n*v ;
|
||||||
|
|
||||||
: pextend-conv ( p q -- p q )
|
: pextend-conv ( p q -- p' q' )
|
||||||
2dup [ length ] bi@ + 1 - 2pad-tail [ >vector ] bi@ ;
|
2dup [ length ] bi@ + 1 - 2pad-tail [ >vector ] bi@ ;
|
||||||
|
|
||||||
: p* ( p q -- r )
|
: p* ( p q -- r )
|
||||||
|
|
|
@ -30,7 +30,7 @@ HELP: q/
|
||||||
{ $examples { $example "USING: math.quaternions prettyprint ;" "{ 0 0 0 1 } { 0 0 1 0 } q/ ." "{ 0 1 0 0 }" } } ;
|
{ $examples { $example "USING: math.quaternions prettyprint ;" "{ 0 0 0 1 } { 0 0 1 0 } q/ ." "{ 0 1 0 0 }" } } ;
|
||||||
|
|
||||||
HELP: q*n
|
HELP: q*n
|
||||||
{ $values { "q" "a quaternion" } { "n" real } { "q" "a quaternion" } }
|
{ $values { "q" "a quaternion" } { "n" real } { "r" "a quaternion" } }
|
||||||
{ $description "Multiplies each element of " { $snippet "q" } " by real value " { $snippet "n" } "." }
|
{ $description "Multiplies each element of " { $snippet "q" } " by real value " { $snippet "n" } "." }
|
||||||
{ $notes "To multiply a quaternion with a complex value, use " { $link c>q } " " { $link q* } "." } ;
|
{ $notes "To multiply a quaternion with a complex value, use " { $link c>q } " " { $link q* } "." } ;
|
||||||
|
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
! Copyright (C) 2005, 2007 Slava Pestov.
|
! Copyright (C) 2005, 2010 Joe Groff, Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: arrays combinators kernel locals math math.functions
|
USING: arrays combinators kernel locals math math.functions
|
||||||
math.libm math.order math.vectors sequences ;
|
math.libm math.order math.vectors sequences ;
|
||||||
|
@ -35,10 +35,10 @@ M: object qconjugate ( u -- u' )
|
||||||
: q/ ( u v -- u/v )
|
: q/ ( u v -- u/v )
|
||||||
qrecip q* ; inline
|
qrecip q* ; inline
|
||||||
|
|
||||||
: n*q ( q n -- q )
|
: n*q ( q n -- r )
|
||||||
v*n ; inline
|
v*n ; inline
|
||||||
|
|
||||||
: q*n ( q n -- q )
|
: q*n ( q n -- r )
|
||||||
v*n ; inline
|
v*n ; inline
|
||||||
|
|
||||||
: n>q ( n -- q )
|
: n>q ( n -- q )
|
||||||
|
|
|
@ -87,7 +87,6 @@ HELP: histogram
|
||||||
HELP: histogram!
|
HELP: histogram!
|
||||||
{ $values
|
{ $values
|
||||||
{ "hashtable" hashtable } { "seq" sequence }
|
{ "hashtable" hashtable } { "seq" sequence }
|
||||||
{ "hashtable" hashtable }
|
|
||||||
}
|
}
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "! Count the number of times the elements of two sequences appear."
|
{ $example "! Count the number of times the elements of two sequences appear."
|
||||||
|
@ -128,7 +127,6 @@ HELP: sequence>assoc
|
||||||
HELP: sequence>assoc!
|
HELP: sequence>assoc!
|
||||||
{ $values
|
{ $values
|
||||||
{ "assoc" assoc } { "seq" sequence } { "quot" quotation }
|
{ "assoc" assoc } { "seq" sequence } { "quot" quotation }
|
||||||
{ "assoc" assoc }
|
|
||||||
}
|
}
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "! Iterate over a sequence and add the counts to an existing assoc"
|
{ $example "! Iterate over a sequence and add the counts to an existing assoc"
|
||||||
|
|
|
@ -52,7 +52,7 @@ HELP: delete-gl-shader
|
||||||
{ $description "Deletes the shader object, invalidating it and releasing any resources allocated for it by the OpenGL implementation." } ;
|
{ $description "Deletes the shader object, invalidating it and releasing any resources allocated for it by the OpenGL implementation." } ;
|
||||||
|
|
||||||
HELP: gl-shader-info-log
|
HELP: gl-shader-info-log
|
||||||
{ $values { "shader" "A " { $link gl-shader } " object" } { "shader" "a new " { $link gl-shader } } { "log" string } }
|
{ $values { "shader" "A " { $link gl-shader } " object" } { "log" string } }
|
||||||
{ $description "Retrieves the info log for " { $snippet "shader" } ", including any errors or warnings generated in compiling the shader object." } ;
|
{ $description "Retrieves the info log for " { $snippet "shader" } ", including any errors or warnings generated in compiling the shader object." } ;
|
||||||
|
|
||||||
HELP: gl-program
|
HELP: gl-program
|
||||||
|
|
|
@ -75,7 +75,7 @@ HELP: with-system-random
|
||||||
HELP: randomize
|
HELP: randomize
|
||||||
{ $values
|
{ $values
|
||||||
{ "seq" sequence }
|
{ "seq" sequence }
|
||||||
{ "seq" sequence }
|
{ "randomized" sequence }
|
||||||
}
|
}
|
||||||
{ $description "Randomizes a sequence in-place with the Fisher-Yates algorithm and returns the sequence." } ;
|
{ $description "Randomizes a sequence in-place with the Fisher-Yates algorithm and returns the sequence." } ;
|
||||||
|
|
||||||
|
|
|
@ -67,7 +67,7 @@ M: sequence random
|
||||||
[ [ random ] [ 1 - ] bi [ pick exchange ] keep ]
|
[ [ random ] [ 1 - ] bi [ pick exchange ] keep ]
|
||||||
while drop ;
|
while drop ;
|
||||||
|
|
||||||
: randomize ( seq -- seq )
|
: randomize ( seq -- randomized )
|
||||||
dup length randomize-n-last ;
|
dup length randomize-n-last ;
|
||||||
|
|
||||||
ERROR: too-many-samples seq n ;
|
ERROR: too-many-samples seq n ;
|
||||||
|
|
|
@ -39,7 +39,7 @@ HELP: roman>
|
||||||
{ >roman >ROMAN roman> } related-words
|
{ >roman >ROMAN roman> } related-words
|
||||||
|
|
||||||
HELP: roman+
|
HELP: roman+
|
||||||
{ $values { "x" string } { "x" string } { "x" string } }
|
{ $values { "x" string } { "y" string } { "z" string } }
|
||||||
{ $description "Adds two Roman numerals." }
|
{ $description "Adds two Roman numerals." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: io roman ;"
|
{ $example "USING: io roman ;"
|
||||||
|
@ -49,7 +49,7 @@ HELP: roman+
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: roman-
|
HELP: roman-
|
||||||
{ $values { "x" string } { "x" string } { "x" string } }
|
{ $values { "x" string } { "y" string } { "z" string } }
|
||||||
{ $description "Subtracts two Roman numerals." }
|
{ $description "Subtracts two Roman numerals." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: io roman ;"
|
{ $example "USING: io roman ;"
|
||||||
|
@ -61,7 +61,7 @@ HELP: roman-
|
||||||
{ roman+ roman- } related-words
|
{ roman+ roman- } related-words
|
||||||
|
|
||||||
HELP: roman*
|
HELP: roman*
|
||||||
{ $values { "x" string } { "x" string } { "x" string } }
|
{ $values { "x" string } { "y" string } { "z" string } }
|
||||||
{ $description "Multiplies two Roman numerals." }
|
{ $description "Multiplies two Roman numerals." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: io roman ;"
|
{ $example "USING: io roman ;"
|
||||||
|
@ -71,7 +71,7 @@ HELP: roman*
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: roman/i
|
HELP: roman/i
|
||||||
{ $values { "x" string } { "x" string } { "x" string } }
|
{ $values { "x" string } { "y" string } { "z" string } }
|
||||||
{ $description "Computes the integer division of two Roman numerals." }
|
{ $description "Computes the integer division of two Roman numerals." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: io roman ;"
|
{ $example "USING: io roman ;"
|
||||||
|
@ -81,7 +81,7 @@ HELP: roman/i
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: roman/mod
|
HELP: roman/mod
|
||||||
{ $values { "x" string } { "x" string } { "x" string } { "x" string } }
|
{ $values { "x" string } { "y" string } { "z" string } { "w" string } }
|
||||||
{ $description "Computes the quotient and remainder of two Roman numerals." }
|
{ $description "Computes the quotient and remainder of two Roman numerals." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: kernel io roman ;"
|
{ $example "USING: kernel io roman ;"
|
||||||
|
|
|
@ -2,8 +2,9 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors arrays assocs effects fry generalizations
|
USING: accessors arrays assocs effects fry generalizations
|
||||||
grouping kernel lexer macros math math.order math.vectors
|
grouping kernel lexer macros math math.order math.vectors
|
||||||
namespaces parser quotations sequences sequences.private
|
namespaces parser effects.parser quotations sequences
|
||||||
splitting.monotonic stack-checker strings unicode.case words ;
|
sequences.private splitting.monotonic stack-checker strings
|
||||||
|
unicode.case words ;
|
||||||
IN: roman
|
IN: roman
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
@ -58,14 +59,14 @@ PRIVATE>
|
||||||
SYNTAX: ROMAN-OP:
|
SYNTAX: ROMAN-OP:
|
||||||
scan-word [ name>> "roman" prepend create-in ] keep
|
scan-word [ name>> "roman" prepend create-in ] keep
|
||||||
1quotation '[ _ binary-roman-op ]
|
1quotation '[ _ binary-roman-op ]
|
||||||
dup infer define-declared ;
|
complete-effect define-declared ;
|
||||||
|
|
||||||
>>
|
>>
|
||||||
|
|
||||||
ROMAN-OP: +
|
ROMAN-OP: + ( x y -- z )
|
||||||
ROMAN-OP: -
|
ROMAN-OP: - ( x y -- z )
|
||||||
ROMAN-OP: *
|
ROMAN-OP: * ( x y -- z )
|
||||||
ROMAN-OP: /i
|
ROMAN-OP: /i ( x y -- z )
|
||||||
ROMAN-OP: /mod
|
ROMAN-OP: /mod ( x y -- z w )
|
||||||
|
|
||||||
SYNTAX: ROMAN: scan roman> suffix! ;
|
SYNTAX: ROMAN: scan roman> suffix! ;
|
||||||
|
|
|
@ -31,7 +31,7 @@ HELP: flatten
|
||||||
{ $description "Creates a sequence of all of the leaf nodes (non-sequence nodes, but including strings and numbers) in the object." } ;
|
{ $description "Creates a sequence of all of the leaf nodes (non-sequence nodes, but including strings and numbers) in the object." } ;
|
||||||
|
|
||||||
HELP: deep-map!
|
HELP: deep-map!
|
||||||
{ $values { "obj" object } { "quot" { $quotation "( elt -- newelt )" } } { "obj" object } }
|
{ $values { "obj" object } { "quot" { $quotation "( elt -- newelt )" } } }
|
||||||
{ $description "Modifies each sub-node of an object in place, in preorder, and returns that object." }
|
{ $description "Modifies each sub-node of an object in place, in preorder, and returns that object." }
|
||||||
{ $see-also map! } ;
|
{ $see-also map! } ;
|
||||||
|
|
||||||
|
|
|
@ -33,7 +33,7 @@ HELP: set-gl-context
|
||||||
{ $description "Selects an OpenGL context to be the implicit destination for subsequent GL rendering calls. This word is called automatically by the UI before drawing a " { $link world } "." } ;
|
{ $description "Selects an OpenGL context to be the implicit destination for subsequent GL rendering calls. This word is called automatically by the UI before drawing a " { $link world } "." } ;
|
||||||
|
|
||||||
HELP: window-resource
|
HELP: window-resource
|
||||||
{ $values { "resource" disposable } { "resource" disposable } }
|
{ $values { "resource" disposable } }
|
||||||
{ $description "Marks " { $snippet "resource" } " to be destroyed with " { $link dispose } " when the window with the currently active OpenGL context (set by " { $link set-gl-context } ") is closed. " { $snippet "resource" } " is left unmodified at the top of the stack." } ;
|
{ $description "Marks " { $snippet "resource" } " to be destroyed with " { $link dispose } " when the window with the currently active OpenGL context (set by " { $link set-gl-context } ") is closed. " { $snippet "resource" } " is left unmodified at the top of the stack." } ;
|
||||||
|
|
||||||
HELP: flush-gl-context
|
HELP: flush-gl-context
|
||||||
|
|
|
@ -9,7 +9,7 @@ HELP: interactor
|
||||||
$nl
|
$nl
|
||||||
"Interactors are created by calling " { $link <interactor> } "."
|
"Interactors are created by calling " { $link <interactor> } "."
|
||||||
$nl
|
$nl
|
||||||
"Interactors implement the " { $link stream-readln } ", " { $link stream-read } " and " { $link read-quot } " generic words." } ;
|
"Interactors implement the " { $link stream-readln } ", " { $link stream-read } " and " { $link stream-read-quot } " generic words." } ;
|
||||||
|
|
||||||
ARTICLE: "ui-listener" "UI listener"
|
ARTICLE: "ui-listener" "UI listener"
|
||||||
"The graphical listener adds input history and word and vocabulary completion. See " { $link "listener" } " for general information on the listener."
|
"The graphical listener adds input history and word and vocabulary completion. See " { $link "listener" } " for general information on the listener."
|
||||||
|
|
|
@ -49,7 +49,7 @@ HELP: rpc-fault
|
||||||
|
|
||||||
HELP: post-rpc
|
HELP: post-rpc
|
||||||
{ $values { "rpc" "an XML-RPC input tuple" } { "url" "a URL" }
|
{ $values { "rpc" "an XML-RPC input tuple" } { "url" "a URL" }
|
||||||
{ "rpc" "an XML-RPC output tuple" } }
|
{ "rpc'" "an XML-RPC output tuple" } }
|
||||||
{ $description "posts an XML-RPC document to the specified URL, receives the response and parses it as XML-RPC, returning the tuple" } ;
|
{ $description "posts an XML-RPC document to the specified URL, receives the response and parses it as XML-RPC, returning the tuple" } ;
|
||||||
|
|
||||||
ARTICLE: { "xml-rpc" "intro" } "XML-RPC"
|
ARTICLE: { "xml-rpc" "intro" } "XML-RPC"
|
||||||
|
|
|
@ -186,7 +186,7 @@ TAG: array xml>item
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: post-rpc ( rpc url -- rpc )
|
: post-rpc ( rpc url -- rpc' )
|
||||||
! This needs to do something in the event of an error
|
! This needs to do something in the event of an error
|
||||||
rpc-post-request http-request nip string>xml receive-rpc ;
|
rpc-post-request http-request nip string>xml receive-rpc ;
|
||||||
|
|
||||||
|
|
|
@ -58,7 +58,7 @@ HELP: children-tags
|
||||||
{ $see-also first-child-tag } ;
|
{ $see-also first-child-tag } ;
|
||||||
|
|
||||||
HELP: first-child-tag
|
HELP: first-child-tag
|
||||||
{ $values { "tag" "an XML tag or document" } { "tag" tag } }
|
{ $values { "tag" "an XML tag or document" } { "child" tag } }
|
||||||
{ $description "Returns the first child of the given tag that is a tag." }
|
{ $description "Returns the first child of the given tag that is a tag." }
|
||||||
{ $see-also children-tags } ;
|
{ $see-also children-tags } ;
|
||||||
|
|
||||||
|
|
|
@ -18,7 +18,7 @@ IN: xml.traversal
|
||||||
: children-tags ( tag -- sequence )
|
: children-tags ( tag -- sequence )
|
||||||
children>> [ tag? ] filter ;
|
children>> [ tag? ] filter ;
|
||||||
|
|
||||||
: first-child-tag ( tag -- tag )
|
: first-child-tag ( tag -- child )
|
||||||
children>> [ tag? ] find nip ;
|
children>> [ tag? ] find nip ;
|
||||||
|
|
||||||
: tag-named? ( name elem -- ? )
|
: tag-named? ( name elem -- ? )
|
||||||
|
|
|
@ -383,7 +383,7 @@ HELP: cache
|
||||||
{ $side-effects "assoc" } ;
|
{ $side-effects "assoc" } ;
|
||||||
|
|
||||||
HELP: 2cache
|
HELP: 2cache
|
||||||
{ $values { "key1" "a key" } { "key2" "a key" } { "assoc" assoc } { "quot" { $quotation "( key -- value )" } } { "value" "a previously-retained or freshly-computed value" } }
|
{ $values { "key1" "a key" } { "key2" "a key" } { "assoc" assoc } { "quot" { $quotation "( key1 key2 -- value )" } } { "value" "a previously-retained or freshly-computed value" } }
|
||||||
{ $description "If a single key composed of the input keys is present in the assoc, outputs the associated value, otherwise calls the quotation to produce a value and stores the keys/value pair into the assoc. Returns the value stored in the assoc. Returns a value either looked up or newly stored in the assoc." }
|
{ $description "If a single key composed of the input keys is present in the assoc, outputs the associated value, otherwise calls the quotation to produce a value and stores the keys/value pair into the assoc. Returns the value stored in the assoc. Returns a value either looked up or newly stored in the assoc." }
|
||||||
{ $side-effects "assoc" } ;
|
{ $side-effects "assoc" } ;
|
||||||
|
|
||||||
|
@ -432,7 +432,7 @@ HELP: assoc-combine
|
||||||
|
|
||||||
HELP: assoc-map-as
|
HELP: assoc-map-as
|
||||||
{ $values
|
{ $values
|
||||||
{ "assoc" assoc } { "quot" quotation } { "exemplar" assoc }
|
{ "assoc" assoc } { "quot" { $quotation "( key value -- newkey newvalue )" } } { "exemplar" assoc }
|
||||||
{ "newassoc" assoc } }
|
{ "newassoc" assoc } }
|
||||||
{ $description "Applies the quotation to each entry in the input assoc and collects the results in a new assoc of the stame type as the exemplar." }
|
{ $description "Applies the quotation to each entry in the input assoc and collects the results in a new assoc of the stame type as the exemplar." }
|
||||||
{ $examples { $example "USING: prettyprint assocs hashtables math ;" " H{ { 1 2 } { 3 4 } } [ sq ] { } assoc-map-as ." "{ { 1 4 } { 3 16 } }" } } ;
|
{ $examples { $example "USING: prettyprint assocs hashtables math ;" " H{ { 1 2 } { 3 4 } } [ sq ] { } assoc-map-as ." "{ { 1 4 } { 3 16 } }" } } ;
|
||||||
|
|
|
@ -708,7 +708,7 @@ HELP: 3curry
|
||||||
{ $notes "This operation is efficient and does not copy the quotation." } ;
|
{ $notes "This operation is efficient and does not copy the quotation." } ;
|
||||||
|
|
||||||
HELP: with
|
HELP: with
|
||||||
{ $values { "param" object } { "obj" object } { "quot" { $quotation "( param elt -- ... )" } } { "obj" object } { "curry" curry } }
|
{ $values { "param" object } { "obj" object } { "quot" { $quotation "( param elt -- ... )" } } { "curry" curry } }
|
||||||
{ $description "Partial application on the left. The following two lines are equivalent:"
|
{ $description "Partial application on the left. The following two lines are equivalent:"
|
||||||
{ $code "swap [ swap A ] curry B" }
|
{ $code "swap [ swap A ] curry B" }
|
||||||
{ $code "[ A ] with B" }
|
{ $code "[ A ] with B" }
|
||||||
|
|
|
@ -212,7 +212,7 @@ HELP: recip
|
||||||
HELP: rem
|
HELP: rem
|
||||||
{ $values { "x" rational } { "y" rational } { "z" rational } }
|
{ $values { "x" rational } { "y" rational } { "z" rational } }
|
||||||
{ $description
|
{ $description
|
||||||
"Computes the remainder of dividing " { $snippet "x" } " by " { $snippet "y" } ", with the remainder always positive."
|
"Computes the remainder of dividing " { $snippet "x" } " by " { $snippet "y" } ", with the remainder always positive or zero."
|
||||||
{ $list
|
{ $list
|
||||||
"Given fixnums, always yields a fixnum."
|
"Given fixnums, always yields a fixnum."
|
||||||
"Given bignums, always yields a bignum."
|
"Given bignums, always yields a bignum."
|
||||||
|
|
|
@ -177,7 +177,7 @@ HELP: parse-lines
|
||||||
{ $errors "Throws a " { $link lexer-error } " if the input is malformed." } ;
|
{ $errors "Throws a " { $link lexer-error } " if the input is malformed." } ;
|
||||||
|
|
||||||
HELP: parse-base
|
HELP: parse-base
|
||||||
{ $values { "parsed" integer } { "base" "an integer between 2 and 36" } { "parsed" integer } }
|
{ $values { "parsed" integer } { "base" "an integer between 2 and 36" } }
|
||||||
{ $description "Reads an integer in a specific numerical base from the parser input." }
|
{ $description "Reads an integer in a specific numerical base from the parser input." }
|
||||||
$parsing-note ;
|
$parsing-note ;
|
||||||
|
|
||||||
|
|
|
@ -269,7 +269,7 @@ HELP: reduce
|
||||||
|
|
||||||
HELP: reduce-index
|
HELP: reduce-index
|
||||||
{ $values
|
{ $values
|
||||||
{ "seq" sequence } { "identity" object } { "quot" quotation } }
|
{ "seq" sequence } { "identity" object } { "quot" { $quotation "( prev elt index -- result )" } } }
|
||||||
{ $description "Combines successive elements of the sequence and their indices binary operations, and outputs the final result. On the first iteration, the three inputs to the quotation are " { $snippet "identity" } ", the first element of the sequence, and its index, 0. On successive iterations, the first input is the result of the previous iteration, the second input is the corresponding element of the sequence, and the third is its index." }
|
{ $description "Combines successive elements of the sequence and their indices binary operations, and outputs the final result. On the first iteration, the three inputs to the quotation are " { $snippet "identity" } ", the first element of the sequence, and its index, 0. On successive iterations, the first input is the result of the previous iteration, the second input is the corresponding element of the sequence, and the third is its index." }
|
||||||
{ $examples { $example "USING: sequences prettyprint math ;"
|
{ $examples { $example "USING: sequences prettyprint math ;"
|
||||||
"{ 10 50 90 } 0 [ + + ] reduce-index ."
|
"{ 10 50 90 } 0 [ + + ] reduce-index ."
|
||||||
|
@ -296,7 +296,7 @@ $nl
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: accumulate!
|
HELP: accumulate!
|
||||||
{ $values { "seq" sequence } { "identity" object } { "quot" { $quotation "( prev elt -- next )" } } { "final" "the final result" } { "seq" sequence } }
|
{ $values { "seq" sequence } { "identity" object } { "quot" { $quotation "( prev elt -- next )" } } { "final" "the final result" } }
|
||||||
{ $description "Combines successive elements of the sequence using a binary operation, and outputs the original sequence of intermediate results, together with the final result."
|
{ $description "Combines successive elements of the sequence using a binary operation, and outputs the original sequence of intermediate results, together with the final result."
|
||||||
$nl
|
$nl
|
||||||
"The first element of the new sequence is " { $snippet "identity" } ". Then, on the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", and the first element of the old sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the corresponding element of the old sequence."
|
"The first element of the new sequence is " { $snippet "identity" } ". Then, on the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", and the first element of the old sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the corresponding element of the old sequence."
|
||||||
|
@ -321,20 +321,20 @@ HELP: map-as
|
||||||
|
|
||||||
HELP: each-index
|
HELP: each-index
|
||||||
{ $values
|
{ $values
|
||||||
{ "seq" sequence } { "quot" quotation } }
|
{ "seq" sequence } { "quot" { $quotation "( elt index -- )" } } }
|
||||||
{ $description "Calls the quotation with the element of the sequence and its index on the stack, with the index on the top of the stack." }
|
{ $description "Calls the quotation with the element of the sequence and its index on the stack, with the index on the top of the stack." }
|
||||||
{ $examples { $example "USING: sequences prettyprint math ;"
|
{ $examples { $example "USING: arrays sequences prettyprint ;"
|
||||||
"{ 10 20 30 } [ + . ] each-index"
|
"{ 10 20 30 } [ 2array . ] each-index"
|
||||||
"10\n21\n32"
|
"{ 10 0 }\n{ 20 1 }\n{ 30 2 }"
|
||||||
} } ;
|
} } ;
|
||||||
|
|
||||||
HELP: map-index
|
HELP: map-index
|
||||||
{ $values
|
{ $values
|
||||||
{ "seq" sequence } { "quot" quotation } { "newseq" sequence } }
|
{ "seq" sequence } { "quot" { $quotation "( elt index -- result )" } } { "newseq" sequence } }
|
||||||
{ $description "Calls the quotation with the element of the sequence and its index on the stack, with the index on the top of the stack. Collects the outputs of the quotation and outputs them in a sequence of the same type as the input sequence." }
|
{ $description "Calls the quotation with the element of the sequence and its index on the stack, with the index on the top of the stack. Collects the outputs of the quotation and outputs them in a sequence of the same type as the input sequence." }
|
||||||
{ $examples { $example "USING: sequences prettyprint math ;"
|
{ $examples { $example "USING: arrays sequences prettyprint ;"
|
||||||
"{ 10 20 30 } [ + ] map-index ."
|
"{ 10 20 30 } [ 2array ] map-index ."
|
||||||
"{ 10 21 32 }"
|
"{ { 10 0 } { 20 1 } { 30 2 } }"
|
||||||
} } ;
|
} } ;
|
||||||
|
|
||||||
HELP: change-nth
|
HELP: change-nth
|
||||||
|
@ -344,7 +344,7 @@ HELP: change-nth
|
||||||
{ $side-effects "seq" } ;
|
{ $side-effects "seq" } ;
|
||||||
|
|
||||||
HELP: map!
|
HELP: map!
|
||||||
{ $values { "seq" "a mutable sequence" } { "quot" { $quotation "( old -- new )" } } { "seq" "a mutable sequence" } }
|
{ $values { "seq" "a mutable sequence" } { "quot" { $quotation "( old -- new )" } } }
|
||||||
{ $description "Applies the quotation to each element yielding a new element, storing the new elements back in the original sequence. Returns the original sequence." }
|
{ $description "Applies the quotation to each element yielding a new element, storing the new elements back in the original sequence. Returns the original sequence." }
|
||||||
{ $errors "Throws an error if the sequence is immutable, or the sequence cannot hold elements of the type output by " { $snippet "quot" } "." }
|
{ $errors "Throws an error if the sequence is immutable, or the sequence cannot hold elements of the type output by " { $snippet "quot" } "." }
|
||||||
{ $side-effects "seq" } ;
|
{ $side-effects "seq" } ;
|
||||||
|
@ -442,7 +442,7 @@ HELP: filter-as
|
||||||
{ $description "Applies the quotation to each element in turn, and outputs a new sequence of the same type as " { $snippet "exemplar" } " containing the elements of the original sequence for which the quotation output a true value." } ;
|
{ $description "Applies the quotation to each element in turn, and outputs a new sequence of the same type as " { $snippet "exemplar" } " containing the elements of the original sequence for which the quotation output a true value." } ;
|
||||||
|
|
||||||
HELP: filter!
|
HELP: filter!
|
||||||
{ $values { "seq" "a resizable mutable sequence" } { "quot" { $quotation "( elt -- ? )" } } { "seq" "a resizable mutable sequence" } }
|
{ $values { "seq" "a resizable mutable sequence" } { "quot" { $quotation "( elt -- ? )" } } }
|
||||||
{ $description "Applies the quotation to each element in turn, and removes elements for which the quotation outputs a false value." }
|
{ $description "Applies the quotation to each element in turn, and removes elements for which the quotation outputs a false value." }
|
||||||
{ $side-effects "seq" } ;
|
{ $side-effects "seq" } ;
|
||||||
|
|
||||||
|
@ -503,19 +503,19 @@ HELP: move
|
||||||
{ $side-effects "seq" } ;
|
{ $side-effects "seq" } ;
|
||||||
|
|
||||||
HELP: remove!
|
HELP: remove!
|
||||||
{ $values { "elt" object } { "seq" "a resizable mutable sequence" } { "elt" object } }
|
{ $values { "elt" object } { "seq" "a resizable mutable sequence" } }
|
||||||
{ $description "Removes all elements equal to " { $snippet "elt" } " from " { $snippet "seq" } " and returns " { $snippet "seq" } "." }
|
{ $description "Removes all elements equal to " { $snippet "elt" } " from " { $snippet "seq" } " and returns " { $snippet "seq" } "." }
|
||||||
{ $notes "This word uses equality comparison (" { $link = } ")." }
|
{ $notes "This word uses equality comparison (" { $link = } ")." }
|
||||||
{ $side-effects "seq" } ;
|
{ $side-effects "seq" } ;
|
||||||
|
|
||||||
HELP: remove-eq!
|
HELP: remove-eq!
|
||||||
{ $values { "elt" object } { "seq" "a resizable mutable sequence" } { "seq" "a resizable mutable sequence" } }
|
{ $values { "elt" object } { "seq" "a resizable mutable sequence" } }
|
||||||
{ $description "Outputs a new sequence containing all elements of the input sequence except the given element." }
|
{ $description "Outputs a new sequence containing all elements of the input sequence except the given element." }
|
||||||
{ $notes "This word uses identity comparison (" { $link eq? } ")." }
|
{ $notes "This word uses identity comparison (" { $link eq? } ")." }
|
||||||
{ $side-effects "seq" } ;
|
{ $side-effects "seq" } ;
|
||||||
|
|
||||||
HELP: remove-nth!
|
HELP: remove-nth!
|
||||||
{ $values { "n" "a non-negative integer" } { "seq" "a resizable mutable sequence" } { "seq" "a resizable mutable sequence" } }
|
{ $values { "n" "a non-negative integer" } { "seq" "a resizable mutable sequence" } }
|
||||||
{ $description "Removes the " { $snippet "n" } "th element from the sequence, shifting all other elements down and reducing its length by one." }
|
{ $description "Removes the " { $snippet "n" } "th element from the sequence, shifting all other elements down and reducing its length by one." }
|
||||||
{ $side-effects "seq" } ;
|
{ $side-effects "seq" } ;
|
||||||
|
|
||||||
|
@ -540,7 +540,7 @@ HELP: suffix
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: suffix!
|
HELP: suffix!
|
||||||
{ $values { "seq" sequence } { "elt" object } { "seq" sequence } }
|
{ $values { "seq" sequence } { "elt" object } }
|
||||||
{ $description "Modifiers a sequence in-place by adding " { $snippet "elt" } " to the end of " { $snippet "seq" } ". Outputs " { $snippet "seq" } "." }
|
{ $description "Modifiers a sequence in-place by adding " { $snippet "elt" } " to the end of " { $snippet "seq" } ". Outputs " { $snippet "seq" } "." }
|
||||||
{ $errors "Throws an error if the type of " { $snippet "elt" } " is not permitted in sequences of the same class as " { $snippet "seq" } "." }
|
{ $errors "Throws an error if the type of " { $snippet "elt" } " is not permitted in sequences of the same class as " { $snippet "seq" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
|
@ -548,7 +548,7 @@ HELP: suffix!
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
HELP: append!
|
HELP: append!
|
||||||
{ $values { "seq1" sequence } { "seq2" sequence } { "seq1" sequence } }
|
{ $values { "seq1" sequence } { "seq2" sequence } }
|
||||||
{ $description "Modifiers " { $snippet "seq1" } " in-place by adding the elements from " { $snippet "seq2" } " to the end and outputs " { $snippet "seq1" } "." }
|
{ $description "Modifiers " { $snippet "seq1" } " in-place by adding the elements from " { $snippet "seq2" } " to the end and outputs " { $snippet "seq1" } "." }
|
||||||
{ $examples
|
{ $examples
|
||||||
{ $example "USING: prettyprint sequences ;" "V{ 1 2 3 } { 4 5 6 } append! ." "V{ 1 2 3 4 5 6 }" }
|
{ $example "USING: prettyprint sequences ;" "V{ 1 2 3 } { 4 5 6 } append! ." "V{ 1 2 3 4 5 6 }" }
|
||||||
|
@ -995,8 +995,8 @@ HELP: count
|
||||||
|
|
||||||
HELP: selector
|
HELP: selector
|
||||||
{ $values
|
{ $values
|
||||||
{ "quot" "a predicate quotation" }
|
{ "quot" { $quotation "( elt -- ? )" } }
|
||||||
{ "quot" quotation } { "accum" vector } }
|
{ "selector" { $quotation "( elt -- )" } } { "accum" vector } }
|
||||||
{ $description "Creates a new vector to accumulate the values which return true for a predicate. Returns a new quotation which accepts an object to be tested and stored in the collector if the test yields true. The collector is left on the stack for convenience." }
|
{ $description "Creates a new vector to accumulate the values which return true for a predicate. Returns a new quotation which accepts an object to be tested and stored in the collector if the test yields true. The collector is left on the stack for convenience." }
|
||||||
{ $example "! Find all the even numbers:" "USING: prettyprint sequences math kernel ;"
|
{ $example "! Find all the even numbers:" "USING: prettyprint sequences math kernel ;"
|
||||||
"10 iota [ even? ] selector [ each ] dip ."
|
"10 iota [ even? ] selector [ each ] dip ."
|
||||||
|
@ -1152,7 +1152,7 @@ HELP: replicate
|
||||||
|
|
||||||
HELP: replicate-as
|
HELP: replicate-as
|
||||||
{ $values
|
{ $values
|
||||||
{ "len" integer } { "quot" quotation } { "exemplar" sequence }
|
{ "len" integer } { "quot" { $quotation "( -- elt )" } } { "exemplar" sequence }
|
||||||
{ "newseq" sequence } }
|
{ "newseq" sequence } }
|
||||||
{ $description "Calls the quotation " { $snippet "len" } " times, collecting results into a new sequence of the same type as the exemplar sequence." }
|
{ $description "Calls the quotation " { $snippet "len" } " times, collecting results into a new sequence of the same type as the exemplar sequence." }
|
||||||
{ $examples
|
{ $examples
|
||||||
|
@ -1190,7 +1190,7 @@ HELP: virtual@
|
||||||
|
|
||||||
HELP: 2map-reduce
|
HELP: 2map-reduce
|
||||||
{ $values
|
{ $values
|
||||||
{ "seq1" sequence } { "seq2" sequence } { "map-quot" quotation } { "reduce-quot" quotation }
|
{ "seq1" sequence } { "seq2" sequence } { "map-quot" { $quotation "( elt1 elt2 -- intermediate )" } } { "reduce-quot" { $quotation "( prev intermediate -- result )" } }
|
||||||
{ "result" object } }
|
{ "result" object } }
|
||||||
{ $description "Calls " { $snippet "map-quot" } " on each pair of elements from " { $snippet "seq1" } " and " { $snippet "seq2" } " and combines the results using " { $snippet "reduce-quot" } " in the same manner as " { $link reduce } ", except that there is no identity element, and the sequence must have a length of at least 1." }
|
{ $description "Calls " { $snippet "map-quot" } " on each pair of elements from " { $snippet "seq1" } " and " { $snippet "seq2" } " and combines the results using " { $snippet "reduce-quot" } " in the same manner as " { $link reduce } ", except that there is no identity element, and the sequence must have a length of at least 1." }
|
||||||
{ $errors "Throws an error if the sequence is empty." }
|
{ $errors "Throws an error if the sequence is empty." }
|
||||||
|
@ -1202,7 +1202,7 @@ HELP: 2map-reduce
|
||||||
HELP: 2selector
|
HELP: 2selector
|
||||||
{ $values
|
{ $values
|
||||||
{ "quot" quotation }
|
{ "quot" quotation }
|
||||||
{ "quot" quotation } { "accum1" vector } { "accum2" vector } }
|
{ "selector" quotation } { "accum1" vector } { "accum2" vector } }
|
||||||
{ $description "Creates two new vectors to accumultate values based on a predicate. The first vector accumulates values for which the predicate yields true; the second for false." } ;
|
{ $description "Creates two new vectors to accumultate values based on a predicate. The first vector accumulates values for which the predicate yields true; the second for false." } ;
|
||||||
|
|
||||||
HELP: 2reverse-each
|
HELP: 2reverse-each
|
||||||
|
@ -1236,7 +1236,7 @@ HELP: collector
|
||||||
|
|
||||||
HELP: binary-reduce
|
HELP: binary-reduce
|
||||||
{ $values
|
{ $values
|
||||||
{ "seq" sequence } { "start" integer } { "quot" quotation }
|
{ "seq" sequence } { "start" integer } { "quot" { $quotation "( elt1 elt2 -- newelt )" } }
|
||||||
{ "value" object } }
|
{ "value" object } }
|
||||||
{ $description "Like " { $link reduce } ", but splits the sequence in half recursively until each sequence is small enough, and calls the quotation on these smaller sequences. If the quotation computes values that depend on the size of their input, such as bignum arithmetic, then this algorithm can be more efficient than using " { $link reduce } "." }
|
{ $description "Like " { $link reduce } ", but splits the sequence in half recursively until each sequence is small enough, and calls the quotation on these smaller sequences. If the quotation computes values that depend on the size of their input, such as bignum arithmetic, then this algorithm can be more efficient than using " { $link reduce } "." }
|
||||||
{ $examples "Computing factorial:"
|
{ $examples "Computing factorial:"
|
||||||
|
@ -1247,7 +1247,7 @@ HELP: binary-reduce
|
||||||
|
|
||||||
HELP: follow
|
HELP: follow
|
||||||
{ $values
|
{ $values
|
||||||
{ "obj" object } { "quot" quotation }
|
{ "obj" object } { "quot" { $quotation "( prev -- result/f )" } }
|
||||||
{ "seq" sequence } }
|
{ "seq" sequence } }
|
||||||
{ $description "Outputs a sequence containing the input object and all of the objects generated by successively feeding the result of the quotation called on the input object to the quotation recursuively. Objects yielded by the quotation are added to the output sequence until the quotation yields " { $link f } ", at which point the recursion terminates." }
|
{ $description "Outputs a sequence containing the input object and all of the objects generated by successively feeding the result of the quotation called on the input object to the quotation recursuively. Objects yielded by the quotation are added to the output sequence until the quotation yields " { $link f } ", at which point the recursion terminates." }
|
||||||
{ $examples "Get random numbers until zero is reached:"
|
{ $examples "Get random numbers until zero is reached:"
|
||||||
|
@ -1323,8 +1323,7 @@ HELP: sequence-hashcode-step
|
||||||
|
|
||||||
HELP: short
|
HELP: short
|
||||||
{ $values
|
{ $values
|
||||||
{ "seq" sequence } { "n" integer }
|
{ "seq" sequence } { "n" integer } { "n'" integer } }
|
||||||
{ "seq" sequence } { "n'" integer } }
|
|
||||||
{ $description "Returns the input sequence and its length or " { $snippet "n" } ", whichever is less." }
|
{ $description "Returns the input sequence and its length or " { $snippet "n" } ", whichever is less." }
|
||||||
{ $examples { $example "USING: sequences kernel prettyprint ;"
|
{ $examples { $example "USING: sequences kernel prettyprint ;"
|
||||||
"\"abcd\" 3 short [ . ] bi@"
|
"\"abcd\" 3 short [ . ] bi@"
|
||||||
|
|
|
@ -486,10 +486,10 @@ PRIVATE>
|
||||||
: push-if ( elt quot accum -- )
|
: push-if ( elt quot accum -- )
|
||||||
[ keep ] dip rot [ push ] [ 2drop ] if ; inline
|
[ keep ] dip rot [ push ] [ 2drop ] if ; inline
|
||||||
|
|
||||||
: selector-for ( quot exemplar -- quot accum )
|
: selector-for ( quot exemplar -- selector accum )
|
||||||
[ length ] keep new-resizable [ [ push-if ] 2curry ] keep ; inline
|
[ length ] keep new-resizable [ [ push-if ] 2curry ] keep ; inline
|
||||||
|
|
||||||
: selector ( quot -- quot accum )
|
: selector ( quot -- selector accum )
|
||||||
V{ } selector-for ; inline
|
V{ } selector-for ; inline
|
||||||
|
|
||||||
: filter-as ( seq quot exemplar -- subseq )
|
: filter-as ( seq quot exemplar -- subseq )
|
||||||
|
@ -501,7 +501,7 @@ PRIVATE>
|
||||||
: push-either ( elt quot accum1 accum2 -- )
|
: push-either ( elt quot accum1 accum2 -- )
|
||||||
[ keep swap ] 2dip ? push ; inline
|
[ keep swap ] 2dip ? push ; inline
|
||||||
|
|
||||||
: 2selector ( quot -- quot accum1 accum2 )
|
: 2selector ( quot -- selector accum1 accum2 )
|
||||||
V{ } clone V{ } clone [ [ push-either ] 3curry ] 2keep ; inline
|
V{ } clone V{ } clone [ [ push-either ] 3curry ] 2keep ; inline
|
||||||
|
|
||||||
: partition ( seq quot -- trueseq falseseq )
|
: partition ( seq quot -- trueseq falseseq )
|
||||||
|
|
|
@ -33,7 +33,7 @@ HELP: y-up { $class-description "Right-handed 3D coordinate system where Y is up
|
||||||
HELP: z-up { $class-description "Right-handed 3D coordinate system where Z is up." } ;
|
HELP: z-up { $class-description "Right-handed 3D coordinate system where Z is up." } ;
|
||||||
|
|
||||||
HELP: >y-up-axis!
|
HELP: >y-up-axis!
|
||||||
{ $values { "seq" sequence } { "from-axis" rh-up } { "seq" sequence } }
|
{ $values { "seq" sequence } { "from-axis" rh-up } }
|
||||||
{ $description "Destructively swizzles the first three elements of the input sequence to a right-handed 3D coordinate system where Y is up and returns the modified sequence." } ;
|
{ $description "Destructively swizzles the first three elements of the input sequence to a right-handed 3D coordinate system where Y is up and returns the modified sequence." } ;
|
||||||
|
|
||||||
HELP: source>seq
|
HELP: source>seq
|
||||||
|
@ -53,7 +53,7 @@ HELP: mesh>vertices
|
||||||
{ $description "Convert the mesh tag's vertices element to a pair for further lookup in " { $link collect-sources } ". " } ;
|
{ $description "Convert the mesh tag's vertices element to a pair for further lookup in " { $link collect-sources } ". " } ;
|
||||||
|
|
||||||
HELP: collect-sources
|
HELP: collect-sources
|
||||||
{ $values { "sources" hashtable } { "vertices" pair } { "inputs" tag sequence } { "sources" sequence } }
|
{ $values { "sources" hashtable } { "vertices" pair } { "inputs" tag sequence } { "seq" sequence } }
|
||||||
{ $description "Look up the sources for these " { $emphasis "input" } " elements and return a sequence of " { $link source } " tuples." } ;
|
{ $description "Look up the sources for these " { $emphasis "input" } " elements and return a sequence of " { $link source } " tuples." } ;
|
||||||
|
|
||||||
HELP: group-indices
|
HELP: group-indices
|
||||||
|
|
|
@ -94,7 +94,7 @@ M: z-up >y-up-axis!
|
||||||
] x*
|
] x*
|
||||||
] bi 2array ;
|
] bi 2array ;
|
||||||
|
|
||||||
:: collect-sources ( sources vertices inputs -- sources )
|
:: collect-sources ( sources vertices inputs -- seq )
|
||||||
inputs
|
inputs
|
||||||
[| input |
|
[| input |
|
||||||
input "source" x@ rest vertices first =
|
input "source" x@ rest vertices first =
|
||||||
|
|
|
@ -58,7 +58,7 @@ HELP: face>aos
|
||||||
{ $description "Convert a face line to a sequence of vertex attributes." } ;
|
{ $description "Convert a face line to a sequence of vertex attributes." } ;
|
||||||
|
|
||||||
HELP: push*
|
HELP: push*
|
||||||
{ $values { "elt" "an object" } { "seq" sequence } { "seq" sequence } }
|
{ $values { "elt" "an object" } { "seq" sequence } }
|
||||||
{ $description "Push the value onto the sequence, keeping the sequence on the stack." } ;
|
{ $description "Push the value onto the sequence, keeping the sequence on the stack." } ;
|
||||||
|
|
||||||
HELP: push-current-model
|
HELP: push-current-model
|
||||||
|
|
|
@ -172,7 +172,7 @@ HELP: vertex-array
|
||||||
HELP: vertex-array-buffers
|
HELP: vertex-array-buffers
|
||||||
{ $values
|
{ $values
|
||||||
{ "vertex-array" vertex-array }
|
{ "vertex-array" vertex-array }
|
||||||
{ "vertex-buffer" buffer }
|
{ "buffers" sequence }
|
||||||
}
|
}
|
||||||
{ $description "Returns a sequence containing all of the " { $link buffer } " objects that make up " { $snippet "vertex-array" } "." } ;
|
{ $description "Returns a sequence containing all of the " { $link buffer } " objects that make up " { $snippet "vertex-array" } "." } ;
|
||||||
|
|
||||||
|
|
|
@ -65,14 +65,6 @@ $nl
|
||||||
"[let { 1 2 3 4 } :> myarr [infix myarr[4/2]*3 infix] ] ."
|
"[let { 1 2 3 4 } :> myarr [infix myarr[4/2]*3 infix] ] ."
|
||||||
"9"
|
"9"
|
||||||
}
|
}
|
||||||
"Please note: in Factor " { $emphasis "fixnums are sequences too." } " If you are not careful with sequence accesses you may introduce subtle bugs:"
|
|
||||||
{ $example
|
|
||||||
"USING: arrays infix locals ;"
|
|
||||||
":: add-2nd-elements ( x y -- res )"
|
|
||||||
" [infix x[1] + y[1] infix] ;"
|
|
||||||
"{ 1 2 3 } { 0 1 2 3 } add-2nd-elements ."
|
|
||||||
"3"
|
|
||||||
}
|
|
||||||
;
|
;
|
||||||
|
|
||||||
ABOUT: "infix"
|
ABOUT: "infix"
|
||||||
|
|
|
@ -1 +1,2 @@
|
||||||
bindings
|
bindings
|
||||||
|
unportable
|
||||||
|
|
|
@ -2,6 +2,6 @@ USING: help.markup help.syntax sequences ;
|
||||||
IN: math.transforms.fft
|
IN: math.transforms.fft
|
||||||
|
|
||||||
HELP: fft
|
HELP: fft
|
||||||
{ $values { "seq" sequence } { "seq" sequence } }
|
{ $values { "seq" sequence } { "seq'" sequence } }
|
||||||
{ $description "Fast Fourier transform function." } ;
|
{ $description "Fast Fourier transform function." } ;
|
||||||
|
|
||||||
|
|
|
@ -13,26 +13,26 @@ IN: math.transforms.fft
|
||||||
: omega ( n -- n' )
|
: omega ( n -- n' )
|
||||||
recip -2 pi i* * * exp ;
|
recip -2 pi i* * * exp ;
|
||||||
|
|
||||||
: twiddle ( seq -- seq )
|
: twiddle ( seq -- seq' )
|
||||||
dup length [ omega ] [ n^v ] bi v* ;
|
dup length [ omega ] [ n^v ] bi v* ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
DEFER: fft
|
DEFER: fft
|
||||||
|
|
||||||
: two ( seq -- seq )
|
: two ( seq -- seq' )
|
||||||
fft 2 v/n dup append ;
|
fft 2 v/n dup append ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: even ( seq -- seq ) 2 group 0 <column> ;
|
: even ( seq -- seq' ) 2 group 0 <column> ;
|
||||||
: odd ( seq -- seq ) 2 group 1 <column> ;
|
: odd ( seq -- seq' ) 2 group 1 <column> ;
|
||||||
|
|
||||||
: (fft) ( seq -- seq )
|
: (fft) ( seq -- seq' )
|
||||||
[ odd two twiddle ] [ even two ] bi v+ ;
|
[ odd two twiddle ] [ even two ] bi v+ ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: fft ( seq -- seq )
|
: fft ( seq -- seq' )
|
||||||
dup length 1 = [ (fft) ] unless ;
|
dup length 1 = [ (fft) ] unless ;
|
||||||
|
|
||||||
|
|
|
@ -2,13 +2,13 @@ USING: help.markup help.syntax sequences ;
|
||||||
IN: math.transforms.haar
|
IN: math.transforms.haar
|
||||||
|
|
||||||
HELP: haar
|
HELP: haar
|
||||||
{ $values { "seq" sequence } { "seq" sequence } }
|
{ $values { "seq" sequence } { "seq'" sequence } }
|
||||||
{ $description "Haar wavelet transform function." }
|
{ $description "Haar wavelet transform function." }
|
||||||
{ $notes "The sequence length should be a power of two." }
|
{ $notes "The sequence length should be a power of two." }
|
||||||
{ $examples { $example "USING: math.transforms.haar prettyprint ;" "{ 7 1 6 6 3 -5 4 2 } haar ." "{ 3 2 -1 -2 3 0 4 1 }" } } ;
|
{ $examples { $example "USING: math.transforms.haar prettyprint ;" "{ 7 1 6 6 3 -5 4 2 } haar ." "{ 3 2 -1 -2 3 0 4 1 }" } } ;
|
||||||
|
|
||||||
HELP: rev-haar
|
HELP: rev-haar
|
||||||
{ $values { "seq" sequence } { "seq" sequence } }
|
{ $values { "seq" sequence } { "seq'" sequence } }
|
||||||
{ $description "Reverse Haar wavelet transform function." }
|
{ $description "Reverse Haar wavelet transform function." }
|
||||||
{ $notes "The sequence length should be a power of two." }
|
{ $notes "The sequence length should be a power of two." }
|
||||||
{ $examples { $example "USING: math.transforms.haar prettyprint ;" "{ 3 2 -1 -2 3 0 4 1 } rev-haar ." "{ 7 1 6 6 3 -5 4 2 }" } } ;
|
{ $examples { $example "USING: math.transforms.haar prettyprint ;" "{ 3 2 -1 -2 3 0 4 1 } rev-haar ." "{ 7 1 6 6 3 -5 4 2 }" } } ;
|
||||||
|
|
|
@ -8,7 +8,7 @@ IN: math.transforms.haar
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: averages ( seq -- seq )
|
: averages ( seq -- seq' )
|
||||||
[ mean ] map ;
|
[ mean ] map ;
|
||||||
|
|
||||||
: differences ( seq averages -- differences )
|
: differences ( seq averages -- differences )
|
||||||
|
@ -22,9 +22,9 @@ IN: math.transforms.haar
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: haar ( seq -- seq )
|
: haar ( seq -- seq' )
|
||||||
dup length 1 <= [ haar-step haar prepend ] unless ;
|
dup length 1 <= [ haar-step haar prepend ] unless ;
|
||||||
|
|
||||||
: rev-haar ( seq -- seq )
|
: rev-haar ( seq -- seq' )
|
||||||
dup length 2 > [ halves swap rev-haar prepend ] when rev-haar-step ;
|
dup length 2 > [ halves swap rev-haar prepend ] when rev-haar-step ;
|
||||||
|
|
||||||
|
|
|
@ -21,7 +21,6 @@ HELP: pile
|
||||||
HELP: pile-align
|
HELP: pile-align
|
||||||
{ $values
|
{ $values
|
||||||
{ "pile" pile } { "align" "a power of two" }
|
{ "pile" pile } { "align" "a power of two" }
|
||||||
{ "pile" pile }
|
|
||||||
}
|
}
|
||||||
{ $description "Adjusts a " { $link pile } "'s internal state so that the next call to " { $link pile-alloc } " will return a pointer aligned to " { $snippet "align" } " bytes relative to the pile's initial offset." } ;
|
{ $description "Adjusts a " { $link pile } "'s internal state so that the next call to " { $link pile-alloc } " will return a pointer aligned to " { $snippet "align" } " bytes relative to the pile's initial offset." } ;
|
||||||
|
|
||||||
|
|
|
@ -49,7 +49,6 @@ HELP: <update>
|
||||||
HELP: >upsert
|
HELP: >upsert
|
||||||
{ $values
|
{ $values
|
||||||
{ "mdb-update-msg" "a mdb-update-msg" }
|
{ "mdb-update-msg" "a mdb-update-msg" }
|
||||||
{ "mdb-update-msg" "mdb-update-msg with the upsert indicator set to t" }
|
|
||||||
}
|
}
|
||||||
{ $description "Marks a mdb-update-msg as upsert operation"
|
{ $description "Marks a mdb-update-msg as upsert operation"
|
||||||
"(inserts object identified by the update selector if it doesn't exist in the collection)" } ;
|
"(inserts object identified by the update selector if it doesn't exist in the collection)" } ;
|
||||||
|
@ -162,7 +161,6 @@ HELP: hint
|
||||||
{ $values
|
{ $values
|
||||||
{ "mdb-query-msg" "a query" }
|
{ "mdb-query-msg" "a query" }
|
||||||
{ "index-hint" "a hint to an index" }
|
{ "index-hint" "a hint to an index" }
|
||||||
{ "mdb-query-msg" "modified query object" }
|
|
||||||
}
|
}
|
||||||
{ $description "Annotates the query with a hint to an index. "
|
{ $description "Annotates the query with a hint to an index. "
|
||||||
"For detailed information see: " { $url "http://www.mongodb.org/display/DOCS/Optimizing+Mongo+Performance#OptimizingMongoPerformance-Hint" } }
|
"For detailed information see: " { $url "http://www.mongodb.org/display/DOCS/Optimizing+Mongo+Performance#OptimizingMongoPerformance-Hint" } }
|
||||||
|
@ -183,7 +181,6 @@ HELP: limit
|
||||||
{ $values
|
{ $values
|
||||||
{ "mdb-query-msg" "a query" }
|
{ "mdb-query-msg" "a query" }
|
||||||
{ "limit#" "number of objects that should be returned at most" }
|
{ "limit#" "number of objects that should be returned at most" }
|
||||||
{ "mdb-query-msg" "modified query object" }
|
|
||||||
}
|
}
|
||||||
{ $description "Limits the number of returned objects to limit#" }
|
{ $description "Limits the number of returned objects to limit#" }
|
||||||
{ $examples
|
{ $examples
|
||||||
|
@ -243,7 +240,6 @@ HELP: skip
|
||||||
{ $values
|
{ $values
|
||||||
{ "mdb-query-msg" "a query message" }
|
{ "mdb-query-msg" "a query message" }
|
||||||
{ "skip#" "number of objects to skip" }
|
{ "skip#" "number of objects to skip" }
|
||||||
{ "mdb-query-msg" "annotated query message" }
|
|
||||||
}
|
}
|
||||||
{ $description "annotates a query message with a number of objects to skip when returning the results" } ;
|
{ $description "annotates a query message with a number of objects to skip when returning the results" } ;
|
||||||
|
|
||||||
|
@ -251,7 +247,6 @@ HELP: sort
|
||||||
{ $values
|
{ $values
|
||||||
{ "mdb-query-msg" "a query message" }
|
{ "mdb-query-msg" "a query message" }
|
||||||
{ "sort-quot" "a quotation with sort specifiers" }
|
{ "sort-quot" "a quotation with sort specifiers" }
|
||||||
{ "mdb-query-msg" "annotated query message" }
|
|
||||||
}
|
}
|
||||||
{ $description "annotates the query message for sort specifiers" } ;
|
{ $description "annotates the query message for sort specifiers" } ;
|
||||||
|
|
||||||
|
|
|
@ -12,7 +12,6 @@ HELP: <spider>
|
||||||
|
|
||||||
HELP: run-spider
|
HELP: run-spider
|
||||||
{ $values
|
{ $values
|
||||||
{ "spider" spider }
|
|
||||||
{ "spider" spider } }
|
{ "spider" spider } }
|
||||||
{ $description "Runs a spider until completion. See the " { $subsection "spider-tutorial" } " for a complete description of the tuple slots that affect how thet spider works." } ;
|
{ $description "Runs a spider until completion. See the " { $subsection "spider-tutorial" } " for a complete description of the tuple slots that affect how thet spider works." } ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue