more type inference work

diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor
index 65ea33d409353a76cd86ebf7011f6e5f0c78914f..4f96a41acbc6563e0f10e3b1a1efa3e09cf925e3 100644 (file)
--- a/library/bootstrap/boot-stage2.factor
+++ b/library/bootstrap/boot-stage2.factor
@@ -30,6 +30,8 @@ USE: kernel
 USE: lists\r
 USE: parser\r
 USE: stdio\r
+USE: words\r
+USE: namespaces\r
 \r
 "Cold boot in progress..." print\r
 \r
@@ -154,20 +156,20 @@ USE: stdio
     dup print\r
     run-resource\r
 ] each\r
-
-os "win32" = [
-    [
-        "/library/io/buffer.factor"
-        "/library/win32/win32-io.factor"
-        "/library/win32/win32-errors.factor"
-        "/library/io/win32-io-internals.factor"
-        "/library/io/win32-stream.factor"
-        "/library/io/win32-console.factor"
-    ] [
-        dup print
-        run-resource
-    ] each
-] when
+\r
+os "win32" = [\r
+    [\r
+        "/library/io/buffer.factor"\r
+        "/library/win32/win32-io.factor"\r
+        "/library/win32/win32-errors.factor"\r
+        "/library/io/win32-io-internals.factor"\r
+        "/library/io/win32-stream.factor"\r
+        "/library/io/win32-console.factor"\r
+    ] [\r
+        dup print\r
+        run-resource\r
+    ] each\r
+] when\r
 \r
 cpu "x86" = [\r
     [\r

diff --git a/library/bootstrap/boot.factor b/library/bootstrap/boot.factor
index 3352f829380d0ccc848dae8d542389a720e4af9a..326cb39d823220a4fdda638321944aecfec1702e 100644 (file)
--- a/library/bootstrap/boot.factor
+++ b/library/bootstrap/boot.factor
@@ -68,18 +68,6 @@ USE: hashtables
 "/library/syntax/parser.factor" run-resource
 "/library/syntax/parse-stream.factor" run-resource
 
-! A bootstrapping trick. See doc/bootstrap.txt.
-vocabularies get [
-    "generic" off
-] bind
-
-"/library/generic/generic.factor" run-resource
-"/library/generic/object.factor" run-resource
-"/library/generic/builtin.factor" run-resource
-"/library/generic/predicate.factor" run-resource
-"/library/generic/union.factor" run-resource
-"/library/generic/traits.factor" run-resource
-
 ! init.factor leaves a boot quotation on the stack
 "/library/bootstrap/init.factor" run-resource
 

diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor
index 521e8c02c86665dd957a2088b12c740f750b659b..c4ed469169134ee8877ad434f1cdbc294aa70ce4 100644 (file)
--- a/library/bootstrap/primitives.factor
+++ b/library/bootstrap/primitives.factor
@@ -82,7 +82,6 @@ vocabularies get [
     [ "strings" | "sbuf=" ]
     [ "strings" | "sbuf-hashcode" ]
     [ "math-internals" | "arithmetic-type" ]
-    [ "math" | "number?" ]
     [ "math" | ">fixnum" ]
     [ "math" | ">bignum" ]
     [ "math" | ">float" ]

diff --git a/library/generic/builtin.factor b/library/generic/builtin.factor
index 3024654058cce1cd569ec5c0c415ef68cd1c8564..c8e60e572e71a2daf75beab036ae341b2cf5d668 100644 (file)
--- a/library/generic/builtin.factor
+++ b/library/generic/builtin.factor
@@ -54,9 +54,13 @@ builtin 50 "priority" set-word-property
     over f type = [
         nip [ not ] "predicate" set-word-property
     ] [
-        dup predicate-word
-        [ rot [ swap type eq? ] cons define-compound ] keep
-        unit "predicate" set-word-property
+        over t type = [
+            nip [ ] "predicate" set-word-property
+        ] [
+            dup predicate-word
+            [ rot [ swap type eq? ] cons define-compound ] keep
+            unit "predicate" set-word-property
+        ] ifte
     ] ifte ;
 
 : builtin-class ( type# symbol -- )

diff --git a/library/generic/union.factor b/library/generic/union.factor
index 19f83048e1990744313249b6d54ec659fa38c0c5..89f0aa4afd796d099e04268ccd8993541eb89857 100644 (file)
--- a/library/generic/union.factor
+++ b/library/generic/union.factor
@@ -66,8 +66,15 @@ union 30 "priority" set-word-property
     ] ifte* ;
 
 : define-union ( class predicate definition -- )
-    #! We have to turn the f object into the f word.
-    [ [ \ f ] unless* ] map
+    #! We have to turn the f object into the f word, same for t.
+    [
+        [
+            [
+                [ f | POSTPONE: f ]
+                [ t | POSTPONE: t ]
+            ] assoc dup
+        ] keep ?
+    ] map
     [ union-predicate define-compound ] keep
     "members" set-word-property ;
 

diff --git a/library/inference/branches.factor b/library/inference/branches.factor
index 3fa127a4dab82a0d3b45506644e11eb279bc1cc6..2960bd6268a4dda17f38282e4634674429ad7bd1 100644 (file)
--- a/library/inference/branches.factor
+++ b/library/inference/branches.factor
@@ -103,12 +103,17 @@ USE: hashtables
         "Unbalanced branches" throw
     ] ifte ;
 
+: deep-clone ( vector -- vector )
+    #! Clone a vector of vectors.
+    [ vector-clone ] vector-map ;
+
 : infer-branch ( value save-effect -- namespace )
     <namespace> [
         save-effect set
         dup value-recursion recursive-state set
-        copy-interpreter
-        d-in [ [ vector-clone ] vector-map ] change
+        meta-r [ deep-clone ] change
+        meta-d [ deep-clone ] change
+        d-in [ deep-clone ] change
         dataflow-graph off
         literal-value infer-quot
         #values values-node

diff --git a/library/inference/words.factor b/library/inference/words.factor
index 3764539ec1137162ac08b4731192bd6997313153..f5970a0c6c566d66f77ad9bb7f1d5a5c64eeb4e8 100644 (file)
--- a/library/inference/words.factor
+++ b/library/inference/words.factor
@@ -184,7 +184,7 @@ USE: prettyprint
         check-recursion recursive-word
     ] [
         drop dup "infer-effect" word-property dup [
-            dup cdr cons? [ old-effect ] when apply-effect
+            apply-effect
         ] [
             drop
             [

diff --git a/library/kernel.factor b/library/kernel.factor
index eeb69661378475ad6bac1b30c48d6954e8b8c372..00620bcf3cd75bbbc96e2c683e5dbfd7a382c7c0 100644 (file)
--- a/library/kernel.factor
+++ b/library/kernel.factor
@@ -68,3 +68,6 @@ M: object = eq? ;
 IN: syntax
 BUILTIN: f 6
 BUILTIN: t 7
+
+IN: kernel
+UNION: boolean f t ;

diff --git a/library/primitives.factor b/library/primitives.factor
index c4cea989529cae3ff63a3b945ea8a4e3cc0f41f1..61dd6a0d5cd7561d64dfea5ecd23ff7befffdc7f 100644 (file)
--- a/library/primitives.factor
+++ b/library/primitives.factor
@@ -49,124 +49,123 @@ USE: words
 
 [
     [ execute                " word -- "                          f ]
-    [ call                   " quot -- "                          [ 1 | 0 ] ]
-    [ ifte                   " cond true false -- "               [ 3 | 0 ] ]
+    [ call                   " quot -- "                          [ [ general-list ] [ ] ] ]
+    [ ifte                   " cond true false -- "               [ [ object general-list general-list ] [ ] ] ]
     [ cons                   " car cdr -- [ car | cdr ] "         [ [ object object ] [ cons ] ] ]
     [ car                    " [ car | cdr ] -- car "             [ [ cons ] [ object ] ] ]
     [ cdr                    " [ car | cdr ] -- cdr "             [ [ cons ] [ object ] ] ]
-    [ <vector>               " capacity -- vector"                [ 1 | 1 ] ]
-    [ vector-length          " vector -- n "                      [ 1 | 1 ] ]
-    [ set-vector-length      " n vector -- "                      [ 2 | 0 ] ]
-    [ vector-nth             " n vector -- obj "                  [ 2 | 1 ] ]
-    [ set-vector-nth         " obj n vector -- "                  [ 3 | 0 ] ]
-    [ str-length             " str -- n "                         [ 1 | 1 ] ]
-    [ str-nth                " n str -- ch "                      [ 2 | 1 ] ]
-    [ str-compare            " str str -- -1/0/1 "                [ 2 | 1 ] ]
-    [ str=                   " str str -- ? "                     [ 2 | 1 ] ]
-    [ str-hashcode           " str -- n "                         [ 1 | 1 ] ]
-    [ index-of*              " n str/ch str -- n "                [ 3 | 1 ] ]
-    [ substring              " start end str -- str "             [ 3 | 1 ] ]
-    [ str-reverse            " str -- str "                       [ 1 | 1 ] ]
-    [ <sbuf>                 " capacity -- sbuf "                 [ 1 | 1 ] ]
-    [ sbuf-length            " sbuf -- n "                        [ 1 | 1 ] ]
-    [ set-sbuf-length        " n sbuf -- "                        [ 2 | 1 ] ]
-    [ sbuf-nth               " n sbuf -- ch "                     [ 2 | 1 ] ]
-    [ set-sbuf-nth           " ch n sbuf -- "                     [ 3 | 0 ] ]
-    [ sbuf-append            " ch/str sbuf -- "                   [ 2 | 0 ] ]
-    [ sbuf>str               " sbuf -- str "                      [ 1 | 1 ] ]
-    [ sbuf-reverse           " sbuf -- "                          [ 1 | 0 ] ]
-    [ sbuf-clone             " sbuf -- sbuf "                     [ 1 | 1 ] ]
-    [ sbuf=                  " sbuf sbuf -- ? "                   [ 2 | 1 ] ]
-    [ sbuf-hashcode          " sbuf -- n "                        [ 1 | 1 ] ]
-    [ arithmetic-type        " n n -- type "                      [ 2 | 3 ] ]
-    [ number?                " obj -- ? "                         [ 1 | 1 ] ]
-    [ >fixnum                " n -- fixnum "                      [ 1 | 1 ] ]
-    [ >bignum                " n -- bignum "                      [ 1 | 1 ] ]
-    [ >float                 " n -- float "                       [ 1 | 1 ] ]
-    [ numerator              " a/b -- a "                         [ 1 | 1 ] ]
-    [ denominator            " a/b -- b "                         [ 1 | 1 ] ]
-    [ fraction>              " a b -- a/b "                       [ 2 | 1 ] ]
-    [ str>float              " str -- float "                     [ 1 | 1 ] ]
-    [ (unparse-float)        " float -- str "                     [ 1 | 1 ] ]
-    [ float>bits             " float -- n "                       [ 1 | 1 ] ]
-    [ real                   " #{ re im } -- re "                 [ 1 | 1 ] ]
-    [ imaginary              " #{ re im } -- im "                 [ 1 | 1 ] ]
-    [ rect>                  " re im -- #{ re im } "              [ 2 | 1 ] ]
-    [ fixnum=                " x y -- ? "                         [ 2 | 1 ] ]
-    [ fixnum+                " x y -- x+y "                       [ 2 | 1 ] ]
-    [ fixnum-                " x y -- x-y "                       [ 2 | 1 ] ]
-    [ fixnum*                " x y -- x*y "                       [ 2 | 1 ] ]
-    [ fixnum/i               " x y -- x/y "                       [ 2 | 1 ] ]
-    [ fixnum/f               " x y -- x/y "                       [ 2 | 1 ] ]
-    [ fixnum-mod             " x y -- x%y "                       [ 2 | 1 ] ]
-    [ fixnum/mod             " x y -- x/y x%y "                   [ 2 | 2 ] ]
-    [ fixnum-bitand          " x y -- x&y "                       [ 2 | 1 ] ]
-    [ fixnum-bitor           " x y -- x|y "                       [ 2 | 1 ] ]
-    [ fixnum-bitxor          " x y -- x^y "                       [ 2 | 1 ] ]
-    [ fixnum-bitnot          " x -- ~x "                          [ 1 | 1 ] ]
-    [ fixnum-shift           " x n -- x<<n"                       [ 2 | 1 ] ]
-    [ fixnum<                " x y -- ? "                         [ 2 | 1 ] ]
-    [ fixnum<=               " x y -- ? "                         [ 2 | 1 ] ]
-    [ fixnum>                " x y -- ? "                         [ 2 | 1 ] ]
-    [ fixnum>=               " x y -- ? "                         [ 2 | 1 ] ]
-    [ bignum=                " x y -- ? "                         [ 2 | 1 ] ]
-    [ bignum+                " x y -- x+y "                       [ 2 | 1 ] ]
-    [ bignum-                " x y -- x-y "                       [ 2 | 1 ] ]
-    [ bignum*                " x y -- x*y "                       [ 2 | 1 ] ]
-    [ bignum/i               " x y -- x/y "                       [ 2 | 1 ] ]
-    [ bignum/f               " x y -- x/y "                       [ 2 | 1 ] ]
-    [ bignum-mod             " x y -- x%y "                       [ 2 | 1 ] ]
-    [ bignum/mod             " x y -- x/y x%y "                   [ 2 | 2 ] ]
-    [ bignum-bitand          " x y -- x&y "                       [ 2 | 1 ] ]
-    [ bignum-bitor           " x y -- x|y "                       [ 2 | 1 ] ]
-    [ bignum-bitxor          " x y -- x^y "                       [ 2 | 1 ] ]
-    [ bignum-bitnot          " x -- ~x "                          [ 1 | 1 ] ]
-    [ bignum-shift           " x n -- x<<n"                       [ 2 | 1 ] ]
-    [ bignum<                " x y -- ? "                         [ 2 | 1 ] ]
-    [ bignum<=               " x y -- ? "                         [ 2 | 1 ] ]
-    [ bignum>                " x y -- ? "                         [ 2 | 1 ] ]
-    [ bignum>=               " x y -- ? "                         [ 2 | 1 ] ]
-    [ float=                 " x y -- ? "                         [ 2 | 1 ] ]
-    [ float+                 " x y -- x+y "                       [ 2 | 1 ] ]
-    [ float-                 " x y -- x-y "                       [ 2 | 1 ] ]
-    [ float*                 " x y -- x*y "                       [ 2 | 1 ] ]
-    [ float/f                " x y -- x/y "                       [ 2 | 1 ] ]
-    [ float<                 " x y -- ? "                         [ 2 | 1 ] ]
-    [ float<=                " x y -- ? "                         [ 2 | 1 ] ]
-    [ float>                 " x y -- ? "                         [ 2 | 1 ] ]
-    [ float>=                " x y -- ? "                         [ 2 | 1 ] ]
-    [ facos                  " x -- y "                           [ 1 | 1 ] ]
-    [ fasin                  " x -- y "                           [ 1 | 1 ] ]
-    [ fatan                  " x -- y "                           [ 1 | 1 ] ]
-    [ fatan2                 " x y -- z "                         [ 2 | 1 ] ]
-    [ fcos                   " x -- y "                           [ 1 | 1 ] ]
-    [ fexp                   " x -- y "                           [ 1 | 1 ] ]
-    [ fcosh                  " x -- y "                           [ 1 | 1 ] ]
-    [ flog                   " x -- y "                           [ 1 | 1 ] ]
-    [ fpow                   " x y -- z "                         [ 2 | 1 ] ]
-    [ fsin                   " x -- y "                           [ 1 | 1 ] ]
-    [ fsinh                  " x -- y "                           [ 1 | 1 ] ]
-    [ fsqrt                  " x -- y "                           [ 1 | 1 ] ]
-    [ <word>                 " prim param plist -- word "         [ 3 | 1 ] ]
-    [ word-hashcode          " word -- n "                        [ 1 | 1 ] ]
-    [ word-xt                " word -- xt "                       [ 1 | 1 ] ]
-    [ set-word-xt            " xt word -- "                       [ 2 | 0 ] ]
-    [ word-primitive         " word -- n "                        [ 1 | 1 ] ]
-    [ set-word-primitive     " n word -- "                        [ 2 | 0 ] ]
-    [ word-parameter         " word -- obj "                      [ 1 | 1 ] ]
-    [ set-word-parameter     " obj word -- "                      [ 2 | 0 ] ]
-    [ word-plist             " word -- alist"                     [ 1 | 1 ] ]
-    [ set-word-plist         " alist word -- "                    [ 2 | 0 ] ]
-    [ drop                   " x -- "                             [ 1 | 0 ] ]
-    [ dup                    " x -- x x "                         [ 1 | 2 ] ]
-    [ swap                   " x y -- y x "                       [ 2 | 2 ] ]
-    [ over                   " x y -- x y x "                     [ 2 | 3 ] ]
-    [ pick                   " x y z -- x y z x "                 [ 3 | 4 ] ]
-    [ >r                     " x -- r:x "                         [ 1 | 0 ] ]
-    [ r>                     " r:x -- x "                         [ 0 | 1 ] ]
-    [ eq?                    " x y -- ? "                         [ 2 | 1 ] ]
-    [ getenv                 " n -- obj "                         [ 1 | 1 ] ]
-    [ setenv                 " obj n -- "                         [ 2 | 0 ] ]
+    [ <vector>               " capacity -- vector"                [ [ integer ] [ vector ] ] ]
+    [ vector-length          " vector -- n "                      [ [ vector ] [ integer ] ] ]
+    [ set-vector-length      " n vector -- "                      [ [ integer vector ] [ ] ] ]
+    [ vector-nth             " n vector -- obj "                  [ [ integer vector ] [ object ] ] ]
+    [ set-vector-nth         " obj n vector -- "                  [ [ object integer vector ] [ ] ] ]
+    [ str-length             " str -- n "                         [ [ string ] [ integer ] ] ]
+    [ str-nth                " n str -- ch "                      [ [ integer string ] [ integer ] ] ]
+    [ 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 ] ] ]
+    [ substring              " start end str -- str "             [ [ integer integer string ] [ string ] ] ]
+    [ str-reverse            " str -- str "                       [ [ string ] [ string ] ] ]
+    [ <sbuf>                 " capacity -- sbuf "                 [ [ integer ] [ sbuf ] ] ]
+    [ sbuf-length            " sbuf -- n "                        [ [ sbuf ] [ integer ] ] ]
+    [ set-sbuf-length        " n sbuf -- "                        [ [ integer sbuf ] [ ] ] ]
+    [ sbuf-nth               " n sbuf -- ch "                     [ [ integer sbuf ] [ integer ] ] ]
+    [ set-sbuf-nth           " ch n sbuf -- "                     [ [ integer integer sbuf ] [ ] ] ]
+    [ sbuf-append            " ch/str sbuf -- "                   [ [ text sbuf ] [ ] ] ]
+    [ sbuf>str               " sbuf -- str "                      [ [ sbuf ] [ string ] ] ]
+    [ sbuf-reverse           " sbuf -- "                          [ [ sbuf ] [ ] ] ]
+    [ sbuf-clone             " sbuf -- sbuf "                     [ [ sbuf ] [ sbuf ] ] ]
+    [ sbuf=                  " sbuf sbuf -- ? "                   [ [ sbuf sbuf ] [ boolean ] ] ]
+    [ sbuf-hashcode          " sbuf -- n "                        [ [ sbuf ] [ integer ] ] ]
+    [ arithmetic-type        " n n -- type "                      [ [ number number ] [ number number fixnum ] ] ]
+    [ >fixnum                " n -- fixnum "                      [ [ number ] [ fixnum ] ] ]
+    [ >bignum                " n -- bignum "                      [ [ number ] [ bignum ] ] ]
+    [ >float                 " n -- float "                       [ [ number ] [ float ] ] ]
+    [ numerator              " a/b -- a "                         [ [ rational ] [ integer ] ] ]
+    [ denominator            " a/b -- b "                         [ [ rational ] [ integer ] ] ]
+    [ fraction>              " a b -- a/b "                       [ [ integer integer ] [ rational ] ] ]
+    [ str>float              " str -- float "                     [ [ string ] [ float ] ] ]
+    [ (unparse-float)        " float -- str "                     [ [ float ] [ string ] ] ]
+    [ float>bits             " float -- n "                       [ [ float ] [ integer ] ] ]
+    [ real                   " #{ re im } -- re "                 [ [ number ] [ real ] ] ]
+    [ imaginary              " #{ re im } -- im "                 [ [ number ] [ real ] ] ]
+    [ rect>                  " re im -- #{ re im } "              [ [ real real ] [ number ] ] ]
+    [ fixnum=                " x y -- ? "                         [ [ fixnum fixnum ] [ boolean ] ] ]
+    [ fixnum+                " x y -- x+y "                       [ [ fixnum fixnum ] [ integer ] ] ]
+    [ fixnum-                " x y -- x-y "                       [ [ fixnum fixnum ] [ integer ] ] ]
+    [ fixnum*                " x y -- x*y "                       [ [ fixnum fixnum ] [ integer ] ] ]
+    [ fixnum/i               " x y -- x/y "                       [ [ fixnum fixnum ] [ integer ] ] ]
+    [ fixnum/f               " x y -- x/y "                       [ [ fixnum fixnum ] [ integer ] ] ]
+    [ fixnum-mod             " x y -- x%y "                       [ [ fixnum fixnum ] [ integer ] ] ]
+    [ fixnum/mod             " x y -- x/y x%y "                   [ [ fixnum fixnum ] [ integer integer ] ] ]
+    [ fixnum-bitand          " x y -- x&y "                       [ [ fixnum fixnum ] [ fixnum ] ] ]
+    [ fixnum-bitor           " x y -- x|y "                       [ [ fixnum fixnum ] [ fixnum ] ] ]
+    [ fixnum-bitxor          " x y -- x^y "                       [ [ fixnum fixnum ] [ fixnum ] ] ]
+    [ fixnum-bitnot          " x -- ~x "                          [ [ fixnum ] [ fixnum ] ] ]
+    [ fixnum-shift           " x n -- x<<n"                       [ [ fixnum fixnum ] [ fixnum ] ] ]
+    [ fixnum<                " x y -- ? "                         [ [ fixnum fixnum ] [ boolean ] ] ]
+    [ fixnum<=               " x y -- ? "                         [ [ fixnum fixnum ] [ boolean ] ] ]
+    [ fixnum>                " x y -- ? "                         [ [ fixnum fixnum ] [ boolean ] ] ]
+    [ fixnum>=               " x y -- ? "                         [ [ fixnum fixnum ] [ boolean ] ] ]
+    [ bignum=                " x y -- ? "                         [ [ fixnum fixnum ] [ boolean ] ] ]
+    [ bignum+                " x y -- x+y "                       [ [ bignum bignum ] [ bignum ] ] ]
+    [ bignum-                " x y -- x-y "                       [ [ bignum bignum ] [ bignum ] ] ]
+    [ bignum*                " x y -- x*y "                       [ [ bignum bignum ] [ bignum ] ] ]
+    [ bignum/i               " x y -- x/y "                       [ [ bignum bignum ] [ bignum ] ] ]
+    [ bignum/f               " x y -- x/y "                       [ [ bignum bignum ] [ bignum ] ] ]
+    [ bignum-mod             " x y -- x%y "                       [ [ bignum bignum ] [ bignum ] ] ]
+    [ bignum/mod             " x y -- x/y x%y "                   [ [ bignum bignum ] [ bignum bignum ] ] ]
+    [ bignum-bitand          " x y -- x&y "                       [ [ bignum bignum ] [ bignum ] ] ]
+    [ bignum-bitor           " x y -- x|y "                       [ [ bignum bignum ] [ bignum ] ] ]
+    [ bignum-bitxor          " x y -- x^y "                       [ [ bignum bignum ] [ bignum ] ] ]
+    [ bignum-bitnot          " x -- ~x "                          [ [ bignum ] [ bignum ] ] ]
+    [ bignum-shift           " x n -- x<<n"                       [ [ bignum bignum ] [ bignum ] ] ]
+    [ bignum<                " x y -- ? "                         [ [ bignum bignum ] [ boolean ] ] ]
+    [ bignum<=               " x y -- ? "                         [ [ bignum bignum ] [ boolean ] ] ]
+    [ bignum>                " x y -- ? "                         [ [ bignum bignum ] [ boolean ] ] ]
+    [ bignum>=               " x y -- ? "                         [ [ bignum bignum ] [ boolean ] ] ]
+    [ float=                 " x y -- ? "                         [ [ bignum bignum ] [ boolean ] ] ]
+    [ float+                 " x y -- x+y "                       [ [ float float ] [ float ] ] ]
+    [ float-                 " x y -- x-y "                       [ [ float float ] [ float ] ] ]
+    [ float*                 " x y -- x*y "                       [ [ float float ] [ float ] ] ]
+    [ float/f                " x y -- x/y "                       [ [ float float ] [ float ] ] ]
+    [ float<                 " x y -- ? "                         [ [ float float ] [ boolean ] ] ]
+    [ float<=                " x y -- ? "                         [ [ float float ] [ boolean ] ] ]
+    [ float>                 " x y -- ? "                         [ [ float float ] [ boolean ] ] ]
+    [ float>=                " x y -- ? "                         [ [ float float ] [ boolean ] ] ]
+    [ facos                  " x -- y "                           [ [ real ] [ float ] ] ]
+    [ fasin                  " x -- y "                           [ [ real ] [ float ] ] ]
+    [ fatan                  " x -- y "                           [ [ real ] [ float ] ] ]
+    [ fatan2                 " x y -- z "                         [ [ real real ] [ float ] ] ]
+    [ fcos                   " x -- y "                           [ [ real ] [ float ] ] ]
+    [ fexp                   " x -- y "                           [ [ real ] [ float ] ] ]
+    [ fcosh                  " x -- y "                           [ [ real ] [ float ] ] ]
+    [ flog                   " x -- y "                           [ [ real ] [ float ] ] ]
+    [ fpow                   " x y -- z "                         [ [ real real ] [ float ] ] ]
+    [ fsin                   " x -- y "                           [ [ real ] [ float ] ] ]
+    [ fsinh                  " x -- y "                           [ [ real ] [ float ] ] ]
+    [ fsqrt                  " x -- y "                           [ [ real ] [ float ] ] ]
+    [ <word>                 " prim param plist -- word "         [ [ integer object general-list ] [ word ] ] ]
+    [ word-hashcode          " word -- n "                        [ [ word ] [ integer ] ] ]
+    [ word-xt                " word -- xt "                       [ [ word ] [ integer ] ] ]
+    [ set-word-xt            " xt word -- "                       [ [ integer word ] [ ] ] ]
+    [ word-primitive         " word -- n "                        [ [ word ] [ integer ] ] ]
+    [ set-word-primitive     " n word -- "                        [ [ integer word ] [ ] ] ]
+    [ 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 ] ] ]
+    [ drop                   " x -- "                             [ [ object ] [ ] ] ]
+    [ dup                    " x -- x x "                         [ [ object ] [ object object ] ] ]
+    [ swap                   " x y -- y x "                       [ [ object object ] [ object object ] ] ]
+    [ over                   " x y -- x y x "                     [ [ object object ] [ object object object ] ] ]
+    [ pick                   " x y z -- x y z x "                 [ [ object object object ] [ object object object object ] ] ]
+    [ >r                     " x -- r:x "                         [ [ object ] [ ] ] ]
+    [ r>                     " r:x -- x "                         [ [ ] [ object ] ] ]
+    [ eq?                    " x y -- ? "                         [ [ object object ] [ boolean ] ] ]
+    [ getenv                 " n -- obj "                         [ [ fixnum ] [ object ] ] ]
+    [ setenv                 " obj n -- "                         [ [ object fixnum ] [ ] ] ]
     [ open-file              " path r w -- port "                 [ 3 | 1 ] ]
     [ stat                   " path -- [ dir? perm size mtime ] " [ 1 | 1 ] ]
     [ (directory)            " path -- list "                     [ 1 | 1 ] ]
@@ -230,13 +229,12 @@ USE: words
     [ set-alien-2            " n alien off -- "                   [ 3 | 0 ] ]
     [ alien-1                " alien off -- n "                   [ 2 | 1 ] ]
     [ set-alien-1            " n alien off -- "                   [ 3 | 0 ] ]
-    [ heap-stats             " -- instances bytes "               [ 0 | 2 ] ]
-    [ throw                  " error -- "                         [ 1 | 0 ] ]
-    [ string>memory          " str address -- "                   [ 2 | 0 ] ]
-    [ memory>string          " address length -- str "            [ 2 | 1 ] ]
+    [ heap-stats             " -- instances bytes "               [ [ ] [ general-list ] ] ]
+    [ throw                  " error -- "                         [ [ object ] [ ] ] ]
+    [ string>memory          " str address -- "                   [ [ string integer ] [ ] ] ]
+    [ memory>string          " address length -- str "            [ [ integer integer ] [ string ] ] ]
     [ local-alien?           " alien -- ? "                       [ [ alien ] [ object ] ] ]
     [ alien-address          " alien -- address "                 [ [ alien ] [ integer ] ] ]
-    [ memory>string          " address length -- str "            [ 2 | 1 ] ]
 ] [
     uncons dupd uncons car ( word word stack-effect infer-effect )
     >r "stack-effect" set-word-property r>

diff --git a/library/strings.factor b/library/strings.factor
index 6bfaf13a764955a8d34bb6b0e499235784e26d09..b93b9c65ed128f9bd200d05289b554874565bc9b 100644 (file)
--- a/library/strings.factor
+++ b/library/strings.factor
@@ -40,6 +40,8 @@ BUILTIN: sbuf   13
 M: sbuf hashcode sbuf-hashcode ;
 M: sbuf = sbuf= ;
 
+UNION: text string integer ;
+
 : f-or-"" ( obj -- ? )
     dup not swap "" = or ;
 

diff --git a/library/test/inference.factor b/library/test/inference.factor
index b6c059c5fea3b3c4fed1a3647b4af2e490a6b1db..027ead53423291fa226c2e8e3cbe85dcfa3c36cc 100644 (file)
--- a/library/test/inference.factor
+++ b/library/test/inference.factor
@@ -201,3 +201,5 @@ SYMBOL: sym-test
 [ [ [ object ] [ object object ] ] ] [ [ dup ] infer ] unit-test
 [ [ [ object object ] [ cons ] ] ] [ [ cons ] infer ] unit-test
 [ [ [ cons ] [ cons ] ] ] [ [ uncons cons ] infer ] unit-test
+[ [ [ object ] [ object ] ] ] [ [ dup [ car ] when ] infer ] unit-test
+[ [ [ vector ] [ vector ] ] ] [ [ vector-clone ] infer ] unit-test

diff --git a/native/arithmetic.c b/native/arithmetic.c
index b1cf55f819757b1fd5e4638d0bb1295e7d69390d..0bb13ed4bce0c73875bdfdbce791c1d0533039c5 100644 (file)
--- a/native/arithmetic.c
+++ b/native/arithmetic.c
@@ -108,12 +108,6 @@ bool realp(CELL tagged)
        }
 }
 
-void primitive_numberp(void)
-{
-       CELL tagged = dpop();
-       box_boolean(realp(tagged) || type_of(tagged) == COMPLEX_TYPE);
-}
-
 bool zerop(CELL tagged)
 {
        switch(type_of(tagged))

diff --git a/native/arithmetic.h b/native/arithmetic.h
index 8aa16028fb008ef633510f7ec7cd96ecf7f17898..2c01f86f350e93275f244bd38d90b72c8861d8aa 100644 (file)
--- a/native/arithmetic.h
+++ b/native/arithmetic.h
@@ -3,7 +3,6 @@
 void primitive_arithmetic_type(void);
 
 bool realp(CELL tagged);
-void primitive_numberp(void);
 
 bool zerop(CELL tagged);
 bool onep(CELL tagged);

diff --git a/native/primitives.c b/native/primitives.c
index 68d6e970e9b508b01611171e5b9ee7e00ccb02b4..ff5e9610cdb58012e38f92cded73c0e12304e11a 100644 (file)
--- a/native/primitives.c
+++ b/native/primitives.c
@@ -35,7 +35,6 @@ XT primitives[] = {
        primitive_sbuf_eq,
        primitive_sbuf_hashcode,
        primitive_arithmetic_type,
-       primitive_numberp,
        primitive_to_fixnum,
        primitive_to_bignum,
        primitive_to_float,

diff --git a/native/primitives.h b/native/primitives.h
index bf3cca526c9527b071f6523c7b2ae3b75d30717a..1aa49ac28140a009df69e8ae1f2e8e2ec6c3c589 100644 (file)
--- a/native/primitives.h
+++ b/native/primitives.h
@@ -1,4 +1,4 @@
 extern XT primitives[];
-#define PRIMITIVE_COUNT 193
+#define PRIMITIVE_COUNT 192
 
 CELL primitive_to_xt(CELL primitive);