From 7744559a46393b467d595e812eaf92e7340d2453 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 10 Mar 2010 15:15:49 +1300
Subject: [PATCH] compiler.tree.propagation: clean up
---
.../tree/propagation/info/info.factor | 21 ++++++++-----------
.../tree/propagation/slots/slots.factor | 2 +-
2 files changed, 10 insertions(+), 13 deletions(-)
diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor
index b154845c07..22ea1306d6 100644
--- a/basis/compiler/tree/propagation/info/info.factor
+++ b/basis/compiler/tree/propagation/info/info.factor
@@ -47,9 +47,7 @@ CONSTANT: object-info T{ value-info f object full-interval }
{ [ over interval-length 0 > ] [ 3drop f f ] }
{ [ pick bignum class<= ] [ 2nip >bignum t ] }
{ [ pick integer class<= ] [ 2nip >fixnum t ] }
- { [ pick float class<= ] [
- 2nip dup zero? [ drop f f ] [ >float t ] if
- ] }
+ { [ pick float class<= ] [ 2nip dup zero? [ drop f f ] [ >float t ] if ] }
[ 3drop f f ]
} cond
] if ;
@@ -73,9 +71,11 @@ UNION: fixed-length array byte-array string ;
] unless
] unless ;
-: length-slots ( length class -- slots )
- "slots" word-prop length 1 - f <array>
- swap prefix ;
+: (slots-with-length) ( length class -- slots )
+ "slots" word-prop length 1 - f <array> swap prefix ;
+
+: slots-with-length ( seq -- slots )
+ [ length <literal-info> ] [ class ] bi (slots-with-length) ;
: init-literal-info ( info -- info )
empty-interval >>interval
@@ -83,10 +83,7 @@ UNION: fixed-length array byte-array string ;
dup literal>> {
{ [ dup real? ] [ [a,a] >>interval ] }
{ [ dup tuple? ] [ tuple-slot-infos >>slots ] }
- { [ dup fixed-length? ] [
- [ length <literal-info> ] [ class ] bi
- length-slots >>slots
- ] }
+ { [ dup fixed-length? ] [ slots-with-length >>slots ] }
[ drop ]
} cond ; inline
@@ -164,10 +161,10 @@ UNION: fixed-length array byte-array string ;
t >>literal?
init-value-info ; foldable
-: <sequence-info'> ( length class -- info )
+: <sequence-info> ( length class -- info )
<value-info>
over >>class
- [ length-slots ] dip swap >>slots
+ [ (slots-with-length) ] dip swap >>slots
init-value-info ;
: <tuple-info> ( slots class -- info )
diff --git a/basis/compiler/tree/propagation/slots/slots.factor b/basis/compiler/tree/propagation/slots/slots.factor
index 6429928294..2602d6d59a 100644
--- a/basis/compiler/tree/propagation/slots/slots.factor
+++ b/basis/compiler/tree/propagation/slots/slots.factor
@@ -23,7 +23,7 @@ IN: compiler.tree.propagation.slots
: propagate-sequence-constructor ( #call word -- infos )
[ in-d>> first value-info ]
[ constructor-output-class ] bi*
- <sequence-info'> 1array ;
+ <sequence-info> 1array ;
: fold-<tuple-boa> ( values class -- info )
[ [ literal>> ] map ] dip prefix >tuple