From 7359873b60b425efad4f56a12df00c9bfd1189bf Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 24 Aug 2008 01:21:23 -0500
Subject: [PATCH] Minor compiler tweaks
---
basis/compiler/tree/checker/checker.factor | 6 ++++--
basis/compiler/tree/cleanup/cleanup-tests.factor | 5 +++++
basis/compiler/tree/optimizer/optimizer.factor | 6 +++---
basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor | 4 +++-
4 files changed, 15 insertions(+), 6 deletions(-)
diff --git a/basis/compiler/tree/checker/checker.factor b/basis/compiler/tree/checker/checker.factor
index 632412a6af..0f81e3805a 100644
--- a/basis/compiler/tree/checker/checker.factor
+++ b/basis/compiler/tree/checker/checker.factor
@@ -126,7 +126,9 @@ M: #r> check-stack-flow* [ check-in-r ] [ check-out-d ] bi ;
retainstack get empty? [ "Retain stack not empty" throw ] unless ;
M: #return check-stack-flow*
- check-in-d assert-datastack-empty assert-retainstack-empty ;
+ check-in-d
+ assert-datastack-empty
+ terminated? get [ assert-retainstack-empty ] unless ;
M: #enter-recursive check-stack-flow*
check-out-d ;
@@ -157,7 +159,7 @@ SYMBOL: branch-out
datastack [ clone ] change
V{ } clone retainstack set
(check-stack-flow)
- assert-retainstack-empty
+ terminated? get [ assert-retainstack-empty ] unless
terminated? get f datastack get ?
] with-scope ;
diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor
index 437112625c..8072a4229e 100644
--- a/basis/compiler/tree/cleanup/cleanup-tests.factor
+++ b/basis/compiler/tree/cleanup/cleanup-tests.factor
@@ -456,3 +456,8 @@ cell-bits 32 = [
[ [ 2array ] [ 0 3array ] if first ]
{ nth-unsafe < <= > >= } inlined?
] unit-test
+
+[ ] [
+ [ [ >r "A" throw r> ] [ "B" throw ] if ]
+ cleaned-up-tree drop
+] unit-test
diff --git a/basis/compiler/tree/optimizer/optimizer.factor b/basis/compiler/tree/optimizer/optimizer.factor
index 9dd2b9ec4c..5d0b8d089b 100644
--- a/basis/compiler/tree/optimizer/optimizer.factor
+++ b/basis/compiler/tree/optimizer/optimizer.factor
@@ -26,7 +26,7 @@ IN: compiler.tree.optimizer
compute-def-use
remove-dead-code
! strength-reduce
- USE: kernel
- compute-def-use
- dup check-nodes
+ ! USE: kernel
+ ! compute-def-use
+ ! dup check-nodes
;
diff --git a/basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor b/basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor
index 6abf323aed..97b4e2aee2 100644
--- a/basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor
+++ b/basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor
@@ -134,4 +134,6 @@ M: #alien-indirect unbox-tuples* dup in-d>> assert-not-unboxed ;
M: #alien-callback unbox-tuples* ;
-: unbox-tuples ( nodes -- nodes ) [ unbox-tuples* ] map-nodes ;
+: unbox-tuples ( nodes -- nodes )
+ allocations get escaping-allocations get assoc-diff assoc-empty?
+ [ [ unbox-tuples* ] map-nodes ] unless ;