compiler.tree.propagation: Eliminate redundant resize calls

Resizing an array or other primitive sequence to the exisiting length is a no-op.

diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index 5a4b3dffc81d4ef5bc008f706291a706b194ceaa..e8fdf70bc251894d95b0471c58ddd3c806a41bed 100644 (file)
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -44,6 +44,22 @@ IN: compiler.tree.propagation.tests
     [ 42 swap resize-array length ] final-literals first
 ] unit-test
 
+{ f } [
+    [ resize-array ] { resize-array } inlined?
+] unit-test
+
+{ t } [
+    [ 3 { 1 2 3 } resize-array ] { resize-array } inlined?
+] unit-test
+
+{ f } [
+    [ 4 { 1 2 3 } resize-array ] { resize-array } inlined?
+] unit-test
+
+{ f } [
+    [ 4 swap { array } declare resize-array ] { resize-array } inlined?
+] unit-test
+
 ! Byte arrays
 { V{ 3 } } [
     [ 3 <byte-array> length ] final-literals
@@ -63,6 +79,10 @@ IN: compiler.tree.propagation.tests
     [ 43 swap resize-byte-array length ] final-literals first
 ] unit-test
 
+{ t } [
+    [ 3 B{ 1 2 3 } resize-byte-array ] { resize-byte-array } inlined?
+] unit-test
+
 ! Strings
 { V{ 3 } } [
     [ 3 f <string> length ] final-literals
@@ -77,6 +97,10 @@ IN: compiler.tree.propagation.tests
     [ 44 swap resize-string length ] final-literals
 ] unit-test
 
+{ t } [
+    [ 3 "123" resize-string ] { resize-string } inlined?
+] unit-test
+
 { V{ t } } [
     [ { string } declare string? ] final-classes
 ] unit-test

diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor
index 8a42872065a77c03400e43720a29810d12820fdd..fcecff5a06e461de7cbe340c566f0c64f02ff033 100644 (file)
--- a/basis/compiler/tree/propagation/transforms/transforms.factor
+++ b/basis/compiler/tree/propagation/transforms/transforms.factor
@@ -1,14 +1,12 @@
 ! Copyright (C) 2008, 2011 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types assocs classes classes.algebra
-classes.tuple classes.tuple.private combinators
-combinators.short-circuit compiler.tree.propagation.info effects
-fry generalizations generic generic.single growable hash-sets
-hashtables kernel layouts locals math math.integers.private
-math.intervals math.order math.partial-dispatch math.private
-namespaces quotations sequences sequences.generalizations
-sequences.private sets sets.private stack-checker
-stack-checker.dependencies vectors words ;
+USING: accessors alien.c-types arrays assocs byte-arrays classes classes.algebra
+classes.tuple classes.tuple.private combinators combinators.short-circuit
+compiler.tree.propagation.info effects generalizations generic generic.single
+growable hash-sets hashtables kernel layouts math math.integers.private
+math.intervals math.order math.partial-dispatch math.private namespaces
+quotations sequences sequences.generalizations sequences.private sets
+sets.private stack-checker stack-checker.dependencies strings vectors words ;
 FROM: math => float ;
 IN: compiler.tree.propagation.transforms
 
@@ -353,3 +351,13 @@ M\ sets:set intersects? [ intersects?-quot ] 1 define-partial-eval
         [ f ]
     } cond 2nip
 ] "custom-inlining" set-word-prop
+
+: constant-number-info? ( info -- ? )
+    { [ value-info-state? ] [ literal?>> ] [ class>> integer class<= ] } 1&& ;
+
+! Resize-sequences to existing length can be optimized out
+{ resize-array resize-string resize-byte-array } [
+    in-d>> first2 [ value-info ] bi@ slots>> ?first
+    { [ [ constant-number-info? ] both? ] [ [ literal>> ] bi@ = ] } 2&&
+    [ [ nip ] ] [ f ] if
+] [ "custom-inlining" set-word-prop ] curry each