Skip to content

Commit 2473ce2

Browse files
dragoncoder047dragoncoder047
authored
add some testing of cb functions
1 parent c410fe7 commit 2473ce2

File tree

7 files changed

+308
-74
lines changed

7 files changed

+308
-74
lines changed

‎pickle.cpp

+61-30
Original file line numberDiff line numberDiff line change
@@ -99,6 +99,9 @@ static int cmp_float(object* a, object* b) {
9999
return (int)(a->as_double - b->as_double);
100100
}
101101

102+
// ------------------------ core types -----------------
103+
// these will later be swapped for actual objects
104+
102105
// metadata = line, column, file, prototypes
103106
const object_schema metadata_type("object_metadata", initmulti<4>, NULL, markmulti<4>, freemulti);
104107
// cons = car, cdr
@@ -107,6 +110,9 @@ const object_schema cons_type("cons", tinobsy::schema_functions::init_cons, NULL
107110
const object_schema partial_type("function_partial", initmulti<5>, NULL, markmulti<5>, freemulti);
108111
// error = type, message, detail, then
109112
const object_schema error_type("error", initmulti<4>, NULL, markmulti<4>, freemulti);
113+
// list = items
114+
const object_schema list_type("list", initmulti<1>, NULL, markmulti<1>, freemulti);
115+
// --------- primitive/ish types ---------------
110116
const object_schema string_type("string", init_string, cmp_string, mark_string, del_string);
111117
const object_schema symbol_type("symbol", tinobsy::schema_functions::init_str, tinobsy::schema_functions::cmp_str, NULL, tinobsy::schema_functions::finalize_str);
112118
const object_schema c_function_type("c_function", init_c_function, cmp_c_function, NULL, NULL);
@@ -146,6 +152,10 @@ object* pickle::append(object* l1, object* l2) {
146152

147153
void pickle::set_retval(object* args, object* env, object* cont, object* fail_cont) {
148154
if (cont == NULL) return; // No next continuation -> drop the result
155+
if (cont->schema == &c_function_type) {
156+
// stupid waste of an object
157+
cont = this->make_partial(cont, args, env, NULL, fail_cont);
158+
}
149159
object* thunk = this->make_partial(cont->cells[0].as_obj, this->append(cont->cells[1].as_obj, args), env, cont->cells[3].as_obj, fail_cont);
150160
this->do_later(thunk);
151161
}
@@ -204,50 +214,71 @@ void pickle::mark_globals() {
204214
this->globals->mark();
205215
}
206216

217+
void getarg(pickle* vm, object* args, size_t nth, const object_schema* type, object* env, object* fail, object* then) {
218+
auto oa = args;
219+
for (size_t i = 0; i < nth; i++) {
220+
if (cdr(args) == NULL) {
221+
vm->set_failure(vm->wrap_error(vm->wrap_symbol("ValueError"), vm->list(2, oa, vm->wrap_integer(nth)), then), env, then, fail);
222+
return;
223+
}
224+
args = cdr(args);
225+
}
226+
auto val = car(args);
227+
if (val == NULL || (val->schema != type))
228+
vm->set_failure(vm->wrap_error(vm->wrap_symbol("TypeError"), vm->list(3, oa, vm->wrap_integer(nth), val), then), env, then, fail);
229+
else
230+
vm->set_retval(vm->list(2, car(args), oa), env, then, fail);
231+
}
232+
233+
//--------------- PARSER --------------------------------------
234+
207235
// Can be called by the program
208-
void funcs::parse(pickle* runner, object* args, object* env, object* cont, object* fail_cont) {
236+
void funcs::parse(pickle* vm, object* args, object* env, object* cont, object* fail_cont) {
209237
DBG("parsing");
210-
object* s = car(args);
211-
const char* str = (const char*)(s->cells[0].as_chars);
212-
object* result = s->cells[1].as_obj;
213-
if (result) { // Saved preparse
214-
if (result->schema == &error_type) goto failure;
215-
else goto success;
216-
}
217-
TODO;
218-
// result = runner->wrap_error(runner->wrap_symbol("SyntaxError"), runner->wrap_string(message), runner->list(1, result), cont)
219-
success:
220-
runner->set_retval(runner->list(1, result), env, cont, fail_cont);
221-
s->cells[1].as_obj = result; // Save parse for later if constantly reparsing string (i.e. a loop)
222-
return;
223-
failure:
224-
runner->set_failure(result, env, cont, fail_cont);
225-
// TODO: copy error as cached parse result
238+
getarg(vm, args, 0, &string_type, env, fail_cont, vm->wrap_func(PICKLE_INLINE_FUNC {
239+
GOTTEN_ARG(s);
240+
const char* str = (const char*)(s->cells[0].as_chars);
241+
object* result = s->cells[1].as_obj;
242+
const char* message;
243+
bool success = true;
244+
if (result) { // Saved preparse
245+
if (result->schema == &error_type) success = false;
246+
goto done;
247+
}
248+
result = vm->wrap_string("Hello, World! parse result i am.");
249+
done:
250+
if (success) vm->set_retval(vm->list(1, result), env, cont, fail_cont);
251+
else {
252+
result = vm->wrap_error(vm->wrap_symbol("SyntaxError"), vm->list(1, vm->wrap_string(message), result), cont);
253+
vm->set_failure(result, env, cont, fail_cont);
254+
}
255+
s->cells[1].as_obj = result; // Save parse for later if constantly eval'ing string (i.e. a loop)
256+
}));
226257
}
227258

228-
static object* get_best_match(pickle* runner, object* ast, object** env) {
229-
TODO;
259+
static object* get_best_match(pickle* vm, object* ast, object** env) {
260+
TODO(gbm);
230261
return NULL;
231262
}
232263

233264
// Eval(list) ::= apply_first_pattern(list), then eval(remaining list), else list if no patterns match
234-
void funcs::eval(pickle* runner, object* args, object* env, object* cont, object* fail_cont) {
265+
void funcs::eval(pickle* vm, object* args, object* env, object* cont, object* fail_cont) {
235266
object* ast = car(args);
236267
// returns Match object: 0=pattern, 1=handler body, 2=match details for splice; and updates env with bindings
237268
object* oldenv = env;
238-
object* matched_pattern = get_best_match(runner, ast, &env);
269+
object* matched_pattern = get_best_match(vm, ast, &env);
239270
if (matched_pattern != NULL) {
240271
// do next is run body --> cont=apply match cont-> eval again -> original eval cont
241-
runner->do_later(runner->make_partial(
272+
vm->do_later(vm->make_partial(
242273
NULL,//matched_pattern->body(),
243274
NULL,
244275
env,
245-
runner->make_partial(
246-
runner->wrap_func(funcs::splice_match),
247-
runner->list(2, runner->append(ast, NULL), NULL/*matched_pattern->match_info()*/),
276+
vm->make_partial(
277+
vm->wrap_func(funcs::splice_match),
278+
vm->list(2, vm->append(ast, NULL), NULL/*matched_pattern->match_info()*/),
248279
oldenv,
249-
runner->make_partial(
250-
runner->wrap_func(funcs::eval),
280+
vm->make_partial(
281+
vm->wrap_func(funcs::eval),
251282
NULL,
252283
oldenv,
253284
cont,
@@ -259,12 +290,12 @@ void funcs::eval(pickle* runner, object* args, object* env, object* cont, object
259290
));
260291
} else {
261292
// No matches so return unchanged
262-
runner->set_retval(runner->list(1, ast), env, cont, fail_cont);
293+
vm->set_retval(vm->list(1, ast), env, cont, fail_cont);
263294
}
264295
}
265296

266-
void funcs::splice_match(pickle* runner, object* args, object* env, object* cont, object* fail_cont) {
267-
TODO;
297+
void funcs::splice_match(pickle* vm, object* args, object* env, object* cont, object* fail_cont) {
298+
TODO(sm);
268299
}
269300

270301

‎pickle.hpp

+18-5
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@ extern const object_schema stream_type;
3131
extern const object_schema error_type;
3232
extern const object_schema integer_type;
3333
extern const object_schema float_type;
34+
extern const object_schema list_type;
3435

3536
class pickle : public tinobsy::vm {
3637
public:
@@ -47,12 +48,20 @@ class pickle : public tinobsy::vm {
4748
inline object* wrap_func(func_ptr f) {
4849
return this->allocate(&c_function_type, f);
4950
}
51+
inline func_ptr unwrap_func(object* f) {
52+
ASSERT(f != NULL && f->schema == &c_function_type);
53+
return (func_ptr)f->as_ptr;
54+
}
5055
inline object* make_partial(object* func, object* args, object* env, object* continuation, object* failure_continuation) {
5156
return this->allocate(&partial_type, func, args, env, continuation, failure_continuation);
5257
}
5358
inline object* wrap_string(const char* chs) {
5459
return this->allocate(&string_type, chs);
5560
}
61+
inline const char* const unwrap_string(object* s) {
62+
ASSERT(s != NULL && s->schema == &string_type);
63+
return s->cells[0].as_chars;
64+
}
5665
inline object* wrap_symbol(const char* symbol) {
5766
return this->allocate(&symbol_type, symbol);
5867
}
@@ -91,20 +100,24 @@ class pickle : public tinobsy::vm {
91100

92101

93102
namespace funcs {
94-
void parse(pickle* runner, object* args, object* env, object* cont, object* fail_cont);
95-
void eval(pickle* runner, object* args, object* env, object* cont, object* fail_cont);
96-
void splice_match(pickle* runner, object* args, object* env, object* cont, object* fail_cont);
103+
void parse(pickle* vm, object* args, object* env, object* cont, object* fail_cont);
104+
void eval(pickle* vm, object* args, object* env, object* cont, object* fail_cont);
105+
void splice_match(pickle* vm, object* args, object* env, object* cont, object* fail_cont);
97106
}
98107

108+
void getarg(pickle* vm, object* args, size_t nth, const object_schema* type, object* env, object* fail, object* then);
109+
99110
}
100111

101112
#define car(x) ((x)->cells[0].as_obj)
102113
#define cdr(x) ((x)->cells[1].as_obj)
114+
#define PICKLE_INLINE_FUNC [](::pickle::pickle* vm, ::pickle::object* args, ::pickle::object* env, ::pickle::object* cont, ::pickle::object* fail_cont) -> void
115+
#define GOTTEN_ARG(nm) auto nm = car(args); args = car(cdr(args))
103116

104117
#ifdef TINOBSY_DEBUG
105-
#define TODO do { DBG("%s: %s", __func__, strerror(ENOSYS)); errno = ENOSYS; perror(__func__); exit(74); } while (0)
118+
#define TODO(nm) do { DBG("%s: %s", #nm, strerror(ENOSYS)); errno = ENOSYS; perror(#nm); exit(74); } while (0)
106119
#else
107-
#define TODO
120+
#define TODO(nm)
108121
#endif
109122

110123
#include "pickle.cpp"

‎pickle_test.cpp

+5-3
Original file line numberDiff line numberDiff line change
@@ -22,9 +22,11 @@ int main() {
2222
start_catch_segfault();
2323
auto vm = new pickle::pickle();
2424
auto foo = vm->with_metadata(vm->wrap_string("foo\n bar\n syntax error"), 1, 1, "foo.pickle", vm->list(3, NULL, NULL, NULL));
25-
vm->run_next_thunk();
26-
vm->gc();
27-
printf("hello world\n");
25+
pickle::funcs::parse(vm, vm->list(1, foo), NULL, vm->wrap_func(PICKLE_INLINE_FUNC {
26+
printf("Foofunc called. Args[0] should be a string, value = %s\n", car(args)->cells[0].as_chars);
27+
}), NULL);
28+
while (vm->queue_head) vm->run_next_thunk(), vm->gc();
29+
printf("all done\n");
2830
delete vm;
2931
return 0;
3032
}

‎test/out32.txt

+98-4
Original file line numberDiff line numberDiff line change
@@ -33,12 +33,106 @@
3333
[tinobsy/tinobsy.cpp:33-allocate] Assertion succeeded: schema != NULL
3434
[tinobsy/tinobsy.cpp:34-allocate] vm::allocate() a object_metadata
3535
[pickle.cpp:45-initmulti] creating object_metadata (4 cells)
36-
[pickle.cpp:173-run_next_thunk] run_next_thunk
37-
[tinobsy/tinobsy.cpp:79-gc] vm::gc() begin, 7 objects {
36+
[tinobsy/tinobsy.cpp:33-allocate] Assertion succeeded: schema != NULL
37+
[tinobsy/tinobsy.cpp:34-allocate] vm::allocate() a c_function
38+
[pickle.cpp:58-init_c_function] Function is eval(): false
39+
[pickle.cpp:59-init_c_function] Function is parse(): false
40+
[tinobsy/tinobsy.cpp:38-allocate] Trying to intern a c_function
41+
[tinobsy/tinobsy.cpp:47-allocate] New c_function not interned
42+
[tinobsy/tinobsy.cpp:33-allocate] Assertion succeeded: schema != NULL
43+
[tinobsy/tinobsy.cpp:34-allocate] vm::allocate() a cons
44+
[tinobsy/tinobsy.cpp:110-init_cons]
45+
[pickle.cpp:237-parse] parsing
46+
[tinobsy/tinobsy.cpp:33-allocate] Assertion succeeded: schema != NULL
47+
[tinobsy/tinobsy.cpp:34-allocate] vm::allocate() a c_function
48+
[pickle.cpp:58-init_c_function] Function is eval(): false
49+
[pickle.cpp:59-init_c_function] Function is parse(): false
50+
[tinobsy/tinobsy.cpp:38-allocate] Trying to intern a c_function
51+
[tinobsy/tinobsy.cpp:47-allocate] New c_function not interned
52+
[tinobsy/tinobsy.cpp:33-allocate] Assertion succeeded: schema != NULL
53+
[tinobsy/tinobsy.cpp:34-allocate] vm::allocate() a cons
54+
[tinobsy/tinobsy.cpp:110-init_cons]
55+
[tinobsy/tinobsy.cpp:33-allocate] Assertion succeeded: schema != NULL
56+
[tinobsy/tinobsy.cpp:34-allocate] vm::allocate() a cons
57+
[tinobsy/tinobsy.cpp:110-init_cons]
58+
[tinobsy/tinobsy.cpp:33-allocate] Assertion succeeded: schema != NULL
59+
[tinobsy/tinobsy.cpp:34-allocate] vm::allocate() a function_partial
60+
[pickle.cpp:45-initmulti] creating function_partial (5 cells)
61+
[tinobsy/tinobsy.cpp:33-allocate] Assertion succeeded: schema != NULL
62+
[tinobsy/tinobsy.cpp:34-allocate] vm::allocate() a cons
63+
[tinobsy/tinobsy.cpp:110-init_cons]
64+
[tinobsy/tinobsy.cpp:33-allocate] Assertion succeeded: schema != NULL
65+
[tinobsy/tinobsy.cpp:34-allocate] vm::allocate() a cons
66+
[tinobsy/tinobsy.cpp:110-init_cons]
67+
[tinobsy/tinobsy.cpp:33-allocate] Assertion succeeded: schema != NULL
68+
[tinobsy/tinobsy.cpp:34-allocate] vm::allocate() a function_partial
69+
[pickle.cpp:45-initmulti] creating function_partial (5 cells)
70+
[pickle.cpp:170-do_later] do_later: Adding cons to tail
71+
[tinobsy/tinobsy.cpp:33-allocate] Assertion succeeded: schema != NULL
72+
[tinobsy/tinobsy.cpp:34-allocate] vm::allocate() a cons
73+
[tinobsy/tinobsy.cpp:110-init_cons]
74+
[pickle.cpp:183-run_next_thunk] run_next_thunk
75+
[pickle.cpp:186-run_next_thunk] Have thunk
76+
[pickle.cpp:190-run_next_thunk] Have func
77+
[pickle.cpp:192-run_next_thunk] Native function
78+
[tinobsy/tinobsy.cpp:33-allocate] Assertion succeeded: schema != NULL
79+
[tinobsy/tinobsy.cpp:34-allocate] vm::allocate() a string
80+
[pickle.cpp:69-init_string] init_string: Hello, World! parse result i am.
81+
[tinobsy/tinobsy.cpp:38-allocate] Trying to intern a string
82+
[tinobsy/tinobsy.cpp:47-allocate] New string not interned
83+
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAa[tinobsy/tinobsy.cpp:33-allocate] Assertion succeeded: schema != NULL
84+
[tinobsy/tinobsy.cpp:34-allocate] vm::allocate() a cons
85+
[tinobsy/tinobsy.cpp:110-init_cons]
86+
[tinobsy/tinobsy.cpp:79-gc] vm::gc() begin, 19 objects {
3887
[tinobsy/tinobsy.cpp:59-mark] NULL::mark()
3988
[tinobsy/tinobsy.cpp:59-mark] NULL::mark()
4089
[tinobsy/tinobsy.cpp:59-mark] NULL::mark()
4190
[tinobsy/tinobsy.cpp:82-gc] garbage collect sweeping
91+
[tinobsy/tinobsy.cpp:22-~object] object::~object() for a cons begin {
92+
[tinobsy/tinobsy.cpp:25-~object] Assertion succeeded: xt != NULL
93+
[tinobsy/tinobsy.cpp:124-finalize_cons]
94+
[tinobsy/tinobsy.cpp:27-~object] }
95+
[tinobsy/tinobsy.cpp:22-~object] object::~object() for a string begin {
96+
[tinobsy/tinobsy.cpp:25-~object] Assertion succeeded: xt != NULL
97+
[tinobsy/tinobsy.cpp:27-~object] }
98+
[tinobsy/tinobsy.cpp:22-~object] object::~object() for a cons begin {
99+
[tinobsy/tinobsy.cpp:25-~object] Assertion succeeded: xt != NULL
100+
[tinobsy/tinobsy.cpp:124-finalize_cons]
101+
[tinobsy/tinobsy.cpp:27-~object] }
102+
[tinobsy/tinobsy.cpp:22-~object] object::~object() for a function_partial begin {
103+
[tinobsy/tinobsy.cpp:25-~object] Assertion succeeded: xt != NULL
104+
[tinobsy/tinobsy.cpp:124-finalize_cons]
105+
[tinobsy/tinobsy.cpp:27-~object] }
106+
[tinobsy/tinobsy.cpp:22-~object] object::~object() for a cons begin {
107+
[tinobsy/tinobsy.cpp:25-~object] Assertion succeeded: xt != NULL
108+
[tinobsy/tinobsy.cpp:124-finalize_cons]
109+
[tinobsy/tinobsy.cpp:27-~object] }
110+
[tinobsy/tinobsy.cpp:22-~object] object::~object() for a cons begin {
111+
[tinobsy/tinobsy.cpp:25-~object] Assertion succeeded: xt != NULL
112+
[tinobsy/tinobsy.cpp:124-finalize_cons]
113+
[tinobsy/tinobsy.cpp:27-~object] }
114+
[tinobsy/tinobsy.cpp:22-~object] object::~object() for a function_partial begin {
115+
[tinobsy/tinobsy.cpp:25-~object] Assertion succeeded: xt != NULL
116+
[tinobsy/tinobsy.cpp:124-finalize_cons]
117+
[tinobsy/tinobsy.cpp:27-~object] }
118+
[tinobsy/tinobsy.cpp:22-~object] object::~object() for a cons begin {
119+
[tinobsy/tinobsy.cpp:25-~object] Assertion succeeded: xt != NULL
120+
[tinobsy/tinobsy.cpp:124-finalize_cons]
121+
[tinobsy/tinobsy.cpp:27-~object] }
122+
[tinobsy/tinobsy.cpp:22-~object] object::~object() for a cons begin {
123+
[tinobsy/tinobsy.cpp:25-~object] Assertion succeeded: xt != NULL
124+
[tinobsy/tinobsy.cpp:124-finalize_cons]
125+
[tinobsy/tinobsy.cpp:27-~object] }
126+
[tinobsy/tinobsy.cpp:22-~object] object::~object() for a c_function begin {
127+
[tinobsy/tinobsy.cpp:25-~object] Assertion succeeded: xt != NULL
128+
[tinobsy/tinobsy.cpp:27-~object] }
129+
[tinobsy/tinobsy.cpp:22-~object] object::~object() for a cons begin {
130+
[tinobsy/tinobsy.cpp:25-~object] Assertion succeeded: xt != NULL
131+
[tinobsy/tinobsy.cpp:124-finalize_cons]
132+
[tinobsy/tinobsy.cpp:27-~object] }
133+
[tinobsy/tinobsy.cpp:22-~object] object::~object() for a c_function begin {
134+
[tinobsy/tinobsy.cpp:25-~object] Assertion succeeded: xt != NULL
135+
[tinobsy/tinobsy.cpp:27-~object] }
42136
[tinobsy/tinobsy.cpp:22-~object] object::~object() for a object_metadata begin {
43137
[tinobsy/tinobsy.cpp:25-~object] Assertion succeeded: xt != NULL
44138
[tinobsy/tinobsy.cpp:124-finalize_cons]
@@ -64,7 +158,7 @@
64158
[tinobsy/tinobsy.cpp:25-~object] Assertion succeeded: xt != NULL
65159
[tinobsy/tinobsy.cpp:124-finalize_cons]
66160
[tinobsy/tinobsy.cpp:27-~object] }
67-
[tinobsy/tinobsy.cpp:95-gc] vm::gc() end, 0 objects, 7 freed }
68-
hello world
161+
[tinobsy/tinobsy.cpp:95-gc] vm::gc() end, 0 objects, 19 freed }
162+
all done
69163
[tinobsy/tinobsy.cpp:100-~vm] vm::~vm() {
70164
[tinobsy/tinobsy.cpp:106-~vm] }

0 commit comments

Comments
 (0)