more cleanups

library/alien/syntax.factor

@@ -23,7 +23,7 @@ USING: compiler kernel lists namespaces parser sequences words ;
 : LIBRARY: scan "c-library" set ; parsing
 
 : parse-arglist ( lst -- types stack effect )
-    unpair [
+    2 swap group flip 2unseq [
         " " % [ "," ?tail drop % " " % ] each "-- " %
     ] make-string ;
 

library/bootstrap/boot-stage1.factor

@@ -7,8 +7,6 @@ sequences io vectors words ;
 
 "Bootstrap stage 1..." print
 
-: pull-in ( list -- ) [ dup print parse-resource % ] each ;
-
 "/library/bootstrap/primitives.factor" run-resource
 
 ! The make-list form creates a boot quotation
@@ -16,6 +14,8 @@ sequences io vectors words ;
     {
         "/version.factor"
 
+        "/library/generic/early-generic.factor"
+
         "/library/kernel.factor"
 
         "/library/collections/sequences.factor"
@@ -67,8 +67,19 @@ sequences io vectors words ;
         "/library/syntax/parse-errors.factor"
         "/library/syntax/parser.factor"
         "/library/syntax/parse-stream.factor"
+
+        "/library/generic/generic.factor"
+        "/library/generic/standard-combination.factor"
+        "/library/generic/slots.factor"
+        "/library/generic/object.factor"
+        "/library/generic/null.factor"
+        "/library/generic/math-combination.factor"
+        "/library/generic/predicate.factor"
+        "/library/generic/union.factor"
+        "/library/generic/complement.factor"
+        "/library/generic/tuple.factor"
+
         "/library/syntax/generic.factor"
-        "/library/syntax/math.factor"
         "/library/syntax/parse-syntax.factor"
         
         "/library/alien/aliens.factor"
@@ -113,22 +124,10 @@ sequences io vectors words ;
         "/library/cli.factor"
         
         "/library/tools/memory.factor"
-    } pull-in
-] make-list
     
-"object" [ "generic" ] search
+        "/library/bootstrap/init.factor"
-"null" [ "generic" ] search
+    } [ dup print parse-resource % ] each
-"typemap" [ "generic" ] search
-"builtins" [ "generic" ] search
     
-vocabularies get [ "generic" off ] bind
-
-reveal
-reveal
-reveal
-reveal
-
-[
     [
         boot
         
@@ -136,44 +135,16 @@ reveal
 
         [ hashtable? ] instances
         [ dup hash-size 1 max swap set-bucket-count ] each
-    ] %
         
-    {
-        "/library/generic/generic.factor"
-        "/library/generic/standard-combination.factor"
-        "/library/generic/slots.factor"
-        "/library/generic/object.factor"
-        "/library/generic/null.factor"
-        "/library/generic/math-combination.factor"
-        "/library/generic/predicate.factor"
-        "/library/generic/union.factor"
-        "/library/generic/complement.factor"
-        "/library/generic/tuple.factor"
-    
-        "/library/bootstrap/init.factor"
-    } pull-in
-] make-list
-
-swap
-
-[
         "/library/bootstrap/boot-stage2.factor" run-resource
-]
+    ] %
-
+] make-list
-append3
 
 vocabularies get [
     "!syntax" get "syntax" set
 
-    "syntax" get [
+    "syntax" get hash-values [ word? ] subset
-        cdr dup word? [
+    [ "syntax" "vocabulary" set-word-prop ] each
-            "syntax" "vocabulary" set-word-prop
-        ] [
-            drop
-        ] ifte
-    ] hash-each
 ] bind
 
 "!syntax" vocabularies get remove-hash
-
-FORGET: pull-in

library/bootstrap/primitives.factor

@@ -9,22 +9,17 @@ math namespaces sequences strings vectors words ;
 
 "Creating primitives and basic runtime structures..." print
 
-! This symbol needs the same hashcode in the target as in the
+! These symbols need the same hashcode in the target as in the
 ! host.
-vocabularies
+{ vocabularies object null typemap builtins }
 
 ! Bring up a bare cross-compiling vocabulary.
-"syntax" vocab clone
+"syntax" vocab
-"generic" vocab clone
 
 <namespace> vocabularies set
 f crossref set
 
-vocabularies get [
+vocabularies get [ "syntax" set [ reveal ] each ] bind
-    "generic" set
-    "syntax" set
-    reveal
-] bind
 
 : make-primitive ( { vocab word } n -- )
     >r 2unseq create r> f define ;

library/collections/cons.factor

@@ -31,15 +31,10 @@ PREDICATE: general-list list ( list -- ? )
 : swons ( cdr car -- [[ car cdr ]] ) swap cons ; inline
 : unit ( a -- [ a ] ) f cons ; inline
 : 2list ( a b -- [ a b ] ) unit cons ; inline
-: 2unlist ( [ a b ] -- a b ) uncons car ; inline
 
 : 2car ( cons cons -- car car ) swap car swap car ; inline
 : 2cdr ( cons cons -- car car ) swap cdr swap cdr ; inline
 
-: unpair ( list -- list1 list2 )
-    [ uncons uncons unpair rot swons >r cons r> ] [ f f ] ifte* ;
-    flushable
-
 : <queue> ( -- queue )
     #! Make a new functional queue.
     [[ [ ] [ ] ]] ; foldable

library/collections/sequence-sort.factor

@@ -3,7 +3,7 @@ USING: kernel math sequences ;
 
 : midpoint ( seq -- elt ) dup length 2 /i swap nth ; inline
 
-TUPLE: sorter start end mid ;
+TUPLE: sorter seq start end mid ;
 
 C: sorter ( seq start end -- sorter )
     [ >r 1 + rot <slice> r> set-sorter-seq ] keep

library/collections/sequences.factor

@@ -29,7 +29,7 @@ GENERIC: resize ( n seq -- seq )
     swap [ thaw ] keep >r dup >r swap call r> r> like ; inline
 
 G: each ( seq quot -- | quot: elt -- )
-    [ over ] [ standard-combination ] ; inline
+    [ over ] standard-combination ; inline
 
 : each-with ( obj seq quot -- | quot: obj elt -- )
     swap [ with ] each 2drop ; inline
@@ -38,7 +38,7 @@ G: each ( seq quot -- | quot: elt -- )
     swapd each ; inline
 
 G: find ( seq quot -- i elt | quot: elt -- ? )
-    [ over ] [ standard-combination ] ; inline
+    [ over ] standard-combination ; inline
 
 : find-with ( obj seq quot -- i elt | quot: elt -- ? )
     swap [ with rot ] find 2swap 2drop ; inline

library/collections/slicing.factor

@@ -78,7 +78,7 @@ M: object tail ( index seq -- seq )
 
 : group ( n seq -- list )
     #! Split a sequence into element chunks.
-    [ 0 -rot (group) ] make-list ; flushable
+    [ 0 -rot (group) ] make-vector ; flushable
 
 : start-step ( subseq seq n -- subseq slice )
     pick length dupd + rot <slice> ;

library/collections/tree-each.factor

@@ -4,7 +4,7 @@ IN: sequences
 USING: generic kernel lists strings ;
 
 G: tree-each ( obj quot -- | quot: elt -- )
-    [ over ] [ standard-combination ] ; inline
+    [ over ] standard-combination ; inline
 
 : tree-each-with ( obj vector quot -- )
     swap [ with ] tree-each 2drop ; inline

library/compiler/ppc/assembler.factor

@@ -158,7 +158,7 @@ USING: compiler errors generic kernel math memory words ;
 : STH d-form 44 insn ;  : STHU d-form 45 insn ;
 : STW d-form 36 insn ;  : STWU d-form 37 insn ;
 
-G: (B) ( dest aa lk -- ) [ pick ] [ standard-combination ] ;
+G: (B) ( dest aa lk -- ) [ pick ] standard-combination ;
 M: integer (B) i-form 18 insn ;
 M: word (B) 0 -rot (B) relative-24 ;
 

library/compiler/vops.factor

@@ -47,8 +47,8 @@ M: vop calls-label? vop-label = ;
 : empty-vop f f f ;
 : label-vop ( label) >r f f r> ;
 : label/src-vop ( label src) 1vector swap f swap ;
-: src-vop ( src) unit f f ;
+: src-vop ( src) 1vector f f ;
-: dest-vop ( dest) unit dup f ;
+: dest-vop ( dest) 1vector dup f ;
 : src/dest-vop ( src dest) >r 1vector r> 1vector f ;
 : 2-in-vop ( in1 in2) 2vector f f ;
 : 3-in-vop ( in1 in2 in3) 3vector f f ;
@@ -202,13 +202,13 @@ TUPLE: %fast-set-slot ;
 C: %fast-set-slot make-vop ;
 : %fast-set-slot ( value obj n )
     #! %fast-set-slot writes to vreg obj.
-    >r >r <vreg> r> <vreg> r> over >r 3vector r> unit f
+    >r >r <vreg> r> <vreg> r> over >r 3vector r> 1vector f
     <%fast-set-slot> ;
 M: %fast-set-slot basic-block? drop t ;
 
 TUPLE: %write-barrier ;
 C: %write-barrier make-vop ;
-: %write-barrier ( ptr ) <vreg> unit dup f <%write-barrier> ;
+: %write-barrier ( ptr ) <vreg> dest-vop <%write-barrier> ;
 
 ! fixnum intrinsics
 TUPLE: %fixnum+ ;

library/compiler/x86/assembler.factor

@@ -88,7 +88,7 @@ M: indirect canonicalize dup car EBP = [ drop [ EBP 0 ] ] when ;
 ( Displaced indirect register operands -- eg, [ EAX 4 ]        )
 PREDICATE: cons displaced
     dup length 2 =
-    [ 2unlist integer? swap register? and ] [ drop f ] ifte ;
+    [ 2unseq integer? swap register? and ] [ drop f ] ifte ;
 
 M: displaced modifier second byte? BIN: 01 BIN: 10 ? ;
 M: displaced register car register ;

library/generic/generic.factor

@@ -79,7 +79,19 @@ SYMBOL: builtin
      [ drop ] [ <namespace> "methods" set-word-prop ] ifte ;
 
 ! Defining generic words
+
+: bootstrap-combination ( quot -- quot )
+    #! Bootstrap hack.
+    global [
+        [
+            dup word? [
+                dup word-name swap word-vocabulary vocab hash
+            ] when
+        ] map
+    ] bind ;
+
 : define-generic* ( word combination -- )
+    bootstrap-combination
     dupd "combination" set-word-prop
     dup init-methods make-generic ;
 

library/generic/tuple.factor

@@ -12,12 +12,6 @@ namespaces parser sequences strings vectors words ;
 ! slot 2 - the class, a word
 ! slot 3 - the delegate tuple, or f
 
-: delegate ( object -- delegate )
-    dup tuple? [ 3 slot ] [ drop f ] ifte ; inline
-
-: set-delegate ( delegate tuple -- )
-    dup tuple? [ 3 set-slot ] [ 2drop ] ifte ; inline
-
 : class ( object -- class )
     dup tuple? [ 2 slot ] [ type type>class ] ifte ; inline
 

library/generic/union.factor

@@ -9,8 +9,7 @@ SYMBOL: union
 
 : union-predicate ( members -- list )
     [
-        "predicate" word-prop
+        "predicate" word-prop \ dup swons [ drop t ] cons
-        [ dup ] swap add [ drop t ] cons
     ] map [ drop f ] swap alist>quot ;
 
 : set-members ( class members -- )

library/inference/words.factor

@@ -16,7 +16,7 @@ hashtables parser prettyprint ;
     #! produces a number of values.
     swap #call [
         over [
-            2unlist swap consume-d produce-d
+            2unseq swap consume-d produce-d
         ] hairy-node
     ] keep node, ;
 

library/math/math.factor

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

library/syntax/generic.factor

@@ -54,3 +54,7 @@ words ;
     #! stack.
     scan-word [ tuple-constructor ] keep
     [ define-constructor ] [ ] ; parsing
+
+! Tuples.
+: << f ; parsing
+: >> reverse literal-tuple swons ; parsing

library/syntax/math.factor

@@ -1,19 +0,0 @@
-! Copyright (C) 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-
-IN: !syntax
-USING: kernel lists math parser sequences syntax vectors ;
-
-! Complex numbers
-: #{ f ; parsing
-: }# dup second swap first rect> swons ; parsing
-
-! Reading integers in other bases
-: (BASE) ( base -- )
-    #! Reads an integer in a specific base.
-    scan swap base> swons ;
-
-: HEX: 16 (BASE) ; parsing
-: DEC: 10 (BASE) ; parsing
-: OCT: 8 (BASE) ; parsing
-: BIN: 2 (BASE) ; parsing

library/syntax/parse-syntax.factor

@@ -46,7 +46,7 @@ words ;
 
 ! Conses (whose cdr might not be a list)
 : [[ f ; parsing
-: ]] 2unlist swons swons ; parsing
+: ]] 2unseq swons swons ; parsing
 
 ! Vectors
 : { f ; parsing
@@ -56,10 +56,6 @@ words ;
 : {{ f ; parsing
 : }} alist>hash swons ; parsing
 
-! Tuples.
-: << f ; parsing
-: >> reverse literal-tuple swons ; parsing
-
 ! Do not execute parsing word
 : POSTPONE: ( -- ) scan-word swons ; parsing
 
@@ -136,3 +132,17 @@ words ;
 : #!
     #! Documentation comment.
     until-eol parsed-documentation ; parsing
+
+! Complex numbers
+: #{ f ; parsing
+: }# dup second swap first rect> swons ; parsing
+
+! Reading integers in other bases
+: (BASE) ( base -- )
+    #! Reads an integer in a specific base.
+    scan swap base> swons ;
+
+: HEX: 16 (BASE) ; parsing
+: DEC: 10 (BASE) ; parsing
+: OCT: 8 (BASE) ; parsing
+: BIN: 2 (BASE) ; parsing

library/syntax/prettyprint.factor

@@ -276,7 +276,7 @@ M: dll pprint* ( obj -- str ) dll-path "DLL\" " pprint-string ;
 
 M: cons pprint* ( list -- )
    [
-       dup list? [ \ [ \ ] ] [ uncons 2list \ [[ \ ]] ] ifte
+       dup list? [ \ [ \ ] ] [ uncons 2vector \ [[ \ ]] ] ifte
        pprint-sequence
    ] check-recursion ;
 

library/test/generic.factor

@@ -175,7 +175,7 @@ M: number union-containment drop 2 ;
 [ "M: vocabularies unhappy ;" eval ] unit-test-fails
 [ ] [ "GENERIC: unhappy" eval ] unit-test
 
-G: complex-combination [ over ] [ standard-combination ] ;
+G: complex-combination [ over ] standard-combination ;
 M: string complex-combination drop ;
 M: object complex-combination nip ;
 

library/test/test.factor

@@ -15,7 +15,7 @@ M: assert error.
     2dup = [ 2drop ] [ <assert> throw ] ifte ;
 
 : print-test ( input output -- )
-    "--> " write 2list . flush ;
+    "--> " write 2vector . flush ;
 
 : time ( code -- )
     #! Evaluates the given code and prints the time taken to

library/tools/inspector.factor

@@ -15,13 +15,13 @@ M: object sheet ( obj -- sheet )
     tuck [ execute ] map-with
     2vector ;
 
-M: list sheet unit ;
+M: list sheet 1vector ;
 
-M: vector sheet unit ;
+M: vector sheet 1vector ;
 
-M: array sheet unit ;
+M: array sheet 1vector ;
 
-M: hashtable sheet dup hash-keys swap hash-values 2list ;
+M: hashtable sheet dup hash-keys swap hash-values 2vector ;
 
 : format-column ( list -- list )
     [ unparse-short ] map

library/tools/memory.factor

@@ -60,7 +60,7 @@ unparser vectors words ;
     ] make-list ;
 
 G: each-slot ( obj quot -- )
-    [ over ] [ standard-combination ] ; inline
+    [ over ] standard-combination ; inline
 
 M: array each-slot ( array quot -- ) each ;