diff --git a/core/compile.c b/core/compile.c index d68f625d..85c41b31 100644 --- a/core/compile.c +++ b/core/compile.c @@ -1133,12 +1133,13 @@ static SpecialFormHelper get_special(const GstValue *form) { name[2] == 'r') { return compile_var; } - if (gst_string_length(name) == 6 && + if (gst_string_length(name) == 7 && name[1] == 'a' && name[2] == 'r' && name[3] == 's' && name[4] == 'e' && - name[5] == 't') { + name[5] == 't' && + name[6] == '!') { return compile_varset; } } @@ -1264,23 +1265,36 @@ static Slot compile_form(GstCompiler *c, FormOptions opts, const GstValue *form) /* Recursively compile any value or form */ static Slot compile_value(GstCompiler *c, FormOptions opts, GstValue x) { + Slot ret; + /* Check if recursion is too deep */ + if (c->recursionGuard++ > GST_RECURSION_GUARD) { + c_error(c, "recursed too deeply"); + } switch (x.type) { case GST_NIL: case GST_BOOLEAN: case GST_REAL: case GST_INTEGER: - return compile_nonref_type(c, opts, x); + ret = compile_nonref_type(c, opts, x); + break; case GST_STRING: - return compile_symbol(c, opts, x); + ret = compile_symbol(c, opts, x); + break; case GST_TUPLE: - return compile_form(c, opts, x.data.tuple); + ret = compile_form(c, opts, x.data.tuple); + break; case GST_ARRAY: - return compile_array(c, opts, x.data.array); + ret = compile_array(c, opts, x.data.array); + break; case GST_TABLE: - return compile_table(c, opts, x.data.table); + ret = compile_table(c, opts, x.data.table); + break; default: - return compile_literal(c, opts, x); + ret = compile_literal(c, opts, x); + break; } + c->recursionGuard--; + return ret; } /* Initialize a GstCompiler struct */ @@ -1290,6 +1304,7 @@ void gst_compiler(GstCompiler *c, Gst *vm) { c->tail = NULL; c->error.type = GST_NIL; c->env = vm->env; + c->recursionGuard = 0; compiler_push_scope(c, 0); } @@ -1297,6 +1312,7 @@ void gst_compiler(GstCompiler *c, Gst *vm) { * given AST. Returns NULL if there was an error during compilation. */ GstFunction *gst_compiler_compile(GstCompiler *c, GstValue form) { FormOptions opts = form_options_default(); + c->recursionGuard = 0; GstFuncDef *def; if (setjmp(c->onError)) { /* Clear all but root scope */ diff --git a/core/serialize.c b/core/serialize.c index 7f75d00a..a0e2e3ae 100644 --- a/core/serialize.c +++ b/core/serialize.c @@ -106,7 +106,8 @@ static const char *gst_deserialize_impl( const uint8_t *end, const uint8_t **newData, GstArray *visited, - GstValue *out) { + GstValue *out, + int depth) { GstValue ret; ret.type = GST_NIL; @@ -129,6 +130,11 @@ static const char *gst_deserialize_impl( #define read_dbl(out) do{deser_datacheck(8); (out)=bytes2dbl(data); data += 8; }while(0) #define read_i64(out) do{deser_datacheck(8); (out)=bytes2int(data); data += 8; }while(0) + /* Check if we have recursed too deeply */ + if (depth++ > GST_RECURSION_GUARD) { + return "deserialize recursed too deeply"; + } + /* Check enough buffer left to read one byte */ if (data >= end) deser_error(UEB); @@ -181,9 +187,9 @@ static const char *gst_deserialize_impl( buffer = gst_struct_begin(vm, length); for (i = 0; i < length; ++i) { GstValue k, v; - if ((err = gst_deserialize_impl(vm, data, end, &data, visited, &k))) + if ((err = gst_deserialize_impl(vm, data, end, &data, visited, &k, depth))) return err; - if ((err = gst_deserialize_impl(vm, data, end, &data, visited, &v))) + if ((err = gst_deserialize_impl(vm, data, end, &data, visited, &v, depth))) return err; gst_struct_put(buffer, k, v); } @@ -217,7 +223,7 @@ static const char *gst_deserialize_impl( ret.data.array->capacity = length; gst_array_push(vm, visited, ret); for (i = 0; i < length; ++i) - if ((err = gst_deserialize_impl(vm, data, end, &data, visited, buffer + i))) + if ((err = gst_deserialize_impl(vm, data, end, &data, visited, buffer + i, depth))) return err; break; @@ -226,7 +232,7 @@ static const char *gst_deserialize_impl( read_u32(length); buffer = gst_tuple_begin(vm, length); for (i = 0; i < length; ++i) - if ((err = gst_deserialize_impl(vm, data, end, &data, visited, buffer + i))) + if ((err = gst_deserialize_impl(vm, data, end, &data, visited, buffer + i, depth))) return err; ret.type = GST_TUPLE; ret.data.tuple = gst_tuple_end(vm, buffer); @@ -242,7 +248,7 @@ static const char *gst_deserialize_impl( t = gst_thread(vm, gst_wrap_nil(), 64); ret = gst_wrap_thread(t); gst_array_push(vm, visited, ret); - err = gst_deserialize_impl(vm, data, end, &data, visited, &ret); + err = gst_deserialize_impl(vm, data, end, &data, visited, &ret, depth); if (err != NULL) return err; if (ret.type == GST_NIL) { t->parent = NULL; @@ -251,7 +257,7 @@ static const char *gst_deserialize_impl( } else { return "expected thread parent to be thread"; } - err = gst_deserialize_impl(vm, data, end, &data, visited, &ret); + err = gst_deserialize_impl(vm, data, end, &data, visited, &ret, depth); if (err != NULL) return err; if (ret.type == GST_NIL) { t->errorParent = NULL; @@ -271,9 +277,9 @@ static const char *gst_deserialize_impl( uint32_t pcoffset; uint16_t ret, args, size, j; /* Read the stack */ - err = gst_deserialize_impl(vm, data, end, &data, visited, &callee); + err = gst_deserialize_impl(vm, data, end, &data, visited, &callee, depth); if (err != NULL) return err; - err = gst_deserialize_impl(vm, data, end, &data, visited, &env); + err = gst_deserialize_impl(vm, data, end, &data, visited, &env, depth); if (err != NULL) return err; if (env.type != GST_FUNCENV && env.type != GST_NIL) return "expected funcenv in stackframe"; @@ -302,7 +308,7 @@ static const char *gst_deserialize_impl( /* Push stack args */ for (j = 0; j < size; ++j) { GstValue temp; - err = gst_deserialize_impl(vm, data, end, &data, visited, &temp); + err = gst_deserialize_impl(vm, data, end, &data, visited, &temp, depth); gst_thread_push(vm, t, temp); } } @@ -315,9 +321,9 @@ static const char *gst_deserialize_impl( gst_array_push(vm, visited, ret); for (i = 0; i < length; ++i) { GstValue key, value; - err = gst_deserialize_impl(vm, data, end, &data, visited, &key); + err = gst_deserialize_impl(vm, data, end, &data, visited, &key, depth); if (err != NULL) return err; - err = gst_deserialize_impl(vm, data, end, &data, visited, &value); + err = gst_deserialize_impl(vm, data, end, &data, visited, &value, depth); if (err != NULL) return err; gst_table_put(vm, ret.data.table, key, value); } @@ -344,7 +350,7 @@ static const char *gst_deserialize_impl( def->literals = NULL; } for (i = 0; i < literalsLen; ++i) { - err = gst_deserialize_impl(vm, data, end, &data, visited, def->literals + i); + err = gst_deserialize_impl(vm, data, end, &data, visited, def->literals + i, depth); if (err != NULL) return err; } read_u32(byteCodeLen); @@ -363,7 +369,7 @@ static const char *gst_deserialize_impl( ret.type = GST_FUNCENV; ret.data.env = gst_alloc(vm, sizeof(GstFuncEnv)); gst_array_push(vm, visited, ret); - err = gst_deserialize_impl(vm, data, end, &data, visited, &thread); + err = gst_deserialize_impl(vm, data, end, &data, visited, &thread, depth); if (err != NULL) return err; read_u32(length); ret.data.env->stackOffset = length; @@ -374,7 +380,7 @@ static const char *gst_deserialize_impl( ret.data.env->values = gst_alloc(vm, sizeof(GstValue) * length); for (i = 0; i < length; ++i) { GstValue item; - err = gst_deserialize_impl(vm, data, end, &data, visited, &item); + err = gst_deserialize_impl(vm, data, end, &data, visited, &item, depth); if (err != NULL) return err; ret.data.env->values[i] = item; } @@ -388,11 +394,11 @@ static const char *gst_deserialize_impl( ret.type = GST_FUNCTION; ret.data.function = gst_alloc(vm, sizeof(GstFunction)); gst_array_push(vm, visited, ret); - err = gst_deserialize_impl(vm, data, end, &data, visited, &parent); + err = gst_deserialize_impl(vm, data, end, &data, visited, &parent, depth); if (err != NULL) return err; - err = gst_deserialize_impl(vm, data, end, &data, visited, &env); + err = gst_deserialize_impl(vm, data, end, &data, visited, &env, depth); if (err != NULL) return err; - err = gst_deserialize_impl(vm, data, end, &data, visited, &def); + err = gst_deserialize_impl(vm, data, end, &data, visited, &def, depth); if (err != NULL) return err; if (parent.type == GST_NIL) { ret.data.function->parent = NULL; @@ -460,7 +466,7 @@ const char *gst_deserialize( GstValue ret; const char *err; GstArray *visited = gst_array(vm, 10); - err = gst_deserialize_impl(vm, data, data + len, nextData, visited, &ret); + err = gst_deserialize_impl(vm, data, data + len, nextData, visited, &ret, 0); if (err != NULL) return err; *out = ret; return NULL; @@ -474,12 +480,13 @@ BUFFER_DEFINE(u16, uint16_t) /* Serialize a value and write to a buffer. Returns possible * error messages. */ -const char *gst_serialize_impl( +static const char *gst_serialize_impl( Gst *vm, GstBuffer *buffer, GstTable *visited, uint32_t *nextId, - GstValue x) { + GstValue x, + int depth) { uint32_t i, count; const char *err; @@ -492,6 +499,11 @@ const char *gst_serialize_impl( #define write_int(b) gst_buffer_push_integer(vm, buffer, (b)) /*printf("Type: %d\n", x.type);*/ + /* Check if we have gone too deep */ + if (depth++ > GST_RECURSION_GUARD) { + return "serialize recursed too deeply"; + } + /* Check non reference types - if successful, return NULL */ switch (x.type) { case GST_USERDATA: @@ -539,9 +551,9 @@ const char *gst_serialize_impl( write_u32(gst_struct_length(x.data.st)); for (i = 0; i < count; i += 2) { if (data[i].type != GST_NIL) { - err = gst_serialize_impl(vm, buffer, visited, nextId, data[i]); + err = gst_serialize_impl(vm, buffer, visited, nextId, data[i], depth); if (err != NULL) return err; - err = gst_serialize_impl(vm, buffer, visited, nextId, data[i + 1]); + err = gst_serialize_impl(vm, buffer, visited, nextId, data[i + 1], depth); if (err != NULL) return err; } } @@ -550,7 +562,7 @@ const char *gst_serialize_impl( count = gst_tuple_length(x.data.tuple); write_u32(count); for (i = 0; i < count; ++i) { - err = gst_serialize_impl(vm, buffer, visited, nextId, x.data.tuple[i]); + err = gst_serialize_impl(vm, buffer, visited, nextId, x.data.tuple[i], depth); if (err != NULL) return err; } } @@ -598,9 +610,9 @@ const char *gst_serialize_impl( write_u32(x.data.table->count); for (i = 0; i < count; i += 2) { if (data[i].type != GST_NIL) { - err = gst_serialize_impl(vm, buffer, visited, nextId, data[i]); + err = gst_serialize_impl(vm, buffer, visited, nextId, data[i], depth); if (err != NULL) return err; - err = gst_serialize_impl(vm, buffer, visited, nextId, data[i + 1]); + err = gst_serialize_impl(vm, buffer, visited, nextId, data[i + 1], depth); if (err != NULL) return err; } } @@ -622,7 +634,7 @@ const char *gst_serialize_impl( count = x.data.array->count; write_u32(count); for (i = 0; i < count; ++i) { - err = gst_serialize_impl(vm, buffer, visited, nextId, x.data.array->data[i]); + err = gst_serialize_impl(vm, buffer, visited, nextId, x.data.array->data[i], depth); if (err != NULL) return err; } break; @@ -635,14 +647,14 @@ const char *gst_serialize_impl( uint32_t i; write_byte(210); if (t->parent) - err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_thread(t->parent)); + err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_thread(t->parent), depth); else - err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_nil()); + err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_nil(), depth); if (t->errorParent) err = gst_serialize_impl(vm, buffer, visited, nextId, - gst_wrap_thread(t->errorParent)); + gst_wrap_thread(t->errorParent), depth); else - err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_nil()); + err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_nil(), depth); if (err != NULL) return err; /* Write the status byte */ write_byte(t->status); @@ -653,12 +665,12 @@ const char *gst_serialize_impl( uint32_t j, size; GstValue callee = gst_frame_callee(stack); GstFuncEnv *env = gst_frame_env(stack); - err = gst_serialize_impl(vm, buffer, visited, nextId, callee); + err = gst_serialize_impl(vm, buffer, visited, nextId, callee, depth); if (err != NULL) return err; if (env) - err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_funcenv(env)); + err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_funcenv(env), depth); else - err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_nil()); + err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_nil(), depth); if (err != NULL) return err; if (callee.type == GST_FUNCTION) { write_u32(gst_frame_pc(stack) - callee.data.function->def->byteCode); @@ -670,7 +682,7 @@ const char *gst_serialize_impl( size = gst_frame_size(stack); write_u32(size); for (j = 0; j < size; ++j) { - err = gst_serialize_impl(vm, buffer, visited, nextId, stack[j]); + err = gst_serialize_impl(vm, buffer, visited, nextId, stack[j], depth); if (err != NULL) return err; } /* Next stack frame */ @@ -688,7 +700,7 @@ const char *gst_serialize_impl( write_u32(def->flags); write_u32(def->literalsLen); for (i = 0; i < def->literalsLen; ++i) { - err = gst_serialize_impl(vm, buffer, visited, nextId, def->literals[i]); + err = gst_serialize_impl(vm, buffer, visited, nextId, def->literals[i], depth); if (err != NULL) return err; } write_u32(def->byteCodeLen); @@ -703,14 +715,14 @@ const char *gst_serialize_impl( GstFuncEnv *env = x.data.env; write_byte(213); if (env->thread) { - err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_thread(env->thread)); + err = gst_serialize_impl(vm, buffer, visited, nextId, gst_wrap_thread(env->thread), depth); if (err != NULL) return err; write_u32(env->stackOffset); } else { write_byte(201); /* Write nil */ write_u32(env->stackOffset); for (i = 0; i < env->stackOffset; ++i) { - err = gst_serialize_impl(vm, buffer, visited, nextId, env->values[i]); + err = gst_serialize_impl(vm, buffer, visited, nextId, env->values[i], depth); if (err != NULL) return err; } } @@ -725,11 +737,11 @@ const char *gst_serialize_impl( pv = fn->parent ? gst_wrap_function(fn->parent) : gst_wrap_nil(); dv = gst_wrap_funcdef(fn->def); ev = fn->env ? gst_wrap_funcenv(fn->env) : gst_wrap_nil(); - err = gst_serialize_impl(vm, buffer, visited, nextId, pv); + err = gst_serialize_impl(vm, buffer, visited, nextId, pv, depth); if (err != NULL) return err; - err = gst_serialize_impl(vm, buffer, visited, nextId, ev); + err = gst_serialize_impl(vm, buffer, visited, nextId, ev, depth); if (err != NULL) return err; - err = gst_serialize_impl(vm, buffer, visited, nextId, dv); + err = gst_serialize_impl(vm, buffer, visited, nextId, dv, depth); if (err != NULL) return err; } break; @@ -745,7 +757,7 @@ const char *gst_serialize(Gst *vm, GstBuffer *buffer, GstValue x) { uint32_t oldCount = buffer->count; const char *err; GstTable *visited = gst_table(vm, 10); - err = gst_serialize_impl(vm, buffer, visited, &nextId, x); + err = gst_serialize_impl(vm, buffer, visited, &nextId, x, 0); if (err != NULL) { buffer->count = oldCount; } diff --git a/core/stl.c b/core/stl.c index c4288a6d..4017937f 100644 --- a/core/stl.c +++ b/core/stl.c @@ -1130,7 +1130,7 @@ static const GstModuleItem std_module[] = { {"parent", gst_stl_parent}, {"print", gst_stl_print}, {"tostring", gst_stl_tostring}, - {"exit", gst_stl_exit}, + {"exit!", gst_stl_exit}, {"get", gst_stl_get}, {"set!", gst_stl_set}, {"next", gst_stl_next}, diff --git a/gsttests/basic.gst b/gsttests/basic.gst index 496c525a..e3ce60bf 100644 --- a/gsttests/basic.gst +++ b/gsttests/basic.gst @@ -5,25 +5,68 @@ (if x (do (print " \e[32m✔\e[0m" e) - (varset numTestsPassed (+ 1 numTestsPassed)) x) + (varset! numTestsPassed (+ 1 numTestsPassed)) x) (do (print e) - (exit 1))))) + (exit! (+ numTestsPassed 1)))))) (assert (= 10 (+ 1 2 3 4)) "addition") (assert (= -8 (- 1 2 3 4)) "subtraction") (assert (= 24 (* 1 2 3 4)) "multiplication") (assert (= 4 (blshift 1 2)) "left shift") (assert (= 1 (brshift 4 2)) "right shift") +(assert (< 1 2 3 4 5 6) "less than integers") +(assert (< 1.0 2.0 3.0 4.0 5.0 6.0) "less than reals") +(assert (> 6 5 4 3 2 1) "greater than integers") +(assert (> 6.0 5.0 4.0 3.0 2.0 1.0) "greater then reals") +(assert (<= 1 2 3 3 4 5 6) "less than or equal to integers") +(assert (<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0) "less than or equal to reals") +(assert (>= 6 5 4 4 3 2 1) "greater than or equal to integers") +(assert (>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0) "greater than or equal to reals") + +(assert (< nil 1.0 1 false true "hi" + (array 1 2 3) + (tuple 1 2 3) + (table "a" "b" "c" false) + (struct 1 2) + (thread (fn [x] x)) + (buffer "hi") + (fn [x] (+ x x)) + +) "type ordering") + +(assert (not false) "false literal") +(assert true "true literal") +(assert (not nil) "nil literal") +(assert (= 7 (bor 3 4)) "bit or") +(assert (= 0 (band 3 4)) "bit and") (var accum 1) (var count 0) (while (< count 16) - (varset accum (blshift accum 1)) - (varset count (+ 1 count))) + (varset! accum (blshift accum 1)) + (varset! count (+ 1 count))) (assert (= accum 65536) "loop") -(print "All" numTestsPassed "tests passed") +"Serialization tests" +(def scheck (fn [x] + (def dat (serialize x)) + (def deser (deserialize dat)) + (assert (= x deser) (string "serialize " (debugp x))) +)) -(exit 0) \ No newline at end of file +(scheck 1) +(scheck true) +(scheck false) +(scheck nil) +(scheck "asdasdasd") +(scheck (struct 1 2 3 4)) +(scheck (tuple 1 2 3)) +(scheck 123412.12) +(scheck (struct (struct 1 2 3 "a") (struct 1 2 3 "a") false 1 "asdasd" (tuple "a" "b"))) +(scheck "psdafoilasdfbiusbdfliasbldfiubaslidufbliausdbfiluasbdfiulbasldiufbalisudhfiasudbfaisuldfbl") + +"All tests passed" + +(print "All" numTestsPassed "tests passed") +(exit! 0) \ No newline at end of file diff --git a/include/gst/gst.h b/include/gst/gst.h index 61c3b11e..ffa33491 100644 --- a/include/gst/gst.h +++ b/include/gst/gst.h @@ -88,6 +88,10 @@ /* Size of stack frame in number of values */ #define GST_FRAME_SIZE 5 +/* Prevent some recursive functions from recursing too deeply + * ands crashing. */ +#define GST_RECURSION_GUARD 2056 + /* Macros for referencing a stack frame given a stack */ #define gst_frame_callee(s) (*(s - 1)) #define gst_frame_size(s) ((s - 2)->data.dwords[0]) @@ -127,12 +131,12 @@ typedef enum GstType { GST_STRING, GST_ARRAY, GST_TUPLE, + GST_TABLE, GST_STRUCT, GST_THREAD, GST_BYTEBUFFER, GST_FUNCTION, GST_CFUNCTION, - GST_TABLE, GST_USERDATA, GST_FUNCENV, GST_FUNCDEF @@ -373,6 +377,7 @@ struct GstCompiler { GstScope *tail; GstBuffer *buffer; GstTable *env; + int recursionGuard; }; /* Bytecode */ diff --git a/libs/hello.gst b/libs/hello.gst index 298f057e..6c2048b3 100644 --- a/libs/hello.gst +++ b/libs/hello.gst @@ -5,9 +5,7 @@ (print _ ) "Comment" -(do - (: i 0) - (while (< i 1000) - (print i) - (: i (+ i 1))) -) +(var i 0) +(while (< i 1000) + (print i) + (varset i (+ i 1))) diff --git a/libs/pp.gst b/libs/pp.gst deleted file mode 100644 index a63fe3e2..00000000 --- a/libs/pp.gst +++ /dev/null @@ -1,65 +0,0 @@ -(do - -(: pp nil) - -"Pretty print an array or tuple" -(: print-seq (fn [start end a seen] - (: seen (if seen seen {})) - (if (get seen a) (get seen a) - (do - (set! seen a "") - (: parts []) - (: len (length a)) - (: i 0) - (while (< i len) - (push! parts (pp (get a i) seen)) - (push! parts " ") - (: i (+ 1 i))) - (if (> len 0) (pop! parts)) - (push! parts end) - (: ret (apply string start parts)) - (set! seen a ret) - ret)))) - -"Pretty print an object or struct" -(: print-struct (fn [start end s seen] - (: seen (if seen seen {})) - (if (get seen s) (get seen s) - (do - (set! seen s "") - (: parts []) - (: key (next s)) - (while (not (= key nil)) - (push! parts (pp key seen)) - (push! parts " ") - (push! parts (pp (get s key) seen)) - (push! parts " ") - (: key (next s key))) - (if (> (length parts) 0) (pop! parts)) - (push! parts end) - (: ret (apply string start parts)) - (set! seen s ret) - ret)))) - -"Type handlers" -(: handlers { - "array" (fn [a seen] (print-seq "[" "]" a seen)) - "tuple" (fn [a seen] (print-seq "(" ")" a seen)) - "table" (fn [s seen] (print-struct "{" "}" s seen)) - "struct" (fn [s seen] (print-struct "#{" "}" s seen)) - }) - -"Define pretty print" -(: pp (fn [x seen] - (: handler (get handlers (type x))) - (: handler (if handler handler tostring)) - (handler x seen))) - -"Export pretty print" -(export! "pp" pp) - -(: arr [1 2 3 4]) -(push! arr arr) -(print (pp arr)) - -) diff --git a/libs/serialize.gst b/libs/serialize.gst deleted file mode 100644 index c3f341ec..00000000 --- a/libs/serialize.gst +++ /dev/null @@ -1,22 +0,0 @@ -(export! "scheck" (fn [x] - (: dat (serialize x)) - (: deser (deserialize dat)) - (print (debugp deser)) - deser -)) - -(scheck 1) -(scheck true) -(scheck nil) -(scheck "asdasdasd") -(scheck (struct 1 2 3 4)) -(scheck (tuple 1 2 3)) -(scheck 123412.12) -(scheck (funcdef (fn [] 1))) -(scheck (funcenv (fn [] 1))) -(do - (: producer (fn [a] (fn [] a))) - (: f (producer "hello!")) - (scheck (funcenv f)) -) -(scheck (fn [] 1))