steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Remove intern-symbol

db4
Slava Pestov 2007-12-25 18:10:05 -05:00
parent 28d6fec557
commit 32641f04e7
7 changed files with 229 additions and 231 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

402
core/bootstrap/primitives.factor
View File

@ -79,207 +79,7 @@ H{ } clone source-files set
H{ } clone class<map set
H{ } clone update-map set
: make-primitive ( word vocab n -- ) >r create r> define ;
{
{ "(execute)" "words.private" }
{ "(call)" "kernel.private" }
{ "uncurry" "kernel.private" }
{ "string>sbuf" "sbufs.private" }
{ "bignum>fixnum" "math.private" }
{ "float>fixnum" "math.private" }
{ "fixnum>bignum" "math.private" }
{ "float>bignum" "math.private" }
{ "fixnum>float" "math.private" }
{ "bignum>float" "math.private" }
{ "<ratio>" "math.private" }
{ "string>float" "math.private" }
{ "float>string" "math.private" }
{ "float>bits" "math" }
{ "double>bits" "math" }
{ "bits>float" "math" }
{ "bits>double" "math" }
{ "<complex>" "math.private" }
{ "fixnum+" "math.private" }
{ "fixnum+fast" "math.private" }
{ "fixnum-" "math.private" }
{ "fixnum-fast" "math.private" }
{ "fixnum*" "math.private" }
{ "fixnum*fast" "math.private" }
{ "fixnum/i" "math.private" }
{ "fixnum-mod" "math.private" }
{ "fixnum/mod" "math.private" }
{ "fixnum-bitand" "math.private" }
{ "fixnum-bitor" "math.private" }
{ "fixnum-bitxor" "math.private" }
{ "fixnum-bitnot" "math.private" }
{ "fixnum-shift" "math.private" }
{ "fixnum<" "math.private" }
{ "fixnum<=" "math.private" }
{ "fixnum>" "math.private" }
{ "fixnum>=" "math.private" }
{ "bignum=" "math.private" }
{ "bignum+" "math.private" }
{ "bignum-" "math.private" }
{ "bignum*" "math.private" }
{ "bignum/i" "math.private" }
{ "bignum-mod" "math.private" }
{ "bignum/mod" "math.private" }
{ "bignum-bitand" "math.private" }
{ "bignum-bitor" "math.private" }
{ "bignum-bitxor" "math.private" }
{ "bignum-bitnot" "math.private" }
{ "bignum-shift" "math.private" }
{ "bignum<" "math.private" }
{ "bignum<=" "math.private" }
{ "bignum>" "math.private" }
{ "bignum>=" "math.private" }
{ "bignum-bit?" "math.private" }
{ "bignum-log2" "math.private" }
{ "byte-array>bignum" "math" }
{ "float=" "math.private" }
{ "float+" "math.private" }
{ "float-" "math.private" }
{ "float*" "math.private" }
{ "float/f" "math.private" }
{ "float-mod" "math.private" }
{ "float<" "math.private" }
{ "float<=" "math.private" }
{ "float>" "math.private" }
{ "float>=" "math.private" }
{ "<word>" "words" }
{ "word-xt" "words" }
{ "drop" "kernel" }
{ "2drop" "kernel" }
{ "3drop" "kernel" }
{ "dup" "kernel" }
{ "2dup" "kernel" }
{ "3dup" "kernel" }
{ "rot" "kernel" }
{ "-rot" "kernel" }
{ "dupd" "kernel" }
{ "swapd" "kernel" }
{ "nip" "kernel" }
{ "2nip" "kernel" }
{ "tuck" "kernel" }
{ "over" "kernel" }
{ "pick" "kernel" }
{ "swap" "kernel" }
{ ">r" "kernel" }
{ "r>" "kernel" }
{ "eq?" "kernel" }
{ "getenv" "kernel.private" }
{ "setenv" "kernel.private" }
{ "(stat)" "io.files.private" }
{ "(directory)" "io.files.private" }
{ "data-gc" "memory" }
{ "code-gc" "memory" }
{ "gc-time" "memory" }
{ "save-image" "memory" }
{ "save-image-and-exit" "memory" }
{ "datastack" "kernel" }
{ "retainstack" "kernel" }
{ "callstack" "kernel" }
{ "set-datastack" "kernel" }
{ "set-retainstack" "kernel" }
{ "set-callstack" "kernel" }
{ "exit" "system" }
{ "data-room" "memory" }
{ "code-room" "memory" }
{ "os-env" "system" }
{ "millis" "system" }
{ "type" "kernel.private" }
{ "tag" "kernel.private" }
{ "cwd" "io.files" }
{ "cd" "io.files" }
{ "modify-code-heap" "words.private" }
{ "dlopen" "alien" }
{ "dlsym" "alien" }
{ "dlclose" "alien" }
{ "<byte-array>" "byte-arrays" }
{ "<bit-array>" "bit-arrays" }
{ "<displaced-alien>" "alien" }
{ "alien-signed-cell" "alien" }
{ "set-alien-signed-cell" "alien" }
{ "alien-unsigned-cell" "alien" }
{ "set-alien-unsigned-cell" "alien" }
{ "alien-signed-8" "alien" }
{ "set-alien-signed-8" "alien" }
{ "alien-unsigned-8" "alien" }
{ "set-alien-unsigned-8" "alien" }
{ "alien-signed-4" "alien" }
{ "set-alien-signed-4" "alien" }
{ "alien-unsigned-4" "alien" }
{ "set-alien-unsigned-4" "alien" }
{ "alien-signed-2" "alien" }
{ "set-alien-signed-2" "alien" }
{ "alien-unsigned-2" "alien" }
{ "set-alien-unsigned-2" "alien" }
{ "alien-signed-1" "alien" }
{ "set-alien-signed-1" "alien" }
{ "alien-unsigned-1" "alien" }
{ "set-alien-unsigned-1" "alien" }
{ "alien-float" "alien" }
{ "set-alien-float" "alien" }
{ "alien-double" "alien" }
{ "set-alien-double" "alien" }
{ "alien-cell" "alien" }
{ "set-alien-cell" "alien" }
{ "alien>char-string" "alien" }
{ "string>char-alien" "alien" }
{ "alien>u16-string" "alien" }
{ "string>u16-alien" "alien" }
{ "(throw)" "kernel.private" }
{ "string>memory" "alien" }
{ "memory>string" "alien" }
{ "alien-address" "alien" }
{ "slot" "slots.private" }
{ "set-slot" "slots.private" }
{ "char-slot" "strings.private" }
{ "set-char-slot" "strings.private" }
{ "resize-array" "arrays" }
{ "resize-string" "strings" }
{ "(hashtable)" "hashtables.private" }
{ "<array>" "arrays" }
{ "begin-scan" "memory" }
{ "next-object" "memory" }
{ "end-scan" "memory" }
{ "size" "memory" }
{ "die" "kernel" }
{ "fopen" "io.streams.c" }
{ "fgetc" "io.streams.c" }
{ "fread" "io.streams.c" }
{ "fwrite" "io.streams.c" }
{ "fflush" "io.streams.c" }
{ "fclose" "io.streams.c" }
{ "<wrapper>" "kernel" }
{ "(clone)" "kernel" }
{ "array>vector" "vectors.private" }
{ "<string>" "strings" }
{ "(>tuple)" "tuples.private" }
{ "array>quotation" "quotations.private" }
{ "quotation-xt" "quotations" }
{ "<tuple>" "tuples.private" }
{ "tuple>array" "tuples" }
{ "profiling" "tools.profiler.private" }
{ "become" "kernel.private" }
{ "(sleep)" "threads.private" }
{ "<float-array>" "float-arrays" }
{ "curry" "kernel" }
{ "<tuple-boa>" "tuples.private" }
{ "class-hash" "kernel.private" }
{ "callstack>array" "kernel" }
{ "innermost-frame-quot" "kernel.private" }
{ "innermost-frame-scan" "kernel.private" }
{ "set-innermost-frame-quot" "kernel.private" }
{ "call-clear" "kernel" }
{ "strip-compiled-quotations" "quotations" }
{ "(os-envs)" "system" }
}
dup length [ >r first2 r> make-primitive ] 2each
! Okay, now we have primitives fleshed out. Bring up the generic
! word system.
! Builtin classes
: builtin-predicate ( class predicate -- )
[
over "type" word-prop dup
@ -607,6 +407,206 @@ builtins get num-tags get tail f union-class define-class
"tombstone" "hashtables.private" lookup t
2array >tuple 1quotation define-inline
! Primitive words
: make-primitive ( word vocab n -- ) >r create r> define ;
{
{ "(execute)" "words.private" }
{ "(call)" "kernel.private" }
{ "uncurry" "kernel.private" }
{ "string>sbuf" "sbufs.private" }
{ "bignum>fixnum" "math.private" }
{ "float>fixnum" "math.private" }
{ "fixnum>bignum" "math.private" }
{ "float>bignum" "math.private" }
{ "fixnum>float" "math.private" }
{ "bignum>float" "math.private" }
{ "<ratio>" "math.private" }
{ "string>float" "math.private" }
{ "float>string" "math.private" }
{ "float>bits" "math" }
{ "double>bits" "math" }
{ "bits>float" "math" }
{ "bits>double" "math" }
{ "<complex>" "math.private" }
{ "fixnum+" "math.private" }
{ "fixnum+fast" "math.private" }
{ "fixnum-" "math.private" }
{ "fixnum-fast" "math.private" }
{ "fixnum*" "math.private" }
{ "fixnum*fast" "math.private" }
{ "fixnum/i" "math.private" }
{ "fixnum-mod" "math.private" }
{ "fixnum/mod" "math.private" }
{ "fixnum-bitand" "math.private" }
{ "fixnum-bitor" "math.private" }
{ "fixnum-bitxor" "math.private" }
{ "fixnum-bitnot" "math.private" }
{ "fixnum-shift" "math.private" }
{ "fixnum<" "math.private" }
{ "fixnum<=" "math.private" }
{ "fixnum>" "math.private" }
{ "fixnum>=" "math.private" }
{ "bignum=" "math.private" }
{ "bignum+" "math.private" }
{ "bignum-" "math.private" }
{ "bignum*" "math.private" }
{ "bignum/i" "math.private" }
{ "bignum-mod" "math.private" }
{ "bignum/mod" "math.private" }
{ "bignum-bitand" "math.private" }
{ "bignum-bitor" "math.private" }
{ "bignum-bitxor" "math.private" }
{ "bignum-bitnot" "math.private" }
{ "bignum-shift" "math.private" }
{ "bignum<" "math.private" }
{ "bignum<=" "math.private" }
{ "bignum>" "math.private" }
{ "bignum>=" "math.private" }
{ "bignum-bit?" "math.private" }
{ "bignum-log2" "math.private" }
{ "byte-array>bignum" "math" }
{ "float=" "math.private" }
{ "float+" "math.private" }
{ "float-" "math.private" }
{ "float*" "math.private" }
{ "float/f" "math.private" }
{ "float-mod" "math.private" }
{ "float<" "math.private" }
{ "float<=" "math.private" }
{ "float>" "math.private" }
{ "float>=" "math.private" }
{ "<word>" "words" }
{ "word-xt" "words" }
{ "drop" "kernel" }
{ "2drop" "kernel" }
{ "3drop" "kernel" }
{ "dup" "kernel" }
{ "2dup" "kernel" }
{ "3dup" "kernel" }
{ "rot" "kernel" }
{ "-rot" "kernel" }
{ "dupd" "kernel" }
{ "swapd" "kernel" }
{ "nip" "kernel" }
{ "2nip" "kernel" }
{ "tuck" "kernel" }
{ "over" "kernel" }
{ "pick" "kernel" }
{ "swap" "kernel" }
{ ">r" "kernel" }
{ "r>" "kernel" }
{ "eq?" "kernel" }
{ "getenv" "kernel.private" }
{ "setenv" "kernel.private" }
{ "(stat)" "io.files.private" }
{ "(directory)" "io.files.private" }
{ "data-gc" "memory" }
{ "code-gc" "memory" }
{ "gc-time" "memory" }
{ "save-image" "memory" }
{ "save-image-and-exit" "memory" }
{ "datastack" "kernel" }
{ "retainstack" "kernel" }
{ "callstack" "kernel" }
{ "set-datastack" "kernel" }
{ "set-retainstack" "kernel" }
{ "set-callstack" "kernel" }
{ "exit" "system" }
{ "data-room" "memory" }
{ "code-room" "memory" }
{ "os-env" "system" }
{ "millis" "system" }
{ "type" "kernel.private" }
{ "tag" "kernel.private" }
{ "cwd" "io.files" }
{ "cd" "io.files" }
{ "modify-code-heap" "words.private" }
{ "dlopen" "alien" }
{ "dlsym" "alien" }
{ "dlclose" "alien" }
{ "<byte-array>" "byte-arrays" }
{ "<bit-array>" "bit-arrays" }
{ "<displaced-alien>" "alien" }
{ "alien-signed-cell" "alien" }
{ "set-alien-signed-cell" "alien" }
{ "alien-unsigned-cell" "alien" }
{ "set-alien-unsigned-cell" "alien" }
{ "alien-signed-8" "alien" }
{ "set-alien-signed-8" "alien" }
{ "alien-unsigned-8" "alien" }
{ "set-alien-unsigned-8" "alien" }
{ "alien-signed-4" "alien" }
{ "set-alien-signed-4" "alien" }
{ "alien-unsigned-4" "alien" }
{ "set-alien-unsigned-4" "alien" }
{ "alien-signed-2" "alien" }
{ "set-alien-signed-2" "alien" }
{ "alien-unsigned-2" "alien" }
{ "set-alien-unsigned-2" "alien" }
{ "alien-signed-1" "alien" }
{ "set-alien-signed-1" "alien" }
{ "alien-unsigned-1" "alien" }
{ "set-alien-unsigned-1" "alien" }
{ "alien-float" "alien" }
{ "set-alien-float" "alien" }
{ "alien-double" "alien" }
{ "set-alien-double" "alien" }
{ "alien-cell" "alien" }
{ "set-alien-cell" "alien" }
{ "alien>char-string" "alien" }
{ "string>char-alien" "alien" }
{ "alien>u16-string" "alien" }
{ "string>u16-alien" "alien" }
{ "(throw)" "kernel.private" }
{ "string>memory" "alien" }
{ "memory>string" "alien" }
{ "alien-address" "alien" }
{ "slot" "slots.private" }
{ "set-slot" "slots.private" }
{ "char-slot" "strings.private" }
{ "set-char-slot" "strings.private" }
{ "resize-array" "arrays" }
{ "resize-string" "strings" }
{ "(hashtable)" "hashtables.private" }
{ "<array>" "arrays" }
{ "begin-scan" "memory" }
{ "next-object" "memory" }
{ "end-scan" "memory" }
{ "size" "memory" }
{ "die" "kernel" }
{ "fopen" "io.streams.c" }
{ "fgetc" "io.streams.c" }
{ "fread" "io.streams.c" }
{ "fwrite" "io.streams.c" }
{ "fflush" "io.streams.c" }
{ "fclose" "io.streams.c" }
{ "<wrapper>" "kernel" }
{ "(clone)" "kernel" }
{ "array>vector" "vectors.private" }
{ "<string>" "strings" }
{ "(>tuple)" "tuples.private" }
{ "array>quotation" "quotations.private" }
{ "quotation-xt" "quotations" }
{ "<tuple>" "tuples.private" }
{ "tuple>array" "tuples" }
{ "profiling" "tools.profiler.private" }
{ "become" "kernel.private" }
{ "(sleep)" "threads.private" }
{ "<float-array>" "float-arrays" }
{ "curry" "kernel" }
{ "<tuple-boa>" "tuples.private" }
{ "class-hash" "kernel.private" }
{ "callstack>array" "kernel" }
{ "innermost-frame-quot" "kernel.private" }
{ "innermost-frame-scan" "kernel.private" }
{ "set-innermost-frame-quot" "kernel.private" }
{ "call-clear" "kernel" }
{ "strip-compiled-quotations" "quotations" }
{ "(os-envs)" "system" }
}
dup length [ >r first2 r> make-primitive ] 2each
! Bump build number
"build" "kernel" create build 1+ 1quotation define-compound

2
core/classes/classes.factor
View File

@ -253,8 +253,8 @@ PRIVATE>
: (define-class) ( word props -- )
over reset-class
over define-symbol
>r dup word-props r> union over set-word-props
dup intern-symbol
t "class" set-word-prop ;
: define-class ( word members superclass metaclass -- )

3
core/definitions/definitions.factor
View File

@ -56,7 +56,7 @@ TUPLE: redefine-error def ;
{ { "Continue" t } } throw-restarts drop ;
: add-once ( key assoc -- )
2dup key? [ drop redefine-error ] when dupd set-at ;
2dup key? [ over redefine-error ] when dupd set-at ;
: (remember-definition) ( definition loc assoc -- )
>r over set-where r> add-once ;
@ -65,6 +65,7 @@ TUPLE: redefine-error def ;
new-definitions get first (remember-definition) ;
: remember-class ( class loc -- )
over new-definitions get first key? [ dup redefine-error ] when
new-definitions get second (remember-definition) ;
TUPLE: forward-error word ;

12
core/parser/parser-tests.factor
View File

@ -104,11 +104,6 @@ IN: temporary
[ "OCT: 999" eval ] unit-test-fails
[ "BIN: --0" eval ] unit-test-fails
[ f ] [
"IN: temporary : foo ; TUPLE: foo ;" eval
"foo" "temporary" lookup symbol?
] unit-test
! Another funny bug
[ t ] [
[
@ -366,6 +361,13 @@ IN: temporary
<string-reader> "redefining-a-class-3" parse-stream drop
] catch [ forward-error? ] is?
] unit-test
[ t ] [
[
"IN: temporary : foo ; TUPLE: foo ;"
<string-reader> "redefining-a-class-4" parse-stream drop
] catch [ redefine-error? ] is?
] unit-test
] with-scope
[

31
core/prettyprint/prettyprint.factor Normal file → Executable file
View File

@ -207,29 +207,28 @@ M: word declarations.
: pprint-; \ ; pprint-word ;
: (see) ( spec -- )
[
<colon dup synopsis*
<block dup definition pprint-elements block>
dup definer nip [ pprint-word ] when* declarations.
block>
] with-use nl ;
<colon dup synopsis*
<block dup definition pprint-elements block>
dup definer nip [ pprint-word ] when* declarations.
block> ;
M: object see (see) ;
M: object see
[ (see) ] with-use nl ;
GENERIC: see-class* ( word -- )
M: union-class see-class*
\ UNION: pprint-word
<colon \ UNION: pprint-word
dup pprint-word
members pprint-elements pprint-; ;
members pprint-elements pprint-; block> ;
M: mixin-class see-class*
\ MIXIN: pprint-word
<block \ MIXIN: pprint-word
dup pprint-word <block
dup members [
hard line-break
\ INSTANCE: pprint-word pprint-word pprint-word
] curry* each block> ;
] curry* each block> block> ;
M: predicate-class see-class*
<colon \ PREDICATE: pprint-word
@ -240,10 +239,10 @@ M: predicate-class see-class*
pprint-; block> block> ;
M: tuple-class see-class*
\ TUPLE: pprint-word
<colon \ TUPLE: pprint-word
dup pprint-word
"slot-names" word-prop [ text ] each
pprint-; ;
pprint-; block> ;
M: word see-class* drop ;
@ -265,8 +264,10 @@ M: builtin-class see-class*
[ 2array ] curry map ;
M: word see
dup (see)
dup see-class
[
dup see-class*
dup class? over symbol? and not [ dup (see) ] when
] with-use nl
[
dup class? [ dup see-implementors % ] when
dup generic? [ dup see-methods % ] when

4
core/words/words-docs.factor
View File

@ -241,10 +241,6 @@ HELP: define-symbol
{ $description "Defines the word to push itself on the stack when executed." }
{ $side-effects "word" } ;
HELP: intern-symbol
{ $values { "word" word } }
{ $description "If the word is undefined, makes it into a symbol which pushes itself on the stack when executed. If the word already has a definition, does nothing." } ;
HELP: define-compound
{ $values { "word" word } { "def" quotation } }
{ $description "Defines the word to call a quotation when executed." }

6
core/words/words.factor
View File

@ -97,10 +97,8 @@ M: compound redefined* ( word -- )
PRIVATE>
: define-symbol ( word -- ) t define ;
: intern-symbol ( word -- )
dup undefined? [ define-symbol ] [ drop ] if ;
: define-symbol ( word -- )
t define ;
: define-compound ( word def -- )
[ ] like define ;