Make the walker infer

db4
Slava Pestov 2009-04-16 23:14:11 -05:00
parent a69d404f74
commit 0a5b076c11
5 changed files with 32 additions and 25 deletions

View File

@ -63,19 +63,20 @@ SYMBOLS: +optimized+ +unoptimized+ ;
} 1|| } 1||
] [ error-type +compiler-warning+ eq? ] bi* and ; ] [ error-type +compiler-warning+ eq? ] bi* and ;
: fail ( word error -- * ) : (fail) ( word -- * )
[ 2dup ignore-error? [ drop f ] when swap compiler-error ]
[
drop
[ compiled-unxref ] [ compiled-unxref ]
[ f swap compiled get set-at ] [ f swap compiled get set-at ]
[ +unoptimized+ save-compiled-status ] [ +unoptimized+ save-compiled-status ]
tri tri
] 2bi
return ; return ;
: fail ( word error -- * )
[ 2dup ignore-error? [ drop f ] when swap compiler-error ] [ drop (fail) ] 2bi ;
: frontend ( word -- nodes ) : frontend ( word -- nodes )
[ build-tree-from-word ] [ fail ] recover optimize-tree ; dup contains-breakpoints? [ (fail) ] [
[ build-tree-from-word ] [ fail ] recover optimize-tree
] if ;
! Only switch this off for debugging. ! Only switch this off for debugging.
SYMBOL: compile-dependencies? SYMBOL: compile-dependencies?

View File

@ -58,3 +58,6 @@ TUPLE: do-not-compile word ;
} cleave } cleave
] maybe-cannot-infer ] maybe-cannot-infer
] with-tree-builder ; ] with-tree-builder ;
: contains-breakpoints? ( word -- ? )
def>> [ word? ] filter [ "break?" word-prop ] any? ;

View File

@ -148,7 +148,11 @@ DEFER: (flat-length)
] sum-outputs ; ] sum-outputs ;
: should-inline? ( #call word -- ? ) : should-inline? ( #call word -- ? )
dup "inline" word-prop [ 2drop t ] [ inlining-rank 5 >= ] if ; {
{ [ dup contains-breakpoints? ] [ 2drop f ] }
{ [ dup "inline" word-prop ] [ 2drop t ] }
[ inlining-rank 5 >= ]
} cond ;
SYMBOL: history SYMBOL: history

View File

@ -12,7 +12,6 @@ IN: tools.continuations
: after-break ( object -- ) : after-break ( object -- )
{ {
{ [ dup continuation? ] [ (continue) ] } { [ dup continuation? ] [ (continue) ] }
{ [ dup quotation? ] [ call ] }
{ [ dup not ] [ "Single stepping abandoned" rethrow ] } { [ dup not ] [ "Single stepping abandoned" rethrow ] }
} cond ; } cond ;
@ -22,7 +21,7 @@ SYMBOL: break-hook
: break ( -- ) : break ( -- )
continuation callstack >>call continuation callstack >>call
break-hook get call break-hook get call( continuation -- continuation' )
after-break ; after-break ;
\ break t "break?" set-word-prop \ break t "break?" set-word-prop
@ -125,14 +124,14 @@ PRIVATE>
} [ "step-into" set-word-prop ] assoc-each } [ "step-into" set-word-prop ] assoc-each
! Never step into these words ! Never step into these words
: don't-step-into ( word -- )
dup [ execute break ] curry "step-into" set-word-prop ;
{ {
>n ndrop >c c> >n ndrop >c c>
continue continue-with continue continue-with
stop suspend (spawn) stop suspend (spawn)
} [ } [ don't-step-into ] each
dup [ execute break ] curry
"step-into" set-word-prop
] each
\ break [ break ] "step-into" set-word-prop \ break [ break ] "step-into" set-word-prop

View File

@ -74,14 +74,14 @@ C: <continuation> continuation
<PRIVATE <PRIVATE
: (continue) ( continuation -- * ) : (continue) ( continuation -- * )
[
>continuation< >continuation<
set-catchstack set-catchstack
set-namestack set-namestack
set-retainstack set-retainstack
[ set-datastack ] dip [ set-datastack ] dip
set-callstack ; set-callstack
] (( continuation -- * )) call-effect-unsafe ;
\ (continue) t "no-compile" set-word-prop
PRIVATE> PRIVATE>