]> gitweb.factorcode.org Git - factor.git/commitdiff
stack effects for all primitives, updated to do list, literal hashtable syntax {...
authorSlava Pestov <slava@factorcode.org>
Thu, 11 Nov 2004 21:45:55 +0000 (21:45 +0000)
committerSlava Pestov <slava@factorcode.org>
Thu, 11 Nov 2004 21:45:55 +0000 (21:45 +0000)
TODO.FACTOR.txt
library/platform/native/parse-syntax.factor
library/platform/native/primitives.factor
library/prettyprint.factor
library/tools/inference.factor

index 0377795da4b6a399a245bc7745df91aab01be5e3..c4fae85644062e678e0a0cab904b43b971dd5bdb 100644 (file)
@@ -1,14 +1,22 @@
-- add a socket timeout\r
-- compiling when*\r
-- compiling unless*\r
-- getenv/setenv: if literal arg, compile as a load/store\r
-- inline words\r
-- alist -vs- assoc terminology\r
-- compiler: drop literal peephole optimization\r
++ inference/interpreter:\r
+\r
+- : bin 5 [ 5 bin bin 5 ] [ 2drop ] ifte ;\r
+- combinator inference\r
+- generic/2generic inference\r
+- type inference\r
 - [ 2 2 . ] run fails\r
+- some way to step over a word in the stepper\r
+- step: print NEXT word to execute, not word that JUST executed\r
+- cache stack effects\r
+- once generic inference is done, can-compile is "has stack effect!"\r
 \r
 + compiler/ffi:\r
 \r
+- compiling when*\r
+- compiling each, etc.\r
+- getenv/setenv: if literal arg, compile as a load/store\r
+- inline words\r
+- compiler: drop literal peephole optimization\r
 - is signed -vs- unsigned pointers an issue?\r
 - bitfields in C structs\r
 - SDL_Rect** type\r
 - float types\r
 - compile word twice; no more 'cannot compile' error!\r
 - perhaps /i should work with all numbers\r
-\r
-+ docs:\r
-\r
-- explain how log uses >polar and rect>\r
-- simple i/o section\r
-- unparse examples, and difference from prettyprint\r
-- review doc formatting with latex2html\r
-- recursion -vs- iteration in vectors chapter, and combinator\r
-  construction\r
-- [, , ,] -- mention that , are usually in nested words\r
-- finish namespaces docs\r
-- mention word accessors/mutators\r
-- to document:\r
-  continuations\r
-  streams\r
-  multitasking\r
-  unit testing\r
+- assembler opcodes dispatch on operand types\r
+- lifting\r
+- save code in image\r
 \r
 + listener/plugin:\r
 \r
@@ -48,7 +42,6 @@
 - maple-like: press enter at old commands to evaluate there\r
 - completion in the listener\r
 - special completion for USE:/IN:\r
-- inspector links when describe called without object path\r
 \r
 + kernel:\r
 \r
 - better i/o scheduler\r
 - >lower, >upper for strings\r
 - don't rehash strings on every startup\r
+- remove sbufs\r
+- cat, reverse-cat primitives\r
+- first-class hashtables\r
+- hash words in stage 2 of bootstrap\r
+- rewrite accessors and mutators in Factor, with slot/set-slot primitive\r
+- replace -export-dynamic with sundry-xt\r
+- add a socket timeout\r
 \r
 + misc:\r
 \r
+- alist -vs- assoc terminology\r
 - jedit ==> jedit-word, jedit takes a file name\r
 - 'cascading' styles\r
 - command line parsing cleanup\r
 - nicer way to combine two paths\r
+- :get &get\r
+- namestack, catchstack lists\r
+- OOP\r
+- room. prints code heap size\r
+- refactor sort\r
+- ditch java factor\r
+- ditch object paths\r
+- browser responder for word links in HTTPd; inspect responder for\r
+  objects\r
+- use keep instead of tuck, try to remove usages of transp\r
+- worddef props\r
+- prettyprint: when unparse called due to recursion, write a link\r
+- prettyprinter should output {{ ... }} syntax for hashtables\r
+- FORGET: and forget\r
 \r
 + httpd:\r
 \r
-- wiki responder:\r
-  - port to native\r
-  - text styles\r
 - log with date\r
- basic authentication, using httpdAuth function from a config file\r
+- basic authentication, using httpdAuth function from a config file\r
 - file responder; last-modified field\r
-\r
-+ java factor is going away:\r
-\r
-- compiled stack traces broken\r
-- save classes to disk\r
-- tail call optimization broken again\r
-- don't compile inline words\r
-- recursive words with code after ifte\r
-- less unnecessary args to auxiliary methods\r
-- inlining tail-recursive immediates\r
-- direct stack access leaks memory on stack\r
-- unnecessary local allocation: max is instance var, but several methods\r
-  get compiled.\r
-- ditch expand\r
-- when* compilation in jvm\r
-- plugin should not exit jEdit on fatal errors\r
-- java factor: equal numbers have non-equal hashcodes!\r
-- FactorLib.equal() not very good\r
index 9f0c1c7fa1b1539a1a3424dc21956fb12336e78f..72b9629b2d5face416e1901c9025ec23d92734e7 100644 (file)
@@ -29,6 +29,7 @@ IN: parser
 
 USE: combinators
 USE: errors
+USE: hashtables
 USE: kernel
 USE: lists
 USE: logic
@@ -134,6 +135,10 @@ IN: syntax
 : { f ; parsing
 : } reverse list>vector parsed ; parsing
 
+! Hashtables
+: {{ f ; parsing
+: }} alist>hash parsed ; parsing
+
 ! Do not execute parsing word
 : POSTPONE: ( -- ) scan-word parsed ; parsing
 
index 858f743893235adadbd695cf812afca98cc47c34..476552350439564f6f2f2e1d8408bd8478fb7cc7 100644 (file)
@@ -45,193 +45,195 @@ USE: vectors
 USE: words
 
 [
-    [ execute                | " word -- " ]
-    [ call                   | " quot -- " ]
-    [ ifte                   | " cond true false -- " ]
-    [ cons                   | " car cdr -- [ car | cdr ] " ]
-    [ car                    | " [ car | cdr ] -- car " ]
-    [ cdr                    | " [ car | cdr ] -- cdr " ]
-    [ <vector>               | " capacity -- vector" ]
-    [ vector-length          | " vector -- n " ]
-    [ set-vector-length      | " n vector -- " ]
-    [ vector-nth             | " n vector -- obj " ]
-    [ set-vector-nth         | " obj n vector -- " ]
-    [ str-length             | " str -- n " ]
-    [ str-nth                | " n str -- ch " ]
-    [ str-compare            | " str str -- -1/0/1 " ]
-    [ str=                   | " str str -- ? " ]
-    [ str-hashcode           | " str -- n " ]
-    [ index-of*              | " n str/ch str -- n " ]
-    [ substring              | " start end str -- str "]
-    [ str-reverse            | " str -- str " ]
-    [ <sbuf>                 | " capacity -- sbuf " ]
-    [ sbuf-length            | " sbuf -- n " ]
-    [ set-sbuf-length        | " n sbuf -- " ]
-    [ sbuf-nth               | " n sbuf -- ch " ]
-    [ set-sbuf-nth           | " ch n sbuf -- " ]
-    [ sbuf-append            | " ch/str sbuf -- " ]
-    [ sbuf>str               | " sbuf -- str " ]
-    [ sbuf-reverse           | " sbuf -- " ]
-    [ sbuf-clone             | " sbuf -- sbuf " ]
-    [ sbuf=                  | " sbuf sbuf -- ? " ]
-    [ sbuf-hashcode          | " sbuf -- n " ]
-    [ arithmetic-type        | " n n -- type " ]
-    [ number?                | " obj -- ? " ]
-    [ >fixnum                | " n -- fixnum " ]
-    [ >bignum                | " n -- bignum " ]
-    [ >float                 | " n -- float " ]
-    [ numerator              | " a/b -- a " ]
-    [ denominator            | " a/b -- b " ]
-    [ fraction>              | " a b -- a/b " ]
-    [ str>float              | " str -- float " ]
-    [ unparse-float          | " float -- str " ]
-    [ float>bits             | " float -- n " ]
-    [ real                   | " #{ re im } -- re " ]
-    [ imaginary              | " #{ re im } -- im " ]
-    [ rect>                  | " re im -- #{ re im } " ]
-    [ fixnum=                | " x y -- ? " ]
-    [ fixnum+                | " x y -- x+y " ]
-    [ fixnum-                | " x y -- x-y " ]
-    [ fixnum*                | " x y -- x*y " ]
-    [ fixnum/i               | " x y -- x/y " ]
-    [ fixnum/f               | " x y -- x/y " ]
-    [ fixnum-mod             | " x y -- x%y " ]
-    [ fixnum/mod             | " x y -- x/y x%y " ]
-    [ fixnum-bitand          | " x y -- x&y " ]
-    [ fixnum-bitor           | " x y -- x|y " ]
-    [ fixnum-bitxor          | " x y -- x^y " ]
-    [ fixnum-bitnot          | " x -- ~x " ]
-    [ fixnum-shift           | " x n -- x<<n" ]
-    [ fixnum<                | " x y -- ? " ]
-    [ fixnum<=               | " x y -- ? " ]
-    [ fixnum>                | " x y -- ? " ]
-    [ fixnum>=               | " x y -- ? " ]
-    [ bignum=                | " x y -- ? " ]
-    [ bignum+                | " x y -- x+y " ]
-    [ bignum-                | " x y -- x-y " ]
-    [ bignum*                | " x y -- x*y " ]
-    [ bignum/i               | " x y -- x/y " ]
-    [ bignum/f               | " x y -- x/y " ]
-    [ bignum-mod             | " x y -- x%y " ]
-    [ bignum/mod             | " x y -- x/y x%y " ]
-    [ bignum-bitand          | " x y -- x&y " ]
-    [ bignum-bitor           | " x y -- x|y " ]
-    [ bignum-bitxor          | " x y -- x^y " ]
-    [ bignum-bitnot          | " x -- ~x " ]
-    [ bignum-shift           | " x n -- x<<n" ]
-    [ bignum<                | " x y -- ? " ]
-    [ bignum<=               | " x y -- ? " ]
-    [ bignum>                | " x y -- ? " ]
-    [ bignum>=               | " x y -- ? " ]
-    [ float=                 | " x y -- ? " ]
-    [ float+                 | " x y -- x+y " ]
-    [ float-                 | " x y -- x-y " ]
-    [ float*                 | " x y -- x*y " ]
-    [ float/f                | " x y -- x/y " ]
-    [ float<                 | " x y -- ? " ]
-    [ float<=                | " x y -- ? " ]
-    [ float>                 | " x y -- ? " ]
-    [ float>=                | " x y -- ? " ]
-    [ facos                  | " x -- y " ]
-    [ fasin                  | " x -- y " ]
-    [ fatan                  | " x -- y " ]
-    [ fatan2                 | " x y -- z " ]
-    [ fcos                   | " x -- y " ]
-    [ fexp                   | " x -- y " ]
-    [ fcosh                  | " x -- y " ]
-    [ flog                   | " x -- y " ]
-    [ fpow                   | " x y -- z " ]
-    [ fsin                   | " x -- y " ]
-    [ fsinh                  | " x -- y " ]
-    [ fsqrt                  | " x -- y " ]
-    [ <word>                 | " prim param plist -- word " ]
-    [ word-hashcode          | " word -- n " ]
-    [ word-xt                | " word -- xt " ]
-    [ set-word-xt            | " xt word -- " ]
-    [ word-primitive         | " word -- n " ]
-    [ set-word-primitive     | " n word -- " ]
-    [ word-parameter         | " word -- obj " ]
-    [ set-word-parameter     | " obj word -- " ]
-    [ word-plist             | " word -- alist" ]
-    [ set-word-plist         | " alist word -- " ]
-    [ drop                   | " x -- " ]
-    [ dup                    | " x -- x x " ]
-    [ swap                   | " x y -- y x " ]
-    [ over                   | " x y -- x y x " ]
-    [ pick                   | " x y z -- x y z x " ]
-    [ nip                    | " x y -- y " ]
-    [ tuck                   | " x y -- y x y " ]
-    [ rot                    | " x y z -- y z x " ]
-    [ >r                     | " x -- r:x " ]
-    [ r>                     | " r:x -- x " ]
-    [ eq?                    | " x y -- ? " ]
-    [ getenv                 | " n -- obj " ]
-    [ setenv                 | " obj n -- " ]
-    [ open-file              | " path r w -- port " ]
-    [ stat                   | " path -- [ dir? perm size mtime ] " ]
-    [ (directory)            | " path -- list " ]
-    [ garbage-collection     | " -- " ]
-    [ save-image             | " path -- " ]
-    [ datastack              | " -- ds " ]
-    [ callstack              | " -- cs " ]
-    [ set-datastack          | " ds -- " ]
-    [ set-callstack          | " cs -- " ]
-    [ exit*                  | " n -- " ]
-    [ client-socket          | " host port -- in out " ]
-    [ server-socket          | " port -- server " ]
-    [ close-port             | " port -- " ]
-    [ add-accept-io-task     | " server callback -- " ]
-    [ accept-fd              | " server -- host port in out " ]
-    [ can-read-line?         | " port -- ? " ]
-    [ add-read-line-io-task  | " port callback -- " ]
-    [ read-line-fd-8         | " port -- sbuf " ]
-    [ can-read-count?        | " n port -- ? " ]
-    [ add-read-count-io-task | " n port callback -- " ]
-    [ read-count-fd-8        | " n port -- sbuf " ]
-    [ can-write?             | " n port -- ? " ]
-    [ add-write-io-task      | " port callback -- " ]
-    [ write-fd-8             | " ch/str port -- " ]
-    [ add-copy-io-task       | " from to callback -- " ]
-    [ pending-io-error       | " -- " ]
-    [ next-io-task           | " -- callback " ]
-    [ room                   | " -- free total " ]
-    [ os-env                 | " str -- str " ]
-    [ millis                 | " -- n " ]
-    [ init-random            | " -- " ]
-    [ (random-int)           | " -- n " ]
-    [ type                   | " obj -- n " ]
-    [ size                   | " obj -- n " ]
-    [ call-profiling         | " depth -- " ]
-    [ call-count             | " word -- n " ]
-    [ set-call-count         | " n word -- " ]
-    [ allot-profiling        | " depth -- " ]
-    [ allot-count            | " word -- n " ]
-    [ set-allot-count        | " n word -- n " ]
-    [ cwd                    | " -- dir " ]
-    [ cd                     | " dir -- " ]
-    [ compiled-offset        | " -- ptr " ]
-    [ set-compiled-offset    | " ptr -- " ]
-    [ set-compiled-cell      | " n ptr -- " ]
-    [ set-compiled-byte      | " n ptr -- " ]
-    [ literal-top            | " -- ptr " ]
-    [ set-literal-top        | " ptr -- " ]
-    [ address                | " obj -- ptr " ]
-    [ dlopen                 | " path -- dll " ]
-    [ dlsym                  | " name dll -- ptr " ]
-    [ dlsym-self             | " name -- ptr " ]
-    [ dlclose                | " dll -- " ]
-    [ <alien>                | " ptr -- alien " ]
-    [ <local-alien>          | " len -- alien " ]
-    [ alien-cell             | " alien off -- n " ]
-    [ set-alien-cell         | " n alien off -- " ]
-    [ alien-4                | " alien off -- n " ]
-    [ set-alien-4            | " n alien off -- " ]
-    [ alien-2                | " alien off -- n " ]
-    [ set-alien-2            | " n alien off -- " ]
-    [ alien-1                | " alien off -- n " ]
-    [ set-alien-1            | " n alien off -- " ]
-    [ heap-stats             | " -- instances bytes " ]
-    [ throw                  | " error -- " ]
+    [ execute                " word -- "                          f ]
+    [ call                   " quot -- "                          [ 1 | 0 ] ]
+    [ ifte                   " cond true false -- "               [ 3 | 0 ] ]
+    [ cons                   " car cdr -- [ car | cdr ] "         [ 2 | 1 ] ]
+    [ car                    " [ car | cdr ] -- car "             [ 1 | 1 ] ]
+    [ cdr                    " [ car | cdr ] -- cdr "             [ 1 | 1 ] ]
+    [ <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 | 1 ] ]
+    [ 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 | 1 ] ]
+    [ 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 "                       [ 1 | 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 ] ]
+    [ nip                    " x y -- y "                         [ 2 | 1 ] ]
+    [ tuck                   " x y -- y x y "                     [ 2 | 3 ] ]
+    [ rot                    " x y z -- y z x "                   [ 3 | 3 ] ]
+    [ >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 ] ]
+    [ open-file              " path r w -- port "                 [ 3 | 1 ] ]
+    [ stat                   " path -- [ dir? perm size mtime ] " [ 1 | 1 ] ]
+    [ (directory)            " path -- list "                     [ 1 | 1 ] ]
+    [ garbage-collection     " -- "                               [ 0 | 0 ] ]
+    [ save-image             " path -- "                          [ 1 | 0 ] ]
+    [ datastack              " -- ds "                            f ]
+    [ callstack              " -- cs "                            f ]
+    [ set-datastack          " ds -- "                            f ]
+    [ set-callstack          " cs -- "                            f ]
+    [ exit*                  " n -- "                             [ 1 | 0 ] ]
+    [ client-socket          " host port -- in out "              [ 2 | 2 ] ]
+    [ server-socket          " port -- server "                   [ 1 | 1 ] ]
+    [ close-port             " port -- "                          [ 1 | 0 ] ]
+    [ add-accept-io-task     " server callback -- "               [ 2 | 0 ] ]
+    [ accept-fd              " server -- host port in out "       [ 1 | 4 ] ]
+    [ can-read-line?         " port -- ? "                        [ 1 | 1 ] ]
+    [ add-read-line-io-task  " port callback -- "                 [ 2 | 0 ] ]
+    [ read-line-fd-8         " port -- sbuf "                     [ 1 | 1 ] ]
+    [ can-read-count?        " n port -- ? "                      [ 2 | 1 ] ]
+    [ add-read-count-io-task " n port callback -- "               [ 3 | 0 ] ]
+    [ read-count-fd-8        " n port -- sbuf "                   [ 2 | 1 ] ]
+    [ can-write?             " n port -- ? "                      [ 2 | 1 ] ]
+    [ add-write-io-task      " port callback -- "                 [ 2 | 0 ] ]
+    [ write-fd-8             " ch/str port -- "                   [ 2 | 0 ] ]
+    [ add-copy-io-task       " from to callback -- "              [ 3 | 1 ] ]
+    [ pending-io-error       " -- "                               [ 0 | 0 ] ]
+    [ next-io-task           " -- callback "                      [ 0 | 1 ] ]
+    [ room                   " -- free total "                    [ 0 | 2 ] ]
+    [ os-env                 " str -- str "                       [ 1 | 1 ] ]
+    [ millis                 " -- n "                             [ 0 | 1 ] ]
+    [ 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 ] ]
+    [ allot-profiling        " depth -- "                         [ 1 | 0 ] ]
+    [ allot-count            " word -- n "                        [ 1 | 1 ] ]
+    [ set-allot-count        " n word -- n "                      [ 2 | 1 ] ]
+    [ cwd                    " -- dir "                           [ 0 | 1 ] ]
+    [ cd                     " dir -- "                           [ 1 | 0 ] ]
+    [ compiled-offset        " -- ptr "                           [ 0 | 1 ] ]
+    [ set-compiled-offset    " ptr -- "                           [ 1 | 0 ] ]
+    [ set-compiled-cell      " n ptr -- "                         [ 2 | 0 ] ]
+    [ set-compiled-byte      " n ptr -- "                         [ 2 | 0 ] ]
+    [ literal-top            " -- ptr "                           [ 0 | 1 ] ]
+    [ set-literal-top        " ptr -- "                           [ 1 | 0 ] ]
+    [ address                " obj -- ptr "                       [ 1 | 1 ] ]
+    [ dlopen                 " path -- dll "                      [ 1 | 1 ] ]
+    [ dlsym                  " name dll -- ptr "                  [ 2 | 1 ] ]
+    [ dlsym-self             " name -- ptr "                      [ 1 | 1 ] ]
+    [ dlclose                " dll -- "                           [ 1 | 0 ] ]
+    [ <alien>                " ptr -- alien "                     [ 1 | 1 ] ]
+    [ <local-alien>          " len -- alien "                     [ 1 | 1 ] ]
+    [ alien-cell             " alien off -- n "                   [ 2 | 1 ] ]
+    [ set-alien-cell         " n alien off -- "                   [ 3 | 0 ] ]
+    [ alien-4                " alien off -- n "                   [ 2 | 1 ] ]
+    [ set-alien-4            " n alien off -- "                   [ 3 | 0 ] ]
+    [ alien-2                " alien off -- n "                   [ 2 | 1 ] ]
+    [ 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 ] ]
 ] [
-    uncons "stack-effect" set-word-property
+    uncons dupd uncons car ( word word stack-effect infer-effect )
+    >r "stack-effect" set-word-property r>
+    "infer-effect" set-word-property
 ] each
index 370aa2d179f10b5d86dec99384b795dd5684fe06..a2bf944d79a6338f0a291ac1996ed1bee43232ec 100644 (file)
@@ -88,24 +88,18 @@ DEFER: prettyprint*
         dup prettyprint-newline
     ] unless ;
 
-: check-recursion ( indent obj quot -- )
-    >r over prettyprint-limit >= [
-        r> drop drop "#< ... > " write
-    ] [
-        r> call
-    ] ifte ;
-
 : prettyprint-[ ( indent -- indent )
     "[" write <prettyprint ;
 
 : prettyprint-] ( indent -- indent )
     prettyprint> "]" write ;
 
-: (prettyprint-list) ( indent list -- indent )
+: prettyprint-list ( indent list -- indent )
+    #! Pretty-print a list, without [ and ].
     [
         uncons >r prettyprint-element r>
         dup cons? [
-            (prettyprint-list)
+            prettyprint-list
         ] [
             [
                 "|" write prettyprint-space prettyprint-element
@@ -113,10 +107,6 @@ DEFER: prettyprint*
         ] ifte
     ] when* ;
 
-: prettyprint-list ( indent list -- indent )
-    #! Pretty-print a list, without [ and ].
-    [ (prettyprint-list) ] check-recursion ;
-
 : prettyprint-[] ( indent list -- indent )
     swap prettyprint-[ swap prettyprint-list prettyprint-] ;
 
@@ -128,7 +118,7 @@ DEFER: prettyprint*
 
 : prettyprint-vector ( indent list -- indent )
     #! Pretty-print a vector, without { and }.
-    [ [ prettyprint-element ] vector-each ] check-recursion ;
+    [ prettyprint-element ] vector-each ;
 
 : prettyprint-{} ( indent vector -- indent )
     dup vector-length 0 = [
@@ -181,14 +171,18 @@ DEFER: prettyprint*
     unparse write ;
 
 : prettyprint* ( indent obj -- indent )
-    [
-        [ f =       ] [ prettyprint-object ]
-        [ cons?     ] [ prettyprint-[] ]
-        [ vector?   ] [ prettyprint-{} ]
-        [ comment?  ] [ prettyprint-comment ]
-        [ word?     ] [ prettyprint-word ]
-        [ drop t    ] [ prettyprint-object ]
-    ] cond ;
+    over prettyprint-limit >= [
+        unparse write
+    ] [
+        [
+            [ f =       ] [ prettyprint-object ]
+            [ cons?     ] [ prettyprint-[] ]
+            [ vector?   ] [ prettyprint-{} ]
+            [ comment?  ] [ prettyprint-comment ]
+            [ word?     ] [ prettyprint-word ]
+            [ drop t    ] [ prettyprint-object ]
+        ] cond
+    ] ifte ;
 
 : prettyprint ( obj -- )
     0 swap prettyprint* drop terpri ;
@@ -203,15 +197,15 @@ DEFER: prettyprint*
     dup vocab-attrs write-attr ;
 
 : prettyprint-IN: ( indent word -- )
-    "IN:" write prettyprint-space
+    \ IN: prettyprint-word prettyprint-space
     word-vocabulary prettyprint-vocab prettyprint-newline ;
 
 : prettyprint-: ( indent -- indent )
-    ":" write prettyprint-space
+    \ : prettyprint-word prettyprint-space
     tab-size + ;
 
 : prettyprint-; ( indent -- indent )
-    ";" write
+    \ ; prettyprint-word
     tab-size - ;
 
 : prettyprint-plist ( word -- )
index ed36784827b6f965f546ff59c2158de6e74ac3bd..49d9ac2b27ac1f368aaa3d20f85bf503f9653ed0 100644 (file)
@@ -258,43 +258,16 @@ DEFER: (infer)
     [ init-inference (infer)  effect ] with-scope ;
 
 \ call [ pop-d (infer) ] "infer" set-word-property
-\ call [ 1 | 0 ] "infer-effect" set-word-property
-
-\ ifte [ 3 | 0 ] "infer-effect" set-word-property
 \ ifte [ infer-ifte ] "infer" set-word-property
 
 \ >r [ pop-d push-r ] "infer" set-word-property
-\ >r [ 1 | 0 ] "infer-effect" set-word-property
 \ r> [ pop-r push-d ] "infer" set-word-property
-\ r> [ 0 | 1 ] "infer-effect" set-word-property
 
 \ drop  t "meta-infer" set-word-property
-\ drop [ 1 | 0 ] "infer-effect" set-word-property
-\ nip t "meta-infer" set-word-property
-\ nip [ 2 | 1 ] "infer-effect" set-word-property
 \ dup  t "meta-infer" set-word-property
-\ dup [ 1 | 2 ] "infer-effect" set-word-property
+\ swap t "meta-infer" set-word-property
 \ over t "meta-infer" set-word-property
-\ over [ 2 | 3 ] "infer-effect" set-word-property
 \ pick t "meta-infer" set-word-property
-\ pick [ 3 | 4 ] "infer-effect" set-word-property
-\ swap t "meta-infer" set-word-property
-\ swap [ 2 | 2 ] "infer-effect" set-word-property
+\ nip t "meta-infer" set-word-property
+\ tuck t "meta-infer" set-word-property
 \ rot t "meta-infer" set-word-property
-\ rot [ 3 | 3 ] "infer-effect" set-word-property
-
-\ type [ 1 | 1 ] "infer-effect" set-word-property
-\ eq? [ 2 | 1 ] "infer-effect" set-word-property
-
-\ car [ 1 | 1 ] "infer-effect" set-word-property
-\ cdr [ 1 | 1 ] "infer-effect" set-word-property
-\ cons [ 2 | 1 ] "infer-effect" set-word-property
-
-\ fixnum+ [ 2 | 1 ] "infer-effect" set-word-property
-\ fixnum- [ 2 | 1 ] "infer-effect" set-word-property
-\ fixnum* [ 2 | 1 ] "infer-effect" set-word-property
-
-\ vector-nth [ 2 | 1 ] "infer-effect" set-word-property
-\ set-vector-nth [ 3 | 0 ] "infer-effect" set-word-property
-\ vector-length [ 1 | 1 ] "infer-effect" set-word-property
-\ set-vector-length [ 2 | 0 ] "infer-effect" set-word-property