From 1b9e04fdc5d01ae0ff87fef59e8421f3bd202cd2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 26 Dec 2007 17:28:34 -0500 Subject: [PATCH] Deferred words are now compound words --- core/bootstrap/image/image.factor | 2 -- core/bootstrap/primitives.factor | 2 +- core/debugger/debugger-docs.factor | 3 --- core/debugger/debugger.factor | 11 +++++------ core/inference/backend/backend.factor | 3 --- core/words/words-docs.factor | 10 +++++----- core/words/words.factor | 24 +++++++++++++++++++----- extra/cocoa/messages/messages.factor | 2 +- extra/locals/locals.factor | 8 ++++---- vm/cpu-arm.h | 1 - vm/cpu-x86.S | 4 ---- vm/cpu-x86.h | 1 - vm/errors.c | 7 ------- vm/errors.h | 5 +---- vm/image.c | 2 +- vm/run.c | 7 ------- vm/types.c | 2 +- 17 files changed, 38 insertions(+), 56 deletions(-) mode change 100644 => 100755 core/debugger/debugger-docs.factor mode change 100644 => 100755 extra/cocoa/messages/messages.factor mode change 100644 => 100755 extra/locals/locals.factor diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index 6ea7ebb107..7748c7f418 100755 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -374,11 +374,9 @@ M: curry ' jit-word-primitive-call jit-word-jump jit-word-call - jit-push-wrapper jit-push-literal jit-if-word jit-if-jump - jit-if-call jit-dispatch-word jit-dispatch jit-epilog diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 0142d2f9a1..28bb3637c0 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -476,7 +476,7 @@ builtins get num-tags get tail f union-class define-class { "float<=" "math.private" } { "float>" "math.private" } { "float>=" "math.private" } - { "" "words" } + { "" "words.private" } { "word-xt" "words" } { "drop" "kernel" } { "2drop" "kernel" } diff --git a/core/debugger/debugger-docs.factor b/core/debugger/debugger-docs.factor old mode 100644 new mode 100755 index d5c7ecfeb1..b754856ee4 --- a/core/debugger/debugger-docs.factor +++ b/core/debugger/debugger-docs.factor @@ -98,9 +98,6 @@ HELP: expired-error. HELP: io-error. { $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. { $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." } ; diff --git a/core/debugger/debugger.factor b/core/debugger/debugger.factor index be3393fbc2..a085eea0cb 100755 --- a/core/debugger/debugger.factor +++ b/core/debugger/debugger.factor @@ -92,9 +92,6 @@ TUPLE: assert got expect ; : expired-error. ( obj -- ) "Object did not survive image save/load: " write third . ; -: undefined-word-error. ( obj -- ) - "Undefined word: " write third . ; - : io-error. ( error -- ) "I/O error: " write third print ; @@ -150,14 +147,14 @@ PREDICATE: array kernel-error ( obj -- ? ) { { [ dup empty? ] [ drop f ] } { [ dup first "kernel-error" = not ] [ drop f ] } - { [ t ] [ second 0 16 between? ] } + { [ t ] [ second 0 15 between? ] } } cond ; : kernel-errors second { { 0 [ expired-error. ] } { 1 [ io-error. ] } - { 2 [ undefined-word-error. ] } + { 2 [ primitive-error. ] } { 3 [ type-check-error. ] } { 4 [ divide-by-zero-error. ] } { 5 [ signal-error. ] } @@ -171,7 +168,6 @@ PREDICATE: array kernel-error ( obj -- ? ) { 13 [ retainstack-underflow. ] } { 14 [ retainstack-overflow. ] } { 15 [ memory-error. ] } - { 16 [ primitive-error. ] } } ; inline M: kernel-error error. dup kernel-errors case ; @@ -228,3 +224,6 @@ M: redefine-error error. M: forward-error error. "Forward reference to " write forward-error-word . ; + +M: undefined summary + drop "Calling a deferred word before it has been defined" ; diff --git a/core/inference/backend/backend.factor b/core/inference/backend/backend.factor index e5f282a8d1..f2f153e0bd 100755 --- a/core/inference/backend/backend.factor +++ b/core/inference/backend/backend.factor @@ -465,9 +465,6 @@ M: compound apply-object [ declared-infer ] [ apply-word ] if ] if-inline ; -M: undefined apply-object - drop "Undefined word" time-bomb ; - : with-infer ( quot -- effect dataflow ) [ [ diff --git a/core/words/words-docs.factor b/core/words/words-docs.factor index 91e5bef1f8..98ac00aeb7 100755 --- a/core/words/words-docs.factor +++ b/core/words/words-docs.factor @@ -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." { $subsection POSTPONE: DEFER: } "The class of forward word definitions:" -{ $subsection undefined } -{ $subsection undefined? } ; +{ $subsection deferred } +{ $subsection deferred? } ; 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." @@ -197,10 +197,10 @@ HELP: set-word-def ( obj word -- ) $low-level-note { $side-effects "word" } ; -HELP: undefined -{ $class-description "The class of undefined words created by " { $link POSTPONE: DEFER: } "." } ; +HELP: deferred +{ $class-description "The class of deferred words created by " { $link POSTPONE: DEFER: } "." } ; -{ undefined POSTPONE: DEFER: } related-words +{ deferred POSTPONE: DEFER: } related-words HELP: compound { $description "The class of compound words created by " { $link POSTPONE: : } "." } ; diff --git a/core/words/words.factor b/core/words/words.factor index 972262675f..3fba06b816 100755 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -19,15 +19,23 @@ M: word <=> 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? ; M: compound definer drop \ : \ ; ; 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 -- ? ) dup 1array swap word-def sequence= ; M: symbol definer drop \ SYMBOL: f ; @@ -102,6 +110,9 @@ PRIVATE> : define-compound ( word def -- ) [ ] like define ; +: undefine ( word -- ) + dup [ undefined ] curry define-compound ; + : define-declared ( word def effect -- ) pick swap "declared-effect" set-word-prop define-compound ; @@ -133,8 +144,11 @@ PRIVATE> : reset-generic ( word -- ) dup reset-word { "methods" "combination" } reset-props ; +: ( name -- word ) + f dup undefine ; + : gensym ( -- word ) - "G:" \ gensym counter number>string append f ; + "G:" \ gensym counter number>string append ; : define-temp ( quot -- word ) gensym dup rot define-compound ; @@ -151,7 +165,7 @@ TUPLE: check-create name vocab ; : create ( name vocab -- word ) check-create 2dup lookup - dup [ 2nip ] [ drop dup reveal ] if ; + dup [ 2nip ] [ drop dup reveal dup undefine ] if ; : constructor-word ( name vocab -- word ) >r "<" swap ">" 3append r> create ; diff --git a/extra/cocoa/messages/messages.factor b/extra/cocoa/messages/messages.factor old mode 100644 new mode 100755 index 54ddbaa0cf..b0a4253b1b --- a/extra/cocoa/messages/messages.factor +++ b/extra/cocoa/messages/messages.factor @@ -14,7 +14,7 @@ IN: cocoa.messages [ % "_" % unparse % ] "" make ; : sender-stub ( method function -- word ) - [ sender-stub-name f dup ] 2keep + [ sender-stub-name dup ] 2keep over first large-struct? [ "_stret" append ] when make-sender define-compound dup compile ; diff --git a/extra/locals/locals.factor b/extra/locals/locals.factor old mode 100644 new mode 100755 index 688507be78..3582f92a5f --- a/extra/locals/locals.factor +++ b/extra/locals/locals.factor @@ -27,22 +27,22 @@ PREDICATE: word local "local?" word-prop ; : ( name -- word ) #! Create a local variable identifier - f dup t "local?" set-word-prop ; + dup t "local?" set-word-prop ; PREDICATE: word local-word "local-word?" word-prop ; : ( name -- word ) - f dup t "local-word?" set-word-prop ; + dup t "local-word?" set-word-prop ; PREDICATE: word local-reader "local-reader?" word-prop ; : ( name -- word ) - f dup t "local-reader?" set-word-prop ; + dup t "local-reader?" set-word-prop ; PREDICATE: word local-writer "local-writer?" word-prop ; : ( reader -- word ) - dup word-name "!" append f + dup word-name "!" append [ t "local-writer?" set-word-prop ] keep [ "local-writer" set-word-prop ] 2keep [ swap "local-reader" set-word-prop ] keep ; diff --git a/vm/cpu-arm.h b/vm/cpu-arm.h index c134389969..e6ea0a1158 100755 --- a/vm/cpu-arm.h +++ b/vm/cpu-arm.h @@ -8,7 +8,6 @@ register CELL rs asm("r6"); #define FRAME_RETURN_ADDRESS(frame) *(XT *)(frame_successor(frame) + 1) 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 throw_impl(CELL quot, F_STACK_FRAME *rewind); void lazy_jit_compile(CELL quot); diff --git a/vm/cpu-x86.S b/vm/cpu-x86.S index eef540907e..5c0a105a55 100755 --- a/vm/cpu-x86.S +++ b/vm/cpu-x86.S @@ -14,10 +14,6 @@ DEF(F_FASTCALL void,c_to_factor,(CELL quot)): POP_NONVOLATILE 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)): mov (DS_REG),ARG0 /* Load quotation from data stack */ sub $CELL_SIZE,DS_REG /* Pop data stack */ diff --git a/vm/cpu-x86.h b/vm/cpu-x86.h index e2c474808e..3b08479e4b 100755 --- a/vm/cpu-x86.h +++ b/vm/cpu-x86.h @@ -4,7 +4,6 @@ INLINE void flush_icache(CELL start, CELL len) {} F_FASTCALL void c_to_factor(CELL quot); 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); void set_callstack(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, void *memcpy); diff --git a/vm/errors.c b/vm/errors.c index e82942af55..966fbe353d 100755 --- a/vm/errors.c +++ b/vm/errors.c @@ -75,13 +75,6 @@ void not_implemented_error(void) 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 offset being 0 or -1) of area+area_size */ bool in_page(CELL fault, CELL area, CELL area_size, int offset) diff --git a/vm/errors.h b/vm/errors.h index 14e755a095..5fe5b08e0d 100755 --- a/vm/errors.h +++ b/vm/errors.h @@ -3,7 +3,7 @@ typedef enum { ERROR_EXPIRED = 0, ERROR_IO, - ERROR_UNDEFINED_WORD, + ERROR_NOT_IMPLEMENTED, ERROR_TYPE, ERROR_DIVIDE_BY_ZERO, ERROR_SIGNAL, @@ -17,7 +17,6 @@ typedef enum ERROR_RS_UNDERFLOW, ERROR_RS_OVERFLOW, ERROR_MEMORY, - ERROR_NOT_IMPLEMENTED, } F_ERRORTYPE; 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 not_implemented_error(void); -F_FASTCALL void undefined_error(CELL word, F_STACK_FRAME *callstack_top); - DECLARE_PRIMITIVE(throw); DECLARE_PRIMITIVE(call_clear); diff --git a/vm/image.c b/vm/image.c index fab37d6303..251136e16b 100755 --- a/vm/image.c +++ b/vm/image.c @@ -189,7 +189,7 @@ void fixup_word(F_WORD *word) } else { - /* Primitive or undefined */ + /* Primitive */ default_word_xt(word); return; } diff --git a/vm/run.c b/vm/run.c index 766f399328..c5f16ac190 100755 --- a/vm/run.c +++ b/vm/run.c @@ -268,16 +268,9 @@ void default_word_xt(F_WORD *word) critical_error("default_word_xt invariant lost",0); word->xt = quot->xt; word->code = quot->code; - - //if(profiling_p()) - // word->xt = docol_profiling; - //else - // word->xt = docol; } else if(type_of(word->def) == FIXNUM_TYPE) word->xt = primitives[to_fixnum(word->def)]; - else if(word->def == F) - word->xt = undefined; else critical_error("bad word-def",tag_object(word)); } diff --git a/vm/types.c b/vm/types.c index 3e97af8ba3..aad2be8a1c 100755 --- a/vm/types.c +++ b/vm/types.c @@ -499,7 +499,7 @@ F_WORD *allot_word(CELL vocab, CELL name) word->props = F; word->counter = tag_fixnum(0); word->compiledp = F; - word->xt = undefined; + word->xt = NULL; return word; }