diff --git a/basis/compiler/cfg/utilities/utilities.factor b/basis/compiler/cfg/utilities/utilities.factor index 4b0468b911..2be805bd20 100644 --- a/basis/compiler/cfg/utilities/utilities.factor +++ b/basis/compiler/cfg/utilities/utilities.factor @@ -5,21 +5,6 @@ compiler.cfg compiler.cfg.instructions cpu.architecture kernel layouts locals make math namespaces sequences sets vectors fry ; IN: compiler.cfg.utilities -: value-info-small-fixnum? ( value-info -- ? ) - literal>> { - { [ dup fixnum? ] [ tag-fixnum small-enough? ] } - [ drop f ] - } cond ; - -: value-info-small-tagged? ( value-info -- ? ) - dup literal?>> [ - literal>> { - { [ dup fixnum? ] [ tag-fixnum small-enough? ] } - { [ dup not ] [ drop t ] } - [ drop f ] - } cond - ] [ drop f ] if ; - PREDICATE: kill-block < basic-block instructions>> { [ length 2 = ] @@ -59,3 +44,9 @@ SYMBOL: visited swap >vector \ ##branch new-insn over push >>instructions ; + +: has-phis? ( bb -- ? ) + instructions>> first ##phi? ; + +: if-has-phis ( bb quot: ( bb -- ) -- ) + [ dup has-phis? ] dip [ drop ] if ; inline diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor index 816368466f..f45fc2e18a 100644 --- a/basis/compiler/tree/propagation/info/info.factor +++ b/basis/compiler/tree/propagation/info/info.factor @@ -306,3 +306,18 @@ SYMBOL: value-infos dup in-d>> last node-value-info literal>> first immutable-tuple-class? ] [ drop f ] if ; + +: value-info-small-fixnum? ( value-info -- ? ) + literal>> { + { [ dup fixnum? ] [ tag-fixnum small-enough? ] } + [ drop f ] + } cond ; + +: value-info-small-tagged? ( value-info -- ? ) + dup literal?>> [ + literal>> { + { [ dup fixnum? ] [ tag-fixnum small-enough? ] } + { [ dup not ] [ drop t ] } + [ drop f ] + } cond + ] [ drop f ] if ;