shithub: lpa

ref: 2b23d05d57743af57385cd42c0fd2d223b11d8c8
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 */

/* niladic functions */
static Array *primfn_var(void);

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

static Array *primfn_assert(Array *);
static Array *primfn_allsolutions(Array *);
static Array *primfn_solve(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[] = {
	[PRight] = {
		"⊢", NameclassFunc, nil, primfn_same, primfn_right
	},
	[PLeft] = {
		"⊣", NameclassFunc, nil, primfn_same, primfn_left,
	},
	[PPlus] = {
		"+", NameclassFunc, nil, nil, nil
	},
	[PMinus] = {
		"-", NameclassFunc, nil, nil, nil
	},
	[PRho] = {
		"⍴", NameclassFunc, nil, primfn_shape, nil
	},
	[PMatch] = {
		"≡", NameclassFunc, nil, nil, primfn_match
	},

	/* Constraint stuff. Pick glyphs for them later */
	[PAssert] = {
		"⎕assert",	NameclassFunc, nil, primfn_assert, nil
	},
	[PAll] = {
		"⎕all",		NameclassFunc, nil, primfn_allsolutions, nil
	},
	[PSolve] = {
		"⎕solve",	NameclassFunc, nil, primfn_solve, nil
	},
	[PVar] = {
		"⎕var",		NameclassFunc, primfn_var, nil, nil
	}
};

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].nilad)
		valence |= Niladic;
	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)
{
	Array *(*fn)(void) = primspecs[id].nilad;
	if(fn == nil)
		error(EInternal, "primitive %s has no niladic definition", primsymb(id));
	return fn();	
}

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

	if(gettype(y) == TypeVar && !(id == PAssert || id == PSolve))
		return delayedexpr(id, nil, y);

	return fn(y);
}

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

	if(gettype(x) == TypeVar || gettype(y) == TypeVar)
		return delayedexpr(id, x, y);

	return fn(x, y);	
}

/* niladic functions */
static Array *
primfn_var(void)
{
	return allocvar(nil);
}

/* 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;
}

static Array *
primfn_assert(Array *y)
{
	if(gettype(y) != TypeVar || getrank(y) != 0)
		error(EDomain, "⎕assert expected a single constraint expression");
	constrain(getvar(y, 0));
	Array *r = allocarray(TypeNumber, 0, 1);
	setint(r, 0, 0);
	return r;
}

static Array *
primfn_allsolutions(Array *)
{
	error(EInternal, "⎕all should never be evaluated");
}

static Array *
primfn_solve(Array *y)
{
	if(gettype(y) != TypeVar || getrank(y) != 0)
		error(EDomain, "expected single contraint variable");
	return solve(getvar(y, 0));
}

/* 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;
}