Merge branch 'master' of git://factorcode.org/git/factor

Conflicts:

	extra/bunny/bunny.factor
	extra/opengl/demo-support/demo-support.factor

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:

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." } ;
 
@@ -281,7 +281,7 @@ HELP: assoc-union
 
 HELP: assoc-diff
 { $values { "assoc1" assoc } { "assoc2" assoc } { "diff" "a new assoc" } }
-{ $description "Outputs an assoc consisting of all entries from " { $snippet "assoc2" } " whose key is not contained in " { $snippet "assoc1" } "." } 
+{ $description "Outputs an assoc consisting of all entries from " { $snippet "assoc1" } " whose key is not contained in " { $snippet "assoc2" } "." } 
 ;
 HELP: remove-all
 { $values { "assoc" assoc } { "seq" "a sequence" } { "subseq" "a new sequence" } }

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 ] [

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 ;
+    [ 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

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

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 )
@@ -305,7 +305,7 @@ M: float-array ' float-array emit-dummy-array ;
 
 ! Tuples
 : (emit-tuple) ( tuple -- pointer )
-    [ tuple>array 1 tail-slice ]
+    [ tuple>array rest-slice ]
     [ class transfer-word tuple-layout ] bi prefix [ ' ] map
     tuple type-number dup [ emit-seq ] emit-object ;
 

core/bootstrap/primitives.factor

@@ -157,7 +157,7 @@ num-types get f <array> 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
 

core/bootstrap/stage2.factor

@@ -22,13 +22,13 @@ SYMBOL: bootstrap-time
     xref-sources ;
 
 : load-components ( -- )
-    "exclude" "include"
+    "include" "exclude"
-    [ 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

core/classes/algebra/algebra.factor

@@ -183,7 +183,7 @@ C: <anonymous-complement> 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> 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 ;

core/classes/classes-docs.factor

@@ -55,7 +55,7 @@ HELP: class
 { $values { "object" object } { "class" class } }
 { $description "Outputs an object's canonical class. While an object may be an instance of more than one class, the canonical class is either its built-in class, or if the object is a tuple, its tuple class." }
 { $class-description "The class of all class words." }
-{ $examples { $example "USING: classes prettyprint ;" "1.0 class ." "float" } { $example "USING: classes prettyprint ;" "TUPLE: point x y z ;\nT{ point f 1 2 3 } class ." "point" } } ;
+{ $examples { $example "USING: classes prettyprint ;" "1.0 class ." "float" } { $example "USING: classes prettyprint ;" "IN: scratchpad" "TUPLE: point x y z ;\nT{ point f 1 2 3 } class ." "point" } } ;
 
 HELP: classes
 { $values { "seq" "a sequence of class words" } }
@@ -63,7 +63,7 @@ HELP: classes
 
 HELP: tuple-class
 { $class-description "The class of tuple class words." }
-{ $examples { $example "USING: classes prettyprint ;" "TUPLE: name title first last ;" "name tuple-class? ." "t" } } ;
+{ $examples { $example "USING: classes prettyprint ;" "IN: scratchpad" "TUPLE: name title first last ;" "name tuple-class? ." "t" } } ;
 
 HELP: update-map
 { $var-description "Hashtable mapping each class to a set of classes defined in terms of this class. The " { $link define-class } " word uses this information to update generic words when classes are redefined." } ;

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 ;

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

core/classes/singleton/singleton-docs.factor

@@ -18,7 +18,7 @@ HELP: SINGLETON:
     "Defines a new singleton class. The class word itself is the sole instance of the singleton class."
 }
 { $examples
-    { $example "USING: classes.singleton kernel io ;" "SINGLETON: foo\nGENERIC: bar ( obj -- )\nM: foo bar drop \"a foo!\" print ;\nfoo bar" "a foo!" }
+    { $example "USING: classes.singleton kernel io ;" "IN: scratchpad" "SINGLETON: foo\nGENERIC: bar ( obj -- )\nM: foo bar drop \"a foo!\" print ;\nfoo bar" "a foo!" }
 } ;
 
 HELP: define-singleton-class

core/classes/tuple/tuple-docs.factor

@@ -341,6 +341,7 @@ HELP: new
 { $examples
     { $example
         "USING: kernel prettyprint ;"
+        "IN: scratchpad"
         "TUPLE: employee number name department ;"
         "employee new ."
         "T{ employee f f f f }"

core/classes/tuple/tuple-tests.factor

@@ -4,7 +4,7 @@ namespaces quotations sequences.private classes continuations
 generic.standard effects classes.tuple classes.tuple.private
 arrays vectors strings compiler.units accessors classes.algebra
 calendar prettyprint io.streams.string splitting inspector
-columns ;
+columns math.order ;
 IN: classes.tuple.tests
 
 TUPLE: rect x y w h ;
@@ -88,7 +88,7 @@ C: <empty> empty
 [ t length ] [ object>> t eq? ] must-fail-with
 
 [ "<constructor-test>" ]
-[ "TUPLE: constructor-test ; C: <constructor-test> constructor-test" eval word word-name ] unit-test
+[ "IN: classes.tuple.test TUPLE: constructor-test ; C: <constructor-test> constructor-test" eval word word-name ] unit-test
 
 TUPLE: size-test a b c d ;
 

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

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 ;

core/command-line/command-line.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2003, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-IN: command-line
 USING: init continuations debugger hashtables io kernel
 kernel.private namespaces parser sequences strings system
 splitting io.files ;
+IN: command-line
 
 : run-bootstrap-init ( -- )
     "user-init" get [
@@ -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* ;

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

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

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

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 ( -- )

core/cpu/ppc/architecture/architecture.factor

@@ -4,7 +4,7 @@ USING: alien.c-types cpu.ppc.assembler cpu.architecture generic
 kernel kernel.private math memory namespaces sequences words
 assocs generator generator.registers generator.fixup system
 layouts classes words.private alien combinators
-compiler.constants ;
+compiler.constants math.order ;
 IN: cpu.ppc.architecture
 
 ! PowerPC register assignments

core/cpu/ppc/assembler/assembler.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
+USING: generator.fixup generic kernel memory namespaces
+words math math.bitfields math.order io.binary ;
 IN: cpu.ppc.assembler
-USING: generator.fixup generic kernel math memory namespaces
-words math.bitfields io.binary ;
 
 ! See the Motorola or IBM documentation for details. The opcode
 ! names are standard, and the operand order is the same as in

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

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

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.

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 -- )
@@ -96,10 +97,10 @@ M: relative-overflow summary
 
 : assert-depth ( quot -- )
     >r datastack r> swap slip >r datastack r>
-    2dup [ length ] compare sgn {
+    2dup [ length ] compare {
-        { -1 [ trim-datastacks nip relative-underflow ] }
+        { +lt+ [ trim-datastacks nip relative-underflow ] }
-        { 0 [ 2drop ] }
+        { +eq+ [ 2drop ] }
-        { 1 [ trim-datastacks drop relative-overflow ] }
+        { +gt+ [ trim-datastacks drop relative-overflow ] }
     } case ; inline
 
 : expired-error. ( obj -- )

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 )
 

core/dlists/dlists-tests.factor

@@ -79,7 +79,7 @@ IN: dlists.tests
         [ dlist-push-all ] keep
         [ dlist-delete-all ] keep
         dlist>array
-    ] 2keep diff assert-same-elements
+    ] 2keep swap diff assert-same-elements
 ] unit-test
 
 [ ] [

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?

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

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 )
@@ -372,7 +372,7 @@ M: value (lazy-load)
 : (compute-free-vregs) ( used class -- vector )
     #! Find all vregs in 'class' which are not in 'used'.
     [ vregs length reverse ] keep
-    [ <vreg> ] curry map diff
+    [ <vreg> ] curry map swap diff
     >vector ;
 
 : compute-free-vregs ( -- )
@@ -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 -- )

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
 

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

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
@@ -23,7 +23,7 @@ PREDICATE: math-class < class
     } cond ;
     
 : math-class-max ( class class -- class )
-    [ [ math-precedence ] compare 0 > ] most ;
+    [ [ math-precedence ] compare +gt+ eq? ] most ;
 
 : (math-upgrade) ( max class -- quot )
     dupd = [ drop [ ] ] [ "coercer" word-prop [ ] or ] if ;

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< not ] curry assoc-filter ]
-    [ [ nip class<     ] curry assoc-subset ] 2bi ;
+    [ [ nip class<     ] curry assoc-filter ] 2bi ;
 
 : convert-methods ( assoc class word -- assoc' )
     over >r >r split-methods dup assoc-empty? [

core/generic/standard/engines/predicate/predicate.factor

@@ -17,8 +17,8 @@ C: <predicate-dispatch-engine> predicate-dispatch-engine
     {
         { [ dup empty? ] [ drop [ "Unreachable" throw ] { } ] }
         { [ dup length 1 = ] [ first second { } ] }
-        { [ dup keep-going? ] [ 1 tail-slice prune-redundant-predicates ] }
+        { [ dup keep-going? ] [ rest-slice prune-redundant-predicates ] }
-        [ [ first second ] [ 1 tail-slice ] bi ]
+        [ [ first second ] [ rest-slice ] bi ]
     } cond ;
 
 : sort-methods ( assoc -- assoc' )

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 ]

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"

core/heaps/heaps-tests.factor

@@ -3,7 +3,7 @@
 
 USING: arrays kernel math namespaces tools.test
 heaps heaps.private math.parser random assocs sequences sorting
-accessors ;
+accessors math.order ;
 IN: heaps.tests
 
 [ <min-heap> heap-pop ] must-fail

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
@@ -92,11 +92,11 @@ M: priority-queue heap-size ( heap -- n )
 
 GENERIC: heap-compare ( pair1 pair2 heap -- ? )
 
-: (heap-compare) drop [ entry-key ] compare 0 ; inline
+: (heap-compare) drop [ entry-key ] compare ; inline
 
-M: min-heap heap-compare (heap-compare) > ;
+M: min-heap heap-compare (heap-compare) +gt+ eq? ;
 
-M: max-heap heap-compare (heap-compare) < ;
+M: max-heap heap-compare (heap-compare) +lt+ eq? ;
 
 : heap-bounds-check? ( m heap -- ? )
     heap-size >= ; inline

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 )
@@ -60,7 +60,7 @@ M: object value-literal \ literal-expected inference-warning ;
 : value-vector ( n -- vector ) [ drop <computed> ] V{ } map-as ;
 
 : add-inputs ( seq stack -- n stack )
-    tuck [ length ] compare dup 0 >
+    tuck [ length ] bi@ - dup 0 >
     [ dup value-vector [ swapd push-all ] keep ]
     [ drop 0 swap ] if ;
 
@@ -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

core/inference/class/class-tests.factor

@@ -5,7 +5,7 @@ sequences words inference.class quotations alien
 alien.c-types strings sbufs sequences.private
 slots.private combinators definitions compiler.units
 system layouts vectors optimizer.math.partial accessors
-optimizer.inlining ;
+optimizer.inlining math.order ;
 
 [ t ] [ T{ literal-constraint f 1 2 } T{ literal-constraint f 1 2 } equal? ] unit-test
 

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

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?
 

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 ;
 

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
 

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 -- ? )
 
@@ -92,7 +92,7 @@ ERROR: no-parent-directory path ;
 : append-path-empty ( path1 path2 -- path' )
     {
         { [ dup head.? ] [
-            1 tail left-trim-separators append-path-empty
+            rest left-trim-separators append-path-empty
         ] }
         { [ dup head..? ] [ drop no-parent-directory ] }
         [ nip ]
@@ -122,7 +122,7 @@ PRIVATE>
         { [ over empty? ] [ append-path-empty ] }
         { [ dup empty? ] [ drop ] }
         { [ dup absolute-path? ] [ nip ] }
-        { [ dup head.? ] [ 1 tail left-trim-separators append-path ] }
+        { [ dup head.? ] [ rest left-trim-separators append-path ] }
         { [ dup head..? ] [
             2 tail left-trim-separators
             >r parent-directory r> append-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 ;

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 ;

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

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
 

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

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"

core/math/intervals/intervals-tests.factor

@@ -1,5 +1,5 @@
-USING: math.intervals kernel sequences words math arrays
+USING: math.intervals kernel sequences words math math.order
-prettyprint tools.test random vocabs combinators ;
+arrays prettyprint tools.test random vocabs combinators ;
 IN: math.intervals.tests
 
 [ T{ interval f { 1 t } { 2 t } } ] [ 1 2 [a,b] ] unit-test

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 ;

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

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

core/math/order/order-docs.factor

@@ -0,0 +1,72 @@
+USING: help.markup help.syntax kernel math sequences quotations
+math.private ;
+IN: math.order
+
+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
+        { { $link +lt+ } " - indicating that " { $snippet "obj1" } " precedes " { $snippet "obj2" } }
+        { { $link +eq+ } " - indicating that " { $snippet "obj1" } " is equal to " { $snippet "obj2" } }
+        { { $link +gt+ } " - indicating that " { $snippet "obj1" } " follows " { $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."
+} ;
+
+HELP: +lt+
+{ $description "Returned by " { $link <=> } " when the first object is strictly less than the second object." } ;
+
+HELP: +eq+
+{ $description "Returned by " { $link <=> } " when the first object is equal to the second object." } ;
+
+HELP: +gt+
+{ $description "Returned by " { $link <=> } " when the first object is strictly greater than the second object." } ;
+
+HELP: compare
+{ $values { "obj1" object } { "obj2" object } { "quot" "a quotation with stack effect " { $snippet "( obj -- newobj )" } } { "symbol" "a comparison symbol, +lt+, +eq+, or +gt+" } }
+{ $description "Compares the results of applying the quotation to both objects via " { $link <=> } "." }
+{ $examples { $example "USING: kernel math.order prettyprint sequences ;" "\"hello\" \"hi\" [ length ] compare ." "+gt+" }
+} ;
+
+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: 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" real } { "y" real } { "z" real } }
+{ $description "Subtracts " { $snippet "y" } " from " { $snippet "x" } ". If the result is less than zero, outputs zero." } ;
+

core/math/order/order-tests.factor

@@ -0,0 +1,9 @@
+USING: kernel math.order tools.test ;
+IN: math.order.tests
+
+[ +lt+ ] [ "ab" "abc" <=> ] unit-test
+[ +gt+ ] [ "abc" "ab" <=> ] unit-test
+[ +lt+ ] [ 3 4 <=> ] unit-test
+[ +eq+ ] [ 4 4 <=> ] unit-test
+[ +gt+ ] [ 4 3 <=> ] unit-test
+

core/math/order/order.factor

@@ -0,0 +1,40 @@
+! Copyright (C) 2008 Slava Pestov, Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math ;
+IN: math.order
+
+SYMBOL: +lt+
+SYMBOL: +eq+
+SYMBOL: +gt+
+
+GENERIC: <=> ( obj1 obj2 -- n )
+
+: (<=>) - dup 0 < [ drop +lt+ ] [ zero? +eq+ +gt+ ? ] if ;
+
+M: real <=> (<=>) ;
+M: integer <=> (<=>) ;
+
+GENERIC: before? ( obj1 obj2 -- ? )
+GENERIC: after? ( obj1 obj2 -- ? )
+GENERIC: before=? ( obj1 obj2 -- ? )
+GENERIC: after=? ( obj1 obj2 -- ? )
+
+M: object before? ( obj1 obj2 -- ? ) <=> +lt+ eq? ;
+M: object after? ( obj1 obj2 -- ? ) <=> +gt+ eq? ;
+M: object before=? ( obj1 obj2 -- ? ) <=> +gt+ eq? not ;
+M: object after=? ( obj1 obj2 -- ? ) <=> +lt+ eq? not ;
+
+M: real before? ( obj1 obj2 -- ? ) < ;
+M: real after? ( obj1 obj2 -- ? ) > ;
+M: real before=? ( obj1 obj2 -- ? ) <= ;
+M: real after=? ( obj1 obj2 -- ? ) >= ;
+
+: min ( x y -- z ) [ before? ] most ; inline 
+: max ( x y -- z ) [ after? ] most ; inline
+
+: between? ( x y z -- ? )
+    pick after=? [ after=? ] [ 2drop f ] if ; inline
+
+: [-] ( x y -- z ) - 0 max ; inline
+
+: compare ( obj1 obj2 quot -- n ) bi@ <=> ; inline

core/mirrors/mirrors-docs.factor

@@ -30,6 +30,7 @@ HELP: <mirror>
 { $examples
     { $example
         "USING: assocs mirrors prettyprint ;"
+        "IN: scratchpad"
         "TUPLE: circle center radius ;"
         "C: <circle> circle"
         "{ 100 50 } 15 <circle> <mirror> >alist ."

core/namespaces/namespaces-docs.factor

@@ -87,7 +87,7 @@ HELP: +@
 { $description "Adds " { $snippet "n" } " to the value of the variable. A variable value of " { $link f } " is interpreted as being zero." }
 { $side-effects "variable" }
 { $examples
-    { $example "USING: namespaces prettyprint ;" "SYMBOL: foo\n1 foo +@\n10 foo +@\nfoo get ." "11" }
+    { $example "USING: namespaces prettyprint ;" "IN: scratchpad" "SYMBOL: foo\n1 foo +@\n10 foo +@\nfoo get ." "11" }
 } ;
 
 HELP: inc

core/namespaces/namespaces-tests.factor

@@ -1,5 +1,5 @@
-IN: namespaces.tests
 USING: kernel namespaces tools.test words ;
+IN: namespaces.tests
 
 H{ } clone "test-namespace" set
 

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 [

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 ;
 

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

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 ]

core/optimizer/specializers/specializers.factor

@@ -12,7 +12,7 @@ IN: optimizer.specializers
 : make-specializer ( classes -- quot )
     dup length <reversed>
     [ (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

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 -- )
@@ -132,7 +132,7 @@ name>char-hook global [
     "{" ?head-slice [
         CHAR: } over index cut-slice
         >r >string name>char-hook get call r>
-        1 tail-slice
+        rest-slice
     ] [
         6 cut-slice >r hex> r>
     ] if ;
@@ -146,7 +146,7 @@ name>char-hook global [
 
 : (parse-string) ( str -- m )
     dup [ "\"\\" member? ] find dup [
-        >r cut-slice >r % r> 1 tail-slice r>
+        >r cut-slice >r % r> rest-slice r>
         dup CHAR: " = [
             drop slice-from
         ] [
@@ -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
@@ -345,6 +345,11 @@ M: invalid-slot-name summary
         [ >r tuple parse-tuple-slots r> prefix ]
     } case 3dup check-slot-shadowing ;
 
+ERROR: not-in-a-method-error ;
+
+M: not-in-a-method-error summary
+    drop "call-next-method can only be called in a method definition" ;
+
 ERROR: staging-violation word ;
 
 M: staging-violation summary
@@ -513,10 +518,10 @@ SYMBOL: interactive-vocabs
     ] if ;
 
 : filter-moved ( assoc1 assoc2 -- seq )
-    assoc-diff [
+    swap 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 +536,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

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
 

core/prettyprint/prettyprint-docs.factor

@@ -242,8 +242,16 @@ HELP: definer
 { $values { "defspec" "a definition specifier" } { "start" word } { "end" "a word or " { $link f } } }
 { $contract "Outputs the parsing words which delimit the definition." }
 { $examples
-    { $example "USING: definitions prettyprint ;" ": foo ; \\ foo definer . ." ";\nPOSTPONE: :" }
+    { $example "USING: definitions prettyprint ;"
-    { $example "USING: definitions prettyprint ;" "SYMBOL: foo \\ foo definer . ." "f\nPOSTPONE: SYMBOL:" }
+               "IN: scratchpad"
+               ": foo ; \\ foo definer . ."
+               ";\nPOSTPONE: :"
+    }
+    { $example "USING: definitions prettyprint ;"
+               "IN: scratchpad"
+               "SYMBOL: foo \\ foo definer . ."
+               "f\nPOSTPONE: SYMBOL:"
+    }
 }
 { $notes "This word is used in the implementation of " { $link see } "." } ;
 

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

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 ;

core/quotations/quotations.factor

@@ -50,14 +50,14 @@ M: curry nth
 INSTANCE: curry immutable-sequence
 
 M: compose length
-    dup compose-first length
+    [ compose-first length ]
-    swap compose-second 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

core/sequences/sequences-docs.factor

@@ -1,5 +1,5 @@
-USING: arrays bit-arrays help.markup help.syntax
+USING: arrays bit-arrays help.markup help.syntax math
-sequences.private vectors strings sbufs kernel 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 <slice> }
 { $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." }

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
+[ [ 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 = ] subset ] 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-from ] unit-test
-[ f f ] [ 100 { 1 2 3 } [ 1 = ] find-last* ] unit-test
+[ f f ] [ 100 { 1 2 3 } [ 1 = ] find-last-from ] unit-test
-[ f f ] [ -1 { 1 2 3 } [ 1 = ] find* ] 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

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 ) [ <reversed> ] keep like ;
+: reverse ( seq -- newseq ) [ <reversed> ] [ 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) <slice> ;
 
+: 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 -- tailseq ) 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
+    [ >r over length r> copy ]
-    [ 0 swap copy ] keep ; inline
+    [ 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
+        [ >r pick length pick length + r> copy ]
-        ((append))
+        [ ((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-from ( n seq quot -- i elt )
-    [ (find-integer) ] (find*) ; inline
+    [ (find-integer) ] (find-from) ; inline
 
 : find ( seq quot -- i elt )
     [ find-integer ] (find) ; inline
 
-: find-last* ( n seq quot -- i elt )
+: find-last-from ( n seq quot -- i elt )
-    [ nip find-last-integer ] (find*) ; inline
+    [ 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 )
+: index-from ( obj i seq -- n )
-    rot [ = ] curry find* drop ;
+    rot [ = ] curry find-from drop ;
 
 : last-index ( obj seq -- n )
     [ = ] with find-last drop ;
 
-: last-index* ( obj i seq -- n )
+: last-index-from ( obj i seq -- n )
-    rot [ = ] curry find-last* drop ;
+    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 ;
 
 <PRIVATE
 
@@ -650,7 +656,7 @@ PRIVATE>
 
 : 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 ;
 
 : <flat-slice> ( seq -- slice )
     dup slice? [ { } like ] when 0 over length rot <slice> ;
@@ -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 ;

core/sets/sets-docs.factor

@@ -39,9 +39,9 @@ HELP: all-unique?
 
 HELP: diff
 { $values { "seq1" sequence } { "seq2" sequence } { "newseq" sequence } }
-{ $description "Outputs a sequence consisting of elements present in " { $snippet "seq2" } " but not " { $snippet "seq1" } ", comparing elements for equality." 
+{ $description "Outputs a sequence consisting of elements present in " { $snippet "seq1" } " but not " { $snippet "seq2" } ", comparing elements for equality." 
 } { $examples
-    { $example "USING: sets prettyprint ;" "{ 1 2 3 } { 2 3 4 } diff ." "{ 4 }" }
+    { $example "USING: sets prettyprint ;" "{ 1 2 3 } { 2 3 4 } diff ." "{ 1 }" }
 } ;
 
 HELP: intersect

core/sets/sets-tests.factor

@@ -11,7 +11,7 @@ IN: sets.tests
 [ { 2 3 } ] [ { 1 2 3 } { 2 3 4 } intersect ] unit-test
 
 [ { } ] [ { } { } diff ] unit-test
-[ { 4 } ] [ { 1 2 3 } { 2 3 4 } diff ] unit-test
+[ { 1 } ] [ { 1 2 3 } { 2 3 4 } diff ] unit-test
 
 [ V{ } ] [ { } { } union ] unit-test
 [ V{ 1 2 3 4 } ] [ { 1 2 3 } { 2 3 4 } union ] unit-test

core/sets/sets.factor

@@ -22,10 +22,10 @@ IN: sets
     dup length <hashtable> [ (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 ;
+    unique [ key? not ] curry filter ;
 
 : union ( seq1 seq2 -- newseq )
     append prune ;

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 ;

core/sorting/sorting-docs.factor

@@ -1,5 +1,6 @@
-USING: sorting help.markup help.syntax kernel words math
+USING: help.markup help.syntax kernel words math
-sequences ;
+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:"

core/sorting/sorting-tests.factor

@@ -1,5 +1,5 @@
-USING: sorting sequences kernel math random tools.test
+USING: sorting sequences kernel math math.order random
-vectors ;
+tools.test vectors ;
 IN: sorting.tests
 
 [ [ ] ] [ [ ] natural-sort ] unit-test

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
 
@@ -17,7 +17,7 @@ DEFER: sort
     dup slice-from 1+ swap set-slice-from ; inline
 
 : smallest ( iter1 iter2 quot -- elt )
-    >r over this over this r> call 0 <
+    >r over this over this r> call +lt+ eq?
     -rot ? [ this ] keep next ; inline
 
 : (merge) ( iter1 iter2 quot accum -- )

core/source-files/source-files.factor

@@ -19,7 +19,7 @@ uses definitions ;
 
 : (xref-source) ( source-file -- pathname uses )
     dup source-file-path <pathname>
-    swap source-file-uses [ crossref? ] subset ;
+    swap source-file-uses [ crossref? ] filter ;
 
 : xref-source ( source-file -- )
     (xref-source) crossref get add-vertex ;

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
 

core/strings/strings-tests.factor

@@ -1,4 +1,4 @@
-USING: continuations kernel math namespaces strings
+USING: continuations kernel math math.order namespaces strings
 strings.private sbufs tools.test sequences vectors arrays memory
 prettyprint io.streams.null ;
 IN: strings.tests
@@ -31,6 +31,8 @@ IN: strings.tests
 
 [ t ] [ "abc" "abd" before? ] unit-test
 [ t ] [ "z" "abd" after? ] unit-test
+[ "abc" ] [ "abc" "abd" min ] unit-test
+[ "z" ] [ "z" "abd" max ] unit-test
 
 [ 0 10 "hello" subseq ] must-fail
 

core/syntax/syntax-docs.factor

@@ -190,7 +190,7 @@ HELP: delimiter
 HELP: parsing
 { $syntax ": foo ... ; parsing" }
 { $description "Declares the most recently defined word as a parsing word." }
-{ $examples "In the below example, the " { $snippet "world" } " word is never called, however its body references a parsing word which executes immediately:" { $example "USE: io" "<< : hello \"Hello parser!\" print ; parsing >>\n: world hello ;" "Hello parser!" } } ;
+{ $examples "In the below example, the " { $snippet "world" } " word is never called, however its body references a parsing word which executes immediately:" { $example "USE: io" "IN: scratchpad" "<< : hello \"Hello parser!\" print ; parsing >>\n: world hello ;" "Hello parser!" } } ;
 
 HELP: inline
 { $syntax ": foo ... ; inline" }
@@ -338,7 +338,7 @@ HELP: SYMBOL:
 { $syntax "SYMBOL: word" }
 { $values { "word" "a new word to define" } }
 { $description "Defines a new symbol word in the current vocabulary. Symbols push themselves on the stack when executed, and are used to identify variables (see " { $link "namespaces" } ") as well as for storing crufties in word properties (see " { $link "word-props" } ")." }
-{ $examples { $example "USE: prettyprint" "SYMBOL: foo\nfoo ." "foo" } } ;
+{ $examples { $example "USE: prettyprint" "IN: scratchpad" "SYMBOL: foo\nfoo ." "foo" } } ;
 
 { define-symbol POSTPONE: SYMBOL: } related-words
 
@@ -472,6 +472,7 @@ HELP: HOOK:
 { $examples
     { $example
         "USING: io namespaces ;"
+        "IN: scratchpad"
         "SYMBOL: transport"
         "TUPLE: land-transport ;"
         "TUPLE: air-transport ;"

core/syntax/syntax.factor

@@ -189,8 +189,12 @@ IN: bootstrap.syntax
     ] define-syntax
 
     "call-next-method" [
-        current-class get literalize parsed
+        current-class get current-generic get
-        current-generic get literalize parsed
+        2dup [ word? ] both? [
-        \ (call-next-method) parsed
+            [ literalize parsed ] bi@
+            \ (call-next-method) parsed
+        ] [
+            not-in-a-method-error
+        ] if
     ] define-syntax
 ] with-compilation-unit

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
 

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 ;
 

core/words/words-docs.factor

@@ -197,7 +197,7 @@ HELP: execute ( word -- )
 { $values { "word" word } }
 { $description "Executes a word." }
 { $examples
-    { $example "USING: kernel io words ;" ": twice dup execute execute ;\n: hello \"Hello\" print ;\n\\ hello twice" "Hello\nHello" }
+    { $example "USING: kernel io words ;" "IN: scratchpad" ": twice dup execute execute ;\n: hello \"Hello\" print ;\n\\ hello twice" "Hello\nHello" }
 } ;
 
 HELP: word-props ( word -- props )
@@ -278,7 +278,7 @@ HELP: reset-generic
 $low-level-note
 { $side-effects "word" } ;
 
-HELP: <word>
+HELP: <word> ( name vocab -- word )
 { $values { "name" string } { "vocab" string } { "word" word } }
 { $description "Allocates an uninterned word with the specified name and vocabulary, and a blank word property hashtable. User code should call " { $link gensym } " to create uninterned words and " { $link create } " to create interned words." } ;
 
@@ -300,7 +300,7 @@ HELP: word
 
 HELP: set-word
 { $values { "word" word } }
-{ $description "Sets the recently defined word. Usually you would call " { $link save-location } " on a newly-defined word instead, which will in turn call this word." } ;
+{ $description "Sets the recently defined word." } ;
 
 HELP: lookup
 { $values { "name" string } { "vocab" string } { "word" "a word or " { $link f } } }

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

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 ;
 
 <PRIVATE
@@ -135,9 +136,9 @@ SYMBOL: visited
         [ reset-on-redefine reset-props ]
         [ dup visited get set-at ]
         [
-            crossref get at keys [ word? ] subset [
+            crossref get at keys [ word? ] filter [
                 reset-on-redefine [ word-prop ] with contains?
-            ] subset
+            ] filter
             [ (redefined) ] each
         ] tri
     ] if ;

extra/alarms/alarms.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays calendar combinators generic init kernel math
 namespaces sequences heaps boxes threads debugger quotations
-assocs ;
+assocs math.order ;
 IN: alarms
 
 TUPLE: alarm quot time interval entry ;

extra/ascii/ascii-tests.factor

@@ -1,5 +1,5 @@
-IN: ascii.tests
 USING: ascii tools.test sequences kernel math ;
+IN: ascii.tests
 
 [ t ] [ CHAR: a letter? ] unit-test
 [ f ] [ CHAR: A letter? ] unit-test
@@ -8,7 +8,6 @@ USING: ascii tools.test sequences kernel math ;
 [ t ] [ CHAR: 0 digit? ] unit-test
 [ f ] [ CHAR: x digit? ] unit-test
 
-
 [ 4 ] [
     0 "There are Four Upper Case characters"
     [ LETTER? [ 1+ ] when ] each

extra/ascii/ascii.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: sequences math kernel ;
+USING: kernel math math.order sequences ;
 IN: ascii
 
 : blank? ( ch -- ? ) " \t\n\r" member? ; inline

extra/assocs/lib/lib.factor

@@ -38,7 +38,7 @@ IN: assocs.lib
 : insert ( value variable -- ) namespace insert-at ;
 
 : generate-key ( assoc -- str )
-    >r 256 random-bits >hex r>
+    >r 32 random-bits >hex r>
     2dup key? [ nip generate-key ] [ drop ] if ;
 
 : set-at-unique ( value assoc -- key )

extra/benchmark/binary-trees/binary-trees.factor

@@ -1,5 +1,5 @@
 USING: kernel math accessors prettyprint io locals sequences
-math.ranges ;
+math.ranges math.order ;
 IN: benchmark.binary-trees
 
 TUPLE: tree-node item left right ;