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 3fc70a5c..99c9dbf5 

99c9dbf5 assoc/cossa fix and refactoring/renaming of  internal funktions

git-subtree-dir: lispBM/lispBM
git-subtree-split: 99c9dbf5c450eea8eeb6325bbdbfdf56929abc5e
This commit is contained in:
Benjamin Vedder 2023-04-06 20:33:01 +02:00
parent 26ec05af09
commit 319bae781a
6 changed files with 68 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
include/heap.h
View File

@ -767,11 +767,11 @@ static inline bool lbm_is_ptr(lbm_value x) {
return (x & LBM_PTR_MASK);
}
static inline bool lbm_is_cons(lbm_value x) {
static inline bool lbm_is_cons_rw(lbm_value x) {
return (lbm_type_of(x) == LBM_TYPE_CONS);
}
static inline bool lbm_is_cons_general(lbm_value x) {
static inline bool lbm_is_cons(lbm_value x) {
lbm_type t = lbm_type_of(x);
return (t == LBM_TYPE_CONS ||
t == (LBM_TYPE_CONS | LBM_PTR_TO_CONSTANT_BIT));
@ -811,7 +811,7 @@ static inline bool lbm_is_special(lbm_value symrep) {
}
static inline bool lbm_is_closure(lbm_value exp) {
return ((lbm_is_cons_general(exp)) &&
return ((lbm_is_cons(exp)) &&
(lbm_type_of(lbm_car(exp)) == LBM_TYPE_SYMBOL) &&
(lbm_dec_sym(lbm_car(exp)) == SYM_CLOSURE));
}
@ -865,8 +865,8 @@ static inline bool lbm_is_list(lbm_value x) {
return (lbm_is_cons(x) || lbm_is_symbol_nil(x));
}
static inline bool lbm_is_list_general(lbm_value x) {
return (lbm_is_cons_general(x) || lbm_is_symbol_nil(x));
static inline bool lbm_is_list_rw(lbm_value x) {
return (lbm_is_cons_rw(x) || lbm_is_symbol_nil(x));
}
static inline bool lbm_is_quoted_list(lbm_value x) {

52
src/eval_cps.c
View File

@ -830,7 +830,7 @@ static void yield_ctx(lbm_uint sleep_us) {
static lbm_cid lbm_create_ctx_parent(lbm_value program, lbm_value env, lbm_uint stack_size, lbm_cid parent, uint32_t context_flags) {
if (!lbm_is_cons_general(program)) return -1;
if (!lbm_is_cons(program)) return -1;
eval_context_t *ctx = NULL;
ctx = (eval_context_t*)lbm_malloc(sizeof(eval_context_t));
@ -947,7 +947,7 @@ static bool mailbox_add_mail(eval_context_t *ctx, lbm_value mail) {
/* Advance execution to the next expression in the program */
static void advance_ctx(eval_context_t *ctx) {
if (lbm_is_cons_general(ctx->program)) {
if (lbm_is_cons(ctx->program)) {
lbm_push(&ctx->K, DONE);
ctx->curr_exp = lbm_car(ctx->program);
ctx->curr_env = ENC_SYM_NIL;
@ -1093,8 +1093,8 @@ static bool match(lbm_value p, lbm_value e, lbm_value *env, bool *gc) {
if (lbm_dec_sym(p) == SYM_DONTCARE) return true;
return (p == e);
}
if (lbm_is_cons_general(p) &&
lbm_is_cons_general(e) ) {
if (lbm_is_cons(p) &&
lbm_is_cons(e) ) {
lbm_value headp = lbm_car(p);
lbm_value heade = lbm_car(e);
@ -1113,7 +1113,7 @@ static int find_match(lbm_value plist, lbm_value *earr, lbm_uint num, lbm_value
bool gc = false;
for (int i = 0; i < (int)num; i ++ ) {
lbm_value curr_e = earr[i];
while (lbm_is_cons_general(curr_p)) {
while (lbm_is_cons(curr_p)) {
lbm_value me = lbm_car(curr_p);
if (match(lbm_car(me), curr_e, env, &gc)) {
if (gc) return FM_NEED_GC;
@ -1293,7 +1293,7 @@ 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_general(exps)) {
if (lbm_is_cons(exps)) {
lbm_uint *sptr = lbm_stack_reserve(&ctx->K, 4);
if (!sptr) {
error_ctx(ENC_SYM_STACK_ERROR);
@ -1495,7 +1495,7 @@ static int create_binding_location(lbm_value key, lbm_value *env) {
return BL_NO_MEMORY;
}
*env = new_env_tmp;
} else if (lbm_is_cons_general(key)) { // deconstruct case
} else if (lbm_is_cons(key)) { // deconstruct case
int r = create_binding_location(lbm_car(key), env);
if (r == BL_OK) {
r = create_binding_location(lbm_cdr(key), env);
@ -1513,14 +1513,14 @@ static void eval_let(eval_context_t *ctx) {
lbm_value curr = binds;
lbm_value new_env = orig_env;
if (!lbm_is_cons_general(binds)) {
if (!lbm_is_cons(binds)) {
// binds better be nil or there is a programmer error.
ctx->curr_exp = exp;
return;
}
// Implements letrec by "preallocating" the key parts
while (lbm_is_cons_general(curr)) {
while (lbm_is_cons(curr)) {
lbm_value new_env_tmp = new_env;
lbm_value key = lbm_caar(curr);
int r = create_binding_location(key, &new_env_tmp);
@ -1876,7 +1876,7 @@ static void apply_spawn_base(lbm_value *args, lbm_uint nargs, eval_context_t *ct
lbm_value curr_param = params;
lbm_uint i = closure_pos + 1;
while (lbm_is_cons_general(curr_param) &&
while (lbm_is_cons(curr_param) &&
i <= nargs) {
lbm_value entry;
@ -1970,7 +1970,7 @@ static void apply_eval_program(lbm_value *args, lbm_uint nargs, eval_context_t *
} else {
new_prg = lbm_list_append(prg_copy, ctx->program);
}
if (!lbm_is_list_general(new_prg)) {
if (!lbm_is_list(new_prg)) {
error_ctx(ENC_SYM_EERROR);
return;
}
@ -2021,7 +2021,7 @@ static void apply_error(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
}
static void apply_map(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
if (nargs == 2 && lbm_is_list_general(args[1])) {
if (nargs == 2 && lbm_is_list(args[1])) {
if (lbm_is_symbol_nil(args[1])) {
lbm_stack_drop(&ctx->K, 3);
ctx->r = ENC_SYM_NIL;
@ -2089,11 +2089,11 @@ static void apply_map(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
}
static void apply_reverse(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
if (nargs == 1 && lbm_is_list_general(args[0])) {
if (nargs == 1 && lbm_is_list(args[0])) {
lbm_value curr = args[0];
lbm_value new_list = ENC_SYM_NIL;
while (lbm_is_cons_general(curr)) {
while (lbm_is_cons(curr)) {
lbm_value tmp;
WITH_GC_RMBR(tmp, lbm_cons(lbm_car(curr), new_list), 1, new_list);
new_list = tmp;
@ -2231,7 +2231,7 @@ static void cont_closure_application_args(eval_context_t *ctx) {
lbm_value params = (lbm_value)sptr[3];
lbm_value args = (lbm_value)sptr[4];
if (lbm_is_cons_general(params)) {
if (lbm_is_cons(params)) {
lbm_value ls;
WITH_GC(ls, lbm_heap_allocate_list(2));
lbm_value entry = ls;
@ -2308,7 +2308,7 @@ static void cont_application_args(eval_context_t *ctx) {
error_ctx(ENC_SYM_FATAL_ERROR);
return;
}
} else if (lbm_is_cons_general(rest)) {
} else if (lbm_is_cons(rest)) {
sptr[1] = env;
sptr[2] = lbm_enc_u(lbm_dec_u(count) + 1);
CHECK_STACK(lbm_push_2(&ctx->K,lbm_cdr(rest), APPLICATION_ARGS));
@ -2353,8 +2353,8 @@ static int fill_binding_location(lbm_value key, lbm_value value, lbm_value env)
if (key == ENC_SYM_DONTCARE) return FB_OK;
lbm_env_modify_binding(env,key,value);
return FB_OK;
} else if (lbm_is_cons_general(key) &&
lbm_is_cons_general(value)) {
} else if (lbm_is_cons(key) &&
lbm_is_cons(value)) {
int r = fill_binding_location(lbm_car(key), lbm_car(value), env);
if (r == FB_OK) {
r = fill_binding_location(lbm_cdr(key), lbm_cdr(value), env);
@ -2381,7 +2381,7 @@ static void cont_bind_to_key_rest(eval_context_t *ctx) {
return;
}
if (lbm_is_cons_general(rest)) {
if (lbm_is_cons(rest)) {
lbm_value keyn = lbm_caar(rest);
lbm_value valn_exp = lbm_cadr(lbm_car(rest));
@ -2471,7 +2471,7 @@ static void cont_match(eval_context_t *ctx) {
/* no more patterns */
ctx->r = ENC_SYM_NO_MATCH;
ctx->app_cont = true;
} else if (lbm_is_cons_general(patterns)) {
} else if (lbm_is_cons(patterns)) {
lbm_value match_case = lbm_car(patterns);
lbm_value pattern = lbm_car(match_case);
lbm_value n1 = lbm_cadr(match_case);
@ -2544,7 +2544,7 @@ static void cont_map_first(eval_context_t *ctx) {
CONS_WITH_GC(elt, ctx->r, ENC_SYM_NIL, ENC_SYM_NIL);
sptr[2] = elt; // head of result list
sptr[3] = elt; // tail of result list
if (lbm_is_cons_general(ls)) {
if (lbm_is_cons(ls)) {
lbm_value rest = lbm_cdr(ls);
lbm_value next = lbm_car(ls);
sptr[0] = rest;
@ -2574,7 +2574,7 @@ static void cont_map_rest(eval_context_t *ctx) {
CONS_WITH_GC(elt, ctx->r, ENC_SYM_NIL, ENC_SYM_NIL);
lbm_set_cdr(t, elt);
sptr[3] = elt; // update tail of result list.
if (lbm_is_cons_general(ls)) {
if (lbm_is_cons(ls)) {
lbm_value rest = lbm_cdr(ls);
lbm_value next = lbm_car(ls);
sptr[0] = rest;
@ -3146,7 +3146,7 @@ static void cont_read_dot_terminate(eval_context_t *ctx) {
done_reading(ctx->id);
return;
} else {
if (lbm_is_cons_general(last_cell)) {
if (lbm_is_cons(last_cell)) {
lbm_set_cdr(last_cell, ctx->r);
ctx->r = first_cell;
CHECK_STACK(lbm_push_3(&ctx->K,
@ -3243,7 +3243,7 @@ static void cont_application_start(eval_context_t *ctx) {
}
lbm_value args = (lbm_value)sptr[1];
if (lbm_is_cons_general(ctx->r)) {
if (lbm_is_cons(ctx->r)) {
switch (lbm_car(ctx->r)) {
case ENC_SYM_MACRO:{
/*
@ -3257,8 +3257,8 @@ static void cont_application_start(eval_context_t *ctx) {
lbm_value curr_param = lbm_cadr(ctx->r);
lbm_value curr_arg = args;
lbm_value expand_env = env;
while (lbm_is_cons_general(curr_param) &&
lbm_is_cons_general(curr_arg)) {
while (lbm_is_cons(curr_param) &&
lbm_is_cons(curr_arg)) {
lbm_value entry;
WITH_GC_RMBR(entry,lbm_cons(lbm_car(curr_param),lbm_car(curr_arg)), 1, expand_env);

19
src/fundamental.c
View File

@ -249,12 +249,12 @@ static lbm_value index_list(lbm_value l, int32_t n) {
if (n < 0) return ENC_SYM_NIL;
}
while (lbm_is_cons_general(curr) &&
while (lbm_is_cons(curr) &&
n > 0) {
curr = lbm_cdr(curr);
n --;
}
if (lbm_is_cons_general(curr)) {
if (lbm_is_cons(curr)) {
return lbm_car(curr);
} else {
return ENC_SYM_NIL;
@ -263,7 +263,7 @@ static lbm_value index_list(lbm_value l, int32_t n) {
static lbm_value assoc_lookup(lbm_value key, lbm_value assoc) {
lbm_value curr = assoc;
while (lbm_is_cons_general(curr)) {
while (lbm_is_cons(curr)) {
lbm_value c = lbm_ref_cell(curr)->car;
if (struct_eq(lbm_ref_cell(c)->car, key)) {
return lbm_ref_cell(c)->cdr;
@ -275,7 +275,7 @@ static lbm_value assoc_lookup(lbm_value key, lbm_value assoc) {
static lbm_value cossa_lookup(lbm_value key, lbm_value assoc) {
lbm_value curr = assoc;
while (lbm_is_cons_general(curr)) {
while (lbm_is_cons(curr)) {
lbm_value c = lbm_ref_cell(curr)->car;
if (struct_eq(lbm_ref_cell(c)->cdr, key)) {
return lbm_ref_cell(c)->car;
@ -613,7 +613,7 @@ static lbm_value fundamental_cons(lbm_value *args, lbm_uint nargs, eval_context_
static lbm_value fundamental_car(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
(void) ctx;
if (nargs == 1) {
if (lbm_is_cons_general(args[0])) {
if (lbm_is_cons(args[0])) {
lbm_cons_t *cell = lbm_ref_cell(args[0]);
return cell->car;
}
@ -624,7 +624,7 @@ static lbm_value fundamental_car(lbm_value *args, lbm_uint nargs, eval_context_t
static lbm_value fundamental_cdr(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
(void) ctx;
if (nargs == 1) {
if (lbm_is_cons_general(args[0])) {
if (lbm_is_cons(args[0])) {
lbm_cons_t *cell = lbm_ref_cell(args[0]);
return cell->cdr;
}
@ -646,12 +646,12 @@ static lbm_value fundamental_list(lbm_value *args, lbm_uint nargs, eval_context_
static lbm_value fundamental_append(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
(void) ctx;
if (nargs == 0) return ENC_SYM_NIL;
if (nargs == 1 && !lbm_is_list_general(args[0])) return ENC_SYM_TERROR;
if (nargs == 1 && !lbm_is_list(args[0])) return ENC_SYM_TERROR;
lbm_value res = args[nargs-1];
for (int i = (int)nargs -2; i >= 0; i --) {
lbm_value curr = args[i];
if (!lbm_is_list_general(curr)) return ENC_SYM_TERROR;
if (!lbm_is_list(curr)) return ENC_SYM_TERROR;
int n = 0;
while (lbm_type_of_functional(curr) == LBM_TYPE_CONS) {
n++;
@ -665,6 +665,7 @@ static lbm_value fundamental_append(lbm_value *args, lbm_uint nargs, eval_contex
return(res);
}
// TODO: See if trouble
static lbm_value fundamental_undefine(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
(void) ctx;
lbm_value env = lbm_get_env();
@ -1128,7 +1129,7 @@ static lbm_value fundamental_type_of(lbm_value *args, lbm_uint nargs, eval_conte
static lbm_value fundamental_list_length(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
(void) ctx;
lbm_value result = ENC_SYM_EERROR;
if (nargs == 1 && lbm_is_list_general(args[0])) {
if (nargs == 1 && lbm_is_list(args[0])) {
int32_t len = (int32_t)lbm_list_length(args[0]);
result = lbm_enc_i(len);
}

18
src/heap.c
View File

@ -862,7 +862,7 @@ int lbm_set_car(lbm_value c, lbm_value v) {
int lbm_set_cdr(lbm_value c, lbm_value v) {
int r = 0;
if (lbm_type_of(c) == LBM_TYPE_CONS){
if (lbm_is_cons_rw(c)){
lbm_cons_t *cell = lbm_ref_cell(c);
cell->cdr = v;
r = 1;
@ -872,7 +872,7 @@ int lbm_set_cdr(lbm_value c, lbm_value v) {
int lbm_set_car_and_cdr(lbm_value c, lbm_value car_val, lbm_value cdr_val) {
int r = 0;
if (lbm_type_of(c) == LBM_TYPE_CONS) {
if (lbm_is_cons_rw(c)) {
lbm_cons_t *cell = lbm_ref_cell(c);
cell->car = car_val;
cell->cdr = cdr_val;
@ -885,7 +885,7 @@ int lbm_set_car_and_cdr(lbm_value c, lbm_value car_val, lbm_value cdr_val) {
unsigned int lbm_list_length(lbm_value c) {
unsigned int len = 0;
while (lbm_is_cons_general(c)){
while (lbm_is_cons(c)){
len ++;
c = lbm_cdr(c);
}
@ -898,7 +898,7 @@ unsigned int lbm_list_length_pred(lbm_value c, bool *pres, bool (*pred)(lbm_valu
bool res = true;
unsigned int len = 0;
while (lbm_type_of(c) == LBM_TYPE_CONS){
while (lbm_is_cons(c)){
len ++;
res = res && pred(lbm_car(c));
c = lbm_cdr(c);
@ -916,7 +916,7 @@ lbm_value lbm_list_reverse(lbm_value list) {
lbm_value curr = list;
lbm_value new_list = ENC_SYM_NIL;
while (lbm_is_cons_general(curr)) {
while (lbm_is_cons(curr)) {
new_list = lbm_cons(lbm_car(curr), new_list);
if (lbm_type_of(new_list) == LBM_TYPE_SYMBOL) {
@ -934,7 +934,7 @@ lbm_value lbm_list_destructive_reverse(lbm_value list) {
lbm_value curr = list;
lbm_value last_cell = ENC_SYM_NIL;
while (lbm_type_of(curr) == LBM_TYPE_CONS) {
while (lbm_is_cons_rw(curr)) {
lbm_value next = lbm_cdr(curr);
lbm_set_cdr(curr, last_cell);
last_cell = curr;
@ -949,7 +949,7 @@ lbm_value lbm_list_copy(lbm_value list) {
lbm_value curr = list;
while (lbm_is_cons_general(curr)) {
while (lbm_is_cons(curr)) {
lbm_value c = lbm_cons (lbm_car(curr), res);
if (lbm_type_of(c) == LBM_TYPE_SYMBOL) {
return ENC_SYM_MERROR;
@ -965,8 +965,8 @@ lbm_value lbm_list_copy(lbm_value list) {
// Destructive update of list1.
lbm_value lbm_list_append(lbm_value list1, lbm_value list2) {
if(lbm_is_list(list1) &&
lbm_is_list_general(list2)) {
if(lbm_is_list_rw(list1) &&
lbm_is_list(list2)) {
lbm_value curr = list1;
while(lbm_type_of(lbm_cdr(curr)) == LBM_TYPE_CONS) {

10
tests/test_assoc_4.lisp Normal file
View File

@ -0,0 +1,10 @@
(def a '(
(test1 . 1)
(test2 . 2)
(test3 . 3)
))
(move-to-flash a)
(check (and (eq (assoc a 'test2) 2)
(eq (cossa a 3) 'test3)))

8
tests/test_move_to_flash_4.lisp Normal file
View File

@ -0,0 +1,8 @@
(defun test (a b)
(cond
((= a 0) a)
(t b)
))
(move-to-flash test)
(check (= (test 10 2) 2))