Gregg's parse-func-spec function for Rebol3

func-spec.r3

Rebol [
	note: {There are some hacks in this, based on empirical testing.}
]

func-spec-ctx: context [
	func-spec: context [
		desc: none
		attr: none
		params: copy []
		refinements: copy []
		locals: copy []
	]

	set 'parse-func-spec func [
		"Parses a function spec and returns an object model of it."
		spec [block! any-function!]
		/local 
			emit-name emit-attr emit-target	res
			func-desc= attr-val= func-attr= 
			param-name= param-type=	param-desc= param-attr= param= 
			ref-name= ref-desc= ref-param= refinement= 
			locals= spec=
			=val 
	][
		emit-name: func [val] [
			append/only emit-target reduce [:val]
			new-line back tail emit-target on
		]
		emit-attr: func [val] [append/only last emit-target val]
		 
		func-desc=:  [set =val string! (res/desc: =val)]
		attr-val=:   ['catch | 'throw]
		func-attr=:  [into [copy =val some attr-val= (res/attr: =val)]]
		param-name=: [set =val [word! | get-word! | lit-word!] (emit-name :=val)]
		;!! param types are word! vals under R3 alpha currently.
		;	add typeset support?
		param-type=: [into [copy =val some [word! | datatype!]] (emit-attr =val)] 
		; actions that check datatypes (e.g. unset?) use integers in the 
		; doc-string position of the arg. Nothing else seems to do that.
		;param-desc=: [set =val string! (emit-attr =val)]
		param-desc=: [set =val [string! | integer!] (emit-attr =val)]
		; Either type or desc can come first
		param-attr=: [opt param-type= opt param-desc= opt param-type=]
		param=:      [param-name= param-attr=]
		ref-name=:   [set =val refinement! (emit-name =val)]
		ref-desc=:   [set =val string! (emit-attr =val)] 
		ref-param=:  [param-name= param-attr=]
		refinement=: [
			ref-name= opt ref-desc= 
			(emit-target: last res/refinements)
			any ref-param=
			(emit-target: res/refinements)
		]
		locals=: [/local copy =val any word! (res/locals: =val)]
		spec=: [
			; In some rare cases, the attr's come before the desc
			opt func-desc= opt func-attr= opt func-desc= 
 			(emit-target: res/params)
 			any param= (foreach param res/params [new-line/all param off])
 			(emit-target: res/refinements)
 			any [locals= to end | refinement=]
 			(foreach param res/refinements [new-line/all param off]) 
		]
	
		if any-function? :spec [spec: third :spec]
		res: make func-spec [
			params: copy []
			refinements: copy []
			locals: copy []
		]
		either parse spec spec= [res] [none]
	]
]