GameLib is a collection of libraries for creating applications in Cakelisp.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

1947 lines
90 KiB

(import "FileUtilities.cake"
"CHelpers.cake" "ComptimeHelpers.cake")
(c-import "<stdlib.h>" ;; atoi, atof
"<string.h>" ;; strcmp
"<ctype.h>" ;; For isspace
&with-decls "<stdio.h>" ;; FILE ;; TODO: How can I remove this from header?
"<stddef.h>") ;; For size_t, offsetof
;;
;; Comptime
;;
;; Allows modules to conditionally define introspection overrides in GameLib without requiring
;; everything use Introspection
(comptime-define-symbol 'Introspection)
(defun-comptime is-type-string (tokens (& (const (<> (in std vector) Token)))
start-type-token-index int
;; Will distinguish which sub-type of string it is
possible-string-introspect-type (* (* (const char)))
&return bool)
(var start-type-token (* (const Token)) (addr (at start-type-token-index tokens)))
;; No string types can be expressed with a single keyword
(unless (= TokenType_OpenParen (path start-type-token > type))
(set (deref possible-string-introspect-type) null)
(return false))
(var start-possible-char-type int -1)
(cond
((std-str-equals (path (+ 1 start-type-token) > contents) "*")
(set start-possible-char-type (+ 2 start-type-token-index))
(set (deref possible-string-introspect-type) "introspect-type-string"))
((std-str-equals (path (+ 1 start-type-token) > contents) "[]")
(set start-possible-char-type (+ 3 start-type-token-index)) ;; Skip the size ;; TODO Bug if size is expression
(set (deref possible-string-introspect-type) "introspect-type-fixed-size-string"))
(true
(set (deref possible-string-introspect-type) null)
(return false)))
(var start-possible-char-type-token (* (const Token))
(addr (at start-possible-char-type tokens)))
(cond
((and (= TokenType_OpenParen (path start-possible-char-type-token > type))
(= TokenType_Symbol (path (+ 1 start-possible-char-type-token) > type))
(std-str-equals (path (+ 1 start-possible-char-type-token) > contents) "const")
(std-str-equals (path (+ 2 start-possible-char-type-token) > contents) "char"))
(return true))
((and (= TokenType_Symbol (path start-possible-char-type-token > type))
(std-str-equals (path start-possible-char-type-token > contents) "char"))
(return true))
(true
(set (deref possible-string-introspect-type) null)
(return false)))
(set (deref possible-string-introspect-type) null)
(return false))
(defun-comptime introspect-metadata-name-from-struct-name (buffer-out (* char) buffer-size size_t
struct-name (* (const char)))
(SafeSnprintf buffer-out buffer-size "%s--metadata-def"
struct-name))
(defun-comptime introspect-metadata-pointer-name-from-struct-name (buffer-out (* char)
buffer-size size_t
struct-name (* (const char)))
(SafeSnprintf buffer-out buffer-size "%s--metadata"
struct-name))
;; Use macro so it can be used in comptime and at runtime
(defmacro introspect-get-num-tags ()
;; Tags are arbitrarily limited to 2. They are strings to facilitate cross-executable
;; communication as well as not require any enum updating
;; TODO: Don't change this without also updating the metadata-field! The macro doesn't work yet there
(tokenize-push output 2)
(return true))
;; The main interface to create introspect-structs. Define them just like regular structs, only you
;; can add a () list after the type to specify tags and other things.
;; Note that you will need to define override handlers for types the system can't figure out how to
;; read/write/compare etc.
(defmacro def-introspect-struct (struct-name symbol &rest arguments any)
(var processed-arguments (* (<> std::vector Token)) (new (<> std::vector Token)))
(call-on push_back (field environment comptimeTokens) processed-arguments)
(var fields-metadata (* (<> std::vector Token)) (new (<> std::vector Token)))
(call-on push_back (field environment comptimeTokens) fields-metadata)
(var end-token-index int (FindCloseParenTokenIndex tokens startTokenIndex))
(var num-parens int 1) ;; Count the opening of the struct definition
(defenum read-state
state-variable-name
state-variable-type
state-variable-annotations)
(var state read-state state-variable-name)
;; TODO: Need better helper functions for getting tokens vs. elements (where element can be array or symbol)
(var start-members int (getExpectedArgument "first member" tokens startTokenIndex 2 end-token-index))
(when (= -1 start-members)
(return false))
(each-token-argument-in tokens start-members end-token-index i
(var name-token (* (const Token))
(addr (at i tokens)))
(set i (getNextArgument tokens i end-token-index))
(var type-token-index int i)
(var type-token (* (const Token))
(addr (at i tokens)))
;; Read annotations
(var ignore-field bool false)
(var override-field bool false)
(var possible-annotation-index int (getNextArgument tokens i end-token-index))
(var annotations-token (* (const Token))
(addr (at possible-annotation-index tokens)))
(var tags-tokens (<> (in std vector) Token))
(call-on resize tags-tokens (introspect-get-num-tags))
(each-in-range (call-on size tags-tokens) i
(set (at i tags-tokens) (deref type-token))
(set (field (at i tags-tokens) type) TokenType_Symbol)
(set (field (at i tags-tokens) contents) "null"))
(var next-free-tag-token int 0)
(when (= TokenType_OpenParen (path annotations-token > type))
;; Process annotation
(var end-annotation-index int (FindCloseParenTokenIndex tokens possible-annotation-index))
(each-token-argument-in tokens (+ 1 possible-annotation-index) end-annotation-index annotation-arg
(var annotation-token (* (const Token)) (addr (at annotation-arg tokens)))
(cond
((and (= TokenType_Symbol (path annotation-token > type))
(std-str-equals (path annotation-token > contents) "ignore"))
(set ignore-field true))
((and (= TokenType_Symbol (path annotation-token > type))
(std-str-equals (path annotation-token > contents) "override"))
(set override-field true))
((or
(= (path annotation-token > type) TokenType_String)
(= (at 0 (path annotation-token > contents)) '\''))
(when (>= next-free-tag-token (call-on size tags-tokens))
(ErrorAtTokenf (deref annotation-token)
"the max number of tags is %d. Consider consolidating your tags or " \
"raise the max in Introspection.cake"
(type-cast (call-on size tags-tokens) int))
(return false))
(set (at next-free-tag-token tags-tokens) (deref annotation-token))
(set (field (at next-free-tag-token tags-tokens) type) TokenType_String)
(incr next-free-tag-token))))
;; Absorb the argument as part of this field
(set i possible-annotation-index))
(unless ignore-field ;; Build field metadata
(var name-to-string-token Token (deref name-token))
(set (field name-to-string-token type) TokenType_String)
(var possible-string-introspect-type (* (const char)) null)
(var core-type-token (* (const Token)) type-token)
(var core-type-token-index int type-token-index)
(var is-override-pointer bool false)
(var array-count-token (* (const Token)) null)
(when (= (path core-type-token > type) TokenType_OpenParen)
;; Strip off pointer to store core type
(when (and (std-str-equals (path (+ 1 core-type-token) > contents) "*")
;; Strings get their own special handling
(not (is-type-string tokens core-type-token-index
(addr possible-string-introspect-type))))
;; Require the user to provide an override to handle any pointers
(set override-field true)
;; Ensure that if this is an array of pointers, we're using the size of the pointer, not
;; the size of the element. If the size is needed, use the metadata-struct to get it
(set is-override-pointer true)
(set core-type-token-index (+ 2 core-type-token-index)) ;; skip (*. TODO Handle (* (const X))
(set core-type-token (addr (at core-type-token-index tokens))))
(when (and (std-str-equals (path (+ 1 core-type-token) > contents) "[]")
;; Exclude arrays of chars because they are handled like strings
(not (is-type-string tokens core-type-token-index
(addr possible-string-introspect-type))))
;; Count must be provided in struct definitions
(set array-count-token (+ 2 core-type-token))
;; Skip over array stuff so the basic type can be found
(var end-type-index int (FindCloseParenTokenIndex tokens core-type-token-index))
(var start-core-type-index int (getNextArgument tokens (+ 2 core-type-token-index) end-type-index))
(set core-type-token-index start-core-type-index)
(set core-type-token (addr (at core-type-token-index tokens)))))
(set possible-string-introspect-type null)
(var field-introspect-type Token (deref core-type-token))
(set (field field-introspect-type type) TokenType_Symbol)
(var determined-type-string (* (const char)) null)
(var type-is-string bool false)
(var field-type-metadata-from-core-type bool is-override-pointer)
(cond
(override-field
(set determined-type-string "introspect-type-override"))
((std-str-equals (path core-type-token > contents) "int")
(set determined-type-string "introspect-type-int"))
((std-str-equals (path core-type-token > contents) "float")
(set determined-type-string "introspect-type-float"))
((std-str-equals (path core-type-token > contents) "bool")
(set determined-type-string "introspect-type-bool"))
((std-str-equals (path core-type-token > contents) "char")
(set determined-type-string "introspect-type-char"))
((is-type-string tokens core-type-token-index (addr possible-string-introspect-type))
(set type-is-string true)
(set determined-type-string possible-string-introspect-type))
;; (true
;; (ErrorAtToken (deref core-type-token) "cannot generate metadata for unknown type")
;; (return false))
(true
;; TODO: Have cakelisp verify structures are introspectable at comptime rather than C++ at link time?
(set determined-type-string "introspect-type-introspect-struct")
(set field-type-metadata-from-core-type true)))
(set (field field-introspect-type contents) determined-type-string)
;; In the case of substructures or pointers to structures, they must be introspect structs in
;; order to be able to be handled correctly. Determine the metadata name here
;; TODO: Allow completely overridden pointers to structs which aren't introspect structs
(var field-type-metadata-token Token (deref core-type-token))
(set (field field-type-metadata-token type) TokenType_Symbol)
(call-on clear (field field-type-metadata-token contents))
(when field-type-metadata-from-core-type
(var type-metadata-pointer-name ([] 128 char) (array 0))
(introspect-metadata-pointer-name-from-struct-name
type-metadata-pointer-name (sizeof type-metadata-pointer-name)
(call-on c_str (path core-type-token > contents)))
(set (field field-type-metadata-token contents) type-metadata-pointer-name))
(var field-count Token (deref core-type-token))
(unless array-count-token
(set (field field-count type) TokenType_Symbol)
(set (field field-count contents) "0")
(set array-count-token (addr field-count)))
(var field-type-metadata-reference (<> (in std vector) Token))
(if (call-on empty (field field-type-metadata-token contents))
(tokenize-push field-type-metadata-reference null)
(tokenize-push field-type-metadata-reference
(token-splice-addr field-type-metadata-token)))
(var field-type-element-size (<> (in std vector) Token))
(cond
;; A somewhat special case: repurpose element-size where a fixed char array is one element
((= 0 (strcmp determined-type-string "introspect-type-fixed-size-string"))
(tokenize-push field-type-element-size (token-splice (+ 2 core-type-token))))
(type-is-string
(tokenize-push field-type-element-size (sizeof char)))
(is-override-pointer ;; Assume pointers are the same size
(tokenize-push field-type-element-size (sizeof (type (* void)))))
(true
(tokenize-push field-type-element-size (sizeof (type (token-splice core-type-token))))))
(tokenize-push (deref fields-metadata)
(array (token-splice-addr name-to-string-token)
(token-splice-addr field-introspect-type)
(token-splice-array field-type-metadata-reference)
(offsetof (type (token-splice struct-name)) (token-splice name-token))
(token-splice-array field-type-element-size)
(token-splice array-count-token)
(array (token-splice-array tags-tokens)))))
;; Output regular struct fields
(PushBackTokenExpression (deref processed-arguments) name-token)
(PushBackTokenExpression (deref processed-arguments) type-token))
;; Output metadata
(var metadata-name Token (deref struct-name))
(scope
(var metadata-name-buffer ([] 128 char) (array 0))
(introspect-metadata-name-from-struct-name
metadata-name-buffer (sizeof metadata-name-buffer)
(call-on c_str (path struct-name > contents)))
(set (field metadata-name contents) metadata-name-buffer))
(var metadata-pointer-name Token (deref struct-name))
(scope
(var metadata-pointer-name-buffer ([] 128 char) (array 0))
(introspect-metadata-pointer-name-from-struct-name
metadata-pointer-name-buffer (sizeof metadata-pointer-name-buffer)
(call-on c_str (path struct-name > contents)))
(set (field metadata-pointer-name contents) metadata-pointer-name-buffer))
(var metadata-fields-name Token (deref struct-name))
(scope
(var metadata-fields-name-buffer ([] 128 char) (array 0))
(PrintfBuffer metadata-fields-name-buffer "%s--metadata-fields"
(call-on c_str (path struct-name > contents)))
(set (field metadata-fields-name contents) metadata-fields-name-buffer))
(var struct-name-to-str Token (deref struct-name))
(set (field struct-name-to-str type) TokenType_String)
;; TODO: global vs. local
(tokenize-push output
(defstruct (token-splice struct-name)
(token-splice-array (deref processed-arguments)))
(var (token-splice-addr metadata-fields-name) ([] metadata-field)
(array (token-splice-array (deref fields-metadata))))
(var (token-splice-addr metadata-name) metadata-struct
(array (token-splice-addr struct-name-to-str)
(token-splice-addr metadata-fields-name)
(array-size (token-splice-addr metadata-fields-name))
(sizeof (type (token-splice struct-name)))))
;; Allow access to the metadata without having to declare all the types in the header
(forward-declare (struct metadata-struct)) ;; TODO Would be nice to not do this for every struct
(var-global (token-splice-addr metadata-pointer-name) (* (const metadata-struct))
(addr (token-splice-addr metadata-name))))
(return true))
;; TODO: This is a limitation of not being able to declare and reference new types in comptime
(defmacro introspect-override-define-types ()
(tokenize-push output
(defstruct introspect-override-handler
handler-type (* (const char))
override-function-name Token
function-signature (<> (in std vector) Token)
function-invocation (<> (in std vector) Token)
on-override-missing (<> (in std vector) Token)
registered-handlers (<> (in std unordered_map)
(* (const Token)) ;; Handler name
(* (const Token))) ;; Condition to invoke this handler
num-installed int)
(defstruct introspect-override-state
handlers-by-type (<> (in std vector) introspect-override-handler)))
(return true))
(defun-comptime destroy-introspect-override-state (data (* void))
(introspect-override-define-types)
(delete (type-cast data (* introspect-override-state))))
;; Must return void because types cannot be defined in comptime
(defun-comptime create-introspect-override-state (environment (& EvaluatorEnvironment)
state-out (* (* void))
;; Needs to return bool only because tokenize-push
&return bool)
(set (deref state-out) null)
(introspect-override-define-types)
(var overrides-state (* introspect-override-state) (new introspect-override-state))
(unless (CreateCompileTimeVariable environment
"introspect-override-handlers" "(* introspect-override-state)"
(type-cast overrides-state (* void))
"destroy-introspect-override-state")
(delete overrides-state)
(return false))
;; By setting -1, we ensure the override handler functions are generated even if none are
;; registered, to make sure everything still compiles
(var start-num-installed-sentinel int -1)
(scope
(var handler introspect-override-handler)
(set (field handler handler-type) "'write-s-expr")
(set (field handler override-function-name type) TokenType_Symbol)
(set (field handler override-function-name source) "Introspection.cake")
(set (field handler override-function-name contents)
"write-s-expr-handle-override")
(tokenize-push (field handler function-signature)
(struct-metadata (* (const metadata-struct))
field (* (const metadata-field))
struct-to-write (* (const void))
value-offset size_t
write-func write-introspect-function
write-func-userdata (* void)
write-options write-introspect-struct-options
&return bool))
(tokenize-push (field handler function-invocation)
struct-metadata
field
struct-to-write
value-offset
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)
(call-on push_back (path overrides-state > handlers-by-type)
(call (in std move) handler)))
(scope
(var handler introspect-override-handler)
(set (field handler handler-type) "'read-s-expr")
(set (field handler override-function-name type) TokenType_Symbol)
(set (field handler override-function-name source) "Introspection.cake")
(set (field handler override-function-name contents)
"read-s-expr-handle-override")
(tokenize-push (field handler function-signature)
(struct-metadata (* (const metadata-struct))
field (* (const metadata-field))
struct-out (* void)
value-offset size_t
value-argument-start (* (const char))
string-allocate allocate-string-function
&return bool))
(tokenize-push (field handler function-invocation)
struct-metadata
field
struct-out
value-offset
value-argument-start
string-allocate)
(tokenize-push (field handler on-override-missing) (return false))
(set (field handler num-installed) start-num-installed-sentinel)
(call-on push_back (path overrides-state > handlers-by-type)
(call (in std move) handler)))
(scope
(var handler introspect-override-handler)
(set (field handler handler-type) "'compare")
(set (field handler override-function-name type) TokenType_Symbol)
(set (field handler override-function-name source) "Introspection.cake")
(set (field handler override-function-name contents)
"compare-introspect-field-handle-override")
(tokenize-push (field handler function-signature)
(struct-metadata (* (const metadata-struct))
field (* (const metadata-field))
struct-a (* void)
struct-b (* void)
value-offset size_t
dispatch-value-index size_t
print-difference bool
&return int))
(tokenize-push (field handler function-invocation)
struct-metadata
field
struct-a
struct-b
value-offset
dispatch-value-index
print-difference)
(tokenize-push (field handler on-override-missing) (return -1))
(set (field handler num-installed) start-num-installed-sentinel)
(call-on push_back (path overrides-state > handlers-by-type)
(call (in std move) handler)))
(scope
(var handler introspect-override-handler)
(set (field handler handler-type) "'copy")
(set (field handler override-function-name type) TokenType_Symbol)
(set (field handler override-function-name source) "Introspection.cake")
(set (field handler override-function-name contents)
"copy-introspect-field-handle-override")
(tokenize-push (field handler function-signature)
(struct-metadata (* (const metadata-struct))
field (* (const metadata-field))
struct-dest (* void)
struct-src (* void)
value-offset size_t
dispatch-value-index size_t
string-allocate allocate-string-function
&return bool))
(tokenize-push (field handler function-invocation)
struct-metadata
field
struct-dest
struct-src
value-offset
dispatch-value-index
string-allocate)
(tokenize-push (field handler on-override-missing) (return false))
(set (field handler num-installed) start-num-installed-sentinel)
(call-on push_back (path overrides-state > handlers-by-type)
(call (in std move) handler)))
(scope
(var handler introspect-override-handler)
(set (field handler handler-type) "'free")
(set (field handler override-function-name type) TokenType_Symbol)
(set (field handler override-function-name source) "Introspection.cake")
(set (field handler override-function-name contents)
"free-introspect-field-handle-override")
(tokenize-push (field handler function-signature)
(struct-metadata (* (const metadata-struct))
field (* (const metadata-field))
struct-to-destroy (* void)
value-offset size_t
dispatch-value-index size_t
string-free free-string-function))
(tokenize-push (field handler function-invocation)
struct-metadata
field
struct-to-destroy
value-offset
dispatch-value-index
string-free)
(tokenize-push (field handler on-override-missing) (ignore))
(set (field handler num-installed) start-num-installed-sentinel)
(call-on push_back (path overrides-state > handlers-by-type)
(call (in std move) handler)))
(set (deref state-out) (type-cast overrides-state (* void)))
(return true))
;; Replaced by introspect-overrides-install
(defun-local read-s-expr-handle-override ())
(defun-local write-s-expr-handle-override ())
(defun-local compare-introspect-field-handle-override ())
(defun-local copy-introspect-field-handle-override ())
(defun-local free-introspect-field-handle-override ())
(defun-comptime introspect-override-get-handler-by-type (environment (& EvaluatorEnvironment)
handler-type (* (const char))
handler-out (* (* void))
&return bool)
(introspect-override-get-shared-variables)
(for-in handler-by-type (& introspect-override-handler) (path overrides-state > handlers-by-type)
(when (= 0 (strcmp (field handler-by-type handler-type) handler-type))
(set (deref handler-out) (type-cast (addr handler-by-type) (* void)))
(return true)))
(return false))
;; I'm not super pleased with this, but it's important these don't get out of sync
(defmacro introspect-override-get-shared-variables ()
(tokenize-push output
(introspect-override-define-types)
(var overrides-state (* introspect-override-state) null)
;; Don't use get-or-create-comptime-var because it'll have a hard time with our custom type
(unless (GetCompileTimeVariable environment "introspect-override-handlers"
"(* introspect-override-state)"
(type-cast (addr overrides-state) (* (* void))))
(unless (create-introspect-override-state environment
(type-cast (addr overrides-state) (* (* void))))
(return false))))
(return true))
(defmacro introspect-override-invocation-args (handler-type symbol)
(introspect-override-get-shared-variables)
(var handler (* introspect-override-handler) null)
(introspect-override-get-handler-by-type environment
(call-on c_str (path handler-type > contents))
(type-cast (addr handler) (* (* void))))
(unless handler
(return false))
(tokenize-push output
(token-splice-array (path handler > function-invocation)))
(return true))
;; Any field overrides are handled via defining a custom function which will be called handler-name
;; with body handler-body. This handler will be called if condition is true for a field already
;; marked as introspect-type-override.
;; operation is one of the symbols defined in the topmost cond block of this macro
(defmacro introspect-override-register-handler (operation symbol
condition any
handler-name symbol ;; Will be created
&rest handler-body any)
(introspect-override-get-shared-variables)
(var handler (* introspect-override-handler) null)
(introspect-override-get-handler-by-type environment
(call-on c_str (path operation > contents))
(type-cast (addr handler) (* (* void))))
(unless handler
(ErrorAtToken (deref operation)
"expected operation to be one of the following symbols:")
(for-in handler-by-type (& introspect-override-handler) (path overrides-state > handlers-by-type)
(Logf "\t%s\n" (field handler-by-type handler-type)))
(return false))
(set (at handler-name (path handler > registered-handlers)) condition)
(tokenize-push output
(defun-nodecl (token-splice handler-name)
(token-splice-array (path handler > function-signature))
(token-splice-rest handler-body tokens)))
(return true))
(defun-comptime sorted-handler-comparison (a (& (const (* (<> (in std pair)
(const (* (const Token)))
(* (const Token))))))
b (& (const (* (<> (in std pair)
(const (* (const Token)))
(* (const Token))))))
&return bool)
1 year ago
(return (> 0 (call-on compare (path a > first > contents)
(path b > first > contents)))))
;; The linker will handle finding the actual functions. This is nice because we don't need to worry
;; about including anything the implementations need
(defun-comptime introspect-overrides-install (environment (& EvaluatorEnvironment)
&return bool)
(introspect-override-get-shared-variables)
(for-in handler-by-type (& introspect-override-handler) (path overrides-state > handlers-by-type)
;; (Logf "Handler %s installed %d registered: %d\n" (field handler-by-type handler-type)
;; (type-cast (field handler-by-type num-installed) int)
;; (type-cast (call-on size (field handler-by-type registered-handlers)) int))
;; Already handled in a previous pass
;; We need to do it at least once to write the proper signature; by setting num-installed to -1
;; as the starting value, we ensure even with no registered handlers, they will get signatures
;; generated, which is important to compilation
(when (= (call-on size (field handler-by-type registered-handlers))
(field handler-by-type num-installed))
(continue))
;; We used unordered_map, which due to not being ordered, causes unnecessary recompilation due
;; to not being deterministic between runs (which I assume is for security in case an attacker
;; wants to manipulate the data order). I'd rather do this than introduce std::map for now
(var sorted-handlers (<> (in std vector) (* (<> (in std pair)
(const (* (const Token)))
(* (const Token))))))
(for-in handler-cond-pair (& (<> (in std pair) (const (* (const Token)))
(* (const Token))))
(field handler-by-type registered-handlers)
(call-on push_back sorted-handlers (addr handler-cond-pair)))
;; TODO: This is a HACK: Invoke the sort function once so it's registered as a reference on
;; this definition, which will pull it into the comptime compilation
(unless (call-on empty (field handler-by-type registered-handlers))
(sorted-handler-comparison (deref (call-on begin sorted-handlers))
(deref (call-on begin sorted-handlers)))
(call (in std sort) (call-on begin sorted-handlers)
(call-on end sorted-handlers) sorted-handler-comparison))
(var handler-forward-declare-tokens (<> (in std vector) Token))
(var handler-cond-tokens (<> (in std vector) Token))
(for-in handler-cond-pair (* (<> (in std pair) (const (* (const Token)))
(* (const Token))))
sorted-handlers
;; Let the compiler know we expect to get the handler during linking
(tokenize-push handler-forward-declare-tokens
(declare-extern-function (token-splice (path handler-cond-pair > first))
(token-splice-array (field handler-by-type function-signature))))
(tokenize-push handler-cond-tokens
;; Condition
((token-splice (path handler-cond-pair > second))
;; Invocation
(return ((token-splice (path handler-cond-pair > first))
(token-splice-array (field handler-by-type function-invocation)))))))
(var handler-amalgamation (* (<> std::vector Token)) (new (<> std::vector Token)))
;; Environment will handle freeing tokens for us
(call-on push_back (field environment comptimeTokens) handler-amalgamation)
;; Give the cond something to chew on in the empty state
(when (call-on empty handler-cond-tokens)
(tokenize-push handler-cond-tokens
(true (fprintf stderr "warning: no overrides registered\n"))))
(var handler-type-string-token Token)
(set (field handler-type-string-token type) TokenType_String)
(set (field handler-type-string-token source) "Introspection.cake")
(set (field handler-type-string-token contents)
(field handler-by-type handler-type))
(tokenize-push (deref handler-amalgamation)
(token-splice-array handler-forward-declare-tokens)
(defun-local (token-splice-addr (field handler-by-type override-function-name))
(token-splice-array (field handler-by-type function-signature))
(cond
(token-splice-array handler-cond-tokens))
(fprintf stderr "error: override for struct \"%s\" field \"%s\" not handled. You need to
define a %s handler for this field via introspect-override-register-handler\n"
(path struct-metadata > name) (path field > name)
(token-splice-addr handler-type-string-token))
(token-splice-array (field handler-by-type on-override-missing))))
;; (prettyPrintTokens (deref handler-amalgamation))
(unless (ReplaceAndEvaluateDefinition
environment
(call-on c_str (field handler-by-type override-function-name contents))
(deref handler-amalgamation))
(return false))
;; Track that we have installed these, preventing post-references-resolved loops
(set (field handler-by-type num-installed)
(call-on size (field handler-by-type registered-handlers))))
(return true))
(add-compile-time-hook post-references-resolved introspect-overrides-install)
;;
;; Types
;;
(defenum introspect-type
introspect-type-override ;; Use custom callbacks when operating on this type
introspect-type-int
introspect-type-float
introspect-type-bool
introspect-type-char
introspect-type-string
introspect-type-fixed-size-string
;; Recurse into the substruct
introspect-type-introspect-struct)
;; Gross, but necessary so the structs can refer to each other
(forward-declare (struct MetadataField)
(struct MetadataStruct))
(defstruct metadata-field
name (* (const char))
type introspect-type
field-type-metadata (* (const metadata-struct))
offset size_t
element-size size_t
count size_t ;; For arrays
tags ([] 2 (* (const char))))
(defstruct metadata-struct
name (* (const char))
;; type introspect-struct-type ;; Almost always field-by-field, but TODO let them override the whole process
members (* (const metadata-field))
num-members size_t
struct-size size_t)
;;
;; Runtime
;;
(defmacro offset-pointer-to-type (start-address any offset-bytes any desired-type any)
(tokenize-push output
(type-cast (+ (type-cast (token-splice start-address) (* char))
(token-splice offset-bytes))
(token-splice desired-type)))
(return true))
;; This isn't ideal, but I did want to eliminate the need to branch repeatedly on the same field's
;; type. So, we'll create a separate for loop for each type
(defmacro introspect-field-dispatch (field-pointer any
offset-out symbol &rest per-value-body any)
(tokenize-push output
(each-in-range (? (path (token-splice field-pointer) > count)
(path (token-splice field-pointer) > count)
1)
dispatch-value-index
(var (token-splice offset-out) size_t
(+ (* dispatch-value-index
(path (token-splice field-pointer) > element-size))
(path (token-splice field-pointer) > offset)))
(token-splice-rest per-value-body tokens)))
(return true))