Named-Arguments Functions Factory with Refinements Support

nfunc.red

; + this support both positional and named args + refinements
; + type validation working properly accodring to the function definition
; + better error information
; note: a collab with Red/Sensei

nfunc: func [spc bdy /local groups pos-names][
	groups: collect [
		current: copy []
		stop: false
		parse spc [
			any [
				if (not stop) [
					set w word! (append current w)
					| set r refinement! (
						if any [r = /local r = /extern] [
							stop: true
						] [
							if not empty? current [keep/only current]
							current: reduce [r]
						]
					)
					| skip
				]
				| skip   ; after stop, just consume the rest
			]
		]
		if not empty? current [keep/only current]
	]
	valid-names: make map! []
	foreach group groups [
		foreach word group [
			valid-names/:word: true
		]
	]
	;; Positional arg names = first group (if not refinement-led)
	pos-names: either refinement? groups/1/1 [copy []] [groups/1]
	
	func [args /local obj g w pos-idx named-mode? i] compose/deep/only [
		apply func (spc) (bdy) collect [
			;; Build lookup: positional args fill slots first, then named pairs
			obj: make map! []
			pos-idx: 1
			named-mode?: false
			i: 1
			while [i <= length? args] [
				either set-word? args/:i [
					if not valid-names/(args/:i) [
						err: make error! rejoin ["Invalid named arg: " args/:i " (valid: " mold keys-of valid-names ")"]
						err/near: args       ; <-- This is the magic!
						do err
					]
					named-mode?: true
					put obj to word! args/:i args/(i + 1)
					i: i + 2
				][
					if named-mode? [ 
						err: make error! rejoin ["Positional arg after named arg: " args/:i " (valid: " mold keys-of valid-names ")"]
						err/near: args       ; <-- This is the magic!
						do err
					]
					if pos-idx <= length? (pos-names) [ put obj pick (pos-names) pos-idx args/:i ]
					pos-idx: pos-idx + 1
					i: i + 1
				]
			]
			;; Build apply block (same logic as before)
			foreach g (groups) [
				either refinement? g/1 [
					if select obj to word! g/1 [
						keep g/1  keep select obj to word! g/1
						foreach w next g [keep select obj w]
					]
				][
					foreach w g [
						keep/only select obj w
					]
				]
			]
		]
	]
]

Examples:
Wrapping native functions to support named-arguments:

n-append: nfunc [series[series! bitset! port!] value[any-type!] /part length [number! series!] /only /dup count[integer!]] [
    append/:part/:only/:dup series value length count
]
probe n-append ["Hello" "World!"]                               ;== "HelloWorld!"
probe n-append ["Hello" value: "World!" part: true length: 2]   ;== "HelloWo"

n-if: nfunc [ cond [any-type!] then [block!] else [block!] ][ either cond then else ]
repeat i 10 [
    n-if [ 
        (odd? i)
        else: [ print [i "is even!"] ]
        then: [ print [i "is odd!"] ]
    ]
]

Output:

1 is odd!
2 is even!
3 is odd!
4 is even!
5 is odd!
6 is even!
7 is odd!
8 is even!
9 is odd!
10 is even!

Creating custom functions with named-arguments:

send-packet: nfunc [data timeout interval][
	print ["data:" data "timeout:" timeout "interval:" interval]
]

send-packet ["Hello world!" interval: 30 timeout: 10]

Output:

data: Hello world! timeout: 10 interval: 30