diff --git a/basis/db/db.factor b/basis/db/db.factor index 4e3fe49947..eac22a2999 100755 --- a/basis/db/db.factor +++ b/basis/db/db.factor @@ -116,19 +116,6 @@ M: object execute-statement* ( statement type -- ) : default-query ( query -- result-set ) query-results [ [ sql-row ] query-map ] with-disposal ; -SYMBOL: in-transaction -HOOK: begin-transaction db ( -- ) -HOOK: commit-transaction db ( -- ) -HOOK: rollback-transaction db ( -- ) - -: in-transaction? ( -- ? ) in-transaction get ; - -: with-transaction ( quot -- ) - t in-transaction [ - begin-transaction - [ ] [ rollback-transaction ] cleanup commit-transaction - ] with-variable ; - : sql-query ( sql -- rows ) f f [ default-query ] with-disposal ; @@ -140,3 +127,20 @@ HOOK: rollback-transaction db ( -- ) [ sql-command ] each ! ] with-transaction ] if ; + +SYMBOL: in-transaction +HOOK: begin-transaction db ( -- ) +HOOK: commit-transaction db ( -- ) +HOOK: rollback-transaction db ( -- ) + +M: db begin-transaction ( -- ) "BEGIN" sql-command ; +M: db commit-transaction ( -- ) "COMMIT" sql-command ; +M: db rollback-transaction ( -- ) "ROLLBACK" sql-command ; + +: in-transaction? ( -- ? ) in-transaction get ; + +: with-transaction ( quot -- ) + t in-transaction [ + begin-transaction + [ ] [ rollback-transaction ] cleanup commit-transaction + ] with-variable ; diff --git a/basis/db/postgresql/postgresql.factor b/basis/db/postgresql/postgresql.factor index 8e0dd6ef6b..ae31b168cb 100755 --- a/basis/db/postgresql/postgresql.factor +++ b/basis/db/postgresql/postgresql.factor @@ -40,15 +40,15 @@ M: postgresql-db dispose ( db -- ) M: postgresql-statement bind-statement* ( statement -- ) drop ; -GENERIC: postgresql-bind-conversion ( tuple obj -- low-level-binding ) +GENERIC: postgresql-bind-conversion ( tuple object -- low-level-binding ) -M: sql-spec postgresql-bind-conversion ( tuple spec -- obj ) +M: sql-spec postgresql-bind-conversion ( tuple spec -- object ) slot-name>> swap get-slot-named ; -M: literal-bind postgresql-bind-conversion ( tuple literal-bind -- obj ) +M: literal-bind postgresql-bind-conversion ( tuple literal-bind -- object ) nip value>> ; -M: generator-bind postgresql-bind-conversion ( tuple generate-bind -- obj ) +M: generator-bind postgresql-bind-conversion ( tuple generate-bind -- object ) dup generator-singleton>> eval-generator [ swap slot-name>> rot set-slot-named ] [ ] bi ; @@ -66,10 +66,10 @@ M: postgresql-result-set #columns ( result-set -- n ) : result-handle-n ( result-set -- handle n ) [ handle>> ] [ n>> ] bi ; -M: postgresql-result-set row-column ( result-set column -- obj ) +M: postgresql-result-set row-column ( result-set column -- object ) >r result-handle-n r> pq-get-string ; -M: postgresql-result-set row-column-typed ( result-set column -- obj ) +M: postgresql-result-set row-column-typed ( result-set column -- object ) dup pick out-params>> nth type>> >r >r result-handle-n r> r> postgresql-column-typed ; @@ -121,7 +121,7 @@ M: postgresql-db ( sql in out -- statement ) M: postgresql-db bind% ( spec -- ) bind-name% 1, ; -M: postgresql-db bind# ( spec obj -- ) +M: postgresql-db bind# ( spec object -- ) >r bind-name% f swap type>> r> 1, ; : create-table-sql ( class -- statement ) @@ -251,7 +251,8 @@ M: postgresql-db persistent-table ( -- hashtable ) { random-generator { f f f } } } ; -M: postgresql-db compound ( str obj -- str' ) +ERROR: no-compound-found string object ; +M: postgresql-db compound ( string object -- string' ) over { { "default" [ first number>string join-space ] } { "varchar" [ first number>string paren append ] } @@ -260,5 +261,5 @@ M: postgresql-db compound ( str obj -- str' ) swap [ slot-name>> = ] with find nip column-name>> paren append ] } - [ "no compound found" 3array throw ] + [ drop no-compound-found ] } case ; diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor index 023ef3d9a8..ede7612942 100644 --- a/basis/db/queries/queries.factor +++ b/basis/db/queries/queries.factor @@ -50,10 +50,6 @@ M: retryable execute-statement* ( statement type -- ) [ 0 sql-counter rot with-variable ] curry { "" { } { } } nmake maybe-make-retryable ; inline -M: db begin-transaction ( -- ) "BEGIN" sql-command ; -M: db commit-transaction ( -- ) "COMMIT" sql-command ; -M: db rollback-transaction ( -- ) "ROLLBACK" sql-command ; - : where-primary-key% ( specs -- ) " where " 0% find-primary-key dup column-name>> 0% " = " 0% bind% ; @@ -70,7 +66,7 @@ M: db ( class -- statement ) M: random-id-generator eval-generator ( singleton -- obj ) drop system-random-generator get [ - 63 [ 2^ random ] keep 1 - set-bit + 63 [ random-bits ] keep 1- set-bit ] with-random ; : interval-comparison ( ? str -- str ) @@ -154,22 +150,22 @@ M: db ( tuple class -- statement ) : do-group ( tuple groups -- ) [ - ", " join " group by " prepend append + ", " join " group by " swap 3append ] curry change-sql drop ; : do-order ( tuple order -- ) [ - ", " join " order by " prepend append + ", " join " order by " swap 3append ] curry change-sql drop ; : do-offset ( tuple n -- ) [ - number>string " offset " prepend append + number>string " offset " swap 3append ] curry change-sql drop ; : do-limit ( tuple n -- ) [ - number>string " limit " prepend append + number>string " limit " swap 3append ] curry change-sql drop ; : make-query ( tuple query -- tuple' ) diff --git a/basis/db/sql/sql.factor b/basis/db/sql/sql.factor index 2496ac6f3a..ba0673ae24 100755 --- a/basis/db/sql/sql.factor +++ b/basis/db/sql/sql.factor @@ -30,8 +30,6 @@ DEFER: sql% [ third 1, \ ? 0, ] tri ] each ; -USE: multiline -/* HOOK: sql-create db ( object -- ) M: db sql-create ( object -- ) drop @@ -97,35 +95,35 @@ M: db sql-limit ( object -- ) ! M: db sql-subselectselect ( object -- ) ! "(select" sql% sql% ")" sql% ; -GENERIC: sql-table db ( object -- ) +HOOK: sql-table db ( object -- ) M: db sql-table ( object -- ) sql% ; -GENERIC: sql-set db ( object -- ) +HOOK: sql-set db ( object -- ) M: db sql-set ( object -- ) "set" "," sql-interleave ; -GENERIC: sql-values db ( object -- ) +HOOK: sql-values db ( object -- ) M: db sql-values ( object -- ) "values(" sql% "," (sql-interleave) ")" sql% ; -GENERIC: sql-count db ( object -- ) +HOOK: sql-count db ( object -- ) M: db sql-count ( object -- ) "count" sql-function, ; -GENERIC: sql-sum db ( object -- ) +HOOK: sql-sum db ( object -- ) M: db sql-sum ( object -- ) "sum" sql-function, ; -GENERIC: sql-avg db ( object -- ) +HOOK: sql-avg db ( object -- ) M: db sql-avg ( object -- ) "avg" sql-function, ; -GENERIC: sql-min db ( object -- ) +HOOK: sql-min db ( object -- ) M: db sql-min ( object -- ) "min" sql-function, ; -GENERIC: sql-max db ( object -- ) +HOOK: sql-max db ( object -- ) M: db sql-max ( object -- ) "max" sql-function, ; @@ -156,9 +154,7 @@ M: db sql-max ( object -- ) { \ max [ sql-max ] } [ sql% [ sql% ] each ] } case ; -*/ -: sql-array% ( array -- ) drop ; ERROR: no-sql-match ; : sql% ( obj -- ) { diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor index 94fa1a66e8..3c3bae3adc 100755 --- a/basis/db/tuples/tuples.factor +++ b/basis/db/tuples/tuples.factor @@ -15,13 +15,13 @@ IN: db.tuples ERROR: not-persistent class ; -: db-table ( class -- obj ) +: db-table ( class -- object ) dup "db-table" word-prop [ ] [ not-persistent ] ?if ; -: db-columns ( class -- obj ) +: db-columns ( class -- object ) superclasses [ "db-columns" word-prop ] map concat ; -: db-relations ( class -- obj ) +: db-relations ( class -- object ) "db-relations" word-prop ; : set-primary-key ( key tuple -- ) @@ -34,13 +34,13 @@ SYMBOL: sql-counter sql-counter [ inc ] [ get ] bi number>string ; ! returns a sequence of prepared-statements -HOOK: create-sql-statement db ( class -- obj ) -HOOK: drop-sql-statement db ( class -- obj ) +HOOK: create-sql-statement db ( class -- object ) +HOOK: drop-sql-statement db ( class -- object ) -HOOK: db ( class -- obj ) -HOOK: db ( class -- obj ) -HOOK: db ( class -- obj ) -HOOK: db ( tuple class -- obj ) +HOOK: db ( class -- object ) +HOOK: db ( class -- object ) +HOOK: db ( class -- object ) +HOOK: db ( tuple class -- object ) HOOK: db ( tuple class -- tuple ) TUPLE: query group order offset limit ; HOOK: db ( tuple class query -- statement' ) @@ -48,7 +48,7 @@ HOOK: db ( tuple class groups -- n ) HOOK: insert-tuple* db ( tuple statement -- ) -GENERIC: eval-generator ( singleton -- obj ) +GENERIC: eval-generator ( singleton -- object ) : resulting-tuple ( exemplar-tuple row out-params -- tuple ) rot class new [ @@ -68,7 +68,7 @@ GENERIC: eval-generator ( singleton -- obj ) [ slot-name>> ] dip set-slot-named ] curry 2each ; -: with-disposals ( seq quot -- ) +: with-disposals ( object quotation -- ) over sequence? [ [ with-disposal ] curry each ] [ diff --git a/basis/db/types/types-docs.factor b/basis/db/types/types-docs.factor index d60878555a..9300a68f2e 100644 --- a/basis/db/types/types-docs.factor +++ b/basis/db/types/types-docs.factor @@ -133,24 +133,12 @@ HELP: db-assigned-id-spec? { "?" "a boolean" } } { $description "" } ; -HELP: double-quote -{ $values - { "string" string } - { "new-string" null } } -{ $description "" } ; - HELP: find-primary-key { $values { "specs" null } { "obj" object } } { $description "" } ; -HELP: find-random-generator -{ $values - { "seq" sequence } - { "obj" object } } -{ $description "" } ; - HELP: generator-bind { $description "" } ; @@ -266,12 +254,6 @@ HELP: set-slot-named { "value" null } { "name" null } { "obj" object } } { $description "" } ; -HELP: single-quote -{ $values - { "string" string } - { "new-string" null } } -{ $description "" } ; - HELP: spec>tuple { $values { "class" class } { "spec" null } @@ -281,18 +263,6 @@ HELP: spec>tuple HELP: sql-spec { $description "" } ; -HELP: tuple>filled-slots -{ $values - { "tuple" null } - { "alist" "an array of key/value pairs" } } -{ $description "" } ; - -HELP: tuple>params -{ $values - { "specs" null } { "tuple" null } - { "obj" object } } -{ $description "" } ; - HELP: unknown-modifier { $description "" } ; diff --git a/basis/random/random-tests.factor b/basis/random/random-tests.factor index 0fc4bb039e..89c0c02c4a 100644 --- a/basis/random/random-tests.factor +++ b/basis/random/random-tests.factor @@ -1,4 +1,5 @@ -USING: random sequences tools.test kernel math math.functions ; +USING: random sequences tools.test kernel math math.functions +sets ; IN: random.tests [ 4 ] [ 4 random-bytes length ] unit-test @@ -12,3 +13,5 @@ IN: random.tests [ t ] [ 10000 [ 0 [ drop 187 random + ] reduce ] keep / 2 * 187 10 ~ ] unit-test [ t ] [ 10000 [ 0 [ drop 400 random + ] reduce ] keep / 2 * 400 10 ~ ] unit-test + +[ t ] [ 1000 [ 400 random ] replicate prune length 256 > ] unit-test diff --git a/basis/random/random.factor b/basis/random/random.factor index c1dd146206..0a421288d5 100755 --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -36,10 +36,9 @@ M: f random-32* ( obj -- * ) no-random-number-generator ; : random ( seq -- elt ) [ f ] [ [ - length [ - log2 8 + 8 /i - random-bytes byte-array>bignum - ] keep mod + length dup log2 7 + 8 /i 1+ random-bytes + [ length 3 shift 2^ ] [ byte-array>bignum ] bi + swap / * >integer ] keep nth ] if-empty ; diff --git a/basis/smtp/smtp-docs.factor b/basis/smtp/smtp-docs.factor index e30b3fcc27..435b04504d 100644 --- a/basis/smtp/smtp-docs.factor +++ b/basis/smtp/smtp-docs.factor @@ -20,8 +20,7 @@ HELP: HELP: send-email { $values { "email" email } } -{ $description "Sends an " { $link email } " object to an STMP server stored in the " { $link smtp-server } " variable. The required slots are " { $snippet "from" } " and " { $snippet "to" } "." } - +{ $description "Sends an " { $link email } " object to an STMP server stored in the " { $link smtp-server } " variable. The required slots are " { $slot "from" } " and " { $slot "to" } "." } { $examples { $unchecked-example "USING: accessors smtp ;" "" @@ -37,9 +36,5 @@ HELP: send-email } ; ARTICLE: "smtp" "SMTP Client Library" -"Start by creating a new email object:" -{ $subsection } -"Set the " { $snippet "from" } " slot to a " { $link string } "." $nl -"Set the recipient fields, " { $snippet "to" } ", " { $snippet "cc" } ", and " { $snippet "bcc" } ", to arrays of strings." -"Set the " { $snippet "subject" } " to a " { $link string } "." $nl -"Set the " { $snippet "body" } " to a " { $link string } "." $nl ; +"Sending an email:" +{ $subsection send-email } ; diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 16d16c3e77..5c0dbf7985 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -81,6 +81,7 @@ ARTICLE: "sequences-reshape" "Reshaping sequences" ARTICLE: "sequences-appending" "Appending sequences" { $subsection append } +{ $subsection prepend } { $subsection 3append } { $subsection concat } { $subsection join } @@ -100,6 +101,7 @@ ARTICLE: "sequences-slices" "Subsequences and slices" { $subsection but-last } "Taking a sequence apart into a head and a tail:" { $subsection unclip } +{ $subsection unclip-last } { $subsection cut } { $subsection cut* } "A " { $emphasis "slice" } " is a virtual sequence which presents as view of a subsequence of an underlying sequence:" @@ -124,6 +126,8 @@ ARTICLE: "sequences-combinators" "Sequence combinators" { $subsection each } { $subsection reduce } { $subsection interleave } +{ $subsection replicate } +{ $subsection replicate-as } "Mapping:" { $subsection map } { $subsection map-as } @@ -871,12 +875,43 @@ HELP: push-all HELP: append { $values { "seq1" sequence } { "seq2" sequence } { "newseq" sequence } } { $description "Outputs a new sequence of the same type as " { $snippet "seq1" } " consisting of the elements of " { $snippet "seq1" } " followed by " { $snippet "seq2" } "." } -{ $errors "Throws an error if " { $snippet "seq2" } " contains elements not permitted in sequences of the same class as " { $snippet "seq1" } "." } ; +{ $errors "Throws an error if " { $snippet "seq2" } " contains elements not permitted in sequences of the same class as " { $snippet "seq1" } "." } +{ $examples + { $example "USING: prettyprint sequences ;" + "{ 1 2 } B{ 3 4 } append ." + "{ 1 2 3 4 }" + } + { $example "USING: prettyprint sequences strings ;" + "\"go\" \"ing\" append ." + "\"going\"" + } +} ; + +HELP: prepend +{ $values { "seq1" sequence } { "seq2" sequence } { "newseq" sequence } } +{ $description "Outputs a new sequence of the same type as " { $snippet "seq2" } " consisting of the elements of " { $snippet "seq2" } " followed by " { $snippet "seq1" } "." } +{ $errors "Throws an error if " { $snippet "seq1" } " contains elements not permitted in sequences of the same class as " { $snippet "seq2" } "." } +{ $examples + { $example "USING: prettyprint sequences ;" + "{ 1 2 } B{ 3 4 } prepend ." + "B{ 3 4 1 2 }" + } + { $example "USING: prettyprint sequences strings ;" + "\"go\" \"car\" prepend ." + "\"cargo\"" + } +} ; HELP: 3append { $values { "seq1" sequence } { "seq2" sequence } { "seq3" sequence } { "newseq" sequence } } { $description "Outputs a new sequence consisting of the elements of " { $snippet "seq1" } ", " { $snippet "seq2" } " and " { $snippet "seq3" } " in turn." } -{ $errors "Throws an error if " { $snippet "seq2" } " or " { $snippet "seq3" } " contain elements not permitted in sequences of the same class as " { $snippet "seq1" } "." } ; +{ $errors "Throws an error if " { $snippet "seq2" } " or " { $snippet "seq3" } " contain elements not permitted in sequences of the same class as " { $snippet "seq1" } "." } +{ $examples + { $example "USING: prettyprint sequences ;" + "\"a\" \"b\" \"c\" 3append ." + "\"abc\"" + } +} ; HELP: subseq { $values { "from" "a non-negative integer" } { "to" "a non-negative integer" } { "seq" sequence } { "subseq" "a new sequence" } } @@ -1004,6 +1039,17 @@ HELP: unclip-slice { $values { "seq" sequence } { "rest" slice } { "first" object } } { $description "Outputs a tail sequence and the first element of " { $snippet "seq" } "; the tail sequence consists of all elements of " { $snippet "seq" } " but the first. Unlike " { $link unclip } ", this word does not make a copy of the input sequence, and runs in constant time." } ; +HELP: unclip-last +{ $values { "seq" sequence } { "butlast" sequence } { "last" object } } +{ $description "Outputs a head sequence and the last element of " { $snippet "seq" } "; the head sequence consists of all elements of " { $snippet "seq" } " but the last." } +{ $examples + { $example "USING: prettyprint sequences ;" "{ 1 2 3 } unclip-last prefix ." "{ 3 1 2 }" } +} ; + +HELP: unclip-last-slice +{ $values { "seq" sequence } { "butlast" slice } { "last" object } } +{ $description "Outputs a head sequence and the last element of " { $snippet "seq" } "; the head sequence consists of all elements of " { $snippet "seq" } " but the last Unlike " { $link unclip-last } ", this word does not make a copy of the input sequence, and runs in constant time." } ; + HELP: sum { $values { "seq" "a sequence of numbers" } { "n" "a number" } } { $description "Outputs the sum of all elements of " { $snippet "seq" } ". Outputs zero given an empty sequence." } ; @@ -1072,6 +1118,16 @@ HELP: trim-left "{ 1 2 3 0 0 }" } ; +HELP: trim-left-slice +{ $values + { "seq" sequence } { "quot" quotation } + { "slice" slice } } +{ $description "Removes elements starting from the left side of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a slice" } +{ $example "" "USING: prettyprint math sequences ;" + "{ 0 0 1 2 3 0 0 } [ zero? ] trim-left-slice ." + "T{ slice { from 2 } { to 7 } { seq { 0 0 1 2 3 0 0 } } }" +} ; + HELP: trim-right { $values { "seq" sequence } { "quot" quotation } @@ -1082,6 +1138,16 @@ HELP: trim-right "{ 0 0 1 2 3 }" } ; +HELP: trim-right-slice +{ $values + { "seq" sequence } { "quot" quotation } + { "slice" slice } } +{ $description "Removes elements starting from the right side of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a slice." } +{ $example "" "USING: prettyprint math sequences ;" + "{ 0 0 1 2 3 0 0 } [ zero? ] trim-right-slice ." + "T{ slice { from 0 } { to 5 } { seq { 0 0 1 2 3 0 0 } } }" +} ; + HELP: trim { $values { "seq" sequence } { "quot" quotation } @@ -1092,4 +1158,123 @@ HELP: trim "{ 1 2 3 }" } ; -{ trim-left trim-right trim } related-words +HELP: trim-slice +{ $values + { "seq" sequence } { "quot" quotation } + { "slice" slice } } +{ $description "Removes elements starting from the left and right sides of a sequence if they match a predicate. Once an element does not match, the test stops and the rest of the sequence is left on the stack as a slice." } +{ $example "" "USING: prettyprint math sequences ;" + "{ 0 0 1 2 3 0 0 } [ zero? ] trim-slice ." + "T{ slice { from 2 } { to 5 } { seq { 0 0 1 2 3 0 0 } } }" +} ; + +{ trim trim-slice trim-left trim-left-slice trim-right trim-right-slice } related-words + +HELP: sift +{ $values + { "seq" sequence } + { "newseq" sequence } } + { $description "Outputs a new sequence with all instance of " { $link f } " removed." } + { $examples + { $example "USING: prettyprint sequences ;" + "{ \"a\" 3 { } f } sift ." + "{ \"a\" 3 { } }" + } +} ; + +HELP: harvest +{ $values + { "seq" sequence } + { "newseq" sequence } } +{ $description "Outputs a new sequence with all empty sequences removed." } +{ $examples + { $example "USING: prettyprint sequences ;" + "{ { } { 2 3 } { 5 } { } } harvest ." + "{ { 2 3 } { 5 } }" + } +} ; + +{ filter sift harvest } related-words + +HELP: set-first +{ $values + { "first" object } { "seq" sequence } } +{ $description "Sets the first element of a sequence." } +{ $examples + { $example "USING: prettyprint kernel sequences ;" + "{ 1 2 3 4 } 5 over set-first ." + "{ 5 2 3 4 }" + } +} ; + +HELP: set-second +{ $values + { "second" object } { "seq" sequence } } +{ $description "Sets the second element of a sequence." } +{ $examples + { $example "USING: prettyprint kernel sequences ;" + "{ 1 2 3 4 } 5 over set-second ." + "{ 1 5 3 4 }" + } +} ; + +HELP: set-third +{ $values + { "third" object } { "seq" sequence } } +{ $description "Sets the third element of a sequence." } +{ $examples + { $example "USING: prettyprint kernel sequences ;" + "{ 1 2 3 4 } 5 over set-third ." + "{ 1 2 5 4 }" + } +} ; + +HELP: set-fourth +{ $values + { "fourth" object } { "seq" sequence } } +{ $description "Sets the fourth element of a sequence." } +{ $examples + { $example "USING: prettyprint kernel sequences ;" + "{ 1 2 3 4 } 5 over set-fourth ." + "{ 1 2 3 5 }" + } +} ; + +{ set-first set-second set-third set-fourth } related-words + +HELP: replicate +{ $values + { "seq" sequence } { "quot" quotation } + { "newseq" sequence } } +{ $description "Calls the quotation for every element of the sequence in order. However, the element is not passed to the quotation -- it is dropped, and the quotation produces an element of its own that is collected into a sequence of the same class as the input sequence." } +{ $examples + { $unchecked-example "USING: prettyprint kernel sequences ;" + "5 [ 100 random ] replicate ." + "{ 52 10 45 81 30 }" + } +} ; + +HELP: replicate-as +{ $values + { "seq" sequence } { "quot" quotation } { "exemplar" sequence } + { "newseq" sequence } } +{ $description "Calls the quotation for every element of the sequence in order. However, the element is not passed to the quotation -- it is dropped, and the quotation produces an element of its own that is collected into a sequence of the same class as the exemplar sequence." } +{ $examples + { $unchecked-example "USING: prettyprint kernel sequences ;" + "5 [ 100 random ] B{ } replicate-as ." + "B{ 44 8 2 33 18 }" + } +} ; +{ replicate replicate-as } related-words + +HELP: partition +{ $values + { "seq" sequence } { "quot" quotation } + { "trueseq" sequence } { "falseseq" sequence } } + { $description "Calls a predicate quotation on each element of the input sequence. If the test yields true, the element is added to " { $snippet "trueseq" } "; if false, it's added to " { $snippet "falseseq" } "." } +{ $examples + { $example "USING: prettyprint kernel math sequences ;" + "{ 1 2 3 4 5 } [ even? ] partition [ . ] bi@" + "{ 2 4 }\n{ 1 3 5 }" + } +} ; diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index e5c6b5ad99..df79069898 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -741,7 +741,7 @@ PRIVATE> : unclip-slice ( seq -- rest first ) [ rest-slice ] [ first ] bi ; inline -: unclip-last-slice ( seq -- butfirst last ) +: unclip-last-slice ( seq -- butlast last ) [ but-last-slice ] [ peek ] bi ; inline : ( seq -- slice ) diff --git a/extra/random/blum-blum-shub/blum-blum-shub-tests.factor b/extra/random/blum-blum-shub/blum-blum-shub-tests.factor index 2a1af53232..9ace53ab25 100644 --- a/extra/random/blum-blum-shub/blum-blum-shub-tests.factor +++ b/extra/random/blum-blum-shub/blum-blum-shub-tests.factor @@ -8,14 +8,14 @@ IN: blum-blum-shub.tests ] unit-test -[ 887708070 ] [ +[ 70576473 ] [ T{ blum-blum-shub f 590695557939 811977232793 } clone [ 32 random-bits little-endian? [ reverse *uint ] unless ] with-random ] unit-test -[ 5726770047455156646 ] [ +[ 5570804936418322777 ] [ T{ blum-blum-shub f 590695557939 811977232793 } clone [ 64 random-bits little-endian? [ 4 group [ reverse ] map concat *ulonglong ] unless diff --git a/unfinished/regexp2/regexp2.factor b/unfinished/regexp2/regexp2.factor index efc5c660de..24221baeb6 100644 --- a/unfinished/regexp2/regexp2.factor +++ b/unfinished/regexp2/regexp2.factor @@ -29,7 +29,7 @@ IN: regexp2 : matches? ( string regexp -- ? ) dupd match - [ [ length ] [ range-length 1- ] bi* = ] [ drop f ] if* ; + [ [ length ] [ length>> 1- ] bi* = ] [ drop f ] if* ; : match-head ( string regexp -- end ) match length>> 1- ; diff --git a/unfinished/regexp2/traversal/traversal.factor b/unfinished/regexp2/traversal/traversal.factor index a5db2cdaa8..0bc304bfe0 100644 --- a/unfinished/regexp2/traversal/traversal.factor +++ b/unfinished/regexp2/traversal/traversal.factor @@ -18,7 +18,7 @@ TUPLE: dfa-traverser matches ; : ( text regexp -- match ) - [ dfa-table>> ] [ traversal-flags>> ] bi + [ dfa-table>> ] [ dfa-traversal-flags>> ] bi dfa-traverser new swap >>traversal-flags swap [ start-state>> >>current-state ] keep