shithub: lpa

ref: 1da09c81867fc8416f99b8d7a24d73b2e3acf6e6
dir: /prim.c/

#include <u.h>
#include <libc.h>
#include <thread.h>

#include "dat.h"
#include "fns.h"

/* NOTE: In LPA, system functions are treated as primitives as well */

/* monadic functions */
static Array *primfn_same(Array *);
static Array *primfn_shape(Array *);

/* dyadic functions */
static Array *primfn_left(Array *, Array *);
static Array *primfn_right(Array *, Array *);
static Array *primfn_match(Array *, Array *);

struct {
	char *spelling;
	int nameclass;
	Array *(*nilad)(void);
	Array *(*monad)(Array *);
	Array *(*dyad)(Array *, Array *);
} primspecs[] = {
	"⊢", NameclassFunc, nil, primfn_same, primfn_right,
	"⊣", NameclassFunc, nil, primfn_same, primfn_left,
	"+", NameclassFunc, nil, nil, nil,
	"-", NameclassFunc, nil, nil, nil,
	"⍴", NameclassFunc, nil, primfn_shape, nil,
	"≡", NameclassFunc, nil, nil, primfn_match,
};

char *
primsymb(int id)
{
	return primspecs[id].spelling;
}

int
primclass(int id)
{
	return primspecs[id].nameclass;
}

int
primvalence(int id)
{
	int valence = 0;
	if(primspecs[id].monad)
		valence |= Monadic;
	if(primspecs[id].dyad)
		valence |= Dyadic;
	return valence;
}

int
primid(char *s)
{
	for(int i = 0; i < nelem(primspecs); i++){
		char *x = primspecs[i].spelling;
		if(strncmp(s, x, strlen(x)) == 0)
			return i;
	}
	return -1;
}

Array *
primnilad(int id)
{
	if(primspecs[id].nilad)
		return primspecs[id].nilad();
	else
		error(EInternal, "primitive %s has no niladic definition", primsymb(id));
}

Array *
primmonad(int id, Array *y)
{
	if(primspecs[id].monad)
		return primspecs[id].monad(y);
	else
		error(EInternal, "primitive %s has no monadic definition", primsymb(id));
}

Array *
primdyad(int id, Array *x, Array *y)
{
	if(primspecs[id].dyad)
		return primspecs[id].dyad(x, y);
	else
		error(EInternal, "primitive %s has no dyadic definition", primsymb(id));
}

/* monadic functions */
static Array *
primfn_same(Array *a)
{
	return a;
}

static Array *
primfn_shape(Array *a)
{
	Array *r;
	int rank;

	rank = getrank(a);
	r = allocarray(TypeNumber, 1, rank);
	for(int dim = 0; dim < rank; dim++)
		setint(r, dim, getshape(a, dim));
	return r;
}

/* dyadic functions */
static Array *
primfn_left(Array *x, Array *)
{
	return x;
}

static Array *
primfn_right(Array *, Array *y)
{
	return y;
}

static int
matches(Array *x, Array *y)
{
	int res = 0;
	usize size = 1;
	int type = gettype(x);

	if(gettype(x) != gettype(y))
		goto no;
	if(getrank(x) != getrank(y))
		goto no;
	for(int dim = 0; dim < getrank(x); dim++){
		if(getshape(x, dim) != getshape(y, dim))
			goto no;
		size *= getshape(x, dim);
	}

	for(usize i = 0; i < size; i++){
		switch(type){
		case TypeNumber:
			if(getint(x, i) != getint(y, i))
				goto no;
			break;
		case TypeChar:
			if(getchar(x, i) != getchar(y, i))
				goto no;
			break;
		case TypeArray:
			if(!matches(getarray(x, i), getarray(y, i))) /* TODO: RECURSION */
				goto no;
			/* TODO: that means we can save space by making them
			 * point to the same thing :)
			 */
			break;
		default:
			error(EInternal, "unknown element type");
		}
	}

	res = 1;
no:
	return res;
}

static Array *
primfn_match(Array *x, Array *y)
{
	Array *z = allocarray(TypeNumber, 0, 1);
	setint(z, 0, matches(x, y));
	return z;
}