]> gitweb.factorcode.org Git - factor.git/commitdiff
more cleanups
authorSlava Pestov <slava@factorcode.org>
Mon, 22 Aug 2005 19:33:18 +0000 (19:33 +0000)
committerSlava Pestov <slava@factorcode.org>
Mon, 22 Aug 2005 19:33:18 +0000 (19:33 +0000)
24 files changed:
library/alien/syntax.factor
library/bootstrap/boot-stage1.factor
library/bootstrap/primitives.factor
library/collections/cons.factor
library/collections/sequence-sort.factor
library/collections/sequences.factor
library/collections/slicing.factor
library/collections/tree-each.factor
library/compiler/ppc/assembler.factor
library/compiler/vops.factor
library/compiler/x86/assembler.factor
library/generic/generic.factor
library/generic/tuple.factor
library/generic/union.factor
library/inference/words.factor
library/math/math.factor
library/syntax/generic.factor
library/syntax/math.factor [deleted file]
library/syntax/parse-syntax.factor
library/syntax/prettyprint.factor
library/test/generic.factor
library/test/test.factor
library/tools/inspector.factor
library/tools/memory.factor

index 9283db2f9117292b61f6465a1211d18968b20a16..f89054c91f600fb455ea668e64084743b95d4708 100644 (file)
@@ -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 ;
 
index 15c945eb19cda8a908a45e633fc04e8d90377756..9d18ef3b12732b22ddb8a279ce77d0011708bbce 100644 (file)
@@ -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
-"null" [ "generic" ] search
-"typemap" [ "generic" ] search
-"builtins" [ "generic" ] search
-
-vocabularies get [ "generic" off ] bind
-
-reveal
-reveal
-reveal
-reveal
-
-[
+    
+        "/library/bootstrap/init.factor"
+    } [ dup print parse-resource % ] each
+    
     [
         boot
         
@@ -136,44 +135,16 @@ reveal
 
         [ hashtable? ] instances
         [ dup hash-size 1 max swap set-bucket-count ] each
+        
+        "/library/bootstrap/boot-stage2.factor" run-resource
     ] %
-
-    {
-        "/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
-]
-
-append3
-
 vocabularies get [
     "!syntax" get "syntax" set
 
-    "syntax" get [
-        cdr dup word? [
-            "syntax" "vocabulary" set-word-prop
-        ] [
-            drop
-        ] ifte
-    ] hash-each
+    "syntax" get hash-values [ word? ] subset
+    [ "syntax" "vocabulary" set-word-prop ] each
 ] bind
 
 "!syntax" vocabularies get remove-hash
-
-FORGET: pull-in
index 220a5109b303daf1e5f522342132227eb4df821c..0bf5c24ad8b26dde8f8f9e59409009325a090983 100644 (file)
@@ -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
-"generic" vocab clone
+"syntax" vocab
 
 <namespace> vocabularies set
 f crossref set
 
-vocabularies get [
-    "generic" set
-    "syntax" set
-    reveal
-] bind
+vocabularies get [ "syntax" set [ reveal ] each ] bind
 
 : make-primitive ( { vocab word } n -- )
     >r 2unseq create r> f define ;
index 818185dedd50febb588da2b6583ea0fc151c2f35..4192b09b9f910147d674e4b2a70102f004c67001 100644 (file)
@@ -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
index 58429e098708aec0c2c9c28b55b7ea990d5aaf20..a5829f6b89fa92c312b51293a4c273e7836f1ba8 100644 (file)
@@ -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
index cef19dee68e1e43fded5fb4b52c0ef6149fcbd80..e2b9950fb6368f3266e8d16bfc1d8a29d688743e 100644 (file)
@@ -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
index ebd81d4a4793df0bda68619a3990b385a2d8b185..f959da79dbcfb08ecdabcfe3ce884a0e6f310ce2 100644 (file)
@@ -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> ;
index d41592e9780e7e7736bb8f2949860971b737cc73..5cf4099aefa4e1f86f200e8f1703a125f04f7fb1 100644 (file)
@@ -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
index 9e36b79b0bfea89c6ad6c652d384ff9d671559c7..4e7503e7a1abb435868ce525789c5276a4072b08 100644 (file)
@@ -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 ;
 
index 273516eb7a0f626a3ab45431eda276e5d8c9175e..8c872d54ca2ec6dc4585bf4530a35c33fd6f1c03 100644 (file)
@@ -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 ;
-: dest-vop ( dest) unit dup f ;
+: src-vop ( src) 1vector f 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+ ;
index 5595794ab95874f90695dd515831738b36721973..a1c3a12da411316c4a1b197238b08e27cf130b77 100644 (file)
@@ -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 ;
index 9ab74d8dec853bd6bc1ad7b0a139c6223a560ad7..c9f5ea649c47a56d39d1016d8b5608b0acea3f56 100644 (file)
@@ -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 ;
 
index 8a26ca75a2e08648566d5450aed045e6d6070837..321c93d6d89d1a6b18b0a057cd2ff7e6ba82b641 100644 (file)
@@ -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
 
index e091a5669b04f0a50bb380157fd37e15766e3781..7342ade6ca34a08c7a5bc5234a78b76ac0e1f62c 100644 (file)
@@ -9,8 +9,7 @@ SYMBOL: union
 
 : union-predicate ( members -- list )
     [
-        "predicate" word-prop
-        [ dup ] swap add [ drop t ] cons
+        "predicate" word-prop \ dup swons [ drop t ] cons
     ] map [ drop f ] swap alist>quot ;
 
 : set-members ( class members -- )
index c6abdeaecaa78e43035aa2915a6a41c2de13b597..1365cf74581cdc54cb18fc483a8dde95d8c57ae2 100644 (file)
@@ -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, ;
 
index 4e575e4d337b9d3c37613c3ff4573f20bc3beb3a..6ea8dec95ee49a18dca54769b8c2887bb5782879 100644 (file)
@@ -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 -- 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: /f  ( 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: bitand ( x y -- z ) [ ] [ math-combination ] ; foldable
-G: bitor  ( x y -- z ) [ ] [ math-combination ] ; foldable
-G: bitxor ( x y -- z ) [ ] [ math-combination ] ; foldable
-G: shift  ( x n -- 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: /i  ( 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 x%y ) math-combination ; foldable
+
+G: bitand ( x y -- z ) math-combination ; foldable
+G: bitor  ( x y -- z ) math-combination ; foldable
+G: bitxor ( x y -- z ) math-combination ; foldable
+G: shift  ( x n -- y ) math-combination ; foldable
 
 GENERIC: bitnot ( n -- n ) foldable
 
index d7190b5cf90eddbe280dfc88bbfc79df699c58ba..c611ddb1433aaffd886092319d86d808d2c32f46 100644 (file)
@@ -54,3 +54,7 @@ words ;
     #! stack.
     scan-word [ tuple-constructor ] keep
     [ define-constructor ] [ ] ; parsing
+
+! Tuples.
+: << f ; parsing
+: >> reverse literal-tuple swons ; parsing
diff --git a/library/syntax/math.factor b/library/syntax/math.factor
deleted file mode 100644 (file)
index c28a176..0000000
+++ /dev/null
@@ -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
index 7d96e2e06ec234cac019c5b26383d86ee2d26529..8436bb5b66873a4a8a468f50b519bc11431656b1 100644 (file)
@@ -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
index 49aefedf60eae10c472a89ad74f462b6579da842..fd899d4d4df15efff5cfe0f3c17599a538e3b9a7 100644 (file)
@@ -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 ;
 
index bd6a95f5c72ba74195034dce4f6d4da5aeb36f78..05a93d5c12158c1a6ae2b6f5933e408a8e89bf74 100644 (file)
@@ -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 ;
 
index 292c62fb6b5ceb3abe90d9905c31316eb68c677b..80e8c3495ef6ca14327fd77c82933d123d7a74b6 100644 (file)
@@ -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
index 426f5a9d89ea7a965affb58ce8f62a2eba657692..1a92619530850e2a6718d9bca1f038addd21c3ef 100644 (file)
@@ -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
index 8c4f0683e753e2f9d055bb28c3458ba9317d345c..aa10da4076db63774262ba7e476c0dc49729b2cd 100644 (file)
@@ -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 ;