remove [wlet ]
							parent
							
								
									d17ef38007
								
							
						
					
					
						commit
						8f0321a0b1
					
				| 
						 | 
				
			
			@ -12,7 +12,7 @@ M: >r/r>-in-lambda-error summary
 | 
			
		|||
ERROR: binding-form-in-literal-error ;
 | 
			
		||||
 | 
			
		||||
M: binding-form-in-literal-error summary
 | 
			
		||||
    drop "[let, [let* and [wlet not permitted inside literals" ;
 | 
			
		||||
    drop "[let and [let* not permitted inside literals" ;
 | 
			
		||||
 | 
			
		||||
ERROR: local-writer-in-literal-error ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -19,29 +19,13 @@ HELP: [let*
 | 
			
		|||
 | 
			
		||||
{ POSTPONE: [let POSTPONE: [let* } related-words
 | 
			
		||||
 | 
			
		||||
HELP: [wlet
 | 
			
		||||
{ $syntax "[wlet | binding1 [ body1... ]\n        binding2 [ body2... ]\n        ... |\n     body... ]" }
 | 
			
		||||
{ $description "Introduces a set of lexically-scoped non-recursive local functions. The bodies may not refer to other bindings within the same " { $link POSTPONE: [wlet } " form." }
 | 
			
		||||
{ $examples
 | 
			
		||||
    { $example
 | 
			
		||||
        "USING: locals math prettyprint sequences ;"
 | 
			
		||||
        "IN: scratchpad"
 | 
			
		||||
        ":: quuxify ( n seq -- newseq )"
 | 
			
		||||
        "    [wlet | add-n [| m | m n + ] |"
 | 
			
		||||
        "        seq [ add-n ] map ] ;"
 | 
			
		||||
        "2 { 1 2 3 } quuxify ."
 | 
			
		||||
        "{ 3 4 5 }"
 | 
			
		||||
    }
 | 
			
		||||
} ;
 | 
			
		||||
 | 
			
		||||
HELP: :>
 | 
			
		||||
{ $syntax ":> var" ":> var!" }
 | 
			
		||||
{ $description "Binds the value on the top of the datastack to a new local variable named " { $snippet "var" } ", lexically scoped to the enclosing quotation or definition."
 | 
			
		||||
$nl
 | 
			
		||||
"If the " { $snippet "var" } " name is followed by an exclamation point (" { $snippet "!" } "), the new variable will be mutable. See " { $link "locals-mutable" } " for more information on mutable local bindings." }
 | 
			
		||||
{ $notes
 | 
			
		||||
    "This syntax can only be used inside a " { $link POSTPONE: :: } " word, " { $link POSTPONE: [let } ", " { $link POSTPONE: [let* } ",  or " { $link POSTPONE: [wlet } " form, or inside a quotation literal inside one of those forms."
 | 
			
		||||
}
 | 
			
		||||
    "This syntax can only be used inside a " { $link POSTPONE: :: } " word, " { $link POSTPONE: [let } " or " { $link POSTPONE: [let* } " form, or inside a quotation literal inside one of those forms." }
 | 
			
		||||
{ $examples "See " { $link "locals-examples" } "." } ;
 | 
			
		||||
 | 
			
		||||
HELP: ::
 | 
			
		||||
| 
						 | 
				
			
			@ -301,7 +285,6 @@ ARTICLE: "locals" "Lexical variables and closures"
 | 
			
		|||
    POSTPONE: :>
 | 
			
		||||
    POSTPONE: [let
 | 
			
		||||
    POSTPONE: [let*
 | 
			
		||||
    POSTPONE: [wlet
 | 
			
		||||
}
 | 
			
		||||
"Quotation literals where the inputs are named local variables:"
 | 
			
		||||
{ $subsections POSTPONE: [| }
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -55,29 +55,6 @@ IN: locals.tests
 | 
			
		|||
 | 
			
		||||
[ -1 ] [ -1 let-test-3 call ] unit-test
 | 
			
		||||
 | 
			
		||||
[ 5 ] [
 | 
			
		||||
    [let | a [ 3 ] | [wlet | func [ a + ] | 2 func ] ]
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
:: wlet-test-2 ( a b -- seq )
 | 
			
		||||
    [wlet | add-b [ b + ] |
 | 
			
		||||
        a [ add-b ] map ] ;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
[ { 4 5 6 } ] [ { 2 3 4 } 2 wlet-test-2 ] unit-test
 | 
			
		||||
    
 | 
			
		||||
:: wlet-test-3 ( a -- b )
 | 
			
		||||
    [wlet | add-a [ a + ] | [ add-a ] ]
 | 
			
		||||
    [let | a [ 3 ] | a swap call ] ;
 | 
			
		||||
 | 
			
		||||
[ 5 ] [ 2 wlet-test-3 ] unit-test
 | 
			
		||||
 | 
			
		||||
:: wlet-test-4 ( a -- b )
 | 
			
		||||
    [wlet | sub-a [| b | b a - ] |
 | 
			
		||||
        3 sub-a ] ;
 | 
			
		||||
 | 
			
		||||
[ -7 ] [ 10 wlet-test-4 ] unit-test
 | 
			
		||||
 | 
			
		||||
:: write-test-1 ( n! -- q )
 | 
			
		||||
    [| i | n i + dup n! ] ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -120,12 +97,6 @@ write-test-2 "q" set
 | 
			
		|||
 | 
			
		||||
[ ] [ 5 write-test-4 drop ] unit-test
 | 
			
		||||
 | 
			
		||||
! Not really a write test; just enforcing consistency
 | 
			
		||||
:: write-test-5 ( x -- y )
 | 
			
		||||
    [wlet | fun! [ x + ] | 5 fun! ] ;
 | 
			
		||||
 | 
			
		||||
[ 9 ] [ 4 write-test-5 ] unit-test
 | 
			
		||||
 | 
			
		||||
:: let-let-test ( n -- n ) [let | n [ n 3 + ] | n ] ;
 | 
			
		||||
 | 
			
		||||
[ 13 ] [ 10 let-let-test ] unit-test
 | 
			
		||||
| 
						 | 
				
			
			@ -170,12 +141,6 @@ M:: string lambda-generic ( a b -- c ) a b lambda-generic-2 ;
 | 
			
		|||
    \ unparse-test-1 "lambda" word-prop body>> first unparse
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
:: unparse-test-2 ( -- ) [wlet | a! [ ] | ] ;
 | 
			
		||||
 | 
			
		||||
[ "[wlet | a! [ ] | ]" ] [
 | 
			
		||||
    \ unparse-test-2 "lambda" word-prop body>> first unparse
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
:: unparse-test-3 ( -- b ) [| a! | ] ;
 | 
			
		||||
 | 
			
		||||
[ "[| a! | ]" ] [
 | 
			
		||||
| 
						 | 
				
			
			@ -486,14 +451,10 @@ M:: integer lambda-method-forget-test ( a -- b ) a ;
 | 
			
		|||
 | 
			
		||||
[ "USE: locals [| | { [let | a [ 0 ] | a ] } ]" eval( -- ) ] must-fail
 | 
			
		||||
 | 
			
		||||
[ "USE: locals [| | { [wlet | a [ 0 ] | a ] } ]" eval( -- ) ] must-fail
 | 
			
		||||
 | 
			
		||||
[ "USE: locals [| | { [let* | a [ 0 ] | a ] } ]" eval( -- ) ] must-fail
 | 
			
		||||
 | 
			
		||||
[ "USE: locals [| | [let | a! [ 0 ] | { a! } ] ]" eval( -- ) ] must-fail
 | 
			
		||||
 | 
			
		||||
[ "USE: locals [| | [wlet | a [ 0 ] | { a } ] ]" eval( -- ) ] must-fail
 | 
			
		||||
 | 
			
		||||
[ "USE: locals [| | { :> a } ]" eval( -- ) ] must-fail
 | 
			
		||||
 | 
			
		||||
[ "USE: locals 3 :> a" eval( -- ) ] must-fail
 | 
			
		||||
| 
						 | 
				
			
			@ -504,19 +465,6 @@ M:: integer lambda-method-forget-test ( a -- b ) a ;
 | 
			
		|||
 | 
			
		||||
[ 3 ] [ 2 [| | :> a! a 1 + a! a ] call ] unit-test
 | 
			
		||||
 | 
			
		||||
:: wlet-&&-test ( a -- ? )
 | 
			
		||||
    [wlet | is-integer? [ a integer? ]
 | 
			
		||||
            is-even? [ a even? ]
 | 
			
		||||
            >10? [ a 10 > ] |
 | 
			
		||||
        { [ is-integer? ] [ is-even? ] [ >10? ] } &&
 | 
			
		||||
    ] ;
 | 
			
		||||
 | 
			
		||||
\ wlet-&&-test def>> must-infer
 | 
			
		||||
[ f ] [ 1.5 wlet-&&-test ] unit-test
 | 
			
		||||
[ f ] [ 3 wlet-&&-test ] unit-test
 | 
			
		||||
[ f ] [ 8 wlet-&&-test ] unit-test
 | 
			
		||||
[ t ] [ 12 wlet-&&-test ] unit-test
 | 
			
		||||
 | 
			
		||||
: fry-locals-test-1 ( -- n )
 | 
			
		||||
    [let | | 6 '[ [let | A [ 4 ] | A _ + ] ] call ] ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -15,8 +15,6 @@ SYNTAX: [let parse-let over push-all ;
 | 
			
		|||
 | 
			
		||||
SYNTAX: [let* parse-let* over push-all ;
 | 
			
		||||
 | 
			
		||||
SYNTAX: [wlet parse-wlet over push-all ;
 | 
			
		||||
 | 
			
		||||
SYNTAX: :: (::) define-declared ;
 | 
			
		||||
 | 
			
		||||
SYNTAX: M:: (M::) define ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -86,19 +86,6 @@ M: lambda-parser parse-quotation ( -- quotation )
 | 
			
		|||
    "|" expect "|" parse-bindings*
 | 
			
		||||
    (parse-lambda) <let*> ?rewrite-closures ;
 | 
			
		||||
 | 
			
		||||
: (parse-wbindings) ( end -- )
 | 
			
		||||
    dup parse-binding dup [
 | 
			
		||||
        first2 [ make-local-word ] keep 2array ,
 | 
			
		||||
        (parse-wbindings)
 | 
			
		||||
    ] [ 2drop ] if ;
 | 
			
		||||
 | 
			
		||||
: parse-wbindings ( end -- bindings vars )
 | 
			
		||||
    [ (parse-wbindings) ] with-bindings ;
 | 
			
		||||
 | 
			
		||||
: parse-wlet ( -- form )
 | 
			
		||||
    "|" expect "|" parse-wbindings
 | 
			
		||||
    (parse-lambda) <wlet> ?rewrite-closures ;
 | 
			
		||||
 | 
			
		||||
: parse-locals ( -- effect vars assoc )
 | 
			
		||||
    complete-effect
 | 
			
		||||
    dup
 | 
			
		||||
| 
						 | 
				
			
			@ -121,4 +108,4 @@ M: lambda-parser parse-quotation ( -- quotation )
 | 
			
		|||
    [
 | 
			
		||||
        [ parse-definition ] 
 | 
			
		||||
        parse-locals-definition drop
 | 
			
		||||
    ] with-method-definition ;
 | 
			
		||||
    ] with-method-definition ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -40,8 +40,6 @@ M: lambda pprint*
 | 
			
		|||
 | 
			
		||||
M: let pprint* \ [let pprint-let ;
 | 
			
		||||
 | 
			
		||||
M: wlet pprint* \ [wlet pprint-let ;
 | 
			
		||||
 | 
			
		||||
M: let* pprint* \ [let* pprint-let ;
 | 
			
		||||
 | 
			
		||||
M: def pprint*
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -6,7 +6,7 @@ locals.errors locals.types make quotations sequences vectors
 | 
			
		|||
words ;
 | 
			
		||||
IN: locals.rewrite.sugar
 | 
			
		||||
 | 
			
		||||
! Step 1: rewrite [| [let [let* [wlet into :> forms, turn
 | 
			
		||||
! Step 1: rewrite [| [let [let* into :> forms, turn
 | 
			
		||||
! literals with locals in them into code which constructs
 | 
			
		||||
! the literal after pushing locals on the stack
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -124,8 +124,3 @@ M: let rewrite-sugar*
 | 
			
		|||
 | 
			
		||||
M: let* rewrite-sugar*
 | 
			
		||||
    [ body>> ] [ bindings>> ] bi let-rewrite ;
 | 
			
		||||
 | 
			
		||||
M: wlet rewrite-sugar*
 | 
			
		||||
    [ body>> ] [ bindings>> ] bi
 | 
			
		||||
    [ '[ _ ] ] assoc-map
 | 
			
		||||
    let-rewrite ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -18,10 +18,6 @@ TUPLE: let* < binding-form ;
 | 
			
		|||
 | 
			
		||||
C: <let*> let*
 | 
			
		||||
 | 
			
		||||
TUPLE: wlet < binding-form ;
 | 
			
		||||
 | 
			
		||||
C: <wlet> wlet
 | 
			
		||||
 | 
			
		||||
TUPLE: quote local ;
 | 
			
		||||
 | 
			
		||||
C: <quote> quote
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -81,8 +81,6 @@ M: wrapper noise wrapped>> noise ;
 | 
			
		|||
 | 
			
		||||
M: let noise body>> noise ;
 | 
			
		||||
 | 
			
		||||
M: wlet noise body>> noise ;
 | 
			
		||||
 | 
			
		||||
M: lambda noise body>> noise ;
 | 
			
		||||
 | 
			
		||||
M: object noise drop { 0 0 } ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -272,7 +272,7 @@
 | 
			
		|||
    ("\\(\n\\| \\);\\_>" (1 ">b"))
 | 
			
		||||
    ;; Let and lambda:
 | 
			
		||||
    ("\\_<\\(!(\\) .* \\()\\)" (1 "<") (2 ">"))
 | 
			
		||||
    ("\\(\\[\\)\\(let\\|wlet\\|let\\*\\)\\( \\|$\\)" (1 "(]"))
 | 
			
		||||
    ("\\(\\[\\)\\(let\\|let\\*\\)\\( \\|$\\)" (1 "(]"))
 | 
			
		||||
    ("\\(\\[\\)\\(|\\) +[^|]* \\(|\\)" (1 "(]") (2 "(|") (3 ")|"))
 | 
			
		||||
    (" \\(|\\) " (1 "(|"))
 | 
			
		||||
    (" \\(|\\)$" (1 ")"))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue