From 15402ed1b4c876dbe5d3fc465e87292a79f670f4 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 25 Apr 2008 23:12:44 -0500 Subject: [PATCH] core changes: index* -> index-from last-index* -> last-index-from 1 tail -> rest 1 tail-slice -> rest-slice subset -> filter prepose find* -> find-from find-last* -> find-last-from before, after generic, < for integers make between? work for timestamps --- core/alien/syntax/syntax.factor | 2 +- core/assocs/assocs-docs.factor | 4 +- core/assocs/assocs-tests.factor | 4 +- core/assocs/assocs.factor | 8 +- core/bootstrap/compiler/compiler.factor | 4 +- core/bootstrap/image/image.factor | 2 +- core/bootstrap/primitives.factor | 2 +- core/bootstrap/stage2.factor | 4 +- core/classes/algebra/algebra.factor | 4 +- core/classes/classes.factor | 2 +- core/classes/mixin/mixin.factor | 2 +- core/classes/tuple/tuple.factor | 2 +- core/combinators/combinators.factor | 4 +- core/command-line/command-line.factor | 2 +- core/compiler/errors/errors.factor | 2 +- core/compiler/tests/intrinsics.factor | 4 +- core/compiler/tests/stack-trace.factor | 4 +- core/compiler/units/units.factor | 4 +- core/cpu/x86/64/64.factor | 2 +- core/cpu/x86/architecture/architecture.factor | 3 +- core/cpu/x86/assembler/assembler.factor | 2 +- core/debugger/debugger.factor | 3 +- core/definitions/definitions-tests.factor | 2 +- core/dlists/dlists.factor | 2 +- core/generator/fixup/fixup.factor | 2 +- core/generator/registers/registers.factor | 6 +- core/generic/generic-tests.factor | 8 +- core/generic/generic.factor | 4 +- core/generic/math/math.factor | 2 +- core/generic/standard/engines/engines.factor | 4 +- core/hashtables/hashtables-tests.factor | 2 +- core/heaps/heaps-docs.factor | 3 +- core/heaps/heaps.factor | 2 +- core/inference/backend/backend.factor | 6 +- core/inference/class/class.factor | 2 +- core/inference/dataflow/dataflow.factor | 2 +- core/inspector/inspector.factor | 2 +- core/io/files/files-tests.factor | 4 +- core/io/files/files.factor | 6 +- core/io/streams/string/string.factor | 2 +- core/kernel/kernel-docs.factor | 23 +----- core/kernel/kernel.factor | 7 +- core/layouts/layouts.factor | 2 +- core/math/intervals/intervals-docs.factor | 2 +- core/math/intervals/intervals-tests.factor | 4 +- core/math/intervals/intervals.factor | 2 +- core/math/math-docs.factor | 39 --------- core/math/math.factor | 22 +---- core/optimizer/backend/backend.factor | 2 +- core/optimizer/control/control.factor | 4 +- core/optimizer/def-use/def-use.factor | 4 +- core/optimizer/math/partial/partial.factor | 4 +- .../specializers/specializers.factor | 2 +- core/parser/parser.factor | 12 +-- core/prettyprint/backend/backend.factor | 2 +- core/prettyprint/prettyprint.factor | 2 +- core/prettyprint/sections/sections.factor | 4 +- core/quotations/quotations.factor | 6 +- core/sequences/sequences-docs.factor | 45 +++++++---- core/sequences/sequences-tests.factor | 21 +++-- core/sequences/sequences.factor | 80 ++++++++++--------- core/sets/sets.factor | 4 +- core/slots/deprecated/deprecated.factor | 2 +- core/sorting/sorting-docs.factor | 5 +- core/sorting/sorting.factor | 2 +- core/source-files/source-files.factor | 2 +- core/splitting/splitting.factor | 4 +- core/strings/strings-tests.factor | 2 + core/threads/threads.factor | 5 +- core/vocabs/vocabs.factor | 4 +- core/words/words-tests.factor | 4 +- core/words/words.factor | 11 +-- 72 files changed, 205 insertions(+), 260 deletions(-) diff --git a/core/alien/syntax/syntax.factor b/core/alien/syntax/syntax.factor index f0f495cac9..b2e819f8fb 100755 --- a/core/alien/syntax/syntax.factor +++ b/core/alien/syntax/syntax.factor @@ -40,7 +40,7 @@ PRIVATE> : FUNCTION: scan "c-library" get scan ";" parse-tokens - [ "()" subseq? not ] subset + [ "()" subseq? not ] filter define-function ; parsing : TYPEDEF: diff --git a/core/assocs/assocs-docs.factor b/core/assocs/assocs-docs.factor index 863fdaecb3..f06cc70613 100755 --- a/core/assocs/assocs-docs.factor +++ b/core/assocs/assocs-docs.factor @@ -96,7 +96,7 @@ $nl { $subsection assoc-each } { $subsection assoc-map } { $subsection assoc-push-if } -{ $subsection assoc-subset } +{ $subsection assoc-filter } { $subsection assoc-contains? } { $subsection assoc-all? } "Three additional combinators:" @@ -203,7 +203,7 @@ HELP: assoc-push-if { $values { "accum" "a resizable mutable sequence" } { "quot" "a quotation with stack effect " { $snippet "( key value -- ? )" } } { "key" object } { "value" object } } { $description "If the quotation yields true when applied to the key/value pair, adds the key/value pair at the end of " { $snippet "accum" } "." } ; -HELP: assoc-subset +HELP: assoc-filter { $values { "assoc" assoc } { "quot" "a quotation with stack effect " { $snippet "( key value -- ? )" } } { "subassoc" "a new assoc" } } { $description "Outputs an assoc of the same type as " { $snippet "assoc" } " consisting of all entries for which the predicate quotation yields true." } ; diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor index 76f484006d..19e323bdae 100755 --- a/core/assocs/assocs-tests.factor +++ b/core/assocs/assocs-tests.factor @@ -30,10 +30,10 @@ continuations ; [ t ] [ H{ { 1 1 } { 2 2 } } [ = ] assoc-all? ] unit-test [ f ] [ H{ { 1 2 } { 2 2 } } [ = ] assoc-all? ] unit-test -[ H{ } ] [ H{ { t f } { f t } } [ 2drop f ] assoc-subset ] unit-test +[ H{ } ] [ H{ { t f } { f t } } [ 2drop f ] assoc-filter ] unit-test [ H{ { 3 4 } { 4 5 } { 6 7 } } ] [ H{ { 1 2 } { 2 3 } { 3 4 } { 4 5 } { 6 7 } } - [ drop 3 >= ] assoc-subset + [ drop 3 >= ] assoc-filter ] unit-test [ 21 ] [ diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 4a6ecae4fe..a58dfea900 100755 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -50,7 +50,7 @@ M: assoc assoc-find : assoc-pusher ( quot -- quot' accum ) V{ } clone [ [ assoc-push-if ] 2curry ] keep ; inline -: assoc-subset ( assoc quot -- subassoc ) +: assoc-filter ( assoc quot -- subassoc ) over >r assoc-pusher >r assoc-each r> r> assoc-like ; inline : assoc-contains? ( assoc quot -- ? ) @@ -110,7 +110,7 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) ] { } assoc>map hashcode* ; : assoc-intersect ( assoc1 assoc2 -- intersection ) - swap [ nip key? ] curry assoc-subset ; + swap [ nip key? ] curry assoc-filter ; : update ( assoc1 assoc2 -- ) swap [ swapd set-at ] curry assoc-each ; @@ -120,10 +120,10 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) [ rot update ] keep [ swap update ] keep ; : assoc-diff ( assoc1 assoc2 -- diff ) - swap [ nip key? not ] curry assoc-subset ; + swap [ nip key? not ] curry assoc-filter ; : remove-all ( assoc seq -- subseq ) - swap [ key? not ] curry subset ; + swap [ key? not ] curry filter ; : (substitute) [ dupd at* [ nip ] [ drop ] if ] curry ; inline diff --git a/core/bootstrap/compiler/compiler.factor b/core/bootstrap/compiler/compiler.factor index da3c634ebd..a19ffe742e 100755 --- a/core/bootstrap/compiler/compiler.factor +++ b/core/bootstrap/compiler/compiler.factor @@ -5,7 +5,7 @@ namespaces parser kernel kernel.private classes classes.private arrays hashtables vectors classes.tuple sbufs inference.dataflow hashtables.private sequences.private math classes.tuple.private growable namespaces.private assocs words generator command-line -vocabs io prettyprint libc compiler.units ; +vocabs io prettyprint libc compiler.units math.order ; IN: bootstrap.compiler ! Don't bring this in when deploying, since it will store a @@ -74,6 +74,6 @@ nl malloc calloc free memcpy } compile -vocabs [ words [ compiled? not ] subset compile "." write flush ] each +vocabs [ words [ compiled? not ] filter compile "." write flush ] each " done" print flush diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index 05d48af2e8..46ed34c35c 100755 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -8,7 +8,7 @@ splitting growable classes classes.builtin classes.tuple classes.tuple.private words.private io.binary io.files vocabs vocabs.loader source-files definitions debugger float-arrays quotations.private sequences.private combinators -io.encodings.binary ; +io.encodings.binary math.order ; IN: bootstrap.image : my-arch ( -- arch ) diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index dd3a4adf8b..bcd75e9854 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -157,7 +157,7 @@ num-types get f builtins set ! Catch-all class for providing a default method. "object" "kernel" create -[ f builtins get [ ] subset union-class define-class ] +[ f builtins get [ ] filter union-class define-class ] [ [ drop t ] "predicate" set-word-prop ] bi diff --git a/core/bootstrap/stage2.factor b/core/bootstrap/stage2.factor index dfd2e4be6f..8e16417ca6 100755 --- a/core/bootstrap/stage2.factor +++ b/core/bootstrap/stage2.factor @@ -23,12 +23,12 @@ SYMBOL: bootstrap-time : load-components ( -- ) "exclude" "include" - [ get-global " " split [ empty? not ] subset ] bi@ + [ get-global " " split [ empty? not ] filter ] bi@ diff [ "bootstrap." prepend require ] each ; : count-words ( pred -- ) - all-words swap subset length number>string write ; + all-words swap filter length number>string write ; : print-report ( time -- ) 1000 /i diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor index f2941e3cef..6a286e3204 100755 --- a/core/classes/algebra/algebra.factor +++ b/core/classes/algebra/algebra.factor @@ -183,7 +183,7 @@ C: anonymous-complement : largest-class ( seq -- n elt ) dup [ [ 2dup class< >r swap class< not r> and ] - with subset empty? + with filter empty? ] curry find [ "Topological sort failed" throw ] unless* ; : sort-classes ( seq -- newseq ) @@ -193,7 +193,7 @@ C: anonymous-complement [ ] unfold nip ; : min-class ( class seq -- class/f ) - over [ classes-intersect? ] curry subset + over [ classes-intersect? ] curry filter dup empty? [ 2drop f ] [ tuck [ class< ] with all? [ peek ] [ drop f ] if ] if ; diff --git a/core/classes/classes.factor b/core/classes/classes.factor index 4f43b86f64..c998a1b155 100755 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -33,7 +33,7 @@ PREDICATE: class < word PREDICATE: tuple-class < class "metaclass" word-prop tuple-class eq? ; -: classes ( -- seq ) all-words [ class? ] subset ; +: classes ( -- seq ) all-words [ class? ] filter ; : predicate-word ( word -- predicate ) [ word-name "?" append ] keep word-vocabulary create ; diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor index 33b0fc32fa..ca2547bacf 100755 --- a/core/classes/mixin/mixin.factor +++ b/core/classes/mixin/mixin.factor @@ -31,7 +31,7 @@ TUPLE: check-mixin-class mixin ; >r >r check-mixin-class 2dup members memq? r> r> if ; inline : change-mixin-class ( class mixin quot -- ) - [ members swap bootstrap-word ] swap compose keep + [ members swap bootstrap-word ] prepose keep swap redefine-mixin-class ; inline : add-mixin-instance ( class mixin -- ) diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index c14205e1d9..8bcf023131 100755 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -166,7 +166,7 @@ M: tuple-class update-class 3tri ; : subclasses ( class -- classes ) - class-usages keys [ tuple-class? ] subset ; + class-usages keys [ tuple-class? ] filter ; : each-subclass ( class quot -- ) >r subclasses r> each ; inline diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor index da98a78736..d33edfab30 100755 --- a/core/combinators/combinators.factor +++ b/core/combinators/combinators.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -IN: combinators USING: arrays sequences sequences.private math.private kernel kernel.private math assocs quotations vectors -hashtables sorting words sets ; +hashtables sorting words sets math.order ; +IN: combinators : cleave ( x seq -- ) [ call ] with each ; diff --git a/core/command-line/command-line.factor b/core/command-line/command-line.factor index 246bf2dabe..f4aef6292d 100644 --- a/core/command-line/command-line.factor +++ b/core/command-line/command-line.factor @@ -54,7 +54,7 @@ SYMBOL: main-vocab-hook "none" "run" set-global ; : parse-command-line ( -- ) - cli-args [ cli-arg ] subset + cli-args [ cli-arg ] filter "script" get [ script-mode ] when ignore-cli-args? [ drop ] [ [ run-file ] each ] if "e" get [ eval ] when* ; diff --git a/core/compiler/errors/errors.factor b/core/compiler/errors/errors.factor index b7b599e5a9..e7dc5156e4 100755 --- a/core/compiler/errors/errors.factor +++ b/core/compiler/errors/errors.factor @@ -27,7 +27,7 @@ SYMBOL: with-compiler-errors? : errors-of-type ( type -- assoc ) compiler-errors get-global swap [ >r nip compiler-error-type r> eq? ] curry - assoc-subset ; + assoc-filter ; : compiler-errors. ( type -- ) errors-of-type >alist sort-keys diff --git a/core/compiler/tests/intrinsics.factor b/core/compiler/tests/intrinsics.factor index 7d473871fe..6fb6afe0c6 100755 --- a/core/compiler/tests/intrinsics.factor +++ b/core/compiler/tests/intrinsics.factor @@ -1,11 +1,11 @@ -IN: compiler.tests USING: arrays compiler.units kernel kernel.private math math.constants math.private sequences strings tools.test words continuations sequences.private hashtables.private byte-arrays strings.private system random layouts vectors.private -sbufs.private strings.private slots.private alien +sbufs.private strings.private slots.private alien math.order alien.accessors alien.c-types alien.syntax alien.strings namespaces libc sequences.private io.encodings.ascii ; +IN: compiler.tests ! Make sure that intrinsic ops compile to correct code. [ ] [ 1 [ drop ] compile-call ] unit-test diff --git a/core/compiler/tests/stack-trace.factor b/core/compiler/tests/stack-trace.factor index f54ac62204..9ee774d81d 100755 --- a/core/compiler/tests/stack-trace.factor +++ b/core/compiler/tests/stack-trace.factor @@ -13,11 +13,11 @@ words splitting sorting ; [ baz ] [ 3 = ] must-fail-with [ t ] [ symbolic-stack-trace - [ word? ] subset + [ word? ] filter { baz bar foo throw } tail? ] unit-test -: bleh [ 3 + ] map [ 0 > ] subset ; +: bleh [ 3 + ] map [ 0 > ] filter ; : stack-trace-contains? symbolic-stack-trace memq? ; diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index 65e57a8912..a31cd8de16 100755 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -53,7 +53,7 @@ GENERIC: definitions-changed ( assoc obj -- ) [ definitions-changed ] with each ; : changed-vocabs ( assoc -- vocabs ) - [ drop word? ] assoc-subset + [ drop word? ] assoc-filter [ drop word-vocabulary dup [ vocab ] when dup ] assoc-map ; : updated-definitions ( -- assoc ) @@ -73,7 +73,7 @@ SYMBOL: outdated-tuples SYMBOL: update-tuples-hook : call-recompile-hook ( -- ) - changed-definitions get keys [ word? ] subset + changed-definitions get keys [ word? ] filter compiled-usages recompile-hook get call ; : call-update-tuples-hook ( -- ) diff --git a/core/cpu/x86/64/64.factor b/core/cpu/x86/64/64.factor index d79ce58d88..5f396e7751 100755 --- a/core/cpu/x86/64/64.factor +++ b/core/cpu/x86/64/64.factor @@ -181,7 +181,7 @@ stack-params "__stack_value" c-type set-c-type-reg-class >> : split-struct ( pairs -- seq ) [ [ 8 mod zero? [ t , ] when , ] assoc-each - ] { } make { t } split [ empty? not ] subset ; + ] { } make { t } split [ empty? not ] filter ; : flatten-large-struct ( type -- ) heap-size cell align diff --git a/core/cpu/x86/architecture/architecture.factor b/core/cpu/x86/architecture/architecture.factor index 7e7ff8a334..f0ca47a1ba 100755 --- a/core/cpu/x86/architecture/architecture.factor +++ b/core/cpu/x86/architecture/architecture.factor @@ -3,7 +3,8 @@ USING: alien alien.c-types alien.compiler arrays cpu.x86.assembler cpu.architecture kernel kernel.private math memory namespaces sequences words generator generator.registers -generator.fixup system layouts combinators compiler.constants ; +generator.fixup system layouts combinators compiler.constants +math.order ; IN: cpu.x86.architecture HOOK: ds-reg cpu diff --git a/core/cpu/x86/assembler/assembler.factor b/core/cpu/x86/assembler/assembler.factor index 3ad7d4f7b5..cabd81dad6 100755 --- a/core/cpu/x86/assembler/assembler.factor +++ b/core/cpu/x86/assembler/assembler.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays generator.fixup io.binary kernel combinators kernel.private math namespaces parser sequences -words system layouts ; +words system layouts math.order ; IN: cpu.x86.assembler ! A postfix assembler for x86 and AMD64. diff --git a/core/debugger/debugger.factor b/core/debugger/debugger.factor index 8360019646..9492304628 100755 --- a/core/debugger/debugger.factor +++ b/core/debugger/debugger.factor @@ -6,7 +6,8 @@ strings io.styles vectors words system splitting math.parser classes.tuple continuations continuations.private combinators generic.math io.streams.duplex classes.builtin classes compiler.units generic.standard vocabs threads threads.private -init kernel.private libc io.encodings mirrors accessors ; +init kernel.private libc io.encodings mirrors accessors +math.order ; IN: debugger GENERIC: error. ( error -- ) diff --git a/core/definitions/definitions-tests.factor b/core/definitions/definitions-tests.factor index b20d81ec7c..b2d265a2e3 100755 --- a/core/definitions/definitions-tests.factor +++ b/core/definitions/definitions-tests.factor @@ -1,6 +1,6 @@ -IN: definitions.tests USING: tools.test generic kernel definitions sequences compiler.units words ; +IN: definitions.tests GENERIC: some-generic ( a -- b ) diff --git a/core/dlists/dlists.factor b/core/dlists/dlists.factor index e79907f11f..d9aa6b1c19 100755 --- a/core/dlists/dlists.factor +++ b/core/dlists/dlists.factor @@ -153,7 +153,7 @@ PRIVATE> drop ; : dlist-each ( dlist quot -- ) - [ obj>> ] swap compose dlist-each-node ; inline + [ obj>> ] prepose dlist-each-node ; inline : dlist-slurp ( dlist quot -- ) over dlist-empty? diff --git a/core/generator/fixup/fixup.factor b/core/generator/fixup/fixup.factor index ad6cd3051c..06895cd8ac 100755 --- a/core/generator/fixup/fixup.factor +++ b/core/generator/fixup/fixup.factor @@ -3,7 +3,7 @@ USING: arrays generic assocs hashtables kernel kernel.private math namespaces sequences words quotations strings alien.strings layouts system combinators -math.bitfields words.private cpu.architecture ; +math.bitfields words.private cpu.architecture math.order ; IN: generator.fixup : no-stack-frame -1 ; inline diff --git a/core/generator/registers/registers.factor b/core/generator/registers/registers.factor index 6a1d9ec0f4..4753f18c9a 100755 --- a/core/generator/registers/registers.factor +++ b/core/generator/registers/registers.factor @@ -4,7 +4,7 @@ USING: arrays assocs classes classes.private classes.algebra combinators cpu.architecture generator.fixup hashtables kernel layouts math namespaces quotations sequences system vectors words effects alien byte-arrays bit-arrays float-arrays -accessors sets ; +accessors sets math.order ; IN: generator.registers SYMBOL: +input+ @@ -314,7 +314,7 @@ M: phantom-retainstack finalize-height : (live-locs) ( phantom -- seq ) #! Discard locs which haven't moved [ phantom-locs* ] [ stack>> ] bi zip - [ live-loc? ] assoc-subset + [ live-loc? ] assoc-filter values ; : live-locs ( -- seq ) @@ -484,7 +484,7 @@ M: loc lazy-store : substitute-vregs ( values vregs -- ) [ vreg-substitution ] 2map - [ substitute-vreg? ] assoc-subset >hashtable + [ substitute-vreg? ] assoc-filter >hashtable [ >r stack>> r> substitute-here ] curry each-phantom ; : set-operand ( value var -- ) diff --git a/core/generic/generic-tests.factor b/core/generic/generic-tests.factor index bbd7186a11..600f422274 100755 --- a/core/generic/generic-tests.factor +++ b/core/generic/generic-tests.factor @@ -143,7 +143,7 @@ GENERIC: generic-forget-test-1 M: integer generic-forget-test-1 / ; [ t ] [ - \ / usage [ word? ] subset + \ / usage [ word? ] filter [ word-name "generic-forget-test-1/integer" = ] contains? ] unit-test @@ -152,7 +152,7 @@ M: integer generic-forget-test-1 / ; ] unit-test [ f ] [ - \ / usage [ word? ] subset + \ / usage [ word? ] filter [ word-name "generic-forget-test-1/integer" = ] contains? ] unit-test @@ -161,7 +161,7 @@ GENERIC: generic-forget-test-2 M: sequence generic-forget-test-2 = ; [ t ] [ - \ = usage [ word? ] subset + \ = usage [ word? ] filter [ word-name "generic-forget-test-2/sequence" = ] contains? ] unit-test @@ -170,7 +170,7 @@ M: sequence generic-forget-test-2 = ; ] unit-test [ f ] [ - \ = usage [ word? ] subset + \ = usage [ word? ] filter [ word-name "generic-forget-test-2/sequence" = ] contains? ] unit-test diff --git a/core/generic/generic.factor b/core/generic/generic.factor index 6c59d76d07..82bab475b3 100755 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -35,7 +35,7 @@ PREDICATE: method-spec < pair GENERIC: effective-method ( ... generic -- method ) : next-method-class ( class generic -- class/f ) - order [ class< ] with subset reverse dup length 1 = + order [ class< ] with filter reverse dup length 1 = [ drop f ] [ second ] if ; : next-method ( class generic -- class/f ) @@ -137,7 +137,7 @@ M: method-body forget* all-words [ "methods" word-prop keys swap [ key? ] curry contains? - ] with subset ; + ] with filter ; : implementors ( class -- seq ) dup associate implementors* ; diff --git a/core/generic/math/math.factor b/core/generic/math/math.factor index 884ab8027e..d71749804b 100755 --- a/core/generic/math/math.factor +++ b/core/generic/math/math.factor @@ -3,7 +3,7 @@ USING: arrays generic hashtables kernel kernel.private math namespaces sequences words quotations layouts combinators sequences.private classes classes.builtin classes.algebra -definitions ; +definitions math.order ; IN: generic.math PREDICATE: math-class < class diff --git a/core/generic/standard/engines/engines.factor b/core/generic/standard/engines/engines.factor index 1f0b80e016..c09f1abfd4 100644 --- a/core/generic/standard/engines/engines.factor +++ b/core/generic/standard/engines/engines.factor @@ -26,8 +26,8 @@ M: method-body engine>quot 1quotation ; alist>quot ; : split-methods ( assoc class -- first second ) - [ [ nip class< not ] curry assoc-subset ] - [ [ nip class< ] curry assoc-subset ] 2bi ; + [ [ nip class< not ] curry assoc-filter ] + [ [ nip class< ] curry assoc-filter ] 2bi ; : convert-methods ( assoc class word -- assoc' ) over >r >r split-methods dup assoc-empty? [ diff --git a/core/hashtables/hashtables-tests.factor b/core/hashtables/hashtables-tests.factor index f4e76aa68e..4e80ed1f6e 100755 --- a/core/hashtables/hashtables-tests.factor +++ b/core/hashtables/hashtables-tests.factor @@ -10,7 +10,7 @@ continuations ; [ ] [ 1000 [ dup sq ] H{ } map>assoc "testhash" set ] unit-test [ V{ } ] -[ 1000 [ dup sq swap "testhash" get at = not ] subset ] +[ 1000 [ dup sq swap "testhash" get at = not ] filter ] unit-test [ t ] diff --git a/core/heaps/heaps-docs.factor b/core/heaps/heaps-docs.factor index f9224eafeb..d1003ac2f8 100755 --- a/core/heaps/heaps-docs.factor +++ b/core/heaps/heaps-docs.factor @@ -1,4 +1,5 @@ -USING: heaps.private help.markup help.syntax kernel math assocs ; +USING: heaps.private help.markup help.syntax kernel math assocs +math.order ; IN: heaps ARTICLE: "heaps" "Heaps" diff --git a/core/heaps/heaps.factor b/core/heaps/heaps.factor index 02a8b8d88b..54eb93a201 100755 --- a/core/heaps/heaps.factor +++ b/core/heaps/heaps.factor @@ -2,7 +2,7 @@ ! Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math sequences arrays assocs sequences.private -growable accessors ; +growable accessors math.order ; IN: heaps MIXIN: priority-queue diff --git a/core/inference/backend/backend.factor b/core/inference/backend/backend.factor index f60748a5ac..2e1a69e407 100755 --- a/core/inference/backend/backend.factor +++ b/core/inference/backend/backend.factor @@ -4,7 +4,7 @@ USING: inference.dataflow inference.state arrays generic io io.streams.string kernel math namespaces parser prettyprint sequences strings vectors words quotations effects classes continuations debugger assocs combinators compiler.errors -generic.standard.engines.tuple accessors ; +generic.standard.engines.tuple accessors math.order ; IN: inference.backend : recursive-label ( word -- label/f ) @@ -261,7 +261,7 @@ TUPLE: cannot-unify-specials ; : balanced? ( in out -- ? ) [ dup [ length - ] [ 2drop f ] if ] 2map - [ ] subset all-equal? ; + [ ] filter all-equal? ; TUPLE: unbalanced-branches-error quots in out ; @@ -281,7 +281,7 @@ TUPLE: unbalanced-branches-error quots in out ; 2dup balanced? [ over supremum -rot [ >r dupd r> unify-inputs ] 2map - [ ] subset unify-stacks + [ ] filter unify-stacks rot drop ] [ unbalanced-branches-error diff --git a/core/inference/class/class.factor b/core/inference/class/class.factor index 6d5b708f34..9d0c55afeb 100755 --- a/core/inference/class/class.factor +++ b/core/inference/class/class.factor @@ -153,7 +153,7 @@ M: pair constraint-satisfied? first constraint-satisfied? ; : extract-keys ( seq assoc -- newassoc ) - [ dupd at ] curry H{ } map>assoc [ nip ] assoc-subset f assoc-like ; + [ dupd at ] curry H{ } map>assoc [ nip ] assoc-filter f assoc-like ; : annotate-node ( node -- ) #! Annotate the node with the currently-inferred set of diff --git a/core/inference/dataflow/dataflow.factor b/core/inference/dataflow/dataflow.factor index bb66a5386c..d7e3e78308 100755 --- a/core/inference/dataflow/dataflow.factor +++ b/core/inference/dataflow/dataflow.factor @@ -300,7 +300,7 @@ SYMBOL: node-stack dup in-d>> first node-class ; : active-children ( node -- seq ) - children>> [ last-node ] map [ #terminate? not ] subset ; + children>> [ last-node ] map [ #terminate? not ] filter ; DEFER: #tail? diff --git a/core/inspector/inspector.factor b/core/inspector/inspector.factor index c9bfbfad54..0ab016b0fa 100755 --- a/core/inspector/inspector.factor +++ b/core/inspector/inspector.factor @@ -96,7 +96,7 @@ SYMBOL: +editable+ : namestack. ( seq -- ) [ - [ global eq? not ] subset + [ global eq? not ] filter [ keys ] map concat prune ] keep [ dupd assoc-stack ] curry H{ } map>assoc describe ; diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 5efbb9496d..a463fd2e40 100755 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -135,13 +135,13 @@ strings accessors io.encodings.utf8 ; [ { { "kernel" t } } ] [ "core" resource-path [ - "." directory [ first "kernel" = ] subset + "." directory [ first "kernel" = ] filter ] with-directory ] unit-test [ { { "kernel" t } } ] [ "resource:core" [ - "." directory [ first "kernel" = ] subset + "." directory [ first "kernel" = ] filter ] with-directory ] unit-test diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 061e6386da..7fa2080661 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -3,7 +3,7 @@ USING: io.backend io.files.private io hashtables kernel math memory namespaces sequences strings assocs arrays definitions system combinators splitting sbufs continuations io.encodings -io.encodings.binary init accessors ; +io.encodings.binary init accessors math.order ; IN: io.files HOOK: (file-reader) io-backend ( path -- stream ) @@ -54,7 +54,7 @@ HOOK: (file-appender) io-backend ( path -- stream ) [ path-separator? ] left-trim ; : last-path-separator ( path -- n ? ) - [ length 1- ] keep [ path-separator? ] find-last* ; + [ length 1- ] keep [ path-separator? ] find-last-from ; HOOK: root-directory? io-backend ( path -- ? ) @@ -232,7 +232,7 @@ HOOK: make-directory io-backend ( path -- ) dup string? [ tuck append-path directory? 2array ] [ nip ] if ] with map - [ first { "." ".." } member? not ] subset ; + [ first { "." ".." } member? not ] filter ; : directory ( path -- seq ) normalize-directory dup (directory) fixup-directory ; diff --git a/core/io/streams/string/string.factor b/core/io/streams/string/string.factor index b7ff37a971..531d0401b2 100755 --- a/core/io/streams/string/string.factor +++ b/core/io/streams/string/string.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: io kernel math namespaces sequences sbufs strings generic splitting growable continuations io.streams.plain -io.encodings io.encodings.private ; +io.encodings io.encodings.private math.order ; IN: io.streams.string M: growable dispose drop ; diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index 4578e2a93f..a3209ea42c 100755 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -1,7 +1,7 @@ USING: generic help.markup help.syntax math memory namespaces sequences kernel.private layouts sorting classes kernel.private vectors combinators quotations strings words -assocs arrays ; +assocs arrays math.order ; IN: kernel ARTICLE: "shuffle-words" "Shuffle words" @@ -393,29 +393,8 @@ HELP: identity-tuple { $unchecked-example "T{ foo } dup clone = ." "f" } } ; -HELP: <=> -{ $values { "obj1" object } { "obj2" object } { "n" real } } -{ $contract - "Compares two objects using an intrinsic total order, for example, the natural order for real numbers and lexicographic order for strings." - $nl - "The output value is one of the following:" - { $list - { "positive - indicating that " { $snippet "obj1" } " follows " { $snippet "obj2" } } - { "zero - indicating that " { $snippet "obj1" } " is equal to " { $snippet "obj2" } } - { "negative - indicating that " { $snippet "obj1" } " precedes " { $snippet "obj2" } } - } - "The default implementation treats the two objects as sequences, and recursively compares their elements. So no extra work is required to compare sequences lexicographically." -} ; - { <=> compare natural-sort sort-keys sort-values } related-words -HELP: compare -{ $values { "obj1" object } { "obj2" object } { "quot" "a quotation with stack effect " { $snippet "( obj -- newobj )" } } { "n" integer } } -{ $description "Compares the results of applying the quotation to both objects via " { $link <=> } "." } -{ $examples - { $example "USING: kernel prettyprint sequences ;" "\"hello\" \"hi\" [ length ] compare ." "3" } -} ; - HELP: clone { $values { "obj" object } { "cloned" "a new object" } } { $contract "Outputs a new object equal to the given object. This is not guaranteed to actually copy the object; it does nothing with immutable objects, and does not copy words either. However, sequences and tuples can be cloned to obtain a shallow copy of the original." } ; diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index 95f0d60720..a72e25b9e0 100755 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -133,8 +133,6 @@ M: identity-tuple equal? 2drop f ; : = ( obj1 obj2 -- ? ) 2dup eq? [ 2drop t ] [ equal? ] if ; inline -GENERIC: <=> ( obj1 obj2 -- n ) - GENERIC: clone ( obj -- cloned ) M: object clone ; @@ -158,6 +156,9 @@ M: callstack clone (clone) ; : with ( param obj quot -- obj curry ) swapd [ swapd call ] 2curry ; inline +: prepose ( quot1 quot2 -- curry ) + swap compose ; inline + : 3compose ( quot1 quot2 quot3 -- curry ) compose compose ; inline @@ -176,8 +177,6 @@ M: callstack clone (clone) ; : either? ( x y quot -- ? ) bi@ or ; inline -: compare ( obj1 obj2 quot -- n ) bi@ <=> ; inline - : most ( x y quot -- z ) >r 2dup r> call [ drop ] [ nip ] if ; inline diff --git a/core/layouts/layouts.factor b/core/layouts/layouts.factor index 879862c926..19fe03202c 100755 --- a/core/layouts/layouts.factor +++ b/core/layouts/layouts.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: namespaces math words kernel assocs classes -kernel.private ; +math.order kernel.private ; IN: layouts SYMBOL: tag-mask diff --git a/core/math/intervals/intervals-docs.factor b/core/math/intervals/intervals-docs.factor index 7eb20090ab..59fb0df18e 100644 --- a/core/math/intervals/intervals-docs.factor +++ b/core/math/intervals/intervals-docs.factor @@ -1,4 +1,4 @@ -USING: help.markup help.syntax math ; +USING: help.markup help.syntax math math.order ; IN: math.intervals ARTICLE: "math-intervals-new" "Creating intervals" diff --git a/core/math/intervals/intervals-tests.factor b/core/math/intervals/intervals-tests.factor index 5204d7d45a..ba728e67c0 100755 --- a/core/math/intervals/intervals-tests.factor +++ b/core/math/intervals/intervals-tests.factor @@ -1,5 +1,5 @@ -USING: math.intervals kernel sequences words math arrays -prettyprint tools.test random vocabs combinators ; +USING: math.intervals kernel sequences words math math.order +arrays prettyprint tools.test random vocabs combinators ; IN: math.intervals.tests [ T{ interval f { 1 t } { 2 t } } ] [ 1 2 [a,b] ] unit-test diff --git a/core/math/intervals/intervals.factor b/core/math/intervals/intervals.factor index 77d60e67f8..324d628fd1 100755 --- a/core/math/intervals/intervals.factor +++ b/core/math/intervals/intervals.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. ! Based on Slate's src/unfinished/interval.slate by Brian Rice. -USING: kernel sequences arrays math combinators ; +USING: kernel sequences arrays math combinators math.order ; IN: math.intervals TUPLE: interval from to ; diff --git a/core/math/math-docs.factor b/core/math/math-docs.factor index c8a763b5f7..b15f09e49d 100755 --- a/core/math/math-docs.factor +++ b/core/math/math-docs.factor @@ -79,28 +79,6 @@ HELP: >= { $values { "x" real } { "y" real } { "?" "a boolean" } } { $description "Tests if " { $snippet "x" } " is greater than or equal to " { $snippet "y" } "." } ; -HELP: before? -{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } } -{ $description "Tests if " { $snippet "obj1" } " comes before " { $snippet "obj2" } " using an intrinsic total order." } -{ $notes "Implemented using " { $link <=> } "." } ; - -HELP: after? -{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } } -{ $description "Tests if " { $snippet "obj1" } " comes after " { $snippet "obj2" } " using an intrinsic total order." } -{ $notes "Implemented using " { $link <=> } "." } ; - -HELP: before=? -{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } } -{ $description "Tests if " { $snippet "obj1" } " comes before or equals " { $snippet "obj2" } " using an intrinsic total order." } -{ $notes "Implemented using " { $link <=> } "." } ; - -HELP: after=? -{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } } -{ $description "Tests if " { $snippet "obj1" } " comes after or equals " { $snippet "obj2" } " using an intrinsic total order." } -{ $notes "Implemented using " { $link <=> } "." } ; - -{ before? after? before=? after=? } related-words - HELP: + { $values { "x" number } { "y" number } { "z" number } } @@ -275,19 +253,6 @@ HELP: recip { $description "Computes a number's multiplicative inverse." } { $errors "Throws an error if " { $snippet "x" } " is the integer 0." } ; -HELP: max -{ $values { "x" real } { "y" real } { "z" real } } -{ $description "Outputs the greatest of two real numbers." } ; - -HELP: min -{ $values { "x" real } { "y" real } { "z" real } } -{ $description "Outputs the smallest of two real numbers." } ; - -HELP: between? -{ $values { "x" real } { "y" real } { "z" real } { "?" "a boolean" } } -{ $description "Tests if " { $snippet "x" } " is in the interval " { $snippet "[y,z]" } "." } -{ $notes "As per the closed interval notation, the end-points are included in the interval." } ; - HELP: rem { $values { "x" integer } { "y" integer } { "z" integer } } { $description @@ -333,10 +298,6 @@ HELP: times { $description "Calls the quotation " { $snippet "n" } " times." } { $notes "If you need to pass the current index to the quotation, use " { $link each } "." } ; -HELP: [-] -{ $values { "x" real } { "y" real } { "z" real } } -{ $description "Subtracts " { $snippet "y" } " from " { $snippet "x" } ". If the result is less than zero, outputs zero." } ; - HELP: fp-nan? { $values { "x" real } { "?" "a boolean" } } { $description "Tests if " { $snippet "x" } " is an IEEE Not-a-Number value. While " { $snippet "x" } " can be any real number, this word will only ever yield true if " { $snippet "x" } " is a " { $link float } "." } ; diff --git a/core/math/math.factor b/core/math/math.factor index 14cbe68351..a35e4926bc 100755 --- a/core/math/math.factor +++ b/core/math/math.factor @@ -17,11 +17,6 @@ MATH: <= ( x y -- ? ) foldable MATH: > ( x y -- ? ) foldable MATH: >= ( x y -- ? ) foldable -: after? ( obj1 obj2 -- ? ) <=> 0 > ; inline -: before? ( obj1 obj2 -- ? ) <=> 0 < ; inline -: after=? ( obj1 obj2 -- ? ) <=> 0 >= ; inline -: before=? ( obj1 obj2 -- ? ) <=> 0 <= ; inline - MATH: + ( x y -- z ) foldable MATH: - ( x y -- z ) foldable MATH: * ( x y -- z ) foldable @@ -61,23 +56,14 @@ M: object zero? drop f ; : sq ( x -- y ) dup * ; inline : neg ( x -- -x ) 0 swap - ; inline : recip ( x -- y ) 1 swap / ; inline +: sgn ( x -- n ) dup 0 < [ drop -1 ] [ 0 > 1 0 ? ] if ; inline : ?1+ [ 1+ ] [ 0 ] if* ; inline : /f ( x y -- z ) >r >float r> >float float/f ; inline -: max ( x y -- z ) [ > ] most ; inline -: min ( x y -- z ) [ < ] most ; inline - -: between? ( x y z -- ? ) - pick >= [ >= ] [ 2drop f ] if ; inline - : rem ( x y -- z ) tuck mod over + swap mod ; foldable -: sgn ( x -- n ) dup 0 < [ drop -1 ] [ 0 > 1 0 ? ] if ; inline - -: [-] ( x y -- z ) - 0 max ; inline - : 2^ ( n -- 2^n ) 1 swap shift ; inline : even? ( n -- ? ) 1 bitand zero? ; @@ -96,13 +82,9 @@ M: number equal? number= ; M: real hashcode* nip >fixnum ; -M: real <=> - ; - ! real and sequence overlap. we disambiguate: M: integer hashcode* nip >fixnum ; -M: integer <=> - ; - GENERIC: fp-nan? ( x -- ? ) M: object fp-nan? @@ -161,7 +143,7 @@ PRIVATE> iterate-prep (each-integer) ; inline : times ( n quot -- ) - [ drop ] swap compose each-integer ; inline + [ drop ] prepose each-integer ; inline : find-integer ( n quot -- i ) iterate-prep (find-integer) ; inline diff --git a/core/optimizer/backend/backend.factor b/core/optimizer/backend/backend.factor index 9630f9dc70..9b70ccdd9d 100755 --- a/core/optimizer/backend/backend.factor +++ b/core/optimizer/backend/backend.factor @@ -87,7 +87,7 @@ M: node optimize-node* drop t f ; : compute-value-substitutions ( #call/#merge #return/#values -- assoc ) [ out-d>> ] [ in-d>> ] bi* 2array unify-lengths flip - [ = not ] assoc-subset >hashtable ; + [ = not ] assoc-filter >hashtable ; : cleanup-inlining ( #return/#values -- newnode changed? ) dup node-successor [ diff --git a/core/optimizer/control/control.factor b/core/optimizer/control/control.factor index 976156db77..de7aec2bb1 100755 --- a/core/optimizer/control/control.factor +++ b/core/optimizer/control/control.factor @@ -75,7 +75,7 @@ USE: prettyprint M: #call-label collect-label-info* node-param label-info get at node-stack get over third tail - [ [ #label? ] subset [ node-param ] map ] keep + [ [ #label? ] filter [ node-param ] map ] keep [ node-successor #tail? ] all? 2array swap second push ; @@ -91,7 +91,7 @@ SYMBOL: potential-loops : remove-non-tail-calls ( -- ) label-info get - [ nip second [ second ] all? ] assoc-subset + [ nip second [ second ] all? ] assoc-filter [ first ] assoc-map potential-loops set ; diff --git a/core/optimizer/def-use/def-use.factor b/core/optimizer/def-use/def-use.factor index 66bffd9767..a2e9f88135 100755 --- a/core/optimizer/def-use/def-use.factor +++ b/core/optimizer/def-use/def-use.factor @@ -56,7 +56,7 @@ UNION: #killable : purge-invariants ( stacks -- seq ) #! Output a sequence of values which are not present in the #! same position in each sequence of the stacks sequence. - unify-lengths flip [ all-eq? not ] subset concat ; + unify-lengths flip [ all-eq? not ] filter concat ; M: #label node-def-use [ @@ -75,7 +75,7 @@ M: #branch node-def-use dup branch-def-use (node-def-use) ; : compute-dead-literals ( -- values ) - def-use get [ >r value? r> empty? and ] assoc-subset ; + def-use get [ >r value? r> empty? and ] assoc-filter ; DEFER: kill-nodes SYMBOL: dead-literals diff --git a/core/optimizer/math/partial/partial.factor b/core/optimizer/math/partial/partial.factor index bbe1d0a83f..8b5e25deb1 100644 --- a/core/optimizer/math/partial/partial.factor +++ b/core/optimizer/math/partial/partial.factor @@ -85,7 +85,7 @@ PREDICATE: math-partial < word : define-math-ops ( op -- ) { fixnum bignum float } [ [ dup 3array ] [ swap method ] 2bi ] with { } map>assoc - [ nip ] assoc-subset + [ nip ] assoc-filter [ word-def peek ] assoc-map % ; SYMBOL: math-ops @@ -155,7 +155,7 @@ SYMBOL: fast-math-ops [ drop math-class-max swap specific-method >boolean ] if ; : (derived-ops) ( word assoc -- words ) - swap [ rot first eq? nip ] curry assoc-subset values ; + swap [ rot first eq? nip ] curry assoc-filter values ; : derived-ops ( word -- words ) [ 1array ] diff --git a/core/optimizer/specializers/specializers.factor b/core/optimizer/specializers/specializers.factor index b33a9e8fc2..c3702e9805 100755 --- a/core/optimizer/specializers/specializers.factor +++ b/core/optimizer/specializers/specializers.factor @@ -12,7 +12,7 @@ IN: optimizer.specializers : make-specializer ( classes -- quot ) dup length [ (picker) 2array ] 2map - [ drop object eq? not ] assoc-subset + [ drop object eq? not ] assoc-filter dup empty? [ drop [ t ] ] [ [ (make-specializer) ] { } assoc>map unclip [ swap [ f ] \ if 3array append [ ] like ] reduce diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 961fa89d8f..1cfe6d63d9 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -63,7 +63,7 @@ t parser-notes set-global : skip ( i seq ? -- n ) over >r - [ swap CHAR: \s eq? xor ] curry find* drop + [ swap CHAR: \s eq? xor ] curry find-from drop [ r> drop ] [ r> length ] if* ; : change-lexer-column ( lexer quot -- ) @@ -207,7 +207,7 @@ SYMBOL: in : add-use ( seq -- ) [ use+ ] each ; : set-use ( seq -- ) - [ vocab-words ] map [ ] subset >vector use set ; + [ vocab-words ] map [ ] filter >vector use set ; : check-vocab-string ( name -- name ) dup string? @@ -270,7 +270,7 @@ M: no-word-error summary : no-word ( name -- newword ) dup no-word-error boa - swap words-named [ forward-reference? not ] subset + swap words-named [ forward-reference? not ] filter word-restarts throw-restarts dup word-vocabulary (use+) ; @@ -278,7 +278,7 @@ M: no-word-error summary dup forward-reference? [ drop use get - [ at ] with map [ ] subset + [ at ] with map [ ] filter [ forward-reference? not ] find nip ] [ nip @@ -516,7 +516,7 @@ SYMBOL: interactive-vocabs assoc-diff [ drop where dup [ first ] when file get source-file-path = - ] assoc-subset keys ; + ] assoc-filter keys ; : removed-definitions ( -- assoc1 assoc2 ) new-definitions old-definitions @@ -531,7 +531,7 @@ SYMBOL: interactive-vocabs : reset-removed-classes ( -- ) removed-classes - filter-moved [ class? ] subset [ reset-class ] each ; + filter-moved [ class? ] filter [ reset-class ] each ; : fix-class-words ( -- ) #! If a class word had a compound definition which was diff --git a/core/prettyprint/backend/backend.factor b/core/prettyprint/backend/backend.factor index c9933d5be2..e13a991e2b 100755 --- a/core/prettyprint/backend/backend.factor +++ b/core/prettyprint/backend/backend.factor @@ -3,7 +3,7 @@ USING: arrays byte-arrays bit-arrays generic hashtables io assocs kernel math namespaces sequences strings sbufs io.styles vectors words prettyprint.config prettyprint.sections quotations -io io.files math.parser effects classes.tuple +io io.files math.parser effects classes.tuple math.order classes.tuple.private classes float-arrays ; IN: prettyprint.backend diff --git a/core/prettyprint/prettyprint.factor b/core/prettyprint/prettyprint.factor index 981c8dcfd0..4974e1df3c 100755 --- a/core/prettyprint/prettyprint.factor +++ b/core/prettyprint/prettyprint.factor @@ -45,7 +45,7 @@ sets ; ] if ; : vocabs. ( in use -- ) - dupd remove [ { "syntax" "scratchpad" } member? not ] subset + dupd remove [ { "syntax" "scratchpad" } member? not ] filter use. in. ; : with-use ( obj quot -- ) diff --git a/core/prettyprint/sections/sections.factor b/core/prettyprint/sections/sections.factor index 803f6e2459..5f32539115 100644 --- a/core/prettyprint/sections/sections.factor +++ b/core/prettyprint/sections/sections.factor @@ -171,7 +171,7 @@ M: block section-fits? ( section -- ? ) line-limit? [ drop t ] [ call-next-method ] if ; : pprint-sections ( block advancer -- ) - swap sections>> [ line-break? not ] subset + swap sections>> [ line-break? not ] filter unclip pprint-section [ dup rot call pprint-section ] with each ; inline @@ -310,7 +310,7 @@ M: f section-end-group? drop f ; 2dup 1+ swap ?nth next set swap nth dup split-before dup , split-after ] with each - ] { } make { t } split [ empty? not ] subset ; + ] { } make { t } split [ empty? not ] filter ; : break-group? ( seq -- ? ) [ first section-fits? ] [ peek section-fits? not ] bi and ; diff --git a/core/quotations/quotations.factor b/core/quotations/quotations.factor index c0f15a9388..2a0f5d289f 100755 --- a/core/quotations/quotations.factor +++ b/core/quotations/quotations.factor @@ -50,14 +50,14 @@ M: curry nth INSTANCE: curry immutable-sequence M: compose length - dup compose-first length - swap compose-second length + ; + [ compose-first length ] + [ compose-second length ] bi + ; M: compose nth 2dup compose-first length < [ compose-first ] [ - [ compose-first length - ] keep compose-second + [ compose-first length - ] [ compose-second ] bi ] if nth ; INSTANCE: compose immutable-sequence diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 0dea0f43d9..2a2fcf29cd 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -1,5 +1,5 @@ -USING: arrays bit-arrays help.markup help.syntax -sequences.private vectors strings sbufs kernel math ; +USING: arrays bit-arrays help.markup help.syntax math +sequences.private vectors strings sbufs kernel math.order ; IN: sequences ARTICLE: "sequences-unsafe" "Unsafe sequence operations" @@ -92,6 +92,7 @@ ARTICLE: "sequences-slices" "Subsequences and slices" { $subsection subseq } { $subsection head } { $subsection tail } +{ $subsection rest } { $subsection head* } { $subsection tail* } "Taking a sequence apart into a head and a tail:" @@ -105,6 +106,7 @@ ARTICLE: "sequences-slices" "Subsequences and slices" { $subsection } { $subsection head-slice } { $subsection tail-slice } +{ $subsection rest-slice } { $subsection head-slice* } { $subsection tail-slice* } "Taking a sequence apart into a head and a tail:" @@ -127,7 +129,7 @@ ARTICLE: "sequences-combinators" "Sequence combinators" { $subsection unfold } "Filtering:" { $subsection push-if } -{ $subsection subset } ; +{ $subsection filter } ; ARTICLE: "sequences-tests" "Testing sequences" "Testing for an empty sequence:" @@ -153,17 +155,17 @@ ARTICLE: "sequences-tests" "Testing sequences" ARTICLE: "sequences-search" "Searching sequences" "Finding the index of an element:" { $subsection index } -{ $subsection index* } +{ $subsection index-from } { $subsection last-index } -{ $subsection last-index* } +{ $subsection last-index-from } "Finding the start of a subsequence:" { $subsection start } { $subsection start* } "Finding the index of an element satisfying a predicate:" { $subsection find } -{ $subsection find* } +{ $subsection find-from } { $subsection find-last } -{ $subsection find-last* } ; +{ $subsection find-last-from } ; ARTICLE: "sequences-destructive" "Destructive operations" "These words modify their input, instead of creating a new sequence." @@ -500,9 +502,9 @@ HELP: find { $snippet "( elt -- ? )" } } { "i" "the index of the first match, or f" } { "elt" "the first matching element, or " { $link f } } } -{ $description "A simpler variant of " { $link find* } " where the starting index is 0." } ; +{ $description "A simpler variant of " { $link find-from } " where the starting index is 0." } ; -HELP: find* +HELP: find-from { $values { "n" "a starting index" } { "seq" sequence } { "quot" "a quotation with stack effect " @@ -513,9 +515,9 @@ HELP: find* HELP: find-last { $values { "seq" sequence } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } { "i" "the index of the first match, or f" } { "elt" "the first matching element, or " { $link f } } } -{ $description "A simpler variant of " { $link find-last* } " where the starting index is one less than the length of the sequence." } ; +{ $description "A simpler variant of " { $link find-last-from } " where the starting index is one less than the length of the sequence." } ; -HELP: find-last* +HELP: find-last-from { $values { "n" "a starting index" } { "seq" sequence } { "quot" "a quotation with stack effect " { $snippet "( 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." } ; @@ -530,9 +532,9 @@ HELP: all? HELP: push-if { $values { "elt" object } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } { "accum" "a resizable mutable sequence" } } { $description "Adds the element at the end of the sequence if the quotation yields a true value." } -{ $notes "This word is a factor of " { $link subset } "." } ; +{ $notes "This word is a factor of " { $link filter } "." } ; -HELP: subset +HELP: filter { $values { "seq" sequence } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } { "subseq" "a new sequence" } } { $description "Applies the quotation to each element in turn, and outputs a new sequence containing the elements of the original sequence for which the quotation output a true value." } ; @@ -562,9 +564,9 @@ HELP: index { $values { "obj" object } { "seq" sequence } { "n" "an index" } } { $description "Outputs the index of the first element in the sequence equal to " { $snippet "obj" } ". If no element is found, outputs " { $link f } "." } ; -{ index index* last-index last-index* member? memq? } related-words +{ index index-from last-index last-index-from member? memq? } related-words -HELP: index* +HELP: index-from { $values { "obj" object } { "i" "a start index" } { "seq" sequence } { "n" "an index" } } { $description "Outputs the index of the first element in the sequence equal to " { $snippet "obj" } ", starting the search from the " { $snippet "i" } "th element. If no element is found, outputs " { $link f } "." } ; @@ -572,7 +574,7 @@ HELP: last-index { $values { "obj" object } { "seq" sequence } { "n" "an index" } } { $description "Outputs the index of the last element in the sequence equal to " { $snippet "obj" } "; the sequence is traversed back to front. If no element is found, outputs " { $link f } "." } ; -HELP: last-index* +HELP: last-index-from { $values { "obj" object } { "i" "a start index" } { "seq" sequence } { "n" "an index" } } { $description "Outputs the index of the last element in the sequence equal to " { $snippet "obj" } ", traversing the sequence backwards starting from the " { $snippet "i" } "th element and finishing at the first. If no element is found, outputs " { $link f } "." } ; @@ -834,6 +836,12 @@ HELP: tail-slice { $description "Outputs a virtual sequence sharing storage with all elements from the " { $snippet "n" } "th index until the end of the input sequence." } { $errors "Throws an error if the index is out of bounds." } ; +HELP: rest-slice +{ $values { "seq" sequence } { "slice" "a slice" } } +{ $description "Outputs a virtual sequence sharing storage with all elements from the 1st index until the end of the input sequence." } +{ $notes "Equivalent to " { $snippet "1 tail" } } +{ $errors "Throws an error if the index is out of bounds." } ; + HELP: head-slice* { $values { "seq" sequence } { "n" "a non-negative integer" } { "slice" "a slice" } } { $description "Outputs a virtual sequence sharing storage with all elements of " { $snippet "seq" } " until the " { $snippet "n" } "th element from the end. In other words, it outputs a sequence of the first " { $snippet "l-n" } " elements of the input sequence, where " { $snippet "l" } " is its length." } @@ -854,6 +862,11 @@ HELP: tail { $description "Outputs a new sequence consisting of the input sequence with the first n items removed." } { $errors "Throws an error if the index is out of bounds." } ; +HELP: rest +{ $values { "seq" sequence } { "tailseq" "a new sequence" } } +{ $description "Outputs a new sequence consisting of the input sequence with the first item removed." } +{ $errors "Throws an error on an empty sequence." } ; + HELP: head* { $values { "seq" sequence } { "n" "a non-negative integer" } { "headseq" "a new sequence" } } { $description "Outputs a new sequence consisting of all elements of " { $snippet "seq" } " until the " { $snippet "n" } "th element from the end. In other words, it outputs a sequence of the first " { $snippet "l-n" } " elements of the input sequence, where " { $snippet "l" } " is its length." } diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index 100184798c..2479c125a2 100755 --- a/core/sequences/sequences-tests.factor +++ b/core/sequences/sequences-tests.factor @@ -27,7 +27,7 @@ IN: sequences.tests [ "hello world" "aeiou" [ member? ] curry find ] unit-test [ 4 CHAR: o ] -[ 3 "hello world" "aeiou" [ member? ] curry find* ] unit-test +[ 3 "hello world" "aeiou" [ member? ] curry find-from ] unit-test [ f ] [ 3 [ ] member? ] unit-test [ f ] [ 3 [ 1 2 ] member? ] unit-test @@ -39,18 +39,18 @@ IN: sequences.tests [ 4 ] [ CHAR: x "tuvwxyz" >vector index ] unit-test -[ f ] [ CHAR: x 5 "tuvwxyz" >vector index* ] unit-test +[ f ] [ CHAR: x 5 "tuvwxyz" >vector index-from ] unit-test -[ f ] [ CHAR: a 0 "tuvwxyz" >vector index* ] unit-test +[ f ] [ CHAR: a 0 "tuvwxyz" >vector index-from ] unit-test [ f ] [ [ "Hello" { } 0.75 ] [ string? ] all? ] unit-test [ t ] [ [ ] [ ] all? ] unit-test [ t ] [ [ "hi" t 0.5 ] [ ] all? ] unit-test -[ [ 1 2 3 ] ] [ [ 1 4 2 5 3 6 ] [ 4 < ] subset ] unit-test -[ { 4 2 6 } ] [ { 1 4 2 5 3 6 } [ 2 mod 0 = ] subset ] unit-test +[ [ 1 2 3 ] ] [ [ 1 4 2 5 3 6 ] [ 4 < ] filter ] unit-test +[ { 4 2 6 } ] [ { 1 4 2 5 3 6 } [ 2 mod 0 = ] filter ] unit-test -[ [ 3 ] ] [ [ 1 2 3 ] 2 [ swap < ] curry subset ] unit-test +[ [ 3 ] ] [ [ 1 2 3 ] 2 [ swap < ] curry filter ] unit-test [ "hello world how are you" ] [ { "hello" "world" "how" "are" "you" } " " join ] @@ -169,9 +169,9 @@ unit-test [ 3 "a" ] [ { "a" "b" "c" "a" "d" } [ "a" = ] find-last ] unit-test -[ f f ] [ 100 { 1 2 3 } [ 1 = ] find* ] unit-test -[ f f ] [ 100 { 1 2 3 } [ 1 = ] find-last* ] unit-test -[ f f ] [ -1 { 1 2 3 } [ 1 = ] find* ] unit-test +[ f f ] [ 100 { 1 2 3 } [ 1 = ] find-from ] unit-test +[ f f ] [ 100 { 1 2 3 } [ 1 = ] find-last-from ] unit-test +[ f f ] [ -1 { 1 2 3 } [ 1 = ] find-from ] unit-test [ 0 ] [ { "a" "b" "c" } { "A" "B" "C" } mismatch ] unit-test @@ -187,9 +187,6 @@ unit-test [ V{ "a" "b" } V{ } ] [ { "X" "a" "b" } { "X" } drop-prefix [ >vector ] bi@ ] unit-test -[ -1 ] [ "ab" "abc" <=> ] unit-test -[ 1 ] [ "abc" "ab" <=> ] unit-test - [ 1 4 9 16 16 V{ f 1 4 9 16 } ] [ V{ } clone "cache-test" set 1 "cache-test" get [ sq ] cache-nth diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 924d9a05cb..798a3ed1ed 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2005, 2008 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. +USING: kernel kernel.private slots.private math math.private +math.order ; IN: sequences -USING: kernel kernel.private slots.private math math.private ; MIXIN: sequence @@ -36,7 +37,7 @@ M: sequence lengthen 2dup length > [ set-length ] [ 2drop ] if ; : set-third ( third seq -- ) 2 swap set-nth ; inline : set-fourth ( fourth seq -- ) 3 swap set-nth ; inline -: push ( elt seq -- ) dup length swap set-nth ; +: push ( elt seq -- ) [ length ] [ set-nth ] bi ; : bounds-check? ( n seq -- ? ) length 1- 0 swap between? ; inline @@ -100,13 +101,13 @@ M: integer nth-unsafe drop ; INSTANCE: integer immutable-sequence : first2-unsafe - [ 0 swap nth-unsafe ] keep 1 swap nth-unsafe ; inline + [ 0 swap nth-unsafe 1 ] [ nth-unsafe ] bi ; inline : first3-unsafe - [ first2-unsafe ] keep 2 swap nth-unsafe ; inline + [ first2-unsafe 2 ] [ nth-unsafe ] bi ; inline : first4-unsafe - [ first3-unsafe ] keep 3 swap nth-unsafe ; inline + [ first3-unsafe 3 ] [ nth-unsafe ] bi ; inline : exchange-unsafe ( m n seq -- ) [ tuck nth-unsafe >r nth-unsafe r> ] 3keep tuck @@ -179,7 +180,7 @@ M: reversed length reversed-seq length ; INSTANCE: reversed virtual-sequence -: reverse ( seq -- newseq ) [ ] keep like ; +: reverse ( seq -- newseq ) [ ] [ like ] bi ; ! A slice of another sequence. TUPLE: slice from to seq ; @@ -201,7 +202,7 @@ ERROR: slice-error reason ; M: slice virtual-seq slice-seq ; -M: slice virtual@ [ slice-from + ] keep slice-seq ; +M: slice virtual@ [ slice-from + ] [ slice-seq ] bi ; M: slice length dup slice-to swap slice-from - ; @@ -209,6 +210,8 @@ M: slice length dup slice-to swap slice-from - ; : tail-slice ( seq n -- slice ) (tail) ; +: rest-slice ( seq -- slice ) 1 tail-slice ; + : head-slice* ( seq n -- slice ) from-end head-slice ; : tail-slice* ( seq n -- slice ) from-end tail-slice ; @@ -248,12 +251,14 @@ INSTANCE: repetition immutable-sequence PRIVATE> : subseq ( from to seq -- subseq ) - [ check-slice prepare-subseq (copy) ] keep like ; + [ check-slice prepare-subseq (copy) ] [ like ] bi ; : head ( seq n -- headseq ) (head) subseq ; : tail ( seq n -- tailseq ) (tail) subseq ; +: rest ( seq -- seq' ) 1 tail ; + : head* ( seq n -- headseq ) from-end head ; : tail* ( seq n -- tailseq ) from-end tail ; @@ -267,11 +272,12 @@ M: sequence clone-like M: immutable-sequence clone-like like ; -: push-all ( src dest -- ) [ length ] keep copy ; +: push-all ( src dest -- ) [ length ] [ copy ] bi ; : ((append)) ( seq1 seq2 accum -- accum ) - [ >r over length r> copy ] keep - [ 0 swap copy ] keep ; inline + [ >r over length r> copy ] + [ 0 swap copy ] + [ ] tri ; inline : (append) ( seq1 seq2 exemplar -- newseq ) >r over length over length + r> @@ -279,8 +285,8 @@ M: immutable-sequence clone-like like ; : (3append) ( seq1 seq2 seq3 exemplar -- newseq ) >r pick length pick length pick length + + r> [ - [ >r pick length pick length + r> copy ] keep - ((append)) + [ >r pick length pick length + r> copy ] + [ ((append)) ] bi ] new-like ; inline : append ( seq1 seq2 -- newseq ) over (append) ; @@ -323,7 +329,7 @@ M: immutable-sequence clone-like like ; : (find) ( seq quot quot' -- i elt ) pick >r >r (each) r> call r> finish-find ; inline -: (find*) ( n seq quot quot' -- i elt ) +: (find-from) ( n seq quot quot' -- i elt ) >r >r 2dup bounds-check? [ r> r> (find) ] [ @@ -332,7 +338,7 @@ M: immutable-sequence clone-like like ; : (monotonic) ( seq quot -- ? ) [ 2dup nth-unsafe rot 1+ rot nth-unsafe ] - swap compose curry ; inline + prepose curry ; inline : (interleave) ( n elt between quot -- ) roll zero? [ nip ] [ swapd 2slip ] if call ; inline @@ -373,14 +379,14 @@ PRIVATE> : 2all? ( seq1 seq2 quot -- ? ) (2each) all-integers? ; inline -: find* ( n seq quot -- i elt ) - [ (find-integer) ] (find*) ; inline +: find-from ( n seq quot -- i elt ) + [ (find-integer) ] (find-from) ; inline : find ( seq quot -- i elt ) [ find-integer ] (find) ; inline -: find-last* ( n seq quot -- i elt ) - [ nip find-last-integer ] (find*) ; inline +: find-last-from ( n seq quot -- i elt ) + [ nip find-last-integer ] (find-from) ; inline : find-last ( seq quot -- i elt ) [ >r 1- r> find-last-integer ] (find) ; inline @@ -394,7 +400,7 @@ PRIVATE> : pusher ( quot -- quot accum ) V{ } clone [ [ push-if ] 2curry ] keep ; inline -: subset ( seq quot -- subseq ) +: filter ( seq quot -- subseq ) over >r pusher >r each r> r> like ; inline : monotonic? ( seq quot -- ? ) @@ -414,14 +420,14 @@ PRIVATE> : index ( obj seq -- n ) [ = ] with find drop ; -: index* ( obj i seq -- n ) - rot [ = ] curry find* drop ; +: index-from ( obj i seq -- n ) + rot [ = ] curry find-from drop ; : last-index ( obj seq -- n ) [ = ] with find-last drop ; -: last-index* ( obj i seq -- n ) - rot [ = ] curry find-last* drop ; +: last-index-from ( obj i seq -- n ) + rot [ = ] curry find-last-from drop ; : contains? ( seq quot -- ? ) find drop >boolean ; inline @@ -433,7 +439,7 @@ PRIVATE> [ eq? ] with contains? ; : remove ( obj seq -- newseq ) - [ = not ] with subset ; + [ = not ] with filter ; : cache-nth ( i seq quot -- elt ) 2over ?nth dup [ @@ -472,7 +478,7 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ; : move ( to from seq -- ) 2over number= - [ 3drop ] [ [ nth swap ] keep set-nth ] if ; inline + [ 3drop ] [ [ nth swap ] [ set-nth ] bi ] if ; inline : (delete) ( elt store scan seq -- elt store scan seq ) 2dup length < [ @@ -497,9 +503,9 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ; [ 0 swap copy ] keep ] new-like ; -: peek ( seq -- elt ) dup length 1- swap nth ; +: peek ( seq -- elt ) [ length 1- ] [ nth ] bi ; -: pop* ( seq -- ) dup length 1- swap set-length ; +: pop* ( seq -- ) [ length 1- ] [ set-length ] bi ; : move-backward ( shift from to seq -- ) 2over number= [ @@ -519,7 +525,7 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ; : (open-slice) ( shift from to seq ? -- ) [ - >r >r 1- r> 1- r> move-forward + >r [ 1- ] bi@ r> move-forward ] [ >r >r over - r> r> move-backward ] if ; @@ -544,7 +550,7 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ; copy ; : pop ( seq -- elt ) - dup length 1- swap [ nth ] 2keep set-length ; + [ length 1- ] [ [ nth ] [ set-length ] 2bi ] bi ; : all-equal? ( seq -- ? ) [ = ] monotonic? ; @@ -609,7 +615,7 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ; ] if ; : cut-slice ( seq n -- before after ) - [ head-slice ] 2keep tail-slice ; + [ head-slice ] [ tail-slice ] 2bi ; : midpoint@ ( seq -- n ) length 2/ ; inline @@ -634,10 +640,10 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ; ] if ; inline : cut ( seq n -- before after ) - [ head ] 2keep tail ; + [ head ] [ tail ] 2bi ; : cut* ( seq n -- before after ) - [ head* ] 2keep tail* ; + [ head* ] [ tail* ] 2bi ; : start* ( subseq seq n -- i ) pick length pick length swap - 1+ - [ (start) ] find* + [ (start) ] find-from swap >r 3drop r> ; : start ( subseq seq -- i ) 0 start* ; inline @@ -662,10 +668,10 @@ PRIVATE> tuck tail-slice >r tail-slice r> ; : unclip ( seq -- rest first ) - dup 1 tail swap first ; + [ rest ] [ first ] bi ; : unclip-slice ( seq -- rest first ) - dup 1 tail-slice swap first ; + [ rest-slice ] [ first ] bi ; : ( seq -- slice ) dup slice? [ { } like ] when 0 over length rot ; @@ -680,7 +686,7 @@ PRIVATE> [ 1+ head ] [ 0 head ] if* ; inline : trim ( seq quot -- newseq ) - [ left-trim ] keep right-trim ; inline + [ left-trim ] [ right-trim ] bi ; inline : sum ( seq -- n ) 0 [ + ] binary-reduce ; : product ( seq -- n ) 1 [ * ] binary-reduce ; diff --git a/core/sets/sets.factor b/core/sets/sets.factor index 31c39c6105..71a7d77903 100644 --- a/core/sets/sets.factor +++ b/core/sets/sets.factor @@ -22,10 +22,10 @@ IN: sets dup length [ (all-unique?) ] curry all? ; : intersect ( seq1 seq2 -- newseq ) - unique [ key? ] curry subset ; + unique [ key? ] curry filter ; : diff ( seq1 seq2 -- newseq ) - swap unique [ key? not ] curry subset ; + swap unique [ key? not ] curry filter ; : union ( seq1 seq2 -- newseq ) append prune ; diff --git a/core/slots/deprecated/deprecated.factor b/core/slots/deprecated/deprecated.factor index 2ec8f3d0d1..90f468a185 100755 --- a/core/slots/deprecated/deprecated.factor +++ b/core/slots/deprecated/deprecated.factor @@ -86,7 +86,7 @@ PREDICATE: slot-writer < word "writing" word-prop >boolean ; { [ over string? ] [ >r dupd r> short-slot ] } { [ over array? ] [ long-slot ] } } cond - ] 2map [ ] subset nip ; + ] 2map [ ] filter nip ; : slot-of-reader ( reader specs -- spec/f ) [ slot-spec-reader eq? ] with find nip ; diff --git a/core/sorting/sorting-docs.factor b/core/sorting/sorting-docs.factor index 4fa5c7974d..3da6ea6bd6 100644 --- a/core/sorting/sorting-docs.factor +++ b/core/sorting/sorting-docs.factor @@ -1,5 +1,6 @@ -USING: sorting help.markup help.syntax kernel words math -sequences ; +USING: help.markup help.syntax kernel words math +sequences math.order ; +IN: sorting ARTICLE: "sequences-sorting" "Sorting and binary search" "Sorting and binary search combinators all take comparator quotations with stack effect " { $snippet "( elt1 elt2 -- n )" } " that order the two given elements and output a value whose sign denotes the result:" diff --git a/core/sorting/sorting.factor b/core/sorting/sorting.factor index 5f81b17187..6aafe2ded1 100755 --- a/core/sorting/sorting.factor +++ b/core/sorting/sorting.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2005, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays kernel math sequences vectors +USING: arrays kernel math sequences vectors math.order sequences sequences.private growable ; IN: sorting diff --git a/core/source-files/source-files.factor b/core/source-files/source-files.factor index 5703b631f4..5ef2d46790 100755 --- a/core/source-files/source-files.factor +++ b/core/source-files/source-files.factor @@ -19,7 +19,7 @@ uses definitions ; : (xref-source) ( source-file -- pathname uses ) dup source-file-path - swap source-file-uses [ crossref? ] subset ; + swap source-file-uses [ crossref? ] filter ; : xref-source ( source-file -- ) (xref-source) crossref get add-vertex ; diff --git a/core/splitting/splitting.factor b/core/splitting/splitting.factor index f840ca15ad..eb10b9fe4a 100755 --- a/core/splitting/splitting.factor +++ b/core/splitting/splitting.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math namespaces strings arrays vectors sequences -sets ; +sets math.order ; IN: splitting TUPLE: groups seq n sliced? ; @@ -61,7 +61,7 @@ INSTANCE: groups sequence dup [ swap ] when ; : (split) ( separators n seq -- ) - 3dup rot [ member? ] curry find* drop + 3dup rot [ member? ] curry find-from drop [ [ swap subseq , ] 2keep 1+ swap (split) ] [ swap dup zero? [ drop ] [ tail ] if , drop ] if* ; inline diff --git a/core/strings/strings-tests.factor b/core/strings/strings-tests.factor index 961c8cdf6e..028759c9f9 100755 --- a/core/strings/strings-tests.factor +++ b/core/strings/strings-tests.factor @@ -31,6 +31,8 @@ IN: strings.tests [ t ] [ "abc" "abd" before? ] unit-test [ t ] [ "z" "abd" after? ] unit-test +[ t ] [ "abc" "abd" min ] unit-test +[ t ] [ "z" "abd" max ] unit-test [ 0 10 "hello" subseq ] must-fail diff --git a/core/threads/threads.factor b/core/threads/threads.factor index 2f9c3a73de..8b89cd5732 100755 --- a/core/threads/threads.factor +++ b/core/threads/threads.factor @@ -1,10 +1,11 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! Copyright (C) 2005 Mackenzie Straight. ! See http://factorcode.org/license.txt for BSD license. -IN: threads USING: arrays hashtables heaps kernel kernel.private math namespaces sequences vectors continuations continuations.private -dlists assocs system combinators init boxes accessors ; +dlists assocs system combinators init boxes accessors +math.order ; +IN: threads SYMBOL: initial-thread diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor index 24a00189e4..edd82b2596 100755 --- a/core/vocabs/vocabs.factor +++ b/core/vocabs/vocabs.factor @@ -76,14 +76,14 @@ SYMBOL: load-vocab-hook ! ( name -- ) : words-named ( str -- seq ) dictionary get values [ vocab-words at ] with map - [ ] subset ; + [ ] filter ; : child-vocab? ( prefix name -- ? ) 2dup = pick empty? or [ 2drop t ] [ swap CHAR: . suffix head? ] if ; : child-vocabs ( vocab -- seq ) - vocab-name vocabs [ child-vocab? ] with subset ; + vocab-name vocabs [ child-vocab? ] with filter ; TUPLE: vocab-link name ; diff --git a/core/words/words-tests.factor b/core/words/words-tests.factor index 694e54cf96..2a164ab11d 100755 --- a/core/words/words-tests.factor +++ b/core/words/words-tests.factor @@ -68,7 +68,7 @@ FORGET: another-forgotten : foe fee ; : fie foe ; -[ t ] [ \ fee usage [ word? ] subset empty? ] unit-test +[ t ] [ \ fee usage [ word? ] filter empty? ] unit-test [ t ] [ \ foe usage empty? ] unit-test [ f ] [ \ foe crossref get key? ] unit-test @@ -80,7 +80,7 @@ FORGET: foe ] unit-test [ t ] [ - \ * usage [ word? ] subset [ crossref? ] all? + \ * usage [ word? ] filter [ crossref? ] all? ] unit-test DEFER: calls-a-gensym diff --git a/core/words/words.factor b/core/words/words.factor index 3466544eef..138b1ef928 100755 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays definitions graphs assocs kernel kernel.private slots.private math namespaces sequences strings vectors sbufs -quotations assocs hashtables sorting words.private vocabs ; +quotations assocs hashtables sorting words.private vocabs +math.order ; IN: words : word ( -- word ) \ word get-global ; @@ -101,7 +102,7 @@ SYMBOL: compiled-crossref compiled-crossref global [ H{ } assoc-like ] change-at : compiled-xref ( word dependencies -- ) - [ drop compiled-crossref? ] assoc-subset + [ drop compiled-crossref? ] assoc-filter 2dup "compiled-uses" set-word-prop compiled-crossref get add-vertex* ; @@ -121,7 +122,7 @@ SYMBOL: +called+ : compiled-usages ( words -- seq ) [ [ dup ] H{ } map>assoc dup ] keep [ - compiled-usage [ nip +inlined+ eq? ] assoc-subset update + compiled-usage [ nip +inlined+ eq? ] assoc-filter update ] with each keys ;