Make the walker infer
parent
a69d404f74
commit
0a5b076c11
|
@ -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?
|
||||||
|
|
|
@ -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? ;
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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>
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue