shithub: sl

ref: a70379d7e4b822f532fb0a8ccdd1624a90b64a68
dir: /src/types.c/

#include "sl.h"
#include "cvalues.h"
#include "equalhash.h"
#include "types.h"

sl_type *
get_type(sl_v t)
{
	sl_type *ft;
	if(issym(t)){
		ft = ((sl_sym*)ptr(t))->type;
		if(ft != nil)
			return ft;
	}
	void **bp = equalhash_bp(&slg.types, (void*)t);
	if(*bp != HT_NOTFOUND){
		assert(*bp != nil);
		return *bp;
	}

	bool isarr = iscons(t) && car_(t) == sl_arrsym && iscons(cdr_(t));
	usize sz;
	if(isarr && !iscons(cdr_(cdr_(t)))){
		// special case: incomplete array type
		sz = 0;
	}else{
		sz = ctype_sizeof(t);
	}

	ft = MEM_CALLOC(1, sizeof(sl_type));
	assert(ft != nil);
	ft->type = t;
	ft->numtype = NONNUMERIC;
	if(issym(t)){
		ft->numtype = sym_to_numtype(t);
		assert(valid_numtype(ft->numtype));
		((sl_sym*)ptr(t))->type = ft;
	}
	ft->size = sz;
	if(isarr && iscons(t)){
		sl_type *eltype = get_type(car_(cdr_(t)));
		assert(eltype != nil && eltype->size > 0);
		ft->elsz = eltype->size;
		ft->eltype = eltype;
		ft->init = cvalue_arr_init;
		//eltype->artype = ft; -- this is a bad idea since some types carry array sizes
	}
	*bp = ft;
	return ft;
}

sl_type *
get_arr_type(sl_v eltype)
{
	sl_type *et = get_type(eltype);
	if(et->artype == nil)
		et->artype = get_type(mk_list2(sl_arrsym, eltype));
	return et->artype;
}

sl_type *
define_opaque_type(sl_v sym, usize sz, sl_cvtable *vtab, cvinitfunc_t init)
{
	sl_type *ft = MEM_CALLOC(1, sizeof(sl_type));
	assert(ft != nil);
	ft->type = sym;
	ft->numtype = NONNUMERIC;
	ft->size = sz;
	ft->vtable = vtab;
	ft->init = init;
	return ft;
}

void
relocate_typetable(void)
{
	sl_htable *h = &slg.types;
	for(int i = 0; i < h->size; i += 2){
		if(h->table[i] != HT_NOTFOUND){
			void *nv = (void*)sl_relocate((sl_v)h->table[i]);
			h->table[i] = nv;
			if(h->table[i+1] != HT_NOTFOUND)
				((sl_type*)h->table[i+1])->type = (sl_v)nv;
		}
	}
}