template.red

Red [
	Author: "ifgem"
]

#do [
	macro: context [
		make-object-spec: function [words] [
			spec: copy []

			foreach word words [
				append spec reduce [
					to set-word! word
					none
				]
			]

			spec
		]

		copy-or-set: func [pattern] [
			either any [
				pattern/1 = 'any
				pattern/1 = 'some
				integer? pattern/1
			] ['copy] ['set]
		]

		make-rule: func [rule words name pattern] [
			either name [
				append rule reduce [
					copy-or-set pattern
					name
					pattern
				]

				append words name
			] [
				append/only rule pattern
			]
		]

		to-rule: function [spec body] [
			rule: copy []
			words: copy []

			parse spec [
				any [
					set name opt word!
					set pattern block!
					(make-rule rule words name pattern)
				]
			]
			; hide words used in the rule:)
			hidden-context: make object! make-object-spec words
			bind rule hidden-context
			bind body hidden-context

			rule
		]

		to-debug-rule: func [
			spec body
			/local
			rule words
			hidden-context
		] [
			rule: copy []
			words: copy []

			parse spec [
				any [
					set name opt word!
					set pattern block!
					(make-rule rule words name pattern)
				]
			]

			rule: compose/only [
				copy macro-match (rule)
			]

			hidden-context: make object! make-object-spec words
			bind rule hidden-context
			bind body hidden-context

			reduce [rule hidden-context]
		]

		local: function [body [block!]] [
			local-words: copy []

			parse body [
				any [
					  remove ['local set val [word! | block!]] 
					  (append local-words val)
					| change ['local set val set-word!]
					  (append local-words to word! val
					   val)
					| skip
				]
			]
			
			local-words
		]

		replacement: []

		quote: func [
			block [block!]
			/local val
		] [
			block: copy block

			parse block [
				any [
					change only ['unquote set val [word! | block!]] (
						either block? val [
							do val
						] [
							get val
						]
					)
					| skip
				]
			]

			append replacement block
		]

		writer: func [recursive? name? spec body] [
			bind body 'quote

			either name? [
				name?: to lit-word! name?
			] [
				name?: 'none
			]

			compose/deep [
				#macro [
					(name?)
					(to-rule spec body)
				] func [
					[manual] start end
					/local
					macro-end
					(local body)
				] [
					macro/replacement: copy []
					
					(body)

					macro-end: change/part start
						macro/replacement
					end

					(either recursive? [
						'start
					] [
						'macro-end
					])
				]
			]
		]

		debugger: func [
			recursive? name? spec body
			/local rule-context
		] [
			rule-context: to-debug-rule spec body
			;probe rule-context/1

			bind body 'quote

			either name? [
				name?: to lit-word! name?
			] [
				name?: 'none
			]

			compose/deep [
				#macro [
					(name?)
					(rule-context/1)
				] func [
					[manual] start end
					/local
					macro-end
					(macro/local body)
				] [
					macro/replacement: copy []

					(body)

					macro-end: change/part start
						macro/replacement
					end

					print "MATCH RESULT"
					print "HIDDEN CONTEXT"
					probe (rule-context/2)
					print "BEFORE"
					probe macro-match
					print "AFTER"
					probe macro/replacement
					;print "MATCH END"

					(either recursive? [
						'start
					] [
						'macro-end
					])
				]
			]			
		]
	]
]

#macro [
	set template-debug? opt 'debug
	set template-recursive? opt 'recursive
	'template
	set template-name opt word!
	set template-spec block!
	set template-body block!
] func [[manual] start end /local name? template] [

	if template-debug? [
		template: macro/writer
			template-recursive?
			template-name
			copy template-spec
			copy template-body
	]

	change/part start
		either template-debug? [
			macro/debugger
				template-recursive?
				template-name
				template-spec
				template-body
		] [
			macro/writer
				template-recursive?
				template-name
				template-spec
				template-body
		]
	end

	if template-debug? [
		print "TEMPLATE"
		probe template
		;print "TEMPLATE END"
	]

	start ; process generated macro
]

debug recursive template [times [integer!] ['times] body [block!]] [
	quote [
		loop unquote times unquote body
	]
]

5 times [
	print "hello"
	2 times [
		print "world"
	]
]