generic words are more flexible, sequences cleaned up

CHANGES.txt

@@ -1,8 +1,11 @@
 Factor 0.75:
 ------------
 
-The SO_OOBINLINE socket flag is now set. In 0.74, sending out-of-band
+New generational garbage collector. There are two command line switches
-data could fill up the buffer and cause a denial-of-service attack.
+for controlling it:
+
+ +Yn   Size of 2 youngest generations, megabytes
+ +An   Size of tenured and semi-spaces, megabytes
 
 The alien interface now supports "float" and "double" types.
 
@@ -10,6 +13,26 @@ Defining a predicate subclass of tuple is supported now. Note that
 unions and complements over tuples are still not supported. Also,
 predicate subclasses of concrete tuple classes are not supported either.
 
+The seq-each and seq-map words have been renamed to each and map, and
+now work with lists. The each and map words in the lists vocabulary have
+been removed; use the new generic equivalents instead.
+
+The SO_OOBINLINE socket flag is now set. In 0.74, sending out-of-band
+data could fill up the buffer and cause a denial-of-service attack.
+
+Generic words can now dispatch on stack elements other than the top one;
+define your generic like this to dispatch on the second element:
+
+ G: foo [ over ] [ type ] ;
+
+Or this for the third:
+
+ G: foo [ pick ] [ type ] ;
+
+Note that GENERIC: foo is the same as
+
+ G: foo [ dup ] [ type ] ;
+
 Factor 0.74:
 ------------
 

TODO.FACTOR.txt

@@ -6,7 +6,7 @@
 <magnus--> http://www.caddr.com/macho/archives/sbcl-devel/2005-3/4764.html
 <magnus--> http://clozure.com/cgi-bin/viewcvs.cgi/ccl/lisp-kernel/lisp-exceptions.c?rev=1.9&content-type=text/vnd.viewcvs-markup
 
-
+- investigate if COPYING_GEN needs a fix
 - alien-global type wrong
 - simplifier:
   - dead loads not optimized out
@@ -22,8 +22,6 @@
 - sleep word
 - update docs
 - redo new compiler backend for PowerPC
-- type predicates: : foo? type 7 eq? ;
-- remove 'not' word, and move t?/f? to kernel
 
 - plugin: supportsBackspace
 - if external factor is down, don't add tons of random shit to the       
@@ -36,12 +34,10 @@
 - nappend: instead of using push, enlarge the sequence with set-length
   then add set the elements with set-nth
 - faster sequence operations
-- generic each some? all? memq? all=?  index? subseq? map
+- generic some? all? memq? all=?  index? subseq?
 - index and index* are very slow with lists
 - unsafe-sbuf>string
 - generic subseq
-- GENERIC: map
-  - list impl same as now
 - code walker & exceptions
 - if two tasks write to a unix stream, the buffer can overflow
 - rename prettyprint to pprint

contrib/cont-responder/eval-responder.factor

@@ -73,7 +73,7 @@ USE: sequences
 : escape-quotes ( string -- string )
   #! Replace occurrences of single quotes with
   #! backslash quote.
-  [ dup [ [[ CHAR: ' "\\'" ]] [[ CHAR: " "\\\"" ]] ] assoc dup rot ? ] seq-map ;
+  [ dup [ [[ CHAR: ' "\\'" ]] [[ CHAR: " "\\\"" ]] ] assoc dup rot ? ] map ;
  
 : make-eval-javascript ( string -- string )
   #! Give a string return some javascript that when

contrib/cont-responder/todo-example.factor

@@ -209,7 +209,7 @@ USE: sequences
     ] [ 
       drop CHAR: _ 
     ] ifte 
-  ] seq-map ;
+  ] map ;
 
 : is-valid-username? ( username -- bool )
   #! Return true if the username parses correctly

examples/lcd.factor

@@ -8,7 +8,7 @@ USING: sequences kernel math stdio strings ;
     } nth >r 4 * dup 4 + r> substring ;
 
 : lcd-row ( num row -- )
-    swap [ CHAR: 0 - over lcd-digit write ] seq-each drop ;
+    swap [ CHAR: 0 - over lcd-digit write ] each drop ;
 
 : lcd ( num -- str )
     3 [ 2dup lcd-row terpri ] repeat drop ;

examples/timesheet.factor

@@ -36,7 +36,7 @@ strings unparser vectors ;
 
 : print-timesheet ( timesheet -- )
     "TIMESHEET:" print
-    [ uncons print-entry ] seq-each ;
+    [ uncons print-entry ] each ;
 
 ! Displaying a menu
 

library/alien/aliens.factor

@@ -3,10 +3,14 @@
 IN: alien
 USING: hashtables kernel lists math namespaces parser stdio ;
 
-BUILTIN: dll   15 [ 1 "dll-path" f ] ;
+DEFER: dll?
-BUILTIN: alien 16 ;
+BUILTIN: dll 15 dll? [ 1 "dll-path" f ] ;
-BUILTIN: byte-array 19 ;
+DEFER: alien?
-BUILTIN: displaced-alien 20 ;
+BUILTIN: alien 16 alien? ;
+DEFER: byte-array?
+BUILTIN: byte-array 19 byte-array? ;
+DEFER: displaced-alien?
+BUILTIN: displaced-alien 20 displaced-alien? ;
 
 : NULL ( -- null )
     #! C null value.

library/bootstrap/image.factor

@@ -180,7 +180,7 @@ M: f ' ( obj -- ptr )
 : fixup-words ( -- )
     image get [
         dup word? [ fixup-word ] when
-    ] seq-map image set ;
+    ] map image set ;
 
 M: word ' ( word -- pointer )
     transfer-word dup pooled-object dup [ nip ] [ drop ] ifte ;
@@ -311,7 +311,7 @@ M: hashtable ' ( hashtable -- pointer )
     ] ifte ;
 
 : write-image ( image file -- )
-    <file-writer> [ [ write-word ] seq-each ] with-stream ;
+    <file-writer> [ [ write-word ] each ] with-stream ;
 
 : with-minimal-image ( quot -- image )
     [

library/collections/arrays.factor

@@ -17,7 +17,8 @@ DEFER: repeat
 IN: kernel-internals
 USING: kernel math-internals sequences ;
 
-BUILTIN: array 8  ;
+DEFER: array?
+BUILTIN: array 8 array? ;
 
 : array-capacity ( a -- n ) 1 slot ; inline
 : array-nth ( n a -- obj ) swap 2 fixnum+ slot ; inline

library/collections/assoc.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: lists USING: kernel ;
+IN: lists USING: kernel sequences ;
 
 ! An association list is a list of conses where the car of each
 ! cons is a key, and the cdr is a value. See the Factor

library/collections/cons.factor

@@ -6,7 +6,9 @@ IN: lists USING: generic kernel sequences ;
 ! else depends on, and is loaded early in bootstrap.
 ! lists.factor has everything else.
 
-BUILTIN: cons 2 [ 0 "car" f ] [ 1 "cdr" f ] ;
+DEFER: cons?
+BUILTIN: cons 2 cons? [ 0 "car" f ] [ 1 "cdr" f ] ;
+UNION: general-list f cons ;
 
 ! We borrow an idiom from Common Lisp. The car/cdr of an empty
 ! list is the empty list.
@@ -14,6 +16,7 @@ M: f car ;
 M: f cdr ;
 
 GENERIC: >list ( seq -- list )
+M: general-list >list ( list -- list ) ;
 
 : swons ( cdr car -- [[ car cdr ]] )
     #! Push a new cons cell. If the cdr is f or a proper list,
@@ -49,17 +52,11 @@ M: cons peek ( list -- last )
     #! Last element of a list.
     last car ;
 
-UNION: general-list f cons ;
-
 PREDICATE: general-list list ( list -- ? )
     #! Proper list test. A proper list is either f, or a cons
     #! cell whose cdr is a proper list.
     dup [ last cdr ] when not ;
 
-: with ( obj quot elt -- obj quot )
-    #! Utility word for each-with, map-with.
-    pick pick >r >r swap call r> r> ; inline
-
 : all? ( list pred -- ? )
     #! Push if the predicate returns true for each element of
     #! the list.
@@ -79,15 +76,13 @@ PREDICATE: general-list list ( list -- ? )
 : (each) ( list quot -- list quot )
     [ >r car r> call ] 2keep >r cdr r> ; inline
 
-: each ( list quot -- )
+M: general-list each ( list quot -- )
     #! Push each element of a proper list in turn, and apply a
     #! quotation with effect ( elt -- ) to each element.
-    over [ (each) each ] [ 2drop ] ifte ; inline
+    over [ (each) each ] [ 2drop ] ifte ;
 
-: each-with ( obj list quot -- )
+M: cons tree-each ( cons quot -- )
-    #! Push each element of a proper list in turn, and apply a
+    >r uncons r> tuck >r >r tree-each r> r> tree-each ;
-    #! quotation with effect ( obj elt -- ) to each element.
-    swap [ with ] each 2drop ; inline
 
 : subset ( list quot -- list )
     #! Applies a quotation with effect ( X -- ? ) to each

library/collections/hashtables.factor

@@ -11,7 +11,8 @@ USING: generic kernel lists math sequences vectors ;
 
 ! We put hash-size in the hashtables vocabulary, and
 ! the other words in kernel-internals.
-BUILTIN: hashtable 10
+DEFER: hashtable?
+BUILTIN: hashtable 10 hashtable?
     [ 1 "hash-size" set-hash-size ]
     [ 2 hash-array set-hash-array ] ;
 

library/collections/lists.factor

@@ -3,7 +3,8 @@
 IN: lists USING: errors generic kernel math sequences ;
 
 ! Sequence protocol
-M: general-list length 0 swap [ drop 1 + ] each ;
+M: f length drop 0 ;
+M: cons length cdr length 1 + ;
 
 M: f empty? drop t ;
 M: cons empty? drop f ;
@@ -65,17 +66,11 @@ M: general-list contains? ( obj list -- ? )
 M: general-list reverse ( list -- list )
     [ ] swap [ swons ] each ;
 
-: map ( list quot -- list )
+M: general-list map ( list quot -- list )
     #! Push each element of a proper list in turn, and collect
     #! return values of applying a quotation with effect
     #! ( X -- Y ) to each element into a new list.
-    over [ (each) rot >r map r> swons ] [ drop ] ifte ; inline
+    over [ (each) rot >r map r> swons ] [ drop ] ifte ;
-
-: map-with ( obj list quot -- list )
-    #! Push each element of a proper list in turn, and collect
-    #! return values of applying a quotation with effect
-    #! ( obj elt -- obj ) to each element into a new list.
-    swap [ with rot ] map 2nip ; inline
 
 : remove ( obj list -- list )
     #! Remove all occurrences of objects equal to this one from

library/collections/sbuf.factor

@@ -6,7 +6,8 @@ sequences ;
 
 M: string (grow) grow-string ;
 
-BUILTIN: sbuf 13
+DEFER: sbuf?
+BUILTIN: sbuf 13 sbuf?
     [ 1 length set-capacity ]
     [ 2 underlying set-underlying ] ;
 

library/collections/sequences-epilogue.factor

@@ -23,38 +23,18 @@ M: object empty? ( seq -- ? ) length 0 = ;
     ] ifte ;
 
 M: object >list ( seq -- list ) dup length 0 rot (>list) ;
-M: general-list >list ( list -- list ) ;
 
 : 2nth ( s s n -- x x ) tuck swap nth >r swap nth r> ;
 
 ! Combinators
-GENERIC: (seq-each) ( quot seq -- ) inline
+M: object each ( quot seq -- )
+    swap dup length [
+        [ swap nth swap call ] 3keep
+    ] repeat 2drop ;
 
-M: object (seq-each) ( quot seq -- )
+M: object tree-each call ;
-    dup length [ [ swap nth swap call ] 3keep ] repeat 2drop ;
 
-M: general-list (seq-each) ( quot seq -- )
+M: sequence tree-each swap [ swap tree-each ] each-with ;
-    swap each ;
-
-: seq-each ( seq quot -- ) swap (seq-each) ; inline
-
-: seq-each-with ( obj seq quot -- )
-    swap [ with ] seq-each 2drop ; inline
-
-GENERIC: (tree-each) ( quot obj -- ) inline
-
-M: object (tree-each) swap call ;
-
-M: cons (tree-each) [ car (tree-each) ] 2keep cdr (tree-each) ;
-
-M: f (tree-each) swap call ;
-
-M: sequence (tree-each) [ (tree-each) ] seq-each-with ;
-
-: tree-each swap (tree-each) ; inline
-
-: tree-each-with ( obj vector quot -- )
-    swap [ with ] tree-each 2drop ; inline
 
 : change-nth ( seq i quot -- )
     pick pick >r >r >r swap nth r> call r> r> swap set-nth ;
@@ -74,11 +54,8 @@ M: sequence (tree-each) [ (tree-each) ] seq-each-with ;
 : immutable ( seq quot -- seq | quot: seq -- )
     swap [ thaw ] keep >r dup >r swap call r> r> freeze ; inline
 
-: seq-map ( seq quot -- seq | quot: elt -- elt )
+M: object map ( seq quot -- seq | quot: elt -- elt )
-    swap [ swap nmap ] immutable ; inline
+    swap [ swap nmap ] immutable ;
-
-: seq-map-with ( obj list quot -- list )
-    swap [ with rot ] seq-map 2nip ; inline
 
 : (2nmap) ( seq1 seq2 i quot -- elt3 )
     pick pick >r >r >r 2nth r> call r> r> swap set-nth ; inline
@@ -89,8 +66,8 @@ M: sequence (tree-each) [ (tree-each) ] seq-each-with ;
         [ >r 3dup r> swap (2nmap) ] keep
     ] repeat 3drop ; inline
 
-: seq-2map ( seq1 seq2 quot -- seq | quot: elt1 elt2 -- elt3 )
+M: object 2map ( seq1 seq2 quot -- seq | quot: elt1 elt2 -- elt3 )
-    swap [ swap 2nmap ] immutable ; inline
+    swap [ swap 2nmap ] immutable ;
 
 ! Operations
 : index* ( obj i seq -- n )
@@ -113,7 +90,7 @@ M: object contains? ( obj seq -- ? ) index -1 > ;
 
 : nappend ( s1 s2 -- )
     #! Destructively append s2 to s1.
-    [ over push ] seq-each drop ;
+    [ over push ] each drop ;
 
 : append ( s1 s2 -- s1+s2 )
     #! Return a new sequence of the same type as s1.
@@ -126,7 +103,7 @@ M: object contains? ( obj seq -- ? ) index -1 > ;
 : concat ( seq -- seq )
     #! Append together a sequence of sequences.
     dup empty? [
-        unswons [ swap [ nappend ] seq-each-with ] immutable
+        unswons [ swap [ nappend ] each-with ] immutable
     ] unless ;
 
 M: object peek ( sequence -- element )

library/collections/sequences.factor

@@ -22,6 +22,27 @@ GENERIC: reverse ( seq -- seq )
 GENERIC: peek ( seq -- elt )
 GENERIC: contains? ( elt seq -- ? )
 
+G: each ( seq quot -- | quot: elt -- )
+    [ over ] [ type ] ; inline
+
+: each-with ( obj seq quot -- | quot: obj elt -- )
+    swap [ with ] each 2drop ; inline
+
+G: tree-each ( obj quot -- | quot: elt -- )
+    [ over ] [ type ] ; inline
+
+: tree-each-with ( obj vector quot -- )
+    swap [ with ] tree-each 2drop ; inline
+
+G: map ( seq quot -- seq | quot: elt -- elt )
+    [ over ] [ type ] ; inline
+
+: map-with ( obj list quot -- list | quot: obj elt -- elt )
+    swap [ with rot ] map 2nip ; inline
+
+G: 2map ( seq seq quot -- seq | quot: elt elt -- elt )
+    [ over ] [ type ] ; inline
+
 DEFER: append ! remove this when sort is moved from lists to sequences
 
 ! Some low-level code used by vectors and string buffers.

library/collections/strings.factor

@@ -4,7 +4,8 @@ IN: strings
 USING: generic kernel kernel-internals lists math sequences ;
 
 ! Strings
-BUILTIN: string 12 [ 1 length f ] [ 2 hashcode f ] ;
+DEFER: string?
+BUILTIN: string 12 string? [ 1 length f ] [ 2 hashcode f ] ;
 
 M: string =
     over string? [

library/collections/vectors.factor

@@ -4,7 +4,8 @@ IN: vectors
 USING: errors generic kernel kernel-internals lists math
 math-internals sequences ;
 
-BUILTIN: vector 11
+DEFER: vector?
+BUILTIN: vector 11 vector?
     [ 1 length set-capacity ]
     [ 2 underlying set-underlying ] ;
 

library/combinators.factor

@@ -55,3 +55,7 @@ IN: kernel
     #! the quotation is evaluated. Otherwise, the condition is
     #! popped off the stack.
     dupd [ drop ] ifte ; inline
+
+: with ( obj quot elt -- obj quot )
+    #! Utility word for each-with, map-with.
+    pick pick >r >r swap call r> r> ; inline

library/compiler/generator.factor

@@ -17,7 +17,7 @@ GENERIC: generate-node ( vop -- )
 
 : generate-reloc ( -- length )
     relocation-table get
-    dup [ compile-cell ] seq-each
+    dup [ compile-cell ] each
     length cell * ;
 
 : (generate) ( word linear -- )

library/compiler/linearizer.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: compiler-frontend
-USING: compiler-backend inference kernel lists math namespaces
+USING: compiler-backend inference kernel kernel-internals lists
-words strings errors prettyprint kernel-internals ;
+math namespaces words strings errors prettyprint sequences ;
 
 : >linear ( node -- )
     #! Dataflow OPs have a linearizer word property. This

library/generic/builtin.factor

@@ -24,29 +24,25 @@ builtin 50 "priority" set-word-prop
 ! All builtin types are equivalent in ordering
 builtin [ 2drop t ] "class<" set-word-prop
 
-: builtin-predicate ( type# symbol -- )
+: builtin-predicate ( class -- )
-    #! We call search here because we have to know if the symbol
+    dup "predicate" word-prop car swap
-    #! is t or f, and cannot compare type numbers or symbol
+    [
-    #! identity during bootstrapping.
+        \ type , "builtin-type" word-prop , \ eq? ,
-    dup "f" [ "syntax" ] search = [
+    ] make-list
-        nip [ not ] "predicate" set-word-prop
+    define-compound ;
-    ] [
-        dup "t" [ "syntax" ] search = [
-            nip [ ] "predicate" set-word-prop
-        ] [
-            dup predicate-word
-            [ rot [ swap type eq? ] cons define-compound ] keep
-            unit "predicate" set-word-prop
-        ] ifte
-    ] ifte ;
 
-: builtin-class ( symbol type# slotspec -- )
+: register-builtin ( class -- )
-    >r 2dup builtins get set-nth r>
+    dup "builtin-type" word-prop builtins get set-nth ;
-    >r swap
+
+: define-builtin ( symbol type# predicate slotspec -- )
+    >r >r >r
     dup intern-symbol
-    2dup builtin-predicate
+    dup r> "builtin-type" set-word-prop
-    [ swap "builtin-type" set-word-prop ] keep
+    dup builtin define-class
-    dup builtin define-class r> define-slots ;
+    dup r> unit "predicate" set-word-prop
+    dup builtin-predicate
+    dup r> define-slots
+    register-builtin ;
 
 : builtin-type ( n -- symbol ) builtins get nth ;
 

library/generic/generic.factor

@@ -17,7 +17,8 @@ math-internals ;
 ! based on type, or some combination of type, predicate, or
 ! method map.
 ! - metaclass: a metaclass is a symbol with a handful of word
-! properties: "builtin-types" "priority"
+! properties: "builtin-supertypes" "priority" "add-method"
+! "class<"
 
 ! Metaclasses have priority -- this induces an order in which
 ! methods are added to the vtable.
@@ -57,9 +58,8 @@ math-internals ;
     ] unless* call ;
 
 : <empty-vtable> ( generic -- vtable )
-    unit num-types
+    [ literal, \ no-method , ] make-list
-    [ drop dup [ car no-method ] cons ] vector-project
+    num-types swap <repeated> >vector ;
-    nip ;
 
 : <vtable> ( generic -- vtable )
     dup <empty-vtable> over methods [
@@ -70,8 +70,12 @@ math-internals ;
 : make-generic ( word -- )
     #! (define-compound) is used to avoid resetting generic
     #! word properties.
-    dup <vtable> over "combination" word-prop cons
+    [
-    (define-compound) ;
+        dup "picker" word-prop %
+        dup "dispatcher" word-prop %
+        dup <vtable> ,
+        \ dispatch ,
+    ] make-list (define-compound) ;
 
 : define-method ( class generic definition -- )
     -rot
@@ -88,30 +92,25 @@ math-internals ;
      ] ifte ;
 
 ! Defining generic words
-: define-generic ( combination word -- )
+: define-generic* ( picker dispatcher word -- )
-    #! Takes a combination parameter. A combination is a
+    [ swap "dispatcher" set-word-prop ] keep
-    #! quotation that takes some objects and a vtable from the
+    [ swap "picker" set-word-prop ] keep
-    #! stack, and calls the appropriate row of the vtable.
-    [ swap "combination" set-word-prop ] keep
     dup init-methods make-generic ;
 
-: single-combination ( obj vtable -- )
+: define-generic ( word -- )
-    >r dup type r> dispatch ; inline
+    >r [ dup ] [ type ] r> define-generic* ;
 
 PREDICATE: compound generic ( word -- ? )
-    "combination" word-prop [ single-combination ] = ;
+    dup "dispatcher" word-prop [ type ] =
+    swap "picker" word-prop [ dup ] = and ;
 M: generic definer drop \ GENERIC: ;
 
-: single-combination ( obj vtable -- )
+: define-2generic ( word -- )
-    >r dup type r> dispatch ; inline
+    >r [ ] [ arithmetic-type ] r> define-generic* ;
-
-: arithmetic-combination ( n n vtable -- )
-    #! Note that the numbers remain on the stack, possibly after
-    #! being coerced to a maximal type.
-    >r arithmetic-type r> dispatch ; inline
 
 PREDICATE: compound 2generic ( word -- ? )
-    "combination" word-prop [ arithmetic-combination ] = ;
+    dup "dispatcher" word-prop [ arithmetic-type ] =
+    swap "picker" word-prop not and ;
 M: 2generic definer drop \ 2GENERIC: ;
 
 ! Maps lists of builtin type numbers to class objects.

library/generic/slots.factor

@@ -11,8 +11,7 @@ sequences strings words ;
     #! Just like:
     #! GENERIC: generic
     #! M: class generic def ;
-    over [ single-combination ] swap
+    over define-generic define-method ;
-    define-generic define-method ;
 
 : define-slot-word ( class slot word quot -- )
     over [

library/generic/tuple.factor

@@ -31,7 +31,8 @@ M: tuple-seq length ( tuple-seq -- len )
 
 IN: generic
 
-BUILTIN: tuple 18 [ 1 length f ] ;
+DEFER: tuple?
+BUILTIN: tuple 18 tuple? [ 1 length f ] ;
 
 ! So far, only tuples can have delegates, which also must be
 ! tuples (the UI uses numbers as delegates in a couple of places
@@ -162,8 +163,8 @@ UNION: arrayed array tuple ;
     #! Generate a quotation that performs tuple class dispatch
     #! for methods defined on the given generic.
     dup default-tuple-method \ drop swons
-    swap tuple-methods hash>quot
+    over tuple-methods hash>quot
-    [ dup class-tuple ] swap append ;
+    >r "picker" word-prop [ class-tuple ] r> append3 ;
 
 : add-tuple-dispatch ( word vtable -- )
     >r tuple-dispatch-quot tuple r> set-vtable ;

library/httpd/html.factor

@@ -19,9 +19,7 @@ stdio streams strings unparser http ;
 : chars>entities ( str -- str )
     #! Convert <, >, &, ' and " to HTML entities.
     [
-        [
+        [ dup html-entities assoc [ % ] [ , ] ?ifte ] each
-            dup html-entities assoc [ % ] [ , ] ?ifte
-        ] seq-each
     ] make-string ;
 
 : >hex-color ( triplet -- hex )

library/httpd/http-common.factor

@@ -21,7 +21,7 @@ stdio streams strings unparser ;
             ] [
                 CHAR: % , >hex 2 CHAR: 0 pad %
             ] ifte
-        ] seq-each
+        ] each
     ] make-string ;
 
 : catch-hex> ( str -- n )

library/inference/branches.factor

@@ -37,7 +37,7 @@ sequences strings vectors words hashtables prettyprint ;
 : unify-stacks ( list -- stack )
     #! Replace differing literals in stacks with unknown
     #! results.
-    unify-lengths vector-transpose [ unify-results ] seq-map ; 
+    unify-lengths vector-transpose [ unify-results ] map ; 
 
 : balanced? ( list -- ? )
     #! Check if a list of [[ instack outstack ]] pairs is
@@ -84,7 +84,7 @@ SYMBOL: cloned
 
 : deep-clone-seq ( seq -- seq )
     #! Clone a sequence and each object it contains.
-    [ deep-clone ] seq-map ;
+    [ deep-clone ] map ;
 
 : copy-inference ( -- )
     #! We avoid cloning the same object more than once in order

library/inference/conditions.factor

@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: inference
 USING: errors interpreter kernel lists namespaces prettyprint
-stdio ;
+sequences stdio ;
 
 DEFER: recursive-state
 

library/kernel.factor

@@ -27,13 +27,14 @@ M: object clone ;
     #! Push t if cond is true, otherwise push f.
     rot [ drop ] [ nip ] ifte ; inline
 
-: >boolean t f ? ; inline
+! defined in parse-syntax.factor
-: not ( a -- ~a ) f t ? ; inline
+DEFER: not
+DEFER: t?
 
+: >boolean t f ? ; inline
 : and ( a b -- a&b ) f ? ; inline
 : or ( a b -- a|b ) t swap ? ; inline
 : xor ( a b -- a^b ) dup not swap ? ; inline
-: implies ( a b -- a->b ) t ? ; inline
 
 : cpu ( -- arch ) 7 getenv ;
 : os ( -- os ) 11 getenv ;

library/math/complex.factor

@@ -10,7 +10,8 @@ USING: errors generic kernel kernel-internals math ;
 
 IN: math
 
-BUILTIN: complex 6 [ 0 "real" f ] [ 1 "imaginary" f ] ;
+DEFER: complex?
+BUILTIN: complex 6 complex? [ 0 "real" f ] [ 1 "imaginary" f ] ;
 UNION: number real complex ;
 
 M: real real ;

library/math/float.factor

@@ -3,7 +3,8 @@
 IN: math
 USING: generic kernel math-internals ;
 
-BUILTIN: float 5 ;
+DEFER: float?
+BUILTIN: float 5 float? ;
 UNION: real rational float ;
 
 M: real abs dup 0 < [ neg ] when ;

library/math/integer.factor

@@ -3,8 +3,10 @@
 IN: math
 USING: errors generic kernel math ;
 
-BUILTIN: fixnum 0 ;
+DEFER: fixnum?
-BUILTIN: bignum 1 ;
+BUILTIN: fixnum 0 fixnum? ;
+DEFER: bignum?
+BUILTIN: bignum 1 bignum? ;
 UNION: integer fixnum bignum ;
 
 : (gcd) ( b a y x -- a d )

library/math/math.factor

@@ -4,28 +4,28 @@ IN: math
 USING: errors generic kernel math-internals ;
 
 ! Math operations
-2GENERIC: number= ( x y -- ? )
+G: number= ( x y -- ? ) [ ] [ arithmetic-type ] ;
 M: object number= 2drop f ;
 
-2GENERIC: <  ( x y -- ? )
+G: <  ( x y -- ? ) [ ] [ arithmetic-type ] ;
-2GENERIC: <= ( x y -- ? )
+G: <= ( x y -- ? ) [ ] [ arithmetic-type ] ;
-2GENERIC: >  ( x y -- ? )
+G: >  ( x y -- ? ) [ ] [ arithmetic-type ] ;
-2GENERIC: >= ( x y -- ? )
+G: >= ( x y -- ? ) [ ] [ arithmetic-type ] ;
 
-2GENERIC: +   ( x y -- x+y )
+G: +   ( x y -- x+y ) [ ] [ arithmetic-type ] ;
-2GENERIC: -   ( x y -- x-y )
+G: -   ( x y -- x-y ) [ ] [ arithmetic-type ] ;
-2GENERIC: *   ( x y -- x*y )
+G: *   ( x y -- x*y ) [ ] [ arithmetic-type ] ;
-2GENERIC: /   ( x y -- x/y )
+G: /   ( x y -- x/y ) [ ] [ arithmetic-type ] ;
-2GENERIC: /i  ( x y -- x/y )
+G: /i  ( x y -- x/y ) [ ] [ arithmetic-type ] ;
-2GENERIC: /f  ( x y -- x/y )
+G: /f  ( x y -- x/y ) [ ] [ arithmetic-type ] ;
-2GENERIC: mod ( x y -- x%y )
+G: mod ( x y -- x%y ) [ ] [ arithmetic-type ] ;
 
-2GENERIC: /mod ( x y -- x/y x%y )
+G: /mod ( x y -- x/y x%y ) [ ] [ arithmetic-type ] ;
 
-2GENERIC: bitand ( x y -- z )
+G: bitand ( x y -- z ) [ ] [ arithmetic-type ] ;
-2GENERIC: bitor  ( x y -- z )
+G: bitor  ( x y -- z ) [ ] [ arithmetic-type ] ;
-2GENERIC: bitxor ( x y -- z )
+G: bitxor ( x y -- z ) [ ] [ arithmetic-type ] ;
-2GENERIC: shift  ( x n -- y )
+G: shift  ( x n -- y ) [ ] [ arithmetic-type ] ;
 
 GENERIC: bitnot ( n -- n )
 

library/math/matrices.factor

@@ -6,16 +6,16 @@ vectors ;
 
 : n*v ( n vec -- vec )
     #! Multiply a vector by a scalar.
-    [ * ] seq-map-with ;
+    [ * ] map-with ;
 
 ! Vector operations
-: v+ ( v v -- v ) [ + ] seq-2map ;
+: v+ ( v v -- v ) [ + ] 2map ;
-: v- ( v v -- v ) [ - ] seq-2map ;
+: v- ( v v -- v ) [ - ] 2map ;
-: v* ( v v -- v ) [ * ] seq-2map ;
+: v* ( v v -- v ) [ * ] 2map ;
 
 ! Later, this will fixed when seq-2each works properly
 ! : v. ( v v -- x ) 0 swap [ * + ] seq-2each ;
-: +/ ( seq -- n ) 0 swap [ + ] seq-each ;
+: +/ ( seq -- n ) 0 swap [ + ] each ;
 : v. ( v v -- x ) v* +/ ;
 
 ! Matrices

library/math/ratio.factor

@@ -3,7 +3,8 @@
 IN: math
 USING: generic kernel kernel-internals math math-internals ;
 
-BUILTIN: ratio 4 [ 0 "numerator" f ] [ 1 "denominator" f ] ;
+DEFER: ratio?
+BUILTIN: ratio 4 ratio? [ 0 "numerator" f ] [ 1 "denominator" f ] ;
 UNION: rational integer ratio ;
 
 M: integer numerator ;

library/sdl/sdl-keyboard.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: sdl
-USING: alien lists namespaces kernel math hashtables ;
+USING: alien lists namespaces kernel math hashtables
+sequences ;
 
 : SDL_EnableUNICODE ( enable -- )
     "int" "sdl" "SDL_EnableUNICODE" [ "int" ] alien-invoke ;

library/syntax/generic.factor

@@ -6,20 +6,22 @@ IN: !syntax
 USING: syntax generic kernel lists namespaces parser words ;
 
 : GENERIC:
-    #! GENERIC: bar creates a generic word bar. Add methods to
+    #! GENERIC: bar == G: bar [ dup ] [ type ] ;
-    #! the generic word using M:.
+    CREATE define-generic ; parsing
-    [ single-combination ] CREATE define-generic ; parsing
 
 : 2GENERIC:
-    #! 2GENERIC: bar creates a generic word bar. Add methods to
+    #! 2GENERIC: bar == G: bar [ ] [ arithmetic-type ] ;
-    #! the generic word using M:. 2GENERIC words dispatch on
+    #! 2GENERIC words dispatch on arithmetic types and should
-    #! arithmetic types and should not be used for non-numerical
+    #! not be used for non-numerical types.
-    #! types.
+    CREATE define-2generic ; parsing
-    [ arithmetic-combination ] CREATE define-generic ; parsing
+
+: G:
+    #! G: word picker dispatcher ;
+    CREATE [ 2unlist rot define-generic* ] [ ] ; parsing
 
 : BUILTIN:
-    #! Syntax: BUILTIN: <class> <type#> <slots> ;
+    #! Syntax: BUILTIN: <class> <type#> <predicate> <slots> ;
-    CREATE scan-word [ builtin-class ] [ ] ; parsing
+    CREATE scan-word scan-word [ define-builtin ] [ ] ; parsing
 
 : COMPLEMENT: ( -- )
     #! Followed by a class name, then a complemented class.
@@ -60,4 +62,4 @@ USING: syntax generic kernel lists namespaces parser words ;
     #! Followed by a tuple name, then constructor code, then ;
     #! Constructor code executes with the empty tuple on the
     #! stack.
-    scan-word [ define-constructor ] f ; parsing
+    scan-word [ define-constructor ] [ ] ; parsing

library/syntax/parse-numbers.factor

@@ -20,7 +20,7 @@ M: object digit> not-a-number ;
     dup empty? [
         not-a-number
     ] [
-        0 swap [ digit> pick digit+ ] seq-each nip
+        0 swap [ digit> pick digit+ ] each nip
     ] ifte ;
 
 : base> ( str base -- num )

library/syntax/parse-syntax.factor

@@ -23,14 +23,15 @@ words ;
 
 ! Booleans
 
-! The canonical t is a heap-allocated dummy object. It is always
+! The canonical t is a heap-allocated dummy object.
-! the first in the image.
+BUILTIN: t 7 t? ;
-BUILTIN: t 7 ;  : t t swons ; parsing
+: t t swons ; parsing
 
 ! In the runtime, the canonical f is represented as a null
 ! pointer with tag 3. So
 ! f address . ==> 3
-BUILTIN: f 9 ;  : f f swons ; parsing
+BUILTIN: f 9 not ;
+: f f swons ; parsing
 
 ! Lists
 : [ f ; parsing

library/syntax/prettyprint.factor

@@ -181,7 +181,7 @@ M: matrix prettyprint* ( indent obj -- indent )
 
 : [.] ( sequence -- )
     #! Unparse each element on its own line.
-    [ . ] seq-each ;
+    [ . ] each ;
 
 : .s datastack  reverse [.] flush ;
 : .r callstack  reverse [.] flush ;

library/syntax/see.factor

@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: prettyprint
 USING: generic hashtables kernel lists math namespaces
-presentation stdio streams strings unparser words ;
+sequences stdio streams strings unparser words ;
 
 ! Prettyprinting words
 : vocab-actions ( search -- list )

library/syntax/unparser.factor

@@ -87,7 +87,7 @@ M: complex unparse ( num -- str )
         dup ch>ascii-escape [ ] [ ch>unicode-escape ] ?ifte
     ] unless ;
 
-: unparse-string [ unparse-ch , ] seq-each ;
+: unparse-string [ unparse-ch , ] each ;
 
 M: string unparse ( str -- str )
     [ CHAR: " , unparse-string CHAR: " , ] make-string ;

library/test/generic.factor

@@ -1,5 +1,5 @@
 IN: temporary
-USING: parser prettyprint sequences stdio unparser ;
+USING: parser prettyprint sequences stdio strings unparser ;
 
 USE: hashtables
 USE: namespaces
@@ -157,3 +157,15 @@ M: number union-containment drop 2 ;
 "GENERIC: unhappy" eval
 [ "M: vocabularies unhappy ;" eval ] unit-test-fails
 [ ] [ "GENERIC: unhappy" eval ] unit-test
+
+G: complex-combination [ over ] [ type ] ;
+M: string complex-combination drop ;
+M: object complex-combination nip ;
+
+[ "hi" ] [ "hi" 3 complex-combination ] unit-test
+[ "hi" ] [ 3 "hi" complex-combination ] unit-test
+
+TUPLE: shit ;
+
+M: shit complex-combination cons ;
+[ [[ << shit f >> 5 ]] ] [ << shit f >> 5 complex-combination ] unit-test

library/test/strings.factor

@@ -80,13 +80,13 @@ unit-test
 
 [ 4 ] [
     0 "There are Four Upper Case characters"
-    [ LETTER? [ 1 + ] when ] seq-each
+    [ LETTER? [ 1 + ] when ] each
 ] unit-test
 
 [ "Replacing+spaces+with+plus" ]
 [
     "Replacing spaces with plus"
-    [ dup CHAR: \s = [ drop CHAR: + ] when ] seq-map
+    [ dup CHAR: \s = [ drop CHAR: + ] when ] map
 ]
 unit-test
 

library/test/vectors.factor

@@ -25,7 +25,7 @@ sequences strings test vectors ;
 [ { 1 2 } ] [ [ 1 2 ] >vector ] unit-test
 
 [ t ] [
-    100 empty-vector [ drop 0 100 random-int ] seq-map
+    100 empty-vector [ drop 0 100 random-int ] map
     dup >list >vector =
 ] unit-test
 
@@ -37,7 +37,7 @@ sequences strings test vectors ;
 [ [ 1 4 9 16 ] ]
 [
     [ 1 2 3 4 ]
-    >vector [ dup * ] seq-map >list
+    >vector [ dup * ] map >list
 ] unit-test
 
 [ t ] [ { } hashcode { } hashcode = ] unit-test

library/tools/word-tools.factor

@@ -2,8 +2,8 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: words
 USING: files generic inspector lists kernel namespaces
-prettyprint stdio streams strings unparser math hashtables
+prettyprint stdio streams strings sequences unparser math
-parser ;
+hashtables parser ;
 
 : vocab-apropos ( substring vocab -- list )
     #! Push a list of all words in a vocabulary whose names

library/ui/buttons.factor

@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
 USING: generic kernel lists math namespaces prettyprint sdl
-sequences stdio ;
+sequences stdio sequences ;
 
 : button-down? ( n -- ? ) hand hand-buttons contains? ;
 

library/ui/checkboxes.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: generic kernel lists math namespaces sdl ;
+USING: generic kernel lists math namespaces sdl sequences ;
 
 : check-size 8 ;
 

library/ui/frames.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: gadgets generic kernel lists math namespaces sdl words ;
+USING: gadgets generic kernel lists math namespaces sdl
+sequences words ;
 
 ! A frame arranges left/right/top/bottom gadgets around a
 ! center gadget, which gets any leftover space.

library/ui/gadgets.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: generic hashtables kernel lists math namespaces ;
+USING: generic hashtables kernel lists math namespaces
+sequences ;
 
 ! A gadget is a shape, a paint, a mapping of gestures to
 ! actions, and a reference to the gadget's parent. A gadget

library/ui/gestures.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: alien generic hashtables kernel lists math sdl ;
+USING: alien generic hashtables kernel lists math sdl
+sequences ;
 
 : action ( gadget gesture -- quot )
     swap gadget-gestures hash ;

library/ui/labels.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: generic kernel lists math namespaces sdl stdio ;
+USING: generic kernel lists math namespaces sdl stdio
+sequences ;
 
 ! A label gadget draws a string.
 TUPLE: label text ;

library/ui/layouts.factor

@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
 USING: errors generic hashtables kernel lists math namespaces
-sdl ;
+sdl sequences ;
 
 : layout ( gadget -- )
     #! Set the gadget's width and height to its preferred width

library/ui/paint.factor

@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
 USING: generic hashtables kernel lists math namespaces sdl
-stdio strings ;
+stdio strings sequences ;
 
 ! Clipping
 

library/ui/stacks.factor

@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
 USING: errors generic hashtables kernel lists math namespaces
-sdl ;
+sdl sequences ;
 
 ! A stack just lays out all its children on top of each other.
 TUPLE: stack ;

library/ui/text.factor

@@ -52,7 +52,7 @@ global [
 
 : filter-nulls ( str -- str )
     "\0" over string-contains? [
-        [ dup CHAR: \0 = [ drop CHAR: \s ] when ] seq-map
+        [ dup CHAR: \0 = [ drop CHAR: \s ] when ] map
     ] when ;
 
 : size-string ( font text -- w h )

library/ui/world.factor

@@ -3,7 +3,7 @@
 IN: gadgets
 USING: alien errors generic kernel lists math
 memory namespaces prettyprint sdl sequences stdio strings
-threads ;
+threads sequences ;
 
 ! The world gadget is the top level gadget that all (visible)
 ! gadgets are contained in. The current world is stored in the

library/words.factor

@@ -6,7 +6,8 @@ namespaces sequences strings vectors ;
 
 ! The basic word type. Words can be named and compared using
 ! identity. They hold a property map.
-BUILTIN: word 17
+DEFER: word?
+BUILTIN: word 17 word?
     [ 1 hashcode f ]
     [ 4 "word-def" "set-word-def" ]
     [ 5 "word-props" "set-word-props" ] ;
@@ -130,5 +131,6 @@ M: compound definer drop \ : ;
     #! If the word is a generic word, clear the properties 
     #! involved so that 'see' can work properly.
     over f "methods" set-word-prop
-    over f "combination" set-word-prop
+    over f "picker" set-word-prop
+    over f "dispatcher" set-word-prop
     (define-compound) ;