gdjn  Check-in [c0fd81ac3d]

	(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))))
................................................................................
	(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]
................................................................................
(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)

	(defn recurse [acc dox t & r]
		(cond
			(string? t)
				(recurse acc [;dox t] ;r)
			(or (struct?  t)
				(keyword? t))
				(recurse [;acc t] dox ;r)
			:else [[;(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))))
................................................................................
	(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
						@{ '@id      ,(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]
................................................................................
(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 [:subclass] ,;r))
(defmacro defclass- [id & r] ~(defclass* ,id [:subclass :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 (tuple 'quote id)}
					 ;(parse-sig r) ]
		_ []))

(defmacro defm [id & rest]
	(def (meta sig ret & 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)

# [ʞ] 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

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

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

(defmacro- extern [name]
	(def sym (gensym))
	(put *gd-api-ext* 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

export gd_build_gen = $g
export gd_api_spec  = $g/extension_api.json
export gd_api_iface = $g/gdextension_interface.h

.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)/

export gd_build_gen = $g
export gd_api_spec  = $g/extension_api.json
export gd_api_iface = $g/gdextension_interface.h

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

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

typedef void (*GDExtensionInterfacePrintError)(const char *p_description, const char *p_function, const char *p_file, int32_t p_line, GDExtensionBool p_editor_notify);

#define _emit(fn, msg) \
	(gdjn_ctx -> gd.fn((msg), __func__, __FILE__, __LINE__, true))
#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)))

typedef void (*GDExtensionInterfacePrintError)(const char *p_description, const char *p_function, const char *p_file, int32_t p_line, GDExtensionBool p_editor_notify);

#define _emit(fn, msg) \
	(gdjn_ctx -> gd.fn((msg), __func__, __FILE__, __LINE__, true))
#define _warn(msg) _emit(warn, msg)
#define _err(msg)  _emit(err, msg)

#define _emitMsg(fn, desc, msg) \
	(gdjn_ctx -> gd.fn((desc), (msg), __func__, __FILE__, __LINE__, true))
#define _errMsg(desc, msg)  _emitMsg(errMsg, desc, 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)))

	impl _can_inherit_from_file()  -> bool { return true; };

	impl _handles_global_class_type(string t) -> bool { return false; };
	impl _get_type() -> string {
		gd_string s = {};
		_t(string).newWithUtf8Chars(&s, "JanetScriptText");
		return s;















	};
	impl _get_recognized_extensions() -> packed-string-array {
		gd_packedStringArray r = {};
		_t(packedStringArray).empty(&r, nullptr);
		_gdu_array_string_pushLit(&r, "janet");
		_gdu_array_string_pushLit(&r, "jimage");
		return r;
................................................................................
		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");
................................................................................
	impl _get_base_script() -> ref Script {
		return nullptr;
	};
	impl _has_static_method(string-name method) -> bool {
		return false;
	};
	impl _is_tool() -> bool { return false; }; (* FIXME *)
	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 {
................................................................................
		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;

	impl _can_inherit_from_file()  -> bool { return true; };

	impl _handles_global_class_type(string t) -> bool { return false; };
	impl _get_type() -> string {
		gd_string s = {};
		_t(string).newWithUtf8Chars(&s, "JanetScriptText");
		return s;
	};
	impl _get_public_functions() -> array[dictionary] {
		gd_array list;
		_t(array).empty(&list, nullptr);
		return list;
	};
	impl _get_public_constants() -> dictionary {
		gd_dictionary consts;
		_t(dictionary).empty(&consts, nullptr);
		return consts;
	};
	impl _get_public_annotations() -> array[dictionary] {
		gd_array list;
		_t(array).empty(&list, nullptr);
		return list;
	};
	impl _get_recognized_extensions() -> packed-string-array {
		gd_packedStringArray r = {};
		_t(packedStringArray).empty(&r, nullptr);
		_gdu_array_string_pushLit(&r, "janet");
		_gdu_array_string_pushLit(&r, "jimage");
		return r;
................................................................................
		return dict;
	};
};

class JanetScript is ScriptExtension {
	var as string: path;
	var JanetTable*: env;
	var pstr: id;
	var pstr: exportID;
	var pstr: uid;
	var pstr: doc;
	var pstr: inherit;
	
	var as array[dictionary]: methodBinds;

	use "vm.h";

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

		_t(array).empty(&me -> methodBinds, nullptr);
		me -> id       = (pstr){};
		me -> exportID = (pstr){};
		me -> uid      = (pstr){};
		me -> doc      = (pstr){};
		me -> inherit  = (pstr){};
	};
	del {
		_t(string).dtor(&me -> path);
		_t(array).dtor(&me -> methodBinds);
		if (me -> env) janet_gcunroot(janet_wrap_table(me -> env));
		_drop(me -> id);
		_drop(me -> exportID);
		_drop(me -> uid);
		_drop(me -> doc);
		_drop(me -> inherit);

	};

	class BaseInstance is Object {
		var as ref JanetScript: script;
		del {
			gd_refCounted_unreference(me -> script);
			printf("del script instance\n");
................................................................................
	impl _get_base_script() -> ref Script {
		return nullptr;
	};
	impl _has_static_method(string-name method) -> bool {
		return false;
	};
	impl _is_tool() -> bool { return false; }; (* FIXME *)
	impl _get_global_name() -> string-name {
		if (me -> exportID.v)
			return gdu_internp(me -> exportID);
		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_internp(me -> inherit);
	};
	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;
	};

	use {
		static pstr
		classParam
		(	JanetTable* env,
			const char* sym,
			pstr        dflt
		) {
			Janet v = janet_table_rawget(env, janet_csymbolv(sym));
			if (janet_type(v) != JANET_TABLE) return dflt;

			Janet s = janet_table_rawget(janet_unwrap_table(v), 
				janet_ckeywordv("value"));
			if (janet_type(s) == JANET_NIL) return dflt;

			JanetString str = janet_unwrap_string(s);
			return (pstr) {
				.v = (char*)str,
				.sz = janet_string_length(str),
			};
		}
	};
	impl _reload(bool keepState) -> int {
		gd_array_clear(&me -> methodBinds);
		/* parse the class environment */
		JanetTable* const env = me -> env;
		printf("core reload\n");

		pstr id      = classParam(env, "@id", (pstr){});
		pstr gdid    = classParam(env, "@gd-id", (pstr){});
		pstr inherit = classParam(env, "@inherit", _pstrLit("RefCounted"));
		pstr doc     = classParam(env, "@doc", (pstr){});

		if (gdid.v) me -> exportID = pstrDup(gdid);
			else me -> exportID = pstrDup(id);
		if (id.v) me -> id = pstrDup(id);

		if (doc.v) me -> doc = pstrDup(doc);
		if (inherit.v) me -> inherit = pstrDup(inherit);

		Janet wenv = janet_wrap_table(env);
		/* scan for bindings */
		for (Janet key = janet_next(wenv, janet_wrap_nil());
					janet_type(key) != JANET_NIL;
					key = janet_next(wenv, key)) {

			Janet val = janet_table_rawget(env, key);

			if (!janet_checktypes(key, JANET_TFLAG_BYTES)) continue;
			printf(" * consider val id %s (%s)\n",
					janet_unwrap_string(key),
					janet_type_names[janet_type(val)]);
			if (!janet_checktypes(val, JANET_TFLAG_DICTIONARY)) continue;
			JanetTable* v = janet_unwrap_table(val);
			Janet ty;
			const bool priv = gdjn_vm_metaFlag(v, "private");
			JanetString jkey = janet_unwrap_string(key);

			if (gdjn_vm_metaKey(v, "method", &ty)) {
			/* &&  janet_type(ty) == JANET_TABLE) { */
				printf("   * is method %s\n",
					janet_type_names[janet_type(ty)]);
				JanetTable* tspec = janet_unwrap_table(ty);
				/* janet_unwrap_function() */
				gd_dictionary meta;
				_t(dictionary).empty(&meta, nullptr);
				gdu_setKey_str(&meta, _pstrLit("name"),
					(pstr) {
						.sz = janet_string_length(jkey),
						.v = (char*)jkey,
					});

				/* build arg array */
				gd_array argList;
				_t(array).empty(&argList, nullptr);
				for (size_t j = 0; j < tspec -> count; ++j) {
				/*
					gd_dictionary
					gdu_array_append(&argList_, )
					*/
				}
				
				{gd_variant tv = gd_variant_of_array(argList);
				 gdu_setKey(&meta, _pstrLit("args"), &tv);}
					

				{gd_variant tv = gd_variant_of_dictionary(meta);
				 gd_array_append(&me -> methodBinds, &tv);}

				_t(array).dtor(&argList);
				_t(dictionary).dtor(&meta);
			} else if (gdjn_vm_metaKey(v, "prop", &ty)) {
			} else if (gdjn_vm_metaKey(v, "const", &ty)) {
			} else if (gdjn_vm_metaFlag(v, "subclass")) {
			};
			/* else: the value is not meaningful to godot; skip over */
		}
		return gd_Error_ok;
	};
	
	(*
	impl _update_exports() {

	};
	impl _placeholder_instance_create
	(ref Object forObj) -> ref Object {
................................................................................
		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));
		}
		if (errorCode != gd_Error_ok) return errorCode;


		/* invoke super by static dispatch */
		return gdjn_class_JanetScript_method__reload(&me -> super, keepState);
	};
};

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

#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, \
})

#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, \
})

static inline pstr
pstrDup(pstr p) {
	if (p.v == nullptr) return p;
	if (p.sz == 0) p.sz = strlen(p.v);
	auto n = _new(pstr, p.sz + 1);
	memcpy(n.v, p.v, p.sz);
	n.v[p.sz] = 0;
	n.sz = p.sz;
	return n;
}

	return r;
}

static inline gd_stringName
gdu_intern (const char* str) {
	return gdu_intern_sz(str, 0);
}






static inline gd_stringName
gdu_sym_null(void) {
	gd_stringName n;
	_t(stringName).empty(&n, nullptr);
	return n;
}
................................................................................
static inline gd_string
gdu_str_sz (const char* str, const size_t sz) {
	gd_string r = {};
	if (sz == 0) _t(string).newWithUtf8Chars(&r, str);
	        else _t(string).newWithUtf8CharsAndLen(&r, str, sz);
	return r;
}






static inline gd_string
gdu_str (const char* str) {
	return gdu_str_sz(str, 0);
}

#define _gdu_intern(x) (gdu_intern_sz((x), sizeof(x)-1))
................................................................................
	gd_variant v = gd_variant_of_dictionary(*dict);
	_withSym(keyName, key, {
		uint8_t ok = false;
		_t(variant).setNamed(&v, &keyName, val, &ok);
	});
}

	return r;
}

static inline gd_stringName
gdu_intern (const char* str) {
	return gdu_intern_sz(str, 0);
}

static inline gd_stringName
gdu_internp (pstr p) {
	return gdu_intern_sz(p.v, p.sz);
}

static inline gd_stringName
gdu_sym_null(void) {
	gd_stringName n;
	_t(stringName).empty(&n, nullptr);
	return n;
}
................................................................................
static inline gd_string
gdu_str_sz (const char* str, const size_t sz) {
	gd_string r = {};
	if (sz == 0) _t(string).newWithUtf8Chars(&r, str);
	        else _t(string).newWithUtf8CharsAndLen(&r, str, sz);
	return r;
}

static inline gd_string
gdu_pstr (pstr p) {
	return gdu_str_sz(p.v, p.sz);
}

static inline gd_string
gdu_str (const char* str) {
	return gdu_str_sz(str, 0);
}

#define _gdu_intern(x) (gdu_intern_sz((x), sizeof(x)-1))
................................................................................
	gd_variant v = gd_variant_of_dictionary(*dict);
	_withSym(keyName, key, {
		uint8_t ok = false;
		_t(variant).setNamed(&v, &keyName, val, &ok);
	});
}

static inline void
gdu_setKey_str
(	gd_dictionary* const dict,
	pstr           const key,
	pstr           const val
) {
	gd_string s = gdu_str_sz(val.v, val.sz);
	gd_variant v = gd_variant_of_string(s);
	gdu_setKey(dict, key, &v);
	_t(string).dtor(&s);
}

		_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) {

		_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, 1,
			(Janet[]) {janet_wrap_table(tgt)},
			&ret, nullptr);
	if (e == JANET_SIGNAL_ERROR) {
		_errMsg("failed to unpack the janet environment",
			(char*)janet_unwrap_string(ret));
		goto fail;
	}
	/* janet_table_merge_table(tgt, janet_unwrap_table(ret)); */
	printf("environment load complete\n");
fail:
	janet_gcunlock(gc);
	/* janet_collect(); */
}

JanetTable* gdjn_vm_api_build_compTime(void) {

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

................................................................................
# 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)

# 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- dict-filter [pred dict]
	(def d @{})
	(loop [[k v] :pairs dict]
		(when (pred k v)
			(put d k v)))
	d)
(defn- install [name env-raw]
	(def env (dict-filter
				 |(and (table? $1)
					   (not ($1 :private)))
				 env-raw))
	(put *gd-api-map* name env)

	(when-let [b (get env '*gd-api-ext*)
			   ok (table? b)]
		(def gdmap (get-in env ['*gd-api-ext* :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)))

................................................................................
# 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 [core-env]
	(print "beginning merge")
	(merge-into module/cache *gd-api-map*)
	(print "loaded modules, forcing imports")
	(merge-into core-env (get *gd-api-map* "core"))
	(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)

					    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}

					    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 append append-array insert]
	 :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}

	(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 [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"))))