Archive version of: clean-func.r ... version: 1 ... ladislav 2-Oct-2020

Amendment note: new script || Publicly available? Yes

Rebol [
	Author: "Ladislav Mecir"
	File: %clean-func.r
	Title: "Clean-func"
	Date: 2-Oct-2020
	Purpose: {
		Func defines a function with given spec and body
		that remembers its arguments and locals after return.
		
		Clean-func defines a function with given spec and body
		that does not remember its arguments and locals after return.
	}
]

make object! [
	; helper function
	do-body: func [body [block!]] [do body]
	
	; result store
	result: none
	
	part1: [
		; get the result
		set/any 'result do-body
	]
	
	set 'body-of-clean func [
		[catch]
		{Return the body of a clean-func}
		f [function!]
	] [
		unless all [
			equal? length? second :f 8
			block? fourth second :f
			find/match second :f part1
			same? 'do-body third second :f
		] [
			throw make error! "cannot use body-of-clean on the function"
		]
		fourth second :f
	]
	
	set 'clean-func func [
		{
			Define a function with given spec and body that does not remember
			argument values on return.
			Warning - not suitable for recursive functions.
		}
		[catch]
		spec [block!] {Help string (opt) followed by arg words (and opt type and string)}
		body [block!] "The body block of the function"
		/local context-var f part2
	] [
		unless find spec /local [append spec /local]
		
		; every function defined will have its own context-var
		context-var: use [context] ['context]
		
		; create modified function body
		part2: compose [
			; clear the context
			unset (context-var)
			; return the result
			get/any 'result
		]
		body: compose [
			(part1) (reduce [body])
			(part2)
		]
		
		; we need a local word
		change body 'local
		
		; make the function
		throw-on-error [f: make function! spec body]
		
		spec: first :f
		body: second :f
		
		; get the function context
		set context-var clear copy spec
		foreach value spec [
			if any-word? :value [
				append get context-var to word! :value
			]
		]
		bind get context-var first body
		
		; revert changes to the parts of the function body
		change body part1
		change skip body 1 + length? part1 part2
		
		:f
	]
]

comment [
	; Examples
	
	; normal func
	f: func [x [series!]] [length? :x]
	body-of :f
	; == [length? :x]

	; f remembers its argument value(s) and locals
	f head insert/dup copy "" "0" 1000
	get second body-of :f
	; == {0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000...
	
	; this should not work
	body-of-clean :f
	; ** User Error: cannot use body-of-clean on the function
	; ** Near: body-of-clean :f
	
	; clean-func
	g: clean-func [x [series!]] [length? :x]
	; this works
	body-of :g
	; == [
	; 	set/any 'result do-body [length? :x]
	; 	unset context
	; 	get/any 'result
	; ]
	
	; this works too
	body-of-clean :g
	; == [length? :x]
	

	; g does not remember its argument value(s) and locals
	g head insert/dup copy "" "0" 1000
	get second body-of-clean :g
	; ** Script Error: x has no value
	; ** Near: get second body-of-clean :g
]