From a8f0c9dc6b71035d7bcdbe7e4d938ec62b250eff Mon Sep 17 00:00:00 2001
From: timor <timor.dd@googlemail.com>
Date: Thu, 29 Jul 2021 23:19:47 +0200
Subject: [PATCH] compiler.tree.propagation: Propagate length slot of primitive
 resize calls

---
 .../known-words/known-words.factor            | 13 ++++++++++
 .../tree/propagation/propagation-tests.factor | 26 +++++++++++++++++--
 2 files changed, 37 insertions(+), 2 deletions(-)

diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor
index 5c54c9f56e..dad34ccf3e 100644
--- a/basis/compiler/tree/propagation/known-words/known-words.factor
+++ b/basis/compiler/tree/propagation/known-words/known-words.factor
@@ -391,3 +391,16 @@ generic-comparison-ops [
 \ tag [
     drop fixnum 0 num-types get [a,b) <class/interval-info>
 ] "outputs" set-word-prop
+
+! Primitive resize operations
+
+: propagate-resize-fixed-length-sequence ( n-info in-info class -- out-info )
+    nip <sequence-info> ;
+
+{ { resize-array array }
+  { resize-byte-array byte-array }
+  { resize-string string } }
+[
+    [ propagate-resize-fixed-length-sequence ] curry
+    "outputs" set-word-prop
+] assoc-each
diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index 33321734c3..5a4b3dffc8 100644
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -35,6 +35,15 @@ IN: compiler.tree.propagation.tests
     [ dup "foo" <array> drop ] final-info first
 ] unit-test
 
+{ t } [
+    [ resize-array length ] final-info first
+    array-capacity <class-info> =
+] unit-test
+
+{ 42 } [
+    [ 42 swap resize-array length ] final-literals first
+] unit-test
+
 ! Byte arrays
 { V{ 3 } } [
     [ 3 <byte-array> length ] final-literals
@@ -46,8 +55,12 @@ IN: compiler.tree.propagation.tests
 ] unit-test
 
 { t } [
-    [ dupd resize-byte-array drop ] final-info first
-    integer-array-capacity <class-info> =
+    [ resize-byte-array length ] final-info first
+    array-capacity <class-info> =
+] unit-test
+
+{ 43 } [
+    [ 43 swap resize-byte-array length ] final-literals first
 ] unit-test
 
 ! Strings
@@ -55,6 +68,15 @@ IN: compiler.tree.propagation.tests
     [ 3 f <string> length ] final-literals
 ] unit-test
 
+{ t } [
+    [ resize-string length ] final-info first
+    array-capacity <class-info> =
+] unit-test
+
+{ V{ 44 } } [
+    [ 44 swap resize-string length ] final-literals
+] unit-test
+
 { V{ t } } [
     [ { string } declare string? ] final-classes
 ] unit-test
-- 
2.34.1