Browse Source

WIP strdict introspect support

windows-imgui
Macoy Madson 9 months ago
parent
commit
2302dd2a8e
  1. 3
      .gitignore
  2. 473
      src/Dictionary.cake

3
.gitignore

@ -73,4 +73,5 @@ test/imgui.ini
test/TestSerialize.cakedata
test/TestDynamicArraySerialize.cakedata
test/TestDictionarySerialize.cakedata
test/TestDictionarySerialize.cakedata
test/TestDictionarySerializeStrDict.cakedata

473
src/Dictionary.cake

@ -205,211 +205,274 @@
(return true))
(defmacro dict-set-struct-void (void-ptr-to-dict any element-size any
new-element-key any new-element-key-size any
struct-to-add any)
element-key any element-key-size any
element-key-offset any
struct-to-add any stb-put-mode symbol)
(tokenize-push output
(set (token-splice void-ptr-to-dict)
(stbds_hmput_key_wrapper (token-splice void-ptr-to-dict)
(token-splice element-size)
(addr (token-splice new-element-key))
(token-splice new-element-key-size)
STBDS_HM_BINARY))
(memcpy
(+ (* (token-splice element-size)
(path (dict-header-pointer-void (token-splice void-ptr-to-dict element-size)) > temp))
(type-cast (token-splice void-ptr-to-dict) (* char)))
(token-splice struct-to-add)
(token-splice element-size)))
(addr (token-splice element-key))
(token-splice element-key-size)
(token-splice stb-put-mode)))
(scope
(var dict-set-struct-start-element-ptr (* void)
(+ (* (token-splice element-size)
(path (dict-header-pointer-void (token-splice void-ptr-to-dict element-size)) > temp))
(type-cast (token-splice void-ptr-to-dict) (* char))))
(memcpy
dict-set-struct-start-element-ptr
(token-splice struct-to-add)
(token-splice element-size))
(when (= (token-splice stb-put-mode) STBDS_HM_STRING)
;; above line overwrites whole structure, so must rewrite key here if it was allocated internally
(memcpy (+ (type-cast dict-set-struct-start-element-ptr (* char))
(token-splice element-key-offset))
;; (deref (type-cast (path (dict-header-pointer-void
;; (token-splice void-ptr-to-dict element-size))
;; > hash_table)
;; (* (* char))))
(addr (deref (type-cast (path (dict-header-pointer-void
(token-splice void-ptr-to-dict element-size))
> hash_table)
(* char))))
(token-splice element-key-size)))
))
(return true))
;; Protect against really crazy array sizes due to e.g. text parsing error
(var reasonable-max-dictionary-read-length (const int) 100000)
(introspect-override-register-handler 'write-s-expr
(metadata-field-has-tag field "'dictionary")
write-dictionary-ptr
(var dictionary-ptr-write (* (* void))
(offset-pointer-to-type struct-to-write value-offset (* (* void))))
(if (and (deref dictionary-ptr-write)
(dict-get-length-void (deref dictionary-ptr-write)
(path field > field-type-metadata > struct-size)))
(scope
(fprintf out-file " (dictionary ")
(var num-elements int
(dict-get-length-void (deref dictionary-ptr-write)
(path field > field-type-metadata > struct-size)))
;; NOT required, because otherwise it'd make hand-editing a pain. This is for performance
;; only; the reader should not take this as a guarantee, hence "hint"
(fprintf out-file ":length-hint %d " num-elements)
(each-in-range num-elements i
(var current-element (* void)
(offset-pointer-to-type (deref dictionary-ptr-write)
(* i (path field > field-type-metadata > struct-size))
(* void)))
(unless (write-introspect-struct-s-expr
(path field > field-type-metadata)
current-element out-file
;; TODO: Pay attention to parent output settings
(? (= i (- num-elements 1)) write-introspect-struct-default
write-introspect-struct-add-newline))
(return false)))
(fprintf out-file ")"))
(fprintf out-file " null"))
(return true))
(introspect-override-register-handler 'read-s-expr
(metadata-field-has-tag field "'dictionary")
read-dictionary-ptr
(var dictionary-ptr-read (* (* void))
(offset-pointer-to-type struct-out value-offset (* (* void))))
;; You need to clean up the elements; I'd just clear them in this function, but that could lead
;; to memory leaks
(assert (not (dict-get-length-void (deref dictionary-ptr-read)
(path field > field-type-metadata > struct-size))))
;; Determine some details about elements
(var element-key-offset size_t 0)
(var element-key-size size_t 0)
(each-in-range (path field > field-type-metadata > num-members) i
(var possible-key-field (* (const metadata-field))
(addr (at i (path field > field-type-metadata > members))))
(when (= 0 (strcmp "key" (path possible-key-field > name)))
(set element-key-offset (path possible-key-field > offset))
(set element-key-size (path possible-key-field > element-size))
(break)))
(unless element-key-size
(fprintf stderr "error: failed to find field named \"key\" in element struct %s\n"
(path field > field-type-metadata > name))
(dict-free-void (deref dictionary-ptr-read)
(path field > field-type-metadata > struct-size))
(set (deref dictionary-ptr-read) null)
(return false))
(var start-tag (* (const char)) "(dictionary")
(var start-tag-length (const size_t) (strlen start-tag))
(var length-hint-tag (* (const char)) ":length-hint")
(var length-hint-tag-length (const size_t) (strlen length-hint-tag))
(unless (= 0 (strncmp start-tag value-argument-start start-tag-length))
(fprintf stderr "error: expected \"%s\", got \"%s\"\n" start-tag value-argument-start)
(return false))
(var start-arguments (* (const char)) (+ value-argument-start start-tag-length))
(var argument-start (* (const char)) null)
(var argument-end (* (const char)) null)
(s-expr-get-next-argument-start-end start-arguments (addr argument-start) (addr argument-end))
(while (and argument-start argument-end)
(cond
((= 0 (strncmp length-hint-tag argument-start length-hint-tag-length))
(s-expr-get-next-argument-start-end argument-end (addr argument-start)
(addr argument-end))
;; TODO Reduce duplication!
(var basic-type-buffer ([] 64 char) (array 0))
(var value-length size_t (- argument-end argument-start))
(when (> value-length (array-size basic-type-buffer))
(fprintf stderr "error: failed to copy basic type of size %d into buffer of size %d from value "
(type-cast value-length int) (type-cast (array-size basic-type-buffer) int))
(print-string-range argument-start argument-end true)
(return false))
(memcpy basic-type-buffer argument-start value-length)
(var length-hint int (atoi basic-type-buffer))
(assert (< length-hint reasonable-max-dictionary-read-length))
(ignore ;; TODO: Dictionary initial size, which doesn't seem exposed by stb
(fprintf stderr "Reserving capacity %d\n" length-hint)
(dict-set-capacity-with-element-size
dictionary-ptr-read
(path field > field-type-metadata > struct-size)
length-hint)))
(true
;; TODO: Expose option to not use malloc
(var new-element (* void) (malloc (path field > field-type-metadata > struct-size)))
(unless (read-introspect-struct-s-expr (path field > field-type-metadata)
new-element
argument-start string-allocate)
(fprintf stderr "error: failed to read element into dictionary: ")
(print-string-range argument-start argument-end true)
(free new-element)
(dict-free-void (deref dictionary-ptr-read)
(path field > field-type-metadata > struct-size))
(set (deref dictionary-ptr-read) null)
(return false))
(var new-element-key (* void)
(offset-pointer-to-type new-element element-key-offset (* void)))
(dict-set-struct-void (deref dictionary-ptr-read)
(path field > field-type-metadata > struct-size)
new-element-key element-key-size
new-element)
(free new-element)))
;; Creates both strdict and binary key dictionary overrides
(defmacro create-dictionary-introspect-overrides (handler-suffix symbol tag string
s-expr-opening-marker string
;; e.g. STBDS_HM_BINARY
stb-put-mode symbol
;; When reading in a fresh dictionary, do this
;; before starting reading
dictionary-setup any)
(var format-buffer ([] 128 char) (array 0))
(var writer-name Token (deref handler-suffix))
(var reader-name Token (deref handler-suffix))
(var compare-name Token (deref handler-suffix))
(var free-name Token (deref handler-suffix))
(defstruct names-to-create
out-token (* Token)
prefix (* (const char)))
(var names ([] names-to-create) (array
(array (addr writer-name) "write")
(array (addr reader-name) "read")
(array (addr compare-name) "compare")
(array (addr free-name) "free")))
(each-in-array names i
(PrintfBuffer format-buffer "%s-%s" (field (at i names) prefix)
(call-on c_str (path handler-suffix > contents)))
(set (path (at i names) . out-token > contents) format-buffer))
(s-expr-get-next-argument-start-end argument-end (addr argument-start)
(addr argument-end)))
(tokenize-push output
(introspect-override-register-handler 'write-s-expr
(metadata-field-has-tag field (token-splice tag))
(token-splice-addr writer-name)
(var dictionary-ptr-write (* (* void))
(offset-pointer-to-type struct-to-write value-offset (* (* void))))
(if (and (deref dictionary-ptr-write)
(dict-get-length-void (deref dictionary-ptr-write)
(path field > field-type-metadata > struct-size)))
(scope
(fprintf out-file " %s " (token-splice s-expr-opening-marker))
(var num-elements int
(dict-get-length-void (deref dictionary-ptr-write)
(path field > field-type-metadata > struct-size)))
;; NOT required, because otherwise it'd make hand-editing a pain. This is for performance
;; only; the reader should not take this as a guarantee, hence "hint"
(fprintf out-file ":length-hint %d " num-elements)
(each-in-range num-elements i
(var current-element (* void)
(offset-pointer-to-type (deref dictionary-ptr-write)
(* i (path field > field-type-metadata > struct-size))
(* void)))
(unless (write-introspect-struct-s-expr
(path field > field-type-metadata)
current-element out-file
;; TODO: Pay attention to parent output settings
(? (= i (- num-elements 1)) write-introspect-struct-default
write-introspect-struct-add-newline))
(return false)))
(fprintf out-file ")"))
(fprintf out-file " null"))
(return true))
(introspect-override-register-handler 'read-s-expr
(metadata-field-has-tag field (token-splice tag))
(token-splice-addr reader-name)
(var dictionary-ptr-read (* (* void))
(offset-pointer-to-type struct-out value-offset (* (* void))))
;; You need to clean up the elements; I'd just clear them in this function, but that could lead
;; to memory leaks
(assert (not (dict-get-length-void (deref dictionary-ptr-read)
(path field > field-type-metadata > struct-size))))
(token-splice dictionary-setup)
;; Determine some details about elements
(var element-key-offset size_t 0)
(var element-key-size size_t 0)
(each-in-range (path field > field-type-metadata > num-members) i
(var possible-key-field (* (const metadata-field))
(addr (at i (path field > field-type-metadata > members))))
(when (= 0 (strcmp "key" (path possible-key-field > name)))
(set element-key-offset (path possible-key-field > offset))
(set element-key-size (path possible-key-field > element-size))
(break)))
(unless element-key-size
(fprintf stderr "error: failed to find field named \"key\" in element struct %s\n"
(path field > field-type-metadata > name))
(dict-free-void (deref dictionary-ptr-read)
(path field > field-type-metadata > struct-size))
(set (deref dictionary-ptr-read) null)
(return false))
(var start-tag (* (const char)) (token-splice s-expr-opening-marker))
(var start-tag-length (const size_t) (strlen start-tag))
(var length-hint-tag (* (const char)) ":length-hint")
(var length-hint-tag-length (const size_t) (strlen length-hint-tag))
(unless (= 0 (strncmp start-tag value-argument-start start-tag-length))
(fprintf stderr "error: expected \"%s\", got \"%s\"\n" start-tag value-argument-start)
(return false))
(var start-arguments (* (const char)) (+ value-argument-start start-tag-length))
(var argument-start (* (const char)) null)
(var argument-end (* (const char)) null)
(s-expr-get-next-argument-start-end start-arguments (addr argument-start) (addr argument-end))
(while (and argument-start argument-end)
(cond
((= 0 (strncmp length-hint-tag argument-start length-hint-tag-length))
(s-expr-get-next-argument-start-end argument-end (addr argument-start)
(addr argument-end))
;; TODO Reduce duplication!
(var basic-type-buffer ([] 64 char) (array 0))
(var value-length size_t (- argument-end argument-start))
(when (> value-length (array-size basic-type-buffer))
(fprintf stderr "error: failed to copy basic type of size %d into buffer of size %d from value "
(type-cast value-length int) (type-cast (array-size basic-type-buffer) int))
(print-string-range argument-start argument-end true)
(return false))
(memcpy basic-type-buffer argument-start value-length)
(var length-hint int (atoi basic-type-buffer))
(assert (< length-hint reasonable-max-dictionary-read-length))
(ignore ;; TODO: Dictionary initial size, which doesn't seem exposed by stb
(fprintf stderr "Reserving capacity %d\n" length-hint)
(dict-set-capacity-with-element-size
dictionary-ptr-read
(path field > field-type-metadata > struct-size)
length-hint)))
(true
;; TODO: Expose option to not use malloc
(var new-element (* void) (malloc (path field > field-type-metadata > struct-size)))
(unless (read-introspect-struct-s-expr (path field > field-type-metadata)
new-element
argument-start string-allocate)
(fprintf stderr "error: failed to read element into dictionary: ")
(print-string-range argument-start argument-end true)
(free-introspect-struct-fields (path field > field-type-metadata)
new-element free)
(free new-element)
(dict-free-void (deref dictionary-ptr-read)
(path field > field-type-metadata > struct-size))
(set (deref dictionary-ptr-read) null)
(return false))
(var new-element-key (* void)
(offset-pointer-to-type new-element element-key-offset (* void)))
(dict-set-struct-void (deref dictionary-ptr-read)
(path field > field-type-metadata > struct-size)
new-element-key element-key-size element-key-offset
new-element (token-splice stb-put-mode))
(free-introspect-struct-fields (path field > field-type-metadata)
new-element free)
(free new-element)))
(s-expr-get-next-argument-start-end argument-end (addr argument-start)
(addr argument-end)))
(return true))
(introspect-override-register-handler 'compare
(metadata-field-has-tag field (token-splice tag))
(token-splice-addr compare-name)
(var dictionary-a (* (* void))
(offset-pointer-to-type struct-a value-offset (* (* void))))
(var dictionary-b (* (* void))
(offset-pointer-to-type struct-b value-offset (* (* void))))
(var element-size size_t (path field > field-type-metadata > struct-size))
(when (!= (deref dictionary-a) (deref dictionary-b))
(var num-elements-a int
(dict-get-length-void (deref dictionary-a)
element-size))
(var num-elements-b int
(dict-get-length-void (deref dictionary-b)
element-size))
(when (!= num-elements-a num-elements-b)
(when print-difference
(fprintf stderr "structs differ by field '%s' [%d] length (%d vs %d)\n"
(path field > name)
(type-cast dispatch-value-index int)
(type-cast (dict-get-length-void dictionary-a element-size) int)
(type-cast (dict-get-length-void dictionary-b element-size) int)))
(return (- num-elements-a num-elements-b)))
(each-in-range num-elements-a i
(var current-element-a (* void)
(offset-pointer-to-type (deref dictionary-a)
(* i element-size)
(* void)))
(var current-element-b (* void)
(offset-pointer-to-type (deref dictionary-b)
(* i element-size)
(* void)))
(var return-value int
(compare-introspect-struct-internal (path field > field-type-metadata)
current-element-a
current-element-b
print-difference))
(when (!= 0 return-value)
(when print-difference
(fprintf stderr "structs differ by field '%s' [%d][%d]\n"
(path field > name)
(type-cast dispatch-value-index int) i))
(return return-value))))
(return 0))
(introspect-override-register-handler 'free
(metadata-field-has-tag field (token-splice tag))
(token-splice-addr free-name)
(var dict-ptr (* (* void))
(offset-pointer-to-type struct-to-destroy value-offset (* (* void))))
(var element-size size_t (path field > field-type-metadata > struct-size))
(var num-elements int
(dict-get-length-void (deref dict-ptr) element-size))
(each-in-range num-elements i ;; Deep free
(var current-element (* void)
(offset-pointer-to-type (deref dict-ptr)
(* i element-size)
(* void)))
(free-introspect-struct-fields (path field > field-type-metadata)
current-element string-free))
(dict-free-void (deref dict-ptr)
(path field > field-type-metadata > struct-size))
(set (deref dict-ptr) null)))
(return true))
(introspect-override-register-handler 'compare
(metadata-field-has-tag field "'dictionary")
compare-dictionary
(var dictionary-a (* (* void))
(offset-pointer-to-type struct-a value-offset (* (* void))))
(var dictionary-b (* (* void))
(offset-pointer-to-type struct-b value-offset (* (* void))))
(var element-size size_t (path field > field-type-metadata > struct-size))
(when (!= (deref dictionary-a) (deref dictionary-b))
(var num-elements-a int
(dict-get-length-void (deref dictionary-a)
element-size))
(var num-elements-b int
(dict-get-length-void (deref dictionary-b)
element-size))
(when (!= num-elements-a num-elements-b)
(when print-difference
(fprintf stderr "structs differ by field '%s' [%d] length (%d vs %d)\n"
(path field > name)
(type-cast dispatch-value-index int)
(type-cast (dict-get-length-void dictionary-a element-size) int)
(type-cast (dict-get-length-void dictionary-b element-size) int)))
(return (- num-elements-a num-elements-b)))
(each-in-range num-elements-a i
(var current-element-a (* void)
(offset-pointer-to-type (deref dictionary-a)
(* i element-size)
(* void)))
(var current-element-b (* void)
(offset-pointer-to-type (deref dictionary-b)
(* i element-size)
(* void)))
(var return-value int
(compare-introspect-struct-internal (path field > field-type-metadata)
current-element-a
current-element-b
print-difference))
(when (!= 0 return-value)
(when print-difference
(fprintf stderr "structs differ by field '%s' [%d][%d]\n"
(path field > name)
(type-cast dispatch-value-index int) i))
(return return-value))))
(return 0))
(introspect-override-register-handler 'free
(metadata-field-has-tag field "'dictionary")
free-dict-ptr
(var dict-ptr (* (* void))
(offset-pointer-to-type struct-to-destroy value-offset (* (* void))))
(var element-size size_t (path field > field-type-metadata > struct-size))
(var num-elements int
(dict-get-length-void (deref dict-ptr) element-size))
(each-in-range num-elements i ;; Deep free
(var current-element (* void)
(offset-pointer-to-type (deref dict-ptr)
(* i element-size)
(* void)))
(free-introspect-struct-fields (path field > field-type-metadata)
current-element string-free))
(dict-free-void (deref dict-ptr)
(path field > field-type-metadata > struct-size))
(set (deref dict-ptr) null))))
(create-dictionary-introspect-overrides dictionary-ptr "'dictionary" "(dictionary"
STBDS_HM_BINARY (ignore))
(create-dictionary-introspect-overrides
strdict-ptr "'strdict" "(strdict"
STBDS_HM_STRING
;; Set mode to strdup, otherwise we lose our keys
(set
(deref dictionary-ptr-read)
(stbds_shmode_func_wrapper (deref dictionary-ptr-read)
(path field > field-type-metadata > struct-size)
STBDS_SH_STRDUP)))))
;;
;; Tests
@ -526,7 +589,13 @@
key int
value float)
(def-introspect-struct my-dict
dictionary (* dict-entry) (override 'dictionary)) ;; TODO strdict
dictionary (* dict-entry) (override 'dictionary))
(def-introspect-struct strdict-entry
key (* char)
value float)
(def-introspect-struct my-strdict
dictionary (* strdict-entry) (override 'strdict))
(defun test--dictionary-introspection (&return int)
(var baseline my-dict (array 0))
@ -539,4 +608,18 @@
(return 1))
(free-introspect-struct-fields my-dict--metadata (addr baseline) free)
(var baseline-strdict my-strdict (array 0))
(strdict-use-key-arena (field baseline-strdict dictionary))
(each-in-range 10 i ;; Don't do more than 10!
(var my-entry strdict-entry (array null (* i 42.f)))
(var buffer ([] char) (array '0'))
(set (at 0 buffer) (+ i (at 0 buffer))) ;; Limits count to 9
(set (field my-entry key) buffer)
(strdict-set-struct (field baseline-strdict dictionary) my-entry))
(unless (introspect-test-struct my-strdict--metadata (addr baseline-strdict)
"TestDictionarySerializeStrDict.cakedata")
(return 1))
(free-introspect-struct-fields my-strdict--metadata (addr baseline-strdict) free)
(return 0))))))

Loading…
Cancel
Save