gdjn  Check-in [91e02e35d5]

%toc

@civ {
	to meet the bare minimum standards necessary to qualify as [!civilized] to my mind, a language must:
	* support compilation, whether to bytecode or machine code (excludes gdscript)
	* parse into an AST (excludes bash, php (or used to))
	* support AST-rewriting macros (excludes everything outside the lisp family except maybe rust)
	* use real syntax, not whitespace-based kludges (excludes python, gdscript inter alia)
	* provide a proper module system (excludes C)
	* provide for hygienic namespacing (excludes C, gdscript)
	* provide simple, cheap aggregate types (excludes gdscript, java, maybe python depending on how you view tuples)
	so, janet and fennel are about the only game in town.
}

................................................................................
	abi: okay yes in reality it absolutely fucking does, everyone uses the same gods-damned amd one, in actual materially existing reality there is no interop problem at least on x86, but because we haven't ritually enshrined this model at ISO and pacified its marauding [!aramitama] with burnt offerings of motor oil and obsolete DRAM chips, we cover our eyes and pretend we cannot see what is sitting right in front of us. i love too compute dont u

so GDExtension is designed (if i may use the word liberally) with certain notions fixed firmly in mind. chief among them is that the actual C-level calls will be thoroughly ensconced in a suffocating buffer of template hackery, which will employ dark arts and crafts to generate gobs and gobs of impenetrable C at compile time. in fact, GDExtension is so designed that it is basically impossible to use it directly without a code generation layer. unwilling as i was to use C++ (it's against my religion), i wrote my layer from scratch, in janet.

this was not as bad as it could have been. janet has something [^deficient magnificent] in its stdlib that every language should have: a PEG module. the resulting program, ["tool/class-compile.janet] is under 1k lines! just barely. this tool is fired off by the makefile for the ["src/*.gcd] files, generating a header file ["gen/*.h] and an object file ["out/*.o] that implements the class described in the file. the care and feeding of this file format is described in the [>gcd GCD section].

	deficient: it is deficient in one particular way: it only operates over bytestrings. so you can use a PEG to parse raw text, or you can use it to implement a lexer, but you can't have both a PEG lexer and parser, which is really fucking dumb and makes things like dealing with whitespace far more painful than it needs to be.)































































##gcd GCD language
GCD is a simple IDL which is translated into [^complex much more complicated C]. it's designed to make writing GDExtension classes as close to the native GDScript experience as possible, without the syntactic hanging offenses. you define the structure of the class using GCD, and write inline C to implement your functions. linemarkers are emitted properly so when you inevitably fuck it up, the compiler will be able to apportion the blame properly.

	complex: the generated implementation code is roughly 24x longer than the input file

the C "lexing" is pretty robust, and as long as you aren't doing horrible shit with the preprocessor (on the order of ["#define fi }]) it shouldn't choke on anything you write. if you [!are] doing horrible shit with the preprocessor however, [!you deserve everything you get].

%toc

@civ {
	to meet the bare minimum standards necessary to qualify as [!civilized] to my mind, a language must:
	* support compilation, whether to bytecode or machine code (excludes gdscript)
	* parse into an AST (excludes bash, php (or used to))
	* support AST-rewriting macros (excludes everything outside the lisp family except nim and maybe rust)
	* use real syntax, not whitespace-based kludges (excludes python, gdscript inter alia)
	* provide a proper module system (excludes C)
	* provide for hygienic namespacing (excludes C, gdscript)
	* provide simple, cheap aggregate types (excludes gdscript, java, maybe python depending on how you view tuples)
	so, janet and fennel are about the only game in town.
}

................................................................................
	abi: okay yes in reality it absolutely fucking does, everyone uses the same gods-damned amd one, in actual materially existing reality there is no interop problem at least on x86, but because we haven't ritually enshrined this model at ISO and pacified its marauding [!aramitama] with burnt offerings of motor oil and obsolete DRAM chips, we cover our eyes and pretend we cannot see what is sitting right in front of us. i love too compute dont u

so GDExtension is designed (if i may use the word liberally) with certain notions fixed firmly in mind. chief among them is that the actual C-level calls will be thoroughly ensconced in a suffocating buffer of template hackery, which will employ dark arts and crafts to generate gobs and gobs of impenetrable C at compile time. in fact, GDExtension is so designed that it is basically impossible to use it directly without a code generation layer. unwilling as i was to use C++ (it's against my religion), i wrote my layer from scratch, in janet.

this was not as bad as it could have been. janet has something [^deficient magnificent] in its stdlib that every language should have: a PEG module. the resulting program, ["tool/class-compile.janet] is under 1k lines! just barely. this tool is fired off by the makefile for the ["src/*.gcd] files, generating a header file ["gen/*.h] and an object file ["out/*.o] that implements the class described in the file. the care and feeding of this file format is described in the [>gcd GCD section].

	deficient: it is deficient in one particular way: it only operates over bytestrings. so you can use a PEG to parse raw text, or you can use it to implement a lexer, but you can't have both a PEG lexer and parser, which is really fucking dumb and makes things like dealing with whitespace far more painful than it needs to be.)

##obj object model
godot uses a strongly javalike OOP system, which translates poorly to Janet's prototype-based OO. gdjn therefore uses the following convention to translate between the two.

the engine executes the "compile-time" phase of a janet script once it is finished loading. it is the responsibility of the compile-time thunk to set up the local environment to represent a class using def statements. the abstract serves as a proxy for method calls. when a lookup is performed against a class proxy, the proxy inspects its attached environment and returns an appropriate object.

unadorned immutable bindings are treated as constants. values with the [":field type] annotation are treated as object fields. when a new instance is created, space is allocated for a field of the appropriate type, and initialized to the value of the binding. public [`var] mutable bindins are treated as static variables.

~~~[janet] example bindings
(def name "Lisuan") # constant string
(def name :field "Lisuan") # field of type string, initializes to "Lisuan"
(def name {:field :variant} "Lisuan") field of type variant
(def- secret "swordfish") # private constant
(def- secret :field "swordfish") # private string field
(var count 0) # static variable of type int
(var- count 0) # private static variable of type int
~~~

unadorned functions are treated as static functions.

private functions (those declared with [`def-]) are available only within the class implementation. they are not exported as methods.

functions with the annotation [":method] are treated as methods. when invoked, they are passed a [`self]-reference as their first argument.

function type signatures can be specified with the annotations [":takes [...]] and [`:gives [$type]].

tables with the annotation [":subclass] are treated as environment tables specifying inner classes. the macro [`subclass] should generally be used to maintain uniform syntax between outer and inner classes, e.g.

~~~[janet]
(use core)
(use-classes Object RefCounted)
(declare outerClass :is Object)
(def val 10)
(prop v vec3)
(defclass innerClass :is RefCounted
	(def val 2))

# equivalent to
(import prim)
(def Object (prim/load-class :Object))
(def RefCounted (prim/load-class :RefCounted))
(def *class-name* :meta :outerClass)
(def *class-inherit* :meta Object)
(def val 10)
(def innerClass (do
	(def *class-inherit* :meta RefCounted)
	(let [env (table/setproto @{} (curenv))]
		(eval '(do
			(def val 2))
		env)
	env)))
~~~

since the annotations are somewhat verbose, macros are provided to automate the process.

+ janet + gdscript
| ["(def count 10)] | ["const count := 10]
| ["(def count {:field int} 10)] | ["var count: int = 10]
| ["(defn open [path] ...)] | ["static func open(path: Variant) ...]
| ["(defn open {:takes [:string] :gives :int} [path] ...)] | ["static func open(path: String) -> int:  ...]
| ["(defn close :method [me] ...)] |  func close() -> void: ...


##gcd GCD language
GCD is a simple IDL which is translated into [^complex much more complicated C]. it's designed to make writing GDExtension classes as close to the native GDScript experience as possible, without the syntactic hanging offenses. you define the structure of the class using GCD, and write inline C to implement your functions. linemarkers are emitted properly so when you inevitably fuck it up, the compiler will be able to apportion the blame properly.

	complex: the generated implementation code is roughly 24x longer than the input file

the C "lexing" is pretty robust, and as long as you aren't doing horrible shit with the preprocessor (on the order of ["#define fi }]) it shouldn't choke on anything you write. if you [!are] doing horrible shit with the preprocessor however, [!you deserve everything you get].

# [ʞ] lib/core.janet
#  ~ lexi hale <lexi@hale.su>
#  🄯 AGPLv3
#  ? provides a nicer interface to gdprims
#  > (import :/lib/core)

(import /lib/prim)

# this parameter controls the class to inherit from
# when a superclass is not explicitly specified.
# this should be set to point at RefCounted
(def *class-base* (gensym))
(def *class-path* (gensym))

(def- valid-class-flags
	(do (def list [:abstract :final])
		(tabseq [f :in list] f true)))

(defn- assemble-meta [args]
	(defn recurse [acc dox t & r]
		(cond
			(string? t)
				(recurse acc [;dox t] ;r)
			(or (struct?  t)
				(keyword? t))
				(recurse [;acc t] dox ;r)
			[[;(if (empty? dox) []
				   [{:doc (string/join dox)}])
			  ;acc] t ;r]))
	(recurse [] [] ;args))

(defmacro class [name & dfn]
	(def def-map (tuple tuple (dyn *current-file*)
	                   ;(tuple/sourcemap (dyn :macro-form))))
	(defn mapped-val [val]
		@{:value val
		 :source-map def-map})
	(var spec dfn)
	(var super (dyn *class-base*))
	(var export-name (string name))
	# documentation is stored differently for classes,
	# as godot needs to be able to retrieve the text
	# from a reference to @scope
	(def dox @[])
	(def mode @{})

	(forever
		(match spec
			[:is super_ & r] # set superclass
				(do (set super (eval super_)) 
					(set spec r))

			[:as ident & r]
				(do (set export-name (string ident))
					(set spec r))

			([m & r] (has-key? valid-class-flags m))
				(do (put mode m true)
					(set spec r))

			([x & r] (string? x)) # docstring
				(do (array/push dox x)
					(set spec r))

			_ (break)))

	(def doc-str (string/join dox))
	(def body spec)
	(with-dyns [*class-path*
				[;(or (dyn *class-path*) []) name]]
	(with-syms [$local-env $parent-env $form]
			~(let [,$parent-env (or @scope (curenv))
				   ,$local-env (,table/setproto
						@{ '@name    ,(mapped-val (keyword name))
						   '@gd-id   ,(mapped-val (string export-name))
						   '@inherit ,(mapped-val super)
						   '@mode    ,(mapped-val mode)
						   '@doc     ,(if (empty? dox) nil
										  (mapped-val doc-str))}
						,$parent-env)
				  ,name ,$local-env]
				  (,put ,$local-env '@scope @{:value ,$local-env})

				  # *self* can be used to access statics
				  (put ,$local-env '@self @{:value
					   (fn @self[& x]
						   (get-in ,$local-env [;x :value]))})
				  (each ,$form ',body 
					  (,eval ,$form ,$local-env))
				  ,$local-env))))

(defn- member [& x]
	(string/join [;(or (dyn *class-path*) [])
				  ;x] "."))

(defmacro defclass* [id meta & r]
	~(def ,id ,;meta (class ,id ,;r)))

(defmacro defclass  [id & r] ~(defclass* ,id [] ,;r))
(defmacro defclass- [id & r] ~(defclass* ,id [:private] ,;r))

(defn- parse-sig [sig]
	(match sig
		([ty id dox & r] (string? dox))
		 [{:type (eval ty) :id id :doc dox}
		  ;(parse-sig r)]
		[ty id & r] [{:type (eval ty) :id id}
					 ;(parse-sig r) ]
		_ []))

(defmacro defm [id & rest]
	(def (meta ret sig & body) (assemble-meta rest))
	(def args (parse-sig sig))
	(def md [;meta :method {:sig args :ret (eval ret)}])
	(def arg-names ['me ;(map (fn [{:id id}] id) args)])
	(def path (symbol (member id)))
	~(def ,id ,;md (fn ,path ,arg-names ,;body)))

(defmacro defm- [id & r] ~(defm ,id :private ,;r))

(defmacro prop [id & args]
	(def (meta-list ty init-val)
		(assemble-meta args))
	(assert init-val "property missing initial value")
	~(def ,id :prop {:type ,ty} ,;meta-list ,init-val))

(defmacro const [id & args]
	(def (meta-list ty init-val)
		(assemble-meta args))
	(assert init-val "constant missing value")
	~(def ,id :const {:type ,ty} ,;meta-list ,init-val))

(defmacro hoist [ids & body]
	~(upscope (def ,ids
				  (do ,;body
					  ,ids))))

# [ʞ] lib/prim.janet
#  ~ lexi hale <lexi@hale.su>
#  🄯 AGPLv3
#  ? declares the primitives supplied by gdjn
#  > (import /lib/prim)

(def *gd-api-map* @{})

(defmacro- extern [name]
	(def sym (gensym))
	(put *gd-api-map* sym name)
	~(def ,name ',sym))

# takes a string and returns a prim/class-handle
# for a native godot class
(extern class-load)

# an abstract that wraps a class and provides
# a uniform interface for both native godot
# classes and janet environment-classes
(extern class)
(extern class?)
# @-prefixed methods/props are implemented by the vm.
# everything else is passed through verbatim.
# :@janet? - returns true if underlying class is
#           a janet env
# :@methods - returns a list of methods
#  {:id method-id :args [(type/variant :Vector3) etc] 
#                 :ret (type/variant :String)}
# :@super - returns a handle to the superclass
# :@new - invokes a constructor, returning an object
# use :@janet? and :@env methods to retrieve a
# janet environment from a wrapped janet class

(extern object)
(extern object?)
(extern object/class)
# method calls on an object are translated to
# godot method invocations. index into a class
# to retrieve a property.

# explicitly create godot values
(extern type/dict)
(extern type/array)
(extern type/array-packed)

#   form.
#
# * ["ext] is a Keter-class high-security containment unit for
#   Other People's Code.
#
# * ["lib] contains (mostly janet) code that will be included
#   as blobs in the binary. janet code will be able to import
#   them. these will be compiled down to .jimage files and
#   then bundled into rsrc.o. libraries used in ["tool/*] 
#   should only be placed in this directory if they are also
#   used at runtime in the godot environment (e.g. the OOP
#   macros). library code used only by tools belongs in the
#   tool directory.
#
# * ["out] contains all live binaries and object files.

godot = godot4
godot.flags = --headless
godot.cmd = "$(godot)" $(godot.flags)
janet = $o/janet
git = git
git.flags.clone = --depth=1

janet.src.path = $x/janet
janet.src.git = https://github.com/janet-lang/janet.git
janet.root = $x/janet/src



janet.cfg = 

cc.link = -flto
cc.comp = -fPIC

ifeq ($(debug),1)
    cc.link += -g
    cc.comp += -g -O0










endif

cc.gdjn.comp = $(cc.comp) \
	-std=gnu23 \
	-I"$g" \
	-I"$s" \
	-I"$(janet.root)/include" \
................................................................................

.PHONY: all clean purge
all: $o/gdjn.so 
clean:
	rm "$o/"*.o "$g/"*.{jimage,h} "$o/gdjn.so"
purge:
	rm "$o/"* "$g/"*


%/:; $(path-ensure)
%: | $(@D)/

tags: .
	find "$s" "$g" -name "*.h" -o -name "*.c" | xargs ctags

$o/gdjn.so: $o/gdjn.o $o/rsrc.o $o/interface.o \
            $o/janet-lang.o $o/janet-rsrc.o \
			$o/libjanet.a 
	"$(cc)" $(cc.gdjn.link) $^ -o"$@"

$o/interface.o: $t/c-bind-gen.janet \
                $g/interface.h \
				$(gd_api_spec) \
				$(gd_api_iface)

	"$(janet)" "$<" loader | "$(cc)" $(cc.gdjn.comp) -c -xc - -o "$@"

$g/interface.h: $t/c-bind-gen.janet \
				$(gd_api_spec)

	"$(janet)" "$<" header >"$@"

$g/%.h: $s/%.gcd $t/class-compile.janet $(realpath $(janet))
	"$(janet)" "$t/class-compile.janet" "$<" header >"$@"
$o/%.o: $s/%.gcd $g/%.h $t/class-compile.janet $(realpath $(janet))

	"$(janet)" "$t/class-compile.janet" "$<" loader \
		| "$(cc)" $(cc.gdjn.comp) -c -xc - -o "$@"

$o/%.o: $s/%.c $s/%.h $(realpath $(janet.root)/include/janet.h)
	"$(cc)" -c $(cc.gdjn.comp) "$<" -o"$@"

$o/rsrc.o: $t/rsrc.janet $(realpath $(janet)) \
           $g/api.jimage
	"$(janet)" "$<" -- "$g/api.jimage"

%.jimage: $(realpath $(janet))

$g/api.jimage: $t/api-compile.janet $(gd_api_spec)
	"$(janet)" "$<" "$(gd_api_spec)" "$@"

$g/%.jimage: $l/%.janet
	"$(janet)" -c "$<" "$@"

$x/janet $x/janet/src/include/janet.h:
	"$(git)" $(git.flags) clone $(git.flags.clone) "$(janet.src.git)" "$x/janet"

canon = $(realpath $(dir $1))/$(notdir $1)
define janet.build =
	"$(MAKE)" -C "$(janet.src.path)" "$(call canon,$@)" \
		JANET_$1="$(call canon,$@)"    \

		$(janet.cfg)
endef

$o/libjanet.a: $(janet.src.path)
	$(call janet.build,STATIC_LIBRARY)
$o/janet: $(janet.src.path)
	$(call janet.build,TARGET)

$g/extension_api.json $g/gdextension_interface.h:
	cd "$g" && $(godot.cmd) --dump-extension-api-with-docs \
	                        --dump-gdextension-interface


# individual dependencies

janet-header = $(janet.root)/include/janet.h

$o/gdjn.o: $s/util.h $g/interface.h $g/janet-lang.h $g/janet-rsrc.h $(gd_api_iface)
$o/janet-lang.o: $s/util.h $(janet-header)
$o/janet-rsrc.o: $s/util.h $g/janet-lang.h $(janet-header)

#   form.
#
# * ["ext] is a Keter-class high-security containment unit for
#   Other People's Code.
#
# * ["lib] contains (mostly janet) code that will be included
#   as blobs in the binary. janet code will be able to import
#   them. these will be compiled into the api.jimage file and
#   then bundled into rsrc.o. libraries used in ["tool/*] 
#   should only be placed in ["lib] if they are also used at
#   runtime in the godot environment (e.g. the OOP macros).
#   library code used only by tools belongs in the tool
#   directory.
#
# * ["out] contains all live binaries and object files.

godot = godot4
godot.flags = --headless
godot.cmd = "$(godot)" $(godot.flags)
janet = $o/janet
git = git
git.flags.clone = --depth=1

janet.src.path = $x/janet
janet.src.git = https://github.com/janet-lang/janet.git
janet.root = $x/janet/src
janet.cfgfile = $s/janetconf.h
janet.cfg = JANETCONF_HEADER=$(realpath janet.cfgfile)
janet.cc.bin = -D_gdjn_shims
janet.cc.lib = 

cc.link = -flto
cc.comp = -fPIC

ifeq ($(debug),1)
    cc.link += -g 
    cc.comp += -g -O0 -Wall -D_gdjn_build_debug
    ifndef feat.editor
        feat.editor = 1
    endif
else
    cc.comp += -D_gdjn_build_release
endif

# are we building with editor support?
ifeq ($(feat.editor),1)
	cc.comp += -D_gdjn_build_editor
endif

cc.gdjn.comp = $(cc.comp) \
	-std=gnu23 \
	-I"$g" \
	-I"$s" \
	-I"$(janet.root)/include" \
................................................................................

.PHONY: all clean purge
all: $o/gdjn.so 
clean:
	rm "$o/"*.o "$g/"*.{jimage,h} "$o/gdjn.so"
purge:
	rm "$o/"* "$g/"*
	$(MAKE) -C "$(janet.src.path)" clean

%/:; $(path-ensure)
%: | $(@D)/

tags: .
	find "$s" "$g" -name "*.h" -o -name "*.c" | xargs ctags

$o/gdjn.so: $o/gdjn.o $o/rsrc.o $o/interface.o $o/vm.o \
            $o/janet-lang.o $o/janet-rsrc.o \
			$o/libjanet.a 
	"$(cc)" $(cc.gdjn.link) $^ -o"$@"

$o/interface.o: $t/c-bind-gen.janet \
                $g/interface.h \
				$(gd_api_spec) \
				$(gd_api_iface) \
				$(janet)
	"$(janet)" "$<" loader | "$(cc)" $(cc.gdjn.comp) -c -xc - -o "$@"

$g/interface.h: $t/c-bind-gen.janet \
				$(gd_api_spec) \
				$(janet)
	"$(janet)" "$<" header >"$@"

$g/%.h: $s/%.gcd $t/class-compile.janet $(janet)
	"$(janet)" "$t/class-compile.janet" "$<" header >"$@"

$o/%.o: $s/%.gcd $g/%.h $s/gdjn.h $g/interface.h $t/class-compile.janet $(janet)
	"$(janet)" "$t/class-compile.janet" "$<" loader \
		| "$(cc)" $(cc.gdjn.comp) -c -xc - -o "$@"

$o/%.o: $s/%.c $s/%.h $(janet.root)/include/janet.h
	"$(cc)" -c $(cc.gdjn.comp) "$<" -o"$@"

$o/rsrc.o: $t/rsrc.janet $(janet) \
           $g/api.jimage
	"$(janet)" "$<" -- "$g/api.jimage"

%.jimage: $(janet)

$g/api.jimage: $t/api-compile.janet $(wildcard $l/*.janet) $(janet)
	"$(janet)" "$<" "$@"




$x/janet $x/janet/src/include/janet.h:
	"$(git)" $(git.flags) clone $(git.flags.clone) "$(janet.src.git)" "$x/janet"

canon = $(realpath $(dir $1))/$(notdir $1)
define janet.build =
	"$(MAKE)" -C "$(janet.src.path)" "$(call canon,$@)" \
		JANET_$1="$(call canon,$@)"    \
		CFLAGS+="-O2 -g $(janet.cc) $(janet.cc.$2)" \
		$(janet.cfg)
endef

$o/libjanet.a: $(janet.src.path)
	$(call janet.build,STATIC_LIBRARY,lib)
$o/janet: $(janet.src.path)
	$(call janet.build,TARGET,bin)

$g/extension_api.json $g/gdextension_interface.h:
	cd "$g" && $(godot.cmd) --dump-extension-api-with-docs \
	                        --dump-gdextension-interface


# individual dependencies

janet-header = $(janet.root)/include/janet.h

$o/gdjn.o: $s/util-gd.h $s/type.h $g/interface.h $g/janet-lang.h $g/janet-rsrc.h $(gd_api_iface)
$o/janet-lang.o $g/janet-lang.h: $s/util-gd.h $s/type.h $s/util-jn.h $(janet-header)
$o/janet-rsrc.o $g/janet-rsrc.h: $s/util-gd.h $s/type.h $s/util-jn.h $g/janet-lang.h $(janet-header)
$o/vm.o: $s/util-jn.h

 *  🄯 AGPLv3
 *  ? gdjn entry point
 */

#include "gdjn.h"
#include "janet-lang.h"
#include "janet-rsrc.h"


gdjn* gdjn_ctx = nullptr;












static void
gdjn_init
(	void*                          data,
	GDExtensionInitializationLevel lvl
) {
	if (lvl != GDEXTENSION_INITIALIZATION_SCENE) return;
	gdjn_types_fetch(&gdjn_ctx -> gd.t, gdjn_ctx -> gd.getProc);

	const gdjn_typeDB* c = &gdjn_ctx -> gd.t;





	gdjn_unit_janetLang_load();
	gdjn_unit_janetRsrc_load();

	gdjn_ctx -> gd.janetLang_inst = gdjn_class_JanetLang_new() -> self;

	auto e = gd_engine_registerScriptLanguage(
		c -> objects.engine,
................................................................................
		false
	);
	gd_resourceSaver_addResourceFormatSaver(
		gdjn_ctx -> gd.t.objects.resourceSaver,
		gdjn_ctx -> gd.janetSaver_inst,
		false
	);
		/*
	gd_variant ret;
	c -> gd_object.methodBindPtrcall(
		c -> gd_m_engine.registerScriptLanguage_ptr,
		c -> objects.engine,
		(GDExtensionConstTypePtr[]) {
			&gdjn_ctx -> gd.janetLang_inst,
		}, &ret
	);
	*/

	_t(array).empty(&gdjn_ctx -> gd.dox, nullptr);
	gd_stringName empty = {};
	_t(stringName).empty(&empty, nullptr);
	_t(array).setTyped(&gdjn_ctx -> gd.dox,
			GDEXTENSION_VARIANT_TYPE_DICTIONARY, &empty, &empty);

................................................................................
(	void*                          data,
	GDExtensionInitializationLevel lvl
) {
	if (lvl != GDEXTENSION_INITIALIZATION_SCENE) return;
	/* we get double frees otherwise */

	const gdjn_typeDB* c = &gdjn_ctx -> gd.t;


	gd_engine_unregisterScriptLanguage(
		c -> objects.engine,
		gdjn_ctx -> gd.janetLang_inst
	);
	/*
	GDExtensionTypePtr ret;
................................................................................
	gd_resourceSaver_removeResourceFormatSaver(
		gdjn_ctx -> gd.t.objects.resourceSaver,
		gdjn_ctx -> gd.janetSaver_inst
	);
	/* gd_refCounted_unreference(gdjn_ctx -> gd.janetLoader_inst); */
	/* gd_refCounted_unreference(gdjn_ctx -> gd.janetSaver_inst); */
	gdjn_class_JanetLang_del(nullptr, gdjn_ctx -> gd.janetLang_inst);



	gdjn_ctx -> gd.free(gdjn_ctx);
	gdjn_ctx = nullptr;
}


gdBool

 *  🄯 AGPLv3
 *  ? gdjn entry point
 */

#include "gdjn.h"
#include "janet-lang.h"
#include "janet-rsrc.h"
#include "vm.h"

gdjn* gdjn_ctx = nullptr;

void* gdjn_janet_malloc (size_t sz) { return _alloc(char, sz); }
void  gdjn_janet_free   (void* ptr) { _free(ptr); }
void* gdjn_janet_realloc(void* ptr, size_t sz)
	{ return _realloc(ptr, char, sz); }
void* gdjn_janet_calloc (size_t n, size_t esz) {
	const size_t sz = esz*n;
	void* v = _alloc(char, sz);
	memset(v, 0, sz);
	return v;
}

static void
gdjn_init
(	void*                          data,
	GDExtensionInitializationLevel lvl
) {
	if (lvl != GDEXTENSION_INITIALIZATION_SCENE) return;
	gdjn_types_fetch(&gdjn_ctx -> gd.t, gdjn_ctx -> gd.getProc);

	const gdjn_typeDB* c = &gdjn_ctx -> gd.t;

	janet_init();
	gdjn_ctx -> jn.api = gdjn_vm_api_build_core();
	janet_gcroot(janet_wrap_table(gdjn_ctx -> jn.api));

	gdjn_unit_janetLang_load();
	gdjn_unit_janetRsrc_load();

	gdjn_ctx -> gd.janetLang_inst = gdjn_class_JanetLang_new() -> self;

	auto e = gd_engine_registerScriptLanguage(
		c -> objects.engine,
................................................................................
		false
	);
	gd_resourceSaver_addResourceFormatSaver(
		gdjn_ctx -> gd.t.objects.resourceSaver,
		gdjn_ctx -> gd.janetSaver_inst,
		false
	);











	_t(array).empty(&gdjn_ctx -> gd.dox, nullptr);
	gd_stringName empty = {};
	_t(stringName).empty(&empty, nullptr);
	_t(array).setTyped(&gdjn_ctx -> gd.dox,
			GDEXTENSION_VARIANT_TYPE_DICTIONARY, &empty, &empty);

................................................................................
(	void*                          data,
	GDExtensionInitializationLevel lvl
) {
	if (lvl != GDEXTENSION_INITIALIZATION_SCENE) return;
	/* we get double frees otherwise */

	const gdjn_typeDB* c = &gdjn_ctx -> gd.t;
	janet_gcunroot(janet_wrap_table(gdjn_ctx -> jn.api));

	gd_engine_unregisterScriptLanguage(
		c -> objects.engine,
		gdjn_ctx -> gd.janetLang_inst
	);
	/*
	GDExtensionTypePtr ret;
................................................................................
	gd_resourceSaver_removeResourceFormatSaver(
		gdjn_ctx -> gd.t.objects.resourceSaver,
		gdjn_ctx -> gd.janetSaver_inst
	);
	/* gd_refCounted_unreference(gdjn_ctx -> gd.janetLoader_inst); */
	/* gd_refCounted_unreference(gdjn_ctx -> gd.janetSaver_inst); */
	gdjn_class_JanetLang_del(nullptr, gdjn_ctx -> gd.janetLang_inst);

	janet_deinit();

	gdjn_ctx -> gd.free(gdjn_ctx);
	gdjn_ctx = nullptr;
}


gdBool

#define _warn(msg) _emit(warn, msg)
#define _err(msg)  _emit(err, msg)

typedef GDExtensionBool gdBool;

#define _alloc(ty, n) \
	((typeof(ty)*)gdjn_alloc(sizeof(ty) * (n)))


#define _free(v) \
	(gdjn_ctx -> gd.free(v))
#define _sz(r) ((sizeof(r) / sizeof(*r)))

#define _t(T) \
	(gdjn_ctx -> gd.t.gd_##T)
#define _method(name) \
................................................................................

		GDExtensionObjectPtr
			janetLang_inst,
			janetLoader_inst,
			janetSaver_inst;
	} gd;
	struct gdjn_jn {
		Janet env;
	} jn;
} gdjn;

extern gdjn* gdjn_ctx;

[[gnu::alloc_size(1)]] static inline
void* gdjn_alloc(size_t sz) {
	return gdjn_ctx -> gd.alloc(sz);
}






typedef struct gdjn_gd gdjn_gd; // derp
typedef struct gdjn_jn gdjn_jn;

typedef struct gdjn_class_def gdjn_class_def;

void
gdjn_dox
(	gd_dictionary* page
);

#define _warn(msg) _emit(warn, msg)
#define _err(msg)  _emit(err, msg)

typedef GDExtensionBool gdBool;

#define _alloc(ty, n) \
	((typeof(ty)*)gdjn_alloc(sizeof(ty) * (n)))
#define _realloc(v, ty, n) \
	((typeof(ty)*)gdjn_realloc((v), sizeof(ty) * (n)))
#define _free(v) \
	(gdjn_ctx -> gd.free(v))
#define _sz(r) ((sizeof(r) / sizeof(*r)))

#define _t(T) \
	(gdjn_ctx -> gd.t.gd_##T)
#define _method(name) \
................................................................................

		GDExtensionObjectPtr
			janetLang_inst,
			janetLoader_inst,
			janetSaver_inst;
	} gd;
	struct gdjn_jn {
		JanetTable* api;
	} jn;
} gdjn;

extern gdjn* gdjn_ctx;

[[gnu::alloc_size(1)]] static inline
void* gdjn_alloc(size_t sz) {
	return gdjn_ctx -> gd.alloc(sz);
}
[[gnu::alloc_size(2)]] static inline
void* gdjn_realloc(void* v, size_t sz) {
	return gdjn_ctx -> gd.realloc(v, sz);
}


typedef struct gdjn_gd gdjn_gd; // derp
typedef struct gdjn_jn gdjn_jn;

typedef struct gdjn_class_def gdjn_class_def;

void
gdjn_dox
(	gd_dictionary* page
);

(* [ʞ] src/janet-lang.gcd vi:ft=d
 *  ~ lexi hale <lexi@hale.su>
 *  🄯 AGPLv3
 *  ? implement the godot-janet interface
 *)




use <janet.h>;

class JanetLang is ScriptLanguageExtension {
	use <stdio.h>;
	use "util.h";

	new {};



	impl _get_name() -> string {
		gd_string j;
		_t(string).newWithUtf8Chars(&j, "Janet");
		return j;
	};

................................................................................
			l("for"), l("forv"), l("forever"),
			l("seq"), l("catseq"),
			l("map"), l("mapcat"),
			l("find"),
			l("array"), l("tuple"),
			l("string"), l("buffer"),
			l("table"), l("struct"),





			(* et cetera ad nauseam *)
		};
		gd_packedStringArray r = {};
		_t(packedStringArray).empty(&r, nullptr);
		for (size_t i = 0; i < _sz(words); ++i) {
			gdu_array_string_pushPtr(&r, words[i].w, words[i].sz);
		}
................................................................................
		return janscr -> self;
	};
	impl _create_script() -> ref Object {
		auto janscr = gdjn_class_JanetScriptText_new();
		return janscr -> self;
	};




	impl _get_documentation() -> array[dictionary] {
		gd_array a = {};
		_t(array).ref(&a, &gdjn_ctx -> gd.dox);
		return gdjn_ctx -> gd.dox;

















	};

	impl _init() { /* (* "deprecated" but i still have to impl it?? *) */ }; 
	impl _frame() {};
	impl _thread_enter() { janet_init(); };
	impl _thread_exit() { janet_deinit(); };
	impl _finish() {};
................................................................................
		_t(dictionary).empty(&dict,nullptr);
		return dict;
	};
};

class JanetScript is ScriptExtension {
	var as string: path;


	new {
		_t(string).empty(&me -> path, nullptr);

	};
	del {
		_t(string).dtor(&me -> path);

	};

	impl _create_instance(array[variant] argv, int argc, ref Object owner, bool refCounted, int error) -> ref Object {






























	};
	impl _get_language() -> ref ScriptLanguage {
		return gdjn_ctx -> gd.janetLang_inst;
	};
	impl _set_path(string path, bool takeOver) {
		if (takeOver) {
			_t(string).dtor(&me -> path);
			me -> path = path;
		} else {
			_t(string).dtor(&me -> path);
			/* _t(string).copy(&me -> path, (void const*[]) {&path}); */
			me -> path = gdu_string_dup(&path);
		}
	};
	impl _get_base_script() -> ref Script {
		return nullptr;
	};
	impl _has_static_method(string-name method) -> bool {
		return false;
	};
................................................................................
	impl _get_global_name(string-name id) -> string-name {
		return gdu_sym_null();
	};
	impl _is_abstract() -> bool {
		return false; (* TODO abuse for non-class scripts? *)
	};
	impl _get_instance_base_type() -> string-name {
		return _gdu_intern("Object");
	};
	impl _is_valid() -> bool {
		return true;
	};
	impl _get_documentation() -> array[dictionary] {
		gd_array dox;
		_t(array).empty(&dox, nullptr);
		auto empty = gdu_sym_null();
		_t(array).setTyped(&dox,
			GDEXTENSION_VARIANT_TYPE_DICTIONARY, &empty, &empty);
		_t(stringName).dtor(&empty);
		return dox;
	};














};

class JanetScriptText extends JanetScript {
	var as string: src;
	new {
		_t(string).empty(&me -> src, nullptr);
	};
	del {
		_t(string).dtor(&me -> src);
	};

	impl _has_source_code() -> bool   { return true; };
	impl _get_source_code() -> string {

		auto d = gdu_string_dup(&me -> src);
		return d;
	};
	impl _set_source_code(string s) {




		_t(string).dtor(&me -> src);
		_t(string).copy(&me -> src, (void const*[]) {&s});
	};
	impl _reload(bool keepState) -> int (* Error *) {
		(* TODO *)
		return gd_Error_ok;























	};
};

import {
	typedef struct gdjn_janet_image {
		size_t   sz;
		uint8_t* buf;

(* [ʞ] src/janet-lang.gcd vi:ft=d
 *  ~ lexi hale <lexi@hale.su>
 *  🄯 AGPLv3
 *  ? implement the godot-janet interface
 *)

import "type.h";
import "util-gd.h";
use    "util-jn.h";
use    <janet.h>;

class JanetLang is ScriptLanguageExtension {
	(* use <stdio.h>; *)


	new {};

	(* var as array[ref Object]: placeholders; *)

	impl _get_name() -> string {
		gd_string j;
		_t(string).newWithUtf8Chars(&j, "Janet");
		return j;
	};

................................................................................
			l("for"), l("forv"), l("forever"),
			l("seq"), l("catseq"),
			l("map"), l("mapcat"),
			l("find"),
			l("array"), l("tuple"),
			l("string"), l("buffer"),
			l("table"), l("struct"),
			l("print"), l("prin"), l("pp"),
			(* gdjn macros *)
			l("defm"), l("defm-"),
			l("class"), l("defclass"), l("defclass-"),
			l("prop"),
			(* et cetera ad nauseam *)
		};
		gd_packedStringArray r = {};
		_t(packedStringArray).empty(&r, nullptr);
		for (size_t i = 0; i < _sz(words); ++i) {
			gdu_array_string_pushPtr(&r, words[i].w, words[i].sz);
		}
................................................................................
		return janscr -> self;
	};
	impl _create_script() -> ref Object {
		auto janscr = gdjn_class_JanetScriptText_new();
		return janscr -> self;
	};

	use {
		#define _typeCode(x) gd_ScriptLanguageExtension_LookupResultType_lookupResult##x
	};
	impl _get_documentation() -> array[dictionary] {
		gd_array a = {};
		_t(array).ref(&a, &gdjn_ctx -> gd.dox);
		return gdjn_ctx -> gd.dox;
	};
	impl _lookup_code
	(	string code;
		string symbol;
		string path;
		ref Object owner;
	) -> dictionary {
		gd_dictionary d;
		_t(dictionary).empty(&d, nullptr);
		gd_variant v;

		v = gd_variant_of_int(gd_Error_failed);
		gdu_setKey(&d, _pstrLit("result"), &v);

		v = gd_variant_of_int(_typeCode(ScriptLocation));
		gdu_setKey(&d, _pstrLit("type"), &v);
		return d;
	};

	impl _init() { /* (* "deprecated" but i still have to impl it?? *) */ }; 
	impl _frame() {};
	impl _thread_enter() { janet_init(); };
	impl _thread_exit() { janet_deinit(); };
	impl _finish() {};
................................................................................
		_t(dictionary).empty(&dict,nullptr);
		return dict;
	};
};

class JanetScript is ScriptExtension {
	var as string: path;
	var JanetTable*: env;
	
	new {
		_t(string).empty(&me -> path, nullptr);
		me -> env = nullptr;
	};
	del {
		_t(string).dtor(&me -> path);
		if (me -> env) janet_gcunroot(janet_wrap_table(me -> env));
	};


	class BaseInstance is Object {
		var as ref JanetScript: script;
		del {
			gd_refCounted_unreference(me -> script);
			printf("del script instance\n");
		};
	};
	class Instance extends JanetScript_BaseInstance {
	};
	class Placeholder extends JanetScript_BaseInstance {
	};

	(* impl _create_instance(array[variant] argv, int argc, ref Object owner, bool refCounted, int error) -> ref Object { *)
	impl _can_instantiate() -> bool {
		if (me -> env == nullptr) return false;
		return true; // FIXME
	};
	impl _instance_create(ref Object obj) -> ref Object {
		auto ci = gdjn_class_JanetScript_Instance_new();
		printf("made new script instance\n");
		ci -> super.script = me;
		gd_refCounted_reference(me -> self);
		return ci;
	};
	impl _placeholder_instance_create(ref Object obj) -> ref Object {
		auto ci = gdjn_class_JanetScript_Placeholder_new();
		printf("made new script placeholder\n");
		ci -> super.script = me;
		gd_refCounted_reference(me -> self);
		return ci;
	};
	impl _get_language() -> ref ScriptLanguage {
		return gdjn_ctx -> gd.janetLang_inst;
	};
	impl _set_path(string path, bool takeOver) {

		_t(string).dtor(&me -> path);



		/* _t(string).copy(&me -> path, (void const*[]) {&path}); */
		me -> path = gdu_string_dup(&path);

	};
	impl _get_base_script() -> ref Script {
		return nullptr;
	};
	impl _has_static_method(string-name method) -> bool {
		return false;
	};
................................................................................
	impl _get_global_name(string-name id) -> string-name {
		return gdu_sym_null();
	};
	impl _is_abstract() -> bool {
		return false; (* TODO abuse for non-class scripts? *)
	};
	impl _get_instance_base_type() -> string-name {
		return _gdu_intern("ScriptExtension");
	};
	impl _is_valid() -> bool {
		return true;
	};
	impl _get_documentation() -> array[dictionary] {
		gd_array dox;
		_t(array).empty(&dox, nullptr);
		auto empty = gdu_sym_null();
		_t(array).setTyped(&dox,
			GDEXTENSION_VARIANT_TYPE_DICTIONARY, &empty, &empty);
		_t(stringName).dtor(&empty);
		return dox;
	};
	
	(*
	impl _update_exports() {

	};
	impl _placeholder_instance_create
	(ref Object forObj) -> ref Object {
		
	};
	impl _placeholder_erased
	(ref Object ph) {
	};
	*)
		
};

class JanetScriptText extends JanetScript {
	var pstr: src;
	new {
		me -> src = (pstr){};
	};
	del {
		_drop(me -> src);
	};

	impl _has_source_code() -> bool   { return true; };
	impl _get_source_code() -> string {
		return gdu_str_sz(me -> src.v, me -> src.sz);
		/* auto d = gdu_string_dup(&me -> src); */
		/* return d; */
	};
	impl _set_source_code(string s) {
		_drop(me -> src);
		me -> src = gdu_string_pdup(&s);
		/* printf("janet: set script %d %s\n", (int)me -> src.sz, me -> src.v); */
		gdjn_class_JanetScriptText_method__reload(me, false);
		/* _t(string).dtor(&me -> src); */
		/* _t(string).copy(&me -> src, (void const*[]) {&s}); */
	};
	impl _reload(bool keepState) -> int (* Error *) {

		auto errorCode = gd_Error_ok;
		if (me -> super.env)
			janet_gcunroot(janet_wrap_table(me -> super.env));
		me -> super.env = nullptr;
		pstr path = _gdu_string_stackp(&me -> super.path);

		auto cls = jnu_table_extend(gdjn_ctx -> jn.api, 8);
		janet_gcroot(janet_wrap_table(cls));
		/* printf("janet: doing bytes %d %s\n", (int)me -> src.sz, me -> src.v); */
		int e = janet_dobytes(cls,
			(uint8_t const*)me -> src.v, me -> src.sz,
			path.v, nullptr);
		(* we discard the return value; the environment is what
		 * we're really interested in here *)
		/* printf("janet: bytes done, got %d\n",e); */
		if (e == 0) {
			me -> super.env = cls;
		} else {
			_err("janet module could not be loaded");
			errorCode = gd_Error_errParseError;
			janet_gcunroot(janet_wrap_table(cls));
		}

		return errorCode;
	};
};

import {
	typedef struct gdjn_janet_image {
		size_t   sz;
		uint8_t* buf;

(* [ʞ] src/janet-rsrc.gcd vi:ft=d
 *  ~ lexi hale <lexi@hale.su>
 *  🄯 AGPLv3
 *  ? implement the saving and loading of janet scripts
 *)
use "util.h";
use <assert.h>;
use "janet-lang.h";

use {
	static gd_packedStringArray
	janetExts(void) {
		gd_packedStringArray r = {};
................................................................................
		    || gdu_symEq(&type, "JanetScriptImage");
	};
	impl _get_resource_type(string path) -> string {
		const char* str = "";
		switch (janetKind(&path)) {
			case janetFileImage: str="JanetScriptImage"; break;
			case janetFileText: str="JanetScriptText"; break;

		}
		return gdu_str(str);
	};
	use {
		static inline gd_variant
		vFromErr(int64_t err) {
			gd_variant v;
................................................................................
	};
	impl _load
	(	string path;
		string origPath;
		bool   subThreads;
		int    cacheMode;
	) -> variant {











		switch (janetKind(&path)) {
			case janetFileImage: {
				auto s = gdjn_class_JanetScriptImage_new();
				return vFromObj(gdu_cast(s->self, "Resource"));



			}; 
			case janetFileText: {
				auto s = gdjn_class_JanetScriptText_new();
				return vFromObj(gdu_cast(s->self, "Resource"));







			};
			default: {
				return vFromErr(gd_Error_errFileUnrecognized);
			};
		}





	};
};


class JanetScriptSaver is ResourceFormatSaver {
	use {
		static inline bool
................................................................................
			    || _gdu_objIs(res, JanetScriptText);
		}
	};
	impl _get_recognized_extensions() -> packed-string-array {
		return janetExts();
	};
	impl _recognize(ref Resource res) -> bool {

		return gdjn_isJanet(res);
	};
	impl _save(ref Resource res, string path, int flags) -> int {
		gd_refCounted_reference(res);
		assert(gdjn_isJanet(res));
		gd_string path_mine;
		_t(string).copy(&path_mine, (void const*[]) {&path});
		auto fd = gd_fileAccess_open(path, 
				gd_FileAccess_ModeFlags_write);
		gd_refCounted_reference(fd);

		if (_gdu_objIs(res, JanetScriptText)) {
			auto asText = gdu_cast(res, "JanetScriptText");
			gd_string src = gd_script_getSourceCode(asText);
			gd_fileAccess_storeString(fd, src);
			_t(string).dtor(&src);
			auto data = gdjn_class_JanetScriptText_data(res);
		} else if (_gdu_objIs(res, JanetScriptImage)) {
			auto asImg = gdu_cast(res, "JanetScriptImage");
			auto data = gdjn_class_JanetScriptImage_data(res);
		};

		gd_fileAccess_close(fd);
		_t(string).dtor(&path_mine);

		gd_refCounted_unreference(fd);
		gd_refCounted_unreference(res);

	};
};

(* [ʞ] src/janet-rsrc.gcd vi:ft=d
 *  ~ lexi hale <lexi@hale.su>
 *  🄯 AGPLv3
 *  ? implement the saving and loading of janet scripts
 *)
use "util-gd.h";
use <assert.h>;
use "janet-lang.h";

use {
	static gd_packedStringArray
	janetExts(void) {
		gd_packedStringArray r = {};
................................................................................
		    || gdu_symEq(&type, "JanetScriptImage");
	};
	impl _get_resource_type(string path) -> string {
		const char* str = "";
		switch (janetKind(&path)) {
			case janetFileImage: str="JanetScriptImage"; break;
			case janetFileText: str="JanetScriptText"; break;
			default: break;
		}
		return gdu_str(str);
	};
	use {
		static inline gd_variant
		vFromErr(int64_t err) {
			gd_variant v;
................................................................................
	};
	impl _load
	(	string path;
		string origPath;
		bool   subThreads;
		int    cacheMode;
	) -> variant {
		(* yes it's a bit hinky using hardwired static dispatch here
		 * but ye gods, at least it spares us from having to use the
		 * horrible gdscript ptrcall mechanism *)
		GDExtensionObjectPtr obj = nullptr;
		auto cpath = _gdu_string_stackp(&path);
		gd_string path_mine = gdu_str_sz(cpath.v, cpath.sz);
		auto fd = gd_fileAccess_open(path_mine, 
				gd_FileAccess_ModeFlags_read);
		// auto cpath = _gdu_string_stackp(&path_mine);
		printf("janet: loading from file %zu %s\n", cpath.sz, cpath.v);
		/* gd_refCounted_reference(fd); */
		switch (janetKind(&path)) {
			case janetFileImage: {
				auto s = gdjn_class_JanetScriptImage_new();
				gdjn_class_JanetScript_method__set_path(&s->super, path_mine, false);
				gdjn_class_JanetScriptImage_method__reload(s, false);
				obj = s -> self;
				break;
			}; 
			case janetFileText: {
				auto s = gdjn_class_JanetScriptText_new();
				gdjn_class_JanetScript_method__set_path(&s->super, path_mine, false);

				auto text = gd_fileAccess_getAsText(fd, false);
				gdjn_class_JanetScriptText_method__set_source_code
					(s, text);
				_t(string).dtor(&text);
				obj = s -> self;
				break;
			};
			default: break;


		}
		gd_fileAccess_close(fd);
		_t(string).dtor(&path_mine);
		/* gd_refCounted_unreference(fd); */
		if (obj) return vFromObj(gdu_cast(obj, "Resource"));
		    else return vFromErr(gd_Error_errFileUnrecognized);
	};
};


class JanetScriptSaver is ResourceFormatSaver {
	use {
		static inline bool
................................................................................
			    || _gdu_objIs(res, JanetScriptText);
		}
	};
	impl _get_recognized_extensions() -> packed-string-array {
		return janetExts();
	};
	impl _recognize(ref Resource res) -> bool {
		printf("checking against res %p\n", res);
		return gdjn_isJanet(res);
	};
	impl _save(ref Resource res, string path, int flags) -> int {
		gd_refCounted_reference(res);
		assert(gdjn_isJanet(res));
		gd_string path_mine = gdu_string_dup(&path);

		auto fd = gd_fileAccess_open(path, 
				gd_FileAccess_ModeFlags_write);
		gd_refCounted_reference(fd);

		if (_gdu_objIs(res, JanetScriptText)) {
			auto asText = gdu_cast(res, "JanetScriptText");
			gd_string src = gd_script_getSourceCode(asText);
			gd_fileAccess_storeString(fd, src);
			_t(string).dtor(&src);

		} else if (_gdu_objIs(res, JanetScriptImage)) {
			// auto asImg = gdu_cast(res, "JanetScriptImage");
			// auto data = gdjn_class_JanetScriptImage_data(res);
		};

		// gd_fileAccess_close(fd);
		_t(string).dtor(&path_mine);
		printf("number of surviving saver refs: %zu\n", gd_refCounted_getReferenceCount(gdu_cast(me -> self, "RefCounted")));
		gd_refCounted_unreference(fd);
		gd_refCounted_unreference(res);
		return gd_Error_ok;
	};
};

#pragma once

#ifdef _gdjn_shims
// install shims for code compiled in library mode
// yes this is awful, why do you ask
void* gdjn_janet_malloc(size_t sz) { return malloc(sz); }
void* gdjn_janet_realloc(void* ptr, size_t sz) { return realloc(ptr, sz); }
void* gdjn_janet_calloc(size_t n, size_t sz) { return calloc(n, sz); }
void  gdjn_janet_free(void* ptr) { free(ptr); }
#else
#	define janet_malloc gdjn_janet_malloc
#	define janet_calloc gdjn_janet_calloc
#	define janet_realloc gdjn_janet_realloc
#	define janet_free gdjn_janet_free
#endif

/* [ʞ] src/type.h
 *  ~ lexi hale <lexi@hale.su>
 *  🄯 AGPLv3
 *  ? miscellaneous useful types & macros
 */

#pragma once

#define _strDynSz(a) \
	__builtin_choose_expr( \
			/*   if */ __builtin_types_compatible_p(typeof(a), pstr), \
			/* then */ ((pstr*)&(a))->sz, \
			/* else */ strlen(*(char const**)&(a)))
#define _strDynMem(a) \
	__builtin_choose_expr( \
			/*   if */ __builtin_types_compatible_p(typeof(a), pstr), \
			/* then */ ((pstr*)&(a))->v, \
			/* else */ *(char**)&(a))
#define _pstrOf(a) ((pstr){.v=_strDynMem(a), .sz=_strDynSz(a)})

#define _array(t) struct {t* v; size_t sz;}
typedef _array(char) pstr;

#define _pstrLit(a) ((pstr){.v=(a),.sz=sizeof(a)-1})

#define _drop(x) ({ \
	if (x.v) { \
		_free (x.v); \
		x.v = nullptr; \
		x.sz = 0; \
	} \
})
#define _new(T, n) ((T){ \
	.v = _alloc( typeof( ((typeof(T)) {}).v ), n), \
	.sz = n, \
})

/* [ʞ] util.h
 *  ~ lexi hale <lexi@hale.su>
 *  🄯 AGPLv3
 *  ? encapsulate annoying operations (read: pitiful, fragile blast
 *    shield over the most indefensibly psychotic pieces of the godot
 *    "type" "system")
 *
 *    if you want to use this outside gdjn, redefine the macro _t
 *    from gdjn.h appropriately.
 *
 *    (honestly tho you should use c-bind-gen.janet too)
 */

#pragma once
#include "gdjn.h"
#include <string.h>


static inline gd_string
gdu_string_of_stringName(const gd_stringName* const s) {
	gd_string r;
	_t(string).fromStringName(&r, (void*)&s);
	return r;
}
................................................................................
#define _refMut(x) typeof(typeof(x)      * const)
#define _with(T, k, v, ...) ({\
	typeof(gd_##T) k = v; \
	do { __VA_ARGS__; } while (0); \
	_t(T).dtor(&k); \
})

#define _withSym(k, v, ...) \
	_with(stringName, k, gdu_intern(v), __VA_ARGS__)
#define _withSym0(k, ...) \
	_with(stringName, k, {}, __VA_ARGS__)
#define _withStr(k, v, ...) \
	_with(string, k, gdu_str(v), __VA_ARGS__)
#define _withStr0(k, v, ...) \
	_with(string, k, {}, __VA_ARGS__)

#define _typeEq(a, b) \
	__builtin_classify_type(typeof(a)) == _builtin_classify_type(typeof(b))


#define _refVal   0
#define _refPtr   1
#define _refArray 2


#define _indirect(a) \
		__builtin_types_compatible_p(typeof(a), void*)

#define _refKind(a) \
	__builtin_choose( _typeEq(typeof_unqual(a), \
	                          typeof_unqual(a[0]) []), _refArray \
		/* false */ __builtin_choose(_typeEq(a, (typeof_unqual(a[0]) *)), _refPtr ))

#define _szElse(a, zero) \
	__builtin_choose(_refKind(a) == _refArray, \
		/* true */ _sz(a), \
		/* false */ __builtin_choose(_refKind(a) == _refPtr, \
			/* true */ (__builtin_counted_by(ptr) != nullptr ? \
			            *__builtin_counted_by(ptr) : (zero)) \
			/* false */ (void)0 /* bad type */ ))
#define _sz0(a)   _szElse(a,0)
#define _szStr(a) \
	__builtin_choose(_typeEq((a), pstr), (a).sz, _szElse(a, strlen(a)))

#define _array(t) struct {t* v; size_t sz;}
typedef _array(char) pstr;

#define _strWithSz(a) (a), _strLen(a)

static inline bool
gdu_symIs
(	gd_stringName const* const a,
	gd_stringName const* const b
) {
	bool res;
................................................................................
	char* buf = _alloc(char, len);
	gdu_string_emit(s, buf, len - 1);
	return (pstr){buf,len};
}

static inline gd_string
gdu_string_dup (_ref(gd_string) s) {
	gd_string cp;






	_t(string).copy(&cp, (void const*[]) {s});



	return cp;
}

#define _cat(x,y) x##y
#define __cat(x,y) _cat(x,y)
#define _gensym __cat(_sym_,__COUNTER__)

#define __gdu_string_auto(szid, name, str) \
................................................................................
static inline GDExtensionObjectPtr
gdu_cast
(	GDExtensionConstObjectPtr what,
	_ref(char)                to
) {
	return _t(object).castTo(what, gdu_classTag(to));
}

/* [ʞ] src/util-gd.h
 *  ~ lexi hale <lexi@hale.su>
 *  🄯 AGPLv3
 *  ? encapsulate annoying godot operations (read: pitiful,
 *    fragile blast shield over the most indefensibly psychotic
 *    pieces of the godot "type" "system")





 */

#pragma once
#include "gdjn.h"
#include <string.h>
#include "type.h"

static inline gd_string
gdu_string_of_stringName(const gd_stringName* const s) {
	gd_string r;
	_t(string).fromStringName(&r, (void*)&s);
	return r;
}
................................................................................
#define _refMut(x) typeof(typeof(x)      * const)
#define _with(T, k, v, ...) ({\
	typeof(gd_##T) k = v; \
	do { __VA_ARGS__; } while (0); \
	_t(T).dtor(&k); \
})

#define _withSym0(k, ...) \
	_with(stringName, k, {}, __VA_ARGS__)
#define _withSymSz(k, v, sz, ...) \
	_with(stringName, k, gdu_intern_sz(v, sz), __VA_ARGS__)
#define _withSym(k, v, ...) \
	_withSymSz(k, _strDynMem(v), _strDynSz(v), __VA_ARGS__)
#define _withSymLit(k, v, ...) \
	_withSymSz(k, _litSz(v), __VA_ARGS__)

#define _withStr0(k, ...) \
	_with(string, k, {}, __VA_ARGS__)

#define _withStrSz(k, v, sz, ...) \
	_with(string, k, gdu_str_sz(v, sz), __VA_ARGS__)
#define _withStr(k, v, ...) \
	_withStrSz(k, _strDynMem(v), _strDynSz(v), __VA_ARGS__)

#define _withStrLit(k, v, ...) \
	_withStrSz(k, _litSz(v), __VA_ARGS__)























static inline bool
gdu_symIs
(	gd_stringName const* const a,
	gd_stringName const* const b
) {
	bool res;
................................................................................
	char* buf = _alloc(char, len);
	gdu_string_emit(s, buf, len - 1);
	return (pstr){buf,len};
}

static inline gd_string
gdu_string_dup (_ref(gd_string) s) {
	/* the godot copy method seems to be broken somehow,
	 * probably for reasons that have to do with the
	 * hypercomplicated CoW implementation that i think
	 * is meant to be handled on this end somehow? we
	 * can seemingly avoid crashes and memory corruption
	 * if we copy the string through C, forcing a clean
	 * new string to be generated on the godot side. */
	// _t(string).copy(&cp, (void const*[]) {s});
	auto cstr = gdu_string_pdup(s);
	auto copied = gdu_str_sz(cstr.v, cstr.sz);
	_drop(cstr);
	return copied;
}

#define _cat(x,y) x##y
#define __cat(x,y) _cat(x,y)
#define _gensym __cat(_sym_,__COUNTER__)

#define __gdu_string_auto(szid, name, str) \
................................................................................
static inline GDExtensionObjectPtr
gdu_cast
(	GDExtensionConstObjectPtr what,
	_ref(char)                to
) {
	return _t(object).castTo(what, gdu_classTag(to));
}

static inline void
gdu_setKey
(	gd_dictionary* const dict,
	pstr           const key,
	_ref(gd_variant)     val
) {
	gd_variant v = gd_variant_of_dictionary(*dict);
	_withSym(keyName, key, {
		uint8_t ok = false;
		_t(variant).setNamed(&v, &keyName, val, &ok);
	});
}

/* [ʞ] util-gn.h
 *  ~ lexi hale <lexi@hale.su>
 *  🄯 AGPLv3
 *  ? convenience functions for janet
 */

#pragma once
#include <janet.h>

static inline void
jnu_table_inherit(Janet tbl, Janet proto) {
	auto t = janet_unwrap_table(tbl);
	auto p = janet_unwrap_table(proto);
	t -> proto = p;
}

static inline JanetTable*
jnu_table_extend(JanetTable* p, size_t sz) {
	auto t = janet_table(sz);
	t -> proto = p;
	return t;
}

#include "vm.h"
#include "util-jn.h"
#include "util-gd.h"
#include "rsrc.h"

#define _safe_wrap(gdt, ct) ({ \
	_Static_assert(sizeof(gdt) == sizeof(ct)); \
	*(typeof(ct)*)v; \
})

void
gdjn_dejanetize_typed
(	GDExtensionTypePtr v,
	GDExtensionVariantType const t,
	Janet val
) {
	switch (t) {
		case GDEXTENSION_VARIANT_TYPE_BOOL:
			assert(janet_type(val) == JANET_BOOLEAN);
			*(bool*)v = janet_unwrap_boolean(val);
			break;
		case GDEXTENSION_VARIANT_TYPE_INT:
			switch (janet_type(val)) {
				case JANET_NUMBER:
					*(int64_t*)v = janet_unwrap_integer(val); break;
				case JANET_INT_S64:
					*(int64_t*)v = janet_unwrap_s64(val); break;
				case JANET_INT_U64:
					*(int64_t*)v = janet_unwrap_u64(val); break;
				default: assert(false);
			}
			break;
		case GDEXTENSION_VARIANT_TYPE_STRING: 
		case GDEXTENSION_VARIANT_TYPE_STRING_NAME: {
			JanetString str;
			switch (janet_type(val)) {
				case JANET_STRING: str = janet_unwrap_string(val); break;
				case JANET_KEYWORD: str = janet_unwrap_keyword(val); break;
				case JANET_SYMBOL: str = janet_unwrap_symbol(val); break;
				default: assert(false);
			}
			size_t len = janet_string_length(str);
			if (t == GDEXTENSION_VARIANT_TYPE_STRING_NAME) {
				_t(stringName).newWithUtf8CharsAndLen(v, (char*)str, len);
			} else {
				_t(string).newWithUtf8CharsAndLen(v, (char*)str, len);
			}
			break;
		}
		case GDEXTENSION_VARIANT_TYPE_ARRAY: {
		}
		case GDEXTENSION_VARIANT_TYPE_DICTIONARY: {
		}
		default: {
			assert(false);
		}
	}
}

Janet
gdjn_janetize_typed
(	GDExtensionTypePtr     const v,
	GDExtensionVariantType const t
) {
	switch (t) {
		case GDEXTENSION_VARIANT_TYPE_NIL:
			return janet_wrap_nil();
		case GDEXTENSION_VARIANT_TYPE_BOOL:
			return janet_wrap_boolean(_safe_wrap(gd_bool, int8_t));
		case GDEXTENSION_VARIANT_TYPE_INT:
			return janet_wrap_s64(_safe_wrap(gd_int, int64_t));
		case GDEXTENSION_VARIANT_TYPE_FLOAT:
			_Static_assert(
				sizeof(gd_float) == sizeof(double) ||
				sizeof(gd_float) == sizeof(float)
			);
			return janet_wrap_number(
				(sizeof(gd_float) == sizeof(double)) ? *(double*)v :
				(sizeof(gd_float) == sizeof(float))  ? *(float*)v  :0);

		case GDEXTENSION_VARIANT_TYPE_STRING: {
			auto str = gdu_string_pdup((gd_string*)v);
			auto j = janet_stringv((void*)str.v, str.sz);
			_free(str.v);
			return j;
		};

		case GDEXTENSION_VARIANT_TYPE_STRING_NAME: {
		   /* we can reasonably assume syms will be small enough
			* to fit on the stack and avoid a pointless malloc */
			auto str = _gdu_stringName_stackp((gd_stringName*)v);
			auto j = janet_keywordv((void*)str.v, str.sz);
			return j;
		};

		case GDEXTENSION_VARIANT_TYPE_ARRAY: {
			auto sz = gd_array_size(v);
			auto ja = janet_array(sz);
			for (size_t i = 0; i < sz; ++i) {
				auto val = _t(array).operatorIndexConst(v, i);
				auto j = gdjn_janetize(val);
				janet_array_push(ja, j);
			}
			return janet_wrap_array(ja);
		};
		default: assert(false);
	}
}


typedef struct jn_closure {
	Janet (*fn)(void* data, int32_t argc, Janet* argv);
	void (*gc)(void* data);
	char alignas(max_align_t) data [];
} jn_closure;

typedef struct jn_hnd_dict {
	JanetAbstractHead header;
	GDExtensionVariantType key, val;
	gd_dictionary dict;
} jn_hnd_dict;

typedef struct jn_hnd_array {
	JanetAbstractHead header;
	GDExtensionVariantType ty;
	gd_array array;
} jn_hnd_array;

static int
api_del_closure(void* ptr, size_t sz) {
	jn_closure* c = ptr;
	if (c -> gc != nullptr) {
		(*c -> gc)(c -> data);
	}
	return 0;
}

static Janet
api_call_closure
(	void* ptr,
	int32_t argc,
	Janet* argv
) {
	jn_closure* c = ptr;
	return (c -> fn)(c -> data, argc, argv);
}

static int
api_del_dict(void* ptr, size_t sz) {
	jn_hnd_dict* dict = ptr;
	_t(dictionary).dtor(&dict -> dict);
	printf("drop dict\n");
	return 0;
}
static int
api_del_array(void* ptr, size_t sz) {
	jn_hnd_array* array = ptr;
	_t(array).dtor(&array -> array);
	printf("drop array\n");
	return 0;
}

const JanetAbstractType jn_closure_def = {
	.name = "closure",
	.call = api_call_closure,
	.gc = api_del_closure,
};

const JanetAbstractType jn_hnd_dict_def = {
	.name = "prim/type/dict",
	.gc = api_del_dict,
};

const JanetAbstractType jn_hnd_array_def = {
	.name = "prim/type/array",
	.gc = api_del_array,
};


static Janet
api_new_array(int32_t argc, Janet* argv) {
	auto a = (jn_hnd_array*)janet_abstract(&jn_hnd_array_def, sizeof(jn_hnd_array));
	_t(array).empty(&a -> array, nullptr);
	printf("create array\n");
	return janet_wrap_abstract(a);
}

static Janet
api_new_dict(int32_t argc, Janet* argv) {
	auto a = (jn_hnd_dict*)janet_abstract(&jn_hnd_dict_def, sizeof(jn_hnd_dict));
	_t(dictionary).empty(&a -> dict, nullptr);
	printf("create dict\n");
	return janet_wrap_abstract(a);
}


/* (prim/class-load [<ident> [<ident2>...]])
 * low-level class loader. run at compile time to
 * import a godot class */
static Janet
api_class_load(int32_t argc, Janet* argv) {
	return janet_wrap_nil(); /* FIXME */
}

static const JanetReg reg_core [] = {
	{"class-load", api_class_load,
		"(prim/class-load ident)\n\n"
		"low-level loading function for Godot classes"},
	{"type/array", api_new_array,
		"(prim/type/array [...])\n\n"
		"create a handle to a new godot array object"},
	{"type/dict", api_new_dict,
		"(prim/type/dict <key-type> <val-type> {...})\n\n"
		"create a handle to a new godot dictionary object"},
	{}
};


JanetTable*
gdjn_vm_api_spawnEnv (JanetTable* api) {
	/* create a clean new environment that can be used
	 * and discarded by a script without contaminating
	 * the global environment(s)
	 * yes this is ooky */
	auto env = jnu_table_extend(api, 8);
	auto sym_mc = janet_csymbolv("module/cache");
	auto cleancache = jnu_table_extend(
			janet_unwrap_table(janet_table_get(api, sym_mc)), 8);

	janet_table_put(env, janet_csymbolv("module/cache"), janet_wrap_table(cleancache));
	return env;
}


gdjn_vm_bind
gdjn_vm_meta
(	JanetTable* bind
) {
	gdjn_vm_bind b = {};

	if (gdjn_vm_metaFlag(bind, "private")) goto fail;
	if (!gdjn_vm_metaKey(bind, "value", &b.val)) goto fail;

	if (gdjn_vm_metaFlag(bind, "macro"))
		b.kind = gdjn_vm_bind_mac;
	else {
		if (gdjn_vm_metaKey(bind, "method", &b.meta))
			/* TODO assert callability */
			b.kind = gdjn_vm_bind_method;
		else if (gdjn_vm_metaFlag(bind, "class"))
			b.kind = gdjn_vm_bind_class;
		else if (gdjn_vm_metaKey(bind, "type", &b.meta)) {
			if (gdjn_vm_metaFlag(bind, "prop")) {
				b.kind = gdjn_vm_bind_prop;
			} else /* constant */ {
				b.kind = gdjn_vm_bind_const;
				goto succeed;
			}
			if (gdjn_vm_metaFlag(bind, "share"))
				b.kind |= gdjn_vm_bind_flag_static;
		} else {
			switch (janet_type(b.val)) {
				case JANET_ABSTRACT:
					if ((janet_abstract_type(&b.val)) != &jn_closure_def) {
						b.kind = gdjn_vm_bind_const; break;
					}
				case JANET_FUNCTION:
				case JANET_CFUNCTION:
					b.kind = gdjn_vm_bind_method_static;
					break;
				default: goto fail;
			}
		}
	}
	/* found a valid export, return it */
	succeed: return b;
	/* this binding is not marked correctly for gdexport */
	fail: return (gdjn_vm_bind){gdjn_vm_bind_none};
}

gdjn_vm_bind
gdjn_vm_resv
(	JanetTable* env,
	Janet       key
) {
	auto gchnd = janet_gclock();
	Janet def = janet_table_get(env, key);
	if (janet_type(def) == JANET_NIL)
		return (gdjn_vm_bind){};
	auto m = gdjn_vm_meta(janet_unwrap_table(def));
	janet_gcunlock(gchnd);
	return m;
}

void gdjn_vm_api_installCommon (JanetTable* tgt) {
	/* install primitives */
	janet_cfuns(tgt, "prim", reg_core);
	auto idmap = janet_env_lookup(tgt);
	int gc = janet_gclock();

	/* unpack API image */
	Janet apiEnv = janet_unmarshal(
		gdjn_rsrc_api_jimage,
		sizeof gdjn_rsrc_api_jimage,
		0,
		idmap,
		nullptr);
	printf("apienv type is %s\n",
			janet_type_names[janet_type(apiEnv)]);

	JanetTable* apiTbl = janet_unwrap_table(apiEnv);
	/* call the init function to precache base modules */
	Janet initDef = janet_table_get(apiTbl, janet_csymbolv("init"));
	if (janet_type(initDef) == JANET_NIL) {
		_err("no init fn in api envtbl");
		goto fail;
	}
	auto initFn = janet_unwrap_function(
			janet_table_get(janet_unwrap_table(initDef), 
				janet_ckeywordv("value")));
	Janet ret;
	auto e = janet_pcall(initFn, 0, nullptr, &ret, nullptr);
	if (e == JANET_SIGNAL_ERROR) {
		_err("failed to unpack the janet environment");
		goto fail;
	}
	printf("environment load complete\n");
fail:
	janet_gcunlock(gc);
	/* janet_collect(); */
}

JanetTable* gdjn_vm_api_build_compTime(void) {
	auto core = janet_core_env(nullptr);
	auto api = jnu_table_extend(core,32);
	gdjn_vm_api_installCommon(api);
	return api;
}

JanetTable* gdjn_vm_api_build_core(void) {
	auto core = janet_core_env(nullptr);
	auto api = jnu_table_extend(core,32);
	gdjn_vm_api_installCommon(api);
	return api;
}

JanetTable*
gdjn_vm_compile
(	pstr const  body,
	JanetTable* api,
	const char* ctx
) {
	if (!ctx) ctx = "<anon>";
	if (!api) api = gdjn_ctx -> jn.api;

	auto cls = jnu_table_extend(api, 8);
	janet_gcroot(janet_wrap_table(cls));
	/* printf("janet: doing bytes %d %s\n", (int)me -> src.sz, me -> src.v); */
	int e = janet_dobytes(cls,
		(uint8_t const*)body.v, body.sz,
		ctx, nullptr);
	/* we discard the return value; the environment is what
	 * we're really interested in here */
	/* printf("janet: bytes done, got %d\n",e); */
	if (e != 0) {
		_err("janet module could not be loaded");
		/* TODO capture parse error */
		janet_gcunroot(janet_wrap_table(cls));
		cls = nullptr;
	}
	return cls;
}


pstr
gdjn_vm_image
(	JanetTable* env,
	JanetTable* binds
) {
	return (pstr){}; //TODO
}

#pragma once
#include "gdjn.h"
#include "type.h"

Janet
gdjn_janetize_typed
(	GDExtensionTypePtr     const v,
	GDExtensionVariantType const t
);

static inline Janet
gdjn_janetize(gd_variant* const v) {
	return gdjn_janetize_typed(v, _t(variant).getType(v));
}

void
gdjn_dejanetize_typed
(	GDExtensionTypePtr v, /* out */
	GDExtensionVariantType const t,
	Janet val /* in */
);

// typedef struct gdjn_vm_class {
//
// } gdjn_vm_class;

JanetTable* gdjn_vm_api_build_compTime(void);
JanetTable* gdjn_vm_api_build_core(void);

JanetTable*
gdjn_vm_compile
(	pstr const  body,
	JanetTable* api,
	const char* ctx
);

pstr
gdjn_vm_image
(	JanetTable* env,
	JanetTable* binds
);

typedef struct gdjn_vm_bind {
	enum gdjn_vm_bind_kind {
		gdjn_vm_bind_flag_static = 1 << 5,
		gdjn_vm_bind_flag_doc    = 1 << 6,
		gdjn_vm_bind_flag_umask = ~(
			gdjn_vm_bind_flag_static |
			gdjn_vm_bind_flag_doc
		),

		gdjn_vm_bind_none = 0,
		gdjn_vm_bind_const,
		gdjn_vm_bind_prop,
		gdjn_vm_bind_method,
		gdjn_vm_bind_class,
		gdjn_vm_bind_mac, /* always static unfortunately */

		gdjn_vm_bind_prop_static = gdjn_vm_bind_prop
			| gdjn_vm_bind_flag_static,
		gdjn_vm_bind_method_static = gdjn_vm_bind_method
			| gdjn_vm_bind_flag_static,
	} kind;
	Janet val, meta;
} gdjn_vm_bind;

static inline bool
gdjn_vm_metaKey
(	JanetTable* const bind,
	char const* const kw,
	Janet     *       valSlot
) {
	Janet jv;
	if (valSlot == nullptr) valSlot = &jv;
	*valSlot = janet_table_get(bind, janet_ckeywordv(kw));
	return (janet_type(*valSlot) != JANET_NIL);
}

static inline bool
gdjn_vm_metaFlag
(	JanetTable* const bind,
	char const* const kw
) {
	Janet v = janet_table_get(bind, janet_ckeywordv(kw));
	return janet_truthy(v);
}

gdjn_vm_bind
gdjn_vm_meta
(	JanetTable* bind
);

gdjn_vm_bind
gdjn_vm_resv
(	JanetTable* env,
	Janet       key
);

(defn api-parse [src]
	{} #TODO parse json




	)




(defn api-gen [api]
	@{} #TODO gen bindings











	)




























































(defn main [_ api-src api-dest & _]
	(def api



		(with [fd (file/open api-src :r)]
			(api-gen (api-parse (:read fd :all)))))
	(def api-bin (make-image api))
	(with [fd (file/open api-dest :w)]
		(:write fd api-bin))
	0)

# [ʞ] tool/api-compile.janet
#  ~ lexi hale <lexi@hale.su>
#  🄯 AGPLv3
#  ? gathers the core modules and assembles
#    them into a unified image that can be
#    loaded into gdjn.

(def- extern-table  @{})
(def  marshal-map   @{})
(def  unmarshal-map @{})



(defn- safe-to-export? [x]
	# only ref types and explicit exportscan be safely replaced;
	# otherwise e.g. any use of the string "release" will be
	# replaced by the value of janet/build when loaded
	# yes this is lunacy i don't know why they did it like that
	(or (function?  x)
		(cfunction? x)
		(table?     x)
		(array?     x)
		(buffer?    x)
		(has-key? extern-table x)))

(defn- register-env [env]
	(merge-into extern-table
		(tabseq [[sym data] :pairs env
				 :when (has-key?         data :value)
				 :when (safe-to-export? (data :value))]
						(data :value) sym)))


# provide symbol mapping for core values &
# external symbols provided by gdjn
(register-env root-env)

(def modules '[
	core prim json
])

# here we iterate over the core modules and load each
# in turn. the array *gd-api-map* is assembled at
# compile-time and then used by the init function at
# runtime to enumerate and install the core modules.
# when core modules use a primitive, they declare their
# own *gd-api-map* which maps gensyms to the name of
# the desired primitive.
(def *gd-api-map* @{})
(defn- install [name env]
	(put *gd-api-map* name env)
	(when (has-key? env '*gd-api-map*)
		(def gdmap (get-in env ['*gd-api-map* :value]))
		(loop [[val key] :pairs gdmap
			   :when (safe-to-export? val)]
			(def sym (symbol '-val- (bxor (hash name) (hash val))))
			(put   marshal-map val sym)
			(put unmarshal-map sym val))
		(merge-into extern-table gdmap)))

(defn- log [fmt & r]
	(:write stderr "(api-compile) "
			(string/format fmt ;r)))
(defn- install-mod [name]
	(log "loading library %s\n" name)
	(def env (require (string "/lib/" name)))
	(install (string name) env))

(each m modules (install-mod m))

# macro implementations can be provided directly in janet
# and incorporated into the API image without having to
# implement anything beyond the primitive API in C

# this function is exported as part of api.jimage.
# it will be called from vm.c after initializing
# the primitive bindings
(defn init []
	(print "beginning merge")
	(merge-into module/cache *gd-api-map*)
	(print "api loaded"))

# this is the build-time entry point, which does
# the work of assembling the modules and marshalling
# them out. it is not exported
(defn main [_ out-path]
	(def env @{})
	(each sym '[init marshal-map unmarshal-map]
		(put env sym ((curenv) sym)))
	(let [blob (marshal env extern-table)]
		(with [fd (file/open out-path :w)]



			(:write fd blob)))
	0)

				  [ ;((<gd-sym> :%init) spec)
				   :binds (map bind-def
							   (or (spec :binds) []))
				   :methods (map bind-def
							   (or (spec :methods) []))
				   :ops (map bind-def
							   (or (spec :ops) []))

				   :ctors (or (spec :ctors) {})
				   :mode (spec :mode)])

	   :binds []
	   :methods []
	   :ctors {}
	   :ops []
	   :mode  :



	   :enum (fn [me]
				 (string "GDEXTENSION_VARIANT_TYPE_" (:scream me)))
	   ))

(defn env: [v dflt]
	(or ((os/environ) v) dflt))

................................................................................
		(has-value? x)))
(def variants (map |(:@new <gd-type> $) ~[
	{:id variant :binds [get-ptr-constructor
						 get-ptr-destructor
						 get-ptr-operator-evaluator
						 get-ptr-internal-getter
						 get-ptr-builtin-method


						 get-type
						 booleanize]}
	{:id bool        }


	{:id color }

	,;(map |{:id $} vector-types)
	,;(map |{:id $
			 :methods '[get set size resize fill clear
					    append append_array insert remove-at
					    has is-empty find rfind count
					    reverse slice duplicate]
			 :ctors {:empty []}
			 }
		   packed-types)
	{:id array
	 :binds [ref set-typed]

	 :ctors {:empty []}}

	{:id dictionary
	 :binds [set-typed operator-index operator-index-const]

	 :ctors {:empty []}}


	{:id string-name :mode :dc
	 :ops   [equal]
	 :binds [new-with-utf8-chars
			 new-with-utf8-chars-and-len]
	 :methods [length
			   ends-with begins-with
................................................................................
							 get-reference-count]}
	{:id script :binds [get-source-code set-source-code]}
	{:id file-access :binds [open close store-string get-as-text]}
	{:id resource-loader :binds [add-resource-format-loader
								 remove-resource-format-loader]}
	{:id resource-saver :binds [add-resource-format-saver
								remove-resource-format-saver]}


]))

(def global-enums (map |(:from <gd-sym> $) '[
	error
]))

(def singletons (map |(:from <gd-sym> $) '[
................................................................................
	(def api {
	  :decls   @[]
	  :aliases @[]
	  :calls   @[]
	  :defer-calls @[] # dependency Hel bypass
	  :types   @[]
	  :method-defs @[]


	})
	(def config (env: "gd_config" "double_64"))
	(def sizes (do
	   (var sz-list nil)
	   (loop [cfg :in (api-spec "builtin_class_sizes")
			      :until (not= nil sz-list)]
		   (when (= config (cfg "build_configuration"))
................................................................................
			(case (sizes x)
				4 small
				8 big
				(error (string "bad type size " (sizes x) " for " x))))
		(case x
			"int" (bp "int" "int32_t" "int64_t")
			"float" (bp "float" "float" "double")
			"bool" "bool"))

	(defn variant:gd->c [x]
		(def v (find |(= x (:tall (:@new <gd-sym> {:id ($ :id)}))) variants))
		(string "gd_" (:name v)))
	(defn translate-type [st &opt flags]
		(defn fl [x] (string/check-set (or flags :) x))
		(match (string/split "::" st)
			# enums can be directly mapped to a C
................................................................................
			(def id (string "gd_" (:tall class) "_" (e "name")))
			# the underlying type is IMPORTANT! godot enums
			# appear to use the godot int type, which (at present)
			# is always 8 bytes long. this means trying to write
			# a godot "enum" to a plain old C enum will, if you
			# are very lucky, cause your program to barf all over
			# the stack and immediately segfault
			(ln  "typedef enum %s : int64_t {" id)
			# thank the gods for C23. this would have been really
			# unpleasant otherwise
			(each n (e "values")
				(def ident (:from-snek <gd-sym> (n "name")))
				(def sym (:@new <gd-sym> ident))
				(ln "\t%s_%s = %d," id (:name sym) (n "value"))
				(ln "\t/* %s */"
................................................................................
			(def name (:from-snek <gd-sym> (v "name")))
			(ln "\tgd_%s_%s = %d," (:tall e) (:name name) (v "value"))
			(when (v "description")
				(ln "\t/* %s */" (v "description"))))
		(ln "} gd_%s;\n" (:tall e))
		)









	(loop [v :in variants
		   :let [vsz (or (sizes (:tall v))
						 (sizes (string (v :id) )))]]
		(add (api :aliases) # these are all opaque objects
			 "typedef _opaque(%d) gd_%s;"
			 vsz (:name v))
		(add (api :decls  ) "struct {")
		(def my-enum (:enum v))
		(add-methods v (v :binds))
		(add-enums v)






































		# bind builtins
		# WHY IS THIS *YET ANOTHER* COMPLETELY DIFFERENT API
		# for the SAME LITERAL THING fuck youuuuu
		(when (has-key? gdclasses (:tall v)) (loop [m :in (v :methods)
			   :let [method (get-in gdclasses [(:tall v) :methods
											   (:sulk m)])]]
................................................................................
					(translate-type (method :return_type))))
			(def args (method:args method (:tall v)
								   (if (method :is_const) :c :)))

			(def impl @[])
			(unless (= return-type "void")
				(array/push impl
					(string/format "typeof(%s) ret;" return-type)))
			(array/push impl
				(string/format "_g_typeDB -> gd_%s.%s("
							   (:name v) (:name m)))
					
			
			(array/push impl
						(string "\t" (if (method :is_static)
................................................................................
			(print "\ntypedef struct gdjn_typeDB {")
			(loop [d :in (api :decls)]
				(print "\t" d))
			(print "} gdjn_typeDB;")
			(each t (api :types) (print t))
			(print c-fetch-decl ";")
			(each m (api :method-defs)
				(print (m :dfn) ";")))



		"loader" (do
					 (print "#include <stdlib.h>\n"
							"#include <stdio.h>\n"
							"#include <assert.h>\n"
							"#include \"interface.h\"\n\n"
							"static gdjn_typeDB* _g_typeDB;\n\n"
							# HORRID HACK
							
							c-fetch-decl "{\n"
							;(map |(string "\t" $ "\n")
								  [ "_g_typeDB = t;"
								    ;(api :calls)



								    ;(api :defer-calls) ])
							"}")
					 (each m (api :method-defs)
						 (print (m :dfn) "{\n\t" (string/join (m :impl) "\n\t") "\n}\n")))))

				  [ ;((<gd-sym> :%init) spec)
				   :binds (map bind-def
							   (or (spec :binds) []))
				   :methods (map bind-def
							   (or (spec :methods) []))
				   :ops (map bind-def
							   (or (spec :ops) []))
				   :indexed (or (spec :indexed) false)
				   :ctors (or (spec :ctors) {})
				   :mode (spec :mode)
				   :c-repr (spec :c-repr)])
	   :binds []
	   :methods []
	   :ctors {}
	   :ops []
	   :mode  :
	   :c-type (fn [me]
				   (string (or (me :c-repr)
							   (string "gd_" (:name me)))))
	   :enum (fn [me]
				 (string "GDEXTENSION_VARIANT_TYPE_" (:scream me)))
	   ))

(defn env: [v dflt]
	(or ((os/environ) v) dflt))

................................................................................
		(has-value? x)))
(def variants (map |(:@new <gd-type> $) ~[
	{:id variant :binds [get-ptr-constructor
						 get-ptr-destructor
						 get-ptr-operator-evaluator
						 get-ptr-internal-getter
						 get-ptr-builtin-method
						 get-indexed set-indexed
						 get-named set-named
						 get-type
						 booleanize]}
	{:id bool  }
	{:id int   }
	{:id float }
	{:id color }

	,;(map |{:id $ :mode :dc} vector-types)
	,;(map |{:id $ :mode :dc
			 :methods '[get set size resize fill clear
					    append append_array insert remove-at
					    has is-empty find rfind count
					    reverse slice duplicate]
			 :ctors {:empty []}
			 }
		   packed-types)
	{:id array :mode :dc
	 :binds [ref set-typed operator-index operator-index-const]
	 :methods [size is-empty clear]
	 :ctors {:empty []}
	 :indexed true}
	{:id dictionary :mode :dc
	 :binds [set-typed operator-index operator-index-const]
	 :methods [size is-empty clear]
	 :ctors {:empty []}
	 :indexed true}

	{:id string-name :mode :dc
	 :ops   [equal]
	 :binds [new-with-utf8-chars
			 new-with-utf8-chars-and-len]
	 :methods [length
			   ends-with begins-with
................................................................................
							 get-reference-count]}
	{:id script :binds [get-source-code set-source-code]}
	{:id file-access :binds [open close store-string get-as-text]}
	{:id resource-loader :binds [add-resource-format-loader
								 remove-resource-format-loader]}
	{:id resource-saver :binds [add-resource-format-saver
								remove-resource-format-saver]}
	{:id script-language-extension}
	{:id script-extension}
]))

(def global-enums (map |(:from <gd-sym> $) '[
	error
]))

(def singletons (map |(:from <gd-sym> $) '[
................................................................................
	(def api {
	  :decls   @[]
	  :aliases @[]
	  :calls   @[]
	  :defer-calls @[] # dependency Hel bypass
	  :types   @[]
	  :method-defs @[]
	  :methods-inline @[]
	  :wrappers @[]
	})
	(def config (env: "gd_config" "double_64"))
	(def sizes (do
	   (var sz-list nil)
	   (loop [cfg :in (api-spec "builtin_class_sizes")
			      :until (not= nil sz-list)]
		   (when (= config (cfg "build_configuration"))
................................................................................
			(case (sizes x)
				4 small
				8 big
				(error (string "bad type size " (sizes x) " for " x))))
		(case x
			"int" (bp "int" "int32_t" "int64_t")
			"float" (bp "float" "float" "double")
			"bool" "bool"
			"object" "GDExtensionObjectPtr"))
	(defn variant:gd->c [x]
		(def v (find |(= x (:tall (:@new <gd-sym> {:id ($ :id)}))) variants))
		(string "gd_" (:name v)))
	(defn translate-type [st &opt flags]
		(defn fl [x] (string/check-set (or flags :) x))
		(match (string/split "::" st)
			# enums can be directly mapped to a C
................................................................................
			(def id (string "gd_" (:tall class) "_" (e "name")))
			# the underlying type is IMPORTANT! godot enums
			# appear to use the godot int type, which (at present)
			# is always 8 bytes long. this means trying to write
			# a godot "enum" to a plain old C enum will, if you
			# are very lucky, cause your program to barf all over
			# the stack and immediately segfault
			(ln  "typedef enum %s : GDExtensionInt {" id)
			# thank the gods for C23. this would have been really
			# unpleasant otherwise
			(each n (e "values")
				(def ident (:from-snek <gd-sym> (n "name")))
				(def sym (:@new <gd-sym> ident))
				(ln "\t%s_%s = %d," id (:name sym) (n "value"))
				(ln "\t/* %s */"
................................................................................
			(def name (:from-snek <gd-sym> (v "name")))
			(ln "\tgd_%s_%s = %d," (:tall e) (:name name) (v "value"))
			(when (v "description")
				(ln "\t/* %s */" (v "description"))))
		(ln "} gd_%s;\n" (:tall e))
		)

	(add (api :wrappers)
		 (string 
			 "auto getWrap = "
				 "(GDExtensionInterfaceGetVariantFromTypeConstructor)"
				 `getProc("get_variant_from_type_constructor");`
			 "\nauto getCast = "
				 "(GDExtensionInterfaceGetVariantToTypeConstructor)"
				 `getProc("get_variant_to_type_constructor");` "\n"))
	(loop [v :in variants
		   :let [vsz (or (sizes (:tall v))
						 (sizes (string (v :id) )))]]
		(add (api :aliases) # these are all opaque objects
			 "typedef _opaque(%d) gd_%s;"
			 vsz (:name v))
		(add (api :decls  ) "struct {")
		(def my-enum (:enum v))
		(add-methods v (v :binds))
		(add-enums v)
		(unless (= (v :id) 'variant)
			(add (api :decls)
				 "\tGDExtensionVariantFromTypeConstructorFunc wrap;")
			(add (api :decls)
				 "\tGDExtensionTypeFromVariantConstructorFunc cast;")
			(add (api :wrappers) "t -> gd_%s.wrap = getWrap(%s);"
				 (:name v) (:enum v))
			(add (api :wrappers) "t -> gd_%s.cast = getCast(%s);"
				 (:name v) (:enum v))
			(def ct (or (prim:gd->c (:name v))
						(variant:gd->c (:tall v))))
			(add (api :methods-inline)
				 (string "static inline %s\n"
						 "gd_variant_to_%s\n"
						 "(\tgd_variant const* const v\n"
						 ") {\n"
							 "\textern struct gdjn_typeDB* _g_typeDB;"
							 "\t%s ret = {};\n"
							 "\t_g_typeDB  -> gd_%s.cast(&ret, (void*)v);\n"
							 "\treturn ret;\n"
						 "}\n")
				 ct (:name v)
				 ct (:name v) )
			(add (api :methods-inline)
				 (string "static inline gd_variant\n"
						 "gd_variant_of_%s\n"
						 "(\t%s v\n"
						 ") {\n"
							 "\textern struct gdjn_typeDB* _g_typeDB;"
							 "\tgd_variant ret = {};\n"
							 "\t_g_typeDB -> gd_%s.wrap(&ret, &v);\n"
							 "\treturn ret;\n"
						 "}\n")
				 (:name v) 
				 ct
				 (:name v) 
			))

		# bind builtins
		# WHY IS THIS *YET ANOTHER* COMPLETELY DIFFERENT API
		# for the SAME LITERAL THING fuck youuuuu
		(when (has-key? gdclasses (:tall v)) (loop [m :in (v :methods)
			   :let [method (get-in gdclasses [(:tall v) :methods
											   (:sulk m)])]]
................................................................................
					(translate-type (method :return_type))))
			(def args (method:args method (:tall v)
								   (if (method :is_const) :c :)))

			(def impl @[])
			(unless (= return-type "void")
				(array/push impl
					(string/format "typeof(%s) ret = {};" return-type)))
			(array/push impl
				(string/format "_g_typeDB -> gd_%s.%s("
							   (:name v) (:name m)))
					
			
			(array/push impl
						(string "\t" (if (method :is_static)
................................................................................
			(print "\ntypedef struct gdjn_typeDB {")
			(loop [d :in (api :decls)]
				(print "\t" d))
			(print "} gdjn_typeDB;")
			(each t (api :types) (print t))
			(print c-fetch-decl ";")
			(each m (api :method-defs)
				(print (m :dfn) ";"))
			(each m (api :methods-inline)
				(print m)))

		"loader" (do
					 (print "#include <stdlib.h>\n"
							"#include <stdio.h>\n"
							"#include <assert.h>\n"
							"#include \"interface.h\"\n\n"
							"gdjn_typeDB* _g_typeDB;\n\n"
							# HORRID HACK
							
							c-fetch-decl "{\n"
							;(map |(string "\t" $ "\n")
								  [ "_g_typeDB = t;"
								    ;(api :calls)
									"{"
									;(api :wrappers)
									"}"
								    ;(api :defer-calls) ])
							"}")
					 (each m (api :method-defs)
						 (print (m :dfn) "{\n\t" (string/join (m :impl) "\n\t") "\n}\n")))))

					   (<- (any (+ (* `\` (backmatch :quo))
								   (if-not (backmatch :quo) 1))))
					   (backmatch :quo)) :quo)))
		(defn fail [cause]
			(defn mk [ln col]
				{:kind :parse
				 :cause cause

				 :ln ln :col col})
			~(error (cmt (* (line) (column)) ,mk)))
		(defn req [id body]
			~(+ (* ,;body) ,(fail (keyword :malformed- id))))
		(defn kw [id body]
			~(* ,id (> 1 :bound) ,(req id ~(:s+ ,;body))))
		(defn comment-syntax [id open close]
................................................................................
	(enter body ""))

(defn err->msg [e]
	(defn err-span [h & m] [:span [:hl [:red h]] ": " ;m ])
	(match e
		{:kind :parse} (err-span "parse error"
			 (string (e :cause) " at ")
			 [:hl (string/format "%d:%d" (e :ln) (e :col))])
		_ (error e)))
		# _ (err-span "error"
		# 			"something went wrong (" [:em (string e)] ")")))


(defn indent [n lst]
	(map |(string (string/repeat "\t" n) $) lst))
................................................................................
	[:ref        _] :object
	x (keyword x)))
(defn gdtype->ctype [t]
	(match t
		:void        :void
		:float       :double
		:int         :int64_t
		:bool        :bool
		[:array      _] :gd_array
		[:dictionary _] :gd_dictionary
		[:ref        _] :GDExtensionObjectPtr

		# use an opaque wrapper struct defined in interface.h
		x (string "gd_" (:say (:read <sym> t)))))

................................................................................
	~(do (var ,acc ,init)
		 (loop ,binds
			 (set ,acc (do ,;body)))
		 ,acc))


(defn unit-files [u]
	(def h @[ `#pragma once` `#include "gdjn.h"` `#include "util.h"`
			 ;(u :header-prefix)])
	(def c @[
		(string `#include "` (:stab (u :name)) `.h"`)
		`typedef struct gdjn_vcall {`
		`	GDExtensionClassMethodPtrCall caller; `
		`	void* tgt;`
		`} gdjn_vcall;`
................................................................................
						:method (array/push (cls :methods) meth)
						:impl   (array/push (cls :impls)   meth)))
			)))

	(def root (:new <cursor> :unit unit))
	(each n ast (process n root))

	(defn class-prefix [c & r]
		(def pf (let [p (:prefix c)]
					(if (empty? p) [] [p])))
		(string/join ["gdjn_class" ;pf ;r] "_"))





	(defn bind-methods [class]
		(defn bind [f kind]
			(def t-args (map (fn [[t] &] t)
							 (f :args)))
			(def invocant
				((unit :invocants) [(f :ret) t-args]))
			(def invocant-ptr
				((unit :invocants-ptr) [(f :ret) t-args]))
			(def fp-t (func-ptr-t (gdtype->ctype (f :ret))
								  [(string "typeof("
										   (class-prefix (class :cursor)
														 (class :id))")*")
								   ;(map gdtype->ctype t-args)]))

			(def strings-lst @[])
			(def strings
				(cache (fn [idx text] 
						   (def id (string "_priv_str_" idx))
						   (array/push strings-lst id text)
................................................................................
									 `,`])
						:impl [`.return_value = ` 
							   ;(prop-info (if (= :void (f :ret)) :nil
											   (f :ret)))]
					)])
				)

			(def fn-path (class-prefix (f :cursor) "method" (f :id)))
			(with-names [:s_methodName (f :id) ;strings-lst]
				(if (not= kind :method) ""
					(string fp-t " func = " fn-path ";"))
				(string/format `auto info = (%s) {`
					(case kind
						:method "GDExtensionClassMethodInfo"
						:impl "GDExtensionClassVirtualMethodInfo"))
................................................................................
						(length t-args) ",")
				;(indent 1 arg-info)
				;(if (= kind :method) [
					`	.method_userdata = func,`
					`	.method_flags = GDEXTENSION_METHOD_FLAGS_DEFAULT,`
					(string "\t.has_return_value = "
							(if (= :void (f :ret)) "false" "true") ",")
					(string "\t.call_func = " invocant ",")
					(string "\t.ptrcall_func = " invocant-ptr ",")
				] [])
				;ret-info
				`};`
				(comment (string `printf("binding method %s\n",`
						(string/format "%q" fn-path)
						`);`))
				(string `_t(classdb).`
						(case kind
							:method "registerExtensionClassMethod"
							:impl "registerExtensionClassVirtualMethod")
						`(gdjn_ctx -> gd.lib, &s_className, &info);`)))

	   (array/concat @[] "{" ;(with-names [:s_className (class :id)]
				 ;(map |(bind $ :method) (class :methods))
				 ;(map |(bind $ :impl) (class :impls))) "}"))

	(defn push-item [kind cursor item] # abuse hashtables for fun & profit
		(array/push (unit kind) item)
		(when (and cursor (cursor :doc))
			(put (unit :doc) item (cursor :doc))))

	(loop [c :in (unit :classes)]
		(def id (class-prefix (c :cursor) (c :id)))
		(def [id-ctor id-dtor
			  id-ctor-api
			  id-init id-create]
			(map |(string id  "_" $) ["new"     "del"
									  "api_new" "init" "create"]))

		(def id-base (as-> (c :base) b
................................................................................
						   (string "gdjn_class_" b))) #HAAACK
		(when (not (empty? (c :impls)))
			(def vtbl @[])
			(loop [i :range [0 (length (c :impls))]
				     :let   [f ((c :impls) i)]]
				(def t-args (map (fn [[t] &] t)
								 (f :args)))
				(def call   (class-prefix (f :cursor) "method" (f :id)))
				(def caller ((unit :invocants-ptr) [(f :ret) t-args]))
				(put (c :vtbl-map) (f :id) i)
				(array/push vtbl
							(string "{.caller=" caller ", .tgt=" call "}"))
				)
			(let [vstr (string/join (map |(string "\n\t" $ ",") vtbl))
				  vwr (string "{" vstr "\n}") ]
................................................................................
							   (with-names ["superName" (c :base)]
								   "super = _t(classdb).constructObject(&superName);")
							   [(string/format "super = %s_create();"
											   id-base)])
						   "return super;"))

		(def icb-null "(&(GDExtensionInstanceBindingCallbacks){})")

		(array/push (unit :funcs)
					(:dec <func-c> self-ref-t id-ctor []

					  (string "typeof("id")* me = _alloc("id", 1);")
					  ;(with-names ["className" (c :id)]
						   (string/format "auto gdobj = %s();"
										  id-create)
						   #`printf("constructed super object %p\n", gdobj);`
						   "_t(object).setInstance(gdobj, &className, me);"
						   # register the instance as a binding so
						   # that other classes can access it. this
						   # is so dumb
................................................................................
						   (string id-init "(me, gdobj);"))
					  "return me;"))
		(push-event :dtor id-dtor :void
					[[:void* :_data]
					 [:GDExtensionClassInstancePtr :_ptr_me]]
					|[(string "typeof("id")* me = _ptr_me;")
					  ;$
					  "_free(me);"])


		(def id-virt (class-prefix (c :cursor) (c :id) "virt"))
		(array/push (unit :funcs)
					(:dec* <func-c> [:inline :static]
						   self-ref-t (string id "_data")
						  [[:GDExtensionObjectPtr :self]]
						  "return _t(object).getInstanceBinding("
						  "	self, gdjn_ctx -> gd.lib,"
							icb-null
						  ");"))

		(array/push (unit :funcs) (:dec- <func-c> :void* id-virt
			 [[:void* :data]
			  [:GDExtensionConstStringNamePtr :method]
			  [:uint32_t :hash]]
			 `bool res = false;`
			 ;(catseq [[name idx] :pairs (c :vtbl-map)] [

					  ;(with-names [:name name]
					  `_t(stringName).equal(&name, method, &res);`
						  `if (res) {`
							  (string "\treturn (void*)&" id "_vtbl[" idx "];")
						  `}`)])
			 ;(if (= :native (c :base-mode)) [`return nullptr;`]
				  # inherits from a gdextension class; call up
				  [(string/format "return %s_virt(data, method, hash);"
								  id-base)])
			 ))
		(def id-virt-call (class-prefix (c :cursor) (c :id) "virt_call"))
		(array/push (unit :funcs) (:dec- <func-c> :void id-virt-call
			 [[:GDExtensionClassInstancePtr   :inst]
			  [:GDExtensionConstStringNamePtr :method]
			  [:void* :vcall]
			  ["const GDExtensionConstTypePtr*" :args]
			  [:GDExtensionTypePtr :ret]]
			 `auto c = (const gdjn_vcall*)vcall;`
			 `c -> caller(c -> tgt, inst, args, ret);`))

		(array/push (unit :load)
					;(with-names ["className" (c :id)
								  "superName" (c :base)]
						 "auto classDesc = (GDExtensionClassCreationInfo4) {"
						 `	.is_virtual = false,`
						 (string "\t.is_abstract = " (if (c :abstract)  "true" "false")",")
						 `	.is_exposed = true,`
						 `	.is_runtime = true,`
						 (string "\t.create_instance_func = " id-ctor-api ",")
................................................................................
		(def binder (bind-methods c))
		(array/concat (unit :load) binder)



		)
	(loop [f :in (unit :methods)]
		(def class (class-prefix (f :cursor)))
		(def cid (class-prefix (f :cursor) "method" (f :id)))
		(def cfn (:dec <func-c> (gdtype->ctype (f :ret)) cid
					   [ [(string class "*") "me"]
						;(map (fn [[t id dox]]
								  [(gdtype->ctype t) id])
							  (f :args))]
					   (f :text)))
		(def arg-dox
................................................................................
	(let [uf (unit-files unit)]
		(:write stdout (case emit
			"header" (lines->str (uf :header))
			"loader" (lines->str (uf :impl))
			(error :bad-cmd)))))

(defn main [& argv]
	# (entry ;argv))
	(try (entry ;argv)
		([e] (:write stderr (style ;(err->msg e))))))

					   (<- (any (+ (* `\` (backmatch :quo))
								   (if-not (backmatch :quo) 1))))
					   (backmatch :quo)) :quo)))
		(defn fail [cause]
			(defn mk [ln col]
				{:kind :parse
				 :cause cause
				 :src (dyn *src-file* "<stdin>")
				 :ln ln :col col})
			~(error (cmt (* (line) (column)) ,mk)))
		(defn req [id body]
			~(+ (* ,;body) ,(fail (keyword :malformed- id))))
		(defn kw [id body]
			~(* ,id (> 1 :bound) ,(req id ~(:s+ ,;body))))
		(defn comment-syntax [id open close]
................................................................................
	(enter body ""))

(defn err->msg [e]
	(defn err-span [h & m] [:span [:hl [:red h]] ": " ;m ])
	(match e
		{:kind :parse} (err-span "parse error"
			 (string (e :cause) " at ")
			 [:hl (string/format "%s:%d:%d" (e :src) (e :ln) (e :col))])
		_ (error e)))
		# _ (err-span "error"
		# 			"something went wrong (" [:em (string e)] ")")))


(defn indent [n lst]
	(map |(string (string/repeat "\t" n) $) lst))
................................................................................
	[:ref        _] :object
	x (keyword x)))
(defn gdtype->ctype [t]
	(match t
		:void        :void
		:float       :double
		:int         :int64_t
		:bool        :uint8_t
		[:array      _] :gd_array
		[:dictionary _] :gd_dictionary
		[:ref        _] :GDExtensionObjectPtr

		# use an opaque wrapper struct defined in interface.h
		x (string "gd_" (:say (:read <sym> t)))))

................................................................................
	~(do (var ,acc ,init)
		 (loop ,binds
			 (set ,acc (do ,;body)))
		 ,acc))


(defn unit-files [u]
	(def h @[ `#pragma once` `#include "gdjn.h"`
			 ;(u :header-prefix)])
	(def c @[
		(string `#include "` (:stab (u :name)) `.h"`)
		`typedef struct gdjn_vcall {`
		`	GDExtensionClassMethodPtrCall caller; `
		`	void* tgt;`
		`} gdjn_vcall;`
................................................................................
						:method (array/push (cls :methods) meth)
						:impl   (array/push (cls :impls)   meth)))
			)))

	(def root (:new <cursor> :unit unit))
	(each n ast (process n root))

	(defn class-prefix* [sep c begin r]
		(def pf (let [p (:prefix c)]
					(if (empty? p) [] [p])))
		(string/join [;begin ;pf ;r] sep))
	(defn class-prefix. [c & r]
		(class-prefix* "." c [] r))
	(defn class-prefix_  [c & r]
		(class-prefix* "_" c ["gdjn_class"] r))

	(defn bind-methods [class]
		(defn bind [f kind]
			(def t-args (map (fn [[t] &] t)
							 (f :args)))
			(def invocant
				|((unit :invocants) [(f :ret) t-args]))
			(def invocant-ptr
				|((unit :invocants-ptr) [(f :ret) t-args]))
			(def fp-t (func-ptr-t (gdtype->ctype (f :ret))
								  [(string "typeof("
										   (class-prefix_ (class :cursor)
														  (class :id))")*")
								   ;(map gdtype->ctype t-args)]))

			(def strings-lst @[])
			(def strings
				(cache (fn [idx text] 
						   (def id (string "_priv_str_" idx))
						   (array/push strings-lst id text)
................................................................................
									 `,`])
						:impl [`.return_value = ` 
							   ;(prop-info (if (= :void (f :ret)) :nil
											   (f :ret)))]
					)])
				)

			(def fn-path (class-prefix_ (f :cursor) "method" (f :id)))
			(with-names [:s_methodName (f :id) ;strings-lst]
				(if (not= kind :method) ""
					(string fp-t " func = " fn-path ";"))
				(string/format `auto info = (%s) {`
					(case kind
						:method "GDExtensionClassMethodInfo"
						:impl "GDExtensionClassVirtualMethodInfo"))
................................................................................
						(length t-args) ",")
				;(indent 1 arg-info)
				;(if (= kind :method) [
					`	.method_userdata = func,`
					`	.method_flags = GDEXTENSION_METHOD_FLAGS_DEFAULT,`
					(string "\t.has_return_value = "
							(if (= :void (f :ret)) "false" "true") ",")
					(string "\t.call_func = " (invocant) ",")
					(string "\t.ptrcall_func = " (invocant-ptr) ",")
				] [])
				;ret-info
				`};`
				(comment (string `printf("binding method %s\n",`
						(string/format "%q" fn-path)
						`);`))
				(string `_t(classdb).`
						(case kind
							:method "registerExtensionClassMethod"
							:impl "registerExtensionClassVirtualMethod")
						`(gdjn_ctx -> gd.lib, &s_className, &info);`)))
		(def class-path (class-prefix* "_" (class :cursor) [] [(class :id)]))
		(array/concat @[] "{" ;(with-names [:s_className class-path]
				 ;(map |(bind $ :method) (class :methods))
				 ;(map |(bind $ :impl) (class :impls))) "}"))

	(defn push-item [kind cursor item] # abuse hashtables for fun & profit
		(array/push (unit kind) item)
		(when (and cursor (cursor :doc))
			(put (unit :doc) item (cursor :doc))))

	(loop [c :in (unit :classes)]
		(def id (class-prefix_ (c :cursor) (c :id)))
		(def [id-ctor id-dtor
			  id-ctor-api
			  id-init id-create]
			(map |(string id  "_" $) ["new"     "del"
									  "api_new" "init" "create"]))

		(def id-base (as-> (c :base) b
................................................................................
						   (string "gdjn_class_" b))) #HAAACK
		(when (not (empty? (c :impls)))
			(def vtbl @[])
			(loop [i :range [0 (length (c :impls))]
				     :let   [f ((c :impls) i)]]
				(def t-args (map (fn [[t] &] t)
								 (f :args)))
				(def call   (class-prefix_ (f :cursor) "method" (f :id)))
				(def caller ((unit :invocants-ptr) [(f :ret) t-args]))
				(put (c :vtbl-map) (f :id) i)
				(array/push vtbl
							(string "{.caller=" caller ", .tgt=" call "}"))
				)
			(let [vstr (string/join (map |(string "\n\t" $ ",") vtbl))
				  vwr (string "{" vstr "\n}") ]
................................................................................
							   (with-names ["superName" (c :base)]
								   "super = _t(classdb).constructObject(&superName);")
							   [(string/format "super = %s_create();"
											   id-base)])
						   "return super;"))

		(def icb-null "(&(GDExtensionInstanceBindingCallbacks){})")
		(def class-path (class-prefix* "_" (c :cursor) [] [(c :id)]))
		(array/push (unit :funcs)
					(:dec <func-c> self-ref-t id-ctor []
					  (string `printf("creating object ` id `\n");`)
					  (string "typeof("id")* me = _alloc("id", 1);")
					  ;(with-names ["className" class-path]
						   (string/format "auto gdobj = %s();"
										  id-create)
						   #`printf("constructed super object %p\n", gdobj);`
						   "_t(object).setInstance(gdobj, &className, me);"
						   # register the instance as a binding so
						   # that other classes can access it. this
						   # is so dumb
................................................................................
						   (string id-init "(me, gdobj);"))
					  "return me;"))
		(push-event :dtor id-dtor :void
					[[:void* :_data]
					 [:GDExtensionClassInstancePtr :_ptr_me]]
					|[(string "typeof("id")* me = _ptr_me;")
					  ;$
					  (if (= :native (c :base-mode)) "_free(me);"
						   (string/format "%s_del(_data, &me -> super);"
										  id-base))])
		(def id-virt (class-prefix_ (c :cursor) (c :id) "virt"))
		(array/push (unit :funcs)
					(:dec* <func-c> [:inline :static]
						   self-ref-t (string id "_data")
						  [[:GDExtensionObjectPtr :self]]
						  "return _t(object).getInstanceBinding("
						  "	self, gdjn_ctx -> gd.lib,"
							icb-null
						  ");"))

		(array/push (unit :funcs) (:dec- <func-c> :void* id-virt
			 [[:void* :data]
			  [:GDExtensionConstStringNamePtr :method]
			  [:uint32_t :hash]]

			 ;(catseq [[name idx] :pairs (c :vtbl-map)]
					  [ `{bool res = false;`
					   ;(with-names [:name name]
							 `_t(stringName).equal(&name, method, &res);`)
					   `if (res) {`
					   (string "\treturn (void*)&" id "_vtbl[" idx "];")
					   `}}`])
			 ;(if (= :native (c :base-mode)) [`return nullptr;`]
				  # inherits from a gdextension class; call up
				  [(string/format "return %s_virt(data, method, hash);"
								  id-base)])
			 ))
		(def id-virt-call (class-prefix_ (c :cursor) (c :id) "virt_call"))
		(array/push (unit :funcs) (:dec- <func-c> :void id-virt-call
			 [[:GDExtensionClassInstancePtr   :inst]
			  [:GDExtensionConstStringNamePtr :method]
			  [:void* :vcall]
			  ["const GDExtensionConstTypePtr*" :args]
			  [:GDExtensionTypePtr :ret]]
			 `auto c = (const gdjn_vcall*)vcall;`
			 `c -> caller(c -> tgt, inst, args, ret);`))
		(def class-path (class-prefix* "_" (c :cursor) [] [(c :id)]))
		(array/push (unit :load)
					;(with-names ["className" class-path
								  "superName" (c :base)]
						 "auto classDesc = (GDExtensionClassCreationInfo4) {"
						 `	.is_virtual = false,`
						 (string "\t.is_abstract = " (if (c :abstract)  "true" "false")",")
						 `	.is_exposed = true,`
						 `	.is_runtime = true,`
						 (string "\t.create_instance_func = " id-ctor-api ",")
................................................................................
		(def binder (bind-methods c))
		(array/concat (unit :load) binder)



		)
	(loop [f :in (unit :methods)]
		(def class (class-prefix_ (f :cursor)))
		(def cid (class-prefix_ (f :cursor) "method" (f :id)))
		(def cfn (:dec <func-c> (gdtype->ctype (f :ret)) cid
					   [ [(string class "*") "me"]
						;(map (fn [[t id dox]]
								  [(gdtype->ctype t) id])
							  (f :args))]
					   (f :text)))
		(def arg-dox
................................................................................
	(let [uf (unit-files unit)]
		(:write stdout (case emit
			"header" (lines->str (uf :header))
			"loader" (lines->str (uf :impl))
			(error :bad-cmd)))))

(defn main [& argv]
	(entry ;argv))
	# (try (entry ;argv)
	# 	([e] (:write stderr (style ;(err->msg e)) "\n"))))

	(let [fd (file/open path :r) 
		  rec {:id (reduce |(string/replace-all $1 "_" $0)
						   (basename path) ["-" "." "/"])
			   :vals (blob->c-array (:read fd :all))}]
		(:close fd)
		rec))

(defn c-decl [t]
	(string "const uint8_t gdjn_rsrc_" (t :id) " []"))


(defn c-def [t]
	(string (c-decl t) " = {" (t :vals) "}"))


(defn c-compile [c to-path]
	(def cc (os/spawn [(dyn *cc*)
					   "-xc" "-c" "-"
					         "-o" to-path]
					  :p {:in :pipe}))

	(let [fd (file/open path :r) 
		  rec {:id (reduce |(string/replace-all $1 "_" $0)
						   (basename path) ["-" "." "/"])
			   :vals (blob->c-array (:read fd :all))}]
		(:close fd)
		rec))

(defn c-base [t]
	(string "const uint8_t gdjn_rsrc_" (t :id) " [" (length (t :vals))"]"))
(defn c-decl [t]
	(string "extern " (c-base t)))
(defn c-def [t]
	(string (c-base t) " = {" (t :vals) "}"))


(defn c-compile [c to-path]
	(def cc (os/spawn [(dyn *cc*)
					   "-xc" "-c" "-"
					         "-o" to-path]
					  :p {:in :pipe}))