Browse Source

Abstract writing of introspect structs

This allows for a more flexible interface instead of requiring the
user to use files.
master
Macoy Madson 3 months ago
parent
commit
d4d49a6e80
  1. 13
      src/Dictionary.cake
  2. 12
      src/DynamicArray.cake
  3. 124
      src/Introspection.cake

13
src/Dictionary.cake

@ -253,13 +253,16 @@
(dict-get-length-void (deref dictionary-ptr-write)
(path field > field-type-metadata > struct-size)))
(scope
(fprintf out-file " %s " (? is-strdict "(strdict" "(dictionary"))
(var format-buffer ([] 128 char) (array 0))
(snprintf-or-return-false format-buffer " %s " (? is-strdict "(strdict" "(dictionary"))
(unless (write-func format-buffer 0 write-func-userdata) (return false))
(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)
(snprintf-or-return-false format-buffer ":length-hint %d " num-elements)
(unless (write-func format-buffer 0 write-func-userdata) (return false))
(each-in-range num-elements i
(var current-element (* void)
(offset-pointer-to-type (deref dictionary-ptr-write)
@ -267,13 +270,13 @@
(* void)))
(unless (write-introspect-struct-s-expr
(path field > field-type-metadata)
current-element out-file
current-element write-func write-func-userdata
;; 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"))
(unless (write-func ")" 0 write-func-userdata) (return false)))
(unless (write-func " null" 0 write-func-userdata) (return false)))
(return true))
(defun-local introspect-dictionary-get-key-details (element-key-offset-out (* size_t)

12
src/DynamicArray.cake

@ -210,11 +210,13 @@
(if (and (deref dynarray-ptr-write)
(dynarray-length (deref dynarray-ptr-write)))
(scope
(fprintf out-file " (dynarray ")
(unless (write-func " (dynarray " 0 write-func-userdata) (return false))
(var num-elements int (dynarray-length (deref dynarray-ptr-write)))
;; 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)
(var format-buffer ([] 128 char) (array 0))
(snprintf-or-return-false format-buffer ":length-hint %d " num-elements)
(unless (write-func format-buffer 0 write-func-userdata) (return false))
(each-in-range num-elements i
(var current-element (* void)
(offset-pointer-to-type (deref dynarray-ptr-write)
@ -222,13 +224,13 @@
(* void)))
(unless (write-introspect-struct-s-expr
(path field > field-type-metadata)
current-element out-file
current-element write-func write-func-userdata
;; 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"))
(unless (write-func ")" 0 write-func-userdata) (return false)))
(unless (write-func " null" 0 write-func-userdata) (return false)))
(return true))
(introspect-override-register-handler 'read-s-expr

124
src/Introspection.cake

@ -371,7 +371,8 @@
field (* (const metadata-field))
struct-to-write (* (const void))
value-offset size_t
out-file (* FILE)
write-func write-introspect-function
write-func-userdata (* void)
write-options write-introspect-struct-options
&return bool))
(tokenize-push (field handler function-invocation)
@ -379,7 +380,7 @@
field
struct-to-write
value-offset
out-file
write-func write-func-userdata
write-options)
(tokenize-push (field handler on-override-missing) (return false))
(set (field handler num-installed) start-num-installed-sentinel)
@ -757,13 +758,16 @@
(defun-local bool-to-string (value bool &return (* (const char)))
(return (? value "true" "false")))
(defun-local escape-write-string-element (out-file (* FILE) string-to-output (* (const char)))
(defun-local escape-write-string-element (write-func write-introspect-function
write-func-userdata (* void)
string-to-output (* (const char))
&return bool)
(when (or (not string-to-output) (= (deref string-to-output) 0))
(fputs " \"\"" out-file)
(return))
(unless (write-func " \"\"" 0 write-func-userdata) (return false))
(return true))
;; Space between element and string
(fputs " \"" out-file)
(unless (write-func " \"" 0 write-func-userdata) (return false))
(var write-start (* (const char)) string-to-output)
(var previous-char (* (const char)) string-to-output)
(each-char-in-string-const string-to-output current-char
@ -773,15 +777,18 @@
(= '\\' (deref current-char)))
(var range size_t (- current-char write-start))
(when (> range 0)
(fwrite write-start range 1 out-file))
(fputc '\\' out-file)
(unless (write-func write-start range write-func-userdata) (return false)))
;; TODO: Cakelisp gets confused by a string with that
(var backslash-hack ([] (const char)) (array '\\'))
(unless (write-func backslash-hack 0 write-func-userdata) (return false))
;; The next big write will write the now escaped character out
(set write-start current-char))
(set previous-char current-char))
;; previous-char is now the final character before null terminator.
(var range size_t (+ (- previous-char write-start) 1))
(fwrite write-start range 1 out-file)
(fputs "\"" out-file))
(unless (write-func write-start range write-func-userdata) (return false))
(unless (write-func "\"" 0 write-func-userdata) (return false))
(return true))
(defun-local read-escaped-string (buffer-out (* char) value-length size_t
read-string (* (const char)))
@ -813,18 +820,50 @@
write-introspect-struct-default
write-introspect-struct-add-newline)
;; When optional-limit-length is zero, write the string until a null terminator is encountered.
;; Otherwise, only write the given length.
(def-function-signature-global write-introspect-function (write-string (* (const char))
optional-limit-length (unsigned int)
userdata (* void)
&return bool))
(defun write-introspect-struct-file-writer (write-string (* (const char))
optional-limit-length (unsigned int)
userdata (* void)
&return bool)
(var-cast-to output-file (* FILE) userdata)
(if optional-limit-length
(fwrite write-string optional-limit-length 1 output-file)
(fprintf output-file "%s" write-string))
(return true))
(defmacro snprintf-or-return-false (output-buffer any format any &optional &rest arguments any)
(tokenize-push output
(unless (< (snprintf (token-splice output-buffer)
(sizeof (token-splice output-buffer))
(token-splice format)
(token-splice-rest arguments tokens))
(- (sizeof (token-splice output-buffer)) 1))
(fprintf stderr "write-introspect-struct-s-expr format-buffer was not large enough to fit\n")
(return false)))
(return true))
(defun write-introspect-struct-s-expr (struct-metadata (* (const metadata-struct))
struct-to-write (* (const void))
out-file (* FILE)
write-func write-introspect-function
write-func-userdata (* void)
write-options write-introspect-struct-options
&return bool)
(fprintf out-file "(%s" (path struct-metadata > name))
(var format-buffer ([] 2048 char) (array 0))
(snprintf-or-return-false format-buffer "(%s" (path struct-metadata > name))
(unless (write-func format-buffer 0 write-func-userdata) (return false))
(each-in-range (path struct-metadata > num-members) i
(var field (* (const metadata-field)) (addr (at i (path struct-metadata > members))))
(fprintf out-file " :%s" (path field > name))
(snprintf-or-return-false format-buffer " :%s" (path field > name))
(unless (write-func format-buffer 0 write-func-userdata) (return false))
(when (path field > count)
(fprintf out-file " (array"))
(unless (write-func " (array" 0 write-func-userdata) (return false)))
(cond
;; Numeric and boolean types
@ -832,43 +871,52 @@
(introspect-field-dispatch field value-offset
(var int-write (* int)
(offset-pointer-to-type struct-to-write value-offset (* int)))
(fprintf out-file " %d" (deref int-write))))
(snprintf-or-return-false format-buffer " %d" (deref int-write))
(unless (write-func format-buffer 0 write-func-userdata) (return false))))
((= (path field > type) introspect-type-float)
(introspect-field-dispatch field value-offset
(var float-write (* float)
(offset-pointer-to-type struct-to-write value-offset (* float)))
(fprintf out-file " %f" (deref float-write))))
(snprintf-or-return-false format-buffer " %f" (deref float-write))
(unless (write-func format-buffer 0 write-func-userdata) (return false))))
((= (path field > type) introspect-type-bool)
(introspect-field-dispatch field value-offset
(var bool-write (* bool)
(offset-pointer-to-type struct-to-write value-offset (* bool)))
(fprintf out-file " %s" (bool-to-string (deref bool-write)))))
(snprintf-or-return-false format-buffer " %s" (bool-to-string (deref bool-write)))
(unless (write-func format-buffer 0 write-func-userdata) (return false))))
((= (path field > type) introspect-type-char)
(var char-write (* char)
(offset-pointer-to-type struct-to-write (path field > offset) (* char)))
;; Write chars as integers to avoid writing e.g. '\0' in text
(fprintf out-file " %d" (deref char-write)))
(snprintf-or-return-false format-buffer " %d" (deref char-write))
(unless (write-func format-buffer 0 write-func-userdata) (return false)))
;; Strings
((= (path field > type) introspect-type-fixed-size-string)
(introspect-field-dispatch field value-offset
(var str-write (* (const char))
(offset-pointer-to-type struct-to-write value-offset (* (const char))))
(escape-write-string-element out-file (? str-write str-write ""))))
(unless (escape-write-string-element write-func write-func-userdata
(? str-write str-write ""))
(return false))))
((= (path field > type) introspect-type-string)
(introspect-field-dispatch field value-offset
(var str-write (* (* (const char)))
(offset-pointer-to-type struct-to-write value-offset (* (* (const char)))))
(escape-write-string-element out-file (? (deref str-write) (deref str-write) ""))))
(unless (escape-write-string-element write-func write-func-userdata
(? (deref str-write) (deref str-write) ""))
(return false))))
;; TODO: Add indentation for substructs to improve readability
((= (path field > type) introspect-type-introspect-struct)
(introspect-field-dispatch field value-offset
(var substruct-write (* void)
(offset-pointer-to-type struct-to-write value-offset (* void)))
(fprintf out-file " ")
(unless (write-func " " 0 write-func-userdata) (return false))
(write-introspect-struct-s-expr (path field > field-type-metadata)
substruct-write out-file
substruct-write
write-func write-func-userdata
write-introspect-struct-default)))
((= (path field > type) introspect-type-override)
@ -877,18 +925,17 @@
(return false))))
(true
;; (fprintf out-file " <unknown>")
(fprintf stderr "error: attempted to write field of unknown type %d\n" (path field > type))
(return false)))
(when (path field > count)
(fprintf out-file ")"))
(unless (write-func ")" 0 write-func-userdata) (return false)))
(when (< i (- (path struct-metadata > num-members) 1))
(fprintf out-file "\n")))
(unless (write-func "\n" 0 write-func-userdata) (return false))))
(fprintf out-file ")")
(unless (write-func ")" 0 write-func-userdata) (return false))
(when (= write-options write-introspect-struct-add-newline)
(fprintf out-file "\n"))
(unless (write-func "\n" 0 write-func-userdata) (return false)))
(return true))
(def-function-signature-global allocate-string-function (num-bytes size_t &return (* void)))
@ -1512,14 +1559,16 @@
&return bool)
(unless is-quiet
(fprintf stderr "Baseline:\n")
(unless (write-introspect-struct-s-expr struct-metadata baseline stderr
(unless (write-introspect-struct-s-expr struct-metadata baseline
write-introspect-struct-file-writer stderr
write-introspect-struct-add-newline)
(return false)))
(scope ;; Write to a file
(var out-file (* FILE) (fopen serialization-filename "wb"))
(unless out-file (return false))
(unless (write-introspect-struct-s-expr struct-metadata baseline out-file
(unless (write-introspect-struct-s-expr struct-metadata baseline
write-introspect-struct-file-writer out-file
write-introspect-struct-add-newline)
(fclose out-file)
(return false))
@ -1547,7 +1596,8 @@
(unless is-quiet
(fprintf stderr "Read-in struct:\n")
(unless (write-introspect-struct-s-expr struct-metadata read-struct stderr
(unless (write-introspect-struct-s-expr struct-metadata read-struct
write-introspect-struct-file-writer stderr
write-introspect-struct-add-newline)
(free-introspect-struct-fields
struct-metadata read-struct free)
@ -1636,7 +1686,9 @@
write-my-type
(var my-type-write (* my-type)
(offset-pointer-to-type struct-to-write value-offset (* my-type)))
(fprintf out-file " %d" (deref my-type-write))
(var format-buffer ([] 64 char) (array 0))
(snprintf-or-return-false format-buffer " %d" (deref my-type-write))
(unless (write-func format-buffer 0 write-func-userdata) (return false))
(return true))
(introspect-override-register-handler 'read-s-expr
@ -1686,8 +1738,8 @@
(offset-pointer-to-type struct-to-write value-offset (* (* my-nested-struct))))
(if (deref my-nested-struct-ptr-write)
;; (fprintf out-file " %d" (deref (deref my-nested-struct-ptr-write)))
(fprintf out-file " TODO")
(fprintf out-file " null"))
(unless (write-func " TODO" 0 write-func-userdata) (return false))
(unless (write-func " null" 0 write-func-userdata) (return false)))
(return true))
(introspect-override-register-handler 'read-s-expr
@ -1756,11 +1808,13 @@
(scope ;; Write to a file
(var out-file (* FILE) (fopen "MultiReads.cakedata" "wb"))
(unless out-file (return false))
(unless (write-introspect-struct-s-expr my-struct--metadata (addr a) out-file
(unless (write-introspect-struct-s-expr my-struct--metadata (addr a)
write-introspect-struct-file-writer out-file
write-introspect-struct-add-newline)
(fclose out-file)
(return false))
(unless (write-introspect-struct-s-expr my-struct--metadata (addr a) out-file
(unless (write-introspect-struct-s-expr my-struct--metadata (addr a)
write-introspect-struct-file-writer out-file
write-introspect-struct-add-newline)
(fclose out-file)
(return false))

Loading…
Cancel
Save