From 1a409b92138cf072f876fbf622a657ced8fda59a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 28 Jan 2009 15:46:04 -0600 Subject: [PATCH 1/2] Fix specialized-arrays.direct.functor --- basis/specialized-arrays/direct/functor/functor.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/specialized-arrays/direct/functor/functor.factor b/basis/specialized-arrays/direct/functor/functor.factor index 14fb739947..ce23186fc6 100755 --- a/basis/specialized-arrays/direct/functor/functor.factor +++ b/basis/specialized-arrays/direct/functor/functor.factor @@ -27,8 +27,8 @@ TUPLE: A M: A length length>> ; M: A nth-unsafe underlying>> NTH call ; M: A set-nth-unsafe underlying>> SET-NTH call ; -M: A like drop dup A instance? [ >A' execute ] unless ; -M: A new-sequence drop execute ; +M: A like drop dup A instance? [ >A' ] unless ; +M: A new-sequence drop ; INSTANCE: A sequence From 4de41f94e91529b828bbbeab690c18525a20beda Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 28 Jan 2009 17:07:31 -0600 Subject: [PATCH 2/2] Fixing wrappers with locals --- basis/functors/functors-tests.factor | 18 ++++++++++++++++++ basis/functors/functors.factor | 11 +++++++++-- basis/locals/locals-docs.factor | 6 ++++-- basis/locals/locals-tests.factor | 6 +++++- basis/locals/rewrite/sugar/sugar.factor | 10 +++++++--- basis/locals/types/types.factor | 9 +++++++-- .../specialized-arrays/functor/functor.factor | 2 +- core/quotations/quotations-docs.factor | 4 ++++ core/syntax/syntax.factor | 2 +- 9 files changed, 56 insertions(+), 12 deletions(-) diff --git a/basis/functors/functors-tests.factor b/basis/functors/functors-tests.factor index 577debd398..a5f3042b38 100644 --- 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 b13ee8ff7c..f4d35b6932 100644 --- 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 ; + ; [ 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 + rewrite-closures first ; +PRIVATE> + : FUNCTOR: (FUNCTOR:) define ; parsing diff --git a/basis/locals/locals-docs.factor b/basis/locals/locals-docs.factor index efaad748cf..a4a9ca448b 100644 --- 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 e3aa504fbc..bd9e7cf103 100644 --- 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 6e7e156ced..515473c467 100644 --- 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 , ; + +: rewrite-wrapper ( wrapper -- ) + dup rewrite-literal? + [ wrapped>> rewrite-element ] [ , ] if ; M: wrapper rewrite-element - dup rewrite-literal? [ wrapped>> rewrite-element \ literalize , ] [ , ] if ; + rewrite-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 7a8dac1947..3ed753e094 100644 --- 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 dup t "local?" set-word-prop ; +M: local literalize ; + PREDICATE: local-word < word "local-word?" word-prop ; : ( name -- word ) @@ -49,6 +52,8 @@ PREDICATE: local-reader < word "local-reader?" word-prop ; f dup t "local-reader?" set-word-prop ; +M: local-reader literalize ; + PREDICATE: local-writer < word "local-writer?" word-prop ; : ( reader -- word ) diff --git a/basis/specialized-arrays/functor/functor.factor b/basis/specialized-arrays/functor/functor.factor index 718a1a7aa1..9a56346be4 100644 --- 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 1a16d0f92a..f2629a36c4 100644 --- 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 c81fc9201e..af5fa38aeb 100644 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -103,7 +103,7 @@ IN: bootstrap.syntax "W{" [ \ } [ first ] parse-literal ] define-syntax "POSTPONE:" [ scan-word parsed ] define-syntax - "\\" [ scan-word literalize parsed ] define-syntax + "\\" [ scan-word parsed ] define-syntax "inline" [ word make-inline ] define-syntax "recursive" [ word make-recursive ] define-syntax "foldable" [ word make-foldable ] define-syntax