Deferred words are now compound words

db4
Slava Pestov 2007-12-26 17:28:34 -05:00
parent c9a7138b76
commit 1b9e04fdc5
17 changed files with 38 additions and 56 deletions

View File

@ -374,11 +374,9 @@ M: curry '
jit-word-primitive-call jit-word-primitive-call
jit-word-jump jit-word-jump
jit-word-call jit-word-call
jit-push-wrapper
jit-push-literal jit-push-literal
jit-if-word jit-if-word
jit-if-jump jit-if-jump
jit-if-call
jit-dispatch-word jit-dispatch-word
jit-dispatch jit-dispatch
jit-epilog jit-epilog

View File

@ -476,7 +476,7 @@ builtins get num-tags get tail f union-class define-class
{ "float<=" "math.private" } { "float<=" "math.private" }
{ "float>" "math.private" } { "float>" "math.private" }
{ "float>=" "math.private" } { "float>=" "math.private" }
{ "<word>" "words" } { "<word>" "words.private" }
{ "word-xt" "words" } { "word-xt" "words" }
{ "drop" "kernel" } { "drop" "kernel" }
{ "2drop" "kernel" } { "2drop" "kernel" }

3
core/debugger/debugger-docs.factor Normal file → Executable file
View File

@ -98,9 +98,6 @@ HELP: expired-error.
HELP: io-error. HELP: io-error.
{ $error-description "Thrown by the C streams I/O primitives if an I/O error occurs." } ; { $error-description "Thrown by the C streams I/O primitives if an I/O error occurs." } ;
HELP: undefined-word-error.
{ $error-description "Thrown if an attempt is made to call a word which was defined by " { $link POSTPONE: DEFER: } "." } ;
HELP: type-check-error. HELP: type-check-error.
{ $error-description "Thrown by various primitives if one of the inputs does not have the expected type. Generic words throw " { $link no-method } " and " { $link no-math-method } " errors in such cases instead." } ; { $error-description "Thrown by various primitives if one of the inputs does not have the expected type. Generic words throw " { $link no-method } " and " { $link no-math-method } " errors in such cases instead." } ;

View File

@ -92,9 +92,6 @@ TUPLE: assert got expect ;
: expired-error. ( obj -- ) : expired-error. ( obj -- )
"Object did not survive image save/load: " write third . ; "Object did not survive image save/load: " write third . ;
: undefined-word-error. ( obj -- )
"Undefined word: " write third . ;
: io-error. ( error -- ) : io-error. ( error -- )
"I/O error: " write third print ; "I/O error: " write third print ;
@ -150,14 +147,14 @@ PREDICATE: array kernel-error ( obj -- ? )
{ {
{ [ dup empty? ] [ drop f ] } { [ dup empty? ] [ drop f ] }
{ [ dup first "kernel-error" = not ] [ drop f ] } { [ dup first "kernel-error" = not ] [ drop f ] }
{ [ t ] [ second 0 16 between? ] } { [ t ] [ second 0 15 between? ] }
} cond ; } cond ;
: kernel-errors : kernel-errors
second { second {
{ 0 [ expired-error. ] } { 0 [ expired-error. ] }
{ 1 [ io-error. ] } { 1 [ io-error. ] }
{ 2 [ undefined-word-error. ] } { 2 [ primitive-error. ] }
{ 3 [ type-check-error. ] } { 3 [ type-check-error. ] }
{ 4 [ divide-by-zero-error. ] } { 4 [ divide-by-zero-error. ] }
{ 5 [ signal-error. ] } { 5 [ signal-error. ] }
@ -171,7 +168,6 @@ PREDICATE: array kernel-error ( obj -- ? )
{ 13 [ retainstack-underflow. ] } { 13 [ retainstack-underflow. ] }
{ 14 [ retainstack-overflow. ] } { 14 [ retainstack-overflow. ] }
{ 15 [ memory-error. ] } { 15 [ memory-error. ] }
{ 16 [ primitive-error. ] }
} ; inline } ; inline
M: kernel-error error. dup kernel-errors case ; M: kernel-error error. dup kernel-errors case ;
@ -228,3 +224,6 @@ M: redefine-error error.
M: forward-error error. M: forward-error error.
"Forward reference to " write forward-error-word . ; "Forward reference to " write forward-error-word . ;
M: undefined summary
drop "Calling a deferred word before it has been defined" ;

View File

@ -465,9 +465,6 @@ M: compound apply-object
[ declared-infer ] [ apply-word ] if [ declared-infer ] [ apply-word ] if
] if-inline ; ] if-inline ;
M: undefined apply-object
drop "Undefined word" time-bomb ;
: with-infer ( quot -- effect dataflow ) : with-infer ( quot -- effect dataflow )
[ [
[ [

View File

@ -50,8 +50,8 @@ ARTICLE: "deferred" "Deferred words and mutual recursion"
"Words cannot be referenced before they are defined; that is, source files must order definitions in a strictly bottom-up fashion. This is done to simplify the implementation, facilitate better parse-time checking and remove some odd corner cases; it also encourages better coding style. Sometimes this restriction gets in the way, for example when defining mutually-recursive words; one way to get around this limitation is to make a forward definition." "Words cannot be referenced before they are defined; that is, source files must order definitions in a strictly bottom-up fashion. This is done to simplify the implementation, facilitate better parse-time checking and remove some odd corner cases; it also encourages better coding style. Sometimes this restriction gets in the way, for example when defining mutually-recursive words; one way to get around this limitation is to make a forward definition."
{ $subsection POSTPONE: DEFER: } { $subsection POSTPONE: DEFER: }
"The class of forward word definitions:" "The class of forward word definitions:"
{ $subsection undefined } { $subsection deferred }
{ $subsection undefined? } ; { $subsection deferred? } ;
ARTICLE: "declarations" "Declarations" ARTICLE: "declarations" "Declarations"
"Declarations give special behavior to a word. Declarations are parsing words that set a word property in the most recently defined word." "Declarations give special behavior to a word. Declarations are parsing words that set a word property in the most recently defined word."
@ -197,10 +197,10 @@ HELP: set-word-def ( obj word -- )
$low-level-note $low-level-note
{ $side-effects "word" } ; { $side-effects "word" } ;
HELP: undefined HELP: deferred
{ $class-description "The class of undefined words created by " { $link POSTPONE: DEFER: } "." } ; { $class-description "The class of deferred words created by " { $link POSTPONE: DEFER: } "." } ;
{ undefined POSTPONE: DEFER: } related-words { deferred POSTPONE: DEFER: } related-words
HELP: compound HELP: compound
{ $description "The class of compound words created by " { $link POSTPONE: : } "." } ; { $description "The class of compound words created by " { $link POSTPONE: : } "." } ;

View File

@ -19,15 +19,23 @@ M: word <=>
M: word definition drop f ; M: word definition drop f ;
PREDICATE: word undefined ( obj -- ? ) word-def not ;
M: undefined definer drop \ DEFER: f ;
PREDICATE: word compound ( obj -- ? ) word-def quotation? ; PREDICATE: word compound ( obj -- ? ) word-def quotation? ;
M: compound definer drop \ : \ ; ; M: compound definer drop \ : \ ; ;
M: compound definition word-def ; M: compound definition word-def ;
TUPLE: undefined word ;
: undefined ( word -- * ) \ undefined construct-boa throw ;
PREDICATE: compound deferred ( obj -- ? )
dup [ undefined ] curry swap word-def sequence= ;
M: deferred definer drop \ DEFER: f ;
M: deferred definition drop f ;
PREDICATE: compound symbol ( obj -- ? ) PREDICATE: compound symbol ( obj -- ? )
dup <wrapper> 1array swap word-def sequence= ; dup <wrapper> 1array swap word-def sequence= ;
M: symbol definer drop \ SYMBOL: f ; M: symbol definer drop \ SYMBOL: f ;
@ -102,6 +110,9 @@ PRIVATE>
: define-compound ( word def -- ) : define-compound ( word def -- )
[ ] like define ; [ ] like define ;
: undefine ( word -- )
dup [ undefined ] curry define-compound ;
: define-declared ( word def effect -- ) : define-declared ( word def effect -- )
pick swap "declared-effect" set-word-prop pick swap "declared-effect" set-word-prop
define-compound ; define-compound ;
@ -133,8 +144,11 @@ PRIVATE>
: reset-generic ( word -- ) : reset-generic ( word -- )
dup reset-word { "methods" "combination" } reset-props ; dup reset-word { "methods" "combination" } reset-props ;
: <uninterned> ( name -- word )
f <word> dup undefine ;
: gensym ( -- word ) : gensym ( -- word )
"G:" \ gensym counter number>string append f <word> ; "G:" \ gensym counter number>string append <uninterned> ;
: define-temp ( quot -- word ) : define-temp ( quot -- word )
gensym dup rot define-compound ; gensym dup rot define-compound ;
@ -151,7 +165,7 @@ TUPLE: check-create name vocab ;
: create ( name vocab -- word ) : create ( name vocab -- word )
check-create 2dup lookup check-create 2dup lookup
dup [ 2nip ] [ drop <word> dup reveal ] if ; dup [ 2nip ] [ drop <word> dup reveal dup undefine ] if ;
: constructor-word ( name vocab -- word ) : constructor-word ( name vocab -- word )
>r "<" swap ">" 3append r> create ; >r "<" swap ">" 3append r> create ;

2
extra/cocoa/messages/messages.factor Normal file → Executable file
View File

@ -14,7 +14,7 @@ IN: cocoa.messages
[ % "_" % unparse % ] "" make ; [ % "_" % unparse % ] "" make ;
: sender-stub ( method function -- word ) : sender-stub ( method function -- word )
[ sender-stub-name f <word> dup ] 2keep [ sender-stub-name <uninterned> dup ] 2keep
over first large-struct? [ "_stret" append ] when over first large-struct? [ "_stret" append ] when
make-sender define-compound dup compile ; make-sender define-compound dup compile ;

8
extra/locals/locals.factor Normal file → Executable file
View File

@ -27,22 +27,22 @@ PREDICATE: word local "local?" word-prop ;
: <local> ( name -- word ) : <local> ( name -- word )
#! Create a local variable identifier #! Create a local variable identifier
f <word> dup t "local?" set-word-prop ; <uninterned> dup t "local?" set-word-prop ;
PREDICATE: word local-word "local-word?" word-prop ; PREDICATE: word local-word "local-word?" word-prop ;
: <local-word> ( name -- word ) : <local-word> ( name -- word )
f <word> dup t "local-word?" set-word-prop ; <uninterned> dup t "local-word?" set-word-prop ;
PREDICATE: word local-reader "local-reader?" word-prop ; PREDICATE: word local-reader "local-reader?" word-prop ;
: <local-reader> ( name -- word ) : <local-reader> ( name -- word )
f <word> dup t "local-reader?" set-word-prop ; <uninterned> dup t "local-reader?" set-word-prop ;
PREDICATE: word local-writer "local-writer?" word-prop ; PREDICATE: word local-writer "local-writer?" word-prop ;
: <local-writer> ( reader -- word ) : <local-writer> ( reader -- word )
dup word-name "!" append f <word> dup word-name "!" append <uninterned>
[ t "local-writer?" set-word-prop ] keep [ t "local-writer?" set-word-prop ] keep
[ "local-writer" set-word-prop ] 2keep [ "local-writer" set-word-prop ] 2keep
[ swap "local-reader" set-word-prop ] keep ; [ swap "local-reader" set-word-prop ] keep ;

View File

@ -8,7 +8,6 @@ register CELL rs asm("r6");
#define FRAME_RETURN_ADDRESS(frame) *(XT *)(frame_successor(frame) + 1) #define FRAME_RETURN_ADDRESS(frame) *(XT *)(frame_successor(frame) + 1)
void c_to_factor(CELL quot); void c_to_factor(CELL quot);
void undefined(CELL word);
void set_callstack(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, void *memcpy); void set_callstack(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, void *memcpy);
void throw_impl(CELL quot, F_STACK_FRAME *rewind); void throw_impl(CELL quot, F_STACK_FRAME *rewind);
void lazy_jit_compile(CELL quot); void lazy_jit_compile(CELL quot);

View File

@ -14,10 +14,6 @@ DEF(F_FASTCALL void,c_to_factor,(CELL quot)):
POP_NONVOLATILE POP_NONVOLATILE
ret ret
DEF(F_FASTCALL void,undefined,(CELL word)):
mov STACK_REG,ARG1 /* Pass callstack pointer */
jmp MANGLE(undefined_error) /* This throws an error */
DEF(F_FASTCALL void,primitive_call,(void)): DEF(F_FASTCALL void,primitive_call,(void)):
mov (DS_REG),ARG0 /* Load quotation from data stack */ mov (DS_REG),ARG0 /* Load quotation from data stack */
sub $CELL_SIZE,DS_REG /* Pop data stack */ sub $CELL_SIZE,DS_REG /* Pop data stack */

View File

@ -4,7 +4,6 @@ INLINE void flush_icache(CELL start, CELL len) {}
F_FASTCALL void c_to_factor(CELL quot); F_FASTCALL void c_to_factor(CELL quot);
F_FASTCALL void throw_impl(CELL quot, F_STACK_FRAME *rewind_to); F_FASTCALL void throw_impl(CELL quot, F_STACK_FRAME *rewind_to);
F_FASTCALL void undefined(CELL word);
F_FASTCALL void lazy_jit_compile(CELL quot); F_FASTCALL void lazy_jit_compile(CELL quot);
void set_callstack(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, void *memcpy); void set_callstack(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, void *memcpy);

View File

@ -75,13 +75,6 @@ void not_implemented_error(void)
general_error(ERROR_NOT_IMPLEMENTED,F,F,NULL); general_error(ERROR_NOT_IMPLEMENTED,F,F,NULL);
} }
/* This function is called from the undefined function in cpu_*.S */
F_FASTCALL void undefined_error(CELL word, F_STACK_FRAME *callstack_top)
{
stack_chain->callstack_top = callstack_top;
general_error(ERROR_UNDEFINED_WORD,word,F,NULL);
}
/* Test if 'fault' is in the guard page at the top or bottom (depending on /* Test if 'fault' is in the guard page at the top or bottom (depending on
offset being 0 or -1) of area+area_size */ offset being 0 or -1) of area+area_size */
bool in_page(CELL fault, CELL area, CELL area_size, int offset) bool in_page(CELL fault, CELL area, CELL area_size, int offset)

View File

@ -3,7 +3,7 @@ typedef enum
{ {
ERROR_EXPIRED = 0, ERROR_EXPIRED = 0,
ERROR_IO, ERROR_IO,
ERROR_UNDEFINED_WORD, ERROR_NOT_IMPLEMENTED,
ERROR_TYPE, ERROR_TYPE,
ERROR_DIVIDE_BY_ZERO, ERROR_DIVIDE_BY_ZERO,
ERROR_SIGNAL, ERROR_SIGNAL,
@ -17,7 +17,6 @@ typedef enum
ERROR_RS_UNDERFLOW, ERROR_RS_UNDERFLOW,
ERROR_RS_OVERFLOW, ERROR_RS_OVERFLOW,
ERROR_MEMORY, ERROR_MEMORY,
ERROR_NOT_IMPLEMENTED,
} F_ERRORTYPE; } F_ERRORTYPE;
void fatal_error(char* msg, CELL tagged); void fatal_error(char* msg, CELL tagged);
@ -32,8 +31,6 @@ void signal_error(int signal, F_STACK_FRAME *native_stack);
void type_error(CELL type, CELL tagged); void type_error(CELL type, CELL tagged);
void not_implemented_error(void); void not_implemented_error(void);
F_FASTCALL void undefined_error(CELL word, F_STACK_FRAME *callstack_top);
DECLARE_PRIMITIVE(throw); DECLARE_PRIMITIVE(throw);
DECLARE_PRIMITIVE(call_clear); DECLARE_PRIMITIVE(call_clear);

View File

@ -189,7 +189,7 @@ void fixup_word(F_WORD *word)
} }
else else
{ {
/* Primitive or undefined */ /* Primitive */
default_word_xt(word); default_word_xt(word);
return; return;
} }

View File

@ -268,16 +268,9 @@ void default_word_xt(F_WORD *word)
critical_error("default_word_xt invariant lost",0); critical_error("default_word_xt invariant lost",0);
word->xt = quot->xt; word->xt = quot->xt;
word->code = quot->code; word->code = quot->code;
//if(profiling_p())
// word->xt = docol_profiling;
//else
// word->xt = docol;
} }
else if(type_of(word->def) == FIXNUM_TYPE) else if(type_of(word->def) == FIXNUM_TYPE)
word->xt = primitives[to_fixnum(word->def)]; word->xt = primitives[to_fixnum(word->def)];
else if(word->def == F)
word->xt = undefined;
else else
critical_error("bad word-def",tag_object(word)); critical_error("bad word-def",tag_object(word));
} }

View File

@ -499,7 +499,7 @@ F_WORD *allot_word(CELL vocab, CELL name)
word->props = F; word->props = F;
word->counter = tag_fixnum(0); word->counter = tag_fixnum(0);
word->compiledp = F; word->compiledp = F;
word->xt = undefined; word->xt = NULL;
return word; return word;
} }