Merge branch 'master' into global_optimization

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 ;

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 ;
 

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+ <repetition> ] dip append ] [ 3drop f ] if ;
+    ! Introduced values can be anything, and don't unify with
+    ! literals.
+    dup [ [ - +top+ <repetition> ] 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

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 -- )

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
+[ [ [ "OOPS" throw ] dip ] [ drop ] if ] must-infer
+
+! Found during code review
+[ [ [ drop [ ] ] when call ] infer ] must-fail
+[ swap [ [ drop [ ] ] when call ] infer ] must-fail

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' ) <repetition> >quotation ;
+: compose-n-quot ( n word -- quot' ) <repetition> >quotation ;
 \ compose-n [ compose-n-quot ] 2 define-transform
 \ compose-n t "no-compile" set-word-prop
 >>