Mirrors a field value to another object using a map. It could use a block for modification

mirror.red

Red [
  Title: "Mirror fields"
  Description: "Mirrors a field from a context to another. A modification code can be used"
  Usage: mirror [obj1 obj2] [src-word | :src-word dest-word | 'dst-word [code]....]
  Version: 2.0
]

mirror: func [
	"Mirrors the value of a word in a context to a word in another"
	objects [block!] "The objects to link"
	map [block!] "The map as [source-word dest-word]"
 	/blacklist
 	blacklist* [block!]
	/excluding "TBD: Esclude some words in the destination"
 	excl [block!]
	/later "TBD:"
	/local
	body 
	specs
	src-word
	dest-word
	cd
	err
	react-function
	valid-map?
] [
	
	;DIALECT: [source dest [CODE]] ;<- CODE block is optional
	;
	;Writes a sourcee to a destination
	;
	;SOURCE can be SOURCE - normal reactions- 
	;or :SOURCE - If a reatcion returns here, do no run be but skip it
	;
	;DEST can be DEST - Normal Reaction -
	;or 'DEST - SetQuiet: start no reaction
	;
	
	;TBD: Later
	;TBD: Change set-quiet to quietly
	;TBD: The created Function SPECS has locals, you should remove them
	;  or execute in a custom context	
	;TBD: Review the reactions system
	
	;--- Working
	;-- This function generates a reaction for each word of the mapping to its destination
	;-- it uses REACT/LINK, creating and passing the following function:
	; FUNC [start nxt] [[:start/word] set/any in nxt 'dest-word :start/:src-word]
	; or
	; FUNC [start nxt] [[:start/word] set/any in nxt bind do CODE 'local]
	;		
	

	;--- Verification phase
	;-- here we check if the arguents ar correct
	;ERR: is set before each test, so if it fails, the EITHER ELSE block will print it
		
				
	valid-map?: parse map [
		(err: "Source is not valid") ;set item
		[word! | get-word!]
		(err: "Destination is not valid")
		[word! | lit-word!]
		(err: "Error on block") 
		opt block!
		(err: "End not reached")
		end
		(err: none)
	]
	
	either not valid-map? [
		do make error! ["Map not parsable error: " err] 
	] [
	

		;--- Function generator, it creates a funtion for the requested and a reaction
		;
		; In the first block of the function body you will find
		; the reactive field mentioned as path ->>> [start/bbbbb]
		
		;--- Generates a function which executes a code whose result is written
		; to the destination word expressed in MAP as [SRC DEST [code]...]
		; code is bound to a function and shielded from path gathering
		;


		;		------- Function SPECS for reference
		;
		;func [
		;    {Mirrors a word from the start object to the nestination} 
		;    start "The source object" 
		;    nxt "The target object" 
		;    /local 
		;    map 
		;    code 
		;    excl 
		;    pos 
		;    blacklist
		;][
		;
		;		------ EXAMPLE BODY
		;
		;	[start/bbbbb] map: [bbbbb 'aaaa] blacklist: [] 
		;	if not skippable? blacklist nxt to-word map/2 [
		;    either not blacklisted? blacklist nxt to-word map/2 [
		;        append blacklist nxt map/2 
		;        if get-word? map/1 [append blacklist reduce [ctx map/1]] 
		;        do compose [
		;            (
		;                case [
		;                    lit-word? map/2 [
		;                        [set-quiet in nxt to-word map/2]
		;                    ] 
		;                    word? map/2 [
		;                        [set/any in nxt map/2]
		;                    ]
		;                ]
		;            ) 
		;            (
		;                case [
		;                    code [[do bind code context? 'local]] 
		;                    true [[get/any in start to-word map/1]]
		;                ]
		;            )
		;        ]
		;    ] [
		;        do make error! rejoin ["Looping on word: " :map/2]
		;    ]
		;] 
		;	if get-word? map/1 [
		;  	  append blacklist start to-get-word map/1
		;] 
		;	if all [pos: find-blacklisted blacklist start map/1 1 = index? pos] [clear blacklist]
		;]

		;--- The specification of the function created for each mapping
		;
			
		specs: [
			"Mirrors a word from the start object to the nestination"
			start "The source object"
			nxt "The target object"
			/local
			map
			code
			excl
			pos
			blacklist
		]

		;--- Inits the source and dest word
		;
		set [src-word dest-word cd] map
		
		;--- Blacklist is the one passed or here you init it
		;
		blacklist*: any [all [blacklist blacklist*] copy []]
									
		body: copy []


		;--- Appends to function body -> [start/<src-word>] ; to have it mapped in reaction
		;											
		append body reduce [
				reduce copy/deep [to-path copy reduce ['start to-word :src-word]] 
		]


		;--- Appends to function body -> map: [start-word dest-word] ; so you have a reference for the reaction source -> end
		;				
		append body reduce [to-set-word 'map reduce [:src-word :dest-word]]

		;--- Adding blacklist
		;
		append body reduce [to-set-word 'blacklist blacklist*]


		;--CODE SHIELDING for PATHS
		;
		;--- Appends to function body -> code: get in make object! [code: [code you have passed]] 'code
		;
		; An anonymous context is created with the code you have passed inside, and insert it on the body code
		; The it is set to CODE: word at runtime
		; The context shields its content from the gathering of paths from REACT/LINK, 
		; You retrieve it with GET IN <CTX> 'WORD like code
		; so you are free to use any path
		;

		if cd [
			append body reduce compose/deep [
					to-set-word 'code 'get 'in (make object! compose/only [code: (cd)]) to-lit-word 'code
							
			]
		]
						

		;In condizioni normali, io vado un blacklist,
		;se si trova SKIPME, allora viene inserita la sorgente come GET-WORD
		;Tutte le altre controllano se la destinazione è un GET-WORD, in caso si salta
		;Fare partire la reazione
		;tutte le reazioni seguenti dopo il mio set, non devono scrivere sulla destinazione
		;   Devono SKIPPARE la scrittura come sopra
		;   più corretto sarebbe: se contesto di destinazione e word di destinazione
		;   scrivono su me, allora si skippa
		;		se altro contesto scrive su me, si da errore di loop
		;Quando ritorna a me, togliermi dalla lista come skip
		;se sono primo nella reazioni, cancelare list
		;Nel dialetto, io devo essere passthrought e non la destinazione
		

		;--- Main Writing section
		; START, NXT, MAP, CODE words available (Also LOCAL :)  ) 


		append body [

			;--- Check for skippable and blacklist
			;
								
			if not skippable? blacklist nxt to-word map/2 [ 

				
				either not blacklisted? blacklist nxt to-word map/2 [


					;--- Add the blacklist so we wont return here
					;					
					append blacklist nxt map/2
					
					if get-word? map/1 [append blacklist reduce [ctx map/1]]
					
					;---- Main writing code
					;
					;--On runtime will COMPOSE the WRITING PART and READING PART and DO it 
					;
					;
					do compose [
						
						(
							
							case [
							
								;--Lit words means: NO REACTIONS
								lit-word? map/2 [
									[set-quiet in nxt to-word map/2]
								]
								;--Word = trigger all reactions
								word? map/2 [
									[set/any in nxt map/2]
								]
							]
							
						)

						;--- Emits the argument of the writing code: the reading code which gets the value
						(
							case [
								;--- The value to write is calculated by your code and returned as block result
								;(remember, here you have the function context)
								;
								code [[do bind code context? 'local]]
								
								;--- The value to write is the one of the starting field
								;
								true [[get/any in start to-word map/1]] 
							] 
						)	
					]
				] [
					;-- This does not stop for reaction logic but we keep it here always
					;
					do make error! rejoin ["Looping on word: " :map/2]
				]
			]
		];---End append body

		;--- Testing if START WORD is skippable, so we add to blacklist
		;
		append body [
			if get-word? map/1 [
				append blacklist start to-get-word map/1
			]				
		]

		;--- If we find ourself at position 1 of the blacklist, we have started the chain
		;-- so we must clear the whole blacklist as the reaction has ended
		;-- Note, NO REACTION should write back to us as we are not an EVOLVING reaction system
		;
		append body [
			if all [pos: find-blacklisted blacklist start map/1 1 = index? pos] [clear blacklist]
	
		]
		;^--------- End composition of function body

						 
			
		;--- The final part, building the function
		;
		react-function: func specs copy/deep body

		;---  Craating the link
		react/link :react-function objects							

	]
	
]


;--------------------------- TESTS -------------------------------------

;----- Test 1
o1: make reactor! [a: none]
o2: make reactor! [b: none]
o3: make reactor! [c: none]

mirror [o1 o2] [a b]
mirror [o2 o3] [b c]

o1/a: "Hello"

probe o3

;--- Result
;
;make object! [
;    c: "Hello"
;]

;----- Test 2
o1: make reactor! [a: none]
o2: make reactor! [b: none]
o3: make reactor! [c: none]

mirror [o1 o2] [a b [rejoin [start/a start/a]]]
mirror [o2 o3] [b c [rejoin [start/b start/b]]]

o1/a: "Hello"

probe o3

;--- Result
;
;make object! [
;    c: "HelloHelloHelloHello"
;]