steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix conflict

db4
Slava Pestov 2008-09-09 23:39:30 -05:00
parent a3bbce3956 0507f99a36
commit 9dfb646606
14 changed files with 254 additions and 105 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
basis/db/db.factor
View File

@ -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 <simple-statement> [ 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 ;

19
basis/db/postgresql/postgresql.factor
View File

@ -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 <low-level-binding> ;
M: literal-bind postgresql-bind-conversion ( tuple literal-bind -- obj )
M: literal-bind postgresql-bind-conversion ( tuple literal-bind -- object )
nip value>> <low-level-binding> ;
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 ] [ <low-level-binding> ] 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 <prepared-statement> ( 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> <literal-bind> 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 ;

14
basis/db/queries/queries.factor
View File

@ -50,10 +50,6 @@ M: retryable execute-statement* ( statement type -- )
[ 0 sql-counter rot with-variable ] curry { "" { } { } } nmake
<simple-statement> 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 <update-tuple-statement> ( 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 <select-by-slots-statement> ( 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' )

20
basis/db/sql/sql.factor
View File

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

22
basis/db/tuples/tuples.factor
View File

@ -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: <insert-db-assigned-statement> db ( class -- obj )
HOOK: <insert-user-assigned-statement> db ( class -- obj )
HOOK: <update-tuple-statement> db ( class -- obj )
HOOK: <delete-tuples-statement> db ( tuple class -- obj )
HOOK: <insert-db-assigned-statement> db ( class -- object )
HOOK: <insert-user-assigned-statement> db ( class -- object )
HOOK: <update-tuple-statement> db ( class -- object )
HOOK: <delete-tuples-statement> db ( tuple class -- object )
HOOK: <select-by-slots-statement> db ( tuple class -- tuple )
TUPLE: query group order offset limit ;
HOOK: <query> db ( tuple class query -- statement' )
@ -48,7 +48,7 @@ HOOK: <count-statement> 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
] [

30
basis/db/types/types-docs.factor
View File

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

5
basis/random/random-tests.factor
View File

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

7
basis/random/random.factor
View File

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

11
basis/smtp/smtp-docs.factor
View File

@ -20,8 +20,7 @@ HELP: <email>
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 ;"
"<email>"
@ -37,9 +36,5 @@ HELP: send-email
} ;
ARTICLE: "smtp" "SMTP Client Library"
"Start by creating a new email object:"
{ $subsection <email> }
"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 } ;

191
core/sequences/sequences-docs.factor
View File

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

2
core/sequences/sequences.factor
View File

@ -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
: <flat-slice> ( seq -- slice )

4
extra/random/blum-blum-shub/blum-blum-shub-tests.factor
View File

@ -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? [ <uint> reverse *uint ] unless
] with-random
] unit-test
[ 5726770047455156646 ] [
[ 5570804936418322777 ] [
T{ blum-blum-shub f 590695557939 811977232793 } clone [
64 random-bits
little-endian? [ <ulonglong> 4 group [ reverse ] map concat *ulonglong ] unless

2
unfinished/regexp2/regexp2.factor
View File

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

2
unfinished/regexp2/traversal/traversal.factor
View File

@ -18,7 +18,7 @@ TUPLE: dfa-traverser
matches ;
: <dfa-traverser> ( 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