From 2cc40052bfeffb82a31f76a005ace9c6e3e6249d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 13 Sep 2008 03:06:36 -0500
Subject: [PATCH] Rewrite locals-in-literals in idiomatic Factor, and fix a
 performance regression with locals in tuples

---
 basis/locals/locals-tests.factor |  4 +-
 basis/locals/locals.factor       | 93 +++++++++++---------------------
 2 files changed, 35 insertions(+), 62 deletions(-)

diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor
index 59ec325f39..eb06d05146 100755
--- a/basis/locals/locals-tests.factor
+++ b/basis/locals/locals-tests.factor
@@ -329,4 +329,6 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
 [ 10 20 30 [| a b c | H{ { a "a" } { b "b" } { c "c" } } ] call ] unit-test
 
 [ T{ slice f 0 3 "abc" } ]
-[ 0 3 "abc" [| from to seq | T{ slice f from to seq } ] call ] unit-test
\ No newline at end of file
+[ 0 3 "abc" [| from to seq | T{ slice f from to seq } ] call ] unit-test
+
+{ 3 1 } [| from to seq | T{ slice f from to seq } ] must-infer-as
\ No newline at end of file
diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor
index bfc92ee9e2..05ea3cb524 100755
--- a/basis/locals/locals.factor
+++ b/basis/locals/locals.factor
@@ -6,7 +6,7 @@ quotations debugger macros arrays macros splitting combinators
 prettyprint.backend definitions prettyprint hashtables
 prettyprint.sections sets sequences.private effects
 effects.parser generic generic.parser compiler.units accessors
-locals.backend memoize macros.expander lexer
+locals.backend memoize macros.expander lexer classes
 stack-checker.known-words ;
 IN: locals
 
@@ -195,70 +195,41 @@ M: block lambda-rewrite*
         swap point-free ,
     ] keep length \ curry <repetition> % ;
 
+GENERIC: rewrite-element ( obj -- )
+
+: rewrite-elements ( seq -- )
+    [ rewrite-element ] each ;
+
+: rewrite-sequence ( seq -- )
+    [ rewrite-elements ] [ length , ] [ , ] tri \ nsequence , ;
+
+M: array rewrite-element rewrite-sequence ;
+
+M: vector rewrite-element rewrite-sequence ;
+
+M: hashtable rewrite-element >alist rewrite-sequence \ >hashtable , ;
+
+M: tuple rewrite-element
+    [ tuple-slots rewrite-elements ] [ class , ] bi \ boa , ;
+
+M: local rewrite-element , ;
+
+M: word rewrite-element literalize , ;
+
+M: object rewrite-element , ;
+
+M: array local-rewrite* rewrite-element ;
+
+M: vector local-rewrite* rewrite-element ;
+
+M: tuple local-rewrite* rewrite-element ;
+
+M: hashtable local-rewrite* rewrite-element ;
+
 M: object lambda-rewrite* , ;
 
 M: object local-rewrite* , ;
 
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-! Broil is used to support locals in literals
-
-DEFER: [broil]
-DEFER: [broil-hashtable]
-DEFER: [broil-tuple]
-
-: broil-element ( obj -- quot )
-  {
-    { [ dup number?    ] [            1quotation ] }
-    { [ dup string?    ] [            1quotation ] }
-    { [ dup sequence?  ] [ [broil]               ] }
-    { [ dup hashtable? ] [ [broil-hashtable]     ] }
-    { [ dup tuple?     ] [ [broil-tuple]         ] }
-    { [ dup local?     ] [            1quotation ] }
-    { [ dup word?      ] [ literalize 1quotation ] }
-    { [ t              ] [            1quotation ] }
-  }
-  cond ;
-
-: [broil] ( seq -- quot )
-  [ [ broil-element ] map concat >quotation ]
-  [ length ]
-  [        ]
-  tri
-  [ nsequence ] curry curry compose ;
-  
-MACRO: broil ( seq -- quot ) [broil] ;
-
-: [broil-hashtable] ( hashtable -- quot )
-  >alist
-  [ [ broil-element ] map concat >quotation ]
-  [ length ]
-  [        ]
-  tri
-  [ nsequence >hashtable ] curry curry compose ;
-
-MACRO: broil-hashtable ( hashtable -- quot ) [broil-hashtable] ;
-
-: [broil-tuple] ( tuple -- quot )
-  tuple>array
-  [ [ broil-element ] map concat >quotation ]
-  [ length ]
-  [        ]
-  tri
-  [ nsequence >tuple ] curry curry compose ;
-
-MACRO: broil-tuple ( tuple -- quot ) [broil-tuple] ;
-
-! Engage broil on arrays and vectors. Can't do it on 'sequence'
-! because that will pick up strings and integers. What do do...
-
-M: array     local-rewrite* ( array      -- ) [broil]           % ;
-M: vector    local-rewrite* ( vector     -- ) [broil]           % ;
-M: tuple     local-rewrite* ( tuple      -- ) [broil-tuple]     % ;
-M: hashtable local-rewrite* ( hashtable  -- ) [broil-hashtable] % ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
 : make-local ( name -- word )
     "!" ?tail [
         <local-reader>