From d9f24effac850ac634f2e490e0f3f1e04c170d29 Mon Sep 17 00:00:00 2001 From: bakpakin Date: Sat, 13 Jan 2018 14:08:42 -0500 Subject: [PATCH] Fix compiler errors with upvalues. --- core/compile.c | 1 + core/math.c | 8 ++--- core/stl.c | 73 ++++++++++++++++++++++++++++++++++++++++++++++ core/string.c | 2 +- dsttest/suite0.dst | 21 +++++++++++++ 5 files changed, 100 insertions(+), 5 deletions(-) diff --git a/core/compile.c b/core/compile.c index 6c4d9d15..6560bb00 100644 --- a/core/compile.c +++ b/core/compile.c @@ -296,6 +296,7 @@ DstSlot dstc_resolve( /* Add the environment if it is not already referenced */ if (!scopefound) { if (!dst_v_count(scope->envs)) dst_v_push(scope->envs, 0); + len = dst_v_count(scope->envs); dst_v_push(scope->envs, envindex); envindex = len; } diff --git a/core/math.c b/core/math.c index 0653aac7..2f8abcf4 100644 --- a/core/math.c +++ b/core/math.c @@ -130,7 +130,7 @@ int dst_##name(int32_t argn, Dst *argv, Dst *ret) {\ *ret = dst_cstringv("expected at least one argument");\ return 1;\ } else if (argn == 1) {\ - accum = dst_wrap_real(unarystart);\ + accum = unarystart;\ i = 0;\ } else {\ accum = argv[0];\ @@ -147,9 +147,9 @@ int dst_##name(int32_t argn, Dst *argv, Dst *ret) {\ return 0;\ } -DST_DEFINE_DIVIDER(divide, 1) -DST_DEFINE_DIVIDER(modulo, 1) -DST_DEFINE_DIVIDER(subtract, 0) +DST_DEFINE_DIVIDER(divide, dst_wrap_real(1)) +DST_DEFINE_DIVIDER(modulo, dst_wrap_real(1)) +DST_DEFINE_DIVIDER(subtract, dst_wrap_integer(0)) #undef ADD #undef SUB diff --git a/core/stl.c b/core/stl.c index 54c6de7d..1ddddc5f 100644 --- a/core/stl.c +++ b/core/stl.c @@ -23,6 +23,76 @@ #include #include +int dst_stl_parse(int32_t argn, Dst *argv, Dst *ret) { + const uint8_t *src; + int32_t len; + DstParseResult res; + const char *status_string = "ok"; + DstTable *t; + if (argn < 1) { + *ret = dst_cstringv("expected at least on argument"); + return 1; + } + if (!dst_chararray_view(argv[0], &src, &len)) { + *ret = dst_cstringv("expected string/buffer"); + return 1; + } + res = dst_parse(src, len); + t = dst_table(4); + switch (res.status) { + case DST_PARSE_OK: + status_string = "ok"; + break; + case DST_PARSE_ERROR: + status_string = "error"; + break; + case DST_PARSE_NODATA: + status_string = "nodata"; + break; + case DST_PARSE_UNEXPECTED_EOS: + status_string = "eos"; + break; + } + dst_table_put(t, dst_cstringv("status"), dst_cstringv(status_string)); + if (res.status == DST_PARSE_OK) dst_table_put(t, dst_cstringv("map"), dst_wrap_tuple(res.map)); + if (res.status == DST_PARSE_OK) dst_table_put(t, dst_cstringv("value"), res.value); + if (res.status == DST_PARSE_ERROR) dst_table_put(t, dst_cstringv("error"), dst_wrap_string(res.error)); + dst_table_put(t, dst_cstringv("bytes-read"), dst_wrap_integer(res.bytes_read)); + *ret = dst_wrap_table(t); + return 0; +} + +int dst_stl_compile(int32_t argn, Dst *argv, Dst *ret) { + DstCompileOptions opts; + DstCompileResult res; + DstTable *t; + if (argn < 1) { + *ret = dst_cstringv("expected at least on argument"); + return 1; + } + if (argn >= 3 && !dst_checktype(argv[2], DST_TUPLE)) { + *ret = dst_cstringv("expected source map to be tuple"); + return 1; + } + opts.source = argv[0]; + opts.env = argn >= 2 ? argv[1] : dst_loadstl(0); + opts.sourcemap = argn >= 3 ? dst_unwrap_tuple(argv[2]) : NULL; + opts.flags = 0; + res = dst_compile(opts); + if (res.status == DST_COMPILE_OK) { + DstFunction *fun = dst_compile_func(res); + *ret = dst_wrap_function(fun); + } else { + t = dst_table(2); + dst_table_put(t, dst_cstringv("error"), dst_wrap_string(res.error)); + dst_table_put(t, dst_cstringv("error-start"), dst_wrap_integer(res.error_start)); + dst_table_put(t, dst_cstringv("error-end"), dst_wrap_integer(res.error_end)); + *ret = dst_wrap_table(t); + } + return 0; + +} + int dst_stl_exit(int32_t argn, Dst *argv, Dst *ret) { (void)ret; int32_t exitcode = 0; @@ -30,6 +100,7 @@ int dst_stl_exit(int32_t argn, Dst *argv, Dst *ret) { exitcode = dst_hash(argv[0]); } exit(exitcode); + return 0; } int dst_stl_print(int32_t argn, Dst *argv, Dst *ret) { @@ -314,6 +385,8 @@ DST_DEFINE_COMPARATOR(notdescending, > 0) DST_DEFINE_COMPARATOR(notascending, < 0) static DstReg stl[] = { + {"parse", dst_stl_parse}, + {"compile", dst_stl_compile}, {"int", dst_int}, {"real", dst_real}, {"print", dst_stl_print}, diff --git a/core/string.c b/core/string.c index c4749a8f..b85f0c90 100644 --- a/core/string.c +++ b/core/string.c @@ -107,7 +107,7 @@ const uint8_t *dst_cstring(const char *str) { #define DST_BUFSIZE 36 static int32_t real_to_string_impl(uint8_t *buf, double x) { - int count = snprintf((char *) buf, DST_BUFSIZE, "%.17g", x); + int count = snprintf((char *) buf, DST_BUFSIZE, "%.17gr", x); return (int32_t) count; } diff --git a/dsttest/suite0.dst b/dsttest/suite0.dst index 2c26b073..4b0ab2a0 100644 --- a/dsttest/suite0.dst +++ b/dsttest/suite0.dst @@ -157,6 +157,27 @@ (assert (= 10 (vargf [1 2 3 4])) "var arg tuple size 3") (assert (= 110 (vargf [1 2 3 4 10 10 10 10 10 10 10 10 10 10])) "var arg large tuple") +# Higher order functions + +(def compose (fn [f g] (fn [& xs] (f (apply g xs))))) + +(def -+ (compose - +)) +(def +- (compose + -)) + +(assert (= (-+ 1 2 3 4) -10) "compose - +") +(assert (= (+- 1 2 3 4) -8) "compose + -") +(assert (= ((compose -+ +-) 1 2 3 4) 8) "compose -+ +-") +(assert (= ((compose +- -+) 1 2 3 4) 10) "compose +- -+") + +# UTF-8 + +#🐙🐙🐙🐙 + +(def 🦊 :fox) +(def 🐮 :cow) +(assert (= (string "🐼" 🦊 🐮) "🐼foxcow") "emojis 🙉 :)") +(assert (not= 🦊 :🦊) "utf8 strings are not symbols and vice versa") + # Gensym tests (assert (not= (gensym) (gensym)) "two gensyms not equal")