diff --git a/basis/compiler/tree/normalization/normalization.factor b/basis/compiler/tree/normalization/normalization.factor index 7494ed064e..fcfa42c70b 100644 --- a/basis/compiler/tree/normalization/normalization.factor +++ b/basis/compiler/tree/normalization/normalization.factor @@ -60,7 +60,7 @@ M: #branch normalize* : eliminate-phi-introductions ( introductions seq terminated -- seq' ) [ [ nip ] [ - dup [ +bottom+ eq? ] trim-head + dup [ +top+ eq? ] trim-head [ [ length ] bi@ - tail* ] keep append ] if ] 3map ; diff --git a/basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor b/basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor index 107ea59902..6bed4407b8 100755 --- a/basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor +++ b/basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor @@ -91,6 +91,8 @@ M: #terminate unbox-tuples* [ flatten-values ] change-in-r ; M: #phi unbox-tuples* + ! pad-with-bottom is only needed if some branches are terminated, + ! which means all output values are bottom [ [ flatten-values ] map pad-with-bottom ] change-phi-in-d [ flatten-values ] change-out-d ; diff --git a/basis/stack-checker/branches/branches.factor b/basis/stack-checker/branches/branches.factor index 690af39c28..8b0665aa49 100755 --- a/basis/stack-checker/branches/branches.factor +++ b/basis/stack-checker/branches/branches.factor @@ -9,12 +9,16 @@ IN: stack-checker.branches : balanced? ( pairs -- ? ) [ second ] filter [ first2 length - ] map all-equal? ; -SYMBOL: +bottom+ +SYMBOLS: +bottom+ +top+ ; : unify-inputs ( max-d-in d-in meta-d -- new-meta-d ) - dup [ [ - +bottom+ ] dip append ] [ 3drop f ] if ; + ! Introduced values can be anything, and don't unify with + ! literals. + dup [ [ - +top+ ] dip append ] [ 3drop f ] if ; : pad-with-bottom ( seq -- newseq ) + ! Terminated branches are padded with bottom values which + ! unify with literals. dup empty? [ dup [ length ] [ max ] map-reduce '[ _ +bottom+ pad-head ] map diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 70382c0829..cf2d08b84f 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -219,8 +219,6 @@ M: object infer-call* \ compose f "no-compile" set-word-prop ! More words not to compile -\ call t "no-compile" set-word-prop -\ execute t "no-compile" set-word-prop \ clear t "no-compile" set-word-prop : non-inline-word ( word -- ) diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor index 201f3ce30b..b84f561861 100644 --- a/basis/stack-checker/stack-checker-tests.factor +++ b/basis/stack-checker/stack-checker-tests.factor @@ -371,4 +371,8 @@ DEFER: eee' [ [ bi ] infer ] must-fail [ at ] must-infer -[ [ [ "OOPS" throw ] dip ] [ drop ] if ] must-infer \ No newline at end of file +[ [ [ "OOPS" throw ] dip ] [ drop ] if ] must-infer + +! Found during code review +[ [ [ drop [ ] ] when call ] infer ] must-fail +[ swap [ [ drop [ ] ] when call ] infer ] must-fail \ No newline at end of file diff --git a/basis/stack-checker/transforms/transforms-tests.factor b/basis/stack-checker/transforms/transforms-tests.factor index fe0fa08356..843083bd52 100644 --- a/basis/stack-checker/transforms/transforms-tests.factor +++ b/basis/stack-checker/transforms/transforms-tests.factor @@ -6,7 +6,7 @@ classes classes.tuple ; : compose-n ( quot n -- ) "OOPS" throw ; << -: compose-n-quot ( word n -- quot' ) >quotation ; +: compose-n-quot ( n word -- quot' ) >quotation ; \ compose-n [ compose-n-quot ] 2 define-transform \ compose-n t "no-compile" set-word-prop >>