Fixing wrappers with locals

basis/functors/functors-tests.factor

@@ -45,3 +45,21 @@ WHERE
 \ sqsq must-infer
 
 [ 16 ] [ 2 sqsq ] unit-test
+
+<<
+
+FUNCTOR: wrapper-test-2 ( W -- )
+
+W DEFINES ${W}
+
+WHERE
+
+: W ( a b -- c ) \ + execute ;
+
+;FUNCTOR
+
+"blah" wrapper-test-2
+
+>>
+
+[ 4 ] [ 1 3 blah ] unit-test

basis/functors/functors.factor

@@ -9,8 +9,9 @@ IN: functors
 
 ! This is a hack
 
-: scan-param ( -- obj )
+<PRIVATE
-    scan-object dup special? [ literalize ] unless ;
+
+: scan-param ( -- obj ) scan-object literalize ;
 
 : define* ( word def effect -- ) pick set-word define-declared ;
 
@@ -89,12 +90,16 @@ M: object fake-quotations> ;
     [ scan interpolate-locals ] dip
     '[ _ with-string-writer @ ] parsed ;
 
+PRIVATE>
+
 : IS [ dup search [ ] [ no-word ] ?if ] (INTERPOLATE) ; parsing
 
 : DEFINES [ create-in ] (INTERPOLATE) ; parsing
 
 DEFER: ;FUNCTOR delimiter
 
+<PRIVATE
+
 : functor-words ( -- assoc )
     H{
         { "TUPLE:" POSTPONE: `TUPLE: }
@@ -129,4 +134,6 @@ DEFER: ;FUNCTOR delimiter
     parse-functor-body swap pop-locals <lambda>
     rewrite-closures first ;
 
+PRIVATE>
+
 : FUNCTOR: (FUNCTOR:) define ; parsing

basis/locals/locals-docs.factor

@@ -113,7 +113,7 @@ HELP: MEMO::
 
 { POSTPONE: MEMO: POSTPONE: MEMO:: } related-words
 
-ARTICLE: "locals-literals" "Locals in array and hashtable literals"
+ARTICLE: "locals-literals" "Locals in literals"
 "Certain data type literals are permitted to contain free variables. Any such literals are written into code which constructs an instance of the type with the free variable values spliced in. Conceptually, this is similar to the transformation applied to quotations containing free variables."
 $nl
 "The data types which receive this special handling are the following:"
@@ -122,7 +122,9 @@ $nl
     { $link "hashtables" }
     { $link "vectors" }
     { $link "tuples" }
+    { $link "wrappers" }
 }
+{ $heading "Object identity" }
 "This feature changes the semantics of literal object identity. An ordinary word containing a literal pushes the same literal on the stack every time it is invoked:"
 { $example
     "IN: scratchpad"
@@ -143,7 +145,7 @@ $nl
     "f"
 }
 "One exception to the above rule is that array instances containing no free variables do retain identity. This allows macros such as " { $link cond } " to recognize that the array is constant and expand at compile-time."
-$nl
+{ $heading "Example" }
 "For example, here is an implementation of the " { $link 3array } " word which uses this feature:"
 { $code ":: 3array ( x y z -- array ) { x y z } ;" } ;
 

basis/locals/locals-tests.factor

@@ -497,3 +497,7 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
 [ 10 ] [ [let | a [ 10 ] | [let | b [ a ] | b ] ] ] unit-test
 
 [ { \ + } ] [ [let | x [ \ + ] | { \ x } ] ] unit-test
+
+[ { \ + 3 } ] [ [let | a [ 3 ] | { \ + a } ] ] unit-test
+
+[ 3 ] [ [let | a [ \ + ] | 1 2 [ \ a execute ] ] call ] unit-test

basis/locals/rewrite/sugar/sugar.factor

@@ -81,10 +81,14 @@ M: local-writer rewrite-element
 M: local-word rewrite-element
     local-word-in-literal-error ;
 
-M: word rewrite-element literalize , ;
+M: word rewrite-element <wrapper> , ;
+
+: rewrite-wrapper ( wrapper -- )
+    dup rewrite-literal?
+    [ wrapped>> rewrite-element ] [ , ] if ;
 
 M: wrapper rewrite-element
-    dup rewrite-literal? [ wrapped>> rewrite-element \ literalize , ] [ , ] if ;
+    rewrite-wrapper \ <wrapper> , ;
 
 M: object rewrite-element , ;
 
@@ -99,7 +103,7 @@ M: def rewrite-sugar* , ;
 M: hashtable rewrite-sugar* rewrite-element ;
 
 M: wrapper rewrite-sugar*
-    dup rewrite-literal? [ wrapped>> rewrite-element ] [ , ] if ;
+    rewrite-wrapper ;
 
 M: word rewrite-sugar*
     dup { load-locals get-local drop-locals } memq?

basis/locals/types/types.factor

@@ -1,6 +1,7 @@
-! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! Copyright (C) 2007, 2009 Slava Pestov, Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators kernel sequences words ;
+USING: accessors combinators kernel sequences words
+quotations ;
 IN: locals.types
 
 TUPLE: lambda vars body ;
@@ -38,6 +39,8 @@ PREDICATE: local < word "local?" word-prop ;
     f <word>
     dup t "local?" set-word-prop ;
 
+M: local literalize ;
+
 PREDICATE: local-word < word "local-word?" word-prop ;
 
 : <local-word> ( name -- word )
@@ -49,6 +52,8 @@ PREDICATE: local-reader < word "local-reader?" word-prop ;
     f <word>
     dup t "local-reader?" set-word-prop ;
 
+M: local-reader literalize ;
+
 PREDICATE: local-writer < word "local-writer?" word-prop ;
 
 : <local-writer> ( reader -- word )

basis/specialized-arrays/functor/functor.factor

@@ -64,7 +64,7 @@ M: A resize
 
 M: A byte-length underlying>> length ;
 
-M: A pprint-delims drop A{ \ } ;
+M: A pprint-delims drop \ A{ \ } ;
 
 M: A >pprint-sequence ;
 

core/quotations/quotations-docs.factor

@@ -14,6 +14,10 @@ $nl
 "Quotations implement the " { $link "sequence-protocol" } ", and existing sequences can be converted into quotations:"
 { $subsection >quotation }
 { $subsection 1quotation }
+"Wrappers:"
+{ $subsection "wrappers" } ;
+
+ARTICLE: "wrappers" "Wrappers"
 "Wrappers are used to push words on the data stack; they evaluate to the object being wrapped:"
 { $subsection wrapper }
 { $subsection literalize }

core/syntax/syntax.factor

@@ -103,7 +103,7 @@ IN: bootstrap.syntax
     "W{" [ \ } [ first <wrapper> ] parse-literal ] define-syntax
 
     "POSTPONE:" [ scan-word parsed ] define-syntax
-    "\\" [ scan-word literalize parsed ] define-syntax
+    "\\" [ scan-word <wrapper> parsed ] define-syntax
     "inline" [ word make-inline ] define-syntax
     "recursive" [ word make-recursive ] define-syntax
     "foldable" [ word make-foldable ] define-syntax