From ab61e5cd8c599bdeb5c6511119d1238e724d79d4 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 20 Oct 2008 05:56:13 -0500
Subject: [PATCH] Fix performance problem

---
 core/classes/tuple/tuple.factor | 26 ++++++++++++--------------
 1 file changed, 12 insertions(+), 14 deletions(-)

diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index 577ad133e1..8cde049524 100644
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -102,8 +102,8 @@ ERROR: bad-superclass class ;
     dup dup tuple-layout echelon>>
     [ tuple-instance? ] 2curry define-predicate ;
 
-: superclass-size ( class -- n )
-    superclasses but-last [ "slots" word-prop length ] sigma ;
+: class-size ( class -- n )
+    superclasses [ "slots" word-prop length ] sigma ;
 
 : (instance-check-quot) ( class -- quot )
     [
@@ -138,16 +138,12 @@ ERROR: bad-superclass class ;
 : define-tuple-prototype ( class -- )
     dup tuple-prototype "prototype" set-word-prop ;
 
-: finalize-tuple-slots ( class slots -- slots )
-    swap superclass-size 2 + finalize-slots ;
-
 : define-tuple-slots ( class -- )
-    dup dup "slots" word-prop finalize-tuple-slots
-    define-accessors ;
+    dup "slots" word-prop define-accessors ;
 
 : make-tuple-layout ( class -- layout )
     [ ]
-    [ [ superclass-size ] [ "slots" word-prop length ] bi + ]
+    [ [ superclass class-size ] [ "slots" word-prop length ] bi + ]
     [ superclasses dup length 1- ] tri
     <tuple-layout> ;
 
@@ -208,7 +204,6 @@ M: tuple-class update-class
     } cleave ;
 
 : define-new-tuple-class ( class superclass slots -- )
-    make-slots
     [ drop f f tuple-class define-class ]
     [ nip "slots" set-word-prop ]
     [ 2drop update-classes ]
@@ -241,16 +236,19 @@ M: tuple-class update-class
 : check-superclass ( superclass -- )
     dup valid-superclass? [ bad-superclass ] unless drop ;
 
+GENERIC# (define-tuple-class) 2 ( class superclass slots -- )
+
 PRIVATE>
 
-GENERIC# define-tuple-class 2 ( class superclass slots -- )
-
-M: word define-tuple-class
+: define-tuple-class ( class superclass slots -- )
     over check-superclass
+    make-slots over class-size 2 + finalize-slots
+    (define-tuple-class) ;
+
+M: word (define-tuple-class)
     define-new-tuple-class ;
 
-M: tuple-class define-tuple-class
-    over check-superclass
+M: tuple-class (define-tuple-class)
     3dup tuple-class-unchanged?
     [ 3drop ] [ redefine-tuple-class ] if ;