! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: checksums checksums.openssl splitting assocs
-kernel io.files bootstrap.image sequences io namespaces
+kernel io.files bootstrap.image sequences io namespaces make
io.launcher math io.encodings.ascii ;
IN: bootstrap.image.upload
! See http://factorcode.org/license.txt for BSD license.
!
! Remote Channels
-USING: kernel init namespaces assocs arrays random
+USING: kernel init namespaces make assocs arrays random
sequences channels match concurrency.messaging
concurrency.distributed threads accessors ;
IN: channels.remote
! Copyright (C) 2006, 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.bitwise strings io.binary namespaces
-grouping ;
+make grouping ;
IN: checksums.common
SYMBOL: bytes-read
! See http://factorcode.org/license.txt for BSD license.
USING: arrays combinators kernel io io.encodings.binary io.files
io.streams.byte-array math.vectors strings sequences namespaces
-math parser sequences assocs grouping vectors io.binary hashtables
-symbols math.bitwise checksums checksums.common ;
+make math parser sequences assocs grouping vectors io.binary
+hashtables symbols math.bitwise checksums checksums.common ;
IN: checksums.sha1
! Implemented according to RFC 3174.
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel splitting grouping math sequences namespaces
+USING: kernel splitting grouping math sequences namespaces make
io.binary symbols math.bitwise checksums checksums.common
sbufs strings ;
IN: checksums.sha2
object state stackbuf count -> countByEnumeratingWithState:objects:count:
dup zero? [ drop ] [
state NSFastEnumerationState-itemsPtr [ stackbuf ] unless*
- '[ , void*-nth quot call ] each
+ '[ _ void*-nth quot call ] each
object quot state stackbuf count (NSFastEnumeration-each)
] if ; inline recursive
: NSFastEnumeration-map ( object quot -- vector )
NS-EACH-BUFFER-SIZE <vector>
- [ '[ @ , push ] NSFastEnumeration-each ] keep ; inline
+ [ '[ @ _ push ] NSFastEnumeration-each ] keep ; inline
: NSFastEnumeration>vector ( object -- vector )
[ ] NSFastEnumeration-map ;
[ '[ drop N ndup @ dup not ] [ drop N ndrop f ] 2array ]
map
[ t ] [ N nnip ] 2array suffix
- '[ f , cond ] ;
+ '[ f _ cond ] ;
MACRO: 0&& ( quots -- quot ) 0 n&&-rewrite ;
MACRO: 1&& ( quots -- quot ) 1 n&&-rewrite ;
[ '[ drop N ndup @ dup ] [ N nnip ] 2array ]
map
[ drop N ndrop t ] [ f ] 2array suffix
- '[ f , cond ] ;
+ '[ f _ cond ] ;
MACRO: 0|| ( quots -- quot ) 0 n||-rewrite ;
MACRO: 1|| ( quots -- quot ) 1 n||-rewrite ;
H{ } clone dependencies set
H{ } clone generic-dependencies set
- , {
+ _ {
[ compile-begins ]
[
[ build-tree-from-word ] [ compile-failed return ] recover
: inlined? ( quot seq/word -- ? )
[ cleaned-up-tree ] dip
dup word? [ 1array ] when
- '[ dup #call? [ word>> , member? ] [ drop f ] if ]
+ '[ dup #call? [ word>> _ member? ] [ drop f ] if ]
contains-node? not ;
[ f ] [
: delete-unreachable-branches ( #branch -- )
dup live-branches>> '[
- ,
+ _
[ [ [ drop ] [ delete-nodes ] if ] 2each ]
[ select-children ]
2bi
M: #phi cleanup*
#! Remove #phi function inputs which no longer exist.
live-branches get
- [ '[ , sift-children ] change-phi-in-d ]
- [ '[ , sift-children ] change-phi-info-d ]
- [ '[ , sift-children ] change-terminated ] tri
+ [ '[ _ sift-children ] change-phi-in-d ]
+ [ '[ _ sift-children ] change-phi-info-d ]
+ [ '[ _ sift-children ] change-terminated ] tri
eliminate-phi
live-branches off ;
: each-node ( nodes quot: ( node -- ) -- )
dup dup '[
- , [
+ _ [
dup #branch? [
- children>> [ , each-node ] each
+ children>> [ _ each-node ] each
] [
dup #recursive? [
- child>> , each-node
+ child>> _ each-node
] [ drop ] if
] if
] bi
dup dup '[
@
dup #branch? [
- [ [ , map-nodes ] map ] change-children
+ [ [ _ map-nodes ] map ] change-children
] [
dup #recursive? [
- [ , map-nodes ] change-child
+ [ _ map-nodes ] change-child
] when
] if
] map flatten ; inline recursive
: contains-node? ( nodes quot: ( node -- ? ) -- ? )
dup dup '[
- , keep swap [ drop t ] [
+ _ keep swap [ drop t ] [
dup #branch? [
- children>> [ , contains-node? ] contains?
+ children>> [ _ contains-node? ] contains?
] [
dup #recursive? [
- child>> , contains-node?
+ child>> _ contains-node?
] [ drop f ] if
] if
] if
: live-value-indices ( values -- indices )
[ length ] keep live-values get
- '[ , nth , key? ] filter ; inline
+ '[ _ nth _ key? ] filter ; inline
: drop-indexed-values ( values indices -- node )
[ drop filter-live ] [ nths ] 2bi
: insert-drops ( nodes values indices -- nodes' )
'[
over ends-with-terminate?
- [ drop ] [ , drop-indexed-values suffix ] if
+ [ drop ] [ _ drop-indexed-values suffix ] if
] 2map ;
: hoist-drops ( #phi -- )
if-node get swap
[ phi-in-d>> ] [ out-d>> live-value-indices ] bi
- '[ , , insert-drops ] change-children drop ;
+ '[ _ _ insert-drops ] change-children drop ;
: remove-phi-outputs ( #phi -- )
[ filter-live ] change-out-d drop ;
M: #alien-indirect compute-live-values* nip look-at-inputs ;
: filter-mapping ( assoc -- assoc' )
- live-values get '[ drop , key? ] assoc-filter ;
+ live-values get '[ drop _ key? ] assoc-filter ;
: filter-corresponding ( new old -- old' )
#! Remove elements from 'old' if the element with the same
GENERIC: node>quot ( node -- )
MACRO: match-choose ( alist -- )
- [ '[ , ] ] assoc-map '[ , match-cond ] ;
+ [ [ ] curry ] assoc-map [ match-cond ] curry ;
MATCH-VARS: ?a ?b ?c ;
: recursive-stacks ( #enter-recursive -- stacks )
recursive-phi-in
- escaping-values get '[ [ , disjoint-set-member? ] all? ] filter
+ escaping-values get '[ [ _ disjoint-set-member? ] all? ] filter
flip ;
: analyze-recursive-phi ( #enter-recursive -- )
[ call-next-method ]
[
[ in-d>> ] [ label>> calls>> ] bi
- [ out-d>> escaping-values get '[ , equate ] 2each ] with each
+ [ out-d>> escaping-values get '[ _ equate ] 2each ] with each
] bi ;
MEMO: (tuple-boa-expansion) ( n -- quot )
[
[ 2 + ] map <reversed>
- [ '[ [ , set-slot ] keep ] % ] each
+ [ '[ [ _ set-slot ] keep ] % ] each
] [ ] make ;
: tuple-boa-expansion ( layout -- quot )
[ rename-map get at ] keep or ;
: rename-values ( values -- values' )
- rename-map get '[ [ , at ] keep or ] map ;
+ rename-map get '[ [ _ at ] keep or ] map ;
GENERIC: rename-node-values* ( node -- node )
: add-renamings ( old new -- )
[ rename-values ] dip
- rename-map get '[ , set-at ] 2each ;
+ rename-map get '[ _ set-at ] 2each ;
M: #introduce normalize*
out-d>> [ length pop-introductions ] keep add-renamings f ;
M: #phi normalize*
remaining-introductions get swap dup terminated>>
- '[ , eliminate-phi-introductions ] change-phi-in-d ;
+ '[ _ eliminate-phi-introductions ] change-phi-in-d ;
: (normalize) ( nodes introductions -- nodes )
introduction-stack [
M: #recursive normalize*
dup label>> introductions>>
[ drop [ child>> first ] [ in-d>> ] bi >>in-d drop ]
- [ make-values '[ , (normalize) ] change-child ]
+ [ make-values '[ _ (normalize) ] change-child ]
2bi ;
M: #enter-recursive normalize*
: call<return ( #call-recursive n -- nodes )
neg dup make-values [
- [ pop-introductions '[ , prepend ] change-in-d ]
- [ '[ , prepend ] change-out-d ]
+ [ pop-introductions '[ _ prepend ] change-in-d ]
+ [ '[ _ prepend ] change-out-d ]
bi*
] [ introduction-stack [ prepend ] change ] bi ;
: call>return ( #call-recursive n -- #call-recursive )
- [ [ [ in-d>> ] [ out-d>> ] bi ] [ '[ , head ] ] bi* bi@ add-renamings ]
- [ '[ , tail ] [ change-in-d ] [ change-out-d ] bi ]
+ [ [ [ in-d>> ] [ out-d>> ] bi ] [ '[ _ head ] ] bi* bi@ add-renamings ]
+ [ '[ _ tail ] [ change-in-d ] [ change-out-d ] bi ]
2bi ;
M: #call-recursive normalize*
M: #dispatch live-branches
[ children>> length ] [ in-d>> first value-info interval>> ] bi
- '[ , interval-contains? ] map ;
+ '[ _ interval-contains? ] map ;
: live-children ( #branch -- children )
[ children>> ] [ live-branches>> ] bi select-children ;
infer-children-data get
[
'[
- , [
+ _ [
dup +bottom+ eq?
[ drop null-info ] [ value-info ] if
] bind
: binary-op ( word interval-quot post-proc-quot -- )
'[
- [ binary-op-class ] [ , binary-op-interval ] 2bi
+ [ binary-op-class ] [ _ binary-op-interval ] 2bi
@
<class/interval-info>
] "outputs" set-word-prop ;
in1 in2 op negate-comparison (comparison-constraints) out f--> /\ ;
: define-comparison-constraints ( word op -- )
- '[ , comparison-constraints ] "constraints" set-word-prop ;
+ '[ _ comparison-constraints ] "constraints" set-word-prop ;
comparison-ops
-[ dup '[ , define-comparison-constraints ] each-derived-op ] each
+[ dup '[ _ define-comparison-constraints ] each-derived-op ] each
generic-comparison-ops [
dup specific-comparison
- '[ , , define-comparison-constraints ] each-derived-op
+ '[ _ _ define-comparison-constraints ] each-derived-op
] each
! Remove redundant comparisons
comparison-ops [
dup '[
- [ , fold-comparison ] "outputs" set-word-prop
+ [ _ fold-comparison ] "outputs" set-word-prop
] each-derived-op
] each
generic-comparison-ops [
dup specific-comparison
- '[ , fold-comparison ] "outputs" set-word-prop
+ '[ _ fold-comparison ] "outputs" set-word-prop
] each
: maybe-or-never ( ? -- info )
{ >float float }
} [
'[
- ,
+ _
[ nip ] [
[ interval>> ] [ class-interval ] bi*
interval-intersect
[ in-d>> [ value-info literal?>> ] all? ] [ drop f ] if ;
: (fold-call) ( #call word -- info )
- [ [ out-d>> ] [ in-d>> [ value-info literal>> ] map ] bi ] [ '[ , execute ] ] bi*
- '[ , , with-datastack [ <literal-info> ] map nip ]
+ [ [ out-d>> ] [ in-d>> [ value-info literal>> ] map ] bi ] [ '[ _ execute ] ] bi*
+ '[ _ _ with-datastack [ <literal-info> ] map nip ]
[ drop [ object-info ] replicate ]
recover ;
: shuffle-effect ( #shuffle -- effect )
[ in-d>> ] [ out-d>> ] [ mapping>> ] tri
- '[ , at ] map
+ '[ _ at ] map
<effect> ;
: recursive-phi-in ( #enter-recursive -- seq )
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: compiler.generator.fixup kernel namespaces sequences
+USING: compiler.generator.fixup kernel namespaces make sequences
words math math.bitwise io.binary parser lexer ;
IN: cpu.ppc.assembler.backend
! Simple CSV Parser
! Phil Dawes phil@phildawes.net
-USING: kernel sequences io namespaces combinators unicode.categories ;
+USING: kernel sequences io namespaces make
+combinators unicode.categories ;
IN: csv
SYMBOL: delimiter
! Copyright (C) 2007, 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs alien alien.syntax continuations io
-kernel math math.parser namespaces prettyprint quotations
+kernel math math.parser namespaces make prettyprint quotations
sequences debugger db db.postgresql.lib db.postgresql.ffi
db.tuples db.types tools.annotations math.ranges
combinators classes locals words tools.walker
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel math namespaces sequences random strings
-math.parser math.intervals combinators math.bitwise nmake db
-db.tuples db.types db.sql classes words shuffle arrays destructors
-continuations ;
+USING: accessors kernel math namespaces make sequences random
+strings math.parser math.intervals combinators math.bitwise
+nmake db db.tuples db.types db.sql classes words shuffle arrays
+destructors continuations ;
IN: db.queries
GENERIC: where ( specs obj -- )
"Now we've created a book. Let's save it to the database."
{ $code <" USING: db db.sqlite fry io.files ;
: with-book-tutorial ( quot -- )
- '[ "book-tutorial.db" temp-file sqlite-db , with-db ] call ;
+ '[ "book-tutorial.db" temp-file sqlite-db _ with-db ] call ;
[
book recreate-table
! ] with-db
: test-sqlite ( quot -- )
- [ ] swap '[ "tuples-test.db" temp-file sqlite-db , with-db ] unit-test ;
+ [ ] swap '[ "tuples-test.db" temp-file sqlite-db _ with-db ] unit-test ;
: test-postgresql ( quot -- )
- [ ] swap '[ { "localhost" "postgres" "foob" "factor-test" } postgresql-db , with-db ] unit-test ;
+ [ ] swap '[ { "localhost" "postgres" "foob" "factor-test" } postgresql-db _ with-db ] unit-test ;
: test-repeated-insert
[ ] [ person ensure-table ] unit-test
[ 1 -rot counts>> set-at ]
2tri ;
-: add-atoms ( seq disjoint-set -- ) '[ , add-atom ] each ;
+: add-atoms ( seq disjoint-set -- ) '[ _ add-atom ] each ;
GENERIC: disjoint-set-member? ( a disjoint-set -- ? )
] if ;
: equate-all-with ( seq a disjoint-set -- )
- '[ , , equate ] each ;
+ '[ _ _ equate ] each ;
: equate-all ( seq disjoint-set -- )
over empty? [ 2drop ] [
: assoc>disjoint-set ( assoc -- disjoint-set )
<disjoint-set>
- [ '[ drop , add-atom ] assoc-each ]
- [ '[ , equate ] assoc-each ]
+ [ '[ drop _ add-atom ] assoc-each ]
+ [ '[ _ equate ] assoc-each ]
[ nip ]
2tri ;
USING: help.markup help.syntax quotations kernel ;\r
IN: fry\r
\r
-HELP: ,\r
+HELP: _\r
{ $description "Fry specifier. Inserts a literal value into the fried quotation." } ;\r
\r
HELP: @\r
\r
HELP: '[\r
{ $syntax "code... ]" }\r
-{ $description "Literal fried quotation. Expands into code which takes values from the stack and substitutes them in place of the fry specifiers " { $link , } " and " { $link @ } "." }\r
+{ $description "Literal fried quotation. Expands into code which takes values from the stack and substitutes them in place of the fry specifiers " { $link _ } " and " { $link @ } "." }\r
{ $examples "See " { $link "fry.examples" } "." } ;\r
\r
ARTICLE: "fry.examples" "Examples of fried quotations"\r
$nl\r
"If a quotation does not contain any fry specifiers, then " { $link POSTPONE: '[ } " behaves just like " { $link POSTPONE: [ } ":"\r
{ $code "{ 10 20 30 } '[ . ] each" }\r
-"Occurrences of " { $link , } " on the left map directly to " { $link curry } ". That is, the following three lines are equivalent:"\r
+"Occurrences of " { $link _ } " on the left map directly to " { $link curry } ". That is, the following three lines are equivalent:"\r
{ $code \r
- "{ 10 20 30 } 5 '[ , + ] map"\r
+ "{ 10 20 30 } 5 '[ _ + ] map"\r
"{ 10 20 30 } 5 [ + ] curry map"\r
"{ 10 20 30 } [ 5 + ] map"\r
}\r
-"Occurrences of " { $link , } " in the middle of a quotation map to more complex quotation composition patterns. The following three lines are equivalent:"\r
+"Occurrences of " { $link _ } " in the middle of a quotation map to more complex quotation composition patterns. The following three lines are equivalent:"\r
{ $code \r
- "{ 10 20 30 } 5 '[ 3 , / ] map"\r
+ "{ 10 20 30 } 5 '[ 3 _ / ] map"\r
"{ 10 20 30 } 5 [ 3 ] swap [ / ] curry compose map"\r
"{ 10 20 30 } [ 3 5 / ] map"\r
}\r
-"Occurrences of " { $link @ } " are simply syntax sugar for " { $snippet ", call" } ". The following four lines are equivalent:"\r
+"Occurrences of " { $link @ } " are simply syntax sugar for " { $snippet "_ call" } ". The following four lines are equivalent:"\r
{ $code \r
"{ 10 20 30 } [ sq ] '[ @ . ] each"\r
"{ 10 20 30 } [ sq ] [ call . ] curry each"\r
"{ 10 20 30 } [ sq ] [ . ] compose each"\r
"{ 10 20 30 } [ sq . ] each"\r
}\r
-"The " { $link , } " and " { $link @ } " specifiers may be freely mixed:"\r
+"The " { $link _ } " and " { $link @ } " specifiers may be freely mixed:"\r
{ $code\r
- "{ 8 13 14 27 } [ even? ] 5 '[ @ dup , ? ] map"\r
+ "{ 8 13 14 27 } [ even? ] 5 '[ @ dup _ ? ] map"\r
"{ 8 13 14 27 } [ even? ] 5 [ dup ] swap [ ? ] curry 3compose map"\r
"{ 8 13 14 27 } [ even? dup 5 ? ] map"\r
}\r
"Here are some built-in combinators rewritten in terms of fried quotations:"\r
{ $table\r
- { { $link literalize } { $snippet ": literalize '[ , ] ;" } }\r
- { { $link slip } { $snippet ": slip '[ @ , ] call ;" } }\r
- { { $link curry } { $snippet ": curry '[ , @ ] ;" } }\r
+ { { $link literalize } { $snippet ": literalize '[ _ ] ;" } }\r
+ { { $link slip } { $snippet ": slip '[ @ _ ] call ;" } }\r
+ { { $link curry } { $snippet ": curry '[ _ @ ] ;" } }\r
{ { $link compose } { $snippet ": compose '[ @ @ ] ;" } }\r
- { { $link bi@ } { $snippet ": bi@ tuck '[ , @ , @ ] call ;" } }\r
+ { { $link bi@ } { $snippet ": bi@ tuck '[ _ @ _ @ ] call ;" } }\r
} ;\r
\r
ARTICLE: "fry.philosophy" "Fried quotation philosophy"\r
"Fried quotations generalize quotation-building words such as " { $link curry } " and " { $link compose } ". They can clean up code with lots of currying and composition, particularly when quotations are nested:"\r
{ $code\r
- "'[ [ , key? ] all? ] filter"\r
+ "'[ [ _ key? ] all? ] filter"\r
"[ [ key? ] curry all? ] curry filter"\r
}\r
"There is a mapping from fried quotations to lexical closures as defined in the " { $vocab-link "locals" } " vocabulary. Namely, a fried quotation is equivalent to a ``let'' form where each local binding is only used once, and bindings are used in the same order in which they are defined. The following two lines are equivalent:"\r
{ $code\r
- "'[ 3 , + 4 , / ]"\r
+ "'[ 3 _ + 4 _ / ]"\r
"[let | a [ ] b [ ] | [ 3 a + 4 b / ] ]"\r
} ;\r
\r
"Fried quotations are denoted with a special parsing word:"\r
{ $subsection POSTPONE: '[ }\r
"Fried quotations contain zero or more " { $emphasis "fry specifiers" } ":"\r
-{ $subsection , }\r
+{ $subsection _ }\r
{ $subsection @ }\r
"When a fried quotation is being evaluated, values are consumed from the stack and spliced into the quotation from right to left."\r
{ $subsection "fry.examples" }\r
USING: fry tools.test math prettyprint kernel io arrays
sequences ;
-[ [ 3 + ] ] [ 3 '[ , + ] ] unit-test
+[ [ 3 + ] ] [ 3 '[ _ + ] ] unit-test
-[ [ 1 3 + ] ] [ 1 3 '[ , , + ] ] unit-test
+[ [ 1 3 + ] ] [ 1 3 '[ _ _ + ] ] unit-test
-[ [ 1 + ] ] [ 1 [ + ] '[ , @ ] ] unit-test
+[ [ 1 + ] ] [ 1 [ + ] '[ _ @ ] ] unit-test
-[ [ 1 + . ] ] [ 1 [ + ] '[ , @ . ] ] unit-test
+[ [ 1 + . ] ] [ 1 [ + ] '[ _ @ . ] ] unit-test
[ [ + - ] ] [ [ + ] [ - ] '[ @ @ ] ] unit-test
[ [ "a" write "b" print ] ]
-[ "a" "b" '[ , write , print ] ] unit-test
+[ "a" "b" '[ _ write _ print ] ] unit-test
[ [ 1 2 + 3 4 - ] ]
[ [ + ] [ - ] '[ 1 2 @ 3 4 @ ] ] unit-test
[ 1/2 ] [
- 1 '[ [ , ] dip / ] 2 swap call
+ 1 '[ [ _ ] dip / ] 2 swap call
] unit-test
[ { { 1 "a" "A" } { 1 "b" "B" } { 1 "c" "C" } } ] [
- 1 '[ [ , ] 2dip 3array ]
+ 1 '[ [ _ ] 2dip 3array ]
{ "a" "b" "c" } { "A" "B" "C" } rot 2map
] unit-test
] unit-test
[ { { 1 "a" 2 } { 1 "b" 2 } { 1 "c" 2 } } ] [
- 1 2 '[ [ , ] dip , 3array ]
+ 1 2 '[ [ _ ] dip , 3array ]
{ "a" "b" "c" } swap map
] unit-test
[ "hi" 3 ] [ "h" "i" 3 [ append ] funny-dip ] unit-test
[ { 1 2 3 } ] [
- 3 1 '[ , [ , + ] map ] call
+ 3 1 '[ _ [ _ + ] map ] call
] unit-test
[ { 1 { 2 { 3 } } } ] [
- 1 2 3 '[ , [ , [ , 1array ] call 2array ] call 2array ] call
+ 1 2 3 '[ _ [ _ [ _ 1array ] call 2array ] call 2array ] call
] unit-test
-{ 1 1 } [ '[ [ [ , ] ] ] ] must-infer-as
+{ 1 1 } [ '[ [ [ _ ] ] ] ] must-infer-as
[ { { { 3 } } } ] [
- 3 '[ [ [ , 1array ] call 1array ] call 1array ] call
+ 3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
] unit-test
[ { { { 3 } } } ] [
- 3 '[ [ [ , 1array ] call 1array ] call 1array ] call
+ 3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
] unit-test
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences combinators parser splitting math
quotations arrays make qualified words ;
-QUALIFIED: make
IN: fry
-: , ( -- * ) "Only valid inside a fry" throw ;
+: _ ( -- * ) "Only valid inside a fry" throw ;
: @ ( -- * ) "Only valid inside a fry" throw ;
<PRIVATE
: (shallow-fry) ( accum quot -- result )
[ 1quotation ] [
unclip {
- { \ , [ [ curry ] ((shallow-fry)) ] }
+ { \ , [ "Oops!!" throw ] }
+ { \ _ [ [ curry ] ((shallow-fry)) ] }
{ \ @ [ [ compose ] ((shallow-fry)) ] }
-
- ! to avoid confusion, remove if fry goes core
- { \ make:, [ [ curry ] ((shallow-fry)) ] }
-
[ swap >r suffix r> (shallow-fry) ]
} case
] if-empty ;
: shallow-fry ( quot -- quot' ) [ ] swap (shallow-fry) ;
-PREDICATE: fry-specifier < word { , make:, @ } memq? ;
+PREDICATE: fry-specifier < word { _ @ , } memq? ;
GENERIC: count-inputs ( quot -- n )
M: callable count-inputs [ count-inputs ] sigma ;
-M: fry-specifier count-inputs drop 1 ;
+M: fry-specifier count-inputs \ , eq? [ "Oops!!" throw ] when 1 ;
M: object count-inputs drop 0 ;
PRIVATE>
[
[
dup callable? [
- [ count-inputs \ , <repetition> % ] [ fry % ] bi
- ] [ make:, ] if
+ [ count-inputs \ _ <repetition> % ] [ fry % ] bi
+ ] [ , ] if
] each
] [ ] make shallow-fry ;
\r
: handle-get ( action -- response )\r
'[\r
- , dup display>> [\r
+ _ dup display>> [\r
{\r
[ init>> call ]\r
[ authorize>> call ]\r
\r
: handle-post ( action -- response )\r
'[\r
- , dup submit>> [\r
+ _ dup submit>> [\r
[ validate>> call ]\r
[ authorize>> call ]\r
[ submit>> call ]\r
\r
: <page-action> ( -- page )\r
page-action new-action\r
- dup '[ , template>> <chloe-content> ] >>display ;\r
+ dup '[ _ template>> <chloe-content> ] >>display ;\r
'[
<conversations>
<sessions>
- , , <db-persistence>
+ _ _ <db-persistence>
<check-form-submissions>
] call ;
: start-expiring ( db params -- )
'[
- , , [ state-classes [ expire-state ] each ] with-db
+ _ _ [ state-classes [ expire-state ] each ] with-db
] 5 minutes every drop ;
C: <secure-realm-only> secure-realm-only\r
\r
M: secure-realm-only call-responder*\r
- '[ , , call-next-method ] if-secure-realm ;\r
+ '[ _ _ call-next-method ] if-secure-realm ;\r
\r
TUPLE: protected < filter-responder description capabilities ;\r
\r
! Copyright (c) 2007 Chris Double.\r
! See http://factorcode.org/license.txt for BSD license.\r
-USING: accessors kernel splitting base64 namespaces strings\r
+USING: accessors kernel splitting base64 namespaces make strings\r
http http.server.responses furnace.auth ;\r
IN: furnace.auth.basic\r
\r
! Copyright (c) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces accessors kernel assocs arrays io.sockets threads
-fry urls smtp validators html.forms present
+USING: namespaces make accessors kernel assocs arrays io.sockets
+threads fry urls smtp validators html.forms present
http http.server.responses http.server.redirection
http.server.dispatchers
furnace furnace.actions furnace.auth furnace.auth.providers
] "" make >>body ;
: send-password-email ( user -- )
- '[ , password-email send-email ]
+ '[ _ password-email send-email ]
"E-mail send thread" spawn drop ;
: <recover-action-1> ( -- action )
: compile-link-attrs ( tag -- )
#! Side-effects current namespace.
- attrs>> '[ [ [ , ] dip link-attr ] each-responder ] [code] ;
+ attrs>> '[ [ [ _ ] dip link-attr ] each-responder ] [code] ;
: a-start-tag ( tag -- )
[ compile-link-attrs ] [ compile-a-url ] bi
: compile-hidden-form-fields ( for -- )
'[
- , [ "," split [ hidden render ] each ] when*
+ _ [ "," split [ hidden render ] each ] when*
nested-forms get " " join f like nested-forms-key hidden-form-field
[ modify-form ] each-responder
] [code] ;
: restore-conversation ( seq -- )
conversation get dup [
namespace>>
- [ '[ , key? ] filter ]
- [ '[ [ , at ] keep set ] each ]
+ [ '[ _ key? ] filter ]
+ [ '[ [ _ at ] keep set ] each ]
bi
] [ 2drop ] if ;
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces assocs sequences kernel classes splitting
+USING: namespaces make assocs sequences kernel classes splitting
vocabs.loader accessors strings combinators arrays
continuations present fry
urls html.elements
} cond ; inline
M: secure-only call-responder*
- '[ , , call-next-method ] if-secure ;
+ '[ _ _ call-next-method ] if-secure ;
feed-action new-action
dup '[
feed new
- ,
+ _
[ title>> call >>title ]
[ url>> call adjust-url relative-to-request >>url ]
[ entries>> call process-entries >>entries ]
IN: generalizations\r
\r
MACRO: nsequence ( n seq -- quot )\r
- [ drop <reversed> ] [ '[ , , new-sequence ] ] 2bi\r
- [ '[ @ [ , swap set-nth-unsafe ] keep ] ] reduce ;\r
+ [ drop <reversed> ] [ '[ _ _ new-sequence ] ] 2bi\r
+ [ '[ @ [ _ swap set-nth-unsafe ] keep ] ] reduce ;\r
\r
MACRO: narray ( n -- quot )\r
- '[ , { } nsequence ] ;\r
+ '[ _ { } nsequence ] ;\r
\r
MACRO: firstn ( n -- )\r
dup zero? [ drop [ drop ] ] [\r
- [ [ '[ [ , ] dip nth-unsafe ] ] map ]\r
- [ 1- '[ [ , ] dip bounds-check 2drop ] ]\r
- bi prefix '[ , cleave ]\r
+ [ [ '[ [ _ ] dip nth-unsafe ] ] map ]\r
+ [ 1- '[ [ _ ] dip bounds-check 2drop ] ]\r
+ bi prefix '[ _ cleave ]\r
] if ;\r
\r
MACRO: npick ( n -- )\r
1- dup saver [ dup ] rot [ r> swap ] n*quot 3append ;\r
\r
MACRO: ndup ( n -- )\r
- dup '[ , npick ] n*quot ;\r
+ dup '[ _ npick ] n*quot ;\r
\r
MACRO: nrot ( n -- )\r
1- dup saver swap [ r> swap ] n*quot append ;\r
2 + [ dupd -nrot ] curry ;\r
\r
MACRO: nrev ( n -- quot )\r
- 1 [a,b] [ ] [ '[ @ , -nrot ] ] reduce ;\r
+ 1 [a,b] [ ] [ '[ @ _ -nrot ] ] reduce ;\r
\r
MACRO: ndip ( quot n -- )\r
dup saver -rot restorer 3append ;\r
\r
MACRO: nkeep ( n -- )\r
[ ] [ 1+ ] [ ] tri\r
- '[ [ , ndup ] dip , -nrot , nslip ] ;\r
+ '[ [ _ ndup ] dip _ -nrot _ nslip ] ;\r
\r
MACRO: ncurry ( n -- )\r
[ curry ] n*quot ;\r
\r
MACRO: napply ( n -- )\r
2 [a,b]\r
- [ [ 1- ] keep '[ , ntuck , nslip ] ]\r
+ [ [ 1- ] keep '[ _ ntuck _ nslip ] ]\r
map concat >quotation [ call ] append ;\r
$predicate
$class-description
$error-description
- } swap '[ , elements empty? not ] contains? ;
+ } swap '[ _ elements empty? not ] contains? ;
: check-values ( word element -- )
{
H{ } clone [
'[
dup >link where dup
- [ first , at , push-at ] [ 2drop ] if
+ [ first _ at _ push-at ] [ 2drop ] if
] each
] keep ;
: specializer-cases ( quot word -- default alist )
dup [ array? ] all? [ 1array ] unless [
[ make-specializer ] keep
- '[ , declare ] pick append
+ '[ _ declare ] pick append
] { } map>assoc ;
: method-declaration ( method -- quot )
bi prefix ;
: specialize-method ( quot method -- quot' )
- method-declaration '[ , declare ] prepend ;
+ method-declaration '[ _ declare ] prepend ;
: specialize-quot ( quot specializer -- quot' )
specializer-cases alist>quot ;
</option> ;
: render-options ( options selected -- )
- '[ dup , member? render-option ] each ;
+ '[ dup _ member? render-option ] each ;
M: choice render*
<select
: def-for-html-word-<foo> ( name -- )
#! Return the name and code for the <foo> patterned
#! word.
- dup <foo> swap '[ , <foo> write-html ]
+ dup <foo> swap '[ _ <foo> write-html ]
(( -- )) html-word ;
: <foo ( str -- <str ) "<" prepend ;
: def-for-html-word-<foo ( name -- )
#! Return the name and code for the <foo patterned
#! word.
- <foo dup '[ , write-html ]
+ <foo dup '[ _ write-html ]
(( -- )) html-word ;
: foo> ( str -- foo> ) ">" append ;
: def-for-html-word-</foo> ( name -- )
#! Return the name and code for the </foo> patterned
#! word.
- </foo> dup '[ , write-html ] (( -- )) html-word ;
+ </foo> dup '[ _ write-html ] (( -- )) html-word ;
: <foo/> ( str -- <str/> ) "<" swap "/>" 3append ;
: def-for-html-word-<foo/> ( name -- )
#! Return the name and code for the <foo/> patterned
#! word.
- dup <foo/> swap '[ , <foo/> write-html ]
+ dup <foo/> swap '[ _ <foo/> write-html ]
(( -- )) html-word ;
: foo/> ( str -- str/> ) "/>" append ;
: define-attribute-word ( name -- )
dup "=" prepend swap
- '[ , write-attr ] (( string -- )) html-word ;
+ '[ _ write-attr ] (( string -- )) html-word ;
! Define some closed HTML tags
[
: with-form ( name quot -- )
'[
- ,
+ _
[ nested-forms [ swap prefix ] change ]
[ value form set ]
bi
swap set-value ;
: validate-values ( assoc validators -- assoc' )
- swap '[ [ dup , at ] dip validate-value ] assoc-each ;
+ swap '[ [ dup _ at ] dip validate-value ] assoc-each ;
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-
-USING: combinators generic assocs help http io io.styles io.files
- continuations io.streams.string kernel math math.order math.parser
- namespaces quotations assocs sequences strings words html.elements
- xml.entities sbufs continuations destructors accessors arrays ;
-
+USING: combinators generic assocs help http io io.styles
+io.files continuations io.streams.string kernel math math.order
+math.parser namespaces make quotations assocs sequences strings
+words html.elements xml.entities sbufs continuations destructors
+accessors arrays ;
IN: html.streams
GENERIC: browser-link-href ( presented -- href )
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sequences combinators kernel fry
-namespaces classes.tuple assocs splitting words arrays memoize
-io io.files io.encodings.utf8 io.streams.string unicode.case
-mirrors math urls present multiline quotations xml xml.data
+namespaces make classes.tuple assocs splitting words arrays
+memoize io io.files io.encodings.utf8 io.streams.string
+unicode.case mirrors math urls present multiline quotations xml
+xml.data
html.forms
html.elements
html.components
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: assocs namespaces kernel sequences accessors combinators
-strings splitting io io.streams.string present xml.writer
-xml.data xml.entities html.forms html.templates.chloe.syntax ;
+USING: assocs namespaces make kernel sequences accessors
+combinators strings splitting io io.streams.string present
+xml.writer xml.data xml.entities html.forms
+html.templates.chloe.syntax ;
IN: html.templates.chloe.compiler
: chloe-attrs-only ( assoc -- assoc' )
: CHLOE-SINGLETON:
scan-word
- [ name>> ] [ '[ , singleton-component-tag ] ] bi
+ [ name>> ] [ '[ _ singleton-component-tag ] ] bi
define-chloe-tag ;
parsing
: compile-component-attrs ( tag class -- )
[ attrs>> [ drop main>> "name" = not ] assoc-filter ] dip
- [ all-slots swap '[ name>> , at compile-attr ] each ]
+ [ all-slots swap '[ name>> _ at compile-attr ] each ]
[ [ boa ] [code-with] ]
bi ;
: CHLOE-TUPLE:
scan-word
- [ name>> ] [ '[ , tuple-component-tag ] ] bi
+ [ name>> ] [ '[ _ tuple-component-tag ] ] bi
define-chloe-tag ;
parsing
C: <fhtml> fhtml
M: fhtml call-template* ( filename -- )
- '[ , path>> utf8 file-contents eval-template ] assert-depth ;
+ '[ _ path>> utf8 file-contents eval-template ] assert-depth ;
INSTANCE: fhtml template
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs kernel math math.parser namespaces
+USING: accessors assocs kernel math math.parser namespaces make
sequences io io.sockets io.streams.string io.files io.timeouts
strings splitting calendar continuations accessors vectors
math.order hashtables byte-arrays prettyprint
SYMBOL: redirects
: redirect-url ( request url -- request )
- '[ , >url derive-url ensure-port ] change-url ;
+ '[ _ >url derive-url ensure-port ] change-url ;
: do-redirect ( response data -- response data )
over code>> 300 399 between? [
: download-to ( url file -- )
#! Downloads the contents of a URL to a file.
swap http-get
- [ content-charset>> ] [ '[ , write ] ] bi*
+ [ content-charset>> ] [ '[ _ write ] ] bi*
with-file-writer ;
: download ( url -- )
! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel combinators math namespaces
+USING: accessors kernel combinators math namespaces make
assocs sequences splitting sorting sets debugger
strings vectors hashtables quotations arrays byte-arrays
math.parser calendar calendar.format present
[ read-crlf dup f like ] [ parse-header-line ] [ drop ] produce ;
: collect-headers ( assoc -- assoc' )
- H{ } clone [ '[ , push-at ] assoc-each ] keep ;
+ H{ } clone [ '[ _ push-at ] assoc-each ] keep ;
: process-header ( alist -- assoc )
f swap [ [ swap or dup ] dip swap ] assoc-map nip
[ clone ] change-cookies ;
: get-cookie ( request/response name -- cookie/f )
- [ cookies>> ] dip '[ [ , ] dip name>> = ] find nip ;
+ [ cookies>> ] dip '[ [ _ ] dip name>> = ] find nip ;
: delete-cookie ( request/response name -- )
over cookies>> [ get-cookie ] dip delete ;
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.short-circuit math math.order math.parser kernel
-sequences sequences.deep peg peg.parsers assocs arrays
-hashtables strings unicode.case namespaces ascii ;
+USING: combinators.short-circuit math math.order math.parser
+kernel sequences sequences.deep peg peg.parsers assocs arrays
+hashtables strings unicode.case namespaces make ascii ;
IN: http.parsers
: except ( quot -- parser )
200 >>code\r
"CGI output follows" >>message\r
swap '[\r
-
, output-stream get swap <cgi-process> <process-stream> [
\r+
_ output-stream get swap <cgi-process> <process-stream> [
\r post-request? [ request get post-data>> raw>> write flush ] when\r
input-stream get swap (stream-copy)\r
] with-stream\r
: <500> ( error -- response )
500 "Internal server error" <trivial-response>
- swap development? get [ '[ , http-error. ] >>body ] [ drop ] if ;
+ swap development? get [ '[ _ http-error. ] >>body ] [ drop ] if ;
: do-response ( response -- )
[ request get swap write-full-response ]
[
local-address get
[ secure? "https" "http" ? >>protocol ]
- [ port>> '[ , or ] change-port ]
+ [ port>> '[ _ or ] change-port ]
bi
] change-url drop ;
: do-request ( request -- response )
'[
- ,
+ _
{
[ init-request ]
[ prepare-request ]
\r
: list-directory ( directory -- response )\r
file-responder get allow-listings>> [\r
- '[ , directory. ] "text/html" <content>\r
+ '[ _ directory. ] "text/html" <content>\r
] [\r
drop <403>\r
] if ;\r
: handle-client ( client remote local -- )
'[
- , , log-connection
+ _ _ log-connection
threaded-server get
[ timeout>> timeouts ] [ handle-client* ] bi
] with-stream ;
: accept-connection ( threaded-server -- )
[ accept ] [ addr>> ] bi
- [ '[ , , , handle-client ] ]
+ [ '[ _ _ _ handle-client ] ]
[ drop threaded-server get name>> swap thread-name ] 2bi
spawn drop ;
PRIVATE>
: with-datagrams ( seq service quot -- )
- '[ [ [ , ] dip spawn-datagrams ] parallel-each ] with-logging ; inline
+ '[ [ [ _ ] dip spawn-datagrams ] parallel-each ] with-logging ; inline
! Copyright (C) 2006 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel parser-combinators namespaces sequences promises strings
+USING: kernel parser-combinators namespaces make sequences promises strings
assocs math math.parser math.vectors math.functions math.order
lists hashtables ascii accessors ;
IN: json.reader
! Copyright (C) 2006 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel io.streams.string io strings splitting sequences math
- math.parser assocs classes words namespaces prettyprint
- hashtables mirrors tr ;
+USING: kernel io.streams.string io strings splitting sequences
+math math.parser assocs classes words namespaces make
+prettyprint hashtables mirrors tr ;
IN: json.writer
#! Writes the object out to a stream in JSON format
USING: sequences kernel math locals math.order math.ranges\r
-accessors arrays namespaces combinators combinators.short-circuit ;\r
+accessors arrays namespaces make combinators\r
+combinators.short-circuit ;\r
IN: lcs\r
\r
<PRIVATE\r
! Copyright (C) 2008 Slava Pestov.\r
! See http://factorcode.org/license.txt for BSD license.\r
USING: logging.analysis logging.server logging smtp kernel\r
-io.files io.streams.string namespaces alarms assocs\r
+io.files io.streams.string namespaces make alarms assocs\r
io.encodings.utf8 accessors calendar sequences qualified ;\r
QUALIFIED: io.sockets\r
IN: logging.insomniac\r
: input# ( word -- n ) stack-effect in>> length ;\r
\r
: input-logging-quot ( quot word level -- quot' )\r
- rot [ [ input# ] keep ] 2dip '[ , , , log-stack @ ] ;\r
+ rot [ [ input# ] keep ] 2dip '[ _ _ _ log-stack @ ] ;\r
\r
: add-input-logging ( word level -- )\r
[ input-logging-quot ] (define-logging) ;\r
: output# ( word -- n ) stack-effect out>> length ;\r
\r
: output-logging-quot ( quot word level -- quot' )\r
- [ [ output# ] keep ] dip '[ @ , , , log-stack ] ;\r
+ [ [ output# ] keep ] dip '[ @ _ _ _ log-stack ] ;\r
\r
: add-output-logging ( word level -- )\r
[ output-logging-quot ] (define-logging) ;\r
\r
: error-logging-quot ( quot word -- quot' )\r
dup stack-effect stack-balancer\r
- '[ , [ , log-error @ ] recover ] ;\r
+ '[ _ [ _ log-error @ ] recover ] ;\r
\r
: add-error-logging ( word level -- )\r
[ [ input-logging-quot ] 2keep drop error-logging-quot ]\r
: LOG:\r
#! Syntax: name level\r
CREATE-WORD dup scan-word\r
- '[ 1array stack>message , , log-message ]\r
+ '[ 1array stack>message _ _ log-message ]\r
(( message -- )) define-declared ; parsing\r
\r
USE: vocabs.loader\r
! Copyright (C) 2008 Slava Pestov.\r
! See http://factorcode.org/license.txt for BSD license.\r
USING: accessors peg peg.parsers memoize kernel sequences\r
-logging arrays words strings vectors io io.files io.encodings.utf8\r
-namespaces combinators logging.server calendar calendar.format ;\r
+logging arrays words strings vectors io io.files\r
+io.encodings.utf8 namespaces make combinators logging.server\r
+calendar calendar.format ;\r
IN: logging.parser\r
\r
TUPLE: log-entry date level word-name message ;\r
\ byte-bit-count
256 [
0 swap [ [ 1+ ] when ] each-bit
-] B{ } map-as '[ HEX: ff bitand , nth-unsafe ] define-inline
+] B{ } map-as '[ HEX: ff bitand _ nth-unsafe ] define-inline
>>
MEMO: mime-types ( -- assoc )
[
- mime-db [ unclip '[ [ , ] dip set ] each ] each
+ mime-db [ unclip '[ [ _ ] dip set ] each ] each
] H{ } make-assoc
nonstandard-mime-types assoc-union ;
! Copyright (C) 2007 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces parser lexer kernel sequences words quotations math
-accessors ;
+USING: namespaces make parser lexer kernel sequences words
+quotations math accessors ;
IN: multiline
<PRIVATE
! Copyright (C) 2007 Chris Double.\r
! See http://factorcode.org/license.txt for BSD license.\r
-USING: kernel compiler.units words arrays strings math.parser sequences \r
- quotations vectors namespaces math assocs continuations peg\r
- peg.parsers unicode.categories multiline \r
- splitting accessors effects sequences.deep peg.search\r
- combinators.short-circuit lexer io.streams.string\r
- stack-checker io prettyprint combinators parser ;\r
+USING: kernel compiler.units words arrays strings math.parser\r
+sequences quotations vectors namespaces make math assocs\r
+continuations peg peg.parsers unicode.categories multiline\r
+splitting accessors effects sequences.deep peg.search\r
+combinators.short-circuit lexer io.streams.string stack-checker\r
+io prettyprint combinators parser ;\r
IN: peg.ebnf\r
\r
: rule ( name word -- parser )\r
] if ;
M: token-parser (compile) ( peg -- quot )
- symbol>> '[ input-slice , parse-token ] ;
+ symbol>> '[ input-slice _ parse-token ] ;
TUPLE: satisfy-parser quot ;
M: satisfy-parser (compile) ( peg -- quot )
- quot>> '[ input-slice , parse-satisfy ] ;
+ quot>> '[ input-slice _ parse-satisfy ] ;
TUPLE: range-parser min max ;
] if ;
M: range-parser (compile) ( peg -- quot )
- [ min>> ] [ max>> ] bi '[ input-slice , , parse-range ] ;
+ [ min>> ] [ max>> ] bi '[ input-slice _ _ parse-range ] ;
TUPLE: seq-parser parsers ;
M: repeat0-parser (compile) ( peg -- quot )
p1>> compile-parser 1quotation '[
- input-slice V{ } clone <parse-result> , swap (repeat)
+ input-slice V{ } clone <parse-result> _ swap (repeat)
] ;
TUPLE: repeat1-parser p1 ;
M: repeat1-parser (compile) ( peg -- quot )
p1>> compile-parser 1quotation '[
- input-slice V{ } clone <parse-result> , swap (repeat) repeat1-empty-check
+ input-slice V{ } clone <parse-result> _ swap (repeat) repeat1-empty-check
] ;
TUPLE: optional-parser p1 ;
M: semantic-parser (compile) ( peg -- quot )
[ p1>> compile-parser 1quotation ] [ quot>> ] bi
- '[ @ , check-semantic ] ;
+ '[ @ _ check-semantic ] ;
TUPLE: ensure-parser p1 ;
] if ; inline
M: action-parser (compile) ( peg -- quot )
- [ p1>> compile-parser 1quotation ] [ quot>> ] bi '[ @ , check-action ] ;
+ [ p1>> compile-parser 1quotation ] [ quot>> ] bi '[ @ _ check-action ] ;
TUPLE: sp-parser p1 ;
: random-assocs ( -- hash phash )
[ random-string ] replicate
- [ H{ } clone [ '[ swap , set-at ] each-index ] keep ]
+ [ H{ } clone [ '[ swap _ set-at ] each-index ] keep ]
[ PH{ } clone swap [ spin new-at ] each-index ]
bi ;
! Based on Clojure's PersistentHashMap by Rich Hickey.
USING: kernel math accessors assocs fry combinators parser
-prettyprint.backend namespaces
+prettyprint.backend make
persistent.assocs
persistent.hashtables.nodes
persistent.hashtables.nodes.empty
IN: persistent.hashtables.nodes.collision
: find-index ( key hashcode collision-node -- n leaf-node )
- leaves>> -rot '[ [ , , ] dip matching-key? ] find ; inline
+ leaves>> -rot '[ [ _ _ ] dip matching-key? ] find ; inline
M:: collision-node (entry-at) ( key hashcode collision-node -- leaf-node )
key hashcode collision-node find-index nip ;
! Based on Clojure's PersistentHashMap by Rich Hickey.
-USING: kernel accessors locals math arrays namespaces
+USING: kernel accessors locals math arrays namespaces make
persistent.hashtables.config
persistent.hashtables.nodes ;
IN: persistent.hashtables.nodes.leaf
! Copyright (C) 2007, 2008 Elie CHAFTARI, Dirk Vleugels,
! Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays namespaces io io.timeouts kernel logging
+USING: arrays namespaces make io io.timeouts kernel logging
io.sockets sequences combinators splitting assocs strings
math.parser random system calendar io.encodings.ascii summary
calendar.format accessors sets hashtables ;
2array recursive-state get swap prefix infer-quot ;
: time-bomb ( error -- )
- '[ , throw ] recursive-state get infer-quot ;
+ '[ _ throw ] recursive-state get infer-quot ;
: bad-call ( -- )
"call must be given a callable" time-bomb ;
] maybe-cannot-infer ;
: apply-word/effect ( word effect -- )
- swap '[ , #call, ] consume/produce ;
+ swap '[ _ #call, ] consume/produce ;
: required-stack-effect ( word -- effect )
dup stack-effect [ ] [ \ missing-effect inference-error ] ?if ;
: pad-with-bottom ( seq -- newseq )
dup empty? [
dup [ length ] map supremum
- '[ , +bottom+ pad-left ] map
+ '[ _ +bottom+ pad-left ] map
] unless ;
: phi-inputs ( max-d-in pairs -- newseq )
dup empty? [ nip ] [
- swap '[ [ , ] dip first2 unify-inputs ] map
+ swap '[ [ _ ] dip first2 unify-inputs ] map
pad-with-bottom
] if ;
] if-empty ;
: branch-variable ( seq symbol -- seq )
- '[ [ , ] dip at ] map ;
+ '[ [ _ ] dip at ] map ;
: active-variable ( seq symbol -- seq )
[ [ terminated? over at [ drop f ] when ] map ] dip
: adjust-stack-effect ( effect -- effect' )
[ in>> ] [ out>> ] bi
meta-d get length pick length [-]
- object <repetition> '[ , prepend ] bi@
+ object <repetition> '[ _ prepend ] bi@
<effect> ;
: call-recursive-inline-word ( word -- )
dup "recursive" word-prop [
[ required-stack-effect adjust-stack-effect ] [ ] [ recursive-label ] tri
- [ 2nip check-call ] [ nip '[ , #call-recursive, ] consume/produce ] 3bi
+ [ 2nip check-call ] [ nip '[ _ #call-recursive, ] consume/produce ] 3bi
] [ undeclared-recursion-error inference-error ] if ;
: inline-word ( word -- )
: depends-on ( word how -- )
over primitive? [ 2drop ] [
dependencies get dup [
- swap '[ , strongest-dependency ] change-at
+ swap '[ _ strongest-dependency ] change-at
] [ 3drop ] if
] if ;
: depends-on-generic ( generic class -- )
generic-dependencies get dup
- [ swap '[ null or , class-or ] change-at ] [ 3drop ] if ;
+ [ swap '[ null or _ class-or ] change-at ] [ 3drop ] if ;
! Words we've inferred the stack effect of, for rollback
SYMBOL: recorded
dup [
[
[ drop ] [
- [ length meta-d get '[ , pop* ] times ]
+ [ length meta-d get '[ _ pop* ] times ]
[ #drop, ]
bi
] bi*
dup tuple-class? [
dup inlined-dependency depends-on
[ "boa-check" word-prop ]
- [ tuple-layout '[ , <tuple-boa> ] ]
+ [ tuple-layout '[ _ <tuple-boa> ] ]
bi append
] [ drop f ] if
] 1 define-transform
#! from code until the quotation given is true and\r
#! advance spot to after the substring.\r
10 <sbuf> [\r
- '[ @ [ t ] [ get-char , push f ] if ] skip-until\r
+ '[ @ [ t ] [ get-char _ push f ] if ] skip-until\r
] keep >string ; inline\r
\r
: take-rest ( -- string )\r
\r
: take ( n -- string )\r
[ 1- ] [ <sbuf> ] bi [\r
- '[ drop get-char [ next , push f ] [ t ] if* ] contains? drop\r
+ '[ drop get-char [ next _ push f ] [ t ] if* ] contains? drop\r
] keep get-char [ over push ] when* >string ;\r
\r
: pass-blank ( -- )\r
USING: xml.utilities kernel assocs xml.generator math.order
strings sequences xml.data xml.writer
io.streams.string combinators xml xml.entities io.files io
- http.client namespaces xml.generator hashtables
+ http.client namespaces make xml.generator hashtables
calendar.format accessors continuations urls present ;
IN: syndication
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors qualified io.streams.c init fry namespaces
+USING: accessors qualified io.streams.c init fry namespaces make
assocs kernel parser lexer strings.parser tools.deploy.config
vocabs sequences words words.private memory kernel.private
continuations io prettyprint vocabs.loader debugger system
[
[
props>> swap
- '[ drop , member? not ] assoc-filter sift-assoc
+ '[ drop _ member? not ] assoc-filter sift-assoc
dup assoc-empty? [ drop f ] [ >alist >vector ] if
] keep (>>props)
] with each ;
strip-globals? [
"Stripping globals" show
global swap
- '[ drop , member? not ] assoc-filter
+ '[ drop _ member? not ] assoc-filter
[ drop string? not ] assoc-filter ! strip CLI args
sift-assoc
dup keys unparse show
<PRIVATE
: compute-tr ( quot from to -- mapping )
- zip [ 256 ] 2dip '[ [ @ , at ] keep or ] B{ } map-as ; inline
+ zip [ 256 ] 2dip '[ [ @ _ at ] keep or ] B{ } map-as ; inline
: tr-hints ( word -- )
{ { byte-array } { string } } "specializer" set-word-prop ;
create-in dup tr-hints ;
: tr-quot ( mapping -- quot )
- '[ [ dup 0 255 between? [ , nth-unsafe ] when ] map ] ;
+ '[ [ dup 0 255 between? [ _ nth-unsafe ] when ] map ] ;
: define-tr ( word mapping -- )
tr-quot (( seq -- translated )) define-declared ;
: fast-tr-quot ( mapping -- quot )
- '[ [ , nth-unsafe ] change-each ] ;
+ '[ [ _ nth-unsafe ] change-each ] ;
: define-fast-tr ( word mapping -- )
fast-tr-quot (( seq -- )) define-declared ;
TUPLE: track < pack sizes ;
: normalized-sizes ( track -- seq )
- sizes>> dup sift sum '[ dup [ , / ] when ] map ;
+ sizes>> dup sift sum '[ dup [ _ / ] when ] map ;
: init-track ( track -- track )
init-gadget
-USING: combinators.short-circuit unicode.categories kernel math combinators splitting
-sequences math.parser io.files io assocs arrays namespaces
-math.ranges unicode.normalize values io.encodings.ascii
-unicode.syntax unicode.data compiler.units alien.syntax sets ;
+USING: combinators.short-circuit unicode.categories kernel math
+combinators splitting sequences math.parser io.files io assocs
+arrays namespaces make math.ranges unicode.normalize values
+io.encodings.ascii unicode.syntax unicode.data compiler.units
+alien.syntax sets ;
IN: unicode.breaks
C-ENUM: Any L V T Extend Control CR LF graphemes ;
USING: combinators.short-circuit sequences io.files\r
io.encodings.ascii kernel values splitting accessors math.parser\r
-ascii io assocs strings math namespaces sorting combinators\r
+ascii io assocs strings math namespaces make sorting combinators\r
math.order arrays unicode.normalize unicode.data locals\r
unicode.syntax macros sequences.deep words unicode.breaks\r
quotations ;\r
USING: accessors values kernel sequences assocs io.files
io.encodings ascii math.ranges io splitting math.parser
-namespaces byte-arrays locals math sets io.encodings.ascii
+namespaces make byte-arrays locals math sets io.encodings.ascii
words compiler.units arrays interval-maps unicode.data ;
IN: unicode.script
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel ascii combinators combinators.short-circuit
-sequences splitting fry namespaces assocs arrays strings
+sequences splitting fry namespaces make assocs arrays strings
io.sockets io.sockets.secure io.encodings.string
io.encodings.utf8 math math.parser accessors parser
strings.parser lexer prettyprint.backend hashtables present ;
swap query>> at ;
: set-query-param ( url value key -- url )
- '[ [ , , ] dip ?set-at ] change-query ;
+ '[ [ _ _ ] dip ?set-at ] change-query ;
: parse-host ( string -- host port )
":" split1 [ url-decode ] [
} case ;
: ensure-port ( url -- url' )
- dup protocol>> '[ , protocol-port or ] change-port ;
+ dup protocol>> '[ _ protocol-port or ] change-port ;
! Literal syntax
: URL" lexer get skip-blank parse-string >url parsed ; parsing
! Copyright (C) 2006, 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel continuations sequences math
-namespaces sets math.parser math.ranges assocs regexp
-unicode.categories arrays hashtables words
-classes quotations xmode.catalog ;
+USING: kernel continuations sequences math namespaces make sets
+math.parser math.ranges assocs regexp unicode.categories arrays
+hashtables words classes quotations xmode.catalog ;
IN: validators
: v-default ( str def -- str )
MACRO: com-invoke ( n return parameters -- )
dup length -roll
'[
- , npick com-interface-vtbl , swap void*-nth , ,
+ _ npick com-interface-vtbl _ swap void*-nth _ _
"stdcall" alien-indirect
] ;
(query-interface-cases)
'[
swap 16 memory>byte-array
- , case
+ _ case
[
"void*" heap-size * rot <displaced-alien> com-add-ref
0 rot set-void*-nth S_OK
: (make-add-ref) ( interfaces -- quot )
length "void*" heap-size * '[
- , swap <displaced-alien>
+ _ swap <displaced-alien>
0 over ulong-nth
1+ [ 0 rot set-ulong-nth ] keep
] ;
: (make-release) ( interfaces -- quot )
length "void*" heap-size * '[
- , over <displaced-alien>
+ _ over <displaced-alien>
0 over ulong-nth
1- [ 0 rot set-ulong-nth ] keep
dup zero? [ swap (free-wrapped-object) ] [ nip ] if
: (thunk) ( n -- quot )
dup 0 =
[ drop [ ] ]
- [ "void*" heap-size neg * '[ , swap <displaced-alien> ] ]
+ [ "void*" heap-size neg * '[ _ swap <displaced-alien> ] ]
if ;
: (thunked-quots) ( quots iunknown-methods thunk -- {thunk,quot}s )
- [ '[ , '[ @ com-unwrap ] [ swap 2array ] curry map ] ]
- [ '[ , [ swap 2array ] curry map ] ] bi bi*
+ [ '[ _ '[ @ com-unwrap ] [ swap 2array ] curry map ] ]
+ [ '[ _ [ swap 2array ] curry map ] ] bi bi*
swap append ;
: compile-alien-callback ( word return parameters abi quot -- word )
- '[ , , , , alien-callback ]
+ '[ _ _ _ _ alien-callback ]
[ [ (( -- alien )) define-declared ] pick slip ]
with-compilation-unit ;
"windows.com.wrapper.callbacks" create ;
: (finish-thunk) ( param-count thunk quot -- thunked-quot )
- [ [ drop [ ] ] [ swap 1- '[ , , ndip ] ] if-empty ]
+ [ [ drop [ ] ] [ swap 1- '[ _ _ ndip ] ] if-empty ]
dip compose ;
: (make-interface-callbacks) ( interface-name quots iunknown-methods n -- words )
swap [ find-com-interface-definition family-tree-functions ]
keep (next-vtbl-counter) '[
swap [
- [ name>> , , (callback-word) ]
+ [ name>> _ _ (callback-word) ]
[ return>> ] [
parameters>>
[ [ first ] map ]
: (malloc-guid-symbol) ( symbol guid -- )
global swap '[ [
- , execute [ byte-length malloc ] [ over byte-array>memory ] bi
+ _ execute [ byte-length malloc ] [ over byte-array>memory ] bi
] unless* ] change-at ;
: define-guid-constants ( -- )
-USING: sequences kernel namespaces splitting math math.order ;
+USING: sequences kernel namespaces make splitting math math.order ;
IN: wrap
! Very stupid word wrapping/line breaking
!
! based on glx.h from xfree86, and some of glxtokens.h
USING: alien alien.c-types alien.syntax alien.syntax.private x11.xlib
-namespaces kernel sequences parser words ;
+namespaces make kernel sequences parser words ;
IN: x11.glx
LIBRARY: glx
! Copyright (C) 2005, 2006 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces kernel assocs sequences ;
+USING: namespaces make kernel assocs sequences ;
IN: xml.entities
: entities-out
! Copyright (C) 2006, 2007 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces kernel xml.data xml.utilities assocs sequences ;
+USING: namespaces make kernel xml.data xml.utilities assocs
+sequences ;
IN: xml.generator
: comment, ( string -- ) <comment> , ;
! Copyright (C) 2005, 2006 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: xml.errors xml.data xml.utilities xml.char-classes sets
-xml.entities kernel state-parser kernel namespaces strings math
-math.parser sequences assocs arrays splitting combinators unicode.case
-accessors ;
+xml.entities kernel state-parser kernel namespaces make strings
+math math.parser sequences assocs arrays splitting combinators
+unicode.case accessors ;
IN: xml.tokenize
! XML namespace processing: ns = namespace
[\r
drop\r
dup '[\r
- , utf8 [\r
- , file-name input-stream get htmlize-stream\r
+ _ utf8 [\r
+ _ file-name input-stream get htmlize-stream\r
] with-file-reader\r
] "text/html" <content>\r
] <file-responder> ;\r
-USING: accessors xmode.tokens xmode.rules xmode.keyword-map xml.data
-xml.utilities xml assocs kernel combinators sequences
-math.parser namespaces parser lexer xmode.utilities regexp io.files ;
+! Copyright (C) 2007, 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors xmode.tokens xmode.rules xmode.keyword-map
+xml.data xml.utilities xml assocs kernel combinators sequences
+math.parser namespaces make parser lexer xmode.utilities regexp
+io.files ;
IN: xmode.loader.syntax
SYMBOL: ignore-case?
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
IN: xmode.marker
-USING: kernel namespaces xmode.rules xmode.tokens
+USING: kernel namespaces make xmode.rules xmode.tokens
xmode.marker.state xmode.marker.context xmode.utilities
xmode.catalog sequences math assocs combinators
strings regexp splitting parser-combinators ascii unicode.case
+! Copyright (C) 2007, 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
USING: xmode.marker.context xmode.rules symbols accessors
-xmode.tokens namespaces kernel sequences assocs math ;
+xmode.tokens namespaces make kernel sequences assocs math ;
IN: xmode.marker.state
! Based on org.gjt.sp.jedit.syntax.TokenMarker
USING: arrays asn1.ldap assocs byte-arrays combinators
continuations io io.binary io.streams.string kernel math
-math.parser namespaces pack strings sequences accessors ;
+math.parser namespaces make pack strings sequences accessors ;
IN: asn1
[ fail ] unless ;\r
\r
MACRO: checkpoint ( quot -- quot' )\r
- '[ failure get ,\r
- '[ '[ failure set , continue ] callcc0\r
- , failure set @ ] callcc0 ] ;\r
+ '[ failure get _\r
+ '[ '[ failure set _ continue ] callcc0\r
+ _ failure set @ ] callcc0 ] ;\r
\r
: number-from ( from -- from+n )\r
[ 1 + number-from ] checkpoint ;\r
dup length 1 =\r
[ first 1quotation ]\r
[ [ first ] [ rest ] bi\r
- '[ , [ drop , unsafe-amb ] checkpoint ] ] if ;\r
+ '[ _ [ drop _ unsafe-amb ] checkpoint ] ] if ;\r
\r
PRIVATE> \r
\r
\r
MACRO: amb-execute ( seq -- quot )\r
[ length 1 - ] [ <enum> [ 1quotation ] assoc-map ] bi\r
- '[ , 0 unsafe-number-from-to nip , case ] ;\r
+ '[ _ 0 unsafe-number-from-to nip _ case ] ;\r
\r
: if-amb ( true false -- )\r
[\r
-USING: namespaces math sequences splitting grouping
+USING: make math sequences splitting grouping
kernel columns float-arrays bit-arrays ;
IN: benchmark.dispatch2
USING: sequences math mirrors splitting grouping
-kernel namespaces assocs alien.syntax columns
+kernel make assocs alien.syntax columns
float-arrays bit-arrays ;
IN: benchmark.dispatch3
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays io kernel math math.functions math.order
-math.parser sequences byte-arrays byte-vectors io.files
-io.encodings.binary fry namespaces benchmark.mandel.params
+USING: arrays io kernel namespaces math math.functions
+math.order math.parser sequences byte-arrays byte-vectors
+io.files io.encodings.binary fry make benchmark.mandel.params
benchmark.mandel.colors ;
IN: benchmark.mandel
: pixel ( c -- iterations )
[ C{ 0.0 0.0 } max-iterations ] dip
- '[ sq , + ] [ absq 4.0 >= ] count-iterations ; inline
+ '[ sq _ + ] [ absq 4.0 >= ] count-iterations ; inline
: color ( iterations -- color )
[ color-map [ length mod ] keep nth ] [ B{ 0 0 0 } ] if* ; inline
: render ( -- )
- height [ width swap '[ , c pixel color % ] each ] each ; inline
+ height [ width swap '[ _ c pixel color % ] each ] each ; inline
: ppm-header ( -- )
"P6\n" % width # " " % height # "\n255\n" % ; inline
IN: benchmark.nsieve-bits
USING: math math.parser sequences sequences.private kernel
-bit-arrays namespaces io ;
+bit-arrays make io ;
: clear-flags ( step i seq -- )
2dup length >= [
IN: benchmark.nsieve
USING: math math.parser sequences sequences.private kernel
-arrays namespaces io ;
+arrays make io ;
: clear-flags ( step i seq -- )
2dup length >= [
USING: arrays accessors float-arrays io io.files
io.encodings.binary kernel math math.functions math.vectors
-math.parser namespaces sequences sequences.private words ;
+math.parser make sequences sequences.private words ;
IN: benchmark.raytracer
! parameters
-USING: parser lexer kernel math sequences namespaces assocs summary
-words splitting math.parser arrays sequences.next mirrors
-generalizations compiler.units ;
+USING: parser lexer kernel math sequences namespaces make assocs
+summary words splitting math.parser arrays sequences.next
+mirrors generalizations compiler.units ;
IN: bitfields
! Example:
-USING: kernel namespaces sequences arrays io io.files
+USING: kernel namespaces make sequences arrays io io.files
builder.util
builder.common
builder.release.archive ;
-USING: kernel alien.c-types combinators namespaces arrays
+USING: kernel alien.c-types combinators namespaces make arrays
sequences sequences.lib namespaces.lib splitting
math math.functions math.vectors math.trig
opengl.gl opengl.glu opengl ui ui.gadgets.slate
! Cleave into array
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-: [narr] ( seq n -- quot ) over length '[ , , ncleave , narray ] ;
+: [narr] ( seq n -- quot ) over length '[ _ _ ncleave _ narray ] ;
MACRO: narr ( seq n -- array ) [narr] ;
MACRO: <arr> ( seq -- )
[ >quots ] [ length ] bi
- '[ , cleave , narray ] ;
+ '[ _ cleave _ narray ] ;
MACRO: <2arr> ( seq -- )
[ >quots ] [ length ] bi
- '[ , 2cleave , narray ] ;
+ '[ _ 2cleave _ narray ] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MACRO: <arr*> ( seq -- )
[ >quots ] [ length ] bi
- '[ , spread , narray ] ;
+ '[ _ spread _ narray ] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-MACRO: 1if ( test then else -- ) '[ dup @ , , if ] ;
+MACRO: 1if ( test then else -- ) '[ dup @ _ _ if ] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Doug Coleman, Eduardo Cavazos,
! Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel combinators fry namespaces quotations hashtables
+USING: kernel combinators fry namespaces make quotations hashtables
sequences assocs arrays stack-checker effects math math.ranges
generalizations macros continuations random locals accessors ;
MACRO: preserving ( predicate -- quot )
dup infer in>>
dup 1+
- '[ , , nkeep , nrot ] ;
+ '[ _ _ nkeep _ nrot ] ;
MACRO: ifte ( quot quot quot -- )
- '[ , preserving , , if ] ;
+ '[ _ preserving _ _ if ] ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! switch
! Copyright (C) 2005 Chris Double, 2007 Clemens Hofreither.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel hashtables namespaces continuations quotations
+USING: kernel hashtables namespaces make continuations quotations
accessors ;
IN: coroutines
USING: arrays kernel sequences io io.files io.backend
io.encodings.ascii math.parser vocabs definitions
-namespaces words sorting ;
+namespaces make words sorting ;
IN: ctags
: ctag-word ( ctag -- word )
! Emacs Etags generator
! Alfredo Beaumont <alfredo.beaumont@gmail.com>
USING: kernel sequences sorting assocs words prettyprint ctags
-io.encodings.ascii io.files math math.parser namespaces strings locals
-shuffle io.backend arrays ;
+io.encodings.ascii io.files math math.parser namespaces make
+strings shuffle io.backend arrays ;
IN: ctags.etags
: etag-at ( key hash -- vector )
: demo-vocabs ( -- seq ) "demos" tagged [ second ] map concat [ name>> ] map ;
: <run-vocab-button> ( vocab-name -- button )
- dup '[ drop [ , run ] call-listener ] <bevel-button> { 0 0 } >>align ;
+ dup '[ drop [ _ run ] call-listener ] <bevel-button> { 0 0 } >>align ;
: <demo-runner> ( -- gadget )
<pile> 1 >>fill demo-vocabs [ <run-vocab-button> add-gadget ] each ;
USING: kernel namespaces sequences math
- listener io prettyprint sequences.lib fry ;
+ listener io prettyprint sequences.lib bake bake.fry ;
IN: display-stack
USING: kernel combinators sequences sets math threads namespaces continuations
debugger io io.sockets unicode.case accessors destructors
combinators.cleave combinators.lib combinators.short-circuit
- newfx fry
+ newfx bake bake.fry
dns dns.util dns.misc ;
IN: dns.server
-USING: kernel sequences sorting math math.order macros fry ;
+USING: kernel sequences sorting math math.order macros bake bake.fry ;
IN: dns.util
! See http://factorcode.org/license.txt for BSD license.
USING: xml kernel sequences xml.utilities combinators.lib
math xml.data arrays assocs xml.generator xml.writer namespaces
-math.parser io accessors ;
+make math.parser io accessors ;
IN: faq
: find-after ( seq quot -- elem after )
! Copyright (C) 2006 Chris Double. All Rights Reserved.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel peg strings sequences math
-math.parser namespaces words quotations arrays hashtables io
+USING: accessors kernel peg strings sequences math math.parser
+namespaces make words quotations arrays hashtables io
io.streams.string assocs ascii peg.parsers accessors ;
IN: fjsc
: with-ftp-client ( ftp-client quot -- )
dupd '[
- , [ ftp-login ] [ @ ] bi
+ _ [ ftp-login ] [ @ ] bi
ftp-quit drop
] >r ftp-connect r> with-stream ; inline
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.short-circuit accessors combinators io io.encodings.8-bit
-io.encodings io.encodings.binary io.encodings.utf8 io.files
-io.sockets kernel math.parser namespaces sequences
-ftp io.unix.launcher.parser unicode.case splitting assocs
-classes io.servers.connection destructors calendar io.timeouts
-io.streams.duplex threads continuations math
-concurrency.promises byte-arrays ;
+USING: combinators.short-circuit accessors combinators io
+io.encodings.8-bit io.encodings io.encodings.binary
+io.encodings.utf8 io.files io.sockets kernel math.parser
+namespaces make sequences ftp io.unix.launcher.parser
+unicode.case splitting assocs classes io.servers.connection
+destructors calendar io.timeouts io.streams.duplex threads
+continuations math concurrency.promises byte-arrays ;
IN: ftp.server
SYMBOL: client
vertices length ;
M: graph num-edges
- [ vertices ] [ '[ , adjlist length ] map sum ] bi ;
+ [ vertices ] [ '[ _ adjlist length ] map sum ] bi ;
M: graph adjlist
- [ vertices ] [ swapd '[ , swap , adj? ] filter ] bi ;
+ [ vertices ] [ swapd '[ _ swap _ adj? ] filter ] bi ;
M: graph adj?
swapd adjlist index >boolean ;
[ delete-edge* ] [ swapd delete-edge* ] 3bi ;
: add-blank-vertices ( seq graph -- )
- '[ , add-blank-vertex ] each ;
+ '[ _ add-blank-vertex ] each ;
: delete-vertex ( index graph -- )
[ adjlist ]
- [ '[ , , 3dup adj? [ delete-edge* ] [ 3drop ] if ] each ]
+ [ '[ _ _ 3dup adj? [ delete-edge* ] [ 3drop ] if ] each ]
[ delete-blank-vertex ] 2tri ;
<PRIVATE
{ [ 2drop visited? get t -rot set-at ]
[ drop call ]
[ [ graph get adjlist ] 2dip
- '[ dup visited? get at [ drop ] [ , , (depth-first) ] if ] each ]
+ '[ dup visited? get at [ drop ] [ _ _ (depth-first) ] if ] each ]
[ nip call ] } 3cleave ; inline
PRIVATE>
: depth-first ( v graph pre post -- ?list ? )
- '[ , , (depth-first) visited? get ] swap search-wrap ; inline
+ '[ _ _ (depth-first) visited? get ] swap search-wrap ; inline
: full-depth-first ( graph pre post tail -- ? )
'[ [ visited? get [ nip not ] assoc-find ]
- [ drop , , (depth-first) @ ]
+ [ drop _ _ (depth-first) @ ]
[ 2drop ] while ] swap search-wrap ; inline
: dag? ( graph -- ? )
V{ } clone swap [ 2dup swap push dupd
- '[ , swap graph get adj? not ] all?
+ '[ _ swap graph get adj? not ] all?
[ end-search ] unless ]
[ drop dup pop* ] [ ] full-depth-first nip ;
: >sparse-graph ( graph -- sparse-graph )
[ vertices ] keep
- '[ dup , adjlist 2array ] map >hashtable sparse-graph boa ;
+ '[ dup _ adjlist 2array ] map >hashtable sparse-graph boa ;
INSTANCE: sparse-graph graph
USING: assocs html.parser kernel math sequences strings ascii
-arrays generalizations shuffle unicode.case namespaces splitting
-http sequences.lib accessors io combinators http.client urls ;
+arrays generalizations shuffle unicode.case namespaces make
+splitting http sequences.lib accessors io combinators
+http.client urls ;
IN: html.parser.analyzer
TUPLE: link attributes clickable ;
USING: accessors arrays html.parser.utils hashtables io kernel
-namespaces prettyprint quotations
-sequences splitting state-parser strings unicode.categories unicode.case
+namespaces make prettyprint quotations sequences splitting
+state-parser strings unicode.categories unicode.case
sequences.lib ;
IN: html.parser
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel words summary slots quotations
sequences assocs math arrays stack-checker effects generalizations
-continuations debugger classes.tuple namespaces vectors
+continuations debugger classes.tuple namespaces make vectors
bit-arrays byte-arrays strings sbufs math.functions macros
sequences.private combinators mirrors
combinators.short-circuit ;
: set+run-listener ( name irc-listener -- )
over irc> listeners>> set-at
- '[ , listener-loop ] "listener" spawn-irc-loop ;
+ '[ _ listener-loop ] "listener" spawn-irc-loop ;
GENERIC: (add-listener) ( irc-listener -- )
[ [ name>> ] [ password>> ] bi /JOIN ]
[ [ [ drop irc> join-messages>> ]
[ timeout>> ]
- [ name>> '[ trailing>> , = ] ]
+ [ name>> '[ trailing>> _ = ] ]
tri mailbox-get-timeout? trailing>> ] keep set+run-listener
] bi ;
spawn-irc ] with-irc-client ;
: add-listener ( irc-listener irc-client -- )
- swap '[ , (add-listener) ] with-irc-client ;
+ swap '[ _ (add-listener) ] with-irc-client ;
: remove-listener ( irc-listener irc-client -- )
- swap '[ , (remove-listener) ] with-irc-client ;
+ swap '[ _ (remove-listener) ] with-irc-client ;
: write-message ( message irc-listener -- ) out-messages>> mailbox-put ;
: read-message ( irc-listener -- message ) in-messages>> mailbox-get ;
! ======================================
: split-at-first ( seq separators -- before after )
- dupd '[ , member? ] find
+ dupd '[ _ member? ] find
[ cut 1 tail ]
[ swap ]
if ;
} case
[ [ tuple-slots ] [ parameters>> ] bi append ] dip
[ all-slots over [ length ] bi@ min head >quotation ] keep
- '[ @ , boa ] call ;
+ '[ @ _ boa ] call ;
GENERIC: handle-inbox ( tab message -- )\r
\r
: value-labels ( assoc val -- seq )\r
- '[ nip , = ] assoc-filter keys sort-strings [ <label> ] map ;\r
+ '[ nip _ = ] assoc-filter keys sort-strings [ <label> ] map ;\r
\r
: add-gadget-color ( pack seq color -- pack )\r
- '[ , >>color add-gadget ] each ;\r
+ '[ _ >>color add-gadget ] each ;\r
\r
M: object handle-inbox\r
nip print-irc ;\r
\r
: display ( stream tab -- )\r
- '[ , [ [ t ]\r
- [ , dup listener>> read-message handle-inbox ]\r
+ '[ _ [ [ t ]\r
+ [ _ dup listener>> read-message handle-inbox ]\r
[ ] while ] with-output-stream ] "ircv" spawn drop ;\r
\r
: <irc-pane> ( tab -- tab pane )\r
[ [ irc-tab? ] find-parent ]\r
[ editor-string ]\r
[ "" swap set-editor-string ] } cleave\r
- '[ , irc-tab set , parse-message ] with-output-stream ;\r
+ '[ _ irc-tab set _ parse-message ] with-output-stream ;\r
\r
irc-editor "general" f {\r
{ T{ key-down f f "RET" } editor-send }\r
[ (update-axes) ] [ kill-update-axes ] if* ;
M: joystick-demo-gadget graft*
- dup '[ , update-axes ] FREQUENCY every >>alarm
+ dup '[ _ update-axes ] FREQUENCY every >>alarm
drop ;
M: joystick-demo-gadget ungraft*
relayout-1 ;
M: key-caps-gadget graft*
- dup '[ , update-key-caps-state ] FREQUENCY every >>alarm
+ dup '[ _ update-key-caps-state ] FREQUENCY every >>alarm
drop ;
M: key-caps-gadget ungraft*
: convert-cond ( cons -- quot )
cdr [ 2car [ convert-form ] bi@ 2array ]
- { } lmap-as '[ , cond ] ;
+ { } lmap-as '[ _ cond ] ;
: convert-general-form ( cons -- quot )
- uncons [ convert-body ] [ convert-form ] bi* '[ , @ funcall ] ;
+ uncons [ convert-body ] [ convert-form ] bi* '[ _ @ funcall ] ;
! words for convert-lambda
<PRIVATE
: localize-body ( assoc body -- newbody )
{
- { [ dup list? ] [ [ lisp-symbol? ] rot '[ [ name>> , at ] [ ] bi or ] traverse ] }
+ { [ dup list? ] [ [ lisp-symbol? ] rot '[ [ name>> _ at ] [ ] bi or ] traverse ] }
{ [ dup lisp-symbol? ] [ name>> swap at ] }
[ nip ]
} cond ;
: rest-lambda ( body vars -- quot )
"&rest" swap [ remove ] [ index ] 2bi
[ localize-lambda <lambda> lambda-rewrite call ] dip
- swap '[ , cut '[ @ , seq>list ] call , call call ] 1quotation ;
+ swap '[ _ cut '[ @ _ seq>list ] call _ call call ] 1quotation ;
: normal-lambda ( body vars -- quot )
localize-lambda <lambda> lambda-rewrite '[ @ compose call call ] 1quotation ;
: convert-begin ( cons -- quot )
cdr [ convert-form ] [ ] lmap-as [ 1 tail* ] [ but-last ] bi
- [ '[ { } , with-datastack drop ] ] map prepend '[ , [ call ] each ] ;
+ [ '[ { } _ with-datastack drop ] ] map prepend '[ _ [ call ] each ] ;
: form-dispatch ( cons lisp-symbol -- quot )
name>>
{
{ [ dup cons? ] [ convert-list-form ] }
{ [ dup lisp-var? ] [ lookup-var 1quotation ] }
- { [ dup lisp-symbol? ] [ '[ , lookup-var ] ] }
+ { [ dup lisp-symbol? ] [ '[ _ lookup-var ] ] }
[ 1quotation ]
} cond ;
[ 1array [ call ] with-datastack >quotation ] dip curry call ; inline
: define-primitive ( name vocab word -- )
- swap lookup 1quotation '[ , compose call ] swap lisp-define ;
+ swap lookup 1quotation '[ _ compose call ] swap lisp-define ;
: lookup-macro ( lisp-symbol -- lambda )
name>> macro-env get at ;
! Updated by Chris Double, September 2006
! Updated by James Cash, June 2008
!
-USING: kernel sequences math vectors arrays namespaces
+USING: kernel sequences math vectors arrays namespaces make
quotations promises combinators io lists accessors ;
IN: lists.lazy
1 ;
MACRO: (do-copy) ( copy make-vector -- )
- '[ over 6 npick , 2dip 1 @ ] ;
+ '[ over 6 npick _ 2dip 1 @ ] ;
: (prepare-swap) ( v1 v2 -- length v1-data v1-inc v2-data v2-inc v1 v2 )
[
MACRO: (complex-nth) ( nth-quot -- )
'[
[ 2 * dup 1+ ] dip
- , curry bi@ rect>
+ _ curry bi@ rect>
] ;
: (c-complex-nth) ( n alien -- complex )
[ 2 * dup 1+ ] bi*
swapd
] dip
- , curry 2bi@
+ _ curry 2bi@
] ;
: (set-c-complex-nth) ( complex n alien -- )
! Copyright (c) 2007, 2008 Slava Pestov, Doug Coleman, Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs kernel math math.order math.ranges mirrors
-namespaces sequences sequences.lib sorting ;
+namespaces make sequences sequences.lib sorting ;
IN: math.combinatorics
<PRIVATE
-USING: arrays kernel sequences namespaces math math.ranges
+USING: arrays kernel sequences namespaces make math math.ranges
math.vectors vectors ;
IN: math.numerical-integration
-USING: arrays kernel sequences vectors math math.vectors namespaces
-shuffle splitting sequences.lib math.order ;
+USING: arrays kernel sequences vectors math math.vectors
+namespaces make shuffle splitting sequences.lib math.order ;
IN: math.polynomials
! Polynomials are vectors with the highest powers on the right:
! Copyright (C) 2007 Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel lists math math.primes namespaces sequences ;
+USING: arrays kernel lists math math.primes namespaces make
+sequences ;
IN: math.primes.factors
<PRIVATE
M: monad fail monad-of fail ;
: bind ( mvalue quot -- mvalue' ) swap >>= call ;
-: >> ( mvalue k -- mvalue' ) '[ drop , ] bind ;
+: >> ( mvalue k -- mvalue' ) '[ drop _ ] bind ;
:: lift-m2 ( m1 m2 f monad -- m3 )
m1 [| x1 | m2 [| x2 | x1 x2 f monad return ] bind ] bind ;
] bind
] bind ;
-M: monad fmap over '[ @ , return ] bind ;
+M: monad fmap over '[ @ _ return ] bind ;
! 'do' notation
: do ( quots -- result ) unclip dip [ bind ] each ;
M: identity-monad return drop identity boa ;
M: identity-monad fail "Fail" throw ;
-M: identity >>= value>> '[ , swap call ] ;
+M: identity >>= value>> '[ _ swap call ] ;
: run-identity ( identity -- value ) value>> ;
M: maybe-monad return drop just ;
M: maybe-monad fail 2drop nothing ;
-M: nothing >>= '[ drop , ] ;
-M: just >>= value>> '[ , swap call ] ;
+M: nothing >>= '[ drop _ ] ;
+M: just >>= value>> '[ _ swap call ] ;
: if-maybe ( maybe just-quot nothing-quot -- )
pick nothing? [ 2nip call ] [ drop [ value>> ] dip call ] if ; inline
M: either-monad return drop right ;
M: either-monad fail drop left ;
-M: left >>= '[ drop , ] ;
-M: right >>= value>> '[ , swap call ] ;
+M: left >>= '[ drop _ ] ;
+M: right >>= value>> '[ _ swap call ] ;
: if-either ( value left-quot right-quot -- )
[ [ value>> ] [ left? ] bi ] 2dip if ; inline
M: array monad-of drop array-monad ;
-M: array >>= '[ , swap map concat ] ;
+M: array >>= '[ _ swap map concat ] ;
! List
SINGLETON: list-monad
M: list monad-of drop list-monad ;
-M: list >>= '[ , swap lazy-map lconcat ] ;
+M: list >>= '[ _ swap lazy-map lconcat ] ;
! State
SINGLETON: state-monad
M: state monad-of drop state-monad ;
-M: state-monad return drop '[ , 2array ] state ;
+M: state-monad return drop '[ _ 2array ] state ;
M: state-monad fail "Fail" throw ;
: mcall ( state -- ) quot>> call ;
-M: state >>= '[ , swap '[ , mcall first2 @ mcall ] state ] ;
+M: state >>= '[ _ swap '[ _ mcall first2 @ mcall ] state ] ;
: get-st ( -- state ) [ dup 2array ] state ;
-: put-st ( value -- state ) '[ drop , f 2array ] state ;
+: put-st ( value -- state ) '[ drop _ f 2array ] state ;
: run-st ( state initial -- ) swap mcall second ;
M: reader monad-of drop reader-monad ;
-M: reader-monad return drop '[ drop , ] reader ;
+M: reader-monad return drop '[ drop _ ] reader ;
M: reader-monad fail "Fail" throw ;
-M: reader >>= '[ , swap '[ dup , mcall @ mcall ] reader ] ;
+M: reader >>= '[ _ swap '[ dup _ mcall @ mcall ] reader ] ;
: run-reader ( reader env -- ) swap mcall ;
: ask ( -- reader ) [ ] reader ;
-: local ( reader quot -- reader' ) swap '[ @ , mcall ] reader ;
+: local ( reader quot -- reader' ) swap '[ @ _ mcall ] reader ;
! Writer
SINGLETON: writer-monad
: run-writer ( writer -- value log ) [ value>> ] [ log>> ] bi ;
-M: writer >>= '[ [ , run-writer ] dip '[ @ run-writer ] dip append writer ] ;
+M: writer >>= '[ [ _ run-writer ] dip '[ @ run-writer ] dip append writer ] ;
: pass ( writer -- writer' ) run-writer [ first2 ] dip swap call writer ;
: listen ( writer -- writer' ) run-writer [ 2array ] keep writer ;
USING: io kernel math math.functions math.parser parser lexer
-namespaces sequences splitting grouping combinators
+namespaces make sequences splitting grouping combinators
continuations sequences.lib ;
IN: money
! Copyright (C) 2007, 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs combinators hashtables kernel lists math namespaces openal parser-combinators promises sequences strings symbols synth synth.buffers unicode.case ;
+USING: accessors assocs combinators hashtables kernel lists math
+namespaces make openal parser-combinators promises sequences
+strings symbols synth synth.buffers unicode.case ;
IN: morse
<PRIVATE
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math sequences vectors classes classes.algebra
-combinators arrays words assocs parser namespaces definitions
-prettyprint prettyprint.backend quotations generalizations
-debugger io compiler.units kernel.private effects accessors
-hashtables sorting shuffle math.order sets ;
+combinators arrays words assocs parser namespaces make
+definitions prettyprint prettyprint.backend quotations
+generalizations debugger io compiler.units kernel.private
+effects accessors hashtables sorting shuffle math.order sets ;
IN: multi-methods
! PART I: Converting hook specializers
! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel alien alien.strings alien.syntax
-combinators alien.c-types strings sequences namespaces words
-math threads io.encodings.ascii ;
+combinators alien.c-types strings sequences namespaces make
+words math threads io.encodings.ascii ;
IN: odbc
<< "odbc" "odbc32.dll" "stdcall" add-library >>
! Copyright (C) 2008 Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel namespaces sequences splitting opengl.gl
+USING: kernel namespaces make sequences splitting opengl.gl
continuations math.parser math arrays sets math.order ;
IN: opengl.capabilities
-USING: kernel namespaces accessors
+USING: kernel namespaces make accessors
math math.constants math.functions math.matrices math.vectors
sequences splitting grouping self math.trig ;
USING: alien alien.c-types arrays assocs byte-arrays io
io.binary io.streams.string kernel math math.parser namespaces
-parser prettyprint quotations sequences strings vectors words
-macros math.functions math.bitwise ;
+make parser prettyprint quotations sequences strings vectors
+words macros math.functions math.bitwise ;
IN: pack
SYMBOL: big-endian
combinators
combinators.lib
combinators.cleave
- rewrite-closures fry accessors newfx
+ rewrite-closures bake bake.fry accessors newfx
processing.gadget math.geometry.rect
processing.shapes
colors ;
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.functions namespaces sequences sorting ;
+USING: kernel math math.functions namespaces make sequences sorting ;
IN: project-euler.009
! http://projecteuler.net/index.php?section=problems&id=9
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel namespaces project-euler.common sequences
+USING: kernel namespaces make project-euler.common sequences
splitting grouping ;
IN: project-euler.011
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays combinators.lib combinators.short-circuit kernel math math.ranges
- namespaces sequences sorting ;
+USING: arrays combinators.lib combinators.short-circuit kernel
+math math.ranges namespaces make sequences sorting ;
IN: project-euler.014
! http://projecteuler.net/index.php?section=problems&id=14
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: ascii io.files kernel math math.functions namespaces
+USING: ascii io.files kernel math math.functions namespaces make
project-euler.common sequences sequences.lib splitting io.encodings.ascii ;
IN: project-euler.042
! Copyright (c) 2008 Aaron Schaefer, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays ascii assocs hashtables io.encodings.ascii io.files kernel math
- math.parser namespaces sequences sequences.lib sequences.private sorting
+ math.parser namespaces make sequences sequences.lib sequences.private sorting
splitting grouping strings sets accessors ;
IN: project-euler.059
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: assocs hashtables io.files kernel math math.parser namespaces
-io.encodings.ascii sequences sets ;
+USING: assocs hashtables io.files kernel math math.parser
+namespaces make io.encodings.ascii sequences sets ;
IN: project-euler.079
! http://projecteuler.net/index.php?section=problems&id=79
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: continuations io kernel math math.functions math.parser math.statistics
- namespaces tools.time ;
+ namespaces make tools.time ;
IN: project-euler.ave-time
: collect-benchmarks ( quot n -- seq )
-USING: arrays kernel math math.functions math.miller-rabin math.matrices
- math.order math.parser math.primes.factors math.ranges namespaces
- sequences sequences.lib sorting unicode.case ;
+USING: arrays kernel math math.functions math.miller-rabin
+math.matrices math.order math.parser math.primes.factors
+math.ranges namespaces make sequences sequences.lib sorting
+unicode.case ;
IN: project-euler.common
! A collection of words used by more than one Project Euler solution
! Updated by Chris Double, September 2006
USING: arrays kernel sequences math vectors arrays namespaces
-quotations parser effects stack-checker words accessors ;
+make quotations parser effects stack-checker words accessors ;
IN: promises
TUPLE: promise quot forced? value ;
USING: kernel namespaces arrays quotations sequences assocs combinators
- mirrors math math.vectors random macros fry ;
+ mirrors math math.vectors random macros bake bake.fry ;
IN: random-weighted
namespaces parser lexer parser-combinators parser-combinators.simple
promises quotations sequences combinators.lib strings math.order
assocs prettyprint.backend memoize unicode.case unicode.categories
-combinators.short-circuit accessors ;
-USE: io
+combinators.short-circuit accessors make io ;
IN: regexp
<PRIVATE
-USING: kernel parser math quotations namespaces sequences macros fry ;
+USING: kernel parser math quotations namespaces sequences macros
+bake bake.fry ;
IN: rewrite-closures
! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays assocs kernel math math.order math.vectors namespaces
-quotations sequences sequences.lib sequences.private strings unicode.case ;
+USING: arrays assocs kernel math math.order math.vectors
+namespaces make quotations sequences sequences.lib
+sequences.private strings unicode.case ;
IN: roman
<PRIVATE
! Copyright (C) 2007 Slava Pestov, Chris Double, Doug Coleman,
! Eduardo Cavazos, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.lib kernel sequences math namespaces assocs
-random sequences.private shuffle math.functions
-arrays math.parser math.private sorting strings ascii macros
-assocs.lib quotations hashtables math.order locals
-generalizations ;
+USING: combinators.lib kernel sequences math namespaces make
+assocs random sequences.private shuffle math.functions arrays
+math.parser math.private sorting strings ascii macros assocs.lib
+quotations hashtables math.order locals generalizations ;
IN: sequences.lib
: each-withn ( seq quot n -- ) nwith each ; inline
-USING: kernel parser lexer strings math namespaces
+USING: kernel parser lexer strings math namespaces make
sequences words io arrays quotations debugger accessors
sequences.private ;
IN: state-machine
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel namespaces sequences vectors assocs accessors ;
+USING: kernel namespaces make sequences vectors assocs accessors ;
IN: state-tables
TUPLE: table rows columns start-state final-states ;
! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel namespaces openal sequences synth synth.buffers ;
+USING: accessors arrays kernel namespaces make openal sequences
+synth synth.buffers ;
IN: synth.example
: play-sine-wave ( freq seconds sample-freq -- )
\r
:: add-toggle ( model n name toggler -- )\r
<frame>\r
- n name toggler parent>> '[ , , , (del-page) ] "X" swap <bevel-button>\r
+ n name toggler parent>> '[ _ _ _ (del-page) ] "X" swap <bevel-button>\r
@right grid-add\r
n model name <toggle-button> @center grid-add\r
toggler swap add-gadget drop ;\r
[ names>> ] [ model>> ] [ toggler>> ] tri\r
[ clear-gadget ] keep\r
[ [ length ] keep ] 2dip\r
- '[ [ , ] 2dip , add-toggle ] 2each ;\r
+ '[ [ _ ] 2dip _ add-toggle ] 2each ;\r
\r
: refresh-book ( tabbed -- )\r
model>> [ ] change-model ;\r
USING: kernel sequences math math.order
ui.gadgets ui.gadgets.tracks ui.gestures
- fry accessors ;
+ bake.fry accessors ;
IN: ui.gadgets.tiling
: exchanged! ( seq a b -- )
[ 0 max ] bi@
- pick length 1 - '[ , min ] bi@
+ pick length 1 - '[ _ min ] bi@
rot exchange ;
: move-prev ( tiling -- tiling )
: <counter-action> ( quot -- action )
<action>
swap '[
- count , schange
+ count _ schange
URL" $counter-app" <redirect>
] >>submit ;
: fetch-blogroll ( blogroll -- entries )
[ [ feed-url>> fetch-feed ] parallel-map ] [ [ name>> ] map ] bi
- [ '[
, <posting> ] map ] 2map concat ;
+ [ '[
_ <posting> ] map ] 2map concat ;
: sort-entries ( entries -- entries' )
[ [ date>> ] compare invert-comparison ] sort ;
{ planet "planet-common" } >>template ;
: start-update-task ( db params -- )
- '[ , , [ update-cached-postings ] with-db ] 10 minutes every drop ;
+ '[ _ _ [ update-cached-postings ] with-db ] 10 minutes every drop ;
1 6 [a,b] random [ letter-bank random ] "" replicate-as ;
: insert-short-url ( short-url -- short-url )
- '[ , dup random-url >>short insert-tuple ] 10 retry ;
+ '[ _ dup random-url >>short insert-tuple ] 10 retry ;
: shorten ( url -- short )
short-url new swap >>url dup select-tuple
! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel hashtables calendar random assocs
-namespaces splitting sequences sorting math.order present
+namespaces make splitting sequences sorting math.order present
io.files io.encodings.ascii
syndication farkup
html.components html.forms
-USING: kernel sequences namespaces math assocs words arrays tools.annotations vocabs sorting prettyprint io micros math.statistics accessors ;
+USING: kernel sequences namespaces make math assocs words arrays
+tools.annotations vocabs sorting prettyprint io micros
+math.statistics accessors ;
IN: wordtimer
SYMBOL: *wordtimes*
! Copyright (C) 2008 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
-USING: lexer parser splitting kernel quotations namespaces
+USING: lexer parser splitting kernel quotations namespaces make
sequences assocs sequences.lib xml.generator xml.utilities
xml.data ;
IN: xml.syntax
projects / factor.git / commitdiff