]> gitweb.factorcode.org Git - factor.git/commitdiff
Better handling of wrappers in locals
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Wed, 28 Jan 2009 21:04:36 +0000 (15:04 -0600)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Wed, 28 Jan 2009 21:04:36 +0000 (15:04 -0600)
basis/locals/locals-tests.factor
basis/locals/rewrite/sugar/sugar.factor

index 982674694aae097cbc66fa8e07c68faa7a81408d..e3aa504fbc8ef342a7381982189b0f297f6a08f3 100644 (file)
@@ -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
index 835fa6e421818b5dc36c58cbef94d758b6166be1..6e7e156ced4c99c45c03adf3a6a850e90e51444d 100644 (file)
@@ -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?