Call APPLY with objects (experiments)

apply-objects-x1.red

Comment {
APPLY is coming! To keep it simple, it won't support named args in
the initial release. These are experiments for how we can think of
ways to do that at the mezz level and play.

APPLY is an avanced func and may be used in both very dynamic code
(think thunks) but also code that requires high performance. We may
not get all the features to do both without some effort, but some
of the ideas here may give you clues about how to do things to your
taste, that meets your needs.

To that end, this gist is about using objects. A big benefit is
that they are name-value structures, but a big cost is the
overhead of creating them. If you're using them for clarity and
flexibility, where performance isn't an issue, it's no problem.
You just care about being able to use names in any order, and
not worry about counting anonymous args when calling APPLY.

In looking at some of Boris' code, I saw him using many tricks
together. One of those was defining blocks of "apply specs" which
were used by name later. That's how I think the functions here
might be used, even in cases where performance matters. You don't
make and destory the object on every call. You make them once,
and just change key values for each call in a loop. The important
thing is that they do the job of mapping args to exactly what
APPLY wants, automatically.

Oh yeah, the names here are for playing. Better names are needed.
}

func-spec-words: function [
	"Get all the word-type values from a func spec."
	fn [any-function!]
	/as type [datatype!] "Cast results to this type."
][
	arg-types: make typeset! [word! lit-word! get-word! refinement!]
	parse spec-of :fn [
		; If we want an apply-specific version of objects, we could
		; denote refinements with a sigil for added clarity.
		collect [
			any [set w arg-types keep (either type [to type w][w]) | skip]
		]
	]
;	collect [
;		foreach val spec-of :fn [
;			if find arg-types type? val [
;				keep either type [to type val][val]
;			]
;		]
;	]
]
probe func-spec-words :append
probe func-spec-words/as :append set-word!

func-spec-to-obj-proto: function [
	"Returns an object whose words match a function's spec."
	fn [any-function!]
	; The idea here is that you can both preset values that are in the spec,
	; and also extend the object with extra words. If APPLY is strict, and
	; doesn't ignore extra args, this won't work. 
	/with args [block!] "TBD: If APPLY doesn't ignore extra values, keys must be in spec."
][
	obj: construct/with any [args []]
		construct append func-spec-words/as :fn set-word! none
	; Refinement values in apply calls MUST be logic!, not none!.
	foreach word func-spec-words :fn [
		if refinement? word [set in obj to word! word false]
	]
		
	; If func-spec-words always casts to set-words, less general, but shorter
	;object append func-spec-words :fn none
	obj
]
probe o-1: func-spec-to-obj-proto :append
probe o-2: func-spec-to-obj-proto/with :append [only: true dup: true count: 5]
probe o-3: func-spec-to-obj-proto :find
probe o-4: func-spec-to-obj-proto/with :find [only: true case: yes last: on value: 'xyz]
; wacky new words added at the end
probe o-4: func-spec-to-obj-proto/with :find [
	only: true case: yes last: on value: 'xyz
	foo: 'a bar: 'b baz: 'c
]

; Alt approach to func-spec-to-obj-proto
make-apply-obj-proto: function [
	"Returns an object whose words match a function's spec."
	fn [any-function! word! path!]
	/with args [block!] "TBD: If APPLY doesn't ignore extra values, keys must be in spec."
][
	if path? :fn [refs: next fn  fn: first fn]					; split path
	if word? :fn [fn: get fn]									; get func value
	obj: construct append func-spec-words/as :fn set-word! none	; make object
	; Refinement values in apply calls MUST be logic!, not none!.
	foreach word func-spec-words :fn [
		if refinement? word [set in obj to word! word false]
	]
	if refs [foreach ref refs [obj/:ref: true]]					; set refinements
	; can't use obj/:key: if key is a set-word!
	if args [foreach [key val] args [set in obj key :val]]		; set arg values
	obj
]
probe o-1: make-apply-obj-proto 'append
probe o-1: make-apply-obj-proto 'append/only
probe o-1: make-apply-obj-proto/with 'append/only/dup [count: 5]

probe o-1: make-apply-obj-proto/with 'find/case/part/tail/skip/with [wild: "*?+" length: 10 size: 2]
probe o-2: make-apply-obj-proto/with 'find/case/tail/part/with/skip [size: 2 length: 10 wild: "*?+"]
probe o-3: make-apply-obj-proto/with 'find/part/case/skip/with/tail [length: 10 size: 2 wild: "*?+"]

clear-obj: func [obj [object!]][set obj none]
; No easy way to clear map values but keep keys

set-apply-obj-proto: function [
	"Set values in an existing apply-object."
	obj  [object!] "Result of make-apply-obj-proto."
	refs [path! block! refinement!]
	args [block!]
	/clear "Clear all existing values."
][
	if clear [set obj none]	; clear object values
	;?? TBD maybe have the path include the func word to vet the spec and obj
	;if path? :fn [refs: next fn  fn: first fn]		; split path
	; IN doesn't support refinements. Have to cast to word.
	either refinement? refs [set in obj to word! refs true][
		foreach ref refs [set in obj to word! ref true]
		;foreach ref refs [k: to word! ref  obj/:k: true]
	]
	foreach [key val] args [set in obj key :val]	; can't use obj/:key: if key is a set-word!
	obj
]
probe o-1: make-apply-obj-proto 'append
probe o-1: set-apply-obj-proto  o-1 /only       [series: blk value: 'a count: 3]
probe o-1: set-apply-obj-proto  o-1 [/only/dup] [series: blk value: 'b count: 4]
probe o-1: set-apply-obj-proto  o-1 'only/dup   [series: blk value: 'c count: 5]
; errors, as it should, but we need a nicer message.
;probe o-1: set-apply-obj-proto  o-1 'foo/bar    [series: blk value: 'c count: 5]
; But if we have extra words in there, it works. Makes no sense for the
; actual call, as the refinements don't exist. But they do exist in the
; object, and it's a hackity way to set lots of logic values concisely.
probe o-1: func-spec-to-obj-proto/with :append [foo: 'a bar: 'b baz: 'c]
probe o-1: set-apply-obj-proto  o-1 'foo/bar       [series: blk value: 'c count: 5]
probe o-1: set-apply-obj-proto/clear  o-1 'foo/bar [series: blk value: 'c]

probe o-1: make-apply-obj-proto 'find
args: [series: blk value: 'a wild: "*?+" length: 10 size: 2]
probe o-1: set-apply-obj-proto  o-1 [/case/part/tail/skip/with] args

; We finally get here, and it's anticlimactic.
apply-object: func [
	"Call APPLY using an object's values as args."
	fn  [any-function!]
	obj [object!]
][
	apply :fn values-of obj
]