Replicates a function adding custom code handling

replica.red

Red [
  title: "Replica"
  Description: "Creates another function that calls the original, with context manipulation capabilities"
  Author: "Giuseppe Chillemi"
  Copyright: "MIT license"
  Version: 1.00
  Needs: [
    func-spec-words
    quotes
    get-all
    words-to-object
  ]
  
]

func-spec-words: function [
    "Get all the word-type values from a func spec."
    fn [any-function! word! block!]
    /as type [datatype!] "Cast results to this type."
][
	[DOC: main/func ~func-spec-words <name>] ;Oppure prende il nome
		;AUTHOR: GREGG + Giuseppe Chillemi modifications

		case [
			any-function? :fn [specs: spec-of :fn]
			block? fn [specs: fn]
			word? fn [
				fname: fn
				fn: get fn
				either function? :fn [specs: spec-of :fn] [do make error! rejoin ["No function found in: " :fname]]
			]
		]
		 
    arg-types: make typeset! [word! lit-word! get-word! refinement!]
    parse specs  [
        ; If we want an apply-specific version of objects, we could
        ; denote refinements with a sigil for added clarity.
        collect [
            any [set w arg-types keep (either type [to type w][w]) | skip]
        ]
    ]
]

quotes: func [
	"Quotes the actives and reduceable values in a block"
	bl [block!]
] [
	forall bl [
		if any	[any-word? bl/1 any-path? bl/1 any-function? bl/1]  [insert bl 'quote bl: skip bl 1] 
	]
	bl
]

get-all: func [
	"Gets all of the words in a block"
	bl [block!]
] [
	forall bl [
		either any [word? bl/1]  [change/only bl get/any bl/1] [do make error! rejoin ["Element not a word: " :bl/1 ]] 
	]
	bl
]

words-to-object: func [
	"Transform a block of words to object"
	bl [block!]
	/local
	w
	out-data
] [
	out-data: copy []
	either parse bl [any [set w word! (append out-data reduce [to-set-word w 'quote get/any :w])]] [
		make object! out-data	
	] [
		false
	]
	
]

replica: func [
	"Recreate a function from its specs"
	fn [word! any-function!]
	/code
	cd [any-function!] "Arity 1 Function that receives the arguments"
;	/args "Additional arguments"
;	ar [block!]
	/local
	spec-words
	specs
	op
	function
	function-name
	body
	func-ctx
] [
	;--- TBD: Save the function context as object in heading
	;--- TBD: refinement for FUNCTION or FUNC

	
	;--- Managing function as names or as value
	;	
	either word? :fn [function-name: fn fn: :fn] [function-name: none]

	spec-words: func-spec-words/as :fn word!
	
	;--- Adding the LOCAL word as universal guarranted word to obtain the context
	;
	append spec-words 'local
	
	;--- Creating a specs block from the original function 
	;
	specs: append func-spec-words :fn /local


	;--- The body of the caller function
	;
	body: compose/only/deep [
		
		;--- For reference and any future use
		[
			specs: (specs) 
			spec-words: (spec-words) 
			function: (:fn) 
			function-name: (function-name) 
			;call-original: (:call-original)
		]
		
		;--- Calling your custom code for processing arguments
		;
		if (code) [
			;--- converts the local context to an object
			;--- handle it to the user function
			;--- on return converts it to a block of values
			;--- set the local context to the values of the returned one,
			;---   so syncing the modifications
			set words-of context? 'local values-of (:cd) words-to-object words-of context? 'local
		] 
		
		;--- Calling the original function
		apply/all quote (:fn) quotes get-all bind (spec-words) context? 'local			
		
		]	
	;--- Returns the created function
	;
	func specs copy/deep body
]

[
;-------------- Test1
  f: replica :find 
  probe f [a b c d] 'c

  ;---result [c d]

;-------------- Test2, using code that modifies the function context
;----------------- Note we are passing a function to change the searched value from 'c to 'd

  f: replica/code :find func [ctx] [ctx/value: 'd ctx]
  probe f [a b c d] 'c

  ;---result [d]

]