From f438bd5157f32c4dea0d6c5220ae9492fc3a1fb4 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 28 Jan 2009 15:04:36 -0600
Subject: [PATCH] Better handling of wrappers in locals

---
 basis/locals/locals-tests.factor        |  4 +++-
 basis/locals/rewrite/sugar/sugar.factor | 11 ++++++-----
 2 files changed, 9 insertions(+), 6 deletions(-)

diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor
index 982674694a..e3aa504fbc 100644
--- a/basis/locals/locals-tests.factor
+++ b/basis/locals/locals-tests.factor
@@ -494,4 +494,6 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
 
 ! Discovered by littledan
 [ "bar" ] [ [let | a [ [let | foo [ "bar" ] | foo ] ] | a ] ] unit-test
-[ 10 ] [ [let | a [ 10 ] | [let | b [ a ] | b ] ] ] unit-test
\ No newline at end of file
+[ 10 ] [ [let | a [ 10 ] | [let | b [ a ] | b ] ] ] unit-test
+
+[ { \ + } ] [ [let | x [ \ + ] | { \ x } ] ] unit-test
\ No newline at end of file
diff --git a/basis/locals/rewrite/sugar/sugar.factor b/basis/locals/rewrite/sugar/sugar.factor
index 835fa6e421..6e7e156ced 100644
--- a/basis/locals/rewrite/sugar/sugar.factor
+++ b/basis/locals/rewrite/sugar/sugar.factor
@@ -37,7 +37,7 @@ M: array rewrite-literal? [ rewrite-literal? ] contains? ;
 
 M: quotation rewrite-literal? [ rewrite-literal? ] contains? ;
 
-M: wrapper rewrite-literal? drop t ;
+M: wrapper rewrite-literal? wrapped>> rewrite-literal? ;
 
 M: hashtable rewrite-literal? drop t ;
 
@@ -53,7 +53,7 @@ GENERIC: rewrite-element ( obj -- )
     [ rewrite-element ] each ;
 
 : rewrite-sequence ( seq -- )
-    [ rewrite-elements ] [ length , ] [ 0 head , ] tri \ nsequence , ;
+    [ rewrite-elements ] [ length ] [ 0 head ] tri '[ _ _ nsequence ] % ;
 
 M: array rewrite-element
     dup rewrite-literal? [ rewrite-sequence ] [ , ] if ;
@@ -63,7 +63,7 @@ M: vector rewrite-element rewrite-sequence ;
 M: hashtable rewrite-element >alist rewrite-sequence \ >hashtable , ;
 
 M: tuple rewrite-element
-    [ tuple-slots rewrite-elements ] [ class literalize , ] bi \ boa , ;
+    [ tuple-slots rewrite-elements ] [ class ] bi '[ _ boa ] % ;
 
 M: quotation rewrite-element rewrite-sugar* ;
 
@@ -84,7 +84,7 @@ M: local-word rewrite-element
 M: word rewrite-element literalize , ;
 
 M: wrapper rewrite-element
-    dup rewrite-literal? [ wrapped>> rewrite-element ] [ , ] if ;
+    dup rewrite-literal? [ wrapped>> rewrite-element \ literalize , ] [ , ] if ;
 
 M: object rewrite-element , ;
 
@@ -98,7 +98,8 @@ M: def rewrite-sugar* , ;
 
 M: hashtable rewrite-sugar* rewrite-element ;
 
-M: wrapper rewrite-sugar* rewrite-element ;
+M: wrapper rewrite-sugar*
+    dup rewrite-literal? [ wrapped>> rewrite-element ] [ , ] if ;
 
 M: word rewrite-sugar*
     dup { load-locals get-local drop-locals } memq?