Fixing wrappers with locals

diff --git a/basis/functors/functors-tests.factor b/basis/functors/functors-tests.factor
index 577debd398e5242e76556a841dab42e9778f9655..a5f3042b38e6eaf669e50689e0f1a1521e7937f8 100644 (file)
--- a/basis/functors/functors-tests.factor
+++ b/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
\ No newline at end of file

diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor
index b13ee8ff7cc990b6ccef976f8a23c7901d877bcc..f4d35b6932ae09b1403711494516d735c43aea2f 100644 (file)
--- a/basis/functors/functors.factor
+++ b/basis/functors/functors.factor
@@ -9,8 +9,9 @@ IN: functors
 
 ! This is a hack
 
-: scan-param ( -- obj )
-    scan-object dup special? [ literalize ] unless ;
+<PRIVATE
+
+: 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

diff --git a/basis/locals/locals-docs.factor b/basis/locals/locals-docs.factor
index efaad748cf634dd290beb7eda92b4913e29fba95..a4a9ca448bdd756743c3227c68ca0ea076042769 100644 (file)
--- a/basis/locals/locals-docs.factor
+++ b/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 } ;" } ;
 

diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor
index e3aa504fbc8ef342a7381982189b0f297f6a08f3..bd9e7cf1030f097fcd5cd7254faa60abc917fa98 100644 (file)
--- a/basis/locals/locals-tests.factor
+++ b/basis/locals/locals-tests.factor
@@ -496,4 +496,8 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
 [ "bar" ] [ [let | a [ [let | foo [ "bar" ] | foo ] ] | a ] ] unit-test
 [ 10 ] [ [let | a [ 10 ] | [let | b [ a ] | b ] ] ] unit-test
 
-[ { \ + } ] [ [let | x [ \ + ] | { \ x } ] ] unit-test
\ No newline at end of file
+[ { \ + } ] [ [let | x [ \ + ] | { \ x } ] ] unit-test
+
+[ { \ + 3 } ] [ [let | a [ 3 ] | { \ + a } ] ] unit-test
+
+[ 3 ] [ [let | a [ \ + ] | 1 2 [ \ a execute ] ] call ] 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 6e7e156ced4c99c45c03adf3a6a850e90e51444d..515473c467c83db87bcb00b29b7c1caf2317b723 100644 (file)
--- a/basis/locals/rewrite/sugar/sugar.factor
+++ b/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?

diff --git a/basis/locals/types/types.factor b/basis/locals/types/types.factor
index 7a8dac19472e2007101e0eec9addbe353626bbe9..3ed753e094c9cda310b37fde12adf41f56c6f991 100644 (file)
--- a/basis/locals/types/types.factor
+++ b/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 )

diff --git a/basis/specialized-arrays/functor/functor.factor b/basis/specialized-arrays/functor/functor.factor
index 718a1a7aa1774692a18aa11c4f69ec7957d789fb..9a56346be472a96953b48441646de1c3a421c689 100644 (file)
--- a/basis/specialized-arrays/functor/functor.factor
+++ b/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 ;
 

diff --git a/core/quotations/quotations-docs.factor b/core/quotations/quotations-docs.factor
index 1a16d0f92a273cfdc51b5aa87697644a62b1c527..f2629a36c4317b317656eb73d3b84ee00384cc0f 100644 (file)
--- a/core/quotations/quotations-docs.factor
+++ b/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 }

diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor
index c81fc9201e64794e573a2309c099de384cb52845..af5fa38aeb439a3031699433f08e39c9ae8857ac 100644 (file)
--- a/core/syntax/syntax.factor
+++ b/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