From be4484d708ebe17a7127bf2b47e0c1cf9acb0011 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= Date: Fri, 18 Mar 2016 20:39:28 +0100 Subject: [PATCH] compiler.tree.*: fixes the propagation and dead-code removal logic so it becomes aware of integer-array-capacity --- .../tree/dead-code/simple/simple-docs.factor | 5 ++- .../tree/dead-code/simple/simple.factor | 6 +-- .../tree/propagation/info/info-tests.factor | 40 ++++++++++++++----- .../tree/propagation/info/info.factor | 17 ++++++++ .../propagation/simple/simple-tests.factor | 3 +- .../tree/propagation/simple/simple.factor | 31 +++++--------- 6 files changed, 66 insertions(+), 36 deletions(-) diff --git a/basis/compiler/tree/dead-code/simple/simple-docs.factor b/basis/compiler/tree/dead-code/simple/simple-docs.factor index 1f069b5bc6..6c967a34d5 100644 --- a/basis/compiler/tree/dead-code/simple/simple-docs.factor +++ b/basis/compiler/tree/dead-code/simple/simple-docs.factor @@ -1,4 +1,5 @@ -USING: compiler.tree help.markup help.syntax kernel sequences ; +USING: compiler.tree help.markup help.syntax kernel math sequences +strings ; IN: compiler.tree.dead-code.simple HELP: dead-flushable-call? @@ -11,4 +12,4 @@ HELP: filter-corresponding HELP: flushable-call? { $values { "#call" #call } { "?" "boolean" } } -{ $description { $link t } " if the call is flushable" } ; +{ $description { $link t } " if the call is flushable. To be flushable, two conditions must hold; first the word must have been declared flushable. Then, if it has any \"input-classes\" declared, all inputs to the word must fit within those classes. For example, if an input is a " { $link string } " and the declared input class is " { $link integer } ", it doesn't fit and the word is not flushable." } ; diff --git a/basis/compiler/tree/dead-code/simple/simple.factor b/basis/compiler/tree/dead-code/simple/simple.factor index 78ceb1f02f..a4df21392d 100644 --- a/basis/compiler/tree/dead-code/simple/simple.factor +++ b/basis/compiler/tree/dead-code/simple/simple.factor @@ -9,10 +9,10 @@ IN: compiler.tree.dead-code.simple : flushable-call? ( #call -- ? ) dup word>> dup flushable? [ - "input-classes" word-prop [ drop t ] [ + word>input-infos [ [ node-input-infos ] dip - [ [ class>> ] dip class<= ] 2all? - ] if-empty + [ value-info<= ] 2all? + ] [ drop t ] if* ] [ 2drop f ] if ; M: #call mark-live-values* diff --git a/basis/compiler/tree/propagation/info/info-tests.factor b/basis/compiler/tree/propagation/info/info-tests.factor index 6293d38bb2..a9541c5618 100644 --- a/basis/compiler/tree/propagation/info/info-tests.factor +++ b/basis/compiler/tree/propagation/info/info-tests.factor @@ -1,10 +1,12 @@ USING: accessors alien arrays byte-arrays classes.algebra -classes.struct compiler.tree.propagation.info kernel literals math -math.intervals sequences sequences.private tools.test ; +classes.struct compiler.tree.propagation.copy +compiler.tree.propagation.info io.encodings.utf8 kernel literals math +math.intervals namespaces sequences sequences.private tools.test ; IN: compiler.tree.propagation.info.tests { f } [ 0.0 -0.0 eql? ] unit-test +! value-info-intersect { t t } [ 0 10 [a,b] 5 20 [a,b] @@ -51,13 +53,6 @@ IN: compiler.tree.propagation.info.tests value-info-intersect ] unit-test -{ 3 t } [ - 3 - null-info value-info-union >literal< -] unit-test - -{ } [ { } value-infos-union drop ] unit-test - TUPLE: test-tuple { x read-only } ; { t } [ @@ -75,6 +70,30 @@ TUPLE: test-tuple { x read-only } ; [ interval>> 0 40 [a,b] = ] bi ] unit-test +! refine-value-info +{ + $[ fixnum array-capacity-interval ] +} [ + H{ { 1234 1234 } } copies set + { + H{ + { 1234 $[ fixnum ] } + } + } value-infos set + integer array-capacity-interval 1234 + refine-value-info + 1234 value-info +] unit-test + +! value-info-union + +{ 3 t } [ + 3 + null-info value-info-union >literal< +] unit-test + +{ } [ { } value-infos-union drop ] unit-test + ! interval>literal { 10 t } [ fixnum 10 10 [a,b] interval>literal @@ -193,6 +212,9 @@ TUPLE: tup2 < tup1 bar ; tup1 tup2 value-info<= ] unit-test +! +{ utf8 } [ utf8 class>> ] unit-test + ! init-interval { T{ value-info-state diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor index 6a4658f8d8..a530f2e4aa 100644 --- a/basis/compiler/tree/propagation/info/info.factor +++ b/basis/compiler/tree/propagation/info/info.factor @@ -86,10 +86,12 @@ UNION: fixed-length array byte-array string ; [ [ interval>> empty-interval eq? ] [ class>> real class<= ] bi and ] } 1|| ; +! Hardcoding classes is kind of a hack. : min-value ( class -- n ) { { fixnum [ most-negative-fixnum ] } { array-capacity [ 0 ] } + { integer-array-capacity [ 0 ] } [ drop -1/0. ] } case ; @@ -97,6 +99,7 @@ UNION: fixed-length array byte-array string ; { { fixnum [ most-positive-fixnum ] } { array-capacity [ max-array-capacity ] } + { integer-array-capacity [ max-array-capacity ] } [ drop 1/0. ] } case ; @@ -104,9 +107,16 @@ UNION: fixed-length array byte-array string ; { { fixnum [ fixnum-interval ] } { array-capacity [ array-capacity-interval ] } + { integer-array-capacity [ array-capacity-interval ] } [ drop full-interval ] } case ; +: fix-capacity-class ( class -- class' ) + { + { array-capacity fixnum } + { integer-array-capacity integer } + } ?at drop ; + : wrap-interval ( interval class -- interval' ) class-interval 2dup interval-subset? [ drop ] [ nip ] if ; @@ -125,6 +135,7 @@ UNION: fixed-length array byte-array string ; init-interval dup [ class>> ] [ interval>> ] bi interval>literal [ >>literal ] [ >>literal? ] bi* + [ fix-capacity-class ] change-class ] if ] if ; inline @@ -323,3 +334,9 @@ SYMBOL: value-infos dup in-d>> last node-value-info literal>> first immutable-tuple-class? ] [ drop f ] if ; + +: class-infos ( classes/f -- infos ) + [ ] map ; + +: word>input-infos ( word -- input-infos/f ) + "input-classes" word-prop class-infos ; diff --git a/basis/compiler/tree/propagation/simple/simple-tests.factor b/basis/compiler/tree/propagation/simple/simple-tests.factor index 06200acd68..fdddcfe494 100644 --- a/basis/compiler/tree/propagation/simple/simple-tests.factor +++ b/basis/compiler/tree/propagation/simple/simple-tests.factor @@ -37,8 +37,7 @@ IN: compiler.tree.propagation.simple.tests { } [ fixnum-value-infos setup-value-infos - #call-fixnum* dup word>> "input-classes" word-prop - propagate-input-classes + #call-fixnum* dup word>> word>input-infos propagate-input-infos ] unit-test { diff --git a/basis/compiler/tree/propagation/simple/simple.factor b/basis/compiler/tree/propagation/simple/simple.factor index ee6301e69e..2692767f39 100644 --- a/basis/compiler/tree/propagation/simple/simple.factor +++ b/basis/compiler/tree/propagation/simple/simple.factor @@ -1,14 +1,12 @@ ! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types arrays assocs classes -classes.algebra classes.algebra.private classes.maybe -classes.tuple.private combinators combinators.short-circuit -compiler.tree compiler.tree.propagation.constraints -compiler.tree.propagation.info -compiler.tree.propagation.inlining -compiler.tree.propagation.nodes compiler.tree.propagation.slots -continuations fry kernel sequences stack-checker.dependencies -words ; +USING: accessors alien.c-types arrays assocs classes classes.algebra +classes.algebra.private classes.maybe classes.tuple.private +combinators combinators.short-circuit compiler.tree +compiler.tree.propagation.constraints compiler.tree.propagation.info +compiler.tree.propagation.inlining compiler.tree.propagation.nodes +compiler.tree.propagation.slots continuations fry kernel +math.intervals sequences stack-checker.dependencies words ; IN: compiler.tree.propagation.simple M: #introduce propagate-before @@ -18,12 +16,9 @@ M: #push propagate-before [ literal>> ] [ out-d>> first ] bi set-value-info ; -: refine-value-infos ( classes values -- ) +: refine-value-infos ( classes/f values -- ) [ refine-value-info ] 2each ; -: class-infos ( classes -- infos ) - [ ] map ; - : set-value-infos ( infos values -- ) [ set-value-info ] 2each ; @@ -121,9 +116,6 @@ ERROR: invalid-outputs #call infos ; if ; : propagate-predicate ( #call word -- infos ) - ! We need to force the caller word to recompile when the class - ! is redefined, since now we're making assumptions but the - ! class definition itself. [ in-d>> first value-info ] [ "predicating" word-prop ] bi* [ nip add-depends-on-conditionally ] @@ -158,12 +150,11 @@ M: #call propagate-before M: #call annotate-node dup [ in-d>> ] [ out-d>> ] bi append (annotate-node) ; -: propagate-input-classes ( node input-classes -- ) - class-infos swap in-d>> refine-value-infos ; +: propagate-input-infos ( node infos/f -- ) + swap in-d>> refine-value-infos ; M: #call propagate-after - dup word>> "input-classes" word-prop dup - [ propagate-input-classes ] [ 2drop ] if ; + dup word>> word>input-infos propagate-input-infos ; : propagate-alien-invoke ( node -- ) [ out-d>> ] [ params>> return>> ] bi