From 2ad801305cf5e114a6d5c2169fb0dc4c27bb9c24 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Tue, 9 Jul 2019 17:14:05 +1200 Subject: [PATCH 01/67] Keep ANY in stack memory --- runtime/purescript.c | 278 ++++++----- runtime/purescript.h | 481 ++++++++++--------- src/Language/PureScript/CodeGen/C.purs | 2 +- src/Language/PureScript/CodeGen/C/File.purs | 6 +- src/Language/PureScript/CodeGen/Runtime.purs | 16 +- 5 files changed, 390 insertions(+), 393 deletions(-) diff --git a/runtime/purescript.c b/runtime/purescript.c index 428c5c3..7d4bab7 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -28,89 +28,89 @@ const managed_t * managed_new (const void * data, // Any: allocate // ----------------------------------------------------------------------------- -inline const ANY * purs_any_int_new(const purs_any_int_t i) { - ANY * v = purs_new(ANY); - v->tag = PURS_ANY_TAG_INT; - v->value.i = i; +inline ANY purs_any_int_new(const purs_any_int_t i) { + ANY v; + v.tag = PURS_ANY_TAG_INT; + v.value.i = i; return v; } -inline const ANY * purs_any_num_new(const purs_any_num_t n) { - ANY * v = purs_new(ANY); - v->tag = PURS_ANY_TAG_NUM; - v->value.n = n; +inline ANY purs_any_num_new(const purs_any_num_t n) { + ANY v; + v.tag = PURS_ANY_TAG_NUM; + v.value.n = n; return v; } -inline const ANY * purs_any_cont_new(const void * ctx, purs_any_fun_t * fn) { - ANY * v = purs_new(ANY); - v->tag = PURS_ANY_TAG_CONT; - v->value.cont.fn = fn; - v->value.cont.ctx = ctx; +inline ANY purs_any_cont_new(const void * ctx, purs_any_fun_t * fn) { + ANY v; + v.tag = PURS_ANY_TAG_CONT; + v.value.cont.fn = fn; + v.value.cont.ctx = ctx; return v; } -inline const ANY * purs_any_thunk_new(const void * ctx, purs_any_thunk_fun_t * fn) { - ANY * v = purs_new(ANY); - v->tag = PURS_ANY_TAG_THUNK; - v->value.thunk.ctx = ctx; - v->value.thunk.fn = fn; +inline ANY purs_any_thunk_new(const void * ctx, purs_any_thunk_fun_t * fn) { + ANY v; + v.tag = PURS_ANY_TAG_THUNK; + v.value.thunk.ctx = ctx; + v.value.thunk.fn = fn; return v; } -inline const ANY * purs_any_cons_new(int tag, const ANY ** values) { - ANY * v = purs_new(ANY); - v->tag = PURS_ANY_TAG_CONS; - v->value.cons.tag = tag; - v->value.cons.values = values; +inline ANY purs_any_cons_new(int tag, ANY* values) { + ANY v; + v.tag = PURS_ANY_TAG_CONS; + v.value.cons.tag = tag; + v.value.cons.values = values; return v; } -inline const ANY * purs_any_record_new(const purs_record_t * record) { - ANY * v = purs_new(ANY); - v->tag = PURS_ANY_TAG_RECORD; - v->value.record = record; +inline ANY purs_any_record_new(const purs_record_t * record) { + ANY v; + v.tag = PURS_ANY_TAG_RECORD; + v.value.record = record; return v; } -inline const ANY * purs_any_string_new_mv(const char * ptr) { - ANY * v = purs_new(ANY); - v->tag = PURS_ANY_TAG_STRING; - v->value.str = managed_new(ptr, managed_noop_release); +inline ANY purs_any_string_new_mv(const char * ptr) { + ANY v; + v.tag = PURS_ANY_TAG_STRING; + v.value.str = managed_new(ptr, managed_noop_release); return v; } -inline const ANY * purs_any_string_new(const char * fmt, ...) { - ANY * v = purs_new(ANY); - v->tag = PURS_ANY_TAG_STRING; +inline ANY purs_any_string_new(const char * fmt, ...) { + ANY v; + v.tag = PURS_ANY_TAG_STRING; va_list ap; char *ptr; va_start(ap, fmt); assert (vasprintf(&ptr, fmt, ap) >= 0); va_end(ap); - v->value.str = managed_new(ptr, NULL); + v.value.str = managed_new(ptr, NULL); return v; } -inline const ANY * purs_any_char_new(utf8_int32_t chr) { - ANY * v = purs_new(ANY); - v->tag = PURS_ANY_TAG_CHAR; - v->value.chr = chr; +inline ANY purs_any_char_new(utf8_int32_t chr) { + ANY v; + v.tag = PURS_ANY_TAG_CHAR; + v.value.chr = chr; return v; } -inline const ANY * purs_any_array_new(const purs_vec_t * array) { - ANY * v = purs_new(ANY); - v->tag = PURS_ANY_TAG_ARRAY; - v->value.array = array; +inline ANY purs_any_array_new(const purs_vec_t * array) { + ANY v; + v.tag = PURS_ANY_TAG_ARRAY; + v.value.array = array; return v; } -inline const ANY * purs_any_foreign_new(void * tag, void * data) { - ANY * v = purs_new(ANY); - v->tag = PURS_ANY_TAG_FOREIGN; - v->value.foreign.tag = tag; - v->value.foreign.data = data; +inline ANY purs_any_foreign_new(void * tag, void * data) { + ANY v; + v.tag = PURS_ANY_TAG_FOREIGN; + v.value.foreign.tag = tag; + v.value.foreign.data = data; return v; } @@ -137,87 +137,80 @@ inline const char * purs_any_tag_str (const purs_any_tag_t tag) { #define _PURS_ASSERT_TAG(TAG)\ do {\ - purs_assert(v != NULL, "expected tag: %s, but got: NULL", \ - purs_any_tag_str(TAG));\ v = purs_any_unthunk(v);\ - purs_assert(v->tag == TAG, "expected tag: %s, but got: %s",\ + purs_assert(v.tag == TAG, "expected tag: %s, but got: %s",\ purs_any_tag_str(TAG),\ - purs_any_tag_str(v->tag));\ + purs_any_tag_str(v.tag));\ } while (0) -inline const purs_any_int_t purs_any_get_int (const ANY * v) { +inline const purs_any_int_t purs_any_get_int (ANY v) { _PURS_ASSERT_TAG(PURS_ANY_TAG_INT); - return v->value.i; + return v.value.i; } -inline const purs_any_num_t purs_any_get_num (const ANY * v) { +inline const purs_any_num_t purs_any_get_num (ANY v) { _PURS_ASSERT_TAG(PURS_ANY_TAG_NUM); - return v->value.n; + return v.value.n; } -inline const purs_cont_t * purs_any_get_cont (const ANY * v) { +inline purs_any_cont_t purs_any_get_cont (ANY v) { _PURS_ASSERT_TAG(PURS_ANY_TAG_CONT); - return (const purs_cont_t *) &v->value.cont; + return v.value.cont; } -inline const purs_cons_t * purs_any_get_cons (const ANY * v) { +inline purs_any_cons_t purs_any_get_cons (ANY v) { _PURS_ASSERT_TAG(PURS_ANY_TAG_CONS); - return (const purs_cons_t *) &v->value.cons; + return v.value.cons; } -inline const purs_record_t * purs_any_get_record (const ANY * v) { +inline const purs_record_t * purs_any_get_record (ANY v) { _PURS_ASSERT_TAG(PURS_ANY_TAG_RECORD); - return v->value.record; + return v.value.record; } -inline const void * purs_any_get_string (const ANY * v) { +inline const void * purs_any_get_string (ANY v) { _PURS_ASSERT_TAG(PURS_ANY_TAG_STRING); - return v->value.str->data; + return v.value.str->data; } -inline const utf8_int32_t purs_any_get_char (const ANY * v) { +inline const utf8_int32_t purs_any_get_char (ANY v) { _PURS_ASSERT_TAG(PURS_ANY_TAG_CHAR); - return v->value.chr; + return v.value.chr; } -inline const purs_vec_t * purs_any_get_array (const ANY * v) { +inline const purs_vec_t * purs_any_get_array (ANY v) { _PURS_ASSERT_TAG(PURS_ANY_TAG_ARRAY); - return v->value.array; + return v.value.array; } -inline const purs_foreign_t * purs_any_get_foreign (const ANY * v) { +inline purs_foreign_t purs_any_get_foreign (ANY v) { _PURS_ASSERT_TAG(PURS_ANY_TAG_FOREIGN); - return (const purs_foreign_t *) &v->value.foreign; + return v.value.foreign; } // ----------------------------------------------------------------------------- // Any // ----------------------------------------------------------------------------- -inline const ANY * purs_any_unthunk (const ANY * x) { - const ANY * tmp; - const ANY * out = (ANY *) x; - while (out != NULL && out->tag == PURS_ANY_TAG_THUNK) { - tmp = out->value.thunk.fn(out->value.thunk.ctx); - purs_assert(tmp != out, "infinite unthunk loop"); - out = tmp; +inline ANY purs_any_unthunk (ANY x) { + ANY out = x; + while (out.tag == PURS_ANY_TAG_THUNK) { + out = out.value.thunk.fn(out.value.thunk.ctx); } - return (const ANY *) out; + return out; } -inline const purs_any_tag_t purs_any_get_tag (const ANY * v) { - return v->tag; +inline const purs_any_tag_t purs_any_get_tag (ANY v) { + return v.tag; } -inline const ANY * purs_any_app(const ANY * f, const ANY * v, ...) { - assert(f != NULL); +inline ANY purs_any_app(ANY f, ANY v, ...) { f = purs_any_unthunk(f); - assert(f != NULL); - assert(f->tag == PURS_ANY_TAG_CONT); + assert(f.tag == PURS_ANY_TAG_CONT); va_list args; va_start(args, v); - const ANY * r = f->value.cont.fn(f->value.cont.ctx, v, args); + ANY r = f.value.cont.fn(f.value.cont.ctx, v, args); va_end(args); return r; } @@ -226,60 +219,60 @@ inline const ANY * purs_any_app(const ANY * f, const ANY * v, ...) { // Any: built-ins // ----------------------------------------------------------------------------- -PURS_ANY_THUNK_DEF(purs_any_true, purs_any_int_new(1)); -PURS_ANY_THUNK_DEF(purs_any_false, purs_any_int_new(0)); -PURS_ANY_THUNK_DEF(purs_any_int_zero, purs_any_int_new(0)); -PURS_ANY_THUNK_DEF(purs_any_num_zero, purs_any_num_new(0.0)); -PURS_ANY_THUNK_DEF(purs_any_int_one, purs_any_int_new(1)); -PURS_ANY_THUNK_DEF(purs_any_num_one, purs_any_num_new(1.0)); -PURS_ANY_THUNK_DEF(purs_any_NaN, purs_any_num_new(PURS_NAN)); -PURS_ANY_THUNK_DEF(purs_any_infinity, purs_any_num_new(PURS_INFINITY)); -PURS_ANY_THUNK_DEF(purs_any_neg_infinity, purs_any_num_new(-PURS_INFINITY)); - -inline int purs_any_eq_char (const ANY * x, utf8_int32_t y) { + +ANY purs_any_null = { .tag = PURS_ANY_TAG_NULL }; +ANY purs_any_true = PURS_ANY_INT(1); +ANY purs_any_false = PURS_ANY_INT(0); +ANY purs_any_int_zero = PURS_ANY_INT(0); +ANY purs_any_num_zero = PURS_ANY_NUM(0.0); +ANY purs_any_int_one = PURS_ANY_INT(1); +ANY purs_any_num_one = PURS_ANY_NUM(1.0); +ANY purs_any_NaN = PURS_ANY_NUM(PURS_NAN); +ANY purs_any_infinity = PURS_ANY_NUM(PURS_INFINITY); +ANY purs_any_neg_infinity = PURS_ANY_NUM(-PURS_INFINITY); + +inline int purs_any_eq_char (ANY x, utf8_int32_t y) { return purs_any_get_char(x) == y; } -inline int purs_any_eq_string (const ANY * x, const void * str) { +inline int purs_any_eq_string (ANY x, const void * str) { return utf8cmp(purs_any_get_string(x), str) == 0; } -inline int purs_any_eq_int (const ANY * x, purs_any_int_t y) { +inline int purs_any_eq_int (ANY x, purs_any_int_t y) { return purs_any_get_int(x) == y; } -inline int purs_any_eq_num (const ANY * x, double y) { +inline int purs_any_eq_num (ANY x, double y) { return purs_any_get_num(x) == y; } -int purs_any_eq(const ANY * x, const ANY * y) { +int purs_any_eq(ANY x, ANY y) { x = purs_any_unthunk(x); y = purs_any_unthunk(y); /* special treatment for NaN on LHS */ - if (x != NULL && purs_any_is_NaN(x) && - (y->tag == PURS_ANY_TAG_NUM || y->tag == PURS_ANY_TAG_INT)) { + if (purs_any_is_NaN(x) && + (y.tag == PURS_ANY_TAG_NUM || y.tag == PURS_ANY_TAG_INT)) { return 0; } /* special treatment for NaN on RHS */ - if (y != NULL && purs_any_is_NaN(y) && - (x->tag == PURS_ANY_TAG_NUM || x->tag == PURS_ANY_TAG_INT)) { + if (purs_any_is_NaN(y) && + (x.tag == PURS_ANY_TAG_NUM || x.tag == PURS_ANY_TAG_INT)) { return 0; } - if (x == y) { - return 1; - } else if (x == NULL || y == NULL) { + if (x.tag == PURS_ANY_TAG_NULL || y.tag == PURS_ANY_TAG_NULL) { return 0; } else { purs_assert( - x->tag == y->tag, + x.tag == y.tag, "Cannot eq %s with %s", - purs_any_tag_str(x->tag), - purs_any_tag_str(y->tag)); + purs_any_tag_str(x.tag), + purs_any_tag_str(y.tag)); - switch (x->tag) { + switch (x.tag) { case PURS_ANY_TAG_INT: return purs_any_get_int(x) == purs_any_get_int(y); case PURS_ANY_TAG_NUM: @@ -297,21 +290,21 @@ int purs_any_eq(const ANY * x, const ANY * y) { /** Concatenate two dyanmic values into a new dynamic value */ -const ANY * purs_any_concat(const ANY * x, const ANY * y) { +ANY purs_any_concat(ANY x, ANY y) { x = purs_any_unthunk(x); y = purs_any_unthunk(y); - assert(x != NULL); - assert(y != NULL); + assert(x.tag != PURS_ANY_TAG_NULL); + assert(y.tag != PURS_ANY_TAG_NULL); - if (x->tag != y->tag) { + if (x.tag != y.tag) { purs_assert( 0, "cannot concat %s with %s", - purs_any_tag_str(x->tag), - purs_any_tag_str(y->tag)); + purs_any_tag_str(x.tag), + purs_any_tag_str(y.tag)); } else { - switch(x->tag) { + switch(x.tag) { case PURS_ANY_TAG_STRING: { return purs_any_string_new( "%s%s", @@ -332,15 +325,16 @@ const ANY * purs_any_concat(const ANY * x, const ANY * y) { } } default: - purs_assert(0, "cannot concat %s", purs_any_tag_str(x->tag)); + purs_assert(0, "cannot concat %s", purs_any_tag_str(x.tag)); } } } -inline const ANY * purs_any_copy(const ANY * src) { - ANY * copy = purs_new(ANY); - memcpy(copy, src, sizeof (ANY)); - return (const ANY*) copy; +inline ANY purs_any_copy(ANY src) { + ANY copy; + copy.tag = src.tag; + copy.value = src.value; + return copy; } // ----------------------------------------------------------------------------- @@ -371,10 +365,10 @@ inline const purs_vec_t * purs_vec_new () { const purs_vec_t * purs_vec_new_va (int count, ...) { int i; va_list args; - const ANY ** xs = malloc(sizeof (ANY *) * count); + ANY* xs = malloc(sizeof (ANY) * count); va_start(args, count); for (i = 0; i < count; i++) { - xs[i] = va_arg(args, const ANY *); + xs[i] = va_arg(args, ANY); } purs_vec_t * o = (purs_vec_t *) purs_vec_new(); vec_pusharr(o, xs, count); @@ -405,7 +399,7 @@ const purs_vec_t * purs_vec_slice (const purs_vec_t * vec, int begin) { const purs_vec_t * purs_vec_insert(const purs_vec_t * vec, int idx, - const ANY * val) { + ANY val) { if (vec == NULL) { return purs_vec_new_va(1, val); } else { @@ -419,7 +413,7 @@ const purs_vec_t * purs_vec_insert(const purs_vec_t * vec, // records // ----------------------------------------------------------------------------- -PURS_ANY_THUNK_DEF(purs_record_empty, purs_any_record_new(NULL)); +ANY purs_record_empty = PURS_ANY_RECORD(NULL); const purs_record_t * purs_record_copy_shallow(const purs_record_t * source) { const purs_record_t * current_entry, * tmp; @@ -444,7 +438,7 @@ static purs_record_t * _purs_record_add_multi_mut(purs_record_t * source, va_list args) { for (size_t i = 0; i < count; i++) { const void * key = va_arg(args, const void *); - const ANY * value = va_arg(args, const ANY *); + ANY value = va_arg(args, ANY); purs_record_t * entry = purs_new(purs_record_t); entry->key = managed_new(afmt("%s", key), NULL); entry->value = value; @@ -536,41 +530,41 @@ const purs_record_t * purs_record_find_by_key(const purs_record_t * record, // Code-gen helpers // ----------------------------------------------------------------------------- -inline const ANY * purs_indirect_thunk_new(const ANY ** x) { +inline ANY purs_indirect_thunk_new(ANY* x) { return purs_any_thunk_new(x, purs_thunked_deref); } -inline void purs_indirect_value_assign(const ANY ** i, const ANY * v) { +inline void purs_indirect_value_assign(ANY* i, ANY v) { *i = v; } -inline const ANY ** purs_indirect_value_new() { - return purs_new(const ANY *); +inline ANY* purs_indirect_value_new() { + return purs_new(ANY); } -inline const ANY * purs_thunked_deref(const void * data) { - const ANY ** _data = (const ANY **) data; +inline ANY purs_thunked_deref(const void * data) { + ANY* _data = (ANY*) data; return *_data; } -inline int purs_cons_get_tag (const purs_cons_t * cons) { - return cons->tag; +inline int purs_cons_get_tag (purs_any_cons_t cons) { + return cons.tag; } -inline const ANY ** _purs_scope_alloc(int num_bindings) { +inline ANY* _purs_scope_alloc(int num_bindings) { if (num_bindings == 0) return NULL; - return purs_malloc(num_bindings * sizeof (const ANY *)); + return purs_malloc(num_bindings * sizeof (ANY)); } -inline const ANY ** _purs_scope_new(int num_bindings, const ANY * binding, ...) { +inline ANY* _purs_scope_new(int num_bindings, ANY binding, ...) { if (num_bindings == 0) return NULL; - const ANY ** mem = purs_malloc(num_bindings * sizeof (const ANY *)); + ANY* mem = purs_malloc(num_bindings * sizeof (ANY)); mem[0] = binding; va_list vl; va_start(vl, binding); for (int i = 1; i < num_bindings; i++) { - mem[i] = va_arg(vl, const ANY *); + mem[i] = va_arg(vl, ANY); } va_end(vl); - return (const ANY **) mem; + return (ANY*) mem; } diff --git a/runtime/purescript.h b/runtime/purescript.h index ec81519..645e18a 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -48,16 +48,14 @@ typedef struct managed managed_t; #define managed_utf8str_t managed_t typedef struct purs_any purs_any_t; -typedef vec_t(const purs_any_t*) purs_vec_t; +typedef vec_t(purs_any_t) purs_vec_t; typedef struct purs_record purs_record_t; -typedef struct purs_cons purs_cons_t; -typedef struct purs_cont purs_cont_t; typedef struct purs_any_cont purs_any_cont_t; typedef struct purs_any_thunk purs_any_thunk_t; -typedef struct purs_cons purs_cons_t; +typedef struct purs_any_cons purs_any_cons_t; typedef union purs_any_value purs_any_value_t; -typedef const ANY * (purs_any_thunk_fun_t)(const void * ctx); -typedef const ANY * (purs_any_fun_t)(const void * ctx, const ANY *, va_list); +typedef ANY (purs_any_thunk_fun_t)(const void * ctx); +typedef ANY (purs_any_fun_t)(const void * ctx, ANY, va_list); typedef struct purs_foreign purs_foreign_t; struct managed { const void * data; }; @@ -66,7 +64,7 @@ typedef void (*managed_release_func)(managed_t * managed); const managed_t * managed_new(const void * data, managed_release_func release); typedef enum { - PURS_ANY_TAG_UNKNOWN = 0, + PURS_ANY_TAG_NULL = 0, PURS_ANY_TAG_INT = 1, PURS_ANY_TAG_NUM = 2, PURS_ANY_TAG_CONT = 3, @@ -94,9 +92,9 @@ struct purs_foreign { void * data; }; -struct purs_cons { +struct purs_any_cons { int tag; - const ANY ** values; + ANY* values; }; union purs_any_value { @@ -104,7 +102,7 @@ union purs_any_value { purs_any_num_t n; purs_any_cont_t cont; purs_any_thunk_t thunk; - purs_cons_t cons; + purs_any_cons_t cons; const purs_record_t * record; const managed_t * str; utf8_int32_t chr; @@ -117,47 +115,49 @@ struct purs_any { purs_any_value_t value; }; -const ANY * purs_any_app(const ANY *, const ANY *, ...); -const ANY * purs_any_unthunk (const ANY *); -const purs_any_tag_t purs_any_get_tag (const ANY *); +ANY purs_any_null; + +ANY purs_any_app(ANY, ANY, ...); +ANY purs_any_unthunk (ANY); +const purs_any_tag_t purs_any_get_tag (ANY); const char * purs_any_tag_str (const purs_any_tag_t); -const ANY * purs_any_int_new(const purs_any_int_t); -const ANY * purs_any_num_new(const purs_any_num_t); -const ANY * purs_any_cont_new(const void * ctx, purs_any_fun_t *); -const ANY * purs_any_thunk_new(const void * ctx, purs_any_thunk_fun_t *); -const ANY * purs_any_cons_new(int tag, const ANY ** values); -const ANY * purs_any_record_new(const purs_record_t *); -const ANY * purs_any_string_new(const char * fmt, ...); -const ANY * purs_any_char_new(utf8_int32_t); -const ANY * purs_any_array_new(const purs_vec_t *); -const ANY * purs_any_foreign_new(void * tag, void * data); +ANY purs_any_int_new(const purs_any_int_t); +ANY purs_any_num_new(const purs_any_num_t); +ANY purs_any_cont_new(const void * ctx, purs_any_fun_t *); +ANY purs_any_thunk_new(const void * ctx, purs_any_thunk_fun_t *); +ANY purs_any_cons_new(int tag, ANY* values); +ANY purs_any_record_new(const purs_record_t *); +ANY purs_any_string_new(const char * fmt, ...); +ANY purs_any_char_new(utf8_int32_t); +ANY purs_any_array_new(const purs_vec_t *); +ANY purs_any_foreign_new(void * tag, void * data); /* allocate a new string box with existing, *GC-allocated* data */ -const ANY * purs_any_string_new_mv(const char *); - -const purs_any_int_t purs_any_get_int (const ANY *); -const purs_any_num_t purs_any_get_num (const ANY *); -const purs_cont_t * purs_any_get_cont (const ANY *); -const purs_cons_t * purs_any_get_cons (const ANY *); -const purs_record_t * purs_any_get_record (const ANY *); -const void * purs_any_get_string (const ANY *); -const utf8_int32_t purs_any_get_char (const ANY *); -const purs_vec_t * purs_any_get_array (const ANY *); -const purs_foreign_t * purs_any_get_foreign (const ANY *); +ANY purs_any_string_new_mv(const char *); + +const purs_any_int_t purs_any_get_int (ANY); +const purs_any_num_t purs_any_get_num (ANY); +purs_any_cont_t purs_any_get_cont (ANY); +purs_any_cons_t purs_any_get_cons (ANY); +const purs_record_t * purs_any_get_record (ANY); +const void * purs_any_get_string (ANY); +const utf8_int32_t purs_any_get_char (ANY); +const purs_vec_t * purs_any_get_array (ANY); +purs_foreign_t purs_any_get_foreign (ANY); // ----------------------------------------------------------------------------- // Any: built-in functions // ----------------------------------------------------------------------------- -int purs_any_eq_string (const ANY *, const void *); -int purs_any_eq_char (const ANY *, utf8_int32_t); -int purs_any_eq_int (const ANY *, purs_any_int_t); -int purs_any_eq_num (const ANY *, double); +int purs_any_eq_string (ANY, const void *); +int purs_any_eq_char (ANY, utf8_int32_t); +int purs_any_eq_int (ANY, purs_any_int_t); +int purs_any_eq_num (ANY, double); -int purs_any_eq(const ANY *, const ANY *); -const ANY * purs_any_concat(const ANY *, const ANY *); -const ANY * purs_any_copy(const ANY *); +int purs_any_eq(ANY, ANY); +ANY purs_any_concat(ANY, ANY); +ANY purs_any_copy(ANY); // ----------------------------------------------------------------------------- // strings @@ -197,7 +197,7 @@ const purs_vec_t * purs_vec_slice (const purs_vec_t *, int begin); * Insert the value val at index idx shifting the elements after the index to * make room for the new value. */ -const purs_vec_t * purs_vec_insert(const purs_vec_t *, int idx, const ANY * val); +const purs_vec_t * purs_vec_insert(const purs_vec_t *, int idx, ANY val); // ----------------------------------------------------------------------------- // records @@ -205,12 +205,12 @@ const purs_vec_t * purs_vec_insert(const purs_vec_t *, int idx, const ANY * val) typedef struct purs_record { const managed_utf8str_t * key; - const ANY * value; + ANY value; UT_hash_handle hh; } purs_record_t; // TODO: rename to 'purs_any_record_empty' -const ANY * purs_record_empty; +ANY purs_record_empty; /** * Create a shallow copy of the given record. @@ -274,10 +274,10 @@ purs_record_add_multi(NULL, count, __VA_ARGS__) // ----------------------------------------------------------------------------- /* thunked pointer dereference. useful for recursive bindings */ -const ANY ** purs_indirect_value_new(); -void purs_indirect_value_assign(const ANY **, const ANY *); -const ANY * purs_indirect_thunk_new(const ANY **); -const ANY * purs_thunked_deref(const void * data); +ANY* purs_indirect_value_new(); +void purs_indirect_value_assign(ANY*, ANY); +ANY purs_indirect_thunk_new(ANY*); +ANY purs_thunked_deref(const void * data); #define purs_any_int_neg(X) purs_any_int_new(-purs_any_get_int(X)) #define purs_any_int_set_mut(X, V) do { X->value.i = V; } while (0) @@ -288,23 +288,25 @@ const ANY * purs_thunked_deref(const void * data); } while (0) /* code-gen helper to allocate and fill a scope. - * assumes scope to consist only of (const ANY *) pointers, the count of which + * assumes scope to consist only of (ANY) pointers, the count of which * is known. */ -const ANY ** _purs_scope_alloc(int num_bindings); -const ANY ** _purs_scope_new(int num_bindings, const ANY * binding, ...); +ANY* _purs_scope_alloc(int num_bindings); +ANY* _purs_scope_new(int num_bindings, ANY binding, ...); /* declare a thunked top-level value. */ #define PURS_ANY_THUNK_DEF(NAME, INIT)\ - static const ANY * NAME ## __thunk_fn__ (const void * __unused__1) { \ - static const ANY * NAME ## __thunk_val__ = NULL;\ - if (NAME ## __thunk_val__ == NULL) {\ - NAME ## __thunk_val__ = INIT;\ + static ANY NAME ## __thunk_fn__ (ANY __unused__1) { \ + static ANY v;\ + static int x = 0;\ + if (x == 0) {\ + x = 1;\ + v = INIT;\ }\ - return NAME ## __thunk_val__;\ - }\ - static const ANY NAME ## __thunk__ = {\ + return v;\ + };\ + ANY NAME = {\ .tag = PURS_ANY_TAG_THUNK,\ .value = {\ .thunk = {\ @@ -312,17 +314,17 @@ const ANY ** _purs_scope_new(int num_bindings, const ANY * binding, ...); .ctx = NULL\ }\ }\ - };\ - const ANY * NAME = & NAME ## __thunk__;\ + }; -/* allocate a cons 'value' field large enough to fit 'n' amount of 'ANY *' +/* allocate a cons 'value' field large enough to fit 'n' amount of 'ANY' */ #define PURS_CONS_VALUES_NEW(n)\ - purs_malloc(sizeof (const ANY *) * n) + purs_malloc(sizeof (ANY) * n) /* simply return the 'tag' of a 'purs_cons_t'. + * todo: remove */ -int purs_cons_get_tag (const purs_cons_t * cons); +int purs_cons_get_tag (purs_any_cons_t cons); // ----------------------------------------------------------------------------- // Any: initializers @@ -348,6 +350,9 @@ int purs_cons_get_tag (const purs_cons_t * cons); }\ } +#define PURS_ANY_RECORD(x)\ + { .tag = PURS_ANY_TAG_RECORD, .value = { .record = x } } + #define PURS_ANY_ARRAY(ARR)\ { .tag = PURS_ANY_TAG_ARRAY, .value = { .array = ARR } } @@ -357,7 +362,7 @@ int purs_cons_get_tag (const purs_cons_t * cons); /* note: The '$' is currently appended to all names (see code generation) */ #define PURS_FFI_EXPORT(NAME)\ - const ANY * NAME ## _$ + ANY NAME ## _$ #define PURS_SCOPE_T(NAME, DECLS)\ typedef struct NAME {\ @@ -365,26 +370,28 @@ int purs_cons_get_tag (const purs_cons_t * cons); } NAME #define PURS_FFI_VALUE(NAME, INIT)\ - static const purs_any_t _ ## NAME ## _$ = INIT;\ - const purs_any_t * NAME ## _$ = & _ ## NAME ## _$ + static const purs_any_t NAME ## _$ = INIT // ----------------------------------------------------------------------------- // FFI: fixed-arity curried functions // ----------------------------------------------------------------------------- #define _PURS_FFI_FUNC_ENTRY(NAME)\ - const ANY NAME##__1_ = {\ + ANY NAME = {\ .tag = PURS_ANY_TAG_CONT,\ .value = { .cont = { .fn = NAME##__1, .ctx = NULL } }\ };\ - const ANY * NAME = & NAME##__1_; /* for manual use */\ - const ANY * NAME ## _$ = & NAME##__1_ /* for code-gen use */ + /* for code-gen use. todo: remove? */\ + ANY NAME ## _$ = {\ + .tag = PURS_ANY_TAG_CONT,\ + .value = { .cont = { .fn = NAME##__1, .ctx = NULL } }\ + } #define _PURS_FFI_FUNC_CONT(NAME, CUR, NEXT)\ - const ANY * NAME##__##CUR (const void * $__super__, const ANY * a, va_list $__unused__) {\ - const ANY ** ctx = _purs_scope_alloc(CUR);\ + ANY NAME##__##CUR (const void * $__super__, ANY a, va_list $__unused__) {\ + ANY* ctx = _purs_scope_alloc(CUR);\ if ($__super__ != NULL) {\ - memcpy(ctx, $__super__, CUR * sizeof (const ANY *));\ + memcpy(ctx, $__super__, CUR * sizeof (ANY));\ }\ if (ctx != NULL) {\ ctx[CUR - 1] = a;\ @@ -407,23 +414,23 @@ int purs_cons_get_tag (const purs_cons_t * cons); #define PURS_FFI_FUNC_CONTEXT $__super__ #define PURS_FFI_FUNC_1(NAME, A1, BODY)\ - const ANY * NAME##__1 (const void * $__super__, const ANY * A1, va_list $__unused__) {\ + ANY NAME##__1 (const void * $__super__, ANY A1, va_list $__unused__) {\ BODY;\ }\ _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_2(NAME, A1, A2, BODY)\ - const ANY * NAME##__2 (const void * $__super__, const ANY * A2, va_list $__unused__) {\ - const ANY * A1 = ((const ANY **)$__super__)[0];\ + ANY NAME##__2 (const void * $__super__, ANY A2, va_list $__unused__) {\ + ANY A1 = ((ANY*)$__super__)[0];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_1_TO_2(NAME);\ _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_3(NAME, A1, A2, A3, BODY)\ - const ANY * NAME##__3 (const void * $__super__, const ANY * A3, va_list $__unused__) {\ - const ANY * A1 = ((const ANY **)$__super__)[0];\ - const ANY * A2 = ((const ANY **)$__super__)[1];\ + ANY NAME##__3 (const void * $__super__, ANY A3, va_list $__unused__) {\ + ANY A1 = ((ANY*)$__super__)[0];\ + ANY A2 = ((ANY*)$__super__)[1];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_2_TO_3(NAME);\ @@ -431,10 +438,10 @@ int purs_cons_get_tag (const purs_cons_t * cons); _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_4(NAME, A1, A2, A3, A4, BODY)\ - const ANY * NAME##__4 (const void * $__super__, const ANY * A4, va_list $__unused__) {\ - const ANY * A1 = ((const ANY **)$__super__)[0];\ - const ANY * A2 = ((const ANY **)$__super__)[1];\ - const ANY * A3 = ((const ANY **)$__super__)[2];\ + ANY NAME##__4 (const void * $__super__, ANY A4, va_list $__unused__) {\ + ANY A1 = ((ANY*)$__super__)[0];\ + ANY A2 = ((ANY*)$__super__)[1];\ + ANY A3 = ((ANY*)$__super__)[2];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_3_TO_4(NAME);\ @@ -443,11 +450,11 @@ int purs_cons_get_tag (const purs_cons_t * cons); _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_5(NAME, A1, A2, A3, A4, A5, BODY)\ - const ANY * NAME##__5 (const void * $__super__, const ANY * A5, va_list $__unused__) {\ - const ANY * A1 = ((const ANY **)$__super__)[0];\ - const ANY * A2 = ((const ANY **)$__super__)[1];\ - const ANY * A3 = ((const ANY **)$__super__)[2];\ - const ANY * A4 = ((const ANY **)$__super__)[3];\ + ANY NAME##__5 (const void * $__super__, ANY A5, va_list $__unused__) {\ + ANY A1 = ((ANY*)$__super__)[0];\ + ANY A2 = ((ANY*)$__super__)[1];\ + ANY A3 = ((ANY*)$__super__)[2];\ + ANY A4 = ((ANY*)$__super__)[3];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_4_TO_5(NAME);\ @@ -457,12 +464,12 @@ int purs_cons_get_tag (const purs_cons_t * cons); _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_6(NAME, A1, A2, A3, A4, A5, A6, BODY)\ - const ANY * NAME##__6 (const void * $__super__, const ANY * A6, va_list $__unused__) {\ - const ANY * A1 = ((const ANY **)$__super__)[0];\ - const ANY * A2 = ((const ANY **)$__super__)[1];\ - const ANY * A3 = ((const ANY **)$__super__)[2];\ - const ANY * A4 = ((const ANY **)$__super__)[3];\ - const ANY * A5 = ((const ANY **)$__super__)[4];\ + ANY NAME##__6 (const void * $__super__, ANY A6, va_list $__unused__) {\ + ANY A1 = ((ANY*)$__super__)[0];\ + ANY A2 = ((ANY*)$__super__)[1];\ + ANY A3 = ((ANY*)$__super__)[2];\ + ANY A4 = ((ANY*)$__super__)[3];\ + ANY A5 = ((ANY*)$__super__)[4];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_5_TO_6(NAME);\ @@ -473,13 +480,13 @@ int purs_cons_get_tag (const purs_cons_t * cons); _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_7(NAME, A1, A2, A3, A4, A5, A6, A7, BODY)\ - const ANY * NAME##__7 (const void * $__super__, const ANY * A7, va_list $__unused__) {\ - const ANY * A1 = ((const ANY **)$__super__)[0];\ - const ANY * A2 = ((const ANY **)$__super__)[1];\ - const ANY * A3 = ((const ANY **)$__super__)[2];\ - const ANY * A4 = ((const ANY **)$__super__)[3];\ - const ANY * A5 = ((const ANY **)$__super__)[4];\ - const ANY * A6 = ((const ANY **)$__super__)[5];\ + ANY NAME##__7 (const void * $__super__, ANY A7, va_list $__unused__) {\ + ANY A1 = ((ANY*)$__super__)[0];\ + ANY A2 = ((ANY*)$__super__)[1];\ + ANY A3 = ((ANY*)$__super__)[2];\ + ANY A4 = ((ANY*)$__super__)[3];\ + ANY A5 = ((ANY*)$__super__)[4];\ + ANY A6 = ((ANY*)$__super__)[5];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_6_TO_7(NAME);\ @@ -491,14 +498,14 @@ int purs_cons_get_tag (const purs_cons_t * cons); _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_8(NAME, A1, A2, A3, A4, A5, A6, A7, A8, BODY)\ - const ANY * NAME##__8 (const void * $__super__, const ANY * A8, va_list $__unused__) {\ - const ANY * A1 = ((const ANY **)$__super__)[0];\ - const ANY * A2 = ((const ANY **)$__super__)[1];\ - const ANY * A3 = ((const ANY **)$__super__)[2];\ - const ANY * A4 = ((const ANY **)$__super__)[3];\ - const ANY * A5 = ((const ANY **)$__super__)[4];\ - const ANY * A6 = ((const ANY **)$__super__)[5];\ - const ANY * A7 = ((const ANY **)$__super__)[6];\ + ANY NAME##__8 (const void * $__super__, ANY A8, va_list $__unused__) {\ + ANY A1 = ((ANY*)$__super__)[0];\ + ANY A2 = ((ANY*)$__super__)[1];\ + ANY A3 = ((ANY*)$__super__)[2];\ + ANY A4 = ((ANY*)$__super__)[3];\ + ANY A5 = ((ANY*)$__super__)[4];\ + ANY A6 = ((ANY*)$__super__)[5];\ + ANY A7 = ((ANY*)$__super__)[6];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_7_TO_8(NAME);\ @@ -511,15 +518,15 @@ int purs_cons_get_tag (const purs_cons_t * cons); _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_9(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, BODY)\ - const ANY * NAME##__9 (const void * $__super__, const ANY * A9, va_list $__unused__) {\ - const ANY * A1 = ((const ANY **)$__super__)[0];\ - const ANY * A2 = ((const ANY **)$__super__)[1];\ - const ANY * A3 = ((const ANY **)$__super__)[2];\ - const ANY * A4 = ((const ANY **)$__super__)[3];\ - const ANY * A5 = ((const ANY **)$__super__)[4];\ - const ANY * A6 = ((const ANY **)$__super__)[5];\ - const ANY * A7 = ((const ANY **)$__super__)[6];\ - const ANY * A8 = ((const ANY **)$__super__)[7];\ + ANY NAME##__9 (const void * $__super__, ANY A9, va_list $__unused__) {\ + ANY A1 = ((ANY*)$__super__)[0];\ + ANY A2 = ((ANY*)$__super__)[1];\ + ANY A3 = ((ANY*)$__super__)[2];\ + ANY A4 = ((ANY*)$__super__)[3];\ + ANY A5 = ((ANY*)$__super__)[4];\ + ANY A6 = ((ANY*)$__super__)[5];\ + ANY A7 = ((ANY*)$__super__)[6];\ + ANY A8 = ((ANY*)$__super__)[7];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_8_TO_9(NAME);\ @@ -533,16 +540,16 @@ int purs_cons_get_tag (const purs_cons_t * cons); _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_10(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, BODY)\ - const ANY * NAME##__10 (const void * $__super__, const ANY * A10, va_list $__unused__) {\ - const ANY * A1 = ((const ANY **)$__super__)[0];\ - const ANY * A2 = ((const ANY **)$__super__)[1];\ - const ANY * A3 = ((const ANY **)$__super__)[2];\ - const ANY * A4 = ((const ANY **)$__super__)[3];\ - const ANY * A5 = ((const ANY **)$__super__)[4];\ - const ANY * A6 = ((const ANY **)$__super__)[5];\ - const ANY * A7 = ((const ANY **)$__super__)[6];\ - const ANY * A8 = ((const ANY **)$__super__)[7];\ - const ANY * A9 = ((const ANY **)$__super__)[8];\ + ANY NAME##__10 (const void * $__super__, ANY A10, va_list $__unused__) {\ + ANY A1 = ((ANY*)$__super__)[0];\ + ANY A2 = ((ANY*)$__super__)[1];\ + ANY A3 = ((ANY*)$__super__)[2];\ + ANY A4 = ((ANY*)$__super__)[3];\ + ANY A5 = ((ANY*)$__super__)[4];\ + ANY A6 = ((ANY*)$__super__)[5];\ + ANY A7 = ((ANY*)$__super__)[6];\ + ANY A8 = ((ANY*)$__super__)[7];\ + ANY A9 = ((ANY*)$__super__)[8];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_9_TO_10(NAME);\ @@ -557,17 +564,17 @@ int purs_cons_get_tag (const purs_cons_t * cons); _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_11(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, BODY)\ - const ANY * NAME##__11 (const void * $__super__, const ANY * A11, va_list $__unused__) {\ - const ANY * A1 = ((const ANY **)$__super__)[0];\ - const ANY * A2 = ((const ANY **)$__super__)[1];\ - const ANY * A3 = ((const ANY **)$__super__)[2];\ - const ANY * A4 = ((const ANY **)$__super__)[3];\ - const ANY * A5 = ((const ANY **)$__super__)[4];\ - const ANY * A6 = ((const ANY **)$__super__)[5];\ - const ANY * A7 = ((const ANY **)$__super__)[6];\ - const ANY * A8 = ((const ANY **)$__super__)[7];\ - const ANY * A9 = ((const ANY **)$__super__)[8];\ - const ANY * A10 = ((const ANY **)$__super__)[9];\ + ANY NAME##__11 (const void * $__super__, ANY A11, va_list $__unused__) {\ + ANY A1 = ((ANY*)$__super__)[0];\ + ANY A2 = ((ANY*)$__super__)[1];\ + ANY A3 = ((ANY*)$__super__)[2];\ + ANY A4 = ((ANY*)$__super__)[3];\ + ANY A5 = ((ANY*)$__super__)[4];\ + ANY A6 = ((ANY*)$__super__)[5];\ + ANY A7 = ((ANY*)$__super__)[6];\ + ANY A8 = ((ANY*)$__super__)[7];\ + ANY A9 = ((ANY*)$__super__)[8];\ + ANY A10 = ((ANY*)$__super__)[9];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_10_TO_11(NAME);\ @@ -583,18 +590,18 @@ int purs_cons_get_tag (const purs_cons_t * cons); _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_12(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, BODY)\ - const ANY * NAME##__12 (const void * $__super__, const ANY * A12, va_list $__unused__) {\ - const ANY * A1 = ((const ANY **)$__super__)[0];\ - const ANY * A2 = ((const ANY **)$__super__)[1];\ - const ANY * A3 = ((const ANY **)$__super__)[2];\ - const ANY * A4 = ((const ANY **)$__super__)[3];\ - const ANY * A5 = ((const ANY **)$__super__)[4];\ - const ANY * A6 = ((const ANY **)$__super__)[5];\ - const ANY * A7 = ((const ANY **)$__super__)[6];\ - const ANY * A8 = ((const ANY **)$__super__)[7];\ - const ANY * A9 = ((const ANY **)$__super__)[8];\ - const ANY * A10 = ((const ANY **)$__super__)[9];\ - const ANY * A11 = ((const ANY **)$__super__)[10];\ + ANY NAME##__12 (const void * $__super__, ANY A12, va_list $__unused__) {\ + ANY A1 = ((ANY*)$__super__)[0];\ + ANY A2 = ((ANY*)$__super__)[1];\ + ANY A3 = ((ANY*)$__super__)[2];\ + ANY A4 = ((ANY*)$__super__)[3];\ + ANY A5 = ((ANY*)$__super__)[4];\ + ANY A6 = ((ANY*)$__super__)[5];\ + ANY A7 = ((ANY*)$__super__)[6];\ + ANY A8 = ((ANY*)$__super__)[7];\ + ANY A9 = ((ANY*)$__super__)[8];\ + ANY A10 = ((ANY*)$__super__)[9];\ + ANY A11 = ((ANY*)$__super__)[10];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_11_TO_12(NAME);\ @@ -615,146 +622,146 @@ int purs_cons_get_tag (const purs_cons_t * cons); // ----------------------------------------------------------------------------- #define _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME)\ - const ANY NAME##__1_ = {\ + ANY NAME##__1_ = {\ .tag = PURS_ANY_TAG_CONT,\ .value = { .cont = { .fn = NAME, .ctx = NULL } }\ };\ - const ANY * NAME ## _$ = & NAME##__1_ + ANY NAME ## _$ = & NAME##__1_ #define PURS_FFI_FUNC_UNCURRIED_1(NAME, A1, BODY)\ - const ANY * NAME (const void * $__super__, const ANY * A1, va_list $__unused__) {\ + ANY NAME (const void * $__super__, ANY A1, va_list $__unused__) {\ BODY;\ }\ _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) #define PURS_FFI_FUNC_UNCURRIED_2(NAME, A1, A2, BODY)\ - const ANY * NAME (const void * $__super__, const ANY * A1, va_list vl) {\ - const ANY * A2 = va_arg(vl, const ANY *);\ + ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ BODY;\ }\ _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) #define PURS_FFI_FUNC_UNCURRIED_3(NAME, A1, A2, A3, BODY)\ - const ANY * NAME (const void * $__super__, const ANY * A1, va_list vl) {\ - const ANY * A2 = va_arg(vl, const ANY *);\ - const ANY * A3 = va_arg(vl, const ANY *);\ + ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ + ANY A3 = va_arg(vl, ANY);\ BODY;\ }\ _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) #define PURS_FFI_FUNC_UNCURRIED_4(NAME, A1, A2, A3, A4, BODY)\ - const ANY * NAME (const void * $__super__, const ANY * A1, va_list vl) {\ - const ANY * A2 = va_arg(vl, const ANY *);\ - const ANY * A3 = va_arg(vl, const ANY *);\ - const ANY * A4 = va_arg(vl, const ANY *);\ + ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ + ANY A3 = va_arg(vl, ANY);\ + ANY A4 = va_arg(vl, ANY);\ BODY;\ }\ _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) #define PURS_FFI_FUNC_UNCURRIED_5(NAME, A1, A2, A3, A4, A5, BODY)\ - const ANY * NAME (const void * $__super__, const ANY * A1, va_list vl) {\ - const ANY * A2 = va_arg(vl, const ANY *);\ - const ANY * A3 = va_arg(vl, const ANY *);\ - const ANY * A4 = va_arg(vl, const ANY *);\ - const ANY * A5 = va_arg(vl, const ANY *);\ + ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ + ANY A3 = va_arg(vl, ANY);\ + ANY A4 = va_arg(vl, ANY);\ + ANY A5 = va_arg(vl, ANY);\ BODY;\ }\ _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) #define PURS_FFI_FUNC_UNCURRIED_6(NAME, A1, A2, A3, A4, A5, A6, BODY)\ - const ANY * NAME (const void * $__super__, const ANY * A1, va_list vl) {\ - const ANY * A2 = va_arg(vl, const ANY *);\ - const ANY * A3 = va_arg(vl, const ANY *);\ - const ANY * A4 = va_arg(vl, const ANY *);\ - const ANY * A5 = va_arg(vl, const ANY *);\ - const ANY * A6 = va_arg(vl, const ANY *);\ + ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ + ANY A3 = va_arg(vl, ANY);\ + ANY A4 = va_arg(vl, ANY);\ + ANY A5 = va_arg(vl, ANY);\ + ANY A6 = va_arg(vl, ANY);\ BODY;\ }\ _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) #define PURS_FFI_FUNC_UNCURRIED_7(NAME, A1, A2, A3, A4, A5, A6, A7, BODY)\ - const ANY * NAME (const void * $__super__, const ANY * A1, va_list vl) {\ - const ANY * A2 = va_arg(vl, const ANY *);\ - const ANY * A3 = va_arg(vl, const ANY *);\ - const ANY * A4 = va_arg(vl, const ANY *);\ - const ANY * A5 = va_arg(vl, const ANY *);\ - const ANY * A6 = va_arg(vl, const ANY *);\ - const ANY * A7 = va_arg(vl, const ANY *);\ + ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ + ANY A3 = va_arg(vl, ANY);\ + ANY A4 = va_arg(vl, ANY);\ + ANY A5 = va_arg(vl, ANY);\ + ANY A6 = va_arg(vl, ANY);\ + ANY A7 = va_arg(vl, ANY);\ BODY;\ }\ _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) #define PURS_FFI_FUNC_UNCURRIED_8(NAME, A1, A2, A3, A4, A5, A6, A7, A8, BODY)\ - const ANY * NAME (const void * $__super__, const ANY * A1, va_list vl) {\ - const ANY * A2 = va_arg(vl, const ANY *);\ - const ANY * A3 = va_arg(vl, const ANY *);\ - const ANY * A4 = va_arg(vl, const ANY *);\ - const ANY * A5 = va_arg(vl, const ANY *);\ - const ANY * A6 = va_arg(vl, const ANY *);\ - const ANY * A7 = va_arg(vl, const ANY *);\ - const ANY * A8 = va_arg(vl, const ANY *);\ + ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ + ANY A3 = va_arg(vl, ANY);\ + ANY A4 = va_arg(vl, ANY);\ + ANY A5 = va_arg(vl, ANY);\ + ANY A6 = va_arg(vl, ANY);\ + ANY A7 = va_arg(vl, ANY);\ + ANY A8 = va_arg(vl, ANY);\ BODY;\ }\ _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) #define PURS_FFI_FUNC_UNCURRIED_9(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, BODY)\ - const ANY * NAME (const void * $__super__, const ANY * A1, va_list vl) {\ - const ANY * A2 = va_arg(vl, const ANY *);\ - const ANY * A3 = va_arg(vl, const ANY *);\ - const ANY * A4 = va_arg(vl, const ANY *);\ - const ANY * A5 = va_arg(vl, const ANY *);\ - const ANY * A6 = va_arg(vl, const ANY *);\ - const ANY * A7 = va_arg(vl, const ANY *);\ - const ANY * A8 = va_arg(vl, const ANY *);\ - const ANY * A9 = va_arg(vl, const ANY *);\ + ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ + ANY A3 = va_arg(vl, ANY);\ + ANY A4 = va_arg(vl, ANY);\ + ANY A5 = va_arg(vl, ANY);\ + ANY A6 = va_arg(vl, ANY);\ + ANY A7 = va_arg(vl, ANY);\ + ANY A8 = va_arg(vl, ANY);\ + ANY A9 = va_arg(vl, ANY);\ BODY;\ }\ _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) #define PURS_FFI_FUNC_UNCURRIED_10(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, BODY)\ - const ANY * NAME (const void * $__super__, const ANY * A1, va_list vl) {\ - const ANY * A2 = va_arg(vl, const ANY *);\ - const ANY * A3 = va_arg(vl, const ANY *);\ - const ANY * A4 = va_arg(vl, const ANY *);\ - const ANY * A5 = va_arg(vl, const ANY *);\ - const ANY * A6 = va_arg(vl, const ANY *);\ - const ANY * A7 = va_arg(vl, const ANY *);\ - const ANY * A8 = va_arg(vl, const ANY *);\ - const ANY * A9 = va_arg(vl, const ANY *);\ - const ANY * A10 = va_arg(vl, const ANY *);\ + ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ + ANY A3 = va_arg(vl, ANY);\ + ANY A4 = va_arg(vl, ANY);\ + ANY A5 = va_arg(vl, ANY);\ + ANY A6 = va_arg(vl, ANY);\ + ANY A7 = va_arg(vl, ANY);\ + ANY A8 = va_arg(vl, ANY);\ + ANY A9 = va_arg(vl, ANY);\ + ANY A10 = va_arg(vl, ANY);\ BODY;\ }\ _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) #define PURS_FFI_FUNC_UNCURRIED_11(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, BODY)\ - const ANY * NAME (const void * $__super__, const ANY * A1, va_list vl) {\ - const ANY * A2 = va_arg(vl, const ANY *);\ - const ANY * A3 = va_arg(vl, const ANY *);\ - const ANY * A4 = va_arg(vl, const ANY *);\ - const ANY * A5 = va_arg(vl, const ANY *);\ - const ANY * A6 = va_arg(vl, const ANY *);\ - const ANY * A7 = va_arg(vl, const ANY *);\ - const ANY * A8 = va_arg(vl, const ANY *);\ - const ANY * A9 = va_arg(vl, const ANY *);\ - const ANY * A10 = va_arg(vl, const ANY *);\ - const ANY * A11 = va_arg(vl, const ANY *);\ + ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ + ANY A3 = va_arg(vl, ANY);\ + ANY A4 = va_arg(vl, ANY);\ + ANY A5 = va_arg(vl, ANY);\ + ANY A6 = va_arg(vl, ANY);\ + ANY A7 = va_arg(vl, ANY);\ + ANY A8 = va_arg(vl, ANY);\ + ANY A9 = va_arg(vl, ANY);\ + ANY A10 = va_arg(vl, ANY);\ + ANY A11 = va_arg(vl, ANY);\ BODY;\ }\ _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) #define PURS_FFI_FUNC_UNCURRIED_12(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, BODY)\ - const ANY * NAME (const void * $__super__, const ANY * A1, va_list vl) {\ - const ANY * A2 = va_arg(vl, const ANY *);\ - const ANY * A3 = va_arg(vl, const ANY *);\ - const ANY * A4 = va_arg(vl, const ANY *);\ - const ANY * A5 = va_arg(vl, const ANY *);\ - const ANY * A6 = va_arg(vl, const ANY *);\ - const ANY * A7 = va_arg(vl, const ANY *);\ - const ANY * A8 = va_arg(vl, const ANY *);\ - const ANY * A9 = va_arg(vl, const ANY *);\ - const ANY * A10 = va_arg(vl, const ANY *);\ - const ANY * A11 = va_arg(vl, const ANY *);\ - const ANY * A12 = va_arg(vl, const ANY *);\ + ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ + ANY A3 = va_arg(vl, ANY);\ + ANY A4 = va_arg(vl, ANY);\ + ANY A5 = va_arg(vl, ANY);\ + ANY A6 = va_arg(vl, ANY);\ + ANY A7 = va_arg(vl, ANY);\ + ANY A8 = va_arg(vl, ANY);\ + ANY A9 = va_arg(vl, ANY);\ + ANY A10 = va_arg(vl, ANY);\ + ANY A11 = va_arg(vl, ANY);\ + ANY A12 = va_arg(vl, ANY);\ BODY;\ }\ _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) @@ -770,13 +777,13 @@ int purs_cons_get_tag (const purs_cons_t * cons); // Built-ins // ----------------------------------------------------------------------------- -const ANY * purs_any_true; -const ANY * purs_any_false; -const ANY * purs_any_NaN; -const ANY * purs_any_int_one; -const ANY * purs_any_num_one; -const ANY * purs_any_int_zero; -const ANY * purs_any_num_zero; +ANY purs_any_true; +ANY purs_any_false; +ANY purs_any_NaN; +ANY purs_any_int_one; +ANY purs_any_num_one; +ANY purs_any_int_zero; +ANY purs_any_num_zero; #define purs_any_bool(V) \ (V == 1) \ diff --git a/src/Language/PureScript/CodeGen/C.purs b/src/Language/PureScript/CodeGen/C.purs index c93950c..d47feab 100644 --- a/src/Language/PureScript/CodeGen/C.purs +++ b/src/Language/PureScript/CodeGen/C.purs @@ -216,7 +216,7 @@ declToAst isTopLevel (x /\ ident) val = do pure $ AST.VariableIntroduction { name - , type: R.any'' [ Type.Const ] + , type: Type.Any [] , qualifiers: [] , initialization: Just initAst } diff --git a/src/Language/PureScript/CodeGen/C/File.purs b/src/Language/PureScript/CodeGen/C/File.purs index 1b51853..df06c8a 100644 --- a/src/Language/PureScript/CodeGen/C/File.purs +++ b/src/Language/PureScript/CodeGen/C/File.purs @@ -67,11 +67,11 @@ toHeader toHeader = A.catMaybes <<< map go where - go (AST.VariableIntroduction { name, initialization }) = + go (AST.VariableIntroduction { name }) = Just $ AST.VariableIntroduction { name - , type: Type.Pointer (Type.Any [ Type.Const ]) + , type: Type.Any [] , qualifiers: [] , initialization: Nothing } @@ -128,7 +128,7 @@ nativeMain mainVar = , AST.App R.purs_any_app [ mainVar - , AST.Null + , R.purs_any_null ] , AST.Return (AST.NumericLiteral (Left 0)) ] diff --git a/src/Language/PureScript/CodeGen/Runtime.purs b/src/Language/PureScript/CodeGen/Runtime.purs index c348f1e..6d23293 100644 --- a/src/Language/PureScript/CodeGen/Runtime.purs +++ b/src/Language/PureScript/CodeGen/Runtime.purs @@ -3,8 +3,7 @@ module Language.PureScript.CodeGen.Runtime -- any: dynamic runtime types any - , any', anyMut - , any'' + , anyMut -- any: built-ins , purs_any_app @@ -18,6 +17,7 @@ module Language.PureScript.CodeGen.Runtime , purs_any_get_array , purs_any_true , purs_any_false + , purs_any_null , purs_any_int_zero , purs_any_num_zero , purs_any_int_one @@ -79,18 +79,11 @@ import Language.PureScript.CodeGen.C.AST as Type void :: Array AST.TypeQualifier -> AST.Type void = Type.RawType "void" -any'' :: Array AST.TypeQualifier -> AST.Type -any'' xs = Type.Pointer (Type.Any xs) - anyMut :: AST.Type anyMut = Type.Pointer (Type.Any []) --- TODO remove this alias -any' :: AST.Type -any' = anyMut - any :: AST.Type -any = Type.Pointer (Type.Any [ Type.Const ]) +any = Type.Any [] purs_any_fun_t :: AST.Type purs_any_fun_t = Type.RawType "purs_any_fun_t" [] @@ -113,6 +106,9 @@ purs_any_num_zero = AST.Var "purs_any_num_zero" purs_any_int_zero :: AST purs_any_int_zero = AST.Var "purs_any_int_zero" +purs_any_null :: AST +purs_any_null = AST.Var "purs_any_null" + purs_any_false :: AST purs_any_false = AST.Var "purs_any_false" From 9ac573b4942e16f365f705139d1118e88b38c1c6 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Thu, 11 Jul 2019 12:14:46 +1200 Subject: [PATCH 02/67] Move 'ANY' into stack memory This commit is rather large and contains unrelated changes that were necessary to retain sanity when refactoring this: * Move to using 'spago'. * (For now) Maintain an in-repo package-set of pure-c compatible packages. * Remove old examples, and replace by new "bottom" up tests. Eventually this folder will be renamed to "tests" or similar. * Add a "ctests" folder, for testing the runtime library directly. --- .gitignore | 1 + Makefile | 41 +- ctests/main.c | 7 + ctests/test_arrays.c | 13 + examples/basic/.gitignore | 10 + examples/{effect => basic}/Makefile | 6 +- examples/basic/packages.dhall | 9 + examples/basic/spago.dhall | 9 + examples/basic/src/Main.purs | 45 ++ examples/bower.json | 24 - examples/effect/psc-package.json | 10 - examples/effect/src/Main.purs | 70 --- examples/example1/psc-package.json | 9 - examples/example1/src/Example1.h | 32 -- examples/example1/src/Example1.purs | 65 --- examples/example2/Makefile | 11 - examples/example2/src/Example2.h | 25 - examples/example2/src/Example2.purs | 223 -------- examples/mutrec/.gitignore | 10 + examples/mutrec/Makefile | 11 + examples/mutrec/packages.dhall | 9 + examples/mutrec/spago.dhall | 9 + examples/mutrec/src/Main.purs | 35 ++ examples/partialfuns/.gitignore | 10 + examples/partialfuns/Makefile | 11 + examples/partialfuns/packages.dhall | 9 + examples/partialfuns/spago.dhall | 9 + examples/partialfuns/src/Main.purs | 75 +++ examples/prelude/#Makefile# | 12 + examples/prelude/Makefile | 11 + examples/prelude/packages.dhall | 9 + examples/prelude/spago.dhall | 9 + examples/prelude/src/Main.purs | 8 + {examples/example1 => examples2}/Makefile | 2 +- examples2/bower.json | 18 + .../example2 => examples2}/psc-package.json | 3 - examples2/src/Example1.h | 11 + examples2/src/Example1.purs | 20 + mk/target.mk | 8 +- package-sets/mkPackage.dhall | 4 + package-sets/packages.dhall | 17 + package.json | 6 +- packages.dhall | 26 + runtime/purescript.c | 127 ++--- runtime/purescript.h | 495 +++++++++--------- spago.dhall | 27 + src/Language/PureScript/CodeGen/C.purs | 22 +- src/Language/PureScript/CodeGen/C/File.purs | 25 +- .../CodeGen/C/Optimizer/Inliner.purs | 8 +- .../PureScript/CodeGen/C/Optimizer/TCO.purs | 2 +- .../PureScript/CodeGen/C/Transforms.purs | 6 +- src/Language/PureScript/CodeGen/Runtime.purs | 64 ++- test.c | 24 + test/Main.purs | 178 +------ test/Upstream.purs | 129 +++++ test/{Main.js => Utils.js} | 0 test/Utils.purs | 42 +- 57 files changed, 1077 insertions(+), 1034 deletions(-) create mode 100644 ctests/main.c create mode 100644 ctests/test_arrays.c create mode 100644 examples/basic/.gitignore rename examples/{effect => basic}/Makefile (70%) create mode 100644 examples/basic/packages.dhall create mode 100644 examples/basic/spago.dhall create mode 100644 examples/basic/src/Main.purs delete mode 100644 examples/bower.json delete mode 100644 examples/effect/psc-package.json delete mode 100644 examples/effect/src/Main.purs delete mode 100644 examples/example1/psc-package.json delete mode 100644 examples/example1/src/Example1.h delete mode 100644 examples/example1/src/Example1.purs delete mode 100644 examples/example2/Makefile delete mode 100644 examples/example2/src/Example2.h delete mode 100644 examples/example2/src/Example2.purs create mode 100644 examples/mutrec/.gitignore create mode 100644 examples/mutrec/Makefile create mode 100644 examples/mutrec/packages.dhall create mode 100644 examples/mutrec/spago.dhall create mode 100644 examples/mutrec/src/Main.purs create mode 100644 examples/partialfuns/.gitignore create mode 100644 examples/partialfuns/Makefile create mode 100644 examples/partialfuns/packages.dhall create mode 100644 examples/partialfuns/spago.dhall create mode 100644 examples/partialfuns/src/Main.purs create mode 100644 examples/prelude/#Makefile# create mode 100644 examples/prelude/Makefile create mode 100644 examples/prelude/packages.dhall create mode 100644 examples/prelude/spago.dhall create mode 100644 examples/prelude/src/Main.purs rename {examples/example1 => examples2}/Makefile (89%) create mode 100644 examples2/bower.json rename {examples/example2 => examples2}/psc-package.json (75%) create mode 100644 examples2/src/Example1.h create mode 100644 examples2/src/Example1.purs create mode 100644 package-sets/mkPackage.dhall create mode 100644 package-sets/packages.dhall create mode 100644 packages.dhall create mode 100644 spago.dhall create mode 100644 test.c create mode 100644 test/Upstream.purs rename test/{Main.js => Utils.js} (100%) diff --git a/.gitignore b/.gitignore index 37adeb4..0547045 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ +.spago .psc-package/ *.out *.tar.bz2 diff --git a/Makefile b/Makefile index 322e65b..f66adbb 100644 --- a/Makefile +++ b/Makefile @@ -109,33 +109,44 @@ deps/bwdgc: # Tests #------------------------------------------------------------------------------- -# note: this is temporary while building up the project -test: examples/bower_components -.PHONY: test +test/c: $(LIBPUREC) + @$(CLANG) -L. \ + ctests/*.c \ + -lpurec \ + -lpthread \ + -I. \ + -o ctests/a.out + @./ctests/a.out +.PHONY: test/c + +test/examples/example1: + @$(MAKE) -s -C examples/example1 + @./examples/example1/main.out <<< "foobar" -test/examples: - @$(MAKE) -s examples - @./examples/example1/main.out <<< "john" +test/examples/example2: + @$(MAKE) -s -C examples/example2 @./examples/example2/main.out + +test/examples/effect: + @$(MAKE) -s -C examples/effect @./examples/effect/main.out + +test/examples: \ + test/examples/example1 \ + test/examples/example2 \ + test/examples/effect .PHONY: test/examples -test/pulp: upstream/tests/support/bower_components +test/purs: upstream/tests/support/bower_components $(PULP) test .PHONY: test/pulp -test: test/examples test/pulp +test: test/examples test/purs test/c #------------------------------------------------------------------------------- -# Examples +# utilities #------------------------------------------------------------------------------- -examples: purec examples/bower_components - @$(MAKE) -s -C examples/example1 - @$(MAKE) -s -C examples/example2 - @$(MAKE) -s -C examples/effect -.PHONY: examples - %/bower_components: @ROOT=$(PWD) &&\ cd "$(dir $@)" &&\ diff --git a/ctests/main.c b/ctests/main.c new file mode 100644 index 0000000..e37a75d --- /dev/null +++ b/ctests/main.c @@ -0,0 +1,7 @@ +#include + +int test_arrays(); + +int main () { + assert(test_arrays() == 0); +} diff --git a/ctests/test_arrays.c b/ctests/test_arrays.c new file mode 100644 index 0000000..cd6eea5 --- /dev/null +++ b/ctests/test_arrays.c @@ -0,0 +1,13 @@ +#include "runtime/purescript.h" + + +int test_empty_array () { +} + +int test_arrays () { + const purs_vec_t * v = purs_vec_new_va(0); + int i = 0; + ANY tmp; + purs_vec_foreach(v, tmp, i) {} + return 0; +} diff --git a/examples/basic/.gitignore b/examples/basic/.gitignore new file mode 100644 index 0000000..30efe19 --- /dev/null +++ b/examples/basic/.gitignore @@ -0,0 +1,10 @@ +/bower_components/ +/node_modules/ +/.pulp-cache/ +/output/ +/generated-docs/ +/.psc-package/ +/.psc* +/.purs* +/.psa* +/.spago diff --git a/examples/effect/Makefile b/examples/basic/Makefile similarity index 70% rename from examples/effect/Makefile rename to examples/basic/Makefile index 8b98f77..b0496c5 100644 --- a/examples/effect/Makefile +++ b/examples/basic/Makefile @@ -4,8 +4,8 @@ default: main PUREC_DIR := ../.. include $(PUREC_DIR)/mk/target.mk -.psc-package: - psc-package install -main: .psc-package +.spago: + spago install +main: .spago $(eval $(call purs_mk_target,main,Main,src)) diff --git a/examples/basic/packages.dhall b/examples/basic/packages.dhall new file mode 100644 index 0000000..1e24bba --- /dev/null +++ b/examples/basic/packages.dhall @@ -0,0 +1,9 @@ +let mkPackage = ../../package-sets/mkPackage.dhall + +let upstream = ../../package-sets/packages.dhall + +let overrides = {=} + +let additions = {=} + +in upstream ⫽ overrides ⫽ additions diff --git a/examples/basic/spago.dhall b/examples/basic/spago.dhall new file mode 100644 index 0000000..fbaf8ca --- /dev/null +++ b/examples/basic/spago.dhall @@ -0,0 +1,9 @@ +{ name = + "purec-example-basic" +, dependencies = + [] : List Text +, packages = + ./packages.dhall +, sources = + [ "src/**/*.purs", "test/**/*.purs" ] +} diff --git a/examples/basic/src/Main.purs b/examples/basic/src/Main.purs new file mode 100644 index 0000000..919649d --- /dev/null +++ b/examples/basic/src/Main.purs @@ -0,0 +1,45 @@ +module Main where + +data Unit = Unit +type Effect a = Unit -> a + +chain :: Effect Int -> Effect Int -> Effect Int +chain a b = \_ -> + let x = a Unit + in + case x of + 0 -> b Unit + n -> n + +infixl 5 chain as >> + +testString :: Effect Int +testString _ = + let s = "fooBAZ" + in case s of + "fooBAZ" -> 0 + _ -> 1 + +testRecord :: Effect Int +testRecord _ = + let r = { a: 1, b: 2, c: 0 } + in + case r of + { a: 1, b: 2, c: 0 } -> + 0 + _ -> + 1 + +testArray :: Effect Int +testArray _ = + let xs = [ 1, 2, 0, 3 ] + in + case xs of + [_, _, x, _] -> x + _ -> 1 + +main :: Effect Int +main = + testArray >> + testRecord >> + testString diff --git a/examples/bower.json b/examples/bower.json deleted file mode 100644 index 04b6fd7..0000000 --- a/examples/bower.json +++ /dev/null @@ -1,24 +0,0 @@ -{ - "name": "purescript-pure-c--examples", - "private": true, - "ignore": [ - "**/.*", - "node_modules", - "bower_components", - "output" - ], - "dependencies": { - "purescript-prelude": "pure-c/purescript-prelude#master", - "purescript-console": "pure-c/purescript-console#master", - "purescript-control": "pure-c/purescript-control#master", - "purescript-effect": "pure-c/purescript-effect#master", - "purescript-math": "pure-c/purescript-math#master", - "purescript-refs": "pure-c/purescript-refs#master", - "purescript-foldable-traversable": "pure-c/purescript-foldable-traversable#master" - }, - "resolutions": { - "purescript-effect": "master", - "purescript-prelude": "master", - "purescript-control": "master" - } -} diff --git a/examples/effect/psc-package.json b/examples/effect/psc-package.json deleted file mode 100644 index 2702c1d..0000000 --- a/examples/effect/psc-package.json +++ /dev/null @@ -1,10 +0,0 @@ -{ - "name": "purec-example-effect", - "set": "master", - "source": "https://github.com/pure-c/package-sets", - "depends": [ - "prelude", - "effect", - "console" - ] -} diff --git a/examples/effect/src/Main.purs b/examples/effect/src/Main.purs deleted file mode 100644 index 3f20b32..0000000 --- a/examples/effect/src/Main.purs +++ /dev/null @@ -1,70 +0,0 @@ -module Main where - -import Prelude - -import Effect (Effect) -import Effect.Console as Console -import Effect.Uncurried - -fn1 :: EffectFn1 String String -fn1 = - mkEffectFn1 \a -> - pure $ ">" <> a <> "<" - -fn2 :: EffectFn2 String String String -fn2 = - mkEffectFn2 \a b -> - pure $ ">" <> a <> ":" <> b <> "<" - -fn3 :: EffectFn3 String String String String -fn3 = - mkEffectFn3 \a b c -> - pure $ ">" <> a <> ":" <> b <> ":" <> c <> "<" - -fn4 :: EffectFn4 String String String String String -fn4 = - mkEffectFn4 \a b c d -> - pure $ ">" <> a <> ":" <> b <> ":" <> c <> ":" <> d <> "<" - -fn5 :: EffectFn5 String String String String String String -fn5 = - mkEffectFn5 \a b c d e -> - pure $ ">" <> a <> ":" <> b <> ":" <> c <> ":" <> d <> ":" <> e <> "<" - -fn6 :: EffectFn6 String String String String String String String -fn6 = - mkEffectFn6 \a b c d e f -> - pure $ ">" <> a <> ":" <> b <> ":" <> c <> ":" <> d <> ":" <> e <> ":" <> f <> "<" - -fn7 :: EffectFn7 String String String String String String String String -fn7 = - mkEffectFn7 \a b c d e f g -> - pure $ ">" <> a <> ":" <> b <> ":" <> c <> ":" <> d <> ":" <> e <> ":" <> f <> ":" <> g <> "<" - -fn8 :: EffectFn8 String String String String String String String String String -fn8 = - mkEffectFn8 \a b c d e f g h -> - pure $ ">" <> a <> ":" <> b <> ":" <> c <> ":" <> d <> ":" <> e <> ":" <> f <> ":" <> g <> ":" <> h <> "<" - -fn9 :: EffectFn9 String String String String String String String String String String -fn9 = - mkEffectFn9 \a b c d e f g h i -> - pure $ ">" <> a <> ":" <> b <> ":" <> c <> ":" <> d <> ":" <> e <> ":" <> f <> ":" <> g <> ":" <> h <> ":" <> i <> "<" - -fn10 :: EffectFn10 String String String String String String String String String String String -fn10 = - mkEffectFn10 \a b c d e f g h i j -> - pure $ ">" <> a <> ":" <> b <> ":" <> c <> ":" <> d <> ":" <> e <> ":" <> f <> ":" <> g <> ":" <> h <> ":" <> i <> ":" <> j <> "<" - -main :: Effect Unit -main = do - Console.log =<< runEffectFn1 fn1 "a" - Console.log =<< runEffectFn2 fn2 "a" "b" - Console.log =<< runEffectFn3 fn3 "a" "b" "c" - Console.log =<< runEffectFn4 fn4 "a" "b" "c" "d" - Console.log =<< runEffectFn5 fn5 "a" "b" "c" "d" "e" - Console.log =<< runEffectFn6 fn6 "a" "b" "c" "d" "e" "f" - Console.log =<< runEffectFn7 fn7 "a" "b" "c" "d" "e" "f" "g" - Console.log =<< runEffectFn8 fn8 "a" "b" "c" "d" "e" "f" "g" "h" - Console.log =<< runEffectFn9 fn9 "a" "b" "c" "d" "e" "f" "g" "h" "i" - Console.log =<< runEffectFn10 fn10 "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" diff --git a/examples/example1/psc-package.json b/examples/example1/psc-package.json deleted file mode 100644 index 4384c00..0000000 --- a/examples/example1/psc-package.json +++ /dev/null @@ -1,9 +0,0 @@ -{ - "name": "purec-example-example1", - "set": "master", - "source": "https://github.com/pure-c/package-sets", - "depends": [ - "prelude", - "effect" - ] -} diff --git a/examples/example1/src/Example1.h b/examples/example1/src/Example1.h deleted file mode 100644 index ae66d53..0000000 --- a/examples/example1/src/Example1.h +++ /dev/null @@ -1,32 +0,0 @@ -#ifndef Example1_H -#define Example1_H - -#include - -PURS_FFI_FUNC_2(Example1_putStr, s, _, { - printf("%s", purs_any_get_string(s)); - return NULL; -}); - -PURS_FFI_FUNC_2(Example1_exit, _code, _, { - exit(purs_any_get_int(_code)); - return NULL; -}); - -PURS_FFI_FUNC_2(Example1_putStrLn, s, _, { - printf("%s\n", purs_any_get_string(s)); - return NULL; -}); - -PURS_FFI_FUNC_UNCURRIED_2(Example1_getLineImpl, Just, Nothing, { - size_t len; - char * line = NULL; - if (getline(&line, &len, stdin) != -1) { - line[strlen(line) - 1] = 0; // remove trailing newline - return purs_any_app(Just, purs_any_string_new(line)); - } else { - return Nothing; - } -}); - -#endif // Example1_H diff --git a/examples/example1/src/Example1.purs b/examples/example1/src/Example1.purs deleted file mode 100644 index 97f048e..0000000 --- a/examples/example1/src/Example1.purs +++ /dev/null @@ -1,65 +0,0 @@ -module Example1 where - -import Effect -import Prelude - -import Effect.Uncurried (EffectFn2, runEffectFn2) - -data Maybe a - = Just a - | Nothing - -foreign import putStr :: String -> Effect Unit -foreign import putStrLn :: String -> Effect Unit -foreign import getLineImpl - :: ∀ a - . EffectFn2 - (a -> Maybe a) - (Maybe a) - (Maybe String) -foreign import exit :: ∀ a. Int -> Effect a - -getLine :: Effect (Maybe String) -getLine = runEffectFn2 getLineImpl Just Nothing - -instance showMaybe :: Show a => Show (Maybe a) where - show Nothing = "(Nothing)" - show (Just a) = "(Just " <> show a <> ")" - -type User = - { name :: String - , email :: String - } - -main :: Effect Unit -main = do - putStrLn "Please enter your details:" - name <- getName - putStrLn $ "Hello, " <> name <> "!" - - where - getFoo = do - putStr "name> " - let - x = - let - getFoo = "1000" - in getFoo <> "." - getLine >>= case _ of - Nothing -> - exit 0 - Just "" -> do - putStrLn $ "Please, hand me your name: " <> x - getName - Just line -> - pure line - getName = do - putStr "name> " - getLine >>= case _ of - Nothing -> - exit 0 - Just "" -> do - putStrLn "Don't be silly now, give us your name." - getFoo - Just line -> - pure line diff --git a/examples/example2/Makefile b/examples/example2/Makefile deleted file mode 100644 index cab14fa..0000000 --- a/examples/example2/Makefile +++ /dev/null @@ -1,11 +0,0 @@ -default: main -.PHONY: default - -PUREC_DIR := ../.. -include $(PUREC_DIR)/mk/target.mk - -.psc-package: - psc-package install -main: .psc-package - -$(eval $(call purs_mk_target,main,Example2,src)) diff --git a/examples/example2/src/Example2.h b/examples/example2/src/Example2.h deleted file mode 100644 index 45a866e..0000000 --- a/examples/example2/src/Example2.h +++ /dev/null @@ -1,25 +0,0 @@ -#ifndef Example2_H -#define Example2_H - -#include - -PURS_FFI_FUNC_1(Example2_runGC, _, { - GC_gcollect(); - return NULL; -}); - -PURS_FFI_FUNC_2(Example2_usleep, x, _, { - usleep(purs_any_get_int(x)); - return NULL; -}); - -PURS_FFI_FUNC_1(Example2_unsafeCoerce, x, { - return x; -}); - -PURS_FFI_FUNC_2(Example2_consoleLog, s, _, { - printf("%s\n", purs_any_get_string(s)); - return NULL; -}); - -#endif // Example2_H diff --git a/examples/example2/src/Example2.purs b/examples/example2/src/Example2.purs deleted file mode 100644 index 25b1ce3..0000000 --- a/examples/example2/src/Example2.purs +++ /dev/null @@ -1,223 +0,0 @@ -module Example2 - ( Foo (..) - ) where - - -import Effect -import Prelude - -import Control.Extend (extend) - -data Maybe a - = Nothing - | Just a - -x :: Boolean -> Foo -x true = Qux -x false = Bar 0 "hi" - -data Foo - = Bar Int String - | Qux - -const :: ∀ a b. a -> b -> a -const static _ = static - -bar :: ∀ a. a -> Int -bar = const foo - -eq' :: Int -> Int -> Boolean -eq' 200 200 | false = true -eq' 100 100 = true -eq' _ _ = false - -foo :: Int -foo = - let - y = 200 - z = 200 - y' = 200 - in - let z = 200 - in 100 - -zzx :: Int -zzx = 10 - -litString :: String -litString = "foobår" - -litChar :: Char -litChar = 'å' - -litInt :: Int -litInt = 10 - -litNumber :: Number -litNumber = 100.0 - -litRecord :: { b :: String, a :: Int } -litRecord = { b: "hi!", a: 42 } - -foreign import unsafeCoerce :: ∀ a b. a -> b - -data A = A | B A | E C -data C = C | D A - -instance showC :: Show C where - show C = "(C)" - show (D d) = "(D " <> (show d) <> ")" - - -instance showA :: Show A where - show A = "(A)" - show (B a) = "(B " <> (show a) <> ")" - show (E c) = "(C " <> (show c) <> ")" - -showThemAll :: String -showThemAll = - let - x :: Int - x = 0 -- absurd (unsafeCoerce unit) - in - show $ identity <$> ( - [ show litChar - , show true - , show false - , show $ litChar == litChar - , "---" - , "3 < 10 = " <> show (3 < 10) - , "3.0 < 10.0 = " <> show (3.0 < 10.0) - , "'a' < 'b' = " <> show ('a' < 'b') - , "\"a\" < \"b\" = " <> show ("a" < "b") - , "true < false = " <> show (true < false) - , "false < true = " <> show (false < true) - , "---" - , show $ "[ 1, 2 ] < [ 3, 4 ] = " <> show ([ 1, 2 ] < [ 3, 4 ]) - , "---" - , show $ true == true - , show $ true == false - , show $ false == false - , show $ false == true - , "---" - , show $ true && true - , show $ true && false - , show $ false && false - , show $ false && true - , "---" - , show $ true || true - , show $ true || false - , show $ false || false - , show $ false || true - , "---" - , show $ not true - , show $ not false - , "---" - , show litString - , show litInt - , show litNumber - , show litRecord - , show unit - , show $ B $ B $ E $ D $ B A - , "---" - , show $ [ 100, 200 ] == [ 100, 200 ] - , show $ [ 200, 400 ] == [ 100, 200 ] - , "---" - , "2 + 2 = " <> show (2 + 2) - , "5 * 2 = " <> show (5 * 2) - , "2.0 + 2.0 = " <> show (2.0 + 2.0) - , "5.0 * 2.0 = " <> show (5.0 * 2.0) - , "3 - 2 = " <> show (3 - 2) - , "5.0 - 2.0 = " <> show (5.0 - 2.0) - , "--- apply: ---" - , show $ [(_ * 2)] <*> [ 2 ] - , "--- euclidean ring: ---" - , "0.0 / 0.0 = " <> show (0.0 / 0.0) - , "2.0 / 2.0 = " <> show (2.0 / 2.0) - , "20 / 5 = " <> show (20 / 5) - , "2 % 5 = " <> show (2 `mod` 5) - , "--- bounded: ---" - , "bottom Char: " <> show (bottom :: Char) - , "bottom Int: " <> show (bottom :: Int) - , "bottom Number: " <> show (bottom :: Number) - , "top Char: " <> show (top :: Char) - , "top Int: " <> show (top :: Int) - , "top Number: " <> show (top :: Number) - , "--- concat: ---" - , show $ [] <> [] :: Array Int - , show $ [] <> [ 3.0 ] - , show $ [ 2.0 ] <> [] - , show $ [ 2.0 ] <> [ 3.0 ] - , "--- bind: ---" - , show $ - ((do - _ <- pure 10 - pure 20 - ) :: Array Int) - , "---" - ] <> - let - xs = [ 1, 2, 3 ] - ys = [ 1, 2 ] - in [ show xs, show ys, show ys, show (xs <> ys), show xs, show ys ] - ) - -foreign import consoleLog :: String -> Effect Unit -foreign import runGC :: Effect Unit - -main_2 :: Effect Unit -main_2 = consoleLog - let - x = { a: 100, b: 200 } - y = x { a = 200 } - in - case y of - foo@{ a: 200 } -> - show { foo } - _ -> - show x - -main_3 :: Effect Unit -main_3 = go 1 (mkF unit) - where - go 100 _ = do - consoleLog "done!" - go n f = do - runGC - consoleLog $ f n - runGC - go (n + 1) f - - mkF _ = - let - r _ = { foo: "bar" } - k = r unit - g x = - a <> b <> x <> show k - f x = - g (a <> (show $ x * y)) - y = 2 - a = "hallo: " - b = "welt: " - in f - -main_1 :: Effect Unit -main_1 = go 1 - where - go 100 = do - consoleLog "done!" - go n = do - runGC - consoleLog $ "hello world (" <> show n <> ")" - consoleLog showThemAll - consoleLog $ show $ extend (map (_ * 2)) [ 1, 2, 3 ] - runGC - go (n + 1) - -foreign import usleep :: Int -> Effect Unit - -main :: Effect Unit -main = do - main_1 *> runGC *> usleep 100 - main_2 *> runGC *> usleep 100 - main_3 *> runGC *> usleep 100 diff --git a/examples/mutrec/.gitignore b/examples/mutrec/.gitignore new file mode 100644 index 0000000..30efe19 --- /dev/null +++ b/examples/mutrec/.gitignore @@ -0,0 +1,10 @@ +/bower_components/ +/node_modules/ +/.pulp-cache/ +/output/ +/generated-docs/ +/.psc-package/ +/.psc* +/.purs* +/.psa* +/.spago diff --git a/examples/mutrec/Makefile b/examples/mutrec/Makefile new file mode 100644 index 0000000..b0496c5 --- /dev/null +++ b/examples/mutrec/Makefile @@ -0,0 +1,11 @@ +default: main +.PHONY: default + +PUREC_DIR := ../.. +include $(PUREC_DIR)/mk/target.mk + +.spago: + spago install +main: .spago + +$(eval $(call purs_mk_target,main,Main,src)) diff --git a/examples/mutrec/packages.dhall b/examples/mutrec/packages.dhall new file mode 100644 index 0000000..1e24bba --- /dev/null +++ b/examples/mutrec/packages.dhall @@ -0,0 +1,9 @@ +let mkPackage = ../../package-sets/mkPackage.dhall + +let upstream = ../../package-sets/packages.dhall + +let overrides = {=} + +let additions = {=} + +in upstream ⫽ overrides ⫽ additions diff --git a/examples/mutrec/spago.dhall b/examples/mutrec/spago.dhall new file mode 100644 index 0000000..85b3a3d --- /dev/null +++ b/examples/mutrec/spago.dhall @@ -0,0 +1,9 @@ +{ name = + "purec-example-mutrec" +, dependencies = + [] : List Text +, packages = + ./packages.dhall +, sources = + [ "src/**/*.purs", "test/**/*.purs" ] +} diff --git a/examples/mutrec/src/Main.purs b/examples/mutrec/src/Main.purs new file mode 100644 index 0000000..0893eed --- /dev/null +++ b/examples/mutrec/src/Main.purs @@ -0,0 +1,35 @@ +module Main where + +data Unit = Unit +type Effect a = Unit -> a + +data Step + = Start + | Step1 + | Step2 + | Done + +main :: Effect Int +main _ = + let + f = + case _ of + Start -> + g Step1 + Step1 -> + g Step2 + Step2 -> + g Done + Done -> + 1 -- 'g' should finish! + g = + case _ of + Start -> + f Step1 + Step1 -> + f Step2 + Step2 -> + f Done + Done -> + 0 + in f Start diff --git a/examples/partialfuns/.gitignore b/examples/partialfuns/.gitignore new file mode 100644 index 0000000..30efe19 --- /dev/null +++ b/examples/partialfuns/.gitignore @@ -0,0 +1,10 @@ +/bower_components/ +/node_modules/ +/.pulp-cache/ +/output/ +/generated-docs/ +/.psc-package/ +/.psc* +/.purs* +/.psa* +/.spago diff --git a/examples/partialfuns/Makefile b/examples/partialfuns/Makefile new file mode 100644 index 0000000..b0496c5 --- /dev/null +++ b/examples/partialfuns/Makefile @@ -0,0 +1,11 @@ +default: main +.PHONY: default + +PUREC_DIR := ../.. +include $(PUREC_DIR)/mk/target.mk + +.spago: + spago install +main: .spago + +$(eval $(call purs_mk_target,main,Main,src)) diff --git a/examples/partialfuns/packages.dhall b/examples/partialfuns/packages.dhall new file mode 100644 index 0000000..1e24bba --- /dev/null +++ b/examples/partialfuns/packages.dhall @@ -0,0 +1,9 @@ +let mkPackage = ../../package-sets/mkPackage.dhall + +let upstream = ../../package-sets/packages.dhall + +let overrides = {=} + +let additions = {=} + +in upstream ⫽ overrides ⫽ additions diff --git a/examples/partialfuns/spago.dhall b/examples/partialfuns/spago.dhall new file mode 100644 index 0000000..010f44a --- /dev/null +++ b/examples/partialfuns/spago.dhall @@ -0,0 +1,9 @@ +{ name = + "purec-example-partialfuns" +, dependencies = + [] : List Text +, packages = + ./packages.dhall +, sources = + [ "src/**/*.purs", "test/**/*.purs" ] +} diff --git a/examples/partialfuns/src/Main.purs b/examples/partialfuns/src/Main.purs new file mode 100644 index 0000000..7e48d55 --- /dev/null +++ b/examples/partialfuns/src/Main.purs @@ -0,0 +1,75 @@ +module Main where + +data Unit = Unit +type Effect a = Unit -> a +data Maybe a = Just a | Nothing + +chain :: Effect Int -> Effect Int -> Effect Int +chain a b = \_ -> + let x = a Unit + in + case x of + 0 -> b Unit + n -> n + +infixl 5 chain as >> + +testString :: Effect Int +testString = + let s = "fooBAZ" + in \_ -> + case s of + "fooBAZ" -> 0 + _ -> 1 + +testRecord :: Effect Int +testRecord = + let r = { a: 1, b: 2, c: 0 } + in \_ -> + case r of + { a: 1, b: 2, c: 0 } -> + 0 + _ -> + 1 + +testArray :: Effect Int +testArray = + let xs = [ 1, 2, 0, 3 ] + in \_ -> + case xs of + [_, _, x, _] -> x + _ -> 1 + +uselessArrayIndex :: ∀ a. Array a -> Int -> Maybe a +uselessArrayIndex xs 0 = + case xs of + [x, _] -> Just x + _ -> Nothing +uselessArrayIndex xs 1 = + case xs of + [_, x] -> Just x + _ -> Nothing +uselessArrayIndex _ _ = + Nothing + +twice :: Effect Int -> Effect Int +twice x = x >> x + +main :: Effect Int +main = + let + f = uselessArrayIndex [ 0, 1 ] + in + twice (testArray >> testRecord >> testString) + >> (\_ -> + case f 0 of + Just 0 -> 0 + _ -> 1) + >> (\_ -> + case f 1 of + Just 1 -> 0 + _ -> 1) + >> (\_ -> + case f 2 of + Nothing -> 0 + _ -> 1) diff --git a/examples/prelude/#Makefile# b/examples/prelude/#Makefile# new file mode 100644 index 0000000..7e4f222 --- /dev/null +++ b/examples/prelude/#Makefile# @@ -0,0 +1,12 @@ +default: main +.PHONY: default + +PUREC_DIR := ../.. +include $(PUREC_DIR)/mk/target.mk + +.spago: +ech + spago install +main: .spago + +$(eval $(call purs_mk_target,main,Main,src)) diff --git a/examples/prelude/Makefile b/examples/prelude/Makefile new file mode 100644 index 0000000..b0496c5 --- /dev/null +++ b/examples/prelude/Makefile @@ -0,0 +1,11 @@ +default: main +.PHONY: default + +PUREC_DIR := ../.. +include $(PUREC_DIR)/mk/target.mk + +.spago: + spago install +main: .spago + +$(eval $(call purs_mk_target,main,Main,src)) diff --git a/examples/prelude/packages.dhall b/examples/prelude/packages.dhall new file mode 100644 index 0000000..1e24bba --- /dev/null +++ b/examples/prelude/packages.dhall @@ -0,0 +1,9 @@ +let mkPackage = ../../package-sets/mkPackage.dhall + +let upstream = ../../package-sets/packages.dhall + +let overrides = {=} + +let additions = {=} + +in upstream ⫽ overrides ⫽ additions diff --git a/examples/prelude/spago.dhall b/examples/prelude/spago.dhall new file mode 100644 index 0000000..58e0837 --- /dev/null +++ b/examples/prelude/spago.dhall @@ -0,0 +1,9 @@ +{ name = + "purec-example-prelude" +, dependencies = + [ "prelude" ] +, packages = + ./packages.dhall +, sources = + [ "src/**/*.purs", "test/**/*.purs" ] +} diff --git a/examples/prelude/src/Main.purs b/examples/prelude/src/Main.purs new file mode 100644 index 0000000..ed9c8fa --- /dev/null +++ b/examples/prelude/src/Main.purs @@ -0,0 +1,8 @@ +module Main where + +import Prelude + +type Effect a = Unit -> a + +main :: Effect Int +main _ = 1 diff --git a/examples/example1/Makefile b/examples2/Makefile similarity index 89% rename from examples/example1/Makefile rename to examples2/Makefile index 9a6725e..e633c07 100644 --- a/examples/example1/Makefile +++ b/examples2/Makefile @@ -1,7 +1,7 @@ default: main .PHONY: default -PUREC_DIR := ../.. +PUREC_DIR := .. include $(PUREC_DIR)/mk/target.mk .psc-package: diff --git a/examples2/bower.json b/examples2/bower.json new file mode 100644 index 0000000..e64683f --- /dev/null +++ b/examples2/bower.json @@ -0,0 +1,18 @@ +{ + "name": "purescript-pure-c--examples2", + "private": true, + "ignore": [ + "**/.*", + "node_modules", + "bower_components", + "output" + ], + "dependencies": { + "purescript-prelude": "pure-c/purescript-prelude#master" + }, + "resolutions": { + "purescript-effect": "master", + "purescript-prelude": "master", + "purescript-control": "master" + } +} diff --git a/examples/example2/psc-package.json b/examples2/psc-package.json similarity index 75% rename from examples/example2/psc-package.json rename to examples2/psc-package.json index 8d81796..8db2f7b 100644 --- a/examples/example2/psc-package.json +++ b/examples2/psc-package.json @@ -3,8 +3,5 @@ "set": "master", "source": "https://github.com/pure-c/package-sets", "depends": [ - "prelude", - "control", - "effect" ] } diff --git a/examples2/src/Example1.h b/examples2/src/Example1.h new file mode 100644 index 0000000..0677b8a --- /dev/null +++ b/examples2/src/Example1.h @@ -0,0 +1,11 @@ +#ifndef Example1_H +#define Example1_H + +#include + +PURS_FFI_FUNC_2(Example1_putStr, s, _, { + printf("%s", purs_any_get_string(s)); + return purs_any_null; +}); + +#endif // Example1_H diff --git a/examples2/src/Example1.purs b/examples2/src/Example1.purs new file mode 100644 index 0000000..86ef418 --- /dev/null +++ b/examples2/src/Example1.purs @@ -0,0 +1,20 @@ +module Example1 where + +data Unit = Unit +-- import data Effect :: Type -> Type +type Effect a = Unit -> a + +foreign import putStr :: String -> Effect Int + +main :: Effect Int +main = + let + x :: Unit -> Int + x = \_ -> y Unit + + y :: Unit -> Int + y = \_ -> x Unit + + -- in \ _-> (x Unit).y + in + putStr "test" -- (x Unit).y diff --git a/mk/target.mk b/mk/target.mk index c36ad7a..6afd9b6 100644 --- a/mk/target.mk +++ b/mk/target.mk @@ -15,8 +15,8 @@ PUREC_LIB = $(PUREC_DIR)/libpurec.a PUREC_LIB_DIR = $(dir $(PUREC_LIB)) PUREC_LIB_NAME = $(notdir %/%,%,$(PUREC_LIB)) -PSC_PACKAGE ?= psc-package -PACKAGE_SOURCES = $(shell [ -f psc-package.json ] && $(PSC_PACKAGE) sources) +SPAGO ?= spago +PACKAGE_SOURCES = $(shell [ -d .spago ] && $(SPAGO) sources) OS := $(shell uname) ifeq ($(OS),Darwin) @@ -40,7 +40,7 @@ clean: @rm -f $$(find . -type f -name '*.o') @echo 'removing *.out' @rm -f $$(find . -type f -name '*.out') - @echo 'removing working directory $(PUREC_WORKDIR)' + @echo 'removing dir $(PUREC_WORKDIR)' @rm -rf $(PUREC_WORKDIR) %.o: %.c @@ -138,5 +138,5 @@ _$$(target): $$(PUREC_WORKDIR)/$$(target)/.genc @$$(MAKE) -s $$(PUREC_WORKDIR)/$$(target)/.build $$(target): - @$$(MAKE) _$$(target) + @$$(MAKE) -s _$$(target) endef diff --git a/package-sets/mkPackage.dhall b/package-sets/mkPackage.dhall new file mode 100644 index 0000000..6c72556 --- /dev/null +++ b/package-sets/mkPackage.dhall @@ -0,0 +1,4 @@ +let mkPackage = + https://raw.githubusercontent.com/purescript/package-sets/psc-0.12.5/src/mkPackage.dhall + +in mkPackage diff --git a/package-sets/packages.dhall b/package-sets/packages.dhall new file mode 100644 index 0000000..48112bb --- /dev/null +++ b/package-sets/packages.dhall @@ -0,0 +1,17 @@ +let mkPackage = ./mkPackage.dhall + +let upstream = + https://raw.githubusercontent.com/purescript/package-sets/psc-0.12.5/src/packages.dhall sha256:aee7258b1bf1b81ed5e22d1247e812a80ec2e879758562f33334512ed086c5ae + +let overrides = + { effect = + upstream.effect + // { repo = "/home/felix/projects/pure-c/purescript-effect" } + , prelude = + upstream.prelude + // { repo = "/home/felix/projects/pure-c/purescript-prelude" } + } + +let additions = {=} + +in upstream // overrides // additions diff --git a/package.json b/package.json index b49fd7d..4e5be40 100644 --- a/package.json +++ b/package.json @@ -16,12 +16,12 @@ "devDependencies": { "bower": "^1.8.4", "pulp": "^12.3.0", - "purescript": "^0.12.0" + "purescript": "^0.12.5" }, "scripts": { "test": "echo \"Error: no test specified\" && exit 1", - "build": "pulp build -t purec.js -O", - "watch": "pulp -w build" + "build": "spago bundle-app -t purec.js", + "watch": "spago bundle-app -w -t purec.js" }, "repository": { "type": "git", diff --git a/packages.dhall b/packages.dhall new file mode 100644 index 0000000..ac5b01c --- /dev/null +++ b/packages.dhall @@ -0,0 +1,26 @@ +let mkPackage = + https://raw.githubusercontent.com/purescript/package-sets/psc-0.12.5/src/mkPackage.dhall sha256:0b197efa1d397ace6eb46b243ff2d73a3da5638d8d0ac8473e8e4a8fc528cf57 + +let upstream = + https://raw.githubusercontent.com/purescript/package-sets/psc-0.12.5/src/packages.dhall sha256:aee7258b1bf1b81ed5e22d1247e812a80ec2e879758562f33334512ed086c5ae + +let overrides = {=} + +let additions = + { corefn = + mkPackage + [ "console" + , "foreign-generic" + , "errors" + , "strings" + , "newtype" + , "tuples" + , "foldable-traversable" + , "profunctor" + , "aff" + ] + "https://github.com/felixschl/purescript-corefn.git" + "compiler/0.12.x" + } + +in upstream ⫽ overrides ⫽ additions diff --git a/runtime/purescript.c b/runtime/purescript.c index 7d4bab7..f73175b 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -1,4 +1,4 @@ -#include +#include "runtime/purescript.h" static inline void managed_noop_release (managed_t * managed) {} @@ -28,59 +28,71 @@ const managed_t * managed_new (const void * data, // Any: allocate // ----------------------------------------------------------------------------- -inline ANY purs_any_int_new(const purs_any_int_t i) { +/* todo: turn into macro */ +ANY purs_any_int(const purs_any_int_t i) { ANY v; v.tag = PURS_ANY_TAG_INT; v.value.i = i; return v; } -inline ANY purs_any_num_new(const purs_any_num_t n) { +/* todo: turn into macro */ +ANY purs_any_num(const purs_any_num_t n) { ANY v; v.tag = PURS_ANY_TAG_NUM; v.value.n = n; return v; } -inline ANY purs_any_cont_new(const void * ctx, purs_any_fun_t * fn) { +/* todo: turn into macro */ +ANY purs_any_cont(ANY * ctx, int len, purs_any_fun_t * fn) { ANY v; v.tag = PURS_ANY_TAG_CONT; - v.value.cont.fn = fn; - v.value.cont.ctx = ctx; + v.value.cont = purs_malloc(sizeof (purs_any_cont_t)); + v.value.cont->fn = fn; + v.value.cont->ctx = ctx; + v.value.cont->len = len; return v; } -inline ANY purs_any_thunk_new(const void * ctx, purs_any_thunk_fun_t * fn) { +/* todo: turn into macro */ +ANY purs_any_thunk(ANY ctx, purs_any_thunk_fun_t * fn) { ANY v; v.tag = PURS_ANY_TAG_THUNK; - v.value.thunk.ctx = ctx; - v.value.thunk.fn = fn; + v.value.thunk = purs_malloc(sizeof (purs_any_thunk_t)); + v.value.thunk->ctx = ctx; + v.value.thunk->fn = fn; return v; } -inline ANY purs_any_cons_new(int tag, ANY* values) { +/* todo: turn into macro */ +ANY purs_any_cons(int tag, ANY* values) { ANY v; v.tag = PURS_ANY_TAG_CONS; - v.value.cons.tag = tag; - v.value.cons.values = values; + v.value.cons = purs_malloc(sizeof (purs_any_cons_t)); + v.value.cons->tag = tag; + v.value.cons->values = values; return v; } -inline ANY purs_any_record_new(const purs_record_t * record) { +/* todo: turn into macro */ +ANY purs_any_record(const purs_record_t * record) { ANY v; v.tag = PURS_ANY_TAG_RECORD; v.value.record = record; return v; } -inline ANY purs_any_string_new_mv(const char * ptr) { +/* todo: turn into macro */ +ANY purs_any_string_mv(const char * ptr) { ANY v; v.tag = PURS_ANY_TAG_STRING; v.value.str = managed_new(ptr, managed_noop_release); return v; } -inline ANY purs_any_string_new(const char * fmt, ...) { +/* todo: turn into macro */ +ANY purs_any_string(const char * fmt, ...) { ANY v; v.tag = PURS_ANY_TAG_STRING; va_list ap; @@ -92,21 +104,24 @@ inline ANY purs_any_string_new(const char * fmt, ...) { return v; } -inline ANY purs_any_char_new(utf8_int32_t chr) { +/* todo: turn into macro */ +ANY purs_any_char(utf8_int32_t chr) { ANY v; v.tag = PURS_ANY_TAG_CHAR; v.value.chr = chr; return v; } -inline ANY purs_any_array_new(const purs_vec_t * array) { +/* todo: turn into macro */ +ANY purs_any_array(const purs_vec_t * array) { ANY v; v.tag = PURS_ANY_TAG_ARRAY; v.value.array = array; return v; } -inline ANY purs_any_foreign_new(void * tag, void * data) { +/* todo: turn into macro */ +ANY purs_any_foreign(void * tag, void * data) { ANY v; v.tag = PURS_ANY_TAG_FOREIGN; v.value.foreign.tag = tag; @@ -154,12 +169,17 @@ inline const purs_any_num_t purs_any_get_num (ANY v) { return v.value.n; } -inline purs_any_cont_t purs_any_get_cont (ANY v) { +inline const utf8_int32_t purs_any_get_char (ANY v) { + _PURS_ASSERT_TAG(PURS_ANY_TAG_CHAR); + return v.value.chr; +} + +inline purs_any_cont_t * purs_any_get_cont (ANY v) { _PURS_ASSERT_TAG(PURS_ANY_TAG_CONT); return v.value.cont; } -inline purs_any_cons_t purs_any_get_cons (ANY v) { +inline purs_any_cons_t * purs_any_get_cons (ANY v) { _PURS_ASSERT_TAG(PURS_ANY_TAG_CONS); return v.value.cons; } @@ -169,16 +189,6 @@ inline const purs_record_t * purs_any_get_record (ANY v) { return v.value.record; } -inline const void * purs_any_get_string (ANY v) { - _PURS_ASSERT_TAG(PURS_ANY_TAG_STRING); - return v.value.str->data; -} - -inline const utf8_int32_t purs_any_get_char (ANY v) { - _PURS_ASSERT_TAG(PURS_ANY_TAG_CHAR); - return v.value.chr; -} - inline const purs_vec_t * purs_any_get_array (ANY v) { _PURS_ASSERT_TAG(PURS_ANY_TAG_ARRAY); return v.value.array; @@ -189,6 +199,11 @@ inline purs_foreign_t purs_any_get_foreign (ANY v) { return v.value.foreign; } +inline const void * purs_any_get_string (ANY v) { + _PURS_ASSERT_TAG(PURS_ANY_TAG_STRING); + return v.value.str->data; +} + // ----------------------------------------------------------------------------- // Any // ----------------------------------------------------------------------------- @@ -196,7 +211,7 @@ inline purs_foreign_t purs_any_get_foreign (ANY v) { inline ANY purs_any_unthunk (ANY x) { ANY out = x; while (out.tag == PURS_ANY_TAG_THUNK) { - out = out.value.thunk.fn(out.value.thunk.ctx); + out = out.value.thunk->fn(out.value.thunk->ctx); } return out; } @@ -210,7 +225,7 @@ inline ANY purs_any_app(ANY f, ANY v, ...) { assert(f.tag == PURS_ANY_TAG_CONT); va_list args; va_start(args, v); - ANY r = f.value.cont.fn(f.value.cont.ctx, v, args); + ANY r = f.value.cont->fn(f.value.cont->ctx, v, args); va_end(args); return r; } @@ -219,14 +234,17 @@ inline ANY purs_any_app(ANY f, ANY v, ...) { // Any: built-ins // ----------------------------------------------------------------------------- - ANY purs_any_null = { .tag = PURS_ANY_TAG_NULL }; + ANY purs_any_true = PURS_ANY_INT(1); ANY purs_any_false = PURS_ANY_INT(0); + ANY purs_any_int_zero = PURS_ANY_INT(0); ANY purs_any_num_zero = PURS_ANY_NUM(0.0); + ANY purs_any_int_one = PURS_ANY_INT(1); ANY purs_any_num_one = PURS_ANY_NUM(1.0); + ANY purs_any_NaN = PURS_ANY_NUM(PURS_NAN); ANY purs_any_infinity = PURS_ANY_NUM(PURS_INFINITY); ANY purs_any_neg_infinity = PURS_ANY_NUM(-PURS_INFINITY); @@ -306,7 +324,7 @@ ANY purs_any_concat(ANY x, ANY y) { } else { switch(x.tag) { case PURS_ANY_TAG_STRING: { - return purs_any_string_new( + return purs_any_string( "%s%s", purs_any_get_string(x), purs_any_get_string(y)); @@ -321,7 +339,7 @@ ANY purs_any_concat(ANY x, ANY y) { } else { purs_vec_t * out_vec = (purs_vec_t *) purs_vec_copy(x_vec); vec_pusharr(out_vec, y_vec->data, y_vec->length); - return purs_any_array_new((const purs_vec_t *) out_vec); + return purs_any_array((const purs_vec_t *) out_vec); } } default: @@ -530,41 +548,28 @@ const purs_record_t * purs_record_find_by_key(const purs_record_t * record, // Code-gen helpers // ----------------------------------------------------------------------------- -inline ANY purs_indirect_thunk_new(ANY* x) { - return purs_any_thunk_new(x, purs_thunked_deref); +ANY purs_indirect_thunk_new(ANY * x) { + ANY w = { .value = { .foreign = { .data = x } } }; + return purs_any_thunk(w, purs_thunked_deref); } -inline void purs_indirect_value_assign(ANY* i, ANY v) { - *i = v; +/* todo: convert to macro */ +ANY purs_thunked_deref(ANY ctx) { + return *((ANY*)(ctx.value.foreign.data)); } -inline ANY* purs_indirect_value_new() { +/* todo: convert to macro */ +ANY * purs_indirect_value_new() { return purs_new(ANY); } -inline ANY purs_thunked_deref(const void * data) { - ANY* _data = (ANY*) data; - return *_data; -} - -inline int purs_cons_get_tag (purs_any_cons_t cons) { - return cons.tag; +/* todo: convert to macro */ +void purs_indirect_value_assign(ANY * i, ANY v) { + *i = v; } -inline ANY* _purs_scope_alloc(int num_bindings) { +/* todo: turn into macro */ +ANY* purs_malloc_many(int num_bindings) { if (num_bindings == 0) return NULL; return purs_malloc(num_bindings * sizeof (ANY)); } - -inline ANY* _purs_scope_new(int num_bindings, ANY binding, ...) { - if (num_bindings == 0) return NULL; - ANY* mem = purs_malloc(num_bindings * sizeof (ANY)); - mem[0] = binding; - va_list vl; - va_start(vl, binding); - for (int i = 1; i < num_bindings; i++) { - mem[i] = va_arg(vl, ANY); - } - va_end(vl); - return (ANY*) mem; -} diff --git a/runtime/purescript.h b/runtime/purescript.h index 645e18a..6b856c0 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -45,8 +45,9 @@ #define purs_any_int_t int32_t #define purs_any_num_t double -typedef struct managed managed_t; #define managed_utf8str_t managed_t + +typedef struct managed managed_t; typedef struct purs_any purs_any_t; typedef vec_t(purs_any_t) purs_vec_t; typedef struct purs_record purs_record_t; @@ -54,8 +55,8 @@ typedef struct purs_any_cont purs_any_cont_t; typedef struct purs_any_thunk purs_any_thunk_t; typedef struct purs_any_cons purs_any_cons_t; typedef union purs_any_value purs_any_value_t; -typedef ANY (purs_any_thunk_fun_t)(const void * ctx); -typedef ANY (purs_any_fun_t)(const void * ctx, ANY, va_list); +typedef ANY (purs_any_thunk_fun_t)(ANY ctx); +typedef ANY (purs_any_fun_t)(ANY * ctx, ANY, va_list); typedef struct purs_foreign purs_foreign_t; struct managed { const void * data; }; @@ -77,37 +78,26 @@ typedef enum { PURS_ANY_TAG_FOREIGN = 10, } purs_any_tag_t; -struct purs_any_cont { - purs_any_fun_t * fn; - const void * ctx; -}; - -struct purs_any_thunk { - purs_any_thunk_fun_t * fn; - const void * ctx; -}; - struct purs_foreign { void * tag; void * data; }; -struct purs_any_cons { - int tag; - ANY* values; -}; - union purs_any_value { + + /* inline values */ purs_any_int_t i; purs_any_num_t n; - purs_any_cont_t cont; - purs_any_thunk_t thunk; - purs_any_cons_t cons; + utf8_int32_t chr; + purs_foreign_t foreign; + + /* self-referential, and other values */ + purs_any_cont_t * cont; + purs_any_cons_t * cons; + purs_any_thunk_t * thunk; const purs_record_t * record; const managed_t * str; - utf8_int32_t chr; const purs_vec_t * array; - purs_foreign_t foreign; }; struct purs_any { @@ -115,36 +105,54 @@ struct purs_any { purs_any_value_t value; }; +struct purs_any_thunk { + purs_any_thunk_fun_t * fn; + ANY ctx; +}; + +struct purs_any_cont { + purs_any_fun_t * fn; + int len; + ANY * ctx; +}; + +/* todo: track len values, for clean up */ +struct purs_any_cons { + int tag; + ANY * values; +}; + ANY purs_any_null; +#define purs_any_is_null(x) (x.tag == PURS_ANY_TAG_NULL) ANY purs_any_app(ANY, ANY, ...); ANY purs_any_unthunk (ANY); const purs_any_tag_t purs_any_get_tag (ANY); const char * purs_any_tag_str (const purs_any_tag_t); -ANY purs_any_int_new(const purs_any_int_t); -ANY purs_any_num_new(const purs_any_num_t); -ANY purs_any_cont_new(const void * ctx, purs_any_fun_t *); -ANY purs_any_thunk_new(const void * ctx, purs_any_thunk_fun_t *); -ANY purs_any_cons_new(int tag, ANY* values); -ANY purs_any_record_new(const purs_record_t *); -ANY purs_any_string_new(const char * fmt, ...); -ANY purs_any_char_new(utf8_int32_t); -ANY purs_any_array_new(const purs_vec_t *); -ANY purs_any_foreign_new(void * tag, void * data); +ANY purs_any_int(const purs_any_int_t); +ANY purs_any_num(const purs_any_num_t); +ANY purs_any_cont(ANY * ctx, int len, purs_any_fun_t *); +ANY purs_any_thunk(ANY ctx, purs_any_thunk_fun_t *); +ANY purs_any_cons(int tag, ANY* values); +ANY purs_any_record(const purs_record_t *); +ANY purs_any_string(const char * fmt, ...); +ANY purs_any_char(utf8_int32_t); +ANY purs_any_array(const purs_vec_t *); +ANY purs_any_foreign(void * tag, void * data); /* allocate a new string box with existing, *GC-allocated* data */ ANY purs_any_string_new_mv(const char *); const purs_any_int_t purs_any_get_int (ANY); const purs_any_num_t purs_any_get_num (ANY); -purs_any_cont_t purs_any_get_cont (ANY); -purs_any_cons_t purs_any_get_cons (ANY); +const utf8_int32_t purs_any_get_char (ANY); +purs_foreign_t purs_any_get_foreign (ANY); +purs_any_cont_t * purs_any_get_cont (ANY); +purs_any_cons_t * purs_any_get_cons (ANY); const purs_record_t * purs_any_get_record (ANY); const void * purs_any_get_string (ANY); -const utf8_int32_t purs_any_get_char (ANY); const purs_vec_t * purs_any_get_array (ANY); -purs_foreign_t purs_any_get_foreign (ANY); // ----------------------------------------------------------------------------- // Any: built-in functions @@ -178,9 +186,6 @@ const purs_vec_t * purs_vec_new_va (int count, ...); const purs_vec_t * purs_vec_copy (const purs_vec_t *); const purs_vec_t * purs_vec_slice (const purs_vec_t *, int begin); -#define purs_vec_new_from_array(count, ...)\ - purs_vec_new_va(count, __VA_ARGS__) - #define purs_vec_foreach(v, var, iter)\ vec_foreach(v, var, iter) @@ -273,29 +278,38 @@ purs_record_add_multi(NULL, count, __VA_ARGS__) // Code-gen helpers // ----------------------------------------------------------------------------- +#define PURS_SCOPE_T(NAME, DECLS)\ + typedef struct NAME {\ + struct DECLS;\ + } NAME + +/* todo: remove this! */ +#define purs_cons_get_tag(V) V->tag + /* thunked pointer dereference. useful for recursive bindings */ -ANY* purs_indirect_value_new(); -void purs_indirect_value_assign(ANY*, ANY); -ANY purs_indirect_thunk_new(ANY*); -ANY purs_thunked_deref(const void * data); - -#define purs_any_int_neg(X) purs_any_int_new(-purs_any_get_int(X)) -#define purs_any_int_set_mut(X, V) do { X->value.i = V; } while (0) -#define purs_any_assign_mut(V1, V2)\ - do {\ - ((ANY*) V1)->tag = V2->tag;\ - ((ANY*) V1)->value = V2->value;\ - } while (0) +ANY * purs_indirect_value_new(); +void purs_indirect_value_assign(ANY *, ANY); +ANY purs_indirect_thunk_new(ANY *); +ANY purs_thunked_deref(ANY); + +/* allocate a cons 'value' field large enough to fit 'n' amount of 'ANY' */ +#define PURS_CONS_VALUES_NEW(N) purs_malloc(sizeof (ANY) * N) + +/* #define purs_any_int_neg(X) purs_any_int_new(-purs_any_get_int(X)) */ +/* #define purs_any_int_set_mut(X, V) do { X->value.i = V; } while (0) */ +/* #define purs_any_assign_mut(V1, V2)\ */ +/* do {\ */ +/* V1.tag = V2.tag;\ */ +/* V1.value = V2.value;\ */ +/* } while (0) */ /* code-gen helper to allocate and fill a scope. * assumes scope to consist only of (ANY) pointers, the count of which * is known. */ -ANY* _purs_scope_alloc(int num_bindings); -ANY* _purs_scope_new(int num_bindings, ANY binding, ...); +ANY* purs_malloc_many(int num_bindings); -/* declare a thunked top-level value. - */ +/* declare a thunked top-level value. */ #define PURS_ANY_THUNK_DEF(NAME, INIT)\ static ANY NAME ## __thunk_fn__ (ANY __unused__1) { \ static ANY v;\ @@ -306,26 +320,15 @@ ANY* _purs_scope_new(int num_bindings, ANY binding, ...); }\ return v;\ };\ + purs_any_thunk_t NAME ## __thunk__ = {\ + .fn = NAME ## __thunk_fn__,\ + .ctx = { .tag = PURS_ANY_TAG_NULL }\ + };\ ANY NAME = {\ .tag = PURS_ANY_TAG_THUNK,\ - .value = {\ - .thunk = {\ - .fn = NAME ## __thunk_fn__,\ - .ctx = NULL\ - }\ - }\ + .value = { .thunk = & NAME ## __thunk__ }\ }; -/* allocate a cons 'value' field large enough to fit 'n' amount of 'ANY' - */ -#define PURS_CONS_VALUES_NEW(n)\ - purs_malloc(sizeof (ANY) * n) - -/* simply return the 'tag' of a 'purs_cons_t'. - * todo: remove - */ -int purs_cons_get_tag (purs_any_cons_t cons); - // ----------------------------------------------------------------------------- // Any: initializers // ----------------------------------------------------------------------------- @@ -364,11 +367,6 @@ int purs_cons_get_tag (purs_any_cons_t cons); #define PURS_FFI_EXPORT(NAME)\ ANY NAME ## _$ -#define PURS_SCOPE_T(NAME, DECLS)\ - typedef struct NAME {\ - struct DECLS;\ - } NAME - #define PURS_FFI_VALUE(NAME, INIT)\ static const purs_any_t NAME ## _$ = INIT @@ -377,26 +375,31 @@ int purs_cons_get_tag (purs_any_cons_t cons); // ----------------------------------------------------------------------------- #define _PURS_FFI_FUNC_ENTRY(NAME)\ + purs_any_cont_t NAME ## __cont__ = {\ + .fn = NAME ## __1,\ + .len = 0,\ + .ctx = NULL\ + };\ ANY NAME = {\ .tag = PURS_ANY_TAG_CONT,\ - .value = { .cont = { .fn = NAME##__1, .ctx = NULL } }\ + .value = { .cont = & NAME ## __cont__ }\ };\ /* for code-gen use. todo: remove? */\ ANY NAME ## _$ = {\ .tag = PURS_ANY_TAG_CONT,\ - .value = { .cont = { .fn = NAME##__1, .ctx = NULL } }\ + .value = { .cont = & NAME ## __cont__ }\ } #define _PURS_FFI_FUNC_CONT(NAME, CUR, NEXT)\ - ANY NAME##__##CUR (const void * $__super__, ANY a, va_list $__unused__) {\ - ANY* ctx = _purs_scope_alloc(CUR);\ + ANY NAME##__##CUR (ANY * $__super__, ANY a, va_list $__unused__) {\ + ANY* ctx = purs_malloc_many(CUR);\ if ($__super__ != NULL) {\ memcpy(ctx, $__super__, CUR * sizeof (ANY));\ }\ if (ctx != NULL) {\ ctx[CUR - 1] = a;\ }\ - return purs_any_cont_new(ctx, NAME##__##NEXT);\ + return purs_any_cont(ctx, CUR, NAME##__##NEXT);\ } #define _PURS_FFI_FUNC_CONT_1_TO_2(NAME) _PURS_FFI_FUNC_CONT(NAME, 1, 2) @@ -414,13 +417,13 @@ int purs_cons_get_tag (purs_any_cons_t cons); #define PURS_FFI_FUNC_CONTEXT $__super__ #define PURS_FFI_FUNC_1(NAME, A1, BODY)\ - ANY NAME##__1 (const void * $__super__, ANY A1, va_list $__unused__) {\ + ANY NAME##__1 (ANY * $__super__, ANY A1, va_list $__unused__) {\ BODY;\ }\ _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_2(NAME, A1, A2, BODY)\ - ANY NAME##__2 (const void * $__super__, ANY A2, va_list $__unused__) {\ + ANY NAME##__2 (ANY * $__super__, ANY A2, va_list $__unused__) {\ ANY A1 = ((ANY*)$__super__)[0];\ BODY;\ }\ @@ -428,7 +431,7 @@ int purs_cons_get_tag (purs_any_cons_t cons); _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_3(NAME, A1, A2, A3, BODY)\ - ANY NAME##__3 (const void * $__super__, ANY A3, va_list $__unused__) {\ + ANY NAME##__3 (ANY * $__super__, ANY A3, va_list $__unused__) {\ ANY A1 = ((ANY*)$__super__)[0];\ ANY A2 = ((ANY*)$__super__)[1];\ BODY;\ @@ -438,7 +441,7 @@ int purs_cons_get_tag (purs_any_cons_t cons); _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_4(NAME, A1, A2, A3, A4, BODY)\ - ANY NAME##__4 (const void * $__super__, ANY A4, va_list $__unused__) {\ + ANY NAME##__4 (ANY * $__super__, ANY A4, va_list $__unused__) {\ ANY A1 = ((ANY*)$__super__)[0];\ ANY A2 = ((ANY*)$__super__)[1];\ ANY A3 = ((ANY*)$__super__)[2];\ @@ -450,7 +453,7 @@ int purs_cons_get_tag (purs_any_cons_t cons); _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_5(NAME, A1, A2, A3, A4, A5, BODY)\ - ANY NAME##__5 (const void * $__super__, ANY A5, va_list $__unused__) {\ + ANY NAME##__5 (ANY * $__super__, ANY A5, va_list $__unused__) {\ ANY A1 = ((ANY*)$__super__)[0];\ ANY A2 = ((ANY*)$__super__)[1];\ ANY A3 = ((ANY*)$__super__)[2];\ @@ -464,7 +467,7 @@ int purs_cons_get_tag (purs_any_cons_t cons); _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_6(NAME, A1, A2, A3, A4, A5, A6, BODY)\ - ANY NAME##__6 (const void * $__super__, ANY A6, va_list $__unused__) {\ + ANY NAME##__6 (ANY * $__super__, ANY A6, va_list $__unused__) {\ ANY A1 = ((ANY*)$__super__)[0];\ ANY A2 = ((ANY*)$__super__)[1];\ ANY A3 = ((ANY*)$__super__)[2];\ @@ -480,7 +483,7 @@ int purs_cons_get_tag (purs_any_cons_t cons); _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_7(NAME, A1, A2, A3, A4, A5, A6, A7, BODY)\ - ANY NAME##__7 (const void * $__super__, ANY A7, va_list $__unused__) {\ + ANY NAME##__7 (ANY * $__super__, ANY A7, va_list $__unused__) {\ ANY A1 = ((ANY*)$__super__)[0];\ ANY A2 = ((ANY*)$__super__)[1];\ ANY A3 = ((ANY*)$__super__)[2];\ @@ -498,7 +501,7 @@ int purs_cons_get_tag (purs_any_cons_t cons); _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_8(NAME, A1, A2, A3, A4, A5, A6, A7, A8, BODY)\ - ANY NAME##__8 (const void * $__super__, ANY A8, va_list $__unused__) {\ + ANY NAME##__8 (ANY * $__super__, ANY A8, va_list $__unused__) {\ ANY A1 = ((ANY*)$__super__)[0];\ ANY A2 = ((ANY*)$__super__)[1];\ ANY A3 = ((ANY*)$__super__)[2];\ @@ -518,7 +521,7 @@ int purs_cons_get_tag (purs_any_cons_t cons); _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_9(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, BODY)\ - ANY NAME##__9 (const void * $__super__, ANY A9, va_list $__unused__) {\ + ANY NAME##__9 (ANY * $__super__, ANY A9, va_list $__unused__) {\ ANY A1 = ((ANY*)$__super__)[0];\ ANY A2 = ((ANY*)$__super__)[1];\ ANY A3 = ((ANY*)$__super__)[2];\ @@ -540,7 +543,7 @@ int purs_cons_get_tag (purs_any_cons_t cons); _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_10(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, BODY)\ - ANY NAME##__10 (const void * $__super__, ANY A10, va_list $__unused__) {\ + ANY NAME##__10 (ANY * $__super__, ANY A10, va_list $__unused__) {\ ANY A1 = ((ANY*)$__super__)[0];\ ANY A2 = ((ANY*)$__super__)[1];\ ANY A3 = ((ANY*)$__super__)[2];\ @@ -564,7 +567,7 @@ int purs_cons_get_tag (purs_any_cons_t cons); _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_11(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, BODY)\ - ANY NAME##__11 (const void * $__super__, ANY A11, va_list $__unused__) {\ + ANY NAME##__11 (ANY * $__super__, ANY A11, va_list $__unused__) {\ ANY A1 = ((ANY*)$__super__)[0];\ ANY A2 = ((ANY*)$__super__)[1];\ ANY A3 = ((ANY*)$__super__)[2];\ @@ -590,7 +593,7 @@ int purs_cons_get_tag (purs_any_cons_t cons); _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_12(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, BODY)\ - ANY NAME##__12 (const void * $__super__, ANY A12, va_list $__unused__) {\ + ANY NAME##__12 (ANY * $__super__, ANY A12, va_list $__unused__) {\ ANY A1 = ((ANY*)$__super__)[0];\ ANY A2 = ((ANY*)$__super__)[1];\ ANY A3 = ((ANY*)$__super__)[2];\ @@ -617,161 +620,161 @@ int purs_cons_get_tag (purs_any_cons_t cons); _PURS_FFI_FUNC_CONT_1_TO_2(NAME);\ _PURS_FFI_FUNC_ENTRY(NAME) -// ----------------------------------------------------------------------------- -// FFI: fixed-arity uncurried functions -// ----------------------------------------------------------------------------- - -#define _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME)\ - ANY NAME##__1_ = {\ - .tag = PURS_ANY_TAG_CONT,\ - .value = { .cont = { .fn = NAME, .ctx = NULL } }\ - };\ - ANY NAME ## _$ = & NAME##__1_ - -#define PURS_FFI_FUNC_UNCURRIED_1(NAME, A1, BODY)\ - ANY NAME (const void * $__super__, ANY A1, va_list $__unused__) {\ - BODY;\ - }\ - _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) - -#define PURS_FFI_FUNC_UNCURRIED_2(NAME, A1, A2, BODY)\ - ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ - ANY A2 = va_arg(vl, ANY);\ - BODY;\ - }\ - _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) - -#define PURS_FFI_FUNC_UNCURRIED_3(NAME, A1, A2, A3, BODY)\ - ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ - ANY A2 = va_arg(vl, ANY);\ - ANY A3 = va_arg(vl, ANY);\ - BODY;\ - }\ - _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) - -#define PURS_FFI_FUNC_UNCURRIED_4(NAME, A1, A2, A3, A4, BODY)\ - ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ - ANY A2 = va_arg(vl, ANY);\ - ANY A3 = va_arg(vl, ANY);\ - ANY A4 = va_arg(vl, ANY);\ - BODY;\ - }\ - _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) - -#define PURS_FFI_FUNC_UNCURRIED_5(NAME, A1, A2, A3, A4, A5, BODY)\ - ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ - ANY A2 = va_arg(vl, ANY);\ - ANY A3 = va_arg(vl, ANY);\ - ANY A4 = va_arg(vl, ANY);\ - ANY A5 = va_arg(vl, ANY);\ - BODY;\ - }\ - _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) - -#define PURS_FFI_FUNC_UNCURRIED_6(NAME, A1, A2, A3, A4, A5, A6, BODY)\ - ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ - ANY A2 = va_arg(vl, ANY);\ - ANY A3 = va_arg(vl, ANY);\ - ANY A4 = va_arg(vl, ANY);\ - ANY A5 = va_arg(vl, ANY);\ - ANY A6 = va_arg(vl, ANY);\ - BODY;\ - }\ - _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) - -#define PURS_FFI_FUNC_UNCURRIED_7(NAME, A1, A2, A3, A4, A5, A6, A7, BODY)\ - ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ - ANY A2 = va_arg(vl, ANY);\ - ANY A3 = va_arg(vl, ANY);\ - ANY A4 = va_arg(vl, ANY);\ - ANY A5 = va_arg(vl, ANY);\ - ANY A6 = va_arg(vl, ANY);\ - ANY A7 = va_arg(vl, ANY);\ - BODY;\ - }\ - _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) - -#define PURS_FFI_FUNC_UNCURRIED_8(NAME, A1, A2, A3, A4, A5, A6, A7, A8, BODY)\ - ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ - ANY A2 = va_arg(vl, ANY);\ - ANY A3 = va_arg(vl, ANY);\ - ANY A4 = va_arg(vl, ANY);\ - ANY A5 = va_arg(vl, ANY);\ - ANY A6 = va_arg(vl, ANY);\ - ANY A7 = va_arg(vl, ANY);\ - ANY A8 = va_arg(vl, ANY);\ - BODY;\ - }\ - _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) - -#define PURS_FFI_FUNC_UNCURRIED_9(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, BODY)\ - ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ - ANY A2 = va_arg(vl, ANY);\ - ANY A3 = va_arg(vl, ANY);\ - ANY A4 = va_arg(vl, ANY);\ - ANY A5 = va_arg(vl, ANY);\ - ANY A6 = va_arg(vl, ANY);\ - ANY A7 = va_arg(vl, ANY);\ - ANY A8 = va_arg(vl, ANY);\ - ANY A9 = va_arg(vl, ANY);\ - BODY;\ - }\ - _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) - -#define PURS_FFI_FUNC_UNCURRIED_10(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, BODY)\ - ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ - ANY A2 = va_arg(vl, ANY);\ - ANY A3 = va_arg(vl, ANY);\ - ANY A4 = va_arg(vl, ANY);\ - ANY A5 = va_arg(vl, ANY);\ - ANY A6 = va_arg(vl, ANY);\ - ANY A7 = va_arg(vl, ANY);\ - ANY A8 = va_arg(vl, ANY);\ - ANY A9 = va_arg(vl, ANY);\ - ANY A10 = va_arg(vl, ANY);\ - BODY;\ - }\ - _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) - -#define PURS_FFI_FUNC_UNCURRIED_11(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, BODY)\ - ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ - ANY A2 = va_arg(vl, ANY);\ - ANY A3 = va_arg(vl, ANY);\ - ANY A4 = va_arg(vl, ANY);\ - ANY A5 = va_arg(vl, ANY);\ - ANY A6 = va_arg(vl, ANY);\ - ANY A7 = va_arg(vl, ANY);\ - ANY A8 = va_arg(vl, ANY);\ - ANY A9 = va_arg(vl, ANY);\ - ANY A10 = va_arg(vl, ANY);\ - ANY A11 = va_arg(vl, ANY);\ - BODY;\ - }\ - _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) - -#define PURS_FFI_FUNC_UNCURRIED_12(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, BODY)\ - ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ - ANY A2 = va_arg(vl, ANY);\ - ANY A3 = va_arg(vl, ANY);\ - ANY A4 = va_arg(vl, ANY);\ - ANY A5 = va_arg(vl, ANY);\ - ANY A6 = va_arg(vl, ANY);\ - ANY A7 = va_arg(vl, ANY);\ - ANY A8 = va_arg(vl, ANY);\ - ANY A9 = va_arg(vl, ANY);\ - ANY A10 = va_arg(vl, ANY);\ - ANY A11 = va_arg(vl, ANY);\ - ANY A12 = va_arg(vl, ANY);\ - BODY;\ - }\ - _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) +/* // ----------------------------------------------------------------------------- */ +/* // FFI: fixed-arity uncurried functions */ +/* // ----------------------------------------------------------------------------- */ + +/* #define _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME)\ */ +/* ANY NAME##__1_ = {\ */ +/* .tag = PURS_ANY_TAG_CONT,\ */ +/* .value = { .cont = { .fn = NAME, .ctx = purs_any_null } }\ */ +/* };\ */ +/* ANY NAME ## _$ = & NAME##__1_ */ + +/* #define PURS_FFI_FUNC_UNCURRIED_1(NAME, A1, BODY)\ */ +/* ANY NAME (const void * $__super__, ANY A1, va_list $__unused__) {\ */ +/* BODY;\ */ +/* }\ */ +/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ + +/* #define PURS_FFI_FUNC_UNCURRIED_2(NAME, A1, A2, BODY)\ */ +/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ +/* ANY A2 = va_arg(vl, ANY);\ */ +/* BODY;\ */ +/* }\ */ +/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ + +/* #define PURS_FFI_FUNC_UNCURRIED_3(NAME, A1, A2, A3, BODY)\ */ +/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ +/* ANY A2 = va_arg(vl, ANY);\ */ +/* ANY A3 = va_arg(vl, ANY);\ */ +/* BODY;\ */ +/* }\ */ +/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ + +/* #define PURS_FFI_FUNC_UNCURRIED_4(NAME, A1, A2, A3, A4, BODY)\ */ +/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ +/* ANY A2 = va_arg(vl, ANY);\ */ +/* ANY A3 = va_arg(vl, ANY);\ */ +/* ANY A4 = va_arg(vl, ANY);\ */ +/* BODY;\ */ +/* }\ */ +/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ + +/* #define PURS_FFI_FUNC_UNCURRIED_5(NAME, A1, A2, A3, A4, A5, BODY)\ */ +/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ +/* ANY A2 = va_arg(vl, ANY);\ */ +/* ANY A3 = va_arg(vl, ANY);\ */ +/* ANY A4 = va_arg(vl, ANY);\ */ +/* ANY A5 = va_arg(vl, ANY);\ */ +/* BODY;\ */ +/* }\ */ +/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ + +/* #define PURS_FFI_FUNC_UNCURRIED_6(NAME, A1, A2, A3, A4, A5, A6, BODY)\ */ +/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ +/* ANY A2 = va_arg(vl, ANY);\ */ +/* ANY A3 = va_arg(vl, ANY);\ */ +/* ANY A4 = va_arg(vl, ANY);\ */ +/* ANY A5 = va_arg(vl, ANY);\ */ +/* ANY A6 = va_arg(vl, ANY);\ */ +/* BODY;\ */ +/* }\ */ +/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ + +/* #define PURS_FFI_FUNC_UNCURRIED_7(NAME, A1, A2, A3, A4, A5, A6, A7, BODY)\ */ +/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ +/* ANY A2 = va_arg(vl, ANY);\ */ +/* ANY A3 = va_arg(vl, ANY);\ */ +/* ANY A4 = va_arg(vl, ANY);\ */ +/* ANY A5 = va_arg(vl, ANY);\ */ +/* ANY A6 = va_arg(vl, ANY);\ */ +/* ANY A7 = va_arg(vl, ANY);\ */ +/* BODY;\ */ +/* }\ */ +/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ + +/* #define PURS_FFI_FUNC_UNCURRIED_8(NAME, A1, A2, A3, A4, A5, A6, A7, A8, BODY)\ */ +/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ +/* ANY A2 = va_arg(vl, ANY);\ */ +/* ANY A3 = va_arg(vl, ANY);\ */ +/* ANY A4 = va_arg(vl, ANY);\ */ +/* ANY A5 = va_arg(vl, ANY);\ */ +/* ANY A6 = va_arg(vl, ANY);\ */ +/* ANY A7 = va_arg(vl, ANY);\ */ +/* ANY A8 = va_arg(vl, ANY);\ */ +/* BODY;\ */ +/* }\ */ +/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ + +/* #define PURS_FFI_FUNC_UNCURRIED_9(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, BODY)\ */ +/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ +/* ANY A2 = va_arg(vl, ANY);\ */ +/* ANY A3 = va_arg(vl, ANY);\ */ +/* ANY A4 = va_arg(vl, ANY);\ */ +/* ANY A5 = va_arg(vl, ANY);\ */ +/* ANY A6 = va_arg(vl, ANY);\ */ +/* ANY A7 = va_arg(vl, ANY);\ */ +/* ANY A8 = va_arg(vl, ANY);\ */ +/* ANY A9 = va_arg(vl, ANY);\ */ +/* BODY;\ */ +/* }\ */ +/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ + +/* #define PURS_FFI_FUNC_UNCURRIED_10(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, BODY)\ */ +/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ +/* ANY A2 = va_arg(vl, ANY);\ */ +/* ANY A3 = va_arg(vl, ANY);\ */ +/* ANY A4 = va_arg(vl, ANY);\ */ +/* ANY A5 = va_arg(vl, ANY);\ */ +/* ANY A6 = va_arg(vl, ANY);\ */ +/* ANY A7 = va_arg(vl, ANY);\ */ +/* ANY A8 = va_arg(vl, ANY);\ */ +/* ANY A9 = va_arg(vl, ANY);\ */ +/* ANY A10 = va_arg(vl, ANY);\ */ +/* BODY;\ */ +/* }\ */ +/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ + +/* #define PURS_FFI_FUNC_UNCURRIED_11(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, BODY)\ */ +/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ +/* ANY A2 = va_arg(vl, ANY);\ */ +/* ANY A3 = va_arg(vl, ANY);\ */ +/* ANY A4 = va_arg(vl, ANY);\ */ +/* ANY A5 = va_arg(vl, ANY);\ */ +/* ANY A6 = va_arg(vl, ANY);\ */ +/* ANY A7 = va_arg(vl, ANY);\ */ +/* ANY A8 = va_arg(vl, ANY);\ */ +/* ANY A9 = va_arg(vl, ANY);\ */ +/* ANY A10 = va_arg(vl, ANY);\ */ +/* ANY A11 = va_arg(vl, ANY);\ */ +/* BODY;\ */ +/* }\ */ +/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ + +/* #define PURS_FFI_FUNC_UNCURRIED_12(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, BODY)\ */ +/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ +/* ANY A2 = va_arg(vl, ANY);\ */ +/* ANY A3 = va_arg(vl, ANY);\ */ +/* ANY A4 = va_arg(vl, ANY);\ */ +/* ANY A5 = va_arg(vl, ANY);\ */ +/* ANY A6 = va_arg(vl, ANY);\ */ +/* ANY A7 = va_arg(vl, ANY);\ */ +/* ANY A8 = va_arg(vl, ANY);\ */ +/* ANY A9 = va_arg(vl, ANY);\ */ +/* ANY A10 = va_arg(vl, ANY);\ */ +/* ANY A11 = va_arg(vl, ANY);\ */ +/* ANY A12 = va_arg(vl, ANY);\ */ +/* BODY;\ */ +/* }\ */ +/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ // ----------------------------------------------------------------------------- // Prim shims // note: See codegen notes about '_$' suffix // ----------------------------------------------------------------------------- -#define Prim_undefined_$ NULL +#define Prim_undefined_$ purs_any_null // ----------------------------------------------------------------------------- // Built-ins @@ -789,13 +792,17 @@ ANY purs_any_num_zero; (V == 1) \ ? purs_any_true \ : purs_any_false + #define purs_any_not(V) \ purs_any_is_true(V) \ ? purs_any_false \ : purs_any_true + +/* todo: inline definition */ #define purs_any_is_true(V) purs_any_eq(V, purs_any_true) + +/* todo: inline definition */ #define purs_any_is_false(V) purs_any_eq(V, purs_any_false) -#define purs_any_while(COND) while(purs_any_is_true(COND)) /* check for NaN: https://stackoverflow.com/a/570694 */ #define purs_any_is_NaN(V) (purs_any_get_tag(V) == PURS_ANY_TAG_NUM && \ diff --git a/spago.dhall b/spago.dhall new file mode 100644 index 0000000..0c981e5 --- /dev/null +++ b/spago.dhall @@ -0,0 +1,27 @@ +{ name = + "purec" +, dependencies = + [ "aff" + , "avar" + , "node-fs-aff" + , "node-streams" + , "corefn" + , "spec" + , "argonaut" + , "nullable" + , "console" + , "effect" + , "prelude" + , "free" + , "psci-support" + , "debug" + , "node-process" + , "node-child-process" + , "foreign" + , "node-readline" + ] +, packages = + ./packages.dhall +, sources = + [ "src/**/*.purs", "test/**/*.purs" ] +} diff --git a/src/Language/PureScript/CodeGen/C.purs b/src/Language/PureScript/CodeGen/C.purs index d47feab..1cfc0b2 100644 --- a/src/Language/PureScript/CodeGen/C.purs +++ b/src/Language/PureScript/CodeGen/C.purs @@ -238,19 +238,19 @@ exprToAst (C.Var ann (C.Qualified mModuleName ident)) = exprToAst (C.Literal _ (C.NumericLiteral n)) = pure $ AST.App - (either (const R.purs_any_int_new) (const R.purs_any_num_new) n) + (either (const R.purs_any_int) (const R.purs_any_num) n) [ AST.NumericLiteral n ] exprToAst (C.Literal _ (C.StringLiteral s)) = pure $ AST.App - R.purs_any_string_new + R.purs_any_string [ AST.StringLiteral s ] exprToAst (C.Literal _ (C.CharLiteral c)) = pure $ AST.App - R.purs_any_char_new + R.purs_any_char [ AST.NumericLiteral $ Left $ Int.toCharCode c ] exprToAst (C.Literal _ (C.BooleanLiteral b)) = @@ -262,9 +262,9 @@ exprToAst (C.Literal _ (C.ArrayLiteral xs)) = ado asts <- traverse exprToAst xs in AST.App - R.purs_any_array_new $ + R.purs_any_array $ [ AST.App - R.purs_vec_new_from_array $ + R.purs_vec_new_va $ [ AST.NumericLiteral $ Left $ A.length xs ] <> if A.null asts @@ -282,7 +282,7 @@ exprToAst (C.Literal _ (C.ObjectLiteral kvps)) = ado R.purs_record_empty else AST.App - R.purs_any_record_new $ + R.purs_any_record $ [ AST.App R.purs_record_new_from_kvps $ [ AST.NumericLiteral $ Left $ A.length kvpAsts @@ -305,7 +305,7 @@ exprToAst (C.Let _ binders val) = ado AST.Block $ bindersAsts <> [ AST.Return valAst ] } - , AST.Null + , R.purs_any_null ] exprToAst (C.Case (C.Ann { sourceSpan, type: typ }) exprs binders) = do @@ -378,7 +378,7 @@ exprToAst (C.Case (C.Ann { sourceSpan, type: typ }) exprs binders) = do , [ R.purs_assert' "Failed Pattern Match" ] ] } - , AST.Null + , R.purs_any_null ] where @@ -631,7 +631,7 @@ exprToAst (C.Constructor _ typeName (C.ProperName constructorName) fields) } ] <> assignments <> [ AST.Return $ - AST.App R.purs_any_cons_new + AST.App R.purs_any_cons [ AST.Var $ safeConstructorName $ qualifiedVarName moduleName constructorName , AST.Var valuesName ] @@ -662,7 +662,7 @@ exprToAst (C.Constructor _ typeName (C.ProperName constructorName) _) = do safeConstructorName $ qualifiedVarName moduleName constructorName pure $ AST.App - R.purs_any_cons_new + R.purs_any_cons [ AST.Var constructorName' , AST.Null ] @@ -706,7 +706,7 @@ exprToAst (C.ObjectUpdate _ o ps) = ado sts <- traverse (\(n /\ exp) -> (n /\ _) <$> exprToAst exp) ps temp <- freshName in - AST.App R.purs_any_record_new + AST.App R.purs_any_record [ AST.App R.purs_record_add_multi $ [ AST.App R.purs_any_get_record [ valueAst ] , AST.NumericLiteral (Left $ A.length sts) diff --git a/src/Language/PureScript/CodeGen/C/File.purs b/src/Language/PureScript/CodeGen/C/File.purs index df06c8a..f2d1690 100644 --- a/src/Language/PureScript/CodeGen/C/File.purs +++ b/src/Language/PureScript/CodeGen/C/File.purs @@ -92,12 +92,12 @@ toBody = A.catMaybes <<< map go go' = case _ of AST.Cast _ ast@(AST.App f _) | f `A.elem` - [ R.purs_any_cons_new - , R.purs_any_int_new - , R.purs_any_num_new - , R.purs_any_string_new - , R.purs_any_record_new - , R.purs_any_array_new + [ R.purs_any_cons + , R.purs_any_int + , R.purs_any_num + , R.purs_any_string + , R.purs_any_record + , R.purs_any_array ] -> go' ast _ -> @@ -125,11 +125,12 @@ nativeMain mainVar = , body: Just $ AST.Block [ AST.App (AST.Var "GC_INIT") [] - , AST.App - R.purs_any_app - [ mainVar - , R.purs_any_null - ] - , AST.Return (AST.NumericLiteral (Left 0)) + , AST.Return $ + AST.App R.purs_any_get_int + [ AST.App R.purs_any_app + [ mainVar + , R.purs_any_null + ] + ] ] } diff --git a/src/Language/PureScript/CodeGen/C/Optimizer/Inliner.purs b/src/Language/PureScript/CodeGen/C/Optimizer/Inliner.purs index 4aab735..a9902a9 100644 --- a/src/Language/PureScript/CodeGen/C/Optimizer/Inliner.purs +++ b/src/Language/PureScript/CodeGen/C/Optimizer/Inliner.purs @@ -190,7 +190,7 @@ inlineCommonValues = AST.everywhere go isDict (C.dataRing /\ C.negate) fn = case extractIntLit x of Just n -> - AST.App R.purs_any_int_new [ AST.NumericLiteral (Left (-n)) ] + AST.App R.purs_any_int [ AST.NumericLiteral (Left (-n)) ] Nothing -> AST.App R.purs_any_int_neg [ x ] @@ -212,7 +212,7 @@ inlineCommonValues = AST.everywhere go -- inline operations on two integers. if two litera extractIntLit (AST.App fn [ AST.NumericLiteral (Left n) ]) - | fn == R.purs_any_int_new = + | fn == R.purs_any_int = Just n extractIntLit _ = Nothing @@ -224,14 +224,14 @@ inlineCommonValues = AST.everywhere go intBinOp x y op = case extractIntLit x, extractIntLit y of Just x', Just y' -> - AST.App R.purs_any_int_new + AST.App R.purs_any_int [ AST.NumericLiteral $ Left case op of Add -> x' + y' Sub -> x' - y' Mul -> x' * y' ] mLitX, mLitY -> - AST.App R.purs_any_int_new + AST.App R.purs_any_int [ AST.Binary (toASTBinOp op) (maybe (AST.App R.purs_any_get_int [ x ]) diff --git a/src/Language/PureScript/CodeGen/C/Optimizer/TCO.purs b/src/Language/PureScript/CodeGen/C/Optimizer/TCO.purs index 4b2b4d2..5250d3d 100644 --- a/src/Language/PureScript/CodeGen/C/Optimizer/TCO.purs +++ b/src/Language/PureScript/CodeGen/C/Optimizer/TCO.purs @@ -141,7 +141,7 @@ tco = AST.everywhere convert , qualifiers: [] , initialization: Just $ - AST.App R.purs_any_int_new + AST.App R.purs_any_int [ AST.NumericLiteral $ Left 0 ] } diff --git a/src/Language/PureScript/CodeGen/C/Transforms.purs b/src/Language/PureScript/CodeGen/C/Transforms.purs index 10a1176..77f6961 100644 --- a/src/Language/PureScript/CodeGen/C/Transforms.purs +++ b/src/Language/PureScript/CodeGen/C/Transforms.purs @@ -346,7 +346,7 @@ eraseLambdas moduleName asts = then AST.Null else AST.App - R._purs_scope_alloc $ + R.purs_malloc_many $ [ AST.NumericLiteral $ Left $ A.length scopeStruct.members ] @@ -358,8 +358,10 @@ eraseLambdas moduleName asts = , initialization: Just $ AST.App - R.purs_any_cont_new + R.purs_any_cont [ AST.Var "$_scope" + , AST.NumericLiteral $ + Left $ Set.size capturedScope.bindings , AST.Cast (Type.Pointer (R.void [ Type.Const ])) $ AST.Var contFuncName ] diff --git a/src/Language/PureScript/CodeGen/Runtime.purs b/src/Language/PureScript/CodeGen/Runtime.purs index 6d23293..77a3877 100644 --- a/src/Language/PureScript/CodeGen/Runtime.purs +++ b/src/Language/PureScript/CodeGen/Runtime.purs @@ -28,19 +28,18 @@ module Language.PureScript.CodeGen.Runtime , purs_any_int_neg -- any: allocations - , purs_any_cont_new - , purs_any_array_new - , purs_any_cons_new - , purs_any_record_new - , purs_any_int_new - , purs_any_num_new - , purs_any_string_new - , purs_any_char_new + , purs_any_cont + , purs_any_array + , purs_any_cons + , purs_any_record + , purs_any_int + , purs_any_num + , purs_any_string + , purs_any_char , purs_any_copy -- code-gen helpers - , _purs_scope_alloc - , _purs_scope_new + , purs_malloc_many , _PURS_SCOPE_T , _PURS_CONS_VALUES_NEW , purs_indirect_thunk_new @@ -56,7 +55,7 @@ module Language.PureScript.CodeGen.Runtime , purs_cons_t , purs_record_t , purs_cons_get_tag - , purs_vec_new_from_array + , purs_vec_new_va , purs_record_empty , purs_record_find_by_key , purs_record_copy_shallow @@ -157,8 +156,8 @@ purs_record_copy_shallow = AST.Var "purs_record_copy_shallow" purs_record_add_multi :: AST purs_record_add_multi = AST.Var "purs_record_add_multi" -purs_vec_new_from_array :: AST -purs_vec_new_from_array = AST.Var "purs_vec_new_from_array" +purs_vec_new_va :: AST +purs_vec_new_va = AST.Var "purs_vec_new_va" _PURS_ANY_THUNK_DEF :: AST _PURS_ANY_THUNK_DEF = AST.Var "PURS_ANY_THUNK_DEF" @@ -166,29 +165,29 @@ _PURS_ANY_THUNK_DEF = AST.Var "PURS_ANY_THUNK_DEF" _PURS_ANY_THUNK_DECL :: AST _PURS_ANY_THUNK_DECL = AST.Var "PURS_ANY_THUNK_DECL" -purs_any_cons_new :: AST -purs_any_cons_new = AST.Var "purs_any_cons_new" +purs_any_cons :: AST +purs_any_cons = AST.Var "purs_any_cons" -purs_any_int_new :: AST -purs_any_int_new = AST.Var "purs_any_int_new" +purs_any_int :: AST +purs_any_int = AST.Var "purs_any_int" -purs_any_char_new :: AST -purs_any_char_new = AST.Var "purs_any_char_new" +purs_any_char :: AST +purs_any_char = AST.Var "purs_any_char" -purs_any_num_new :: AST -purs_any_num_new = AST.Var "purs_any_num_new" +purs_any_num :: AST +purs_any_num = AST.Var "purs_any_num" -purs_any_array_new :: AST -purs_any_array_new = AST.Var "purs_any_array_new" +purs_any_array :: AST +purs_any_array = AST.Var "purs_any_array" -purs_any_record_new :: AST -purs_any_record_new = AST.Var "purs_any_record_new" +purs_any_record :: AST +purs_any_record = AST.Var "purs_any_record" -purs_any_cont_new :: AST -purs_any_cont_new = AST.Var "purs_any_cont_new" +purs_any_cont :: AST +purs_any_cont = AST.Var "purs_any_cont" -purs_any_string_new :: AST -purs_any_string_new = AST.Var "purs_any_string_new" +purs_any_string :: AST +purs_any_string = AST.Var "purs_any_string" purs_any_copy :: AST purs_any_copy = AST.Var "purs_any_copy" @@ -211,11 +210,8 @@ purs_any_assign_mut = AST.Var "purs_any_assign_mut" _PURS_CONS_VALUES_NEW :: AST _PURS_CONS_VALUES_NEW = AST.Var "PURS_CONS_VALUES_NEW" -_purs_scope_alloc :: AST -_purs_scope_alloc = AST.Var "_purs_scope_alloc" - -_purs_scope_new :: AST -_purs_scope_new = AST.Var "_purs_scope_new" +purs_malloc_many :: AST +purs_malloc_many = AST.Var "purs_malloc_many" _PURS_SCOPE_T :: AST _PURS_SCOPE_T = AST.Var "PURS_SCOPE_T" diff --git a/test.c b/test.c new file mode 100644 index 0000000..9cd24a1 --- /dev/null +++ b/test.c @@ -0,0 +1,24 @@ +#include "runtime/purescript.h" + +ANY f(ANY ctx) { + return ctx; +} + +ANY g(ANY * ctx, ANY _, va_list __) { + return purs_any_thunk_new(ctx[1], f); +} + +ANY k() { + ANY * ctx; + + ctx = purs_malloc(sizeof (ANY) * 2); + ctx[0] = purs_any_int_new(1); + ctx[1] = purs_any_int_new(3); + + return purs_any_cont_new(ctx, 2, g); +} + +int main () { + ANY x = k(); + return purs_any_get_int(purs_any_unthunk(purs_any_app(x, purs_any_null))); +} diff --git a/test/Main.purs b/test/Main.purs index 76737a1..8376811 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -1,174 +1,20 @@ -module Test.Main where +module Test.Main + ( main + ) where import Prelude -import Control.Monad.Error.Class (throwError) -import Control.Monad.Except.Trans (catchError) -import Control.Parallel (parSequence_, parTraverse_, parallel, sequential) -import Data.Array as A -import Data.Either (Either(..)) -import Data.Maybe (Maybe(..), maybe) -import Data.Newtype (wrap) -import Data.String (Pattern(..)) -import Data.String as Str -import Data.Traversable (for, for_) -import Debug.Trace (traceM) +import Data.Maybe (Maybe(..)) import Effect (Effect) -import Effect.Aff (Aff, launchAff_) +import Effect.Aff (launchAff_) import Effect.Class (liftEffect) -import Effect.Exception (Error) -import Language.PureScript.CodeGen.C.Pretty (PrintError) as C -import Language.PureScript.CodeGen.CompileError (CompileError) as C -import Node.Encoding (Encoding(..)) -import Node.FS.Aff as FS -import Node.Path (FilePath) -import Test.Spec (describe, it, pending) -import Test.Spec.Reporter as Spec +import Test.Spec.Reporter (specReporter) as Spec import Test.Spec.Runner (defaultConfig, run') as Spec -import Test.Utils (runProc) - -data PipelineError - = CompileError C.CompileError - | PrintError C.PrintError - --- | A list of (currently) unsupported tests from upstream -blackList :: Array String -blackList = - [ -- compat issues: - "NumberLiterals" -- due to show instance for numbers - - -- corefn issues: - , "NegativeIntInRange" - , "StringEdgeCases" -- https://github.com/paulyoung/purescript-corefn/issues/57 - , "StringEscapes" -- https://github.com/paulyoung/purescript-corefn/issues/57 - - -- missing dependencies: - , "GenericsRep" - -- depends on: - -- + purescript-enums (https://github.com/pure-c/pure-c/issues/35) - ] +import Test.Upstream (buildUpstreamTestSuite) main :: Effect Unit -main = - let - testsDirectory = - "upstream/tests/purs/passing" - outputDir = - ".tmp/output" - outputDirCache = - outputDir <> ".cache" - in launchAff_ do - - tests <- sequential ado - -- prepare the output directory: build the project at least once - parallel do - mkdirp outputDirCache - FS.writeTextFile UTF8 (outputDirCache <> "/Makefile") makefileContents - FS.writeTextFile UTF8 (outputDirCache <> "/Main.purs") """ -module Main where -data Unit = Unit -main :: Unit -> Unit -main _ = Unit -""" - void $ make outputDirCache [outputDirCache <> "/Main.purs"] - void $ runProc "rm" [ "-f", outputDirCache <> "/Main.purs"] - tests <- parallel $ discoverPureScriptTests testsDirectory - in tests - - liftEffect $ - Spec.run' (Spec.defaultConfig { timeout = Just 10000 }) [Spec.specReporter] $ - describe "PureScript's 'passing' tests" $ - for_ tests case _ of - { name } | name `A.elem` blackList -> - pending name - { name, files } -> - it name do - runProc "rm" [ "-rf", outputDir ] - runProc "rsync" [ "-a", outputDirCache <> "/", outputDir <> "/" ] - make outputDir files >>= runProc <@> [] - - where - make outputDir sources = - outputDir <> "/main.out" <$ do - FS.writeTextFile UTF8 (outputDir <> "/sources") $ - A.intercalate "\n" sources - runProc "make" [ "-s", "-j", "16", "-C", outputDir ] - -makefileContents :: String -makefileContents = """ -default: premain -.PHONY: default - -PUREC_DIR := ../.. -include $(PUREC_DIR)/mk/target.mk - -SHELL := /bin/bash - -srcs := $(addprefix ../../,$(shell cat sources)) - -premain: $(srcs) - @touch $^ || { :; } - @cp "$(PUREC_DIR)"/upstream/tests/support/psc-package.json . - @psc-package install - @$(MAKE) -s main - -$(eval $(call purs_mk_target,main,Main,$(srcs))) -""" - -discoverPureScriptTests - :: FilePath - -> Aff (Array - { name :: String - , directory :: FilePath - , files :: Array FilePath - }) -discoverPureScriptTests testsDirectory = do - testFiles <- FS.readdir testsDirectory - map A.catMaybes $ - for testFiles \file -> - for (Str.stripSuffix (Pattern ".purs") file) \moduleName -> ado - subModules <- - (FS.readdir $ testsDirectory <> "/" <> moduleName) - `catchError` \e -> - if errorCode e == Just "ENOENT" - then pure [] - else throwError e - in - { name: moduleName - , directory: testsDirectory - , files: - (testsDirectory <> "/" <> file) A.: - (((testsDirectory <> "/" <> moduleName <> "/") <> _) <$> subModules) - } - -foreign import errorCodeImpl - :: ∀ a - . Maybe a - -> (a -> Maybe a) - -> Error - -> Maybe String - -errorCode :: Error -> Maybe String -errorCode = errorCodeImpl Nothing Just - --- TODO Pick up a library for this -mkdirp :: String -> Aff Unit -mkdirp dir = go Nothing (Str.split (wrap "/") dir) - where - go cd xs - | Just { head: x, tail: xs' } <- A.uncons xs - = - let - cd' = - maybe "" (_ <> "/") cd <> x - in do - unless (Str.null cd') do - mkdir cd' - go (Just cd') xs' - go _ _ = - pure unit - - mkdir dir' = - FS.mkdir dir' `catchError` \e -> - unless (errorCode e == Just "EEXIST") do - throwError e +main = launchAff_ do + upstreamSpec <- buildUpstreamTestSuite + liftEffect $ + Spec.run' (Spec.defaultConfig { timeout = Just 10000 }) [Spec.specReporter] $ + upstreamSpec diff --git a/test/Upstream.purs b/test/Upstream.purs new file mode 100644 index 0000000..3addcbd --- /dev/null +++ b/test/Upstream.purs @@ -0,0 +1,129 @@ +module Test.Upstream + ( buildUpstreamTestSuite + ) where + +import Prelude + +import Control.Monad.Error.Class (throwError) +import Control.Monad.Except.Trans (catchError) +import Control.Parallel (parallel, sequential) +import Data.Array as A +import Data.Maybe (Maybe(..)) +import Data.String (Pattern(..)) +import Data.String as Str +import Data.Traversable (for, for_) +import Effect.Aff (Aff) +import Node.Encoding (Encoding(..)) +import Node.FS.Aff as FS +import Node.Path (FilePath) +import Test.Spec (Spec, describe, it, pending) +import Test.Utils (errorCode, mkdirp, runProc) + +-- | A list of (currently) unsupported tests from upstream +blackList :: Array String +blackList = + [ -- compat issues: + "NumberLiterals" -- due to show instance for numbers + + -- corefn issues: + , "NegativeIntInRange" + , "StringEdgeCases" -- https://github.com/paulyoung/purescript-corefn/issues/57 + , "StringEscapes" -- https://github.com/paulyoung/purescript-corefn/issues/57 + + -- missing dependencies: + , "GenericsRep" + -- depends on: + -- + purescript-enums (https://github.com/pure-c/pure-c/issues/35) + ] + +buildUpstreamTestSuite :: Aff (Spec Unit) +buildUpstreamTestSuite = + let + testsDirectory = + "upstream/tests/purs/passing" + outputDir = + ".tmp/output" + cacheDir = + outputDir <> ".cache" + in ado + tests <- sequential ado + parallel $ prepareCacheDir cacheDir + tests <- parallel $ discoverPureScriptTests testsDirectory + in tests + in + describe "PureScript's 'passing' tests" $ + for_ tests case _ of + { name } | name `A.elem` blackList -> + pending name + { name, files } -> + it name do + runProc "rm" [ "-rf", outputDir ] + runProc "rsync" [ "-a", cacheDir <> "/", outputDir <> "/" ] + make outputDir files >>= runProc <@> [] + +-- | Run make, return the produced output +make :: FilePath -> Array FilePath -> Aff FilePath +make dir pursSources = + dir <> "/main.out" <$ do + FS.writeTextFile UTF8 (dir <> "/sources") $ + A.intercalate "\n" pursSources + runProc "make" [ "-s", "-j", "16", "-C", dir ] + +-- | prepare the output directory and build the project at least once +prepareCacheDir :: FilePath -> Aff Unit +prepareCacheDir dir = do + mkdirp dir + FS.writeTextFile UTF8 (dir <> "/Makefile") """ +default: premain +.PHONY: default + +PUREC_DIR := ../.. +include $(PUREC_DIR)/mk/target.mk + +SHELL := /bin/bash + +srcs := $(addprefix ../../,$(shell cat sources)) + +premain: $(srcs) + @touch $^ || { :; } + @cp "$(PUREC_DIR)"/upstream/tests/support/psc-package.json . + @psc-package install + @$(MAKE) -s main + +$(eval $(call purs_mk_target,main,Main,$(srcs))) +""" + FS.writeTextFile UTF8 (dir <> "/Main.purs") """ +module Main where +data Unit = Unit +main :: Unit -> Unit +main _ = Unit +""" + void $ make dir [dir <> "/Main.purs"] + void $ runProc "rm" [ "-f", dir <> "/Main.purs"] + +discoverPureScriptTests + :: FilePath + -> Aff + (Array + { name :: String + , directory :: FilePath + , files :: Array FilePath + }) +discoverPureScriptTests testsDirectory = do + testFiles <- FS.readdir testsDirectory + map A.catMaybes $ + for testFiles \file -> + for (Str.stripSuffix (Pattern ".purs") file) \moduleName -> ado + subModules <- + (FS.readdir $ testsDirectory <> "/" <> moduleName) + `catchError` \e -> + if errorCode e == Just "ENOENT" + then pure [] + else throwError e + in + { name: moduleName + , directory: testsDirectory + , files: + (testsDirectory <> "/" <> file) A.: + (((testsDirectory <> "/" <> moduleName <> "/") <> _) <$> subModules) + } diff --git a/test/Main.js b/test/Utils.js similarity index 100% rename from test/Main.js rename to test/Utils.js diff --git a/test/Utils.purs b/test/Utils.purs index 46f3333..1eefd0e 100644 --- a/test/Utils.purs +++ b/test/Utils.purs @@ -1,16 +1,24 @@ module Test.Utils ( runProc + , mkdirp + , errorCode ) where import Prelude +import Control.Monad.Error.Class (catchError, throwError) +import Data.Array as A +import Data.Maybe (Maybe(..), maybe) +import Data.Newtype (wrap) +import Data.String as Str import Effect.Aff (Aff, launchAff_) import Effect.Aff.AVar as AVar import Effect.Class (liftEffect) import Effect.Class.Console as Console -import Effect.Exception (error) +import Effect.Exception (Error, error) import Node.ChildProcess as ChildProcess import Node.ChildProcess as ChildProcess.Exit +import Node.FS.Aff as FS import Node.ReadLine as RL -- | Run a process for it's side-effect @@ -44,3 +52,35 @@ runProc cmd args = do ChildProcess.Exit.BySignal signal -> launchAff_ $ AVar.kill (error $ "Received Signal: " <> show signal) v AVar.take v + +foreign import errorCodeImpl + :: ∀ a + . Maybe a + -> (a -> Maybe a) + -> Error + -> Maybe String + +errorCode :: Error -> Maybe String +errorCode = errorCodeImpl Nothing Just + +-- TODO Pick up a library for this +mkdirp :: String -> Aff Unit +mkdirp dir = go Nothing (Str.split (wrap "/") dir) + where + go cd xs + | Just { head: x, tail: xs' } <- A.uncons xs + = + let + cd' = + maybe "" (_ <> "/") cd <> x + in do + unless (Str.null cd') do + mkdir cd' + go (Just cd') xs' + go _ _ = + pure unit + + mkdir dir' = + FS.mkdir dir' `catchError` \e -> + unless (errorCode e == Just "EEXIST") do + throwError e From 60c33f64cb1668d1bf365bc1dec9d7248439b483 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Fri, 12 Jul 2019 13:47:16 +1200 Subject: [PATCH 03/67] Get rid of 'examples2' folder --- examples2/Makefile | 11 ----------- examples2/bower.json | 18 ------------------ examples2/psc-package.json | 7 ------- examples2/src/Example1.h | 11 ----------- examples2/src/Example1.purs | 20 -------------------- 5 files changed, 67 deletions(-) delete mode 100644 examples2/Makefile delete mode 100644 examples2/bower.json delete mode 100644 examples2/psc-package.json delete mode 100644 examples2/src/Example1.h delete mode 100644 examples2/src/Example1.purs diff --git a/examples2/Makefile b/examples2/Makefile deleted file mode 100644 index e633c07..0000000 --- a/examples2/Makefile +++ /dev/null @@ -1,11 +0,0 @@ -default: main -.PHONY: default - -PUREC_DIR := .. -include $(PUREC_DIR)/mk/target.mk - -.psc-package: - psc-package install -main: .psc-package - -$(eval $(call purs_mk_target,main,Example1,src)) diff --git a/examples2/bower.json b/examples2/bower.json deleted file mode 100644 index e64683f..0000000 --- a/examples2/bower.json +++ /dev/null @@ -1,18 +0,0 @@ -{ - "name": "purescript-pure-c--examples2", - "private": true, - "ignore": [ - "**/.*", - "node_modules", - "bower_components", - "output" - ], - "dependencies": { - "purescript-prelude": "pure-c/purescript-prelude#master" - }, - "resolutions": { - "purescript-effect": "master", - "purescript-prelude": "master", - "purescript-control": "master" - } -} diff --git a/examples2/psc-package.json b/examples2/psc-package.json deleted file mode 100644 index 8db2f7b..0000000 --- a/examples2/psc-package.json +++ /dev/null @@ -1,7 +0,0 @@ -{ - "name": "purec-example-example2", - "set": "master", - "source": "https://github.com/pure-c/package-sets", - "depends": [ - ] -} diff --git a/examples2/src/Example1.h b/examples2/src/Example1.h deleted file mode 100644 index 0677b8a..0000000 --- a/examples2/src/Example1.h +++ /dev/null @@ -1,11 +0,0 @@ -#ifndef Example1_H -#define Example1_H - -#include - -PURS_FFI_FUNC_2(Example1_putStr, s, _, { - printf("%s", purs_any_get_string(s)); - return purs_any_null; -}); - -#endif // Example1_H diff --git a/examples2/src/Example1.purs b/examples2/src/Example1.purs deleted file mode 100644 index 86ef418..0000000 --- a/examples2/src/Example1.purs +++ /dev/null @@ -1,20 +0,0 @@ -module Example1 where - -data Unit = Unit --- import data Effect :: Type -> Type -type Effect a = Unit -> a - -foreign import putStr :: String -> Effect Int - -main :: Effect Int -main = - let - x :: Unit -> Int - x = \_ -> y Unit - - y :: Unit -> Int - y = \_ -> x Unit - - -- in \ _-> (x Unit).y - in - putStr "test" -- (x Unit).y From 5138def93db59b0d86c49054edb22ce46b6dc712 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Fri, 12 Jul 2019 13:49:54 +1200 Subject: [PATCH 04/67] Remove 'test.c' --- test.c | 24 ------------------------ 1 file changed, 24 deletions(-) delete mode 100644 test.c diff --git a/test.c b/test.c deleted file mode 100644 index 9cd24a1..0000000 --- a/test.c +++ /dev/null @@ -1,24 +0,0 @@ -#include "runtime/purescript.h" - -ANY f(ANY ctx) { - return ctx; -} - -ANY g(ANY * ctx, ANY _, va_list __) { - return purs_any_thunk_new(ctx[1], f); -} - -ANY k() { - ANY * ctx; - - ctx = purs_malloc(sizeof (ANY) * 2); - ctx[0] = purs_any_int_new(1); - ctx[1] = purs_any_int_new(3); - - return purs_any_cont_new(ctx, 2, g); -} - -int main () { - ANY x = k(); - return purs_any_get_int(purs_any_unthunk(purs_any_app(x, purs_any_null))); -} From 81be146ce761c3763448676f0da1dff933bedbea Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Fri, 12 Jul 2019 13:50:20 +1200 Subject: [PATCH 05/67] Fix warning in ctests stub function --- ctests/test_arrays.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ctests/test_arrays.c b/ctests/test_arrays.c index cd6eea5..ce91f86 100644 --- a/ctests/test_arrays.c +++ b/ctests/test_arrays.c @@ -1,7 +1,7 @@ #include "runtime/purescript.h" - int test_empty_array () { + return 0; } int test_arrays () { From def99407a599cfdaf1e1df288c200bb9175170e7 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Fri, 12 Jul 2019 17:52:48 +1200 Subject: [PATCH 06/67] Add tests for dealing with prelude and foreign values --- examples/foreign/.gitignore | 10 +++++++ examples/foreign/Makefile | 11 ++++++++ examples/foreign/packages.dhall | 9 +++++++ examples/foreign/spago.dhall | 9 +++++++ examples/foreign/src/Main.h | 35 ++++++++++++++++++++++++ examples/foreign/src/Main.purs | 31 ++++++++++++++++++++++ examples/prelude/src/Main.h | 11 ++++++++ examples/prelude/src/Main.purs | 47 ++++++++++++++++++++++++++++++++- runtime/purescript.c | 2 +- 9 files changed, 163 insertions(+), 2 deletions(-) create mode 100644 examples/foreign/.gitignore create mode 100644 examples/foreign/Makefile create mode 100644 examples/foreign/packages.dhall create mode 100644 examples/foreign/spago.dhall create mode 100644 examples/foreign/src/Main.h create mode 100644 examples/foreign/src/Main.purs create mode 100644 examples/prelude/src/Main.h diff --git a/examples/foreign/.gitignore b/examples/foreign/.gitignore new file mode 100644 index 0000000..30efe19 --- /dev/null +++ b/examples/foreign/.gitignore @@ -0,0 +1,10 @@ +/bower_components/ +/node_modules/ +/.pulp-cache/ +/output/ +/generated-docs/ +/.psc-package/ +/.psc* +/.purs* +/.psa* +/.spago diff --git a/examples/foreign/Makefile b/examples/foreign/Makefile new file mode 100644 index 0000000..b0496c5 --- /dev/null +++ b/examples/foreign/Makefile @@ -0,0 +1,11 @@ +default: main +.PHONY: default + +PUREC_DIR := ../.. +include $(PUREC_DIR)/mk/target.mk + +.spago: + spago install +main: .spago + +$(eval $(call purs_mk_target,main,Main,src)) diff --git a/examples/foreign/packages.dhall b/examples/foreign/packages.dhall new file mode 100644 index 0000000..1e24bba --- /dev/null +++ b/examples/foreign/packages.dhall @@ -0,0 +1,9 @@ +let mkPackage = ../../package-sets/mkPackage.dhall + +let upstream = ../../package-sets/packages.dhall + +let overrides = {=} + +let additions = {=} + +in upstream ⫽ overrides ⫽ additions diff --git a/examples/foreign/spago.dhall b/examples/foreign/spago.dhall new file mode 100644 index 0000000..ee9d183 --- /dev/null +++ b/examples/foreign/spago.dhall @@ -0,0 +1,9 @@ +{ name = + "purec-example-foreign" +, dependencies = + [] : List Text +, packages = + ./packages.dhall +, sources = + [ "src/**/*.purs", "test/**/*.purs" ] +} diff --git a/examples/foreign/src/Main.h b/examples/foreign/src/Main.h new file mode 100644 index 0000000..c16c370 --- /dev/null +++ b/examples/foreign/src/Main.h @@ -0,0 +1,35 @@ +#ifndef MAIN_H +#define MAIN_H + +#include + +struct buf { + char * data; /* heap-allocated buffer */ + int size; +}; + +PURS_FFI_FUNC_1(Main_newBuffer, _, { + struct buf * buf = purs_new(struct buf); + buf->data = NULL; + buf->size = 0; + return purs_any_foreign(NULL, buf); +}); + +PURS_FFI_FUNC_2(Main_bufferSize, x, _, { + assert(x.tag == PURS_ANY_TAG_FOREIGN); + struct buf * buf = (struct buf *) x.value.foreign.data; + return purs_any_int(buf->size); +}); + +PURS_FFI_FUNC_3(Main_bufferGrow, n_, x, _, { + assert(x.tag == PURS_ANY_TAG_FOREIGN); + int n = purs_any_get_int(n_); + struct buf * buf = (struct buf *) x.value.foreign.data; + char * data = purs_malloc(sizeof (char) * (buf->size + n)); + memcpy(data, buf->data, buf->size); + buf->size += n; + buf->data = data; + return purs_any_int(buf->size); +}); + +#endif // MAIN_H diff --git a/examples/foreign/src/Main.purs b/examples/foreign/src/Main.purs new file mode 100644 index 0000000..0ddac4c --- /dev/null +++ b/examples/foreign/src/Main.purs @@ -0,0 +1,31 @@ +module Main where + +data Unit = Unit +type Effect a = Unit -> a + +foreign import data Buffer :: Type +foreign import newBuffer :: Effect Buffer +foreign import bufferSize :: Buffer -> Effect Int +foreign import bufferGrow :: Int -> Buffer -> Effect Int + +pureE :: ∀ a. a -> Effect a +pureE n _ = n + +bindE :: ∀ a b. Effect a -> (a -> Effect b) -> Effect b +bindE a f _ = (f (a Unit)) Unit + +infixl 5 bindE as >>= + +main :: Effect Int +main = + newBuffer >>= \buf -> + bufferSize buf >>= case _ of + 0 -> + bufferGrow 20 buf >>= \_ -> + bufferSize buf >>= case _ of + 20 -> + pureE 0 + _ -> + pureE 1 + _ -> + pureE 1 diff --git a/examples/prelude/src/Main.h b/examples/prelude/src/Main.h new file mode 100644 index 0000000..f9ff507 --- /dev/null +++ b/examples/prelude/src/Main.h @@ -0,0 +1,11 @@ +#ifndef Main_H +#define Main_H + +#include + +PURS_FFI_FUNC_2(Main_putStrLn, s, _, { + printf("%s\n", purs_any_get_string(s)); + return purs_any_int_zero; +}); + +#endif // Main_H diff --git a/examples/prelude/src/Main.purs b/examples/prelude/src/Main.purs index ed9c8fa..c300de2 100644 --- a/examples/prelude/src/Main.purs +++ b/examples/prelude/src/Main.purs @@ -4,5 +4,50 @@ import Prelude type Effect a = Unit -> a +chainE :: Effect Int -> Effect Int -> Effect Int +chainE a b = \_ -> + let x = a unit + in + case x of + 0 -> b unit + n -> n + +infixl 5 chainE as >> + +pureE :: ∀ a. a -> Effect a +pureE n _ = n + +check :: Boolean -> Effect Int +check = pureE <<< if _ then 0 else 1 + +runE :: ∀ a. Effect a -> a +runE f = f unit + +foreign import putStrLn :: String -> Effect Int + main :: Effect Int -main _ = 1 +main = + let + x = pureE 5 + y = pureE 2 + z = pureE $ runE x * runE y + a = pureE $ runE x + runE y + b = pureE $ runE x - runE y + c = pureE $ runE x / runE y + in + check (runE z == 10) + >> check (runE a == 7) + >> check (runE b == 3) + >> check (runE c == 2) + >> check (show ([] :: Array Int) == "[]") + >> check (show [ 99 ] == "[99]") + >> check (show [ 1, 2, 3 ] == "[1, 2, 3]") + >> check (show "" == "\"\"") + >> check (show "\"" == "\"\"\"") + >> check (show {} == "{}") + >> check (show { a: [ 1 ] } == "{ a: [1] }") + >> check ([ 1, 2, 3 ] == [ 1, 2, 3 ]) + >> check (map show [ 1, 2, 3 ] == [ "1", "2", "3" ]) + >> check (show (map show [ 1, 2, 3 ]) == "[\"1\", \"2\", \"3\"]") + >> check (map (_ * 3) [ 1, 2, 3 ] == [ 3, 6, 9 ]) + >> check (pure 3 == [ 3 ]) diff --git a/runtime/purescript.c b/runtime/purescript.c index f73175b..851da65 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -135,7 +135,7 @@ ANY purs_any_foreign(void * tag, void * data) { inline const char * purs_any_tag_str (const purs_any_tag_t tag) { static const char * tags[] = { - "UNKNOWN", + "NULL", "INT", "NUM", "CONT", From 0d7d0c612fac686d208509148b1fbacf3eab5612 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Fri, 12 Jul 2019 22:12:01 +1200 Subject: [PATCH 07/67] Update TCO implementation --- examples/memory/.gitignore | 10 ++ examples/memory/Makefile | 11 ++ examples/memory/packages.dhall | 9 ++ examples/memory/spago.dhall | 9 ++ examples/memory/src/Main.h | 10 ++ examples/memory/src/Main.purs | 12 ++ packages.dhall | 2 +- runtime/purescript.c | 9 +- runtime/purescript.h | 56 ++++++--- src/Language/PureScript/CodeGen/C.purs | 2 +- .../CodeGen/C/Optimizer/Inliner.purs | 2 +- .../PureScript/CodeGen/C/Optimizer/TCO.purs | 114 ++++++++++-------- src/Language/PureScript/CodeGen/Runtime.purs | 40 +++--- 13 files changed, 193 insertions(+), 93 deletions(-) create mode 100644 examples/memory/.gitignore create mode 100644 examples/memory/Makefile create mode 100644 examples/memory/packages.dhall create mode 100644 examples/memory/spago.dhall create mode 100644 examples/memory/src/Main.h create mode 100644 examples/memory/src/Main.purs diff --git a/examples/memory/.gitignore b/examples/memory/.gitignore new file mode 100644 index 0000000..30efe19 --- /dev/null +++ b/examples/memory/.gitignore @@ -0,0 +1,10 @@ +/bower_components/ +/node_modules/ +/.pulp-cache/ +/output/ +/generated-docs/ +/.psc-package/ +/.psc* +/.purs* +/.psa* +/.spago diff --git a/examples/memory/Makefile b/examples/memory/Makefile new file mode 100644 index 0000000..b0496c5 --- /dev/null +++ b/examples/memory/Makefile @@ -0,0 +1,11 @@ +default: main +.PHONY: default + +PUREC_DIR := ../.. +include $(PUREC_DIR)/mk/target.mk + +.spago: + spago install +main: .spago + +$(eval $(call purs_mk_target,main,Main,src)) diff --git a/examples/memory/packages.dhall b/examples/memory/packages.dhall new file mode 100644 index 0000000..1e24bba --- /dev/null +++ b/examples/memory/packages.dhall @@ -0,0 +1,9 @@ +let mkPackage = ../../package-sets/mkPackage.dhall + +let upstream = ../../package-sets/packages.dhall + +let overrides = {=} + +let additions = {=} + +in upstream ⫽ overrides ⫽ additions diff --git a/examples/memory/spago.dhall b/examples/memory/spago.dhall new file mode 100644 index 0000000..b6cb421 --- /dev/null +++ b/examples/memory/spago.dhall @@ -0,0 +1,9 @@ +{ name = + "purec-example-memory" +, dependencies = + [] : List Text +, packages = + ./packages.dhall +, sources = + [ "src/**/*.purs", "test/**/*.purs" ] +} diff --git a/examples/memory/src/Main.h b/examples/memory/src/Main.h new file mode 100644 index 0000000..c6dbd3c --- /dev/null +++ b/examples/memory/src/Main.h @@ -0,0 +1,10 @@ +#ifndef MAIN_H +#define MAIN_H + +#include + +PURS_FFI_FUNC_2(Main_sub, x, y, { + return purs_any_int(purs_any_get_int(x) - purs_any_get_int(y)); +}); + +#endif // MAIN_H diff --git a/examples/memory/src/Main.purs b/examples/memory/src/Main.purs new file mode 100644 index 0000000..e75895b --- /dev/null +++ b/examples/memory/src/Main.purs @@ -0,0 +1,12 @@ +module Main where + +data Unit = Unit +type Effect a = Unit -> a + +foreign import sub :: Int -> Int -> Int + +main :: Effect Int +main _ = go { a: 100000 } + where + go { a: 0 } = 0 + go x = go (x { a = sub x.a 1 }) diff --git a/packages.dhall b/packages.dhall index ac5b01c..4d23a39 100644 --- a/packages.dhall +++ b/packages.dhall @@ -23,4 +23,4 @@ let additions = "compiler/0.12.x" } -in upstream ⫽ overrides ⫽ additions +in upstream // overrides // additions diff --git a/runtime/purescript.c b/runtime/purescript.c index 851da65..3b9024b 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -45,7 +45,7 @@ ANY purs_any_num(const purs_any_num_t n) { } /* todo: turn into macro */ -ANY purs_any_cont(ANY * ctx, int len, purs_any_fun_t * fn) { +ANY purs_any_cont(ANY * ctx, int len, purs_any_cont_fun_t * fn) { ANY v; v.tag = PURS_ANY_TAG_CONT; v.value.cont = purs_malloc(sizeof (purs_any_cont_t)); @@ -348,13 +348,6 @@ ANY purs_any_concat(ANY x, ANY y) { } } -inline ANY purs_any_copy(ANY src) { - ANY copy; - copy.tag = src.tag; - copy.value = src.value; - return copy; -} - // ----------------------------------------------------------------------------- // strings // ----------------------------------------------------------------------------- diff --git a/runtime/purescript.h b/runtime/purescript.h index 6b856c0..6bb752e 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -56,7 +56,7 @@ typedef struct purs_any_thunk purs_any_thunk_t; typedef struct purs_any_cons purs_any_cons_t; typedef union purs_any_value purs_any_value_t; typedef ANY (purs_any_thunk_fun_t)(ANY ctx); -typedef ANY (purs_any_fun_t)(ANY * ctx, ANY, va_list); +typedef ANY (purs_any_cont_fun_t)(ANY * ctx, ANY, va_list); typedef struct purs_foreign purs_foreign_t; struct managed { const void * data; }; @@ -111,7 +111,7 @@ struct purs_any_thunk { }; struct purs_any_cont { - purs_any_fun_t * fn; + purs_any_cont_fun_t * fn; int len; ANY * ctx; }; @@ -132,7 +132,7 @@ const char * purs_any_tag_str (const purs_any_tag_t); ANY purs_any_int(const purs_any_int_t); ANY purs_any_num(const purs_any_num_t); -ANY purs_any_cont(ANY * ctx, int len, purs_any_fun_t *); +ANY purs_any_cont(ANY * ctx, int len, purs_any_cont_fun_t *); ANY purs_any_thunk(ANY ctx, purs_any_thunk_fun_t *); ANY purs_any_cons(int tag, ANY* values); ANY purs_any_record(const purs_record_t *); @@ -165,7 +165,6 @@ int purs_any_eq_num (ANY, double); int purs_any_eq(ANY, ANY); ANY purs_any_concat(ANY, ANY); -ANY purs_any_copy(ANY); // ----------------------------------------------------------------------------- // strings @@ -278,6 +277,28 @@ purs_record_add_multi(NULL, count, __VA_ARGS__) // Code-gen helpers // ----------------------------------------------------------------------------- +struct tco_state { + int done; + purs_any_t * args; +}; + +#define purs_tco_state_new(N)\ + ({\ + struct tco_state x;\ + x.done = 0;\ + x.args = purs_malloc(sizeof (ANY) * N);\ + x;\ + }) +#define purs_tco_is_done(X) (X.done == 1) +#define purs_tco_set_done(X) (((struct tco_state *) X)->done = 1) +#define purs_tco_get_arg(X, I) (((struct tco_state *) X)->args[I]) +#define purs_tco_set_arg(X, I, V) (X.args[I] = V) +#define purs_tco_mut_arg(X, I, V) (((struct tco_state *) X)->args[I] = V) + +#define purs_foreign_get_data(X)\ + (X.data) + +/* emit a scope struct */ #define PURS_SCOPE_T(NAME, DECLS)\ typedef struct NAME {\ struct DECLS;\ @@ -285,6 +306,8 @@ purs_record_add_multi(NULL, count, __VA_ARGS__) /* todo: remove this! */ #define purs_cons_get_tag(V) V->tag +#define purs_address_of(V) &V +#define purs_derefence(V) *V /* thunked pointer dereference. useful for recursive bindings */ ANY * purs_indirect_value_new(); @@ -292,21 +315,10 @@ void purs_indirect_value_assign(ANY *, ANY); ANY purs_indirect_thunk_new(ANY *); ANY purs_thunked_deref(ANY); -/* allocate a cons 'value' field large enough to fit 'n' amount of 'ANY' */ -#define PURS_CONS_VALUES_NEW(N) purs_malloc(sizeof (ANY) * N) - -/* #define purs_any_int_neg(X) purs_any_int_new(-purs_any_get_int(X)) */ -/* #define purs_any_int_set_mut(X, V) do { X->value.i = V; } while (0) */ -/* #define purs_any_assign_mut(V1, V2)\ */ -/* do {\ */ -/* V1.tag = V2.tag;\ */ -/* V1.value = V2.value;\ */ -/* } while (0) */ +/* allocate a buffer to fit 'N' 'ANY's */ +#define purs_malloc_any_buf(N) purs_malloc(sizeof (ANY) * N) -/* code-gen helper to allocate and fill a scope. - * assumes scope to consist only of (ANY) pointers, the count of which - * is known. - */ +/* code-gen helper to allocate and fill a scope. */ ANY* purs_malloc_many(int num_bindings); /* declare a thunked top-level value. */ @@ -329,6 +341,14 @@ ANY* purs_malloc_many(int num_bindings); .value = { .thunk = & NAME ## __thunk__ }\ }; +/* #define purs_any_int_neg(X) purs_any_int_new(-purs_any_get_int(X)) */ +/* #define purs_any_int_set_mut(X, V) do { X->value.i = V; } while (0) */ +/* #define purs_any_assign_mut(V1, V2)\ */ +/* do {\ */ +/* V1.tag = V2.tag;\ */ +/* V1.value = V2.value;\ */ +/* } while (0) */ + // ----------------------------------------------------------------------------- // Any: initializers // ----------------------------------------------------------------------------- diff --git a/src/Language/PureScript/CodeGen/C.purs b/src/Language/PureScript/CodeGen/C.purs index 1cfc0b2..9115607 100644 --- a/src/Language/PureScript/CodeGen/C.purs +++ b/src/Language/PureScript/CodeGen/C.purs @@ -626,7 +626,7 @@ exprToAst (C.Constructor _ typeName (C.ProperName constructorName) fields) , initialization: Just $ AST.App - R._PURS_CONS_VALUES_NEW + R.purs_malloc_any_buf [ AST.NumericLiteral (Left $ A.length fields) ] } ] <> assignments <> [ diff --git a/src/Language/PureScript/CodeGen/C/Optimizer/Inliner.purs b/src/Language/PureScript/CodeGen/C/Optimizer/Inliner.purs index a9902a9..f71c6da 100644 --- a/src/Language/PureScript/CodeGen/C/Optimizer/Inliner.purs +++ b/src/Language/PureScript/CodeGen/C/Optimizer/Inliner.purs @@ -82,7 +82,7 @@ unThunk = AST.everywhere go (AST.App (AST.Var "purs_any_app") [ AST.Function { arguments: [], body: Just (AST.Block body) } - , AST.Null + , AST.Var "purs_any_null" ]) } -> AST.Block $ init <> body diff --git a/src/Language/PureScript/CodeGen/C/Optimizer/TCO.purs b/src/Language/PureScript/CodeGen/C/Optimizer/TCO.purs index 5250d3d..bb53ba3 100644 --- a/src/Language/PureScript/CodeGen/C/Optimizer/TCO.purs +++ b/src/Language/PureScript/CodeGen/C/Optimizer/TCO.purs @@ -12,8 +12,10 @@ import Data.Maybe (Maybe(..)) import Data.Newtype (wrap) import Data.String as Str import Data.Tuple.Nested ((/\)) +import Debug.Trace (trace) import Language.PureScript.CodeGen.C.AST (AST) import Language.PureScript.CodeGen.C.AST as AST +import Language.PureScript.CodeGen.C.AST as Type import Language.PureScript.CodeGen.Runtime as R -- | Eliminate tail calls @@ -25,7 +27,8 @@ tco = AST.everywhere convert convert x@(AST.App (AST.Var "purs_indirect_value_assign") - [ v@(AST.Var internalIdent), (fn@AST.Function _)]) + [ v@(AST.Var internalIdent), (fn@AST.Function _) + ]) | Just name <- Str.stripPrefix (wrap "$_indirect_") internalIdent = let args /\ body /\ replace = @@ -45,13 +48,10 @@ tco = AST.everywhere convert else x convert x = x - tcoDone = "$_tco_done" + tcoState = "$_tco_state" tcoLoop = "$_tco_loop" tcoResult = "$_tco_result" - copyVar n = "$_copy_" <> n - copyFnArg a = a { name = copyVar a.name } - collectFnArgs = go [] identity where go acc f (AST.Function fn@{ arguments, body: Just (AST.Block sts) }) @@ -124,28 +124,25 @@ tco = AST.everywhere convert toLoop :: String -> Array String -> AST -> AST toLoop ident args ast = AST.Block $ - (args <#> \arg -> - AST.VariableIntroduction - { name: copyVar arg - , type: R.any - , qualifiers: [] - , initialization: - Just $ - AST.App R.purs_any_copy - [ AST.Var arg ] - }) - <> [ AST.VariableIntroduction - { name: tcoDone - , type: R.any + { name: tcoState + , type: Type.RawType "struct tco_state" [] , qualifiers: [] , initialization: Just $ - AST.App R.purs_any_int - [ AST.NumericLiteral $ Left 0 + AST.App (AST.Var "purs_tco_state_new") + [ AST.NumericLiteral $ Left $ A.length args ] } - , AST.VariableIntroduction + ] <> + (args # A.mapWithIndex \i arg -> + AST.App (AST.Var "purs_tco_set_arg") + [ AST.Var tcoState + , AST.NumericLiteral $ Left i + , AST.Var arg + ]) + <> + [ AST.VariableIntroduction { name: tcoResult , type: R.any , qualifiers: [] @@ -160,43 +157,51 @@ tco = AST.everywhere convert AST.Function { name: Just tcoLoop , arguments: - [ { name: tcoDone + [ { name: tcoState , type: R.any } - ] <> do - args <#> \name -> - { name: copyVar name - , type: R.any - } + ] , qualifiers: [] , returnType: R.any , variadic: false , body: Just $ AST.Block $ - (args <#> \arg -> + (args # A.mapWithIndex \i arg -> AST.VariableIntroduction { name: arg , type: R.any , qualifiers: [] , initialization: Just $ - AST.App R.purs_any_copy - [ AST.Var $ copyVar arg ] + AST.App (AST.Var "purs_tco_get_arg") + [ AST.App (AST.Var "purs_foreign_get_data") + [ AST.App R.purs_any_get_foreign + [ AST.Var tcoState + ] + ] + , AST.NumericLiteral $ Left i + ] }) <> [ loopify ast ] } } - , AST.While (AST.Unary AST.Not (AST.App R.purs_any_get_int [ AST.Var tcoDone ])) $ + , AST.While + (AST.Unary AST.Not + (AST.App + (AST.Var "purs_tco_is_done") + [ AST.Var tcoState + ])) $ AST.Block [ AST.Assignment (AST.Var tcoResult) $ - AST.App R.purs_any_app $ - A.concat $ - [ [ AST.Var tcoLoop, AST.Var tcoDone ] - , AST.Var <<< copyVar <$> args - , [ AST.Null ] - ] + AST.App R.purs_any_app + [ AST.Var tcoLoop + , AST.App R.purs_any_foreign + [ AST.Null + , AST.App R.purs_address_of [ AST.Var tcoState ] + ] + ] ] , AST.Return $ AST.Var tcoResult ] @@ -211,15 +216,30 @@ tco = AST.everywhere convert in AST.Block $ A.zipWith - (\val arg -> - AST.App R.purs_any_assign_mut [ AST.Var $ copyVar arg, val ]) + (\val (i /\ _) -> + AST.App + (AST.Var "purs_tco_mut_arg") + [ AST.App (AST.Var "purs_foreign_get_data") + [ AST.App R.purs_any_get_foreign + [ AST.Var tcoState + ] + ] + , AST.NumericLiteral $ Left i + , val + ]) allArgumentValues - args + (args # A.mapWithIndex (/\)) <> - [ AST.Return AST.Null ] + [ AST.Return R.purs_any_null ] | otherwise = AST.Block - [ markDone + [ AST.App (AST.Var "purs_tco_set_done") + [ AST.App (AST.Var "purs_foreign_get_data") + [ AST.App R.purs_any_get_foreign + [ AST.Var tcoState + ] + ] + ] , AST.Return ret ] loopify (AST.While cond body) = AST.While cond (loopify body) @@ -227,12 +247,6 @@ tco = AST.everywhere convert loopify (AST.Block body) = AST.Block (map loopify body) loopify x = x - markDone = - AST.App R.purs_any_int_set_mut - [ AST.Cast R.anyMut $ AST.Var tcoDone - , AST.NumericLiteral (Left 1) - ] - collectArguments = go [] where go acc (AST.App (AST.Var "purs_any_app") args) @@ -245,7 +259,7 @@ tco = AST.everywhere convert | Just { head: (AST.Var ident') } <- A.uncons args = ident == ident' isSelfCall ident (AST.App (AST.Var "purs_any_app") args) - | Just { head: fn } <- A.uncons args - = isSelfCall ident fn + | Just { head } <- A.uncons args + = isSelfCall ident head isSelfCall _ _ = false diff --git a/src/Language/PureScript/CodeGen/Runtime.purs b/src/Language/PureScript/CodeGen/Runtime.purs index 77a3877..14b1dbd 100644 --- a/src/Language/PureScript/CodeGen/Runtime.purs +++ b/src/Language/PureScript/CodeGen/Runtime.purs @@ -13,6 +13,7 @@ module Language.PureScript.CodeGen.Runtime , purs_any_eq_string , purs_any_get_cons , purs_any_get_int + , purs_any_get_foreign , purs_any_get_record , purs_any_get_array , purs_any_true @@ -24,34 +25,35 @@ module Language.PureScript.CodeGen.Runtime , purs_any_num_one -- any: built-ins (added for code-gen) - , purs_any_app , purs_any_int_neg - -- any: allocations + -- any: initializors , purs_any_cont , purs_any_array , purs_any_cons , purs_any_record , purs_any_int + , purs_any_foreign , purs_any_num , purs_any_string , purs_any_char - , purs_any_copy -- code-gen helpers , purs_malloc_many - , _PURS_SCOPE_T - , _PURS_CONS_VALUES_NEW , purs_indirect_thunk_new , purs_indirect_value_new , purs_indirect_value_assign + , purs_malloc_any_buf , purs_any_int_set_mut , purs_any_assign_mut + , purs_address_of + , purs_derefence + + , _PURS_SCOPE_T , _PURS_ANY_THUNK_DECL , _PURS_ANY_THUNK_DEF -- misc - , purs_any_fun_t , purs_cons_t , purs_record_t , purs_cons_get_tag @@ -66,6 +68,7 @@ module Language.PureScript.CodeGen.Runtime -- ... , void + , int ) where import Prelude @@ -75,6 +78,9 @@ import Language.PureScript.CodeGen.C.AST (AST) import Language.PureScript.CodeGen.C.AST as AST import Language.PureScript.CodeGen.C.AST as Type +int :: Array AST.TypeQualifier -> AST.Type +int = Type.RawType "int" + void :: Array AST.TypeQualifier -> AST.Type void = Type.RawType "void" @@ -84,9 +90,6 @@ anyMut = Type.Pointer (Type.Any []) any :: AST.Type any = Type.Any [] -purs_any_fun_t :: AST.Type -purs_any_fun_t = Type.RawType "purs_any_fun_t" [] - purs_record_t :: String purs_record_t = "purs_record_t" @@ -126,6 +129,9 @@ purs_any_eq_char = AST.Var "purs_any_eq_char" purs_any_eq_string :: AST purs_any_eq_string = AST.Var "purs_any_eq_string" +purs_any_get_foreign :: AST +purs_any_get_foreign = AST.Var "purs_any_get_foreign" + purs_any_get_int :: AST purs_any_get_int = AST.Var "purs_any_get_int" @@ -168,6 +174,9 @@ _PURS_ANY_THUNK_DECL = AST.Var "PURS_ANY_THUNK_DECL" purs_any_cons :: AST purs_any_cons = AST.Var "purs_any_cons" +purs_any_foreign :: AST +purs_any_foreign = AST.Var "purs_any_foreign" + purs_any_int :: AST purs_any_int = AST.Var "purs_any_int" @@ -189,9 +198,6 @@ purs_any_cont = AST.Var "purs_any_cont" purs_any_string :: AST purs_any_string = AST.Var "purs_any_string" -purs_any_copy :: AST -purs_any_copy = AST.Var "purs_any_copy" - purs_indirect_thunk_new :: AST purs_indirect_thunk_new = AST.Var "purs_indirect_thunk_new" @@ -207,8 +213,14 @@ purs_any_int_set_mut = AST.Var "purs_any_int_set_mut" purs_any_assign_mut :: AST purs_any_assign_mut = AST.Var "purs_any_assign_mut" -_PURS_CONS_VALUES_NEW :: AST -_PURS_CONS_VALUES_NEW = AST.Var "PURS_CONS_VALUES_NEW" +purs_malloc_any_buf :: AST +purs_malloc_any_buf = AST.Var "purs_malloc_any_buf" + +purs_address_of :: AST +purs_address_of = AST.Var "purs_address_of" + +purs_derefence :: AST +purs_derefence = AST.Var "purs_derefence" purs_malloc_many :: AST purs_malloc_many = AST.Var "purs_malloc_many" From c1e6554d67808f3e9c44ba5d99b17abb3630b791 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Fri, 12 Jul 2019 22:31:07 +1200 Subject: [PATCH 08/67] Replace init functions with macros --- runtime/purescript.c | 49 -------------------- runtime/purescript.h | 46 +++++++++--------- src/Language/PureScript/CodeGen/Runtime.purs | 8 ---- 3 files changed, 21 insertions(+), 82 deletions(-) diff --git a/runtime/purescript.c b/runtime/purescript.c index 3b9024b..b8945d4 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -28,22 +28,6 @@ const managed_t * managed_new (const void * data, // Any: allocate // ----------------------------------------------------------------------------- -/* todo: turn into macro */ -ANY purs_any_int(const purs_any_int_t i) { - ANY v; - v.tag = PURS_ANY_TAG_INT; - v.value.i = i; - return v; -} - -/* todo: turn into macro */ -ANY purs_any_num(const purs_any_num_t n) { - ANY v; - v.tag = PURS_ANY_TAG_NUM; - v.value.n = n; - return v; -} - /* todo: turn into macro */ ANY purs_any_cont(ANY * ctx, int len, purs_any_cont_fun_t * fn) { ANY v; @@ -75,14 +59,6 @@ ANY purs_any_cons(int tag, ANY* values) { return v; } -/* todo: turn into macro */ -ANY purs_any_record(const purs_record_t * record) { - ANY v; - v.tag = PURS_ANY_TAG_RECORD; - v.value.record = record; - return v; -} - /* todo: turn into macro */ ANY purs_any_string_mv(const char * ptr) { ANY v; @@ -104,31 +80,6 @@ ANY purs_any_string(const char * fmt, ...) { return v; } -/* todo: turn into macro */ -ANY purs_any_char(utf8_int32_t chr) { - ANY v; - v.tag = PURS_ANY_TAG_CHAR; - v.value.chr = chr; - return v; -} - -/* todo: turn into macro */ -ANY purs_any_array(const purs_vec_t * array) { - ANY v; - v.tag = PURS_ANY_TAG_ARRAY; - v.value.array = array; - return v; -} - -/* todo: turn into macro */ -ANY purs_any_foreign(void * tag, void * data) { - ANY v; - v.tag = PURS_ANY_TAG_FOREIGN; - v.value.foreign.tag = tag; - v.value.foreign.data = data; - return v; -} - // ----------------------------------------------------------------------------- // Any: getters // ----------------------------------------------------------------------------- diff --git a/runtime/purescript.h b/runtime/purescript.h index 6bb752e..d527543 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -130,16 +130,18 @@ ANY purs_any_unthunk (ANY); const purs_any_tag_t purs_any_get_tag (ANY); const char * purs_any_tag_str (const purs_any_tag_t); -ANY purs_any_int(const purs_any_int_t); -ANY purs_any_num(const purs_any_num_t); +/* note: two versions for compat/historical reasons */ +#define purs_any_int PURS_ANY_INT +#define purs_any_num PURS_ANY_NUM +#define purs_any_char PURS_ANY_CHAR +#define purs_any_foreign PURS_ANY_FOREIGN +#define purs_any_array PURS_ANY_ARRAY +#define purs_any_record PURS_ANY_RECORD + ANY purs_any_cont(ANY * ctx, int len, purs_any_cont_fun_t *); ANY purs_any_thunk(ANY ctx, purs_any_thunk_fun_t *); ANY purs_any_cons(int tag, ANY* values); -ANY purs_any_record(const purs_record_t *); ANY purs_any_string(const char * fmt, ...); -ANY purs_any_char(utf8_int32_t); -ANY purs_any_array(const purs_vec_t *); -ANY purs_any_foreign(void * tag, void * data); /* allocate a new string box with existing, *GC-allocated* data */ ANY purs_any_string_new_mv(const char *); @@ -341,29 +343,23 @@ ANY* purs_malloc_many(int num_bindings); .value = { .thunk = & NAME ## __thunk__ }\ }; -/* #define purs_any_int_neg(X) purs_any_int_new(-purs_any_get_int(X)) */ -/* #define purs_any_int_set_mut(X, V) do { X->value.i = V; } while (0) */ -/* #define purs_any_assign_mut(V1, V2)\ */ -/* do {\ */ -/* V1.tag = V2.tag;\ */ -/* V1.value = V2.value;\ */ -/* } while (0) */ +#define purs_any_int_neg(X) purs_any_int_new(-purs_any_get_int(X)) // ----------------------------------------------------------------------------- // Any: initializers // ----------------------------------------------------------------------------- -#define PURS_ANY_INT(x)\ - { .tag = PURS_ANY_TAG_INT, .value = { .i = x } } +#define PURS_ANY_INT(X)\ + ((purs_any_t){ .tag = PURS_ANY_TAG_INT, .value = { .i = X } }) -#define PURS_ANY_NUM(x)\ - { .tag = PURS_ANY_TAG_NUM, .value = { .n = x } } +#define PURS_ANY_NUM(X)\ + ((purs_any_t){ .tag = PURS_ANY_TAG_NUM, .value = { .n = X } }) -#define PURS_ANY_CHAR(x)\ - { .tag = PURS_ANY_TAG_CHAR, .value = { .chr = x } } +#define PURS_ANY_CHAR(X)\ + ((purs_any_t){ .tag = PURS_ANY_TAG_CHAR, .value = { .chr = X } }) #define PURS_ANY_FOREIGN(TAG, DATA)\ - {\ + ((purs_any_t){\ .tag = PURS_ANY_TAG_FOREIGN,\ .value = {\ .foreign = {\ @@ -371,13 +367,13 @@ ANY* purs_malloc_many(int num_bindings); .data = (DATA)\ }\ }\ - } + }) -#define PURS_ANY_RECORD(x)\ - { .tag = PURS_ANY_TAG_RECORD, .value = { .record = x } } +#define PURS_ANY_RECORD(X)\ + ((purs_any_t){ .tag = PURS_ANY_TAG_RECORD, .value = { .record = X } }) -#define PURS_ANY_ARRAY(ARR)\ - { .tag = PURS_ANY_TAG_ARRAY, .value = { .array = ARR } } +#define PURS_ANY_ARRAY(X)\ + ((purs_any_t){ .tag = PURS_ANY_TAG_ARRAY, .value = { .array = X } }) // ----------------------------------------------------------------------------- // FFI helpers diff --git a/src/Language/PureScript/CodeGen/Runtime.purs b/src/Language/PureScript/CodeGen/Runtime.purs index 14b1dbd..b155b37 100644 --- a/src/Language/PureScript/CodeGen/Runtime.purs +++ b/src/Language/PureScript/CodeGen/Runtime.purs @@ -44,8 +44,6 @@ module Language.PureScript.CodeGen.Runtime , purs_indirect_value_new , purs_indirect_value_assign , purs_malloc_any_buf - , purs_any_int_set_mut - , purs_any_assign_mut , purs_address_of , purs_derefence @@ -207,12 +205,6 @@ purs_indirect_value_new = AST.Var "purs_indirect_value_new" purs_indirect_value_assign :: AST purs_indirect_value_assign = AST.Var "purs_indirect_value_assign" -purs_any_int_set_mut :: AST -purs_any_int_set_mut = AST.Var "purs_any_int_set_mut" - -purs_any_assign_mut :: AST -purs_any_assign_mut = AST.Var "purs_any_assign_mut" - purs_malloc_any_buf :: AST purs_malloc_any_buf = AST.Var "purs_malloc_any_buf" From 0af400ea46e79d5745e8cbe9f9038aea23b38dc9 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Fri, 12 Jul 2019 22:43:05 +1200 Subject: [PATCH 09/67] Remove 'purs_any_thunk' functions for now --- runtime/purescript.c | 16 ++++------------ runtime/purescript.h | 7 +++++-- 2 files changed, 9 insertions(+), 14 deletions(-) diff --git a/runtime/purescript.c b/runtime/purescript.c index b8945d4..03a01b9 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -39,16 +39,6 @@ ANY purs_any_cont(ANY * ctx, int len, purs_any_cont_fun_t * fn) { return v; } -/* todo: turn into macro */ -ANY purs_any_thunk(ANY ctx, purs_any_thunk_fun_t * fn) { - ANY v; - v.tag = PURS_ANY_TAG_THUNK; - v.value.thunk = purs_malloc(sizeof (purs_any_thunk_t)); - v.value.thunk->ctx = ctx; - v.value.thunk->fn = fn; - return v; -} - /* todo: turn into macro */ ANY purs_any_cons(int tag, ANY* values) { ANY v; @@ -493,8 +483,10 @@ const purs_record_t * purs_record_find_by_key(const purs_record_t * record, // ----------------------------------------------------------------------------- ANY purs_indirect_thunk_new(ANY * x) { - ANY w = { .value = { .foreign = { .data = x } } }; - return purs_any_thunk(w, purs_thunked_deref); + purs_any_thunk_t * thunk = purs_malloc(sizeof (purs_any_thunk_t)); + thunk->ctx = ((purs_any_t){ .value = { .foreign = { .data = x } } }); + thunk->fn = purs_thunked_deref; + return PURS_ANY_THUNK(thunk); } /* todo: convert to macro */ diff --git a/runtime/purescript.h b/runtime/purescript.h index d527543..ec25032 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -130,7 +130,7 @@ ANY purs_any_unthunk (ANY); const purs_any_tag_t purs_any_get_tag (ANY); const char * purs_any_tag_str (const purs_any_tag_t); -/* note: two versions for compat/historical reasons */ +/* DEPRECATED: two versions for compat/historical reasons only */ #define purs_any_int PURS_ANY_INT #define purs_any_num PURS_ANY_NUM #define purs_any_char PURS_ANY_CHAR @@ -138,8 +138,8 @@ const char * purs_any_tag_str (const purs_any_tag_t); #define purs_any_array PURS_ANY_ARRAY #define purs_any_record PURS_ANY_RECORD +/* XXX these functions heap-allocate. maybe rename? */ ANY purs_any_cont(ANY * ctx, int len, purs_any_cont_fun_t *); -ANY purs_any_thunk(ANY ctx, purs_any_thunk_fun_t *); ANY purs_any_cons(int tag, ANY* values); ANY purs_any_string(const char * fmt, ...); @@ -375,6 +375,9 @@ ANY* purs_malloc_many(int num_bindings); #define PURS_ANY_ARRAY(X)\ ((purs_any_t){ .tag = PURS_ANY_TAG_ARRAY, .value = { .array = X } }) +#define PURS_ANY_THUNK(X)\ + ((purs_any_t){ .tag = PURS_ANY_TAG_THUNK, .value = { .thunk = X } }) + // ----------------------------------------------------------------------------- // FFI helpers // ----------------------------------------------------------------------------- From 8d0f9025f42087eb42ed6b803b592ef76ecdaec7 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Fri, 12 Jul 2019 22:53:58 +1200 Subject: [PATCH 10/67] Track size in 'purs_any_cons_t' --- runtime/purescript.c | 3 ++- runtime/purescript.h | 3 ++- src/Language/PureScript/CodeGen/C.purs | 15 ++++++++++----- 3 files changed, 14 insertions(+), 7 deletions(-) diff --git a/runtime/purescript.c b/runtime/purescript.c index 03a01b9..aa9954c 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -40,11 +40,12 @@ ANY purs_any_cont(ANY * ctx, int len, purs_any_cont_fun_t * fn) { } /* todo: turn into macro */ -ANY purs_any_cons(int tag, ANY* values) { +ANY purs_any_cons(int tag, int size, ANY* values) { ANY v; v.tag = PURS_ANY_TAG_CONS; v.value.cons = purs_malloc(sizeof (purs_any_cons_t)); v.value.cons->tag = tag; + v.value.cons->size = size; v.value.cons->values = values; return v; } diff --git a/runtime/purescript.h b/runtime/purescript.h index ec25032..b0418e8 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -119,6 +119,7 @@ struct purs_any_cont { /* todo: track len values, for clean up */ struct purs_any_cons { int tag; + int size; ANY * values; }; @@ -140,7 +141,7 @@ const char * purs_any_tag_str (const purs_any_tag_t); /* XXX these functions heap-allocate. maybe rename? */ ANY purs_any_cont(ANY * ctx, int len, purs_any_cont_fun_t *); -ANY purs_any_cons(int tag, ANY* values); +ANY purs_any_cons(int tag, int size, ANY* values); ANY purs_any_string(const char * fmt, ...); /* allocate a new string box with existing, *GC-allocated* data */ diff --git a/src/Language/PureScript/CodeGen/C.purs b/src/Language/PureScript/CodeGen/C.purs index 9115607..6a3c9ca 100644 --- a/src/Language/PureScript/CodeGen/C.purs +++ b/src/Language/PureScript/CodeGen/C.purs @@ -627,12 +627,16 @@ exprToAst (C.Constructor _ typeName (C.ProperName constructorName) fields) Just $ AST.App R.purs_malloc_any_buf - [ AST.NumericLiteral (Left $ A.length fields) ] + [ AST.NumericLiteral $ Left $ A.length fields + ] } ] <> assignments <> [ AST.Return $ AST.App R.purs_any_cons - [ AST.Var $ safeConstructorName $ qualifiedVarName moduleName constructorName + [ AST.Var $ + safeConstructorName $ + qualifiedVarName moduleName constructorName + , AST.NumericLiteral $ Left $ A.length fields , AST.Var valuesName ] ] @@ -663,9 +667,10 @@ exprToAst (C.Constructor _ typeName (C.ProperName constructorName) _) = do pure $ AST.App R.purs_any_cons - [ AST.Var constructorName' - , AST.Null - ] + [ AST.Var constructorName' + , AST.NumericLiteral $ Left 0 + , AST.Null + ] exprToAst (C.App (C.Ann { type: typ }) ident expr) = do f <- exprToAst ident arg <- exprToAst expr From 0a8cff555816d26c9a214e81e425c64a8fcc709c Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Fri, 12 Jul 2019 23:25:37 +1200 Subject: [PATCH 11/67] Convert more code-gen helper functions into macros --- runtime/purescript.c | 24 ------------------- runtime/purescript.h | 17 +++++++------ .../PureScript/CodeGen/C/Transforms.purs | 2 +- src/Language/PureScript/CodeGen/Runtime.purs | 5 +--- 4 files changed, 12 insertions(+), 36 deletions(-) diff --git a/runtime/purescript.c b/runtime/purescript.c index aa9954c..15d4525 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -483,30 +483,6 @@ const purs_record_t * purs_record_find_by_key(const purs_record_t * record, // Code-gen helpers // ----------------------------------------------------------------------------- -ANY purs_indirect_thunk_new(ANY * x) { - purs_any_thunk_t * thunk = purs_malloc(sizeof (purs_any_thunk_t)); - thunk->ctx = ((purs_any_t){ .value = { .foreign = { .data = x } } }); - thunk->fn = purs_thunked_deref; - return PURS_ANY_THUNK(thunk); -} - -/* todo: convert to macro */ ANY purs_thunked_deref(ANY ctx) { return *((ANY*)(ctx.value.foreign.data)); } - -/* todo: convert to macro */ -ANY * purs_indirect_value_new() { - return purs_new(ANY); -} - -/* todo: convert to macro */ -void purs_indirect_value_assign(ANY * i, ANY v) { - *i = v; -} - -/* todo: turn into macro */ -ANY* purs_malloc_many(int num_bindings) { - if (num_bindings == 0) return NULL; - return purs_malloc(num_bindings * sizeof (ANY)); -} diff --git a/runtime/purescript.h b/runtime/purescript.h index b0418e8..f1edbf2 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -313,17 +313,20 @@ struct tco_state { #define purs_derefence(V) *V /* thunked pointer dereference. useful for recursive bindings */ -ANY * purs_indirect_value_new(); -void purs_indirect_value_assign(ANY *, ANY); -ANY purs_indirect_thunk_new(ANY *); +#define purs_indirect_value_new() purs_new(ANY) +#define purs_indirect_value_assign(I, V) *(I) = (V) +#define purs_indirect_thunk_new(X) \ + ({\ + purs_any_thunk_t * thunk = purs_malloc(sizeof (purs_any_thunk_t));\ + thunk->ctx = ((purs_any_t){ .value = { .foreign = { .data = X } } });\ + thunk->fn = purs_thunked_deref;\ + PURS_ANY_THUNK(thunk);\ + }) ANY purs_thunked_deref(ANY); /* allocate a buffer to fit 'N' 'ANY's */ #define purs_malloc_any_buf(N) purs_malloc(sizeof (ANY) * N) -/* code-gen helper to allocate and fill a scope. */ -ANY* purs_malloc_many(int num_bindings); - /* declare a thunked top-level value. */ #define PURS_ANY_THUNK_DEF(NAME, INIT)\ static ANY NAME ## __thunk_fn__ (ANY __unused__1) { \ @@ -412,7 +415,7 @@ ANY* purs_malloc_many(int num_bindings); #define _PURS_FFI_FUNC_CONT(NAME, CUR, NEXT)\ ANY NAME##__##CUR (ANY * $__super__, ANY a, va_list $__unused__) {\ - ANY* ctx = purs_malloc_many(CUR);\ + ANY* ctx = purs_malloc_any_buf(CUR);\ if ($__super__ != NULL) {\ memcpy(ctx, $__super__, CUR * sizeof (ANY));\ }\ diff --git a/src/Language/PureScript/CodeGen/C/Transforms.purs b/src/Language/PureScript/CodeGen/C/Transforms.purs index 77f6961..1e0f441 100644 --- a/src/Language/PureScript/CodeGen/C/Transforms.purs +++ b/src/Language/PureScript/CodeGen/C/Transforms.purs @@ -346,7 +346,7 @@ eraseLambdas moduleName asts = then AST.Null else AST.App - R.purs_malloc_many $ + R.purs_malloc_any_buf $ [ AST.NumericLiteral $ Left $ A.length scopeStruct.members ] diff --git a/src/Language/PureScript/CodeGen/Runtime.purs b/src/Language/PureScript/CodeGen/Runtime.purs index b155b37..87130db 100644 --- a/src/Language/PureScript/CodeGen/Runtime.purs +++ b/src/Language/PureScript/CodeGen/Runtime.purs @@ -39,7 +39,7 @@ module Language.PureScript.CodeGen.Runtime , purs_any_char -- code-gen helpers - , purs_malloc_many + , purs_malloc_any_buf , purs_indirect_thunk_new , purs_indirect_value_new , purs_indirect_value_assign @@ -214,9 +214,6 @@ purs_address_of = AST.Var "purs_address_of" purs_derefence :: AST purs_derefence = AST.Var "purs_derefence" -purs_malloc_many :: AST -purs_malloc_many = AST.Var "purs_malloc_many" - _PURS_SCOPE_T :: AST _PURS_SCOPE_T = AST.Var "PURS_SCOPE_T" From 8ddb2df80369a17586a234b831e625d18c12c8d1 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Fri, 12 Jul 2019 23:29:52 +1200 Subject: [PATCH 12/67] Remove unused 'anyMut' --- src/Language/PureScript/CodeGen/Runtime.purs | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/Language/PureScript/CodeGen/Runtime.purs b/src/Language/PureScript/CodeGen/Runtime.purs index 87130db..96504bc 100644 --- a/src/Language/PureScript/CodeGen/Runtime.purs +++ b/src/Language/PureScript/CodeGen/Runtime.purs @@ -3,7 +3,6 @@ module Language.PureScript.CodeGen.Runtime -- any: dynamic runtime types any - , anyMut -- any: built-ins , purs_any_app @@ -39,7 +38,6 @@ module Language.PureScript.CodeGen.Runtime , purs_any_char -- code-gen helpers - , purs_malloc_any_buf , purs_indirect_thunk_new , purs_indirect_value_new , purs_indirect_value_assign @@ -82,9 +80,6 @@ int = Type.RawType "int" void :: Array AST.TypeQualifier -> AST.Type void = Type.RawType "void" -anyMut :: AST.Type -anyMut = Type.Pointer (Type.Any []) - any :: AST.Type any = Type.Any [] From f3f636fc341f51880784eb71b87a9cc8963f0502 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Sat, 13 Jul 2019 07:00:40 +1200 Subject: [PATCH 13/67] Rename 'examples' to 'tests' --- examples/partialfuns/spago.dhall | 9 --------- examples/prelude/#Makefile# | 12 ------------ {examples => tests}/basic/.gitignore | 0 {examples => tests}/basic/Makefile | 0 {examples => tests}/basic/packages.dhall | 0 {examples => tests}/basic/spago.dhall | 2 +- {examples => tests}/basic/src/Main.purs | 0 {examples => tests}/foreign/.gitignore | 0 {examples => tests}/foreign/Makefile | 0 {examples => tests}/foreign/packages.dhall | 0 {examples/memory => tests/foreign}/spago.dhall | 2 +- {examples => tests}/foreign/src/Main.h | 0 {examples => tests}/foreign/src/Main.purs | 0 {examples => tests}/memory/.gitignore | 0 {examples => tests}/memory/Makefile | 0 {examples => tests}/memory/packages.dhall | 0 {examples/mutrec => tests/memory}/spago.dhall | 2 +- {examples => tests}/memory/src/Main.h | 0 {examples => tests}/memory/src/Main.purs | 0 {examples => tests}/mutrec/.gitignore | 0 {examples => tests}/mutrec/Makefile | 0 {examples => tests}/mutrec/packages.dhall | 0 {examples/foreign => tests/mutrec}/spago.dhall | 2 +- {examples => tests}/mutrec/src/Main.purs | 0 {examples => tests}/partialfuns/.gitignore | 0 {examples => tests}/partialfuns/Makefile | 0 {examples => tests}/partialfuns/packages.dhall | 0 tests/partialfuns/spago.dhall | 9 +++++++++ {examples => tests}/partialfuns/src/Main.purs | 0 {examples => tests}/prelude/Makefile | 0 {examples => tests}/prelude/packages.dhall | 0 {examples => tests}/prelude/spago.dhall | 2 +- {examples => tests}/prelude/src/Main.h | 0 {examples => tests}/prelude/src/Main.purs | 0 34 files changed, 14 insertions(+), 26 deletions(-) delete mode 100644 examples/partialfuns/spago.dhall delete mode 100644 examples/prelude/#Makefile# rename {examples => tests}/basic/.gitignore (100%) rename {examples => tests}/basic/Makefile (100%) rename {examples => tests}/basic/packages.dhall (100%) rename {examples => tests}/basic/spago.dhall (83%) rename {examples => tests}/basic/src/Main.purs (100%) rename {examples => tests}/foreign/.gitignore (100%) rename {examples => tests}/foreign/Makefile (100%) rename {examples => tests}/foreign/packages.dhall (100%) rename {examples/memory => tests/foreign}/spago.dhall (83%) rename {examples => tests}/foreign/src/Main.h (100%) rename {examples => tests}/foreign/src/Main.purs (100%) rename {examples => tests}/memory/.gitignore (100%) rename {examples => tests}/memory/Makefile (100%) rename {examples => tests}/memory/packages.dhall (100%) rename {examples/mutrec => tests/memory}/spago.dhall (83%) rename {examples => tests}/memory/src/Main.h (100%) rename {examples => tests}/memory/src/Main.purs (100%) rename {examples => tests}/mutrec/.gitignore (100%) rename {examples => tests}/mutrec/Makefile (100%) rename {examples => tests}/mutrec/packages.dhall (100%) rename {examples/foreign => tests/mutrec}/spago.dhall (82%) rename {examples => tests}/mutrec/src/Main.purs (100%) rename {examples => tests}/partialfuns/.gitignore (100%) rename {examples => tests}/partialfuns/Makefile (100%) rename {examples => tests}/partialfuns/packages.dhall (100%) create mode 100644 tests/partialfuns/spago.dhall rename {examples => tests}/partialfuns/src/Main.purs (100%) rename {examples => tests}/prelude/Makefile (100%) rename {examples => tests}/prelude/packages.dhall (100%) rename {examples => tests}/prelude/spago.dhall (82%) rename {examples => tests}/prelude/src/Main.h (100%) rename {examples => tests}/prelude/src/Main.purs (100%) diff --git a/examples/partialfuns/spago.dhall b/examples/partialfuns/spago.dhall deleted file mode 100644 index 010f44a..0000000 --- a/examples/partialfuns/spago.dhall +++ /dev/null @@ -1,9 +0,0 @@ -{ name = - "purec-example-partialfuns" -, dependencies = - [] : List Text -, packages = - ./packages.dhall -, sources = - [ "src/**/*.purs", "test/**/*.purs" ] -} diff --git a/examples/prelude/#Makefile# b/examples/prelude/#Makefile# deleted file mode 100644 index 7e4f222..0000000 --- a/examples/prelude/#Makefile# +++ /dev/null @@ -1,12 +0,0 @@ -default: main -.PHONY: default - -PUREC_DIR := ../.. -include $(PUREC_DIR)/mk/target.mk - -.spago: -ech - spago install -main: .spago - -$(eval $(call purs_mk_target,main,Main,src)) diff --git a/examples/basic/.gitignore b/tests/basic/.gitignore similarity index 100% rename from examples/basic/.gitignore rename to tests/basic/.gitignore diff --git a/examples/basic/Makefile b/tests/basic/Makefile similarity index 100% rename from examples/basic/Makefile rename to tests/basic/Makefile diff --git a/examples/basic/packages.dhall b/tests/basic/packages.dhall similarity index 100% rename from examples/basic/packages.dhall rename to tests/basic/packages.dhall diff --git a/examples/basic/spago.dhall b/tests/basic/spago.dhall similarity index 83% rename from examples/basic/spago.dhall rename to tests/basic/spago.dhall index fbaf8ca..baaafd5 100644 --- a/examples/basic/spago.dhall +++ b/tests/basic/spago.dhall @@ -1,5 +1,5 @@ { name = - "purec-example-basic" + "purec-test-basic" , dependencies = [] : List Text , packages = diff --git a/examples/basic/src/Main.purs b/tests/basic/src/Main.purs similarity index 100% rename from examples/basic/src/Main.purs rename to tests/basic/src/Main.purs diff --git a/examples/foreign/.gitignore b/tests/foreign/.gitignore similarity index 100% rename from examples/foreign/.gitignore rename to tests/foreign/.gitignore diff --git a/examples/foreign/Makefile b/tests/foreign/Makefile similarity index 100% rename from examples/foreign/Makefile rename to tests/foreign/Makefile diff --git a/examples/foreign/packages.dhall b/tests/foreign/packages.dhall similarity index 100% rename from examples/foreign/packages.dhall rename to tests/foreign/packages.dhall diff --git a/examples/memory/spago.dhall b/tests/foreign/spago.dhall similarity index 83% rename from examples/memory/spago.dhall rename to tests/foreign/spago.dhall index b6cb421..6de5bd3 100644 --- a/examples/memory/spago.dhall +++ b/tests/foreign/spago.dhall @@ -1,5 +1,5 @@ { name = - "purec-example-memory" + "purec-test-foreign" , dependencies = [] : List Text , packages = diff --git a/examples/foreign/src/Main.h b/tests/foreign/src/Main.h similarity index 100% rename from examples/foreign/src/Main.h rename to tests/foreign/src/Main.h diff --git a/examples/foreign/src/Main.purs b/tests/foreign/src/Main.purs similarity index 100% rename from examples/foreign/src/Main.purs rename to tests/foreign/src/Main.purs diff --git a/examples/memory/.gitignore b/tests/memory/.gitignore similarity index 100% rename from examples/memory/.gitignore rename to tests/memory/.gitignore diff --git a/examples/memory/Makefile b/tests/memory/Makefile similarity index 100% rename from examples/memory/Makefile rename to tests/memory/Makefile diff --git a/examples/memory/packages.dhall b/tests/memory/packages.dhall similarity index 100% rename from examples/memory/packages.dhall rename to tests/memory/packages.dhall diff --git a/examples/mutrec/spago.dhall b/tests/memory/spago.dhall similarity index 83% rename from examples/mutrec/spago.dhall rename to tests/memory/spago.dhall index 85b3a3d..8ca9c1b 100644 --- a/examples/mutrec/spago.dhall +++ b/tests/memory/spago.dhall @@ -1,5 +1,5 @@ { name = - "purec-example-mutrec" + "purec-test-memory" , dependencies = [] : List Text , packages = diff --git a/examples/memory/src/Main.h b/tests/memory/src/Main.h similarity index 100% rename from examples/memory/src/Main.h rename to tests/memory/src/Main.h diff --git a/examples/memory/src/Main.purs b/tests/memory/src/Main.purs similarity index 100% rename from examples/memory/src/Main.purs rename to tests/memory/src/Main.purs diff --git a/examples/mutrec/.gitignore b/tests/mutrec/.gitignore similarity index 100% rename from examples/mutrec/.gitignore rename to tests/mutrec/.gitignore diff --git a/examples/mutrec/Makefile b/tests/mutrec/Makefile similarity index 100% rename from examples/mutrec/Makefile rename to tests/mutrec/Makefile diff --git a/examples/mutrec/packages.dhall b/tests/mutrec/packages.dhall similarity index 100% rename from examples/mutrec/packages.dhall rename to tests/mutrec/packages.dhall diff --git a/examples/foreign/spago.dhall b/tests/mutrec/spago.dhall similarity index 82% rename from examples/foreign/spago.dhall rename to tests/mutrec/spago.dhall index ee9d183..d340c7e 100644 --- a/examples/foreign/spago.dhall +++ b/tests/mutrec/spago.dhall @@ -1,5 +1,5 @@ { name = - "purec-example-foreign" + "purec-test-mutrec" , dependencies = [] : List Text , packages = diff --git a/examples/mutrec/src/Main.purs b/tests/mutrec/src/Main.purs similarity index 100% rename from examples/mutrec/src/Main.purs rename to tests/mutrec/src/Main.purs diff --git a/examples/partialfuns/.gitignore b/tests/partialfuns/.gitignore similarity index 100% rename from examples/partialfuns/.gitignore rename to tests/partialfuns/.gitignore diff --git a/examples/partialfuns/Makefile b/tests/partialfuns/Makefile similarity index 100% rename from examples/partialfuns/Makefile rename to tests/partialfuns/Makefile diff --git a/examples/partialfuns/packages.dhall b/tests/partialfuns/packages.dhall similarity index 100% rename from examples/partialfuns/packages.dhall rename to tests/partialfuns/packages.dhall diff --git a/tests/partialfuns/spago.dhall b/tests/partialfuns/spago.dhall new file mode 100644 index 0000000..dbd41d0 --- /dev/null +++ b/tests/partialfuns/spago.dhall @@ -0,0 +1,9 @@ +{ name = + "purec-test-partialfuns" +, dependencies = + [] : List Text +, packages = + ./packages.dhall +, sources = + [ "src/**/*.purs", "test/**/*.purs" ] +} diff --git a/examples/partialfuns/src/Main.purs b/tests/partialfuns/src/Main.purs similarity index 100% rename from examples/partialfuns/src/Main.purs rename to tests/partialfuns/src/Main.purs diff --git a/examples/prelude/Makefile b/tests/prelude/Makefile similarity index 100% rename from examples/prelude/Makefile rename to tests/prelude/Makefile diff --git a/examples/prelude/packages.dhall b/tests/prelude/packages.dhall similarity index 100% rename from examples/prelude/packages.dhall rename to tests/prelude/packages.dhall diff --git a/examples/prelude/spago.dhall b/tests/prelude/spago.dhall similarity index 82% rename from examples/prelude/spago.dhall rename to tests/prelude/spago.dhall index 58e0837..080368b 100644 --- a/examples/prelude/spago.dhall +++ b/tests/prelude/spago.dhall @@ -1,5 +1,5 @@ { name = - "purec-example-prelude" + "purec-test-prelude" , dependencies = [ "prelude" ] , packages = diff --git a/examples/prelude/src/Main.h b/tests/prelude/src/Main.h similarity index 100% rename from examples/prelude/src/Main.h rename to tests/prelude/src/Main.h diff --git a/examples/prelude/src/Main.purs b/tests/prelude/src/Main.purs similarity index 100% rename from examples/prelude/src/Main.purs rename to tests/prelude/src/Main.purs From e1d8961eece3f3dad4105fb40011c963c48fc297 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Sat, 13 Jul 2019 07:02:17 +1200 Subject: [PATCH 14/67] Dhall freeze mkPackage.dhall --- package-sets/mkPackage.dhall | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/package-sets/mkPackage.dhall b/package-sets/mkPackage.dhall index 6c72556..4c5822a 100644 --- a/package-sets/mkPackage.dhall +++ b/package-sets/mkPackage.dhall @@ -1,4 +1,4 @@ let mkPackage = - https://raw.githubusercontent.com/purescript/package-sets/psc-0.12.5/src/mkPackage.dhall + https://raw.githubusercontent.com/purescript/package-sets/psc-0.12.5/src/mkPackage.dhall sha256:0b197efa1d397ace6eb46b243ff2d73a3da5638d8d0ac8473e8e4a8fc528cf57 in mkPackage From c57a16fc35c903740cc7d2215b4c1978723189ad Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Sat, 13 Jul 2019 08:08:19 +1200 Subject: [PATCH 15/67] Set up exhaustive testing via 'make test' --- Makefile | 49 +++++++++++-------- tests/{basic => 00-basic}/.gitignore | 0 tests/{basic => 00-basic}/Makefile | 0 tests/{basic => 00-basic}/packages.dhall | 0 tests/{basic => 00-basic}/spago.dhall | 0 tests/{basic => 00-basic}/src/Main.purs | 0 tests/{foreign => 01-partialfuns}/.gitignore | 0 tests/{foreign => 01-partialfuns}/Makefile | 0 .../packages.dhall | 0 .../spago.dhall | 0 .../src/Main.purs | 0 tests/{memory => 02-foreign}/.gitignore | 0 tests/{memory => 02-foreign}/Makefile | 0 tests/{memory => 02-foreign}/packages.dhall | 0 tests/{foreign => 02-foreign}/spago.dhall | 0 tests/{foreign => 02-foreign}/src/Main.h | 0 tests/{foreign => 02-foreign}/src/Main.purs | 0 tests/{mutrec => 03-mutrec}/.gitignore | 0 tests/{mutrec => 03-mutrec}/Makefile | 0 tests/{mutrec => 03-mutrec}/packages.dhall | 0 tests/{mutrec => 03-mutrec}/spago.dhall | 0 tests/{mutrec => 03-mutrec}/src/Main.purs | 0 tests/{partialfuns => 04-memory}/.gitignore | 0 tests/{partialfuns => 04-memory}/Makefile | 0 .../{partialfuns => 04-memory}/packages.dhall | 0 tests/{memory => 04-memory}/spago.dhall | 0 tests/{memory => 04-memory}/src/Main.h | 0 tests/{memory => 04-memory}/src/Main.purs | 0 tests/{prelude => 10-prelude}/Makefile | 0 tests/{prelude => 10-prelude}/packages.dhall | 0 tests/{prelude => 10-prelude}/spago.dhall | 0 tests/{prelude => 10-prelude}/src/Main.h | 0 tests/{prelude => 10-prelude}/src/Main.purs | 1 + 33 files changed, 29 insertions(+), 21 deletions(-) rename tests/{basic => 00-basic}/.gitignore (100%) rename tests/{basic => 00-basic}/Makefile (100%) rename tests/{basic => 00-basic}/packages.dhall (100%) rename tests/{basic => 00-basic}/spago.dhall (100%) rename tests/{basic => 00-basic}/src/Main.purs (100%) rename tests/{foreign => 01-partialfuns}/.gitignore (100%) rename tests/{foreign => 01-partialfuns}/Makefile (100%) rename tests/{foreign => 01-partialfuns}/packages.dhall (100%) rename tests/{partialfuns => 01-partialfuns}/spago.dhall (100%) rename tests/{partialfuns => 01-partialfuns}/src/Main.purs (100%) rename tests/{memory => 02-foreign}/.gitignore (100%) rename tests/{memory => 02-foreign}/Makefile (100%) rename tests/{memory => 02-foreign}/packages.dhall (100%) rename tests/{foreign => 02-foreign}/spago.dhall (100%) rename tests/{foreign => 02-foreign}/src/Main.h (100%) rename tests/{foreign => 02-foreign}/src/Main.purs (100%) rename tests/{mutrec => 03-mutrec}/.gitignore (100%) rename tests/{mutrec => 03-mutrec}/Makefile (100%) rename tests/{mutrec => 03-mutrec}/packages.dhall (100%) rename tests/{mutrec => 03-mutrec}/spago.dhall (100%) rename tests/{mutrec => 03-mutrec}/src/Main.purs (100%) rename tests/{partialfuns => 04-memory}/.gitignore (100%) rename tests/{partialfuns => 04-memory}/Makefile (100%) rename tests/{partialfuns => 04-memory}/packages.dhall (100%) rename tests/{memory => 04-memory}/spago.dhall (100%) rename tests/{memory => 04-memory}/src/Main.h (100%) rename tests/{memory => 04-memory}/src/Main.purs (100%) rename tests/{prelude => 10-prelude}/Makefile (100%) rename tests/{prelude => 10-prelude}/packages.dhall (100%) rename tests/{prelude => 10-prelude}/spago.dhall (100%) rename tests/{prelude => 10-prelude}/src/Main.h (100%) rename tests/{prelude => 10-prelude}/src/Main.purs (96%) diff --git a/Makefile b/Makefile index f66adbb..12763fd 100644 --- a/Makefile +++ b/Makefile @@ -24,6 +24,8 @@ RUNTIME_SOURCES = \ RUNTIME_OBJECTS = \ $(patsubst %.c,%.o,$(RUNTIME_SOURCES)) +TESTS = $(shell ls tests) + CFLAGS += \ -D 'uthash_malloc=GC_malloc' \ -D 'uthash_free(ptr, sz)=NULL' \ @@ -119,29 +121,34 @@ test/c: $(LIBPUREC) @./ctests/a.out .PHONY: test/c -test/examples/example1: - @$(MAKE) -s -C examples/example1 - @./examples/example1/main.out <<< "foobar" - -test/examples/example2: - @$(MAKE) -s -C examples/example2 - @./examples/example2/main.out - -test/examples/effect: - @$(MAKE) -s -C examples/effect - @./examples/effect/main.out - -test/examples: \ - test/examples/example1 \ - test/examples/example2 \ - test/examples/effect -.PHONY: test/examples - -test/purs: upstream/tests/support/bower_components - $(PULP) test +test/tests: + @for t in $(TESTS); do\ + echo >&2 "running...: $$t" &&\ + $(MAKE) > /dev/null -s -C "tests/$$t" clean &&\ + $(MAKE) > /dev/null -s -C "tests/$$t" || {\ + echo >&2 "[!] failed to compile: $$t";\ + exit 1;\ + } &&\ + ( cd "tests/$$t" && ./main.out; ) || {\ + echo >&2 "[!] failed to run: $$t";\ + exit 1;\ + };\ + done +.PHONY: test/tests + +test/upstream: upstream/tests/support/bower_components + @$(PULP) test > /dev/null .PHONY: test/pulp -test: test/examples test/purs test/c +test: + @echo 'running ctests...' + @$(MAKE) -s test/c + @echo 'running tests...' + @$(MAKE) -s test/tests + @echo 'running upstream tests...' + @$(MAKE) -s test/upstream + @echo 'success!' +.PHONY: test #------------------------------------------------------------------------------- # utilities diff --git a/tests/basic/.gitignore b/tests/00-basic/.gitignore similarity index 100% rename from tests/basic/.gitignore rename to tests/00-basic/.gitignore diff --git a/tests/basic/Makefile b/tests/00-basic/Makefile similarity index 100% rename from tests/basic/Makefile rename to tests/00-basic/Makefile diff --git a/tests/basic/packages.dhall b/tests/00-basic/packages.dhall similarity index 100% rename from tests/basic/packages.dhall rename to tests/00-basic/packages.dhall diff --git a/tests/basic/spago.dhall b/tests/00-basic/spago.dhall similarity index 100% rename from tests/basic/spago.dhall rename to tests/00-basic/spago.dhall diff --git a/tests/basic/src/Main.purs b/tests/00-basic/src/Main.purs similarity index 100% rename from tests/basic/src/Main.purs rename to tests/00-basic/src/Main.purs diff --git a/tests/foreign/.gitignore b/tests/01-partialfuns/.gitignore similarity index 100% rename from tests/foreign/.gitignore rename to tests/01-partialfuns/.gitignore diff --git a/tests/foreign/Makefile b/tests/01-partialfuns/Makefile similarity index 100% rename from tests/foreign/Makefile rename to tests/01-partialfuns/Makefile diff --git a/tests/foreign/packages.dhall b/tests/01-partialfuns/packages.dhall similarity index 100% rename from tests/foreign/packages.dhall rename to tests/01-partialfuns/packages.dhall diff --git a/tests/partialfuns/spago.dhall b/tests/01-partialfuns/spago.dhall similarity index 100% rename from tests/partialfuns/spago.dhall rename to tests/01-partialfuns/spago.dhall diff --git a/tests/partialfuns/src/Main.purs b/tests/01-partialfuns/src/Main.purs similarity index 100% rename from tests/partialfuns/src/Main.purs rename to tests/01-partialfuns/src/Main.purs diff --git a/tests/memory/.gitignore b/tests/02-foreign/.gitignore similarity index 100% rename from tests/memory/.gitignore rename to tests/02-foreign/.gitignore diff --git a/tests/memory/Makefile b/tests/02-foreign/Makefile similarity index 100% rename from tests/memory/Makefile rename to tests/02-foreign/Makefile diff --git a/tests/memory/packages.dhall b/tests/02-foreign/packages.dhall similarity index 100% rename from tests/memory/packages.dhall rename to tests/02-foreign/packages.dhall diff --git a/tests/foreign/spago.dhall b/tests/02-foreign/spago.dhall similarity index 100% rename from tests/foreign/spago.dhall rename to tests/02-foreign/spago.dhall diff --git a/tests/foreign/src/Main.h b/tests/02-foreign/src/Main.h similarity index 100% rename from tests/foreign/src/Main.h rename to tests/02-foreign/src/Main.h diff --git a/tests/foreign/src/Main.purs b/tests/02-foreign/src/Main.purs similarity index 100% rename from tests/foreign/src/Main.purs rename to tests/02-foreign/src/Main.purs diff --git a/tests/mutrec/.gitignore b/tests/03-mutrec/.gitignore similarity index 100% rename from tests/mutrec/.gitignore rename to tests/03-mutrec/.gitignore diff --git a/tests/mutrec/Makefile b/tests/03-mutrec/Makefile similarity index 100% rename from tests/mutrec/Makefile rename to tests/03-mutrec/Makefile diff --git a/tests/mutrec/packages.dhall b/tests/03-mutrec/packages.dhall similarity index 100% rename from tests/mutrec/packages.dhall rename to tests/03-mutrec/packages.dhall diff --git a/tests/mutrec/spago.dhall b/tests/03-mutrec/spago.dhall similarity index 100% rename from tests/mutrec/spago.dhall rename to tests/03-mutrec/spago.dhall diff --git a/tests/mutrec/src/Main.purs b/tests/03-mutrec/src/Main.purs similarity index 100% rename from tests/mutrec/src/Main.purs rename to tests/03-mutrec/src/Main.purs diff --git a/tests/partialfuns/.gitignore b/tests/04-memory/.gitignore similarity index 100% rename from tests/partialfuns/.gitignore rename to tests/04-memory/.gitignore diff --git a/tests/partialfuns/Makefile b/tests/04-memory/Makefile similarity index 100% rename from tests/partialfuns/Makefile rename to tests/04-memory/Makefile diff --git a/tests/partialfuns/packages.dhall b/tests/04-memory/packages.dhall similarity index 100% rename from tests/partialfuns/packages.dhall rename to tests/04-memory/packages.dhall diff --git a/tests/memory/spago.dhall b/tests/04-memory/spago.dhall similarity index 100% rename from tests/memory/spago.dhall rename to tests/04-memory/spago.dhall diff --git a/tests/memory/src/Main.h b/tests/04-memory/src/Main.h similarity index 100% rename from tests/memory/src/Main.h rename to tests/04-memory/src/Main.h diff --git a/tests/memory/src/Main.purs b/tests/04-memory/src/Main.purs similarity index 100% rename from tests/memory/src/Main.purs rename to tests/04-memory/src/Main.purs diff --git a/tests/prelude/Makefile b/tests/10-prelude/Makefile similarity index 100% rename from tests/prelude/Makefile rename to tests/10-prelude/Makefile diff --git a/tests/prelude/packages.dhall b/tests/10-prelude/packages.dhall similarity index 100% rename from tests/prelude/packages.dhall rename to tests/10-prelude/packages.dhall diff --git a/tests/prelude/spago.dhall b/tests/10-prelude/spago.dhall similarity index 100% rename from tests/prelude/spago.dhall rename to tests/10-prelude/spago.dhall diff --git a/tests/prelude/src/Main.h b/tests/10-prelude/src/Main.h similarity index 100% rename from tests/prelude/src/Main.h rename to tests/10-prelude/src/Main.h diff --git a/tests/prelude/src/Main.purs b/tests/10-prelude/src/Main.purs similarity index 96% rename from tests/prelude/src/Main.purs rename to tests/10-prelude/src/Main.purs index c300de2..c146c83 100644 --- a/tests/prelude/src/Main.purs +++ b/tests/10-prelude/src/Main.purs @@ -51,3 +51,4 @@ main = >> check (show (map show [ 1, 2, 3 ]) == "[\"1\", \"2\", \"3\"]") >> check (map (_ * 3) [ 1, 2, 3 ] == [ 3, 6, 9 ]) >> check (pure 3 == [ 3 ]) + >> check (map identity ([] :: Array Int) == []) From 2e9860496fab29d2cd66cdc100a3f7ad0e6cf05b Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Sat, 13 Jul 2019 17:13:28 +1200 Subject: [PATCH 16/67] Set up cmocka, and work towards a ref counting setup --- Makefile | 39 ++++++++-- ctests/main.c | 22 +++++- runtime/purescript.c | 99 +++++++++---------------- runtime/purescript.h | 170 +++++++++++++++++++++++++++++-------------- 4 files changed, 199 insertions(+), 131 deletions(-) diff --git a/Makefile b/Makefile index 12763fd..6686790 100644 --- a/Makefile +++ b/Makefile @@ -1,19 +1,20 @@ CLANG ?= clang CFLAGS ?= +WITH_GC ?= SHELL := /bin/bash SHELLFLAGS := -eo pipefail PURS := PATH=$$PATH:node_modules/.bin purs PULP := PATH=$$PATH:node_modules/.bin pulp + PUREC_JS := purec.js PUREC := node $(PUREC_JS) PUREC_WORKDIR := .purec-work - -BWDGC_V := v8.0.0 - PUREC_LIB := libpurec.a PUREC_INTERMEDIATE_LIB := libpurec.intermediate.a + +BWDGC_V := v8.0.0 BWDGC_LIB := deps/bwdgc/.libs/libgc.a RUNTIME_SOURCES = \ @@ -26,12 +27,19 @@ RUNTIME_OBJECTS = \ TESTS = $(shell ls tests) +ifdef WITH_GC CFLAGS += \ -D 'uthash_malloc=GC_malloc' \ -D 'uthash_free(ptr, sz)=NULL' \ -D 'vec_realloc=GC_realloc' \ -D 'vec_free(x)=NULL' \ -D 'vec_malloc=GC_malloc' +else +ifdef UNIT_TESTING +CFLAGS += \ + -D UNIT_TESTING +endif +endif $(BWDGC_LIB): @$(MAKE) -s deps/bwdgc @@ -43,7 +51,11 @@ $(BWDGC_LIB): $(PUREC_INTERMEDIATE_LIB): $(RUNTIME_OBJECTS) @ar csr $@ $^ +ifdef WITH_GC $(PUREC_LIB): $(PUREC_INTERMEDIATE_LIB) $(BWDGC_LIB) +else +$(PUREC_LIB): $(PUREC_INTERMEDIATE_LIB) +endif @rm -rf .build @mkdir -p .build @cd .build &&\ @@ -68,7 +80,6 @@ clean: @rm -f $(RUNTIME_OBJECTS) @rm -f $$(find . -type f -name '*.out') @rm -f $$(find . -maxdepth 1 -type f -name '*.a') - @rm -rf $$(find examples -type d -name $(PUREC_WORKDIR)) .PHONY: clean %.o: %.c | $(BWDGC_LIB) @@ -111,17 +122,28 @@ deps/bwdgc: # Tests #------------------------------------------------------------------------------- -test/c: $(LIBPUREC) - @$(CLANG) -L. \ +test/c: + @$(MAKE) -s clean + @UNIT_TESTING=1 $(MAKE) -s test/c.0 +PHONY: test/c + +test/c.0: $(PUREC_LIB) + @$(CLANG) \ + -L. \ ctests/*.c \ -lpurec \ + -lcmocka \ -lpthread \ -I. \ -o ctests/a.out @./ctests/a.out -.PHONY: test/c +.PHONY: test/c.0 test/tests: + @$(MAKE) -s clean + @$(MAKE) -s test/tests.0 + +test/tests.0: @for t in $(TESTS); do\ echo >&2 "running...: $$t" &&\ $(MAKE) > /dev/null -s -C "tests/$$t" clean &&\ @@ -134,9 +156,10 @@ test/tests: exit 1;\ };\ done -.PHONY: test/tests +.PHONY: test/tests.0 test/upstream: upstream/tests/support/bower_components + @$(MAKE) -s clean @$(PULP) test > /dev/null .PHONY: test/pulp diff --git a/ctests/main.c b/ctests/main.c index e37a75d..e985477 100644 --- a/ctests/main.c +++ b/ctests/main.c @@ -1,7 +1,21 @@ -#include +#include +#include +#include +#include -int test_arrays(); +#include "runtime/purescript.h" -int main () { - assert(test_arrays() == 0); +static void leak_memory_test(void **state) { + (void) state; + const purs_str_t * s = purs_str_new("foo: %s", "bar"); + const purs_any_t x = purs_any_string(s); + PURS_ANY_RETAIN(&x); + PURS_ANY_RELEASE(&x); +} + +int main (void) { + const struct CMUnitTest tests[] = { + cmocka_unit_test(leak_memory_test), + }; + return cmocka_run_group_tests(tests, NULL, NULL); } diff --git a/runtime/purescript.c b/runtime/purescript.c index 15d4525..55fcb75 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -1,29 +1,5 @@ #include "runtime/purescript.h" -static inline void managed_noop_release (managed_t * managed) {} - -inline void managed_default_release (managed_t * managed) { - free((void *) managed->data); -} - -const managed_t * managed_new (const void * data, - const managed_release_func release) { - managed_t * managed = purs_new(managed_t); - managed->data = data; - if (release != NULL) { - GC_register_finalizer( - (void *) managed, - (GC_finalization_proc) release, - 0, 0, 0); - } else { - GC_register_finalizer( - (void *) managed, - (GC_finalization_proc) managed_default_release, - 0, 0, 0); - } - return managed; -} - // ----------------------------------------------------------------------------- // Any: allocate // ----------------------------------------------------------------------------- @@ -50,27 +26,6 @@ ANY purs_any_cons(int tag, int size, ANY* values) { return v; } -/* todo: turn into macro */ -ANY purs_any_string_mv(const char * ptr) { - ANY v; - v.tag = PURS_ANY_TAG_STRING; - v.value.str = managed_new(ptr, managed_noop_release); - return v; -} - -/* todo: turn into macro */ -ANY purs_any_string(const char * fmt, ...) { - ANY v; - v.tag = PURS_ANY_TAG_STRING; - va_list ap; - char *ptr; - va_start(ap, fmt); - assert (vasprintf(&ptr, fmt, ap) >= 0); - va_end(ap); - v.value.str = managed_new(ptr, NULL); - return v; -} - // ----------------------------------------------------------------------------- // Any: getters // ----------------------------------------------------------------------------- @@ -100,50 +55,58 @@ inline const char * purs_any_tag_str (const purs_any_tag_t tag) { purs_any_tag_str(v.tag));\ } while (0) - +/* todo: macro */ inline const purs_any_int_t purs_any_get_int (ANY v) { _PURS_ASSERT_TAG(PURS_ANY_TAG_INT); return v.value.i; } +/* todo: macro */ inline const purs_any_num_t purs_any_get_num (ANY v) { _PURS_ASSERT_TAG(PURS_ANY_TAG_NUM); return v.value.n; } +/* todo: macro */ inline const utf8_int32_t purs_any_get_char (ANY v) { _PURS_ASSERT_TAG(PURS_ANY_TAG_CHAR); return v.value.chr; } +/* todo: macro */ inline purs_any_cont_t * purs_any_get_cont (ANY v) { _PURS_ASSERT_TAG(PURS_ANY_TAG_CONT); return v.value.cont; } +/* todo: macro */ inline purs_any_cons_t * purs_any_get_cons (ANY v) { _PURS_ASSERT_TAG(PURS_ANY_TAG_CONS); return v.value.cons; } +/* todo: macro */ inline const purs_record_t * purs_any_get_record (ANY v) { _PURS_ASSERT_TAG(PURS_ANY_TAG_RECORD); return v.value.record; } +/* todo: macro */ inline const purs_vec_t * purs_any_get_array (ANY v) { _PURS_ASSERT_TAG(PURS_ANY_TAG_ARRAY); return v.value.array; } +/* todo: macro */ inline purs_foreign_t purs_any_get_foreign (ANY v) { _PURS_ASSERT_TAG(PURS_ANY_TAG_FOREIGN); return v.value.foreign; } -inline const void * purs_any_get_string (ANY v) { +/* todo: macro */ +inline const purs_str_t * purs_any_get_string (ANY v) { _PURS_ASSERT_TAG(PURS_ANY_TAG_STRING); - return v.value.str->data; + return v.value.str; } // ----------------------------------------------------------------------------- @@ -266,10 +229,9 @@ ANY purs_any_concat(ANY x, ANY y) { } else { switch(x.tag) { case PURS_ANY_TAG_STRING: { - return purs_any_string( - "%s%s", - purs_any_get_string(x), - purs_any_get_string(y)); + return purs_any_string(purs_str_new("%s%s", + purs_any_get_string(x)->data, + purs_any_get_string(y)->data)); } case PURS_ANY_TAG_ARRAY: { const purs_vec_t * x_vec = purs_any_get_array(x); @@ -294,11 +256,20 @@ ANY purs_any_concat(ANY x, ANY y) { // strings // ----------------------------------------------------------------------------- -const void * purs_string_copy (const void * source) { - size_t sz = utf8size(source); - void * dest = malloc(sz); - memcpy(dest, source, sz); - return (const void*) dest; +static void purs_str_free(const struct purs_rc *ref) { + purs_str_t * x = container_of(ref, purs_str_t, rc); + free(x->data); /* do not use 'purs_free' ! */ + purs_free(x); +} + +const purs_str_t * purs_str_new(const char * fmt, ...) { + va_list ap; + purs_str_t * x = purs_new(purs_str_t); + x->rc = (struct purs_rc) { purs_str_free, 0 }; + va_start(ap, fmt); + assert (vasprintf(&x->data, fmt, ap) >= 0); + va_end(ap); + return (const purs_str_t *) x; } // ----------------------------------------------------------------------------- @@ -378,8 +349,8 @@ const purs_record_t * purs_record_copy_shallow(const purs_record_t * source) { HASH_ADD_KEYPTR( hh, record, - entry_copy->key->data, - utf8size(entry_copy->key->data), + entry_copy->key, + utf8size(entry_copy->key), entry_copy ); } @@ -393,13 +364,13 @@ static purs_record_t * _purs_record_add_multi_mut(purs_record_t * source, const void * key = va_arg(args, const void *); ANY value = va_arg(args, ANY); purs_record_t * entry = purs_new(purs_record_t); - entry->key = managed_new(afmt("%s", key), NULL); + entry->key = afmt("%s", key); entry->value = value; HASH_ADD_KEYPTR( hh, source, - entry->key->data, - utf8size(entry->key->data), + entry->key, + utf8size(entry->key), entry ); } @@ -442,8 +413,8 @@ const purs_record_t * purs_record_merge(const purs_record_t * l, HASH_ADD_KEYPTR( hh, copy, - entry->key->data, - utf8size(entry->key->data), + entry->key, + utf8size(entry->key), entry ); } diff --git a/runtime/purescript.h b/runtime/purescript.h index f1edbf2..e413415 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -1,9 +1,43 @@ #ifndef PURESCRIPT_RUNTIME_H #define PURESCRIPT_RUNTIME_H +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include +#include +#include +#include + +#ifdef WITH_GC +#include "deps/bwdgc/include/gc.h" #define purs_malloc(SZ) GC_MALLOC(SZ) #define purs_realloc(PTR, SZ) GC_REALLOC(PTR, SZ) -#define purs_new(EXP) GC_NEW(EXP) +#define purs_new(EXP) GC_NEW(sizeof (EXP)) +#define purs_free(X) +#else +#ifdef UNIT_TESTING +extern void* _test_malloc(const size_t size, const char* file, const int line); +extern void* _test_calloc(const size_t number_of_elements, const size_t size, + const char* file, const int line); +extern void _test_free(void* const ptr, const char* file, const int line); +#define purs_malloc(SZ) _test_malloc(SZ, __FILE__, __LINE__) +#define purs_realloc(PTR, SZ) _test_malloc(PTR, SZ, __FILE__, __LINE__) +#define purs_free(PTR) _test_free(PTR, __FILE__, __LINE__) +#define purs_new(EXP) purs_malloc(sizeof (EXP)) +#else // UNIT_TESTING +#define purs_malloc(SZ) malloc(SZ) +#define purs_realloc(PTR, SZ) realloc(PTR, SZ) +#define purs_new(EXP) purs_malloc(sizeof (EXP)) +#define purs_free(X) free(X) +#endif +#endif + +#include "ccan/asprintf/asprintf.h" +#include "vendor/uthash.h" +#include "vendor/utf8.h" +#include "vendor/vec.h" #define purs_log_error(FMT, ...)\ do {\ @@ -33,21 +67,9 @@ #define ANY purs_any_t #define APP purs_any_app -#include -#include -#include -#include -#include "deps/bwdgc/include/gc.h" -#include "ccan/asprintf/asprintf.h" -#include "vendor/uthash.h" -#include "vendor/utf8.h" -#include "vendor/vec.h" - #define purs_any_int_t int32_t #define purs_any_num_t double -#define managed_utf8str_t managed_t -typedef struct managed managed_t; typedef struct purs_any purs_any_t; typedef vec_t(purs_any_t) purs_vec_t; typedef struct purs_record purs_record_t; @@ -58,11 +80,7 @@ typedef union purs_any_value purs_any_value_t; typedef ANY (purs_any_thunk_fun_t)(ANY ctx); typedef ANY (purs_any_cont_fun_t)(ANY * ctx, ANY, va_list); typedef struct purs_foreign purs_foreign_t; - -struct managed { const void * data; }; -void managed_default_release (managed_t * managed); -typedef void (*managed_release_func)(managed_t * managed); -const managed_t * managed_new(const void * data, managed_release_func release); +typedef struct purs_str purs_str_t; typedef enum { PURS_ANY_TAG_NULL = 0, @@ -83,21 +101,41 @@ struct purs_foreign { void * data; }; -union purs_any_value { +/* a reference-counted structure */ +struct purs_rc { + void (*free_fn)(const struct purs_rc *); + int count; +}; +#define container_of(ptr, type, member) \ + ((type *)((char *)(ptr) - offsetof(type, member))) + +static inline void purs_rc_retain(const struct purs_rc *ref) { + ((struct purs_rc *)ref)->count++; +} + +static inline void purs_rc_release(const struct purs_rc *ref) { + if (--((struct purs_rc *)ref)->count == 0) { + ref->free_fn(ref); + } +} + +union purs_any_value { /* inline values */ purs_any_int_t i; purs_any_num_t n; utf8_int32_t chr; + purs_foreign_t foreign; /* self-referential, and other values */ - purs_any_cont_t * cont; - purs_any_cons_t * cons; + purs_any_cont_t * cont; + purs_any_cons_t * cons; purs_any_thunk_t * thunk; + const purs_record_t * record; - const managed_t * str; - const purs_vec_t * array; + const purs_str_t * str; + const purs_vec_t * array; }; struct purs_any { @@ -108,19 +146,26 @@ struct purs_any { struct purs_any_thunk { purs_any_thunk_fun_t * fn; ANY ctx; + struct purs_rc rc; }; struct purs_any_cont { purs_any_cont_fun_t * fn; int len; ANY * ctx; + struct purs_rc rc; }; -/* todo: track len values, for clean up */ struct purs_any_cons { int tag; int size; ANY * values; + struct purs_rc rc; +}; + +struct purs_str { + char * data; + struct purs_rc rc; }; ANY purs_any_null; @@ -138,14 +183,11 @@ const char * purs_any_tag_str (const purs_any_tag_t); #define purs_any_foreign PURS_ANY_FOREIGN #define purs_any_array PURS_ANY_ARRAY #define purs_any_record PURS_ANY_RECORD +#define purs_any_string PURS_ANY_STRING /* XXX these functions heap-allocate. maybe rename? */ ANY purs_any_cont(ANY * ctx, int len, purs_any_cont_fun_t *); ANY purs_any_cons(int tag, int size, ANY* values); -ANY purs_any_string(const char * fmt, ...); - -/* allocate a new string box with existing, *GC-allocated* data */ -ANY purs_any_string_new_mv(const char *); const purs_any_int_t purs_any_get_int (ANY); const purs_any_num_t purs_any_get_num (ANY); @@ -154,7 +196,7 @@ purs_foreign_t purs_any_get_foreign (ANY); purs_any_cont_t * purs_any_get_cont (ANY); purs_any_cons_t * purs_any_get_cons (ANY); const purs_record_t * purs_any_get_record (ANY); -const void * purs_any_get_string (ANY); +const purs_str_t * purs_any_get_string (ANY); const purs_vec_t * purs_any_get_array (ANY); // ----------------------------------------------------------------------------- @@ -173,6 +215,7 @@ ANY purs_any_concat(ANY, ANY); // strings // ----------------------------------------------------------------------------- +const purs_str_t * purs_str_new(const char * fmt, ...); const void * purs_string_copy (const void *); #define purs_string_size(STR) utf8size(STR) @@ -183,22 +226,16 @@ const void * purs_string_copy (const void *); // ----------------------------------------------------------------------------- void purs_vec_release (purs_vec_t *); + const purs_vec_t * purs_vec_new (); const purs_vec_t * purs_vec_new_va (int count, ...); const purs_vec_t * purs_vec_copy (const purs_vec_t *); const purs_vec_t * purs_vec_slice (const purs_vec_t *, int begin); -#define purs_vec_foreach(v, var, iter)\ - vec_foreach(v, var, iter) - -#define purs_vec_reserve(v, n)\ - vec_reserve(v, n) - -#define purs_vec_push_mut(v, x)\ - vec_push(v, x) - -#define purs_vec_pusharr_mut(v, arr, count)\ - vec_pusharr(v, arr, count) +#define purs_vec_foreach(v, var, iter) vec_foreach(v, var, iter) +#define purs_vec_reserve(v, n) vec_reserve(v, n) +#define purs_vec_push_mut(v, x) vec_push(v, x) +#define purs_vec_pusharr_mut(v, arr, count) vec_pusharr(v, arr, count) /** * Insert the value val at index idx shifting the elements after the index to @@ -211,7 +248,7 @@ const purs_vec_t * purs_vec_insert(const purs_vec_t *, int idx, ANY val); // ----------------------------------------------------------------------------- typedef struct purs_record { - const managed_utf8str_t * key; + const void * key; ANY value; UT_hash_handle hh; } purs_record_t; @@ -280,6 +317,10 @@ purs_record_add_multi(NULL, count, __VA_ARGS__) // Code-gen helpers // ----------------------------------------------------------------------------- +#define purs_address_of(V) &V +#define purs_derefence(V) *V + +/* Tail-call optimization generation */ struct tco_state { int done; purs_any_t * args; @@ -297,11 +338,9 @@ struct tco_state { #define purs_tco_get_arg(X, I) (((struct tco_state *) X)->args[I]) #define purs_tco_set_arg(X, I, V) (X.args[I] = V) #define purs_tco_mut_arg(X, I, V) (((struct tco_state *) X)->args[I] = V) +#define purs_foreign_get_data(X) (X.data) -#define purs_foreign_get_data(X)\ - (X.data) - -/* emit a scope struct */ +/* Captured scope generation */ #define PURS_SCOPE_T(NAME, DECLS)\ typedef struct NAME {\ struct DECLS;\ @@ -309,16 +348,14 @@ struct tco_state { /* todo: remove this! */ #define purs_cons_get_tag(V) V->tag -#define purs_address_of(V) &V -#define purs_derefence(V) *V -/* thunked pointer dereference. useful for recursive bindings */ +/* Thunked pointer dereference: Recursive bindings support */ #define purs_indirect_value_new() purs_new(ANY) #define purs_indirect_value_assign(I, V) *(I) = (V) #define purs_indirect_thunk_new(X) \ ({\ purs_any_thunk_t * thunk = purs_malloc(sizeof (purs_any_thunk_t));\ - thunk->ctx = ((purs_any_t){ .value = { .foreign = { .data = X } } });\ + thunk->ctx = ((purs_any_t){ .value = { .foreign = { .data = (X) } } }); \ thunk->fn = purs_thunked_deref;\ PURS_ANY_THUNK(thunk);\ }) @@ -353,14 +390,34 @@ ANY purs_thunked_deref(ANY); // Any: initializers // ----------------------------------------------------------------------------- +#define PURS_ANY_RETAIN(X) {\ + switch ((X)->tag) {\ + case PURS_ANY_TAG_STRING:\ + purs_rc_retain(&((X)->value.str->rc));\ + break;\ + default:\ + break;\ + }\ + } + +#define PURS_ANY_RELEASE(X) {\ + switch ((X)->tag) {\ + case PURS_ANY_TAG_STRING:\ + purs_rc_release(&((X)->value.str->rc));\ + break;\ + default:\ + break;\ + }\ + } + #define PURS_ANY_INT(X)\ - ((purs_any_t){ .tag = PURS_ANY_TAG_INT, .value = { .i = X } }) + ((purs_any_t){ .tag = PURS_ANY_TAG_INT, .value = { .i = (X) } }) #define PURS_ANY_NUM(X)\ - ((purs_any_t){ .tag = PURS_ANY_TAG_NUM, .value = { .n = X } }) + ((purs_any_t){ .tag = PURS_ANY_TAG_NUM, .value = { .n = (X) } }) #define PURS_ANY_CHAR(X)\ - ((purs_any_t){ .tag = PURS_ANY_TAG_CHAR, .value = { .chr = X } }) + ((purs_any_t){ .tag = PURS_ANY_TAG_CHAR, .value = { .chr = (X) } }) #define PURS_ANY_FOREIGN(TAG, DATA)\ ((purs_any_t){\ @@ -373,14 +430,17 @@ ANY purs_thunked_deref(ANY); }\ }) +#define PURS_ANY_STRING(X)\ + ((purs_any_t){ .tag = PURS_ANY_TAG_STRING, .value = { .str = (X) } }) + #define PURS_ANY_RECORD(X)\ - ((purs_any_t){ .tag = PURS_ANY_TAG_RECORD, .value = { .record = X } }) + ((purs_any_t){ .tag = PURS_ANY_TAG_RECORD, .value = { .record = (X) } }) #define PURS_ANY_ARRAY(X)\ - ((purs_any_t){ .tag = PURS_ANY_TAG_ARRAY, .value = { .array = X } }) + ((purs_any_t){ .tag = PURS_ANY_TAG_ARRAY, .value = { .array = (X) } }) #define PURS_ANY_THUNK(X)\ - ((purs_any_t){ .tag = PURS_ANY_TAG_THUNK, .value = { .thunk = X } }) + ((purs_any_t){ .tag = PURS_ANY_TAG_THUNK, .value = { .thunk = (X) } }) // ----------------------------------------------------------------------------- // FFI helpers From bd49d63e1447edae0a622086d51dd8704d798146 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Sat, 13 Jul 2019 22:43:57 +1200 Subject: [PATCH 17/67] Continue RC implementation --- ctests/main.c | 36 ++++++++++-- runtime/purescript.c | 117 +++++++++++++++------------------------ runtime/purescript.h | 127 +++++++++++++++++++++++++++++++------------ 3 files changed, 168 insertions(+), 112 deletions(-) diff --git a/ctests/main.c b/ctests/main.c index e985477..e95c6ee 100644 --- a/ctests/main.c +++ b/ctests/main.c @@ -5,12 +5,38 @@ #include "runtime/purescript.h" +static ANY go(const struct purs_scope * scope, ANY arg, va_list _) { + const char * prefix = purs_any_get_string(scope->bindings[0])->data; + const char * suffix = purs_any_get_string(arg)->data; + return purs_any_string(purs_str_new("%s%s", prefix, suffix)); +} + +static ANY mk_prefix_cont (const char * prefix) { + const purs_str_t * s = purs_str_new("%s", prefix); + const struct purs_scope * scope = ({ + const purs_any_t x = purs_any_string(s); + purs_scope_new(1, &x); + }); + const purs_cont_t * cont = purs_cont_new(scope, go); + PURS_RC_RELEASE(scope); + PURS_RC_RELEASE(s); + return purs_any_cont(cont); +} + static void leak_memory_test(void **state) { - (void) state; - const purs_str_t * s = purs_str_new("foo: %s", "bar"); - const purs_any_t x = purs_any_string(s); - PURS_ANY_RETAIN(&x); - PURS_ANY_RELEASE(&x); + (void) state; /* unused */ + + ANY cont = mk_prefix_cont("foo: "); + const purs_str_t * s = purs_str_new("bar"); + + ANY output = purs_any_app(cont, purs_any_string(s)); + PURS_ANY_RELEASE(&output); + + output = purs_any_app(cont, purs_any_string(s)); + PURS_ANY_RELEASE(&output); + + PURS_RC_RELEASE(s); + PURS_ANY_RELEASE(&cont); } int main (void) { diff --git a/runtime/purescript.c b/runtime/purescript.c index 55fcb75..5e2aa2c 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -4,18 +4,23 @@ // Any: allocate // ----------------------------------------------------------------------------- -/* todo: turn into macro */ -ANY purs_any_cont(ANY * ctx, int len, purs_any_cont_fun_t * fn) { - ANY v; - v.tag = PURS_ANY_TAG_CONT; - v.value.cont = purs_malloc(sizeof (purs_any_cont_t)); - v.value.cont->fn = fn; - v.value.cont->ctx = ctx; - v.value.cont->len = len; - return v; +static void purs_cont_free(const struct purs_rc *ref) { + purs_cont_t * x = container_of(ref, purs_cont_t, rc); + PURS_RC_RELEASE(x->scope); + purs_free(x); +} + +const purs_cont_t * purs_cont_new(const struct purs_scope * scope, + purs_cont_fun_t * fn) { + purs_cont_t * cont = purs_malloc(sizeof (purs_cont_t)); + cont->fn = fn; + cont->scope = scope; + PURS_RC_RETAIN(scope); + cont->rc = ((struct purs_rc) { purs_cont_free, 1 }); + return (const purs_cont_t *) cont; } -/* todo: turn into macro */ +/* todo: treat. */ ANY purs_any_cons(int tag, int size, ANY* values) { ANY v; v.tag = PURS_ANY_TAG_CONS; @@ -47,66 +52,34 @@ inline const char * purs_any_tag_str (const purs_any_tag_t tag) { return tags[tag]; } -#define _PURS_ASSERT_TAG(TAG)\ - do {\ - v = purs_any_unthunk(v);\ - purs_assert(v.tag == TAG, "expected tag: %s, but got: %s",\ - purs_any_tag_str(TAG),\ - purs_any_tag_str(v.tag));\ - } while (0) - -/* todo: macro */ -inline const purs_any_int_t purs_any_get_int (ANY v) { - _PURS_ASSERT_TAG(PURS_ANY_TAG_INT); - return v.value.i; -} - -/* todo: macro */ -inline const purs_any_num_t purs_any_get_num (ANY v) { - _PURS_ASSERT_TAG(PURS_ANY_TAG_NUM); - return v.value.n; -} - -/* todo: macro */ -inline const utf8_int32_t purs_any_get_char (ANY v) { - _PURS_ASSERT_TAG(PURS_ANY_TAG_CHAR); - return v.value.chr; -} - -/* todo: macro */ -inline purs_any_cont_t * purs_any_get_cont (ANY v) { - _PURS_ASSERT_TAG(PURS_ANY_TAG_CONT); - return v.value.cont; -} - -/* todo: macro */ -inline purs_any_cons_t * purs_any_get_cons (ANY v) { - _PURS_ASSERT_TAG(PURS_ANY_TAG_CONS); - return v.value.cons; -} - -/* todo: macro */ -inline const purs_record_t * purs_any_get_record (ANY v) { - _PURS_ASSERT_TAG(PURS_ANY_TAG_RECORD); - return v.value.record; -} - -/* todo: macro */ -inline const purs_vec_t * purs_any_get_array (ANY v) { - _PURS_ASSERT_TAG(PURS_ANY_TAG_ARRAY); - return v.value.array; -} +// ----------------------------------------------------------------------------- +// Scopes +// ----------------------------------------------------------------------------- -/* todo: macro */ -inline purs_foreign_t purs_any_get_foreign (ANY v) { - _PURS_ASSERT_TAG(PURS_ANY_TAG_FOREIGN); - return v.value.foreign; +static void purs_scope_free(const struct purs_rc *ref) { + struct purs_scope * x = container_of(ref, struct purs_scope, rc); + for (int i = 0; i < x->size; i++) { + PURS_ANY_RELEASE(&(x->bindings[i])); + } + purs_free(x->bindings); + purs_free(x); } -/* todo: macro */ -inline const purs_str_t * purs_any_get_string (ANY v) { - _PURS_ASSERT_TAG(PURS_ANY_TAG_STRING); - return v.value.str; +struct purs_scope * purs_scope_new(int size, ...) { + struct purs_scope * scope = purs_new(struct purs_scope); + ANY* bindings = purs_malloc(sizeof (ANY) * size); + scope->size = size; + scope->bindings = bindings; + int i; + va_list ap; + va_start(ap, size); + for (i = 0; i < size; i++) { + bindings[i] = *va_arg(ap, ANY *); + PURS_ANY_RETAIN(&bindings[i]); + } + va_end(ap); + scope->rc = ((struct purs_rc) { purs_scope_free, 1 }); + return scope; } // ----------------------------------------------------------------------------- @@ -130,7 +103,7 @@ inline ANY purs_any_app(ANY f, ANY v, ...) { assert(f.tag == PURS_ANY_TAG_CONT); va_list args; va_start(args, v); - ANY r = f.value.cont->fn(f.value.cont->ctx, v, args); + ANY r = f.value.cont->fn(f.value.cont->scope, v, args); va_end(args); return r; } @@ -257,15 +230,15 @@ ANY purs_any_concat(ANY x, ANY y) { // ----------------------------------------------------------------------------- static void purs_str_free(const struct purs_rc *ref) { - purs_str_t * x = container_of(ref, purs_str_t, rc); - free(x->data); /* do not use 'purs_free' ! */ - purs_free(x); + purs_str_t * x = container_of(ref, purs_str_t, rc); + free(x->data); /* do not use 'purs_free' ! */ + purs_free(x); } const purs_str_t * purs_str_new(const char * fmt, ...) { va_list ap; purs_str_t * x = purs_new(purs_str_t); - x->rc = (struct purs_rc) { purs_str_free, 0 }; + x->rc = (struct purs_rc) { purs_str_free, 1 }; va_start(ap, fmt); assert (vasprintf(&x->data, fmt, ap) >= 0); va_end(ap); diff --git a/runtime/purescript.h b/runtime/purescript.h index e413415..1f44605 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -73,12 +73,13 @@ extern void _test_free(void* const ptr, const char* file, const int line); typedef struct purs_any purs_any_t; typedef vec_t(purs_any_t) purs_vec_t; typedef struct purs_record purs_record_t; -typedef struct purs_any_cont purs_any_cont_t; +typedef struct purs_cont purs_cont_t; typedef struct purs_any_thunk purs_any_thunk_t; typedef struct purs_any_cons purs_any_cons_t; typedef union purs_any_value purs_any_value_t; +struct purs_scope; typedef ANY (purs_any_thunk_fun_t)(ANY ctx); -typedef ANY (purs_any_cont_fun_t)(ANY * ctx, ANY, va_list); +typedef ANY (purs_cont_fun_t)(const struct purs_scope *, ANY, va_list); typedef struct purs_foreign purs_foreign_t; typedef struct purs_str purs_str_t; @@ -120,22 +121,24 @@ static inline void purs_rc_release(const struct purs_rc *ref) { } } +/* by convetion, the rc is embedded as 'rc', making these macros possible */ +#define PURS_RC_RELEASE(X) purs_rc_release(&(X)->rc) +#define PURS_RC_RETAIN(X) purs_rc_retain(&(X)->rc) + union purs_any_value { /* inline values */ purs_any_int_t i; purs_any_num_t n; utf8_int32_t chr; - purs_foreign_t foreign; /* self-referential, and other values */ - purs_any_cont_t * cont; - purs_any_cons_t * cons; + const purs_cont_t * cont; + purs_any_cons_t * cons; purs_any_thunk_t * thunk; - const purs_record_t * record; - const purs_str_t * str; - const purs_vec_t * array; + const purs_str_t * str; + const purs_vec_t * array; }; struct purs_any { @@ -149,10 +152,9 @@ struct purs_any_thunk { struct purs_rc rc; }; -struct purs_any_cont { - purs_any_cont_fun_t * fn; - int len; - ANY * ctx; +struct purs_cont { + purs_cont_fun_t * fn; + const struct purs_scope * scope; /* todo: inline? */ struct purs_rc rc; }; @@ -176,28 +178,43 @@ ANY purs_any_unthunk (ANY); const purs_any_tag_t purs_any_get_tag (ANY); const char * purs_any_tag_str (const purs_any_tag_t); -/* DEPRECATED: two versions for compat/historical reasons only */ -#define purs_any_int PURS_ANY_INT -#define purs_any_num PURS_ANY_NUM -#define purs_any_char PURS_ANY_CHAR -#define purs_any_foreign PURS_ANY_FOREIGN -#define purs_any_array PURS_ANY_ARRAY -#define purs_any_record PURS_ANY_RECORD -#define purs_any_string PURS_ANY_STRING - /* XXX these functions heap-allocate. maybe rename? */ -ANY purs_any_cont(ANY * ctx, int len, purs_any_cont_fun_t *); ANY purs_any_cons(int tag, int size, ANY* values); -const purs_any_int_t purs_any_get_int (ANY); -const purs_any_num_t purs_any_get_num (ANY); -const utf8_int32_t purs_any_get_char (ANY); -purs_foreign_t purs_any_get_foreign (ANY); -purs_any_cont_t * purs_any_get_cont (ANY); -purs_any_cons_t * purs_any_get_cons (ANY); -const purs_record_t * purs_any_get_record (ANY); -const purs_str_t * purs_any_get_string (ANY); -const purs_vec_t * purs_any_get_array (ANY); +#define __PURS_ANY_GETTER(N, A, R, TAG)\ + static inline R _purs_any_get_ ## N (ANY v, char * file, int line) {\ + v = purs_any_unthunk(v);\ + purs_assert(v.tag == TAG,\ + "expected tag: %s, but got: %s. at %s:%d",\ + purs_any_tag_str(TAG),\ + purs_any_tag_str(v.tag),\ + file,\ + line);\ + return v.value.A;\ + } + +__PURS_ANY_GETTER(int, i, purs_any_int_t, PURS_ANY_TAG_INT) +__PURS_ANY_GETTER(num, n, purs_any_num_t, PURS_ANY_TAG_NUM) +__PURS_ANY_GETTER(char, chr, utf8_int32_t, PURS_ANY_TAG_CHAR) +__PURS_ANY_GETTER(foreign, foreign, purs_foreign_t, PURS_ANY_TAG_FOREIGN) +__PURS_ANY_GETTER(cont, cont, const purs_cont_t *, PURS_ANY_TAG_CONT) +__PURS_ANY_GETTER(cons, cons, const purs_any_cons_t *, PURS_ANY_TAG_CONS) +__PURS_ANY_GETTER(thunk, thunk, const purs_any_thunk_t *, PURS_ANY_TAG_THUNK) +__PURS_ANY_GETTER(record, record, const purs_record_t *, PURS_ANY_TAG_RECORD) +__PURS_ANY_GETTER(string, str, const purs_str_t *, PURS_ANY_TAG_STRING) +__PURS_ANY_GETTER(array, array, const purs_vec_t *, PURS_ANY_TAG_ARRAY) + +/* todo: generate faster, unsafe variants */ +#define purs_any_get_int(A) _purs_any_get_int((A), __FILE__, __LINE__) +#define purs_any_get_num(A) _purs_any_get_num((A), __FILE__, __LINE__) +#define purs_any_get_char(A) _purs_any_get_char((A), __FILE__, __LINE__) +#define purs_any_get_foreign(A) _purs_any_get_foreign((A), __FILE__, __LINE__) +#define purs_any_get_cont(A) _purs_any_get_cont((A), __FILE__, __LINE__) +#define purs_any_get_cons(A) _purs_any_get_cons((A), __FILE__, __LINE__) +#define purs_any_get_thunk(A) _purs_any_get_thunk((A), __FILE__, __LINE__) +#define purs_any_get_record(A) _purs_any_get_record((A), __FILE__, __LINE__) +#define purs_any_get_string(A) _purs_any_get_string((A), __FILE__, __LINE__) +#define purs_any_get_array(A) _purs_any_get_array((A), __FILE__, __LINE__) // ----------------------------------------------------------------------------- // Any: built-in functions @@ -211,6 +228,12 @@ int purs_any_eq_num (ANY, double); int purs_any_eq(ANY, ANY); ANY purs_any_concat(ANY, ANY); +// ----------------------------------------------------------------------------- +// continuations +// ----------------------------------------------------------------------------- + +const purs_cont_t * purs_cont_new(const struct purs_scope *, purs_cont_fun_t *); + // ----------------------------------------------------------------------------- // strings // ----------------------------------------------------------------------------- @@ -341,6 +364,14 @@ struct tco_state { #define purs_foreign_get_data(X) (X.data) /* Captured scope generation */ +struct purs_scope { + int size; + ANY* bindings; + struct purs_rc rc; +}; + +struct purs_scope * purs_scope_new(int size, ...); + #define PURS_SCOPE_T(NAME, DECLS)\ typedef struct NAME {\ struct DECLS;\ @@ -402,11 +433,24 @@ ANY purs_thunked_deref(ANY); #define PURS_ANY_RELEASE(X) {\ switch ((X)->tag) {\ + case PURS_ANY_TAG_NULL:\ + case PURS_ANY_TAG_INT:\ + case PURS_ANY_TAG_NUM:\ + break;\ + case PURS_ANY_TAG_THUNK:\ + case PURS_ANY_TAG_CONS:\ + case PURS_ANY_TAG_RECORD:\ + case PURS_ANY_TAG_CHAR:\ + case PURS_ANY_TAG_ARRAY:\ + case PURS_ANY_TAG_FOREIGN:\ + assert(0);\ + break;\ + case PURS_ANY_TAG_CONT:\ + purs_rc_release(&((X)->value.cont->rc));\ + break;\ case PURS_ANY_TAG_STRING:\ purs_rc_release(&((X)->value.str->rc));\ break;\ - default:\ - break;\ }\ } @@ -442,6 +486,19 @@ ANY purs_thunked_deref(ANY); #define PURS_ANY_THUNK(X)\ ((purs_any_t){ .tag = PURS_ANY_TAG_THUNK, .value = { .thunk = (X) } }) +#define PURS_ANY_CONT(X)\ + ((purs_any_t){ .tag = PURS_ANY_TAG_CONT, .value = { .cont = (X) } }) + +/* DEPRECATED: two versions for compat/historical reasons only */ +#define purs_any_int PURS_ANY_INT +#define purs_any_num PURS_ANY_NUM +#define purs_any_char PURS_ANY_CHAR +#define purs_any_foreign PURS_ANY_FOREIGN +#define purs_any_array PURS_ANY_ARRAY +#define purs_any_record PURS_ANY_RECORD +#define purs_any_cont PURS_ANY_CONT +#define purs_any_string PURS_ANY_STRING + // ----------------------------------------------------------------------------- // FFI helpers // ----------------------------------------------------------------------------- @@ -458,7 +515,7 @@ ANY purs_thunked_deref(ANY); // ----------------------------------------------------------------------------- #define _PURS_FFI_FUNC_ENTRY(NAME)\ - purs_any_cont_t NAME ## __cont__ = {\ + purs_cont_t NAME ## __cont__ = {\ .fn = NAME ## __1,\ .len = 0,\ .ctx = NULL\ @@ -482,7 +539,7 @@ ANY purs_thunked_deref(ANY); if (ctx != NULL) {\ ctx[CUR - 1] = a;\ }\ - return purs_any_cont(ctx, CUR, NAME##__##NEXT);\ + return purs_cont(ctx, CUR, NAME##__##NEXT);\ } #define _PURS_FFI_FUNC_CONT_1_TO_2(NAME) _PURS_FFI_FUNC_CONT(NAME, 1, 2) From 099ed9c1667addfb478233216d557f522add7cc5 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Sun, 14 Jul 2019 17:17:26 +1200 Subject: [PATCH 18/67] Continue RC implementation, and add more c tests --- ctests/main.c | 176 ++++++++++- runtime/purescript.c | 301 ++++++++++--------- runtime/purescript.h | 89 +++--- src/Language/PureScript/CodeGen/C.purs | 2 +- src/Language/PureScript/CodeGen/Runtime.purs | 13 +- 5 files changed, 393 insertions(+), 188 deletions(-) diff --git a/ctests/main.c b/ctests/main.c index e95c6ee..255d116 100644 --- a/ctests/main.c +++ b/ctests/main.c @@ -5,7 +5,7 @@ #include "runtime/purescript.h" -static ANY go(const struct purs_scope * scope, ANY arg, va_list _) { +static ANY mk_prefix_cont_0(const struct purs_scope * scope, ANY arg, va_list _) { const char * prefix = purs_any_get_string(scope->bindings[0])->data; const char * suffix = purs_any_get_string(arg)->data; return purs_any_string(purs_str_new("%s%s", prefix, suffix)); @@ -17,31 +17,191 @@ static ANY mk_prefix_cont (const char * prefix) { const purs_any_t x = purs_any_string(s); purs_scope_new(1, &x); }); - const purs_cont_t * cont = purs_cont_new(scope, go); + const purs_cont_t * cont = purs_cont_new(scope, mk_prefix_cont_0); PURS_RC_RELEASE(scope); PURS_RC_RELEASE(s); return purs_any_cont(cont); } -static void leak_memory_test(void **state) { +static void leak_cont_test(void **state) { (void) state; /* unused */ - ANY cont = mk_prefix_cont("foo: "); const purs_str_t * s = purs_str_new("bar"); - ANY output = purs_any_app(cont, purs_any_string(s)); PURS_ANY_RELEASE(&output); - output = purs_any_app(cont, purs_any_string(s)); PURS_ANY_RELEASE(&output); - PURS_RC_RELEASE(s); PURS_ANY_RELEASE(&cont); } +static void leak_string_test(void **state) { + (void) state; /* unused */ + const purs_str_t * s = purs_str_new("bar"); + PURS_RC_RELEASE(s); +} + +/* todo: test empty array */ +static void leak_array_test(void **state) { + (void) state; /* unused */ + const purs_str_t * s1 = purs_str_new("foo"); + const purs_str_t * s2 = purs_str_new("bar"); + const purs_vec_t * v1 = purs_vec_new_va(1, purs_any_string(s1)); + const purs_vec_t * v2 = purs_vec_copy(v1); + const purs_vec_t * v3 = purs_vec_splice(v2, 0, 0); + PURS_RC_RELEASE(s1); + PURS_RC_RELEASE(v1); + assert_string_equal(s1->data, "foo"); /* should not seg-fault */ + PURS_RC_RELEASE(v2); + const purs_vec_t * v4 = purs_vec_insert(v3, 0, purs_any_string(s2)); + const purs_vec_t * v5 = purs_vec_concat(v4, v3); + PURS_RC_RELEASE(s2); + PURS_RC_RELEASE(v3); + PURS_RC_RELEASE(v4); + + /* test: concat */ + assert_null(purs_vec_concat(NULL, NULL)); + + const purs_vec_t * tmp; + assert_ptr_equal(tmp = purs_vec_concat(NULL, v5), v5); + PURS_RC_RELEASE(tmp); + + assert_ptr_equal(tmp = purs_vec_concat(v5, NULL), v5); + PURS_RC_RELEASE(tmp); + + PURS_RC_RELEASE(v5); +} + +static void purs_vec_concat_test(void **state) { + (void) state; /* unused */ + + ANY s1 = purs_any_string(purs_str_new("a")); + ANY s2 = purs_any_string(purs_str_new("b")); + ANY s3 = purs_any_string(purs_str_new("c")); + + const purs_vec_t * v1 = purs_vec_new_va(1, s1); + const purs_vec_t * v2 = purs_vec_new_va(2, s2, s3); + const purs_vec_t * v3 = purs_vec_concat(v1, v2); + + PURS_ANY_RELEASE(&s1); + PURS_ANY_RELEASE(&s2); + PURS_ANY_RELEASE(&s3); + + assert_int_equal(v1->length, 1); + assert_int_equal(v2->length, 2); + assert_int_equal(v3->length, 3); + + assert_string_equal(purs_any_get_string(v1->data[0])->data, "a"); + assert_string_equal(purs_any_get_string(v2->data[0])->data, "b"); + assert_string_equal(purs_any_get_string(v2->data[1])->data, "c"); + assert_string_equal(purs_any_get_string(v3->data[0])->data, "a"); + assert_string_equal(purs_any_get_string(v3->data[1])->data, "b"); + assert_string_equal(purs_any_get_string(v3->data[2])->data, "c"); + + PURS_RC_RELEASE(v1); + PURS_RC_RELEASE(v2); + PURS_RC_RELEASE(v3); +} + +/* todo: test empty record */ +static void leak_record_test(void **state) { + (void) state; /* unused */ + const purs_str_t * s1 = purs_str_new("foo"); + const purs_str_t * s2 = purs_str_new("bar"); + const purs_record_t * x = purs_record_new_va(2, + "s1", purs_any_string(s1), + "s2", purs_any_string(s2)); + PURS_RC_RELEASE(s1); + PURS_RC_RELEASE(s2); + assert_string_equal("foo", s1->data); /* should not seg-fault */ + assert_string_equal("bar", s2->data); /* should not seg-fault */ + const purs_record_t * x2 = purs_record_copy_shallow(x); + assert_string_equal("foo", s1->data); /* should not seg-fault */ + assert_string_equal("bar", s2->data); /* should not seg-fault */ + const purs_record_t * x3 = + purs_record_add_multi(x2, + 2, + "s3", purs_any_string(s1), + "s3", purs_any_string(s1)); + PURS_RC_RELEASE(x); + assert_string_equal("foo", s1->data); /* should not seg-fault */ + assert_string_equal("bar", s2->data); /* should not seg-fault */ + PURS_RC_RELEASE(x2); + assert_string_equal("foo", s1->data); /* should not seg-fault */ + assert_string_equal("bar", s2->data); /* should not seg-fault */ + + /* test key lookup. note looking up on a released record seg-faults! */ + ANY r = *purs_record_find_by_key(x3, "s3"); + assert(strcmp("foo", purs_any_get_string(r)->data) == 0); /* should not seg-fault */ + + PURS_RC_RELEASE(x3); +} + + +static void purs_any_concat_test(void **state) { + (void) state; /* unused */ + + /* test: cannot concat nums */ + expect_assert_failure(purs_any_concat(purs_any_int(0), + purs_any_num(0))); + + /* test: cannot concat ints */ + expect_assert_failure(purs_any_concat(purs_any_int(0.0), + purs_any_num(0.0))); + + /* test: cannot concat differing types */ + for (int i = 0; i < PURS_ANY_TAGS_TOT; i++) { + int j; + if (i == 0) j = PURS_ANY_TAGS_TOT; + else j = i + 1; + if (i == PURS_ANY_TAG_THUNK || j == PURS_ANY_TAG_THUNK) { + /* skip thunks, for now. */ + continue; + } + expect_assert_failure(purs_any_concat((ANY) { .tag = i }, + (ANY) { .tag = j })); + } + + /* test: concat strings */ + { + ANY a = purs_any_string(purs_str_new("a")); + ANY b = purs_any_string(purs_str_new("b")); + ANY ab = purs_any_concat(a, b); + PURS_ANY_RELEASE(&b); + PURS_ANY_RELEASE(&a); + assert_string_equal(purs_any_get_string(ab)->data, "ab"); + PURS_ANY_RELEASE(&ab); + } + + /* test: arrays */ + { + ANY a = purs_any_string(purs_str_new("a")); + ANY b = purs_any_string(purs_str_new("b")); + ANY c = purs_any_string(purs_str_new("c")); + const purs_vec_t * v1 = purs_vec_new_va(2, a, b); + const purs_vec_t * v2 = purs_vec_new_va(3, b, a, c); + ANY v1v2 = purs_any_concat(purs_any_array(v1), + purs_any_array(v2)); + PURS_ANY_RELEASE(&a); + PURS_ANY_RELEASE(&b); + PURS_ANY_RELEASE(&c); + PURS_RC_RELEASE(v1); + PURS_RC_RELEASE(v2); + assert_string_equal(purs_any_get_string(a)->data, "a"); /* should not seg-fault */ + assert_string_equal(purs_any_get_string(b)->data, "b"); /* should not seg-fault */ + assert_string_equal(purs_any_get_string(c)->data, "c"); /* should not seg-fault */ + PURS_ANY_RELEASE(&v1v2); + } +} + int main (void) { const struct CMUnitTest tests[] = { - cmocka_unit_test(leak_memory_test), + cmocka_unit_test(leak_string_test), + cmocka_unit_test(leak_array_test), + cmocka_unit_test(leak_record_test), + cmocka_unit_test(leak_cont_test), + cmocka_unit_test(purs_any_concat_test), + cmocka_unit_test(purs_vec_concat_test), }; return cmocka_run_group_tests(tests, NULL, NULL); } diff --git a/runtime/purescript.c b/runtime/purescript.c index 5e2aa2c..0937c96 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -192,36 +192,21 @@ ANY purs_any_concat(ANY x, ANY y) { assert(x.tag != PURS_ANY_TAG_NULL); assert(y.tag != PURS_ANY_TAG_NULL); + assert(x.tag == y.tag); - if (x.tag != y.tag) { - purs_assert( - 0, - "cannot concat %s with %s", - purs_any_tag_str(x.tag), - purs_any_tag_str(y.tag)); - } else { - switch(x.tag) { - case PURS_ANY_TAG_STRING: { - return purs_any_string(purs_str_new("%s%s", - purs_any_get_string(x)->data, - purs_any_get_string(y)->data)); - } - case PURS_ANY_TAG_ARRAY: { - const purs_vec_t * x_vec = purs_any_get_array(x); - const purs_vec_t * y_vec = purs_any_get_array(y); - if (x_vec->length == 0) { - return y; - } else if (y_vec->length == 0) { - return x; - } else { - purs_vec_t * out_vec = (purs_vec_t *) purs_vec_copy(x_vec); - vec_pusharr(out_vec, y_vec->data, y_vec->length); - return purs_any_array((const purs_vec_t *) out_vec); - } - } - default: - purs_assert(0, "cannot concat %s", purs_any_tag_str(x.tag)); - } + switch(x.tag) { + case PURS_ANY_TAG_STRING: { + return purs_any_string(purs_str_new("%s%s", + purs_any_get_string(x)->data, + purs_any_get_string(y)->data)); + } + case PURS_ANY_TAG_ARRAY: { + const purs_vec_t * x_vec = purs_any_get_array(x); + const purs_vec_t * y_vec = purs_any_get_array(y); + return purs_any_array(purs_vec_concat(x_vec, y_vec)); + } + default: + purs_assert(0, "cannot concat %s", purs_any_tag_str(x.tag)); } } @@ -249,48 +234,110 @@ const purs_str_t * purs_str_new(const char * fmt, ...) { // arrays // ----------------------------------------------------------------------------- -inline void purs_vec_release (purs_vec_t * vec) { - vec_deinit(vec); +static void purs_vec_free(const struct purs_rc *ref) { + purs_vec_t * x = container_of(ref, purs_vec_t, rc); + int i; + ANY v; + purs_vec_foreach(x, v, i) { + PURS_ANY_RELEASE(&v); + } + vec_deinit(x); + purs_free(x); +} + +static inline purs_vec_t * purs_vec_new() { + purs_vec_t * o = purs_new(purs_vec_t); + o->data = NULL; + o->length = 0; + o->capacity = 0; + o->rc = (struct purs_rc) { purs_vec_free, 1 }; + return o; } -inline const purs_vec_t * purs_vec_new () { - purs_vec_t * v = purs_new(purs_vec_t); - vec_init(v); - return (const purs_vec_t *) v; +#define purs_vec_empty NULL +#define purs_vec_is_empty(V) (V == NULL || V->length == 0) + +const purs_vec_t * purs_vec_concat(const purs_vec_t * lhs, + const purs_vec_t * rhs) { + if (purs_vec_is_empty(lhs)) { + if (rhs != NULL) { + PURS_RC_RETAIN(rhs); + return rhs; + } + return NULL; + } else if (purs_vec_is_empty(rhs)) { + if (lhs != NULL) { + PURS_RC_RETAIN(lhs); + return lhs; + } + return NULL; + } else { + int length = lhs->length + rhs->length; + purs_vec_t * o = purs_vec_new(); + o->data = vec_malloc(sizeof (ANY) * length); + o->length = length; + o->capacity = length; + memcpy(o->data, lhs->data, sizeof (ANY) * lhs->length); + memcpy(o->data + lhs->length, rhs->data, sizeof (ANY) * rhs->length); + for (int i = 0; i < o->length; i++) { + PURS_ANY_RETAIN(&o->data[i]); + } + return o; + } } const purs_vec_t * purs_vec_new_va (int count, ...) { - int i; - va_list args; - ANY* xs = malloc(sizeof (ANY) * count); - va_start(args, count); - for (i = 0; i < count; i++) { - xs[i] = va_arg(args, ANY); + if (count <= 0) { + return NULL; } - purs_vec_t * o = (purs_vec_t *) purs_vec_new(); - vec_pusharr(o, xs, count); - free(xs); + + purs_vec_t * o = purs_vec_new(); + + o->data = vec_malloc(sizeof (ANY) * count); + o->length = count; + o->capacity = count; + + va_list ap; + va_start(ap, count); + for (int i = 0; i < count; i++) { + o->data[i] = va_arg(ap, ANY); + PURS_ANY_RETAIN(&o->data[i]); + } + va_end(ap); + return (const purs_vec_t *) o; } -const purs_vec_t * purs_vec_copy (const purs_vec_t * vec) { - if (vec == NULL || vec->data == NULL) { - return (purs_vec_t *) purs_vec_new(); +static const purs_vec_t * _purs_vec_copy (const purs_vec_t * vec) { + if (purs_vec_is_empty(vec)) { + return NULL; } else { - purs_vec_t * copy = (purs_vec_t *) purs_vec_new(); - copy->length = vec->length; - copy->capacity = vec->capacity; - copy->data = vec_malloc(sizeof (ANY*) * vec->capacity); - memcpy(copy->data, - vec->data, - sizeof (*copy->data) * vec->capacity); - return (const purs_vec_t *) copy; + purs_vec_t * o = purs_vec_new(); + o->length = vec->length; + o->capacity = vec->capacity; + o->data = vec_malloc(sizeof (ANY) * vec->capacity); + memcpy(o->data, vec->data, sizeof (ANY) * vec->capacity); + return (const purs_vec_t *) o; + } +} + +const purs_vec_t * purs_vec_copy (const purs_vec_t * vec) { + const purs_vec_t * copy = _purs_vec_copy(vec); + for (int i = 0; i < copy->length; i++) { + PURS_ANY_RETAIN(©->data[i]); } + return copy; } -const purs_vec_t * purs_vec_slice (const purs_vec_t * vec, int begin) { - purs_vec_t * copy = (purs_vec_t *) purs_vec_copy(vec); - vec_splice(copy, 0, begin); +const purs_vec_t * purs_vec_splice (const purs_vec_t * vec, + int start, + int count) { + /* todo: avoid copying input array */ + purs_vec_t * copy = (purs_vec_t *) _purs_vec_copy(vec); + vec_splice(copy, start, count); + for (int i = 0; i < copy->length; i++) { + PURS_ANY_RETAIN(©->data[i]); + } return (const purs_vec_t *) copy; } @@ -302,6 +349,7 @@ const purs_vec_t * purs_vec_insert(const purs_vec_t * vec, } else { purs_vec_t * out = (purs_vec_t *) purs_vec_copy(vec); vec_insert(out, idx, val); + PURS_ANY_RETAIN(&val); return (const purs_vec_t *) out; } } @@ -310,117 +358,102 @@ const purs_vec_t * purs_vec_insert(const purs_vec_t * vec, // records // ----------------------------------------------------------------------------- +static inline void _purs_record_add_multi_mut(purs_record_t * x, int count, va_list ap); + ANY purs_record_empty = PURS_ANY_RECORD(NULL); -const purs_record_t * purs_record_copy_shallow(const purs_record_t * source) { - const purs_record_t * current_entry, * tmp; - purs_record_t * entry_copy; - purs_record_t * record = NULL; - HASH_ITER(hh, source, current_entry, tmp) { - entry_copy = purs_new(purs_record_t); - memcpy(entry_copy, current_entry, sizeof(purs_record_t)); - HASH_ADD_KEYPTR( - hh, - record, - entry_copy->key, - utf8size(entry_copy->key), - entry_copy - ); +static void purs_record_free(const struct purs_rc *ref) { + purs_record_t * x = container_of(ref, purs_record_t, rc); + const purs_record_node_t * e, * tmp; + HASH_ITER(hh, x->root, e, tmp) { + PURS_ANY_RELEASE(&e->value); + HASH_DEL(x->root, (purs_record_node_t *) e); + purs_free((purs_record_node_t *) e); } - return (const purs_record_t *) record; + purs_free(x); } -static purs_record_t * _purs_record_add_multi_mut(purs_record_t * source, - size_t count, - va_list args) { - for (size_t i = 0; i < count; i++) { - const void * key = va_arg(args, const void *); - ANY value = va_arg(args, ANY); - purs_record_t * entry = purs_new(purs_record_t); - entry->key = afmt("%s", key); - entry->value = value; +/* construct a new record from key/value pairs, e.g.: + * > purs_record_new_va(2, "foo", foo, "bar", bar); + */ +const purs_record_t * purs_record_new_va(int count, ...) { + purs_record_t * x = purs_new(purs_record_t); + x->root = NULL; + va_list ap; + va_start(ap, count); + _purs_record_add_multi_mut(x, count, ap); + va_end(ap); + x->rc = ((struct purs_rc) { purs_record_free, 1 }); + return (const purs_record_t *) x; +} + +/* create a shallow copy of the record + */ +const purs_record_t * purs_record_copy_shallow(const purs_record_t * source) { + const purs_record_node_t * src, * tmp; + purs_record_t * x = purs_new(purs_record_t); + x->root = NULL; + HASH_ITER(hh, source->root, src, tmp) { + purs_record_node_t * dst = purs_new(purs_record_node_t); + dst->key = afmt("%s", src->key); /* todo: perf */ + dst->value = src->value; + PURS_ANY_RETAIN(&dst->value); HASH_ADD_KEYPTR( hh, - source, - entry->key, - utf8size(entry->key), - entry + x->root, + dst->key, + utf8size(dst->key), + dst ); } - return source; -} - -purs_record_t * purs_record_add_multi_mut(purs_record_t * source, - size_t count, - ...) { - va_list args; - va_start(args, count); - _purs_record_add_multi_mut(source, count, args); - va_end(args); - return source; + x->rc = ((struct purs_rc) { purs_record_free, 1 }); + return (const purs_record_t *) x; } const purs_record_t * purs_record_add_multi(const purs_record_t * source, size_t count, ...) { if (count == 0) { + PURS_RC_RETAIN(source); return source; } purs_record_t * copy = (purs_record_t *) purs_record_copy_shallow(source); va_list args; va_start(args, count); - copy = _purs_record_add_multi_mut(copy, count, args); + _purs_record_add_multi_mut(copy, count, args); va_end(args); return (const purs_record_t *) copy; } -const purs_record_t * purs_record_merge(const purs_record_t * l, - const purs_record_t * r) { - const purs_record_t *rec, *tmp = NULL; - purs_record_t * copy = (purs_record_t *) purs_record_copy_shallow(l); - HASH_ITER(hh, r, rec, tmp) { - purs_record_t * entry = purs_new(purs_record_t); - entry->key = rec->key; - entry->value = rec->value; +static inline +void _purs_record_add_multi_mut(purs_record_t * x, + int count, + va_list ap) { + for (int i = 0; i < count; i++) { + const char * key = va_arg(ap, const char *); + ANY value = va_arg(ap, ANY); + purs_record_node_t * entry = purs_new(purs_record_node_t); + entry->key = afmt("%s", key); /* todo: perf */ + entry->value = value; + PURS_ANY_RETAIN(&value); HASH_ADD_KEYPTR( hh, - copy, + x->root, entry->key, utf8size(entry->key), entry ); } - return (const purs_record_t *) copy; -} - -const purs_record_t * purs_record_remove(const purs_record_t * source, - const void * key) { - purs_record_t * v = (purs_record_t *) purs_record_find_by_key(source, key); - if (v != NULL) { - purs_record_t * copy = (purs_record_t *) purs_record_copy_shallow(source); - HASH_DEL(copy, (purs_record_t *) v); - return (const purs_record_t *) copy; - } else { - return source; - } -} - -purs_record_t * purs_record_remove_mut(purs_record_t * source, - const void * key) { - purs_record_t * v = (purs_record_t *) purs_record_find_by_key(source, key); - if (v != NULL) { - HASH_DEL(source, (purs_record_t *) v); - } - return source; } -const purs_record_t * purs_record_find_by_key(const purs_record_t * record, - const void * key) { - purs_record_t * result; +ANY * purs_record_find_by_key(const purs_record_t * record, + const void * key) { + purs_record_node_t * result; size_t len = utf8size(key); - HASH_FIND(hh, record, key, len, result); - return result; + HASH_FIND(hh, record->root, key, len, result); + if (result == NULL) return NULL; + return &result->value; } // ----------------------------------------------------------------------------- diff --git a/runtime/purescript.h b/runtime/purescript.h index 1f44605..b5cb1f1 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -18,9 +18,19 @@ #define purs_free(X) #else #ifdef UNIT_TESTING +extern void mock_assert(const int result, const char *const expression, const char *const file, const int line); +#undef assert +#define assert(A) mock_assert((A), #A, __FILE__, __LINE__) +#define purs_assert(A, FMT, ...)\ + do {\ + if (!(A)) {\ + /*char buf[1024];*/\ + /*sprintf(buf, FMT, ##__VA_ARGS__);*/\ + mock_assert((A), #A, __FILE__, __LINE__);\ + }\ + } while (0) extern void* _test_malloc(const size_t size, const char* file, const int line); -extern void* _test_calloc(const size_t number_of_elements, const size_t size, - const char* file, const int line); +extern void* _test_calloc(const size_t number_of_elements, const size_t size, const char* file, const int line); extern void _test_free(void* const ptr, const char* file, const int line); #define purs_malloc(SZ) _test_malloc(SZ, __FILE__, __LINE__) #define purs_realloc(PTR, SZ) _test_malloc(PTR, SZ, __FILE__, __LINE__) @@ -31,6 +41,13 @@ extern void _test_free(void* const ptr, const char* file, const int line); #define purs_realloc(PTR, SZ) realloc(PTR, SZ) #define purs_new(EXP) purs_malloc(sizeof (EXP)) #define purs_free(X) free(X) +#define purs_assert(A, FMT, ...)\ + do {\ + if (!(A)) {\ + purs_log_error(FMT, ##__VA_ARGS__);\ + assert(A);\ + }\ + } while (0) #endif #endif @@ -48,14 +65,6 @@ extern void _test_free(void* const ptr, const char* file, const int line); ##__VA_ARGS__);\ } while (0) -#define purs_assert(A, FMT, ...)\ - do {\ - if (!(A)) {\ - purs_log_error(FMT, ##__VA_ARGS__);\ - assert(A);\ - }\ -} while (0) - #ifdef ANY #error macro 'ANY' already defined #endif @@ -70,8 +79,8 @@ extern void _test_free(void* const ptr, const char* file, const int line); #define purs_any_int_t int32_t #define purs_any_num_t double +typedef struct purs_vec purs_vec_t; typedef struct purs_any purs_any_t; -typedef vec_t(purs_any_t) purs_vec_t; typedef struct purs_record purs_record_t; typedef struct purs_cont purs_cont_t; typedef struct purs_any_thunk purs_any_thunk_t; @@ -83,6 +92,7 @@ typedef ANY (purs_cont_fun_t)(const struct purs_scope *, ANY, va_list); typedef struct purs_foreign purs_foreign_t; typedef struct purs_str purs_str_t; +/* tag numbers are strictly sequential (for lookups, etc.)! */ typedef enum { PURS_ANY_TAG_NULL = 0, PURS_ANY_TAG_INT = 1, @@ -96,6 +106,7 @@ typedef enum { PURS_ANY_TAG_ARRAY = 9, PURS_ANY_TAG_FOREIGN = 10, } purs_any_tag_t; +#define PURS_ANY_TAGS_TOT 10 /* Keep this in Sync! */ struct purs_foreign { void * tag; @@ -170,6 +181,14 @@ struct purs_str { struct purs_rc rc; }; +/* a reference-counted vec_t(...) */ +struct purs_vec { + ANY * data; + int length; + int capacity; + struct purs_rc rc; +}; + ANY purs_any_null; #define purs_any_is_null(x) (x.tag == PURS_ANY_TAG_NULL) @@ -248,12 +267,10 @@ const void * purs_string_copy (const void *); // arrays // ----------------------------------------------------------------------------- -void purs_vec_release (purs_vec_t *); - -const purs_vec_t * purs_vec_new (); const purs_vec_t * purs_vec_new_va (int count, ...); const purs_vec_t * purs_vec_copy (const purs_vec_t *); -const purs_vec_t * purs_vec_slice (const purs_vec_t *, int begin); +const purs_vec_t * purs_vec_splice (const purs_vec_t *, int start, int count); +const purs_vec_t * purs_vec_concat(const purs_vec_t * lhs, const purs_vec_t * rhs); #define purs_vec_foreach(v, var, iter) vec_foreach(v, var, iter) #define purs_vec_reserve(v, n) vec_reserve(v, n) @@ -270,15 +287,22 @@ const purs_vec_t * purs_vec_insert(const purs_vec_t *, int idx, ANY val); // records // ----------------------------------------------------------------------------- -typedef struct purs_record { +typedef struct purs_node_record { const void * key; ANY value; UT_hash_handle hh; +} purs_record_node_t; + +typedef struct purs_record { + const purs_record_node_t * root; + struct purs_rc rc; } purs_record_t; // TODO: rename to 'purs_any_record_empty' ANY purs_record_empty; +const purs_record_t * purs_record_new_va(int count, ...); + /** * Create a shallow copy of the given record. * Copies only the uthash structure @@ -314,27 +338,8 @@ const purs_record_t * purs_record_merge(const purs_record_t *, /** * Find an entry by it's key. */ -const purs_record_t * purs_record_find_by_key(const purs_record_t *, - const void * key); - -/** - * Remove an entry by it's key. - */ -const purs_record_t * purs_record_remove(const purs_record_t *, - const void * key); - -/** - * Remove an entry by it's key (by mutation) - */ -purs_record_t * purs_record_remove_mut(purs_record_t * source, - const void * key); - -/** - * Create a new record from a bunch of key value pairs. - * The 'count' is the count of pairs, not elements in the va_list. - */ -#define purs_record_new_from_kvps(count, ...)\ -purs_record_add_multi(NULL, count, __VA_ARGS__) +ANY * purs_record_find_by_key(const purs_record_t *, + const void * key); // ----------------------------------------------------------------------------- // Code-gen helpers @@ -436,15 +441,19 @@ ANY purs_thunked_deref(ANY); case PURS_ANY_TAG_NULL:\ case PURS_ANY_TAG_INT:\ case PURS_ANY_TAG_NUM:\ + case PURS_ANY_TAG_CHAR:\ break;\ case PURS_ANY_TAG_THUNK:\ case PURS_ANY_TAG_CONS:\ - case PURS_ANY_TAG_RECORD:\ - case PURS_ANY_TAG_CHAR:\ - case PURS_ANY_TAG_ARRAY:\ case PURS_ANY_TAG_FOREIGN:\ assert(0);\ break;\ + case PURS_ANY_TAG_ARRAY:\ + purs_rc_release(&((X)->value.array->rc));\ + break;\ + case PURS_ANY_TAG_RECORD:\ + purs_rc_release(&((X)->value.record->rc));\ + break;\ case PURS_ANY_TAG_CONT:\ purs_rc_release(&((X)->value.cont->rc));\ break;\ diff --git a/src/Language/PureScript/CodeGen/C.purs b/src/Language/PureScript/CodeGen/C.purs index 6a3c9ca..01ee63f 100644 --- a/src/Language/PureScript/CodeGen/C.purs +++ b/src/Language/PureScript/CodeGen/C.purs @@ -284,7 +284,7 @@ exprToAst (C.Literal _ (C.ObjectLiteral kvps)) = ado AST.App R.purs_any_record $ [ AST.App - R.purs_record_new_from_kvps $ + R.purs_record_new_va $ [ AST.NumericLiteral $ Left $ A.length kvpAsts ] <> A.concat kvpAsts ] diff --git a/src/Language/PureScript/CodeGen/Runtime.purs b/src/Language/PureScript/CodeGen/Runtime.purs index 96504bc..2d58e9e 100644 --- a/src/Language/PureScript/CodeGen/Runtime.purs +++ b/src/Language/PureScript/CodeGen/Runtime.purs @@ -49,16 +49,19 @@ module Language.PureScript.CodeGen.Runtime , _PURS_ANY_THUNK_DECL , _PURS_ANY_THUNK_DEF - -- misc , purs_cons_t - , purs_record_t , purs_cons_get_tag , purs_vec_new_va + + -- records + , purs_record_t , purs_record_empty , purs_record_find_by_key , purs_record_copy_shallow , purs_record_add_multi - , purs_record_new_from_kvps + , purs_record_new_va + + -- misc , purs_assert , purs_assert' @@ -143,8 +146,8 @@ purs_cons_get_tag = AST.Var "purs_cons_get_tag" purs_any_app :: AST purs_any_app = AST.Var "purs_any_app" -purs_record_new_from_kvps :: AST -purs_record_new_from_kvps = AST.Var "purs_record_new_from_kvps" +purs_record_new_va :: AST +purs_record_new_va = AST.Var "purs_record_new_va" purs_record_find_by_key :: AST purs_record_find_by_key = AST.Var "purs_record_find_by_key" From bba11e2a629593485b931afaaea8a19ed34c34d4 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Mon, 15 Jul 2019 05:44:24 +1200 Subject: [PATCH 19/67] Fix up compilation and test generated code for leakage --- Makefile | 95 +++++++++++++++---- ctests/main.c | 28 ++++-- ctests/test_arrays.c | 13 --- mk/target.mk | 19 ++-- runtime/purescript.c | 30 +++--- runtime/purescript.h | 30 ++++-- src/Language/PureScript/CodeGen/C.purs | 45 ++++----- src/Language/PureScript/CodeGen/C/File.purs | 5 +- src/Language/PureScript/CodeGen/C/Pretty.purs | 7 +- .../PureScript/CodeGen/C/Transforms.purs | 80 +++++----------- src/Language/PureScript/CodeGen/Runtime.purs | 35 ++++++- tests/00-basic/Makefile | 1 + tests/01-partialfuns/Makefile | 1 + tests/02-foreign/Makefile | 1 + tests/03-mutrec/Makefile | 1 + tests/04-memory/Makefile | 1 + tests/04-memory/src/Main.purs | 2 +- tests/10-prelude/Makefile | 1 + tests/main.stub.c | 22 +++++ 19 files changed, 242 insertions(+), 175 deletions(-) delete mode 100644 ctests/test_arrays.c create mode 100644 tests/main.stub.c diff --git a/Makefile b/Makefile index 6686790..d0cad7c 100644 --- a/Makefile +++ b/Makefile @@ -129,34 +129,67 @@ PHONY: test/c test/c.0: $(PUREC_LIB) @$(CLANG) \ + -I. \ -L. \ - ctests/*.c \ + ctests/main.c \ -lpurec \ -lcmocka \ - -lpthread \ - -I. \ -o ctests/a.out @./ctests/a.out .PHONY: test/c.0 -test/tests: +test/tests/lib: + @$(MAKE) -s clean + @UNIT_TESTING=1 $(MAKE) -s test/tests/lib.0 +PHONY: test/tests/lib + +# compile each project under 'tests/' as a library, load and execute via +# cmocka. +# note: this necessitates *all* projects under test to: +# + Have a 'lib' target without an entry point in a module called 'Main' +# + Export a 'main' function from module 'Main' +define mk_test_case +name := $(1) +test/tests/lib/$$(name): $(PUREC_LIB) + @$(MAKE) -s -C "tests/$$(name)" clean + @$(MAKE) -s -C "tests/$$(name)" lib/c + @cd "tests/$$(name)" &&\ + $(CLANG) \ + -I. \ + -I../.. \ + -L../.. \ + ../main.stub.c \ + -lpurec \ + -lcmocka \ + -o a.out + @./"tests/$$(name)/a.out" +.PHONY: test/tests/lib/$$(name) +endef + +$(eval $(call mk_test_case,00-basic)) + +test/tests/lib.0: $(PUREC_LIB) + @set -e; for t in $(TESTS); do\ + $(MAKE) -s "test/tests/lib/$$t";\ + done +.PHONY: test/tests/lib.0 + +test/tests/main: @$(MAKE) -s clean - @$(MAKE) -s test/tests.0 + @$(MAKE) -s test/tests/main.0 +PHONY: test/tests/main -test/tests.0: - @for t in $(TESTS); do\ - echo >&2 "running...: $$t" &&\ +# compile and execute each project under 'tests/' +test/tests/main.0: + @set -e; for t in $(TESTS); do\ + echo "tests/main: $$t: clean" &&\ $(MAKE) > /dev/null -s -C "tests/$$t" clean &&\ - $(MAKE) > /dev/null -s -C "tests/$$t" || {\ - echo >&2 "[!] failed to compile: $$t";\ - exit 1;\ - } &&\ - ( cd "tests/$$t" && ./main.out; ) || {\ - echo >&2 "[!] failed to run: $$t";\ - exit 1;\ - };\ + echo "tests/main: $$t: compile" &&\ + $(MAKE) > /dev/null -s -C "tests/$$t" &&\ + echo "tests/main: $$t: run" &&\ + ( cd "tests/$$t" && ./main.out; ) done -.PHONY: test/tests.0 +.PHONY: test/tests/main.0 test/upstream: upstream/tests/support/bower_components @$(MAKE) -s clean @@ -164,10 +197,12 @@ test/upstream: upstream/tests/support/bower_components .PHONY: test/pulp test: - @echo 'running ctests...' + @echo 'test: c-tests' @$(MAKE) -s test/c - @echo 'running tests...' - @$(MAKE) -s test/tests + @echo 'test: tests/lib' + @$(MAKE) -s test/tests/lib + @echo 'test: tests/main' + @$(MAKE) -s test/tests/main @echo 'running upstream tests...' @$(MAKE) -s test/upstream @echo 'success!' @@ -181,3 +216,23 @@ test: @ROOT=$(PWD) &&\ cd "$(dir $@)" &&\ "$$ROOT/node_modules/.bin/bower" install + +# @set -e; for t in $(TESTS); do\ +# echo "$tests/lib: $$t: clean" &&\ +# $(MAKE) > /dev/null -s -C "tests/$$t" clean &&\ +# echo "$$t: compile library" &&\ +# $(MAKE) > /dev/null -s -C "tests/$$t" lib/c &&\ +# echo "$$t: compile harness" &&\ +# ( cd "tests/$$t" &&\ +# $(CLANG) \ +# -I. \ +# -I../.. \ +# -L../.. \ +# ../main.stub.c \ +# -lpurec \ +# -lcmocka \ +# -o a.out &&\ +# echo "tests/lib: $$t: run harness" &&\ +# ./a.out;\ +# );\ +# done diff --git a/ctests/main.c b/ctests/main.c index 255d116..bdd9348 100644 --- a/ctests/main.c +++ b/ctests/main.c @@ -35,6 +35,14 @@ static void leak_cont_test(void **state) { PURS_ANY_RELEASE(&cont); } +static void purs_scope_new1_test(void **state) { + (void) state; /* unused */ + const purs_scope_t * s = purs_scope_new1(1); + const purs_cont_t * c = purs_cont_new(s, NULL); + PURS_RC_RELEASE(s); + PURS_RC_RELEASE(c); +} + static void leak_string_test(void **state) { (void) state; /* unused */ const purs_str_t * s = purs_str_new("bar"); @@ -195,13 +203,15 @@ static void purs_any_concat_test(void **state) { } int main (void) { - const struct CMUnitTest tests[] = { - cmocka_unit_test(leak_string_test), - cmocka_unit_test(leak_array_test), - cmocka_unit_test(leak_record_test), - cmocka_unit_test(leak_cont_test), - cmocka_unit_test(purs_any_concat_test), - cmocka_unit_test(purs_vec_concat_test), - }; - return cmocka_run_group_tests(tests, NULL, NULL); + const struct CMUnitTest tests[] = { + cmocka_unit_test(leak_string_test), + cmocka_unit_test(leak_array_test), + cmocka_unit_test(leak_record_test), + cmocka_unit_test(leak_cont_test), + cmocka_unit_test(purs_scope_new1_test), + cmocka_unit_test(purs_any_concat_test), + cmocka_unit_test(purs_vec_concat_test), + }; + + return cmocka_run_group_tests(tests, NULL, NULL); } diff --git a/ctests/test_arrays.c b/ctests/test_arrays.c deleted file mode 100644 index ce91f86..0000000 --- a/ctests/test_arrays.c +++ /dev/null @@ -1,13 +0,0 @@ -#include "runtime/purescript.h" - -int test_empty_array () { - return 0; -} - -int test_arrays () { - const purs_vec_t * v = purs_vec_new_va(0); - int i = 0; - ANY tmp; - purs_vec_foreach(v, tmp, i) {} - return 0; -} diff --git a/mk/target.mk b/mk/target.mk index 6afd9b6..9e72f7a 100644 --- a/mk/target.mk +++ b/mk/target.mk @@ -36,11 +36,11 @@ $(PUREC_LIB): @rsync $< $@ clean: - @echo 'removing *.o' + @echo 2>&1 'clean: removing *.o' @rm -f $$(find . -type f -name '*.o') - @echo 'removing *.out' + @echo 2>&1 'clean: removing *.out' @rm -f $$(find . -type f -name '*.out') - @echo 'removing dir $(PUREC_WORKDIR)' + @echo 2>&1 'clean: removing dir $(PUREC_WORKDIR)' @rm -rf $(PUREC_WORKDIR) %.o: %.c @@ -83,11 +83,7 @@ else target := $(1) endif -ifeq (,$(2)) - $$(target)_main_module := Main -else - $$(target)_main_module := $(2) -endif +$$(target)_main_module := $(2) ifeq (,$(3)) $$(target)_src_dirs := src @@ -127,16 +123,21 @@ $$(PUREC_WORKDIR)/$$(target)/.build: \ -L $(PUREC_LIB_DIR) \ -lpurec \ -lm \ - -lpthread \ -ffunction-sections \ $(LD_FLAGS) \ -Wl,$(LD_LINKER_FLAGS) \ -o "$$(target).out" @touch $$@ + @echo Purec build succeeded! _$$(target): $$(PUREC_WORKDIR)/$$(target)/.genc @$$(MAKE) -s $$(PUREC_WORKDIR)/$$(target)/.build $$(target): @$$(MAKE) -s _$$(target) +.PHONY: $$(target) + +$$(target)/c: + @$$(MAKE) -s $$(PUREC_WORKDIR)/$$(target)/.genc +.PHONY: $$(target)/c endef diff --git a/runtime/purescript.c b/runtime/purescript.c index 0937c96..98ce513 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -6,7 +6,7 @@ static void purs_cont_free(const struct purs_rc *ref) { purs_cont_t * x = container_of(ref, purs_cont_t, rc); - PURS_RC_RELEASE(x->scope); + if (x->scope != NULL) PURS_RC_RELEASE(x->scope); purs_free(x); } @@ -15,7 +15,7 @@ const purs_cont_t * purs_cont_new(const struct purs_scope * scope, purs_cont_t * cont = purs_malloc(sizeof (purs_cont_t)); cont->fn = fn; cont->scope = scope; - PURS_RC_RETAIN(scope); + if (scope != NULL) PURS_RC_RETAIN(scope); cont->rc = ((struct purs_rc) { purs_cont_free, 1 }); return (const purs_cont_t *) cont; } @@ -65,6 +65,16 @@ static void purs_scope_free(const struct purs_rc *ref) { purs_free(x); } +struct purs_scope * purs_scope_new1(int size) { + struct purs_scope * scope = purs_new(struct purs_scope); + ANY* bindings = purs_malloc(sizeof (ANY) * size); + scope->size = size; + scope->bindings = bindings; + memset(bindings, 0, sizeof (ANY) * size); /* todo: calloc? */ + scope->rc = ((struct purs_rc) { purs_scope_free, 1 }); + return scope; +} + struct purs_scope * purs_scope_new(int size, ...) { struct purs_scope * scope = purs_new(struct purs_scope); ANY* bindings = purs_malloc(sizeof (ANY) * size); @@ -127,22 +137,6 @@ ANY purs_any_NaN = PURS_ANY_NUM(PURS_NAN); ANY purs_any_infinity = PURS_ANY_NUM(PURS_INFINITY); ANY purs_any_neg_infinity = PURS_ANY_NUM(-PURS_INFINITY); -inline int purs_any_eq_char (ANY x, utf8_int32_t y) { - return purs_any_get_char(x) == y; -} - -inline int purs_any_eq_string (ANY x, const void * str) { - return utf8cmp(purs_any_get_string(x), str) == 0; -} - -inline int purs_any_eq_int (ANY x, purs_any_int_t y) { - return purs_any_get_int(x) == y; -} - -inline int purs_any_eq_num (ANY x, double y) { - return purs_any_get_num(x) == y; -} - int purs_any_eq(ANY x, ANY y) { x = purs_any_unthunk(x); y = purs_any_unthunk(y); diff --git a/runtime/purescript.h b/runtime/purescript.h index b5cb1f1..3c5b805 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -86,7 +86,7 @@ typedef struct purs_cont purs_cont_t; typedef struct purs_any_thunk purs_any_thunk_t; typedef struct purs_any_cons purs_any_cons_t; typedef union purs_any_value purs_any_value_t; -struct purs_scope; +typedef struct purs_scope purs_scope_t; typedef ANY (purs_any_thunk_fun_t)(ANY ctx); typedef ANY (purs_cont_fun_t)(const struct purs_scope *, ANY, va_list); typedef struct purs_foreign purs_foreign_t; @@ -239,10 +239,21 @@ __PURS_ANY_GETTER(array, array, const purs_vec_t *, PURS_ANY_TAG_ARRAY) // Any: built-in functions // ----------------------------------------------------------------------------- -int purs_any_eq_string (ANY, const void *); -int purs_any_eq_char (ANY, utf8_int32_t); -int purs_any_eq_int (ANY, purs_any_int_t); -int purs_any_eq_num (ANY, double); +static inline int purs_any_eq_char (ANY x, utf8_int32_t y) { + return purs_any_get_char(x) == y; +} + +static inline int purs_any_eq_string (ANY x, const void * str) { + return utf8cmp(purs_any_get_string(x)->data, str) == 0; +} + +static inline int purs_any_eq_int (ANY x, purs_any_int_t y) { + return purs_any_get_int(x) == y; +} + +static inline int purs_any_eq_num (ANY x, double y) { + return purs_any_get_num(x) == y; +} int purs_any_eq(ANY, ANY); ANY purs_any_concat(ANY, ANY); @@ -375,12 +386,11 @@ struct purs_scope { struct purs_rc rc; }; -struct purs_scope * purs_scope_new(int size, ...); +#define purs_scope_binding_at(S, N) ((S)->bindings[(N)]) +#define purs_scope_capture_at(S, N, B) { (S)->bindings[(N)] = (B); } -#define PURS_SCOPE_T(NAME, DECLS)\ - typedef struct NAME {\ - struct DECLS;\ - } NAME +struct purs_scope * purs_scope_new(int size, ...); +struct purs_scope * purs_scope_new1(int size); /* todo: remove this! */ #define purs_cons_get_tag(V) V->tag diff --git a/src/Language/PureScript/CodeGen/C.purs b/src/Language/PureScript/CodeGen/C.purs index 01ee63f..f1f1769 100644 --- a/src/Language/PureScript/CodeGen/C.purs +++ b/src/Language/PureScript/CodeGen/C.purs @@ -62,7 +62,7 @@ moduleToAST isMain mod@(C.Module { moduleName, moduleImports, moduleExports, mod cModulePath = F.cModulePath moduleName cIncludes = - ("purescript" A.: _) $ + ("runtime/purescript" A.: _) $ map F.cModulePath $ (A.catMaybes [ ado @@ -243,9 +243,10 @@ exprToAst (C.Literal _ (C.NumericLiteral n)) = ] exprToAst (C.Literal _ (C.StringLiteral s)) = pure $ - AST.App - R.purs_any_string - [ AST.StringLiteral s + AST.App R.purs_any_string + [ AST.App R.purs_str_new + [ AST.StringLiteral s + ] ] exprToAst (C.Literal _ (C.CharLiteral c)) = pure $ @@ -486,16 +487,14 @@ exprToAst (C.Case (C.Ann { sourceSpan, type: typ }) exprs binders) = do , qualifiers: [] , initialization: Just $ - AST.Accessor - (AST.Raw "value") - (AST.App - R.purs_record_find_by_key - [ - AST.App - R.purs_any_get_record - [ AST.Var varName ] - , AST.StringLiteral prop - ]) + AST.App R.purs_derefence + [ AST.App R.purs_record_find_by_key + [ AST.App + R.purs_any_get_record + [ AST.Var varName ] + , AST.StringLiteral prop + ] + ] } A.: ast in go next binders @@ -696,16 +695,14 @@ exprToAst (C.Accessor _ k exp) = ado -- XXX: what if valueAst is not a record? valueAst <- exprToAst exp in - AST.Accessor - (AST.Raw "value") - (AST.App - R.purs_record_find_by_key - [ - AST.App - R.purs_any_get_record - [ valueAst ] - , AST.StringLiteral k - ]) + AST.App R.purs_derefence + [ AST.App R.purs_record_find_by_key + [ AST.App + R.purs_any_get_record + [ valueAst ] + , AST.StringLiteral k + ] + ] exprToAst (C.ObjectUpdate _ o ps) = ado valueAst <- exprToAst o sts <- traverse (\(n /\ exp) -> (n /\ _) <$> exprToAst exp) ps diff --git a/src/Language/PureScript/CodeGen/C/File.purs b/src/Language/PureScript/CodeGen/C/File.purs index f2d1690..23a0991 100644 --- a/src/Language/PureScript/CodeGen/C/File.purs +++ b/src/Language/PureScript/CodeGen/C/File.purs @@ -84,8 +84,6 @@ toBody = A.catMaybes <<< map go go :: AST -> Maybe AST go x@(AST.Function _) = Just x - go x@(AST.App v _) | v == R._PURS_SCOPE_T = - Just x go (AST.VariableIntroduction { name, type: typ, initialization: Just initialization }) = go' initialization where @@ -124,8 +122,7 @@ nativeMain mainVar = , variadic: false , body: Just $ AST.Block - [ AST.App (AST.Var "GC_INIT") [] - , AST.Return $ + [ AST.Return $ AST.App R.purs_any_get_int [ AST.App R.purs_any_app [ mainVar diff --git a/src/Language/PureScript/CodeGen/C/Pretty.purs b/src/Language/PureScript/CodeGen/C/Pretty.purs index a8dbacf..b9d3f35 100644 --- a/src/Language/PureScript/CodeGen/C/Pretty.purs +++ b/src/Language/PureScript/CodeGen/C/Pretty.purs @@ -74,9 +74,9 @@ prettyPrintAst . Monad m => AST -> PrinterT m -prettyPrintAst (AST.Raw x) = do +prettyPrintAst (AST.Raw x) = emit x -prettyPrintAst (AST.Include { path }) = do +prettyPrintAst (AST.Include { path }) = emit $ "#include \"" <> path <> ".h\"" prettyPrintAst AST.EndOfHeader = pure unit @@ -179,9 +179,6 @@ prettyPrintAst (AST.App fnAst argsAsts) = do indent *> prettyPrintAst last lf indent *> emit ")" - -- TODO move this logic out of the printer - when (fnAst == R._PURS_SCOPE_T) do - emit ";" prettyPrintAst (AST.Assignment l r) = do prettyPrintAst l emit " = " diff --git a/src/Language/PureScript/CodeGen/C/Transforms.purs b/src/Language/PureScript/CodeGen/C/Transforms.purs index 1e0f441..3a927cd 100644 --- a/src/Language/PureScript/CodeGen/C/Transforms.purs +++ b/src/Language/PureScript/CodeGen/C/Transforms.purs @@ -218,6 +218,7 @@ eraseLambdas moduleName asts = -- objects are considered used if there's an (unshadowed) -- reference from anywhere in the lambda's body AST. let + capturedBindings = A.fromFoldable capturedScope.bindings capturedScope = currentScope { bindings = @@ -228,11 +229,6 @@ eraseLambdas moduleName asts = currentScope.bindings } - -- emit the struct to the top-level - scopeStruct <- do - { name, members, ast } <- scopeToStruct capturedScope - { name, members } <$ tell [ ast ] - -- assemble a new top-level function that re-assembles the captured contFuncName <- ado id <- freshId @@ -256,7 +252,7 @@ eraseLambdas moduleName asts = { name: Just contFuncName , arguments: [ { name: "$_ctx" - , type: Type.Pointer (Type.RawType scopeStruct.name []) + , type: Type.Pointer (Type.RawType R.purs_scope_t [ Type.Const ]) } , { name: fromMaybe "$_unused" $ _.name <$> A.head arguments , type: R.any @@ -288,7 +284,7 @@ eraseLambdas moduleName asts = (_.name <$> A.head arguments) ) $ A.concat $ - [ A.mapWithIndex <@> scopeStruct.members $ + [ A.mapWithIndex <@> capturedBindings $ \offset name -> name /\ offset /\ Just offset , A.mapWithIndex <@> (fromMaybe [] $ A.tail arguments) $ @@ -319,8 +315,10 @@ eraseLambdas moduleName asts = , qualifiers: [] , initialization: Just $ - AST.Accessor (AST.Var name) $ - AST.Var "$_ctx" + AST.App (AST.Var "purs_scope_binding_at") + [ AST.Var "$_ctx" + , AST.NumericLiteral $ Left i + ] } , [ body' ] ] @@ -338,17 +336,17 @@ eraseLambdas moduleName asts = AST.Block $ [ AST.VariableIntroduction { name: "$_scope" - , type: Type.Pointer R.any + , type: Type.Pointer (Type.RawType R.purs_scope_t []) , qualifiers: [] , initialization: Just $ - if A.null scopeStruct.members + if A.null capturedBindings then AST.Null else AST.App - R.purs_malloc_any_buf $ + R.purs_scope_new1 $ [ AST.NumericLiteral $ - Left $ A.length scopeStruct.members + Left $ A.length capturedBindings ] } , AST.VariableIntroduction @@ -359,58 +357,26 @@ eraseLambdas moduleName asts = Just $ AST.App R.purs_any_cont - [ AST.Var "$_scope" - , AST.NumericLiteral $ - Left $ Set.size capturedScope.bindings - , AST.Cast (Type.Pointer (R.void [ Type.Const ])) $ - AST.Var contFuncName + [ AST.App + R.purs_cont_new + [ AST.Var "$_scope" + , AST.Cast (Type.Pointer (R.void [ Type.Const ])) $ + AST.Var contFuncName + ] ] } ] <> - (A.mapWithIndex <@> scopeStruct.members $ \i v -> - AST.Assignment - (AST.Indexer (AST.NumericLiteral $ Left i) (AST.Var "$_scope")) $ - if Just v == capturedScope.lhs + (A.mapWithIndex <@> capturedBindings $ \i v -> + AST.App (AST.Var "purs_scope_capture_at") + [ AST.Var "$_scope" + , AST.NumericLiteral $ Left i + , if Just v == capturedScope.lhs then AST.App R.purs_indirect_thunk_new [ AST.Var "$_ivalue" ] else AST.Var v + ] ) <> [ AST.Var "$_cont" ] - - scopeToStruct - :: ∀ n r - . Applicative n - => MonadSupply n - => _ - -> n { name :: String, ast :: AST, members :: Array String } - scopeToStruct currentScope = - let - members = - A.fromFoldable currentScope.bindings - - in ado - name <- ado - id <- freshId - in - fromMaybe (moduleName <> "_anon") currentScope.function <> - "__cont_" <> show currentScope.depth <> "_$" <> show id - in - { name - , members - , ast: - AST.App - R._PURS_SCOPE_T - [ AST.Raw name - , AST.Block $ - members <#> \var -> - AST.VariableIntroduction - { name: var - , type: R.any - , qualifiers: [] - , initialization: Nothing - } - ] - } diff --git a/src/Language/PureScript/CodeGen/Runtime.purs b/src/Language/PureScript/CodeGen/Runtime.purs index 2d58e9e..a72a425 100644 --- a/src/Language/PureScript/CodeGen/Runtime.purs +++ b/src/Language/PureScript/CodeGen/Runtime.purs @@ -45,15 +45,28 @@ module Language.PureScript.CodeGen.Runtime , purs_address_of , purs_derefence - , _PURS_SCOPE_T + -- scope + , purs_scope_t + , purs_scope_new + , purs_scope_new1 + , _PURS_ANY_THUNK_DECL , _PURS_ANY_THUNK_DEF + -- constructors , purs_cons_t , purs_cons_get_tag + + -- arrays , purs_vec_new_va - -- records + -- continuations + , purs_cont_new + + -- strings + , purs_str_new + + -- records , purs_record_t , purs_record_empty , purs_record_find_by_key @@ -89,6 +102,9 @@ any = Type.Any [] purs_record_t :: String purs_record_t = "purs_record_t" +purs_scope_t :: String +purs_scope_t = "purs_scope_t" + purs_cons_t :: String purs_cons_t = "purs_cons_t" @@ -161,6 +177,18 @@ purs_record_add_multi = AST.Var "purs_record_add_multi" purs_vec_new_va :: AST purs_vec_new_va = AST.Var "purs_vec_new_va" +purs_cont_new :: AST +purs_cont_new = AST.Var "purs_cont_new" + +purs_str_new :: AST +purs_str_new = AST.Var "purs_str_new" + +purs_scope_new1 :: AST +purs_scope_new1 = AST.Var "purs_scope_new1" + +purs_scope_new :: AST +purs_scope_new = AST.Var "purs_scope_new" + _PURS_ANY_THUNK_DEF :: AST _PURS_ANY_THUNK_DEF = AST.Var "PURS_ANY_THUNK_DEF" @@ -212,9 +240,6 @@ purs_address_of = AST.Var "purs_address_of" purs_derefence :: AST purs_derefence = AST.Var "purs_derefence" -_PURS_SCOPE_T :: AST -_PURS_SCOPE_T = AST.Var "PURS_SCOPE_T" - purs_record_empty :: AST purs_record_empty = AST.Var "purs_record_empty" diff --git a/tests/00-basic/Makefile b/tests/00-basic/Makefile index b0496c5..b8dc15e 100644 --- a/tests/00-basic/Makefile +++ b/tests/00-basic/Makefile @@ -9,3 +9,4 @@ include $(PUREC_DIR)/mk/target.mk main: .spago $(eval $(call purs_mk_target,main,Main,src)) +$(eval $(call purs_mk_target,lib,,src)) diff --git a/tests/01-partialfuns/Makefile b/tests/01-partialfuns/Makefile index b0496c5..b8dc15e 100644 --- a/tests/01-partialfuns/Makefile +++ b/tests/01-partialfuns/Makefile @@ -9,3 +9,4 @@ include $(PUREC_DIR)/mk/target.mk main: .spago $(eval $(call purs_mk_target,main,Main,src)) +$(eval $(call purs_mk_target,lib,,src)) diff --git a/tests/02-foreign/Makefile b/tests/02-foreign/Makefile index b0496c5..b8dc15e 100644 --- a/tests/02-foreign/Makefile +++ b/tests/02-foreign/Makefile @@ -9,3 +9,4 @@ include $(PUREC_DIR)/mk/target.mk main: .spago $(eval $(call purs_mk_target,main,Main,src)) +$(eval $(call purs_mk_target,lib,,src)) diff --git a/tests/03-mutrec/Makefile b/tests/03-mutrec/Makefile index b0496c5..b8dc15e 100644 --- a/tests/03-mutrec/Makefile +++ b/tests/03-mutrec/Makefile @@ -9,3 +9,4 @@ include $(PUREC_DIR)/mk/target.mk main: .spago $(eval $(call purs_mk_target,main,Main,src)) +$(eval $(call purs_mk_target,lib,,src)) diff --git a/tests/04-memory/Makefile b/tests/04-memory/Makefile index b0496c5..b8dc15e 100644 --- a/tests/04-memory/Makefile +++ b/tests/04-memory/Makefile @@ -9,3 +9,4 @@ include $(PUREC_DIR)/mk/target.mk main: .spago $(eval $(call purs_mk_target,main,Main,src)) +$(eval $(call purs_mk_target,lib,,src)) diff --git a/tests/04-memory/src/Main.purs b/tests/04-memory/src/Main.purs index e75895b..37c3b91 100644 --- a/tests/04-memory/src/Main.purs +++ b/tests/04-memory/src/Main.purs @@ -6,7 +6,7 @@ type Effect a = Unit -> a foreign import sub :: Int -> Int -> Int main :: Effect Int -main _ = go { a: 100000 } +main _ = go { a: 100000000 } where go { a: 0 } = 0 go x = go (x { a = sub x.a 1 }) diff --git a/tests/10-prelude/Makefile b/tests/10-prelude/Makefile index b0496c5..b8dc15e 100644 --- a/tests/10-prelude/Makefile +++ b/tests/10-prelude/Makefile @@ -9,3 +9,4 @@ include $(PUREC_DIR)/mk/target.mk main: .spago $(eval $(call purs_mk_target,main,Main,src)) +$(eval $(call purs_mk_target,lib,,src)) diff --git a/tests/main.stub.c b/tests/main.stub.c new file mode 100644 index 0000000..1c462bd --- /dev/null +++ b/tests/main.stub.c @@ -0,0 +1,22 @@ +#include +#include +#include +#include +#include "runtime/purescript.h" + +#include ".purec-work/lib/Main.h" + +static void leak_test(void **state) { + (void) state; /* unused */ + assert_int_equal(0, + purs_any_get_int(purs_any_app(Main_main_$, + purs_any_null))); +} + +int main (void) { + const struct CMUnitTest tests[] = { + cmocka_unit_test(leak_test), + }; + + return cmocka_run_group_tests(tests, NULL, NULL); +} From b27dfcc22fc29abbf76c257dbc68d2cee5876693 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Mon, 15 Jul 2019 09:47:07 +1200 Subject: [PATCH 20/67] Work towards making test 00-basic non-leaky --- Makefile | 27 +++--------- runtime/purescript.c | 28 +----------- runtime/purescript.h | 43 ++++++++++++++----- .../PureScript/CodeGen/C/Transforms.purs | 12 +----- 4 files changed, 42 insertions(+), 68 deletions(-) diff --git a/Makefile b/Makefile index d0cad7c..1715180 100644 --- a/Makefile +++ b/Makefile @@ -150,7 +150,11 @@ PHONY: test/tests/lib # + Export a 'main' function from module 'Main' define mk_test_case name := $(1) -test/tests/lib/$$(name): $(PUREC_LIB) +test/tests/lib/$$(name): + @$(MAKE) -s clean + @UNIT_TESTING=1 $(MAKE) -s test/tests/lib/$$(name).0 + +test/tests/lib/$$(name).0: $(PUREC_LIB) @$(MAKE) -s -C "tests/$$(name)" clean @$(MAKE) -s -C "tests/$$(name)" lib/c @cd "tests/$$(name)" &&\ @@ -159,6 +163,7 @@ test/tests/lib/$$(name): $(PUREC_LIB) -I../.. \ -L../.. \ ../main.stub.c \ + ./.purec-work/lib/*.c \ -lpurec \ -lcmocka \ -o a.out @@ -216,23 +221,3 @@ test: @ROOT=$(PWD) &&\ cd "$(dir $@)" &&\ "$$ROOT/node_modules/.bin/bower" install - -# @set -e; for t in $(TESTS); do\ -# echo "$tests/lib: $$t: clean" &&\ -# $(MAKE) > /dev/null -s -C "tests/$$t" clean &&\ -# echo "$$t: compile library" &&\ -# $(MAKE) > /dev/null -s -C "tests/$$t" lib/c &&\ -# echo "$$t: compile harness" &&\ -# ( cd "tests/$$t" &&\ -# $(CLANG) \ -# -I. \ -# -I../.. \ -# -L../.. \ -# ../main.stub.c \ -# -lpurec \ -# -lcmocka \ -# -o a.out &&\ -# echo "tests/lib: $$t: run harness" &&\ -# ./a.out;\ -# );\ -# done diff --git a/runtime/purescript.c b/runtime/purescript.c index 98ce513..69b69d4 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -15,8 +15,8 @@ const purs_cont_t * purs_cont_new(const struct purs_scope * scope, purs_cont_t * cont = purs_malloc(sizeof (purs_cont_t)); cont->fn = fn; cont->scope = scope; - if (scope != NULL) PURS_RC_RETAIN(scope); cont->rc = ((struct purs_rc) { purs_cont_free, 1 }); + if (scope != NULL) PURS_RC_RETAIN(scope); return (const purs_cont_t *) cont; } @@ -92,32 +92,6 @@ struct purs_scope * purs_scope_new(int size, ...) { return scope; } -// ----------------------------------------------------------------------------- -// Any -// ----------------------------------------------------------------------------- - -inline ANY purs_any_unthunk (ANY x) { - ANY out = x; - while (out.tag == PURS_ANY_TAG_THUNK) { - out = out.value.thunk->fn(out.value.thunk->ctx); - } - return out; -} - -inline const purs_any_tag_t purs_any_get_tag (ANY v) { - return v.tag; -} - -inline ANY purs_any_app(ANY f, ANY v, ...) { - f = purs_any_unthunk(f); - assert(f.tag == PURS_ANY_TAG_CONT); - va_list args; - va_start(args, v); - ANY r = f.value.cont->fn(f.value.cont->scope, v, args); - va_end(args); - return r; -} - // ----------------------------------------------------------------------------- // Any: built-ins // ----------------------------------------------------------------------------- diff --git a/runtime/purescript.h b/runtime/purescript.h index 3c5b805..20f740f 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -189,26 +189,49 @@ struct purs_vec { struct purs_rc rc; }; +/* todo: a more efficient, non-allocating, release-mode version */ +#define purs_any_assert_tag_eq(EXPECTED, ACTUAL)\ + purs_assert((ACTUAL) == (EXPECTED),\ + "expected tag: %s, but got: %s",\ + purs_any_tag_str((ACTUAL)),\ + purs_any_tag_str((EXPECTED))) + ANY purs_any_null; #define purs_any_is_null(x) (x.tag == PURS_ANY_TAG_NULL) -ANY purs_any_app(ANY, ANY, ...); -ANY purs_any_unthunk (ANY); -const purs_any_tag_t purs_any_get_tag (ANY); const char * purs_any_tag_str (const purs_any_tag_t); -/* XXX these functions heap-allocate. maybe rename? */ +static inline ANY purs_any_unthunk (ANY x) { + ANY out = x; + while (out.tag == PURS_ANY_TAG_THUNK) { + /* todo: free intermediate results? */ + out = out.value.thunk->fn(out.value.thunk->ctx); + } + return out; +} + +static inline ANY purs_any_app(ANY f, ANY v, ...) { + f = purs_any_unthunk(f); + purs_any_assert_tag_eq(f.tag, PURS_ANY_TAG_CONT); + va_list args; + va_start(args, v); + ANY r = f.value.cont->fn(f.value.cont->scope, v, args); + va_end(args); + return r; +} + +/* todo: remove this! */ +static inline const purs_any_tag_t purs_any_get_tag (ANY v) { + return v.tag; +} + +/* todo: treat! */ ANY purs_any_cons(int tag, int size, ANY* values); #define __PURS_ANY_GETTER(N, A, R, TAG)\ static inline R _purs_any_get_ ## N (ANY v, char * file, int line) {\ v = purs_any_unthunk(v);\ - purs_assert(v.tag == TAG,\ - "expected tag: %s, but got: %s. at %s:%d",\ - purs_any_tag_str(TAG),\ - purs_any_tag_str(v.tag),\ - file,\ - line);\ + purs_any_assert_tag_eq(v.tag, TAG);\ return v.value.A;\ } diff --git a/src/Language/PureScript/CodeGen/C/Transforms.purs b/src/Language/PureScript/CodeGen/C/Transforms.purs index 3a927cd..4113a82 100644 --- a/src/Language/PureScript/CodeGen/C/Transforms.purs +++ b/src/Language/PureScript/CodeGen/C/Transforms.purs @@ -70,16 +70,8 @@ hoistVarDecls = map go xs' x -> x --- | Erase lambdas from the AST by creating tailor-made scope structures for --- | every lambda we encounter. --- | --- | For example, given the following function: --- | foo = \a b -> b --- | This is trivially representable as a couple of continuation functions: --- | struct foo_1_scope { const ANY * a; }; --- | struct foo_2_scope { const ANY * a; const ANY * b; }; --- | const ANY * foo_2 (const void * super, const ANY * b); --- | const ANY * foo_1 (const void * super, const ANY * a); +-- | Erase lambdas from the AST by capturing used bindings in a heap-allocated, +-- | buffer and emitting a top-level continuation function. -- | -- | XXX: we might have to run this pass *after* optimization passes ran in -- | order to not capture inlined and unused variables. From a86d262d64db3688756a3344448b3844111d99b3 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Mon, 15 Jul 2019 17:47:53 +1200 Subject: [PATCH 21/67] Continue working towards making 00-basic free of leaks --- runtime/purescript.c | 8 +-- runtime/purescript.h | 134 +++++++++++++++++++++++++------------------ tests/main.stub.c | 13 ++++- 3 files changed, 93 insertions(+), 62 deletions(-) diff --git a/runtime/purescript.c b/runtime/purescript.c index 69b69d4..0a89316 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -112,8 +112,8 @@ ANY purs_any_infinity = PURS_ANY_NUM(PURS_INFINITY); ANY purs_any_neg_infinity = PURS_ANY_NUM(-PURS_INFINITY); int purs_any_eq(ANY x, ANY y) { - x = purs_any_unthunk(x); - y = purs_any_unthunk(y); + x = purs_any_unthunk(x, NULL); + y = purs_any_unthunk(y, NULL); /* special treatment for NaN on LHS */ if (purs_any_is_NaN(x) && @@ -155,8 +155,8 @@ int purs_any_eq(ANY x, ANY y) { Concatenate two dyanmic values into a new dynamic value */ ANY purs_any_concat(ANY x, ANY y) { - x = purs_any_unthunk(x); - y = purs_any_unthunk(y); + x = purs_any_unthunk(x, NULL); + y = purs_any_unthunk(y, NULL); assert(x.tag != PURS_ANY_TAG_NULL); assert(y.tag != PURS_ANY_TAG_NULL); diff --git a/runtime/purescript.h b/runtime/purescript.h index 20f740f..455c5fd 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -56,6 +56,9 @@ extern void _test_free(void* const ptr, const char* file, const int line); #include "vendor/utf8.h" #include "vendor/vec.h" +#define purs_trace_any(A)\ + printf("%s:%d: TAG=%s\n", __FILE__, __LINE__, purs_any_tag_str((A).tag)) + #define purs_log_error(FMT, ...)\ do {\ fprintf(stderr,\ @@ -189,6 +192,20 @@ struct purs_vec { struct purs_rc rc; }; +typedef struct purs_node_record { + const void * key; + ANY value; + UT_hash_handle hh; +} purs_record_node_t; + +typedef struct purs_record { + const purs_record_node_t * root; + struct purs_rc rc; +} purs_record_t; + +// TODO: rename to 'purs_any_record_empty' +ANY purs_record_empty; + /* todo: a more efficient, non-allocating, release-mode version */ #define purs_any_assert_tag_eq(EXPECTED, ACTUAL)\ purs_assert((ACTUAL) == (EXPECTED),\ @@ -201,22 +218,78 @@ ANY purs_any_null; const char * purs_any_tag_str (const purs_any_tag_t); -static inline ANY purs_any_unthunk (ANY x) { +#define PURS_ANY_RETAIN(X) {\ + switch ((X)->tag) {\ + case PURS_ANY_TAG_STRING:\ + purs_rc_retain(&((X)->value.str->rc));\ + break;\ + default:\ + break;\ + }\ + } + +#define PURS_ANY_RELEASE(X) {\ + switch ((X)->tag) {\ + case PURS_ANY_TAG_NULL:\ + case PURS_ANY_TAG_INT:\ + case PURS_ANY_TAG_NUM:\ + case PURS_ANY_TAG_CHAR:\ + break;\ + case PURS_ANY_TAG_THUNK:\ + case PURS_ANY_TAG_CONS:\ + case PURS_ANY_TAG_FOREIGN:\ + assert(0);\ + break;\ + case PURS_ANY_TAG_ARRAY:\ + purs_rc_release(&((X)->value.array->rc));\ + break;\ + case PURS_ANY_TAG_RECORD:\ + purs_rc_release(&((X)->value.record->rc));\ + break;\ + case PURS_ANY_TAG_CONT:\ + purs_rc_release(&((X)->value.cont->rc));\ + break;\ + case PURS_ANY_TAG_STRING:\ + purs_rc_release(&((X)->value.str->rc));\ + break;\ + }\ + } + +static inline ANY purs_any_unthunk(ANY x, int * has_changed) { ANY out = x; + if (has_changed != NULL) { + *has_changed = 0; + } while (out.tag == PURS_ANY_TAG_THUNK) { - /* todo: free intermediate results? */ + /* todo: thunks are not rc-ed atm, but once they are, we should + * release intermediate results. + */ out = out.value.thunk->fn(out.value.thunk->ctx); + if (has_changed != NULL) { + *has_changed = 1; + } } return out; } -static inline ANY purs_any_app(ANY f, ANY v, ...) { - f = purs_any_unthunk(f); +static inline ANY purs_any_app(ANY _f, ANY v, ...) { + + /* unthunk, if necessary */ + int has_changed; + ANY f = purs_any_unthunk(_f, &has_changed); purs_any_assert_tag_eq(f.tag, PURS_ANY_TAG_CONT); + + /* apply the function */ va_list args; va_start(args, v); ANY r = f.value.cont->fn(f.value.cont->scope, v, args); va_end(args); + + /* release the intermediate result */ + if (has_changed) { + PURS_ANY_RELEASE(&f); + } + return r; } @@ -230,7 +303,7 @@ ANY purs_any_cons(int tag, int size, ANY* values); #define __PURS_ANY_GETTER(N, A, R, TAG)\ static inline R _purs_any_get_ ## N (ANY v, char * file, int line) {\ - v = purs_any_unthunk(v);\ + v = purs_any_unthunk(v, NULL);\ purs_any_assert_tag_eq(v.tag, TAG);\ return v.value.A;\ } @@ -321,20 +394,6 @@ const purs_vec_t * purs_vec_insert(const purs_vec_t *, int idx, ANY val); // records // ----------------------------------------------------------------------------- -typedef struct purs_node_record { - const void * key; - ANY value; - UT_hash_handle hh; -} purs_record_node_t; - -typedef struct purs_record { - const purs_record_node_t * root; - struct purs_rc rc; -} purs_record_t; - -// TODO: rename to 'purs_any_record_empty' -ANY purs_record_empty; - const purs_record_t * purs_record_new_va(int count, ...); /** @@ -459,43 +518,6 @@ ANY purs_thunked_deref(ANY); // Any: initializers // ----------------------------------------------------------------------------- -#define PURS_ANY_RETAIN(X) {\ - switch ((X)->tag) {\ - case PURS_ANY_TAG_STRING:\ - purs_rc_retain(&((X)->value.str->rc));\ - break;\ - default:\ - break;\ - }\ - } - -#define PURS_ANY_RELEASE(X) {\ - switch ((X)->tag) {\ - case PURS_ANY_TAG_NULL:\ - case PURS_ANY_TAG_INT:\ - case PURS_ANY_TAG_NUM:\ - case PURS_ANY_TAG_CHAR:\ - break;\ - case PURS_ANY_TAG_THUNK:\ - case PURS_ANY_TAG_CONS:\ - case PURS_ANY_TAG_FOREIGN:\ - assert(0);\ - break;\ - case PURS_ANY_TAG_ARRAY:\ - purs_rc_release(&((X)->value.array->rc));\ - break;\ - case PURS_ANY_TAG_RECORD:\ - purs_rc_release(&((X)->value.record->rc));\ - break;\ - case PURS_ANY_TAG_CONT:\ - purs_rc_release(&((X)->value.cont->rc));\ - break;\ - case PURS_ANY_TAG_STRING:\ - purs_rc_release(&((X)->value.str->rc));\ - break;\ - }\ - } - #define PURS_ANY_INT(X)\ ((purs_any_t){ .tag = PURS_ANY_TAG_INT, .value = { .i = (X) } }) diff --git a/tests/main.stub.c b/tests/main.stub.c index 1c462bd..2ca2299 100644 --- a/tests/main.stub.c +++ b/tests/main.stub.c @@ -6,16 +6,25 @@ #include ".purec-work/lib/Main.h" -static void leak_test(void **state) { +static void test(void **state) { (void) state; /* unused */ assert_int_equal(0, purs_any_get_int(purs_any_app(Main_main_$, purs_any_null))); + assert_int_equal(0, + purs_any_get_int(purs_any_app(Main_main_$, + purs_any_null))); + assert_int_equal(0, + purs_any_get_int(purs_any_app(Main_main_$, + purs_any_null))); + assert_int_equal(0, + purs_any_get_int(purs_any_app(Main_main_$, + purs_any_null))); } int main (void) { const struct CMUnitTest tests[] = { - cmocka_unit_test(leak_test), + cmocka_unit_test(test), }; return cmocka_run_group_tests(tests, NULL, NULL); From 190949fab7a2320702acf1ca0f82de43f1dbeeef Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Tue, 16 Jul 2019 09:31:12 +1200 Subject: [PATCH 22/67] Continue exploring a transform that frees resources --- runtime/purescript.h | 4 +- src/Language/PureScript/CodeGen/C.purs | 13 ++-- .../PureScript/CodeGen/C/Transforms.purs | 62 ++++++++++++++++++- tests/main.stub.c | 13 +--- 4 files changed, 70 insertions(+), 22 deletions(-) diff --git a/runtime/purescript.h b/runtime/purescript.h index 455c5fd..64c8f4e 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -136,8 +136,8 @@ static inline void purs_rc_release(const struct purs_rc *ref) { } /* by convetion, the rc is embedded as 'rc', making these macros possible */ -#define PURS_RC_RELEASE(X) purs_rc_release(&(X)->rc) -#define PURS_RC_RETAIN(X) purs_rc_retain(&(X)->rc) +#define PURS_RC_RELEASE(X) do { if (X != NULL) purs_rc_release(&(X)->rc); } while (0) +#define PURS_RC_RETAIN(X) do { if (X != NULL) purs_rc_retain(&(X)->rc); } while (0) union purs_any_value { /* inline values */ diff --git a/src/Language/PureScript/CodeGen/C.purs b/src/Language/PureScript/CodeGen/C.purs index f1f1769..5aac072 100644 --- a/src/Language/PureScript/CodeGen/C.purs +++ b/src/Language/PureScript/CodeGen/C.purs @@ -35,7 +35,7 @@ import Language.PureScript.CodeGen.C.Common (freshInternalName, freshName, isInt import Language.PureScript.CodeGen.C.File as F import Language.PureScript.CodeGen.C.Optimizer (optimize) import Language.PureScript.CodeGen.C.Pretty as P -import Language.PureScript.CodeGen.C.Transforms (eraseLambdas, hoistVarDecls) +import Language.PureScript.CodeGen.C.Transforms as T import Language.PureScript.CodeGen.Common (runModuleName) import Language.PureScript.CodeGen.CompileError (CompileError(..)) import Language.PureScript.CodeGen.Runtime as R @@ -85,11 +85,12 @@ moduleToAST isMain mod@(C.Module { moduleName, moduleImports, moduleExports, mod _.moduleName <<< unwrap <$> moduleImports in runReaderT <@> { module: mod } $ do - decls <- do - decls <- A.concat <$> traverse (bindToAst true) moduleDecls - eraseLambdas cModuleName =<< do - hoistVarDecls <$> - traverse optimize decls + decls <- + (A.concat <$> traverse (bindToAst true) moduleDecls) + >>= traverse optimize + >>= (pure <<< T.hoistVarDecls) + >>= T.eraseLambdas cModuleName + >>= T.releaseResources let moduleHeader = diff --git a/src/Language/PureScript/CodeGen/C/Transforms.purs b/src/Language/PureScript/CodeGen/C/Transforms.purs index 4113a82..fb882ac 100644 --- a/src/Language/PureScript/CodeGen/C/Transforms.purs +++ b/src/Language/PureScript/CodeGen/C/Transforms.purs @@ -1,14 +1,19 @@ module Language.PureScript.CodeGen.C.Transforms ( hoistVarDecls , eraseLambdas + , releaseResources ) where import Prelude +import Control.Monad.Error.Class (class MonadError, throwError) import Control.Monad.Reader (ask, runReaderT, withReaderT) +import Control.Monad.State (execStateT) +import Control.Monad.State as State import Control.Monad.Writer (runWriterT, tell) import Data.Array as A import Data.Either (Either(..)) +import Data.Foldable (for_) import Data.Function (on) import Data.Map as Map import Data.Maybe (Maybe(..), fromMaybe, maybe) @@ -16,15 +21,64 @@ import Data.Set as Set import Data.Traversable (for, traverse) import Data.Tuple (fst, snd) import Data.Tuple.Nested ((/\)) -import Language.PureScript.CodeGen.C.AST (AST) +import Debug.Trace (traceM) import Language.PureScript.CodeGen.C.AST (AST(..), everywhereTopDown) as AST +import Language.PureScript.CodeGen.C.AST (AST) +import Language.PureScript.CodeGen.C.AST as AST import Language.PureScript.CodeGen.C.AST as Type import Language.PureScript.CodeGen.C.AST.Common (isReferenced) as AST import Language.PureScript.CodeGen.C.Common (isInternalVariable) import Language.PureScript.CodeGen.C.Pretty as PP +import Language.PureScript.CodeGen.CompileError (CompileError(..)) import Language.PureScript.CodeGen.Runtime as R import Language.PureScript.CodeGen.SupplyT (class MonadSupply, freshId) +-- | Traverse all blocks, collecting expressions that cause heap allocations and +-- | emitting a corresponding "free"-ing call when the block no longer needs +-- | the variable. +-- | +-- | * We know that 'return;' exists the function immediately with the given +-- | value. +-- | * We know that purec-generated functions must have at most a single return +-- | value of type 'ANY'. +-- | * Thus, we must call 'PURS_ANY_RELEASE' on *all* variables, except the +-- | one returned. +-- +-- todo: Could we remove shadowed bindings in a separate pass? keword: SSA +-- idea: use gotos? +-- { var ret; goto end; end: [...]; return ret; } +releaseResources + :: ∀ m + . Monad m + => MonadSupply m + => MonadError CompileError m + => Array AST + -> m (Array AST) +releaseResources = traverse go + where + go = + AST.everywhereTopDownM $ case _ of + AST.Block xs -> + AST.Block <<< _.out <$> do + execStateT <@> { vars: [], out: [] } $ do + for_ xs $ case _ of + x@(AST.VariableIntroduction v@{ name }) -> do + pushVar v + pushAst x + x -> + pushAst x + x -> + pure x + + pushAst x = State.modify_ (\s -> s { out = A.snoc s.out x }) + pushVar x = State.modify_ (\s -> s { vars = A.snoc s.vars x }) + +-- releaseResources = traverse go +-- where +-- go x = execStateT <@> x $ +-- pure x + + -- | Split out variable declarations and definitions on a per-block (scope) -- | level and hoist the declarations to the top of the scope. hoistVarDecls :: Array AST -> Array AST @@ -79,6 +133,7 @@ eraseLambdas :: ∀ m . Monad m => MonadSupply m + => MonadError CompileError m => String -- ^ lambda prefix -> Array AST -> m (Array AST) @@ -370,5 +425,8 @@ eraseLambdas moduleName asts = AST.Var v ] ) <> - [ AST.Var "$_cont" + [ AST.App (AST.Var "PURS_RC_RELEASE") + [ AST.Var "$_scope" + ] + , AST.Var "$_cont" ] diff --git a/tests/main.stub.c b/tests/main.stub.c index 2ca2299..5e7e0b4 100644 --- a/tests/main.stub.c +++ b/tests/main.stub.c @@ -8,18 +8,7 @@ static void test(void **state) { (void) state; /* unused */ - assert_int_equal(0, - purs_any_get_int(purs_any_app(Main_main_$, - purs_any_null))); - assert_int_equal(0, - purs_any_get_int(purs_any_app(Main_main_$, - purs_any_null))); - assert_int_equal(0, - purs_any_get_int(purs_any_app(Main_main_$, - purs_any_null))); - assert_int_equal(0, - purs_any_get_int(purs_any_app(Main_main_$, - purs_any_null))); + purs_any_app(Main_main_$, purs_any_null); } int main (void) { From e852335f8244a83fc6e6f84e4d0dab07b4868eeb Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Tue, 16 Jul 2019 09:31:28 +1200 Subject: [PATCH 23/67] Fix mk/target.mk multiple target generation The 'target' assignment would be overriden by subsequent calls and thus change the make rules. Holding onto and using $(1), however, circumvents that issue. --- mk/target.mk | 52 ++++++++++++++++++----------------------- tests/00-basic/Makefile | 2 +- 2 files changed, 24 insertions(+), 30 deletions(-) diff --git a/mk/target.mk b/mk/target.mk index 9e72f7a..7744a11 100644 --- a/mk/target.mk +++ b/mk/target.mk @@ -77,48 +77,42 @@ clean: # $(eval $(call purs_mk_target,main,Test.Main,src test,)) define purs_mk_target -ifeq (,$(1)) - target := main -else - target := $(1) -endif - -$$(target)_main_module := $(2) +$(1)_main_module := $(2) ifeq (,$(3)) - $$(target)_src_dirs := src + $(1)_src_dirs := src else - $$(target)_src_dirs := $(3) + $(1)_src_dirs := $(3) endif -$$(target)_local :=\ - $$(shell find $$($$(target)_src_dirs) -type f -name '*.purs') +$(1)_local :=\ + $$(shell find $$($(1)_src_dirs) -type f -name '*.purs') -$$(target)_deps :=\ +$(1)_deps :=\ $$(foreach pkgdir,\ $(PACKAGE_SOURCES),\ $$(call rwildcard,$$(firstword $$(subst *, ,$$(pkgdir))),*.purs *.c)) -$$(target)_srcs := $$($$(target)_local) $$($$(target)_deps) +$(1)_srcs := $$($(1)_local) $$($(1)_deps) -$$(PUREC_WORKDIR)/$$(target)/.corefns: \ - $$(patsubst %.h,%.purs,$$($$(target)_srcs)) +$$(PUREC_WORKDIR)/$(1)/.corefns: \ + $$(patsubst %.h,%.purs,$$($(1)_srcs)) @mkdir -p $$(@D) @$$(PURS) compile -g corefn -o $$(@D) $$(filter %.purs,$$^) @touch $$@ -$$(PUREC_WORKDIR)/$$(target)/.genc: $$(PUREC_WORKDIR)/$$(target)/.corefns +$$(PUREC_WORKDIR)/$(1)/.genc: $$(PUREC_WORKDIR)/$(1)/.corefns @mkdir -p $$(@D) @$$(MAKE) -s $$@.1 @touch $$@ -$$(PUREC_WORKDIR)/$$(target)/.genc.1: $$(patsubst %,%.1,$$(call rwildcard,$$(PUREC_WORKDIR)/$$(target),corefn.json)) - @$$(PUREC) -m "$$($$(target)_main_module)" $$? +$$(PUREC_WORKDIR)/$(1)/.genc.1: $$(patsubst %,%.1,$$(call rwildcard,$$(PUREC_WORKDIR)/$(1),corefn.json)) + @$$(PUREC) -m "$$($(1)_main_module)" $$? @touch $$@ -$$(PUREC_WORKDIR)/$$(target)/.build: \ +$$(PUREC_WORKDIR)/$(1)/.build: \ $(PUREC_LIB) \ - $$(patsubst %.c,%.o,$$(wildcard $$(PUREC_WORKDIR)/$$(target)/*.c)) + $$(patsubst %.c,%.o,$$(wildcard $$(PUREC_WORKDIR)/$(1)/*.c)) @$(CLANG) $$^ \ -L $(PUREC_LIB_DIR) \ -lpurec \ @@ -126,18 +120,18 @@ $$(PUREC_WORKDIR)/$$(target)/.build: \ -ffunction-sections \ $(LD_FLAGS) \ -Wl,$(LD_LINKER_FLAGS) \ - -o "$$(target).out" + -o "$(1).out" @touch $$@ @echo Purec build succeeded! -_$$(target): $$(PUREC_WORKDIR)/$$(target)/.genc - @$$(MAKE) -s $$(PUREC_WORKDIR)/$$(target)/.build +_$(1): $$(PUREC_WORKDIR)/$(1)/.genc + @$$(MAKE) -s $$(PUREC_WORKDIR)/$(1)/.build -$$(target): - @$$(MAKE) -s _$$(target) -.PHONY: $$(target) +$(1): + @$$(MAKE) -s _$(1) +.PHONY: $(1) -$$(target)/c: - @$$(MAKE) -s $$(PUREC_WORKDIR)/$$(target)/.genc -.PHONY: $$(target)/c +$(1)/c: + @$$(MAKE) -s $$(PUREC_WORKDIR)/$(1)/.genc +.PHONY: $(1)/c endef diff --git a/tests/00-basic/Makefile b/tests/00-basic/Makefile index b8dc15e..4958fe4 100644 --- a/tests/00-basic/Makefile +++ b/tests/00-basic/Makefile @@ -8,5 +8,5 @@ include $(PUREC_DIR)/mk/target.mk spago install main: .spago -$(eval $(call purs_mk_target,main,Main,src)) $(eval $(call purs_mk_target,lib,,src)) +$(eval $(call purs_mk_target,main,Main,src)) From 41fb8d0d6abfd3515c194c89384b406ca2e75479 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Tue, 16 Jul 2019 17:51:46 +1200 Subject: [PATCH 24/67] Fix test-case macro in Makefil, and continue exploration --- Makefile | 17 ++++++++--------- runtime/purescript.h | 12 +++++++----- .../PureScript/CodeGen/C/Transforms.purs | 3 ++- tests/main.stub.c | 10 +++++++++- 4 files changed, 26 insertions(+), 16 deletions(-) diff --git a/Makefile b/Makefile index 1715180..ec02e6d 100644 --- a/Makefile +++ b/Makefile @@ -149,15 +149,14 @@ PHONY: test/tests/lib # + Have a 'lib' target without an entry point in a module called 'Main' # + Export a 'main' function from module 'Main' define mk_test_case -name := $(1) -test/tests/lib/$$(name): +test/tests/lib/$(1): @$(MAKE) -s clean - @UNIT_TESTING=1 $(MAKE) -s test/tests/lib/$$(name).0 + @UNIT_TESTING=0 $(MAKE) -s test/tests/lib/$(1).0 -test/tests/lib/$$(name).0: $(PUREC_LIB) - @$(MAKE) -s -C "tests/$$(name)" clean - @$(MAKE) -s -C "tests/$$(name)" lib/c - @cd "tests/$$(name)" &&\ +test/tests/lib/$(1).0: $(PUREC_LIB) + #@$(MAKE) -s -C "tests/$(1)" clean + #@$(MAKE) -s -C "tests/$(1)" lib/c + @cd "tests/$(1)" &&\ $(CLANG) \ -I. \ -I../.. \ @@ -167,8 +166,8 @@ test/tests/lib/$$(name).0: $(PUREC_LIB) -lpurec \ -lcmocka \ -o a.out - @./"tests/$$(name)/a.out" -.PHONY: test/tests/lib/$$(name) + @./"tests/$(1)/a.out" +.PHONY: test/tests/lib/$(1) endef $(eval $(call mk_test_case,00-basic)) diff --git a/runtime/purescript.h b/runtime/purescript.h index 64c8f4e..7de1a52 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -238,19 +238,19 @@ const char * purs_any_tag_str (const purs_any_tag_t); case PURS_ANY_TAG_THUNK:\ case PURS_ANY_TAG_CONS:\ case PURS_ANY_TAG_FOREIGN:\ - assert(0);\ + fprintf(stderr, "WARN: Todo: Implement PURS_ANY_RELEASE for: %s\n", purs_any_tag_str((X)->tag));\ break;\ case PURS_ANY_TAG_ARRAY:\ - purs_rc_release(&((X)->value.array->rc));\ + PURS_RC_RELEASE((X)->value.array);\ break;\ case PURS_ANY_TAG_RECORD:\ - purs_rc_release(&((X)->value.record->rc));\ + PURS_RC_RELEASE((X)->value.record);\ break;\ case PURS_ANY_TAG_CONT:\ - purs_rc_release(&((X)->value.cont->rc));\ + PURS_RC_RELEASE((X)->value.cont); \ break;\ case PURS_ANY_TAG_STRING:\ - purs_rc_release(&((X)->value.str->rc));\ + PURS_RC_RELEASE((X)->value.str); \ break;\ }\ } @@ -500,6 +500,8 @@ ANY purs_thunked_deref(ANY); if (x == 0) {\ x = 1;\ v = INIT;\ + /* todo: provide a way to release this */\ + PURS_ANY_RETAIN(&v);\ }\ return v;\ };\ diff --git a/src/Language/PureScript/CodeGen/C/Transforms.purs b/src/Language/PureScript/CodeGen/C/Transforms.purs index fb882ac..b914d42 100644 --- a/src/Language/PureScript/CodeGen/C/Transforms.purs +++ b/src/Language/PureScript/CodeGen/C/Transforms.purs @@ -340,7 +340,8 @@ eraseLambdas moduleName asts = ] in A.concat - [ map snd $ A.sortBy (compare `on` fst) $ + [ [ AST.App (AST.Var "PURS_RC_RETAIN") [ AST.Var "$_ctx" ] ] + , map snd $ A.sortBy (compare `on` fst) $ Map.toUnfoldable bindings <#> \(name /\ i /\ mOffset) -> i /\ case mOffset of Nothing -> diff --git a/tests/main.stub.c b/tests/main.stub.c index 5e7e0b4..8e75026 100644 --- a/tests/main.stub.c +++ b/tests/main.stub.c @@ -8,9 +8,12 @@ static void test(void **state) { (void) state; /* unused */ - purs_any_app(Main_main_$, purs_any_null); + ANY tmp = purs_any_app(Main_main_$, purs_any_null); + PURS_ANY_RELEASE(&tmp); } +#define UNIT_TESTING +#ifdef UNIT_TESTING int main (void) { const struct CMUnitTest tests[] = { cmocka_unit_test(test), @@ -18,3 +21,8 @@ int main (void) { return cmocka_run_group_tests(tests, NULL, NULL); } +#else +int main(void) { + test(NULL); +} +#endif From 3387a63c8311e9de9c27c8854ca0deadef3fb0a3 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Wed, 17 Jul 2019 09:21:16 +1200 Subject: [PATCH 25/67] Fix some allocated thunk types not being retained --- ctests/main.c | 2 +- runtime/purescript.c | 10 +-------- runtime/purescript.h | 48 +++++++++++++++++++++++++++++--------------- 3 files changed, 34 insertions(+), 26 deletions(-) diff --git a/ctests/main.c b/ctests/main.c index bdd9348..513c3fd 100644 --- a/ctests/main.c +++ b/ctests/main.c @@ -15,7 +15,7 @@ static ANY mk_prefix_cont (const char * prefix) { const purs_str_t * s = purs_str_new("%s", prefix); const struct purs_scope * scope = ({ const purs_any_t x = purs_any_string(s); - purs_scope_new(1, &x); + purs_scope_new(1, x); }); const purs_cont_t * cont = purs_cont_new(scope, mk_prefix_cont_0); PURS_RC_RELEASE(scope); diff --git a/runtime/purescript.c b/runtime/purescript.c index 0a89316..66e26e8 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -84,7 +84,7 @@ struct purs_scope * purs_scope_new(int size, ...) { va_list ap; va_start(ap, size); for (i = 0; i < size; i++) { - bindings[i] = *va_arg(ap, ANY *); + bindings[i] = va_arg(ap, ANY); PURS_ANY_RETAIN(&bindings[i]); } va_end(ap); @@ -423,11 +423,3 @@ ANY * purs_record_find_by_key(const purs_record_t * record, if (result == NULL) return NULL; return &result->value; } - -// ----------------------------------------------------------------------------- -// Code-gen helpers -// ----------------------------------------------------------------------------- - -ANY purs_thunked_deref(ANY ctx) { - return *((ANY*)(ctx.value.foreign.data)); -} diff --git a/runtime/purescript.h b/runtime/purescript.h index 7de1a52..eee591c 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -221,8 +221,16 @@ const char * purs_any_tag_str (const purs_any_tag_t); #define PURS_ANY_RETAIN(X) {\ switch ((X)->tag) {\ case PURS_ANY_TAG_STRING:\ - purs_rc_retain(&((X)->value.str->rc));\ + PURS_RC_RETAIN(((X)->value.str));\ break;\ + case PURS_ANY_TAG_ARRAY:\ + PURS_RC_RETAIN((X)->value.array);\ + break;\ + case PURS_ANY_TAG_RECORD:\ + PURS_RC_RETAIN((X)->value.record);\ + break;\ + case PURS_ANY_TAG_CONT:\ + PURS_RC_RETAIN((X)->value.cont);\ default:\ break;\ }\ @@ -240,6 +248,9 @@ const char * purs_any_tag_str (const purs_any_tag_t); case PURS_ANY_TAG_FOREIGN:\ fprintf(stderr, "WARN: Todo: Implement PURS_ANY_RELEASE for: %s\n", purs_any_tag_str((X)->tag));\ break;\ + case PURS_ANY_TAG_STRING:\ + PURS_RC_RELEASE((X)->value.str);\ + break;\ case PURS_ANY_TAG_ARRAY:\ PURS_RC_RELEASE((X)->value.array);\ break;\ @@ -247,10 +258,7 @@ const char * purs_any_tag_str (const purs_any_tag_t); PURS_RC_RELEASE((X)->value.record);\ break;\ case PURS_ANY_TAG_CONT:\ - PURS_RC_RELEASE((X)->value.cont); \ - break;\ - case PURS_ANY_TAG_STRING:\ - PURS_RC_RELEASE((X)->value.str); \ + PURS_RC_RELEASE((X)->value.cont);\ break;\ }\ } @@ -480,14 +488,23 @@ struct purs_scope * purs_scope_new1(int size); /* Thunked pointer dereference: Recursive bindings support */ #define purs_indirect_value_new() purs_new(ANY) #define purs_indirect_value_assign(I, V) *(I) = (V) -#define purs_indirect_thunk_new(X) \ - ({\ - purs_any_thunk_t * thunk = purs_malloc(sizeof (purs_any_thunk_t));\ - thunk->ctx = ((purs_any_t){ .value = { .foreign = { .data = (X) } } }); \ - thunk->fn = purs_thunked_deref;\ - PURS_ANY_THUNK(thunk);\ - }) -ANY purs_thunked_deref(ANY); + +static inline ANY purs_thunked_deref(ANY ctx) { + return *((ANY*)(ctx.value.foreign.data)); +} + +static inline ANY purs_indirect_thunk_new(ANY * x) { + purs_any_thunk_t * thunk = purs_malloc(sizeof (purs_any_thunk_t)); + thunk->ctx = ((purs_any_t){ + .tag = PURS_ANY_TAG_FOREIGN, + .value = { .foreign = { .data = x } } + }); + thunk->fn = purs_thunked_deref; + return ((purs_any_t){ + .tag = PURS_ANY_TAG_THUNK, + .value = { .thunk = thunk } + }); +} /* allocate a buffer to fit 'N' 'ANY's */ #define purs_malloc_any_buf(N) purs_malloc(sizeof (ANY) * N) @@ -498,11 +515,10 @@ ANY purs_thunked_deref(ANY); static ANY v;\ static int x = 0;\ if (x == 0) {\ - x = 1;\ + x = 0;\ v = INIT;\ - /* todo: provide a way to release this */\ - PURS_ANY_RETAIN(&v);\ }\ + PURS_ANY_RETAIN(&v);\ return v;\ };\ purs_any_thunk_t NAME ## __thunk__ = {\ From 15da14568342f350b9f0fa83eef458c366e08173 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Wed, 17 Jul 2019 09:44:30 +1200 Subject: [PATCH 26/67] Simplify and write up thoughts on freeing resources --- src/Language/PureScript/CodeGen/C.purs | 4 +- src/Language/PureScript/CodeGen/C/File.purs | 31 ++-- .../PureScript/CodeGen/C/Transforms.purs | 134 ++++++++---------- 3 files changed, 74 insertions(+), 95 deletions(-) diff --git a/src/Language/PureScript/CodeGen/C.purs b/src/Language/PureScript/CodeGen/C.purs index 5aac072..8c25601 100644 --- a/src/Language/PureScript/CodeGen/C.purs +++ b/src/Language/PureScript/CodeGen/C.purs @@ -28,6 +28,7 @@ import Data.Traversable (for, for_, traverse) import Data.TraversableWithIndex (traverseWithIndex) import Data.Tuple (snd) import Data.Tuple.Nested ((/\), type (/\)) +import Debug.Trace (traceM) import Language.PureScript.CodeGen.C.AST (AST) import Language.PureScript.CodeGen.C.AST as AST import Language.PureScript.CodeGen.C.AST as Type @@ -684,7 +685,8 @@ exprToAst (C.Abs (C.Ann { type: typ }) ident expr) = do , qualifiers: [] , variadic: false , arguments: - [{ name: argName, type: R.any }] + [ { name: argName, type: R.any } + ] , returnType: R.any , body: Just $ diff --git a/src/Language/PureScript/CodeGen/C/File.purs b/src/Language/PureScript/CodeGen/C/File.purs index 23a0991..e4cb00a 100644 --- a/src/Language/PureScript/CodeGen/C/File.purs +++ b/src/Language/PureScript/CodeGen/C/File.purs @@ -87,24 +87,19 @@ toBody = A.catMaybes <<< map go go (AST.VariableIntroduction { name, type: typ, initialization: Just initialization }) = go' initialization where - go' = case _ of - AST.Cast _ ast@(AST.App f _) - | f `A.elem` - [ R.purs_any_cons - , R.purs_any_int - , R.purs_any_num - , R.purs_any_string - , R.purs_any_record - , R.purs_any_array - ] - -> go' ast - _ -> - Just $ - AST.App - R._PURS_ANY_THUNK_DEF - [ AST.Raw name - , initialization - ] + go' ast = + -- todo: int, num, string, char, and cont could be statically initialized. + -- Cons(tructors), arrays, and records would need more + -- consideration. The key problem with thunking "into" static + -- variables is that freeing these resources becomes tricky, as they + -- would need to be able to be re-initialized after the RC drops to + -- back to zero. + Just $ + AST.App + R._PURS_ANY_THUNK_DEF + [ AST.Raw name + , ast + ] go _ = Nothing -- XXX: should be configurable diff --git a/src/Language/PureScript/CodeGen/C/Transforms.purs b/src/Language/PureScript/CodeGen/C/Transforms.purs index b914d42..70852bd 100644 --- a/src/Language/PureScript/CodeGen/C/Transforms.purs +++ b/src/Language/PureScript/CodeGen/C/Transforms.purs @@ -21,32 +21,38 @@ import Data.Set as Set import Data.Traversable (for, traverse) import Data.Tuple (fst, snd) import Data.Tuple.Nested ((/\)) -import Debug.Trace (traceM) import Language.PureScript.CodeGen.C.AST (AST(..), everywhereTopDown) as AST import Language.PureScript.CodeGen.C.AST (AST) import Language.PureScript.CodeGen.C.AST as AST import Language.PureScript.CodeGen.C.AST as Type import Language.PureScript.CodeGen.C.AST.Common (isReferenced) as AST import Language.PureScript.CodeGen.C.Common (isInternalVariable) +import Language.PureScript.CodeGen.C.Optimizer.Blocks (collapseNestedBlocks) import Language.PureScript.CodeGen.C.Pretty as PP import Language.PureScript.CodeGen.CompileError (CompileError(..)) import Language.PureScript.CodeGen.Runtime as R import Language.PureScript.CodeGen.SupplyT (class MonadSupply, freshId) --- | Traverse all blocks, collecting expressions that cause heap allocations and --- | emitting a corresponding "free"-ing call when the block no longer needs --- | the variable. +-- | Generate code that releases intermediate results. -- | --- | * We know that 'return;' exists the function immediately with the given --- | value. --- | * We know that purec-generated functions must have at most a single return --- | value of type 'ANY'. --- | * Thus, we must call 'PURS_ANY_RELEASE' on *all* variables, except the --- | one returned. --- --- todo: Could we remove shadowed bindings in a separate pass? keword: SSA --- idea: use gotos? --- { var ret; goto end; end: [...]; return ret; } +-- | Step 0: Flatten all nested blocks. We should throw an 'InternalError' +-- | if a nested block is found. The reason is that nested blocks have +-- | different scoping and may return early. +-- | Step 1: Identify all AST.App calls causing resource allocation, and extract +-- | those into fresh (internal) variables. +-- | Step 2: Extract all intermediate 'purs_any_app' results to temporary +-- | fresh (internal) variables. +-- | Step 3: Bind the return value to a temporary 'ANY' value and call +-- | PURS_ANY_RETAIN on it. This allows us to safely perform the next +-- | step. +-- | Step 4: Release all previously found resource acquistions/intermediate +-- | 'purs_any_app' results with PURS_RC_RELEASE/PURS_ANY_RELEASE +-- | respectively, except the return value bound in Step 3. +-- | Step 5: Return the result bound in Step 3. +-- | +-- | Considerations: +-- | * Consider that some branches in a block may return early. In such case, +-- | simply free everything we learned about up to that point and return. releaseResources :: ∀ m . Monad m @@ -73,16 +79,10 @@ releaseResources = traverse go pushAst x = State.modify_ (\s -> s { out = A.snoc s.out x }) pushVar x = State.modify_ (\s -> s { vars = A.snoc s.vars x }) --- releaseResources = traverse go --- where --- go x = execStateT <@> x $ --- pure x - - -- | Split out variable declarations and definitions on a per-block (scope) -- | level and hoist the declarations to the top of the scope. hoistVarDecls :: Array AST -> Array AST -hoistVarDecls = map go +hoistVarDecls = identity where go = AST.everywhereTopDown case _ of @@ -124,11 +124,14 @@ hoistVarDecls = map go xs' x -> x --- | Erase lambdas from the AST by capturing used bindings in a heap-allocated, --- | buffer and emitting a top-level continuation function. +-- | Erase lambdas from the AST by capturing used bindings into a scope data. +-- | structure. -- | -- | XXX: we might have to run this pass *after* optimization passes ran in -- | order to not capture inlined and unused variables. +-- | +-- | todo: does the inner lambda need to retain it's bound scope and arguments +-- | during every execution? eraseLambdas :: ∀ m . Monad m @@ -137,7 +140,7 @@ eraseLambdas => String -- ^ lambda prefix -> Array AST -> m (Array AST) -eraseLambdas moduleName asts = +eraseLambdas moduleName asts = map collapseNestedBlocks <$> ado asts' /\ toplevels <- runWriterT $ @@ -340,8 +343,7 @@ eraseLambdas moduleName asts = ] in A.concat - [ [ AST.App (AST.Var "PURS_RC_RETAIN") [ AST.Var "$_ctx" ] ] - , map snd $ A.sortBy (compare `on` fst) $ + [ map snd $ A.sortBy (compare `on` fst) $ Map.toUnfoldable bindings <#> \(name /\ i /\ mOffset) -> i /\ case mOffset of Nothing -> @@ -380,54 +382,34 @@ eraseLambdas moduleName asts = id <- freshId in "__cont_" <> show id <> "__" - pure $ AST.StatementExpression $ - AST.Block $ - [ AST.VariableIntroduction - { name: "$_scope" - , type: Type.Pointer (Type.RawType R.purs_scope_t []) - , qualifiers: [] - , initialization: - Just $ - if A.null capturedBindings - then AST.Null - else - AST.App - R.purs_scope_new1 $ - [ AST.NumericLiteral $ - Left $ A.length capturedBindings - ] - } - , AST.VariableIntroduction - { name: "$_cont" - , type: R.any - , qualifiers: [] - , initialization: - Just $ - AST.App - R.purs_any_cont - [ AST.App - R.purs_cont_new - [ AST.Var "$_scope" - , AST.Cast (Type.Pointer (R.void [ Type.Const ])) $ - AST.Var contFuncName - ] - ] - } - ] <> - (A.mapWithIndex <@> capturedBindings $ \i v -> - AST.App (AST.Var "purs_scope_capture_at") - [ AST.Var "$_scope" - , AST.NumericLiteral $ Left i - , if Just v == capturedScope.lhs - then - AST.App R.purs_indirect_thunk_new - [ AST.Var "$_ivalue" ] - else - AST.Var v - ] - ) <> - [ AST.App (AST.Var "PURS_RC_RELEASE") - [ AST.Var "$_scope" + pure if A.null capturedBindings + then + AST.App + R.purs_any_cont + [ AST.App + R.purs_cont_new + [ AST.Null + , AST.Var contFuncName + ] + ] + else + AST.App + R.purs_any_cont + [ AST.App + R.purs_cont_new + [ AST.App + R.purs_scope_new $ + [ AST.NumericLiteral $ Left $ A.length capturedBindings ] + <> + (capturedBindings <#> \v -> + -- todo: solve this dilemma (recursion?) + if Just v == capturedScope.lhs + then + AST.App R.purs_indirect_thunk_new + [ AST.Var "$_ivalue" ] + else + AST.Var v + ) + , AST.Var contFuncName + ] ] - , AST.Var "$_cont" - ] From e230cba6b7b944f28502da1089e0174dfa7f25ac Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Wed, 17 Jul 2019 09:44:55 +1200 Subject: [PATCH 27/67] Emit warning for missing PURS_ANY_RETAIN impls --- runtime/purescript.h | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/runtime/purescript.h b/runtime/purescript.h index eee591c..3d3d61a 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -231,6 +231,12 @@ const char * purs_any_tag_str (const purs_any_tag_t); break;\ case PURS_ANY_TAG_CONT:\ PURS_RC_RETAIN((X)->value.cont);\ + break;\ + case PURS_ANY_TAG_THUNK:\ + case PURS_ANY_TAG_CONS:\ + case PURS_ANY_TAG_FOREIGN:\ + fprintf(stderr, "WARN: Todo: Implement PURS_ANY_RETAIN for: %s\n", purs_any_tag_str((X)->tag));\ + break;\ default:\ break;\ }\ From aaf1c12ce3f83e4256db0406c068f3f710a6a9d1 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Wed, 17 Jul 2019 22:59:34 +1200 Subject: [PATCH 28/67] Release allocated resources (incomplete) TODO: * Apply pass to PURS_ANY_THUNK_DEF bodies * Ensure not to release return value! --- runtime/purescript.h | 28 ++- .../PureScript/CodeGen/C/Transforms.purs | 232 ++++++++++++++---- src/Language/PureScript/CodeGen/Runtime.purs | 6 + 3 files changed, 220 insertions(+), 46 deletions(-) diff --git a/runtime/purescript.h b/runtime/purescript.h index 3d3d61a..f7b6cfa 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -515,16 +515,34 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { /* allocate a buffer to fit 'N' 'ANY's */ #define purs_malloc_any_buf(N) purs_malloc(sizeof (ANY) * N) +/** + * XXX: Static thunks technically leak memory when they are first forced. For + * values known at compile time, we could - in theory - allocate the + * structure as data in the binary. However, for mere reason of simplicity + * in implementation, we thunk them into heap-allocated memory. + * To avoid 'libcmocka' reporting these "leaks", we simply do not hold on + * to the results. + */ +#ifdef UNIT_TESTING +#define _PURS_ANY_THUNK_INIT(x, v, INIT)\ + v = INIT; +#else +#define _PURS_ANY_THUNK_INIT(x, v, INIT)\ + if (x == 0) {\ + x = 1;\ + v = INIT;\ + PURS_ANY_RETAIN(&v); /* never free */\ + } else {\ + PURS_ANY_RETAIN(&v);\ + } +#endif // UNIT_TESTING + /* declare a thunked top-level value. */ #define PURS_ANY_THUNK_DEF(NAME, INIT)\ static ANY NAME ## __thunk_fn__ (ANY __unused__1) { \ static ANY v;\ static int x = 0;\ - if (x == 0) {\ - x = 0;\ - v = INIT;\ - }\ - PURS_ANY_RETAIN(&v);\ + _PURS_ANY_THUNK_INIT(x, v, INIT);\ return v;\ };\ purs_any_thunk_t NAME ## __thunk__ = {\ diff --git a/src/Language/PureScript/CodeGen/C/Transforms.purs b/src/Language/PureScript/CodeGen/C/Transforms.purs index 70852bd..a003f71 100644 --- a/src/Language/PureScript/CodeGen/C/Transforms.purs +++ b/src/Language/PureScript/CodeGen/C/Transforms.purs @@ -8,8 +8,9 @@ import Prelude import Control.Monad.Error.Class (class MonadError, throwError) import Control.Monad.Reader (ask, runReaderT, withReaderT) -import Control.Monad.State (execStateT) +import Control.Monad.State (evalState, execState, execStateT, runStateT) import Control.Monad.State as State +import Control.Monad.Trans.Class (lift) import Control.Monad.Writer (runWriterT, tell) import Data.Array as A import Data.Either (Either(..)) @@ -21,12 +22,13 @@ import Data.Set as Set import Data.Traversable (for, traverse) import Data.Tuple (fst, snd) import Data.Tuple.Nested ((/\)) +import Debug.Trace (traceM) import Language.PureScript.CodeGen.C.AST (AST(..), everywhereTopDown) as AST -import Language.PureScript.CodeGen.C.AST (AST) +import Language.PureScript.CodeGen.C.AST (AST, Type(..)) import Language.PureScript.CodeGen.C.AST as AST import Language.PureScript.CodeGen.C.AST as Type import Language.PureScript.CodeGen.C.AST.Common (isReferenced) as AST -import Language.PureScript.CodeGen.C.Common (isInternalVariable) +import Language.PureScript.CodeGen.C.Common (freshInternalName, isInternalVariable) import Language.PureScript.CodeGen.C.Optimizer.Blocks (collapseNestedBlocks) import Language.PureScript.CodeGen.C.Pretty as PP import Language.PureScript.CodeGen.CompileError (CompileError(..)) @@ -60,24 +62,150 @@ releaseResources => MonadError CompileError m => Array AST -> m (Array AST) -releaseResources = traverse go +releaseResources = traverse (go []) where - go = - AST.everywhereTopDownM $ case _ of - AST.Block xs -> - AST.Block <<< _.out <$> do - execStateT <@> { vars: [], out: [] } $ do - for_ xs $ case _ of - x@(AST.VariableIntroduction v@{ name }) -> do - pushVar v - pushAst x - x -> - pushAst x - x -> - pure x + fnTable = case _ of + AST.Var "purs_any_app" -> Just R.any + AST.Var "purs_vec_new_va" -> Just arrayType + AST.Var "purs_vec_copy" -> Just arrayType + AST.Var "purs_vec_splice" -> Just arrayType + AST.Var "purs_vec_concat" -> Just arrayType + AST.Var "purs_str_new" -> Just stringType + AST.Var "purs_record_new_va" -> Just recordType + AST.Var "purs_cont_new" -> Just contType + _ -> Nothing + + contType = Type.Pointer (Type.RawType "purs_cont_t" [ Type.Const ]) + recordType = Type.Pointer (Type.RawType "purs_record_t" [ Type.Const ]) + stringType = Type.Pointer (Type.RawType "purs_str_t" [ Type.Const ]) + arrayType = Type.Pointer (Type.RawType "purs_vec_t" [ Type.Const ]) + + go parentVars = case _ of + AST.Block xs -> do + out /\ vars <- do + runStateT <@> [] $ + let + go' = + case _ of + x@(AST.Block _) -> do + vars <- State.get + lift $ go (parentVars <> vars) x + x@(AST.App n args) -> do + n' <- go' n + args' <- traverse go' args + case fnTable n' of + Just typ -> do + name' <- lift freshInternalName + State.modify_ (A.snoc <@> { name: name', type: typ }) + pure $ + AST.StatementExpression $ + AST.Block + [ AST.Assignment (AST.Var name') (AST.App n' args') + , AST.Var name' + ] + Nothing -> + pure $ AST.App n' args' + AST.VariableIntroduction x -> ado + initialization' <- traverse go' x.initialization + in AST.VariableIntroduction $ x { initialization = initialization' } + AST.Return x -> do + x' <- go' x + vars <- State.get + tmp <- lift freshInternalName + pure $ + AST.Block $ + [ AST.VariableIntroduction + { name: tmp + , type: R.any + , qualifiers: [] + , initialization: Just x' + } + , AST.App (AST.Var "PURS_ANY_RETAIN") + [ AST.App R.purs_address_of + [ AST.Var tmp ] + ] + ] + <> + -- generate release calls for all introduced variables + -- todo: do not release our return value! + (vars <#> \v -> + if v.type == R.any + then + AST.App (AST.Var "PURS_ANY_RELEASE") + [ AST.App R.purs_address_of [ AST.Var v.name ] + ] + else + AST.App (AST.Var "PURS_RC_RELEASE") + [ AST.Var v.name + ] + ) + <> + [ AST.Return $ AST.Var tmp + ] + AST.Unary o a -> + AST.Unary o <$> go' a + AST.Binary o a b -> + AST.Binary o <$> go' a <*> go' b + AST.ArrayLiteral as -> + AST.ArrayLiteral <$> traverse go' as + AST.Indexer a b -> + AST.Indexer <$> go' a <*> go' b + AST.ObjectLiteral as -> + AST.ObjectLiteral <$> for as \{ key, value } -> ado + key' <- go' key + value' <- go' value + in { key: key', value: value' } + AST.Accessor a b -> + AST.Accessor <$> go' a <*> go' b + AST.Cast a b -> + AST.Cast a <$> go' b + AST.Assignment a b -> + AST.Assignment <$> go' a <*> go' b + AST.While a b -> + AST.While <$> go' a <*> go' b + AST.IfElse a b c -> + AST.IfElse <$> go' a <*> go' b <*> traverse go' c + -- AST.StatementExpression a -> + -- AST.StatementExpression <$> go' a + x -> + pure x + in + traverse go' xs + pure $ + AST.Block $ + A.concat + [ vars <#> \var -> + AST.VariableIntroduction + { name: var.name + , type: var.type + , qualifiers: [] + , initialization: Nothing + } + , out + ] + AST.VariableIntroduction v@{ initialization: Just x@(AST.Block _) } -> do + ast' <- go parentVars x + pure $ AST.VariableIntroduction $ v { initialization = Just ast' } + AST.Function f@{ body: Just x@(AST.Block _) } -> do + ast' <- go parentVars x + pure + if false -- todo: remove or move into a debug transform + then AST.Function $ f { body = Just ast' } + else AST.Function $ + f { body = + Just $ + AST.Block + [ AST.App (AST.Var "printf") + [ AST.StringLiteral "> fn=%s\n" + , AST.StringLiteral (fromMaybe "" f.name) + ] + , ast' + ] } + x -> + pure x - pushAst x = State.modify_ (\s -> s { out = A.snoc s.out x }) - pushVar x = State.modify_ (\s -> s { vars = A.snoc s.vars x }) + -- pushAst x = State.modify_ (\s -> s { out = A.snoc s.out x }) + -- pushVar x = State.modify_ (A.snoc <@> x) -- | Split out variable declarations and definitions on a per-block (scope) -- | level and hoist the declarations to the top of the scope. @@ -382,8 +510,8 @@ eraseLambdas moduleName asts = map collapseNestedBlocks <$> id <- freshId in "__cont_" <> show id <> "__" - pure if A.null capturedBindings - then + if A.null capturedBindings + then pure $ AST.App R.purs_any_cont [ AST.App @@ -392,24 +520,46 @@ eraseLambdas moduleName asts = map collapseNestedBlocks <$> , AST.Var contFuncName ] ] - else - AST.App - R.purs_any_cont - [ AST.App - R.purs_cont_new - [ AST.App - R.purs_scope_new $ - [ AST.NumericLiteral $ Left $ A.length capturedBindings ] - <> - (capturedBindings <#> \v -> - -- todo: solve this dilemma (recursion?) - if Just v == capturedScope.lhs - then - AST.App R.purs_indirect_thunk_new - [ AST.Var "$_ivalue" ] - else - AST.Var v - ) - , AST.Var contFuncName - ] + else ado + scopeVarName <- freshInternalName + contVarName <- freshInternalName + in AST.StatementExpression $ + AST.Block + [ AST.VariableIntroduction + { name: scopeVarName + , type: Type.Pointer (Type.RawType R.purs_scope_t [ Type.Const ]) + , qualifiers: [] + , initialization: + Just $ + AST.App + R.purs_scope_new $ + [ AST.NumericLiteral $ Left $ A.length capturedBindings ] + <> + (capturedBindings <#> \v -> + -- todo: solve this dilemma (recursion?) + if Just v == capturedScope.lhs + then + AST.App R.purs_indirect_thunk_new + [ AST.Var "$_ivalue" ] + else + AST.Var v + ) + } + , AST.VariableIntroduction + { name: contVarName + , type: R.any + , qualifiers: [] + , initialization: + Just $ + AST.App + R.purs_any_cont + [ AST.App + R.purs_cont_new + [ AST.Var scopeVarName + , AST.Var contFuncName + ] + ] + } + , AST.App (AST.Var "PURS_RC_RELEASE") [ AST.Var scopeVarName ] + , AST.Var contVarName ] diff --git a/src/Language/PureScript/CodeGen/Runtime.purs b/src/Language/PureScript/CodeGen/Runtime.purs index a72a425..f05e3c6 100644 --- a/src/Language/PureScript/CodeGen/Runtime.purs +++ b/src/Language/PureScript/CodeGen/Runtime.purs @@ -45,6 +45,9 @@ module Language.PureScript.CodeGen.Runtime , purs_address_of , purs_derefence + -- cont + , purs_cont_t + -- scope , purs_scope_t , purs_scope_new @@ -102,6 +105,9 @@ any = Type.Any [] purs_record_t :: String purs_record_t = "purs_record_t" +purs_cont_t :: String +purs_cont_t = "purs_cont_t" + purs_scope_t :: String purs_scope_t = "purs_scope_t" From b6b6ef7c671149b7a0cc24e9b565287359e84647 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Thu, 18 Jul 2019 09:45:58 +1200 Subject: [PATCH 29/67] Implement initial version of 'releaseResources' pass ... still a little leaky, but mostly there. --- .../PureScript/CodeGen/C/Transforms.purs | 170 ++++++++++++++---- 1 file changed, 138 insertions(+), 32 deletions(-) diff --git a/src/Language/PureScript/CodeGen/C/Transforms.purs b/src/Language/PureScript/CodeGen/C/Transforms.purs index a003f71..3552f6b 100644 --- a/src/Language/PureScript/CodeGen/C/Transforms.purs +++ b/src/Language/PureScript/CodeGen/C/Transforms.purs @@ -6,15 +6,14 @@ module Language.PureScript.CodeGen.C.Transforms import Prelude -import Control.Monad.Error.Class (class MonadError, throwError) +import Control.Monad.Error.Class (class MonadError) import Control.Monad.Reader (ask, runReaderT, withReaderT) -import Control.Monad.State (evalState, execState, execStateT, runStateT) +import Control.Monad.State (runStateT) import Control.Monad.State as State import Control.Monad.Trans.Class (lift) import Control.Monad.Writer (runWriterT, tell) import Data.Array as A import Data.Either (Either(..)) -import Data.Foldable (for_) import Data.Function (on) import Data.Map as Map import Data.Maybe (Maybe(..), fromMaybe, maybe) @@ -22,16 +21,14 @@ import Data.Set as Set import Data.Traversable (for, traverse) import Data.Tuple (fst, snd) import Data.Tuple.Nested ((/\)) -import Debug.Trace (traceM) +import Language.PureScript.CodeGen.C.AST (AST, everywhere) import Language.PureScript.CodeGen.C.AST (AST(..), everywhereTopDown) as AST -import Language.PureScript.CodeGen.C.AST (AST, Type(..)) -import Language.PureScript.CodeGen.C.AST as AST import Language.PureScript.CodeGen.C.AST as Type import Language.PureScript.CodeGen.C.AST.Common (isReferenced) as AST import Language.PureScript.CodeGen.C.Common (freshInternalName, isInternalVariable) import Language.PureScript.CodeGen.C.Optimizer.Blocks (collapseNestedBlocks) import Language.PureScript.CodeGen.C.Pretty as PP -import Language.PureScript.CodeGen.CompileError (CompileError(..)) +import Language.PureScript.CodeGen.CompileError (CompileError) import Language.PureScript.CodeGen.Runtime as R import Language.PureScript.CodeGen.SupplyT (class MonadSupply, freshId) @@ -55,6 +52,14 @@ import Language.PureScript.CodeGen.SupplyT (class MonadSupply, freshId) -- | Considerations: -- | * Consider that some branches in a block may return early. In such case, -- | simply free everything we learned about up to that point and return. +-- | +-- | Future work: +-- | * Currently we need to allocate a stack variable for every capturing every +-- | temporary variable. However, since 'ANY' values are fat, this might +-- | cause pressure on available stack memory for sufficiently large programs +-- | (speculating here.) We could look into a way to improve upon this, +-- | perhaps by building a more intelligent dependency graph and reduing the. +-- | number of introduced variables on the stack. releaseResources :: ∀ m . Monad m @@ -62,9 +67,23 @@ releaseResources => MonadError CompileError m => Array AST -> m (Array AST) -releaseResources = traverse (go []) +releaseResources = map (map cleanup) <<< traverse (go []) where - fnTable = case _ of + cleanup = + everywhere case _ of + AST.Block xs -> + case A.unsnoc xs of + Just { init, last } -> + AST.Block $ + (init # A.filter case _ of + AST.Var _ -> false + _ -> true + ) <> [ last ] + Nothing -> + AST.Block xs + x -> x + + allocatedType = case _ of AST.Var "purs_any_app" -> Just R.any AST.Var "purs_vec_new_va" -> Just arrayType AST.Var "purs_vec_copy" -> Just arrayType @@ -75,28 +94,46 @@ releaseResources = traverse (go []) AST.Var "purs_cont_new" -> Just contType _ -> Nothing - contType = Type.Pointer (Type.RawType "purs_cont_t" [ Type.Const ]) + contType = Type.Pointer (Type.RawType "purs_cont_t" [ Type.Const ]) recordType = Type.Pointer (Type.RawType "purs_record_t" [ Type.Const ]) - stringType = Type.Pointer (Type.RawType "purs_str_t" [ Type.Const ]) - arrayType = Type.Pointer (Type.RawType "purs_vec_t" [ Type.Const ]) + stringType = Type.Pointer (Type.RawType "purs_str_t" [ Type.Const ]) + arrayType = Type.Pointer (Type.RawType "purs_vec_t" [ Type.Const ]) go parentVars = case _ of AST.Block xs -> do - out /\ vars <- do - runStateT <@> [] $ + -- build up a new block, collect new variables we should introduce, and + -- indicate whether or not the block has returned. The latter is necessary + -- to ensure we are still releasing temporary variables introduced in the + -- block, as they are about to leave the scope. + out /\ { vars, hasReturned } <- do + runStateT <@> { vars: [], hasReturned: false } $ let go' = case _ of + -- enter a new context. the block is - itself - responsible + -- for clean up. x@(AST.Block _) -> do - vars <- State.get + { vars } <- State.get lift $ go (parentVars <> vars) x + + -- deal with potential resource allocations, which are *always* + -- due to applying some function. + -- we capture the result of the function in a fresh, internal + -- name that we can release later. x@(AST.App n args) -> do n' <- go' n args' <- traverse go' args - case fnTable n' of + case allocatedType n' of Just typ -> do name' <- lift freshInternalName - State.modify_ (A.snoc <@> { name: name', type: typ }) + State.modify_ \state -> + state + { vars = + A.snoc state.vars + { name: name' + , type: typ + } + } pure $ AST.StatementExpression $ AST.Block @@ -105,12 +142,14 @@ releaseResources = traverse (go []) ] Nothing -> pure $ AST.App n' args' - AST.VariableIntroduction x -> ado - initialization' <- traverse go' x.initialization - in AST.VariableIntroduction $ x { initialization = initialization' } + + -- deal with returning. we must release all variables we + -- collected, *including* any variables collected in our parent + -- scopes, since we won't be coming back. AST.Return x -> do - x' <- go' x - vars <- State.get + x' <- go' x + { vars } <- State.get + State.modify_ (_ { hasReturned = true }) tmp <- lift freshInternalName pure $ AST.Block $ @@ -120,15 +159,18 @@ releaseResources = traverse (go []) , qualifiers: [] , initialization: Just x' } + -- we must *retain* the result value, since it's + -- impossible to know which temporary variable the + -- final return value was collected as, so it would be + -- freed before returning by the release calls generated + -- below. , AST.App (AST.Var "PURS_ANY_RETAIN") [ AST.App R.purs_address_of [ AST.Var tmp ] ] ] <> - -- generate release calls for all introduced variables - -- todo: do not release our return value! - (vars <#> \v -> + ((parentVars <> vars) <#> \v -> if v.type == R.any then AST.App (AST.Var "PURS_ANY_RELEASE") @@ -142,6 +184,12 @@ releaseResources = traverse (go []) <> [ AST.Return $ AST.Var tmp ] + + AST.VariableIntroduction x -> ado + initialization' <- traverse go' x.initialization + in AST.VariableIntroduction $ + x { initialization = initialization' + } AST.Unary o a -> AST.Unary o <$> go' a AST.Binary o a b -> @@ -165,15 +213,15 @@ releaseResources = traverse (go []) AST.While <$> go' a <*> go' b AST.IfElse a b c -> AST.IfElse <$> go' a <*> go' b <*> traverse go' c - -- AST.StatementExpression a -> - -- AST.StatementExpression <$> go' a + AST.StatementExpression a -> + AST.StatementExpression <$> go' a x -> pure x in traverse go' xs pure $ AST.Block $ - A.concat + A.concat $ [ vars <#> \var -> AST.VariableIntroduction { name: var.name @@ -181,11 +229,72 @@ releaseResources = traverse (go []) , qualifiers: [] , initialization: Nothing } - , out + , out # A.filter case _ of + AST.Var _ -> false + _ -> true + , -- if the last statement was a AST.Var, we were likely in a + -- statement expression. therefore, we must retain it's value + -- before freeing resources introduced in the scope. + fromMaybe [] $ + case A.last out of + Just (x@(AST.Var name)) -> + Just + [ AST.App (AST.Var "PURS_ANY_RETAIN") + [ AST.App R.purs_address_of + [ AST.Var name ] + ] + , x + ] + _ -> Nothing + , if not hasReturned + then + -- we're leaving scope, release all vars introduced in this scope + -- before leaving it. + (vars <#> \v -> + if v.type == R.any + then + AST.App (AST.Var "PURS_ANY_RELEASE") + [ AST.App R.purs_address_of [ AST.Var v.name ] + ] + else + AST.App (AST.Var "PURS_RC_RELEASE") + [ AST.Var v.name + ] + ) <> + -- if the last statement was a AST.Var, we were likely in a + -- statement expression. therefore, make sure we place it back + -- at the end of the block. + maybe [] A.singleton + case A.last out of + Just (x@(AST.Var _)) -> Just x + _ -> Nothing + else + [] ] + + -- top-level variable introductions. AST.VariableIntroduction v@{ initialization: Just x@(AST.Block _) } -> do ast' <- go parentVars x pure $ AST.VariableIntroduction $ v { initialization = Just ast' } + + -- top-level block-less variable introductions. + -- we turn those into state-ment expressions. + AST.VariableIntroduction v@{ initialization: Just x } -> do + tmp <- freshInternalName + ast' <- + go parentVars $ + AST.Block + [ AST.VariableIntroduction $ v { name = tmp } + , AST.Var tmp + ] + pure $ + AST.VariableIntroduction $ + v + { initialization = + Just $ + AST.StatementExpression ast' + } + AST.Function f@{ body: Just x@(AST.Block _) } -> do ast' <- go parentVars x pure @@ -204,9 +313,6 @@ releaseResources = traverse (go []) x -> pure x - -- pushAst x = State.modify_ (\s -> s { out = A.snoc s.out x }) - -- pushVar x = State.modify_ (A.snoc <@> x) - -- | Split out variable declarations and definitions on a per-block (scope) -- | level and hoist the declarations to the top of the scope. hoistVarDecls :: Array AST -> Array AST From dd78008e308db3053778514e981f326049bb635d Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Wed, 17 Jul 2019 12:13:16 +1200 Subject: [PATCH 30/67] Update PURS_FFI_FUNC family of macros --- runtime/purescript.c | 2 + runtime/purescript.h | 178 ++++++++++++++++++++++--------------------- 2 files changed, 94 insertions(+), 86 deletions(-) diff --git a/runtime/purescript.c b/runtime/purescript.c index 66e26e8..4eec3cf 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -66,6 +66,7 @@ static void purs_scope_free(const struct purs_rc *ref) { } struct purs_scope * purs_scope_new1(int size) { + if (size == 0) return NULL; struct purs_scope * scope = purs_new(struct purs_scope); ANY* bindings = purs_malloc(sizeof (ANY) * size); scope->size = size; @@ -76,6 +77,7 @@ struct purs_scope * purs_scope_new1(int size) { } struct purs_scope * purs_scope_new(int size, ...) { + if (size == 0) return NULL; struct purs_scope * scope = purs_new(struct purs_scope); ANY* bindings = purs_malloc(sizeof (ANY) * size); scope->size = size; diff --git a/runtime/purescript.h b/runtime/purescript.h index f7b6cfa..fcce8ae 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -623,8 +623,7 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { #define _PURS_FFI_FUNC_ENTRY(NAME)\ purs_cont_t NAME ## __cont__ = {\ .fn = NAME ## __1,\ - .len = 0,\ - .ctx = NULL\ + .scope = NULL\ };\ ANY NAME = {\ .tag = PURS_ANY_TAG_CONT,\ @@ -637,15 +636,22 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { } #define _PURS_FFI_FUNC_CONT(NAME, CUR, NEXT)\ - ANY NAME##__##CUR (ANY * $__super__, ANY a, va_list $__unused__) {\ - ANY* ctx = purs_malloc_any_buf(CUR);\ + ANY NAME##__##CUR (const purs_scope_t * $__super__, ANY a, va_list $__unused__) {\ + purs_scope_t * scope = purs_scope_new1(CUR);\ if ($__super__ != NULL) {\ - memcpy(ctx, $__super__, CUR * sizeof (ANY));\ + memcpy(scope->bindings,\ + $__super__->bindings,\ + $__super__->size * sizeof (ANY));\ + for (int i = 0; i < $__super__->size; i++) {\ + PURS_ANY_RETAIN(&$__super__->bindings[i]);\ + }\ }\ - if (ctx != NULL) {\ - ctx[CUR - 1] = a;\ + if (scope != NULL) {\ + scope->bindings[CUR - 1] = a;\ }\ - return purs_cont(ctx, CUR, NAME##__##NEXT);\ + const purs_cont_t * cont = purs_cont_new(scope, NAME##__##NEXT);\ + PURS_RC_RELEASE(scope);\ + return purs_any_cont(cont);\ } #define _PURS_FFI_FUNC_CONT_1_TO_2(NAME) _PURS_FFI_FUNC_CONT(NAME, 1, 2) @@ -663,23 +669,23 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { #define PURS_FFI_FUNC_CONTEXT $__super__ #define PURS_FFI_FUNC_1(NAME, A1, BODY)\ - ANY NAME##__1 (ANY * $__super__, ANY A1, va_list $__unused__) {\ + ANY NAME##__1 (const purs_scope_t * $__super__, ANY A1, va_list $__unused__) {\ BODY;\ }\ _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_2(NAME, A1, A2, BODY)\ - ANY NAME##__2 (ANY * $__super__, ANY A2, va_list $__unused__) {\ - ANY A1 = ((ANY*)$__super__)[0];\ + ANY NAME##__2 (const purs_scope_t * $__super__, ANY A2, va_list $__unused__) {\ + ANY A1 = $__super__->bindings[0];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_1_TO_2(NAME);\ _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_3(NAME, A1, A2, A3, BODY)\ - ANY NAME##__3 (ANY * $__super__, ANY A3, va_list $__unused__) {\ - ANY A1 = ((ANY*)$__super__)[0];\ - ANY A2 = ((ANY*)$__super__)[1];\ + ANY NAME##__3 (const purs_scope_t * $__super__, ANY A3, va_list $__unused__) {\ + ANY A1 = $__super__->bindings[0];\ + ANY A2 = $__super__->bindings[1];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_2_TO_3(NAME);\ @@ -687,10 +693,10 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_4(NAME, A1, A2, A3, A4, BODY)\ - ANY NAME##__4 (ANY * $__super__, ANY A4, va_list $__unused__) {\ - ANY A1 = ((ANY*)$__super__)[0];\ - ANY A2 = ((ANY*)$__super__)[1];\ - ANY A3 = ((ANY*)$__super__)[2];\ + ANY NAME##__4 (const purs_scope_t * $__super__, ANY A4, va_list $__unused__) {\ + ANY A1 = $__super__->bindings[0];\ + ANY A2 = $__super__->bindings[1];\ + ANY A3 = $__super__->bindings[2];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_3_TO_4(NAME);\ @@ -699,11 +705,11 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_5(NAME, A1, A2, A3, A4, A5, BODY)\ - ANY NAME##__5 (ANY * $__super__, ANY A5, va_list $__unused__) {\ - ANY A1 = ((ANY*)$__super__)[0];\ - ANY A2 = ((ANY*)$__super__)[1];\ - ANY A3 = ((ANY*)$__super__)[2];\ - ANY A4 = ((ANY*)$__super__)[3];\ + ANY NAME##__5 (const purs_scope_t * $__super__, ANY A5, va_list $__unused__) {\ + ANY A1 = $__super__->bindings[0];\ + ANY A2 = $__super__->bindings[1];\ + ANY A3 = $__super__->bindings[2];\ + ANY A4 = $__super__->bindings[3];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_4_TO_5(NAME);\ @@ -713,12 +719,12 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_6(NAME, A1, A2, A3, A4, A5, A6, BODY)\ - ANY NAME##__6 (ANY * $__super__, ANY A6, va_list $__unused__) {\ - ANY A1 = ((ANY*)$__super__)[0];\ - ANY A2 = ((ANY*)$__super__)[1];\ - ANY A3 = ((ANY*)$__super__)[2];\ - ANY A4 = ((ANY*)$__super__)[3];\ - ANY A5 = ((ANY*)$__super__)[4];\ + ANY NAME##__6 (const purs_scope_t * $__super__, ANY A6, va_list $__unused__) {\ + ANY A1 = $__super__->bindings[0];\ + ANY A2 = $__super__->bindings[1];\ + ANY A3 = $__super__->bindings[2];\ + ANY A4 = $__super__->bindings[3];\ + ANY A5 = $__super__->bindings[4];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_5_TO_6(NAME);\ @@ -729,13 +735,13 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_7(NAME, A1, A2, A3, A4, A5, A6, A7, BODY)\ - ANY NAME##__7 (ANY * $__super__, ANY A7, va_list $__unused__) {\ - ANY A1 = ((ANY*)$__super__)[0];\ - ANY A2 = ((ANY*)$__super__)[1];\ - ANY A3 = ((ANY*)$__super__)[2];\ - ANY A4 = ((ANY*)$__super__)[3];\ - ANY A5 = ((ANY*)$__super__)[4];\ - ANY A6 = ((ANY*)$__super__)[5];\ + ANY NAME##__7 (const purs_scope_t * $__super__, ANY A7, va_list $__unused__) {\ + ANY A1 = $__super__->bindings[0];\ + ANY A2 = $__super__->bindings[1];\ + ANY A3 = $__super__->bindings[2];\ + ANY A4 = $__super__->bindings[3];\ + ANY A5 = $__super__->bindings[4];\ + ANY A6 = $__super__->bindings[5];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_6_TO_7(NAME);\ @@ -747,14 +753,14 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_8(NAME, A1, A2, A3, A4, A5, A6, A7, A8, BODY)\ - ANY NAME##__8 (ANY * $__super__, ANY A8, va_list $__unused__) {\ - ANY A1 = ((ANY*)$__super__)[0];\ - ANY A2 = ((ANY*)$__super__)[1];\ - ANY A3 = ((ANY*)$__super__)[2];\ - ANY A4 = ((ANY*)$__super__)[3];\ - ANY A5 = ((ANY*)$__super__)[4];\ - ANY A6 = ((ANY*)$__super__)[5];\ - ANY A7 = ((ANY*)$__super__)[6];\ + ANY NAME##__8 (const purs_scope_t * $__super__, ANY A8, va_list $__unused__) {\ + ANY A1 = $__super__->bindings[0];\ + ANY A2 = $__super__->bindings[1];\ + ANY A3 = $__super__->bindings[2];\ + ANY A4 = $__super__->bindings[3];\ + ANY A5 = $__super__->bindings[4];\ + ANY A6 = $__super__->bindings[5];\ + ANY A7 = $__super__->bindings[6];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_7_TO_8(NAME);\ @@ -767,15 +773,15 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_9(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, BODY)\ - ANY NAME##__9 (ANY * $__super__, ANY A9, va_list $__unused__) {\ - ANY A1 = ((ANY*)$__super__)[0];\ - ANY A2 = ((ANY*)$__super__)[1];\ - ANY A3 = ((ANY*)$__super__)[2];\ - ANY A4 = ((ANY*)$__super__)[3];\ - ANY A5 = ((ANY*)$__super__)[4];\ - ANY A6 = ((ANY*)$__super__)[5];\ - ANY A7 = ((ANY*)$__super__)[6];\ - ANY A8 = ((ANY*)$__super__)[7];\ + ANY NAME##__9 (const purs_scope_t * $__super__, ANY A9, va_list $__unused__) {\ + ANY A1 = $__super__->bindings[0];\ + ANY A2 = $__super__->bindings[1];\ + ANY A3 = $__super__->bindings[2];\ + ANY A4 = $__super__->bindings[3];\ + ANY A5 = $__super__->bindings[4];\ + ANY A6 = $__super__->bindings[5];\ + ANY A7 = $__super__->bindings[6];\ + ANY A8 = $__super__->bindings[7];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_8_TO_9(NAME);\ @@ -789,16 +795,16 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_10(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, BODY)\ - ANY NAME##__10 (ANY * $__super__, ANY A10, va_list $__unused__) {\ - ANY A1 = ((ANY*)$__super__)[0];\ - ANY A2 = ((ANY*)$__super__)[1];\ - ANY A3 = ((ANY*)$__super__)[2];\ - ANY A4 = ((ANY*)$__super__)[3];\ - ANY A5 = ((ANY*)$__super__)[4];\ - ANY A6 = ((ANY*)$__super__)[5];\ - ANY A7 = ((ANY*)$__super__)[6];\ - ANY A8 = ((ANY*)$__super__)[7];\ - ANY A9 = ((ANY*)$__super__)[8];\ + ANY NAME##__10 (const purs_scope_t * $__super__, ANY A10, va_list $__unused__) {\ + ANY A1 = $__super__->bindings[0];\ + ANY A2 = $__super__->bindings[1];\ + ANY A3 = $__super__->bindings[2];\ + ANY A4 = $__super__->bindings[3];\ + ANY A5 = $__super__->bindings[4];\ + ANY A6 = $__super__->bindings[5];\ + ANY A7 = $__super__->bindings[6];\ + ANY A8 = $__super__->bindings[7];\ + ANY A9 = $__super__->bindings[8];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_9_TO_10(NAME);\ @@ -813,17 +819,17 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_11(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, BODY)\ - ANY NAME##__11 (ANY * $__super__, ANY A11, va_list $__unused__) {\ - ANY A1 = ((ANY*)$__super__)[0];\ - ANY A2 = ((ANY*)$__super__)[1];\ - ANY A3 = ((ANY*)$__super__)[2];\ - ANY A4 = ((ANY*)$__super__)[3];\ - ANY A5 = ((ANY*)$__super__)[4];\ - ANY A6 = ((ANY*)$__super__)[5];\ - ANY A7 = ((ANY*)$__super__)[6];\ - ANY A8 = ((ANY*)$__super__)[7];\ - ANY A9 = ((ANY*)$__super__)[8];\ - ANY A10 = ((ANY*)$__super__)[9];\ + ANY NAME##__11 (const purs_scope_t * $__super__, ANY A11, va_list $__unused__) {\ + ANY A1 = $__super__->bindings[0];\ + ANY A2 = $__super__->bindings[1];\ + ANY A3 = $__super__->bindings[2];\ + ANY A4 = $__super__->bindings[3];\ + ANY A5 = $__super__->bindings[4];\ + ANY A6 = $__super__->bindings[5];\ + ANY A7 = $__super__->bindings[6];\ + ANY A8 = $__super__->bindings[7];\ + ANY A9 = $__super__->bindings[8];\ + ANY A10 = $__super__->bindings[9];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_10_TO_11(NAME);\ @@ -839,18 +845,18 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { _PURS_FFI_FUNC_ENTRY(NAME) #define PURS_FFI_FUNC_12(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, BODY)\ - ANY NAME##__12 (ANY * $__super__, ANY A12, va_list $__unused__) {\ - ANY A1 = ((ANY*)$__super__)[0];\ - ANY A2 = ((ANY*)$__super__)[1];\ - ANY A3 = ((ANY*)$__super__)[2];\ - ANY A4 = ((ANY*)$__super__)[3];\ - ANY A5 = ((ANY*)$__super__)[4];\ - ANY A6 = ((ANY*)$__super__)[5];\ - ANY A7 = ((ANY*)$__super__)[6];\ - ANY A8 = ((ANY*)$__super__)[7];\ - ANY A9 = ((ANY*)$__super__)[8];\ - ANY A10 = ((ANY*)$__super__)[9];\ - ANY A11 = ((ANY*)$__super__)[10];\ + ANY NAME##__12 (const purs_scope_t * $__super__, ANY A12, va_list $__unused__) {\ + ANY A1 = $__super__->bindings[0];\ + ANY A2 = $__super__->bindings[1];\ + ANY A3 = $__super__->bindings[2];\ + ANY A4 = $__super__->bindings[3];\ + ANY A5 = $__super__->bindings[4];\ + ANY A6 = $__super__->bindings[5];\ + ANY A7 = $__super__->bindings[6];\ + ANY A8 = $__super__->bindings[7];\ + ANY A9 = $__super__->bindings[8];\ + ANY A10 = $__super__->bindings[9];\ + ANY A11 = $__super__->bindings[10];\ BODY;\ }\ _PURS_FFI_FUNC_CONT_11_TO_12(NAME);\ From 5c9b8c6179776ec2ef2e7e91c4fb5388d863d75a Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Thu, 18 Jul 2019 13:09:42 +1200 Subject: [PATCH 31/67] Fix 'releaseResources' pass: 00-basic test is leak and seg-fault free! --- runtime/purescript.c | 3 +- runtime/purescript.h | 18 ++++----- .../PureScript/CodeGen/C/Transforms.purs | 40 ++++++++----------- 3 files changed, 27 insertions(+), 34 deletions(-) diff --git a/runtime/purescript.c b/runtime/purescript.c index 4eec3cf..b5c0772 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -336,8 +336,9 @@ static void purs_record_free(const struct purs_rc *ref) { purs_record_t * x = container_of(ref, purs_record_t, rc); const purs_record_node_t * e, * tmp; HASH_ITER(hh, x->root, e, tmp) { - PURS_ANY_RELEASE(&e->value); HASH_DEL(x->root, (purs_record_node_t *) e); + PURS_ANY_RELEASE(&e->value); + free((void*) e->key); purs_free((purs_record_node_t *) e); } purs_free(x); diff --git a/runtime/purescript.h b/runtime/purescript.h index fcce8ae..66d5ef4 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -523,27 +523,27 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { * To avoid 'libcmocka' reporting these "leaks", we simply do not hold on * to the results. */ -#ifdef UNIT_TESTING -#define _PURS_ANY_THUNK_INIT(x, v, INIT)\ - v = INIT; +#ifndef CACHE_TOPLEVEL_THUNKS +#define _PURS_ANY_THUNK_INIT(INIT)\ + return INIT; #else -#define _PURS_ANY_THUNK_INIT(x, v, INIT)\ +#define _PURS_ANY_THUNK_INIT(INIT)\ + static ANY v;\ + static int x = 0;\ if (x == 0) {\ x = 1;\ v = INIT;\ PURS_ANY_RETAIN(&v); /* never free */\ } else {\ PURS_ANY_RETAIN(&v);\ - } + }\ + return v; #endif // UNIT_TESTING /* declare a thunked top-level value. */ #define PURS_ANY_THUNK_DEF(NAME, INIT)\ static ANY NAME ## __thunk_fn__ (ANY __unused__1) { \ - static ANY v;\ - static int x = 0;\ - _PURS_ANY_THUNK_INIT(x, v, INIT);\ - return v;\ + _PURS_ANY_THUNK_INIT(INIT);\ };\ purs_any_thunk_t NAME ## __thunk__ = {\ .fn = NAME ## __thunk_fn__,\ diff --git a/src/Language/PureScript/CodeGen/C/Transforms.purs b/src/Language/PureScript/CodeGen/C/Transforms.purs index 3552f6b..213956a 100644 --- a/src/Language/PureScript/CodeGen/C/Transforms.purs +++ b/src/Language/PureScript/CodeGen/C/Transforms.purs @@ -105,16 +105,16 @@ releaseResources = map (map cleanup) <<< traverse (go []) -- indicate whether or not the block has returned. The latter is necessary -- to ensure we are still releasing temporary variables introduced in the -- block, as they are about to leave the scope. - out /\ { vars, hasReturned } <- do - runStateT <@> { vars: [], hasReturned: false } $ + out /\ { allocVars, hasReturned } <- do + runStateT <@> { allocVars: [], hasReturned: false } $ let go' = case _ of -- enter a new context. the block is - itself - responsible -- for clean up. x@(AST.Block _) -> do - { vars } <- State.get - lift $ go (parentVars <> vars) x + { allocVars } <- State.get + lift $ go (parentVars <> allocVars) x -- deal with potential resource allocations, which are *always* -- due to applying some function. @@ -128,8 +128,8 @@ releaseResources = map (map cleanup) <<< traverse (go []) name' <- lift freshInternalName State.modify_ \state -> state - { vars = - A.snoc state.vars + { allocVars = + A.snoc state.allocVars { name: name' , type: typ } @@ -143,12 +143,15 @@ releaseResources = map (map cleanup) <<< traverse (go []) Nothing -> pure $ AST.App n' args' + AST.StatementExpression a -> + AST.StatementExpression <$> go' a + -- deal with returning. we must release all variables we -- collected, *including* any variables collected in our parent -- scopes, since we won't be coming back. AST.Return x -> do x' <- go' x - { vars } <- State.get + { allocVars } <- State.get State.modify_ (_ { hasReturned = true }) tmp <- lift freshInternalName pure $ @@ -159,18 +162,9 @@ releaseResources = map (map cleanup) <<< traverse (go []) , qualifiers: [] , initialization: Just x' } - -- we must *retain* the result value, since it's - -- impossible to know which temporary variable the - -- final return value was collected as, so it would be - -- freed before returning by the release calls generated - -- below. - , AST.App (AST.Var "PURS_ANY_RETAIN") - [ AST.App R.purs_address_of - [ AST.Var tmp ] - ] ] <> - ((parentVars <> vars) <#> \v -> + ((parentVars <> allocVars) <#> \v -> if v.type == R.any then AST.App (AST.Var "PURS_ANY_RELEASE") @@ -213,8 +207,6 @@ releaseResources = map (map cleanup) <<< traverse (go []) AST.While <$> go' a <*> go' b AST.IfElse a b c -> AST.IfElse <$> go' a <*> go' b <*> traverse go' c - AST.StatementExpression a -> - AST.StatementExpression <$> go' a x -> pure x in @@ -222,7 +214,7 @@ releaseResources = map (map cleanup) <<< traverse (go []) pure $ AST.Block $ A.concat $ - [ vars <#> \var -> + [ allocVars <#> \var -> AST.VariableIntroduction { name: var.name , type: var.type @@ -248,9 +240,9 @@ releaseResources = map (map cleanup) <<< traverse (go []) _ -> Nothing , if not hasReturned then - -- we're leaving scope, release all vars introduced in this scope - -- before leaving it. - (vars <#> \v -> + -- we're leaving scope, release all vars introduced in this + -- scope before leaving it. + (allocVars <#> \v -> if v.type == R.any then AST.App (AST.Var "PURS_ANY_RELEASE") @@ -278,7 +270,7 @@ releaseResources = map (map cleanup) <<< traverse (go []) pure $ AST.VariableIntroduction $ v { initialization = Just ast' } -- top-level block-less variable introductions. - -- we turn those into state-ment expressions. + -- we turn those into statement expressions. AST.VariableIntroduction v@{ initialization: Just x } -> do tmp <- freshInternalName ast' <- From ec562ce11fc398cd450d4c3e33569da45ce131aa Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Thu, 18 Jul 2019 18:00:50 +1200 Subject: [PATCH 32/67] Continue... --- Makefile | 37 ++++++++++--------- runtime/purescript.h | 17 +++++---- .../PureScript/CodeGen/C/Transforms.purs | 19 +++++++++- tests/02-foreign/src/Main.c | 27 ++++++++++++++ tests/02-foreign/src/Main.h | 28 ++------------ tests/04-memory/src/Main.c | 5 +++ tests/04-memory/src/Main.h | 6 +-- 7 files changed, 85 insertions(+), 54 deletions(-) create mode 100644 tests/02-foreign/src/Main.c create mode 100644 tests/04-memory/src/Main.c diff --git a/Makefile b/Makefile index ec02e6d..1cafa2f 100644 --- a/Makefile +++ b/Makefile @@ -2,7 +2,7 @@ CLANG ?= clang CFLAGS ?= WITH_GC ?= -SHELL := /bin/bash +SHELL := /bin/bash --init-file ./.functions.sh SHELLFLAGS := -eo pipefail PURS := PATH=$$PATH:node_modules/.bin purs @@ -25,7 +25,7 @@ RUNTIME_SOURCES = \ RUNTIME_OBJECTS = \ $(patsubst %.c,%.o,$(RUNTIME_SOURCES)) -TESTS = $(shell ls tests) +TESTS = $(shell cd tests && find . -maxdepth 1 ! -path . -type d -exec basename {} \;) ifdef WITH_GC CFLAGS += \ @@ -123,19 +123,20 @@ deps/bwdgc: #------------------------------------------------------------------------------- test/c: - @$(MAKE) -s clean + @$(MAKE) -s clean &> /dev/null @UNIT_TESTING=1 $(MAKE) -s test/c.0 PHONY: test/c -test/c.0: $(PUREC_LIB) +test/c.0: + @make -s $(PUREC_LIB) | prefixed "test/c.0" @$(CLANG) \ -I. \ -L. \ ctests/main.c \ -lpurec \ -lcmocka \ - -o ctests/a.out - @./ctests/a.out + -o ctests/a.out &> /dev/null + @./ctests/a.out &> /dev/null .PHONY: test/c.0 test/tests/lib: @@ -153,9 +154,10 @@ test/tests/lib/$(1): @$(MAKE) -s clean @UNIT_TESTING=0 $(MAKE) -s test/tests/lib/$(1).0 -test/tests/lib/$(1).0: $(PUREC_LIB) - #@$(MAKE) -s -C "tests/$(1)" clean - #@$(MAKE) -s -C "tests/$(1)" lib/c +test/tests/lib/$(1).0: + @make -s $(PUREC_LIB) &> /dev/null + @$(MAKE) -s -C "tests/$(1)" clean + @$(MAKE) -s -C "tests/$(1)" lib/c @cd "tests/$(1)" &&\ $(CLANG) \ -I. \ @@ -170,11 +172,12 @@ test/tests/lib/$(1).0: $(PUREC_LIB) .PHONY: test/tests/lib/$(1) endef -$(eval $(call mk_test_case,00-basic)) +# generate test targets +$(foreach t,$(TESTS),$(eval $(call mk_test_case,$(t)))) -test/tests/lib.0: $(PUREC_LIB) +test/tests/lib.0: @set -e; for t in $(TESTS); do\ - $(MAKE) -s "test/tests/lib/$$t";\ + $(MAKE) -s "test/tests/lib/$$t" &> /dev/null;\ done .PHONY: test/tests/lib.0 @@ -201,14 +204,12 @@ test/upstream: upstream/tests/support/bower_components .PHONY: test/pulp test: - @echo 'test: c-tests' + @echo '=== test: c-tests ===================================================' @$(MAKE) -s test/c - @echo 'test: tests/lib' + @echo '=== test: tests/lib =================================================' @$(MAKE) -s test/tests/lib - @echo 'test: tests/main' - @$(MAKE) -s test/tests/main - @echo 'running upstream tests...' - @$(MAKE) -s test/upstream + @echo '=== test: upstream ==================================================' + @$(MAKE) -s test/upstream &> /dev/null @echo 'success!' .PHONY: test diff --git a/runtime/purescript.h b/runtime/purescript.h index 66d5ef4..4cb6595 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -126,12 +126,16 @@ struct purs_rc { ((type *)((char *)(ptr) - offsetof(type, member))) static inline void purs_rc_retain(const struct purs_rc *ref) { - ((struct purs_rc *)ref)->count++; + if (((struct purs_rc *)ref)->count != -1 /* stack */) { + ((struct purs_rc *)ref)->count++; + } } static inline void purs_rc_release(const struct purs_rc *ref) { - if (--((struct purs_rc *)ref)->count == 0) { - ref->free_fn(ref); + if (((struct purs_rc *)ref)->count != -1 /* stack */) { + if (--((struct purs_rc *)ref)->count == 0) { + ref->free_fn(ref); + } } } @@ -623,7 +627,8 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { #define _PURS_FFI_FUNC_ENTRY(NAME)\ purs_cont_t NAME ## __cont__ = {\ .fn = NAME ## __1,\ - .scope = NULL\ + .scope = NULL,\ + .rc = { .count = -1 }\ };\ ANY NAME = {\ .tag = PURS_ANY_TAG_CONT,\ @@ -646,9 +651,7 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { PURS_ANY_RETAIN(&$__super__->bindings[i]);\ }\ }\ - if (scope != NULL) {\ - scope->bindings[CUR - 1] = a;\ - }\ + scope->bindings[CUR - 1] = a;\ const purs_cont_t * cont = purs_cont_new(scope, NAME##__##NEXT);\ PURS_RC_RELEASE(scope);\ return purs_any_cont(cont);\ diff --git a/src/Language/PureScript/CodeGen/C/Transforms.purs b/src/Language/PureScript/CodeGen/C/Transforms.purs index 213956a..596df2b 100644 --- a/src/Language/PureScript/CodeGen/C/Transforms.purs +++ b/src/Language/PureScript/CodeGen/C/Transforms.purs @@ -164,6 +164,15 @@ releaseResources = map (map cleanup) <<< traverse (go []) } ] <> + case x of + AST.StatementExpression _ -> + [] + _ -> + [ AST.App (AST.Var "PURS_ANY_RETAIN") + [ AST.App R.purs_address_of + [ AST.Var tmp ] + ] ] + <> ((parentVars <> allocVars) <#> \v -> if v.type == R.any then @@ -640,7 +649,15 @@ eraseLambdas moduleName asts = map collapseNestedBlocks <$> AST.App R.purs_indirect_thunk_new [ AST.Var "$_ivalue" ] else - AST.Var v + AST.StatementExpression $ + AST.Block + [ AST.App (AST.Var "PURS_ANY_RETAIN") + [ AST.App R.purs_address_of + [ AST.Var v + ] + ] + , AST.Var v + ] ) } , AST.VariableIntroduction diff --git a/tests/02-foreign/src/Main.c b/tests/02-foreign/src/Main.c new file mode 100644 index 0000000..9801bc0 --- /dev/null +++ b/tests/02-foreign/src/Main.c @@ -0,0 +1,27 @@ +#include "runtime/purescript.h" +#include "Main.h" + +PURS_FFI_FUNC_1(Main_newBuffer, _, { + return purs_any_int(1); + /* struct buf * buf = purs_new(struct buf); */ + /* buf->data = NULL; */ + /* buf->size = 0; */ + /* return purs_any_foreign(NULL, buf); */ +}); + +PURS_FFI_FUNC_2(Main_bufferSize, x, _, { + assert(x.tag == PURS_ANY_TAG_FOREIGN); + struct buf * buf = (struct buf *) x.value.foreign.data; + return purs_any_int(buf->size); +}); + +PURS_FFI_FUNC_3(Main_bufferGrow, n_, x, _, { + assert(x.tag == PURS_ANY_TAG_FOREIGN); + int n = purs_any_get_int(n_); + struct buf * buf = (struct buf *) x.value.foreign.data; + char * data = purs_malloc(sizeof (char) * (buf->size + n)); + memcpy(data, buf->data, buf->size); + buf->size += n; + buf->data = data; + return purs_any_int(buf->size); +}); diff --git a/tests/02-foreign/src/Main.h b/tests/02-foreign/src/Main.h index c16c370..8a14dba 100644 --- a/tests/02-foreign/src/Main.h +++ b/tests/02-foreign/src/Main.h @@ -1,35 +1,15 @@ #ifndef MAIN_H #define MAIN_H -#include +#include "runtime/purescript.h" struct buf { char * data; /* heap-allocated buffer */ int size; }; -PURS_FFI_FUNC_1(Main_newBuffer, _, { - struct buf * buf = purs_new(struct buf); - buf->data = NULL; - buf->size = 0; - return purs_any_foreign(NULL, buf); -}); - -PURS_FFI_FUNC_2(Main_bufferSize, x, _, { - assert(x.tag == PURS_ANY_TAG_FOREIGN); - struct buf * buf = (struct buf *) x.value.foreign.data; - return purs_any_int(buf->size); -}); - -PURS_FFI_FUNC_3(Main_bufferGrow, n_, x, _, { - assert(x.tag == PURS_ANY_TAG_FOREIGN); - int n = purs_any_get_int(n_); - struct buf * buf = (struct buf *) x.value.foreign.data; - char * data = purs_malloc(sizeof (char) * (buf->size + n)); - memcpy(data, buf->data, buf->size); - buf->size += n; - buf->data = data; - return purs_any_int(buf->size); -}); +PURS_FFI_EXPORT(Main_newBuffer); +PURS_FFI_EXPORT(Main_bufferSize); +PURS_FFI_EXPORT(Main_bufferGrow); #endif // MAIN_H diff --git a/tests/04-memory/src/Main.c b/tests/04-memory/src/Main.c new file mode 100644 index 0000000..1014174 --- /dev/null +++ b/tests/04-memory/src/Main.c @@ -0,0 +1,5 @@ +#include "Main.h" + +PURS_FFI_FUNC_2(Main_sub, x, y, { + return purs_any_int(purs_any_get_int(x) - purs_any_get_int(y)); +}); diff --git a/tests/04-memory/src/Main.h b/tests/04-memory/src/Main.h index c6dbd3c..866bca7 100644 --- a/tests/04-memory/src/Main.h +++ b/tests/04-memory/src/Main.h @@ -1,10 +1,8 @@ #ifndef MAIN_H #define MAIN_H -#include +#include "runtime/purescript.h" -PURS_FFI_FUNC_2(Main_sub, x, y, { - return purs_any_int(purs_any_get_int(x) - purs_any_get_int(y)); -}); +PURS_FFI_EXPORT(Main_sub); #endif // MAIN_H From 73159c2733bcbd8814f09adfb4722f0b8a62ae97 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Thu, 18 Jul 2019 21:22:49 +1200 Subject: [PATCH 33/67] Fix double-retaining of captured variables --- Makefile | 46 ++++++------ runtime/purescript.h | 6 +- .../PureScript/CodeGen/C/Transforms.purs | 72 ++++++++++--------- tests/02-foreign/src/Main.c | 9 ++- 4 files changed, 66 insertions(+), 67 deletions(-) diff --git a/Makefile b/Makefile index 1cafa2f..2eecf5e 100644 --- a/Makefile +++ b/Makefile @@ -2,7 +2,7 @@ CLANG ?= clang CFLAGS ?= WITH_GC ?= -SHELL := /bin/bash --init-file ./.functions.sh +SHELL := /bin/bash SHELLFLAGS := -eo pipefail PURS := PATH=$$PATH:node_modules/.bin purs @@ -34,12 +34,13 @@ CFLAGS += \ -D 'vec_realloc=GC_realloc' \ -D 'vec_free(x)=NULL' \ -D 'vec_malloc=GC_malloc' -else +endif + ifdef UNIT_TESTING CFLAGS += \ + -g \ -D UNIT_TESTING endif -endif $(BWDGC_LIB): @$(MAKE) -s deps/bwdgc @@ -123,26 +124,30 @@ deps/bwdgc: #------------------------------------------------------------------------------- test/c: - @$(MAKE) -s clean &> /dev/null + @$(MAKE) -s clean @UNIT_TESTING=1 $(MAKE) -s test/c.0 PHONY: test/c test/c.0: - @make -s $(PUREC_LIB) | prefixed "test/c.0" + @make -s $(PUREC_LIB) @$(CLANG) \ + -g \ -I. \ -L. \ ctests/main.c \ -lpurec \ -lcmocka \ - -o ctests/a.out &> /dev/null - @./ctests/a.out &> /dev/null + -o ctests/a.out + @./ctests/a.out .PHONY: test/c.0 -test/tests/lib: +test/tests.0: | $(foreach t,$(TESTS),test/tests/$(t)) +.PHONY: test/tests.0 + +test/tests: @$(MAKE) -s clean - @UNIT_TESTING=1 $(MAKE) -s test/tests/lib.0 -PHONY: test/tests/lib + @UNIT_TESTING=1 $(MAKE) -s test/tests.0 +PHONY: test/tests # compile each project under 'tests/' as a library, load and execute via # cmocka. @@ -150,16 +155,17 @@ PHONY: test/tests/lib # + Have a 'lib' target without an entry point in a module called 'Main' # + Export a 'main' function from module 'Main' define mk_test_case -test/tests/lib/$(1): +test/tests/$(1): @$(MAKE) -s clean - @UNIT_TESTING=0 $(MAKE) -s test/tests/lib/$(1).0 + @UNIT_TESTING=1 $(MAKE) -s test/tests/$(1).0 -test/tests/lib/$(1).0: +test/tests/$(1).0: @make -s $(PUREC_LIB) &> /dev/null @$(MAKE) -s -C "tests/$(1)" clean @$(MAKE) -s -C "tests/$(1)" lib/c @cd "tests/$(1)" &&\ $(CLANG) \ + -g \ -I. \ -I../.. \ -L../.. \ @@ -169,18 +175,12 @@ test/tests/lib/$(1).0: -lcmocka \ -o a.out @./"tests/$(1)/a.out" -.PHONY: test/tests/lib/$(1) +.PHONY: test/tests/$(1) endef # generate test targets $(foreach t,$(TESTS),$(eval $(call mk_test_case,$(t)))) -test/tests/lib.0: - @set -e; for t in $(TESTS); do\ - $(MAKE) -s "test/tests/lib/$$t" &> /dev/null;\ - done -.PHONY: test/tests/lib.0 - test/tests/main: @$(MAKE) -s clean @$(MAKE) -s test/tests/main.0 @@ -206,10 +206,10 @@ test/upstream: upstream/tests/support/bower_components test: @echo '=== test: c-tests ===================================================' @$(MAKE) -s test/c - @echo '=== test: tests/lib =================================================' - @$(MAKE) -s test/tests/lib + @echo '=== test: tests =====================================================' + @$(MAKE) -s test/tests @echo '=== test: upstream ==================================================' - @$(MAKE) -s test/upstream &> /dev/null + @$(MAKE) -s test/upstream @echo 'success!' .PHONY: test diff --git a/runtime/purescript.h b/runtime/purescript.h index 4cb6595..059666d 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -19,7 +19,6 @@ #else #ifdef UNIT_TESTING extern void mock_assert(const int result, const char *const expression, const char *const file, const int line); -#undef assert #define assert(A) mock_assert((A), #A, __FILE__, __LINE__) #define purs_assert(A, FMT, ...)\ do {\ @@ -279,11 +278,10 @@ static inline ANY purs_any_unthunk(ANY x, int * has_changed) { *has_changed = 0; } while (out.tag == PURS_ANY_TAG_THUNK) { - /* todo: thunks are not rc-ed atm, but once they are, we should - * release intermediate results. - */ out = out.value.thunk->fn(out.value.thunk->ctx); if (has_changed != NULL) { + /* todo: consider nested thunks */ + assert(*has_changed == 0); *has_changed = 1; } } diff --git a/src/Language/PureScript/CodeGen/C/Transforms.purs b/src/Language/PureScript/CodeGen/C/Transforms.purs index 596df2b..3754760 100644 --- a/src/Language/PureScript/CodeGen/C/Transforms.purs +++ b/src/Language/PureScript/CodeGen/C/Transforms.purs @@ -21,8 +21,9 @@ import Data.Set as Set import Data.Traversable (for, traverse) import Data.Tuple (fst, snd) import Data.Tuple.Nested ((/\)) -import Language.PureScript.CodeGen.C.AST (AST, everywhere) import Language.PureScript.CodeGen.C.AST (AST(..), everywhereTopDown) as AST +import Language.PureScript.CodeGen.C.AST (AST, everywhere) +import Language.PureScript.CodeGen.C.AST as AST import Language.PureScript.CodeGen.C.AST as Type import Language.PureScript.CodeGen.C.AST.Common (isReferenced) as AST import Language.PureScript.CodeGen.C.Common (freshInternalName, isInternalVariable) @@ -83,6 +84,8 @@ releaseResources = map (map cleanup) <<< traverse (go []) AST.Block xs x -> x + -- note: we purposely omit 'purs_scope_t' as that one is fully managed by + -- the 'eraseLambdas' transform. allocatedType = case _ of AST.Var "purs_any_app" -> Just R.any AST.Var "purs_vec_new_va" -> Just arrayType @@ -94,11 +97,6 @@ releaseResources = map (map cleanup) <<< traverse (go []) AST.Var "purs_cont_new" -> Just contType _ -> Nothing - contType = Type.Pointer (Type.RawType "purs_cont_t" [ Type.Const ]) - recordType = Type.Pointer (Type.RawType "purs_record_t" [ Type.Const ]) - stringType = Type.Pointer (Type.RawType "purs_str_t" [ Type.Const ]) - arrayType = Type.Pointer (Type.RawType "purs_vec_t" [ Type.Const ]) - go parentVars = case _ of AST.Block xs -> do -- build up a new block, collect new variables we should introduce, and @@ -188,11 +186,17 @@ releaseResources = map (map cleanup) <<< traverse (go []) [ AST.Return $ AST.Var tmp ] - AST.VariableIntroduction x -> ado - initialization' <- traverse go' x.initialization - in AST.VariableIntroduction $ - x { initialization = initialization' - } + AST.VariableIntroduction x -> + -- XXX do not recurse into scope assignments! + -- this assumption is tightly coupled to the + -- 'eraseLambdas' transforms. + if x.type == scopeType + then pure $ AST.VariableIntroduction x + else ado + initialization' <- traverse go' x.initialization + in AST.VariableIntroduction $ + x { initialization = initialization' + } AST.Unary o a -> AST.Unary o <$> go' a AST.Binary o a b -> @@ -296,21 +300,9 @@ releaseResources = map (map cleanup) <<< traverse (go []) AST.StatementExpression ast' } - AST.Function f@{ body: Just x@(AST.Block _) } -> do + AST.Function f@{ body: Just x@(AST.Block _) } -> ado ast' <- go parentVars x - pure - if false -- todo: remove or move into a debug transform - then AST.Function $ f { body = Just ast' } - else AST.Function $ - f { body = - Just $ - AST.Block - [ AST.App (AST.Var "printf") - [ AST.StringLiteral "> fn=%s\n" - , AST.StringLiteral (fromMaybe "" f.name) - ] - , ast' - ] } + in AST.Function $ f { body = Just ast' } x -> pure x @@ -634,7 +626,7 @@ eraseLambdas moduleName asts = map collapseNestedBlocks <$> AST.Block [ AST.VariableIntroduction { name: scopeVarName - , type: Type.Pointer (Type.RawType R.purs_scope_t [ Type.Const ]) + , type: scopeType , qualifiers: [] , initialization: Just $ @@ -644,20 +636,14 @@ eraseLambdas moduleName asts = map collapseNestedBlocks <$> <> (capturedBindings <#> \v -> -- todo: solve this dilemma (recursion?) + -- todo: do we need to retain these? should this be + -- handeled by 'releaseResources' transform? if Just v == capturedScope.lhs then AST.App R.purs_indirect_thunk_new [ AST.Var "$_ivalue" ] else - AST.StatementExpression $ - AST.Block - [ AST.App (AST.Var "PURS_ANY_RETAIN") - [ AST.App R.purs_address_of - [ AST.Var v - ] - ] - , AST.Var v - ] + AST.Var v ) } , AST.VariableIntroduction @@ -678,3 +664,19 @@ eraseLambdas moduleName asts = map collapseNestedBlocks <$> , AST.App (AST.Var "PURS_RC_RELEASE") [ AST.Var scopeVarName ] , AST.Var contVarName ] + +contType :: AST.Type +contType = Type.Pointer (Type.RawType "purs_cont_t" [ Type.Const ]) + +recordType :: AST.Type +recordType = Type.Pointer (Type.RawType "purs_record_t" [ Type.Const ]) + + +stringType :: AST.Type +stringType = Type.Pointer (Type.RawType "purs_str_t" [ Type.Const ]) + +arrayType :: AST.Type +arrayType = Type.Pointer (Type.RawType "purs_vec_t" [ Type.Const ]) + +scopeType :: AST.Type +scopeType = Type.Pointer (Type.RawType "purs_scope_t" [ Type.Const ]) diff --git a/tests/02-foreign/src/Main.c b/tests/02-foreign/src/Main.c index 9801bc0..b2ab137 100644 --- a/tests/02-foreign/src/Main.c +++ b/tests/02-foreign/src/Main.c @@ -2,11 +2,10 @@ #include "Main.h" PURS_FFI_FUNC_1(Main_newBuffer, _, { - return purs_any_int(1); - /* struct buf * buf = purs_new(struct buf); */ - /* buf->data = NULL; */ - /* buf->size = 0; */ - /* return purs_any_foreign(NULL, buf); */ + struct buf * buf = purs_new(struct buf); + buf->data = NULL; + buf->size = 0; + return purs_any_foreign(NULL, buf); }); PURS_FFI_FUNC_2(Main_bufferSize, x, _, { From 7d104e8ba4cf9d28f3189072ee570a8ab0188fd4 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Fri, 19 Jul 2019 09:49:08 +1200 Subject: [PATCH 34/67] Get three core tests passing, fix/free TCO state, name temp vars --- runtime/purescript.h | 21 +++++- src/Language/PureScript/CodeGen/C/Common.purs | 11 +++ .../PureScript/CodeGen/C/Optimizer/TCO.purs | 1 + .../PureScript/CodeGen/C/Transforms.purs | 33 +++++---- tests/01-partialfuns/src/Main.purs | 70 ++++--------------- tests/04-memory/src/Main.purs | 2 +- 6 files changed, 63 insertions(+), 75 deletions(-) diff --git a/runtime/purescript.h b/runtime/purescript.h index 059666d..b37a419 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -460,6 +460,7 @@ ANY * purs_record_find_by_key(const purs_record_t *, /* Tail-call optimization generation */ struct tco_state { int done; + int size; purs_any_t * args; }; @@ -467,14 +468,30 @@ struct tco_state { ({\ struct tco_state x;\ x.done = 0;\ + x.size = N;\ x.args = purs_malloc(sizeof (ANY) * N);\ x;\ }) +#define purs_tco_state_free(S) do {\ + for (int i = 0; i < S.size; i++) {\ + PURS_ANY_RELEASE(&S.args[i]);\ + }\ + purs_free(S.args);\ +} while (0) #define purs_tco_is_done(X) (X.done == 1) #define purs_tco_set_done(X) (((struct tco_state *) X)->done = 1) #define purs_tco_get_arg(X, I) (((struct tco_state *) X)->args[I]) -#define purs_tco_set_arg(X, I, V) (X.args[I] = V) -#define purs_tco_mut_arg(X, I, V) (((struct tco_state *) X)->args[I] = V) +#define purs_tco_set_arg(X, I, V) do {\ + ANY __v__ = (V);\ + PURS_ANY_RETAIN(&__v__);\ + X.args[I] = __v__;\ + } while (0) +#define purs_tco_mut_arg(X, I, V) do {\ + ANY __v__ = (V);\ + PURS_ANY_RELEASE(&((struct tco_state *) X)->args[I]);\ + PURS_ANY_RETAIN(&__v__);\ + ((struct tco_state *) X)->args[I] = __v__;\ + } while (0) #define purs_foreign_get_data(X) (X.data) /* Captured scope generation */ diff --git a/src/Language/PureScript/CodeGen/C/Common.purs b/src/Language/PureScript/CodeGen/C/Common.purs index 9e95b96..6d5dd80 100644 --- a/src/Language/PureScript/CodeGen/C/Common.purs +++ b/src/Language/PureScript/CodeGen/C/Common.purs @@ -7,6 +7,7 @@ module Language.PureScript.CodeGen.C.Common , dotsTo , freshName , freshInternalName + , freshInternalName' , isInternalVariable , allM , allM' @@ -64,6 +65,16 @@ freshName = ado id <- freshId in "$value" <> show id +freshInternalName' + :: ∀ m + . Functor m + => MonadSupply m + => String + -> m String +freshInternalName' label = ado + id <- freshId + in "$_" <> label <> show id + freshInternalName :: ∀ m . Functor m diff --git a/src/Language/PureScript/CodeGen/C/Optimizer/TCO.purs b/src/Language/PureScript/CodeGen/C/Optimizer/TCO.purs index bb53ba3..8f2d7af 100644 --- a/src/Language/PureScript/CodeGen/C/Optimizer/TCO.purs +++ b/src/Language/PureScript/CodeGen/C/Optimizer/TCO.purs @@ -203,6 +203,7 @@ tco = AST.everywhere convert ] ] ] + , AST.App (AST.Var "purs_tco_state_free") [ AST.Var tcoState ] , AST.Return $ AST.Var tcoResult ] diff --git a/src/Language/PureScript/CodeGen/C/Transforms.purs b/src/Language/PureScript/CodeGen/C/Transforms.purs index 3754760..5467ae5 100644 --- a/src/Language/PureScript/CodeGen/C/Transforms.purs +++ b/src/Language/PureScript/CodeGen/C/Transforms.purs @@ -26,7 +26,7 @@ import Language.PureScript.CodeGen.C.AST (AST, everywhere) import Language.PureScript.CodeGen.C.AST as AST import Language.PureScript.CodeGen.C.AST as Type import Language.PureScript.CodeGen.C.AST.Common (isReferenced) as AST -import Language.PureScript.CodeGen.C.Common (freshInternalName, isInternalVariable) +import Language.PureScript.CodeGen.C.Common (freshInternalName, freshInternalName', isInternalVariable) import Language.PureScript.CodeGen.C.Optimizer.Blocks (collapseNestedBlocks) import Language.PureScript.CodeGen.C.Pretty as PP import Language.PureScript.CodeGen.CompileError (CompileError) @@ -123,7 +123,7 @@ releaseResources = map (map cleanup) <<< traverse (go []) args' <- traverse go' args case allocatedType n' of Just typ -> do - name' <- lift freshInternalName + name' <- lift $ freshInternalName' "fnret" State.modify_ \state -> state { allocVars = @@ -141,17 +141,20 @@ releaseResources = map (map cleanup) <<< traverse (go []) Nothing -> pure $ AST.App n' args' - AST.StatementExpression a -> - AST.StatementExpression <$> go' a + -- avoid entering a new isolated context for statement + -- expressions, since they might not return and can be used as + -- rhs values to purs_any_app, etc. + AST.StatementExpression (AST.Block xs') -> + AST.StatementExpression <<< AST.Block <$> traverse go' xs' -- deal with returning. we must release all variables we -- collected, *including* any variables collected in our parent -- scopes, since we won't be coming back. AST.Return x -> do - x' <- go' x + x' <- go' x { allocVars } <- State.get State.modify_ (_ { hasReturned = true }) - tmp <- lift freshInternalName + tmp <- lift $ freshInternalName' "ret" pure $ AST.Block $ [ AST.VariableIntroduction @@ -162,14 +165,10 @@ releaseResources = map (map cleanup) <<< traverse (go []) } ] <> - case x of - AST.StatementExpression _ -> - [] - _ -> - [ AST.App (AST.Var "PURS_ANY_RETAIN") - [ AST.App R.purs_address_of - [ AST.Var tmp ] - ] ] + [ AST.App (AST.Var "PURS_ANY_RETAIN") + [ AST.App R.purs_address_of + [ AST.Var tmp ] + ] ] <> ((parentVars <> allocVars) <#> \v -> if v.type == R.any @@ -285,7 +284,7 @@ releaseResources = map (map cleanup) <<< traverse (go []) -- top-level block-less variable introductions. -- we turn those into statement expressions. AST.VariableIntroduction v@{ initialization: Just x } -> do - tmp <- freshInternalName + tmp <- freshInternalName' "alloc" ast' <- go parentVars $ AST.Block @@ -620,8 +619,8 @@ eraseLambdas moduleName asts = map collapseNestedBlocks <$> ] ] else ado - scopeVarName <- freshInternalName - contVarName <- freshInternalName + scopeVarName <- freshInternalName' "scope" + contVarName <- freshInternalName' "cont" in AST.StatementExpression $ AST.Block [ AST.VariableIntroduction diff --git a/tests/01-partialfuns/src/Main.purs b/tests/01-partialfuns/src/Main.purs index 7e48d55..b997ce5 100644 --- a/tests/01-partialfuns/src/Main.purs +++ b/tests/01-partialfuns/src/Main.purs @@ -14,62 +14,22 @@ chain a b = \_ -> infixl 5 chain as >> -testString :: Effect Int -testString = - let s = "fooBAZ" - in \_ -> - case s of - "fooBAZ" -> 0 - _ -> 1 - -testRecord :: Effect Int -testRecord = - let r = { a: 1, b: 2, c: 0 } - in \_ -> - case r of - { a: 1, b: 2, c: 0 } -> - 0 - _ -> - 1 - -testArray :: Effect Int -testArray = - let xs = [ 1, 2, 0, 3 ] - in \_ -> - case xs of - [_, _, x, _] -> x - _ -> 1 - -uselessArrayIndex :: ∀ a. Array a -> Int -> Maybe a -uselessArrayIndex xs 0 = - case xs of - [x, _] -> Just x - _ -> Nothing -uselessArrayIndex xs 1 = - case xs of - [_, x] -> Just x - _ -> Nothing -uselessArrayIndex _ _ = - Nothing - -twice :: Effect Int -> Effect Int -twice x = x >> x +const :: ∀ a. a -> (∀ b. b -> a) +const x _ = x main :: Effect Int main = let - f = uselessArrayIndex [ 0, 1 ] - in - twice (testArray >> testRecord >> testString) - >> (\_ -> - case f 0 of - Just 0 -> 0 - _ -> 1) - >> (\_ -> - case f 1 of - Just 1 -> 0 - _ -> 1) - >> (\_ -> - case f 2 of - Nothing -> 0 - _ -> 1) + f = const [ 0, 1 ] + in (\_ -> + case f 0 of + [ 0, 1 ] -> 0 + _ -> 1) + >> (\_ -> + case f 1 of + [ 0, 1 ] -> 0 + _ -> 1) + >> (\_ -> + case f 2 of + [ 0, 1 ] -> 0 + _ -> 1) diff --git a/tests/04-memory/src/Main.purs b/tests/04-memory/src/Main.purs index 37c3b91..e75895b 100644 --- a/tests/04-memory/src/Main.purs +++ b/tests/04-memory/src/Main.purs @@ -6,7 +6,7 @@ type Effect a = Unit -> a foreign import sub :: Int -> Int -> Int main :: Effect Int -main _ = go { a: 100000000 } +main _ = go { a: 100000 } where go { a: 0 } = 0 go x = go (x { a = sub x.a 1 }) From a79037863813236b1eb8cbcae20952eb41e22098 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Fri, 19 Jul 2019 12:34:08 +1200 Subject: [PATCH 35/67] Quiet down tests and simplify Mutrec test to not use foreigns --- Makefile | 29 ++++++++++++++-------- tests/03-mutrec/src/Main.purs | 46 +++++++++++++++++------------------ tests/main.stub.c | 19 +-------------- 3 files changed, 43 insertions(+), 51 deletions(-) diff --git a/Makefile b/Makefile index 2eecf5e..251264c 100644 --- a/Makefile +++ b/Makefile @@ -124,12 +124,12 @@ deps/bwdgc: #------------------------------------------------------------------------------- test/c: - @$(MAKE) -s clean + @$(MAKE) -s clean > /dev/null @UNIT_TESTING=1 $(MAKE) -s test/c.0 PHONY: test/c test/c.0: - @make -s $(PUREC_LIB) + @make -s $(PUREC_LIB) &> /dev/null @$(CLANG) \ -g \ -I. \ @@ -137,8 +137,8 @@ test/c.0: ctests/main.c \ -lpurec \ -lcmocka \ - -o ctests/a.out - @./ctests/a.out + -o ctests/a.out > /dev/null + @./ctests/a.out > /dev/null .PHONY: test/c.0 test/tests.0: | $(foreach t,$(TESTS),test/tests/$(t)) @@ -160,21 +160,30 @@ test/tests/$(1): @UNIT_TESTING=1 $(MAKE) -s test/tests/$(1).0 test/tests/$(1).0: + @echo "tests/$(1): start" @make -s $(PUREC_LIB) &> /dev/null - @$(MAKE) -s -C "tests/$(1)" clean - @$(MAKE) -s -C "tests/$(1)" lib/c + @echo "tests/$(1): clean" + @$(MAKE) -s -C "tests/$(1)" clean > /dev/null + @echo "tests/$(1): compile PureScript to C" + @$(MAKE) -s -C "tests/$(1)" main/c > /dev/null + @echo "tests/$(1): compile C" @cd "tests/$(1)" &&\ $(CLANG) \ -g \ -I. \ -I../.. \ -L../.. \ - ../main.stub.c \ - ./.purec-work/lib/*.c \ + ./.purec-work/main/*.c \ -lpurec \ -lcmocka \ - -o a.out - @./"tests/$(1)/a.out" + -o a.out > /dev/null + @echo "tests/$(1): run ouput" + @./"tests/$(1)/a.out" > /dev/null + @echo "tests/$(1): check for leaks" + @valgrind -q > /dev/null \ + --error-exitcode=1 \ + --leak-check=full \ + ./"tests/$(1)/a.out" .PHONY: test/tests/$(1) endef diff --git a/tests/03-mutrec/src/Main.purs b/tests/03-mutrec/src/Main.purs index 0893eed..b2e53a4 100644 --- a/tests/03-mutrec/src/Main.purs +++ b/tests/03-mutrec/src/Main.purs @@ -3,33 +3,33 @@ module Main where data Unit = Unit type Effect a = Unit -> a -data Step - = Start - | Step1 - | Step2 - | Done - main :: Effect Int main _ = let f = case _ of - Start -> - g Step1 - Step1 -> - g Step2 - Step2 -> - g Done - Done -> - 1 -- 'g' should finish! + [0] -> + g [1] + [1] -> + g [2] + [2] -> + g [3] + [3] -> + [1] -- 'g' should finish! + _ -> + [1] g = case _ of - Start -> - f Step1 - Step1 -> - f Step2 - Step2 -> - f Done - Done -> - 0 - in f Start + [0] -> + f [1] + [1] -> + f [2] + [2] -> + f [3] + [3] -> + [0] + _ -> + [1] + in case f [0] of + [0] -> 0 + _ -> 1 diff --git a/tests/main.stub.c b/tests/main.stub.c index 8e75026..f5f3005 100644 --- a/tests/main.stub.c +++ b/tests/main.stub.c @@ -6,23 +6,6 @@ #include ".purec-work/lib/Main.h" -static void test(void **state) { - (void) state; /* unused */ - ANY tmp = purs_any_app(Main_main_$, purs_any_null); - PURS_ANY_RELEASE(&tmp); -} - -#define UNIT_TESTING -#ifdef UNIT_TESTING -int main (void) { - const struct CMUnitTest tests[] = { - cmocka_unit_test(test), - }; - - return cmocka_run_group_tests(tests, NULL, NULL); -} -#else int main(void) { - test(NULL); + return purs_any_get_int(purs_any_app(Main_main_$, purs_any_null)); } -#endif From 0af7701f2bfc1935628e24819e917d114c3c2b6e Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Fri, 19 Jul 2019 17:53:34 +1200 Subject: [PATCH 36/67] Implement reference counting for thunks --- Makefile | 15 ++- ctests/main.c | 26 ++-- runtime/purescript.c | 22 +-- runtime/purescript.h | 127 ++++++++++-------- .../PureScript/CodeGen/C/Transforms.purs | 33 +++-- 5 files changed, 123 insertions(+), 100 deletions(-) diff --git a/Makefile b/Makefile index 251264c..fa630dd 100644 --- a/Makefile +++ b/Makefile @@ -25,7 +25,12 @@ RUNTIME_SOURCES = \ RUNTIME_OBJECTS = \ $(patsubst %.c,%.o,$(RUNTIME_SOURCES)) -TESTS = $(shell cd tests && find . -maxdepth 1 ! -path . -type d -exec basename {} \;) +# TESTS = $(shell cd tests && find . -maxdepth 1 ! -path . -type d -exec basename {} \; | sort) +TESTS = \ + 00-basic \ + 01-partialfuns \ + 04-memory \ + 03-mutrec ifdef WITH_GC CFLAGS += \ @@ -129,7 +134,7 @@ test/c: PHONY: test/c test/c.0: - @make -s $(PUREC_LIB) &> /dev/null + @make -s $(PUREC_LIB) @$(CLANG) \ -g \ -I. \ @@ -157,7 +162,7 @@ PHONY: test/tests define mk_test_case test/tests/$(1): @$(MAKE) -s clean - @UNIT_TESTING=1 $(MAKE) -s test/tests/$(1).0 + @UNIT_TESTING=0 $(MAKE) -s test/tests/$(1).0 test/tests/$(1).0: @echo "tests/$(1): start" @@ -218,8 +223,8 @@ test: @echo '=== test: tests =====================================================' @$(MAKE) -s test/tests @echo '=== test: upstream ==================================================' - @$(MAKE) -s test/upstream - @echo 'success!' + @#$(MAKE) -s test/upstream + @#echo 'success!' .PHONY: test #------------------------------------------------------------------------------- diff --git a/ctests/main.c b/ctests/main.c index 513c3fd..50fe7c6 100644 --- a/ctests/main.c +++ b/ctests/main.c @@ -28,11 +28,11 @@ static void leak_cont_test(void **state) { ANY cont = mk_prefix_cont("foo: "); const purs_str_t * s = purs_str_new("bar"); ANY output = purs_any_app(cont, purs_any_string(s)); - PURS_ANY_RELEASE(&output); + PURS_ANY_RELEASE(output); output = purs_any_app(cont, purs_any_string(s)); - PURS_ANY_RELEASE(&output); + PURS_ANY_RELEASE(output); PURS_RC_RELEASE(s); - PURS_ANY_RELEASE(&cont); + PURS_ANY_RELEASE(cont); } static void purs_scope_new1_test(void **state) { @@ -91,9 +91,9 @@ static void purs_vec_concat_test(void **state) { const purs_vec_t * v2 = purs_vec_new_va(2, s2, s3); const purs_vec_t * v3 = purs_vec_concat(v1, v2); - PURS_ANY_RELEASE(&s1); - PURS_ANY_RELEASE(&s2); - PURS_ANY_RELEASE(&s3); + PURS_ANY_RELEASE(s1); + PURS_ANY_RELEASE(s2); + PURS_ANY_RELEASE(s3); assert_int_equal(v1->length, 1); assert_int_equal(v2->length, 2); @@ -175,10 +175,10 @@ static void purs_any_concat_test(void **state) { ANY a = purs_any_string(purs_str_new("a")); ANY b = purs_any_string(purs_str_new("b")); ANY ab = purs_any_concat(a, b); - PURS_ANY_RELEASE(&b); - PURS_ANY_RELEASE(&a); + PURS_ANY_RELEASE(b); + PURS_ANY_RELEASE(a); assert_string_equal(purs_any_get_string(ab)->data, "ab"); - PURS_ANY_RELEASE(&ab); + PURS_ANY_RELEASE(ab); } /* test: arrays */ @@ -190,15 +190,15 @@ static void purs_any_concat_test(void **state) { const purs_vec_t * v2 = purs_vec_new_va(3, b, a, c); ANY v1v2 = purs_any_concat(purs_any_array(v1), purs_any_array(v2)); - PURS_ANY_RELEASE(&a); - PURS_ANY_RELEASE(&b); - PURS_ANY_RELEASE(&c); + PURS_ANY_RELEASE(a); + PURS_ANY_RELEASE(b); + PURS_ANY_RELEASE(c); PURS_RC_RELEASE(v1); PURS_RC_RELEASE(v2); assert_string_equal(purs_any_get_string(a)->data, "a"); /* should not seg-fault */ assert_string_equal(purs_any_get_string(b)->data, "b"); /* should not seg-fault */ assert_string_equal(purs_any_get_string(c)->data, "c"); /* should not seg-fault */ - PURS_ANY_RELEASE(&v1v2); + PURS_ANY_RELEASE(v1v2); } } diff --git a/runtime/purescript.c b/runtime/purescript.c index b5c0772..329d383 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -59,7 +59,7 @@ inline const char * purs_any_tag_str (const purs_any_tag_t tag) { static void purs_scope_free(const struct purs_rc *ref) { struct purs_scope * x = container_of(ref, struct purs_scope, rc); for (int i = 0; i < x->size; i++) { - PURS_ANY_RELEASE(&(x->bindings[i])); + PURS_ANY_RELEASE(x->bindings[i]); } purs_free(x->bindings); purs_free(x); @@ -87,7 +87,7 @@ struct purs_scope * purs_scope_new(int size, ...) { va_start(ap, size); for (i = 0; i < size; i++) { bindings[i] = va_arg(ap, ANY); - PURS_ANY_RETAIN(&bindings[i]); + PURS_ANY_RETAIN(bindings[i]); } va_end(ap); scope->rc = ((struct purs_rc) { purs_scope_free, 1 }); @@ -209,7 +209,7 @@ static void purs_vec_free(const struct purs_rc *ref) { int i; ANY v; purs_vec_foreach(x, v, i) { - PURS_ANY_RELEASE(&v); + PURS_ANY_RELEASE(v); } vec_deinit(x); purs_free(x); @@ -250,7 +250,7 @@ const purs_vec_t * purs_vec_concat(const purs_vec_t * lhs, memcpy(o->data, lhs->data, sizeof (ANY) * lhs->length); memcpy(o->data + lhs->length, rhs->data, sizeof (ANY) * rhs->length); for (int i = 0; i < o->length; i++) { - PURS_ANY_RETAIN(&o->data[i]); + PURS_ANY_RETAIN(o->data[i]); } return o; } @@ -271,7 +271,7 @@ const purs_vec_t * purs_vec_new_va (int count, ...) { va_start(ap, count); for (int i = 0; i < count; i++) { o->data[i] = va_arg(ap, ANY); - PURS_ANY_RETAIN(&o->data[i]); + PURS_ANY_RETAIN(o->data[i]); } va_end(ap); @@ -294,7 +294,7 @@ static const purs_vec_t * _purs_vec_copy (const purs_vec_t * vec) { const purs_vec_t * purs_vec_copy (const purs_vec_t * vec) { const purs_vec_t * copy = _purs_vec_copy(vec); for (int i = 0; i < copy->length; i++) { - PURS_ANY_RETAIN(©->data[i]); + PURS_ANY_RETAIN(copy->data[i]); } return copy; } @@ -306,7 +306,7 @@ const purs_vec_t * purs_vec_splice (const purs_vec_t * vec, purs_vec_t * copy = (purs_vec_t *) _purs_vec_copy(vec); vec_splice(copy, start, count); for (int i = 0; i < copy->length; i++) { - PURS_ANY_RETAIN(©->data[i]); + PURS_ANY_RETAIN(copy->data[i]); } return (const purs_vec_t *) copy; } @@ -319,7 +319,7 @@ const purs_vec_t * purs_vec_insert(const purs_vec_t * vec, } else { purs_vec_t * out = (purs_vec_t *) purs_vec_copy(vec); vec_insert(out, idx, val); - PURS_ANY_RETAIN(&val); + PURS_ANY_RETAIN(val); return (const purs_vec_t *) out; } } @@ -337,7 +337,7 @@ static void purs_record_free(const struct purs_rc *ref) { const purs_record_node_t * e, * tmp; HASH_ITER(hh, x->root, e, tmp) { HASH_DEL(x->root, (purs_record_node_t *) e); - PURS_ANY_RELEASE(&e->value); + PURS_ANY_RELEASE(e->value); free((void*) e->key); purs_free((purs_record_node_t *) e); } @@ -368,7 +368,7 @@ const purs_record_t * purs_record_copy_shallow(const purs_record_t * source) { purs_record_node_t * dst = purs_new(purs_record_node_t); dst->key = afmt("%s", src->key); /* todo: perf */ dst->value = src->value; - PURS_ANY_RETAIN(&dst->value); + PURS_ANY_RETAIN(dst->value); HASH_ADD_KEYPTR( hh, x->root, @@ -407,7 +407,7 @@ void _purs_record_add_multi_mut(purs_record_t * x, purs_record_node_t * entry = purs_new(purs_record_node_t); entry->key = afmt("%s", key); /* todo: perf */ entry->value = value; - PURS_ANY_RETAIN(&value); + PURS_ANY_RETAIN(value); HASH_ADD_KEYPTR( hh, x->root, diff --git a/runtime/purescript.h b/runtime/purescript.h index b37a419..5c8bdaa 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -85,11 +85,11 @@ typedef struct purs_vec purs_vec_t; typedef struct purs_any purs_any_t; typedef struct purs_record purs_record_t; typedef struct purs_cont purs_cont_t; -typedef struct purs_any_thunk purs_any_thunk_t; +typedef struct purs_thunk purs_thunk_t; typedef struct purs_any_cons purs_any_cons_t; typedef union purs_any_value purs_any_value_t; typedef struct purs_scope purs_scope_t; -typedef ANY (purs_any_thunk_fun_t)(ANY ctx); +typedef ANY (purs_thunk_fun_t)(void * ctx); typedef ANY (purs_cont_fun_t)(const struct purs_scope *, ANY, va_list); typedef struct purs_foreign purs_foreign_t; typedef struct purs_str purs_str_t; @@ -139,8 +139,8 @@ static inline void purs_rc_release(const struct purs_rc *ref) { } /* by convetion, the rc is embedded as 'rc', making these macros possible */ -#define PURS_RC_RELEASE(X) do { if (X != NULL) purs_rc_release(&(X)->rc); } while (0) -#define PURS_RC_RETAIN(X) do { if (X != NULL) purs_rc_retain(&(X)->rc); } while (0) +#define PURS_RC_RELEASE(X) do { if (X != NULL) purs_rc_release(&(X->rc)); } while (0) +#define PURS_RC_RETAIN(X) do { if (X != NULL) purs_rc_retain(&(X->rc)); } while (0) union purs_any_value { /* inline values */ @@ -152,7 +152,7 @@ union purs_any_value { /* self-referential, and other values */ const purs_cont_t * cont; purs_any_cons_t * cons; - purs_any_thunk_t * thunk; + purs_thunk_t * thunk; const purs_record_t * record; const purs_str_t * str; const purs_vec_t * array; @@ -163,9 +163,9 @@ struct purs_any { purs_any_value_t value; }; -struct purs_any_thunk { - purs_any_thunk_fun_t * fn; - ANY ctx; +struct purs_thunk { + purs_thunk_fun_t * fn; + void * ctx; struct purs_rc rc; }; @@ -222,23 +222,25 @@ ANY purs_any_null; const char * purs_any_tag_str (const purs_any_tag_t); #define PURS_ANY_RETAIN(X) {\ - switch ((X)->tag) {\ + switch ((X).tag) {\ case PURS_ANY_TAG_STRING:\ - PURS_RC_RETAIN(((X)->value.str));\ + PURS_RC_RETAIN(((X).value.str));\ break;\ case PURS_ANY_TAG_ARRAY:\ - PURS_RC_RETAIN((X)->value.array);\ + PURS_RC_RETAIN((X).value.array);\ break;\ case PURS_ANY_TAG_RECORD:\ - PURS_RC_RETAIN((X)->value.record);\ + PURS_RC_RETAIN((X).value.record);\ break;\ case PURS_ANY_TAG_CONT:\ - PURS_RC_RETAIN((X)->value.cont);\ + PURS_RC_RETAIN((X).value.cont);\ break;\ case PURS_ANY_TAG_THUNK:\ + PURS_RC_RETAIN((X).value.thunk);\ + break;\ case PURS_ANY_TAG_CONS:\ case PURS_ANY_TAG_FOREIGN:\ - fprintf(stderr, "WARN: Todo: Implement PURS_ANY_RETAIN for: %s\n", purs_any_tag_str((X)->tag));\ + fprintf(stderr, "WARN: Todo: Implement PURS_ANY_RETAIN for: %s\n", purs_any_tag_str((X).tag));\ break;\ default:\ break;\ @@ -246,28 +248,30 @@ const char * purs_any_tag_str (const purs_any_tag_t); } #define PURS_ANY_RELEASE(X) {\ - switch ((X)->tag) {\ + switch ((X).tag) {\ case PURS_ANY_TAG_NULL:\ case PURS_ANY_TAG_INT:\ case PURS_ANY_TAG_NUM:\ case PURS_ANY_TAG_CHAR:\ break;\ - case PURS_ANY_TAG_THUNK:\ case PURS_ANY_TAG_CONS:\ case PURS_ANY_TAG_FOREIGN:\ - fprintf(stderr, "WARN: Todo: Implement PURS_ANY_RELEASE for: %s\n", purs_any_tag_str((X)->tag));\ + fprintf(stderr, "WARN: Todo: Implement PURS_ANY_RELEASE for: %s\n", purs_any_tag_str((X).tag));\ + break;\ + case PURS_ANY_TAG_THUNK:\ + PURS_RC_RELEASE((X).value.thunk);\ break;\ case PURS_ANY_TAG_STRING:\ - PURS_RC_RELEASE((X)->value.str);\ + PURS_RC_RELEASE((X).value.str);\ break;\ case PURS_ANY_TAG_ARRAY:\ - PURS_RC_RELEASE((X)->value.array);\ + PURS_RC_RELEASE((X).value.array);\ break;\ case PURS_ANY_TAG_RECORD:\ - PURS_RC_RELEASE((X)->value.record);\ + PURS_RC_RELEASE((X).value.record);\ break;\ case PURS_ANY_TAG_CONT:\ - PURS_RC_RELEASE((X)->value.cont);\ + PURS_RC_RELEASE((X).value.cont);\ break;\ }\ } @@ -303,7 +307,7 @@ static inline ANY purs_any_app(ANY _f, ANY v, ...) { /* release the intermediate result */ if (has_changed) { - PURS_ANY_RELEASE(&f); + PURS_ANY_RELEASE(f); } return r; @@ -330,7 +334,7 @@ __PURS_ANY_GETTER(char, chr, utf8_int32_t, PURS_ANY_TAG_CHAR) __PURS_ANY_GETTER(foreign, foreign, purs_foreign_t, PURS_ANY_TAG_FOREIGN) __PURS_ANY_GETTER(cont, cont, const purs_cont_t *, PURS_ANY_TAG_CONT) __PURS_ANY_GETTER(cons, cons, const purs_any_cons_t *, PURS_ANY_TAG_CONS) -__PURS_ANY_GETTER(thunk, thunk, const purs_any_thunk_t *, PURS_ANY_TAG_THUNK) +__PURS_ANY_GETTER(thunk, thunk, const purs_thunk_t *, PURS_ANY_TAG_THUNK) __PURS_ANY_GETTER(record, record, const purs_record_t *, PURS_ANY_TAG_RECORD) __PURS_ANY_GETTER(string, str, const purs_str_t *, PURS_ANY_TAG_STRING) __PURS_ANY_GETTER(array, array, const purs_vec_t *, PURS_ANY_TAG_ARRAY) @@ -474,7 +478,7 @@ struct tco_state { }) #define purs_tco_state_free(S) do {\ for (int i = 0; i < S.size; i++) {\ - PURS_ANY_RELEASE(&S.args[i]);\ + PURS_ANY_RELEASE(S.args[i]);\ }\ purs_free(S.args);\ } while (0) @@ -483,13 +487,13 @@ struct tco_state { #define purs_tco_get_arg(X, I) (((struct tco_state *) X)->args[I]) #define purs_tco_set_arg(X, I, V) do {\ ANY __v__ = (V);\ - PURS_ANY_RETAIN(&__v__);\ + PURS_ANY_RETAIN(__v__);\ X.args[I] = __v__;\ } while (0) #define purs_tco_mut_arg(X, I, V) do {\ ANY __v__ = (V);\ - PURS_ANY_RELEASE(&((struct tco_state *) X)->args[I]);\ - PURS_ANY_RETAIN(&__v__);\ + PURS_ANY_RELEASE(((struct tco_state *) X)->args[I]);\ + PURS_ANY_RETAIN(__v__);\ ((struct tco_state *) X)->args[I] = __v__;\ } while (0) #define purs_foreign_get_data(X) (X.data) @@ -510,27 +514,6 @@ struct purs_scope * purs_scope_new1(int size); /* todo: remove this! */ #define purs_cons_get_tag(V) V->tag -/* Thunked pointer dereference: Recursive bindings support */ -#define purs_indirect_value_new() purs_new(ANY) -#define purs_indirect_value_assign(I, V) *(I) = (V) - -static inline ANY purs_thunked_deref(ANY ctx) { - return *((ANY*)(ctx.value.foreign.data)); -} - -static inline ANY purs_indirect_thunk_new(ANY * x) { - purs_any_thunk_t * thunk = purs_malloc(sizeof (purs_any_thunk_t)); - thunk->ctx = ((purs_any_t){ - .tag = PURS_ANY_TAG_FOREIGN, - .value = { .foreign = { .data = x } } - }); - thunk->fn = purs_thunked_deref; - return ((purs_any_t){ - .tag = PURS_ANY_TAG_THUNK, - .value = { .thunk = thunk } - }); -} - /* allocate a buffer to fit 'N' 'ANY's */ #define purs_malloc_any_buf(N) purs_malloc(sizeof (ANY) * N) @@ -552,21 +535,22 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { if (x == 0) {\ x = 1;\ v = INIT;\ - PURS_ANY_RETAIN(&v); /* never free */\ + PURS_ANY_RETAIN(v); /* never free */\ } else {\ - PURS_ANY_RETAIN(&v);\ + PURS_ANY_RETAIN(v);\ }\ return v; #endif // UNIT_TESTING /* declare a thunked top-level value. */ #define PURS_ANY_THUNK_DEF(NAME, INIT)\ - static ANY NAME ## __thunk_fn__ (ANY __unused__1) { \ + static ANY NAME ## __thunk_fn__ (void * __unused__1) { \ _PURS_ANY_THUNK_INIT(INIT);\ };\ - purs_any_thunk_t NAME ## __thunk__ = {\ + purs_thunk_t NAME ## __thunk__ = {\ .fn = NAME ## __thunk_fn__,\ - .ctx = { .tag = PURS_ANY_TAG_NULL }\ + .ctx = NULL,\ + .rc = { NULL, -1 }\ };\ ANY NAME = {\ .tag = PURS_ANY_TAG_THUNK,\ @@ -623,6 +607,41 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { #define purs_any_record PURS_ANY_RECORD #define purs_any_cont PURS_ANY_CONT #define purs_any_string PURS_ANY_STRING +#define purs_any_thunk PURS_ANY_THUNK + +// ----------------------------------------------------------------------------- +// Code-gen helpers (pt. 2) +// ----------------------------------------------------------------------------- + +/* Thunked pointer dereference: Recursive bindings support */ +#define purs_indirect_value_assign(I, V) {\ + *I = (V);\ + PURS_ANY_RETAIN(V);\ + }; + +static void purs_indirect_thunk_free(const struct purs_rc *ref) { + purs_thunk_t * thunk = container_of(ref, purs_thunk_t, rc); + ANY any = *((ANY*)thunk->ctx); + PURS_ANY_RELEASE(any); + purs_free(thunk->ctx); + purs_free(thunk); +} + +static inline ANY purs_thunked_deref(void * ctx) { + ANY any = *((ANY*)(ctx)); + PURS_ANY_RETAIN(any); /* purs_any_unthunk will release! */ + return any; +} + +#define purs_indirect_value_new() purs_new(ANY) + +static inline ANY purs_indirect_thunk_new(ANY * x) { + purs_thunk_t * thunk = purs_malloc(sizeof (purs_thunk_t)); + thunk->ctx = x; + thunk->fn = purs_thunked_deref; + thunk->rc = ((struct purs_rc) { purs_indirect_thunk_free, 1 }); + return PURS_ANY_THUNK(thunk); +} // ----------------------------------------------------------------------------- // FFI helpers @@ -663,7 +682,7 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { $__super__->bindings,\ $__super__->size * sizeof (ANY));\ for (int i = 0; i < $__super__->size; i++) {\ - PURS_ANY_RETAIN(&$__super__->bindings[i]);\ + PURS_ANY_RETAIN($__super__->bindings[i]);\ }\ }\ scope->bindings[CUR - 1] = a;\ diff --git a/src/Language/PureScript/CodeGen/C/Transforms.purs b/src/Language/PureScript/CodeGen/C/Transforms.purs index 5467ae5..f973000 100644 --- a/src/Language/PureScript/CodeGen/C/Transforms.purs +++ b/src/Language/PureScript/CodeGen/C/Transforms.purs @@ -87,15 +87,16 @@ releaseResources = map (map cleanup) <<< traverse (go []) -- note: we purposely omit 'purs_scope_t' as that one is fully managed by -- the 'eraseLambdas' transform. allocatedType = case _ of - AST.Var "purs_any_app" -> Just R.any - AST.Var "purs_vec_new_va" -> Just arrayType - AST.Var "purs_vec_copy" -> Just arrayType - AST.Var "purs_vec_splice" -> Just arrayType - AST.Var "purs_vec_concat" -> Just arrayType - AST.Var "purs_str_new" -> Just stringType - AST.Var "purs_record_new_va" -> Just recordType - AST.Var "purs_cont_new" -> Just contType - _ -> Nothing + AST.Var "purs_any_app" -> Just R.any + AST.Var "purs_vec_new_va" -> Just arrayType + AST.Var "purs_vec_copy" -> Just arrayType + AST.Var "purs_vec_splice" -> Just arrayType + AST.Var "purs_vec_concat" -> Just arrayType + AST.Var "purs_str_new" -> Just stringType + AST.Var "purs_record_new_va" -> Just recordType + AST.Var "purs_cont_new" -> Just contType + AST.Var "purs_indirect_thunk_new" -> Just R.any + _ -> Nothing go parentVars = case _ of AST.Block xs -> do @@ -166,15 +167,15 @@ releaseResources = map (map cleanup) <<< traverse (go []) ] <> [ AST.App (AST.Var "PURS_ANY_RETAIN") - [ AST.App R.purs_address_of - [ AST.Var tmp ] - ] ] + [ AST.Var tmp + ] + ] <> ((parentVars <> allocVars) <#> \v -> if v.type == R.any then AST.App (AST.Var "PURS_ANY_RELEASE") - [ AST.App R.purs_address_of [ AST.Var v.name ] + [ AST.Var v.name ] else AST.App (AST.Var "PURS_RC_RELEASE") @@ -244,9 +245,7 @@ releaseResources = map (map cleanup) <<< traverse (go []) Just (x@(AST.Var name)) -> Just [ AST.App (AST.Var "PURS_ANY_RETAIN") - [ AST.App R.purs_address_of - [ AST.Var name ] - ] + [ AST.Var name ] , x ] _ -> Nothing @@ -258,7 +257,7 @@ releaseResources = map (map cleanup) <<< traverse (go []) if v.type == R.any then AST.App (AST.Var "PURS_ANY_RELEASE") - [ AST.App R.purs_address_of [ AST.Var v.name ] + [ AST.Var v.name ] else AST.App (AST.Var "PURS_RC_RELEASE") From dcba22f01eff1aded7b1e05f97819e21fb45cac5 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Sat, 20 Jul 2019 09:07:03 +1200 Subject: [PATCH 37/67] Add tests for indirect thunks and fix related seg-fault --- Makefile | 6 ++-- ctests/main.c | 55 ++++++++++++++++++++++++++++++ runtime/purescript.c | 10 +++--- runtime/purescript.h | 46 ++++++++++++++++--------- tests/01-partialfuns/src/Main.purs | 1 - 5 files changed, 94 insertions(+), 24 deletions(-) diff --git a/Makefile b/Makefile index fa630dd..9ace3b6 100644 --- a/Makefile +++ b/Makefile @@ -134,7 +134,7 @@ test/c: PHONY: test/c test/c.0: - @make -s $(PUREC_LIB) + @UNIT_TESTING=1 make -s $(PUREC_LIB) @$(CLANG) \ -g \ -I. \ @@ -143,7 +143,7 @@ test/c.0: -lpurec \ -lcmocka \ -o ctests/a.out > /dev/null - @./ctests/a.out > /dev/null + @./ctests/a.out .PHONY: test/c.0 test/tests.0: | $(foreach t,$(TESTS),test/tests/$(t)) @@ -183,7 +183,7 @@ test/tests/$(1).0: -lcmocka \ -o a.out > /dev/null @echo "tests/$(1): run ouput" - @./"tests/$(1)/a.out" > /dev/null + @./"tests/$(1)/a.out" @echo "tests/$(1): check for leaks" @valgrind -q > /dev/null \ --error-exitcode=1 \ diff --git a/ctests/main.c b/ctests/main.c index 50fe7c6..f49453c 100644 --- a/ctests/main.c +++ b/ctests/main.c @@ -1,8 +1,10 @@ +#undef UNIT_TESTING #include #include #include #include +#define UNIT_TESTING #include "runtime/purescript.h" static ANY mk_prefix_cont_0(const struct purs_scope * scope, ANY arg, va_list _) { @@ -202,6 +204,57 @@ static void purs_any_concat_test(void **state) { } } +static void purs_indirect_thunk_test(void **state) { + (void) state; /* unused */ + + { /* unassigned/null */ + ANY * ivalue = purs_indirect_value_new(); + ANY ithunk = purs_indirect_thunk_new(ivalue); + int has_changed; + ANY val = purs_any_unthunk(ithunk, &has_changed); + assert_int_equal(has_changed, 1); + assert_int_equal(val.tag, PURS_ANY_TAG_NULL); + PURS_ANY_RELEASE(ithunk); + } + + { /* retained results */ + + ANY arr; + { /* allocate array */ + const purs_str_t * str = purs_str_new("fooba"); + arr = purs_any_array(purs_vec_new_va(1, purs_any_string(str))); + PURS_RC_RELEASE(str); + } + + ANY ithunk; + { /* create and fill thunk */ + ANY * ivalue = purs_indirect_value_new(); + ithunk = purs_indirect_thunk_new(ivalue /* move */); + purs_indirect_value_assign(ivalue, arr); + } + + { /* force the thunk */ + int has_changed; + ANY val = purs_any_unthunk(ithunk, &has_changed); + assert_int_equal(has_changed, 1); + assert_int_equal(val.tag, PURS_ANY_TAG_ARRAY); + PURS_ANY_RELEASE(val); + } + + PURS_ANY_RELEASE(arr); + PURS_ANY_RELEASE(ithunk); + } +} + +static void purs_indirect_value_test(void **state) { + (void) state; /* unused */ + ANY * ivalue = purs_indirect_value_new(); + const purs_cont_t * cont = purs_cont_new(NULL, NULL); + purs_indirect_value_assign(ivalue, purs_any_cont(cont)); + PURS_RC_RELEASE(cont); + purs_indirect_value_free(ivalue); +} + int main (void) { const struct CMUnitTest tests[] = { cmocka_unit_test(leak_string_test), @@ -211,6 +264,8 @@ int main (void) { cmocka_unit_test(purs_scope_new1_test), cmocka_unit_test(purs_any_concat_test), cmocka_unit_test(purs_vec_concat_test), + cmocka_unit_test(purs_indirect_value_test), + cmocka_unit_test(purs_indirect_thunk_test), }; return cmocka_run_group_tests(tests, NULL, NULL); diff --git a/runtime/purescript.c b/runtime/purescript.c index 329d383..fa28adf 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -114,8 +114,8 @@ ANY purs_any_infinity = PURS_ANY_NUM(PURS_INFINITY); ANY purs_any_neg_infinity = PURS_ANY_NUM(-PURS_INFINITY); int purs_any_eq(ANY x, ANY y) { - x = purs_any_unthunk(x, NULL); - y = purs_any_unthunk(y, NULL); + x = purs_any_unthunk(x, NULL) /* todo: has changed? */; + y = purs_any_unthunk(y, NULL) /* todo: has changed? */; /* special treatment for NaN on LHS */ if (purs_any_is_NaN(x) && @@ -157,8 +157,8 @@ int purs_any_eq(ANY x, ANY y) { Concatenate two dyanmic values into a new dynamic value */ ANY purs_any_concat(ANY x, ANY y) { - x = purs_any_unthunk(x, NULL); - y = purs_any_unthunk(y, NULL); + x = purs_any_unthunk(x, NULL) /* todo: has changed? */; + y = purs_any_unthunk(y, NULL) /* todo: has changed? */; assert(x.tag != PURS_ANY_TAG_NULL); assert(y.tag != PURS_ANY_TAG_NULL); @@ -178,6 +178,8 @@ ANY purs_any_concat(ANY x, ANY y) { default: purs_assert(0, "cannot concat %s", purs_any_tag_str(x.tag)); } + + return purs_any_null /* never reached */; } // ----------------------------------------------------------------------------- diff --git a/runtime/purescript.h b/runtime/purescript.h index 5c8bdaa..17e9235 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -19,6 +19,7 @@ #else #ifdef UNIT_TESTING extern void mock_assert(const int result, const char *const expression, const char *const file, const int line); +#undef assert #define assert(A) mock_assert((A), #A, __FILE__, __LINE__) #define purs_assert(A, FMT, ...)\ do {\ @@ -281,11 +282,12 @@ static inline ANY purs_any_unthunk(ANY x, int * has_changed) { if (has_changed != NULL) { *has_changed = 0; } + ANY last = purs_any_null; while (out.tag == PURS_ANY_TAG_THUNK) { out = out.value.thunk->fn(out.value.thunk->ctx); + PURS_ANY_RELEASE(last); + last = out; if (has_changed != NULL) { - /* todo: consider nested thunks */ - assert(*has_changed == 0); *has_changed = 1; } } @@ -614,31 +616,43 @@ struct purs_scope * purs_scope_new1(int size); // ----------------------------------------------------------------------------- /* Thunked pointer dereference: Recursive bindings support */ -#define purs_indirect_value_assign(I, V) {\ - *I = (V);\ - PURS_ANY_RETAIN(V);\ - }; +static inline void purs_indirect_value_assign(ANY * x, ANY v) { + *x = v; + PURS_ANY_RETAIN(v); +} -static void purs_indirect_thunk_free(const struct purs_rc *ref) { - purs_thunk_t * thunk = container_of(ref, purs_thunk_t, rc); - ANY any = *((ANY*)thunk->ctx); - PURS_ANY_RELEASE(any); - purs_free(thunk->ctx); - purs_free(thunk); +static inline void purs_indirect_value_free(ANY * x) { + if (x != NULL) { + ANY y = *x; + PURS_ANY_RELEASE(y); + } + purs_free(x); } -static inline ANY purs_thunked_deref(void * ctx) { +static inline ANY * purs_indirect_value_new() { + ANY * x = purs_new(ANY); + x->tag = PURS_ANY_TAG_NULL; + x->value = (purs_any_value_t){}; + return x; +} + +static inline ANY purs_indirect_thunk_deref(void * ctx) { ANY any = *((ANY*)(ctx)); - PURS_ANY_RETAIN(any); /* purs_any_unthunk will release! */ + PURS_ANY_RETAIN(any); /* user will release! */ return any; } -#define purs_indirect_value_new() purs_new(ANY) +static void purs_indirect_thunk_free(const struct purs_rc *ref) { + purs_thunk_t * thunk = container_of(ref, purs_thunk_t, rc); + purs_indirect_value_free((ANY *) thunk->ctx); + purs_free(thunk); +} +/* takes ownership of 'x' */ static inline ANY purs_indirect_thunk_new(ANY * x) { purs_thunk_t * thunk = purs_malloc(sizeof (purs_thunk_t)); thunk->ctx = x; - thunk->fn = purs_thunked_deref; + thunk->fn = purs_indirect_thunk_deref; thunk->rc = ((struct purs_rc) { purs_indirect_thunk_free, 1 }); return PURS_ANY_THUNK(thunk); } diff --git a/tests/01-partialfuns/src/Main.purs b/tests/01-partialfuns/src/Main.purs index b997ce5..5a972ba 100644 --- a/tests/01-partialfuns/src/Main.purs +++ b/tests/01-partialfuns/src/Main.purs @@ -2,7 +2,6 @@ module Main where data Unit = Unit type Effect a = Unit -> a -data Maybe a = Just a | Nothing chain :: Effect Int -> Effect Int -> Effect Int chain a b = \_ -> From ce208c341c016ba80c5d287264952be5dcecd36c Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Sat, 20 Jul 2019 10:14:56 +1200 Subject: [PATCH 38/67] Generate slighly more easy to read code --- src/Language/PureScript/CodeGen/C/Pretty.purs | 35 +++++++++++++++---- 1 file changed, 29 insertions(+), 6 deletions(-) diff --git a/src/Language/PureScript/CodeGen/C/Pretty.purs b/src/Language/PureScript/CodeGen/C/Pretty.purs index b9d3f35..d71034c 100644 --- a/src/Language/PureScript/CodeGen/C/Pretty.purs +++ b/src/Language/PureScript/CodeGen/C/Pretty.purs @@ -13,6 +13,7 @@ import Control.Monad.Reader (ReaderT, ask, local, runReaderT) import Control.Monad.Writer (WriterT, execWriterT, tell) import Data.Array as A import Data.Bifunctor (rmap) +import Data.Tuple.Nested ((/\)) import Data.Either (Either(..)) import Data.FoldableWithIndex (traverseWithIndex_) import Data.Identity (Identity) @@ -165,20 +166,42 @@ prettyPrintAst (AST.Cast typ ast) = do emit ")" prettyPrintAst (AST.App fnAst argsAsts) = do prettyPrintAst fnAst + let + -- note: this is a crude way to improve readability of some of the generated + -- code by avoiding line feeds for functions that will likely only + -- take few, short arguments. + lf' /\ indent' = + let noop = pure unit /\ pure unit + in case fnAst of + AST.Var "purs_cont_new" -> noop + AST.Var "purs_scope_new" -> noop + AST.Var "PURS_ANY_RETAIN" -> noop + AST.Var "PURS_ANY_RELEASE" -> noop + AST.Var "PURS_RC_RETAIN" -> noop + AST.Var "PURS_RC_RELEASE" -> noop + AST.Var "purs_any_num" -> noop + AST.Var "purs_any_string" -> noop + AST.Var "purs_any_int" -> noop + AST.Var "purs_indirect_thunk_new" -> noop + AST.Var "purs_any_eq_int" -> noop + AST.Var "purs_any_get_int" -> noop + AST.Var "purs_any_get_num" -> noop + AST.Var "purs_any_get_array" -> noop + _ -> lf /\ indent case A.unsnoc argsAsts of Nothing -> emit "()" Just { init, last } -> do emit "(" - lf + lf' withNextIndent do for_ init \ast -> do - indent *> prettyPrintAst ast + indent' *> prettyPrintAst ast emit "," - lf - indent *> prettyPrintAst last - lf - indent *> emit ")" + lf' + indent' *> prettyPrintAst last + lf' + indent' *> emit ")" prettyPrintAst (AST.Assignment l r) = do prettyPrintAst l emit " = " From 160373b7285ef67844edfc77eac08235e1114333 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Sat, 20 Jul 2019 19:43:38 +1200 Subject: [PATCH 39/67] Add support for reference counted data constructors --- Makefile | 3 +- ctests/main.c | 25 +++ runtime/purescript.c | 101 ++++++++---- runtime/purescript.h | 153 ++++++++++++------ src/Language/PureScript/CodeGen/C.purs | 56 ++----- .../PureScript/CodeGen/C/Transforms.purs | 4 + src/Language/PureScript/CodeGen/Runtime.purs | 4 + tests/05-datacons/.gitignore | 10 ++ tests/05-datacons/Makefile | 12 ++ tests/05-datacons/packages.dhall | 9 ++ tests/05-datacons/spago.dhall | 9 ++ tests/05-datacons/src/Main.purs | 38 +++++ 12 files changed, 312 insertions(+), 112 deletions(-) create mode 100644 tests/05-datacons/.gitignore create mode 100644 tests/05-datacons/Makefile create mode 100644 tests/05-datacons/packages.dhall create mode 100644 tests/05-datacons/spago.dhall create mode 100644 tests/05-datacons/src/Main.purs diff --git a/Makefile b/Makefile index 9ace3b6..4ede355 100644 --- a/Makefile +++ b/Makefile @@ -30,6 +30,7 @@ TESTS = \ 00-basic \ 01-partialfuns \ 04-memory \ + 05-datacons \ 03-mutrec ifdef WITH_GC @@ -166,7 +167,7 @@ test/tests/$(1): test/tests/$(1).0: @echo "tests/$(1): start" - @make -s $(PUREC_LIB) &> /dev/null + @make -s $(PUREC_LIB) > /dev/null @echo "tests/$(1): clean" @$(MAKE) -s -C "tests/$(1)" clean > /dev/null @echo "tests/$(1): compile PureScript to C" diff --git a/ctests/main.c b/ctests/main.c index f49453c..3d4ae4f 100644 --- a/ctests/main.c +++ b/ctests/main.c @@ -246,6 +246,30 @@ static void purs_indirect_thunk_test(void **state) { } } +static void purs_cons_test(void **state) { + (void) state; /* unused */ + + { /* empty */ + const purs_cons_t * cons = purs_cons_new(1, 0, NULL); + assert_null(cons->values); + PURS_RC_RELEASE(cons); + } + + { /* non-empty */ + const purs_vec_t * vec = purs_vec_new_va(1, purs_any_int(1)); + const purs_cons_t * cons = purs_cons_new(1, 1, purs_any_array(vec)); + PURS_RC_RELEASE(vec); + PURS_RC_RELEASE(cons); + } + + { /* non-empty, wrapped */ + const purs_vec_t * vec = purs_vec_new_va(1, purs_any_int(1)); + ANY cons = purs_any_cons(purs_cons_new(1, 1, purs_any_array(vec))); + PURS_RC_RELEASE(vec); + PURS_ANY_RELEASE(cons); + } +} + static void purs_indirect_value_test(void **state) { (void) state; /* unused */ ANY * ivalue = purs_indirect_value_new(); @@ -266,6 +290,7 @@ int main (void) { cmocka_unit_test(purs_vec_concat_test), cmocka_unit_test(purs_indirect_value_test), cmocka_unit_test(purs_indirect_thunk_test), + cmocka_unit_test(purs_cons_test), }; return cmocka_run_group_tests(tests, NULL, NULL); diff --git a/runtime/purescript.c b/runtime/purescript.c index fa28adf..da0b86b 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -1,7 +1,7 @@ #include "runtime/purescript.h" // ----------------------------------------------------------------------------- -// Any: allocate +// Continuations // ----------------------------------------------------------------------------- static void purs_cont_free(const struct purs_rc *ref) { @@ -12,7 +12,7 @@ static void purs_cont_free(const struct purs_rc *ref) { const purs_cont_t * purs_cont_new(const struct purs_scope * scope, purs_cont_fun_t * fn) { - purs_cont_t * cont = purs_malloc(sizeof (purs_cont_t)); + purs_cont_t * cont = purs_new(purs_cont_t); cont->fn = fn; cont->scope = scope; cont->rc = ((struct purs_rc) { purs_cont_free, 1 }); @@ -20,15 +20,37 @@ const purs_cont_t * purs_cont_new(const struct purs_scope * scope, return (const purs_cont_t *) cont; } -/* todo: treat. */ -ANY purs_any_cons(int tag, int size, ANY* values) { - ANY v; - v.tag = PURS_ANY_TAG_CONS; - v.value.cons = purs_malloc(sizeof (purs_any_cons_t)); - v.value.cons->tag = tag; - v.value.cons->size = size; - v.value.cons->values = values; - return v; +// ----------------------------------------------------------------------------- +// Constructors +// ----------------------------------------------------------------------------- + +static void purs_cons_free(const struct purs_rc *ref) { + purs_cons_t * x = container_of(ref, purs_cons_t, rc); + for (int i = 0; i < x->size; i++) { + PURS_ANY_RELEASE(x->values[i]); + } + purs_free(x->values); + purs_free(x); +} + +const purs_cons_t * purs_cons_new(int tag, int size, ...) { + purs_cons_t * cons = purs_new(purs_cons_t); + cons->tag = tag; + cons->size = size; + if (size <= 0) { + cons->values = NULL; + } else { + cons->values = purs_malloc(sizeof (ANY) * size); + } + va_list ap; + va_start(ap, size); + for (int i = 0; i < size; i++) { + cons->values[i] = va_arg(ap, ANY); + PURS_ANY_RETAIN(cons->values[i]); + } + va_end(ap); + cons->rc = ((struct purs_rc) { purs_cons_free, 1 }); + return (const purs_cons_t *) cons; } // ----------------------------------------------------------------------------- @@ -114,23 +136,29 @@ ANY purs_any_infinity = PURS_ANY_NUM(PURS_INFINITY); ANY purs_any_neg_infinity = PURS_ANY_NUM(-PURS_INFINITY); int purs_any_eq(ANY x, ANY y) { - x = purs_any_unthunk(x, NULL) /* todo: has changed? */; - y = purs_any_unthunk(y, NULL) /* todo: has changed? */; + int ret = 0; + int x_has_changed; + int y_has_changed; + x = purs_any_unthunk(x, &x_has_changed); + y = purs_any_unthunk(y, &y_has_changed); /* special treatment for NaN on LHS */ if (purs_any_is_NaN(x) && (y.tag == PURS_ANY_TAG_NUM || y.tag == PURS_ANY_TAG_INT)) { - return 0; + ret = 0; + goto end; } /* special treatment for NaN on RHS */ if (purs_any_is_NaN(y) && (x.tag == PURS_ANY_TAG_NUM || x.tag == PURS_ANY_TAG_INT)) { - return 0; + ret = 0; + goto end; } if (x.tag == PURS_ANY_TAG_NULL || y.tag == PURS_ANY_TAG_NULL) { - return 0; + ret = 0; + goto end; } else { purs_assert( x.tag == y.tag, @@ -140,25 +168,37 @@ int purs_any_eq(ANY x, ANY y) { switch (x.tag) { case PURS_ANY_TAG_INT: - return purs_any_get_int(x) == purs_any_get_int(y); + ret = purs_any_get_int(x) == purs_any_get_int(y); + goto end; case PURS_ANY_TAG_NUM: - return purs_any_get_num(x) == purs_any_get_num(y); + ret = purs_any_get_num(x) == purs_any_get_num(y); + goto end; case PURS_ANY_TAG_STRING: - return (utf8cmp(purs_any_get_string(x), purs_any_get_string(y)) == 0); + ret = (utf8cmp(purs_any_get_string(x), purs_any_get_string(y)) == 0); + goto end; case PURS_ANY_TAG_CHAR: - return purs_any_get_char(x) == purs_any_get_char(y); + ret = purs_any_get_char(x) == purs_any_get_char(y); + goto end; default: - return 0; + ret = 0; + goto end; } } + end: + if (x_has_changed) PURS_ANY_RELEASE(x); + if (y_has_changed) PURS_ANY_RELEASE(y); + return ret; } /** Concatenate two dyanmic values into a new dynamic value */ ANY purs_any_concat(ANY x, ANY y) { - x = purs_any_unthunk(x, NULL) /* todo: has changed? */; - y = purs_any_unthunk(y, NULL) /* todo: has changed? */; + ANY ret; + int x_has_changed; + int y_has_changed; + x = purs_any_unthunk(x, &x_has_changed); + y = purs_any_unthunk(y, &y_has_changed); assert(x.tag != PURS_ANY_TAG_NULL); assert(y.tag != PURS_ANY_TAG_NULL); @@ -166,20 +206,27 @@ ANY purs_any_concat(ANY x, ANY y) { switch(x.tag) { case PURS_ANY_TAG_STRING: { - return purs_any_string(purs_str_new("%s%s", - purs_any_get_string(x)->data, - purs_any_get_string(y)->data)); + ret = purs_any_string(purs_str_new("%s%s", + purs_any_get_string(x)->data, + purs_any_get_string(y)->data)); + goto end; } case PURS_ANY_TAG_ARRAY: { const purs_vec_t * x_vec = purs_any_get_array(x); const purs_vec_t * y_vec = purs_any_get_array(y); - return purs_any_array(purs_vec_concat(x_vec, y_vec)); + ret = purs_any_array(purs_vec_concat(x_vec, y_vec)); + goto end; } default: purs_assert(0, "cannot concat %s", purs_any_tag_str(x.tag)); } return purs_any_null /* never reached */; + + end: + if (x_has_changed) PURS_ANY_RELEASE(x); + if (y_has_changed) PURS_ANY_RELEASE(y); + return ret; } // ----------------------------------------------------------------------------- diff --git a/runtime/purescript.h b/runtime/purescript.h index 17e9235..dc8785e 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -82,12 +82,13 @@ extern void _test_free(void* const ptr, const char* file, const int line); #define purs_any_int_t int32_t #define purs_any_num_t double +typedef utf8_int32_t purs_any_char_t; typedef struct purs_vec purs_vec_t; typedef struct purs_any purs_any_t; typedef struct purs_record purs_record_t; typedef struct purs_cont purs_cont_t; typedef struct purs_thunk purs_thunk_t; -typedef struct purs_any_cons purs_any_cons_t; +typedef struct purs_cons purs_cons_t; typedef union purs_any_value purs_any_value_t; typedef struct purs_scope purs_scope_t; typedef ANY (purs_thunk_fun_t)(void * ctx); @@ -140,20 +141,26 @@ static inline void purs_rc_release(const struct purs_rc *ref) { } /* by convetion, the rc is embedded as 'rc', making these macros possible */ -#define PURS_RC_RELEASE(X) do { if (X != NULL) purs_rc_release(&(X->rc)); } while (0) -#define PURS_RC_RETAIN(X) do { if (X != NULL) purs_rc_retain(&(X->rc)); } while (0) +#define PURS_RC_RELEASE(X) do { if ((X) != NULL) purs_rc_release(&((X)->rc)); } while (0) +#define PURS_RC_RETAIN(X) do { if ((X) != NULL) purs_rc_retain(&((X)->rc)); } while (0) + +/* all "base"-compatible structures must have their "rc" field in the same + position as "_purs_rc_base." */ +struct _purs_rc_base { struct purs_rc rc; }; +#define PURS_RC_BASE_RELEASE(X) PURS_RC_RELEASE((struct _purs_rc_base *) X) +#define PURS_RC_BASE_RETAIN(X) PURS_RC_RETAIN((struct _purs_rc_base *) X) union purs_any_value { /* inline values */ purs_any_int_t i; purs_any_num_t n; - utf8_int32_t chr; + purs_any_char_t chr; purs_foreign_t foreign; /* self-referential, and other values */ const purs_cont_t * cont; - purs_any_cons_t * cons; - purs_thunk_t * thunk; + const purs_cons_t * cons; + const purs_thunk_t * thunk; const purs_record_t * record; const purs_str_t * str; const purs_vec_t * array; @@ -165,35 +172,35 @@ struct purs_any { }; struct purs_thunk { + struct purs_rc rc; purs_thunk_fun_t * fn; void * ctx; - struct purs_rc rc; }; struct purs_cont { + struct purs_rc rc; purs_cont_fun_t * fn; const struct purs_scope * scope; /* todo: inline? */ - struct purs_rc rc; }; -struct purs_any_cons { +struct purs_cons { + struct purs_rc rc; int tag; int size; ANY * values; - struct purs_rc rc; }; struct purs_str { - char * data; struct purs_rc rc; + char * data; }; /* a reference-counted vec_t(...) */ struct purs_vec { + struct purs_rc rc; ANY * data; int length; int capacity; - struct purs_rc rc; }; typedef struct purs_node_record { @@ -203,8 +210,8 @@ typedef struct purs_node_record { } purs_record_node_t; typedef struct purs_record { - const purs_record_node_t * root; struct purs_rc rc; + const purs_record_node_t * root; } purs_record_t; // TODO: rename to 'purs_any_record_empty' @@ -240,6 +247,8 @@ const char * purs_any_tag_str (const purs_any_tag_t); PURS_RC_RETAIN((X).value.thunk);\ break;\ case PURS_ANY_TAG_CONS:\ + PURS_RC_RETAIN((X).value.cons);\ + break;\ case PURS_ANY_TAG_FOREIGN:\ fprintf(stderr, "WARN: Todo: Implement PURS_ANY_RETAIN for: %s\n", purs_any_tag_str((X).tag));\ break;\ @@ -250,15 +259,12 @@ const char * purs_any_tag_str (const purs_any_tag_t); #define PURS_ANY_RELEASE(X) {\ switch ((X).tag) {\ - case PURS_ANY_TAG_NULL:\ - case PURS_ANY_TAG_INT:\ - case PURS_ANY_TAG_NUM:\ - case PURS_ANY_TAG_CHAR:\ - break;\ - case PURS_ANY_TAG_CONS:\ case PURS_ANY_TAG_FOREIGN:\ fprintf(stderr, "WARN: Todo: Implement PURS_ANY_RELEASE for: %s\n", purs_any_tag_str((X).tag));\ break;\ + case PURS_ANY_TAG_CONS:\ + PURS_RC_RELEASE((X).value.cons);\ + break;\ case PURS_ANY_TAG_THUNK:\ PURS_RC_RELEASE((X).value.thunk);\ break;\ @@ -274,6 +280,8 @@ const char * purs_any_tag_str (const purs_any_tag_t); case PURS_ANY_TAG_CONT:\ PURS_RC_RELEASE((X).value.cont);\ break;\ + default:\ + break;\ }\ } @@ -320,44 +328,89 @@ static inline const purs_any_tag_t purs_any_get_tag (ANY v) { return v.tag; } -/* todo: treat! */ -ANY purs_any_cons(int tag, int size, ANY* values); - -#define __PURS_ANY_GETTER(N, A, R, TAG)\ +#define __PURS_ANY_GET(N, A, R, TAG)\ static inline R _purs_any_get_ ## N (ANY v, char * file, int line) {\ - v = purs_any_unthunk(v, NULL);\ purs_any_assert_tag_eq(v.tag, TAG);\ return v.value.A;\ } -__PURS_ANY_GETTER(int, i, purs_any_int_t, PURS_ANY_TAG_INT) -__PURS_ANY_GETTER(num, n, purs_any_num_t, PURS_ANY_TAG_NUM) -__PURS_ANY_GETTER(char, chr, utf8_int32_t, PURS_ANY_TAG_CHAR) -__PURS_ANY_GETTER(foreign, foreign, purs_foreign_t, PURS_ANY_TAG_FOREIGN) -__PURS_ANY_GETTER(cont, cont, const purs_cont_t *, PURS_ANY_TAG_CONT) -__PURS_ANY_GETTER(cons, cons, const purs_any_cons_t *, PURS_ANY_TAG_CONS) -__PURS_ANY_GETTER(thunk, thunk, const purs_thunk_t *, PURS_ANY_TAG_THUNK) -__PURS_ANY_GETTER(record, record, const purs_record_t *, PURS_ANY_TAG_RECORD) -__PURS_ANY_GETTER(string, str, const purs_str_t *, PURS_ANY_TAG_STRING) -__PURS_ANY_GETTER(array, array, const purs_vec_t *, PURS_ANY_TAG_ARRAY) +__PURS_ANY_GET(int, i, purs_any_int_t, PURS_ANY_TAG_INT) +__PURS_ANY_GET(num, n, purs_any_num_t, PURS_ANY_TAG_NUM) +__PURS_ANY_GET(char, chr, purs_any_char_t, PURS_ANY_TAG_CHAR) +__PURS_ANY_GET(foreign, foreign, purs_foreign_t, PURS_ANY_TAG_FOREIGN) +__PURS_ANY_GET(cont, cont, const purs_cont_t *, PURS_ANY_TAG_CONT) +__PURS_ANY_GET(cons, cons, const purs_cons_t *, PURS_ANY_TAG_CONS) +__PURS_ANY_GET(thunk, thunk, const purs_thunk_t *, PURS_ANY_TAG_THUNK) +__PURS_ANY_GET(record, record, const purs_record_t *, PURS_ANY_TAG_RECORD) +__PURS_ANY_GET(string, str, const purs_str_t *, PURS_ANY_TAG_STRING) +__PURS_ANY_GET(array, array, const purs_vec_t *, PURS_ANY_TAG_ARRAY) /* todo: generate faster, unsafe variants */ -#define purs_any_get_int(A) _purs_any_get_int((A), __FILE__, __LINE__) -#define purs_any_get_num(A) _purs_any_get_num((A), __FILE__, __LINE__) -#define purs_any_get_char(A) _purs_any_get_char((A), __FILE__, __LINE__) +#define purs_any_get_int(A) _purs_any_get_int((A), __FILE__, __LINE__) +#define purs_any_get_num(A) _purs_any_get_num((A), __FILE__, __LINE__) +#define purs_any_get_char(A) _purs_any_get_char((A), __FILE__, __LINE__) #define purs_any_get_foreign(A) _purs_any_get_foreign((A), __FILE__, __LINE__) -#define purs_any_get_cont(A) _purs_any_get_cont((A), __FILE__, __LINE__) -#define purs_any_get_cons(A) _purs_any_get_cons((A), __FILE__, __LINE__) -#define purs_any_get_thunk(A) _purs_any_get_thunk((A), __FILE__, __LINE__) -#define purs_any_get_record(A) _purs_any_get_record((A), __FILE__, __LINE__) -#define purs_any_get_string(A) _purs_any_get_string((A), __FILE__, __LINE__) -#define purs_any_get_array(A) _purs_any_get_array((A), __FILE__, __LINE__) +#define purs_any_get_cont(A) _purs_any_get_cont((A), __FILE__, __LINE__) +#define purs_any_get_cons(A) _purs_any_get_cons((A), __FILE__, __LINE__) +#define purs_any_get_thunk(A) _purs_any_get_thunk((A), __FILE__, __LINE__) +#define purs_any_get_record(A) _purs_any_get_record((A), __FILE__, __LINE__) +#define purs_any_get_string(A) _purs_any_get_string((A), __FILE__, __LINE__) +#define purs_any_get_array(A) _purs_any_get_array((A), __FILE__, __LINE__) + +#define __PURS_ANY_FORCE_COPY(N, A, R, TAG)\ + static inline R _purs_any_force_ ## N (ANY v, char * file, int line) {\ + int was_forced;\ + v = purs_any_unthunk(v, &was_forced);\ + purs_any_assert_tag_eq(v.tag, TAG);\ + R r = v.value.A;\ + if (was_forced) PURS_ANY_RELEASE(v);\ + return r;\ + } + +#define __PURS_ANY_FORCE_RETAIN(N, A, R, TAG)\ + static inline R _purs_any_force_ ## N (ANY v, char * file, int line) {\ + int was_forced;\ + v = purs_any_unthunk(v, &was_forced);\ + purs_any_assert_tag_eq(v.tag, TAG);\ + R r = v.value.A;\ + PURS_RC_BASE_RETAIN(r);\ + if (was_forced) PURS_ANY_RELEASE(v);\ + return r;\ + } + +__PURS_ANY_FORCE_COPY(int, i, purs_any_int_t, PURS_ANY_TAG_INT) +__PURS_ANY_FORCE_COPY(num, n, purs_any_num_t, PURS_ANY_TAG_NUM) +__PURS_ANY_FORCE_COPY(char, chr, purs_any_char_t, PURS_ANY_TAG_CHAR) +__PURS_ANY_FORCE_COPY(foreign, foreign, purs_foreign_t, PURS_ANY_TAG_FOREIGN) + +__PURS_ANY_FORCE_RETAIN(cont, cont, const purs_cont_t *, PURS_ANY_TAG_CONT) +__PURS_ANY_FORCE_RETAIN(cons, cons, const purs_cons_t *, PURS_ANY_TAG_CONS) +__PURS_ANY_FORCE_RETAIN(thunk, thunk, const purs_thunk_t *, PURS_ANY_TAG_THUNK) +__PURS_ANY_FORCE_RETAIN(record, record, const purs_record_t *, PURS_ANY_TAG_RECORD) +__PURS_ANY_FORCE_RETAIN(string, str, const purs_str_t *, PURS_ANY_TAG_STRING) +__PURS_ANY_FORCE_RETAIN(array, array, const purs_vec_t *, PURS_ANY_TAG_ARRAY) + +/* todo: generate faster, unsafe variants */ +#define purs_any_force_int(A) _purs_any_force_int((A), __FILE__, __LINE__) +#define purs_any_force_num(A) _purs_any_force_num((A), __FILE__, __LINE__) +#define purs_any_force_char(A) _purs_any_force_char((A), __FILE__, __LINE__) +#define purs_any_force_foreign(A) _purs_any_force_foreign((A), __FILE__, __LINE__) +#define purs_any_force_cont(A) _purs_any_force_cont((A), __FILE__, __LINE__) +#define purs_any_force_cons(A) _purs_any_force_cons((A), __FILE__, __LINE__) +#define purs_any_force_thunk(A) _purs_any_force_thunk((A), __FILE__, __LINE__) +#define purs_any_force_record(A) _purs_any_force_record((A), __FILE__, __LINE__) +#define purs_any_force_string(A) _purs_any_force_string((A), __FILE__, __LINE__) +#define purs_any_force_array(A) _purs_any_force_array((A), __FILE__, __LINE__) + +/* access the cons tag directly. */ +__PURS_ANY_FORCE_COPY(cons_tag, cons->tag, int, PURS_ANY_TAG_CONS) +#define purs_any_force_cons_tag(A) _purs_any_force_cons_tag((A), __FILE__, __LINE__) // ----------------------------------------------------------------------------- // Any: built-in functions // ----------------------------------------------------------------------------- -static inline int purs_any_eq_char (ANY x, utf8_int32_t y) { +static inline int purs_any_eq_char (ANY x, purs_any_char_t y) { return purs_any_get_char(x) == y; } @@ -382,6 +435,12 @@ ANY purs_any_concat(ANY, ANY); const purs_cont_t * purs_cont_new(const struct purs_scope *, purs_cont_fun_t *); +// ----------------------------------------------------------------------------- +// Data constructors +// ----------------------------------------------------------------------------- + +const purs_cons_t * purs_cons_new(int tag, int size, ...); + // ----------------------------------------------------------------------------- // strings // ----------------------------------------------------------------------------- @@ -502,9 +561,9 @@ struct tco_state { /* Captured scope generation */ struct purs_scope { + struct purs_rc rc; int size; ANY* bindings; - struct purs_rc rc; }; #define purs_scope_binding_at(S, N) ((S)->bindings[(N)]) @@ -600,6 +659,9 @@ struct purs_scope * purs_scope_new1(int size); #define PURS_ANY_CONT(X)\ ((purs_any_t){ .tag = PURS_ANY_TAG_CONT, .value = { .cont = (X) } }) +#define PURS_ANY_CONS(X)\ + ((purs_any_t){ .tag = PURS_ANY_TAG_CONS, .value = { .cons = (X) } }) + /* DEPRECATED: two versions for compat/historical reasons only */ #define purs_any_int PURS_ANY_INT #define purs_any_num PURS_ANY_NUM @@ -608,6 +670,7 @@ struct purs_scope * purs_scope_new1(int size); #define purs_any_array PURS_ANY_ARRAY #define purs_any_record PURS_ANY_RECORD #define purs_any_cont PURS_ANY_CONT +#define purs_any_cons PURS_ANY_CONS #define purs_any_string PURS_ANY_STRING #define purs_any_thunk PURS_ANY_THUNK diff --git a/src/Language/PureScript/CodeGen/C.purs b/src/Language/PureScript/CodeGen/C.purs index 8c25601..7c6456c 100644 --- a/src/Language/PureScript/CodeGen/C.purs +++ b/src/Language/PureScript/CodeGen/C.purs @@ -565,12 +565,8 @@ exprToAst (C.Case (C.Ann { sourceSpan, type: typ }) exprs binders) = do [ AST.IfElse (AST.Binary AST.EqualTo - (AST.App - R.purs_cons_get_tag - [ AST.App - R.purs_any_get_cons - [ AST.Var varName - ] + (AST.App (AST.Var "purs_any_force_cons_tag") + [ AST.Var varName ] ) (AST.Var tag) @@ -602,15 +598,9 @@ exprToAst (C.Constructor _ typeName (C.ProperName constructorName) fields) finalLambda <- do argName <- identToVarName lastArg valuesName <- freshInternalName - assignments <- - traverseWithIndex <@> fields $ \i v -> ado - name <- identToVarName v - in - AST.Assignment - (AST.Indexer - (AST.NumericLiteral (Left i)) - (AST.Var valuesName)) - (AST.Var name) + fieldVars <- + for fields $ \v -> + AST.Var <$> identToVarName v pure $ AST.Function { name: Nothing @@ -620,25 +610,14 @@ exprToAst (C.Constructor _ typeName (C.ProperName constructorName) fields) , returnType: R.any , body: Just $ AST.Block $ - [ AST.VariableIntroduction - { name: valuesName - , type: Type.Pointer R.any - , qualifiers: [] - , initialization: - Just $ - AST.App - R.purs_malloc_any_buf - [ AST.NumericLiteral $ Left $ A.length fields - ] - } - ] <> assignments <> [ - AST.Return $ + [ AST.Return $ AST.App R.purs_any_cons - [ AST.Var $ - safeConstructorName $ - qualifiedVarName moduleName constructorName - , AST.NumericLiteral $ Left $ A.length fields - , AST.Var valuesName + [ AST.App R.purs_cons_new $ + [ AST.Var $ + safeConstructorName $ + qualifiedVarName moduleName constructorName + , AST.NumericLiteral $ Left $ A.length fields + ] <> fieldVars ] ] } @@ -666,12 +645,11 @@ exprToAst (C.Constructor _ typeName (C.ProperName constructorName) _) = do constructorName' = safeConstructorName $ qualifiedVarName moduleName constructorName pure $ - AST.App - R.purs_any_cons - [ AST.Var constructorName' - , AST.NumericLiteral $ Left 0 - , AST.Null - ] + AST.App R.purs_any_cons + [ AST.App R.purs_cons_new + [ AST.Var constructorName' + , AST.NumericLiteral $ Left 0 + ] ] exprToAst (C.App (C.Ann { type: typ }) ident expr) = do f <- exprToAst ident arg <- exprToAst expr diff --git a/src/Language/PureScript/CodeGen/C/Transforms.purs b/src/Language/PureScript/CodeGen/C/Transforms.purs index f973000..3464248 100644 --- a/src/Language/PureScript/CodeGen/C/Transforms.purs +++ b/src/Language/PureScript/CodeGen/C/Transforms.purs @@ -95,6 +95,7 @@ releaseResources = map (map cleanup) <<< traverse (go []) AST.Var "purs_str_new" -> Just stringType AST.Var "purs_record_new_va" -> Just recordType AST.Var "purs_cont_new" -> Just contType + AST.Var "purs_cons_new" -> Just consType AST.Var "purs_indirect_thunk_new" -> Just R.any _ -> Nothing @@ -663,6 +664,9 @@ eraseLambdas moduleName asts = map collapseNestedBlocks <$> , AST.Var contVarName ] +consType :: AST.Type +consType = Type.Pointer (Type.RawType "purs_cons_t" [ Type.Const ]) + contType :: AST.Type contType = Type.Pointer (Type.RawType "purs_cont_t" [ Type.Const ]) diff --git a/src/Language/PureScript/CodeGen/Runtime.purs b/src/Language/PureScript/CodeGen/Runtime.purs index f05e3c6..ce810b7 100644 --- a/src/Language/PureScript/CodeGen/Runtime.purs +++ b/src/Language/PureScript/CodeGen/Runtime.purs @@ -58,6 +58,7 @@ module Language.PureScript.CodeGen.Runtime -- constructors , purs_cons_t + , purs_cons_new , purs_cons_get_tag -- arrays @@ -114,6 +115,9 @@ purs_scope_t = "purs_scope_t" purs_cons_t :: String purs_cons_t = "purs_cons_t" +purs_cons_new :: AST +purs_cons_new = AST.Var "purs_cons_new" + purs_any_num_one :: AST purs_any_num_one = AST.Var "purs_any_num_one" diff --git a/tests/05-datacons/.gitignore b/tests/05-datacons/.gitignore new file mode 100644 index 0000000..30efe19 --- /dev/null +++ b/tests/05-datacons/.gitignore @@ -0,0 +1,10 @@ +/bower_components/ +/node_modules/ +/.pulp-cache/ +/output/ +/generated-docs/ +/.psc-package/ +/.psc* +/.purs* +/.psa* +/.spago diff --git a/tests/05-datacons/Makefile b/tests/05-datacons/Makefile new file mode 100644 index 0000000..b8dc15e --- /dev/null +++ b/tests/05-datacons/Makefile @@ -0,0 +1,12 @@ +default: main +.PHONY: default + +PUREC_DIR := ../.. +include $(PUREC_DIR)/mk/target.mk + +.spago: + spago install +main: .spago + +$(eval $(call purs_mk_target,main,Main,src)) +$(eval $(call purs_mk_target,lib,,src)) diff --git a/tests/05-datacons/packages.dhall b/tests/05-datacons/packages.dhall new file mode 100644 index 0000000..1e24bba --- /dev/null +++ b/tests/05-datacons/packages.dhall @@ -0,0 +1,9 @@ +let mkPackage = ../../package-sets/mkPackage.dhall + +let upstream = ../../package-sets/packages.dhall + +let overrides = {=} + +let additions = {=} + +in upstream ⫽ overrides ⫽ additions diff --git a/tests/05-datacons/spago.dhall b/tests/05-datacons/spago.dhall new file mode 100644 index 0000000..c5daf50 --- /dev/null +++ b/tests/05-datacons/spago.dhall @@ -0,0 +1,9 @@ +{ name = + "purec-test-datacons" +, dependencies = + [] : List Text +, packages = + ./packages.dhall +, sources = + [ "src/**/*.purs", "test/**/*.purs" ] +} diff --git a/tests/05-datacons/src/Main.purs b/tests/05-datacons/src/Main.purs new file mode 100644 index 0000000..e24fe1f --- /dev/null +++ b/tests/05-datacons/src/Main.purs @@ -0,0 +1,38 @@ +module Main where + +data Unit = Unit +type Effect a = Unit -> a +data Maybe a = Just a | Nothing + +chain :: Effect Int -> Effect Int -> Effect Int +chain a b = \_ -> + let x = a Unit + in + case x of + 0 -> b Unit + n -> n + +infixl 5 chain as >> + +const :: ∀ a. a -> (∀ b. b -> a) +const x _ = x + +main :: Effect Int +main = + let + f = const (Just (Just 0)) + g = const Nothing + in (\_ -> + case f 0 of + Just (Just 0) -> 0 + Nothing -> 1 + _ -> 1) + >> (\_ -> + case f 1 of + Just (Just 0) -> 0 + Nothing -> 1 + _ -> 1) + >> (\_ -> + case g 2 of + Nothing -> 0 + Just _ -> 1) From 55d22ba4214a4612a66c975858a0ff5f61113fe3 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Sat, 20 Jul 2019 19:59:17 +1200 Subject: [PATCH 40/67] Ensure record updates are handled correctly --- .../PureScript/CodeGen/C/Transforms.purs | 1 + src/Language/PureScript/CodeGen/Runtime.purs | 4 ---- tests/00-basic/src/Main.purs | 6 +++--- tests/01-partialfuns/src/Main.purs | 16 ++++++++++++++++ 4 files changed, 20 insertions(+), 7 deletions(-) diff --git a/src/Language/PureScript/CodeGen/C/Transforms.purs b/src/Language/PureScript/CodeGen/C/Transforms.purs index 3464248..6d9afba 100644 --- a/src/Language/PureScript/CodeGen/C/Transforms.purs +++ b/src/Language/PureScript/CodeGen/C/Transforms.purs @@ -97,6 +97,7 @@ releaseResources = map (map cleanup) <<< traverse (go []) AST.Var "purs_cont_new" -> Just contType AST.Var "purs_cons_new" -> Just consType AST.Var "purs_indirect_thunk_new" -> Just R.any + AST.Var "purs_record_add_multi" -> Just recordType _ -> Nothing go parentVars = case _ of diff --git a/src/Language/PureScript/CodeGen/Runtime.purs b/src/Language/PureScript/CodeGen/Runtime.purs index ce810b7..ed71ab6 100644 --- a/src/Language/PureScript/CodeGen/Runtime.purs +++ b/src/Language/PureScript/CodeGen/Runtime.purs @@ -74,7 +74,6 @@ module Language.PureScript.CodeGen.Runtime , purs_record_t , purs_record_empty , purs_record_find_by_key - , purs_record_copy_shallow , purs_record_add_multi , purs_record_new_va @@ -178,9 +177,6 @@ purs_record_new_va = AST.Var "purs_record_new_va" purs_record_find_by_key :: AST purs_record_find_by_key = AST.Var "purs_record_find_by_key" -purs_record_copy_shallow :: AST -purs_record_copy_shallow = AST.Var "purs_record_copy_shallow" - purs_record_add_multi :: AST purs_record_add_multi = AST.Var "purs_record_add_multi" diff --git a/tests/00-basic/src/Main.purs b/tests/00-basic/src/Main.purs index 919649d..a456cdb 100644 --- a/tests/00-basic/src/Main.purs +++ b/tests/00-basic/src/Main.purs @@ -22,10 +22,10 @@ testString _ = testRecord :: Effect Int testRecord _ = - let r = { a: 1, b: 2, c: 0 } + let r = { a: 1, b: 2, c: [0] } in - case r of - { a: 1, b: 2, c: 0 } -> + case r { c = [5] } of + { a: 1, b: 2, c: [5] } -> 0 _ -> 1 diff --git a/tests/01-partialfuns/src/Main.purs b/tests/01-partialfuns/src/Main.purs index 5a972ba..769dcc9 100644 --- a/tests/01-partialfuns/src/Main.purs +++ b/tests/01-partialfuns/src/Main.purs @@ -20,6 +20,10 @@ main :: Effect Int main = let f = const [ 0, 1 ] + f' = const [ 2, 3 ] + r = { a: [ f Unit ] } + h = const (\_ -> (r { a = [ f' Unit ] })) + g = h Unit in (\_ -> case f 0 of [ 0, 1 ] -> 0 @@ -32,3 +36,15 @@ main = case f 2 of [ 0, 1 ] -> 0 _ -> 1) + >> (\_ -> + case g 2 of + { a: [ [ 2, 3 ] ] } -> 0 + _ -> 1) + >> (\_ -> + case g 3 of + { a: [ [ 2, 3 ] ] } -> 0 + _ -> 1) + >> (\_ -> + case r of + { a: [ [ 0, 1 ] ] } -> 0 + _ -> 1) From 89010751f9f3a19b7f9493d04f3def4d81b34587 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Sat, 20 Jul 2019 20:01:04 +1200 Subject: [PATCH 41/67] Fix wording in Makefile --- Makefile | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/Makefile b/Makefile index 4ede355..b1abd81 100644 --- a/Makefile +++ b/Makefile @@ -155,11 +155,7 @@ test/tests: @UNIT_TESTING=1 $(MAKE) -s test/tests.0 PHONY: test/tests -# compile each project under 'tests/' as a library, load and execute via -# cmocka. -# note: this necessitates *all* projects under test to: -# + Have a 'lib' target without an entry point in a module called 'Main' -# + Export a 'main' function from module 'Main' +# compile each project under 'tests', run it, and check for leaks using valgrind define mk_test_case test/tests/$(1): @$(MAKE) -s clean From 9f806168febb2ba73f44d753a69840329b987395 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Sat, 20 Jul 2019 21:15:02 +1200 Subject: [PATCH 42/67] Work towards stitching up upstream tests using Spago --- Makefile | 3 +- package-sets/packages.dhall | 140 +++++++++++++++++++++++- package.json | 3 +- test/Upstream.purs | 9 +- upstream/tests/support/.gitignore | 10 ++ upstream/tests/support/psc-package.json | 39 ------- upstream/tests/support/spago.dhall | 41 +++++++ 7 files changed, 196 insertions(+), 49 deletions(-) create mode 100644 upstream/tests/support/.gitignore delete mode 100644 upstream/tests/support/psc-package.json create mode 100644 upstream/tests/support/spago.dhall diff --git a/Makefile b/Makefile index b1abd81..8da0962 100644 --- a/Makefile +++ b/Makefile @@ -7,6 +7,7 @@ SHELLFLAGS := -eo pipefail PURS := PATH=$$PATH:node_modules/.bin purs PULP := PATH=$$PATH:node_modules/.bin pulp +SPAGO := PATH=$$PATH:node_modules/.bin spago PUREC_JS := purec.js PUREC := node $(PUREC_JS) @@ -209,7 +210,7 @@ test/tests/main.0: done .PHONY: test/tests/main.0 -test/upstream: upstream/tests/support/bower_components +test/upstream: @$(MAKE) -s clean @$(PULP) test > /dev/null .PHONY: test/pulp diff --git a/package-sets/packages.dhall b/package-sets/packages.dhall index 48112bb..66bac9b 100644 --- a/package-sets/packages.dhall +++ b/package-sets/packages.dhall @@ -3,15 +3,147 @@ let mkPackage = ./mkPackage.dhall let upstream = https://raw.githubusercontent.com/purescript/package-sets/psc-0.12.5/src/packages.dhall sha256:aee7258b1bf1b81ed5e22d1247e812a80ec2e879758562f33334512ed086c5ae -let overrides = +let filter = https://prelude.dhall-lang.org/List/filter + +let packages = { effect = upstream.effect // { repo = "/home/felix/projects/pure-c/purescript-effect" } , prelude = upstream.prelude // { repo = "/home/felix/projects/pure-c/purescript-prelude" } + , arrays = + upstream.arrays + // { repo = "https://github.com/pure-c/purescript-arrays.git" } + , assert = + upstream.assert + // { repo = "https://github.com/pure-c/purescript-assert.git" } + , bifunctors = + upstream.bifunctors + // { repo = + "https://github.com/purescript/purescript-bifunctors.git" + } + , console = + upstream.console + // { repo = "https://github.com/pure-c/purescript-console.git" } + , control = + upstream.control + // { repo = "https://github.com/pure-c/purescript-control.git" } + , distributive = + upstream.distributive + // { repo = + "https://github.com/purescript/purescript-distributive.git" + } + , either = + upstream.either + // { repo = "https://github.com/purescript/purescript-either.git" } + , enums = + upstream.enums + // { repo = "https://github.com/pure-c/purescript-enums.git" } + , foldable-traversable = + upstream.foldable-traversable + // { repo = + "https://github.com/pure-c/purescript-foldable-traversable.git" + } + , functions = + upstream.functions + // { repo = "https://github.com/pure-c/purescript-functions.git" } + , gen = + upstream.gen + // { repo = "https://github.com/purescript/purescript-gen.git" } + , generics-rep = + upstream.generics-rep + // { repo = + "https://github.com/purescript/purescript-generics-rep.git" + } + , identity = + upstream.identity + // { repo = "https://github.com/purescript/purescript-identity.git" } + , integers = + { repo = + "https://github.com/pure-c/purescript-integers" + , version = + "c" + , dependencies = + [ "math", "maybe", "prelude" ] + } + , invariant = + upstream.invariant + // { repo = + "https://github.com/purescript/purescript-invariant.git" + } + , lazy = + upstream.lazy + // { repo = "https://github.com/pure-c/purescript-lazy.git" } + , lists = + upstream.lists + // { repo = "https://github.com/purescript/purescript-lists.git" } + , math = + upstream.math + // { repo = + "https://github.com/pure-c/purescript-math.git" + , version = + "purescript-integers" + } + , maybe = + upstream.maybe + // { repo = "https://github.com/purescript/purescript-maybe.git" } + , newtype = + upstream.newtype + // { repo = "https://github.com/purescript/purescript-newtype.git" } + , nonempty = + upstream.nonempty + // { repo = "https://github.com/purescript/purescript-nonempty.git" } + , orders = + upstream.orders + // { repo = "https://github.com/purescript/purescript-orders.git" } + , partial = + upstream.partial + // { repo = "https://github.com/pure-c/purescript-partial.git" } + , proxy = + upstream.proxy + // { repo = "https://github.com/purescript/purescript-proxy.git" } + , record = + upstream.record + // { repo = "https://github.com/pure-c/purescript-record.git" } + , refs = + upstream.refs + // { repo = "https://github.com/pure-c/purescript-refs.git" } + , st = + upstream.st + // { repo = "https://github.com/pure-c/purescript-st.git" } + , tailrec = + upstream.tailrec + // { repo = "https://github.com/purescript/purescript-tailrec.git" } + , transformers = + upstream.transformers + // { repo = + "https://github.com/purescript/purescript-transformers.git" + } + , tuples = + upstream.tuples + // { repo = "https://github.com/purescript/purescript-tuples.git" } + , type-equality = + upstream.type-equality + // { repo = + "https://github.com/purescript/purescript-type-equality.git" + } + , typelevel-prelude = + upstream.typelevel-prelude + // { repo = + "https://github.com/purescript/purescript-typelevel-prelude.git" + } + , unfoldable = + upstream.unfoldable + // { repo = "https://github.com/pure-c/purescript-unfoldable.git" } + , unsafe-coerce = + upstream.unsafe-coerce + // { repo = + "https://github.com/pure-c/purescript-unsafe-coerce.git" + } + , variant = + upstream.variant + // { repo = "https://github.com/natefaubion/purescript-variant.git" } } -let additions = {=} - -in upstream // overrides // additions +in packages diff --git a/package.json b/package.json index 4e5be40..279ba41 100644 --- a/package.json +++ b/package.json @@ -16,7 +16,8 @@ "devDependencies": { "bower": "^1.8.4", "pulp": "^12.3.0", - "purescript": "^0.12.5" + "purescript": "^0.12.5", + "spago": "^0.8.5" }, "scripts": { "test": "echo \"Error: no test specified\" && exit 1", diff --git a/test/Upstream.purs b/test/Upstream.purs index 3addcbd..1612f96 100644 --- a/test/Upstream.purs +++ b/test/Upstream.purs @@ -79,15 +79,16 @@ default: premain PUREC_DIR := ../.. include $(PUREC_DIR)/mk/target.mk - +SPAGO := PATH=$$PATH:$(PUREC_DIR)/node_modules/.bin spago +PURS := PATH=$$PATH:$(PUREC_DIR)/node_modules/.bin purs SHELL := /bin/bash - srcs := $(addprefix ../../,$(shell cat sources)) premain: $(srcs) @touch $^ || { :; } - @cp "$(PUREC_DIR)"/upstream/tests/support/psc-package.json . - @psc-package install + @cp "$(PUREC_DIR)"/package-sets/* . + @cp "$(PUREC_DIR)"/upstream/tests/support/spago.dhall . + @$(SPAGO) install @$(MAKE) -s main $(eval $(call purs_mk_target,main,Main,$(srcs))) diff --git a/upstream/tests/support/.gitignore b/upstream/tests/support/.gitignore new file mode 100644 index 0000000..30efe19 --- /dev/null +++ b/upstream/tests/support/.gitignore @@ -0,0 +1,10 @@ +/bower_components/ +/node_modules/ +/.pulp-cache/ +/output/ +/generated-docs/ +/.psc-package/ +/.psc* +/.purs* +/.psa* +/.spago diff --git a/upstream/tests/support/psc-package.json b/upstream/tests/support/psc-package.json deleted file mode 100644 index edf0f25..0000000 --- a/upstream/tests/support/psc-package.json +++ /dev/null @@ -1,39 +0,0 @@ -{ - "name": "purec-testcase", - "set": "master", - "source": "https://github.com/pure-c/package-sets", - "depends": [ - "arrays", - "assert", - "bifunctors", - "console", - "control", - "distributive", - "effect", - "either", - "foldable-traversable", - "functions", - "gen", - "generics-rep", - "identity", - "integers", - "invariant", - "lazy", - "lists", - "math", - "maybe", - "newtype", - "nonempty", - "partial", - "prelude", - "proxy", - "refs", - "st", - "tailrec", - "tuples", - "type-equality", - "typelevel-prelude", - "unfoldable", - "unsafe-coerce" - ] -} diff --git a/upstream/tests/support/spago.dhall b/upstream/tests/support/spago.dhall new file mode 100644 index 0000000..9f4598c --- /dev/null +++ b/upstream/tests/support/spago.dhall @@ -0,0 +1,41 @@ +{ name = + "support" +, dependencies = + [ "arrays" + , "assert" + , "bifunctors" + , "console" + , "control" + , "distributive" + , "effect" + , "either" + , "foldable-traversable" + , "functions" + , "gen" + , "generics-rep" + , "identity" + , "integers" + , "invariant" + , "lazy" + , "lists" + , "math" + , "maybe" + , "newtype" + , "nonempty" + , "partial" + , "prelude" + , "proxy" + , "refs" + , "st" + , "tailrec" + , "tuples" + , "type-equality" + , "typelevel-prelude" + , "unfoldable" + , "unsafe-coerce" + ] +, packages = + ./packages.dhall +, sources = + [ "src/**/*.purs", "test/**/*.purs" ] +} From cd3afc000e63114120d41e1d436fe1e04a877c67 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Tue, 23 Jul 2019 17:50:24 +1200 Subject: [PATCH 43/67] Add test for type classes --- Makefile | 3 +- runtime/purescript.c | 8 ++--- runtime/purescript.h | 1 + src/Language/PureScript/CodeGen/C.purs | 6 ++-- .../PureScript/CodeGen/C/Transforms.purs | 1 + src/Language/PureScript/CodeGen/Runtime.purs | 4 +++ tests/06-typeclasses/.gitignore | 10 +++++++ tests/06-typeclasses/Makefile | 12 ++++++++ tests/06-typeclasses/packages.dhall | 9 ++++++ tests/06-typeclasses/spago.dhall | 9 ++++++ tests/06-typeclasses/src/Main.purs | 23 +++++++++++++++ tests/10-prelude/src/Main.h | 6 ++-- tests/10-prelude/src/Main.purs | 29 ++++++++++--------- 13 files changed, 97 insertions(+), 24 deletions(-) create mode 100644 tests/06-typeclasses/.gitignore create mode 100644 tests/06-typeclasses/Makefile create mode 100644 tests/06-typeclasses/packages.dhall create mode 100644 tests/06-typeclasses/spago.dhall create mode 100644 tests/06-typeclasses/src/Main.purs diff --git a/Makefile b/Makefile index 8da0962..d48b128 100644 --- a/Makefile +++ b/Makefile @@ -32,7 +32,8 @@ TESTS = \ 01-partialfuns \ 04-memory \ 05-datacons \ - 03-mutrec + 06-typeclasses \ + 10-prelude ifdef WITH_GC CFLAGS += \ diff --git a/runtime/purescript.c b/runtime/purescript.c index da0b86b..0dbb488 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -264,7 +264,7 @@ static void purs_vec_free(const struct purs_rc *ref) { purs_free(x); } -static inline purs_vec_t * purs_vec_new() { +const purs_vec_t * purs_vec_new() { purs_vec_t * o = purs_new(purs_vec_t); o->data = NULL; o->length = 0; @@ -292,7 +292,7 @@ const purs_vec_t * purs_vec_concat(const purs_vec_t * lhs, return NULL; } else { int length = lhs->length + rhs->length; - purs_vec_t * o = purs_vec_new(); + purs_vec_t * o = (purs_vec_t *) purs_vec_new(); o->data = vec_malloc(sizeof (ANY) * length); o->length = length; o->capacity = length; @@ -310,7 +310,7 @@ const purs_vec_t * purs_vec_new_va (int count, ...) { return NULL; } - purs_vec_t * o = purs_vec_new(); + purs_vec_t * o = (purs_vec_t *) purs_vec_new(); o->data = vec_malloc(sizeof (ANY) * count); o->length = count; @@ -331,7 +331,7 @@ static const purs_vec_t * _purs_vec_copy (const purs_vec_t * vec) { if (purs_vec_is_empty(vec)) { return NULL; } else { - purs_vec_t * o = purs_vec_new(); + purs_vec_t * o = (purs_vec_t *) purs_vec_new(); o->length = vec->length; o->capacity = vec->capacity; o->data = vec_malloc(sizeof (ANY) * vec->capacity); diff --git a/runtime/purescript.h b/runtime/purescript.h index dc8785e..ec8e40a 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -455,6 +455,7 @@ const void * purs_string_copy (const void *); // arrays // ----------------------------------------------------------------------------- +const purs_vec_t * purs_vec_new (); const purs_vec_t * purs_vec_new_va (int count, ...); const purs_vec_t * purs_vec_copy (const purs_vec_t *); const purs_vec_t * purs_vec_splice (const purs_vec_t *, int start, int count); diff --git a/src/Language/PureScript/CodeGen/C.purs b/src/Language/PureScript/CodeGen/C.purs index 7c6456c..53f3e5e 100644 --- a/src/Language/PureScript/CodeGen/C.purs +++ b/src/Language/PureScript/CodeGen/C.purs @@ -492,7 +492,7 @@ exprToAst (C.Case (C.Ann { sourceSpan, type: typ }) exprs binders) = do AST.App R.purs_derefence [ AST.App R.purs_record_find_by_key [ AST.App - R.purs_any_get_record + R.purs_any_force_record [ AST.Var varName ] , AST.StringLiteral prop ] @@ -679,7 +679,7 @@ exprToAst (C.Accessor _ k exp) = ado AST.App R.purs_derefence [ AST.App R.purs_record_find_by_key [ AST.App - R.purs_any_get_record + R.purs_any_force_record [ valueAst ] , AST.StringLiteral k ] @@ -691,7 +691,7 @@ exprToAst (C.ObjectUpdate _ o ps) = ado in AST.App R.purs_any_record [ AST.App R.purs_record_add_multi $ - [ AST.App R.purs_any_get_record [ valueAst ] + [ AST.App R.purs_any_force_record [ valueAst ] , AST.NumericLiteral (Left $ A.length sts) ] <> do A.concat $ sts <#> \(n /\ v) -> diff --git a/src/Language/PureScript/CodeGen/C/Transforms.purs b/src/Language/PureScript/CodeGen/C/Transforms.purs index 6d9afba..b15eb7b 100644 --- a/src/Language/PureScript/CodeGen/C/Transforms.purs +++ b/src/Language/PureScript/CodeGen/C/Transforms.purs @@ -98,6 +98,7 @@ releaseResources = map (map cleanup) <<< traverse (go []) AST.Var "purs_cons_new" -> Just consType AST.Var "purs_indirect_thunk_new" -> Just R.any AST.Var "purs_record_add_multi" -> Just recordType + AST.Var "purs_any_force_record" -> Just recordType _ -> Nothing go parentVars = case _ of diff --git a/src/Language/PureScript/CodeGen/Runtime.purs b/src/Language/PureScript/CodeGen/Runtime.purs index ed71ab6..afcb588 100644 --- a/src/Language/PureScript/CodeGen/Runtime.purs +++ b/src/Language/PureScript/CodeGen/Runtime.purs @@ -15,6 +15,7 @@ module Language.PureScript.CodeGen.Runtime , purs_any_get_foreign , purs_any_get_record , purs_any_get_array + , purs_any_force_record , purs_any_true , purs_any_false , purs_any_null @@ -162,6 +163,9 @@ purs_any_get_cons = AST.Var "purs_any_get_cons" purs_any_get_record :: AST purs_any_get_record = AST.Var "purs_any_get_record" +purs_any_force_record :: AST +purs_any_force_record = AST.Var "purs_any_force_record" + purs_any_get_array :: AST purs_any_get_array = AST.Var "purs_any_get_array" diff --git a/tests/06-typeclasses/.gitignore b/tests/06-typeclasses/.gitignore new file mode 100644 index 0000000..30efe19 --- /dev/null +++ b/tests/06-typeclasses/.gitignore @@ -0,0 +1,10 @@ +/bower_components/ +/node_modules/ +/.pulp-cache/ +/output/ +/generated-docs/ +/.psc-package/ +/.psc* +/.purs* +/.psa* +/.spago diff --git a/tests/06-typeclasses/Makefile b/tests/06-typeclasses/Makefile new file mode 100644 index 0000000..b8dc15e --- /dev/null +++ b/tests/06-typeclasses/Makefile @@ -0,0 +1,12 @@ +default: main +.PHONY: default + +PUREC_DIR := ../.. +include $(PUREC_DIR)/mk/target.mk + +.spago: + spago install +main: .spago + +$(eval $(call purs_mk_target,main,Main,src)) +$(eval $(call purs_mk_target,lib,,src)) diff --git a/tests/06-typeclasses/packages.dhall b/tests/06-typeclasses/packages.dhall new file mode 100644 index 0000000..1e24bba --- /dev/null +++ b/tests/06-typeclasses/packages.dhall @@ -0,0 +1,9 @@ +let mkPackage = ../../package-sets/mkPackage.dhall + +let upstream = ../../package-sets/packages.dhall + +let overrides = {=} + +let additions = {=} + +in upstream ⫽ overrides ⫽ additions diff --git a/tests/06-typeclasses/spago.dhall b/tests/06-typeclasses/spago.dhall new file mode 100644 index 0000000..c5daf50 --- /dev/null +++ b/tests/06-typeclasses/spago.dhall @@ -0,0 +1,9 @@ +{ name = + "purec-test-datacons" +, dependencies = + [] : List Text +, packages = + ./packages.dhall +, sources = + [ "src/**/*.purs", "test/**/*.purs" ] +} diff --git a/tests/06-typeclasses/src/Main.purs b/tests/06-typeclasses/src/Main.purs new file mode 100644 index 0000000..066d43e --- /dev/null +++ b/tests/06-typeclasses/src/Main.purs @@ -0,0 +1,23 @@ +module Main where + +data Unit = Unit +type Effect a = Unit -> a + +chain :: Effect Int -> Effect Int -> Effect Int +chain a b = \_ -> + let x = a Unit + in + case x of + 0 -> b Unit + n -> n + +infixl 5 chain as >> + +class Foo a where + foo :: a -> { bar :: a } + +instance fooInt :: Foo Int where + foo i = { bar: i } + +main :: Effect Int +main _ = (foo 0).bar diff --git a/tests/10-prelude/src/Main.h b/tests/10-prelude/src/Main.h index f9ff507..5274928 100644 --- a/tests/10-prelude/src/Main.h +++ b/tests/10-prelude/src/Main.h @@ -3,8 +3,10 @@ #include -PURS_FFI_FUNC_2(Main_putStrLn, s, _, { - printf("%s\n", purs_any_get_string(s)); +PURS_FFI_FUNC_2(Main_putStrLn, s_, _, { + const purs_str_t * s = purs_any_force_string(s_); + printf("%s\n", s->data); + PURS_RC_RELEASE(s); return purs_any_int_zero; }); diff --git a/tests/10-prelude/src/Main.purs b/tests/10-prelude/src/Main.purs index c146c83..6453351 100644 --- a/tests/10-prelude/src/Main.purs +++ b/tests/10-prelude/src/Main.purs @@ -30,25 +30,26 @@ main = let x = pureE 5 y = pureE 2 - z = pureE $ runE x * runE y a = pureE $ runE x + runE y + z = pureE $ runE x * runE y b = pureE $ runE x - runE y c = pureE $ runE x / runE y in - check (runE z == 10) + check (runE x == 5) >> check (runE a == 7) >> check (runE b == 3) >> check (runE c == 2) >> check (show ([] :: Array Int) == "[]") - >> check (show [ 99 ] == "[99]") - >> check (show [ 1, 2, 3 ] == "[1, 2, 3]") - >> check (show "" == "\"\"") - >> check (show "\"" == "\"\"\"") - >> check (show {} == "{}") - >> check (show { a: [ 1 ] } == "{ a: [1] }") - >> check ([ 1, 2, 3 ] == [ 1, 2, 3 ]) - >> check (map show [ 1, 2, 3 ] == [ "1", "2", "3" ]) - >> check (show (map show [ 1, 2, 3 ]) == "[\"1\", \"2\", \"3\"]") - >> check (map (_ * 3) [ 1, 2, 3 ] == [ 3, 6, 9 ]) - >> check (pure 3 == [ 3 ]) - >> check (map identity ([] :: Array Int) == []) + >> putStrLn (show ([] :: Array Int)) + -- >> check (show [ 99 ] == "[99]") + -- >> check (show [ 1, 2, 3 ] == "[1, 2, 3]") + -- >> check (show "" == "\"\"") + -- >> check (show "\"" == "\"\"\"") + -- >> check (show {} == "{}") + -- >> check (show { a: [ 1 ] } == "{ a: [1] }") + -- >> check ([ 1, 2, 3 ] == [ 1, 2, 3 ]) + -- >> check (map show [ 1, 2, 3 ] == [ "1", "2", "3" ]) + -- >> check (show (map show [ 1, 2, 3 ]) == "[\"1\", \"2\", \"3\"]") + -- >> check (map (_ * 3) [ 1, 2, 3 ] == [ 3, 6, 9 ]) + -- >> check (pure 3 == [ 3 ]) + -- >> check (map identity ([] :: Array Int) == []) From e587fc04592b9a0d901a14e1727a922b97470c26 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Tue, 23 Jul 2019 17:51:19 +1200 Subject: [PATCH 44/67] Work towards a passing 10-prelude test --- mk/target.mk | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/mk/target.mk b/mk/target.mk index 7744a11..0a490a8 100644 --- a/mk/target.mk +++ b/mk/target.mk @@ -113,8 +113,9 @@ $$(PUREC_WORKDIR)/$(1)/.genc.1: $$(patsubst %,%.1,$$(call rwildcard,$$(PUREC_WOR $$(PUREC_WORKDIR)/$(1)/.build: \ $(PUREC_LIB) \ $$(patsubst %.c,%.o,$$(wildcard $$(PUREC_WORKDIR)/$(1)/*.c)) - @$(CLANG) $$^ \ + $(CLANG) $$^ \ -L $(PUREC_LIB_DIR) \ + -L $(PUREC_LIB_DIR)/runtime \ -lpurec \ -lm \ -ffunction-sections \ From 4a3ddcb52f5574b927325589908a81abd93457d0 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Tue, 23 Jul 2019 17:51:40 +1200 Subject: [PATCH 45/67] Freeze packages.dhall to speed up builds --- package-sets/packages.dhall | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/package-sets/packages.dhall b/package-sets/packages.dhall index 66bac9b..b420937 100644 --- a/package-sets/packages.dhall +++ b/package-sets/packages.dhall @@ -3,7 +3,8 @@ let mkPackage = ./mkPackage.dhall let upstream = https://raw.githubusercontent.com/purescript/package-sets/psc-0.12.5/src/packages.dhall sha256:aee7258b1bf1b81ed5e22d1247e812a80ec2e879758562f33334512ed086c5ae -let filter = https://prelude.dhall-lang.org/List/filter +let filter = + https://prelude.dhall-lang.org/List/filter sha256:8ebfede5bbfe09675f246c33eb83964880ac615c4b1be8d856076fdbc4b26ba6 let packages = { effect = From ed7f9068a69022f794aa64af6a3e0496f2b0b292 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Wed, 24 Jul 2019 09:16:49 +1200 Subject: [PATCH 46/67] Fix 10-prelude test, update to purs 0.13.2, fix FFI_FUNC seg-fault --- Makefile | 3 +++ ctests/main.c | 12 +++++++++ mk/target.mk | 9 +++++-- package-sets/packages.dhall | 2 +- package.json | 2 +- packages.dhall | 4 +-- runtime/purescript.c | 1 + runtime/purescript.h | 18 ++++++++++--- src/Language/PureScript/CodeGen/C.purs | 7 +++--- .../CodeGen/C/Optimizer/Inliner.purs | 4 +-- .../PureScript/CodeGen/C/Optimizer/TCO.purs | 2 +- src/Language/PureScript/CodeGen/C/Pretty.purs | 20 +++++++-------- .../PureScript/CodeGen/C/Transforms.purs | 4 +-- src/Main.purs | 4 +-- test/Main.purs | 10 +++++--- tests/00-basic/Makefile | 4 --- tests/01-partialfuns/Makefile | 4 --- tests/02-foreign/Makefile | 4 --- tests/03-mutrec/Makefile | 4 --- tests/04-memory/Makefile | 4 --- tests/05-datacons/Makefile | 4 --- tests/06-typeclasses/Makefile | 4 --- tests/10-prelude/Makefile | 5 ++-- tests/10-prelude/src/Main.h | 1 - tests/10-prelude/src/Main.purs | 25 +++++++++---------- 25 files changed, 83 insertions(+), 78 deletions(-) diff --git a/Makefile b/Makefile index d48b128..1d4d48f 100644 --- a/Makefile +++ b/Makefile @@ -141,6 +141,7 @@ test/c.0: @$(CLANG) \ -g \ -I. \ + -Iruntime \ -L. \ ctests/main.c \ -lpurec \ @@ -175,10 +176,12 @@ test/tests/$(1).0: $(CLANG) \ -g \ -I. \ + -I../../runtime \ -I../.. \ -L../.. \ ./.purec-work/main/*.c \ -lpurec \ + -lm \ -lcmocka \ -o a.out > /dev/null @echo "tests/$(1): run ouput" diff --git a/ctests/main.c b/ctests/main.c index 3d4ae4f..7a9bb24 100644 --- a/ctests/main.c +++ b/ctests/main.c @@ -279,6 +279,17 @@ static void purs_indirect_value_test(void **state) { purs_indirect_value_free(ivalue); } +static void purs_string_test(void **state) { + (void) state; /* unused */ + const purs_str_t * x = purs_str_new("test"); + ANY y = purs_any_string(x); + const purs_str_t * z = purs_any_force_string(y); + assert_string_equal("test", z->data); + PURS_RC_RELEASE(z); + assert_string_equal("test", x->data); + PURS_RC_RELEASE(x); +} + int main (void) { const struct CMUnitTest tests[] = { cmocka_unit_test(leak_string_test), @@ -291,6 +302,7 @@ int main (void) { cmocka_unit_test(purs_indirect_value_test), cmocka_unit_test(purs_indirect_thunk_test), cmocka_unit_test(purs_cons_test), + cmocka_unit_test(purs_string_test), }; return cmocka_run_group_tests(tests, NULL, NULL); diff --git a/mk/target.mk b/mk/target.mk index 0a490a8..7d4ff27 100644 --- a/mk/target.mk +++ b/mk/target.mk @@ -25,6 +25,9 @@ else LD_LINKER_FLAGS += -gc-sections endif +.spago: + spago install + ## Not all environments support globstar (** dir pattern) rwildcard=$(wildcard $1$2) $(foreach d,$(wildcard $1*),$(call rwildcard,$d/,$2)) @@ -116,10 +119,12 @@ $$(PUREC_WORKDIR)/$(1)/.build: \ $(CLANG) $$^ \ -L $(PUREC_LIB_DIR) \ -L $(PUREC_LIB_DIR)/runtime \ + $($(1)_CFLAGS) \ -lpurec \ -lm \ -ffunction-sections \ $(LD_FLAGS) \ + $($(1)_LD_FLAGS) \ -Wl,$(LD_LINKER_FLAGS) \ -o "$(1).out" @touch $$@ @@ -128,11 +133,11 @@ $$(PUREC_WORKDIR)/$(1)/.build: \ _$(1): $$(PUREC_WORKDIR)/$(1)/.genc @$$(MAKE) -s $$(PUREC_WORKDIR)/$(1)/.build -$(1): +$(1): .spago @$$(MAKE) -s _$(1) .PHONY: $(1) -$(1)/c: +$(1)/c: .spago @$$(MAKE) -s $$(PUREC_WORKDIR)/$(1)/.genc .PHONY: $(1)/c endef diff --git a/package-sets/packages.dhall b/package-sets/packages.dhall index b420937..a9c55ed 100644 --- a/package-sets/packages.dhall +++ b/package-sets/packages.dhall @@ -1,7 +1,7 @@ let mkPackage = ./mkPackage.dhall let upstream = - https://raw.githubusercontent.com/purescript/package-sets/psc-0.12.5/src/packages.dhall sha256:aee7258b1bf1b81ed5e22d1247e812a80ec2e879758562f33334512ed086c5ae + https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.2/src/packages.dhall sha256:906af79ba3aec7f429b107fd8d12e8a29426db8229d228c6f992b58151e2308e let filter = https://prelude.dhall-lang.org/List/filter sha256:8ebfede5bbfe09675f246c33eb83964880ac615c4b1be8d856076fdbc4b26ba6 diff --git a/package.json b/package.json index 279ba41..e73c18a 100644 --- a/package.json +++ b/package.json @@ -16,7 +16,7 @@ "devDependencies": { "bower": "^1.8.4", "pulp": "^12.3.0", - "purescript": "^0.12.5", + "purescript": "^0.13.2", "spago": "^0.8.5" }, "scripts": { diff --git a/packages.dhall b/packages.dhall index 4d23a39..8bf7503 100644 --- a/packages.dhall +++ b/packages.dhall @@ -1,8 +1,8 @@ let mkPackage = - https://raw.githubusercontent.com/purescript/package-sets/psc-0.12.5/src/mkPackage.dhall sha256:0b197efa1d397ace6eb46b243ff2d73a3da5638d8d0ac8473e8e4a8fc528cf57 + https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.2/src/mkPackage.dhall sha256:0b197efa1d397ace6eb46b243ff2d73a3da5638d8d0ac8473e8e4a8fc528cf57 let upstream = - https://raw.githubusercontent.com/purescript/package-sets/psc-0.12.5/src/packages.dhall sha256:aee7258b1bf1b81ed5e22d1247e812a80ec2e879758562f33334512ed086c5ae + https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.2/src/packages.dhall sha256:906af79ba3aec7f429b107fd8d12e8a29426db8229d228c6f992b58151e2308e let overrides = {=} diff --git a/runtime/purescript.c b/runtime/purescript.c index 0dbb488..74e770e 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -342,6 +342,7 @@ static const purs_vec_t * _purs_vec_copy (const purs_vec_t * vec) { const purs_vec_t * purs_vec_copy (const purs_vec_t * vec) { const purs_vec_t * copy = _purs_vec_copy(vec); + if (copy == NULL) return NULL /* empty */; for (int i = 0; i < copy->length; i++) { PURS_ANY_RETAIN(copy->data[i]); } diff --git a/runtime/purescript.h b/runtime/purescript.h index ec8e40a..0cae680 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -404,7 +404,17 @@ __PURS_ANY_FORCE_RETAIN(array, array, const purs_vec_t *, PURS_ANY_TAG_ARRAY) /* access the cons tag directly. */ __PURS_ANY_FORCE_COPY(cons_tag, cons->tag, int, PURS_ANY_TAG_CONS) -#define purs_any_force_cons_tag(A) _purs_any_force_cons_tag((A), __FILE__, __LINE__) +#define purs_any_force_cons_tag(A) \ + _purs_any_force_cons_tag((A), __FILE__, __LINE__) + +__PURS_ANY_FORCE_COPY(array_length,\ + array == NULL\ + ? 0\ + : v.value.array->length,\ + int,\ + PURS_ANY_TAG_ARRAY) +#define purs_any_force_array_length(A) \ + _purs_any_force_array_length((A), __FILE__, __LINE__) // ----------------------------------------------------------------------------- // Any: built-in functions @@ -461,7 +471,8 @@ const purs_vec_t * purs_vec_copy (const purs_vec_t *); const purs_vec_t * purs_vec_splice (const purs_vec_t *, int start, int count); const purs_vec_t * purs_vec_concat(const purs_vec_t * lhs, const purs_vec_t * rhs); -#define purs_vec_foreach(v, var, iter) vec_foreach(v, var, iter) +#define purs_vec_length(v) ((v == NULL) ? 0 : v->length) +#define purs_vec_foreach(v, var, iter) if (v != NULL) vec_foreach(v, var, iter) #define purs_vec_reserve(v, n) vec_reserve(v, n) #define purs_vec_push_mut(v, x) vec_push(v, x) #define purs_vec_pusharr_mut(v, arr, count) vec_pusharr(v, arr, count) @@ -760,10 +771,11 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { $__super__->bindings,\ $__super__->size * sizeof (ANY));\ for (int i = 0; i < $__super__->size; i++) {\ - PURS_ANY_RETAIN($__super__->bindings[i]);\ + PURS_ANY_RETAIN(scope->bindings[i]);\ }\ }\ scope->bindings[CUR - 1] = a;\ + PURS_ANY_RETAIN(scope->bindings[CUR - 1]);\ const purs_cont_t * cont = purs_cont_new(scope, NAME##__##NEXT);\ PURS_RC_RELEASE(scope);\ return purs_any_cont(cont);\ diff --git a/src/Language/PureScript/CodeGen/C.purs b/src/Language/PureScript/CodeGen/C.purs index 53f3e5e..ef11133 100644 --- a/src/Language/PureScript/CodeGen/C.purs +++ b/src/Language/PureScript/CodeGen/C.purs @@ -159,7 +159,7 @@ bindToAst isTopLevel (C.Rec vals) = ado let asts' = asts <#> case _ of - ast@AST.VariableIntroduction { name, type: typ, initialization: Just init } + ast@(AST.VariableIntroduction { name, type: typ, initialization: Just init }) | not (isInternalVariable name) -> { indirInit: Just $ @@ -464,9 +464,8 @@ exprToAst (C.Case (C.Ann { sourceSpan, type: typ }) exprs binders) = do [ AST.IfElse (AST.Binary AST.EqualTo - (AST.Accessor - (AST.Raw "length") - (AST.App R.purs_any_get_array [ AST.Var varName ])) + (AST.App (AST.Var "purs_any_force_array_length") + [ AST.Var varName ]) (AST.NumericLiteral $ Left (A.length binders))) (AST.Block ast) Nothing diff --git a/src/Language/PureScript/CodeGen/C/Optimizer/Inliner.purs b/src/Language/PureScript/CodeGen/C/Optimizer/Inliner.purs index f71c6da..163b427 100644 --- a/src/Language/PureScript/CodeGen/C/Optimizer/Inliner.purs +++ b/src/Language/PureScript/CodeGen/C/Optimizer/Inliner.purs @@ -110,10 +110,10 @@ inlineVariables = AST.everywhereM pure $ A.reverse acc Just ({ head: - head@AST.VariableIntroduction + head@(AST.VariableIntroduction { name , initialization: Just ast - } + }) , tail }) -> do canBeInlined <- diff --git a/src/Language/PureScript/CodeGen/C/Optimizer/TCO.purs b/src/Language/PureScript/CodeGen/C/Optimizer/TCO.purs index 8f2d7af..743c3ea 100644 --- a/src/Language/PureScript/CodeGen/C/Optimizer/TCO.purs +++ b/src/Language/PureScript/CodeGen/C/Optimizer/TCO.purs @@ -27,7 +27,7 @@ tco = AST.everywhere convert convert x@(AST.App (AST.Var "purs_indirect_value_assign") - [ v@(AST.Var internalIdent), (fn@AST.Function _) + [ v@(AST.Var internalIdent), (fn@(AST.Function _)) ]) | Just name <- Str.stripPrefix (wrap "$_indirect_") internalIdent = let diff --git a/src/Language/PureScript/CodeGen/C/Pretty.purs b/src/Language/PureScript/CodeGen/C/Pretty.purs index d71034c..f80a09c 100644 --- a/src/Language/PureScript/CodeGen/C/Pretty.purs +++ b/src/Language/PureScript/CodeGen/C/Pretty.purs @@ -329,16 +329,16 @@ withNextIndent = local (\st -> st { indent = st.indent + 2 }) encodeChar :: Char -> String -encodeChar '\0' = "\\0" -encodeChar '\b' = "\\b" -encodeChar '\t' = "\\t" -encodeChar '\n' = "\\n" -encodeChar '\v' = "\\v" -encodeChar '\f' = "\\f" -encodeChar '\r' = "\\r" -encodeChar '"' = "\\\"" -encodeChar '\'' = "\\'" -encodeChar '\\' = "\\\\" +encodeChar '\x00' = "\\0" +encodeChar '\x08' = "\\b" +encodeChar '\x09' = "\\t" +encodeChar '\x0A' = "\\n" +encodeChar '\x0B' = "\\v" +encodeChar '\x0C' = "\\f" +encodeChar '\x0D' = "\\r" +encodeChar '"' = "\\\"" +encodeChar '\x27' = "\\'" +encodeChar '\x57' = "\\\\" -- TODO (implement: ctrl chrs): -- encodeChar c | isControl c = T.pack $ "\\x" ++ showHex (fromEnum c) "" encodeChar c = CodeUnits.singleton c diff --git a/src/Language/PureScript/CodeGen/C/Transforms.purs b/src/Language/PureScript/CodeGen/C/Transforms.purs index b15eb7b..0d2767d 100644 --- a/src/Language/PureScript/CodeGen/C/Transforms.purs +++ b/src/Language/PureScript/CodeGen/C/Transforms.purs @@ -418,7 +418,7 @@ eraseLambdas moduleName asts = map collapseNestedBlocks <$> AST.Function x@{ name, arguments, body: Just body } -> withReaderT (\s -> s { isTopLevel = false, depth = s.depth + 1 }) $ eraseLambda { arguments, body } - ast@AST.VariableIntroduction x@{ name, initialization, type: typ } -> do + ast@(AST.VariableIntroduction x@{ name, initialization, type: typ }) -> do currentScope <- ask withReaderT (_ { function = Just name }) do if currentScope.isTopLevel @@ -437,7 +437,7 @@ eraseLambdas moduleName asts = map collapseNestedBlocks <$> xs' <- A.reverse <<< snd <$> A.foldM (\(scope /\ asts') -> case _ of - ast@AST.VariableIntroduction { name, type: typ } + ast@(AST.VariableIntroduction { name, type: typ }) | not currentScope.isTopLevel && not (isInternalVariable name) -> let scope' = diff --git a/src/Main.purs b/src/Main.purs index b9b1cab..b10dd8d 100644 --- a/src/Main.purs +++ b/src/Main.purs @@ -148,10 +148,10 @@ compileModule isMain corefn = do let { module: - mod@C.Module + mod@(C.Module { moduleName , modulePath: C.FilePath modulePath - } + }) } = core diff --git a/test/Main.purs b/test/Main.purs index 8376811..5e443e6 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -5,16 +5,18 @@ module Test.Main import Prelude import Data.Maybe (Maybe(..)) +import Data.Newtype (unwrap) +import Data.Time.Duration (Milliseconds(..)) import Effect (Effect) import Effect.Aff (launchAff_) -import Effect.Class (liftEffect) import Test.Spec.Reporter (specReporter) as Spec -import Test.Spec.Runner (defaultConfig, run') as Spec +import Test.Spec.Runner (defaultConfig, runSpecT) as Spec import Test.Upstream (buildUpstreamTestSuite) main :: Effect Unit main = launchAff_ do upstreamSpec <- buildUpstreamTestSuite - liftEffect $ - Spec.run' (Spec.defaultConfig { timeout = Just 10000 }) [Spec.specReporter] $ + unwrap $ Spec.runSpecT + (Spec.defaultConfig { timeout = Just $ 10000.0 # Milliseconds }) + [ Spec.specReporter ] $ upstreamSpec diff --git a/tests/00-basic/Makefile b/tests/00-basic/Makefile index 4958fe4..0fa1339 100644 --- a/tests/00-basic/Makefile +++ b/tests/00-basic/Makefile @@ -4,9 +4,5 @@ default: main PUREC_DIR := ../.. include $(PUREC_DIR)/mk/target.mk -.spago: - spago install -main: .spago - $(eval $(call purs_mk_target,lib,,src)) $(eval $(call purs_mk_target,main,Main,src)) diff --git a/tests/01-partialfuns/Makefile b/tests/01-partialfuns/Makefile index b8dc15e..cb01400 100644 --- a/tests/01-partialfuns/Makefile +++ b/tests/01-partialfuns/Makefile @@ -4,9 +4,5 @@ default: main PUREC_DIR := ../.. include $(PUREC_DIR)/mk/target.mk -.spago: - spago install -main: .spago - $(eval $(call purs_mk_target,main,Main,src)) $(eval $(call purs_mk_target,lib,,src)) diff --git a/tests/02-foreign/Makefile b/tests/02-foreign/Makefile index b8dc15e..cb01400 100644 --- a/tests/02-foreign/Makefile +++ b/tests/02-foreign/Makefile @@ -4,9 +4,5 @@ default: main PUREC_DIR := ../.. include $(PUREC_DIR)/mk/target.mk -.spago: - spago install -main: .spago - $(eval $(call purs_mk_target,main,Main,src)) $(eval $(call purs_mk_target,lib,,src)) diff --git a/tests/03-mutrec/Makefile b/tests/03-mutrec/Makefile index b8dc15e..cb01400 100644 --- a/tests/03-mutrec/Makefile +++ b/tests/03-mutrec/Makefile @@ -4,9 +4,5 @@ default: main PUREC_DIR := ../.. include $(PUREC_DIR)/mk/target.mk -.spago: - spago install -main: .spago - $(eval $(call purs_mk_target,main,Main,src)) $(eval $(call purs_mk_target,lib,,src)) diff --git a/tests/04-memory/Makefile b/tests/04-memory/Makefile index b8dc15e..cb01400 100644 --- a/tests/04-memory/Makefile +++ b/tests/04-memory/Makefile @@ -4,9 +4,5 @@ default: main PUREC_DIR := ../.. include $(PUREC_DIR)/mk/target.mk -.spago: - spago install -main: .spago - $(eval $(call purs_mk_target,main,Main,src)) $(eval $(call purs_mk_target,lib,,src)) diff --git a/tests/05-datacons/Makefile b/tests/05-datacons/Makefile index b8dc15e..cb01400 100644 --- a/tests/05-datacons/Makefile +++ b/tests/05-datacons/Makefile @@ -4,9 +4,5 @@ default: main PUREC_DIR := ../.. include $(PUREC_DIR)/mk/target.mk -.spago: - spago install -main: .spago - $(eval $(call purs_mk_target,main,Main,src)) $(eval $(call purs_mk_target,lib,,src)) diff --git a/tests/06-typeclasses/Makefile b/tests/06-typeclasses/Makefile index b8dc15e..cb01400 100644 --- a/tests/06-typeclasses/Makefile +++ b/tests/06-typeclasses/Makefile @@ -4,9 +4,5 @@ default: main PUREC_DIR := ../.. include $(PUREC_DIR)/mk/target.mk -.spago: - spago install -main: .spago - $(eval $(call purs_mk_target,main,Main,src)) $(eval $(call purs_mk_target,lib,,src)) diff --git a/tests/10-prelude/Makefile b/tests/10-prelude/Makefile index b8dc15e..9460552 100644 --- a/tests/10-prelude/Makefile +++ b/tests/10-prelude/Makefile @@ -4,9 +4,10 @@ default: main PUREC_DIR := ../.. include $(PUREC_DIR)/mk/target.mk -.spago: - spago install main: .spago +main_CFLAGS = -g +main_LD_FLAGS = -lm + $(eval $(call purs_mk_target,main,Main,src)) $(eval $(call purs_mk_target,lib,,src)) diff --git a/tests/10-prelude/src/Main.h b/tests/10-prelude/src/Main.h index 5274928..3f74a0b 100644 --- a/tests/10-prelude/src/Main.h +++ b/tests/10-prelude/src/Main.h @@ -5,7 +5,6 @@ PURS_FFI_FUNC_2(Main_putStrLn, s_, _, { const purs_str_t * s = purs_any_force_string(s_); - printf("%s\n", s->data); PURS_RC_RELEASE(s); return purs_any_int_zero; }); diff --git a/tests/10-prelude/src/Main.purs b/tests/10-prelude/src/Main.purs index 6453351..13a1a36 100644 --- a/tests/10-prelude/src/Main.purs +++ b/tests/10-prelude/src/Main.purs @@ -40,16 +40,15 @@ main = >> check (runE b == 3) >> check (runE c == 2) >> check (show ([] :: Array Int) == "[]") - >> putStrLn (show ([] :: Array Int)) - -- >> check (show [ 99 ] == "[99]") - -- >> check (show [ 1, 2, 3 ] == "[1, 2, 3]") - -- >> check (show "" == "\"\"") - -- >> check (show "\"" == "\"\"\"") - -- >> check (show {} == "{}") - -- >> check (show { a: [ 1 ] } == "{ a: [1] }") - -- >> check ([ 1, 2, 3 ] == [ 1, 2, 3 ]) - -- >> check (map show [ 1, 2, 3 ] == [ "1", "2", "3" ]) - -- >> check (show (map show [ 1, 2, 3 ]) == "[\"1\", \"2\", \"3\"]") - -- >> check (map (_ * 3) [ 1, 2, 3 ] == [ 3, 6, 9 ]) - -- >> check (pure 3 == [ 3 ]) - -- >> check (map identity ([] :: Array Int) == []) + >> check (show [ 99 ] == "[99]") + >> check (show [ 1, 2, 3 ] == "[1, 2, 3]") + >> check (show "" == "\"\"") + >> check (show "\"" == "\"\"\"") + >> check (show {} == "{}") + >> check (show { a: [ 1 ] } == "{ a: [1] }") + >> check ([ 1, 2, 3 ] == [ 1, 2, 3 ]) + >> check (map show [ 1, 2, 3 ] == [ "1", "2", "3" ]) + >> check (show (map show [ 1, 2, 3 ]) == "[\"1\", \"2\", \"3\"]") + >> check (map (_ * 3) [ 1, 2, 3 ] == [ 3, 6, 9 ]) + >> check (pure 3 == [ 3 ]) + >> check (map identity ([] :: Array Int) == []) From d5fd4c55615e2fba483a075a1dee26384bc0ec59 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Sun, 3 Nov 2019 14:03:09 +1300 Subject: [PATCH 47/67] Implement reference counting for foreign values --- Makefile | 2 +- runtime/purescript.c | 23 ++++++++++++++- runtime/purescript.h | 58 ++++++++++++++++++++----------------- tests/02-foreign/src/Main.c | 14 +++++++-- 4 files changed, 65 insertions(+), 32 deletions(-) diff --git a/Makefile b/Makefile index 1d4d48f..f12cffd 100644 --- a/Makefile +++ b/Makefile @@ -26,10 +26,10 @@ RUNTIME_SOURCES = \ RUNTIME_OBJECTS = \ $(patsubst %.c,%.o,$(RUNTIME_SOURCES)) -# TESTS = $(shell cd tests && find . -maxdepth 1 ! -path . -type d -exec basename {} \; | sort) TESTS = \ 00-basic \ 01-partialfuns \ + 02-foreign \ 04-memory \ 05-datacons \ 06-typeclasses \ diff --git a/runtime/purescript.c b/runtime/purescript.c index 74e770e..43663fe 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -21,7 +21,28 @@ const purs_cont_t * purs_cont_new(const struct purs_scope * scope, } // ----------------------------------------------------------------------------- -// Constructors +// foreign +// ----------------------------------------------------------------------------- + +static void purs_foreign_free(const struct purs_rc *ref) { + purs_foreign_t * x = container_of(ref, purs_foreign_t, rc); + x->finalize_cb(x->tag, x->data); + purs_free(x); +} + +const purs_foreign_t * purs_foreign_new(void * tag, + void * data, + purs_foreign_finalizer finalize_cb) { + purs_foreign_t * foreign = purs_new(purs_foreign_t); + foreign->tag = tag; + foreign->data = data; + foreign->finalize_cb = finalize_cb; + foreign->rc = ((struct purs_rc) { purs_foreign_free, 1 }); + return (const purs_foreign_t*) foreign; +} + +// ----------------------------------------------------------------------------- +// data constructors // ----------------------------------------------------------------------------- static void purs_cons_free(const struct purs_rc *ref) { diff --git a/runtime/purescript.h b/runtime/purescript.h index 0cae680..907540f 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -112,11 +112,6 @@ typedef enum { } purs_any_tag_t; #define PURS_ANY_TAGS_TOT 10 /* Keep this in Sync! */ -struct purs_foreign { - void * tag; - void * data; -}; - /* a reference-counted structure */ struct purs_rc { void (*free_fn)(const struct purs_rc *); @@ -147,6 +142,7 @@ static inline void purs_rc_release(const struct purs_rc *ref) { /* all "base"-compatible structures must have their "rc" field in the same position as "_purs_rc_base." */ struct _purs_rc_base { struct purs_rc rc; }; +#define PURS_RC_BASE_FIELDS struct purs_rc rc; #define PURS_RC_BASE_RELEASE(X) PURS_RC_RELEASE((struct _purs_rc_base *) X) #define PURS_RC_BASE_RETAIN(X) PURS_RC_RETAIN((struct _purs_rc_base *) X) @@ -155,9 +151,9 @@ union purs_any_value { purs_any_int_t i; purs_any_num_t n; purs_any_char_t chr; - purs_foreign_t foreign; /* self-referential, and other values */ + const purs_foreign_t * foreign; const purs_cont_t * cont; const purs_cons_t * cons; const purs_thunk_t * thunk; @@ -172,32 +168,40 @@ struct purs_any { }; struct purs_thunk { - struct purs_rc rc; + PURS_RC_BASE_FIELDS purs_thunk_fun_t * fn; void * ctx; }; struct purs_cont { - struct purs_rc rc; + PURS_RC_BASE_FIELDS purs_cont_fun_t * fn; const struct purs_scope * scope; /* todo: inline? */ }; struct purs_cons { - struct purs_rc rc; + PURS_RC_BASE_FIELDS int tag; int size; ANY * values; }; struct purs_str { - struct purs_rc rc; + PURS_RC_BASE_FIELDS char * data; }; -/* a reference-counted vec_t(...) */ +typedef void (*purs_foreign_finalizer)(void* tag, void* data); + +struct purs_foreign { + PURS_RC_BASE_FIELDS + void * tag; + void * data; + purs_foreign_finalizer finalize_cb; +}; + struct purs_vec { - struct purs_rc rc; + PURS_RC_BASE_FIELDS ANY * data; int length; int capacity; @@ -250,7 +254,7 @@ const char * purs_any_tag_str (const purs_any_tag_t); PURS_RC_RETAIN((X).value.cons);\ break;\ case PURS_ANY_TAG_FOREIGN:\ - fprintf(stderr, "WARN: Todo: Implement PURS_ANY_RETAIN for: %s\n", purs_any_tag_str((X).tag));\ + PURS_RC_RETAIN((X).value.foreign);\ break;\ default:\ break;\ @@ -260,7 +264,7 @@ const char * purs_any_tag_str (const purs_any_tag_t); #define PURS_ANY_RELEASE(X) {\ switch ((X).tag) {\ case PURS_ANY_TAG_FOREIGN:\ - fprintf(stderr, "WARN: Todo: Implement PURS_ANY_RELEASE for: %s\n", purs_any_tag_str((X).tag));\ + PURS_RC_RELEASE((X).value.foreign);\ break;\ case PURS_ANY_TAG_CONS:\ PURS_RC_RELEASE((X).value.cons);\ @@ -337,7 +341,7 @@ static inline const purs_any_tag_t purs_any_get_tag (ANY v) { __PURS_ANY_GET(int, i, purs_any_int_t, PURS_ANY_TAG_INT) __PURS_ANY_GET(num, n, purs_any_num_t, PURS_ANY_TAG_NUM) __PURS_ANY_GET(char, chr, purs_any_char_t, PURS_ANY_TAG_CHAR) -__PURS_ANY_GET(foreign, foreign, purs_foreign_t, PURS_ANY_TAG_FOREIGN) +__PURS_ANY_GET(foreign, foreign, const purs_foreign_t *, PURS_ANY_TAG_FOREIGN) __PURS_ANY_GET(cont, cont, const purs_cont_t *, PURS_ANY_TAG_CONT) __PURS_ANY_GET(cons, cons, const purs_cons_t *, PURS_ANY_TAG_CONS) __PURS_ANY_GET(thunk, thunk, const purs_thunk_t *, PURS_ANY_TAG_THUNK) @@ -381,7 +385,6 @@ __PURS_ANY_GET(array, array, const purs_vec_t *, PURS_ANY_TAG_ARRAY) __PURS_ANY_FORCE_COPY(int, i, purs_any_int_t, PURS_ANY_TAG_INT) __PURS_ANY_FORCE_COPY(num, n, purs_any_num_t, PURS_ANY_TAG_NUM) __PURS_ANY_FORCE_COPY(char, chr, purs_any_char_t, PURS_ANY_TAG_CHAR) -__PURS_ANY_FORCE_COPY(foreign, foreign, purs_foreign_t, PURS_ANY_TAG_FOREIGN) __PURS_ANY_FORCE_RETAIN(cont, cont, const purs_cont_t *, PURS_ANY_TAG_CONT) __PURS_ANY_FORCE_RETAIN(cons, cons, const purs_cons_t *, PURS_ANY_TAG_CONS) @@ -389,6 +392,7 @@ __PURS_ANY_FORCE_RETAIN(thunk, thunk, const purs_thunk_t *, PURS_ANY_TAG_THUNK) __PURS_ANY_FORCE_RETAIN(record, record, const purs_record_t *, PURS_ANY_TAG_RECORD) __PURS_ANY_FORCE_RETAIN(string, str, const purs_str_t *, PURS_ANY_TAG_STRING) __PURS_ANY_FORCE_RETAIN(array, array, const purs_vec_t *, PURS_ANY_TAG_ARRAY) +__PURS_ANY_FORCE_RETAIN(foreign, foreign, const purs_foreign_t *, PURS_ANY_TAG_FOREIGN) /* todo: generate faster, unsafe variants */ #define purs_any_force_int(A) _purs_any_force_int((A), __FILE__, __LINE__) @@ -446,7 +450,15 @@ ANY purs_any_concat(ANY, ANY); const purs_cont_t * purs_cont_new(const struct purs_scope *, purs_cont_fun_t *); // ----------------------------------------------------------------------------- -// Data constructors +// foreign +// ----------------------------------------------------------------------------- + +const purs_foreign_t * purs_foreign_new(void* tag, + void* data, + purs_foreign_finalizer finalize_cb); + +// ----------------------------------------------------------------------------- +// data constructors // ----------------------------------------------------------------------------- const purs_cons_t * purs_cons_new(int tag, int size, ...); @@ -645,16 +657,8 @@ struct purs_scope * purs_scope_new1(int size); #define PURS_ANY_CHAR(X)\ ((purs_any_t){ .tag = PURS_ANY_TAG_CHAR, .value = { .chr = (X) } }) -#define PURS_ANY_FOREIGN(TAG, DATA)\ - ((purs_any_t){\ - .tag = PURS_ANY_TAG_FOREIGN,\ - .value = {\ - .foreign = {\ - .tag = (TAG),\ - .data = (DATA)\ - }\ - }\ - }) +#define PURS_ANY_FOREIGN(X)\ + ((purs_any_t){ .tag = PURS_ANY_TAG_FOREIGN, .value = { .foreign = (X) } }) #define PURS_ANY_STRING(X)\ ((purs_any_t){ .tag = PURS_ANY_TAG_STRING, .value = { .str = (X) } }) diff --git a/tests/02-foreign/src/Main.c b/tests/02-foreign/src/Main.c index b2ab137..32e55f5 100644 --- a/tests/02-foreign/src/Main.c +++ b/tests/02-foreign/src/Main.c @@ -1,25 +1,33 @@ #include "runtime/purescript.h" #include "Main.h" +void buf_free(void* tag, void* data) { + purs_free(tag); + struct buf * buf = data; + purs_free(buf->data); + purs_free(buf); +} + PURS_FFI_FUNC_1(Main_newBuffer, _, { struct buf * buf = purs_new(struct buf); buf->data = NULL; buf->size = 0; - return purs_any_foreign(NULL, buf); + return purs_any_foreign(purs_foreign_new(NULL, buf, buf_free)); }); PURS_FFI_FUNC_2(Main_bufferSize, x, _, { assert(x.tag == PURS_ANY_TAG_FOREIGN); - struct buf * buf = (struct buf *) x.value.foreign.data; + struct buf * buf = (struct buf *) x.value.foreign->data; return purs_any_int(buf->size); }); PURS_FFI_FUNC_3(Main_bufferGrow, n_, x, _, { assert(x.tag == PURS_ANY_TAG_FOREIGN); int n = purs_any_get_int(n_); - struct buf * buf = (struct buf *) x.value.foreign.data; + struct buf * buf = (struct buf *) x.value.foreign->data; char * data = purs_malloc(sizeof (char) * (buf->size + n)); memcpy(data, buf->data, buf->size); + purs_free(buf->data); buf->size += n; buf->data = data; return purs_any_int(buf->size); From 9ad3a683713efac0c5e6e34c9a1791c5f060ab0c Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Sun, 3 Nov 2019 14:21:58 +1300 Subject: [PATCH 48/67] Update codegen for rc-ed foreign values --- runtime/purescript.c | 2 +- runtime/purescript.h | 2 +- .../PureScript/CodeGen/C/Optimizer/TCO.purs | 7 +++++-- src/Language/PureScript/CodeGen/C/Transforms.purs | 13 ++++++++----- src/Language/PureScript/CodeGen/Runtime.purs | 8 +++++++- 5 files changed, 22 insertions(+), 10 deletions(-) diff --git a/runtime/purescript.c b/runtime/purescript.c index 43663fe..96239cb 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -26,7 +26,7 @@ const purs_cont_t * purs_cont_new(const struct purs_scope * scope, static void purs_foreign_free(const struct purs_rc *ref) { purs_foreign_t * x = container_of(ref, purs_foreign_t, rc); - x->finalize_cb(x->tag, x->data); + if (x->finalize_cb) x->finalize_cb(x->tag, x->data); purs_free(x); } diff --git a/runtime/purescript.h b/runtime/purescript.h index 907540f..5209e81 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -581,7 +581,7 @@ struct tco_state { PURS_ANY_RETAIN(__v__);\ ((struct tco_state *) X)->args[I] = __v__;\ } while (0) -#define purs_foreign_get_data(X) (X.data) +#define purs_foreign_get_data(X) (X->data) /* Captured scope generation */ struct purs_scope { diff --git a/src/Language/PureScript/CodeGen/C/Optimizer/TCO.purs b/src/Language/PureScript/CodeGen/C/Optimizer/TCO.purs index 743c3ea..581317e 100644 --- a/src/Language/PureScript/CodeGen/C/Optimizer/TCO.purs +++ b/src/Language/PureScript/CodeGen/C/Optimizer/TCO.purs @@ -198,8 +198,11 @@ tco = AST.everywhere convert AST.App R.purs_any_app [ AST.Var tcoLoop , AST.App R.purs_any_foreign - [ AST.Null - , AST.App R.purs_address_of [ AST.Var tcoState ] + [ AST.App R.purs_foreign_new + [ AST.Null + , AST.App R.purs_address_of [ AST.Var tcoState ] + , AST.Null + ] ] ] ] diff --git a/src/Language/PureScript/CodeGen/C/Transforms.purs b/src/Language/PureScript/CodeGen/C/Transforms.purs index 0d2767d..0fd7e68 100644 --- a/src/Language/PureScript/CodeGen/C/Transforms.purs +++ b/src/Language/PureScript/CodeGen/C/Transforms.purs @@ -93,6 +93,7 @@ releaseResources = map (map cleanup) <<< traverse (go []) AST.Var "purs_vec_splice" -> Just arrayType AST.Var "purs_vec_concat" -> Just arrayType AST.Var "purs_str_new" -> Just stringType + AST.Var "purs_foreign_new" -> Just foreignType AST.Var "purs_record_new_va" -> Just recordType AST.Var "purs_cont_new" -> Just contType AST.Var "purs_cons_new" -> Just consType @@ -667,20 +668,22 @@ eraseLambdas moduleName asts = map collapseNestedBlocks <$> ] consType :: AST.Type -consType = Type.Pointer (Type.RawType "purs_cons_t" [ Type.Const ]) +consType = Type.Pointer (Type.RawType "purs_cons_t" [ Type.Const ]) contType :: AST.Type -contType = Type.Pointer (Type.RawType "purs_cont_t" [ Type.Const ]) +contType = Type.Pointer (Type.RawType "purs_cont_t" [ Type.Const ]) recordType :: AST.Type recordType = Type.Pointer (Type.RawType "purs_record_t" [ Type.Const ]) +foreignType :: AST.Type +foreignType = Type.Pointer (Type.RawType "purs_foreign_t" [ Type.Const ]) stringType :: AST.Type -stringType = Type.Pointer (Type.RawType "purs_str_t" [ Type.Const ]) +stringType = Type.Pointer (Type.RawType "purs_str_t" [ Type.Const ]) arrayType :: AST.Type -arrayType = Type.Pointer (Type.RawType "purs_vec_t" [ Type.Const ]) +arrayType = Type.Pointer (Type.RawType "purs_vec_t" [ Type.Const ]) scopeType :: AST.Type -scopeType = Type.Pointer (Type.RawType "purs_scope_t" [ Type.Const ]) +scopeType = Type.Pointer (Type.RawType "purs_scope_t" [ Type.Const ]) diff --git a/src/Language/PureScript/CodeGen/Runtime.purs b/src/Language/PureScript/CodeGen/Runtime.purs index afcb588..d8994ad 100644 --- a/src/Language/PureScript/CodeGen/Runtime.purs +++ b/src/Language/PureScript/CodeGen/Runtime.purs @@ -57,7 +57,10 @@ module Language.PureScript.CodeGen.Runtime , _PURS_ANY_THUNK_DECL , _PURS_ANY_THUNK_DEF - -- constructors + -- foreign + , purs_foreign_new + + -- data constructors , purs_cons_t , purs_cons_new , purs_cons_get_tag @@ -211,6 +214,9 @@ purs_any_cons = AST.Var "purs_any_cons" purs_any_foreign :: AST purs_any_foreign = AST.Var "purs_any_foreign" +purs_foreign_new :: AST +purs_foreign_new = AST.Var "purs_foreign_new" + purs_any_int :: AST purs_any_int = AST.Var "purs_any_int" From 65d44dc27e3df88bd909a2cfda39526789beca1d Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Sun, 3 Nov 2019 15:01:28 +1300 Subject: [PATCH 49/67] Allow building projects both spago or bower --- mk/target.mk | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) diff --git a/mk/target.mk b/mk/target.mk index 7d4ff27..1011152 100644 --- a/mk/target.mk +++ b/mk/target.mk @@ -15,8 +15,22 @@ PUREC_LIB = $(PUREC_DIR)/libpurec.a PUREC_LIB_DIR = $(dir $(PUREC_LIB)) PUREC_LIB_NAME = $(notdir %/%,%,$(PUREC_LIB)) +PUREC_PM ?= spago + +ifeq ($(PUREC_PM),spago) +DEPS_DIR = .spago SPAGO ?= spago +DEPS_INSTALL = $(SPAGO) install PACKAGE_SOURCES = $(shell [ -d .spago ] && $(SPAGO) sources) +else ifeq ($(PUREC_PM),bower) +BOWER ?= bower +DEPS_DIR = bower_components +DEPS_INSTALL = $(BOWER) install +PACKAGE_SOURCES = $$(shell \ + 2>/dev/null find bower_components -type d -name 'purescript-*/src') +else +$(error PUREC_PM not recognized) +endif OS := $(shell uname) ifeq ($(OS),Darwin) @@ -25,8 +39,8 @@ else LD_LINKER_FLAGS += -gc-sections endif -.spago: - spago install +$(DEPS_DIR): + $(DEPS_INSTALL) ## Not all environments support globstar (** dir pattern) rwildcard=$(wildcard $1$2) $(foreach d,$(wildcard $1*),$(call rwildcard,$d/,$2)) @@ -133,11 +147,11 @@ $$(PUREC_WORKDIR)/$(1)/.build: \ _$(1): $$(PUREC_WORKDIR)/$(1)/.genc @$$(MAKE) -s $$(PUREC_WORKDIR)/$(1)/.build -$(1): .spago +$(1): $(DEPS_DIR) @$$(MAKE) -s _$(1) .PHONY: $(1) -$(1)/c: .spago +$(1)/c: $(DEPS_DIR) @$$(MAKE) -s $$(PUREC_WORKDIR)/$(1)/.genc .PHONY: $(1)/c endef From f53fe27d150cabf71cca008353292510e8de34ba Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Sun, 3 Nov 2019 20:42:13 +1300 Subject: [PATCH 50/67] Add compat return for Unit-based entry functions, fix PURS_FFI_VALUE --- runtime/purescript.h | 40 ++++++++++++++++----- src/Language/PureScript/CodeGen/C/File.purs | 2 +- 2 files changed, 33 insertions(+), 9 deletions(-) diff --git a/runtime/purescript.h b/runtime/purescript.h index 5209e81..b9173a3 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -223,16 +223,20 @@ ANY purs_record_empty; /* todo: a more efficient, non-allocating, release-mode version */ #define purs_any_assert_tag_eq(EXPECTED, ACTUAL)\ - purs_assert((ACTUAL) == (EXPECTED),\ + purs_assert((EXPECTED) == (ACTUAL),\ "expected tag: %s, but got: %s",\ - purs_any_tag_str((ACTUAL)),\ - purs_any_tag_str((EXPECTED))) + purs_any_tag_str((EXPECTED)),\ + purs_any_tag_str((ACTUAL))) ANY purs_any_null; #define purs_any_is_null(x) (x.tag == PURS_ANY_TAG_NULL) const char * purs_any_tag_str (const purs_any_tag_t); +static inline void purs_debug(purs_any_t v, char** out) { + asprintf(out, "tag=%s", purs_any_tag_str(v.tag)); +} + #define PURS_ANY_RETAIN(X) {\ switch ((X).tag) {\ case PURS_ANY_TAG_STRING:\ @@ -311,7 +315,7 @@ static inline ANY purs_any_app(ANY _f, ANY v, ...) { /* unthunk, if necessary */ int has_changed; ANY f = purs_any_unthunk(_f, &has_changed); - purs_any_assert_tag_eq(f.tag, PURS_ANY_TAG_CONT); + purs_any_assert_tag_eq(PURS_ANY_TAG_CONT, f.tag); /* apply the function */ va_list args; @@ -334,7 +338,7 @@ static inline const purs_any_tag_t purs_any_get_tag (ANY v) { #define __PURS_ANY_GET(N, A, R, TAG)\ static inline R _purs_any_get_ ## N (ANY v, char * file, int line) {\ - purs_any_assert_tag_eq(v.tag, TAG);\ + purs_any_assert_tag_eq(TAG, v.tag);\ return v.value.A;\ } @@ -365,7 +369,7 @@ __PURS_ANY_GET(array, array, const purs_vec_t *, PURS_ANY_TAG_ARRAY) static inline R _purs_any_force_ ## N (ANY v, char * file, int line) {\ int was_forced;\ v = purs_any_unthunk(v, &was_forced);\ - purs_any_assert_tag_eq(v.tag, TAG);\ + purs_any_assert_tag_eq(TAG, v.tag);\ R r = v.value.A;\ if (was_forced) PURS_ANY_RELEASE(v);\ return r;\ @@ -375,7 +379,7 @@ __PURS_ANY_GET(array, array, const purs_vec_t *, PURS_ANY_TAG_ARRAY) static inline R _purs_any_force_ ## N (ANY v, char * file, int line) {\ int was_forced;\ v = purs_any_unthunk(v, &was_forced);\ - purs_any_assert_tag_eq(v.tag, TAG);\ + purs_any_assert_tag_eq(TAG, v.tag);\ R r = v.value.A;\ PURS_RC_BASE_RETAIN(r);\ if (was_forced) PURS_ANY_RELEASE(v);\ @@ -543,6 +547,23 @@ ANY * purs_record_find_by_key(const purs_record_t *, // Code-gen helpers // ----------------------------------------------------------------------------- +static inline int purs_any_get_main_rc_compat(purs_any_t v) { + switch(v.tag) { + case PURS_ANY_TAG_NULL: + return 0; + case PURS_ANY_TAG_INT: + return purs_any_force_int(v); + default: { + char* s; + purs_debug(v, &s); + purs_assert(0, + "program did not return unit or int, value=(%s)\n", + s); + free(s); /* for good measure */ + } + } +} + #define purs_address_of(V) &V #define purs_derefence(V) *V @@ -648,6 +669,9 @@ struct purs_scope * purs_scope_new1(int size); // Any: initializers // ----------------------------------------------------------------------------- +#define PURS_ANY_NULL\ + ((purs_any_t){ .tag = PURS_ANY_TAG_NULL }) + #define PURS_ANY_INT(X)\ ((purs_any_t){ .tag = PURS_ANY_TAG_INT, .value = { .i = (X) } }) @@ -745,7 +769,7 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { ANY NAME ## _$ #define PURS_FFI_VALUE(NAME, INIT)\ - static const purs_any_t NAME ## _$ = INIT + purs_any_t NAME ## _$ = INIT // ----------------------------------------------------------------------------- // FFI: fixed-arity curried functions diff --git a/src/Language/PureScript/CodeGen/C/File.purs b/src/Language/PureScript/CodeGen/C/File.purs index e4cb00a..7b863ec 100644 --- a/src/Language/PureScript/CodeGen/C/File.purs +++ b/src/Language/PureScript/CodeGen/C/File.purs @@ -118,7 +118,7 @@ nativeMain mainVar = , body: Just $ AST.Block [ AST.Return $ - AST.App R.purs_any_get_int + AST.App (AST.Var "purs_any_get_main_rc_compat") [ AST.App R.purs_any_app [ mainVar , R.purs_any_null From 6a666b024505f8a4fb98ff96f7b3fc00b4872f97 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Mon, 4 Nov 2019 07:07:20 +1300 Subject: [PATCH 51/67] Fix handling of NULL records --- runtime/purescript.c | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/runtime/purescript.c b/runtime/purescript.c index 96239cb..4637e02 100644 --- a/runtime/purescript.c +++ b/runtime/purescript.c @@ -432,6 +432,7 @@ const purs_record_t * purs_record_new_va(int count, ...) { /* create a shallow copy of the record */ const purs_record_t * purs_record_copy_shallow(const purs_record_t * source) { + if (source == NULL) return NULL; const purs_record_node_t * src, * tmp; purs_record_t * x = purs_new(purs_record_t); x->root = NULL; @@ -460,7 +461,14 @@ const purs_record_t * purs_record_add_multi(const purs_record_t * source, return source; } - purs_record_t * copy = (purs_record_t *) purs_record_copy_shallow(source); + purs_record_t * copy; + if (source == NULL) { + copy = purs_new(purs_record_t); + copy->root = NULL; + copy->rc = ((struct purs_rc) { purs_record_free, 1 }); + } else { + copy = (purs_record_t *) purs_record_copy_shallow(source); + } va_list args; va_start(args, count); _purs_record_add_multi_mut(copy, count, args); From ac7c548d194dd820b3170bb4c08111e9ad9cc942 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Mon, 4 Nov 2019 09:43:24 +1300 Subject: [PATCH 52/67] Fix warning --- runtime/purescript.h | 1 + 1 file changed, 1 insertion(+) diff --git a/runtime/purescript.h b/runtime/purescript.h index b9173a3..7f434fd 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -560,6 +560,7 @@ static inline int purs_any_get_main_rc_compat(purs_any_t v) { "program did not return unit or int, value=(%s)\n", s); free(s); /* for good measure */ + return -1; /* silence warning */ } } } From 284246be0a5277d65b2b22464dd4caf19f591161 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Mon, 4 Nov 2019 09:43:05 +1300 Subject: [PATCH 53/67] Drop support for BWDGC for the time being --- Makefile | 41 ++--------------------------------------- runtime/purescript.h | 8 -------- vendor/vec.h | 2 -- 3 files changed, 2 insertions(+), 49 deletions(-) diff --git a/Makefile b/Makefile index f12cffd..3e7c114 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,5 @@ CLANG ?= clang CFLAGS ?= -WITH_GC ?= SHELL := /bin/bash SHELLFLAGS := -eo pipefail @@ -15,9 +14,6 @@ PUREC_WORKDIR := .purec-work PUREC_LIB := libpurec.a PUREC_INTERMEDIATE_LIB := libpurec.intermediate.a -BWDGC_V := v8.0.0 -BWDGC_LIB := deps/bwdgc/.libs/libgc.a - RUNTIME_SOURCES = \ runtime/purescript.c \ $(shell find ccan -type f -name '*.c') \ @@ -35,36 +31,16 @@ TESTS = \ 06-typeclasses \ 10-prelude -ifdef WITH_GC -CFLAGS += \ - -D 'uthash_malloc=GC_malloc' \ - -D 'uthash_free(ptr, sz)=NULL' \ - -D 'vec_realloc=GC_realloc' \ - -D 'vec_free(x)=NULL' \ - -D 'vec_malloc=GC_malloc' -endif - ifdef UNIT_TESTING CFLAGS += \ -g \ -D UNIT_TESTING endif -$(BWDGC_LIB): - @$(MAKE) -s deps/bwdgc - @cd deps/bwdgc && \ - ./autogen.sh && \ - ./configure --enable-static && \ - $(MAKE) - $(PUREC_INTERMEDIATE_LIB): $(RUNTIME_OBJECTS) @ar csr $@ $^ -ifdef WITH_GC -$(PUREC_LIB): $(PUREC_INTERMEDIATE_LIB) $(BWDGC_LIB) -else $(PUREC_LIB): $(PUREC_INTERMEDIATE_LIB) -endif @rm -rf .build @mkdir -p .build @cd .build &&\ @@ -91,7 +67,7 @@ clean: @rm -f $$(find . -maxdepth 1 -type f -name '*.a') .PHONY: clean -%.o: %.c | $(BWDGC_LIB) +%.o: %.c @echo "Compile" $^ @$(CLANG) $^ -c -o $@ \ -Wall \ @@ -106,8 +82,7 @@ clean: #------------------------------------------------------------------------------- deps:\ - deps/npm\ - deps/bwdgc + deps/npm .PHONY: deps deps/npm: @@ -115,18 +90,6 @@ deps/npm: @node_modules/.bin/bower install .PHONY: deps/npm -deps/bwdgc: - @if [ ! -d deps/bwdgc ]; then \ - if [ ! -f gc.tar.gz ]; then \ - echo "downloading bwdgc tarball...";\ - curl -sfLo gc.tar.gz \ - 'https://api.github.com/repos/ivmai/bdwgc/tarball/$(BWDGC_V)'; \ - fi && \ - mkdir -p deps/bwdgc && \ - tar -C deps/bwdgc -xzf gc.tar.gz --strip-components 1; \ - fi -.PHONY: deps/bwdgc - #------------------------------------------------------------------------------- # Tests #------------------------------------------------------------------------------- diff --git a/runtime/purescript.h b/runtime/purescript.h index 7f434fd..497ae84 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -10,13 +10,6 @@ #include #include -#ifdef WITH_GC -#include "deps/bwdgc/include/gc.h" -#define purs_malloc(SZ) GC_MALLOC(SZ) -#define purs_realloc(PTR, SZ) GC_REALLOC(PTR, SZ) -#define purs_new(EXP) GC_NEW(sizeof (EXP)) -#define purs_free(X) -#else #ifdef UNIT_TESTING extern void mock_assert(const int result, const char *const expression, const char *const file, const int line); #undef assert @@ -49,7 +42,6 @@ extern void _test_free(void* const ptr, const char* file, const int line); }\ } while (0) #endif -#endif #include "ccan/asprintf/asprintf.h" #include "vendor/uthash.h" diff --git a/vendor/vec.h b/vendor/vec.h index 0b9d440..f3e2e5b 100644 --- a/vendor/vec.h +++ b/vendor/vec.h @@ -8,8 +8,6 @@ #ifndef VEC_H #define VEC_H -#include "deps/bwdgc/include/gc.h" /* XXX: required for GC_realloc and friends to work properly (FS) */ - #include #include From 804c80d0e3b286a3e0be9ce9b2a881240f5f28a7 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Mon, 4 Nov 2019 09:41:09 +1300 Subject: [PATCH 54/67] Make PURS_FFI_FUNC_X macros more debug friendly The previous macros would not yield useful addresses when debugging memory leaks or other issues, as the line number would always be that of the macro itself. By removing the BODY from the macro, we recover more precise line numbers. --- runtime/purescript.h | 96 ++++++++++++-------- tests/02-foreign/src/Main.c | 12 +-- tests/04-memory/src/Main.c | 4 +- upstream/tests/purs/passing/FunWithFunDeps.c | 16 ++-- upstream/tests/purs/passing/PolyLabels.c | 8 +- upstream/tests/purs/passing/RowUnion.c | 4 +- 6 files changed, 82 insertions(+), 58 deletions(-) diff --git a/runtime/purescript.h b/runtime/purescript.h index 497ae84..d9fe04c 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -816,73 +816,86 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { #define PURS_FFI_FUNC_CONTEXT $__super__ -#define PURS_FFI_FUNC_1(NAME, A1, BODY)\ +#define PURS_FFI_FUNC_1(NAME, A1)\ + ANY NAME##__1_impl (ANY);\ ANY NAME##__1 (const purs_scope_t * $__super__, ANY A1, va_list $__unused__) {\ - BODY;\ + return NAME##__1_impl(A1);\ }\ - _PURS_FFI_FUNC_ENTRY(NAME) + _PURS_FFI_FUNC_ENTRY(NAME);\ + ANY NAME##__1_impl (ANY A1) -#define PURS_FFI_FUNC_2(NAME, A1, A2, BODY)\ +#define PURS_FFI_FUNC_2(NAME, A1, A2)\ + ANY NAME##__2_impl (ANY, ANY);\ ANY NAME##__2 (const purs_scope_t * $__super__, ANY A2, va_list $__unused__) {\ ANY A1 = $__super__->bindings[0];\ - BODY;\ + return NAME##__2_impl(A1, A2);\ }\ _PURS_FFI_FUNC_CONT_1_TO_2(NAME);\ - _PURS_FFI_FUNC_ENTRY(NAME) + _PURS_FFI_FUNC_ENTRY(NAME);\ + ANY NAME##__2_impl (ANY A1, ANY A2) -#define PURS_FFI_FUNC_3(NAME, A1, A2, A3, BODY)\ +#define PURS_FFI_FUNC_3(NAME, A1, A2, A3)\ + ANY NAME##__3_impl (ANY, ANY, ANY);\ ANY NAME##__3 (const purs_scope_t * $__super__, ANY A3, va_list $__unused__) {\ ANY A1 = $__super__->bindings[0];\ ANY A2 = $__super__->bindings[1];\ - BODY;\ + return NAME##__3_impl(A1, A2, A3);\ }\ _PURS_FFI_FUNC_CONT_2_TO_3(NAME);\ _PURS_FFI_FUNC_CONT_1_TO_2(NAME);\ - _PURS_FFI_FUNC_ENTRY(NAME) + _PURS_FFI_FUNC_ENTRY(NAME);\ + ANY NAME##__3_impl (ANY A1, ANY A2, ANY A3) -#define PURS_FFI_FUNC_4(NAME, A1, A2, A3, A4, BODY)\ +#define PURS_FFI_FUNC_4(NAME, A1, A2, A3, A4)\ + ANY NAME##__4_impl (ANY, ANY, ANY, ANY);\ ANY NAME##__4 (const purs_scope_t * $__super__, ANY A4, va_list $__unused__) {\ ANY A1 = $__super__->bindings[0];\ ANY A2 = $__super__->bindings[1];\ ANY A3 = $__super__->bindings[2];\ - BODY;\ + return NAME##__4_impl(A1, A2, A3, A4);\ }\ _PURS_FFI_FUNC_CONT_3_TO_4(NAME);\ _PURS_FFI_FUNC_CONT_2_TO_3(NAME);\ _PURS_FFI_FUNC_CONT_1_TO_2(NAME);\ - _PURS_FFI_FUNC_ENTRY(NAME) + _PURS_FFI_FUNC_ENTRY(NAME);\ + ANY NAME##__4_impl (ANY A1, ANY A2, ANY A3, ANY A4) -#define PURS_FFI_FUNC_5(NAME, A1, A2, A3, A4, A5, BODY)\ +#define PURS_FFI_FUNC_5(NAME, A1, A2, A3, A4, A5)\ + ANY NAME##__5_impl (ANY, ANY, ANY, ANY, ANY);\ ANY NAME##__5 (const purs_scope_t * $__super__, ANY A5, va_list $__unused__) {\ ANY A1 = $__super__->bindings[0];\ ANY A2 = $__super__->bindings[1];\ ANY A3 = $__super__->bindings[2];\ ANY A4 = $__super__->bindings[3];\ - BODY;\ + return NAME##__5_impl(A1, A2, A3, A4, A5);\ }\ _PURS_FFI_FUNC_CONT_4_TO_5(NAME);\ _PURS_FFI_FUNC_CONT_3_TO_4(NAME);\ _PURS_FFI_FUNC_CONT_2_TO_3(NAME);\ _PURS_FFI_FUNC_CONT_1_TO_2(NAME);\ - _PURS_FFI_FUNC_ENTRY(NAME) + _PURS_FFI_FUNC_ENTRY(NAME);\ + ANY NAME##__5_impl (ANY A1, ANY A2, ANY A3, ANY A4, ANY A5) -#define PURS_FFI_FUNC_6(NAME, A1, A2, A3, A4, A5, A6, BODY)\ +#define PURS_FFI_FUNC_6(NAME, A1, A2, A3, A4, A5, A6)\ + ANY NAME##__6_impl (ANY, ANY, ANY, ANY, ANY, ANY);\ ANY NAME##__6 (const purs_scope_t * $__super__, ANY A6, va_list $__unused__) {\ ANY A1 = $__super__->bindings[0];\ ANY A2 = $__super__->bindings[1];\ ANY A3 = $__super__->bindings[2];\ ANY A4 = $__super__->bindings[3];\ ANY A5 = $__super__->bindings[4];\ - BODY;\ + return NAME##__6_impl(A1, A2, A3, A4, A5, A6);\ }\ _PURS_FFI_FUNC_CONT_5_TO_6(NAME);\ _PURS_FFI_FUNC_CONT_4_TO_5(NAME);\ _PURS_FFI_FUNC_CONT_3_TO_4(NAME);\ _PURS_FFI_FUNC_CONT_2_TO_3(NAME);\ _PURS_FFI_FUNC_CONT_1_TO_2(NAME);\ - _PURS_FFI_FUNC_ENTRY(NAME) + _PURS_FFI_FUNC_ENTRY(NAME);\ + ANY NAME##__6_impl (ANY A1, ANY A2, ANY A3, ANY A4, ANY A5, ANY A6) -#define PURS_FFI_FUNC_7(NAME, A1, A2, A3, A4, A5, A6, A7, BODY)\ +#define PURS_FFI_FUNC_7(NAME, A1, A2, A3, A4, A5, A6, A7)\ + ANY NAME##__7_impl (ANY, ANY, ANY, ANY, ANY, ANY, ANY);\ ANY NAME##__7 (const purs_scope_t * $__super__, ANY A7, va_list $__unused__) {\ ANY A1 = $__super__->bindings[0];\ ANY A2 = $__super__->bindings[1];\ @@ -890,7 +903,7 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { ANY A4 = $__super__->bindings[3];\ ANY A5 = $__super__->bindings[4];\ ANY A6 = $__super__->bindings[5];\ - BODY;\ + return NAME##__7_impl(A1, A2, A3, A4, A5, A6, A7);\ }\ _PURS_FFI_FUNC_CONT_6_TO_7(NAME);\ _PURS_FFI_FUNC_CONT_5_TO_6(NAME);\ @@ -898,9 +911,11 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { _PURS_FFI_FUNC_CONT_3_TO_4(NAME);\ _PURS_FFI_FUNC_CONT_2_TO_3(NAME);\ _PURS_FFI_FUNC_CONT_1_TO_2(NAME);\ - _PURS_FFI_FUNC_ENTRY(NAME) + _PURS_FFI_FUNC_ENTRY(NAME);\ + ANY NAME##__7_impl (ANY A1, ANY A2, ANY A3, ANY A4, ANY A5, ANY A6, ANY A7) -#define PURS_FFI_FUNC_8(NAME, A1, A2, A3, A4, A5, A6, A7, A8, BODY)\ +#define PURS_FFI_FUNC_8(NAME, A1, A2, A3, A4, A5, A6, A7, A8)\ + ANY NAME##__8_impl (ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY);\ ANY NAME##__8 (const purs_scope_t * $__super__, ANY A8, va_list $__unused__) {\ ANY A1 = $__super__->bindings[0];\ ANY A2 = $__super__->bindings[1];\ @@ -909,7 +924,7 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { ANY A5 = $__super__->bindings[4];\ ANY A6 = $__super__->bindings[5];\ ANY A7 = $__super__->bindings[6];\ - BODY;\ + return NAME##__8_impl(A1, A2, A3, A4, A5, A6, A7, A8);\ }\ _PURS_FFI_FUNC_CONT_7_TO_8(NAME);\ _PURS_FFI_FUNC_CONT_6_TO_7(NAME);\ @@ -918,9 +933,11 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { _PURS_FFI_FUNC_CONT_3_TO_4(NAME);\ _PURS_FFI_FUNC_CONT_2_TO_3(NAME);\ _PURS_FFI_FUNC_CONT_1_TO_2(NAME);\ - _PURS_FFI_FUNC_ENTRY(NAME) + _PURS_FFI_FUNC_ENTRY(NAME);\ + ANY NAME##__8_impl (ANY A1, ANY A2, ANY A3, ANY A4, ANY A5, ANY A6, ANY A7, ANY A8) -#define PURS_FFI_FUNC_9(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, BODY)\ +#define PURS_FFI_FUNC_9(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9)\ + ANY NAME##__9_impl (ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY);\ ANY NAME##__9 (const purs_scope_t * $__super__, ANY A9, va_list $__unused__) {\ ANY A1 = $__super__->bindings[0];\ ANY A2 = $__super__->bindings[1];\ @@ -930,7 +947,7 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { ANY A6 = $__super__->bindings[5];\ ANY A7 = $__super__->bindings[6];\ ANY A8 = $__super__->bindings[7];\ - BODY;\ + return NAME##__9_impl(A1, A2, A3, A4, A5, A6, A7, A8, A9);\ }\ _PURS_FFI_FUNC_CONT_8_TO_9(NAME);\ _PURS_FFI_FUNC_CONT_7_TO_8(NAME);\ @@ -940,9 +957,11 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { _PURS_FFI_FUNC_CONT_3_TO_4(NAME);\ _PURS_FFI_FUNC_CONT_2_TO_3(NAME);\ _PURS_FFI_FUNC_CONT_1_TO_2(NAME);\ - _PURS_FFI_FUNC_ENTRY(NAME) + _PURS_FFI_FUNC_ENTRY(NAME);\ + ANY NAME##__9_impl (ANY A1, ANY A2, ANY A3, ANY A4, ANY A5, ANY A6, ANY A7, ANY A8, ANY A9) -#define PURS_FFI_FUNC_10(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, BODY)\ +#define PURS_FFI_FUNC_10(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10)\ + ANY NAME##__10_impl (ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY); \ ANY NAME##__10 (const purs_scope_t * $__super__, ANY A10, va_list $__unused__) {\ ANY A1 = $__super__->bindings[0];\ ANY A2 = $__super__->bindings[1];\ @@ -953,7 +972,7 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { ANY A7 = $__super__->bindings[6];\ ANY A8 = $__super__->bindings[7];\ ANY A9 = $__super__->bindings[8];\ - BODY;\ + return NAME##__10_impl(A1, A2, A3, A4, A5, A6, A7, A8, A9, A10);\ }\ _PURS_FFI_FUNC_CONT_9_TO_10(NAME);\ _PURS_FFI_FUNC_CONT_8_TO_9(NAME);\ @@ -964,9 +983,11 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { _PURS_FFI_FUNC_CONT_3_TO_4(NAME);\ _PURS_FFI_FUNC_CONT_2_TO_3(NAME);\ _PURS_FFI_FUNC_CONT_1_TO_2(NAME);\ - _PURS_FFI_FUNC_ENTRY(NAME) + _PURS_FFI_FUNC_ENTRY(NAME);\ + ANY NAME##__10_impl (ANY A1, ANY A2, ANY A3, ANY A4, ANY A5, ANY A6, ANY A7, ANY A8, ANY A9, ANY A10) -#define PURS_FFI_FUNC_11(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, BODY)\ +#define PURS_FFI_FUNC_11(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11)\ + ANY NAME##__11_impl (ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY); \ ANY NAME##__11 (const purs_scope_t * $__super__, ANY A11, va_list $__unused__) {\ ANY A1 = $__super__->bindings[0];\ ANY A2 = $__super__->bindings[1];\ @@ -978,7 +999,7 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { ANY A8 = $__super__->bindings[7];\ ANY A9 = $__super__->bindings[8];\ ANY A10 = $__super__->bindings[9];\ - BODY;\ + return NAME##__11_impl(A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11); \ }\ _PURS_FFI_FUNC_CONT_10_TO_11(NAME);\ _PURS_FFI_FUNC_CONT_9_TO_10(NAME);\ @@ -990,9 +1011,11 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { _PURS_FFI_FUNC_CONT_3_TO_4(NAME);\ _PURS_FFI_FUNC_CONT_2_TO_3(NAME);\ _PURS_FFI_FUNC_CONT_1_TO_2(NAME);\ - _PURS_FFI_FUNC_ENTRY(NAME) + _PURS_FFI_FUNC_ENTRY(NAME);\ + ANY NAME##__11_impl (ANY A1, ANY A2, ANY A3, ANY A4, ANY A5, ANY A6, ANY A7, ANY A8, ANY A9, ANY A10, ANY A11) -#define PURS_FFI_FUNC_12(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, BODY)\ +#define PURS_FFI_FUNC_12(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12)\ + ANY NAME##__12_impl (ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY);\ ANY NAME##__12 (const purs_scope_t * $__super__, ANY A12, va_list $__unused__) {\ ANY A1 = $__super__->bindings[0];\ ANY A2 = $__super__->bindings[1];\ @@ -1005,7 +1028,7 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { ANY A9 = $__super__->bindings[8];\ ANY A10 = $__super__->bindings[9];\ ANY A11 = $__super__->bindings[10];\ - BODY;\ + return NAME##__12_impl(A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12);\ }\ _PURS_FFI_FUNC_CONT_11_TO_12(NAME);\ _PURS_FFI_FUNC_CONT_10_TO_11(NAME);\ @@ -1018,7 +1041,8 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { _PURS_FFI_FUNC_CONT_3_TO_4(NAME);\ _PURS_FFI_FUNC_CONT_2_TO_3(NAME);\ _PURS_FFI_FUNC_CONT_1_TO_2(NAME);\ - _PURS_FFI_FUNC_ENTRY(NAME) + _PURS_FFI_FUNC_ENTRY(NAME);\ + ANY NAME##__12_impl (ANY A1, ANY A2, ANY A3, ANY A4, ANY A5, ANY A6, ANY A7, ANY A8, ANY A9, ANY A10, ANY A11, ANY A12) /* // ----------------------------------------------------------------------------- */ /* // FFI: fixed-arity uncurried functions */ diff --git a/tests/02-foreign/src/Main.c b/tests/02-foreign/src/Main.c index 32e55f5..604ed94 100644 --- a/tests/02-foreign/src/Main.c +++ b/tests/02-foreign/src/Main.c @@ -8,20 +8,20 @@ void buf_free(void* tag, void* data) { purs_free(buf); } -PURS_FFI_FUNC_1(Main_newBuffer, _, { +PURS_FFI_FUNC_1(Main_newBuffer, _) { struct buf * buf = purs_new(struct buf); buf->data = NULL; buf->size = 0; return purs_any_foreign(purs_foreign_new(NULL, buf, buf_free)); -}); +} -PURS_FFI_FUNC_2(Main_bufferSize, x, _, { +PURS_FFI_FUNC_2(Main_bufferSize, x, _) { assert(x.tag == PURS_ANY_TAG_FOREIGN); struct buf * buf = (struct buf *) x.value.foreign->data; return purs_any_int(buf->size); -}); +} -PURS_FFI_FUNC_3(Main_bufferGrow, n_, x, _, { +PURS_FFI_FUNC_3(Main_bufferGrow, n_, x, _) { assert(x.tag == PURS_ANY_TAG_FOREIGN); int n = purs_any_get_int(n_); struct buf * buf = (struct buf *) x.value.foreign->data; @@ -31,4 +31,4 @@ PURS_FFI_FUNC_3(Main_bufferGrow, n_, x, _, { buf->size += n; buf->data = data; return purs_any_int(buf->size); -}); +} diff --git a/tests/04-memory/src/Main.c b/tests/04-memory/src/Main.c index 1014174..5544be2 100644 --- a/tests/04-memory/src/Main.c +++ b/tests/04-memory/src/Main.c @@ -1,5 +1,5 @@ #include "Main.h" -PURS_FFI_FUNC_2(Main_sub, x, y, { +PURS_FFI_FUNC_2(Main_sub, x, y) { return purs_any_int(purs_any_get_int(x) - purs_any_get_int(y)); -}); +} diff --git a/upstream/tests/purs/passing/FunWithFunDeps.c b/upstream/tests/purs/passing/FunWithFunDeps.c index 73548ef..26d3d19 100644 --- a/upstream/tests/purs/passing/FunWithFunDeps.c +++ b/upstream/tests/purs/passing/FunWithFunDeps.c @@ -2,15 +2,15 @@ PURS_FFI_VALUE(Main_fnil, PURS_ANY_ARRAY(NULL)); -PURS_FFI_FUNC_2(Main_fcons, _hd, _tl, { +PURS_FFI_FUNC_2(Main_fcons, _hd, _tl) { return purs_any_concat(purs_any_array_new(purs_vec_new_va(1, _hd)), _tl); -}); +} -PURS_FFI_FUNC_3(Main_fappend, _, _left, _right, { +PURS_FFI_FUNC_3(Main_fappend, _, _left, _right) { return purs_any_concat(_left, _right); -}); +} -PURS_FFI_FUNC_2(Main_fflatten, _, _v, { +PURS_FFI_FUNC_2(Main_fflatten, _, _v) { const purs_vec_t * v = purs_any_get_array(_v); int i; const purs_any_t * tmp; @@ -19,8 +19,8 @@ PURS_FFI_FUNC_2(Main_fflatten, _, _v, { o = purs_any_concat(o, tmp); } return o; -}); +} -PURS_FFI_FUNC_1(Main_ftoArray, x, { +PURS_FFI_FUNC_1(Main_ftoArray, x) { return x; -}); +} diff --git a/upstream/tests/purs/passing/PolyLabels.c b/upstream/tests/purs/passing/PolyLabels.c index 1593dd8..124e2e0 100644 --- a/upstream/tests/purs/passing/PolyLabels.c +++ b/upstream/tests/purs/passing/PolyLabels.c @@ -1,15 +1,15 @@ #include -PURS_FFI_FUNC_2(Main_unsafeGet, _s, _o, { +PURS_FFI_FUNC_2(Main_unsafeGet, _s, _o) { const purs_record_t * o = purs_any_get_record(_o); const void * s = purs_any_get_string(_s); const purs_record_t * v = purs_record_find_by_key(o, s); assert(v != NULL); return v->value; -}); +} -PURS_FFI_FUNC_3(Main_unsafeSet, _s, _a, _o, { +PURS_FFI_FUNC_3(Main_unsafeSet, _s, _a, _o) { const purs_record_t * o = purs_any_get_record(_o); const void * s = purs_any_get_string(_s); return purs_any_record_new(purs_record_add_multi(o, 1, s, _a)); -}); +} diff --git a/upstream/tests/purs/passing/RowUnion.c b/upstream/tests/purs/passing/RowUnion.c index d904434..80218d6 100644 --- a/upstream/tests/purs/passing/RowUnion.c +++ b/upstream/tests/purs/passing/RowUnion.c @@ -1,7 +1,7 @@ #include -PURS_FFI_FUNC_3(Main_merge, _, _l, _r, { +PURS_FFI_FUNC_3(Main_merge, _, _l, _r) { const purs_record_t * l = purs_any_get_record(_l); const purs_record_t * r = purs_any_get_record(_r); return purs_any_record_new(purs_record_merge(l, r)); -}); +} From 8ed1b1cef4e657f2139c5772600d75236667c699 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Tue, 5 Nov 2019 13:06:49 +1300 Subject: [PATCH 55/67] Get all tests passing --- package-sets/packages.dhall | 30 ++++++++++-------------------- tests/10-prelude/packages.dhall | 2 +- tests/10-prelude/src/Main.h | 4 ++-- 3 files changed, 13 insertions(+), 23 deletions(-) diff --git a/package-sets/packages.dhall b/package-sets/packages.dhall index a9c55ed..0483436 100644 --- a/package-sets/packages.dhall +++ b/package-sets/packages.dhall @@ -8,11 +8,9 @@ let filter = let packages = { effect = - upstream.effect - // { repo = "/home/felix/projects/pure-c/purescript-effect" } + /home/felix/projects/pure-c/purescript-effect/spago.dhall as Location , prelude = - upstream.prelude - // { repo = "/home/felix/projects/pure-c/purescript-prelude" } + /home/felix/projects/pure-c/purescript-prelude/spago.dhall as Location , arrays = upstream.arrays // { repo = "https://github.com/pure-c/purescript-arrays.git" } @@ -21,8 +19,7 @@ let packages = // { repo = "https://github.com/pure-c/purescript-assert.git" } , bifunctors = upstream.bifunctors - // { repo = - "https://github.com/purescript/purescript-bifunctors.git" + // { repo = "https://github.com/purescript/purescript-bifunctors.git" } , console = upstream.console @@ -61,17 +58,13 @@ let packages = upstream.identity // { repo = "https://github.com/purescript/purescript-identity.git" } , integers = - { repo = - "https://github.com/pure-c/purescript-integers" - , version = - "c" - , dependencies = - [ "math", "maybe", "prelude" ] + { repo = "https://github.com/pure-c/purescript-integers" + , version = "c" + , dependencies = [ "math", "maybe", "prelude" ] } , invariant = upstream.invariant - // { repo = - "https://github.com/purescript/purescript-invariant.git" + // { repo = "https://github.com/purescript/purescript-invariant.git" } , lazy = upstream.lazy @@ -81,10 +74,8 @@ let packages = // { repo = "https://github.com/purescript/purescript-lists.git" } , math = upstream.math - // { repo = - "https://github.com/pure-c/purescript-math.git" - , version = - "purescript-integers" + // { repo = "https://github.com/pure-c/purescript-math.git" + , version = "purescript-integers" } , maybe = upstream.maybe @@ -139,8 +130,7 @@ let packages = // { repo = "https://github.com/pure-c/purescript-unfoldable.git" } , unsafe-coerce = upstream.unsafe-coerce - // { repo = - "https://github.com/pure-c/purescript-unsafe-coerce.git" + // { repo = "https://github.com/pure-c/purescript-unsafe-coerce.git" } , variant = upstream.variant diff --git a/tests/10-prelude/packages.dhall b/tests/10-prelude/packages.dhall index 1e24bba..f959b31 100644 --- a/tests/10-prelude/packages.dhall +++ b/tests/10-prelude/packages.dhall @@ -6,4 +6,4 @@ let overrides = {=} let additions = {=} -in upstream ⫽ overrides ⫽ additions +in upstream // overrides // additions diff --git a/tests/10-prelude/src/Main.h b/tests/10-prelude/src/Main.h index 3f74a0b..c1a49ac 100644 --- a/tests/10-prelude/src/Main.h +++ b/tests/10-prelude/src/Main.h @@ -3,10 +3,10 @@ #include -PURS_FFI_FUNC_2(Main_putStrLn, s_, _, { +PURS_FFI_FUNC_2(Main_putStrLn, s_, _) { const purs_str_t * s = purs_any_force_string(s_); PURS_RC_RELEASE(s); return purs_any_int_zero; -}); +} #endif // Main_H From bf6c4bf8f79f139f8de758cde9ed960d96211b75 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Tue, 5 Nov 2019 13:17:48 +1300 Subject: [PATCH 56/67] Work towards getting upstream tests flying again --- mk/target.mk | 2 +- package-sets/packages.dhall | 4 +++- test/Upstream.purs | 2 +- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/mk/target.mk b/mk/target.mk index 1011152..d36d3ad 100644 --- a/mk/target.mk +++ b/mk/target.mk @@ -20,7 +20,7 @@ PUREC_PM ?= spago ifeq ($(PUREC_PM),spago) DEPS_DIR = .spago SPAGO ?= spago -DEPS_INSTALL = $(SPAGO) install +DEPS_INSTALL = $(SPAGO) install -c skip PACKAGE_SOURCES = $(shell [ -d .spago ] && $(SPAGO) sources) else ifeq ($(PUREC_PM),bower) BOWER ?= bower diff --git a/package-sets/packages.dhall b/package-sets/packages.dhall index 0483436..03abd84 100644 --- a/package-sets/packages.dhall +++ b/package-sets/packages.dhall @@ -16,7 +16,9 @@ let packages = // { repo = "https://github.com/pure-c/purescript-arrays.git" } , assert = upstream.assert - // { repo = "https://github.com/pure-c/purescript-assert.git" } + // { repo = "https://github.com/pure-c/purescript-assert.git" + , version = "master" + } , bifunctors = upstream.bifunctors // { repo = "https://github.com/purescript/purescript-bifunctors.git" diff --git a/test/Upstream.purs b/test/Upstream.purs index 1612f96..8425f3f 100644 --- a/test/Upstream.purs +++ b/test/Upstream.purs @@ -88,7 +88,7 @@ premain: $(srcs) @touch $^ || { :; } @cp "$(PUREC_DIR)"/package-sets/* . @cp "$(PUREC_DIR)"/upstream/tests/support/spago.dhall . - @$(SPAGO) install + @$(SPAGO) install -c skip @$(MAKE) -s main $(eval $(call purs_mk_target,main,Main,$(srcs))) From 330cba91115a074ca9189feb852ad50bae526ed5 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Wed, 6 Nov 2019 09:19:11 +1300 Subject: [PATCH 57/67] Simplify custom package-set's packages.dhall --- package-sets/packages.dhall | 88 ++++++++----------------------------- 1 file changed, 19 insertions(+), 69 deletions(-) diff --git a/package-sets/packages.dhall b/package-sets/packages.dhall index 03abd84..c6958fc 100644 --- a/package-sets/packages.dhall +++ b/package-sets/packages.dhall @@ -19,24 +19,15 @@ let packages = // { repo = "https://github.com/pure-c/purescript-assert.git" , version = "master" } - , bifunctors = - upstream.bifunctors - // { repo = "https://github.com/purescript/purescript-bifunctors.git" - } + , bifunctors = upstream.bifunctors , console = upstream.console // { repo = "https://github.com/pure-c/purescript-console.git" } , control = upstream.control // { repo = "https://github.com/pure-c/purescript-control.git" } - , distributive = - upstream.distributive - // { repo = - "https://github.com/purescript/purescript-distributive.git" - } - , either = - upstream.either - // { repo = "https://github.com/purescript/purescript-either.git" } + , distributive = upstream.distributive + , either = upstream.either , enums = upstream.enums // { repo = "https://github.com/pure-c/purescript-enums.git" } @@ -48,55 +39,32 @@ let packages = , functions = upstream.functions // { repo = "https://github.com/pure-c/purescript-functions.git" } - , gen = - upstream.gen - // { repo = "https://github.com/purescript/purescript-gen.git" } - , generics-rep = - upstream.generics-rep - // { repo = - "https://github.com/purescript/purescript-generics-rep.git" - } - , identity = - upstream.identity - // { repo = "https://github.com/purescript/purescript-identity.git" } + , gen = upstream.gen + , generics-rep = upstream.generics-rep + , identity = upstream.identity , integers = { repo = "https://github.com/pure-c/purescript-integers" , version = "c" , dependencies = [ "math", "maybe", "prelude" ] } - , invariant = - upstream.invariant - // { repo = "https://github.com/purescript/purescript-invariant.git" - } + , invariant = upstream.invariant , lazy = upstream.lazy // { repo = "https://github.com/pure-c/purescript-lazy.git" } - , lists = - upstream.lists - // { repo = "https://github.com/purescript/purescript-lists.git" } + , lists = upstream.lists , math = upstream.math // { repo = "https://github.com/pure-c/purescript-math.git" , version = "purescript-integers" } - , maybe = - upstream.maybe - // { repo = "https://github.com/purescript/purescript-maybe.git" } - , newtype = - upstream.newtype - // { repo = "https://github.com/purescript/purescript-newtype.git" } - , nonempty = - upstream.nonempty - // { repo = "https://github.com/purescript/purescript-nonempty.git" } - , orders = - upstream.orders - // { repo = "https://github.com/purescript/purescript-orders.git" } + , maybe = upstream.maybe + , newtype = upstream.newtype + , nonempty = upstream.nonempty + , orders = upstream.orders , partial = upstream.partial // { repo = "https://github.com/pure-c/purescript-partial.git" } - , proxy = - upstream.proxy - // { repo = "https://github.com/purescript/purescript-proxy.git" } + , proxy = upstream.proxy , record = upstream.record // { repo = "https://github.com/pure-c/purescript-record.git" } @@ -106,27 +74,11 @@ let packages = , st = upstream.st // { repo = "https://github.com/pure-c/purescript-st.git" } - , tailrec = - upstream.tailrec - // { repo = "https://github.com/purescript/purescript-tailrec.git" } - , transformers = - upstream.transformers - // { repo = - "https://github.com/purescript/purescript-transformers.git" - } - , tuples = - upstream.tuples - // { repo = "https://github.com/purescript/purescript-tuples.git" } - , type-equality = - upstream.type-equality - // { repo = - "https://github.com/purescript/purescript-type-equality.git" - } - , typelevel-prelude = - upstream.typelevel-prelude - // { repo = - "https://github.com/purescript/purescript-typelevel-prelude.git" - } + , tailrec = upstream.tailrec + , transformers = upstream.transformers + , tuples = upstream.tuples + , type-equality = upstream.type-equality + , typelevel-prelude = upstream.typelevel-prelude , unfoldable = upstream.unfoldable // { repo = "https://github.com/pure-c/purescript-unfoldable.git" } @@ -134,9 +86,7 @@ let packages = upstream.unsafe-coerce // { repo = "https://github.com/pure-c/purescript-unsafe-coerce.git" } - , variant = - upstream.variant - // { repo = "https://github.com/natefaubion/purescript-variant.git" } + , variant = upstream.variant } in packages From 7541f88af9a7f6681bf83dd8a5b60e3eff90b903 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Thu, 7 Nov 2019 09:26:05 +1300 Subject: [PATCH 58/67] Simplify tests' spago.dhall --- tests/10-prelude/packages.dhall | 9 --------- tests/10-prelude/spago.dhall | 12 ++++-------- 2 files changed, 4 insertions(+), 17 deletions(-) delete mode 100644 tests/10-prelude/packages.dhall diff --git a/tests/10-prelude/packages.dhall b/tests/10-prelude/packages.dhall deleted file mode 100644 index f959b31..0000000 --- a/tests/10-prelude/packages.dhall +++ /dev/null @@ -1,9 +0,0 @@ -let mkPackage = ../../package-sets/mkPackage.dhall - -let upstream = ../../package-sets/packages.dhall - -let overrides = {=} - -let additions = {=} - -in upstream // overrides // additions diff --git a/tests/10-prelude/spago.dhall b/tests/10-prelude/spago.dhall index 080368b..5e82db8 100644 --- a/tests/10-prelude/spago.dhall +++ b/tests/10-prelude/spago.dhall @@ -1,9 +1,5 @@ -{ name = - "purec-test-prelude" -, dependencies = - [ "prelude" ] -, packages = - ./packages.dhall -, sources = - [ "src/**/*.purs", "test/**/*.purs" ] +{ name = "purec-test-prelude" +, dependencies = [ "prelude" ] +, packages = ../../package-sets/packages.dhall +, sources = [ "src/**/*.purs", "test/**/*.purs" ] } From dfec898c00c164c0acdbdca4271ac6f3d58bf0ba Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Thu, 7 Nov 2019 09:26:28 +1300 Subject: [PATCH 59/67] Improve PURS_ANY_THUNK_DEF macro for better line nos when debugging --- runtime/purescript.h | 38 +++++---------------- src/Language/PureScript/CodeGen/C/File.purs | 18 +++++----- 2 files changed, 18 insertions(+), 38 deletions(-) diff --git a/runtime/purescript.h b/runtime/purescript.h index d9fe04c..c4bb666 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -616,35 +616,14 @@ struct purs_scope * purs_scope_new1(int size); /* allocate a buffer to fit 'N' 'ANY's */ #define purs_malloc_any_buf(N) purs_malloc(sizeof (ANY) * N) -/** - * XXX: Static thunks technically leak memory when they are first forced. For - * values known at compile time, we could - in theory - allocate the - * structure as data in the binary. However, for mere reason of simplicity - * in implementation, we thunk them into heap-allocated memory. - * To avoid 'libcmocka' reporting these "leaks", we simply do not hold on - * to the results. +/* declare a thunked top-level value. + todo: consider caching top-level thunks once forced. */ -#ifndef CACHE_TOPLEVEL_THUNKS -#define _PURS_ANY_THUNK_INIT(INIT)\ - return INIT; -#else -#define _PURS_ANY_THUNK_INIT(INIT)\ - static ANY v;\ - static int x = 0;\ - if (x == 0) {\ - x = 1;\ - v = INIT;\ - PURS_ANY_RETAIN(v); /* never free */\ - } else {\ - PURS_ANY_RETAIN(v);\ - }\ - return v; -#endif // UNIT_TESTING - -/* declare a thunked top-level value. */ -#define PURS_ANY_THUNK_DEF(NAME, INIT)\ +#define PURS_ANY_THUNK_DEF(NAME)\ + static ANY NAME ## __thunk_fn__init();\ static ANY NAME ## __thunk_fn__ (void * __unused__1) { \ - _PURS_ANY_THUNK_INIT(INIT);\ + + return NAME ## __thunk_fn__init();\ };\ purs_thunk_t NAME ## __thunk__ = {\ .fn = NAME ## __thunk_fn__,\ @@ -654,7 +633,8 @@ struct purs_scope * purs_scope_new1(int size); ANY NAME = {\ .tag = PURS_ANY_TAG_THUNK,\ .value = { .thunk = & NAME ## __thunk__ }\ - }; + };\ + ANY NAME ## __thunk_fn__init() #define purs_any_int_neg(X) purs_any_int_new(-purs_any_get_int(X)) @@ -663,7 +643,7 @@ struct purs_scope * purs_scope_new1(int size); // ----------------------------------------------------------------------------- #define PURS_ANY_NULL\ - ((purs_any_t){ .tag = PURS_ANY_TAG_NULL }) + (purs_any_t){ .tag = PURS_ANY_TAG_NULL }) #define PURS_ANY_INT(X)\ ((purs_any_t){ .tag = PURS_ANY_TAG_INT, .value = { .i = (X) } }) diff --git a/src/Language/PureScript/CodeGen/C/File.purs b/src/Language/PureScript/CodeGen/C/File.purs index 7b863ec..08ef403 100644 --- a/src/Language/PureScript/CodeGen/C/File.purs +++ b/src/Language/PureScript/CodeGen/C/File.purs @@ -79,11 +79,11 @@ toHeader = A.catMaybes <<< map go Nothing toBody :: Array AST -> Array AST -toBody = A.catMaybes <<< map go +toBody = A.concat <<< A.catMaybes <<< map go where - go :: AST -> Maybe AST + go :: AST -> Maybe (Array AST) go x@(AST.Function _) = - Just x + Just [x] go (AST.VariableIntroduction { name, type: typ, initialization: Just initialization }) = go' initialization where @@ -94,12 +94,12 @@ toBody = A.catMaybes <<< map go -- variables is that freeing these resources becomes tricky, as they -- would need to be able to be re-initialized after the RC drops to -- back to zero. - Just $ - AST.App - R._PURS_ANY_THUNK_DEF - [ AST.Raw name - , ast - ] + Just + [ AST.App R._PURS_ANY_THUNK_DEF [ AST.Raw name ] + , AST.Block + [ AST.Return ast + ] + ] go _ = Nothing -- XXX: should be configurable From 23af726c3e6bd65f01da1bde25731c118e2ee006 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Thu, 7 Nov 2019 09:27:35 +1300 Subject: [PATCH 60/67] Commit to Spago --- Makefile | 18 ++++-------------- 1 file changed, 4 insertions(+), 14 deletions(-) diff --git a/Makefile b/Makefile index 3e7c114..40509a8 100644 --- a/Makefile +++ b/Makefile @@ -5,7 +5,6 @@ SHELL := /bin/bash SHELLFLAGS := -eo pipefail PURS := PATH=$$PATH:node_modules/.bin purs -PULP := PATH=$$PATH:node_modules/.bin pulp SPAGO := PATH=$$PATH:node_modules/.bin spago PUREC_JS := purec.js @@ -87,7 +86,7 @@ deps:\ deps/npm: @npm install - @node_modules/.bin/bower install + $(SPAGO) install .PHONY: deps/npm #------------------------------------------------------------------------------- @@ -178,9 +177,9 @@ test/tests/main.0: .PHONY: test/tests/main.0 test/upstream: - @$(MAKE) -s clean - @$(PULP) test > /dev/null -.PHONY: test/pulp + $(MAKE) clean + $(SPAGO) test +.PHONY: test/upstream test: @echo '=== test: c-tests ===================================================' @@ -191,12 +190,3 @@ test: @#$(MAKE) -s test/upstream @#echo 'success!' .PHONY: test - -#------------------------------------------------------------------------------- -# utilities -#------------------------------------------------------------------------------- - -%/bower_components: - @ROOT=$(PWD) &&\ - cd "$(dir $@)" &&\ - "$$ROOT/node_modules/.bin/bower" install From 43005c170f37bb22531e3620ab5ce50057346955 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Thu, 7 Nov 2019 09:28:13 +1300 Subject: [PATCH 61/67] Add tests for purescript-effect Since the actual package has no tests... --- Makefile | 3 ++- tests/11-effects/Makefile | 13 +++++++++++++ tests/11-effects/spago.dhall | 9 +++++++++ tests/11-effects/src/Main.h | 18 ++++++++++++++++++ tests/11-effects/src/Main.purs | 18 ++++++++++++++++++ 5 files changed, 60 insertions(+), 1 deletion(-) create mode 100644 tests/11-effects/Makefile create mode 100644 tests/11-effects/spago.dhall create mode 100644 tests/11-effects/src/Main.h create mode 100644 tests/11-effects/src/Main.purs diff --git a/Makefile b/Makefile index 40509a8..c2d6a29 100644 --- a/Makefile +++ b/Makefile @@ -28,7 +28,8 @@ TESTS = \ 04-memory \ 05-datacons \ 06-typeclasses \ - 10-prelude + 10-prelude \ + 11-effects ifdef UNIT_TESTING CFLAGS += \ diff --git a/tests/11-effects/Makefile b/tests/11-effects/Makefile new file mode 100644 index 0000000..9460552 --- /dev/null +++ b/tests/11-effects/Makefile @@ -0,0 +1,13 @@ +default: main +.PHONY: default + +PUREC_DIR := ../.. +include $(PUREC_DIR)/mk/target.mk + +main: .spago + +main_CFLAGS = -g +main_LD_FLAGS = -lm + +$(eval $(call purs_mk_target,main,Main,src)) +$(eval $(call purs_mk_target,lib,,src)) diff --git a/tests/11-effects/spago.dhall b/tests/11-effects/spago.dhall new file mode 100644 index 0000000..225676c --- /dev/null +++ b/tests/11-effects/spago.dhall @@ -0,0 +1,9 @@ +{ name = + "purec-test-effects" +, dependencies = + [ "prelude", "effect" ] +, packages = + ../../package-sets/packages.dhall +, sources = + [ "src/**/*.purs", "test/**/*.purs" ] +} diff --git a/tests/11-effects/src/Main.h b/tests/11-effects/src/Main.h new file mode 100644 index 0000000..2309aa4 --- /dev/null +++ b/tests/11-effects/src/Main.h @@ -0,0 +1,18 @@ +#ifndef Main_H +#define Main_H + +#include + +PURS_FFI_FUNC_1(Main_someStr, _) { + const purs_str_t *s = purs_str_new("%s", "hi!"); + return purs_any_string(s); +} + +PURS_FFI_FUNC_2(Main_putStrLn, s_, _) { + const purs_str_t * s = purs_any_force_string(s_); + printf("%s\n", s->data); + PURS_RC_RELEASE(s); + return purs_any_int_zero; +} + +#endif // Main_H diff --git a/tests/11-effects/src/Main.purs b/tests/11-effects/src/Main.purs new file mode 100644 index 0000000..51fa0f1 --- /dev/null +++ b/tests/11-effects/src/Main.purs @@ -0,0 +1,18 @@ +module Main where + +import Prelude +import Effect +import Effect.Unsafe + +foreign import putStrLn :: String -> Effect Int +foreign import someStr :: Effect String + +main :: Effect Int +main = + let message = unsafePerformEffect someStr + in bind (void (pure { foo: "bar" })) \_ -> + bind someStr \s -> + bind (putStrLn s) \_ -> + bind someStr \s' -> + bind (putStrLn (s <> "and" <> s')) \_ -> + putStrLn "world" From e0a0073a4557d05e22b77bd7d1c4b5efa6b86ee7 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Fri, 8 Nov 2019 09:24:21 +1300 Subject: [PATCH 62/67] Resurrect improved PURS_FFI_FUNC_UNCURRIED_* macros --- runtime/purescript.h | 333 ++++++++++++++++++++++++------------------- 1 file changed, 183 insertions(+), 150 deletions(-) diff --git a/runtime/purescript.h b/runtime/purescript.h index c4bb666..344e23f 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -622,7 +622,6 @@ struct purs_scope * purs_scope_new1(int size); #define PURS_ANY_THUNK_DEF(NAME)\ static ANY NAME ## __thunk_fn__init();\ static ANY NAME ## __thunk_fn__ (void * __unused__1) { \ - return NAME ## __thunk_fn__init();\ };\ purs_thunk_t NAME ## __thunk__ = {\ @@ -643,7 +642,7 @@ struct purs_scope * purs_scope_new1(int size); // ----------------------------------------------------------------------------- #define PURS_ANY_NULL\ - (purs_any_t){ .tag = PURS_ANY_TAG_NULL }) + ((purs_any_t){ .tag = PURS_ANY_TAG_NULL }) #define PURS_ANY_INT(X)\ ((purs_any_t){ .tag = PURS_ANY_TAG_INT, .value = { .i = (X) } }) @@ -1024,154 +1023,188 @@ static inline ANY purs_indirect_thunk_new(ANY * x) { _PURS_FFI_FUNC_ENTRY(NAME);\ ANY NAME##__12_impl (ANY A1, ANY A2, ANY A3, ANY A4, ANY A5, ANY A6, ANY A7, ANY A8, ANY A9, ANY A10, ANY A11, ANY A12) -/* // ----------------------------------------------------------------------------- */ -/* // FFI: fixed-arity uncurried functions */ -/* // ----------------------------------------------------------------------------- */ - -/* #define _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME)\ */ -/* ANY NAME##__1_ = {\ */ -/* .tag = PURS_ANY_TAG_CONT,\ */ -/* .value = { .cont = { .fn = NAME, .ctx = purs_any_null } }\ */ -/* };\ */ -/* ANY NAME ## _$ = & NAME##__1_ */ - -/* #define PURS_FFI_FUNC_UNCURRIED_1(NAME, A1, BODY)\ */ -/* ANY NAME (const void * $__super__, ANY A1, va_list $__unused__) {\ */ -/* BODY;\ */ -/* }\ */ -/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ - -/* #define PURS_FFI_FUNC_UNCURRIED_2(NAME, A1, A2, BODY)\ */ -/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ -/* ANY A2 = va_arg(vl, ANY);\ */ -/* BODY;\ */ -/* }\ */ -/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ - -/* #define PURS_FFI_FUNC_UNCURRIED_3(NAME, A1, A2, A3, BODY)\ */ -/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ -/* ANY A2 = va_arg(vl, ANY);\ */ -/* ANY A3 = va_arg(vl, ANY);\ */ -/* BODY;\ */ -/* }\ */ -/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ - -/* #define PURS_FFI_FUNC_UNCURRIED_4(NAME, A1, A2, A3, A4, BODY)\ */ -/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ -/* ANY A2 = va_arg(vl, ANY);\ */ -/* ANY A3 = va_arg(vl, ANY);\ */ -/* ANY A4 = va_arg(vl, ANY);\ */ -/* BODY;\ */ -/* }\ */ -/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ - -/* #define PURS_FFI_FUNC_UNCURRIED_5(NAME, A1, A2, A3, A4, A5, BODY)\ */ -/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ -/* ANY A2 = va_arg(vl, ANY);\ */ -/* ANY A3 = va_arg(vl, ANY);\ */ -/* ANY A4 = va_arg(vl, ANY);\ */ -/* ANY A5 = va_arg(vl, ANY);\ */ -/* BODY;\ */ -/* }\ */ -/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ - -/* #define PURS_FFI_FUNC_UNCURRIED_6(NAME, A1, A2, A3, A4, A5, A6, BODY)\ */ -/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ -/* ANY A2 = va_arg(vl, ANY);\ */ -/* ANY A3 = va_arg(vl, ANY);\ */ -/* ANY A4 = va_arg(vl, ANY);\ */ -/* ANY A5 = va_arg(vl, ANY);\ */ -/* ANY A6 = va_arg(vl, ANY);\ */ -/* BODY;\ */ -/* }\ */ -/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ - -/* #define PURS_FFI_FUNC_UNCURRIED_7(NAME, A1, A2, A3, A4, A5, A6, A7, BODY)\ */ -/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ -/* ANY A2 = va_arg(vl, ANY);\ */ -/* ANY A3 = va_arg(vl, ANY);\ */ -/* ANY A4 = va_arg(vl, ANY);\ */ -/* ANY A5 = va_arg(vl, ANY);\ */ -/* ANY A6 = va_arg(vl, ANY);\ */ -/* ANY A7 = va_arg(vl, ANY);\ */ -/* BODY;\ */ -/* }\ */ -/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ - -/* #define PURS_FFI_FUNC_UNCURRIED_8(NAME, A1, A2, A3, A4, A5, A6, A7, A8, BODY)\ */ -/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ -/* ANY A2 = va_arg(vl, ANY);\ */ -/* ANY A3 = va_arg(vl, ANY);\ */ -/* ANY A4 = va_arg(vl, ANY);\ */ -/* ANY A5 = va_arg(vl, ANY);\ */ -/* ANY A6 = va_arg(vl, ANY);\ */ -/* ANY A7 = va_arg(vl, ANY);\ */ -/* ANY A8 = va_arg(vl, ANY);\ */ -/* BODY;\ */ -/* }\ */ -/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ - -/* #define PURS_FFI_FUNC_UNCURRIED_9(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, BODY)\ */ -/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ -/* ANY A2 = va_arg(vl, ANY);\ */ -/* ANY A3 = va_arg(vl, ANY);\ */ -/* ANY A4 = va_arg(vl, ANY);\ */ -/* ANY A5 = va_arg(vl, ANY);\ */ -/* ANY A6 = va_arg(vl, ANY);\ */ -/* ANY A7 = va_arg(vl, ANY);\ */ -/* ANY A8 = va_arg(vl, ANY);\ */ -/* ANY A9 = va_arg(vl, ANY);\ */ -/* BODY;\ */ -/* }\ */ -/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ - -/* #define PURS_FFI_FUNC_UNCURRIED_10(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, BODY)\ */ -/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ -/* ANY A2 = va_arg(vl, ANY);\ */ -/* ANY A3 = va_arg(vl, ANY);\ */ -/* ANY A4 = va_arg(vl, ANY);\ */ -/* ANY A5 = va_arg(vl, ANY);\ */ -/* ANY A6 = va_arg(vl, ANY);\ */ -/* ANY A7 = va_arg(vl, ANY);\ */ -/* ANY A8 = va_arg(vl, ANY);\ */ -/* ANY A9 = va_arg(vl, ANY);\ */ -/* ANY A10 = va_arg(vl, ANY);\ */ -/* BODY;\ */ -/* }\ */ -/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ - -/* #define PURS_FFI_FUNC_UNCURRIED_11(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, BODY)\ */ -/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ -/* ANY A2 = va_arg(vl, ANY);\ */ -/* ANY A3 = va_arg(vl, ANY);\ */ -/* ANY A4 = va_arg(vl, ANY);\ */ -/* ANY A5 = va_arg(vl, ANY);\ */ -/* ANY A6 = va_arg(vl, ANY);\ */ -/* ANY A7 = va_arg(vl, ANY);\ */ -/* ANY A8 = va_arg(vl, ANY);\ */ -/* ANY A9 = va_arg(vl, ANY);\ */ -/* ANY A10 = va_arg(vl, ANY);\ */ -/* ANY A11 = va_arg(vl, ANY);\ */ -/* BODY;\ */ -/* }\ */ -/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ - -/* #define PURS_FFI_FUNC_UNCURRIED_12(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, BODY)\ */ -/* ANY NAME (const void * $__super__, ANY A1, va_list vl) {\ */ -/* ANY A2 = va_arg(vl, ANY);\ */ -/* ANY A3 = va_arg(vl, ANY);\ */ -/* ANY A4 = va_arg(vl, ANY);\ */ -/* ANY A5 = va_arg(vl, ANY);\ */ -/* ANY A6 = va_arg(vl, ANY);\ */ -/* ANY A7 = va_arg(vl, ANY);\ */ -/* ANY A8 = va_arg(vl, ANY);\ */ -/* ANY A9 = va_arg(vl, ANY);\ */ -/* ANY A10 = va_arg(vl, ANY);\ */ -/* ANY A11 = va_arg(vl, ANY);\ */ -/* ANY A12 = va_arg(vl, ANY);\ */ -/* BODY;\ */ -/* }\ */ -/* _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME) */ +// ----------------------------------------------------------------------------- +// FFI: fixed-arity uncurried functions +// ----------------------------------------------------------------------------- + +#define _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME)\ + purs_cont_t NAME ## __cont__ = {\ + .fn = NAME ## _fn,\ + .scope = NULL,\ + .rc = { .count = -1 }\ + };\ + ANY NAME = {\ + .tag = PURS_ANY_TAG_CONT,\ + .value = { .cont = & NAME ## __cont__ }\ + };\ + /* for code-gen use. todo: remove? */\ + ANY NAME ## _$ = {\ + .tag = PURS_ANY_TAG_CONT,\ + .value = { .cont = & NAME ## __cont__ }\ + } + +#define PURS_FFI_FUNC_UNCURRIED_1(NAME, A1)\ + ANY NAME##__impl (ANY);\ + ANY NAME##_fn (const purs_scope_t * $__super__, ANY A1, va_list $__unused__) {\ + return NAME##__impl (A1);\ + }\ + _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME);\ + ANY NAME##__impl (ANY A1) + +#define PURS_FFI_FUNC_UNCURRIED_2(NAME, A1, A2)\ + ANY NAME##__impl (ANY, ANY);\ + ANY NAME##_fn (const purs_scope_t * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ + return NAME##__impl (A1, A2);\ + }\ + _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME);\ + ANY NAME##__impl (ANY A1, ANY A2) + +#define PURS_FFI_FUNC_UNCURRIED_3(NAME, A1, A2, A3)\ + ANY NAME##__impl (ANY, ANY, ANY);\ + ANY NAME##_fn (const purs_scope_t * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ + ANY A3 = va_arg(vl, ANY);\ + return NAME##__impl (A1, A2, A3);\ + }\ + _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME);\ + ANY NAME##__impl (ANY A1, ANY A2, ANY A3) + +#define PURS_FFI_FUNC_UNCURRIED_4(NAME, A1, A2, A3, A4)\ + ANY NAME##__impl (ANY, ANY, ANY, ANY);\ + ANY NAME##_fn (const purs_scope_t * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ + ANY A3 = va_arg(vl, ANY);\ + ANY A4 = va_arg(vl, ANY);\ + return NAME##__impl (A1, A2, A3, A4);\ + }\ + _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME);\ + ANY NAME##__impl (ANY A1, ANY A2, ANY A3, ANY A4) + +#define PURS_FFI_FUNC_UNCURRIED_5(NAME, A1, A2, A3, A4, A5)\ + ANY NAME##__impl (ANY, ANY, ANY, ANY, ANY);\ + ANY NAME##_fn (const purs_scope_t * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ + ANY A3 = va_arg(vl, ANY);\ + ANY A4 = va_arg(vl, ANY);\ + ANY A5 = va_arg(vl, ANY);\ + return NAME##__impl (A1, A2, A3, A4, A5);\ + }\ + _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME);\ + ANY NAME##__impl (ANY A1, ANY A2, ANY A3, ANY A4, ANY A5) + +#define PURS_FFI_FUNC_UNCURRIED_6(NAME, A1, A2, A3, A4, A5, A6)\ + ANY NAME##__impl (ANY, ANY, ANY, ANY, ANY, ANY);\ + ANY NAME##_fn (const purs_scope_t * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ + ANY A3 = va_arg(vl, ANY);\ + ANY A4 = va_arg(vl, ANY);\ + ANY A5 = va_arg(vl, ANY);\ + ANY A6 = va_arg(vl, ANY);\ + return NAME##__impl (A1, A2, A3, A4, A5, A6);\ + }\ + _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME);\ + ANY NAME##__impl (ANY A1, ANY A2, ANY A3, ANY A4, ANY A5, ANY A6) + +#define PURS_FFI_FUNC_UNCURRIED_7(NAME, A1, A2, A3, A4, A5, A6, A7)\ + ANY NAME##__impl (ANY, ANY, ANY, ANY, ANY, ANY, ANY);\ + ANY NAME##_fn (const purs_scope_t * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ + ANY A3 = va_arg(vl, ANY);\ + ANY A4 = va_arg(vl, ANY);\ + ANY A5 = va_arg(vl, ANY);\ + ANY A6 = va_arg(vl, ANY);\ + ANY A7 = va_arg(vl, ANY);\ + return NAME##__impl (A1, A2, A3, A4, A5, A6, A7);\ + }\ + _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME);\ + ANY NAME##__impl (ANY A1, ANY A2, ANY A3, ANY A4, ANY A5, ANY A6, ANY A7) + +#define PURS_FFI_FUNC_UNCURRIED_8(NAME, A1, A2, A3, A4, A5, A6, A7, A8)\ + ANY NAME##__impl (ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY);\ + ANY NAME##_fn (const purs_scope_t * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ + ANY A3 = va_arg(vl, ANY);\ + ANY A4 = va_arg(vl, ANY);\ + ANY A5 = va_arg(vl, ANY);\ + ANY A6 = va_arg(vl, ANY);\ + ANY A7 = va_arg(vl, ANY);\ + ANY A8 = va_arg(vl, ANY);\ + return NAME##__impl (A1, A2, A3, A4, A5, A6, A7, A8);\ + }\ + _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME);\ + ANY NAME##__impl (ANY A1, ANY A2, ANY A3, ANY A4, ANY A5, ANY A6, ANY A7, ANY A8) + +#define PURS_FFI_FUNC_UNCURRIED_9(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9) \ + ANY NAME##__impl (ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY);\ + ANY NAME##_fn (const purs_scope_t * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ + ANY A3 = va_arg(vl, ANY);\ + ANY A4 = va_arg(vl, ANY);\ + ANY A5 = va_arg(vl, ANY);\ + ANY A6 = va_arg(vl, ANY);\ + ANY A7 = va_arg(vl, ANY);\ + ANY A8 = va_arg(vl, ANY);\ + ANY A9 = va_arg(vl, ANY);\ + return NAME##__impl (A1, A2, A3, A4, A5, A6, A7, A8, A9);\ + }\ + _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME);\ + ANY NAME##__impl (ANY A1, ANY A2, ANY A3, ANY A4, ANY A5, ANY A6, ANY A7, ANY A8, ANY A9) + +#define PURS_FFI_FUNC_UNCURRIED_10(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10) \ + ANY NAME##__impl (ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY);\ + ANY NAME##_fn (const purs_scope_t * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ + ANY A3 = va_arg(vl, ANY);\ + ANY A4 = va_arg(vl, ANY);\ + ANY A5 = va_arg(vl, ANY);\ + ANY A6 = va_arg(vl, ANY);\ + ANY A7 = va_arg(vl, ANY);\ + ANY A8 = va_arg(vl, ANY);\ + ANY A9 = va_arg(vl, ANY);\ + ANY A10 = va_arg(vl, ANY);\ + return NAME##__impl (A1, A2, A3, A4, A5, A6, A7, A8, A9, A10);\ + }\ + _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME);\ + ANY NAME##__impl (ANY A1, ANY A2, ANY A3, ANY A4, ANY A5, ANY A6, ANY A7, ANY A8, ANY A9, ANY A10) + +#define PURS_FFI_FUNC_UNCURRIED_11(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11)\ + ANY NAME##__impl (ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY);\ + ANY NAME##_fn (const purs_scope_t * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ + ANY A3 = va_arg(vl, ANY);\ + ANY A4 = va_arg(vl, ANY);\ + ANY A5 = va_arg(vl, ANY);\ + ANY A6 = va_arg(vl, ANY);\ + ANY A7 = va_arg(vl, ANY);\ + ANY A8 = va_arg(vl, ANY);\ + ANY A9 = va_arg(vl, ANY);\ + ANY A10 = va_arg(vl, ANY);\ + ANY A11 = va_arg(vl, ANY);\ + return NAME##__impl (A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11);\ + }\ + _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME);\ + ANY NAME##__impl (ANY A1, ANY A2, ANY A3, ANY A4, ANY A5, ANY A6, ANY A7, ANY A8, ANY A9, ANY A10, ANY A11) + +#define PURS_FFI_FUNC_UNCURRIED_12(NAME, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12)\ + ANY NAME##__impl (ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY, ANY); \ + ANY NAME##_fn (const purs_scope_t * $__super__, ANY A1, va_list vl) {\ + ANY A2 = va_arg(vl, ANY);\ + ANY A3 = va_arg(vl, ANY);\ + ANY A4 = va_arg(vl, ANY);\ + ANY A5 = va_arg(vl, ANY);\ + ANY A6 = va_arg(vl, ANY);\ + ANY A7 = va_arg(vl, ANY);\ + ANY A8 = va_arg(vl, ANY);\ + ANY A9 = va_arg(vl, ANY);\ + ANY A10 = va_arg(vl, ANY);\ + ANY A11 = va_arg(vl, ANY);\ + ANY A12 = va_arg(vl, ANY);\ + return NAME##__impl (A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12);\ + }\ + _PURS_FFI_FUNC_UNCURRIED_ENTRY(NAME);\ + ANY NAME##__impl (ANY A1, ANY A2, ANY A3, ANY A4, ANY A5, ANY A6, ANY A7, ANY A8, ANY A9, ANY A10, ANY A11, ANY A12) + // ----------------------------------------------------------------------------- // Prim shims From dd141f0c2b82ab5c3313ca6a9ec8868f9ca90cfe Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Mon, 1 Feb 2021 10:11:56 +1300 Subject: [PATCH 63/67] Update README, Makefile, and spago --- Makefile | 24 ++--------------- README.md | 18 +++++++------ package-sets/packages.dhall | 4 +-- package.json | 4 +-- tests/12-rec-fns/Makefile | 13 ++++++++++ tests/12-rec-fns/spago.dhall | 9 +++++++ tests/12-rec-fns/src/Main.purs | 47 ++++++++++++++++++++++++++++++++++ 7 files changed, 85 insertions(+), 34 deletions(-) create mode 100644 tests/12-rec-fns/Makefile create mode 100644 tests/12-rec-fns/spago.dhall create mode 100644 tests/12-rec-fns/src/Main.purs diff --git a/Makefile b/Makefile index c2d6a29..7ca20aa 100644 --- a/Makefile +++ b/Makefile @@ -29,7 +29,8 @@ TESTS = \ 05-datacons \ 06-typeclasses \ 10-prelude \ - 11-effects + 11-effects \ + 12-rec-fns ifdef UNIT_TESTING CFLAGS += \ @@ -52,14 +53,6 @@ $(PUREC_LIB): $(PUREC_INTERMEDIATE_LIB) .PHONY: $(PUREC_LIB) -$(PUREC_JS): - @npm run build -.PHONY: $(PUREC_JS) - -# deprecated -purec: $(PUREC_JS) -.PHONY: purec - clean: @rm -rf $(PUREC_WORKDIR) @rm -f $(RUNTIME_OBJECTS) @@ -77,19 +70,6 @@ clean: -I . \ $(CFLAGS) -#------------------------------------------------------------------------------- -# Dependencies -#------------------------------------------------------------------------------- - -deps:\ - deps/npm -.PHONY: deps - -deps/npm: - @npm install - $(SPAGO) install -.PHONY: deps/npm - #------------------------------------------------------------------------------- # Tests #------------------------------------------------------------------------------- diff --git a/README.md b/README.md index db39a7f..55f386b 100644 --- a/README.md +++ b/README.md @@ -29,7 +29,7 @@ purescript-aff and bindings to libuv on top of PureC. * Scrap your node.js * Write small, easy to distribute command line utilities -## Getting Started +## Development These instructions will get you a copy of the project up and running on your local machine for development and testing purposes. @@ -40,17 +40,19 @@ compilers. ### Prerequisites -* Install node.js, including `npm` +PureC is written in PureScript and currently not self-hoisting; A full node.js +runtime is required. With node.js installed (any recent version will work) +install the node.js dependencies to build purec.js: `npm install`. -``` -make deps -``` +Additionally, we require + +* make +* libcmocka-dev +* valgrind ## Build the purec utility -``` -make purec -``` +Run `npm run build` to build the purec.js utility. ## Running the examples diff --git a/package-sets/packages.dhall b/package-sets/packages.dhall index c6958fc..417164d 100644 --- a/package-sets/packages.dhall +++ b/package-sets/packages.dhall @@ -8,9 +8,9 @@ let filter = let packages = { effect = - /home/felix/projects/pure-c/purescript-effect/spago.dhall as Location + ../../purescript-effect/spago.dhall as Location , prelude = - /home/felix/projects/pure-c/purescript-prelude/spago.dhall as Location + ../../purescript-prelude/spago.dhall as Location , arrays = upstream.arrays // { repo = "https://github.com/pure-c/purescript-arrays.git" } diff --git a/package.json b/package.json index e73c18a..1164b3b 100644 --- a/package.json +++ b/package.json @@ -17,10 +17,10 @@ "bower": "^1.8.4", "pulp": "^12.3.0", "purescript": "^0.13.2", - "spago": "^0.8.5" + "spago": "^0.17.0" }, "scripts": { - "test": "echo \"Error: no test specified\" && exit 1", + "test": "make test", "build": "spago bundle-app -t purec.js", "watch": "spago bundle-app -w -t purec.js" }, diff --git a/tests/12-rec-fns/Makefile b/tests/12-rec-fns/Makefile new file mode 100644 index 0000000..79b02b2 --- /dev/null +++ b/tests/12-rec-fns/Makefile @@ -0,0 +1,13 @@ +default: main +.PHONY: default + +PUREC_DIR := ../.. +include $(PUREC_DIR)/mk/target.mk + +main: .spago + +main_CFLAGS = -g +main_LD_FLAGS = -lm -lcmocka + +$(eval $(call purs_mk_target,main,Main,src)) +$(eval $(call purs_mk_target,lib,,src)) diff --git a/tests/12-rec-fns/spago.dhall b/tests/12-rec-fns/spago.dhall new file mode 100644 index 0000000..225676c --- /dev/null +++ b/tests/12-rec-fns/spago.dhall @@ -0,0 +1,9 @@ +{ name = + "purec-test-effects" +, dependencies = + [ "prelude", "effect" ] +, packages = + ../../package-sets/packages.dhall +, sources = + [ "src/**/*.purs", "test/**/*.purs" ] +} diff --git a/tests/12-rec-fns/src/Main.purs b/tests/12-rec-fns/src/Main.purs new file mode 100644 index 0000000..30ec3c6 --- /dev/null +++ b/tests/12-rec-fns/src/Main.purs @@ -0,0 +1,47 @@ +module Main where + +import Prelude + +data Unit = Unit +type Effect a = Unit -> a + +chain :: Effect Int -> Effect Int -> Effect Int +chain a b = \_ -> + let x = a Unit + in + case x of + 0 -> b Unit + n -> n + +infixl 5 chain as >> + +testAnonLetBoundRecFn :: Int -> Int +testAnonLetBoundRecFn n = + let + go 0 = 0 + go n' = go (n' - 1) + in go n + +testAnonRecFn :: Int -> Int +testAnonRecFn n = go n + where + go 0 = 0 + go n' = go (n' - 1) + +testRecFn :: Int -> Int +testRecFn 0 = 0 +testRecFn n = testRecFn (n - 1) + +testNonTCORecFn :: Int -> Int +testNonTCORecFn 0 = 0 +testNonTCORecFn n = + if n + testNonTCORecFn (n - 1) == 1 + then 0 + else 1 + +main :: Effect Int +main = + (\_ -> testRecFn 10) >> + (\_ -> testAnonRecFn 10) >> + (\_ -> testAnonLetBoundRecFn 10) >> + (\_ -> testNonTCORecFn 1) From a9b84c0e1df2766f8027d5d682886b5ee2964fff Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Mon, 1 Feb 2021 10:13:49 +1300 Subject: [PATCH 64/67] Remove README section on examples, and update section on tests --- README.md | 21 +-------------------- 1 file changed, 1 insertion(+), 20 deletions(-) diff --git a/README.md b/README.md index 55f386b..4a2043d 100644 --- a/README.md +++ b/README.md @@ -54,29 +54,10 @@ Additionally, we require Run `npm run build` to build the purec.js utility. -## Running the examples - -Each example is an isolated example of how to use purec. -You can cd into each of these directories and invoke `make`. - -To build all examples: - -``` -make examples -``` - -To run a particular example: - -``` -# ./examples//main.out -# example: -./examples/example1/main.out -``` - ## Running the tests ``` -make test +npm t ``` ## Contributing From e3ca8c3eee7046b98ddb7c64bc23195d4e5d4d3a Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Thu, 4 Feb 2021 05:35:17 +1300 Subject: [PATCH 65/67] Update packages.dhall to use repos on github --- package-sets/packages.dhall | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/package-sets/packages.dhall b/package-sets/packages.dhall index 417164d..b6e32d1 100644 --- a/package-sets/packages.dhall +++ b/package-sets/packages.dhall @@ -8,9 +8,15 @@ let filter = let packages = { effect = - ../../purescript-effect/spago.dhall as Location + upstream.effect + // { repo = "https://github.com/pure-c/purescript-effect.git" + , version = "a68f6898b32e00acf4433b442289d5db2794d526" + } , prelude = - ../../purescript-prelude/spago.dhall as Location + upstream.prelude + // { repo = "https://github.com/pure-c/purescript-prelude.git" + , version = "f9fa363b63240dae99109a95c8007c76a4f32d4c" + } , arrays = upstream.arrays // { repo = "https://github.com/pure-c/purescript-arrays.git" } From f16d4a8575969591d4e07c1db556c987bb3b18d1 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Thu, 4 Feb 2021 08:23:09 +1300 Subject: [PATCH 66/67] Remove support for bower and improve build invalidation --- mk/target.mk | 21 ++++++--------------- package-sets/packages.dhall | 9 ++++++--- runtime/purescript.h | 30 ++++++++++++++---------------- 3 files changed, 26 insertions(+), 34 deletions(-) diff --git a/mk/target.mk b/mk/target.mk index d36d3ad..d73b483 100644 --- a/mk/target.mk +++ b/mk/target.mk @@ -15,22 +15,9 @@ PUREC_LIB = $(PUREC_DIR)/libpurec.a PUREC_LIB_DIR = $(dir $(PUREC_LIB)) PUREC_LIB_NAME = $(notdir %/%,%,$(PUREC_LIB)) -PUREC_PM ?= spago - -ifeq ($(PUREC_PM),spago) DEPS_DIR = .spago SPAGO ?= spago -DEPS_INSTALL = $(SPAGO) install -c skip PACKAGE_SOURCES = $(shell [ -d .spago ] && $(SPAGO) sources) -else ifeq ($(PUREC_PM),bower) -BOWER ?= bower -DEPS_DIR = bower_components -DEPS_INSTALL = $(BOWER) install -PACKAGE_SOURCES = $$(shell \ - 2>/dev/null find bower_components -type d -name 'purescript-*/src') -else -$(error PUREC_PM not recognized) -endif OS := $(shell uname) ifeq ($(OS),Darwin) @@ -39,8 +26,12 @@ else LD_LINKER_FLAGS += -gc-sections endif -$(DEPS_DIR): - $(DEPS_INSTALL) +.spago.sources.sum: + $(SPAGO) sources | md5sum > .spago.sources.sum +.PHONY: .spago.sources.sum + +.spago: .spago.sources.sum + $(SPAGO) install -c skip ## Not all environments support globstar (** dir pattern) rwildcard=$(wildcard $1$2) $(foreach d,$(wildcard $1*),$(call rwildcard,$d/,$2)) diff --git a/package-sets/packages.dhall b/package-sets/packages.dhall index b6e32d1..efd9b09 100644 --- a/package-sets/packages.dhall +++ b/package-sets/packages.dhall @@ -15,7 +15,7 @@ let packages = , prelude = upstream.prelude // { repo = "https://github.com/pure-c/purescript-prelude.git" - , version = "f9fa363b63240dae99109a95c8007c76a4f32d4c" + , version = "379849976f501cae2c0a59303ef3927f67cc99bc" } , arrays = upstream.arrays @@ -28,10 +28,13 @@ let packages = , bifunctors = upstream.bifunctors , console = upstream.console - // { repo = "https://github.com/pure-c/purescript-console.git" } + // { repo = "https://github.com/pure-c/purescript-console.git" + } , control = upstream.control - // { repo = "https://github.com/pure-c/purescript-control.git" } + // { repo = "https://github.com/pure-c/purescript-control.git" + , version = "ed59eb9a7ac30e3bb58a671b7e657665b6e8bfb9" + } , distributive = upstream.distributive , either = upstream.either , enums = diff --git a/runtime/purescript.h b/runtime/purescript.h index 344e23f..e5f3612 100644 --- a/runtime/purescript.h +++ b/runtime/purescript.h @@ -71,10 +71,10 @@ extern void _test_free(void* const ptr, const char* file, const int line); #define ANY purs_any_t #define APP purs_any_app -#define purs_any_int_t int32_t -#define purs_any_num_t double +#define purs_int_t int32_t +#define purs_num_t double -typedef utf8_int32_t purs_any_char_t; +typedef utf8_int32_t purs_char_t; typedef struct purs_vec purs_vec_t; typedef struct purs_any purs_any_t; typedef struct purs_record purs_record_t; @@ -140,9 +140,9 @@ struct _purs_rc_base { struct purs_rc rc; }; union purs_any_value { /* inline values */ - purs_any_int_t i; - purs_any_num_t n; - purs_any_char_t chr; + purs_int_t i; + purs_num_t n; + purs_char_t chr; /* self-referential, and other values */ const purs_foreign_t * foreign; @@ -334,9 +334,9 @@ static inline const purs_any_tag_t purs_any_get_tag (ANY v) { return v.value.A;\ } -__PURS_ANY_GET(int, i, purs_any_int_t, PURS_ANY_TAG_INT) -__PURS_ANY_GET(num, n, purs_any_num_t, PURS_ANY_TAG_NUM) -__PURS_ANY_GET(char, chr, purs_any_char_t, PURS_ANY_TAG_CHAR) +__PURS_ANY_GET(int, i, purs_int_t, PURS_ANY_TAG_INT) +__PURS_ANY_GET(num, n, purs_num_t, PURS_ANY_TAG_NUM) +__PURS_ANY_GET(char, chr, purs_char_t, PURS_ANY_TAG_CHAR) __PURS_ANY_GET(foreign, foreign, const purs_foreign_t *, PURS_ANY_TAG_FOREIGN) __PURS_ANY_GET(cont, cont, const purs_cont_t *, PURS_ANY_TAG_CONT) __PURS_ANY_GET(cons, cons, const purs_cons_t *, PURS_ANY_TAG_CONS) @@ -378,10 +378,9 @@ __PURS_ANY_GET(array, array, const purs_vec_t *, PURS_ANY_TAG_ARRAY) return r;\ } -__PURS_ANY_FORCE_COPY(int, i, purs_any_int_t, PURS_ANY_TAG_INT) -__PURS_ANY_FORCE_COPY(num, n, purs_any_num_t, PURS_ANY_TAG_NUM) -__PURS_ANY_FORCE_COPY(char, chr, purs_any_char_t, PURS_ANY_TAG_CHAR) - +__PURS_ANY_FORCE_COPY(int, i, purs_int_t, PURS_ANY_TAG_INT) +__PURS_ANY_FORCE_COPY(num, n, purs_num_t, PURS_ANY_TAG_NUM) +__PURS_ANY_FORCE_COPY(char, chr, purs_char_t, PURS_ANY_TAG_CHAR) __PURS_ANY_FORCE_RETAIN(cont, cont, const purs_cont_t *, PURS_ANY_TAG_CONT) __PURS_ANY_FORCE_RETAIN(cons, cons, const purs_cons_t *, PURS_ANY_TAG_CONS) __PURS_ANY_FORCE_RETAIN(thunk, thunk, const purs_thunk_t *, PURS_ANY_TAG_THUNK) @@ -390,7 +389,6 @@ __PURS_ANY_FORCE_RETAIN(string, str, const purs_str_t *, PURS_ANY_TAG_STRING) __PURS_ANY_FORCE_RETAIN(array, array, const purs_vec_t *, PURS_ANY_TAG_ARRAY) __PURS_ANY_FORCE_RETAIN(foreign, foreign, const purs_foreign_t *, PURS_ANY_TAG_FOREIGN) -/* todo: generate faster, unsafe variants */ #define purs_any_force_int(A) _purs_any_force_int((A), __FILE__, __LINE__) #define purs_any_force_num(A) _purs_any_force_num((A), __FILE__, __LINE__) #define purs_any_force_char(A) _purs_any_force_char((A), __FILE__, __LINE__) @@ -420,7 +418,7 @@ __PURS_ANY_FORCE_COPY(array_length,\ // Any: built-in functions // ----------------------------------------------------------------------------- -static inline int purs_any_eq_char (ANY x, purs_any_char_t y) { +static inline int purs_any_eq_char (ANY x, purs_char_t y) { return purs_any_get_char(x) == y; } @@ -428,7 +426,7 @@ static inline int purs_any_eq_string (ANY x, const void * str) { return utf8cmp(purs_any_get_string(x)->data, str) == 0; } -static inline int purs_any_eq_int (ANY x, purs_any_int_t y) { +static inline int purs_any_eq_int (ANY x, purs_int_t y) { return purs_any_get_int(x) == y; } From d3651c7cfb12213c9ec6e93c66f9eea418204081 Mon Sep 17 00:00:00 2001 From: Felix Schlitter Date: Thu, 4 Feb 2021 12:09:11 +1300 Subject: [PATCH 67/67] Start documenting runtime C headers --- .gitignore | 3 + Doxyfile | 2579 ++++++++++++++++++ package.json | 3 +- runtime/purescript.c | 2 +- runtime/purescript.h | 772 +++--- src/Language/PureScript/CodeGen/C.purs | 2 +- src/Language/PureScript/CodeGen/Runtime.purs | 6 +- 7 files changed, 3042 insertions(+), 325 deletions(-) create mode 100644 Doxyfile diff --git a/.gitignore b/.gitignore index 0547045..6a06c48 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,7 @@ .spago +.spago.sources.sum +/html/ +/latex/ .psc-package/ *.out *.tar.bz2 diff --git a/Doxyfile b/Doxyfile new file mode 100644 index 0000000..e1991de --- /dev/null +++ b/Doxyfile @@ -0,0 +1,2579 @@ +# Doxyfile 1.8.17 + +# This file describes the settings to be used by the documentation system +# doxygen (www.doxygen.org) for a project. +# +# All text after a double hash (##) is considered a comment and is placed in +# front of the TAG it is preceding. +# +# All text after a single hash (#) is considered a comment and will be ignored. +# The format is: +# TAG = value [value, ...] +# For lists, items can also be appended using: +# TAG += value [value, ...] +# Values that contain spaces should be placed between quotes (\" \"). + +#--------------------------------------------------------------------------- +# Project related configuration options +#--------------------------------------------------------------------------- + +# This tag specifies the encoding used for all characters in the configuration +# file that follow. The default is UTF-8 which is also the encoding used for all +# text before the first occurrence of this tag. Doxygen uses libiconv (or the +# iconv built into libc) for the transcoding. See +# https://www.gnu.org/software/libiconv/ for the list of possible encodings. +# The default value is: UTF-8. + +DOXYFILE_ENCODING = UTF-8 + +# The PROJECT_NAME tag is a single word (or a sequence of words surrounded by +# double-quotes, unless you are using Doxywizard) that should identify the +# project for which the documentation is generated. This name is used in the +# title of most generated pages and in a few other places. +# The default value is: My Project. + +PROJECT_NAME = "Pure-C" + +# The PROJECT_NUMBER tag can be used to enter a project or revision number. This +# could be handy for archiving the generated documentation or if some version +# control system is used. + +PROJECT_NUMBER = + +# Using the PROJECT_BRIEF tag one can provide an optional one line description +# for a project that appears at the top of each page and should give viewer a +# quick idea about the purpose of the project. Keep the description short. + +PROJECT_BRIEF = + +# With the PROJECT_LOGO tag one can specify a logo or an icon that is included +# in the documentation. The maximum height of the logo should not exceed 55 +# pixels and the maximum width should not exceed 200 pixels. Doxygen will copy +# the logo to the output directory. + +PROJECT_LOGO = + +# The OUTPUT_DIRECTORY tag is used to specify the (relative or absolute) path +# into which the generated documentation will be written. If a relative path is +# entered, it will be relative to the location where doxygen was started. If +# left blank the current directory will be used. + +OUTPUT_DIRECTORY = + +# If the CREATE_SUBDIRS tag is set to YES then doxygen will create 4096 sub- +# directories (in 2 levels) under the output directory of each output format and +# will distribute the generated files over these directories. Enabling this +# option can be useful when feeding doxygen a huge amount of source files, where +# putting all generated files in the same directory would otherwise causes +# performance problems for the file system. +# The default value is: NO. + +CREATE_SUBDIRS = NO + +# If the ALLOW_UNICODE_NAMES tag is set to YES, doxygen will allow non-ASCII +# characters to appear in the names of generated files. If set to NO, non-ASCII +# characters will be escaped, for example _xE3_x81_x84 will be used for Unicode +# U+3044. +# The default value is: NO. + +ALLOW_UNICODE_NAMES = NO + +# The OUTPUT_LANGUAGE tag is used to specify the language in which all +# documentation generated by doxygen is written. Doxygen will use this +# information to generate all constant output in the proper language. +# Possible values are: Afrikaans, Arabic, Armenian, Brazilian, Catalan, Chinese, +# Chinese-Traditional, Croatian, Czech, Danish, Dutch, English (United States), +# Esperanto, Farsi (Persian), Finnish, French, German, Greek, Hungarian, +# Indonesian, Italian, Japanese, Japanese-en (Japanese with English messages), +# Korean, Korean-en (Korean with English messages), Latvian, Lithuanian, +# Macedonian, Norwegian, Persian (Farsi), Polish, Portuguese, Romanian, Russian, +# Serbian, Serbian-Cyrillic, Slovak, Slovene, Spanish, Swedish, Turkish, +# Ukrainian and Vietnamese. +# The default value is: English. + +OUTPUT_LANGUAGE = English + +# The OUTPUT_TEXT_DIRECTION tag is used to specify the direction in which all +# documentation generated by doxygen is written. Doxygen will use this +# information to generate all generated output in the proper direction. +# Possible values are: None, LTR, RTL and Context. +# The default value is: None. + +OUTPUT_TEXT_DIRECTION = None + +# If the BRIEF_MEMBER_DESC tag is set to YES, doxygen will include brief member +# descriptions after the members that are listed in the file and class +# documentation (similar to Javadoc). Set to NO to disable this. +# The default value is: YES. + +BRIEF_MEMBER_DESC = YES + +# If the REPEAT_BRIEF tag is set to YES, doxygen will prepend the brief +# description of a member or function before the detailed description +# +# Note: If both HIDE_UNDOC_MEMBERS and BRIEF_MEMBER_DESC are set to NO, the +# brief descriptions will be completely suppressed. +# The default value is: YES. + +REPEAT_BRIEF = YES + +# This tag implements a quasi-intelligent brief description abbreviator that is +# used to form the text in various listings. Each string in this list, if found +# as the leading text of the brief description, will be stripped from the text +# and the result, after processing the whole list, is used as the annotated +# text. Otherwise, the brief description is used as-is. If left blank, the +# following values are used ($name is automatically replaced with the name of +# the entity):The $name class, The $name widget, The $name file, is, provides, +# specifies, contains, represents, a, an and the. + +ABBREVIATE_BRIEF = "The $name class" \ + "The $name widget" \ + "The $name file" \ + is \ + provides \ + specifies \ + contains \ + represents \ + a \ + an \ + the + +# If the ALWAYS_DETAILED_SEC and REPEAT_BRIEF tags are both set to YES then +# doxygen will generate a detailed section even if there is only a brief +# description. +# The default value is: NO. + +ALWAYS_DETAILED_SEC = NO + +# If the INLINE_INHERITED_MEMB tag is set to YES, doxygen will show all +# inherited members of a class in the documentation of that class as if those +# members were ordinary class members. Constructors, destructors and assignment +# operators of the base classes will not be shown. +# The default value is: NO. + +INLINE_INHERITED_MEMB = NO + +# If the FULL_PATH_NAMES tag is set to YES, doxygen will prepend the full path +# before files name in the file list and in the header files. If set to NO the +# shortest path that makes the file name unique will be used +# The default value is: YES. + +FULL_PATH_NAMES = YES + +# The STRIP_FROM_PATH tag can be used to strip a user-defined part of the path. +# Stripping is only done if one of the specified strings matches the left-hand +# part of the path. The tag can be used to show relative paths in the file list. +# If left blank the directory from which doxygen is run is used as the path to +# strip. +# +# Note that you can specify absolute paths here, but also relative paths, which +# will be relative from the directory where doxygen is started. +# This tag requires that the tag FULL_PATH_NAMES is set to YES. + +STRIP_FROM_PATH = + +# The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of the +# path mentioned in the documentation of a class, which tells the reader which +# header file to include in order to use a class. If left blank only the name of +# the header file containing the class definition is used. Otherwise one should +# specify the list of include paths that are normally passed to the compiler +# using the -I flag. + +STRIP_FROM_INC_PATH = + +# If the SHORT_NAMES tag is set to YES, doxygen will generate much shorter (but +# less readable) file names. This can be useful is your file systems doesn't +# support long names like on DOS, Mac, or CD-ROM. +# The default value is: NO. + +SHORT_NAMES = NO + +# If the JAVADOC_AUTOBRIEF tag is set to YES then doxygen will interpret the +# first line (until the first dot) of a Javadoc-style comment as the brief +# description. If set to NO, the Javadoc-style will behave just like regular Qt- +# style comments (thus requiring an explicit @brief command for a brief +# description.) +# The default value is: NO. + +JAVADOC_AUTOBRIEF = NO + +# If the JAVADOC_BANNER tag is set to YES then doxygen will interpret a line +# such as +# /*************** +# as being the beginning of a Javadoc-style comment "banner". If set to NO, the +# Javadoc-style will behave just like regular comments and it will not be +# interpreted by doxygen. +# The default value is: NO. + +JAVADOC_BANNER = NO + +# If the QT_AUTOBRIEF tag is set to YES then doxygen will interpret the first +# line (until the first dot) of a Qt-style comment as the brief description. If +# set to NO, the Qt-style will behave just like regular Qt-style comments (thus +# requiring an explicit \brief command for a brief description.) +# The default value is: NO. + +QT_AUTOBRIEF = NO + +# The MULTILINE_CPP_IS_BRIEF tag can be set to YES to make doxygen treat a +# multi-line C++ special comment block (i.e. a block of //! or /// comments) as +# a brief description. This used to be the default behavior. The new default is +# to treat a multi-line C++ comment block as a detailed description. Set this +# tag to YES if you prefer the old behavior instead. +# +# Note that setting this tag to YES also means that rational rose comments are +# not recognized any more. +# The default value is: NO. + +MULTILINE_CPP_IS_BRIEF = NO + +# If the INHERIT_DOCS tag is set to YES then an undocumented member inherits the +# documentation from any documented member that it re-implements. +# The default value is: YES. + +INHERIT_DOCS = YES + +# If the SEPARATE_MEMBER_PAGES tag is set to YES then doxygen will produce a new +# page for each member. If set to NO, the documentation of a member will be part +# of the file/class/namespace that contains it. +# The default value is: NO. + +SEPARATE_MEMBER_PAGES = NO + +# The TAB_SIZE tag can be used to set the number of spaces in a tab. Doxygen +# uses this value to replace tabs by spaces in code fragments. +# Minimum value: 1, maximum value: 16, default value: 4. + +TAB_SIZE = 4 + +# This tag can be used to specify a number of aliases that act as commands in +# the documentation. An alias has the form: +# name=value +# For example adding +# "sideeffect=@par Side Effects:\n" +# will allow you to put the command \sideeffect (or @sideeffect) in the +# documentation, which will result in a user-defined paragraph with heading +# "Side Effects:". You can put \n's in the value part of an alias to insert +# newlines (in the resulting output). You can put ^^ in the value part of an +# alias to insert a newline as if a physical newline was in the original file. +# When you need a literal { or } or , in the value part of an alias you have to +# escape them by means of a backslash (\), this can lead to conflicts with the +# commands \{ and \} for these it is advised to use the version @{ and @} or use +# a double escape (\\{ and \\}) + +ALIASES = + +# This tag can be used to specify a number of word-keyword mappings (TCL only). +# A mapping has the form "name=value". For example adding "class=itcl::class" +# will allow you to use the command class in the itcl::class meaning. + +TCL_SUBST = + +# Set the OPTIMIZE_OUTPUT_FOR_C tag to YES if your project consists of C sources +# only. Doxygen will then generate output that is more tailored for C. For +# instance, some of the names that are used will be different. The list of all +# members will be omitted, etc. +# The default value is: NO. + +OPTIMIZE_OUTPUT_FOR_C = NO + +# Set the OPTIMIZE_OUTPUT_JAVA tag to YES if your project consists of Java or +# Python sources only. Doxygen will then generate output that is more tailored +# for that language. For instance, namespaces will be presented as packages, +# qualified scopes will look different, etc. +# The default value is: NO. + +OPTIMIZE_OUTPUT_JAVA = NO + +# Set the OPTIMIZE_FOR_FORTRAN tag to YES if your project consists of Fortran +# sources. Doxygen will then generate output that is tailored for Fortran. +# The default value is: NO. + +OPTIMIZE_FOR_FORTRAN = NO + +# Set the OPTIMIZE_OUTPUT_VHDL tag to YES if your project consists of VHDL +# sources. Doxygen will then generate output that is tailored for VHDL. +# The default value is: NO. + +OPTIMIZE_OUTPUT_VHDL = NO + +# Set the OPTIMIZE_OUTPUT_SLICE tag to YES if your project consists of Slice +# sources only. Doxygen will then generate output that is more tailored for that +# language. For instance, namespaces will be presented as modules, types will be +# separated into more groups, etc. +# The default value is: NO. + +OPTIMIZE_OUTPUT_SLICE = NO + +# Doxygen selects the parser to use depending on the extension of the files it +# parses. With this tag you can assign which parser to use for a given +# extension. Doxygen has a built-in mapping, but you can override or extend it +# using this tag. The format is ext=language, where ext is a file extension, and +# language is one of the parsers supported by doxygen: IDL, Java, JavaScript, +# Csharp (C#), C, C++, D, PHP, md (Markdown), Objective-C, Python, Slice, +# Fortran (fixed format Fortran: FortranFixed, free formatted Fortran: +# FortranFree, unknown formatted Fortran: Fortran. In the later case the parser +# tries to guess whether the code is fixed or free formatted code, this is the +# default for Fortran type files), VHDL, tcl. For instance to make doxygen treat +# .inc files as Fortran files (default is PHP), and .f files as C (default is +# Fortran), use: inc=Fortran f=C. +# +# Note: For files without extension you can use no_extension as a placeholder. +# +# Note that for custom extensions you also need to set FILE_PATTERNS otherwise +# the files are not read by doxygen. + +EXTENSION_MAPPING = + +# If the MARKDOWN_SUPPORT tag is enabled then doxygen pre-processes all comments +# according to the Markdown format, which allows for more readable +# documentation. See https://daringfireball.net/projects/markdown/ for details. +# The output of markdown processing is further processed by doxygen, so you can +# mix doxygen, HTML, and XML commands with Markdown formatting. Disable only in +# case of backward compatibilities issues. +# The default value is: YES. + +MARKDOWN_SUPPORT = YES + +# When the TOC_INCLUDE_HEADINGS tag is set to a non-zero value, all headings up +# to that level are automatically included in the table of contents, even if +# they do not have an id attribute. +# Note: This feature currently applies only to Markdown headings. +# Minimum value: 0, maximum value: 99, default value: 5. +# This tag requires that the tag MARKDOWN_SUPPORT is set to YES. + +TOC_INCLUDE_HEADINGS = 5 + +# When enabled doxygen tries to link words that correspond to documented +# classes, or namespaces to their corresponding documentation. Such a link can +# be prevented in individual cases by putting a % sign in front of the word or +# globally by setting AUTOLINK_SUPPORT to NO. +# The default value is: YES. + +AUTOLINK_SUPPORT = YES + +# If you use STL classes (i.e. std::string, std::vector, etc.) but do not want +# to include (a tag file for) the STL sources as input, then you should set this +# tag to YES in order to let doxygen match functions declarations and +# definitions whose arguments contain STL classes (e.g. func(std::string); +# versus func(std::string) {}). This also make the inheritance and collaboration +# diagrams that involve STL classes more complete and accurate. +# The default value is: NO. + +BUILTIN_STL_SUPPORT = NO + +# If you use Microsoft's C++/CLI language, you should set this option to YES to +# enable parsing support. +# The default value is: NO. + +CPP_CLI_SUPPORT = NO + +# Set the SIP_SUPPORT tag to YES if your project consists of sip (see: +# https://www.riverbankcomputing.com/software/sip/intro) sources only. Doxygen +# will parse them like normal C++ but will assume all classes use public instead +# of private inheritance when no explicit protection keyword is present. +# The default value is: NO. + +SIP_SUPPORT = NO + +# For Microsoft's IDL there are propget and propput attributes to indicate +# getter and setter methods for a property. Setting this option to YES will make +# doxygen to replace the get and set methods by a property in the documentation. +# This will only work if the methods are indeed getting or setting a simple +# type. If this is not the case, or you want to show the methods anyway, you +# should set this option to NO. +# The default value is: YES. + +IDL_PROPERTY_SUPPORT = YES + +# If member grouping is used in the documentation and the DISTRIBUTE_GROUP_DOC +# tag is set to YES then doxygen will reuse the documentation of the first +# member in the group (if any) for the other members of the group. By default +# all members of a group must be documented explicitly. +# The default value is: NO. + +DISTRIBUTE_GROUP_DOC = NO + +# If one adds a struct or class to a group and this option is enabled, then also +# any nested class or struct is added to the same group. By default this option +# is disabled and one has to add nested compounds explicitly via \ingroup. +# The default value is: NO. + +GROUP_NESTED_COMPOUNDS = NO + +# Set the SUBGROUPING tag to YES to allow class member groups of the same type +# (for instance a group of public functions) to be put as a subgroup of that +# type (e.g. under the Public Functions section). Set it to NO to prevent +# subgrouping. Alternatively, this can be done per class using the +# \nosubgrouping command. +# The default value is: YES. + +SUBGROUPING = YES + +# When the INLINE_GROUPED_CLASSES tag is set to YES, classes, structs and unions +# are shown inside the group in which they are included (e.g. using \ingroup) +# instead of on a separate page (for HTML and Man pages) or section (for LaTeX +# and RTF). +# +# Note that this feature does not work in combination with +# SEPARATE_MEMBER_PAGES. +# The default value is: NO. + +INLINE_GROUPED_CLASSES = NO + +# When the INLINE_SIMPLE_STRUCTS tag is set to YES, structs, classes, and unions +# with only public data fields or simple typedef fields will be shown inline in +# the documentation of the scope in which they are defined (i.e. file, +# namespace, or group documentation), provided this scope is documented. If set +# to NO, structs, classes, and unions are shown on a separate page (for HTML and +# Man pages) or section (for LaTeX and RTF). +# The default value is: NO. + +INLINE_SIMPLE_STRUCTS = NO + +# When TYPEDEF_HIDES_STRUCT tag is enabled, a typedef of a struct, union, or +# enum is documented as struct, union, or enum with the name of the typedef. So +# typedef struct TypeS {} TypeT, will appear in the documentation as a struct +# with name TypeT. When disabled the typedef will appear as a member of a file, +# namespace, or class. And the struct will be named TypeS. This can typically be +# useful for C code in case the coding convention dictates that all compound +# types are typedef'ed and only the typedef is referenced, never the tag name. +# The default value is: NO. + +TYPEDEF_HIDES_STRUCT = NO + +# The size of the symbol lookup cache can be set using LOOKUP_CACHE_SIZE. This +# cache is used to resolve symbols given their name and scope. Since this can be +# an expensive process and often the same symbol appears multiple times in the +# code, doxygen keeps a cache of pre-resolved symbols. If the cache is too small +# doxygen will become slower. If the cache is too large, memory is wasted. The +# cache size is given by this formula: 2^(16+LOOKUP_CACHE_SIZE). The valid range +# is 0..9, the default is 0, corresponding to a cache size of 2^16=65536 +# symbols. At the end of a run doxygen will report the cache usage and suggest +# the optimal cache size from a speed point of view. +# Minimum value: 0, maximum value: 9, default value: 0. + +LOOKUP_CACHE_SIZE = 0 + +#--------------------------------------------------------------------------- +# Build related configuration options +#--------------------------------------------------------------------------- + +# If the EXTRACT_ALL tag is set to YES, doxygen will assume all entities in +# documentation are documented, even if no documentation was available. Private +# class members and static file members will be hidden unless the +# EXTRACT_PRIVATE respectively EXTRACT_STATIC tags are set to YES. +# Note: This will also disable the warnings about undocumented members that are +# normally produced when WARNINGS is set to YES. +# The default value is: NO. + +EXTRACT_ALL = NO + +# If the EXTRACT_PRIVATE tag is set to YES, all private members of a class will +# be included in the documentation. +# The default value is: NO. + +EXTRACT_PRIVATE = NO + +# If the EXTRACT_PRIV_VIRTUAL tag is set to YES, documented private virtual +# methods of a class will be included in the documentation. +# The default value is: NO. + +EXTRACT_PRIV_VIRTUAL = NO + +# If the EXTRACT_PACKAGE tag is set to YES, all members with package or internal +# scope will be included in the documentation. +# The default value is: NO. + +EXTRACT_PACKAGE = NO + +# If the EXTRACT_STATIC tag is set to YES, all static members of a file will be +# included in the documentation. +# The default value is: NO. + +EXTRACT_STATIC = NO + +# If the EXTRACT_LOCAL_CLASSES tag is set to YES, classes (and structs) defined +# locally in source files will be included in the documentation. If set to NO, +# only classes defined in header files are included. Does not have any effect +# for Java sources. +# The default value is: YES. + +EXTRACT_LOCAL_CLASSES = YES + +# This flag is only useful for Objective-C code. If set to YES, local methods, +# which are defined in the implementation section but not in the interface are +# included in the documentation. If set to NO, only methods in the interface are +# included. +# The default value is: NO. + +EXTRACT_LOCAL_METHODS = NO + +# If this flag is set to YES, the members of anonymous namespaces will be +# extracted and appear in the documentation as a namespace called +# 'anonymous_namespace{file}', where file will be replaced with the base name of +# the file that contains the anonymous namespace. By default anonymous namespace +# are hidden. +# The default value is: NO. + +EXTRACT_ANON_NSPACES = NO + +# If the HIDE_UNDOC_MEMBERS tag is set to YES, doxygen will hide all +# undocumented members inside documented classes or files. If set to NO these +# members will be included in the various overviews, but no documentation +# section is generated. This option has no effect if EXTRACT_ALL is enabled. +# The default value is: NO. + +HIDE_UNDOC_MEMBERS = NO + +# If the HIDE_UNDOC_CLASSES tag is set to YES, doxygen will hide all +# undocumented classes that are normally visible in the class hierarchy. If set +# to NO, these classes will be included in the various overviews. This option +# has no effect if EXTRACT_ALL is enabled. +# The default value is: NO. + +HIDE_UNDOC_CLASSES = NO + +# If the HIDE_FRIEND_COMPOUNDS tag is set to YES, doxygen will hide all friend +# declarations. If set to NO, these declarations will be included in the +# documentation. +# The default value is: NO. + +HIDE_FRIEND_COMPOUNDS = NO + +# If the HIDE_IN_BODY_DOCS tag is set to YES, doxygen will hide any +# documentation blocks found inside the body of a function. If set to NO, these +# blocks will be appended to the function's detailed documentation block. +# The default value is: NO. + +HIDE_IN_BODY_DOCS = NO + +# The INTERNAL_DOCS tag determines if documentation that is typed after a +# \internal command is included. If the tag is set to NO then the documentation +# will be excluded. Set it to YES to include the internal documentation. +# The default value is: NO. + +INTERNAL_DOCS = NO + +# If the CASE_SENSE_NAMES tag is set to NO then doxygen will only generate file +# names in lower-case letters. If set to YES, upper-case letters are also +# allowed. This is useful if you have classes or files whose names only differ +# in case and if your file system supports case sensitive file names. Windows +# (including Cygwin) ands Mac users are advised to set this option to NO. +# The default value is: system dependent. + +CASE_SENSE_NAMES = YES + +# If the HIDE_SCOPE_NAMES tag is set to NO then doxygen will show members with +# their full class and namespace scopes in the documentation. If set to YES, the +# scope will be hidden. +# The default value is: NO. + +HIDE_SCOPE_NAMES = NO + +# If the HIDE_COMPOUND_REFERENCE tag is set to NO (default) then doxygen will +# append additional text to a page's title, such as Class Reference. If set to +# YES the compound reference will be hidden. +# The default value is: NO. + +HIDE_COMPOUND_REFERENCE= NO + +# If the SHOW_INCLUDE_FILES tag is set to YES then doxygen will put a list of +# the files that are included by a file in the documentation of that file. +# The default value is: YES. + +SHOW_INCLUDE_FILES = YES + +# If the SHOW_GROUPED_MEMB_INC tag is set to YES then Doxygen will add for each +# grouped member an include statement to the documentation, telling the reader +# which file to include in order to use the member. +# The default value is: NO. + +SHOW_GROUPED_MEMB_INC = NO + +# If the FORCE_LOCAL_INCLUDES tag is set to YES then doxygen will list include +# files with double quotes in the documentation rather than with sharp brackets. +# The default value is: NO. + +FORCE_LOCAL_INCLUDES = NO + +# If the INLINE_INFO tag is set to YES then a tag [inline] is inserted in the +# documentation for inline members. +# The default value is: YES. + +INLINE_INFO = YES + +# If the SORT_MEMBER_DOCS tag is set to YES then doxygen will sort the +# (detailed) documentation of file and class members alphabetically by member +# name. If set to NO, the members will appear in declaration order. +# The default value is: YES. + +SORT_MEMBER_DOCS = YES + +# If the SORT_BRIEF_DOCS tag is set to YES then doxygen will sort the brief +# descriptions of file, namespace and class members alphabetically by member +# name. If set to NO, the members will appear in declaration order. Note that +# this will also influence the order of the classes in the class list. +# The default value is: NO. + +SORT_BRIEF_DOCS = NO + +# If the SORT_MEMBERS_CTORS_1ST tag is set to YES then doxygen will sort the +# (brief and detailed) documentation of class members so that constructors and +# destructors are listed first. If set to NO the constructors will appear in the +# respective orders defined by SORT_BRIEF_DOCS and SORT_MEMBER_DOCS. +# Note: If SORT_BRIEF_DOCS is set to NO this option is ignored for sorting brief +# member documentation. +# Note: If SORT_MEMBER_DOCS is set to NO this option is ignored for sorting +# detailed member documentation. +# The default value is: NO. + +SORT_MEMBERS_CTORS_1ST = NO + +# If the SORT_GROUP_NAMES tag is set to YES then doxygen will sort the hierarchy +# of group names into alphabetical order. If set to NO the group names will +# appear in their defined order. +# The default value is: NO. + +SORT_GROUP_NAMES = NO + +# If the SORT_BY_SCOPE_NAME tag is set to YES, the class list will be sorted by +# fully-qualified names, including namespaces. If set to NO, the class list will +# be sorted only by class name, not including the namespace part. +# Note: This option is not very useful if HIDE_SCOPE_NAMES is set to YES. +# Note: This option applies only to the class list, not to the alphabetical +# list. +# The default value is: NO. + +SORT_BY_SCOPE_NAME = NO + +# If the STRICT_PROTO_MATCHING option is enabled and doxygen fails to do proper +# type resolution of all parameters of a function it will reject a match between +# the prototype and the implementation of a member function even if there is +# only one candidate or it is obvious which candidate to choose by doing a +# simple string match. By disabling STRICT_PROTO_MATCHING doxygen will still +# accept a match between prototype and implementation in such cases. +# The default value is: NO. + +STRICT_PROTO_MATCHING = NO + +# The GENERATE_TODOLIST tag can be used to enable (YES) or disable (NO) the todo +# list. This list is created by putting \todo commands in the documentation. +# The default value is: YES. + +GENERATE_TODOLIST = YES + +# The GENERATE_TESTLIST tag can be used to enable (YES) or disable (NO) the test +# list. This list is created by putting \test commands in the documentation. +# The default value is: YES. + +GENERATE_TESTLIST = YES + +# The GENERATE_BUGLIST tag can be used to enable (YES) or disable (NO) the bug +# list. This list is created by putting \bug commands in the documentation. +# The default value is: YES. + +GENERATE_BUGLIST = YES + +# The GENERATE_DEPRECATEDLIST tag can be used to enable (YES) or disable (NO) +# the deprecated list. This list is created by putting \deprecated commands in +# the documentation. +# The default value is: YES. + +GENERATE_DEPRECATEDLIST= YES + +# The ENABLED_SECTIONS tag can be used to enable conditional documentation +# sections, marked by \if ... \endif and \cond +# ... \endcond blocks. + +ENABLED_SECTIONS = + +# The MAX_INITIALIZER_LINES tag determines the maximum number of lines that the +# initial value of a variable or macro / define can have for it to appear in the +# documentation. If the initializer consists of more lines than specified here +# it will be hidden. Use a value of 0 to hide initializers completely. The +# appearance of the value of individual variables and macros / defines can be +# controlled using \showinitializer or \hideinitializer command in the +# documentation regardless of this setting. +# Minimum value: 0, maximum value: 10000, default value: 30. + +MAX_INITIALIZER_LINES = 30 + +# Set the SHOW_USED_FILES tag to NO to disable the list of files generated at +# the bottom of the documentation of classes and structs. If set to YES, the +# list will mention the files that were used to generate the documentation. +# The default value is: YES. + +SHOW_USED_FILES = YES + +# Set the SHOW_FILES tag to NO to disable the generation of the Files page. This +# will remove the Files entry from the Quick Index and from the Folder Tree View +# (if specified). +# The default value is: YES. + +SHOW_FILES = YES + +# Set the SHOW_NAMESPACES tag to NO to disable the generation of the Namespaces +# page. This will remove the Namespaces entry from the Quick Index and from the +# Folder Tree View (if specified). +# The default value is: YES. + +SHOW_NAMESPACES = YES + +# The FILE_VERSION_FILTER tag can be used to specify a program or script that +# doxygen should invoke to get the current version for each file (typically from +# the version control system). Doxygen will invoke the program by executing (via +# popen()) the command command input-file, where command is the value of the +# FILE_VERSION_FILTER tag, and input-file is the name of an input file provided +# by doxygen. Whatever the program writes to standard output is used as the file +# version. For an example see the documentation. + +FILE_VERSION_FILTER = + +# The LAYOUT_FILE tag can be used to specify a layout file which will be parsed +# by doxygen. The layout file controls the global structure of the generated +# output files in an output format independent way. To create the layout file +# that represents doxygen's defaults, run doxygen with the -l option. You can +# optionally specify a file name after the option, if omitted DoxygenLayout.xml +# will be used as the name of the layout file. +# +# Note that if you run doxygen from a directory containing a file called +# DoxygenLayout.xml, doxygen will parse it automatically even if the LAYOUT_FILE +# tag is left empty. + +LAYOUT_FILE = + +# The CITE_BIB_FILES tag can be used to specify one or more bib files containing +# the reference definitions. This must be a list of .bib files. The .bib +# extension is automatically appended if omitted. This requires the bibtex tool +# to be installed. See also https://en.wikipedia.org/wiki/BibTeX for more info. +# For LaTeX the style of the bibliography can be controlled using +# LATEX_BIB_STYLE. To use this feature you need bibtex and perl available in the +# search path. See also \cite for info how to create references. + +CITE_BIB_FILES = + +#--------------------------------------------------------------------------- +# Configuration options related to warning and progress messages +#--------------------------------------------------------------------------- + +# The QUIET tag can be used to turn on/off the messages that are generated to +# standard output by doxygen. If QUIET is set to YES this implies that the +# messages are off. +# The default value is: NO. + +QUIET = NO + +# The WARNINGS tag can be used to turn on/off the warning messages that are +# generated to standard error (stderr) by doxygen. If WARNINGS is set to YES +# this implies that the warnings are on. +# +# Tip: Turn warnings on while writing the documentation. +# The default value is: YES. + +WARNINGS = YES + +# If the WARN_IF_UNDOCUMENTED tag is set to YES then doxygen will generate +# warnings for undocumented members. If EXTRACT_ALL is set to YES then this flag +# will automatically be disabled. +# The default value is: YES. + +WARN_IF_UNDOCUMENTED = YES + +# If the WARN_IF_DOC_ERROR tag is set to YES, doxygen will generate warnings for +# potential errors in the documentation, such as not documenting some parameters +# in a documented function, or documenting parameters that don't exist or using +# markup commands wrongly. +# The default value is: YES. + +WARN_IF_DOC_ERROR = YES + +# This WARN_NO_PARAMDOC option can be enabled to get warnings for functions that +# are documented, but have no documentation for their parameters or return +# value. If set to NO, doxygen will only warn about wrong or incomplete +# parameter documentation, but not about the absence of documentation. If +# EXTRACT_ALL is set to YES then this flag will automatically be disabled. +# The default value is: NO. + +WARN_NO_PARAMDOC = NO + +# If the WARN_AS_ERROR tag is set to YES then doxygen will immediately stop when +# a warning is encountered. +# The default value is: NO. + +WARN_AS_ERROR = NO + +# The WARN_FORMAT tag determines the format of the warning messages that doxygen +# can produce. The string should contain the $file, $line, and $text tags, which +# will be replaced by the file and line number from which the warning originated +# and the warning text. Optionally the format may contain $version, which will +# be replaced by the version of the file (if it could be obtained via +# FILE_VERSION_FILTER) +# The default value is: $file:$line: $text. + +WARN_FORMAT = "$file:$line: $text" + +# The WARN_LOGFILE tag can be used to specify a file to which warning and error +# messages should be written. If left blank the output is written to standard +# error (stderr). + +WARN_LOGFILE = + +#--------------------------------------------------------------------------- +# Configuration options related to the input files +#--------------------------------------------------------------------------- + +# The INPUT tag is used to specify the files and/or directories that contain +# documented source files. You may enter file names like myfile.cpp or +# directories like /usr/src/myproject. Separate the files or directories with +# spaces. See also FILE_PATTERNS and EXTENSION_MAPPING +# Note: If this tag is empty the current directory is searched. + +INPUT = runtime + +# This tag can be used to specify the character encoding of the source files +# that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses +# libiconv (or the iconv built into libc) for the transcoding. See the libiconv +# documentation (see: https://www.gnu.org/software/libiconv/) for the list of +# possible encodings. +# The default value is: UTF-8. + +INPUT_ENCODING = UTF-8 + +# If the value of the INPUT tag contains directories, you can use the +# FILE_PATTERNS tag to specify one or more wildcard patterns (like *.cpp and +# *.h) to filter out the source-files in the directories. +# +# Note that for custom extensions or not directly supported extensions you also +# need to set EXTENSION_MAPPING for the extension otherwise the files are not +# read by doxygen. +# +# If left blank the following patterns are tested:*.c, *.cc, *.cxx, *.cpp, +# *.c++, *.java, *.ii, *.ixx, *.ipp, *.i++, *.inl, *.idl, *.ddl, *.odl, *.h, +# *.hh, *.hxx, *.hpp, *.h++, *.cs, *.d, *.php, *.php4, *.php5, *.phtml, *.inc, +# *.m, *.markdown, *.md, *.mm, *.dox (to be provided as doxygen C comment), +# *.doc (to be provided as doxygen C comment), *.txt (to be provided as doxygen +# C comment), *.py, *.pyw, *.f90, *.f95, *.f03, *.f08, *.f, *.for, *.tcl, *.vhd, +# *.vhdl, *.ucf, *.qsf and *.ice. + +FILE_PATTERNS = *.c \ + *.cc \ + *.cxx \ + *.cpp \ + *.c++ \ + *.java \ + *.ii \ + *.ixx \ + *.ipp \ + *.i++ \ + *.inl \ + *.idl \ + *.ddl \ + *.odl \ + *.h \ + *.hh \ + *.hxx \ + *.hpp \ + *.h++ \ + *.cs \ + *.d \ + *.php \ + *.php4 \ + *.php5 \ + *.phtml \ + *.inc \ + *.m \ + *.markdown \ + *.md \ + *.mm \ + *.dox \ + *.doc \ + *.txt \ + *.py \ + *.pyw \ + *.f90 \ + *.f95 \ + *.f03 \ + *.f08 \ + *.f \ + *.for \ + *.tcl \ + *.vhd \ + *.vhdl \ + *.ucf \ + *.qsf \ + *.ice + +# The RECURSIVE tag can be used to specify whether or not subdirectories should +# be searched for input files as well. +# The default value is: NO. + +RECURSIVE = NO + +# The EXCLUDE tag can be used to specify files and/or directories that should be +# excluded from the INPUT source files. This way you can easily exclude a +# subdirectory from a directory tree whose root is specified with the INPUT tag. +# +# Note that relative paths are relative to the directory from which doxygen is +# run. + +EXCLUDE = + +# The EXCLUDE_SYMLINKS tag can be used to select whether or not files or +# directories that are symbolic links (a Unix file system feature) are excluded +# from the input. +# The default value is: NO. + +EXCLUDE_SYMLINKS = NO + +# If the value of the INPUT tag contains directories, you can use the +# EXCLUDE_PATTERNS tag to specify one or more wildcard patterns to exclude +# certain files from those directories. +# +# Note that the wildcards are matched against the file with absolute path, so to +# exclude all test directories for example use the pattern */test/* + +EXCLUDE_PATTERNS = + +# The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names +# (namespaces, classes, functions, etc.) that should be excluded from the +# output. The symbol name can be a fully qualified name, a word, or if the +# wildcard * is used, a substring. Examples: ANamespace, AClass, +# AClass::ANamespace, ANamespace::*Test +# +# Note that the wildcards are matched against the file with absolute path, so to +# exclude all test directories use the pattern */test/* + +EXCLUDE_SYMBOLS = + +# The EXAMPLE_PATH tag can be used to specify one or more files or directories +# that contain example code fragments that are included (see the \include +# command). + +EXAMPLE_PATH = + +# If the value of the EXAMPLE_PATH tag contains directories, you can use the +# EXAMPLE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp and +# *.h) to filter out the source-files in the directories. If left blank all +# files are included. + +EXAMPLE_PATTERNS = * + +# If the EXAMPLE_RECURSIVE tag is set to YES then subdirectories will be +# searched for input files to be used with the \include or \dontinclude commands +# irrespective of the value of the RECURSIVE tag. +# The default value is: NO. + +EXAMPLE_RECURSIVE = NO + +# The IMAGE_PATH tag can be used to specify one or more files or directories +# that contain images that are to be included in the documentation (see the +# \image command). + +IMAGE_PATH = + +# The INPUT_FILTER tag can be used to specify a program that doxygen should +# invoke to filter for each input file. Doxygen will invoke the filter program +# by executing (via popen()) the command: +# +# +# +# where is the value of the INPUT_FILTER tag, and is the +# name of an input file. Doxygen will then use the output that the filter +# program writes to standard output. If FILTER_PATTERNS is specified, this tag +# will be ignored. +# +# Note that the filter must not add or remove lines; it is applied before the +# code is scanned, but not when the output code is generated. If lines are added +# or removed, the anchors will not be placed correctly. +# +# Note that for custom extensions or not directly supported extensions you also +# need to set EXTENSION_MAPPING for the extension otherwise the files are not +# properly processed by doxygen. + +INPUT_FILTER = + +# The FILTER_PATTERNS tag can be used to specify filters on a per file pattern +# basis. Doxygen will compare the file name with each pattern and apply the +# filter if there is a match. The filters are a list of the form: pattern=filter +# (like *.cpp=my_cpp_filter). See INPUT_FILTER for further information on how +# filters are used. If the FILTER_PATTERNS tag is empty or if none of the +# patterns match the file name, INPUT_FILTER is applied. +# +# Note that for custom extensions or not directly supported extensions you also +# need to set EXTENSION_MAPPING for the extension otherwise the files are not +# properly processed by doxygen. + +FILTER_PATTERNS = + +# If the FILTER_SOURCE_FILES tag is set to YES, the input filter (if set using +# INPUT_FILTER) will also be used to filter the input files that are used for +# producing the source files to browse (i.e. when SOURCE_BROWSER is set to YES). +# The default value is: NO. + +FILTER_SOURCE_FILES = NO + +# The FILTER_SOURCE_PATTERNS tag can be used to specify source filters per file +# pattern. A pattern will override the setting for FILTER_PATTERN (if any) and +# it is also possible to disable source filtering for a specific pattern using +# *.ext= (so without naming a filter). +# This tag requires that the tag FILTER_SOURCE_FILES is set to YES. + +FILTER_SOURCE_PATTERNS = + +# If the USE_MDFILE_AS_MAINPAGE tag refers to the name of a markdown file that +# is part of the input, its contents will be placed on the main page +# (index.html). This can be useful if you have a project on for instance GitHub +# and want to reuse the introduction page also for the doxygen output. + +USE_MDFILE_AS_MAINPAGE = + +#--------------------------------------------------------------------------- +# Configuration options related to source browsing +#--------------------------------------------------------------------------- + +# If the SOURCE_BROWSER tag is set to YES then a list of source files will be +# generated. Documented entities will be cross-referenced with these sources. +# +# Note: To get rid of all source code in the generated output, make sure that +# also VERBATIM_HEADERS is set to NO. +# The default value is: NO. + +SOURCE_BROWSER = NO + +# Setting the INLINE_SOURCES tag to YES will include the body of functions, +# classes and enums directly into the documentation. +# The default value is: NO. + +INLINE_SOURCES = NO + +# Setting the STRIP_CODE_COMMENTS tag to YES will instruct doxygen to hide any +# special comment blocks from generated source code fragments. Normal C, C++ and +# Fortran comments will always remain visible. +# The default value is: YES. + +STRIP_CODE_COMMENTS = YES + +# If the REFERENCED_BY_RELATION tag is set to YES then for each documented +# entity all documented functions referencing it will be listed. +# The default value is: NO. + +REFERENCED_BY_RELATION = NO + +# If the REFERENCES_RELATION tag is set to YES then for each documented function +# all documented entities called/used by that function will be listed. +# The default value is: NO. + +REFERENCES_RELATION = NO + +# If the REFERENCES_LINK_SOURCE tag is set to YES and SOURCE_BROWSER tag is set +# to YES then the hyperlinks from functions in REFERENCES_RELATION and +# REFERENCED_BY_RELATION lists will link to the source code. Otherwise they will +# link to the documentation. +# The default value is: YES. + +REFERENCES_LINK_SOURCE = YES + +# If SOURCE_TOOLTIPS is enabled (the default) then hovering a hyperlink in the +# source code will show a tooltip with additional information such as prototype, +# brief description and links to the definition and documentation. Since this +# will make the HTML file larger and loading of large files a bit slower, you +# can opt to disable this feature. +# The default value is: YES. +# This tag requires that the tag SOURCE_BROWSER is set to YES. + +SOURCE_TOOLTIPS = YES + +# If the USE_HTAGS tag is set to YES then the references to source code will +# point to the HTML generated by the htags(1) tool instead of doxygen built-in +# source browser. The htags tool is part of GNU's global source tagging system +# (see https://www.gnu.org/software/global/global.html). You will need version +# 4.8.6 or higher. +# +# To use it do the following: +# - Install the latest version of global +# - Enable SOURCE_BROWSER and USE_HTAGS in the configuration file +# - Make sure the INPUT points to the root of the source tree +# - Run doxygen as normal +# +# Doxygen will invoke htags (and that will in turn invoke gtags), so these +# tools must be available from the command line (i.e. in the search path). +# +# The result: instead of the source browser generated by doxygen, the links to +# source code will now point to the output of htags. +# The default value is: NO. +# This tag requires that the tag SOURCE_BROWSER is set to YES. + +USE_HTAGS = NO + +# If the VERBATIM_HEADERS tag is set the YES then doxygen will generate a +# verbatim copy of the header file for each class for which an include is +# specified. Set to NO to disable this. +# See also: Section \class. +# The default value is: YES. + +VERBATIM_HEADERS = YES + +# If the CLANG_ASSISTED_PARSING tag is set to YES then doxygen will use the +# clang parser (see: http://clang.llvm.org/) for more accurate parsing at the +# cost of reduced performance. This can be particularly helpful with template +# rich C++ code for which doxygen's built-in parser lacks the necessary type +# information. +# Note: The availability of this option depends on whether or not doxygen was +# generated with the -Duse_libclang=ON option for CMake. +# The default value is: NO. + +CLANG_ASSISTED_PARSING = NO + +# If clang assisted parsing is enabled you can provide the compiler with command +# line options that you would normally use when invoking the compiler. Note that +# the include paths will already be set by doxygen for the files and directories +# specified with INPUT and INCLUDE_PATH. +# This tag requires that the tag CLANG_ASSISTED_PARSING is set to YES. + +CLANG_OPTIONS = + +# If clang assisted parsing is enabled you can provide the clang parser with the +# path to the compilation database (see: +# http://clang.llvm.org/docs/HowToSetupToolingForLLVM.html) used when the files +# were built. This is equivalent to specifying the "-p" option to a clang tool, +# such as clang-check. These options will then be passed to the parser. +# Note: The availability of this option depends on whether or not doxygen was +# generated with the -Duse_libclang=ON option for CMake. + +CLANG_DATABASE_PATH = + +#--------------------------------------------------------------------------- +# Configuration options related to the alphabetical class index +#--------------------------------------------------------------------------- + +# If the ALPHABETICAL_INDEX tag is set to YES, an alphabetical index of all +# compounds will be generated. Enable this if the project contains a lot of +# classes, structs, unions or interfaces. +# The default value is: YES. + +ALPHABETICAL_INDEX = YES + +# The COLS_IN_ALPHA_INDEX tag can be used to specify the number of columns in +# which the alphabetical index list will be split. +# Minimum value: 1, maximum value: 20, default value: 5. +# This tag requires that the tag ALPHABETICAL_INDEX is set to YES. + +COLS_IN_ALPHA_INDEX = 5 + +# In case all classes in a project start with a common prefix, all classes will +# be put under the same header in the alphabetical index. The IGNORE_PREFIX tag +# can be used to specify a prefix (or a list of prefixes) that should be ignored +# while generating the index headers. +# This tag requires that the tag ALPHABETICAL_INDEX is set to YES. + +IGNORE_PREFIX = + +#--------------------------------------------------------------------------- +# Configuration options related to the HTML output +#--------------------------------------------------------------------------- + +# If the GENERATE_HTML tag is set to YES, doxygen will generate HTML output +# The default value is: YES. + +GENERATE_HTML = YES + +# The HTML_OUTPUT tag is used to specify where the HTML docs will be put. If a +# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of +# it. +# The default directory is: html. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_OUTPUT = html + +# The HTML_FILE_EXTENSION tag can be used to specify the file extension for each +# generated HTML page (for example: .htm, .php, .asp). +# The default value is: .html. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_FILE_EXTENSION = .html + +# The HTML_HEADER tag can be used to specify a user-defined HTML header file for +# each generated HTML page. If the tag is left blank doxygen will generate a +# standard header. +# +# To get valid HTML the header file that includes any scripts and style sheets +# that doxygen needs, which is dependent on the configuration options used (e.g. +# the setting GENERATE_TREEVIEW). It is highly recommended to start with a +# default header using +# doxygen -w html new_header.html new_footer.html new_stylesheet.css +# YourConfigFile +# and then modify the file new_header.html. See also section "Doxygen usage" +# for information on how to generate the default header that doxygen normally +# uses. +# Note: The header is subject to change so you typically have to regenerate the +# default header when upgrading to a newer version of doxygen. For a description +# of the possible markers and block names see the documentation. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_HEADER = + +# The HTML_FOOTER tag can be used to specify a user-defined HTML footer for each +# generated HTML page. If the tag is left blank doxygen will generate a standard +# footer. See HTML_HEADER for more information on how to generate a default +# footer and what special commands can be used inside the footer. See also +# section "Doxygen usage" for information on how to generate the default footer +# that doxygen normally uses. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_FOOTER = + +# The HTML_STYLESHEET tag can be used to specify a user-defined cascading style +# sheet that is used by each HTML page. It can be used to fine-tune the look of +# the HTML output. If left blank doxygen will generate a default style sheet. +# See also section "Doxygen usage" for information on how to generate the style +# sheet that doxygen normally uses. +# Note: It is recommended to use HTML_EXTRA_STYLESHEET instead of this tag, as +# it is more robust and this tag (HTML_STYLESHEET) will in the future become +# obsolete. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_STYLESHEET = + +# The HTML_EXTRA_STYLESHEET tag can be used to specify additional user-defined +# cascading style sheets that are included after the standard style sheets +# created by doxygen. Using this option one can overrule certain style aspects. +# This is preferred over using HTML_STYLESHEET since it does not replace the +# standard style sheet and is therefore more robust against future updates. +# Doxygen will copy the style sheet files to the output directory. +# Note: The order of the extra style sheet files is of importance (e.g. the last +# style sheet in the list overrules the setting of the previous ones in the +# list). For an example see the documentation. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_EXTRA_STYLESHEET = + +# The HTML_EXTRA_FILES tag can be used to specify one or more extra images or +# other source files which should be copied to the HTML output directory. Note +# that these files will be copied to the base HTML output directory. Use the +# $relpath^ marker in the HTML_HEADER and/or HTML_FOOTER files to load these +# files. In the HTML_STYLESHEET file, use the file name only. Also note that the +# files will be copied as-is; there are no commands or markers available. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_EXTRA_FILES = + +# The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. Doxygen +# will adjust the colors in the style sheet and background images according to +# this color. Hue is specified as an angle on a colorwheel, see +# https://en.wikipedia.org/wiki/Hue for more information. For instance the value +# 0 represents red, 60 is yellow, 120 is green, 180 is cyan, 240 is blue, 300 +# purple, and 360 is red again. +# Minimum value: 0, maximum value: 359, default value: 220. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE_HUE = 220 + +# The HTML_COLORSTYLE_SAT tag controls the purity (or saturation) of the colors +# in the HTML output. For a value of 0 the output will use grayscales only. A +# value of 255 will produce the most vivid colors. +# Minimum value: 0, maximum value: 255, default value: 100. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE_SAT = 100 + +# The HTML_COLORSTYLE_GAMMA tag controls the gamma correction applied to the +# luminance component of the colors in the HTML output. Values below 100 +# gradually make the output lighter, whereas values above 100 make the output +# darker. The value divided by 100 is the actual gamma applied, so 80 represents +# a gamma of 0.8, The value 220 represents a gamma of 2.2, and 100 does not +# change the gamma. +# Minimum value: 40, maximum value: 240, default value: 80. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE_GAMMA = 80 + +# If the HTML_TIMESTAMP tag is set to YES then the footer of each generated HTML +# page will contain the date and time when the page was generated. Setting this +# to YES can help to show when doxygen was last run and thus if the +# documentation is up to date. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_TIMESTAMP = NO + +# If the HTML_DYNAMIC_MENUS tag is set to YES then the generated HTML +# documentation will contain a main index with vertical navigation menus that +# are dynamically created via JavaScript. If disabled, the navigation index will +# consists of multiple levels of tabs that are statically embedded in every HTML +# page. Disable this option to support browsers that do not have JavaScript, +# like the Qt help browser. +# The default value is: YES. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_DYNAMIC_MENUS = YES + +# If the HTML_DYNAMIC_SECTIONS tag is set to YES then the generated HTML +# documentation will contain sections that can be hidden and shown after the +# page has loaded. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_DYNAMIC_SECTIONS = NO + +# With HTML_INDEX_NUM_ENTRIES one can control the preferred number of entries +# shown in the various tree structured indices initially; the user can expand +# and collapse entries dynamically later on. Doxygen will expand the tree to +# such a level that at most the specified number of entries are visible (unless +# a fully collapsed tree already exceeds this amount). So setting the number of +# entries 1 will produce a full collapsed tree by default. 0 is a special value +# representing an infinite number of entries and will result in a full expanded +# tree by default. +# Minimum value: 0, maximum value: 9999, default value: 100. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_INDEX_NUM_ENTRIES = 100 + +# If the GENERATE_DOCSET tag is set to YES, additional index files will be +# generated that can be used as input for Apple's Xcode 3 integrated development +# environment (see: https://developer.apple.com/xcode/), introduced with OSX +# 10.5 (Leopard). To create a documentation set, doxygen will generate a +# Makefile in the HTML output directory. Running make will produce the docset in +# that directory and running make install will install the docset in +# ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find it at +# startup. See https://developer.apple.com/library/archive/featuredarticles/Doxy +# genXcode/_index.html for more information. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_DOCSET = NO + +# This tag determines the name of the docset feed. A documentation feed provides +# an umbrella under which multiple documentation sets from a single provider +# (such as a company or product suite) can be grouped. +# The default value is: Doxygen generated docs. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_FEEDNAME = "Doxygen generated docs" + +# This tag specifies a string that should uniquely identify the documentation +# set bundle. This should be a reverse domain-name style string, e.g. +# com.mycompany.MyDocSet. Doxygen will append .docset to the name. +# The default value is: org.doxygen.Project. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_BUNDLE_ID = org.doxygen.Project + +# The DOCSET_PUBLISHER_ID tag specifies a string that should uniquely identify +# the documentation publisher. This should be a reverse domain-name style +# string, e.g. com.mycompany.MyDocSet.documentation. +# The default value is: org.doxygen.Publisher. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_PUBLISHER_ID = org.doxygen.Publisher + +# The DOCSET_PUBLISHER_NAME tag identifies the documentation publisher. +# The default value is: Publisher. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_PUBLISHER_NAME = Publisher + +# If the GENERATE_HTMLHELP tag is set to YES then doxygen generates three +# additional HTML index files: index.hhp, index.hhc, and index.hhk. The +# index.hhp is a project file that can be read by Microsoft's HTML Help Workshop +# (see: https://www.microsoft.com/en-us/download/details.aspx?id=21138) on +# Windows. +# +# The HTML Help Workshop contains a compiler that can convert all HTML output +# generated by doxygen into a single compiled HTML file (.chm). Compiled HTML +# files are now used as the Windows 98 help format, and will replace the old +# Windows help format (.hlp) on all Windows platforms in the future. Compressed +# HTML files also contain an index, a table of contents, and you can search for +# words in the documentation. The HTML workshop also contains a viewer for +# compressed HTML files. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_HTMLHELP = NO + +# The CHM_FILE tag can be used to specify the file name of the resulting .chm +# file. You can add a path in front of the file if the result should not be +# written to the html output directory. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +CHM_FILE = + +# The HHC_LOCATION tag can be used to specify the location (absolute path +# including file name) of the HTML help compiler (hhc.exe). If non-empty, +# doxygen will try to run the HTML help compiler on the generated index.hhp. +# The file has to be specified with full path. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +HHC_LOCATION = + +# The GENERATE_CHI flag controls if a separate .chi index file is generated +# (YES) or that it should be included in the master .chm file (NO). +# The default value is: NO. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +GENERATE_CHI = NO + +# The CHM_INDEX_ENCODING is used to encode HtmlHelp index (hhk), content (hhc) +# and project file content. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +CHM_INDEX_ENCODING = + +# The BINARY_TOC flag controls whether a binary table of contents is generated +# (YES) or a normal table of contents (NO) in the .chm file. Furthermore it +# enables the Previous and Next buttons. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +BINARY_TOC = NO + +# The TOC_EXPAND flag can be set to YES to add extra items for group members to +# the table of contents of the HTML help documentation and to the tree view. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +TOC_EXPAND = NO + +# If the GENERATE_QHP tag is set to YES and both QHP_NAMESPACE and +# QHP_VIRTUAL_FOLDER are set, an additional index file will be generated that +# can be used as input for Qt's qhelpgenerator to generate a Qt Compressed Help +# (.qch) of the generated HTML documentation. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_QHP = NO + +# If the QHG_LOCATION tag is specified, the QCH_FILE tag can be used to specify +# the file name of the resulting .qch file. The path specified is relative to +# the HTML output folder. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QCH_FILE = + +# The QHP_NAMESPACE tag specifies the namespace to use when generating Qt Help +# Project output. For more information please see Qt Help Project / Namespace +# (see: https://doc.qt.io/archives/qt-4.8/qthelpproject.html#namespace). +# The default value is: org.doxygen.Project. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_NAMESPACE = org.doxygen.Project + +# The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating Qt +# Help Project output. For more information please see Qt Help Project / Virtual +# Folders (see: https://doc.qt.io/archives/qt-4.8/qthelpproject.html#virtual- +# folders). +# The default value is: doc. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_VIRTUAL_FOLDER = doc + +# If the QHP_CUST_FILTER_NAME tag is set, it specifies the name of a custom +# filter to add. For more information please see Qt Help Project / Custom +# Filters (see: https://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom- +# filters). +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_CUST_FILTER_NAME = + +# The QHP_CUST_FILTER_ATTRS tag specifies the list of the attributes of the +# custom filter to add. For more information please see Qt Help Project / Custom +# Filters (see: https://doc.qt.io/archives/qt-4.8/qthelpproject.html#custom- +# filters). +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_CUST_FILTER_ATTRS = + +# The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this +# project's filter section matches. Qt Help Project / Filter Attributes (see: +# https://doc.qt.io/archives/qt-4.8/qthelpproject.html#filter-attributes). +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_SECT_FILTER_ATTRS = + +# The QHG_LOCATION tag can be used to specify the location of Qt's +# qhelpgenerator. If non-empty doxygen will try to run qhelpgenerator on the +# generated .qhp file. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHG_LOCATION = + +# If the GENERATE_ECLIPSEHELP tag is set to YES, additional index files will be +# generated, together with the HTML files, they form an Eclipse help plugin. To +# install this plugin and make it available under the help contents menu in +# Eclipse, the contents of the directory containing the HTML and XML files needs +# to be copied into the plugins directory of eclipse. The name of the directory +# within the plugins directory should be the same as the ECLIPSE_DOC_ID value. +# After copying Eclipse needs to be restarted before the help appears. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_ECLIPSEHELP = NO + +# A unique identifier for the Eclipse help plugin. When installing the plugin +# the directory name containing the HTML and XML files should also have this +# name. Each documentation set should have its own identifier. +# The default value is: org.doxygen.Project. +# This tag requires that the tag GENERATE_ECLIPSEHELP is set to YES. + +ECLIPSE_DOC_ID = org.doxygen.Project + +# If you want full control over the layout of the generated HTML pages it might +# be necessary to disable the index and replace it with your own. The +# DISABLE_INDEX tag can be used to turn on/off the condensed index (tabs) at top +# of each HTML page. A value of NO enables the index and the value YES disables +# it. Since the tabs in the index contain the same information as the navigation +# tree, you can set this option to YES if you also set GENERATE_TREEVIEW to YES. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +DISABLE_INDEX = NO + +# The GENERATE_TREEVIEW tag is used to specify whether a tree-like index +# structure should be generated to display hierarchical information. If the tag +# value is set to YES, a side panel will be generated containing a tree-like +# index structure (just like the one that is generated for HTML Help). For this +# to work a browser that supports JavaScript, DHTML, CSS and frames is required +# (i.e. any modern browser). Windows users are probably better off using the +# HTML help feature. Via custom style sheets (see HTML_EXTRA_STYLESHEET) one can +# further fine-tune the look of the index. As an example, the default style +# sheet generated by doxygen has an example that shows how to put an image at +# the root of the tree instead of the PROJECT_NAME. Since the tree basically has +# the same information as the tab index, you could consider setting +# DISABLE_INDEX to YES when enabling this option. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_TREEVIEW = NO + +# The ENUM_VALUES_PER_LINE tag can be used to set the number of enum values that +# doxygen will group on one line in the generated HTML documentation. +# +# Note that a value of 0 will completely suppress the enum values from appearing +# in the overview section. +# Minimum value: 0, maximum value: 20, default value: 4. +# This tag requires that the tag GENERATE_HTML is set to YES. + +ENUM_VALUES_PER_LINE = 4 + +# If the treeview is enabled (see GENERATE_TREEVIEW) then this tag can be used +# to set the initial width (in pixels) of the frame in which the tree is shown. +# Minimum value: 0, maximum value: 1500, default value: 250. +# This tag requires that the tag GENERATE_HTML is set to YES. + +TREEVIEW_WIDTH = 250 + +# If the EXT_LINKS_IN_WINDOW option is set to YES, doxygen will open links to +# external symbols imported via tag files in a separate window. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +EXT_LINKS_IN_WINDOW = NO + +# Use this tag to change the font size of LaTeX formulas included as images in +# the HTML documentation. When you change the font size after a successful +# doxygen run you need to manually remove any form_*.png images from the HTML +# output directory to force them to be regenerated. +# Minimum value: 8, maximum value: 50, default value: 10. +# This tag requires that the tag GENERATE_HTML is set to YES. + +FORMULA_FONTSIZE = 10 + +# Use the FORMULA_TRANSPARENT tag to determine whether or not the images +# generated for formulas are transparent PNGs. Transparent PNGs are not +# supported properly for IE 6.0, but are supported on all modern browsers. +# +# Note that when changing this option you need to delete any form_*.png files in +# the HTML output directory before the changes have effect. +# The default value is: YES. +# This tag requires that the tag GENERATE_HTML is set to YES. + +FORMULA_TRANSPARENT = YES + +# The FORMULA_MACROFILE can contain LaTeX \newcommand and \renewcommand commands +# to create new LaTeX commands to be used in formulas as building blocks. See +# the section "Including formulas" for details. + +FORMULA_MACROFILE = + +# Enable the USE_MATHJAX option to render LaTeX formulas using MathJax (see +# https://www.mathjax.org) which uses client side JavaScript for the rendering +# instead of using pre-rendered bitmaps. Use this if you do not have LaTeX +# installed or if you want to formulas look prettier in the HTML output. When +# enabled you may also need to install MathJax separately and configure the path +# to it using the MATHJAX_RELPATH option. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +USE_MATHJAX = NO + +# When MathJax is enabled you can set the default output format to be used for +# the MathJax output. See the MathJax site (see: +# http://docs.mathjax.org/en/latest/output.html) for more details. +# Possible values are: HTML-CSS (which is slower, but has the best +# compatibility), NativeMML (i.e. MathML) and SVG. +# The default value is: HTML-CSS. +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_FORMAT = HTML-CSS + +# When MathJax is enabled you need to specify the location relative to the HTML +# output directory using the MATHJAX_RELPATH option. The destination directory +# should contain the MathJax.js script. For instance, if the mathjax directory +# is located at the same level as the HTML output directory, then +# MATHJAX_RELPATH should be ../mathjax. The default value points to the MathJax +# Content Delivery Network so you can quickly see the result without installing +# MathJax. However, it is strongly recommended to install a local copy of +# MathJax from https://www.mathjax.org before deployment. +# The default value is: https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/. +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_RELPATH = https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/ + +# The MATHJAX_EXTENSIONS tag can be used to specify one or more MathJax +# extension names that should be enabled during MathJax rendering. For example +# MATHJAX_EXTENSIONS = TeX/AMSmath TeX/AMSsymbols +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_EXTENSIONS = + +# The MATHJAX_CODEFILE tag can be used to specify a file with javascript pieces +# of code that will be used on startup of the MathJax code. See the MathJax site +# (see: http://docs.mathjax.org/en/latest/output.html) for more details. For an +# example see the documentation. +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_CODEFILE = + +# When the SEARCHENGINE tag is enabled doxygen will generate a search box for +# the HTML output. The underlying search engine uses javascript and DHTML and +# should work on any modern browser. Note that when using HTML help +# (GENERATE_HTMLHELP), Qt help (GENERATE_QHP), or docsets (GENERATE_DOCSET) +# there is already a search function so this one should typically be disabled. +# For large projects the javascript based search engine can be slow, then +# enabling SERVER_BASED_SEARCH may provide a better solution. It is possible to +# search using the keyboard; to jump to the search box use + S +# (what the is depends on the OS and browser, but it is typically +# , /