hiiamboris/func-cache-estimation.red

## func-cache-estimation.red
Red []
#include %assert.red
#include %keep-type.red
#include %composite.red
#include %map-each.red
#include %format-number.red

#macro [#print string!] func [[manual] s e] [insert remove s [print #composite] s]

word-id: routine [word [any-type!] return: [integer!] /local w] [
	w: as red-word! word
	w/symbol
]

starting-length-factor: any [attempt [to 1 system/options/args/1]  1]
growth-per-iteration: 1

max-iter: total-iter: 0
total-size: 0

create-cache: function [spec [block!] ids [block!]] [
	;-- build a list [/ref1-id index-of-ref1 /ref2-id index-of-ref2 ...] to speedup cache creation
	refs: map-each/drop/eval [/i ref [refinement!]] spec [[word-id ref  i]]

	n0: n: starting-length-factor * length? ids
	r: clear next [0]
	append/dup r -1 n								;-- build a cache of size = n
	forever [										;-- increases cache until there are no collisions
		if foreach id ids [
			i: id % n + 1
			if r/:i >= 0 [break/return none]			;-- slot is already occupied - need bigger cache
			r/:i: id									;-- occupy the id slot
		][
			r/-1: n										;-- save the cache size
			map-each/self id r [						;-- finish the cache creation
				any [select/skip refs id 2  -1]
			]
			break
		]

		n: n + growth-per-iteration						;-- try longer cache
		forall r [r/1: -1]								;-- reset the buffer
		append/dup r -1 growth-per-iteration
	]
	r: copy head r
	#print "Created cache in (iter: n - n0 + 1) iterations: (mold r)"
	set 'max-iter max max-iter iter
	set 'total-iter total-iter + iter
	set 'total-size total-size + length? r
	r
]

get-ref-offset: function [ref [refinement!] spec [block!] cache [block!]] [
	if 0 = period: cache/1 [return none]		;-- no refinements in this func
	o: pick cache (word-id ref) % period + 2
	if o < 0 [return none]						;-- unused cache slot
	if spec/:o <> ref [return none]				;-- provided refinement does not exist in the spec
	o											;-- return refinement offset
]

list: to [] system/words
#print "((length? list) / 2) words total"
total-fun: 0
foreach [name value] list [
	unless any-function? :value [continue]
	unless spec: attempt [spec-of :value] [continue]
	spec: keep-type spec all-word!
	set 'total-fun total-fun + 1

	#print "^/Building cache for (name), with spec: (mold/flat spec)..."
	refs: keep-type spec refinement!
	if tail? refs [
		print "Function has no refinements, cache is empty: [0]"
		continue
	]
	#print "Has (length? refs) refinements: (mold/only/flat refs)"
	ids: map-each ref refs [word-id ref]
	#print "Resolved ids are: (ids)"
	cache: create-cache spec ids

	print "Testing lookups..."
	#print "offset of /non-existing: (get-ref-offset /non-existing spec cache)"
	foreach ref refs [
		#print "offset of (mold ref): (get-ref-offset ref spec cache)"
	]

	; #print [pad name 20 word-id name]
]

#print "=== Maximum number of iterations to create the cache: (max-iter), mean: (format-number total-iter / total-fun 1 2)"
#print "=== Total number of iterations to create all caches: (total-iter)"
#print "=== Total cache size: (total-size * 4) bytes for (total-fun) functions - that's (format-number total-size * 4 / total-fun 1 1) bytes per function"
	Red []
	#include %assert.red
	#include %keep-type.red
	#include %composite.red
	#include %map-each.red
	#include %format-number.red

	#macro [#print string!] func [[manual] s e] [insert remove s [print #composite] s]

	word-id: routine [word [any-type!] return: [integer!] /local w] [
	w: as red-word! word
	w/symbol
	]

	starting-length-factor: any [attempt [to 1 system/options/args/1] 1]
	growth-per-iteration: 1

	max-iter: total-iter: 0
	total-size: 0

	create-cache: function [spec [block!] ids [block!]] [
	;-- build a list [/ref1-id index-of-ref1 /ref2-id index-of-ref2 ...] to speedup cache creation
	refs: map-each/drop/eval [/i ref [refinement!]] spec [[word-id ref i]]

	n0: n: starting-length-factor * length? ids
	r: clear next [0]
	append/dup r -1 n ;-- build a cache of size = n
	forever [ ;-- increases cache until there are no collisions
	if foreach id ids [
	i: id % n + 1
	if r/:i >= 0 [break/return none] ;-- slot is already occupied - need bigger cache
	r/:i: id ;-- occupy the id slot
	][
	r/-1: n ;-- save the cache size
	map-each/self id r [ ;-- finish the cache creation
	any [select/skip refs id 2 -1]
	]
	break
	]

	n: n + growth-per-iteration ;-- try longer cache
	forall r [r/1: -1] ;-- reset the buffer
	append/dup r -1 growth-per-iteration
	]
	r: copy head r
	#print "Created cache in (iter: n - n0 + 1) iterations: (mold r)"
	set 'max-iter max max-iter iter
	set 'total-iter total-iter + iter
	set 'total-size total-size + length? r
	r
	]

	get-ref-offset: function [ref [refinement!] spec [block!] cache [block!]] [
	if 0 = period: cache/1 [return none] ;-- no refinements in this func
	o: pick cache (word-id ref) % period + 2
	if o < 0 [return none] ;-- unused cache slot
	if spec/:o <> ref [return none] ;-- provided refinement does not exist in the spec
	o ;-- return refinement offset
	]

	list: to [] system/words
	#print "((length? list) / 2) words total"
	total-fun: 0
	foreach [name value] list [
	unless any-function? :value [continue]
	unless spec: attempt [spec-of :value] [continue]
	spec: keep-type spec all-word!
	set 'total-fun total-fun + 1

	#print "^/Building cache for (name), with spec: (mold/flat spec)..."
	refs: keep-type spec refinement!
	if tail? refs [
	print "Function has no refinements, cache is empty: [0]"
	continue
	]
	#print "Has (length? refs) refinements: (mold/only/flat refs)"
	ids: map-each ref refs [word-id ref]
	#print "Resolved ids are: (ids)"
	cache: create-cache spec ids

	print "Testing lookups..."
	#print "offset of /non-existing: (get-ref-offset /non-existing spec cache)"
	foreach ref refs [
	#print "offset of (mold ref): (get-ref-offset ref spec cache)"
	]

	; #print [pad name 20 word-id name]
	]

	#print "=== Maximum number of iterations to create the cache: (max-iter), mean: (format-number total-iter / total-fun 1 2)"
	#print "=== Total number of iterations to create all caches: (total-iter)"
	#print "=== Total cache size: (total-size * 4) bytes for (total-fun) functions - that's (format-number total-size * 4 / total-fun 1 1) bytes per function"