void potion_dump(Potion *P, PN data) {
PN pd = potion_send(data, PN_string);
PN pt = potion_send(PN_VTABLE(PN_TYPE(data)), PN_string);
char *d = pd ? PN_STR_PTR(pd) : "nil";
char *t = pt ? PN_STR_PTR(pt) : "NilKind";
printf("%s (%s)\n", d, t);
}
void potion_test_sig(CuTest *T) {
// test the simple parser entry point yy_sig, not the compiler transformation potion_sig_compile
PN sig = potion_sig(P, "num1=N,num2=N");
CuAssert(T, "signature isn't a tuple", PN_IS_TUPLE(sig));
CuAssertIntEquals(T, "len=2", 2, PN_INT(PN_TUPLE_LEN(sig)));
CuAssertIntEquals(T, "arity=2", 2, potion_sig_arity(P, sig));
CuAssertStrEquals(T, "num1=N,num2=N", //roundtrip
PN_STR_PTR(potion_sig_string(P,0,sig)));
CuAssertStrEquals(T, "(num1, 78, num2, 78)",
PN_STR_PTR(potion_send(sig, PN_string)));
CuAssertStrEquals(T, "num1",
PN_STR_PTR(potion_send(PN_TUPLE_AT(sig,0), PN_string)));
CuAssertIntEquals(T, "num1=N", 'N',
PN_INT(PN_TUPLE_AT(sig,1)));
CuAssertStrEquals(T, "num2",
PN_STR_PTR(potion_send(PN_TUPLE_AT(sig,2), PN_string)));
CuAssertIntEquals(T, "num2=N", 'N',
PN_INT(PN_TUPLE_AT(sig,3)));
sig = potion_sig(P, "x=N|y=N");
CuAssertStrEquals(T, "(x, 78, 124, y, 78)",
PN_STR_PTR(potion_send(sig, PN_string)));
CuAssertIntEquals(T, "arity=2", 2, potion_sig_arity(P, sig));
sig = potion_sig(P, "x=N,y=N|r=N");
CuAssert(T, "signature isn't a tuple", PN_IS_TUPLE(sig));
CuAssertStrEquals(T, "(x, 78, y, 78, 124, r, 78)",
PN_STR_PTR(potion_send(sig, PN_string)));
CuAssertStrEquals(T, "x=N,y=N|r=N",
PN_STR_PTR(potion_sig_string(P,0,sig)));
CuAssertIntEquals(T, "arity=3", 3, potion_sig_arity(P, sig));
{
// roundtrips
char *sigs[] = {
"", "x,y", "x", "x=N", "x,y", "x=N,y=o",
"x|y", "x|y,z", "x=o|y,z", "x|y=o", "x=N,y=N|r=N", /*optional */
"x:=1", "|x:=1", "x|y:=0", /* defaults */
"x,y.z", /* the dot */
};
int size = sizeof(sigs)/sizeof(char *);
int i;
for (i=0; i< size; i++) {
CuAssertStrEquals(T, sigs[i],
PN_STR_PTR(potion_sig_string(P,0,potion_sig(P, sigs[i]))));
}
}
CuAssertIntEquals(T, "arity nil", 0, potion_sig_arity(P, PN_NIL));
// sig "" returns PN_FALSE, which throws an error
//CuAssertIntEquals(T, "arity ''", 0, potion_sig_arity(P, potion_sig(P, "")));
CuAssertIntEquals(T, "arity x:=1", 1, potion_sig_arity(P, potion_sig(P, "x:=1")));
CuAssertIntEquals(T, "arity |x:=1", 1, potion_sig_arity(P, potion_sig(P, "|x:=1")));
CuAssertIntEquals(T, "arity x|y:=1", 2, potion_sig_arity(P, potion_sig(P, "x|y:=1")));
}
void potion_load_code(Potion *P, const char *filename)
{
PN buf, code;
struct stat stats;
int fd = -1;
if (stat(filename, &stats) == -1)
{
potion_notice("** %s does not exist.\n", filename);
return;
}
fd = open(filename, O_RDONLY | O_BINARY);
if (fd == -1)
{
potion_notice("** could not open %s. check permissions.\n", filename);
return;
}
buf = potion_bytes(P, stats.st_size);
if (read(fd, PN_STR_PTR(buf), stats.st_size) == stats.st_size)
{
PN_STR_PTR(buf)[stats.st_size] = '\0';
code = potion_source_load(P, PN_NIL, buf);
if (!PN_IS_PROTO(code))
{
potion_run(P,
potion_send(
potion_parse(P, buf), PN_compile, potion_str(P, filename), PN_NIL),
POTION_JIT);
}
}
else
{
potion_notice("** could not read entire file: %s.\n", filename);
}
close(fd);
}
void potion_test_empty(CuTest *T) {
PN empty = PN_TUP0();
CuAssert(T, "empty isn't a tuple", PN_IS_TUPLE(empty));
CuAssert(T, "empty isn't a ref", PN_IS_PTR(empty));
CuAssertIntEquals(T, "tuple length is off",
0, PN_INT(potion_send(empty, potion_str(P, "length"))));
}
/**\memberof PNFile
\c "write" a binary representation of obj to the file handle.
\param obj PNString, PNBytes, PNInteger (long or double), PNBoolean (char 0 or 1)
\return PNInteger written bytes or PN_NIL */
PN potion_file_write(Potion *P, PN cl, pn_file self, PN obj) {
long len = 0;
char *ptr = NULL;
union { double d; long l; char c; } tmp;
//TODO: maybe extract ptr+len to seperate function
if (!PN_IS_PTR(obj)) {
if (!obj) return PN_NIL; //silent
else if (PN_IS_INT(obj)) {
tmp.l = PN_NUM(obj); len = sizeof(tmp); ptr = (char *)&tmp.l;
}
else if (PN_IS_BOOL(obj)) {
tmp.c = (obj == PN_TRUE) ? 1 : 0; len = 1; ptr = (char *)&tmp.c;
}
else {
assert(0 && "Invalid primitive type");
}
} else {
switch (PN_TYPE(obj)) {
case PN_TSTRING: len = PN_STR_LEN(obj); ptr = PN_STR_PTR(obj); break;
case PN_TBYTES: len = potion_send(obj, PN_STR("length")); ptr = PN_STR_PTR(obj); break;
case PN_TNUMBER: {
tmp.d = PN_DBL(obj); len = sizeof(tmp); ptr = (char *)&tmp.d;
break;
}
default: return potion_type_error(P, obj);
}
}
int r = write(self->fd, ptr, len);
if (r == -1)
return potion_io_error(P, "write");
return PN_NUM(r);
}
void potion_test_int1(CuTest *T) {
PN zero = PN_ZERO;
CuAssert(T, "zero isn't zero", PN_INT(zero) == 0);
CuAssert(T, "zero isn't a number", PN_IS_INT(zero));
CuAssert(T, "zero is a ref", !PN_IS_PTR(zero));
CuAssert(T, "zero bad add",
490 == PN_INT(potion_send(zero, potion_str(P, "+"), num)));
}
void potion_test_int3(CuTest *T) {
PN neg = PN_NUM(-4343);
CuAssert(T, "negative numbers invalid", PN_INT(neg) == -4343);
CuAssert(T, "negative not a number", PN_IS_INT(neg));
CuAssert(T, "negative is a ref", !PN_IS_PTR(neg));
CuAssert(T, "negative bad add",
-3853 == PN_INT(potion_send(neg, potion_str(P, "+"), num)));
}
static inline char *potion_type_name(Potion *P, PN obj) {
obj = potion_fwd(obj);
return PN_IS_PTR(obj)
? AS_STR(potion_send(PN_VTABLE(PN_TYPE(obj)), PN_string))
: PN_IS_NIL(obj) ? "nil"
: PN_IS_NUM(obj) ? "Number"
: "Boolean";
}
void potion_test_int2(CuTest *T) {
PN pos = PN_NUM(10891);
CuAssert(T, "positive numbers invalid", PN_INT(pos) == 10891);
CuAssert(T, "positive not a number", PN_IS_INT(pos));
CuAssert(T, "positive is a ref", !PN_IS_PTR(pos));
CuAssert(T, "positive bad add",
11381 == PN_INT(potion_send(pos, potion_str(P, "+"), num)));
}
void potion_test_tuple(CuTest *T) {
PN tup = potion_tuple_with_size(P, 3);
PN_TUPLE_AT(tup, 0) = PN_NIL;
PN_TUPLE_AT(tup, 1) = PN_string;
PN_TUPLE_AT(tup, 2) = tup;
CuAssert(T, "tuple isn't a tuple", PN_IS_TUPLE(tup));
CuAssert(T, "tuple isn't a ref", PN_IS_PTR(tup));
CuAssertIntEquals(T, "tuple length is off",
3, PN_INT(potion_send(tup, potion_str(P, "length"))));
}
void potion_file_init(Potion *P) {
PN file_vt = PN_VTABLE(PN_TFILE);
char **env = environ, *key;
PN pe = potion_table_empty(P);
while (*env != NULL) {
for (key = *env; *key != '='; key++);
potion_table_put(P, PN_NIL, pe, potion_str2(P, *env, key - *env),
potion_str(P, key + 1));
env++;
}
potion_send(P->lobby, PN_def, potion_str(P, "Env"), pe);
potion_method(P->lobby, "read", potion_lobby_read, 0);
potion_type_constructor_is(file_vt, PN_FUNC(potion_file_new, "path=S,mode=S"));
potion_class_method(file_vt, "fd", potion_file_with_fd, "fd=N");
potion_method(file_vt, "string", potion_file_string, 0);
potion_method(file_vt, "close", potion_file_close, 0);
potion_method(file_vt, "read", potion_file_read, "n=N");
potion_method(file_vt, "write", potion_file_write, "str=S");
}
void potion_test_nil(CuTest *T) {
CuAssert(T, "nil isn't a nil type", PN_TYPE(PN_NIL) == PN_TNIL);
CuAssert(T, "nil is a ref", !PN_IS_PTR(PN_NIL));
CuAssert(T, "nil nil? is false",
PN_TRUE == potion_send(PN_NIL, potion_str(P, "nil?")));
}
static void potion_cmd_compile
(
char *filename,
int exec,
int verbose,
void *sp
)
{
PN buf, code;
int fd = -1;
struct stat stats;
Potion *P = potion_create(sp);
if (stat(filename, &stats) == -1)
{
potion_warn("** %s does not exist.\n", filename);
goto done;
}
fd = open(filename, O_RDONLY | O_BINARY);
if (fd == -1)
{
potion_warn("** could not open %s. check permissions.\n", filename);
goto done;
}
buf = potion_bytes(P, stats.st_size);
if (read(fd, PN_STR_PTR(buf), stats.st_size) == stats.st_size)
{
PN_STR_PTR(buf)[stats.st_size] = '\0';
code = potion_source_load(P, PN_NIL, buf);
if (PN_IS_PROTO(code))
{
if (verbose > 1)
printf("\n\n-- loaded --\n");
}
else
{
code = potion_parse(P, buf);
if (PN_TYPE(code) == PN_TERROR)
{
potion_send(potion_send(code, PN_string), PN_print);
goto done;
}
if (verbose > 1)
{
printf("\n-- parsed --\n");
potion_send(potion_send(code, PN_string), PN_print);
printf("\n");
}
code =
potion_send(code, PN_compile, potion_str(P, filename), PN_NIL);
if (verbose > 1)
printf("\n-- compiled --\n");
}
if (verbose > 1)
{
potion_send(potion_send(code, PN_string), PN_print);
printf("\n");
}
if (exec == 1)
{
code = potion_vm(P, code, P->lobby, PN_NIL, 0, NULL );
if (verbose > 1)
printf(
"\n-- vm returned %p (fixed=%ld, actual=%ld, reserved=%ld) --\n",
(void *) code, PN_INT(potion_gc_fixed(P, 0, 0)),
PN_INT(potion_gc_actual(P, 0, 0)),
PN_INT(potion_gc_reserved(P, 0, 0)));
if (verbose)
{
potion_send(potion_send(code, PN_string), PN_print);
printf("\n");
}
}
else if (exec == 2)
{
#if POTION_JIT == 1
PN val;
PN cl = potion_closure_new(P, (PN_F)potion_jit_proto(P, code, POTION_JIT_TARGET), PN_NIL, 1);
PN_CLOSURE(cl)->data[0] = code;
val = PN_PROTO(code)->jit(P, cl, P->lobby);
if (verbose > 1)
printf("\n-- jit returned %p (fixed=%ld, actual=%ld, reserved=%ld) --\n", PN_PROTO(code)->jit,
PN_INT(potion_gc_fixed(P, 0, 0)), PN_INT(potion_gc_actual(P, 0, 0)),
PN_INT(potion_gc_reserved(P, 0, 0)));
if (verbose)
{
potion_send(potion_send(val, PN_string), PN_print);
printf("\n");
}
#else
potion_warn("** potion built without JIT support\n");
#endif
}
else
{
char pnbpath[255];
FILE *pnb;
sprintf(pnbpath, "%sb", filename);
pnb = fopen(pnbpath, "wb");
if (!pnb)
{
potion_warn("** could not open %s for writing. check permissions.\n",pnbpath);
goto done;
}
code = potion_source_dump(P, PN_NIL, code);
if (fwrite(PN_STR_PTR(code), 1, PN_STR_LEN(code),
pnb) == PN_STR_LEN(code))
{
potion_notice("** compiled code saved to %s\n", pnbpath);
potion_notice("** run it with: potion %s\n", pnbpath);
fclose(pnb);
}
else
{
potion_warn("** could not write all bytecode.\n");
}
}
#if 0
void *scanptr = (void *)((char *)P->mem->old_lo + (sizeof(PN) * 2));
while ((PN)scanptr < (PN)P->mem->old_cur)
{
printf("%p.vt = %lx (%u)\n",
scanptr, ((struct PNObject *)scanptr)->vt,
potion_type_size(P, scanptr));
if (((struct PNFwd *)scanptr)->fwd != POTION_FWD && ((struct PNFwd *)scanptr)->fwd != POTION_COPIED)
{
if (((struct PNObject *)scanptr)->vt < 0 || ((struct PNObject *)scanptr)->vt > PN_TUSER)
{
printf("wrong type for allocated object: %p.vt = %lx\n",
scanptr, ((struct PNObject *)scanptr)->vt);
break;
}
}
scanptr = (void *)((char *)scanptr + potion_type_size(P, scanptr));
if ((PN)scanptr > (PN)P->mem->old_cur)
{
printf("allocated object goes beyond GC pointer\n");
break;
}
}
#endif
}
else
{
potion_warn("** could not read entire file.");
}
done: if (fd != -1)
close(fd);
if (P != NULL )
potion_destroy(P);
}
static void potion_init(Potion *P) {
PN vtable, obj_vt;
P->lobby = potion_type_new(P, PN_TLOBBY, 0);
vtable = potion_type_new(P, PN_TVTABLE, P->lobby);
obj_vt = potion_type_new(P, PN_TOBJECT, P->lobby);
potion_type_new(P, PN_TNIL, obj_vt);
potion_type_new(P, PN_TNUMBER, obj_vt);
potion_type_new(P, PN_TBOOLEAN, obj_vt);
potion_type_new(P, PN_TSTRING, obj_vt);
potion_type_new(P, PN_TTABLE, obj_vt);
potion_type_new(P, PN_TCLOSURE, obj_vt);
potion_type_new(P, PN_TTUPLE, obj_vt);
potion_type_new(P, PN_TFILE, obj_vt);
potion_type_new(P, PN_TSTATE, obj_vt);
potion_type_new(P, PN_TSOURCE, obj_vt);
potion_type_new(P, PN_TBYTES, obj_vt);
potion_type_new(P, PN_TPROTO, obj_vt);
potion_type_new(P, PN_TWEAK, obj_vt);
potion_type_new(P, PN_TLICK, obj_vt);
potion_type_new(P, PN_TERROR, obj_vt);
potion_type_new(P, PN_TCONT, obj_vt);
potion_type_new(P, PN_TDECIMAL, obj_vt);
potion_str_hash_init(P);
PN_STR0 = PN_STRN("", 0);
PN_add = PN_STRN("+", 1);
PN_sub = PN_STRN("-", 1);
PN_mult = PN_STRN("*", 1);
PN_div = PN_STRN("/", 1);
PN_rem = PN_STRN("%", 1);
PN_bitn = PN_STRN("~", 1);
PN_bitl = PN_STRN("<<", 2);
PN_bitr = PN_STRN(">>", 2);
PN_if = PN_STRN("if", 2);
PN_def = PN_STRN("def", 3);
PN_cmp = PN_STRN("cmp", 3);
PN_call = PN_STRN("call", 4);
PN_else = PN_STRN("else", 4);
PN_loop = PN_STRN("loop", 4);
PN_self = PN_STRN("self", 4);
PN_name = PN_STRN("name", 4);
PN_size = PN_STRN("size", 4);
PN_break = PN_STRN("break", 5);
PN_class = PN_STRN("class", 5);
PN_elsif = PN_STRN("elsif", 5);
PN_print = PN_STRN("print", 5);
PN_while = PN_STRN("while", 5);
PN_length = PN_STRN("length", 6);
PN_return = PN_STRN("return", 6);
PN_string = PN_STRN("string", 6);
PN_lookup = PN_STRN("lookup", 6);
PN_number = PN_STRN("number", 6);
PN_compile = PN_STRN("compile", 7);
PN_allocate = PN_STRN("allocate", 8);
PN_continue = PN_STRN("continue", 8);
PN_delegated = PN_STRN("delegated", 9);
potion_def_method(P, 0, vtable, PN_lookup, PN_FUNC(potion_lookup, 0));
potion_def_method(P, 0, vtable, PN_def, PN_FUNC(potion_def_method, "name=S,block=&"));
potion_send(vtable, PN_def, PN_allocate, PN_FUNC(potion_allocate, 0));
potion_send(vtable, PN_def, PN_delegated, PN_FUNC(potion_delegated, 0));
potion_vm_init(P);
potion_lobby_init(P);
potion_object_init(P);
potion_error_init(P);
#ifndef DISABLE_CALLCC
potion_cont_init(P);
#endif
potion_primitive_init(P);
potion_num_init(P);
potion_str_init(P);
potion_table_init(P);
potion_source_init(P);
potion_lick_init(P);
potion_compiler_init(P);
#ifndef SANDBOX
potion_file_init(P);
potion_loader_init(P);
#endif
pn_filenames = PN_TUP0();
GC_PROTECT(P);
}
// say
void potion_p(Potion *P, PN x) {
potion_send(potion_send(x, PN_string), PN_print);
printf("\n");
}
void potion_test_str(CuTest *T) {
CuAssert(T, "string isn't a string", PN_IS_STR(PN_string));
CuAssert(T, "string isn't a ref", PN_IS_PTR(PN_string));
CuAssert(T, "string length isn't working",
6 == PN_INT(potion_send(PN_string, potion_str(P, "length"))));
}
/**\memberof PNFile
\c "print" a stringification of any object to the filehandle.
Note that \c write prints the binary value of the object.
\param obj any
\return "" or PNError */
PN potion_file_print(Potion *P, PN cl, pn_file self, PN obj) {
PN r = potion_file_write(P, cl, self, potion_send(obj, PN_string));
return PN_IS_INT(r) ? PN_STR0 : r;
}
