Ben / Nujel

/*
 * Wolkenwelten - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
 *
 * This project uses the MIT license, a copy should be included under /LICENSE
 */
#include "nujel.h"

#include "casting.h"
#include "garbage-collection.h"
#include "reader.h"
#include "random-number-generator.h"
#include "datatypes/array.h"
#include "datatypes/native-function.h"
#include "datatypes/string.h"
#include "datatypes/vec.h"
#include "operations/arithmetic.h"
#include "operations/array.h"
#include "operations/binary.h"
#include "operations/conditional.h"
#include "operations/predicates.h"
#include "operations/random.h"
#include "operations/string.h"
#include "operations/time.h"
#include "operations/vec.h"

#include <ctype.h>
#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

extern u8 stdlib_nuj_data[];

int lGCRuns = 0;

lVal     lValList[VAL_MAX];
uint     lValActive = 0;
uint     lValMax    = 1;
uint     lValFFree  = 0;

lClosure lClosureList[CLO_MAX];
uint     lClosureActive = 0;
uint     lClosureMax    = 1;
uint     lClosureFFree  = 0;

lSymbol lSymbolList[SYM_MAX];
uint    lSymbolActive = 0;
uint    lSymbolMax    = 1;
uint    lSymbolFFree  = 0;

char dispWriteBuf[1<<16];
lSymbol *symNull,*symQuote,*symArr,*symIf,*symCond,*symWhen,*symUnless,*symLet,*symBegin,*symMinus;

void lInit(){
	lValActive      = 0;
	lValMax         = 1;

	lClosureActive  = 0;
	lClosureMax     = 1;

	lSymbolActive   = 0;
	lSymbolMax      = 1;

	symNull     = lSymS("");
	symQuote    = lSymS("quote");
	symArr      = lSymS("arr");
	symIf       = lSymS("if");
	symCond     = lSymS("cond");
	symWhen     = lSymS("when");
	symUnless   = lSymS("unless");
	symLet      = lSymS("let");
	symBegin    = lSymS("begin");
	symMinus    = lSymS("-");

	lInitArray();
	lInitNativeFunctions();
	lInitStr();
	lInitVec();
}

uint lClosureAlloc(){
	lClosure *ret;
	if(lClosureFFree == 0){
		if(lClosureMax >= CLO_MAX-1){
			lPrintError("lClosure OOM ");
			return 0;
		}
		ret = &lClosureList[lClosureMax++];
	}else{
		ret = &lClosureList[lClosureFFree & CLO_MASK];
		lClosureFFree = ret->nextFree;
	}
	lClosureActive++;
	*ret = (lClosure){0};
	ret->flags = lfUsed;
	return ret - lClosureList;
}

void lClosureFree(uint c){
	if((c == 0) || (c >= lClosureMax)){return;}
	lClosure *clo = &lClosureList[c];
	if(!(clo->flags & lfUsed)){return;}
	lClosureActive--;
	clo->nextFree   = lClosureFFree;
	clo->flags      = 0;
	lClosureFFree = c;
}

lVal *lValAlloc(){
	lVal *ret;
	if(lValFFree == 0){
		if(lValMax >= VAL_MAX-1){
			exit(1);
			lPrintError("lVal OOM ");
			return NULL;
		}
		ret = &lValList[lValMax++];
	}else{
		ret       = &lValList[lValFFree & VAL_MASK];
		lValFFree = ret->vCdr;
	}
	lValActive++;
	*ret = (lVal){0};
	return ret;
}

void lGUIWidgetFree(lVal *v);
void lValFree(lVal *v){
	if((v == NULL) || (v->type == ltNoAlloc)){return;}
	if(v->type == ltLambda){
		lClo(v->vCdr).refCount--;
	}else if(v->type == ltGUIWidget){
		lGUIWidgetFree(v);
	}
	lValActive--;
	v->type   = ltNoAlloc;
	v->vCdr   = lValFFree;
	lValFFree = v - lValList;
}

lVal *lValCopy(lVal *dst, const lVal *src){
	if((dst == NULL) || (src == NULL)){return NULL;}
	*dst = *src;
	if(dst->type == ltString){
		dst->vCdr = lStringNew(lStrData(src),lStringLength(&lStr(src)));
	}else if(dst->type == ltVec){
		dst->vCdr = lVecAlloc();
		lVecV(dst->vCdr) = lVecV(src->vCdr);
	}else if(dst->type == ltPair){
		dst->vList.car = lValDup(dst->vList.car);
		dst->vList.cdr = lValDup(dst->vList.cdr);
	}
	return dst;
}

lVal *lValInf(){
	lVal *ret = lValAlloc();
	if(ret == NULL){return ret;}
	ret->type = ltInf;
	return ret;
}

lVal *lValInt(int v){
	lVal *ret = lValAlloc();
	if(ret == NULL){return ret;}
	ret->type = ltInt;
	ret->vInt = v;
	return ret;
}

lVal *lValFloat(float v){
	lVal *ret   = lValAlloc();
	if(ret == NULL){return ret;}
	ret->type   = ltFloat;
	ret->vFloat = v;
	return ret;
}
lVal *lValBool(bool v){
	lVal *ret = lValAlloc();
	if(ret == NULL){return ret;}
	ret->type = ltBool;
	ret->vBool = v;
	return ret;
}

lSymbol *lSymSL(const char *str, uint len){
	char buf[32];
	len = MIN(sizeof(buf)-1,len);
	memcpy(buf,str,len);
	buf[len] = 0;
	return lSymS(buf);
}

lSymbol *lSymS(const char *str){
	for(uint i = 0;i<lSymbolMax;i++){
		if(strncmp(str,lSymbolList[i].c,sizeof(lSymbolList[0].c)-1)){continue;}
		return &lSymbolList[i];
	}
	if(lSymbolMax >= SYM_MAX){
		fprintf(stderr,"lSym Overflow\n");
		return NULL;
	}
	snprintf(lSymbolList[lSymbolMax].c,sizeof(lSymbolList[0].c),"%s",str);
	return &lSymbolList[lSymbolMax++];
}

lVal *lValSymS(const lSymbol *s){
	if(s == NULL){return NULL;}
	lVal *ret = lValAlloc();
	if(ret == NULL){return NULL;}
	ret->type = ltSymbol;
	ret->vCdr = lvSymI(s);
	return ret;
}

lVal *lValSym(const char *s){
	return lValSymS(lSymS(s));
}

lVal *lCons(lVal *car, lVal *cdr){
	lVal *v = lValAlloc();
	if(v == NULL){return NULL;}
	v->type = ltPair;
	v->vList.car = car;
	v->vList.cdr = cdr;
	return v;
}

uint lClosureNew(uint parent){
	const uint i = lClosureAlloc();
	if(i == 0){return 0;}
	lClosure *c = &lClosureList[i];
	c->parent = parent;
	lClosure *p = &lClosureList[parent & CLO_MASK];
	p->refCount++;
	return i;
}

/* TODO: Both seem to write outside of buf if v gets too long */
void lDisplayVal(lVal *v){
	lSWriteVal(v,dispWriteBuf,&dispWriteBuf[sizeof(dispWriteBuf)],0,true);
	printf("%s",dispWriteBuf);
}

void lDisplayErrorVal(lVal *v){
	lSWriteVal(v,dispWriteBuf,&dispWriteBuf[sizeof(dispWriteBuf)],0,true);
	fprintf(stderr,"%s",dispWriteBuf);
}

void lWriteVal(lVal *v){
	lSWriteVal(v,dispWriteBuf,&dispWriteBuf[sizeof(dispWriteBuf)],0,false);
	printf("%s\n",dispWriteBuf);
}

lVal *lSearchClosureSym(uint c, lVal *ret, const char *str, uint len){
	if(c == 0){return ret;}

	forEach(n,lCloData(c)){
		lVal *e = lCaar(n);
		if((e == NULL) || (e->type != ltSymbol)){continue;}
		lSymbol *sym = lvSym(e->vCdr);
		if(sym == NULL){continue;}
		if(strncmp(sym->c,str,len)){continue;}
		ret = lCons(e,ret);
	}
	return lSearchClosureSym(lCloParent(c),ret,str,len);
}

static lVal *lnfDefine(uint c, lClosure *ec, lVal *v, lVal *(*func)(uint ,lSymbol *)){
	if((v == NULL) || (v->type != ltPair)){return NULL;}
	lVal *sym = lCar(v);
	lVal *nv = NULL;
	if(lCdr(v) != NULL){
		nv = lEval(ec,lCadr(v));
	}
	if(sym->type != ltSymbol){sym = lEval(&lClo(c),sym);}
	if(sym->type != ltSymbol){return NULL;}
	lSymbol *lsym = lvSym(sym->vCdr);
	if((lsym != NULL) && (lsym->c[0] == ':')){return NULL;}
	lVal *t = func(c,lsym);
	if((t == NULL) || (t->type != ltPair)){return NULL;}
	if((lCar(t) != NULL) && (lCar(t)->flags & lfConst)){
		return lCar(t);
	}else{
		t->vList.car = nv;
		return lCar(t);
	}
}

static lVal *lUndefineClosureSym(uint c, lVal *s){
	if(c == 0){return lValBool(false);}

	lVal *lastPair = lCloData(c);
	forEach(v,lCloData(c)){
		lVal *n = lCar(v);
		if((n == NULL) || (n->type != ltPair))  {break;}
		const lVal *sym = lCar(n);
		if(lSymCmp(s,sym) == 0){
			lastPair->vList.cdr = lCdr(v);
			return lValBool(true);
		}
		lastPair = v;
	}
	return lUndefineClosureSym(lCloParent(c),s);
}
static lVal *lnfUndef(lClosure *c, lVal *v){
	if((v == NULL) || (v->type != ltPair)){return NULL;}
	lVal *sym = lCar(v);
	if(sym->type != ltSymbol){sym = lEval(c,sym);}
	if(sym->type != ltSymbol){return NULL;}
	return lUndefineClosureSym(c - lClosureList,sym);
}
static lVal *lnfDef(lClosure *c, lVal *v){
	return lnfDefine(c - lClosureList,c,v,lDefineClosureSym);
}
static lVal *lnfSet(lClosure *c, lVal *v){
	return lnfDefine(c - lClosureList,c,v,lGetClosureSym);
}

static lVal *lSymTable(lClosure *c, lVal *v, int off, int len){
	(void)v;
	if((c == NULL) || (len == 0)){return v;}
	forEach(n,c->data){
		lVal *entry = lCadar(n);
		if(entry == NULL){continue;}
		if((entry->type != ltNativeFunc) && (entry->type != ltLambda)){continue;}

		if(off > 0){--off; continue;}
		v = lCons(lCaar(n),v);
		if(--len <= 0){return v;}
	}
	if(c->parent == 0){return v;}
	return lSymTable(&lClo(c->parent),v,off,len);
}

static lVal *lnfSymTable(lClosure *c, lVal *v){
	lVal *loff = lnfInt(c,lEval(c,lCar(v)));
	lVal *llen = lnfInt(c,lEval(c,lCadr(v)));
	int off = loff->vInt;
	int len = llen->vInt;
	if(len <= 0){len = 1<<16;}
	return lSymTable(c,NULL,off,len);
}

static int lSymCount(lClosure *c, int ret){
	if(c == NULL){return ret;}
	forEach(n,c->data){
		lVal *entry = lCadar(n);
		if(entry == NULL){continue;}
		if((entry->type != ltNativeFunc) && (entry->type != ltLambda)){continue;}
		++ret;
	}
	if(c->parent == 0){return ret;}
	return lSymCount(&lClo(c->parent),ret);
}

static lVal *lnfSymCount(lClosure *c, lVal *v){
	(void)v;
	return lValInt(lSymCount(c,0));
}

lVal *lnfBegin(lClosure *c, lVal *v){
	lVal *ret = NULL;
	forEach(n,v){
		ret = lEval(c,lCar(n));
	}
	return ret;
}

static lVal *lnfCl(lClosure *c, lVal *v){
	if(c == NULL){return NULL;}
	if(v == NULL){return c->data != NULL ? c->data : lCons(NULL,NULL);}
	lVal *t = lnfInt(c,lEval(c,lCar(v)));
	if((t != NULL) && (t->type == ltInt) && (t->vInt > 0)){
		return lnfCl(&lClo(c->parent),lCons(lValInt(t->vInt - 1),NULL));
	}
	return c->data != NULL ? c->data : lCons(NULL,NULL);
}

static lVal *lnfClText(lClosure *c, lVal *v){
	if((v == NULL) || (v->type != ltPair)){return NULL;}
	lVal *t = lEval(c,lCar(v));
	if(t == NULL){return NULL;}
	if(t->type == ltLambda){
		return lCloText(t->vCdr);
	}else if(t->type == ltNativeFunc){
		return lCons(lCdr(lNFN(t->vCdr).doc),NULL);
	}
	return NULL;
}

static lVal *lnfClData(lClosure *c, lVal *v){
	if((v == NULL) || (v->type != ltPair)){return NULL;}
	lVal *t = lEval(c,lCar(v));
	if(t == NULL){return NULL;}
	if(t->type == ltLambda){
		return lCloData(t->vCdr);
	}else if(t->type == ltNativeFunc){
		return lCar(lNFN(t->vCdr).doc);
	}
	return NULL;
}

static lVal *lnfClLambda(lClosure *c, lVal *v){
	if(c == NULL){return NULL;}
	if(v == NULL){return c->data != NULL ? c->data : lCons(NULL,NULL);}
	lVal *t = lnfInt(c,lEval(c,lCar(v)));
	if((t != NULL) && (t->type == ltInt) && (t->vInt > 0)){
		return lnfClLambda(&lClo(c->parent),lCons(lValInt(t->vInt - 1),NULL));
	}
	lVal *ret = lValAlloc();
	ret->type = ltLambda;
	ret->vCdr = c - lClosureList;
	c->refCount++;
	return ret;
}

static lVal *lnfLambda(lClosure *c, lVal *v){
	const uint cli = lClosureNew(c - lClosureList);
	if(cli == 0){return NULL;}
	if((v == NULL) || (lCar(v) == NULL) || (lCdr(v) == NULL)){return NULL;}
	lCloText(cli) = lCdr(v);
	lVal *ret = lValAlloc();
	if(ret == NULL){return NULL;}
	ret->type = ltLambda;
	ret->vCdr = cli;

	forEach(n,lCar(v)){
		if(lGetType(lCar(n)) != ltSymbol){continue;}
		lVal *t = lDefineClosureSym(cli,lGetSymbol(lCar(n)));
		t->vList.car = NULL;
		(void)t;
	}

	return ret;
}

static lVal *lnfDynamic(lClosure *c, lVal *v){
	lVal *ret = lnfLambda(c,v);
	if(ret == NULL){return NULL;}
	lClo(ret->vCdr).flags |= lfDynamic;
	return ret;
}

static lVal *lnfObject(lClosure *c, lVal *v){
	const uint cli = lClosureNew(c - lClosureList);
	if(cli == 0){return NULL;}
	lVal *ret = lValAlloc();
	ret->type = ltLambda;
	ret->vCdr = cli;
	lClo(cli).flags |= lfObject;
	lnfBegin(&lClo(cli),v);

	return ret;
}

static lVal *lnfSelf(lClosure *c, lVal *v){
	if(c == NULL){return NULL;}
	if(c->flags & lfObject){
		lVal *t = lValAlloc();
		t->type = ltLambda;
		t->vCdr = c - lClosureList;
		return t;
	}
	if(c->parent == 0){return NULL;}
	return lnfSelf(&lClosureList[c->parent],v);
}

static lVal *lnfQuote(lClosure *c, lVal *v){
	(void)c;
	return lCar(v);
}

static lVal *lnfMemInfo(lClosure *c, lVal *v){
	(void)c; (void)v;
	lVal *ret = NULL;
	ret = lCons(lValInt(lSymbolMax),ret);
	ret = lCons(lValSym(":symbol"),ret);
	ret = lCons(lValInt(lNFuncActive),ret);
	ret = lCons(lValSym(":native-function"),ret);
	ret = lCons(lValInt(lStringActive),ret);
	ret = lCons(lValSym(":string"),ret);
	ret = lCons(lValInt(lClosureActive),ret);
	ret = lCons(lValSym(":array"),ret);
	ret = lCons(lValInt(lArrayActive),ret);
	ret = lCons(lValSym(":vector"),ret);
	ret = lCons(lValInt(lVecActive),ret);
	ret = lCons(lValSym(":closure"),ret);
	ret = lCons(lValInt(lValActive),ret);
	ret = lCons(lValSym(":value"),ret);
	return ret;
}

static lVal *lnfLet(lClosure *c, lVal *v){
	if((v == NULL) || (v->type != ltPair)){return NULL;}
	const uint nci = lClosureNew(c - lClosureList);
	if(nci == 0){return NULL;}
	lClosure *nc = &lClosureList[nci & CLO_MASK];
	forEach(n,lCar(v)){
		lnfDefine(nci,c,lCar(n),lDefineClosureSym);
	}
	lVal *ret = NULL;
	forEach(n,lCdr(v)){
		ret = lEval(nc,lCar(n));
	}
	c->refCount--;
	return ret == NULL ? NULL : ret;
}

static inline bool lSymVariadic(lSymbol *s){
	const char *p = s->c;
	if((*p == '@') || (*p == '&')){p++;}
	if((*p == '@') || (*p == '&')){p++;}
	if((p[0] == '.') && (p[1] == '.') && (p[2] == '.')){
		return true;
	}
	return false;
}
/*
static inline bool lSymOptional(lSymbol s){
	if(s.c[0] == '&'){return true;}
	if((s.c[0] == '@') && (s.c[1] == '&')){return true;}
	return false;
}*/
static inline bool lSymNoEval(lSymbol *s){
	if(s->c[0] == '@'){return true;}
	if((s->c[0] == '&') && (s->c[1] == '@')){return true;}
	return false;
}

static lVal *lLambda(lClosure *c,lVal *v, lClosure *lambda){
	if(lambda == NULL){
		lPrintError("lLambda: NULL\n");
		return NULL;
	}
	if(lambda->flags & lfObject){
		return lnfBegin(lambda,v);
	}
	lVal *vn = v;
	uint tmpci = 0;
	if(lambda->flags & lfDynamic){
		tmpci = lClosureNew(lCloI(c));
	}else{
		tmpci = lClosureNew(lCloI(lambda));
	}
	if(tmpci == 0){return NULL;}
	lClosure *tmpc = &lClo(tmpci);
	tmpc->text = lambda->text;
	forEach(n,lambda->data){
		if(vn == NULL){break;}
		lVal *nn = lCar(n);
		if(lGetType(lCar(nn)) != ltSymbol){continue;}
		lSymbol *csym = lGetSymbol(lCar(nn));
		lVal *lv = lDefineClosureSym(tmpci,csym);
		if(lSymVariadic(csym)){
			lVal *t = lSymNoEval(csym) ? vn : lApply(c,vn,lEval);
			if((lv != NULL) && (lv->type == ltPair)){ lv->vList.car = t;}
			break;
		}else{
			lVal *t = lSymNoEval(csym) ? lCar(vn) : lEval(c,lCar(vn));
			if(t  != NULL && t->type == ltSymbol && !lSymNoEval(csym)){t = lEval(c,t);}
			if((lv != NULL) && (lv->type == ltPair)){ lv->vList.car = t;}
			if(vn != NULL){vn = lCdr(vn);}
		}
	}

	lVal *ret = NULL;
	forEach(n,lambda->text){
		ret = lEval(tmpc,lCar(n));
	}
	if(tmpc->refCount == 0){
		lClosureFree(tmpci);
	}
	return ret;
}

lVal *lValNativeFunc(lVal *(*func)(lClosure *,lVal *), lVal *args, lVal *docString){
	lVal *v = lValAlloc();
	if(v == NULL){return NULL;}
	v->type    = ltNativeFunc;
	v->flags  |= lfConst;
	v->vCdr    = lNFuncAlloc();
	if(v->vCdr == 0){
		lValFree(v);
		return NULL;
	}
	lNFunc *fn = &lNFN(v->vCdr);
	fn->fp     = func;
	fn->doc    = lCons(args,docString);
	return v;
}

static lVal *lnfCar(lClosure *c, lVal *v){
	return lCar(lEval(c,lCar(v)));
}

static lVal *lnfCdr(lClosure *c, lVal *v){
	return lCdr(lEval(c,lCar(v)));
}

static lVal *lnfCons(lClosure *c, lVal *v){
	return lCons(lEval(c,lCar(v)),lEval(c,lCadr(v)));
}
static lVal *lnfSetCar(lClosure *c, lVal *v){
	lVal *t = lEval(c,lCar(v));
	if((t == NULL) || (t->type != ltPair)){return NULL;}
	lVal *car = NULL;
	if((v != NULL) && (v->type == ltPair) && (lCdr(v) != NULL)){car = lEval(c,lCadr(v));}
	t->vList.car = car;
	return t;
}
static lVal *lnfSetCdr(lClosure *c, lVal *v){
	lVal *t = lEval(c,lCar(v));
	if((t == NULL) || (t->type != ltPair)){return NULL;}
	lVal *cdr = NULL;
	if((v != NULL) && (v->type == ltPair) && (lCdr(v) != NULL)){cdr = lEval(c,lCadr(v));}
	t->vList.cdr = cdr;
	return t;
}

lVal *lResolve(lClosure *c, lVal *v){
	v = lEval(c,lCar(v));
	for(int i=0;i<16;i++){
		if((v == NULL) || (v->type != ltSymbol)){break;}
		v = lResolveSym(c - lClosureList,v);
	}
	return v;
}

lVal *lEval(lClosure *c, lVal *v){
	if((c == NULL) || (v == NULL)){return NULL;}

	if(v->type == ltSymbol){
		return lResolveSym(c - lClosureList,v);
	}else if(v->type == ltPair){
		lVal *ret = lEval(c,lCar(v));
		if(ret == NULL){return v;}
		switch(ret->type){
		default:
			return v;
		case ltSpecialForm:
			return lNFN(ret->vCdr).fp(c,lCdr(v));
		case ltNativeFunc:
			return lNFN(ret->vCdr).fp(c,lCdr(v));
		case ltLambda:
			return lLambda(c,lCdr(v),&lClo(ret->vCdr));
		case ltPair:
			return lEval(c,ret);
		case ltString:
			return lnfCat(c,v);
		case ltInt:
		case ltFloat:
		case ltVec:
			return v->vList.cdr == NULL ? ret : lnfInfix(c,v);
		case ltArray:
			return v->vList.cdr == NULL ? ret : lnfArrRef(c,v);
		}
	}
	return v;
}

lVal *lnfApply(lClosure *c, lVal *v){
	lVal *func = lEval(c,lCar(v));
	if(func == NULL){return NULL;}
	if(func->type == ltSymbol){func = lResolveSym(c - lClosureList,func);}
	switch(func->type){
	case ltNativeFunc:
		if(lNFN(func->vCdr).fp == NULL){return v;}
		return lNFN(func->vCdr).fp(c,lEval(c,lCadr(v)));
	case ltLambda: {
		lVal *t = lCadr(v);
		if((t == NULL) || (t->type != ltPair)){t = lCons(t,NULL);}
		return lLambda(c,t,&lClo(func->vCdr));}
	default:
		return v;
	}
}

void lDefineVal(lClosure *c, const char *str, lVal *val){
	lVal *var = lDefineClosureSym(lCloI(c),lSymS(str));
	if(var == NULL){return;}
	var->vList.car = val;
}

lVal *lnfRead(lClosure *c, lVal *v){
	lVal *t = lEval(c,v);
	if((t == NULL) || (t->type != ltString)){return NULL;}
	uint dup = lStringDup(t->vCdr);
	if(dup == 0){return NULL;}
	t = lReadString(&lStringList[dup]);
	if((t != NULL) && (t->type == ltPair) && (lCar(t) != NULL) && (lCdr(t) == NULL)){
		return lCar(t);
	}else{
		return t;
	}
}

lVal *lDefineAliased(lClosure *c, lVal *lNF, const char *sym){
	const char *cur = sym;

	// Run at most 64 times, just a precaution
	for(int i=0;i<64;i++){
		uint len;
		for(len=0;len < sizeof(lSymbol);len++){ // Find the end of the current token, either space or 0
			if(cur[len] == 0)    {break;}
			if(isspace((u8)cur[len])){break;}
		}
		lVal *var = lDefineClosureSym(lCloI(c),lSymSL(cur,len));
		if(var == NULL){
			lPrintError("Error adding NFunc %s\n",sym);
			return NULL;
		}
		var->vList.car = lNF;
		for(;len<32;len++){ // Advance to the next non whitespace character
			if(cur[len] == 0)     {return lNF;} // Or return if we reached the final 0 byte
			if(!isspace((u8)cur[len])){break;}
		}
		cur += len;
	}
	lPrintError("Quite the amount of aliases we have there (%s)\n",sym);
	return NULL;
}

static lVal *lnfTypeOf(lClosure *c, lVal *v){
	v = lEval(c,lCar(v));
	if(v == NULL){return lValSym(":nil");}
	switch(v->type){
	case ltNoAlloc:    return lValSym(":no-alloc");
	case ltBool:       return lValSym(":bool");
	case ltPair:       return lValSym(":pair");
	case ltLambda:     return lValSym(":lambda");
	case ltInt:        return lValSym(":int");
	case ltFloat:      return lValSym(":float");
	case ltVec:        return lValSym(":vec");
	case ltString:     return lValSym(":string");
	case ltSymbol:     return lValSym(":symbol");
	case ltNativeFunc: return lValSym(":native-function");
	case ltInf:        return lValSym(":infinity");
	case ltArray:      return lValSym(":array");
	case ltGUIWidget:  return lValSym(":gui-widget");
	}
	return lValSym(":nil");
}

static void lAddPlatformVars(lClosure *c){
	#if defined(__HAIKU__)
	lDefineVal(c, "OS", lConst(lValString("Haiku")));
	#elif defined(__APPLE__)
	lDefineVal(c, "OS", lConst(lValString("Macos")));
	#elif defined(__EMSCRIPTEN__)
	lDefineVal(c, "OS", lConst(lValString("Emscripten")));
	#elif defined(__MINGW32__)
	lDefineVal(c, "OS", lConst(lValString("Windows")));
	#elif defined(__linux__)
	lDefineVal(c, "OS", lConst(lValString("Linux")));
	#else
	lDefineVal(c, "OS", lConst(lValString("*nix")));
	#endif

	#if defined(__arm__)
	lDefineVal(c, "ARCH", lConst(lValString("armv7l")));
	#elif defined(__aarch64__)
	lDefineVal(c, "ARCH", lConst(lValString("aarch64")));
	#elif defined(__x86_64__)
	lDefineVal(c, "ARCH", lConst(lValString("x86_64")));
	#elif defined(__EMSCRIPTEN__)
	lDefineVal(c, "ARCH", lConst(lValString("wasm")));
	#else
	lDefineVal(c, "ARCH", lConst(lValString("unknown")));
	#endif
}

static lVal *lnfConstant(lClosure *c, lVal *v){
	lVal *t = lEval(c,lCar(v));
	if(t == NULL){return NULL;}
	t->flags |= lfConst;
	return t;
}

static void lAddCoreFuncs(lClosure *c){
	lOperationsArithmetic(c);
	lOperationsArray(c);
	lOperationsBinary(c);
	lOperationsCasting(c);
	lOperationsConditional(c);
	lOperationsPredicates(c);
	lOperationsRandom(c);
	lOperationsString(c);
	lOperationsTime(c);
	lOperationsVector(c);

	lAddNativeFunc(c,"car",     "[list]",     "Returs the head of LIST",                          lnfCar);
	lAddNativeFunc(c,"cdr",     "[list]",     "Return the rest of LIST",                          lnfCdr);
	lAddNativeFunc(c,"cons",    "[car cdr]",  "Return a new pair of CAR and CDR",                lnfCons);
	lAddNativeFunc(c,"set-car!","[list car]", "Set the CAR of LIST",                           lnfSetCar);
	lAddNativeFunc(c,"set-cdr!","[list cdr]", "Set the CDR of LIST",                           lnfSetCdr);

	lAddNativeFunc(c,"constant const", "[v]",            "Returns V as a constant",                    lnfConstant);
	lAddNativeFunc(c,"apply",          "[func list]",    "Evaluate FUNC with LIST as arguments",       lnfApply);
	lAddNativeFunc(c,"eval",           "[expr]",         "Evaluate EXPR",                              lEval);
	lAddNativeFunc(c,"read",           "[str]",          "Read and Parses STR as an S-Expression",     lnfRead);
	lAddNativeFunc(c,"resolve",        "[sym]",          "Resolve SYM until it is no longer a symbol", lResolve);
	lAddNativeFunc(c,"memory-info",    "[]",             "Return memory usage data",                   lnfMemInfo);
	lAddNativeFunc(c,"lambda lam λ \\","[args ...body]", "Create a new lambda",                        lnfLambda);
	lAddNativeFunc(c,"dynamic dyn δ",  "[args ...body]", "New Dynamic scoped lambda",                  lnfDynamic);
	lAddNativeFunc(c,"object obj ω",   "[args ...body]", "Create a new object",                        lnfObject);
	lAddNativeFunc(c,"self",           "[]",             "Return the closest object closure",          lnfSelf);
	lAddNativeFunc(c,"cl",             "[i]",            "Return closure",                             lnfCl);
	lAddNativeFunc(c,"cl-lambda",      "[i]",            "Return closure as a lambda",                 lnfClLambda);
	lAddNativeFunc(c,"cl-text",        "[f]",            "Return closures text segment",               lnfClText);
	lAddNativeFunc(c,"cl-data",        "[f]",            "Return closures data segment",               lnfClData);
	lAddNativeFunc(c,"type-of",        "[val]",          "Return a symbol describing the type of VAL", lnfTypeOf);
	lAddNativeFunc(c,"symbol-table",   "[off len]",      "Return a list of len symbols defined, accessible from the current closure from offset off",lnfSymTable);
	lAddNativeFunc(c,"symbol-count",   "[]",             "Return a count of the symbols accessible from the current closure",lnfSymCount);

	lAddNativeFunc(c,"define def","[sym val]",     "Define a new symbol SYM and link it to value VAL",                  lnfDef);
	lAddNativeFunc(c,"undefine!", "[sym]",         "Remove symbol SYM from the first symbol-table it is found in",     lnfUndef);
	lAddNativeFunc(c,"let",       "[args ...body]","Create a new closure with args bound in which to evaluate ...body",lnfLet);
	lAddNativeFunc(c,"begin",     "[...body]",     "Evaluate ...body in order and returns the last result",            lnfBegin);
	lAddNativeFunc(c,"quote",     "[v]",           "Return v as is without evaluating",                                lnfQuote);
	lAddNativeFunc(c,"set!",      "[s v]",         "Bind a new value v to already defined symbol s",                   lnfSet);
}

lClosure *lClosureNewRoot(){
	const uint ci = lClosureAlloc();
	if(ci == 0){return NULL;}
	lClosure *c = &lClosureList[ci];
	c->parent = 0;
	c->flags |= lfNoGC;
	lAddCoreFuncs(c);
	lEval(c,lWrap(lRead((const char *)stdlib_nuj_data)));
	lAddPlatformVars(c);
	return c;
}

static lVal *lGetSym(uint c, lSymbol *s){
	if((c == 0) || (s == NULL)){return NULL;}
	uint sym = lvSymI(s);
	forEach(v,lCloData(c)){
		lVal *cursym = lCaar(v);
		if((cursym == NULL) || (sym != cursym->vCdr)){continue;}
		return lCdar(v);
	}
	return NULL;
}

lVal *lGetClosureSym(uint c, lSymbol *s){
	if(c == 0){return NULL;}
	lVal *t = lGetSym(c,s);
	return t != NULL ? t : lGetClosureSym(lCloParent(c),s);
}

lVal *lDefineClosureSym(uint c, lSymbol *s){
	if(c == 0){return NULL;}
	lVal *get = lGetSym(c,s);
	if(get != NULL){return get;}
	lVal *t = lCons(lValSymS(s),lCons(NULL,NULL));
	if(t == NULL){return NULL;}
	if(lCloData(c) == NULL){
		lCloData(c) = lCons(t,NULL);
	}else{
		lVal *cdr = NULL;
		for(cdr = lCloData(c);(cdr != NULL) && (lCdr(cdr) != NULL);cdr = lCdr(cdr)){}
		if(cdr == NULL){return NULL;}
		cdr->vList.cdr = lCons(t,NULL);
	}
	return t->vList.cdr;
}

lVal *lResolveSym(uint c, lVal *v){
	if((v == NULL) || (v->type != ltSymbol)){return NULL;}
	lVal *ret = lGetClosureSym(c,lvSym(v->vCdr));
	return ret == NULL ? v : lCar(ret);
}

lVal  *lApply(lClosure *c, lVal *v, lVal *(*func)(lClosure *,lVal *)){
	if((c == NULL) || (v == NULL)){return NULL;}
	lVal *ret = NULL, *cc = NULL;

	forEach(t,v){
		lVal *ct = func(c,lCar(t));
		if(ct == NULL){continue;}
		ct = lCons(ct,NULL);
		if(ret == NULL){ret = ct;}
		if(cc  != NULL){cc->vList.cdr = ct;}
		cc = ct;
	}

	return ret;
}

lType lTypecast(const lType a,const lType b){
	if((a == ltInf)   || (b == ltInf))  {return ltInf;}
	if((a == ltVec)   || (b == ltVec))  {return ltVec;}
	if((a == ltFloat) || (b == ltFloat)){return ltFloat;}
	if((a == ltInt)   || (b == ltInt))  {return ltInt;}
	if((a == ltBool)  || (b == ltBool)) {return ltBool;}
	if (a == b){ return a;}
	return ltNoAlloc;
}

lType lTypecastList(lVal *a){
	if((a == NULL) || (a->type != ltPair) || (lCar(a) == NULL)){return ltNoAlloc;}
	lType ret = lGetType(lCar(a));
	forEach(t,lCdr(a)){ret = lTypecast(ret,lGetType(lCar(t)));}
	return ret;
}

lType lGetType(lVal *v){
	return v == NULL ? ltNoAlloc : v->type;
}

lVal *lCast(lClosure *c, lVal *v, lType t){
	switch(t){
	default:
		return v;
	case ltString:
		return lApply(c,v,lnfString);
	case ltInt:
		return lApply(c,v,lnfInt);
	case ltFloat:
		return lApply(c,v,lnfFloat);
	case ltVec:
		return lApply(c,v,lnfVec);
	case ltInf:
		return lApply(c,v,lnfInf);
	case ltBool:
		return lApply(c,v,lnfBool);
	case ltNoAlloc:
		return NULL;
	}
}


lVal *getLArgB(lClosure *c, lVal *v, bool *res){
	if((v == NULL) || (v->type != ltPair)){return NULL;}
	lVal *tlv = lnfBool(c,lEval(c,lCar(v)));
	if(tlv != NULL){
		*res = tlv->vBool;
	}
	return lCdr(v);
}

lVal *getLArgI(lClosure *c, lVal *v, int *res){
	if((v == NULL) || (v->type != ltPair)){return NULL;}
	lVal *tlv = lnfInt(c,lEval(c,lCar(v)));
	if(tlv != NULL){
		*res = tlv->vInt;
	}
	return lCdr(v);
}

lVal *getLArgF(lClosure *c, lVal *v, float *res){
	if((v == NULL) || (v->type != ltPair)){return NULL;}
	lVal *tlv = lnfFloat(c,lEval(c,lCar(v)));
	if(tlv != NULL){
		*res = tlv->vFloat;
	}
	return lCdr(v);
}

lVal *getLArgV(lClosure *c, lVal *v, vec *res){
	if((v == NULL) || (v->type != ltPair)){return NULL;}
	lVal *tlv = lnfVec(c,lEval(c,lCar(v)));
	if(tlv != NULL){
		*res = lVecV(tlv->vCdr);
	}
	return lCdr(v);
}

lVal *getLArgS(lClosure *c, lVal *v,const char **res){
	if((v == NULL) || (v->type != ltPair)){return NULL;}
	lVal *tlv = lnfString(c,lEval(c,lCar(v)));
	if(tlv != NULL){
		*res = lStrData(tlv);
	}
	return lCdr(v);
}

lVal *getLArgL(lClosure *c, lVal *v,lVal **res){
	if((v == NULL) || (v->type != ltPair)){return NULL;}
	lVal *tlv = lEval(c,lCar(v));
	if((tlv != NULL) && ((tlv->type == ltLambda) || (tlv->type == ltNativeFunc))){
		*res = tlv;
	}
	return lCdr(v);
}

lVal *lValDup(const lVal *v){
	return v == NULL ? NULL : lValCopy(lValAlloc(),v);
}

lVal *lWrap(lVal *v){
	return lCons(lValSymS(symBegin),v);
}

lVal *lEvalCast(lClosure *c, lVal *v){
	lVal *t = lApply(c,v,lEval);
	return lCast(c,t,lTypecastList(t));
}

lVal *lEvalCastSpecific(lClosure *c, lVal *v, const lType type){
	return lCast(c,lApply(c,v,lEval),type);
}

lVal *lEvalCastNumeric(lClosure *c, lVal *v){
	lVal *t = lApply(c,v,lEval);
	lType type = lTypecastList(t);
	if(type == ltString){type = ltFloat;}
	return lCast(c,t,type);
}

lVal *lLastCar(lVal *v){
	forEach(a,v){
		if(lCdr(a) == NULL){return lCar(a);}
	}
	return NULL;
}

lVal *lCar(lVal *v){
	return (v != NULL) && (v->type == ltPair) ? v->vList.car : NULL;
}

lVal *lCdr(lVal *v){
	return (v != NULL) && (v->type == ltPair) ? v->vList.cdr : NULL;
}

lVal *lCaar(lVal *v){
	return lCar(lCar(v));
}

lVal *lCadr(lVal *v){
	return lCar(lCdr(v));
}

lVal *lCdar(lVal *v){
	return lCdr(lCar(v));
}

lVal *lCddr(lVal *v){
	return lCdr(lCdr(v));
}

lVal *lCadar(lVal *v){
	return lCar(lCdr(lCar(v)));
}

lVal *lCaddr(lVal *v){
	return lCar(lCdr(lCdr(v)));
}

lVal *lCdddr(lVal *v){
	return lCdr(lCdr(lCdr(v)));
}

int lListLength(lVal *v){
	int i = 0;
	for(lVal *n = v;(n != NULL) && (lCar(n) != NULL); n = lCdr(n)){i++;}
	return i;
}

int lSymCmp(const lVal *a,const lVal *b){
	if((a == NULL) || (b == NULL)){return 2;}
	if((a->type != ltSymbol) || (b->type != ltSymbol) || (a->vCdr == 0)){return 2;}
	return a->vCdr == b->vCdr ? 0 : -1;
}

int lSymEq(const lSymbol *a,const lSymbol *b){
	return a == b ? 0 : -1;
}

lVal *lConst(lVal *v){
	v->flags |= lfConst;
	return v;
}