diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index c99b047686..3552f0bd92 100644 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -545,7 +545,7 @@ M: quotation ' \ c-to-factor c-to-factor-word set \ lazy-jit-compile lazy-jit-compile-word set \ unwind-native-frames unwind-native-frames-word set - [ undefined ] undefined-quot set ; + undefined-def undefined-quot set ; : emit-special-objects ( -- ) special-objects get keys [ emit-special-object ] each ; diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor index d5284133b2..ba90d761cc 100644 --- a/basis/debugger/debugger.factor +++ b/basis/debugger/debugger.factor @@ -236,7 +236,10 @@ M: redefine-error error. def>> . ; M: undefined summary - drop "Calling a deferred word before it has been defined" ; + word>> undefined? + "Cannot call a deferred word before it has been defined" + "Cannot call a word before it has been compiled" + ? ; M: no-compilation-unit error. "Attempting to define " write diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor index 65d25f1812..ccc77068e6 100644 --- a/basis/prettyprint/prettyprint.factor +++ b/basis/prettyprint/prettyprint.factor @@ -1,10 +1,10 @@ -! Copyright (C) 2003, 2009 Slava Pestov. +! Copyright (C) 2003, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays accessors assocs colors combinators grouping io io.streams.string io.styles kernel make math math.parser namespaces parser prettyprint.backend prettyprint.config prettyprint.custom prettyprint.sections quotations sequences sorting strings vocabs -vocabs.prettyprint words sets ; +vocabs.prettyprint words sets generic ; IN: prettyprint : with-use ( obj quot -- ) @@ -72,24 +72,31 @@ SYMBOL: -> ] [ ] make ; : remove-breakpoints ( quot pos -- quot' ) + 1 + short cut [ (remove-breakpoints) ] bi@ [ -> ] glue ; + +: callframe. ( triple -- ) + first3 + [ + { + { [ dup method-body? ] [ "Method: " write . ] } + { [ dup word? ] [ "Word: " write . ] } + [ drop ] + } cond + ] 2dip over quotation? [ - 1 + short cut [ (remove-breakpoints) ] bi@ - [ -> ] glue - ] [ - drop - ] if ; - -PRIVATE> - -: callstack. ( callstack -- ) - callstack>array 2 [ + "Quotation: " write remove-breakpoints [ 3 nesting-limit set 100 length-limit set . ] with-scope - ] assoc-each ; + ] [ 2drop ] if ; + +PRIVATE> + +: callstack. ( callstack -- ) + callstack>array 3 [ nl ] [ callframe. ] interleave ; : .c ( -- ) callstack callstack. ; diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index dfb3e0bc10..cf2c49fff9 100644 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -135,7 +135,7 @@ IN: bootstrap.syntax "DEFER:" [ scan current-vocab create - [ fake-definition ] [ set-word ] [ [ undefined ] define ] tri + [ fake-definition ] [ set-word ] [ undefined-def define ] tri ] define-core-syntax "ALIAS:" [ diff --git a/core/words/words-tests.factor b/core/words/words-tests.factor index 46b20bf2e6..2734defaac 100644 --- a/core/words/words-tests.factor +++ b/core/words/words-tests.factor @@ -64,9 +64,14 @@ FORGET: forgotten FORGET: another-forgotten : another-forgotten ( -- ) ; +! Make sure that undefined words throw proper errors +DEFER: deferred +[ deferred ] [ T{ undefined f deferred } = ] must-fail-with -DEFER: x -[ x ] [ undefined? ] must-fail-with +[ "IN: words.tests DEFER: not-compiled << not-compiled >>" eval( -- ) ] +[ error>> [ undefined? ] [ word>> name>> "not-compiled" = ] bi and ] must-fail-with + +[ ] [ "IN: words.tests FORGET: not-compiled" eval( -- ) ] unit-test [ ] [ [ "no-loc" "words.tests" create drop ] with-compilation-unit ] unit-test [ f ] [ "no-loc" "words.tests" lookup where ] unit-test diff --git a/core/words/words.factor b/core/words/words.factor index 4fe00d1edf..6c6e0d188b 100644 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -32,9 +32,22 @@ M: word definition def>> ; : reset-props ( word seq -- ) [ remove-word-prop ] with each ; -ERROR: undefined ; +> [ undefined ] = ; +: caller ( callstack -- word ) callstack>array third ; + +PRIVATE> + +TUPLE: undefined word ; +: undefined ( -- * ) callstack caller \ undefined boa throw ; + +: undefined-def ( -- quot ) + #! 'f' inhibits tail call optimization in non-optimizing + #! compiler, ensuring that we can pull out the caller word + #! above. + [ undefined f ] ; + +PREDICATE: deferred < word ( obj -- ? ) def>> undefined-def = ; M: deferred definer drop \ DEFER: f ; M: deferred definition drop f ; diff --git a/vm/callstack.cpp b/vm/callstack.cpp index 4aa9321353..195b212d8b 100755 --- a/vm/callstack.cpp +++ b/vm/callstack.cpp @@ -132,10 +132,12 @@ struct stack_frame_accumulator { void operator()(stack_frame *frame) { - data_root executing(parent->frame_executing_quot(frame),parent); + data_root executing_quot(parent->frame_executing_quot(frame),parent); + data_root executing(parent->frame_executing(frame),parent); data_root scan(parent->frame_scan(frame),parent); frames.add(executing.value()); + frames.add(executing_quot.value()); frames.add(scan.value()); } };