|
|
|
@ -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)))))) |
|
|
|
|
