Login
7 branches 0 tags
Ben (X13/Arch) (array/allocate) -> (:alloc Array) 2950b05 2 years ago 1071 Commits
nujel / lib / type-system.c
/* Nujel - Copyright (C) 2020-2022 - Benjamin Vincent Schulenburg
 * This project uses the MIT license, a copy should be included under /LICENSE */
/*
 * In this file you will find different subroutines for casting from one type to
 * another, as well as code for determining which type would be most fitting when
 * you have to for example add two values together.
 */
#ifndef NUJEL_AMALGAMATION
#include "nujel-private.h"
#endif

lClass lClassList[64];

static void initType(int i, const lSymbol *name, lClass *parent){
	lClassList[i].name = name;
	lClassList[i].parent = parent;
	lClassList[i].methods = NULL;
	lClassList[i].staticMethods = NULL;
}

static lVal lAddNativeMethod(lClass *T, const lSymbol *name, const char *args, void *fun, uint flags, u8 argCount){
	lVal v = lValAlloc(ltNativeFunc, lNFuncAlloc());
	v.vNFunc->fp   = fun;
	v.vNFunc->args = lCar(lRead(args));
	v.vNFunc->meta = NULL;
	v.vNFunc->argCount = argCount;
	if(flags & NFUNC_FOLD){
		v.vNFunc->meta = lTreeInsert(v.vNFunc->meta, symFold, lValBool(true));
	}
	if(flags & NFUNC_PURE){
		v.vNFunc->meta = lTreeInsert(v.vNFunc->meta, symPure, lValBool(true));
	}
	T->methods = lTreeInsert(T->methods, name, v);
	return v;
}

lVal lAddNativeMethodV(lClass *T, const lSymbol *name, const char *args, lVal (*fun)(lVal), uint flags){
	return lAddNativeMethod(T, name, args, fun, flags, (1 << 1));
}
lVal lAddNativeMethodVV(lClass *T, const lSymbol *name, const char *args, lVal (*fun)(lVal, lVal), uint flags){
	return lAddNativeMethod(T, name, args, fun, flags, (2 << 1));
}
lVal lAddNativeMethodVVV(lClass *T, const lSymbol *name, const char *args, lVal (*fun)(lVal, lVal, lVal), uint flags){
	return lAddNativeMethod(T, name, args, fun, flags, (3 << 1));
}

static lVal lAddNativeStaticMethod(lClass *T, const lSymbol *name, const char *args, void *fun, uint flags, u8 argCount){
	lVal v = lValAlloc(ltNativeFunc, lNFuncAlloc());
	v.vNFunc->fp   = fun;
	v.vNFunc->args = lCar(lRead(args));
	v.vNFunc->meta = NULL;
	v.vNFunc->argCount = argCount;
	if(flags & NFUNC_FOLD){
		v.vNFunc->meta = lTreeInsert(v.vNFunc->meta, symFold, lValBool(true));
	}
	if(flags & NFUNC_PURE){
		v.vNFunc->meta = lTreeInsert(v.vNFunc->meta, symPure, lValBool(true));
	}
	T->staticMethods = lTreeInsert(T->staticMethods, name, v);
	return v;
}

lVal lAddNativeStaticMethodV(lClass *T, const lSymbol *name, const char *args, lVal (*fun)(lVal), uint flags){
	return lAddNativeStaticMethod(T, name, args, fun, flags, (1 << 1));
}
lVal lAddNativeStaticMethodVV(lClass *T, const lSymbol *name, const char *args, lVal (*fun)(lVal, lVal), uint flags){
	return lAddNativeStaticMethod(T, name, args, fun, flags, (2 << 1));
}
lVal lAddNativeStaticMethodVVV(lClass *T, const lSymbol *name, const char *args, lVal (*fun)(lVal, lVal, lVal), uint flags){
	return lAddNativeStaticMethod(T, name, args, fun, flags, (3 << 1));
}

static lVal lnmTypeName(lVal self){
	if(unlikely(self.type != (self.type & 63))){
		return lValException(lSymVMError, "Out-of-bounds Type", self);
	}
	lClass *T = &lClassList[self.type];
	if(unlikely(T->name == NULL)){
		printf("T: %u\n", self.type);
		return lValException(lSymVMError, "Unnamed Type", self);
	}
	return lValKeywordS(T->name);
}

static lVal lnmTypeOf(lVal self){
	if(unlikely(self.type != (self.type & 63))){
		return lValException(lSymVMError, "Out-of-bounds Type", self);
	}
	return lValType(&lClassList[self.type]);
}

static lVal lnmNilMetaGet(lVal self, lVal key){
	(void)self;(void)key;
	return NIL;
}

static lVal lnmNilLength(lVal self){
	(void)self;
	return lValInt(0);
}

static lVal lnmPairLength(lVal self){
	lVal l = self;
	int i = 0;
	for(; l.type == ltPair; l = l.vList->cdr){
		i++;
	}
	if(unlikely(l.type != ltNil)){
		i++;
	}
	return lValInt(i);
}

static lVal lnmTName(lVal self){
	if(unlikely(self.vType->name == NULL)){
		return lValException(lSymVMError, "Unnamed Type", self);
	}
	return lValKeywordS(self.vType->name);
}

static lVal lnmAddMethod(lVal self, lVal name, lVal fn){
	lVal err = requireSymbolic(name);
	if(unlikely(err.type == ltException)){
		return err;
	}

	if(unlikely(fn.type != ltLambda)){
		return lValExceptionType(fn, ltLambda);
	}
	self.vType->methods = lTreeInsert(self.vType->methods, name.vSymbol, fn);
	return self;
}

static void lTypesAddCoreMethods(){
	lClass *Nil = &lClassList[ltNil];
	lAddNativeMethodV (Nil, lSymS("type-of"), "(self)", lnmTypeOf, NFUNC_PURE);
	lAddNativeMethodV (Nil, lSymS("type-name"), "(self)", lnmTypeName, NFUNC_PURE);
	lAddNativeMethodV (Nil, lSymS("length"), "(self)", lnmNilLength, 0);
	lAddNativeMethodVV(Nil, lSymS("meta"), "(self key)", lnmNilMetaGet, 0);

	lClass *Pair = &lClassList[ltPair];
	lAddNativeMethodV (Pair, lSymS("length"), "(self)", lnmPairLength, NFUNC_PURE);

	lClass *Type = &lClassList[ltType];
	lAddNativeMethodV  (Type, lSymS("name"), "(self)", lnmTName, NFUNC_PURE);
	lAddNativeMethodVVV(Type, lSymS("add-method"), "(self name fn)", lnmAddMethod, NFUNC_PURE);
}

lVal lMethodLookup(const lSymbol *method, lVal self){
	if(unlikely(self.type != (self.type & 63))){
		lValException(lSymVMError, "Out-of-bounds Type", self);
	}
	if(self.type == ltTree){
		lVal v = lTreeRef(self.vTree->root, method);
		if(v.type != ltException){
			return v;
		}
		lVal proto = lTreeRef(self.vTree->root, lSymPrototype);
		if(proto.type != ltException){
			return lMethodLookup(method, proto);
		}
	}
	if(self.type == ltType){
		const lClass *T = self.vType;
		for(;T;T = T->parent){
			const lTree *t = T->staticMethods;
			while(t){
				if(method == t->key){
					return t->value;
				}
				t = method > t->key ? t->right : t->left;
			}
		}
	}
	const lClass *T = &lClassList[self.type];
	for(;T;T = T->parent){
		const lTree *t = T->methods;
		while(t){
			if(method == t->key){
				return t->value;
			}
			t = method > t->key ? t->right : t->left;
		}
	}
	return lValException(lSymUnboundVariable, "Unbound method", self);
}

void lTypesInit(){
	initType(ltNil, lSymLTNil, NULL);
	lClass *tNil = &lClassList[ltNil];
	initType(ltSymbol, lSymLTSymbol, tNil);
	initType(ltKeyword, lSymLTKeyword, tNil);
	initType(ltBool, lSymLTBool, tNil);

	initType(ltInt, lSymLTInt, tNil);
	initType(ltFloat, lSymLTFloat, tNil);

	initType(ltPair, lSymLTPair, tNil);
	initType(ltArray, lSymLTArray, tNil);
	initType(ltTree, lSymLTTree, tNil);

	initType(ltNativeFunc, lSymLTNativeFunction, tNil);
	initType(ltLambda, lSymLTLambda, tNil);
	initType(ltMacro, lSymLTMacro, &lClassList[ltLambda]);
	initType(ltEnvironment, lSymLTEnvironment, &lClassList[ltLambda]);

	initType(ltBuffer, lSymLTBuffer, tNil);
	initType(ltBufferView, lSymLTBufferView, tNil);
	initType(ltBytecodeArr, lSymLTBytecodeArray, tNil);
	initType(ltString, lSymLTString, &lClassList[ltBuffer]);

	initType(ltFileHandle, lSymLTFileHandle, tNil);
	initType(ltType, lSymLTType, tNil);
	initType(ltComment, NULL, NULL);
	initType(ltException, NULL, NULL);

	lTypesAddCoreMethods();
}

lVal lValExceptionType(lVal v, lType T){
	char buf[128];
	snprintf(buf, sizeof(buf), "expected argument of type %s, not: ", getTypeSymbolT(T)->c);
	buf[sizeof(buf)-1] = 0;
	return lValException(lSymTypeError, buf, v);
}

lVal lValExceptionArity(lVal v, int arity){
	char buf[128];
	snprintf(buf, sizeof(buf), "This subroutine needs %i arguments", arity);
	buf[sizeof(buf)-1] = 0;
	return lValException(lSymArityError, buf, v);
}

lVal lValExceptionNonNumeric(lVal v){
	return lValException(lSymTypeError, "Can't calculate with non numeric types", v);
}

lVal lValExceptionFloat(lVal v){
	return lValException(lSymTypeError, "This function can only be used with floats",v);
}

/* Cast v to be an int without memory allocations, or return fallback */
i64 castToInt(const lVal v, i64 fallback){
	switch(v.type){
		case ltFloat: return v.vFloat;
		case ltInt:   return v.vInt;
		default:      return fallback;
	}
}

/* Cast v to be a bool without memory allocations, or return false */
bool castToBool(const lVal v){
	return (v.type == ltBool ? v.vBool : likely(v.type != ltNil));
}

const char *castToString(const lVal v, const char *fallback){
	return (v.type != ltString) ? fallback : v.vString->data;
}

/* Determine which type has the highest precedence between a and b */
lType lTypecast(const lType a, const lType b){
	if (likely(a == b)){
		return a;
	}
	if((a == ltFloat) || (b == ltFloat)){
		return ltFloat;
	}
	return ltNil;
}

lVal requireInt(lVal v){
	if(unlikely(v.type != ltInt)){
		return lValException(lSymTypeError, "Need an :Int", v);
	}
	return v;
}

lVal requireNaturalInt(lVal v){
	if(unlikely(v.type != ltInt)){
		return lValException(lSymTypeError, "Need an :Int", v);
	}
	if(unlikely(v.vInt < 0)){
		return lValException(lSymTypeError, "Expected a Natural int, not: ", v);
	}
	return v;
}

lVal requireBytecodeArray(lVal v){
	if(unlikely(v.type != ltBytecodeArr)){
		return lValException(lSymTypeError, "Need an :BytecodeArray", v);
	}
	return v;
}

lVal requireFloat(lVal v){
	if(likely(v.type == ltFloat)){
		return v;
	} else if(v.type == ltInt){
		return lValFloat(v.vInt);
	} else {
		return lValException(lSymTypeError, "Need an :Int or :Float", v);
	}
}

lVal requireArray(lVal v){
	if(unlikely(v.type != ltArray)){
		return lValException(lSymTypeError, "Need an :Array", v);
	}
	return v;
}

lVal requireString(lVal v){
	if(unlikely(v.type != ltString)){
		return lValException(lSymTypeError, "Need a :String", v);
	}
	return v;
}

lVal requireBuffer(lVal v){
	if(unlikely(v.type != ltBuffer)){
		return lValException(lSymTypeError, "Need a :Buffer", v);
	}
	return v;
}

lVal requireMutableBuffer(lVal v){
	if(unlikely(v.type != ltBuffer)){
		return lValException(lSymTypeError, "Need a :Buffer", v);
	}
	if(unlikely(v.vBuffer->flags & BUFFER_IMMUTABLE)){
		return lValException(lSymTypeError, "Buffer is immutable", v);
	}
	return v;
}

lVal requireSymbol(lVal v){
	if(unlikely(v.type != ltSymbol)){
		return lValException(lSymTypeError, "Need a :Symbol", v);
	}
	return v;
}

lVal requireSymbolic(lVal v){
	if(unlikely((v.type != ltKeyword) && (v.type != ltSymbol))){
		return lValException(lSymTypeError, "Need a :Symbol or :Keyword", v);
	}
	return v;
}

lVal optionalSymbolic(lVal v, const lSymbol *fallback){
	if(likely(v.type == ltNil)){
		return lValSymS(fallback);
	}
	return requireSymbolic(v);
}

lVal requireClosure(lVal v){
	if(unlikely(!((v.type == ltLambda)
		|| (v.type == ltEnvironment)
		|| (v.type == ltMacro))))
	{
			return lValException(lSymTypeError, "Need a closure, not: ", v);
	}
	return v;
}

lVal requireFileHandle(lVal v){
	if(unlikely(v.type != ltFileHandle)) {
		return lValException(lSymTypeError, "Need a :FileHandle", v);
	}
	return v;
}