Function cache size estimation and cache creation prototype

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"

[Click to see] More optimized version (doesn't have to clear the cache after each iteration, and with a special case for 1 refinement)

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
	if 1 = n [						;-- special case of only one refinement (e.g. /local)
		cache: reduce [1 refs/2]
		#print "Created cache immediately for single refinement: (mold cache)"
		set 'total-size total-size + length? cache
		return cache
	]

	;-- buffers should be static so we won't have to reallocate them
	slots: clear []
	append/dup slots -1 n							;-- build a buffer of size = n which will hold the remainders
	cache: clear next [0]							;-- cache will hold words ids (and `n`), filled at the same time
	append/dup cache -1 n
	forever [										;-- increases cache until there are no collisions
		collision?: no
		foreach id ids [
			i: id % n + 1
			if slots/:i = n [collision?: yes break]		;-- slot is already occupied - need bigger cache
			slots/:i: n									;-- occupy the id % n slot, `n` marks which iteration occupied it
			cache/:i: id								;-- save the id so we won't have to repeat (slow) division
		]
		unless collision? [
			cache/-1: n									;-- save the cache size
			repeat i n [								;-- finish the cache creation
				id: cache/:i
				cache/:i: either slots/:i = n [
					select/skip refs id 2				;-- by filling it with /ref indexes
				][	-1									;-- and removing leftovers from previous iterations
				]
			]
			break
		]
		n: n + growth-per-iteration						;-- try longer cache
		append/dup slots -1 growth-per-iteration
		append/dup cache -1 growth-per-iteration
	]
	cache: copy head cache
	#print "Created cache in (iter: n - n0 + 1) iterations: (mold cache)"
	set 'max-iter max max-iter iter
	set 'total-iter total-iter + iter
	set 'total-size total-size + length? cache
	cache
]

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
]

;-- extreme case
; all-refs: [/part /key /into /local /deep /types /only /dup /any /case /some /all /same /with /skip /last /reverse /tail /match /seed /secure /compare /stable /head /auto /lines /name /new /read /write /seek /allow /binary /info /as /append /next /fast /header /trap /flat /to /even /down /half-down /floor /ceiling /half-ceiling /extern /default /expand /args /word /show /force /copy /trace /left /logical /size /radians /return /base /full /year /month /day /time /zone /date /weekday /yearday /precise /utc /wait /console /shell /input /output /error /zlib /deflate /on /off /one /prescan /scan /tight /options /flags /no-wait /dir /safer /clean /length /update /pretty /ascii /quote /as-columns /as-records /trim /link /unlink /later /spec /offset /transparent /init /post /sub /parent /styles /index /x /y /font /mono /title /file /filter /save /multi /keep /target /native /lower /total /strict /stride /eval /drop /self]
; f1: func all-refs []
; f2: func sort copy all-refs []
; f3: func sort/reverse copy all-refs []
; probe length? all-refs

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!
	; append all-refs refs
	if tail? refs [
		print "Function has no refinements, cache is empty: [0]"
		set 'total-size total-size + 1		;-- count the `0` too
		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"