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 1dd732d9..418272ad 

418272ad added a way to load flattened environments into the heap on startup as a library. And added a library for cleaning of closure environments for future experimentation
74eefd1e bugfix in progn variables related to recursive binginds
93536f76 added a member function for list membership checks

git-subtree-dir: lispBM/lispBM
git-subtree-split: 418272ad1454ee414739fe0aef1b30aa9b56002c
This commit is contained in:
Benjamin Vedder 2024-03-31 19:00:36 +02:00
parent e772ad589f
commit 19a0a7cc3f
14 changed files with 338 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
doc/lbmref.lisp
View File

@ -1819,6 +1819,17 @@
))
end)))
(define lists-member
(ref-entry "member"
(list
(para (list "`member` checks if a list contains a given element."
"The form of a `member` expression is `(member list-exp exp)`."
))
(code '((member (list 1 2 3) 5)
(member (list 1 2 3) 2)
))
end)))
(define lists-rotate
(ref-entry "rotate"
@ -1907,6 +1918,7 @@
lists-setcdr
lists-take
lists-drop
lists-member
lists-reverse
lists-rotate
lists-merge

52
doc/lbmref.md
View File

@ -4941,6 +4941,58 @@ apa
---
### member
`member` checks if a list contains a given element. The form of a `member` expression is `(member list-exp exp)`.
<table>
<tr>
<td> Example </td> <td> Result </td>
</tr>
<tr>
<td>
```clj
(member (list 1 2 3) 5)
```
</td>
<td>
```clj
nil
```
</td>
</tr>
<tr>
<td>
```clj
(member (list 1 2 3) 2)
```
</td>
<td>
```clj
(1 2 3)
```
</td>
</tr>
</table>
---

2
include/lbm_defines.h
View File

@ -312,6 +312,7 @@
#define SYM_REG_EVENT_HANDLER 0x20037
#define SYM_TAKE 0x20038
#define SYM_DROP 0x20039
#define SYM_MEMBER 0x2003A
// Apply funs:
// Get their arguments in evaluated form on the stack.
@ -535,5 +536,6 @@
#define ENC_SYM_REG_EVENT_HANDLER ENC_SYM(SYM_REG_EVENT_HANDLER)
#define ENC_SYM_TAKE ENC_SYM(SYM_TAKE)
#define ENC_SYM_DROP ENC_SYM(SYM_DROP)
#define ENC_SYM_MEMBER ENC_SYM(SYM_MEMBER)
#endif

95
repl/clean_cl.h Normal file
View File

@ -0,0 +1,95 @@
unsigned char clean_cl_env[] = {
0x0a, 0x00, 0x00, 0x00, 0x73, 0x65, 0x74, 0x2d, 0x69, 0x6e, 0x73, 0x65,
0x72, 0x74, 0xdc, 0x00, 0x00, 0x00, 0x01, 0x03, 0x63, 0x6c, 0x6f, 0x73,
0x75, 0x72, 0x65, 0x00, 0x01, 0x01, 0x03, 0x61, 0x00, 0x01, 0x03, 0x73,
0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x01, 0x01, 0x03, 0x6d, 0x61, 0x74,
0x63, 0x68, 0x00, 0x01, 0x03, 0x73, 0x00, 0x01, 0x01, 0x03, 0x6e, 0x69,
0x6c, 0x00, 0x01, 0x01, 0x03, 0x6c, 0x69, 0x73, 0x74, 0x00, 0x01, 0x03,
0x61, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00,
0x01, 0x01, 0x01, 0x01, 0x03, 0x3f, 0x00, 0x01, 0x03, 0x65, 0x00, 0x03,
0x6e, 0x69, 0x6c, 0x00, 0x01, 0x03, 0x3f, 0x00, 0x01, 0x03, 0x65, 0x73,
0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x01, 0x01, 0x03, 0x65, 0x71, 0x00,
0x01, 0x03, 0x65, 0x00, 0x01, 0x03, 0x61, 0x00, 0x03, 0x6e, 0x69, 0x6c,
0x00, 0x01, 0x03, 0x73, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x01, 0x01,
0x01, 0x01, 0x03, 0x3f, 0x00, 0x01, 0x03, 0x65, 0x00, 0x03, 0x6e, 0x69,
0x6c, 0x00, 0x01, 0x03, 0x3f, 0x00, 0x01, 0x03, 0x65, 0x73, 0x00, 0x03,
0x6e, 0x69, 0x6c, 0x00, 0x01, 0x01, 0x03, 0x63, 0x6f, 0x6e, 0x73, 0x00,
0x01, 0x03, 0x65, 0x00, 0x01, 0x01, 0x03, 0x73, 0x65, 0x74, 0x2d, 0x69,
0x6e, 0x73, 0x65, 0x72, 0x74, 0x00, 0x01, 0x03, 0x61, 0x00, 0x01, 0x03,
0x65, 0x73, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x03, 0x6e, 0x69, 0x6c,
0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x01,
0x03, 0x6e, 0x69, 0x6c, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x09, 0x00,
0x00, 0x00, 0x73, 0x65, 0x74, 0x2d, 0x75, 0x6e, 0x69, 0x6f, 0x6e, 0x9f,
0x00, 0x00, 0x00, 0x01, 0x03, 0x63, 0x6c, 0x6f, 0x73, 0x75, 0x72, 0x65,
0x00, 0x01, 0x01, 0x03, 0x73, 0x31, 0x00, 0x01, 0x03, 0x73, 0x32, 0x00,
0x03, 0x6e, 0x69, 0x6c, 0x00, 0x01, 0x01, 0x03, 0x6d, 0x61, 0x74, 0x63,
0x68, 0x00, 0x01, 0x03, 0x73, 0x31, 0x00, 0x01, 0x01, 0x03, 0x6e, 0x69,
0x6c, 0x00, 0x01, 0x03, 0x73, 0x32, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00,
0x01, 0x01, 0x01, 0x01, 0x03, 0x3f, 0x00, 0x01, 0x03, 0x65, 0x00, 0x03,
0x6e, 0x69, 0x6c, 0x00, 0x01, 0x03, 0x3f, 0x00, 0x01, 0x03, 0x65, 0x73,
0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x01, 0x01, 0x03, 0x73, 0x65, 0x74,
0x2d, 0x75, 0x6e, 0x69, 0x6f, 0x6e, 0x00, 0x01, 0x03, 0x65, 0x73, 0x00,
0x01, 0x01, 0x03, 0x73, 0x65, 0x74, 0x2d, 0x69, 0x6e, 0x73, 0x65, 0x72,
0x74, 0x00, 0x01, 0x03, 0x65, 0x00, 0x01, 0x03, 0x73, 0x32, 0x00, 0x03,
0x6e, 0x69, 0x6c, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x03, 0x6e, 0x69,
0x6c, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x01, 0x03, 0x6e, 0x69, 0x6c,
0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x08, 0x00, 0x00, 0x00, 0x67, 0x65,
0x74, 0x2d, 0x76, 0x61, 0x72, 0x73, 0xf7, 0x00, 0x00, 0x00, 0x01, 0x03,
0x63, 0x6c, 0x6f, 0x73, 0x75, 0x72, 0x65, 0x00, 0x01, 0x01, 0x03, 0x62,
0x6f, 0x64, 0x79, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x01, 0x01, 0x03,
0x6d, 0x61, 0x74, 0x63, 0x68, 0x00, 0x01, 0x01, 0x03, 0x74, 0x79, 0x70,
0x65, 0x2d, 0x6f, 0x66, 0x00, 0x01, 0x03, 0x62, 0x6f, 0x64, 0x79, 0x00,
0x03, 0x6e, 0x69, 0x6c, 0x00, 0x01, 0x01, 0x03, 0x74, 0x79, 0x70, 0x65,
0x2d, 0x73, 0x79, 0x6d, 0x62, 0x6f, 0x6c, 0x00, 0x01, 0x01, 0x03, 0x73,
0x65, 0x74, 0x2d, 0x69, 0x6e, 0x73, 0x65, 0x72, 0x74, 0x00, 0x01, 0x03,
0x62, 0x6f, 0x64, 0x79, 0x00, 0x01, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x03,
0x6e, 0x69, 0x6c, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x01, 0x01, 0x03,
0x74, 0x79, 0x70, 0x65, 0x2d, 0x6c, 0x69, 0x73, 0x74, 0x00, 0x01, 0x01,
0x03, 0x73, 0x65, 0x74, 0x2d, 0x75, 0x6e, 0x69, 0x6f, 0x6e, 0x00, 0x01,
0x01, 0x03, 0x67, 0x65, 0x74, 0x2d, 0x76, 0x61, 0x72, 0x73, 0x00, 0x01,
0x01, 0x03, 0x63, 0x61, 0x72, 0x00, 0x01, 0x03, 0x62, 0x6f, 0x64, 0x79,
0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x01,
0x01, 0x03, 0x67, 0x65, 0x74, 0x2d, 0x76, 0x61, 0x72, 0x73, 0x00, 0x01,
0x01, 0x03, 0x63, 0x64, 0x72, 0x00, 0x01, 0x03, 0x62, 0x6f, 0x64, 0x79,
0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x03,
0x6e, 0x69, 0x6c, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x01, 0x01, 0x03,
0x5f, 0x00, 0x01, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x03, 0x6e, 0x69, 0x6c,
0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x01, 0x03, 0x6e, 0x69, 0x6c, 0x00,
0x03, 0x6e, 0x69, 0x6c, 0x00, 0x08, 0x00, 0x00, 0x00, 0x70, 0x69, 0x63,
0x6b, 0x2d, 0x6f, 0x75, 0x74, 0xfb, 0x00, 0x00, 0x00, 0x01, 0x03, 0x63,
0x6c, 0x6f, 0x73, 0x75, 0x72, 0x65, 0x00, 0x01, 0x01, 0x03, 0x76, 0x61,
0x72, 0x73, 0x00, 0x01, 0x03, 0x65, 0x6e, 0x76, 0x00, 0x03, 0x6e, 0x69,
0x6c, 0x00, 0x01, 0x01, 0x03, 0x6d, 0x61, 0x74, 0x63, 0x68, 0x00, 0x01,
0x03, 0x65, 0x6e, 0x76, 0x00, 0x01, 0x01, 0x03, 0x6e, 0x69, 0x6c, 0x00,
0x01, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x01,
0x01, 0x01, 0x01, 0x03, 0x3f, 0x00, 0x01, 0x03, 0x62, 0x00, 0x03, 0x6e,
0x69, 0x6c, 0x00, 0x01, 0x03, 0x3f, 0x00, 0x01, 0x03, 0x62, 0x73, 0x00,
0x03, 0x6e, 0x69, 0x6c, 0x00, 0x01, 0x01, 0x03, 0x6d, 0x65, 0x6d, 0x62,
0x65, 0x72, 0x00, 0x01, 0x03, 0x76, 0x61, 0x72, 0x73, 0x00, 0x01, 0x01,
0x03, 0x63, 0x61, 0x72, 0x00, 0x01, 0x03, 0x62, 0x00, 0x03, 0x6e, 0x69,
0x6c, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x01, 0x01, 0x03, 0x63, 0x6f,
0x6e, 0x73, 0x00, 0x01, 0x03, 0x62, 0x00, 0x01, 0x01, 0x03, 0x70, 0x69,
0x63, 0x6b, 0x2d, 0x6f, 0x75, 0x74, 0x00, 0x01, 0x03, 0x76, 0x61, 0x72,
0x73, 0x00, 0x01, 0x03, 0x62, 0x73, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00,
0x03, 0x6e, 0x69, 0x6c, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x01, 0x01,
0x01, 0x03, 0x5f, 0x00, 0x01, 0x03, 0x3f, 0x00, 0x01, 0x03, 0x62, 0x73,
0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x01, 0x01, 0x03, 0x70, 0x69, 0x63,
0x6b, 0x2d, 0x6f, 0x75, 0x74, 0x00, 0x01, 0x03, 0x76, 0x61, 0x72, 0x73,
0x00, 0x01, 0x03, 0x62, 0x73, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x03,
0x6e, 0x69, 0x6c, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x01, 0x03, 0x6e,
0x69, 0x6c, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x0c, 0x00, 0x00, 0x00,
0x63, 0x6c, 0x65, 0x61, 0x6e, 0x2d, 0x63, 0x6c, 0x2d, 0x65, 0x6e, 0x76,
0x8b, 0x00, 0x00, 0x00, 0x01, 0x03, 0x63, 0x6c, 0x6f, 0x73, 0x75, 0x72,
0x65, 0x00, 0x01, 0x01, 0x03, 0x63, 0x6c, 0x6f, 0x00, 0x03, 0x6e, 0x69,
0x6c, 0x00, 0x01, 0x01, 0x03, 0x73, 0x65, 0x74, 0x69, 0x78, 0x00, 0x01,
0x03, 0x63, 0x6c, 0x6f, 0x00, 0x01, 0x05, 0x00, 0x00, 0x00, 0x03, 0x01,
0x01, 0x03, 0x70, 0x69, 0x63, 0x6b, 0x2d, 0x6f, 0x75, 0x74, 0x00, 0x01,
0x01, 0x03, 0x67, 0x65, 0x74, 0x2d, 0x76, 0x61, 0x72, 0x73, 0x00, 0x01,
0x01, 0x03, 0x69, 0x78, 0x00, 0x01, 0x03, 0x63, 0x6c, 0x6f, 0x00, 0x01,
0x05, 0x00, 0x00, 0x00, 0x02, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x03, 0x6e,
0x69, 0x6c, 0x00, 0x01, 0x01, 0x03, 0x69, 0x78, 0x00, 0x01, 0x03, 0x63,
0x6c, 0x6f, 0x00, 0x01, 0x05, 0x00, 0x00, 0x00, 0x03, 0x03, 0x6e, 0x69,
0x6c, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00,
0x01, 0x03, 0x6e, 0x69, 0x6c, 0x00, 0x03, 0x6e, 0x69, 0x6c, 0x00
};
unsigned int clean_cl_env_len = 1103;

82
repl/repl.c
View File

@ -42,6 +42,8 @@
#include "repl_exts.h"
#include "repl_defines.h"
#include "clean_cl.h"
#define GC_STACK_SIZE 256
#define PRINT_STACK_SIZE 256
@ -62,6 +64,8 @@ bool terminate_after_startup = false;
volatile lbm_cid startup_cid = -1;
volatile lbm_cid store_result_cid = -1;
volatile bool silent_mode = false;
bool load_lib_clean_cl = false;
void shutdown_procedure(void);
@ -241,7 +245,7 @@ void print_ctx_info(eval_context_t *ctx, void *arg1, void *arg2) {
char output[1024];
int print_ret = lbm_print_value(output, 1024, ctx->r);
if (!silent_mode) {
if (!silent_mode) {
printf("--------------------------------\n");
printf("ContextID: %"PRI_UINT"\n", ctx->id);
printf("Stack SP: %"PRI_UINT"\n", ctx->K.sp);
@ -305,6 +309,7 @@ lbm_const_heap_t const_heap;
#define STORE_RESULT 0x0403
#define TERMINATE 0x0404
#define SILENT_MODE 0x0405
#define LOAD_LIB_CLEAN_CL 0x0406
struct option options[] = {
{"help", no_argument, NULL, 'h'},
@ -315,6 +320,7 @@ struct option options[] = {
{"store_res", required_argument, NULL, STORE_RESULT},
{"terminate", no_argument, NULL, TERMINATE},
{"silent", no_argument, NULL, SILENT_MODE},
{"lib_clean_cl", no_argument, NULL, LOAD_LIB_CLEAN_CL},
{0,0,0,0}};
typedef struct src_list_s {
@ -380,6 +386,7 @@ void parse_opts(int argc, char **argv) {
printf(" --terminate Terminate the REPL after evaluating the\n"\
" source files specified with --src/-s\n");
printf(" --silent The REPL will print as little as possible\n");
printf(" --lib_clean_cl Load the clean_cl library for closure cleaning\n");
printf("\n");
printf("Multiple sourcefiles can be added with multiple uses of the --src/-s flag.\n" \
"Multiple sources are evaluated in sequence in the order they are specified\n" \
@ -403,14 +410,79 @@ void parse_opts(int argc, char **argv) {
break;
case TERMINATE:
terminate_after_startup = true;
break;
case SILENT_MODE:
silent_mode = true;
break;
case LOAD_LIB_CLEAN_CL:
load_lib_clean_cl=true;
break;
default:
break;
}
}
}
uint32_t read_word(unsigned char *data, unsigned int pos) {
uint32_t res = 0;
res |= (data[pos]);
res |= ((uint32_t)(data[pos+1]) << 8);
res |= ((uint32_t)(data[pos+2]) << 16);
res |= ((uint32_t)(data[pos+3]) << 24);
return res;
}
bool load_flat_library(unsigned char *lib, unsigned int size) {
unsigned int pos = 0;
while (pos < (size - 1) ) {
uint32_t name_size = read_word(lib,pos); pos += 4;
char *name = malloc(name_size+1);
if (name == NULL) return false;
memset(name, 0, name_size + 1);
memcpy(name, lib + pos, name_size);
pos += name_size;
lbm_uint sym_id = 0;
if (!lbm_get_symbol_by_name(name, &sym_id)) {
if (!lbm_add_symbol(name, &sym_id)) {
printf("unable to add symbol\n");
return false;
}
}
free(name);
lbm_value sym = lbm_enc_sym(sym_id);
uint32_t val_size = read_word(lib, pos); pos += 4;
lbm_flat_value_t fv;
fv.buf = &lib[pos];
fv.buf_size = val_size;
fv.buf_pos = 0;
lbm_value val = ENC_SYM_NIL;
if (!lbm_unflatten_value(&fv, &val)) {
printf("Unable to unflatten value\n");
return false;
}
pos += val_size;
lbm_uint ix_key = sym_id & GLOBAL_ENV_MASK;
lbm_value *global_env = lbm_get_global_env();
lbm_uint orig_env = global_env[ix_key];
lbm_value new_env;
// All of this should just succeed with no GC needed.
new_env = lbm_env_set(orig_env,sym,val);
global_env[ix_key] = new_env;
}
return true;
}
int init_repl() {
if (lispbm_thd && lbm_get_eval_state() != EVAL_CPS_STATE_DEAD) {
@ -461,6 +533,14 @@ int init_repl() {
init_exts();
/* Load clean_cl library into heap */
if (load_lib_clean_cl) {
if (!load_flat_library(clean_cl_env, clean_cl_env_len)) {
printf("Error loading a flat library\n");
return 1;
}
}
if (pthread_create(&lispbm_thd, NULL, eval_thd_wrapper, NULL)) {
printf("Error creating evaluation thread\n");
return 1;

35
repl/repl_exts.c
View File

@ -457,9 +457,41 @@ static lbm_value ext_fwrite_str(lbm_value *args, lbm_uint argn) {
}
}
return res;
}
static lbm_value ext_fwrite_value(lbm_value *args, lbm_uint argn) {
lbm_value res = ENC_SYM_TERROR;
if (argn == 2 &&
is_file_handle(args[0])) {
res = ENC_SYM_NIL;
lbm_file_handle_t *h = (lbm_file_handle_t*)lbm_get_custom_value(args[0]);
lbm_set_max_flatten_depth(10000);
int32_t fv_size = flatten_value_size(args[1], 0);
if (fv_size > 0) {
lbm_flat_value_t fv;
fv.buf = malloc((uint32_t)fv_size);
if (fv.buf) {
fv.buf_size = (uint32_t)fv_size;
fv.buf_pos = 0;
if (flatten_value_c(&fv, args[1]) == FLATTEN_VALUE_OK) {
fwrite(fv.buf, 1, (size_t)fv_size, h->fp);
fflush(h->fp);
res = ENC_SYM_TRUE;
} else {
printf("ALERT: Unable to flatten result value\n");
}
} else {
printf("ALERT: Out of memory to allocate result buffer\n");
}
} else {
printf("ALERT: Incorrect FV size: %d \n", fv_size);
}
}
return res;
}
static bool all_arrays(lbm_value *args, lbm_uint argn) {
bool r = true;
for (uint32_t i = 0; i < argn; i ++) {
@ -530,6 +562,7 @@ int init_exts(void) {
lbm_add_extension("fopen", ext_fopen);
lbm_add_extension("fwrite", ext_fwrite);
lbm_add_extension("fwrite-str", ext_fwrite_str);
lbm_add_extension("fwrite-value", ext_fwrite_value);
lbm_add_extension("print", ext_print);
lbm_add_extension("systime", ext_systime);
lbm_add_extension("secs-since", ext_secs_since);

16
src/eval_cps.c
View File

@ -1752,6 +1752,21 @@ static void eval_define(eval_context_t *ctx) {
error_at_ctx(ENC_SYM_EERROR, ctx->curr_exp);
}
/* Eval lambda is cheating, a lot! It does this
for performance reasons. The cheats are that
1. When closure is created, a reference to the local env
in which the lambda was evaluated is added to the closure.
Ideally it should have created a list of free variables in the function
and then looked up the values of these creating a new environment.
2. The global env is considered global constant. As there is no copying
of environment bindings into the closure, undefine may break closures.
Correct closure creation is a lot more expensive than what happens here.
However, one can try to write programs in such a way that closures are created
seldomly. If one does that the space-usage benefits of "correct" closures
may outweigh the performance gain of "incorrect" ones.
*/
// (lambda param-list body-exp) -> (closure param-list body-exp env)
static void eval_lambda(eval_context_t *ctx) {
lbm_value cdr = get_cdr(ctx->curr_exp);
@ -1921,6 +1936,7 @@ static void eval_var(eval_context_t *ctx) {
lbm_value v_exp = get_cadr(args);
stack_push_3(&ctx->K, new_env, key, PROGN_VAR);
ctx->curr_env = new_env; // So binding body knows binding (enables recursion)
ctx->curr_exp = v_exp;
return;
}

19
src/fundamental.c
View File

@ -1317,6 +1317,24 @@ static lbm_value fundamental_drop(lbm_value *args, lbm_uint nargs, eval_context_
return lbm_list_drop(lbm_dec_as_u32(args[1]), args[0]);
}
static lbm_value fundamental_member(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
(void) ctx;
lbm_value res = ENC_SYM_TERROR;
if (nargs == 2 && lbm_is_list(args[0])) {
res = ENC_SYM_NIL;
lbm_value curr = args[0];
while (lbm_is_cons(curr)) {
if (struct_eq(lbm_car(curr), args[1])) {
res = args[0];
break;
}
curr = lbm_cdr(curr);
}
}
return res;
}
const fundamental_fun fundamental_table[] =
{fundamental_add,
fundamental_sub,
@ -1376,4 +1394,5 @@ const fundamental_fun fundamental_table[] =
fundamental_reg_event_handler,
fundamental_take,
fundamental_drop,
fundamental_member,
};

1
src/symrepr.c
View File

@ -210,6 +210,7 @@ special_sym const special_symbols[] = {
{"event-register-handler", SYM_REG_EVENT_HANDLER},
{"take" , SYM_TAKE},
{"drop" , SYM_DROP},
{"member" , SYM_MEMBER},
// fast access in list
{"ix" , SYM_IX},

6
tests/test_member_1.lisp Normal file
View File

@ -0,0 +1,6 @@
;; Check is pretty serious about t and nil
(check (eq (list 1 2 3) (and (member (list 1 2 3) 2)
(member (list 1 2 3) 3)
(member (list 1 2 3) 1))))

2
tests/test_member_2.lisp Normal file
View File

@ -0,0 +1,2 @@
(check (eq nil (member (list 1 2 3) 4)))

1
tests/test_member_3.lisp Normal file
View File

@ -0,0 +1 @@
(check (eq nil (member '() 1)))

8
tests/test_progn_var_10.lisp Normal file
View File

@ -0,0 +1,8 @@
(progn
(var f (lambda (x) ( + x 1)))
(var a 1)
(check ( = (f a) 2))
)

9
tests/test_progn_var_11.lisp Normal file
View File

@ -0,0 +1,9 @@
(progn
(var f (lambda (x)
(if (= 0 x) 0
(+ x (f (- x 1))))))
(var a 10)
(check ( = (f a) 55))
)