From 85e4aae57bfc792742ef300a30030047e783c889 Mon Sep 17 00:00:00 2001 From: Benjamin Vedder Date: Wed, 26 Oct 2022 17:34:07 +0200 Subject: [PATCH] Squashed 'lispBM/lispBM/' changes from 4233bafe..1b286c45 1b286c45 variable_not_bound error prints the variable that is not bound edc731ae Atomic behaves as progn does now 73ddfc5a removed the type-based pattern binders, ?i, ?i32 ... git-subtree-dir: lispBM/lispBM git-subtree-split: 1b286c454af350df93fda02f86e356861e06a399 --- doc/lbmref.md | 46 +------------ include/heap.h | 11 +--- include/lbm_defines.h | 9 --- src/eval_cps.c | 139 +++++++++------------------------------ src/symrepr.c | 9 --- src/tokpar.c | 36 ---------- tests/test_atomic_2.lisp | 7 ++ tests/test_atomic_3.lisp | 7 ++ tests/test_atomic_4.lisp | 7 ++ tests/test_match_3.lisp | 2 +- tests/test_match_6.lisp | 8 +-- 11 files changed, 60 insertions(+), 221 deletions(-) create mode 100644 tests/test_atomic_2.lisp create mode 100644 tests/test_atomic_3.lisp create mode 100644 tests/test_atomic_4.lisp diff --git a/doc/lbmref.md b/doc/lbmref.md index b1026cd2..34a3ca39 100644 --- a/doc/lbmref.md +++ b/doc/lbmref.md @@ -1209,45 +1209,6 @@ An example that evaluates to 19. --- -### ?i - -The `?i` pattern matches an integer (28bit integer on 32bit platforms -and a 56bit integer on 64bit platforms) and binds that value to a -variable. Using the ?i pattern is done as `(?i var)` and the part -of the expression that matches is bound to the `var`. - -The following example evaluates to `not-an-i`. -```clj -(match 3.14 - ( (?i n) (+ n 1)) - ( _ 'not-an-i)) -``` -The example below evaluates to 5. -```clj -(match 4 - ( (?i n) (+ n 1)) - ( _ 'not-an-i)) -``` - - ---- - -### ?u - -The `?u` pattern matches any unsigned and binds that value to a variable. -Using the ?u pattern is done as `(?u var)` and the part of the expression -that matches is bound to the `var`. - ---- - -### ?float - -The `?float` pattern matches any float and binds that value to a -variable. Using the `?float` pattern is done as `(?float var)` and -the part of the expression that matches is bound to the `var`. - ---- - ## Concurrency The concurrency support in LispBM is provided by the set of functions, @@ -1318,17 +1279,16 @@ is number indicating at least how many microseconds the process should sleep. ### atomic -`atomic` can be used to execute a LispBM expression without allowing -the runtime system to switch task during the time that takes. +`atomic` can be used to execute a LispBM one or more expression without allowing +the runtime system to switch task during that time. An example that atomically perfoms operations a,b and c. ```clj (atomic - (progn a b - c)) + c) ``` --- diff --git a/include/heap.h b/include/heap.h index 295592a4..f27c0338 100644 --- a/include/heap.h +++ b/include/heap.h @@ -722,16 +722,7 @@ static inline bool lbm_is_macro(lbm_value exp) { static inline bool lbm_is_match_binder(lbm_value exp) { return ((lbm_type_of(exp) == LBM_TYPE_CONS) && (lbm_type_of(lbm_car(exp)) == LBM_TYPE_SYMBOL) && - ((lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_ANY) || - (lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_I) || - (lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_U) || - (lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_I32) || - (lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_U32) || - (lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_FLOAT) || - (lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_I64) || - (lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_U64) || - (lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_DOUBLE) || - (lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_CONS))); + ((lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_ANY))); } static inline bool lbm_is_comma_qualified_symbol(lbm_value exp) { diff --git a/include/lbm_defines.h b/include/lbm_defines.h index a92d73c9..be88b584 100644 --- a/include/lbm_defines.h +++ b/include/lbm_defines.h @@ -141,15 +141,6 @@ #define SYM_NO_MATCH 0x40 #define SYM_MATCH_ANY 0x41 -#define SYM_MATCH_I 0x42 -#define SYM_MATCH_U 0x43 -#define SYM_MATCH_U32 0x44 -#define SYM_MATCH_I32 0x45 -#define SYM_MATCH_FLOAT 0x46 -#define SYM_MATCH_CONS 0x47 -#define SYM_MATCH_U64 0x48 -#define SYM_MATCH_I64 0x49 -#define SYM_MATCH_DOUBLE 0x4A // Type identifying symbols #define SYM_TYPE_LIST 0x50 diff --git a/src/eval_cps.c b/src/eval_cps.c index 94a9e16e..17bee450 100644 --- a/src/eval_cps.c +++ b/src/eval_cps.c @@ -305,6 +305,11 @@ void print_error_message(lbm_value error, unsigned int row, unsigned int col) { lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES, error); printf_callback("***\tError:\t%s\n", buf); + if (lbm_is_symbol(error) && + error == ENC_SYM_NOT_FOUND) { + lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES, ctx_running->curr_exp); + printf_callback("***\t\t%s\n",buf); + } if (lbm_is_symbol(error) && error == ENC_SYM_RERROR) { @@ -920,88 +925,6 @@ static bool match(lbm_value p, lbm_value e, lbm_value *env, bool *gc) { return true; } break; - case SYM_MATCH_I: - if (lbm_type_of(e) == LBM_TYPE_I) { - if (lbm_dec_sym(var) == SYM_DONTCARE) { - return true; - } else { - break; - } - } - return false; - case SYM_MATCH_U: - if (lbm_type_of(e) == LBM_TYPE_U) { - if (lbm_dec_sym(var) == SYM_DONTCARE) { - return true; - } else { - break; - } - } - return false; - case SYM_MATCH_I32: - if (lbm_type_of(e) == LBM_TYPE_I32) { - if (lbm_dec_sym(var) == SYM_DONTCARE) { - return true; - } else { - break; - } - } - return false; - case SYM_MATCH_U32: - if (lbm_type_of(e) == LBM_TYPE_U32) { - if (lbm_dec_sym(var) == SYM_DONTCARE) { - return true; - } else { - break; - } - } - return false; - - case SYM_MATCH_FLOAT: - if (lbm_type_of(e) == LBM_TYPE_FLOAT) { - if (lbm_dec_sym(var) == SYM_DONTCARE) { - return true; - } else { - break; - } - } - return false; - case SYM_MATCH_U64: - if (lbm_type_of(e) == LBM_TYPE_U64) { - if (lbm_dec_sym(var) == SYM_DONTCARE) { - return true; - } else { - break; - } - } - return false; - case SYM_MATCH_I64: - if (lbm_type_of(e) == LBM_TYPE_I64) { - if (lbm_dec_sym(var) == SYM_DONTCARE) { - return true; - } else { - break; - } - } - return false; - case SYM_MATCH_DOUBLE: - if (lbm_type_of(e) == LBM_TYPE_DOUBLE) { - if (lbm_dec_sym(var) == SYM_DONTCARE) { - return true; - } else { - break; - } - } - return false; - case SYM_MATCH_CONS: - if (lbm_type_of(e) == LBM_TYPE_CONS) { - if (lbm_dec_sym(var) == SYM_DONTCARE) { - return true; - } else { - break; - } - } - return false; default: /* this should be an error case */ return false; } @@ -1223,6 +1146,30 @@ static void eval_selfevaluating(eval_context_t *ctx) { ctx->app_cont = true; } +static void eval_progn(eval_context_t *ctx) { + lbm_value exps = lbm_cdr(ctx->curr_exp); + lbm_value env = ctx->curr_env; + + if (lbm_is_cons(exps)) { + lbm_uint *sptr = lbm_stack_reserve(&ctx->K, 3); + if (!sptr) { + error_ctx(ENC_SYM_STACK_ERROR); + return; + } + sptr[0] = env; + sptr[1] = lbm_cdr(exps); + sptr[2] = PROGN_REST; + ctx->curr_exp = lbm_car(exps); + ctx->curr_env = env; + if (lbm_is_symbol(sptr[1])) /* The only symbol it can be is nil */ + lbm_stack_drop(&ctx->K, 3); + } else if (lbm_is_symbol_nil(exps)) { + ctx->r = ENC_SYM_NIL; + ctx->app_cont = true; + } else { + error_ctx(ENC_SYM_EERROR); + } +} static void eval_atomic(eval_context_t *ctx) { if (is_atomic) { @@ -1233,8 +1180,7 @@ static void eval_atomic(eval_context_t *ctx) { CHECK_STACK(lbm_push(&ctx->K, EXIT_ATOMIC)); is_atomic = true; - ctx->curr_exp = lbm_cadr(ctx->curr_exp); - /*NOTE: ctx->app_cont = false; */ + eval_progn(ctx); } @@ -1307,31 +1253,6 @@ static void eval_define(eval_context_t *ctx) { return; } -static void eval_progn(eval_context_t *ctx) { - lbm_value exps = lbm_cdr(ctx->curr_exp); - lbm_value env = ctx->curr_env; - - if (lbm_is_cons(exps)) { - lbm_uint *sptr = lbm_stack_reserve(&ctx->K, 3); - if (!sptr) { - error_ctx(ENC_SYM_STACK_ERROR); - return; - } - sptr[0] = env; - sptr[1] = lbm_cdr(exps); - sptr[2] = PROGN_REST; - ctx->curr_exp = lbm_car(exps); - ctx->curr_env = env; - if (lbm_is_symbol(sptr[1])) /* The only symbol it can be is nil */ - lbm_stack_drop(&ctx->K, 3); - } else if (lbm_is_symbol_nil(exps)) { - ctx->r = ENC_SYM_NIL; - ctx->app_cont = true; - } else { - error_ctx(ENC_SYM_EERROR); - } -} - // (closure params body env) static lbm_value mk_closure(lbm_value env, lbm_value body, lbm_value params) { if (lbm_heap_num_free() < 4) { diff --git a/src/symrepr.c b/src/symrepr.c index b5e07fb7..74df180a 100644 --- a/src/symrepr.c +++ b/src/symrepr.c @@ -63,15 +63,6 @@ special_sym const special_symbols[] = { // pattern matching {"?" , SYM_MATCH_ANY}, - {"?i" , SYM_MATCH_I}, - {"?u" , SYM_MATCH_U}, - {"?u32" , SYM_MATCH_U32}, - {"?i32" , SYM_MATCH_I32}, - {"?float" , SYM_MATCH_FLOAT}, - {"?cons" , SYM_MATCH_CONS}, - {"?u64" , SYM_MATCH_U64}, - {"?i64" , SYM_MATCH_I64}, - {"?double" , SYM_MATCH_DOUBLE}, // Error symbols with parsable names {"no_match" , SYM_NO_MATCH}, diff --git a/src/tokpar.c b/src/tokpar.c index 503a2156..fe16f324 100644 --- a/src/tokpar.c +++ b/src/tokpar.c @@ -125,15 +125,6 @@ const matcher fixed_size_tokens[NUM_FIXED_SIZE_TOKENS] = { {"`", TOKBACKQUOTE, 1}, {",@", TOKCOMMAAT, 2}, {",", TOKCOMMA, 1}, - {"?double" , TOKMATCHDOUBLE, 7}, - {"?float", TOKMATCHFLOAT, 6}, - {"?cons", TOKMATCHCONS, 5}, - {"?u64", TOKMATCHU64, 4}, - {"?i64", TOKMATCHI64, 4}, - {"?u32", TOKMATCHU32, 4}, - {"?i32", TOKMATCHI32, 4}, - {"?i", TOKMATCHI28, 2}, - {"?u", TOKMATCHU28, 2}, {"?", TOKMATCHANY, 1} }; @@ -595,33 +586,6 @@ lbm_value lbm_get_next_token(lbm_char_channel_t *chan, bool peek) { case TOKCOMMA: res = lbm_enc_sym(SYM_COMMA); break; - case TOKMATCHI28: - res = lbm_enc_sym(SYM_MATCH_I); - break; - case TOKMATCHU28: - res = lbm_enc_sym(SYM_MATCH_U); - break; - case TOKMATCHI32: - res = lbm_enc_sym(SYM_MATCH_I32); - break; - case TOKMATCHU32: - res = lbm_enc_sym(SYM_MATCH_U32); - break; - case TOKMATCHFLOAT: - res = lbm_enc_sym(SYM_MATCH_FLOAT); - break; - case TOKMATCHU64: - res = lbm_enc_sym(SYM_MATCH_U64); - break; - case TOKMATCHI64: - res = lbm_enc_sym(SYM_MATCH_I64); - break; - case TOKMATCHDOUBLE: - res = lbm_enc_sym(SYM_MATCH_DOUBLE); - break; - case TOKMATCHCONS: - res = lbm_enc_sym(SYM_MATCH_CONS); - break; case TOKMATCHANY: res = lbm_enc_sym(SYM_MATCH_ANY); break; diff --git a/tests/test_atomic_2.lisp b/tests/test_atomic_2.lisp new file mode 100644 index 00000000..dfc48d50 --- /dev/null +++ b/tests/test_atomic_2.lisp @@ -0,0 +1,7 @@ +(define foo (lambda () + (atomic (+ 1 2 3) + (+ 1 2 4) + (+ 2 4 8) + (+ 3 6 12)))) + +(= (foo) 21) diff --git a/tests/test_atomic_3.lisp b/tests/test_atomic_3.lisp new file mode 100644 index 00000000..47fbb1a9 --- /dev/null +++ b/tests/test_atomic_3.lisp @@ -0,0 +1,7 @@ +(define foo (lambda () + (atomic (progn (+ 1 2 3) + (+ 1 2 4) + (+ 2 4 8) + (+ 3 6 12))))) + +(= (foo) 21) diff --git a/tests/test_atomic_4.lisp b/tests/test_atomic_4.lisp new file mode 100644 index 00000000..fe61e95b --- /dev/null +++ b/tests/test_atomic_4.lisp @@ -0,0 +1,7 @@ +(define foo (lambda () + (atomic (progn (+ 1 2 3) + (+ 1 2 4)) + (progn (+ 2 4 8) + (+ 3 6 12))))) + +(= (foo) 21) diff --git a/tests/test_match_3.lisp b/tests/test_match_3.lisp index 9530d7a4..8b9b2998 100644 --- a/tests/test_match_3.lisp +++ b/tests/test_match_3.lisp @@ -2,7 +2,7 @@ (define f (lambda (ls) (match ls ( nil 0 ) - ( (?cons c) (+ (car c) (f (cdr c)))) + ( ( (? c) . (? cd)) (+ c (f c))) ( _ 'error-not-a-list)))) (eq (f 'kurt) 'error-not-a-list) diff --git a/tests/test_match_6.lisp b/tests/test_match_6.lisp index 1ec18762..d28b971d 100644 --- a/tests/test_match_6.lisp +++ b/tests/test_match_6.lisp @@ -1,9 +1,9 @@ (defun f (x) - (match x - ((?i64 a) (+ 1 a)) - ((?u64 a) (+ 2 a)) - ((?double a) (+ 3 a)))) + (match (type-of x) + (type-i64 (+ 1 x)) + (type-u64 (+ 2 x)) + (type-double (+ 3 x)))) (and (= (f 1i64) 2i64)