]> gitweb.factorcode.org Git - factor.git/commitdiff
plugin fix; type-name word cleaned up
authorSlava Pestov <slava@factorcode.org>
Mon, 20 Dec 2004 20:29:55 +0000 (20:29 +0000)
committerSlava Pestov <slava@factorcode.org>
Mon, 20 Dec 2004 20:29:55 +0000 (20:29 +0000)
library/compiler/alien.factor
library/generic/builtin.factor
library/io/files.factor
library/io/presentation.factor
library/syntax/prettyprint.factor
library/syntax/unparser.factor
library/tools/debugger.factor
library/tools/heap-stats.factor

index 14c5b96c0a45a70836c2cc45fd2f336700e02417..3c19bd1c146828b7552a1bc380d5cedbf926c264 100644 (file)
@@ -50,7 +50,7 @@ BUILTIN: alien 16
         drop "name" get dlopen dup "dll" set
     ] unless ;
 
-SYMBOL: #c-invoke ( C ABI -- Unix and most Windows libs )
+SYMBOL: #c-invoke ( C ABI -- Unix and some Windows libs )
 SYMBOL: #cleanup ( unwind stack by parameter )
 
 SYMBOL: #c-call ( jump to raw address )
index c4dea751f9060d7703efb8e4e51ff2c6842b5acb..2624b4ace32f9717d20cb71937d9879ff55e660a 100644 (file)
@@ -39,6 +39,10 @@ USE: vectors
 ! Builtin metaclass for builtin types: fixnum, word, cons, etc.
 SYMBOL: builtin
 
+! Vector in global namespace mapping type numbers to
+! builtin classes.
+SYMBOL: types
+
 builtin [
     "builtin-type" word-property unit
 ] "builtin-supertypes" set-word-property
@@ -50,15 +54,17 @@ builtin [
 
 builtin 50 "priority" set-word-property
 
-: builtin-predicate ( type# symbol -- word )
-    predicate-word [
-        swap [ swap type eq? ] cons define-compound
-    ] keep ;
+: add-builtin-table types get set-vector-nth ;
+
+: builtin-predicate ( type# symbol -- )
+    dup predicate-word
+    [ rot [ swap type eq? ] cons define-compound ] keep 
+    "predicate" set-word-property ;
 
-: builtin-class ( number type -- )
+: builtin-class ( type# symbol -- )
+    2dup swap add-builtin-table
     dup undefined? [ dup define-symbol ] when
     2dup builtin-predicate
-    dupd "predicate" set-word-property
     dup builtin "metaclass" set-word-property
     swap "builtin-type" set-word-property ;
 
@@ -67,5 +73,10 @@ builtin 50 "priority" set-word-property
     #! type predicate with this number.
     CREATE scan-word swap builtin-class ; parsing
 
-: builtin-type ( symbol -- n )
-    "builtin-type" word-property ;
+: builtin-type ( n -- symbol )
+    types get vector-nth ;
+
+: type-name ( n -- string )
+    builtin-type word-name ;
+
+global [ num-types <vector> types set ] bind
index 9cd1028932ceef5d58d685b68654ac509512e16e..020aec84c6bf5217217dfee588ebcae31114aa5c 100644 (file)
@@ -33,6 +33,7 @@ USE: namespaces
 USE: presentation
 USE: stdio
 USE: strings
+USE: unparser
 
 : exists? ( file -- ? )
     stat >boolean ;
@@ -78,7 +79,7 @@ USE: strings
 
 : file-link. ( dir name -- )
     tuck "/" swap cat3 dup "file-link" swons swap
-    file-actions <actions> "actions" swons
+    unparse file-actions <actions> "actions" swons
     t "underline" swons
     3list write-attr ;
 
index dbe113c5772d048fe4cdc3f3cbd728063edce7f6..a55f5f876d83ab1aff939c7601e0256e879282ed 100644 (file)
@@ -36,7 +36,6 @@ USE: unparser
 : <actions> ( path alist -- alist )
     #! For each element of the alist, change the value to
     #! path " " value
-    >r unparse r>
     [ uncons >r over " " r> cat3 cons ] map nip ;
 
 ! A style is an alist whose key/value pairs hold
index b347e261fb73c18865130b96e06b15432bda9fd7..68148e6cb71ee051e7e569f51aec76ade844270e 100644 (file)
@@ -86,29 +86,26 @@ M: object prettyprint* ( indent obj -- indent )
 
 : word-link ( word -- link )
     [
-        "vocabularies'" ,
-        dup word-vocabulary ,
-        "'" ,
-        word-name ,
+        dup word-name unparse ,
+        " [ " ,
+        word-vocabulary unparse ,
+        " ] search" ,
     ] make-string ;
 
-: word-actions ( -- list )
+: word-actions ( search -- list )
     [
-        [ "Describe" | "describe-path"  ]
-        [ "Push"     | "lookup"         ]
-        [ "Execute"  | "lookup execute" ]
-        [ "jEdit"    | "lookup jedit"   ]
-        [ "Usages"   | "lookup usages." ]
+        [ "See"     | "see"     ]
+        [ "Push"    | ""        ]
+        [ "Execute" | "execute" ]
+        [ "jEdit"   | "jedit"   ]
+        [ "Usages"  | "usages." ]
     ] ;
 
 : word-attrs ( word -- attrs )
     #! Words without a vocabulary do not get a link or an action
     #! popup.
     dup word-vocabulary [
-        word-link [ "object-link" swons ] keep
-        word-actions <actions> "actions" swons
-        t "underline" swons
-        3list
+        word-link word-actions <actions> "actions" swons unit
     ] [
         drop [ ]
     ] ifte ;
index 727e461bd5d293798136576913edd0903081b31b..c77bf13c56f02fb66bf1dd1779a51cff0c5d6e71 100644 (file)
@@ -36,34 +36,6 @@ USE: stdio
 USE: strings
 USE: words
 
-: type-name ( n -- str )
-    [
-        [ 0 | "fixnum" ]
-        [ 1 | "word" ]
-        [ 2 | "cons" ]
-        [ 3 | "object" ]
-        [ 4 | "ratio" ]
-        [ 5 | "complex" ]
-        [ 6 | "f" ]
-        [ 7 | "t" ]
-        [ 8 | "array" ]
-        [ 9 | "bignum" ]
-        [ 10 | "float" ]
-        [ 11 | "vector" ]
-        [ 12 | "string" ]
-        [ 13 | "sbuf" ]
-        [ 14 | "port" ]
-        [ 15 | "dll" ]
-        [ 16 | "alien" ]
-        ! These values are only used by the kernel for error
-        ! reporting.
-        [ 100 | "fixnum/bignum" ]
-        [ 101 | "fixnum/bignum/ratio" ]
-        [ 102 | "fixnum/bignum/ratio/float" ]
-        [ 103 | "fixnum/bignum/ratio/float/complex" ]
-        [ 104 | "fixnum/string" ]
-    ] assoc ;
-
 GENERIC: unparse ( obj -- str )
 
 M: object unparse ( obj -- str )
index 6e64233da01bb4cd1b2134ff4038cecfd98683a7..2b8bbba607a792e4291d377e81d68b188bf419c1 100644 (file)
@@ -36,6 +36,7 @@ USE: unparser
 USE: vectors
 USE: words
 USE: math
+USE: generic
 
 : expired-error ( obj -- )
     "Object did not survive image save/load: " write . ;
@@ -57,11 +58,22 @@ USE: math
     "I/O error in kernel function " write
     unswons write ": " write car print ;
 
+: type-error-name ( n -- string )
+    #! These values are only used by the kernel for error
+    #! reporting.
+    [
+        [ 100 | "fixnum/bignum" ]
+        [ 101 | "fixnum/bignum/ratio" ]
+        [ 102 | "fixnum/bignum/ratio/float" ]
+        [ 103 | "fixnum/bignum/ratio/float/complex" ]
+        [ 104 | "fixnum/string" ]
+    ] assoc [ type-name ] unless* ;
+
 : type-check-error ( list -- )
     "Type check error" print
     uncons car dup "Object: " write .
-    "Object type: " write type type-name print
-    "Expected type: " write type-name print ;
+    "Object type: " write type type-error-name print
+    "Expected type: " write type-error-name print ;
 
 : array-range-error ( list -- )
     "Array range check error" print
index 0fb8fb8d9a5b395bfc1e9f8b36ffefb028f381d3..41bd44711a85ad66dbb72753f89382e8a2d2a576 100644 (file)
@@ -35,6 +35,7 @@ USE: stdio
 USE: words
 USE: vectors
 USE: unparser
+USE: generic
 
 : heap-stat. ( type instances bytes -- )
     dup 0 = [