diff --git a/library/compiler/alien.factor b/library/compiler/alien.factor index 14c5b96c0a..3c19bd1c14 100644 --- a/library/compiler/alien.factor +++ b/library/compiler/alien.factor @@ -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 ) diff --git a/library/generic/builtin.factor b/library/generic/builtin.factor index c4dea751f9..2624b4ace3 100644 --- a/library/generic/builtin.factor +++ b/library/generic/builtin.factor @@ -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-class ( number type -- ) +: builtin-predicate ( type# symbol -- ) + dup predicate-word + [ rot [ swap type eq? ] cons define-compound ] keep + "predicate" set-word-property ; + +: 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 types set ] bind diff --git a/library/io/files.factor b/library/io/files.factor index 9cd1028932..020aec84c6 100644 --- a/library/io/files.factor +++ b/library/io/files.factor @@ -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" swons + unparse file-actions "actions" swons t "underline" swons 3list write-attr ; diff --git a/library/io/presentation.factor b/library/io/presentation.factor index dbe113c577..a55f5f876d 100644 --- a/library/io/presentation.factor +++ b/library/io/presentation.factor @@ -36,7 +36,6 @@ USE: unparser : ( 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 diff --git a/library/syntax/prettyprint.factor b/library/syntax/prettyprint.factor index b347e261fb..68148e6cb7 100644 --- a/library/syntax/prettyprint.factor +++ b/library/syntax/prettyprint.factor @@ -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" swons - t "underline" swons - 3list + word-link word-actions "actions" swons unit ] [ drop [ ] ] ifte ; diff --git a/library/syntax/unparser.factor b/library/syntax/unparser.factor index 727e461bd5..c77bf13c56 100644 --- a/library/syntax/unparser.factor +++ b/library/syntax/unparser.factor @@ -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 ) diff --git a/library/tools/debugger.factor b/library/tools/debugger.factor index 6e64233da0..2b8bbba607 100644 --- a/library/tools/debugger.factor +++ b/library/tools/debugger.factor @@ -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 diff --git a/library/tools/heap-stats.factor b/library/tools/heap-stats.factor index 0fb8fb8d9a..41bd44711a 100644 --- a/library/tools/heap-stats.factor +++ b/library/tools/heap-stats.factor @@ -35,6 +35,7 @@ USE: stdio USE: words USE: vectors USE: unparser +USE: generic : heap-stat. ( type instances bytes -- ) dup 0 = [