From 1e2561f8631f778cf651eaac632c80534f0d12f7 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 09:12:32 -0500 Subject: [PATCH] Make walker work better with call( and breakpoints which are nested inside combinators --- basis/compiler/compiler.factor | 17 +++++----- basis/compiler/tree/builder/builder.factor | 2 -- .../tree/propagation/inlining/inlining.factor | 6 +--- .../known-words/known-words.factor | 2 +- .../tools/continuations/continuations.factor | 32 ++++++++----------- basis/tools/walker/walker-tests.factor | 18 +++++++++-- core/bootstrap/primitives.factor | 2 +- vm/callstack.cpp | 4 +-- vm/callstack.hpp | 2 +- vm/primitives.cpp | 2 +- 10 files changed, 44 insertions(+), 43 deletions(-) diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index e418f0ef60..01e58461ff 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -112,19 +112,18 @@ M: predicate-engine-word no-compile? "owner-generic" word-prop no-compile? ; } cond ; : optimize? ( word -- ? ) - { - [ predicate-engine-word? ] - [ contains-breakpoints? ] - [ single-generic? ] - } 1|| not ; + { [ predicate-engine-word? ] [ single-generic? ] } 1|| not ; + +: contains-breakpoints? ( -- ? ) + dependencies get keys [ "break?" word-prop ] any? ; : frontend ( word -- nodes ) #! If the word contains breakpoints, don't optimize it, since #! the walker does not support this. - dup optimize? - [ [ build-tree ] [ deoptimize ] recover optimize-tree ] - [ dup def>> deoptimize-with ] - if ; + dup optimize? [ + [ [ build-tree ] [ deoptimize ] recover optimize-tree ] keep + contains-breakpoints? [ nip dup def>> deoptimize-with ] [ drop ] if + ] [ dup def>> deoptimize-with ] if ; : compile-dependency ( word -- ) #! If a word calls an unoptimized word, try to compile the callee. diff --git a/basis/compiler/tree/builder/builder.factor b/basis/compiler/tree/builder/builder.factor index 37cc1f05da..00325f5a72 100644 --- a/basis/compiler/tree/builder/builder.factor +++ b/basis/compiler/tree/builder/builder.factor @@ -65,5 +65,3 @@ PRIVATE> ] [ dup inference-error? [ drop f ] [ rethrow ] if ] recover ] with-variable ; -: contains-breakpoints? ( word -- ? ) - def>> [ word? ] filter [ "break?" word-prop ] any? ; diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor index 2a7d431314..ee9abf00ec 100755 --- a/basis/compiler/tree/propagation/inlining/inlining.factor +++ b/basis/compiler/tree/propagation/inlining/inlining.factor @@ -157,11 +157,7 @@ DEFER: (flat-length) ] sum-outputs ; : should-inline? ( #call word -- ? ) - { - { [ dup contains-breakpoints? ] [ 2drop f ] } - { [ dup "inline" word-prop ] [ 2drop t ] } - [ inlining-rank 5 >= ] - } cond ; + dup inline? [ 2drop t ] [ inlining-rank 5 >= ] if ; SYMBOL: history diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index f6f94bf20d..7603324200 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -651,7 +651,7 @@ M: object infer-call* \ become { array array } { } define-primitive -\ innermost-frame-quot { callstack } { quotation } define-primitive +\ innermost-frame-executing { callstack } { object } define-primitive \ innermost-frame-scan { callstack } { fixnum } define-primitive diff --git a/basis/tools/continuations/continuations.factor b/basis/tools/continuations/continuations.factor index 8c572f4ae3..15fdb9f9b5 100644 --- a/basis/tools/continuations/continuations.factor +++ b/basis/tools/continuations/continuations.factor @@ -4,7 +4,7 @@ USING: threads kernel namespaces continuations combinators sequences math namespaces.private continuations.private concurrency.messaging quotations kernel.private words sequences.private assocs models models.arrow arrays accessors -generic generic.single definitions make sbufs tools.crossref ; +generic generic.single definitions make sbufs tools.crossref fry ; IN: tools.continuations > +: >innermost-frame< ( callstack -- n quot ) + [ innermost-frame-scan 1 + ] [ innermost-frame-executing ] bi ; + +: (change-frame) ( callstack quot -- callstack' ) + [ dup innermost-frame-executing quotation? ] dip '[ + clone [ >innermost-frame< @ ] [ set-innermost-frame-quot ] [ ] tri + ] when ; inline + : change-frame ( continuation quot -- continuation' ) #! Applies quot to innermost call frame of the #! continuation. - [ clone ] dip [ - [ clone ] dip - [ - [ - [ innermost-frame-scan 1+ ] - [ innermost-frame-quot ] bi - ] dip call - ] - [ drop set-innermost-frame-quot ] - [ drop ] - 2tri - ] curry change-call ; inline + [ clone ] dip '[ _ (change-frame) ] change-call ; inline PRIVATE> @@ -101,7 +98,7 @@ PRIVATE> [ 2dup length = [ nip [ break ] append ] [ 2dup nth \ break = [ nip ] [ - swap 1+ cut [ break ] glue + swap 1 + cut [ break ] glue ] if ] if ] change-frame ; @@ -109,7 +106,6 @@ PRIVATE> : continuation-step-out ( continuation -- continuation' ) [ nip \ break suffix ] change-frame ; - { { call [ (step-into-quot) ] } { dip [ (step-into-dip) ] } @@ -124,7 +120,7 @@ PRIVATE> ! Never step into these words : don't-step-into ( word -- ) - dup [ execute break ] curry "step-into" set-word-prop ; + dup '[ _ execute break ] "step-into" set-word-prop ; { >n ndrop >c c> @@ -151,6 +147,4 @@ PRIVATE> ] change-frame ; : continuation-current ( continuation -- obj ) - call>> - [ innermost-frame-scan 1+ ] - [ innermost-frame-quot ] bi ?nth ; + call>> >innermost-frame< ?nth ; diff --git a/basis/tools/walker/walker-tests.factor b/basis/tools/walker/walker-tests.factor index 6f87792faa..b6094d7d7e 100644 --- a/basis/tools/walker/walker-tests.factor +++ b/basis/tools/walker/walker-tests.factor @@ -2,7 +2,7 @@ USING: tools.walker io io.streams.string kernel math math.private namespaces prettyprint sequences tools.test continuations math.parser threads arrays tools.walker.debug generic.single sequences.private kernel.private -tools.continuations accessors words ; +tools.continuations accessors words combinators ; IN: tools.walker.tests [ { } ] [ @@ -131,4 +131,18 @@ M: method-breakpoint-tuple method-breakpoint-test break drop 1 2 + ; \ method-breakpoint-test don't-step-into [ { 3 } ] -[ [ T{ method-breakpoint-tuple } method-breakpoint-test ] test-walker ] unit-test \ No newline at end of file +[ [ T{ method-breakpoint-tuple } method-breakpoint-test ] test-walker ] unit-test + +: case-breakpoint-test ( -- x ) + 5 { [ break 1 + ] } case ; + +\ case-breakpoint-test don't-step-into + +[ { 6 } ] [ [ case-breakpoint-test ] test-walker ] unit-test + +: call(-breakpoint-test ( -- x ) + [ break 1 ] call( -- x ) 2 + ; + +\ call(-breakpoint-test don't-step-into + +[ { 3 } ] [ [ call(-breakpoint-test ] test-walker ] unit-test diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index e5a6bbe5fa..83276cd3f2 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -493,7 +493,7 @@ tuple { "(sleep)" "threads.private" (( us -- )) } { "" "classes.tuple.private" (( ... layout -- tuple )) } { "callstack>array" "kernel" (( callstack -- array )) } - { "innermost-frame-quot" "kernel.private" (( callstack -- quot )) } + { "innermost-frame-executing" "kernel.private" (( callstack -- obj )) } { "innermost-frame-scan" "kernel.private" (( callstack -- n )) } { "set-innermost-frame-quot" "kernel.private" (( n callstack -- )) } { "call-clear" "kernel" (( quot -- )) } diff --git a/vm/callstack.cpp b/vm/callstack.cpp index 56056426dd..ade0b45db7 100755 --- a/vm/callstack.cpp +++ b/vm/callstack.cpp @@ -195,9 +195,9 @@ stack_frame *innermost_stack_frame_quot(callstack *callstack) /* Some primitives implementing a limited form of callstack mutation. Used by the single stepper. */ -PRIMITIVE(innermost_stack_frame_quot) +PRIMITIVE(innermost_stack_frame_executing) { - dpush(frame_executing(innermost_stack_frame_quot(untag_check(dpop())))); + dpush(frame_executing(innermost_stack_frame(untag_check(dpop())))); } PRIMITIVE(innermost_stack_frame_scan) diff --git a/vm/callstack.hpp b/vm/callstack.hpp index efdbc7ba05..ec2e8e37d1 100755 --- a/vm/callstack.hpp +++ b/vm/callstack.hpp @@ -22,7 +22,7 @@ cell frame_type(stack_frame *frame); PRIMITIVE(callstack); PRIMITIVE(set_callstack); PRIMITIVE(callstack_to_array); -PRIMITIVE(innermost_stack_frame_quot); +PRIMITIVE(innermost_stack_frame_executing); PRIMITIVE(innermost_stack_frame_scan); PRIMITIVE(set_innermost_stack_frame_quot); diff --git a/vm/primitives.cpp b/vm/primitives.cpp index 08db684ff6..f1c5468949 100755 --- a/vm/primitives.cpp +++ b/vm/primitives.cpp @@ -135,7 +135,7 @@ const primitive_type primitives[] = { primitive_sleep, primitive_tuple_boa, primitive_callstack_to_array, - primitive_innermost_stack_frame_quot, + primitive_innermost_stack_frame_executing, primitive_innermost_stack_frame_scan, primitive_set_innermost_stack_frame_quot, primitive_call_clear,