Revert part of an earlier ccompiler.tree.checker hange to fix smalltalk.eval regression

db4
Slava Pestov 2009-04-22 21:03:53 -05:00
parent 85426d1d7d
commit 1dd3ed519f
5 changed files with 20 additions and 27 deletions

View File

@ -144,15 +144,13 @@ M: #terminate check-stack-flow*
SYMBOL: branch-out
: check-branch ( nodes -- datastack )
: check-branch ( nodes -- stack )
[
datastack [ clone ] change
retainstack [ clone ] change
retainstack get clone [ (check-stack-flow) ] dip
terminated? get [ drop f ] [
retainstack get assert=
datastack get
] if
V{ } clone retainstack set
(check-stack-flow)
terminated? get [ assert-retainstack-empty ] unless
terminated? get f datastack get ?
] with-scope ;
M: #branch check-stack-flow*

View File

@ -29,7 +29,6 @@ SYMBOL: check-optimizer?
normalize
propagate
cleanup
?check
dup run-escape-analysis? [
escape-analysis
unbox-tuples

View File

@ -84,8 +84,11 @@ M: object apply-object push-literal ;
meta-r empty? [ too-many->r ] unless ;
: infer-quot-here ( quot -- )
meta-r [
V{ } clone \ meta-r set
[ apply-object terminated? get not ] all?
[ commit-literals ] [ literals get delete-all ] if ;
[ commit-literals check->r ] [ literals get delete-all ] if
] dip \ meta-r set ;
: infer-quot ( quot rstate -- )
recursive-state get [
@ -113,33 +116,25 @@ M: object apply-object push-literal ;
] if ;
: infer->r ( n -- )
terminated? get [ drop ] [
consume-d dup copy-values [ nip output-r ] [ #>r, ] 2bi
] if ;
consume-d dup copy-values [ nip output-r ] [ #>r, ] 2bi ;
: infer-r> ( n -- )
terminated? get [ drop ] [
consume-r dup copy-values [ nip output-d ] [ #r>, ] 2bi
] if ;
: (consume/produce) ( effect -- inputs outputs )
[ in>> length consume-d ] [ out>> length produce-d ] bi ;
consume-r dup copy-values [ nip output-d ] [ #r>, ] 2bi ;
: consume/produce ( effect quot: ( inputs outputs -- ) -- )
'[ (consume/produce) @ ]
'[ [ in>> length consume-d ] [ out>> length produce-d ] bi @ ]
[ terminated?>> [ terminate ] when ]
bi ; inline
: apply-word/effect ( word effect -- )
swap '[ _ #call, ] consume/produce ;
: end-infer ( -- )
terminated? get [ check->r ] unless
meta-d clone #return, ;
: required-stack-effect ( word -- effect )
dup stack-effect [ ] [ missing-effect ] ?if ;
: apply-word/effect ( word effect -- )
swap '[ _ #call, ] consume/produce ;
: infer-word ( word -- )
{
{ [ dup macro? ] [ do-not-compile ] }

View File

@ -299,7 +299,7 @@ ERROR: custom-error ;
[ custom-error inference-error ] infer
] unit-test
[ T{ effect f 1 1 t } ] [
[ T{ effect f 1 2 t } ] [
[ dup [ 3 throw ] dip ] infer
] unit-test
@ -370,3 +370,5 @@ DEFER: eee'
[ [ cond ] infer ] must-fail
[ [ bi ] infer ] must-fail
[ at ] must-infer
[ [ [ "OOPS" throw ] dip ] [ drop ] if ] must-infer

View File

@ -42,7 +42,6 @@ SYMBOL: literals
: init-inference ( -- )
terminated? off
V{ } clone \ meta-d set
V{ } clone \ meta-r set
V{ } clone literals set
0 d-in set ;