REBOL [
	title: "Block preprocessor. At last!"
	file: %preprocess.r
	author: "Marco Antoniazzi"
	Copyright: "(C) 2011 Marco Antoniazzi. All Rights reserved"
	email: [luce80 AT libero DOT it]
	date: 17-08-2011
	version: 0.5.1
	Purpose: "Use macros (also with parameters) in your code"
	Notes: {This is a very simple but quite usable implementation.
			Use with care. Not allowed: Macro recursion, multi-level #ifdef . Error checking is a nightmare ;( .
			To see expanded macros use: probe preprocess/debug code (generated code will possibly not work).
	}
	History: [
		0.5.1 [17-08-2011 "First version"]
	]
	library: [
		level: 'intermediate
		platform: 'all
		type: 'function
		domain: 'text-processing
		tested-under: [View 2.7.8.3.1]
		support: none
		license: 'BSD
		see-also: none
	]
]

context [
	system/error: make system/error [
	    macro-errors: make object! [
	        code: 1000
	        type: "Macro Error"
	        no-block: ["macro's spec and body must be block! not:" :arg1]
			no-rec: ["recursion not allowed in:" :arg1]
			redefined: ["macro:" :arg1 "-- already defined"]
	    ]
	]
	throw-error: func [[throw] message [block!]] [insert message first ['macro-errors] throw make error! reduce message]
	
	macros-list: copy []

	erase: func [{Removes from start to end from a series and returns after the remove. (eg. erase/all ";" "^/" to strip Rebol comments)}
		series [series! port! bitset!] start end /all
	] [
		until [
			series: any [remove/part find series start any [find/tail series end break] head series]
			any [head? series not all]
		]
		any [series head series]
	]
	replace_deep: func [target search replaced /all /local pos rep] [
		rep: pick [replace_deep replace_deep/all] none? all
		pos: target
		while [pos: find/tail pos any-block!] [
			do rep first back pos search replaced
		]
		do pick [replace replace/all] none? all target search replaced
		target
	]
	expand_macro_deep: func [code [block! paren!] name spec [block!] body [block!] /local pos new-body type] [

		replace_params_deep: func [args [block! paren!] spec [block!] body [block! paren!] /local param] [
			body: mold body
			foreach param spec [
				replace/all body mold param mold first args
				args: next args
			]
			load body
		]

		pos: code
		while [pos: find pos any-block!] [
			expand_macro_deep first pos name spec body
			pos: next pos
		]
		new-body: [[] []] ; intentionally use a static block
		pos: code
		while [pos: find pos name] [
			new-body: head change new-body next pos
			new-body: replace_params_deep new-body spec copy/deep body
			remove/part pos macros-list/:name + 1; remove macro's param(s)
			insert pos new-body
		]
		code
	]
	set 'preprocess func [[catch] code [block!] /debug /local pos name spec body] [
		insert macros-list [#date 0]
		replace_deep/all code #date now/date
		insert macros-list [#time 0]
		replace_deep/all code #time now/time
		insert macros-list [#define 2]
		expand_macro_deep code #define [name val] [#macro name [] [val]] ; predefined #define
		pos: code
		while [pos: find pos #ifdef] [
			name: first next pos
			either any [
				find/part code rejoin [[] #macro name] pos
				find/part code rejoin [[] #define name] pos
				] [
				remove/part pos 2; remove (unset) word
			] [
				erase pos #ifdef #endif
			]
		]
		pos: code
		while [pos: find pos #ifndef] [
			name: first next pos
			either any [
				find/part code rejoin [[] #macro name] pos
				find/part code rejoin [[] #define name] pos
				] [
				erase pos #ifndef #endif
			] [
				remove/part pos 2 ; remove (unset) word
			]
		]
		pos: code
		while [pos: find/tail pos #macro] [
			name: first pos
			spec: first next pos
			body: first next next pos
			if find mold body mold name [throw-error ['no-rec mold name]]
			if not block? spec [throw-error ['no-block type?/word spec] ]
			if not block? body [throw-error ['no-block type?/word body] ]
			if find mold pos join "#macro " mold name [throw-error ['redefined mold name]]
			insert macros-list reduce [name length? spec]
			if not debug [pos: remove/part back pos 4 pos: skip pos -3] ; remove macro's definition
			expand_macro_deep skip pos 3 name spec body
		]
		replace/all code #endif [] ; remoce orphans #endif
		code
	]
]

; EXAMPLES
; trying to use unique names for macros (using issue to better distinguish them)
code: [
#macro #comment [code] []
#macro #either-c [cond true-block false-block] [case [cond true-block true false-block]]
#macro #either-a [cond true-block false-block] [any [all [cond true-block] false-block]]
#macro #if-e [cond body] [#either-c cond body []] 											; redefine "if" with (redefined) "either"
#macro #if-c [cond body] [case [cond body]]
#macro #if-a [cond body] [all [cond do body]]
#macro #unless [cond body] [if not cond body]
#macro #loop [body] [while [true] body]														; I want an endless loop and I want to call it: ... "loop" ;)
#macro #while [cond body] [#loop [if not do cond [break] do body]]
#macro #until [body] [#loop [if do body [break]]]
#macro #cfor [init test inc body] [do init #while test [do body do inc]]
#macro #forskip [word skip-num body] [#while [not tail? word] [do body word: skip word skip-num]]
#macro #forall [word body] [#forskip word 1 body]
#macro #foreach [word data body] [#forall data [word: first data do body] data: head data]
#macro #func [] [make function!]
#macro #has [spec] [make function! head insert copy spec /local]
; ... and so on

print #comment "this is not printed" "this is not commented out"						; note that using "comment" instead gives an error

Print #date
Print #time

#define one 1
a: one bl: [a b c d]
#define debug 1
#ifdef debug
#macro #print [val] [print join "debugging:" val]
#endif
#ifndef debug
#define #print print
#endif
#print ["bl is:" bl]
#ifdef one
print "#ifdef: one"
#endif
#ifndef one
print "#ifndef: no one"
#endif
prin "#either-c: " print #either-c (a <> one) ["a <> 1"] ["a = 1"]							; ATTENTION: note use of parentheses
prin "#either-a: " print #either-a (a <> one) ["a <> 1"] ["a = 1"]
prin "#if-e: " #if-e (a = one) [print "a = 1"]
prin "#if-c: " #if-c (a = one) [print "a = 1"]
prin "#if-a: " #if-a (a = one) [print "a = 1"]
prin "#unless: " #unless (a <> one) [print "a = 1"]
prin "#loop: " #loop [print ["a =" a] a: a + 1 if a = 3 [break]]
prin "#while: " #while [a <= 4] [print ["a =" a] a: a + 1]
prin "#until: " #until [print ["a =" a] a: a + 1 a = 7]
prin "#cfor: " #cfor [a: 1] [a <= 2] [a: a + 1] [print ["a =" a]]
prin "#forskip: " #forskip bl 2 [print ["bl =" first bl]] bl: head bl
prin "#forall: " #forall bl [print ["bl =" first bl]] bl: head bl
prin "#foreach: " #foreach elem bl [print ["elem =" elem]]
print "end of macro experiments"

]
do preprocess code

halt