rusefi
/
bldc
mirror of https://github.com/rusefi/bldc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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
This commit is contained in:
Benjamin Vedder 2022-10-26 17:34:07 +02:00
parent 0db54cab8b
commit 85e4aae57b
11 changed files with 60 additions and 221 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
doc/lbmref.md
View File

@ -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)
```
---

11
include/heap.h
View File

@ -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) {

9
include/lbm_defines.h
View File

@ -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

139
src/eval_cps.c
View File

@ -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) {

9
src/symrepr.c
View File

@ -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},

36
src/tokpar.c
View File

@ -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;

7
tests/test_atomic_2.lisp Normal file
View File

@ -0,0 +1,7 @@
(define foo (lambda ()
(atomic (+ 1 2 3)
(+ 1 2 4)
(+ 2 4 8)
(+ 3 6 12))))
(= (foo) 21)

7
tests/test_atomic_3.lisp Normal file
View File

@ -0,0 +1,7 @@
(define foo (lambda ()
(atomic (progn (+ 1 2 3)
(+ 1 2 4)
(+ 2 4 8)
(+ 3 6 12)))))
(= (foo) 21)

7
tests/test_atomic_4.lisp Normal file
View File

@ -0,0 +1,7 @@
(define foo (lambda ()
(atomic (progn (+ 1 2 3)
(+ 1 2 4))
(progn (+ 2 4 8)
(+ 3 6 12)))))
(= (foo) 21)

2
tests/test_match_3.lisp
View File

@ -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)

8
tests/test_match_6.lisp
View File

@ -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)