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

Merge branch 'master' into experimental

db4
Alex Chapman 2009-01-30 21:22:54 +11:00
parent da7a6da6a5 fe886fc8f3
commit a04d8aaf17
114 changed files with 264 additions and 271 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/base64/base64.factor
View File

@ -45,8 +45,8 @@ SYMBOL: column
] with each ; inline ] with each ; inline
: encode-pad ( seq n -- ) : encode-pad ( seq n -- )
[ 3 0 pad-right binary [ encode3 ] with-byte-writer ] [ 3 0 pad-tail binary [ encode3 ] with-byte-writer ]
[ 1+ ] bi* head-slice 4 CHAR: = pad-right write-lines ; inline [ 1+ ] bi* head-slice 4 CHAR: = pad-tail write-lines ; inline
ERROR: malformed-base64 ; ERROR: malformed-base64 ;

2
basis/bootstrap/image/image.factor
View File

@ -351,7 +351,7 @@ M: wrapper '
bootstrap-cell <groups> native> emit-seq ; bootstrap-cell <groups> native> emit-seq ;
: pad-bytes ( seq -- newseq ) : pad-bytes ( seq -- newseq )
dup length bootstrap-cell align 0 pad-right ; dup length bootstrap-cell align 0 pad-tail ;
: extended-part ( str -- str' ) : extended-part ( str -- str' )
dup [ 128 < ] all? [ drop f ] [ dup [ 128 < ] all? [ drop f ] [

6
basis/calendar/format/format.factor
View File

@ -5,11 +5,11 @@ sequences io accessors arrays io.streams.string splitting
combinators accessors calendar calendar.format.macros present ; combinators accessors calendar calendar.format.macros present ;
IN: calendar.format IN: calendar.format
: pad-00 ( n -- str ) number>string 2 CHAR: 0 pad-left ; : pad-00 ( n -- str ) number>string 2 CHAR: 0 pad-head ;
: pad-0000 ( n -- str ) number>string 4 CHAR: 0 pad-left ; : pad-0000 ( n -- str ) number>string 4 CHAR: 0 pad-head ;
: pad-00000 ( n -- str ) number>string 5 CHAR: 0 pad-left ; : pad-00000 ( n -- str ) number>string 5 CHAR: 0 pad-head ;
: write-00 ( n -- ) pad-00 write ; : write-00 ( n -- ) pad-00 write ;

2
basis/checksums/sha1/sha1.factor
View File

@ -128,7 +128,7 @@ M: sha1 checksum-stream ( stream -- sha1 )
[ zip concat ] keep like ; [ zip concat ] keep like ;
: sha1-interleave ( string -- seq ) : sha1-interleave ( string -- seq )
[ zero? ] trim-left [ zero? ] trim-head
dup length odd? [ rest ] when dup length odd? [ rest ] when
seq>2seq [ sha1 checksum-bytes ] bi@ seq>2seq [ sha1 checksum-bytes ] bi@
2seq>seq ; 2seq>seq ;

2
basis/checksums/sha2/sha2.factor
View File

@ -62,7 +62,7 @@ SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
[ + + w+ ] 2dip swap set-nth ; inline [ + + w+ ] 2dip swap set-nth ; inline
: prepare-message-schedule ( seq -- w-seq ) : prepare-message-schedule ( seq -- w-seq )
word-size get group [ be> ] map block-size get 0 pad-right word-size get group [ be> ] map block-size get 0 pad-tail
dup 16 64 dup <slice> [ dup 16 64 dup <slice> [
process-M-256 process-M-256
] with each ; ] with each ;

2
basis/compiler/cfg/linearization/linearization.factor Normal file → Executable file
View File

@ -63,7 +63,7 @@ M: ##compare-float-branch linearize-insn
##box-float ##box-float
##box-alien ##box-alien
} memq? } memq?
] contains? ; ] any? ;
: linearize-basic-block ( bb -- ) : linearize-basic-block ( bb -- )
[ number>> _label ] [ number>> _label ]

2
basis/compiler/codegen/codegen.factor Normal file → Executable file
View File

@ -400,7 +400,7 @@ M: no-such-symbol compiler-error-type
: check-dlsym ( symbols dll -- ) : check-dlsym ( symbols dll -- )
dup dll-valid? [ dup dll-valid? [
dupd '[ _ dlsym ] contains? dupd '[ _ dlsym ] any?
[ drop ] [ no-such-symbol ] if [ drop ] [ no-such-symbol ] if
] [ ] [
dll-path no-such-library drop dll-path no-such-library drop

8
basis/compiler/tests/stack-trace.factor Normal file → Executable file
View File

@ -19,14 +19,14 @@ words splitting grouping sorting accessors ;
: bleh ( seq -- seq' ) [ 3 + ] map [ 0 > ] filter ; : bleh ( seq -- seq' ) [ 3 + ] map [ 0 > ] filter ;
: stack-trace-contains? ( word -- ? ) symbolic-stack-trace memq? ; : stack-trace-any? ( word -- ? ) symbolic-stack-trace memq? ;
[ t ] [ [ t ] [
[ { 1 "hi" } bleh ] ignore-errors \ + stack-trace-contains? [ { 1 "hi" } bleh ] ignore-errors \ + stack-trace-any?
] unit-test ] unit-test
[ t f ] [ [ t f ] [
[ { "hi" } bleh ] ignore-errors [ { "hi" } bleh ] ignore-errors
\ + stack-trace-contains? \ + stack-trace-any?
\ > stack-trace-contains? \ > stack-trace-any?
] unit-test ] unit-test

2
basis/compiler/tree/builder/builder-tests.factor Normal file → Executable file
View File

@ -8,4 +8,4 @@ compiler.tree ;
: inline-recursive ( -- ) inline-recursive ; inline recursive : inline-recursive ( -- ) inline-recursive ; inline recursive
[ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] contains? nip ] unit-test [ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] any? nip ] unit-test

2
basis/compiler/tree/checker/checker.factor Normal file → Executable file
View File

@ -175,7 +175,7 @@ M: #branch check-stack-flow*
branch-out get [ ] find nip swap head* >vector datastack set ; branch-out get [ ] find nip swap head* >vector datastack set ;
M: #phi check-stack-flow* M: #phi check-stack-flow*
branch-out get [ ] contains? [ branch-out get [ ] any? [
[ check-phi-in ] [ set-phi-datastack ] [ check-out-d ] tri [ check-phi-in ] [ set-phi-datastack ] [ check-out-d ] tri
] [ drop terminated? on ] if ; ] [ drop terminated? on ] if ;

2
basis/compiler/tree/cleanup/cleanup-tests.factor Normal file → Executable file
View File

@ -498,7 +498,7 @@ cell-bits 32 = [
[ t ] [ [ t ] [
[ { array-capacity } declare 1 fixnum+ ] cleaned-up-tree [ { array-capacity } declare 1 fixnum+ ] cleaned-up-tree
[ { [ #call? ] [ node-input-infos second literal>> 1 = ] } 1&& ] contains? [ { [ #call? ] [ node-input-infos second literal>> 1 = ] } 1&& ] any?
] unit-test ] unit-test
[ ] [ [ ] [

4
basis/compiler/tree/combinators/combinators.factor Normal file → Executable file
View File

@ -34,14 +34,14 @@ IN: compiler.tree.combinators
dup dup '[ dup dup '[
_ keep swap [ drop t ] [ _ keep swap [ drop t ] [
dup #branch? [ dup #branch? [
children>> [ _ contains-node? ] contains? children>> [ _ contains-node? ] any?
] [ ] [
dup #recursive? [ dup #recursive? [
child>> _ contains-node? child>> _ contains-node?
] [ drop f ] if ] [ drop f ] if
] if ] if
] if ] if
] contains? ; inline recursive ] any? ; inline recursive
: select-children ( seq flags -- seq' ) : select-children ( seq flags -- seq' )
[ [ drop f ] unless ] 2map ; [ [ drop f ] unless ] 2map ;

2
basis/compiler/tree/dead-code/simple/simple.factor Normal file → Executable file
View File

@ -79,7 +79,7 @@ M: #alien-indirect compute-live-values* nip look-at-inputs ;
dup out-d>> drop-dead-values tuck in-d>> >>out-d drop ; dup out-d>> drop-dead-values tuck in-d>> >>out-d drop ;
: some-outputs-dead? ( #call -- ? ) : some-outputs-dead? ( #call -- ? )
out-d>> [ live-value? not ] contains? ; out-d>> [ live-value? not ] any? ;
: maybe-drop-dead-outputs ( node -- nodes ) : maybe-drop-dead-outputs ( node -- nodes )
dup some-outputs-dead? [ dup some-outputs-dead? [

2
basis/compiler/tree/normalization/normalization.factor
View File

@ -60,7 +60,7 @@ M: #branch normalize*
: eliminate-phi-introductions ( introductions seq terminated -- seq' ) : eliminate-phi-introductions ( introductions seq terminated -- seq' )
[ [
[ nip ] [ [ nip ] [
dup [ +bottom+ eq? ] trim-left dup [ +bottom+ eq? ] trim-head
[ [ length ] bi@ - tail* ] keep append [ [ length ] bi@ - tail* ] keep append
] if ] if
] 3map ; ] 3map ;

0
basis/compiler/tree/propagation/branches/branches.factor Normal file → Executable file
View File

2
basis/compiler/tree/propagation/inlining/inlining.factor Normal file → Executable file
View File

@ -124,7 +124,7 @@ DEFER: (flat-length)
[ class-types length 1 = ] [ class-types length 1 = ]
[ union-class? not ] [ union-class? not ]
bi and bi and
] contains? ; ] any? ;
: node-count-bias ( -- n ) : node-count-bias ( -- n )
45 node-count get [-] 8 /i ; 45 node-count get [-] 8 /i ;

2
basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor Normal file → Executable file
View File

@ -118,7 +118,7 @@ M: #return-recursive unbox-tuples*
! These nodes never participate in unboxing ! These nodes never participate in unboxing
: assert-not-unboxed ( values -- ) : assert-not-unboxed ( values -- )
dup array? dup array?
[ [ unboxed-allocation ] contains? ] [ unboxed-allocation ] if [ [ unboxed-allocation ] any? ] [ unboxed-allocation ] if
[ "Unboxing wrong value" throw ] when ; [ "Unboxing wrong value" throw ] when ;
M: #branch unbox-tuples* dup in-d>> assert-not-unboxed ; M: #branch unbox-tuples* dup in-d>> assert-not-unboxed ;

2
basis/concurrency/mailboxes/mailboxes.factor Normal file → Executable file
View File

@ -25,7 +25,7 @@ M: mailbox dispose* threads>> notify-all ;
:: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- ) :: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- )
mailbox check-disposed mailbox check-disposed
mailbox data>> pred dlist-contains? [ mailbox data>> pred dlist-any? [
mailbox timeout wait-for-mailbox mailbox timeout wait-for-mailbox
mailbox timeout pred block-unless-pred mailbox timeout pred block-unless-pred
] unless ; inline recursive ] unless ; inline recursive

2
basis/csv/csv.factor Normal file → Executable file
View File

@ -71,7 +71,7 @@ DEFER: quoted-field ( -- endchar )
delimiter swap with-variable ; inline delimiter swap with-variable ; inline
: needs-escaping? ( cell -- ? ) : needs-escaping? ( cell -- ? )
[ [ "\n\"" member? ] [ delimiter get = ] bi or ] contains? ; inline ! " [ [ "\n\"" member? ] [ delimiter get = ] bi or ] any? ; inline
: escape-quotes ( cell -- cell' ) : escape-quotes ( cell -- cell' )
[ [ dup , CHAR: " = [ CHAR: " , ] when ] each ] "" make ; inline [ [ dup , CHAR: " = [ CHAR: " , ] when ] each ] "" make ; inline

2
basis/db/queries/queries.factor Normal file → Executable file
View File

@ -19,7 +19,7 @@ SINGLETON: retryable
] if ; ] if ;
: maybe-make-retryable ( statement -- statement ) : maybe-make-retryable ( statement -- statement )
dup in-params>> [ generator-bind? ] contains? dup in-params>> [ generator-bind? ] any?
[ make-retryable ] when ; [ make-retryable ] when ;
: regenerate-params ( statement -- statement ) : regenerate-params ( statement -- statement )

2
basis/db/sqlite/sqlite.factor Normal file → Executable file
View File

@ -294,7 +294,7 @@ M: sqlite-db-connection persistent-table ( -- assoc )
] with-string-writer ; ] with-string-writer ;
: can-be-null? ( -- ? ) : can-be-null? ( -- ? )
"sql-spec" get modifiers>> [ +not-null+ = ] contains? not ; "sql-spec" get modifiers>> [ +not-null+ = ] any? not ;
: delete-cascade? ( -- ? ) : delete-cascade? ( -- ? )
"sql-spec" get modifiers>> { +on-delete+ +cascade+ } swap subseq? ; "sql-spec" get modifiers>> { +on-delete+ +cascade+ } swap subseq? ;

2
basis/db/tuples/tuples-docs.factor
View File

@ -90,7 +90,7 @@ HELP: ensure-table
HELP: ensure-tables HELP: ensure-tables
{ $values { $values
{ "classes" null } } { "classes" "a sequence of classes" } }
{ $description "Creates a SQL table from a mapping defined by " { $link define-persistent } ". If a table already exists, the error is silently ignored." } ; { $description "Creates a SQL table from a mapping defined by " { $link define-persistent } ". If a table already exists, the error is silently ignored." } ;
HELP: recreate-table HELP: recreate-table

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

@ -4,39 +4,24 @@ USING: classes hashtables help.markup help.syntax io.streams.string
kernel sequences strings math ; kernel sequences strings math ;
IN: db.types IN: db.types
HELP: +autoincrement+
{ $description "" } ;
HELP: +db-assigned-id+ HELP: +db-assigned-id+
{ $description "The database assigns a primary key to the object. The primary key is most likely a big integer, but is database-dependent." } ; { $description "The database assigns a primary key to the object. The primary key is most likely a big integer, but is database-dependent." } ;
HELP: +default+ HELP: +default+
{ $description "" } ; { $description "Allows a default value for a column to be provided." } ;
HELP: +foreign-id+
{ $description "" } ;
HELP: +has-many+
{ $description "" } ;
HELP: +not-null+ HELP: +not-null+
{ $description "" } ; { $description "Ensures that a column is not null." } ;
HELP: +null+ HELP: +null+
{ $description "" } ; { $description "Allows a column to be null." } ;
HELP: +primary-key+ HELP: +primary-key+
{ $description "" } ; { $description "Makes a column a primary key. Only one column may be a primary key." } ;
HELP: +random-id+ HELP: +random-id+
{ $description "Factor chooses a random number and tries to insert the tuple into the database with this number as its primary key. The default number of retries to find a unique random number is 10, though in practice it will almost certainly succeed on the first try." } ; { $description "Factor chooses a random number and tries to insert the tuple into the database with this number as its primary key. The default number of retries to find a unique random number is 10, though in practice it will almost certainly succeed on the first try." } ;
HELP: +serial+
{ $description "" } ;
HELP: +unique+
{ $description "" } ;
HELP: +user-assigned-id+ HELP: +user-assigned-id+
{ $description "The user is responsible for choosing a primary key for tuples inserted with this database type. Keys must be unique or else the database will throw an error. Usually it is better to use a " { $link +db-assigned-id+ } "." } ; { $description "The user is responsible for choosing a primary key for tuples inserted with this database type. Keys must be unique or else the database will throw an error. Usually it is better to use a " { $link +db-assigned-id+ } "." } ;
@ -114,12 +99,12 @@ HELP: user-assigned-id-spec?
HELP: bind# HELP: bind#
{ $values { $values
{ "spec" null } { "obj" object } } { "spec" "a sql spec" } { "obj" object } }
{ $description "" } ; { $description "" } ;
HELP: bind% HELP: bind%
{ $values { $values
{ "spec" null } } { "spec" "a sql spec" } }
{ $description "" } ; { $description "" } ;
HELP: compound HELP: compound
@ -176,7 +161,7 @@ HELP: low-level-binding
HELP: modifiers HELP: modifiers
{ $values { $values
{ "spec" null } { "spec" "a sql spec" }
{ "string" string } } { "string" string } }
{ $description "" } ; { $description "" } ;
@ -187,7 +172,7 @@ HELP: no-sql-type
HELP: normalize-spec HELP: normalize-spec
{ $values { $values
{ "spec" null } } { "spec" "a sql spec" } }
{ $description "" } ; { $description "" } ;
HELP: offset-of-slot HELP: offset-of-slot
@ -204,7 +189,7 @@ HELP: persistent-table
HELP: primary-key? HELP: primary-key?
{ $values { $values
{ "spec" null } { "spec" "a sql spec" }
{ "?" "a boolean" } } { "?" "a boolean" } }
{ $description "" } ; { $description "" } ;
@ -213,37 +198,31 @@ HELP: random-id-generator
HELP: relation? HELP: relation?
{ $values { $values
{ "spec" null } { "spec" "a sql spec" }
{ "?" "a boolean" } } { "?" "a boolean" } }
{ $description "" } ; { $description "" } ;
HELP: remove-db-assigned-id HELP: remove-db-assigned-id
{ $values { $values
{ "specs" null } { "specs" "a sequence of sql specs" }
{ "obj" object } } { "obj" object } }
{ $description "" } ; { $description "" } ;
HELP: remove-id HELP: remove-id
{ $values { $values
{ "specs" null } { "specs" "a sequence of sql specs" }
{ "obj" object } } { "obj" object } }
{ $description "" } ; { $description "" } ;
HELP: remove-relations
{ $values
{ "specs" null }
{ "newcolumns" null } }
{ $description "" } ;
HELP: set-slot-named HELP: set-slot-named
{ $values { $values
{ "value" null } { "name" null } { "obj" object } } { "value" object } { "name" string } { "obj" object } }
{ $description "" } ; { $description "" } ;
HELP: spec>tuple HELP: spec>tuple
{ $values { $values
{ "class" class } { "spec" null } { "class" class } { "spec" "a sql spec" }
{ "tuple" null } } { "tuple" tuple } }
{ $description "" } ; { $description "" } ;
HELP: sql-spec HELP: sql-spec

6
basis/db/types/types.factor Normal file → Executable file
View File

@ -71,10 +71,10 @@ ERROR: not-persistent class ;
primary-key>> +primary-key+? ; primary-key>> +primary-key+? ;
: db-assigned-id-spec? ( specs -- ? ) : db-assigned-id-spec? ( specs -- ? )
[ primary-key>> +db-assigned-id+? ] contains? ; [ primary-key>> +db-assigned-id+? ] any? ;
: user-assigned-id-spec? ( specs -- ? ) : user-assigned-id-spec? ( specs -- ? )
[ primary-key>> +user-assigned-id+? ] contains? ; [ primary-key>> +user-assigned-id+? ] any? ;
: normalize-spec ( spec -- ) : normalize-spec ( spec -- )
dup type>> dup +primary-key+? [ dup type>> dup +primary-key+? [
@ -105,7 +105,7 @@ FACTOR-BLOB NULL URL ;
dup normalize-spec ; dup normalize-spec ;
: spec>tuple ( class spec -- tuple ) : spec>tuple ( class spec -- tuple )
3 f pad-right [ first3 ] keep 3 tail <sql-spec> ; 3 f pad-tail [ first3 ] keep 3 tail <sql-spec> ;
: number>string* ( n/string -- string ) : number>string* ( n/string -- string )
dup number? [ number>string ] when ; dup number? [ number>string ] when ;

4
basis/dlists/dlists-docs.factor Normal file → Executable file
View File

@ -15,7 +15,7 @@ $nl
"Iterating over elements:" "Iterating over elements:"
{ $subsection dlist-each } { $subsection dlist-each }
{ $subsection dlist-find } { $subsection dlist-find }
{ $subsection dlist-contains? } { $subsection dlist-any? }
"Deleting a node matching a predicate:" "Deleting a node matching a predicate:"
{ $subsection delete-node-if* } { $subsection delete-node-if* }
{ $subsection delete-node-if } { $subsection delete-node-if }
@ -40,7 +40,7 @@ HELP: dlist-find
"This operation is O(n)." "This operation is O(n)."
} ; } ;
HELP: dlist-contains? HELP: dlist-any?
{ $values { "dlist" { $link dlist } } { "quot" quotation } { "?" "a boolean" } } { $values { "dlist" { $link dlist } } { "quot" quotation } { "?" "a boolean" } }
{ $description "Just like " { $link dlist-find } " except it doesn't return the object." } { $description "Just like " { $link dlist-find } " except it doesn't return the object." }
{ $notes "This operation is O(n)." } ; { $notes "This operation is O(n)." } ;

4
basis/dlists/dlists-tests.factor Normal file → Executable file
View File

@ -46,8 +46,8 @@ IN: dlists.tests
[ f f ] [ <dlist> [ 1 = ] dlist-find ] unit-test [ f f ] [ <dlist> [ 1 = ] dlist-find ] unit-test
[ 1 t ] [ <dlist> 1 over push-back [ 1 = ] dlist-find ] unit-test [ 1 t ] [ <dlist> 1 over push-back [ 1 = ] dlist-find ] unit-test
[ f f ] [ <dlist> 1 over push-back [ 2 = ] dlist-find ] unit-test [ f f ] [ <dlist> 1 over push-back [ 2 = ] dlist-find ] unit-test
[ f ] [ <dlist> 1 over push-back [ 2 = ] dlist-contains? ] unit-test [ f ] [ <dlist> 1 over push-back [ 2 = ] dlist-any? ] unit-test
[ t ] [ <dlist> 1 over push-back [ 1 = ] dlist-contains? ] unit-test [ t ] [ <dlist> 1 over push-back [ 1 = ] dlist-any? ] unit-test
[ 1 ] [ <dlist> 1 over push-back [ 1 = ] delete-node-if ] unit-test [ 1 ] [ <dlist> 1 over push-back [ 1 = ] delete-node-if ] unit-test
[ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop deque-empty? ] unit-test [ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop deque-empty? ] unit-test

4
basis/dlists/dlists.factor Normal file → Executable file
View File

@ -117,11 +117,11 @@ M: dlist pop-back* ( dlist -- )
: dlist-find ( dlist quot -- obj/f ? ) : dlist-find ( dlist quot -- obj/f ? )
'[ obj>> @ ] dlist-find-node [ obj>> t ] [ drop f f ] if ; inline '[ obj>> @ ] dlist-find-node [ obj>> t ] [ drop f f ] if ; inline
: dlist-contains? ( dlist quot -- ? ) : dlist-any? ( dlist quot -- ? )
dlist-find nip ; inline dlist-find nip ; inline
M: dlist deque-member? ( value dlist -- ? ) M: dlist deque-member? ( value dlist -- ? )
[ = ] with dlist-contains? ; [ = ] with dlist-any? ;
M: dlist delete-node ( dlist-node dlist -- ) M: dlist delete-node ( dlist-node dlist -- )
{ {

4
basis/farkup/farkup.factor Normal file → Executable file
View File

@ -34,7 +34,7 @@ TUPLE: line ;
TUPLE: line-break ; TUPLE: line-break ;
: absolute-url? ( string -- ? ) : absolute-url? ( string -- ? )
{ "http://" "https://" "ftp://" } [ head? ] with contains? ; { "http://" "https://" "ftp://" } [ head? ] with any? ;
: simple-link-title ( string -- string' ) : simple-link-title ( string -- string' )
dup absolute-url? [ "/" split1-last swap or ] unless ; dup absolute-url? [ "/" split1-last swap or ] unless ;
@ -162,7 +162,7 @@ stand-alone
: check-url ( href -- href' ) : check-url ( href -- href' )
{ {
{ [ dup empty? ] [ drop invalid-url ] } { [ dup empty? ] [ drop invalid-url ] }
{ [ dup [ 127 > ] contains? ] [ drop invalid-url ] } { [ dup [ 127 > ] any? ] [ drop invalid-url ] }
{ [ dup first "/\\" member? ] [ drop invalid-url ] } { [ dup first "/\\" member? ] [ drop invalid-url ] }
{ [ CHAR: : over member? ] [ dup absolute-url? [ drop invalid-url ] unless ] } { [ CHAR: : over member? ] [ dup absolute-url? [ drop invalid-url ] unless ] }
[ relative-link-prefix get prepend "" like ] [ relative-link-prefix get prepend "" like ]

2
basis/formatting/formatting-docs.factor
View File

@ -43,7 +43,7 @@ HELP: printf
"string. For example:\n" "string. For example:\n"
{ $list { $list
"\"%.3s\" formats a string to truncate at 3 characters (from the left)." "\"%.3s\" formats a string to truncate at 3 characters (from the left)."
"\"%.10f\" formats a float to pad-right with zeros up to 10 digits beyond the decimal point." "\"%.10f\" formats a float to pad-tail with zeros up to 10 digits beyond the decimal point."
"\"%.5E\" formats a float into scientific notation with zeros up to 5 digits beyond the decimal point, but before the exponent." "\"%.5E\" formats a float into scientific notation with zeros up to 5 digits beyond the decimal point, but before the exponent."
} }
} }

10
basis/formatting/formatting.factor
View File

@ -29,7 +29,7 @@ IN: formatting
[ 0 ] [ string>number ] if-empty ; [ 0 ] [ string>number ] if-empty ;
: pad-digits ( string digits -- string' ) : pad-digits ( string digits -- string' )
[ "." split1 ] dip [ CHAR: 0 pad-right ] [ head-slice ] bi "." glue ; [ "." split1 ] dip [ CHAR: 0 pad-tail ] [ head-slice ] bi "." glue ;
: max-digits ( n digits -- n' ) : max-digits ( n digits -- n' )
10 swap ^ [ * round ] keep / ; inline 10 swap ^ [ * round ] keep / ; inline
@ -48,7 +48,7 @@ IN: formatting
[ max-digits ] keep -rot [ max-digits ] keep -rot
[ [
[ 0 < "-" "+" ? ] [ 0 < "-" "+" ? ]
[ abs number>string 2 CHAR: 0 pad-left ] bi [ abs number>string 2 CHAR: 0 pad-head ] bi
"e" -rot 3append "e" -rot 3append
] ]
[ number>string ] bi* [ number>string ] bi*
@ -60,7 +60,7 @@ zero = "0" => [[ CHAR: 0 ]]
char = "'" (.) => [[ second ]] char = "'" (.) => [[ second ]]
pad-char = (zero|char)? => [[ CHAR: \s or ]] pad-char = (zero|char)? => [[ CHAR: \s or ]]
pad-align = ("-")? => [[ \ pad-right \ pad-left ? ]] pad-align = ("-")? => [[ \ pad-tail \ pad-head ? ]]
pad-width = ([0-9])* => [[ >digits ]] pad-width = ([0-9])* => [[ >digits ]]
pad = pad-align pad-char pad-width => [[ reverse >quotation dup first 0 = [ drop [ ] ] when ]] pad = pad-align pad-char pad-width => [[ reverse >quotation dup first 0 = [ drop [ ] ] when ]]
@ -110,9 +110,9 @@ MACRO: printf ( format-string -- )
<PRIVATE <PRIVATE
: pad-00 ( n -- string ) number>string 2 CHAR: 0 pad-left ; inline : pad-00 ( n -- string ) number>string 2 CHAR: 0 pad-head ; inline
: pad-000 ( n -- string ) number>string 3 CHAR: 0 pad-left ; inline : pad-000 ( n -- string ) number>string 3 CHAR: 0 pad-head ; inline
: >time ( timestamp -- string ) : >time ( timestamp -- string )
[ hour>> ] [ minute>> ] [ second>> floor ] tri 3array [ hour>> ] [ minute>> ] [ second>> floor ] tri 3array

2
basis/ftp/client/listing-parser/listing-parser.factor
View File

@ -39,7 +39,7 @@ name target ;
: parse-list-11 ( lines -- seq ) : parse-list-11 ( lines -- seq )
[ [
11 f pad-right 11 f pad-tail
<remote-file> swap { <remote-file> swap {
[ 0 swap nth parse-permissions ] [ 0 swap nth parse-permissions ]
[ 1 swap nth string>number >>links ] [ 1 swap nth string>number >>links ]

2
basis/furnace/auth/features/edit-profile/edit-profile.factor Normal file → Executable file
View File

@ -31,7 +31,7 @@ IN: furnace.auth.features.edit-profile
} validate-params } validate-params
{ "password" "new-password" "verify-password" } { "password" "new-password" "verify-password" }
[ value empty? not ] contains? [ [ value empty? not ] any? [
"password" value username check-login "password" value username check-login
[ "incorrect password" validation-error ] unless [ "incorrect password" validation-error ] unless

2
basis/furnace/auth/login/login.factor
View File

@ -16,7 +16,7 @@ IN: furnace.auth.login
SYMBOL: permit-id SYMBOL: permit-id
: permit-id-key ( realm -- string ) : permit-id-key ( realm -- string )
[ >hex 2 CHAR: 0 pad-left ] { } map-as concat [ >hex 2 CHAR: 0 pad-head ] { } map-as concat
"__p_" prepend ; "__p_" prepend ;
: client-permit-id ( realm -- id/f ) : client-permit-id ( realm -- id/f )

2
basis/furnace/utilities/utilities.factor Normal file → Executable file
View File

@ -29,7 +29,7 @@ ERROR: no-such-word name vocab ;
: base-path ( string -- pair ) : base-path ( string -- pair )
dup responder-nesting get dup responder-nesting get
[ second class superclasses [ name>> = ] with contains? ] with find nip [ second class superclasses [ name>> = ] with any? ] with find nip
[ first ] [ "No such responder: " swap append throw ] ?if ; [ first ] [ "No such responder: " swap append throw ] ?if ;
: resolve-base-path ( string -- string' ) : resolve-base-path ( string -- string' )

14
basis/help/lint/lint.factor Normal file → Executable file
View File

@ -43,7 +43,7 @@ SYMBOL: vocabs-quot
$predicate $predicate
$class-description $class-description
$error-description $error-description
} swap '[ _ elements empty? not ] contains? ; } swap '[ _ elements empty? not ] any? ;
: don't-check-word? ( word -- ? ) : don't-check-word? ( word -- ? )
{ {
@ -103,7 +103,7 @@ SYMBOL: vocabs-quot
[ "Missing whitespace between strings" throw ] unless ; [ "Missing whitespace between strings" throw ] unless ;
: check-bogus-nl ( element -- ) : check-bogus-nl ( element -- )
{ { $nl } { { $nl } } } [ head? ] with contains? { { $nl } { { $nl } } } [ head? ] with any?
[ "Simple element should not begin with a paragraph break" throw ] when ; [ "Simple element should not begin with a paragraph break" throw ] when ;
: check-elements ( element -- ) : check-elements ( element -- )
@ -114,12 +114,22 @@ SYMBOL: vocabs-quot
[ 2 <clumps> [ [ string? ] all? ] filter [ first2 check-whitespace ] each ] [ 2 <clumps> [ [ string? ] all? ] filter [ first2 check-whitespace ] each ]
} cleave ; } cleave ;
: check-descriptions ( element -- )
{ $description $class-description $var-description }
swap '[
_ elements [
rest { { } { "" } } member?
[ "Empty description" throw ] when
] each
] each ;
: check-markup ( element -- ) : check-markup ( element -- )
{ {
[ check-elements ] [ check-elements ]
[ check-rendering ] [ check-rendering ]
[ check-examples ] [ check-examples ]
[ check-modules ] [ check-modules ]
[ check-descriptions ]
} cleave ; } cleave ;
: all-word-help ( words -- seq ) : all-word-help ( words -- seq )

2
basis/html/streams/streams.factor
View File

@ -55,7 +55,7 @@ TUPLE: html-sub-stream < html-stream style parent ;
: hex-color, ( color -- ) : hex-color, ( color -- )
[ red>> ] [ green>> ] [ blue>> ] tri [ red>> ] [ green>> ] [ blue>> ] tri
[ 255 * >fixnum >hex 2 CHAR: 0 pad-left % ] tri@ ; [ 255 * >fixnum >hex 2 CHAR: 0 pad-head % ] tri@ ;
: fg-css, ( color -- ) : fg-css, ( color -- )
"color: #" % hex-color, "; " % ; "color: #" % hex-color, "; " % ;

2
basis/http/client/client.factor
View File

@ -86,7 +86,7 @@ SYMBOL: redirects
] [ too-many-redirects ] if ; inline recursive ] [ too-many-redirects ] if ; inline recursive
: read-chunk-size ( -- n ) : read-chunk-size ( -- n )
read-crlf ";" split1 drop [ blank? ] trim-right read-crlf ";" split1 drop [ blank? ] trim-tail
hex> [ "Bad chunk size" throw ] unless* ; hex> [ "Bad chunk size" throw ] unless* ;
: read-chunked ( quot: ( chunk -- ) -- ) : read-chunked ( quot: ( chunk -- ) -- )

4
basis/http/server/static/static.factor
View File

@ -45,9 +45,9 @@ TUPLE: file-responder root hook special allow-listings ;
[ file-responder get hook>> call ] [ 2drop <304> ] if ; [ file-responder get hook>> call ] [ 2drop <304> ] if ;
: serving-path ( filename -- filename ) : serving-path ( filename -- filename )
file-responder get root>> trim-right-separators file-responder get root>> trim-tail-separators
"/" "/"
rot "" or trim-left-separators 3append ; rot "" or trim-head-separators 3append ;
: serve-file ( filename -- response ) : serve-file ( filename -- response )
dup mime-type dup mime-type

2
basis/io/backend/unix/unix.factor
View File

@ -167,7 +167,7 @@ M: stdin refill
M: unix (init-stdio) M: unix (init-stdio)
<stdin> <input-port> <stdin> <input-port>
1 <fd> <output-port> 1 <fd> <output-port>
2 <fd> <output-port> ; 2 <fd> <output-port> t ;
! mx io-task for embedding an fd-based mx inside another mx ! mx io-task for embedding an fd-based mx inside another mx
TUPLE: mx-port < port mx ; TUPLE: mx-port < port mx ;

2
basis/io/directories/directories.factor
View File

@ -15,7 +15,7 @@ IN: io.directories
HOOK: make-directory io-backend ( path -- ) HOOK: make-directory io-backend ( path -- )
: make-directories ( path -- ) : make-directories ( path -- )
normalize-path trim-right-separators { normalize-path trim-tail-separators {
{ [ dup "." = ] [ ] } { [ dup "." = ] [ ] }
{ [ dup root-directory? ] [ ] } { [ dup root-directory? ] [ ] }
{ [ dup empty? ] [ ] } { [ dup empty? ] [ ] }

4
basis/io/files/windows/nt/nt-tests.factor
View File

@ -25,8 +25,8 @@ IN: io.files.windows.nt.tests
[ t ] [ "\\\\" root-directory? ] unit-test [ t ] [ "\\\\" root-directory? ] unit-test
[ t ] [ "/" root-directory? ] unit-test [ t ] [ "/" root-directory? ] unit-test
[ t ] [ "//" root-directory? ] unit-test [ t ] [ "//" root-directory? ] unit-test
[ t ] [ "c:\\" trim-right-separators root-directory? ] unit-test [ t ] [ "c:\\" trim-tail-separators root-directory? ] unit-test
[ t ] [ "Z:\\" trim-right-separators root-directory? ] unit-test [ t ] [ "Z:\\" trim-tail-separators root-directory? ] unit-test
[ f ] [ "c:\\foo" root-directory? ] unit-test [ f ] [ "c:\\foo" root-directory? ] unit-test
[ f ] [ "." root-directory? ] unit-test [ f ] [ "." root-directory? ] unit-test
[ f ] [ ".." root-directory? ] unit-test [ f ] [ ".." root-directory? ] unit-test

4
basis/io/files/windows/nt/nt.factor
View File

@ -22,10 +22,10 @@ M: winnt root-directory? ( path -- ? )
{ {
{ [ dup empty? ] [ drop f ] } { [ dup empty? ] [ drop f ] }
{ [ dup [ path-separator? ] all? ] [ drop t ] } { [ dup [ path-separator? ] all? ] [ drop t ] }
{ [ dup trim-right-separators { [ length 2 = ] { [ dup trim-tail-separators { [ length 2 = ]
[ second CHAR: : = ] } 1&& ] [ drop t ] } [ second CHAR: : = ] } 1&& ] [ drop t ] }
{ [ dup unicode-prefix head? ] { [ dup unicode-prefix head? ]
[ trim-right-separators length unicode-prefix length 2 + = ] } [ trim-tail-separators length unicode-prefix length 2 + = ] }
[ drop f ] [ drop f ]
} cond ; } cond ;

4
basis/io/monitors/monitors-tests.factor
View File

@ -56,7 +56,7 @@ os { winnt linux macosx } member? [
"m" get next-change path>> "m" get next-change path>>
dup print flush dup print flush
dup parent-directory dup parent-directory
[ trim-right-separators "xyz" tail? ] either? not [ trim-tail-separators "xyz" tail? ] either? not
] loop ] loop
"c1" get count-down "c1" get count-down
@ -65,7 +65,7 @@ os { winnt linux macosx } member? [
"m" get next-change path>> "m" get next-change path>>
dup print flush dup print flush
dup parent-directory dup parent-directory
[ trim-right-separators "yxy" tail? ] either? not [ trim-tail-separators "yxy" tail? ] either? not
] loop ] loop
"c2" get count-down "c2" get count-down

2
basis/io/styles/styles.factor
View File

@ -118,7 +118,7 @@ M: plain-writer make-block-stream
: format-column ( seq ? -- seq ) : format-column ( seq ? -- seq )
[ [
[ 0 [ length max ] reduce ] keep [ 0 [ length max ] reduce ] keep
swap [ CHAR: \s pad-right ] curry map swap [ CHAR: \s pad-tail ] curry map
] unless ; ] unless ;
: map-last ( seq quot -- seq ) : map-last ( seq quot -- seq )

2
basis/locals/rewrite/point-free/point-free.factor Normal file → Executable file
View File

@ -40,7 +40,7 @@ M: object localize 1quotation ;
! We special-case all the :> at the start of a quotation ! We special-case all the :> at the start of a quotation
: load-locals-quot ( args -- quot ) : load-locals-quot ( args -- quot )
[ [ ] ] [ [ [ ] ] [
dup [ local-reader? ] contains? [ dup [ local-reader? ] any? [
dup [ local-reader? [ 1array ] [ ] ? ] map dup [ local-reader? [ 1array ] [ ] ? ] map
spread>quot spread>quot
] [ [ ] ] if swap length [ load-locals ] curry append ] [ [ ] ] if swap length [ load-locals ] curry append

4
basis/locals/rewrite/sugar/sugar.factor Normal file → Executable file
View File

@ -33,9 +33,9 @@ GENERIC: rewrite-literal? ( obj -- ? )
M: special rewrite-literal? drop t ; M: special rewrite-literal? drop t ;
M: array rewrite-literal? [ rewrite-literal? ] contains? ; M: array rewrite-literal? [ rewrite-literal? ] any? ;
M: quotation rewrite-literal? [ rewrite-literal? ] contains? ; M: quotation rewrite-literal? [ rewrite-literal? ] any? ;
M: wrapper rewrite-literal? wrapped>> rewrite-literal? ; M: wrapper rewrite-literal? wrapped>> rewrite-literal? ;

2
basis/math/combinatorics/combinatorics.factor
View File

@ -25,7 +25,7 @@ IN: math.combinatorics
reverse 1 cut [ (>permutation) ] each ; reverse 1 cut [ (>permutation) ] each ;
: permutation-indices ( n seq -- permutation ) : permutation-indices ( n seq -- permutation )
length [ factoradic ] dip 0 pad-left >permutation ; length [ factoradic ] dip 0 pad-head >permutation ;
PRIVATE> PRIVATE>

2
basis/math/intervals/intervals.factor Normal file → Executable file
View File

@ -77,7 +77,7 @@ TUPLE: interval { from read-only } { to read-only } ;
[ from>> ] [ to>> ] bi ; [ from>> ] [ to>> ] bi ;
: points>interval ( seq -- interval ) : points>interval ( seq -- interval )
dup [ first fp-nan? ] contains? dup [ first fp-nan? ] any?
[ drop [-inf,inf] ] [ [ drop [-inf,inf] ] [
dup first dup first
[ [ endpoint-min ] reduce ] [ [ endpoint-min ] reduce ]

14
basis/math/polynomials/polynomials.factor
View File

@ -6,10 +6,10 @@ IN: math.polynomials
<PRIVATE <PRIVATE
: 2pad-left ( p q n -- p q ) [ 0 pad-left ] curry bi@ ; : 2pad-head ( p q n -- p q ) [ 0 pad-head ] curry bi@ ;
: 2pad-right ( p q n -- p q ) [ 0 pad-right ] curry bi@ ; : 2pad-tail ( p q n -- p q ) [ 0 pad-tail ] curry bi@ ;
: pextend ( p q -- p q ) 2dup [ length ] bi@ max 2pad-right ; : pextend ( p q -- p q ) 2dup [ length ] bi@ max 2pad-tail ;
: pextend-left ( p q -- p q ) 2dup [ length ] bi@ max 2pad-left ; : pextend-left ( p q -- p q ) 2dup [ length ] bi@ max 2pad-head ;
: unempty ( seq -- seq ) [ { 0 } ] when-empty ; : unempty ( seq -- seq ) [ { 0 } ] when-empty ;
: 2unempty ( seq seq -- seq seq ) [ unempty ] bi@ ; : 2unempty ( seq seq -- seq seq ) [ unempty ] bi@ ;
@ -21,7 +21,7 @@ PRIVATE>
: p= ( p q -- ? ) pextend = ; : p= ( p q -- ? ) pextend = ;
: ptrim ( p -- p ) : ptrim ( p -- p )
dup length 1 = [ [ zero? ] trim-right ] unless ; dup length 1 = [ [ zero? ] trim-tail ] unless ;
: 2ptrim ( p q -- p q ) [ ptrim ] bi@ ; : 2ptrim ( p q -- p q ) [ ptrim ] bi@ ;
: p+ ( p q -- r ) pextend v+ ; : p+ ( p q -- r ) pextend v+ ;
@ -29,7 +29,7 @@ PRIVATE>
: n*p ( n p -- n*p ) n*v ; : n*p ( n p -- n*p ) n*v ;
: pextend-conv ( p q -- p q ) : pextend-conv ( p q -- p q )
2dup [ length ] bi@ + 1- 2pad-right [ >vector ] bi@ ; 2dup [ length ] bi@ + 1- 2pad-tail [ >vector ] bi@ ;
: p* ( p q -- r ) : p* ( p q -- r )
2unempty pextend-conv <reversed> dup length 2unempty pextend-conv <reversed> dup length
@ -44,7 +44,7 @@ PRIVATE>
2ptrim 2ptrim
2dup [ length ] bi@ - 2dup [ length ] bi@ -
dup 1 < [ drop 1 ] when dup 1 < [ drop 1 ] when
[ over length + 0 pad-left pextend ] keep 1+ ; [ over length + 0 pad-head pextend ] keep 1+ ;
: /-last ( seq seq -- a ) : /-last ( seq seq -- a )
#! divide the last two numbers in the sequences #! divide the last two numbers in the sequences

4
basis/opengl/gl/gl.factor
View File

@ -356,6 +356,10 @@ CONSTANT: GL_DITHER HEX: 0BD0
CONSTANT: GL_RGB HEX: 1907 CONSTANT: GL_RGB HEX: 1907
CONSTANT: GL_RGBA HEX: 1908 CONSTANT: GL_RGBA HEX: 1908
! GL_BGRA_ext: http://www.opengl.org/registry/specs/EXT/bgra.txt
CONSTANT: GL_BGR_EXT HEX: 80E0
CONSTANT: GL_BGRA_EXT HEX: 80E1
! Implementation limits ! Implementation limits
CONSTANT: GL_MAX_LIST_NESTING HEX: 0B31 CONSTANT: GL_MAX_LIST_NESTING HEX: 0B31
CONSTANT: GL_MAX_ATTRIB_STACK_DEPTH HEX: 0D35 CONSTANT: GL_MAX_ATTRIB_STACK_DEPTH HEX: 0D35

2
basis/peg/peg.factor
View File

@ -509,7 +509,7 @@ TUPLE: sp-parser p1 ;
M: sp-parser (compile) ( peg -- quot ) M: sp-parser (compile) ( peg -- quot )
p1>> compile-parser 1quotation '[ p1>> compile-parser 1quotation '[
input-slice [ blank? ] trim-left-slice input-from pos set @ input-slice [ blank? ] trim-head-slice input-from pos set @
] ; ] ;
TUPLE: delay-parser quot ; TUPLE: delay-parser quot ;

2
basis/quoted-printable/quoted-printable.factor
View File

@ -23,7 +23,7 @@ IN: quoted-printable
: char>quoted ( ch -- str ) : char>quoted ( ch -- str )
dup printable? [ 1string ] [ dup printable? [ 1string ] [
assure-small >hex >upper assure-small >hex >upper
2 CHAR: 0 pad-left 2 CHAR: 0 pad-head
CHAR: = prefix CHAR: = prefix
] if ; ] if ;

6
basis/sequences/deep/deep-docs.factor Normal file → Executable file
View File

@ -21,10 +21,10 @@ HELP: deep-find
{ $description "Gets the first sub-node of the object, in preorder, which satisfies the quotation. If nothing satisifies it, it returns " { $link f } "." } { $description "Gets the first sub-node of the object, in preorder, which satisfies the quotation. If nothing satisifies it, it returns " { $link f } "." }
{ $see-also find } ; { $see-also find } ;
HELP: deep-contains? HELP: deep-any?
{ $values { "obj" object } { "quot" { $quotation "( elt -- ? )" } } { "?" "a boolean" } } { $values { "obj" object } { "quot" { $quotation "( elt -- ? )" } } { "?" "a boolean" } }
{ $description "Tests whether the given object or any subnode satisfies the given quotation." } { $description "Tests whether the given object or any subnode satisfies the given quotation." }
{ $see-also contains? } ; { $see-also any? } ;
HELP: flatten HELP: flatten
{ $values { "obj" object } { "seq" "a sequence" } } { $values { "obj" object } { "seq" "a sequence" } }
@ -41,7 +41,7 @@ ARTICLE: "sequences.deep" "Deep sequence combinators"
{ $subsection deep-map } { $subsection deep-map }
{ $subsection deep-filter } { $subsection deep-filter }
{ $subsection deep-find } { $subsection deep-find }
{ $subsection deep-contains? } { $subsection deep-any? }
{ $subsection deep-change-each } { $subsection deep-change-each }
"A utility word to collapse nested subsequences:" "A utility word to collapse nested subsequences:"
{ $subsection flatten } ; { $subsection flatten } ;

2
basis/sequences/deep/deep-tests.factor Normal file → Executable file
View File

@ -19,7 +19,7 @@ IN: sequences.deep.tests
[ { { "heyhello" "hihello" } } ] [ { { "heyhello" "hihello" } } ]
[ "hey" 1array 1array [ [ change-something ] deep-change-each ] keep ] unit-test [ "hey" 1array 1array [ [ change-something ] deep-change-each ] keep ] unit-test
[ t ] [ "foo" [ string? ] deep-contains? ] unit-test [ t ] [ "foo" [ string? ] deep-any? ] unit-test
[ "foo" ] [ "foo" [ string? ] deep-find ] unit-test [ "foo" ] [ "foo" [ string? ] deep-find ] unit-test

4
basis/sequences/deep/deep.factor Normal file → Executable file
View File

@ -33,10 +33,10 @@ M: object branch? drop f ;
: deep-find ( obj quot -- elt ) (deep-find) drop ; inline : deep-find ( obj quot -- elt ) (deep-find) drop ; inline
: deep-contains? ( obj quot -- ? ) (deep-find) nip ; inline : deep-any? ( obj quot -- ? ) (deep-find) nip ; inline
: deep-all? ( obj quot -- ? ) : deep-all? ( obj quot -- ? )
'[ @ not ] deep-contains? not ; inline '[ @ not ] deep-any? not ; inline
: deep-member? ( obj seq -- ? ) : deep-member? ( obj seq -- ? )
swap '[ swap '[

2
basis/soundex/soundex.factor
View File

@ -14,7 +14,7 @@ TR: soundex-tr
[ 2 <clumps> [ = not ] assoc-filter values ] [ first ] bi prefix ; [ 2 <clumps> [ = not ] assoc-filter values ] [ first ] bi prefix ;
: first>upper ( seq -- seq' ) 1 head >upper ; : first>upper ( seq -- seq' ) 1 head >upper ;
: trim-first ( seq -- seq' ) dup first [ = ] curry trim-left ; : trim-first ( seq -- seq' ) dup first [ = ] curry trim-head ;
: remove-zeroes ( seq -- seq' ) CHAR: 0 swap remove ; : remove-zeroes ( seq -- seq' ) CHAR: 0 swap remove ;
: remove-non-alpha ( seq -- seq' ) [ alpha? ] filter ; : remove-non-alpha ( seq -- seq' ) [ alpha? ] filter ;
: pad-4 ( first seq -- seq' ) "000" 3append 4 head ; : pad-4 ( first seq -- seq' ) "000" 3append 4 head ;

2
basis/stack-checker/backend/backend.factor Normal file → Executable file
View File

@ -147,7 +147,7 @@ M: object apply-object push-literal ;
{ {
{ [ dup deferred? ] [ drop f ] } { [ dup deferred? ] [ drop f ] }
{ [ dup crossref? not ] [ drop f ] } { [ dup crossref? not ] [ drop f ] }
[ def>> [ word? ] contains? ] [ def>> [ word? ] any? ]
} cond ; } cond ;
: ?missing-effect ( word -- ) : ?missing-effect ( word -- )

4
basis/stack-checker/branches/branches.factor Normal file → Executable file
View File

@ -17,7 +17,7 @@ SYMBOL: +bottom+
: pad-with-bottom ( seq -- newseq ) : pad-with-bottom ( seq -- newseq )
dup empty? [ dup empty? [
dup [ length ] map supremum dup [ length ] map supremum
'[ _ +bottom+ pad-left ] map '[ _ +bottom+ pad-head ] map
] unless ; ] unless ;
: phi-inputs ( max-d-in pairs -- newseq ) : phi-inputs ( max-d-in pairs -- newseq )
@ -108,7 +108,7 @@ M: callable infer-branch
(infer-if) (infer-if)
] [ ] [
drop 2 consume-d drop 2 consume-d
dup [ known [ curried? ] [ composed? ] bi or ] contains? [ dup [ known [ curried? ] [ composed? ] bi or ] any? [
output-d output-d
[ rot [ drop call ] [ nip call ] if ] [ rot [ drop call ] [ nip call ] if ]
infer-quot-here infer-quot-here

6
basis/stack-checker/transforms/transforms.factor Normal file → Executable file
View File

@ -125,9 +125,9 @@ IN: stack-checker.transforms
#! Can we use a fast byte array test here? #! Can we use a fast byte array test here?
{ {
{ [ dup length 8 < ] [ f ] } { [ dup length 8 < ] [ f ] }
{ [ dup [ integer? not ] contains? ] [ f ] } { [ dup [ integer? not ] any? ] [ f ] }
{ [ dup [ 0 < ] contains? ] [ f ] } { [ dup [ 0 < ] any? ] [ f ] }
{ [ dup [ bit-member-n >= ] contains? ] [ f ] } { [ dup [ bit-member-n >= ] any? ] [ f ] }
[ t ] [ t ]
} cond nip ; } cond nip ;

2
basis/syndication/syndication.factor Normal file → Executable file
View File

@ -80,7 +80,7 @@ TUPLE: entry title url description date ;
[ atom-entry-link >>url ] [ atom-entry-link >>url ]
[ [
{ "content" "summary" } any-tag-named { "content" "summary" } any-tag-named
dup children>> [ string? not ] contains? dup children>> [ string? not ] any?
[ children>> xml>string ] [ children>> xml>string ]
[ children>string ] if >>description [ children>string ] if >>description
] ]

2
basis/tools/crossref/crossref-tests.factor Normal file → Executable file
View File

@ -10,4 +10,4 @@ M: integer foo + ;
"resource:basis/tools/crossref/test/foo.factor" run-file "resource:basis/tools/crossref/test/foo.factor" run-file
[ t ] [ integer \ foo method \ + usage member? ] unit-test [ t ] [ integer \ foo method \ + usage member? ] unit-test
[ t ] [ \ foo usage [ pathname? ] contains? ] unit-test [ t ] [ \ foo usage [ pathname? ] any? ] unit-test

4
basis/tools/disassembler/udis/udis.factor
View File

@ -59,8 +59,8 @@ SINGLETON: udis-disassembler
dup [ second length ] map supremum dup [ second length ] map supremum
'[ '[
[ [
[ first >hex cell 2 * CHAR: 0 pad-left % ": " % ] [ first >hex cell 2 * CHAR: 0 pad-head % ": " % ]
[ second _ CHAR: \s pad-right % " " % ] [ second _ CHAR: \s pad-tail % " " % ]
[ third % ] [ third % ]
tri tri
] "" make ] "" make

10
basis/tools/files/files.factor
View File

@ -9,22 +9,22 @@ IN: tools.files
: dir-or-size ( file-info -- str ) : dir-or-size ( file-info -- str )
dup directory? [ dup directory? [
drop "<DIR>" 20 CHAR: \s pad-right drop "<DIR>" 20 CHAR: \s pad-tail
] [ ] [
size>> number>string 20 CHAR: \s pad-left size>> number>string 20 CHAR: \s pad-head
] if ; ] if ;
: listing-time ( timestamp -- string ) : listing-time ( timestamp -- string )
[ hour>> ] [ minute>> ] bi [ hour>> ] [ minute>> ] bi
[ number>string 2 CHAR: 0 pad-left ] bi@ ":" glue ; [ number>string 2 CHAR: 0 pad-head ] bi@ ":" glue ;
: listing-date ( timestamp -- string ) : listing-date ( timestamp -- string )
[ month>> month-abbreviation ] [ month>> month-abbreviation ]
[ day>> number>string 2 CHAR: \s pad-left ] [ day>> number>string 2 CHAR: \s pad-head ]
[ [
dup year>> dup now year>> = dup year>> dup now year>> =
[ drop listing-time ] [ nip number>string ] if [ drop listing-time ] [ nip number>string ] if
5 CHAR: \s pad-left 5 CHAR: \s pad-head
] tri 3array " " join ; ] tri 3array " " join ;
: read>string ( ? -- string ) "r" "-" ? ; inline : read>string ( ? -- string ) "r" "-" ? ; inline

6
basis/tools/hexdump/hexdump.factor
View File

@ -12,13 +12,13 @@ IN: tools.hexdump
[ >hex write "h" write nl ] bi ; [ >hex write "h" write nl ] bi ;
: write-offset ( lineno -- ) : write-offset ( lineno -- )
16 * >hex 8 CHAR: 0 pad-left write "h: " write ; 16 * >hex 8 CHAR: 0 pad-head write "h: " write ;
: >hex-digit ( digit -- str ) : >hex-digit ( digit -- str )
>hex 2 CHAR: 0 pad-left " " append ; >hex 2 CHAR: 0 pad-head " " append ;
: >hex-digits ( bytes -- str ) : >hex-digits ( bytes -- str )
[ >hex-digit ] { } map-as concat 48 CHAR: \s pad-right ; [ >hex-digit ] { } map-as concat 48 CHAR: \s pad-tail ;
: >ascii ( bytes -- str ) : >ascii ( bytes -- str )
[ [ printable? ] keep CHAR: . ? ] "" map-as ; [ [ printable? ] keep CHAR: . ? ] "" map-as ;

4
basis/tools/scaffold/scaffold.factor Normal file → Executable file
View File

@ -22,7 +22,7 @@ ERROR: no-vocab vocab ;
: contains-dot? ( string -- ? ) ".." swap subseq? ; : contains-dot? ( string -- ? ) ".." swap subseq? ;
: contains-separator? ( string -- ? ) [ path-separator? ] contains? ; : contains-separator? ( string -- ? ) [ path-separator? ] any? ;
: check-vocab-name ( string -- string ) : check-vocab-name ( string -- string )
dup contains-dot? [ vocab-name-contains-dot ] when dup contains-dot? [ vocab-name-contains-dot ] when
@ -92,7 +92,7 @@ ERROR: no-vocab vocab ;
] if ; ] if ;
: lookup-type ( string -- object/string ? ) : lookup-type ( string -- object/string ? )
"new" ?head drop [ [ CHAR: ' = ] [ digit? ] bi or ] trim-right "new" ?head drop [ [ CHAR: ' = ] [ digit? ] bi or ] trim-tail
H{ H{
{ "object" object } { "obj" object } { "object" object } { "obj" object }
{ "quot" quotation } { "quot" quotation }

4
basis/tools/vocabs/monitor/monitor.factor
View File

@ -9,8 +9,8 @@ IN: tools.vocabs.monitor
TR: convert-separators "/\\" ".." ; TR: convert-separators "/\\" ".." ;
: vocab-dir>vocab-name ( path -- vocab ) : vocab-dir>vocab-name ( path -- vocab )
trim-left-separators trim-head-separators
trim-right-separators trim-tail-separators
convert-separators ; convert-separators ;
: path>vocab-name ( path -- vocab ) : path>vocab-name ( path -- vocab )

2
basis/ui/x11/x11.factor
View File

@ -144,7 +144,7 @@ M: world selection-notify-event
: supported-type? ( atom -- ? ) : supported-type? ( atom -- ? )
{ "UTF8_STRING" "STRING" "TEXT" } { "UTF8_STRING" "STRING" "TEXT" }
[ x-atom = ] with contains? ; [ x-atom = ] with any? ;
: clipboard-for-atom ( atom -- clipboard ) : clipboard-for-atom ( atom -- clipboard )
{ {

4
basis/unicode/collation/collation.factor Normal file → Executable file
View File

@ -88,7 +88,7 @@ ducet insert-helpers
: add ( char -- ) : add ( char -- )
dup blocked? [ 1string , ] [ dup blocked? [ 1string , ] [
dup possible-bases dup length dup possible-bases dup length
[ ?combine ] with with contains? [ ?combine ] with with any?
[ drop ] [ 1string , ] if [ drop ] [ 1string , ] if
] if ; ] if ;
@ -138,7 +138,7 @@ PRIVATE>
: insensitive= ( str1 str2 levels-removed -- ? ) : insensitive= ( str1 str2 levels-removed -- ? )
[ [
[ collation-key ] dip [ collation-key ] dip
[ [ 0 = not ] trim-right but-last ] times [ [ 0 = not ] trim-tail but-last ] times
] curry bi@ = ; ] curry bi@ = ;
PRIVATE> PRIVATE>

2
basis/unicode/data/data.factor
View File

@ -72,7 +72,7 @@ VALUE: properties
: exclusions ( -- set ) : exclusions ( -- set )
exclusions-file utf8 file-lines exclusions-file utf8 file-lines
[ "#" split1 drop [ blank? ] trim-right hex> ] map harvest ; [ "#" split1 drop [ blank? ] trim-tail hex> ] map harvest ;
: remove-exclusions ( alist -- alist ) : remove-exclusions ( alist -- alist )
exclusions [ dup ] H{ } map>assoc assoc-diff ; exclusions [ dup ] H{ } map>assoc assoc-diff ;

2
basis/unix/utmpx/utmpx.factor
View File

@ -33,7 +33,7 @@ HOOK: new-utmpx-record os ( -- utmpx-record )
HOOK: utmpx>utmpx-record os ( utmpx -- utmpx-record ) HOOK: utmpx>utmpx-record os ( utmpx -- utmpx-record )
: memory>string ( alien n -- string ) : memory>string ( alien n -- string )
memory>byte-array utf8 decode [ 0 = ] trim-right ; memory>byte-array utf8 decode [ 0 = ] trim-tail ;
M: unix new-utmpx-record M: unix new-utmpx-record
utmpx-record new ; utmpx-record new ;

2
basis/urls/encoding/encoding.factor
View File

@ -37,7 +37,7 @@ IN: urls.encoding
: push-utf8 ( ch -- ) : push-utf8 ( ch -- )
1string utf8 encode 1string utf8 encode
[ CHAR: % , >hex 2 CHAR: 0 pad-left % ] each ; [ CHAR: % , >hex 2 CHAR: 0 pad-head % ] each ;
PRIVATE> PRIVATE>

2
basis/uuid/uuid.factor
View File

@ -43,7 +43,7 @@ IN: uuid
] dip 76 shift bitor ; ] dip 76 shift bitor ;
: uuid>string ( n -- string ) : uuid>string ( n -- string )
>hex 32 CHAR: 0 pad-left >hex 32 CHAR: 0 pad-head
[ CHAR: - 20 ] dip insert-nth [ CHAR: - 20 ] dip insert-nth
[ CHAR: - 16 ] dip insert-nth [ CHAR: - 16 ] dip insert-nth
[ CHAR: - 12 ] dip insert-nth [ CHAR: - 12 ] dip insert-nth

4
basis/windows/ole32/ole32.factor
View File

@ -163,10 +163,10 @@ M: ole32-error error.
] keep ; ] keep ;
: (guid-section%) ( guid quot len -- ) : (guid-section%) ( guid quot len -- )
[ call >hex ] dip CHAR: 0 pad-left % ; inline [ call >hex ] dip CHAR: 0 pad-head % ; inline
: (guid-byte%) ( guid byte -- ) : (guid-byte%) ( guid byte -- )
swap nth >hex 2 CHAR: 0 pad-left % ; inline swap nth >hex 2 CHAR: 0 pad-head % ; inline
: guid>string ( guid -- string ) : guid>string ( guid -- string )
[ [

2
basis/xml/utilities/utilities.factor Normal file → Executable file
View File

@ -8,7 +8,7 @@ IN: xml.utilities
: children>string ( tag -- string ) : children>string ( tag -- string )
children>> { children>> {
{ [ dup empty? ] [ drop "" ] } { [ dup empty? ] [ drop "" ] }
{ [ dup [ string? not ] contains? ] { [ dup [ string? not ] any? ]
[ "XML tag unexpectedly contains non-text children" throw ] } [ "XML tag unexpectedly contains non-text children" throw ] }
[ concat ] [ concat ]
} cond ; } cond ;

2
basis/xml/writer/writer.factor Normal file → Executable file
View File

@ -15,7 +15,7 @@ SYMBOL: xml-pprint?
SYMBOL: indentation SYMBOL: indentation
: sensitive? ( tag -- ? ) : sensitive? ( tag -- ? )
sensitive-tags get swap '[ _ names-match? ] contains? ; sensitive-tags get swap '[ _ names-match? ] any? ;
: indent-string ( -- string ) : indent-string ( -- string )
xml-pprint? get xml-pprint? get

4
basis/xml/xml.factor Normal file → Executable file
View File

@ -30,7 +30,7 @@ M: prolog process
: before-main? ( -- ? ) : before-main? ( -- ? )
xml-stack get { xml-stack get {
[ length 1 = ] [ length 1 = ]
[ first second [ tag? ] contains? not ] [ first second [ tag? ] any? not ]
} 1&& ; } 1&& ;
M: directive process M: directive process
@ -76,7 +76,7 @@ M: closer process
: no-post-tags ( post -- post/* ) : no-post-tags ( post -- post/* )
! this does *not* affect the contents of the stack ! this does *not* affect the contents of the stack
dup [ tag? ] contains? [ multitags ] when ; dup [ tag? ] any? [ multitags ] when ;
: assure-tags ( seq -- seq ) : assure-tags ( seq -- seq )
! this does *not* affect the contents of the stack ! this does *not* affect the contents of the stack

2
basis/xmode/marker/marker.factor Normal file → Executable file
View File

@ -15,7 +15,7 @@ ascii combinators.short-circuit accessors ;
: keyword-number? ( keyword -- ? ) : keyword-number? ( keyword -- ? )
{ {
[ current-rule-set highlight-digits?>> ] [ current-rule-set highlight-digits?>> ]
[ dup [ digit? ] contains? ] [ dup [ digit? ] any? ]
[ [
dup [ digit? ] all? [ dup [ digit? ] all? [
current-rule-set digit-re>> current-rule-set digit-re>>

6
core/assocs/assocs-docs.factor Normal file → Executable file
View File

@ -82,7 +82,7 @@ ARTICLE: "assocs-sets" "Set-theoretic operations on assocs"
{ $subsection substitute } { $subsection substitute }
{ $subsection substitute-here } { $subsection substitute-here }
{ $subsection extract-keys } { $subsection extract-keys }
{ $see-also key? assoc-contains? assoc-all? "sets" } ; { $see-also key? assoc-any? assoc-all? "sets" } ;
ARTICLE: "assocs-mutation" "Storing keys and values in assocs" ARTICLE: "assocs-mutation" "Storing keys and values in assocs"
"Utility operations built up from the " { $link "assocs-protocol" } ":" "Utility operations built up from the " { $link "assocs-protocol" } ":"
@ -115,7 +115,7 @@ $nl
{ $subsection assoc-map } { $subsection assoc-map }
{ $subsection assoc-filter } { $subsection assoc-filter }
{ $subsection assoc-filter-as } { $subsection assoc-filter-as }
{ $subsection assoc-contains? } { $subsection assoc-any? }
{ $subsection assoc-all? } { $subsection assoc-all? }
"Additional combinators:" "Additional combinators:"
{ $subsection cache } { $subsection cache }
@ -231,7 +231,7 @@ HELP: assoc-filter-as
{ assoc-filter assoc-filter-as } related-words { assoc-filter assoc-filter-as } related-words
HELP: assoc-contains? HELP: assoc-any?
{ $values { "assoc" assoc } { "quot" { $quotation "( key value -- ? )" } } { "?" "a boolean" } } { $values { "assoc" assoc } { "quot" { $quotation "( key value -- ? )" } } { "?" "a boolean" } }
{ $description "Tests if the assoc contains an entry satisfying a predicate by applying the quotation to each entry in turn. Iteration stops if an entry is found for which the quotation outputs a true value." } ; { $description "Tests if the assoc contains an entry satisfying a predicate by applying the quotation to each entry in turn. Iteration stops if an entry is found for which the quotation outputs a true value." } ;

4
core/assocs/assocs.factor Normal file → Executable file
View File

@ -70,11 +70,11 @@ PRIVATE>
[ (assoc-each) partition ] [ drop ] 2bi [ (assoc-each) partition ] [ drop ] 2bi
tuck [ assoc-like ] 2bi@ ; inline tuck [ assoc-like ] 2bi@ ; inline
: assoc-contains? ( assoc quot -- ? ) : assoc-any? ( assoc quot -- ? )
assoc-find 2nip ; inline assoc-find 2nip ; inline
: assoc-all? ( assoc quot -- ? ) : assoc-all? ( assoc quot -- ? )
[ not ] compose assoc-contains? not ; inline [ not ] compose assoc-any? not ; inline
: at ( key assoc -- value/f ) : at ( key assoc -- value/f )
at* drop ; inline at* drop ; inline

2
core/checksums/checksums.factor
View File

@ -25,4 +25,4 @@ M: checksum checksum-lines
[ normalize-path (file-reader) ] dip checksum-stream ; [ normalize-path (file-reader) ] dip checksum-stream ;
: hex-string ( seq -- str ) : hex-string ( seq -- str )
[ >hex 2 CHAR: 0 pad-left ] { } map-as concat ; [ >hex 2 CHAR: 0 pad-head ] { } map-as concat ;

8
core/classes/algebra/algebra.factor Normal file → Executable file
View File

@ -66,10 +66,10 @@ DEFER: (class-or)
[ members>> ] dip [ class<= ] curry all? ; [ members>> ] dip [ class<= ] curry all? ;
: right-anonymous-union<= ( first second -- ? ) : right-anonymous-union<= ( first second -- ? )
members>> [ class<= ] with contains? ; members>> [ class<= ] with any? ;
: left-anonymous-intersection<= ( first second -- ? ) : left-anonymous-intersection<= ( first second -- ? )
[ participants>> ] dip [ class<= ] curry contains? ; [ participants>> ] dip [ class<= ] curry any? ;
: right-anonymous-intersection<= ( first second -- ? ) : right-anonymous-intersection<= ( first second -- ? )
participants>> [ class<= ] with all? ; participants>> [ class<= ] with all? ;
@ -125,7 +125,7 @@ PREDICATE: empty-intersection < anonymous-intersection participants>> empty? ;
] if ; ] if ;
M: anonymous-union (classes-intersect?) M: anonymous-union (classes-intersect?)
members>> [ classes-intersect? ] with contains? ; members>> [ classes-intersect? ] with any? ;
M: anonymous-intersection (classes-intersect?) M: anonymous-intersection (classes-intersect?)
participants>> [ classes-intersect? ] with all? ; participants>> [ classes-intersect? ] with all? ;
@ -203,7 +203,7 @@ M: anonymous-complement (classes-intersect?)
[ class<= ] [ swap class<= ] 2bi and ; [ class<= ] [ swap class<= ] 2bi and ;
: largest-class ( seq -- n elt ) : largest-class ( seq -- n elt )
dup [ [ class< ] with contains? not ] curry find-last dup [ [ class< ] with any? not ] curry find-last
[ "Topological sort failed" throw ] unless* ; [ "Topological sort failed" throw ] unless* ;
: sort-classes ( seq -- newseq ) : sort-classes ( seq -- newseq )

2
core/classes/builtin/builtin-tests.factor Normal file → Executable file
View File

@ -6,5 +6,5 @@ USING: tools.test words sequences kernel memory accessors ;
[ [
[ name>> "f?" = ] [ name>> "f?" = ]
[ vocabulary>> "syntax" = ] bi and [ vocabulary>> "syntax" = ] bi and
] contains? ] any?
] unit-test ] unit-test

2
core/classes/tuple/tuple.factor Normal file → Executable file
View File

@ -148,7 +148,7 @@ ERROR: bad-superclass class ;
: tuple-prototype ( class -- prototype ) : tuple-prototype ( class -- prototype )
[ initial-values ] keep [ initial-values ] keep
over [ ] contains? [ slots>tuple ] [ 2drop f ] if ; over [ ] any? [ slots>tuple ] [ 2drop f ] if ;
: define-tuple-prototype ( class -- ) : define-tuple-prototype ( class -- )
dup tuple-prototype "prototype" set-word-prop ; dup tuple-prototype "prototype" set-word-prop ;

2
core/classes/union/union.factor Normal file → Executable file
View File

@ -31,7 +31,7 @@ M: union-class update-class define-union-predicate ;
M: union-class rank-class drop 2 ; M: union-class rank-class drop 2 ;
M: union-class instance? M: union-class instance?
"members" word-prop [ instance? ] with contains? ; "members" word-prop [ instance? ] with any? ;
M: union-class (flatten-class) M: union-class (flatten-class)
members <anonymous-union> (flatten-class) ; members <anonymous-union> (flatten-class) ;

4
core/combinators/combinators.factor Normal file → Executable file
View File

@ -127,9 +127,9 @@ ERROR: no-case ;
: case>quot ( default assoc -- quot ) : case>quot ( default assoc -- quot )
dup keys { dup keys {
{ [ dup empty? ] [ 2drop ] } { [ dup empty? ] [ 2drop ] }
{ [ dup [ length 4 <= ] [ [ word? ] contains? ] bi or ] [ drop linear-case-quot ] } { [ dup [ length 4 <= ] [ [ word? ] any? ] bi or ] [ drop linear-case-quot ] }
{ [ dup contiguous-range? ] [ drop dispatch-case-quot ] } { [ dup contiguous-range? ] [ drop dispatch-case-quot ] }
{ [ dup [ wrapper? ] contains? not ] [ drop hash-case-quot ] } { [ dup [ wrapper? ] any? not ] [ drop hash-case-quot ] }
{ [ dup [ wrapper? ] all? ] [ drop [ [ wrapped>> ] dip ] assoc-map hash-case-quot ] } { [ dup [ wrapper? ] all? ] [ drop [ [ wrapped>> ] dip ] assoc-map hash-case-quot ] }
[ drop linear-case-quot ] [ drop linear-case-quot ]
} cond ; } cond ;

8
core/generic/generic-tests.factor Normal file → Executable file
View File

@ -141,7 +141,7 @@ M: integer generic-forget-test-1 / ;
[ t ] [ [ t ] [
\ / usage [ word? ] filter \ / usage [ word? ] filter
[ name>> "integer=>generic-forget-test-1" = ] contains? [ name>> "integer=>generic-forget-test-1" = ] any?
] unit-test ] unit-test
[ ] [ [ ] [
@ -150,7 +150,7 @@ M: integer generic-forget-test-1 / ;
[ f ] [ [ f ] [
\ / usage [ word? ] filter \ / usage [ word? ] filter
[ name>> "integer=>generic-forget-test-1" = ] contains? [ name>> "integer=>generic-forget-test-1" = ] any?
] unit-test ] unit-test
GENERIC: generic-forget-test-2 ( a b -- c ) GENERIC: generic-forget-test-2 ( a b -- c )
@ -159,7 +159,7 @@ M: sequence generic-forget-test-2 = ;
[ t ] [ [ t ] [
\ = usage [ word? ] filter \ = usage [ word? ] filter
[ name>> "sequence=>generic-forget-test-2" = ] contains? [ name>> "sequence=>generic-forget-test-2" = ] any?
] unit-test ] unit-test
[ ] [ [ ] [
@ -168,7 +168,7 @@ M: sequence generic-forget-test-2 = ;
[ f ] [ [ f ] [
\ = usage [ word? ] filter \ = usage [ word? ] filter
[ name>> "sequence=>generic-forget-test-2" = ] contains? [ name>> "sequence=>generic-forget-test-2" = ] any?
] unit-test ] unit-test
GENERIC: generic-forget-test-3 ( a -- b ) GENERIC: generic-forget-test-3 ( a -- b )

26
core/io/pathnames/pathnames.factor
View File

@ -10,11 +10,11 @@ SYMBOL: current-directory
: path-separator ( -- string ) os windows? "\\" "/" ? ; : path-separator ( -- string ) os windows? "\\" "/" ? ;
: trim-right-separators ( str -- newstr ) : trim-tail-separators ( str -- newstr )
[ path-separator? ] trim-right ; [ path-separator? ] trim-tail ;
: trim-left-separators ( str -- newstr ) : trim-head-separators ( str -- newstr )
[ path-separator? ] trim-left ; [ path-separator? ] trim-head ;
: last-path-separator ( path -- n ? ) : last-path-separator ( path -- n ? )
[ length 1- ] keep [ path-separator? ] find-last-from ; [ length 1- ] keep [ path-separator? ] find-last-from ;
@ -28,7 +28,7 @@ ERROR: no-parent-directory path ;
: parent-directory ( path -- parent ) : parent-directory ( path -- parent )
dup root-directory? [ dup root-directory? [
trim-right-separators trim-tail-separators
dup last-path-separator [ dup last-path-separator [
1+ cut 1+ cut
] [ ] [
@ -55,7 +55,7 @@ ERROR: no-parent-directory path ;
: append-path-empty ( path1 path2 -- path' ) : append-path-empty ( path1 path2 -- path' )
{ {
{ [ dup head.? ] [ { [ dup head.? ] [
rest trim-left-separators append-path-empty rest trim-head-separators append-path-empty
] } ] }
{ [ dup head..? ] [ drop no-parent-directory ] } { [ dup head..? ] [ drop no-parent-directory ] }
[ nip ] [ nip ]
@ -84,19 +84,19 @@ PRIVATE>
{ {
{ [ over empty? ] [ append-path-empty ] } { [ over empty? ] [ append-path-empty ] }
{ [ dup empty? ] [ drop ] } { [ dup empty? ] [ drop ] }
{ [ over trim-right-separators "." = ] [ nip ] } { [ over trim-tail-separators "." = ] [ nip ] }
{ [ dup absolute-path? ] [ nip ] } { [ dup absolute-path? ] [ nip ] }
{ [ dup head.? ] [ rest trim-left-separators append-path ] } { [ dup head.? ] [ rest trim-head-separators append-path ] }
{ [ dup head..? ] [ { [ dup head..? ] [
2 tail trim-left-separators 2 tail trim-head-separators
[ parent-directory ] dip append-path [ parent-directory ] dip append-path
] } ] }
{ [ over absolute-path? over first path-separator? and ] [ { [ over absolute-path? over first path-separator? and ] [
[ 2 head ] dip append [ 2 head ] dip append
] } ] }
[ [
[ trim-right-separators "/" ] dip [ trim-tail-separators "/" ] dip
trim-left-separators 3append trim-head-separators 3append
] ]
} cond ; } cond ;
@ -105,7 +105,7 @@ PRIVATE>
: file-name ( path -- string ) : file-name ( path -- string )
dup root-directory? [ dup root-directory? [
trim-right-separators trim-tail-separators
dup last-path-separator [ 1+ tail ] [ dup last-path-separator [ 1+ tail ] [
drop "resource:" ?head [ file-name ] when drop "resource:" ?head [ file-name ] when
] if ] if
@ -121,7 +121,7 @@ GENERIC: (normalize-path) ( path -- path' )
M: string (normalize-path) M: string (normalize-path)
"resource:" ?head [ "resource:" ?head [
trim-left-separators resource-path trim-head-separators resource-path
(normalize-path) (normalize-path)
] [ ] [
current-directory get prepend-path current-directory get prepend-path

42
core/sequences/sequences-docs.factor Normal file → Executable file
View File

@ -393,7 +393,7 @@ HELP: find-last-from
{ $values { "n" "a starting index" } { "seq" sequence } { "quot" { $quotation "( elt -- ? )" } } { "i" "the index of the first match, or f" } { "elt" "the first matching element, or " { $link f } } } { $values { "n" "a starting index" } { "seq" sequence } { "quot" { $quotation "( elt -- ? )" } } { "i" "the index of the first match, or f" } { "elt" "the first matching element, or " { $link f } } }
{ $description "Applies the quotation to each element of the sequence in reverse order, until it outputs a true value or the start of the sequence is reached. If the quotation yields a true value for some sequence element, the word outputs the element index and the element itself. Otherwise, the word outputs an index of f and " { $link f } " as the element." } ; { $description "Applies the quotation to each element of the sequence in reverse order, until it outputs a true value or the start of the sequence is reached. If the quotation yields a true value for some sequence element, the word outputs the element index and the element itself. Otherwise, the word outputs an index of f and " { $link f } " as the element." } ;
HELP: contains? HELP: any?
{ $values { "seq" sequence } { "quot" { $quotation "( elt -- ? )" } } { "?" "a boolean" } } { $values { "seq" sequence } { "quot" { $quotation "( elt -- ? )" } } { "?" "a boolean" } }
{ $description "Tests if the sequence contains an element satisfying the predicate, by applying the predicate to each element in turn until a true value is found. If the sequence is empty or if the end of the sequence is reached, outputs " { $link f } "." } ; { $description "Tests if the sequence contains an element satisfying the predicate, by applying the predicate to each element in turn until a true value is found. If the sequence is empty or if the end of the sequence is reached, outputs " { $link f } "." } ;
@ -575,15 +575,15 @@ HELP: padding
{ $values { "seq" sequence } { "n" "a non-negative integer" } { "elt" object } { "quot" { $quotation "( seq1 seq2 -- newseq )" } } { "newseq" "a new sequence" } } { $values { "seq" sequence } { "n" "a non-negative integer" } { "elt" object } { "quot" { $quotation "( seq1 seq2 -- newseq )" } } { "newseq" "a new sequence" } }
{ $description "Outputs a new string sequence of " { $snippet "elt" } " repeated, that when appended to " { $snippet "seq" } ", yields a sequence of length " { $snippet "n" } ". If the length of " { $snippet "seq" } " is greater than " { $snippet "n" } ", this word outputs an empty sequence." } ; { $description "Outputs a new string sequence of " { $snippet "elt" } " repeated, that when appended to " { $snippet "seq" } ", yields a sequence of length " { $snippet "n" } ". If the length of " { $snippet "seq" } " is greater than " { $snippet "n" } ", this word outputs an empty sequence." } ;
HELP: pad-left HELP: pad-head
{ $values { "seq" sequence } { "n" "a non-negative integer" } { "elt" object } { "padded" "a new sequence" } } { $values { "seq" sequence } { "n" "a non-negative integer" } { "elt" object } { "padded" "a new sequence" } }
{ $description "Outputs a new sequence consisting of " { $snippet "seq" } " padded on the left with enough repetitions of " { $snippet "elt" } " to have the result be of length " { $snippet "n" } "." } { $description "Outputs a new sequence consisting of " { $snippet "seq" } " padded on the left with enough repetitions of " { $snippet "elt" } " to have the result be of length " { $snippet "n" } "." }
{ $examples { $example "USING: io sequences ;" "{ \"ab\" \"quux\" } [ 5 CHAR: - pad-left print ] each" "---ab\n-quux" } } ; { $examples { $example "USING: io sequences ;" "{ \"ab\" \"quux\" } [ 5 CHAR: - pad-head print ] each" "---ab\n-quux" } } ;
HELP: pad-right HELP: pad-tail
{ $values { "seq" sequence } { "n" "a non-negative integer" } { "elt" object } { "padded" "a new sequence" } } { $values { "seq" sequence } { "n" "a non-negative integer" } { "elt" object } { "padded" "a new sequence" } }
{ $description "Outputs a new sequence consisting of " { $snippet "seq" } " padded on the right with enough repetitions of " { $snippet "elt" } " to have the result be of length " { $snippet "n" } "." } { $description "Outputs a new sequence consisting of " { $snippet "seq" } " padded on the right with enough repetitions of " { $snippet "elt" } " to have the result be of length " { $snippet "n" } "." }
{ $examples { $example "USING: io sequences ;" "{ \"ab\" \"quux\" } [ 5 CHAR: - pad-right print ] each" "ab---\nquux-" } } ; { $examples { $example "USING: io sequences ;" "{ \"ab\" \"quux\" } [ 5 CHAR: - pad-tail print ] each" "ab---\nquux-" } } ;
HELP: sequence= HELP: sequence=
{ $values { "seq1" sequence } { "seq2" sequence } { "?" "a boolean" } } { $values { "seq1" sequence } { "seq2" sequence } { "?" "a boolean" } }
@ -960,43 +960,43 @@ HELP: pusher
} }
{ $notes "Used to implement the " { $link filter } " word." } ; { $notes "Used to implement the " { $link filter } " word." } ;
HELP: trim-left HELP: trim-head
{ $values { $values
{ "seq" sequence } { "quot" quotation } { "seq" sequence } { "quot" quotation }
{ "newseq" sequence } } { "newseq" sequence } }
{ $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 new sequence." } { $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 new sequence." }
{ $example "" "USING: prettyprint math sequences ;" { $example "" "USING: prettyprint math sequences ;"
"{ 0 0 1 2 3 0 0 } [ zero? ] trim-left ." "{ 0 0 1 2 3 0 0 } [ zero? ] trim-head ."
"{ 1 2 3 0 0 }" "{ 1 2 3 0 0 }"
} ; } ;
HELP: trim-left-slice HELP: trim-head-slice
{ $values { $values
{ "seq" sequence } { "quot" quotation } { "seq" sequence } { "quot" quotation }
{ "slice" slice } } { "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" } { $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 ;" { $example "" "USING: prettyprint math sequences ;"
"{ 0 0 1 2 3 0 0 } [ zero? ] trim-left-slice ." "{ 0 0 1 2 3 0 0 } [ zero? ] trim-head-slice ."
"T{ slice { from 2 } { to 7 } { seq { 0 0 1 2 3 0 0 } } }" "T{ slice { from 2 } { to 7 } { seq { 0 0 1 2 3 0 0 } } }"
} ; } ;
HELP: trim-right HELP: trim-tail
{ $values { $values
{ "seq" sequence } { "quot" quotation } { "seq" sequence } { "quot" quotation }
{ "newseq" sequence } } { "newseq" sequence } }
{ $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 new sequence." } { $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 new sequence." }
{ $example "" "USING: prettyprint math sequences ;" { $example "" "USING: prettyprint math sequences ;"
"{ 0 0 1 2 3 0 0 } [ zero? ] trim-right ." "{ 0 0 1 2 3 0 0 } [ zero? ] trim-tail ."
"{ 0 0 1 2 3 }" "{ 0 0 1 2 3 }"
} ; } ;
HELP: trim-right-slice HELP: trim-tail-slice
{ $values { $values
{ "seq" sequence } { "quot" quotation } { "seq" sequence } { "quot" quotation }
{ "slice" slice } } { "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." } { $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 ;" { $example "" "USING: prettyprint math sequences ;"
"{ 0 0 1 2 3 0 0 } [ zero? ] trim-right-slice ." "{ 0 0 1 2 3 0 0 } [ zero? ] trim-tail-slice ."
"T{ slice { from 0 } { to 5 } { seq { 0 0 1 2 3 0 0 } } }" "T{ slice { from 0 } { to 5 } { seq { 0 0 1 2 3 0 0 } } }"
} ; } ;
@ -1020,7 +1020,7 @@ HELP: trim-slice
"T{ slice { from 2 } { to 5 } { seq { 0 0 1 2 3 0 0 } } }" "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 { trim trim-slice trim-head trim-head-slice trim-tail trim-tail-slice } related-words
HELP: sift HELP: sift
{ $values { $values
@ -1407,8 +1407,8 @@ ARTICLE: "sequences-appending" "Appending sequences"
{ $subsection concat } { $subsection concat }
{ $subsection join } { $subsection join }
"A pair of words useful for aligning strings:" "A pair of words useful for aligning strings:"
{ $subsection pad-left } { $subsection pad-head }
{ $subsection pad-right } ; { $subsection pad-tail } ;
ARTICLE: "sequences-slices" "Subsequences and slices" ARTICLE: "sequences-slices" "Subsequences and slices"
"Extracting a subsequence:" "Extracting a subsequence:"
@ -1463,7 +1463,7 @@ ARTICLE: "sequences-combinators" "Sequence combinators"
{ $subsection push-if } { $subsection push-if }
{ $subsection filter } { $subsection filter }
"Testing if a sequence contains elements satisfying a predicate:" "Testing if a sequence contains elements satisfying a predicate:"
{ $subsection contains? } { $subsection any? }
{ $subsection all? } { $subsection all? }
{ $subsection "sequence-2combinators" } { $subsection "sequence-2combinators" }
{ $subsection "sequence-3combinators" } ; { $subsection "sequence-3combinators" } ;
@ -1513,12 +1513,12 @@ ARTICLE: "sequences-search" "Searching sequences"
ARTICLE: "sequences-trimming" "Trimming sequences" ARTICLE: "sequences-trimming" "Trimming sequences"
"Trimming words:" "Trimming words:"
{ $subsection trim } { $subsection trim }
{ $subsection trim-left } { $subsection trim-head }
{ $subsection trim-right } { $subsection trim-tail }
"Potentially more efficient trim:" "Potentially more efficient trim:"
{ $subsection trim-slice } { $subsection trim-slice }
{ $subsection trim-left-slice } { $subsection trim-head-slice }
{ $subsection trim-right-slice } ; { $subsection trim-tail-slice } ;
ARTICLE: "sequences-destructive-discussion" "When to use destructive operations" ARTICLE: "sequences-destructive-discussion" "When to use destructive operations"
"Constructive (non-destructive) operations should be preferred where possible because code without side-effects is usually more re-usable and easier to reason about. There are two main reasons to use destructive operations:" "Constructive (non-destructive) operations should be preferred where possible because code without side-effects is usually more re-usable and easier to reason about. There are two main reasons to use destructive operations:"

12
core/sequences/sequences-tests.factor
View File

@ -225,13 +225,13 @@ unit-test
[ -1./0. 0 delete-nth ] must-fail [ -1./0. 0 delete-nth ] must-fail
[ "" ] [ "" [ CHAR: \s = ] trim ] unit-test [ "" ] [ "" [ CHAR: \s = ] trim ] unit-test
[ "" ] [ "" [ CHAR: \s = ] trim-left ] unit-test [ "" ] [ "" [ CHAR: \s = ] trim-head ] unit-test
[ "" ] [ "" [ CHAR: \s = ] trim-right ] unit-test [ "" ] [ "" [ CHAR: \s = ] trim-tail ] unit-test
[ "" ] [ " " [ CHAR: \s = ] trim-left ] unit-test [ "" ] [ " " [ CHAR: \s = ] trim-head ] unit-test
[ "" ] [ " " [ CHAR: \s = ] trim-right ] unit-test [ "" ] [ " " [ CHAR: \s = ] trim-tail ] unit-test
[ "asdf" ] [ " asdf " [ CHAR: \s = ] trim ] unit-test [ "asdf" ] [ " asdf " [ CHAR: \s = ] trim ] unit-test
[ "asdf " ] [ " asdf " [ CHAR: \s = ] trim-left ] unit-test [ "asdf " ] [ " asdf " [ CHAR: \s = ] trim-head ] unit-test
[ " asdf" ] [ " asdf " [ CHAR: \s = ] trim-right ] unit-test [ " asdf" ] [ " asdf " [ CHAR: \s = ] trim-tail ] unit-test
[ 328350 ] [ 100 [ sq ] sigma ] unit-test [ 328350 ] [ 100 [ sq ] sigma ] unit-test

24
core/sequences/sequences.factor Normal file → Executable file
View File

@ -524,14 +524,14 @@ PRIVATE>
: nths ( indices seq -- seq' ) : nths ( indices seq -- seq' )
[ nth ] curry map ; [ nth ] curry map ;
: contains? ( seq quot -- ? ) : any? ( seq quot -- ? )
find drop >boolean ; inline find drop >boolean ; inline
: member? ( elt seq -- ? ) : member? ( elt seq -- ? )
[ = ] with contains? ; [ = ] with any? ;
: memq? ( elt seq -- ? ) : memq? ( elt seq -- ? )
[ eq? ] with contains? ; [ eq? ] with any? ;
: remove ( elt seq -- newseq ) : remove ( elt seq -- newseq )
[ = not ] with filter ; [ = not ] with filter ;
@ -711,10 +711,10 @@ PRIVATE>
[ <repetition> ] curry [ <repetition> ] curry
] dip compose if ; inline ] dip compose if ; inline
: pad-left ( seq n elt -- padded ) : pad-head ( seq n elt -- padded )
[ swap dup append-as ] padding ; [ swap dup append-as ] padding ;
: pad-right ( seq n elt -- padded ) : pad-tail ( seq n elt -- padded )
[ append ] padding ; [ append ] padding ;
: shorter? ( seq1 seq2 -- ? ) [ length ] bi@ < ; : shorter? ( seq1 seq2 -- ? ) [ length ] bi@ < ;
@ -816,22 +816,22 @@ PRIVATE>
dup slice? [ { } like ] when 0 over length rot <slice> ; dup slice? [ { } like ] when 0 over length rot <slice> ;
inline inline
: trim-left-slice ( seq quot -- slice ) : trim-head-slice ( seq quot -- slice )
over [ [ not ] compose find drop ] dip swap over [ [ not ] compose find drop ] dip swap
[ tail-slice ] [ dup length tail-slice ] if* ; inline [ tail-slice ] [ dup length tail-slice ] if* ; inline
: trim-left ( seq quot -- newseq ) : trim-head ( seq quot -- newseq )
over [ trim-left-slice ] dip like ; inline over [ trim-head-slice ] dip like ; inline
: trim-right-slice ( seq quot -- slice ) : trim-tail-slice ( seq quot -- slice )
over [ [ not ] compose find-last drop ] dip swap over [ [ not ] compose find-last drop ] dip swap
[ 1+ head-slice ] [ 0 head-slice ] if* ; inline [ 1+ head-slice ] [ 0 head-slice ] if* ; inline
: trim-right ( seq quot -- newseq ) : trim-tail ( seq quot -- newseq )
over [ trim-right-slice ] dip like ; inline over [ trim-tail-slice ] dip like ; inline
: trim-slice ( seq quot -- slice ) : trim-slice ( seq quot -- slice )
[ trim-left-slice ] [ trim-right-slice ] bi ; inline [ trim-head-slice ] [ trim-tail-slice ] bi ; inline
: trim ( seq quot -- newseq ) : trim ( seq quot -- newseq )
over [ trim-slice ] dip like ; inline over [ trim-slice ] dip like ; inline

2
core/sets/sets-docs.factor Normal file → Executable file
View File

@ -22,7 +22,7 @@ $nl
"Adding elements to sets:" "Adding elements to sets:"
{ $subsection adjoin } { $subsection adjoin }
{ $subsection conjoin } { $subsection conjoin }
{ $see-also member? memq? contains? all? "assocs-sets" } ; { $see-also member? memq? any? all? "assocs-sets" } ;
ABOUT: "sets" ABOUT: "sets"

2
core/sets/sets.factor Normal file → Executable file
View File

@ -41,7 +41,7 @@ PRIVATE>
tester filter ; tester filter ;
: intersects? ( seq1 seq2 -- ? ) : intersects? ( seq1 seq2 -- ? )
tester contains? ; tester any? ;
: diff ( seq1 seq2 -- newseq ) : diff ( seq1 seq2 -- newseq )
tester [ not ] compose filter ; tester [ not ] compose filter ;

4
core/strings/strings-tests.factor
View File

@ -43,8 +43,8 @@ IN: strings.tests
] ]
unit-test unit-test
[ "05" ] [ "5" 2 CHAR: 0 pad-left ] unit-test [ "05" ] [ "5" 2 CHAR: 0 pad-head ] unit-test
[ "666" ] [ "666" 2 CHAR: 0 pad-left ] unit-test [ "666" ] [ "666" 2 CHAR: 0 pad-head ] unit-test
[ 1 "" nth ] must-fail [ 1 "" nth ] must-fail
[ -6 "hello" nth ] must-fail [ -6 "hello" nth ] must-fail

2
core/words/words-tests.factor Normal file → Executable file
View File

@ -188,7 +188,7 @@ SYMBOL: quot-uses-b
[ [
all-words [ all-words [
"compiled-uses" word-prop "compiled-uses" word-prop
keys [ "forgotten" word-prop ] contains? keys [ "forgotten" word-prop ] any?
] filter ] filter
] unit-test ] unit-test

2
core/words/words.factor Normal file → Executable file
View File

@ -144,7 +144,7 @@ SYMBOL: visited
crossref get at keys crossref get at keys
[ word? ] filter [ word? ] filter
[ [
[ reset-on-redefine [ word-prop ] with contains? ] [ reset-on-redefine [ word-prop ] with any? ]
[ inline? ] [ inline? ]
bi or bi or
] filter ] filter

2
extra/automata/automata.factor
View File

@ -22,7 +22,7 @@ VAR: rule VAR: rule-number
{ 0 0 1 } { 0 0 1 }
{ 0 0 0 } } ; { 0 0 0 } } ;
: rule-values ( n -- seq ) >bin 8 CHAR: 0 pad-left string>digits ; : rule-values ( n -- seq ) >bin 8 CHAR: 0 pad-head string>digits ;
: set-rule ( n -- ) : set-rule ( n -- )
dup >rule-number rule-values rule-keys [ rule> set-at ] 2each ; dup >rule-number rule-values rule-keys [ rule> set-at ] 2each ;

4
extra/benchmark/beust2/beust2.factor Normal file → Executable file
View File

@ -26,10 +26,10 @@ IN: benchmark.beust2
] if ] if
] [ f ] if ] [ f ] if
] ]
] contains? ; inline recursive ] any? ; inline recursive
:: count-numbers ( max listener -- ) :: count-numbers ( max listener -- )
10 [ 1+ 1 1 0 max listener (count-numbers) ] contains? drop ; 10 [ 1+ 1 1 0 max listener (count-numbers) ] any? drop ;
inline inline
:: beust ( -- ) :: beust ( -- )

2
extra/benchmark/knucleotide/knucleotide.factor
View File

@ -8,7 +8,7 @@ IN: benchmark.knucleotide
swap >float number>string swap >float number>string
"." split1 rot "." split1 rot
over length over < over length over <
[ CHAR: 0 pad-right ] [ CHAR: 0 pad-tail ]
[ head ] if "." glue ; [ head ] if "." glue ;
: discard-lines ( -- ) : discard-lines ( -- )

2
extra/boolean-expr/boolean-expr.factor
View File

@ -74,7 +74,7 @@ METHOD: satisfiable? { ⊥ } drop f ;
[ \ ¬ instance? ] partition [ x>> ] map intersect empty? ; [ \ ¬ instance? ] partition [ x>> ] map intersect empty? ;
METHOD: satisfiable? { □ } METHOD: satisfiable? { □ }
cnf [ (satisfiable?) ] contains? ; cnf [ (satisfiable?) ] any? ;
GENERIC: (expr.) ( expr -- ) GENERIC: (expr.) ( expr -- )

2
extra/crypto/hmac/hmac.factor
View File

@ -27,7 +27,7 @@ MEMO: ipad ( -- seq ) 64 HEX: 36 <array> ;
MEMO: opad ( -- seq ) 64 HEX: 5c <array> ; MEMO: opad ( -- seq ) 64 HEX: 5c <array> ;
: init-hmac ( K -- o i ) : init-hmac ( K -- o i )
64 0 pad-right 64 0 pad-tail
[ opad seq-bitxor ] keep [ opad seq-bitxor ] keep
ipad seq-bitxor ; ipad seq-bitxor ;

Some files were not shown because too many files have changed in this diff Show More