generic cleanups and type inference work

diff --git a/doc/devel-guide.tex b/doc/devel-guide.tex
index def5188ce51030342c2d5f89e3ac744ee8c0cb9f..3fc2bcaad813f885471952fc3a2d5ea22606f3d3 100644 (file)
--- a/doc/devel-guide.tex
+++ b/doc/devel-guide.tex
@@ -693,6 +693,10 @@ Entering colon definitions at the listener is very convenient for quick testing,
 Lets put our program for solving quadratic equations in a source file. Create a file named \texttt{quadratic.factor} in your favorite editor, and add the following content:
 
 \begin{verbatim}
+IN: quadratic
+USE: math
+USE: kernel
+
 : quadratic-e ( b a -- -b/2a )
     2 * / neg ;
 

diff --git a/factor/jedit/FactorPlugin.java b/factor/jedit/FactorPlugin.java
index 4ad20a438c244c41f55c3ef1cc6c713479aeee3e..cd9888456896289cfd58b4e579e9a196e4cf7799 100644 (file)
--- a/factor/jedit/FactorPlugin.java
+++ b/factor/jedit/FactorPlugin.java
@@ -104,7 +104,7 @@ public class FactorPlugin extends EditPlugin
                                nargs[1] = jEdit.getProperty("factor.external.image");
                                nargs[2] = "-no-ansi";
                                nargs[3] = "-no-smart-terminal";
-                               System.arraycopy(args,0,nargs,3,args.length);
+                               System.arraycopy(args,0,nargs,4,args.length);
                                p = Runtime.getRuntime().exec(nargs);
                                p.getErrorStream().close();
 

diff --git a/factor/jedit/FactorSideKickParser.java b/factor/jedit/FactorSideKickParser.java
index a2464d2ec90ec363dd8192a7d257a5d62f771f12..68e123d30a2acdf25d887cc4f67218cba90b506e 100644 (file)
--- a/factor/jedit/FactorSideKickParser.java
+++ b/factor/jedit/FactorSideKickParser.java
@@ -162,8 +162,11 @@ public class FactorSideKickParser extends SideKickParser
        {
                while(words != null)
                {
-                       Object obj = words.car;
-                       FactorPlugin.getExternalInstance().forget((FactorWord)obj);
+                       FactorWord word = (FactorWord)words.car;
+                       // We're not allowed to forget parsing words.
+                       if(word.parsing != null)
+                               return;
+                       FactorPlugin.getExternalInstance().forget(word);
                        words = words.next();
                }
        } //}}}

diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor
index 4f96a41acbc6563e0f10e3b1a1efa3e09cf925e3..a39fbe2e61c8c6b39befe4f2697ae83bad22945d 100644 (file)
--- a/library/bootstrap/boot-stage2.factor
+++ b/library/bootstrap/boot-stage2.factor
@@ -35,6 +35,10 @@ USE: namespaces
 \r
 "Cold boot in progress..." print\r
 \r
+! vocabularies get [\r
+!     "generic" off\r
+! ] bind\r
+\r
 [\r
     "/library/generic/generic.factor"\r
     "/library/generic/object.factor"\r
@@ -74,7 +78,6 @@ USE: namespaces
     "/library/syntax/parse-numbers.factor"\r
     "/library/syntax/parser.factor"\r
     "/library/syntax/parse-stream.factor"\r
-    "/library/bootstrap/init.factor"\r
 \r
     "/library/syntax/unparser.factor"\r
     "/library/io/presentation.factor"\r

diff --git a/library/bootstrap/boot.factor b/library/bootstrap/boot.factor
index 326cb39d823220a4fdda638321944aecfec1702e..13835f9722742bbec67f863fd2d50ef265a3b482 100644 (file)
--- a/library/bootstrap/boot.factor
+++ b/library/bootstrap/boot.factor
@@ -36,43 +36,61 @@ USE: words
 USE: hashtables
 
 "/library/bootstrap/primitives.factor" run-resource
-"/version.factor" run-resource
-"/library/stack.factor" run-resource
-"/library/combinators.factor" run-resource
-"/library/kernel.factor" run-resource
-"/library/cons.factor" run-resource
-"/library/assoc.factor" run-resource
-"/library/math/math.factor" run-resource
-"/library/math/integer.factor" run-resource
-"/library/math/ratio.factor" run-resource
-"/library/math/float.factor" run-resource
-"/library/math/complex.factor" run-resource
-"/library/words.factor" run-resource
-"/library/math/math-combinators.factor" run-resource
-"/library/lists.factor" run-resource
-"/library/vectors.factor" run-resource
-"/library/strings.factor" run-resource
-"/library/hashtables.factor" run-resource
-"/library/namespaces.factor" run-resource
-"/library/list-namespaces.factor" run-resource
-"/library/sbuf.factor" run-resource
-"/library/errors.factor" run-resource
-"/library/continuations.factor" run-resource
-"/library/threads.factor" run-resource
-"/library/io/stream.factor" run-resource
-"/library/io/stdio.factor" run-resource
-"/library/io/io-internals.factor" run-resource
-"/library/io/stream-impl.factor" run-resource
-"/library/vocabularies.factor" run-resource
-"/library/syntax/parse-numbers.factor" run-resource
-"/library/syntax/parser.factor" run-resource
-"/library/syntax/parse-stream.factor" run-resource
 
-! init.factor leaves a boot quotation on the stack
-"/library/bootstrap/init.factor" run-resource
+! The make-list form creates a boot quotation
+[
+    "/version.factor" parse-resource append,
+    "/library/stack.factor" parse-resource append,
+    "/library/combinators.factor" parse-resource append,
+    "/library/kernel.factor" parse-resource append,
+    "/library/cons.factor" parse-resource append,
+    "/library/assoc.factor" parse-resource append,
+    "/library/math/math.factor" parse-resource append,
+    "/library/math/integer.factor" parse-resource append,
+    "/library/math/ratio.factor" parse-resource append,
+    "/library/math/float.factor" parse-resource append,
+    "/library/math/complex.factor" parse-resource append,
+    "/library/words.factor" parse-resource append,
+    "/library/math/math-combinators.factor" parse-resource append,
+    "/library/lists.factor" parse-resource append,
+    "/library/vectors.factor" parse-resource append,
+    "/library/strings.factor" parse-resource append,
+    "/library/hashtables.factor" parse-resource append,
+    "/library/namespaces.factor" parse-resource append,
+    "/library/list-namespaces.factor" parse-resource append,
+    "/library/sbuf.factor" parse-resource append,
+    "/library/errors.factor" parse-resource append,
+    "/library/continuations.factor" parse-resource append,
+    "/library/threads.factor" parse-resource append,
+    "/library/io/stream.factor" parse-resource append,
+    "/library/io/stdio.factor" parse-resource append,
+    "/library/io/io-internals.factor" parse-resource append,
+    "/library/io/stream-impl.factor" parse-resource append,
+    "/library/vocabularies.factor" parse-resource append,
+    "/library/syntax/parse-numbers.factor" parse-resource append,
+    "/library/syntax/parser.factor" parse-resource append,
+    "/library/syntax/parse-stream.factor" parse-resource append,
 
-! A bootstrapping trick. See doc/bootstrap.txt.
-"/library/syntax/parse-syntax.factor" run-resource
+    "traits" [ "generic" ] search
+    "delegate" [ "generic" ] search
+
+    vocabularies get [ "generic" off ] bind
+
+    reveal
+    reveal
+
+    "/library/generic/generic.factor" parse-resource append,
+    "/library/generic/object.factor" parse-resource append,
+    "/library/generic/builtin.factor" parse-resource append,
+    "/library/generic/predicate.factor" parse-resource append,
+    "/library/generic/union.factor" parse-resource append,
+    "/library/generic/traits.factor" parse-resource append,
+
+    "/library/bootstrap/init.factor" parse-resource append,
+    "/library/syntax/parse-syntax.factor" parse-resource append,
+] make-list
+
+"boot" [ "kernel" ] search swons
 
 vocabularies get [
     "!syntax" get "syntax" set

diff --git a/library/bootstrap/init.factor b/library/bootstrap/init.factor
index b5c2700104fa6191ffa40794acdd24303ed0b636..bc0854d8aa8a562847a4614a230d514a8da68b5a 100644 (file)
--- a/library/bootstrap/init.factor
+++ b/library/bootstrap/init.factor
@@ -41,9 +41,6 @@ USE: words
     "HOME" os-env [ "." ] unless* "~" set
     init-search-path ;
 
-[
-    boot
-    "Good morning!" print
-    flush
-    "/library/bootstrap/boot-stage2.factor" run-resource
-]
+"Good morning!" print
+flush
+"/library/bootstrap/boot-stage2.factor" run-resource

diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor
index c4ed469169134ee8877ad434f1cdbc294aa70ce4..2587b3d03cd42149d59f7e7080185d9a02eb67b9 100644 (file)
--- a/library/bootstrap/primitives.factor
+++ b/library/bootstrap/primitives.factor
@@ -210,7 +210,6 @@ vocabularies get [
     [ "random" | "init-random" ]
     [ "random" | "(random-int)" ]
     [ "kernel" | "type" ]
-    [ "kernel" | "size" ]
     [ "files" | "cwd" ]
     [ "files" | "cd" ]
     [ "compiler" | "compiled-offset" ]

diff --git a/library/compiler/alien-types.factor b/library/compiler/alien-types.factor
index 5c9c1b2326f17d7246034ae13b0e34d409aa9073..937c6fb05c995c4d8d95b1a8b1eba6142502156a 100644 (file)
--- a/library/compiler/alien-types.factor
+++ b/library/compiler/alien-types.factor
@@ -75,12 +75,12 @@ USE: words
         dup "c-types" get hash dup [
             nip
         ] [
-            drop "No such C type: " swap cat2 throw
+            drop "No such C type: " swap cat2 throw f
         ] ifte
     ] bind ;
 
 : define-c-type ( quot name -- )
-    c-types [ >r <c-type> swap extend r> set ] bind ;
+    c-types [ >r <c-type> swap extend r> set ] bind ; inline
 
 : define-getter ( offset type name -- )
     #! Define a word with stack effect ( alien -- obj ) in the

diff --git a/library/generic/builtin.factor b/library/generic/builtin.factor
index c8e60e572e71a2daf75beab036ae341b2cf5d668..515314ec04273e22853c2219c0f09ca45a6a60ad 100644 (file)
--- a/library/generic/builtin.factor
+++ b/library/generic/builtin.factor
@@ -44,8 +44,8 @@ builtin [
 ] "builtin-supertypes" set-word-property
 
 builtin [
-    ( vtable definition class -- )
-    rot set-vtable
+    ( generic vtable definition class -- )
+    rot set-vtable drop
 ] "add-method" set-word-property
 
 builtin 50 "priority" set-word-property

diff --git a/library/generic/generic.factor b/library/generic/generic.factor
index c4e376498dca0abb23e21ba8980e43d3935a0841..6db948354324ef4048aecb512c4597ebaf62218d 100644 (file)
--- a/library/generic/generic.factor
+++ b/library/generic/generic.factor
@@ -76,9 +76,6 @@ USE: math-internals
 : set-vtable ( definition class vtable -- )
     >r "builtin-type" word-property r> set-vector-nth ;
 
-: <empty-vtable> ( -- vtable )
-    num-types [ drop [ undefined-method ] ] vector-project ;
-
 : class-ord ( class -- n ) metaclass "priority" word-property ;
 
 : class< ( cls1 cls2 -- ? )
@@ -87,40 +84,38 @@ USE: math-internals
 : sort-methods ( methods -- alist )
     hash>alist [ 2car class< ] sort ;
 
-: add-method ( vtable definition class -- )
+: add-method ( generic vtable definition class -- )
     #! Add the method entry to the vtable. Unlike define-method,
     #! this is called at vtable build time, and in the sorted
     #! order.
     dup metaclass "add-method" word-property
     [ [ undefined-method ] ] unless* call ;
 
-: <vtable> ( methods -- vtable )
-    <empty-vtable> swap sort-methods [
-        dupd unswons add-method
-    ] each ;
+: <empty-vtable> ( -- vtable )
+    num-types [ drop [ undefined-method ] ] vector-project ;
 
-DEFER: add-traits-dispatch
+: <vtable> ( generic methods -- vtable )
+    >r <empty-vtable> r> sort-methods [
+        >r 2dup r> unswons add-method
+    ] each nip ;
 
 : define-generic ( word vtable -- )
     over "combination" word-property cons define-compound ;
 
 : (define-method) ( definition class generic -- )
-    [ "methods" word-property [ set-hash ] keep <vtable> ] keep
-    swap define-generic ;
+    [ "methods" word-property set-hash ] keep
+    dup dup "methods" word-property <vtable>
+    define-generic ;
 
 ! Defining generic words
 : (GENERIC) ( combination -- )
     #! Takes a combination parameter. A combination is a
     #! quotation that takes some objects and a vtable from the
     #! stack, and calls the appropriate row of the vtable.
-    CREATE 2dup "combination" word-property = [
-        2drop
-    ] [
-        [ swap "combination" set-word-property ] keep
-        dup <namespace> "methods" set-word-property
-        <empty-vtable> [ add-traits-dispatch ] 2keep
-        define-generic
-    ] ifte ;
+    CREATE [ swap "combination" set-word-property ] keep
+    dup dup "methods" word-property [
+        dup <namespace> [ "methods" set-word-property ] keep
+    ] unless* <vtable> define-generic ;
 
 : single-combination ( obj vtable -- )
     >r dup type r> dispatch ; inline

diff --git a/library/generic/object.factor b/library/generic/object.factor
index ab740425e2544df311e712e0b09710b159414aa2..edd24e3faa29bcc465ebcf93bfda9ea429589220 100644 (file)
--- a/library/generic/object.factor
+++ b/library/generic/object.factor
@@ -45,10 +45,10 @@ object [
 ] "builtin-supertypes" set-word-property
 
 object [
-    ( vtable definition class -- )
+    ( generic vtable definition class -- )
     drop over vector-length [
         pick pick -rot set-vector-nth
-    ] times* 2drop
+    ] times* 3drop
 ] "add-method" set-word-property
 
 object [ drop t ] "predicate" set-word-property

diff --git a/library/generic/predicate.factor b/library/generic/predicate.factor
index d37002c0e2d266bf8044ef6f33abf8e3793d3f1e..ef17c0e1e1fa7a6c2f76635c4b71f64ab2103a85 100644 (file)
--- a/library/generic/predicate.factor
+++ b/library/generic/predicate.factor
@@ -56,11 +56,11 @@ predicate [
 ] "builtin-supertypes" set-word-property
 
 predicate [
-    ( vtable definition class -- )
+    ( generic vtable definition class -- )
     dup builtin-supertypes [
         ( vtable definition class type# )
         >r 3dup r> predicate-method
-    ] each 3drop
+    ] each 2drop 2drop
 ] "add-method" set-word-property
 
 predicate 25 "priority" set-word-property

diff --git a/library/generic/traits.factor b/library/generic/traits.factor
index ae7ba9f031bbb15b34e48468a9e46603dd13101f..b56cedf48ea47da706e747abf966666bbe4858af 100644 (file)
--- a/library/generic/traits.factor
+++ b/library/generic/traits.factor
@@ -46,18 +46,6 @@ SYMBOL: traits
     #! definitions.
     "traits-map" word-property ;
 
-traits [
-    ( class generic quotation )
-    
-    swap rot traits-map set-hash
-] "define-method" set-word-property
-
-traits [
-    \ vector "builtin-type" word-property unique,
-] "builtin-supertypes" set-word-property
-
-traits 10 "priority" set-word-property
-
 ! Hashtable slot holding an optional delegate. Any undefined
 ! methods are called on the delegate. The object can also
 ! manually pass any methods on to the delegate.
@@ -68,9 +56,6 @@ SYMBOL: delegate
     #! We will use hashtable? here when its a first-class type.
     dup vector? [ traits swap hash ] [ drop f ] ifte ;
 
-: init-traits-map ( word -- )
-    <namespace> "traits-map" set-word-property ;
-
 : traits-dispatch ( selector traits -- traits quot )
     #! Look up the method with the traits object on the stack.
     #! Returns the traits to call the method on; either the
@@ -85,6 +70,31 @@ SYMBOL: delegate
         ] ifte
     ] ifte ;
 
+: add-traits-dispatch ( word vtable -- )
+    >r unit [ car swap traits-dispatch call ] cons \ vector r>
+    set-vtable ;
+
+traits [
+    ( generic vtable definition class -- )
+    2drop add-traits-dispatch
+] "add-method" set-word-property
+
+traits [
+    ( class generic quotation )
+    3dup -rot (define-method)
+    over dup word-parameter car add-traits-dispatch
+    swap rot traits-map set-hash
+] "define-method" set-word-property
+
+traits [
+    drop vector "builtin-type" word-property unit
+] "builtin-supertypes" set-word-property
+
+traits 10 "priority" set-word-property
+
+: init-traits-map ( word -- )
+    <namespace> "traits-map" set-word-property ;
+
 : traits-predicate ( word -- )
     #! foo? where foo is a traits type tests if the top of stack
     #! is of this type.
@@ -101,10 +111,6 @@ SYMBOL: delegate
     dup traits "metaclass" set-word-property
     traits-predicate ; parsing
 
-: add-traits-dispatch ( word vtable -- )
-    >r unit [ car swap traits-dispatch call ] cons \ vector r>
-    set-vtable ;
-
 : constructor-word ( word -- word )
     word-name "<" swap ">" cat3 "in" get create ;
 

diff --git a/library/generic/union.factor b/library/generic/union.factor
index 89f0aa4afd796d099e04268ccd8993541eb89857..8da98f582d4bd465a2de83afd801fbc254758ab7 100644 (file)
--- a/library/generic/union.factor
+++ b/library/generic/union.factor
@@ -46,8 +46,8 @@ union [
 ] "builtin-supertypes" set-word-property
 
 union [
-    ( vtable definition class -- )
-    "members" word-property [ >r 2dup r> add-method ] each 2drop
+    ( generic vtable definition class -- )
+    "members" word-property [ >r 3dup r> add-method ] each 3drop
 ] "add-method" set-word-property
 
 union 30 "priority" set-word-property

diff --git a/library/inference/branches.factor b/library/inference/branches.factor
index 2960bd6268a4dda17f38282e4634674429ad7bd1..56b16f00025766d0b375054b3dff3ad88a5ba7e9 100644 (file)
--- a/library/inference/branches.factor
+++ b/library/inference/branches.factor
@@ -119,34 +119,40 @@ USE: hashtables
         #values values-node
     ] extend ;
 
-: terminator? ( quot -- ? )
-    #! This is a hack. undefined-method has a stack effect that
-    #! probably does not match any other branch of the generic,
-    #! so we handle it specially.
-    literal-value \ undefined-method swap tree-contains? ;
+: terminator? ( obj -- ? )
+    dup word? [ "terminator" word-property ] [ drop f ] ifte ;
 
-: recursive-branch ( value -- )
+: terminator-quot? ( quot -- ? )
+    literal-value [ terminator? ] some? ;
+
+: recursive-branch ( rstate value -- )
     #! Set base case if inference didn't fail.
     [
         f infer-branch [
-            effect old-effect recursive-state get set-base
+            effect old-effect swap set-base
         ] bind
     ] [
-        [ drop ] when
+        [ 2drop ] when
     ] catch ;
 
+: dual-branch ( branch branchlist -- rstate )
+    #! Return a recursive state for a branch other than the
+    #! given one in the list.
+    [ over eq? not ] subset nip car value-recursion ;
+
 : infer-base-case ( branchlist -- )
-    [
-        dup terminator? [
+    dup [
+        dup terminator-quot? [
             drop
         ] [
+            [ over dual-branch ] keep
             recursive-branch
         ] ifte
-    ] each ;
+    ] each drop ;
 
 : (infer-branches) ( branchlist -- list )
     dup infer-base-case [
-        dup terminator? [
+        dup terminator-quot? [
             t infer-branch [
                 meta-d off meta-r off d-in off
             ] extend

diff --git a/library/inference/words.factor b/library/inference/words.factor
index eef233f2111a9ccf4bf7a31d6ebb97667cfa5725..b35838b65a055ee018f4a45dab4927001ff4bc26 100644 (file)
--- a/library/inference/words.factor
+++ b/library/inference/words.factor
@@ -37,6 +37,7 @@ USE: strings
 USE: vectors
 USE: words
 USE: hashtables
+USE: parser
 
 : with-dataflow ( param op [ in | out ] quot -- )
     #! Take input parameters, execute quotation, take output
@@ -206,8 +207,12 @@ USE: hashtables
 
 \ call [ infer-call ] "infer" set-word-property
 
-\ - [ 2 | 1 ] "infer-effect" set-word-property
-\ * [ 2 | 1 ] "infer-effect" set-word-property
-\ / [ 2 | 1 ] "infer-effect" set-word-property
-\ gcd [ 2 | 1 ] "infer-effect" set-word-property
-\ hashcode [ 1 | 1 ] "infer-effect" set-word-property
+! These are due to bugs and will be removed
+\ - [ [ number number ] [ number ] ] "infer-effect" set-word-property
+\ * [ [ number number ] [ number ] ] "infer-effect" set-word-property
+\ / [ [ number number ] [ number ] ] "infer-effect" set-word-property
+\ gcd [ [ number number ] [ number ] ] "infer-effect" set-word-property
+\ hashcode [ [ object ] [ integer ] ] "infer-effect" set-word-property
+
+\ undefined-method t "terminator" set-word-property
+\ not-a-number t "terminator" set-word-property

diff --git a/library/primitives.factor b/library/primitives.factor
index 61dd6a0d5cd7561d64dfea5ecd23ff7befffdc7f..bb0d2fb105f8ea027c442a057b4878d37ca7786a 100644 (file)
--- a/library/primitives.factor
+++ b/library/primitives.factor
@@ -64,7 +64,7 @@ USE: words
     [ str-compare            " str str -- -1/0/1 "                [ [ string string ] [ integer ] ] ]
     [ str=                   " str str -- ? "                     [ [ string string ] [ boolean ] ] ]
     [ str-hashcode           " str -- n "                         [ [ string ] [ integer ] ] ]
-    [ index-of*              " n str/ch str -- n "                [ [ integer text string ] [ integer ] ] ]
+    [ index-of*              " n str/ch str -- n "                [ [ integer string text ] [ integer ] ] ]
     [ substring              " start end str -- str "             [ [ integer integer string ] [ string ] ] ]
     [ str-reverse            " str -- str "                       [ [ string ] [ string ] ] ]
     [ <sbuf>                 " capacity -- sbuf "                 [ [ integer ] [ sbuf ] ] ]
@@ -155,7 +155,7 @@ USE: words
     [ word-parameter         " word -- obj "                      [ [ word ] [ object ] ] ]
     [ set-word-parameter     " obj word -- "                      [ [ object word ] [ ] ] ]
     [ word-plist             " word -- alist"                     [ [ word ] [ general-list ] ] ]
-    [ set-word-plist         " alist word -- "                    [ [ general-list ] [ integer ] ] ]
+    [ set-word-plist         " alist word -- "                    [ [ general-list word ] [ ] ] ]
     [ drop                   " x -- "                             [ [ object ] [ ] ] ]
     [ dup                    " x -- x x "                         [ [ object ] [ object object ] ] ]
     [ swap                   " x y -- y x "                       [ [ object object ] [ object object ] ] ]
@@ -199,7 +199,6 @@ USE: words
     [ init-random            " -- "                               [ 0 | 0 ] ]
     [ (random-int)           " -- n "                             [ 0 | 1 ] ]
     [ type                   " obj -- n "                         [ 1 | 1 ] ]
-    [ size                   " obj -- n "                         [ 1 | 1 ] ]
     [ call-profiling         " depth -- "                         [ 1 | 0 ] ]
     [ call-count             " word -- n "                        [ 1 | 1 ] ]
     [ set-call-count         " n word -- "                        [ 2 | 0 ] ]

diff --git a/library/test/compiler/optimizer.factor b/library/test/compiler/optimizer.factor
index 6bf3a094c41bfab15671b30a02317ad854cae839..82b33536fc8d3ed669dcffafe6aa07c34f6a0783 100644 (file)
--- a/library/test/compiler/optimizer.factor
+++ b/library/test/compiler/optimizer.factor
@@ -17,4 +17,4 @@ USE: lists
 
 [ [ [ 1 ] [ 2 ] ] ] [ [ t [ 1 ] [ 2 ] ifte ] dataflow kill-set ] unit-test
 
-[ [ t t f ] ] [ [ 1 2 ] [ 1 2 3 ] [ f <literal-value> ] map kill-mask ] unit-test
+[ [ t t f ] ] [ [ 1 2 ] [ 1 2 3 ] [ f <literal> ] map kill-mask ] unit-test

diff --git a/library/test/generic.factor b/library/test/generic.factor
index dc119ab0995ed50d1608a7b2546a3909f72c7076..e2d3f1883bef5a74c6003072574f3fd0bf65f9d8 100644 (file)
--- a/library/test/generic.factor
+++ b/library/test/generic.factor
@@ -138,3 +138,5 @@ M: very-funny gooey sq ;
 [ rational ] [ ratio integer class-or ] unit-test
 [ number ] [ number object class-and ] unit-test
 [ number ] [ object number class-and ] unit-test
+
+[ t ] [ del1 builtin-supertypes [ integer? ] all? ] unit-test

diff --git a/library/test/inference.factor b/library/test/inference.factor
index 29bb6eb0b1ed007ce7abb4005a78ce2e336299cd..0f233543a9738d4e00b77b236a27ade7a0765815 100644 (file)
--- a/library/test/inference.factor
+++ b/library/test/inference.factor
@@ -6,6 +6,7 @@ USE: vectors
 USE: kernel
 USE: lists
 USE: namespaces
+USE: parser
 USE: kernel
 USE: math-internals
 USE: generic
@@ -160,16 +161,16 @@ SYMBOL: sym-test
 [ [ 1 | 2 ] ] [ [ uncons ] infer old-effect ] unit-test
 [ [ 1 | 1 ] ] [ [ unit ] infer old-effect ] unit-test
 [ [ 1 | 2 ] ] [ [ unswons ] infer old-effect ] unit-test
-! [ [ 1 | 1 ] ] [ [ last* ] infer old-effect ] unit-test
-! [ [ 1 | 1 ] ] [ [ last ] infer old-effect ] unit-test
-! [ [ 1 | 1 ] ] [ [ list? ] infer old-effect ] unit-test
+[ [ 1 | 1 ] ] [ [ last* ] infer old-effect ] unit-test
+[ [ 1 | 1 ] ] [ [ last ] infer old-effect ] unit-test
+[ [ 1 | 1 ] ] [ [ list? ] infer old-effect ] unit-test
 
 [ [ 1 | 1 ] ] [ [ length ] infer old-effect ] unit-test
 [ [ 1 | 1 ] ] [ [ reverse ] infer old-effect ] unit-test
 [ [ 2 | 1 ] ] [ [ contains? ] infer old-effect ] unit-test
 [ [ 2 | 1 ] ] [ [ tree-contains? ] infer old-effect ] unit-test
 [ [ 2 | 1 ] ] [ [ remove ] infer old-effect ] unit-test
-! [ [ 1 | 1 ] ] [ [ prune ] infer old-effect ] unit-test
+[ [ 1 | 1 ] ] [ [ prune ] infer old-effect ] unit-test
 
 [ [ 2 | 1 ] ] [ [ bitor ] infer old-effect ] unit-test
 [ [ 2 | 1 ] ] [ [ bitand ] infer old-effect ] unit-test
@@ -204,3 +205,4 @@ SYMBOL: sym-test
 [ [ [ object ] [ object ] ] ] [ [ dup [ car ] when ] infer ] unit-test
 [ [ [ vector ] [ vector ] ] ] [ [ vector-clone ] infer ] unit-test
 [ [ [ number ] [ number ] ] ] [ [ dup + ] infer ] unit-test
+[ [ [ number number number ] [ number ] ] ] [ [ digit+ ] infer ] unit-test

diff --git a/native/primitives.c b/native/primitives.c
index ff5e9610cdb58012e38f92cded73c0e12304e11a..406da752ae8396ed848fd653355a33edeb3e89eb 100644 (file)
--- a/native/primitives.c
+++ b/native/primitives.c
@@ -163,7 +163,6 @@ XT primitives[] = {
        primitive_init_random,
        primitive_random_int,
        primitive_type,
-       primitive_size,
        primitive_cwd,
        primitive_cd,
        primitive_compiled_offset,

diff --git a/native/types.c b/native/types.c
index dbe2fd330493989a0d3858fcb4350af16536254a..2ed580cffd3d805b9bae111bac74899ecbbabc4f 100644 (file)
--- a/native/types.c
+++ b/native/types.c
@@ -102,8 +102,3 @@ void primitive_type(void)
 {
        drepl(tag_fixnum(type_of(dpeek())));
 }
-
-void primitive_size(void)
-{
-       drepl(tag_fixnum(object_size(dpeek())));
-}

diff --git a/native/types.h b/native/types.h
index 6255423c78954eb57d9b1e84226bc7ca994544de..c2f6c9e88a691c6d42fcf3b2e366b0c70a000e71 100644 (file)
--- a/native/types.h
+++ b/native/types.h
@@ -103,7 +103,6 @@ void* allot_object(CELL type, CELL length);
 CELL untagged_object_size(CELL pointer);
 CELL object_size(CELL pointer);
 void primitive_type(void);
-void primitive_size(void);
 
 INLINE CELL type_of(CELL tagged)
 {