Squashed 'lispBM/lispBM/' changes from fd0f1fab..e421208f
e421208f small tweaks to strings, dec_str and string extensions 0baa53c6 Merge pull request #12 from laxsjo/update/str-extensions 1e27ba02 swapped start and occurrence arguments in str-find 7d5a997e Write tests for new string extensions 6bd2c1bd Update str-find argument behavior b84a779b add_symbol functions now check if a symbol already exists before adding it. dac49f47 move test lisp files into dedicated directory 34a14229 added a few more move-to-flash tests 1f221aaf change order of flash writes in a few more cases. The high-level array case needs refactoring to fit the pattern e9e7083f add compiled repl and tests executable to .gitignore a70eda64 cast/change int types to avoid warnings in string_extensions.c 5dc5b022 Swapped meaning of 'left and 'right in str-find Realized that the previous behavior is completely stupid, since the argument is called direction, while the previous left and right specified which end to start in. 93805c98 Add the str-join and str-find extensions, remove old str-merge 3f364178 change to order in which values are written to flash when processing lists. 6c1a0672 added tests related to progn + var. May need to think a bit about the meaning of var in progn dd09cecf tweak refman a9c5fd53 small update lbmref 3642e8a5 small update lbmref 8be7ab05 small tweaks to manual 77a38617 update to lbmref fa56ea05 changes to lbmref. minor tweaks git-subtree-dir: lispBM/lispBM git-subtree-split: e421208f5355be188ac80949e36300f43f15a8fc
|
@ -62,4 +62,6 @@ dkms.conf
|
||||||
.settings
|
.settings
|
||||||
*.xxd
|
*.xxd
|
||||||
style.md
|
style.md
|
||||||
repl-ChibiOS/build
|
repl-ChibiOS/build
|
||||||
|
repl/repl
|
||||||
|
tests/test_lisp_code_cps
|
||||||
|
|
Before Width: | Height: | Size: 21 KiB After Width: | Height: | Size: 21 KiB |
Before Width: | Height: | Size: 28 KiB After Width: | Height: | Size: 29 KiB |
Before Width: | Height: | Size: 28 KiB After Width: | Height: | Size: 29 KiB |
Before Width: | Height: | Size: 47 KiB After Width: | Height: | Size: 49 KiB |
|
@ -571,8 +571,8 @@
|
||||||
))
|
))
|
||||||
(para (list "Some times evaluation is impossible. This could be because the program is malformed, a type mismatch or"
|
(para (list "Some times evaluation is impossible. This could be because the program is malformed, a type mismatch or"
|
||||||
"a division by zero (among many other possibilities)."
|
"a division by zero (among many other possibilities)."
|
||||||
"Errors terminate the evaluation of the expression. To recover from an error and handle it"
|
"Errors terminate the evaluation of the expression. To recover from an error"
|
||||||
"the programmer needs to explicitly `trap` the error."
|
"the programmer needs to explicitly `trap` it."
|
||||||
))
|
))
|
||||||
(code '((trap (/ 1 0 ))
|
(code '((trap (/ 1 0 ))
|
||||||
))
|
))
|
||||||
|
@ -599,9 +599,11 @@
|
||||||
)
|
)
|
||||||
|
|
||||||
(para (list "Symbols evaluate by a lookup in the environment."
|
(para (list "Symbols evaluate by a lookup in the environment."
|
||||||
"First, the local environment is searched for a binding of the symbols."
|
"First, the local environment is searched for a binding of the symbol."
|
||||||
"If unable to find a binding in the local environment, the global environment is searched."
|
"If unable to find a binding in the local environment, the global environment is searched."
|
||||||
"If unable to find a binding in the global environment as well, an error `variable_not_bound` is triggered."
|
"If unable to find a binding in the global environment as well, the runtime system attempts to dynamically load"
|
||||||
|
"a binding using a system provided callback function."
|
||||||
|
"If all of the above fails to provide a value a `variable_not_bound` error is produced."
|
||||||
))
|
))
|
||||||
(para (list "**Composite forms**"
|
(para (list "**Composite forms**"
|
||||||
))
|
))
|
||||||
|
@ -610,7 +612,7 @@
|
||||||
"There are three major categories that `e1` can fall into. Either `e1` is something that"
|
"There are three major categories that `e1` can fall into. Either `e1` is something that"
|
||||||
"represents a function and `(e1 ... eN)` is a function application."
|
"represents a function and `(e1 ... eN)` is a function application."
|
||||||
"Or `e1` is a so-called *special-form* that form the core of the LBM language."
|
"Or `e1` is a so-called *special-form* that form the core of the LBM language."
|
||||||
"Or lastly, `e1` is anything else than the above and the composite form is malformed ultimately resulting in an error."
|
"Or lastly, `e1` is anything else and the composite form is malformed and will ultimately result in an error."
|
||||||
))
|
))
|
||||||
(para (list "The composite form `(e1 ... eN)` is evaluated by first checking if `e1` is a special form or not."
|
(para (list "The composite form `(e1 ... eN)` is evaluated by first checking if `e1` is a special form or not."
|
||||||
"if `e1` is a special form the composite form is passed to a special-form evaluator."
|
"if `e1` is a special form the composite form is passed to a special-form evaluator."
|
||||||
|
@ -619,28 +621,34 @@
|
||||||
))
|
))
|
||||||
(para (list "**Special form evaluation**"
|
(para (list "**Special form evaluation**"
|
||||||
))
|
))
|
||||||
(para (list "The special-forms in lispBM are:"
|
(para (list "Below are a selection of basic special-forms in lispBM together with their evaluation process"
|
||||||
))
|
))
|
||||||
(bullet (list "quote"
|
(bullet (list "**quote**: `(quote a)` evaluates to a for any a"
|
||||||
"define"
|
"**define**: `(define s e)`, `e` is evaluated into `v` and the global environment is augmented with the pair `(s . v)`"
|
||||||
"progn"
|
"**lambda**: `(lambda params body)` is evaluated into '(closure params body env)`. `env` is the local environment there the lambda expression is evaluated."
|
||||||
"lambda"
|
"**if**: `(if e1 e2 e3)` is evaluated by evaluating `e1` into `v1` if `v1` is nil, `e3` is evaluated otherwise `e2` is evaluated."
|
||||||
"if"
|
"**progn**: `(progn e1 e2 ... eN)` is evaluated by evaluating `e1` then `e2` and so on until `eN`. The value `v` that `eN` evaluats into is the value `(progn e1 e2 ... eN)` evaluates to."
|
||||||
"let"
|
"**and**: `(and e1 e2 ... eN)` evaluates the `eI` expressions from left to right as long as they result in a non-nil value."
|
||||||
"and"
|
"**or**: `(or e1 e2 ... eN)` evaluates the `eI` expressions from left to right until there is a non-nil result."
|
||||||
"or"
|
))
|
||||||
"match"
|
(para (list "`and`, `or`, `progn` and `if` evaluates expressions in sequence."
|
||||||
"receive"
|
"`if` evaluates first the condition expression and then"
|
||||||
"callcc"
|
"either the true or false branch. `progn` evaluates all of the expressions in sequence."
|
||||||
"atomic"
|
"In the case of `and`, `or`, `progn` and `if`, the constituent expressions are all evaluated in the same local environment."
|
||||||
"macro"
|
"Any extensions to the local environment performed by an expresison in the sequence is only visible within that expression itself."
|
||||||
"closure"
|
))
|
||||||
"cond"
|
(bullet (list "**let**: `(let ((s1 e1) (s2 e2) ... (sN eN) e)` eI are evaluated in order into `vI`. The local environment is extended with `(sI . vI)`. `sI` is visible in `eJ` for `J >= I`. `e` is then evaluated in the extended local environment."
|
||||||
"setq"
|
"**setq**: `(setq s e)' is evaluated by first evaluating `e` into `v`. The environments are then scanned for a bining of `s`. local environment is searched first followed by global. If a binding of `s` is found it is modified into `(s . v)`."
|
||||||
"move-to-flash"
|
))
|
||||||
"loop"
|
(para (list "If no binding of `s` is found when evaluating `(setq s e)` a `variable_not_bound` error is triggered."
|
||||||
"trap"
|
))
|
||||||
))
|
;; (bullet (list "callcc"
|
||||||
|
;; "atomic"
|
||||||
|
;; "macro"
|
||||||
|
;; "closure"
|
||||||
|
;; "cond"
|
||||||
|
;; "trap"
|
||||||
|
;; ))
|
||||||
(para (list "**Function application evaluation**"
|
(para (list "**Function application evaluation**"
|
||||||
))
|
))
|
||||||
(para (list "The evaluation strategies explained here are applied to composite expressions"
|
(para (list "The evaluation strategies explained here are applied to composite expressions"
|
||||||
|
@ -648,6 +656,12 @@
|
||||||
))
|
))
|
||||||
(para (list "**The quote and the quasiquote**"
|
(para (list "**The quote and the quasiquote**"
|
||||||
))
|
))
|
||||||
|
(para (list "The LBM parser (Reader) expands usages of the character sequences:"
|
||||||
|
"`'`, `` ` ``, `,` and `,@`."
|
||||||
|
"The `'` as in `'a` is expanded into `(quote a)` for any a."
|
||||||
|
"The remaining `` ` ``, `,` and `,@` are expanded into applications of `quote`, `append` and `cons`"
|
||||||
|
"using the algorithms described by Bawden in [quasiquotation in lisp](https://brics.dk/NS/99/1/BRICS-NS-99-1.pdf#page=6)."
|
||||||
|
))
|
||||||
))
|
))
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
|
@ -527,7 +527,7 @@ Still, it is worthwhile to remember that values can be expressions and expressio
|
||||||
|
|
||||||
**Errors**
|
**Errors**
|
||||||
|
|
||||||
Some times evaluation is impossible. This could be because the program is malformed, a type mismatch or a division by zero (among many other possibilities). Errors terminate the evaluation of the expression. To recover from an error and handle it the programmer needs to explicitly `trap` the error.
|
Some times evaluation is impossible. This could be because the program is malformed, a type mismatch or a division by zero (among many other possibilities). Errors terminate the evaluation of the expression. To recover from an error the programmer needs to explicitly `trap` it.
|
||||||
|
|
||||||
<table>
|
<table>
|
||||||
<tr>
|
<tr>
|
||||||
|
@ -623,37 +623,32 @@ hello world
|
||||||
</tr>
|
</tr>
|
||||||
</table>
|
</table>
|
||||||
|
|
||||||
Symbols evaluate by a lookup in the environment. First, the local environment is searched for a binding of the symbols. If unable to find a binding in the local environment, the global environment is searched. If unable to find a binding in the global environment as well, an error `variable_not_bound` is triggered.
|
Symbols evaluate by a lookup in the environment. First, the local environment is searched for a binding of the symbol. If unable to find a binding in the local environment, the global environment is searched. If unable to find a binding in the global environment as well, the runtime system attempts to dynamically load a binding using a system provided callback function. If all of the above fails to provide a value a `variable_not_bound` error is produced.
|
||||||
|
|
||||||
**Composite forms**
|
**Composite forms**
|
||||||
|
|
||||||
A composite form, such as `(e1 ... eN)` is evaluated in different ways depending on what `e1` is. There are three major categories that `e1` can fall into. Either `e1` is something that represents a function and `(e1 ... eN)` is a function application. Or `e1` is a so-called *special-form* that form the core of the LBM language. Or lastly, `e1` is anything else than the above and the composite form is malformed ultimately resulting in an error.
|
A composite form, such as `(e1 ... eN)` is evaluated in different ways depending on what `e1` is. There are three major categories that `e1` can fall into. Either `e1` is something that represents a function and `(e1 ... eN)` is a function application. Or `e1` is a so-called *special-form* that form the core of the LBM language. Or lastly, `e1` is anything else and the composite form is malformed and will ultimately result in an error.
|
||||||
|
|
||||||
The composite form `(e1 ... eN)` is evaluated by first checking if `e1` is a special form or not. if `e1` is a special form the composite form is passed to a special-form evaluator. if `e1` is not a special form, the composite form is evaluated as a function application. These two major branches of composite form evaluation are described below.
|
The composite form `(e1 ... eN)` is evaluated by first checking if `e1` is a special form or not. if `e1` is a special form the composite form is passed to a special-form evaluator. if `e1` is not a special form, the composite form is evaluated as a function application. These two major branches of composite form evaluation are described below.
|
||||||
|
|
||||||
**Special form evaluation**
|
**Special form evaluation**
|
||||||
|
|
||||||
The special-forms in lispBM are:
|
Below are a selection of basic special-forms in lispBM together with their evaluation process
|
||||||
|
|
||||||
- quote
|
- **quote**: `(quote a)` evaluates to a for any a
|
||||||
- define
|
- **define**: `(define s e)`, `e` is evaluated into `v` and the global environment is augmented with the pair `(s . v)`
|
||||||
- progn
|
- **lambda**: `(lambda params body)` is evaluated into '(closure params body env)`. `env` is the local environment there the lambda expression is evaluated.
|
||||||
- lambda
|
- **if**: `(if e1 e2 e3)` is evaluated by evaluating `e1` into `v1` if `v1` is nil, `e3` is evaluated otherwise `e2` is evaluated.
|
||||||
- if
|
- **progn**: `(progn e1 e2 ... eN)` is evaluated by evaluating `e1` then `e2` and so on until `eN`. The value `v` that `eN` evaluats into is the value `(progn e1 e2 ... eN)` evaluates to.
|
||||||
- let
|
- **and**: `(and e1 e2 ... eN)` evaluates the `eI` expressions from left to right as long as they result in a non-nil value.
|
||||||
- and
|
- **or**: `(or e1 e2 ... eN)` evaluates the `eI` expressions from left to right until there is a non-nil result.
|
||||||
- or
|
|
||||||
- match
|
`and`, `or`, `progn` and `if` evaluates expressions in sequence. `if` evaluates first the condition expression and then either the true or false branch. `progn` evaluates all of the expressions in sequence. In the case of `and`, `or`, `progn` and `if`, the constituent expressions are all evaluated in the same local environment. Any extensions to the local environment performed by an expresison in the sequence is only visible within that expression itself.
|
||||||
- receive
|
|
||||||
- callcc
|
- **let**: `(let ((s1 e1) (s2 e2) ... (sN eN) e)` eI are evaluated in order into `vI`. The local environment is extended with `(sI . vI)`. `sI` is visible in `eJ` for `J >= I`. `e` is then evaluated in the extended local environment.
|
||||||
- atomic
|
- **setq**: `(setq s e)' is evaluated by first evaluating `e` into `v`. The environments are then scanned for a bining of `s`. local environment is searched first followed by global. If a binding of `s` is found it is modified into `(s . v)`.
|
||||||
- macro
|
|
||||||
- closure
|
If no binding of `s` is found when evaluating `(setq s e)` a `variable_not_bound` error is triggered.
|
||||||
- cond
|
|
||||||
- setq
|
|
||||||
- move-to-flash
|
|
||||||
- loop
|
|
||||||
- trap
|
|
||||||
|
|
||||||
**Function application evaluation**
|
**Function application evaluation**
|
||||||
|
|
||||||
|
@ -661,6 +656,8 @@ The evaluation strategies explained here are applied to composite expressions of
|
||||||
|
|
||||||
**The quote and the quasiquote**
|
**The quote and the quasiquote**
|
||||||
|
|
||||||
|
The LBM parser (Reader) expands usages of the character sequences: `'`, `` ` ``, `,` and `,@`. The `'` as in `'a` is expanded into `(quote a)` for any a. The remaining `` ` ``, `,` and `,@` are expanded into applications of `quote`, `append` and `cons` using the algorithms described by Bawden in [quasiquotation in lisp](https://brics.dk/NS/99/1/BRICS-NS-99-1.pdf#page=6).
|
||||||
|
|
||||||
### Concurrency and Semantics
|
### Concurrency and Semantics
|
||||||
|
|
||||||
TODO: Finish section.
|
TODO: Finish section.
|
||||||
|
|
|
@ -390,6 +390,20 @@ int64_t lbm_dec_as_i64(lbm_value val);
|
||||||
*/
|
*/
|
||||||
double lbm_dec_as_double(lbm_value val);
|
double lbm_dec_as_double(lbm_value val);
|
||||||
|
|
||||||
|
/** Decode a numerical value into the architecture defined unsigned integer type.
|
||||||
|
*
|
||||||
|
* \param val Value to decode
|
||||||
|
* \return The value encoded in val casted to an unsigned int. Returns 0 if val does not encode a number.
|
||||||
|
*/
|
||||||
|
lbm_uint lbm_dec_as_uint(lbm_value val);
|
||||||
|
|
||||||
|
/** Decode a numerical value into the architecture defined signed integer type.
|
||||||
|
*
|
||||||
|
* \param val Value to decode
|
||||||
|
* \return The value encoded in val casted to a signed int. Returns 0 if val does not encode a number.
|
||||||
|
*/
|
||||||
|
lbm_int lbm_dec_as_int(lbm_value val);
|
||||||
|
|
||||||
lbm_uint lbm_dec_raw(lbm_value v);
|
lbm_uint lbm_dec_raw(lbm_value v);
|
||||||
/** Allocates an lbm_cons_t cell from the heap and populates it.
|
/** Allocates an lbm_cons_t cell from the heap and populates it.
|
||||||
*
|
*
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
/** \file lbm_types.h */
|
/** \file lbm_types.h */
|
||||||
/*
|
/*
|
||||||
Copyright 2019, 2022 Joel Svensson svenssonjoel@yahoo.se
|
Copyright 2019, 2022 Joel Svensson svenssonjoel@yahoo.se
|
||||||
|
Copyright 2024 Rasmus Söderhielm rasmus.soderhielm@gmail.com
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU General Public License as published by
|
it under the terms of the GNU General Public License as published by
|
||||||
|
@ -49,6 +50,10 @@ typedef int32_t lbm_int;
|
||||||
typedef float lbm_float;
|
typedef float lbm_float;
|
||||||
typedef double lbm_double;
|
typedef double lbm_double;
|
||||||
|
|
||||||
|
#define LBM_UINT_MAX UINT32_MAX
|
||||||
|
#define LBM_INT_MIN INT32_MIN
|
||||||
|
#define LBM_INT_MAX INT32_MAX
|
||||||
|
|
||||||
#define PRI_VALUE PRIu32
|
#define PRI_VALUE PRIu32
|
||||||
#define PRI_TYPE PRIu32
|
#define PRI_TYPE PRIu32
|
||||||
#define PRI_UINT PRIu32
|
#define PRI_UINT PRIu32
|
||||||
|
@ -72,6 +77,10 @@ typedef int64_t lbm_int;
|
||||||
typedef float lbm_float;
|
typedef float lbm_float;
|
||||||
typedef double lbm_double;
|
typedef double lbm_double;
|
||||||
|
|
||||||
|
#define LBM_UINT_MAX UINT64_MAX
|
||||||
|
#define LBM_INT_MIN INT64_MIN
|
||||||
|
#define LBM_INT_MAX INT64_MAX
|
||||||
|
|
||||||
#define PRI_VALUE PRIu64
|
#define PRI_VALUE PRIu64
|
||||||
#define PRI_TYPE PRIu64
|
#define PRI_TYPE PRIu64
|
||||||
#define PRI_UINT PRIu64
|
#define PRI_UINT PRIu64
|
||||||
|
|
|
@ -51,6 +51,7 @@ int lbm_symrepr_init(void);
|
||||||
* \param symrepr_name_iterator_fun function taking a string
|
* \param symrepr_name_iterator_fun function taking a string
|
||||||
*/
|
*/
|
||||||
void lbm_symrepr_name_iterator(symrepr_name_iterator_fun f);
|
void lbm_symrepr_name_iterator(symrepr_name_iterator_fun f);
|
||||||
|
int lbm_add_symbol_base(char *name, lbm_uint *id, bool flash);
|
||||||
/** Add a symbol to the symbol table. The symbol name string is copied to arrays and symbols memory.
|
/** Add a symbol to the symbol table. The symbol name string is copied to arrays and symbols memory.
|
||||||
*
|
*
|
||||||
* \param name String representation of the symbol.
|
* \param name String representation of the symbol.
|
||||||
|
@ -72,6 +73,7 @@ int lbm_add_symbol_flash(char *name, lbm_uint* id);
|
||||||
\return 1 for success and 0 for failure.
|
\return 1 for success and 0 for failure.
|
||||||
*/
|
*/
|
||||||
int lbm_str_to_symbol(char *name, lbm_uint *sym_id);
|
int lbm_str_to_symbol(char *name, lbm_uint *sym_id);
|
||||||
|
int lbm_add_symbol_const_base(char *name, lbm_uint* id);
|
||||||
/** Add a symbol to the symbol table. The name is assumed to be a statically allocated string.
|
/** Add a symbol to the symbol table. The name is assumed to be a statically allocated string.
|
||||||
*
|
*
|
||||||
* \param name Statically allocated name string.
|
* \param name Statically allocated name string.
|
||||||
|
|
|
@ -3860,16 +3860,16 @@ static void cont_read_next_token(eval_context_t *ctx) {
|
||||||
} else {
|
} else {
|
||||||
if (ctx->flags & EVAL_CPS_CONTEXT_FLAG_CONST_SYMBOL_STRINGS &&
|
if (ctx->flags & EVAL_CPS_CONTEXT_FLAG_CONST_SYMBOL_STRINGS &&
|
||||||
ctx->flags & EVAL_CPS_CONTEXT_FLAG_INCREMENTAL_READ) {
|
ctx->flags & EVAL_CPS_CONTEXT_FLAG_INCREMENTAL_READ) {
|
||||||
r = lbm_add_symbol_flash(tokpar_sym_str, &symbol_id);
|
r = lbm_add_symbol_base(tokpar_sym_str, &symbol_id, true); //flash
|
||||||
if (!r) {
|
if (!r) {
|
||||||
lbm_set_error_reason((char*)lbm_error_str_flash_error);
|
lbm_set_error_reason((char*)lbm_error_str_flash_error);
|
||||||
error_ctx(ENC_SYM_FATAL_ERROR);
|
error_ctx(ENC_SYM_FATAL_ERROR);
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
r = lbm_add_symbol(tokpar_sym_str, &symbol_id);
|
r = lbm_add_symbol_base(tokpar_sym_str, &symbol_id,false); //ram
|
||||||
if (!r) {
|
if (!r) {
|
||||||
gc();
|
gc();
|
||||||
r = lbm_add_symbol(tokpar_sym_str, &symbol_id);
|
r = lbm_add_symbol_base(tokpar_sym_str, &symbol_id,false); //ram
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -4433,11 +4433,9 @@ static void cont_move_val_to_flash_dispatch(eval_context_t *ctx) {
|
||||||
lbm_value val = ctx->r;
|
lbm_value val = ctx->r;
|
||||||
|
|
||||||
if (lbm_is_cons(val)) {
|
if (lbm_is_cons(val)) {
|
||||||
lbm_value flash_cell = ENC_SYM_NIL;
|
|
||||||
handle_flash_status(request_flash_storage_cell(val, &flash_cell));
|
|
||||||
lbm_value *rptr = stack_reserve(ctx, 5);
|
lbm_value *rptr = stack_reserve(ctx, 5);
|
||||||
rptr[0] = flash_cell;
|
rptr[0] = ENC_SYM_NIL; // fst cell of list
|
||||||
rptr[1] = flash_cell;
|
rptr[1] = ENC_SYM_NIL; // last cell of list
|
||||||
rptr[2] = get_cdr(val);
|
rptr[2] = get_cdr(val);
|
||||||
rptr[3] = MOVE_LIST_TO_FLASH;
|
rptr[3] = MOVE_LIST_TO_FLASH;
|
||||||
rptr[4] = MOVE_VAL_TO_FLASH_DISPATCH;
|
rptr[4] = MOVE_VAL_TO_FLASH_DISPATCH;
|
||||||
|
@ -4453,19 +4451,18 @@ static void cont_move_val_to_flash_dispatch(eval_context_t *ctx) {
|
||||||
}
|
}
|
||||||
|
|
||||||
if (lbm_is_ptr(val)) {
|
if (lbm_is_ptr(val)) {
|
||||||
// Request a flash storage cell.
|
|
||||||
lbm_value flash_cell = ENC_SYM_NIL;
|
|
||||||
handle_flash_status(request_flash_storage_cell(val, &flash_cell));
|
|
||||||
ctx->r = flash_cell;
|
|
||||||
lbm_cons_t *ref = lbm_ref_cell(val);
|
lbm_cons_t *ref = lbm_ref_cell(val);
|
||||||
if (lbm_type_of(ref->cdr) == LBM_TYPE_SYMBOL) {
|
if (lbm_type_of(ref->cdr) == LBM_TYPE_SYMBOL) {
|
||||||
switch (ref->cdr) {
|
switch (ref->cdr) {
|
||||||
case ENC_SYM_RAW_I_TYPE: /* fall through */
|
case ENC_SYM_RAW_I_TYPE: /* fall through */
|
||||||
case ENC_SYM_RAW_U_TYPE:
|
case ENC_SYM_RAW_U_TYPE:
|
||||||
case ENC_SYM_RAW_F_TYPE:
|
case ENC_SYM_RAW_F_TYPE: {
|
||||||
|
lbm_value flash_cell = ENC_SYM_NIL;
|
||||||
|
handle_flash_status(request_flash_storage_cell(val, &flash_cell));
|
||||||
handle_flash_status(write_const_car(flash_cell, ref->car));
|
handle_flash_status(write_const_car(flash_cell, ref->car));
|
||||||
handle_flash_status(write_const_cdr(flash_cell, ref->cdr));
|
handle_flash_status(write_const_cdr(flash_cell, ref->cdr));
|
||||||
break;
|
ctx->r = flash_cell;
|
||||||
|
} break;
|
||||||
case ENC_SYM_IND_I_TYPE: /* fall through */
|
case ENC_SYM_IND_I_TYPE: /* fall through */
|
||||||
case ENC_SYM_IND_U_TYPE:
|
case ENC_SYM_IND_U_TYPE:
|
||||||
case ENC_SYM_IND_F_TYPE: {
|
case ENC_SYM_IND_F_TYPE: {
|
||||||
|
@ -4475,8 +4472,11 @@ static void cont_move_val_to_flash_dispatch(eval_context_t *ctx) {
|
||||||
lbm_uint flash_ptr;
|
lbm_uint flash_ptr;
|
||||||
|
|
||||||
handle_flash_status(lbm_write_const_raw(lbm_mem_ptr, 2, &flash_ptr));
|
handle_flash_status(lbm_write_const_raw(lbm_mem_ptr, 2, &flash_ptr));
|
||||||
|
lbm_value flash_cell = ENC_SYM_NIL;
|
||||||
|
handle_flash_status(request_flash_storage_cell(val, &flash_cell));
|
||||||
handle_flash_status(write_const_car(flash_cell, flash_ptr));
|
handle_flash_status(write_const_car(flash_cell, flash_ptr));
|
||||||
handle_flash_status(write_const_cdr(flash_cell, ref->cdr));
|
handle_flash_status(write_const_cdr(flash_cell, ref->cdr));
|
||||||
|
ctx->r = flash_cell;
|
||||||
#else
|
#else
|
||||||
// There are no indirect types in LBM64
|
// There are no indirect types in LBM64
|
||||||
error_ctx(ENC_SYM_FATAL_ERROR);
|
error_ctx(ENC_SYM_FATAL_ERROR);
|
||||||
|
@ -4487,8 +4487,9 @@ static void cont_move_val_to_flash_dispatch(eval_context_t *ctx) {
|
||||||
lbm_uint size = arr->size / sizeof(lbm_uint);
|
lbm_uint size = arr->size / sizeof(lbm_uint);
|
||||||
lbm_uint flash_addr;
|
lbm_uint flash_addr;
|
||||||
lbm_value *arrdata = (lbm_value *)arr->data;
|
lbm_value *arrdata = (lbm_value *)arr->data;
|
||||||
|
lbm_value flash_cell = ENC_SYM_NIL;
|
||||||
|
handle_flash_status(request_flash_storage_cell(val, &flash_cell));
|
||||||
handle_flash_status(lbm_allocate_const_raw(size, &flash_addr));
|
handle_flash_status(lbm_allocate_const_raw(size, &flash_addr));
|
||||||
|
|
||||||
lift_array_flash(flash_cell,
|
lift_array_flash(flash_cell,
|
||||||
false,
|
false,
|
||||||
(char *)flash_addr,
|
(char *)flash_addr,
|
||||||
|
@ -4509,10 +4510,13 @@ static void cont_move_val_to_flash_dispatch(eval_context_t *ctx) {
|
||||||
// arbitrary address: flash_arr.
|
// arbitrary address: flash_arr.
|
||||||
lbm_uint flash_arr;
|
lbm_uint flash_arr;
|
||||||
handle_flash_status(lbm_write_const_array_padded((uint8_t*)arr->data, arr->size, &flash_arr));
|
handle_flash_status(lbm_write_const_array_padded((uint8_t*)arr->data, arr->size, &flash_arr));
|
||||||
|
lbm_value flash_cell = ENC_SYM_NIL;
|
||||||
|
handle_flash_status(request_flash_storage_cell(val, &flash_cell));
|
||||||
lift_array_flash(flash_cell,
|
lift_array_flash(flash_cell,
|
||||||
true,
|
true,
|
||||||
(char *)flash_arr,
|
(char *)flash_arr,
|
||||||
arr->size);
|
arr->size);
|
||||||
|
ctx->r = flash_cell;
|
||||||
} break;
|
} break;
|
||||||
case ENC_SYM_CHANNEL_TYPE: /* fall through */
|
case ENC_SYM_CHANNEL_TYPE: /* fall through */
|
||||||
case ENC_SYM_CUSTOM_TYPE:
|
case ENC_SYM_CUSTOM_TYPE:
|
||||||
|
@ -4522,7 +4526,6 @@ static void cont_move_val_to_flash_dispatch(eval_context_t *ctx) {
|
||||||
} else {
|
} else {
|
||||||
error_ctx(ENC_SYM_FATAL_ERROR);
|
error_ctx(ENC_SYM_FATAL_ERROR);
|
||||||
}
|
}
|
||||||
ctx->r = flash_cell;
|
|
||||||
ctx->app_cont = true;
|
ctx->app_cont = true;
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
@ -4540,14 +4543,24 @@ static void cont_move_list_to_flash(eval_context_t *ctx) {
|
||||||
lbm_value lst = sptr[1];
|
lbm_value lst = sptr[1];
|
||||||
lbm_value val = sptr[2];
|
lbm_value val = sptr[2];
|
||||||
|
|
||||||
handle_flash_status(write_const_car(lst, ctx->r));
|
|
||||||
|
lbm_value new_lst = ENC_SYM_NIL;
|
||||||
|
// Allocate element ptr storage after storing the element to flash.
|
||||||
|
handle_flash_status(request_flash_storage_cell(lbm_enc_cons_ptr(LBM_PTR_NULL), &new_lst));
|
||||||
|
|
||||||
|
if (lbm_is_symbol_nil(fst)) {
|
||||||
|
lst = new_lst;
|
||||||
|
fst = new_lst;
|
||||||
|
handle_flash_status(write_const_car(lst, ctx->r));
|
||||||
|
} else {
|
||||||
|
handle_flash_status(write_const_cdr(lst, new_lst)); // low before high
|
||||||
|
handle_flash_status(write_const_car(new_lst, ctx->r));
|
||||||
|
lst = new_lst;
|
||||||
|
}
|
||||||
|
|
||||||
if (lbm_is_cons(val)) {
|
if (lbm_is_cons(val)) {
|
||||||
// prepare cell for rest of list
|
sptr[0] = fst;
|
||||||
lbm_value rest_cell = ENC_SYM_NIL;
|
sptr[1] = lst;//rest_cell;
|
||||||
handle_flash_status(request_flash_storage_cell(val, &rest_cell));
|
|
||||||
handle_flash_status(write_const_cdr(lst, rest_cell));
|
|
||||||
sptr[1] = rest_cell;
|
|
||||||
sptr[2] = get_cdr(val);
|
sptr[2] = get_cdr(val);
|
||||||
lbm_value *rptr = stack_reserve(ctx, 2);
|
lbm_value *rptr = stack_reserve(ctx, 2);
|
||||||
rptr[0] = MOVE_LIST_TO_FLASH;
|
rptr[0] = MOVE_LIST_TO_FLASH;
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
/*
|
/*
|
||||||
Copyright 2022, 2023 Joel Svensson svenssonjoel@yahoo.se
|
Copyright 2022, 2023 Joel Svensson svenssonjoel@yahoo.se
|
||||||
Copyright 2022, 2023 Benjamin Vedder
|
Copyright 2022, 2023 Benjamin Vedder
|
||||||
|
Copyright 2024 Rasmus Söderhielm rasmus.soderhielm@gmail.com
|
||||||
|
|
||||||
This program is free software: you can redistribute it and/or modify
|
This program is free software: you can redistribute it and/or modify
|
||||||
it under the terms of the GNU General Public License as published by
|
it under the terms of the GNU General Public License as published by
|
||||||
|
@ -21,6 +22,7 @@
|
||||||
#include "heap.h"
|
#include "heap.h"
|
||||||
#include "fundamental.h"
|
#include "fundamental.h"
|
||||||
#include "lbm_c_interop.h"
|
#include "lbm_c_interop.h"
|
||||||
|
#include "eval_cps.h"
|
||||||
#include "print.h"
|
#include "print.h"
|
||||||
|
|
||||||
#include <ctype.h>
|
#include <ctype.h>
|
||||||
|
@ -34,6 +36,9 @@
|
||||||
|
|
||||||
static char print_val_buffer[256];
|
static char print_val_buffer[256];
|
||||||
|
|
||||||
|
static lbm_uint sym_left;
|
||||||
|
static lbm_uint sym_right;
|
||||||
|
|
||||||
static size_t strlen_max(const char *s, size_t maxlen) {
|
static size_t strlen_max(const char *s, size_t maxlen) {
|
||||||
size_t i;
|
size_t i;
|
||||||
for (i = 0; i < maxlen; i ++) {
|
for (i = 0; i < maxlen; i ++) {
|
||||||
|
@ -94,29 +99,75 @@ static lbm_value ext_str_from_n(lbm_value *args, lbm_uint argn) {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static lbm_value ext_str_merge(lbm_value *args, lbm_uint argn) {
|
// signature: (str-join strings [delim]) -> str
|
||||||
size_t len_tot = 0;
|
static lbm_value ext_str_join(lbm_value *args, lbm_uint argn) {
|
||||||
for (unsigned int i = 0;i < argn;i++) {
|
// This function does not check that the string arguments contain any
|
||||||
char *str = lbm_dec_str(args[i]);
|
// terminating null bytes.
|
||||||
if (str) {
|
|
||||||
len_tot += strlen(str);
|
if (argn != 1 && argn != 2) {
|
||||||
} else {
|
lbm_set_error_reason((char *)lbm_error_str_num_args);
|
||||||
|
return ENC_SYM_EERROR;
|
||||||
|
}
|
||||||
|
|
||||||
|
size_t str_len = 0;
|
||||||
|
size_t str_count = 0;
|
||||||
|
if (!lbm_is_list(args[0])) {
|
||||||
|
lbm_set_error_reason((char *)lbm_error_str_incorrect_arg);
|
||||||
|
lbm_set_error_suspect(args[0]);
|
||||||
|
return ENC_SYM_TERROR;
|
||||||
|
}
|
||||||
|
for (lbm_value current = args[0]; lbm_is_cons(current); current = lbm_cdr(current)) {
|
||||||
|
char *str = lbm_dec_str(lbm_car(current));
|
||||||
|
if (!str) {
|
||||||
|
lbm_set_error_reason((char *)lbm_error_str_incorrect_arg);
|
||||||
|
lbm_set_error_suspect(args[0]);
|
||||||
|
return ENC_SYM_TERROR;
|
||||||
|
}
|
||||||
|
|
||||||
|
str_len += (strlen(str));
|
||||||
|
str_count += 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
const char *delim = "";
|
||||||
|
if (argn >= 2) {
|
||||||
|
delim = lbm_dec_str(args[1]);
|
||||||
|
if (!delim) {
|
||||||
|
lbm_set_error_reason((char *)lbm_error_str_incorrect_arg);
|
||||||
|
lbm_set_error_suspect(args[1]);
|
||||||
return ENC_SYM_TERROR;
|
return ENC_SYM_TERROR;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
lbm_value res;
|
size_t delim_len = strlen(delim);
|
||||||
if (lbm_create_array(&res, len_tot + 1)) {
|
if (str_count > 0) {
|
||||||
lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(res);
|
str_len += (str_count - 1) * delim_len;
|
||||||
unsigned int offset = 0;
|
}
|
||||||
for (unsigned int i = 0;i < argn;i++) {
|
|
||||||
offset += (unsigned int)sprintf((char*)arr->data + offset, "%s", lbm_dec_str(args[i]));
|
lbm_value result;
|
||||||
}
|
if (!lbm_create_array(&result, str_len + 1)) {
|
||||||
((char*)(arr->data))[len_tot] = '\0';
|
|
||||||
return res;
|
|
||||||
} else {
|
|
||||||
return ENC_SYM_MERROR;
|
return ENC_SYM_MERROR;
|
||||||
}
|
}
|
||||||
|
char *result_str = lbm_dec_str(result);
|
||||||
|
|
||||||
|
size_t i = 0;
|
||||||
|
size_t offset = 0;
|
||||||
|
for (lbm_value current = args[0]; lbm_is_cons(current); current = lbm_cdr(current)) {
|
||||||
|
const char *str = lbm_dec_str(lbm_car(current));
|
||||||
|
size_t len = strlen(str);
|
||||||
|
|
||||||
|
memcpy(result_str + offset, str, len);
|
||||||
|
offset += len;
|
||||||
|
|
||||||
|
if (i != str_count - 1) {
|
||||||
|
memcpy(result_str + offset, delim, delim_len);
|
||||||
|
offset += delim_len;
|
||||||
|
}
|
||||||
|
i++;
|
||||||
|
}
|
||||||
|
|
||||||
|
result_str[str_len] = '\0';
|
||||||
|
|
||||||
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
static lbm_value ext_str_to_i(lbm_value *args, lbm_uint argn) {
|
static lbm_value ext_str_to_i(lbm_value *args, lbm_uint argn) {
|
||||||
|
@ -525,13 +576,158 @@ static lbm_value ext_str_replicate(lbm_value *args, lbm_uint argn) {
|
||||||
return res;
|
return res;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
// signature: (str-find str:byte-array substr [start:int] [occurrence:int] [dir]) -> int
|
||||||
|
// where
|
||||||
|
// seq = string|(..string)
|
||||||
|
// dir = 'left|'right
|
||||||
|
static lbm_value ext_str_find(lbm_value *args, lbm_uint argn) {
|
||||||
|
if (argn < 2 || 5 < argn) {
|
||||||
|
lbm_set_error_reason((char *)lbm_error_str_num_args);
|
||||||
|
return ENC_SYM_EERROR;
|
||||||
|
}
|
||||||
|
if (!lbm_is_array_r(args[0])) {
|
||||||
|
lbm_set_error_suspect(args[0]);
|
||||||
|
lbm_set_error_reason((char *)lbm_error_str_incorrect_arg);
|
||||||
|
return ENC_SYM_TERROR;
|
||||||
|
}
|
||||||
|
|
||||||
|
lbm_array_header_t *str_header = (lbm_array_header_t *)lbm_car(args[0]);
|
||||||
|
const char *str = (const char *)str_header->data;
|
||||||
|
lbm_int str_size = (lbm_int)str_header->size;
|
||||||
|
|
||||||
|
// Guaranteed to be list containing strings.
|
||||||
|
lbm_value substrings;
|
||||||
|
lbm_int min_substr_len = LBM_INT_MAX;
|
||||||
|
if (lbm_is_array_r(args[1])) {
|
||||||
|
substrings = lbm_cons(args[1], ENC_SYM_NIL);
|
||||||
|
if (substrings == ENC_SYM_MERROR) {
|
||||||
|
return ENC_SYM_MERROR;
|
||||||
|
}
|
||||||
|
lbm_array_header_t *header =
|
||||||
|
(lbm_array_header_t *)lbm_car(args[1]);
|
||||||
|
if (!header) {
|
||||||
|
// Should not be possible
|
||||||
|
return ENC_SYM_FATAL_ERROR;
|
||||||
|
}
|
||||||
|
|
||||||
|
lbm_int len = (lbm_int)header->size - 1;
|
||||||
|
if (len < 0) {
|
||||||
|
// substr is zero length array
|
||||||
|
return lbm_enc_i(-1);
|
||||||
|
}
|
||||||
|
min_substr_len = len;
|
||||||
|
} else if (lbm_is_list(args[1])) {
|
||||||
|
for (lbm_value current = args[1]; lbm_is_cons(current); current = lbm_cdr(current)) {
|
||||||
|
if (!lbm_is_array_r(lbm_car(current))) {
|
||||||
|
lbm_set_error_suspect(args[1]);
|
||||||
|
lbm_set_error_reason((char *)lbm_error_str_incorrect_arg);
|
||||||
|
return ENC_SYM_TERROR;
|
||||||
|
}
|
||||||
|
|
||||||
|
lbm_array_header_t *header =
|
||||||
|
(lbm_array_header_t *)lbm_car(lbm_car(current));
|
||||||
|
|
||||||
|
lbm_int len = (lbm_int)header->size - 1;
|
||||||
|
if (len < 0) {
|
||||||
|
// substr is zero length array
|
||||||
|
continue;
|
||||||
|
}
|
||||||
|
if (len < min_substr_len) {
|
||||||
|
min_substr_len = len;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
substrings = args[1];
|
||||||
|
} else {
|
||||||
|
lbm_set_error_suspect(args[1]);
|
||||||
|
lbm_set_error_reason((char *)lbm_error_str_incorrect_arg);
|
||||||
|
return ENC_SYM_TERROR;
|
||||||
|
}
|
||||||
|
|
||||||
|
bool to_right = true;
|
||||||
|
lbm_uint dir_index = 4;
|
||||||
|
if (argn >= 3 && lbm_is_symbol(args[argn - 1])) {
|
||||||
|
dir_index = argn - 1;
|
||||||
|
lbm_uint symbol = lbm_dec_sym(args[dir_index]);
|
||||||
|
|
||||||
|
if (symbol == sym_left) {
|
||||||
|
to_right = false;
|
||||||
|
} else if (symbol != sym_right) {
|
||||||
|
lbm_set_error_suspect(args[dir_index]);
|
||||||
|
lbm_set_error_reason((char *)lbm_error_str_incorrect_arg);
|
||||||
|
return ENC_SYM_TERROR;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
lbm_int start = to_right ? 0 : str_size - min_substr_len;
|
||||||
|
if (argn >= 3 && dir_index != 2) {
|
||||||
|
if (!lbm_is_number(args[2])) {
|
||||||
|
lbm_set_error_reason((char *)lbm_error_str_no_number);
|
||||||
|
lbm_set_error_suspect(args[2]);
|
||||||
|
return ENC_SYM_TERROR;
|
||||||
|
}
|
||||||
|
|
||||||
|
start = lbm_dec_as_int(args[2]);
|
||||||
|
}
|
||||||
|
|
||||||
|
uint32_t occurrence = 0;
|
||||||
|
if (argn >= 4 && dir_index != 3) {
|
||||||
|
if (!lbm_is_number(args[3])) {
|
||||||
|
lbm_set_error_reason((char *)lbm_error_str_no_number);
|
||||||
|
lbm_set_error_suspect(args[3]);
|
||||||
|
return ENC_SYM_TERROR;
|
||||||
|
}
|
||||||
|
|
||||||
|
occurrence = lbm_dec_as_u32(args[3]);
|
||||||
|
}
|
||||||
|
|
||||||
|
if (start < 0) {
|
||||||
|
// start: -1 starts the search at the character index before the final null
|
||||||
|
// byte index.
|
||||||
|
start = str_size - 1 + start;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (!to_right && (start > str_size - min_substr_len)) {
|
||||||
|
start = str_size - min_substr_len;
|
||||||
|
}
|
||||||
|
else if (to_right && (start < 0)) {
|
||||||
|
start = 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
lbm_int dir = to_right ? 1 : -1;
|
||||||
|
for (lbm_int i = start; to_right ? (i <= str_size - min_substr_len) : (i >= 0); i += dir) {
|
||||||
|
for (lbm_value current = substrings; lbm_is_cons(current); current = lbm_cdr(current)) {
|
||||||
|
lbm_array_header_t *header = (lbm_array_header_t *)lbm_car(lbm_car(current));
|
||||||
|
lbm_int substr_len = (lbm_int)header->size - 1;
|
||||||
|
const char *substr = (const char *)header->data;
|
||||||
|
|
||||||
|
if (
|
||||||
|
i > str_size - substr_len // substr length runs over str end.
|
||||||
|
|| substr_len < 0 // substr was zero bytes in size
|
||||||
|
) {
|
||||||
|
continue;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (memcmp(&str[i], substr, (size_t)substr_len) == 0) {
|
||||||
|
if (occurrence == 0) {
|
||||||
|
return lbm_enc_i(i);
|
||||||
|
}
|
||||||
|
occurrence -= 1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return lbm_enc_i(-1);
|
||||||
|
}
|
||||||
|
|
||||||
bool lbm_string_extensions_init(void) {
|
bool lbm_string_extensions_init(void) {
|
||||||
|
|
||||||
bool res = true;
|
bool res = true;
|
||||||
|
|
||||||
|
res = res && lbm_add_symbol_const("left", &sym_left);
|
||||||
|
res = res && lbm_add_symbol_const("right", &sym_right);
|
||||||
|
|
||||||
res = res && lbm_add_extension("str-from-n", ext_str_from_n);
|
res = res && lbm_add_extension("str-from-n", ext_str_from_n);
|
||||||
res = res && lbm_add_extension("str-merge", ext_str_merge);
|
res = res && lbm_add_extension("str-join", ext_str_join);
|
||||||
res = res && lbm_add_extension("str-to-i", ext_str_to_i);
|
res = res && lbm_add_extension("str-to-i", ext_str_to_i);
|
||||||
res = res && lbm_add_extension("str-to-f", ext_str_to_f);
|
res = res && lbm_add_extension("str-to-f", ext_str_to_f);
|
||||||
res = res && lbm_add_extension("str-part", ext_str_part);
|
res = res && lbm_add_extension("str-part", ext_str_part);
|
||||||
|
@ -544,6 +740,7 @@ bool lbm_string_extensions_init(void) {
|
||||||
res = res && lbm_add_extension("to-str-delim", ext_to_str_delim);
|
res = res && lbm_add_extension("to-str-delim", ext_to_str_delim);
|
||||||
res = res && lbm_add_extension("str-len", ext_str_len);
|
res = res && lbm_add_extension("str-len", ext_str_len);
|
||||||
res = res && lbm_add_extension("str-replicate", ext_str_replicate);
|
res = res && lbm_add_extension("str-replicate", ext_str_replicate);
|
||||||
|
res = res && lbm_add_extension("str-find", ext_str_find);
|
||||||
|
|
||||||
return res;
|
return res;
|
||||||
}
|
}
|
||||||
|
|
53
src/heap.c
|
@ -238,11 +238,10 @@ int64_t lbm_dec_i64(lbm_value x) {
|
||||||
|
|
||||||
char *lbm_dec_str(lbm_value val) {
|
char *lbm_dec_str(lbm_value val) {
|
||||||
char *res = 0;
|
char *res = 0;
|
||||||
|
// If val is an array, car of val will be non-null.
|
||||||
if (lbm_is_array_r(val)) {
|
if (lbm_is_array_r(val)) {
|
||||||
lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(val);
|
lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(val);
|
||||||
if (array) {
|
res = (char *)array->data;
|
||||||
res = (char *)array->data;
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
return res;
|
return res;
|
||||||
}
|
}
|
||||||
|
@ -384,6 +383,54 @@ uint64_t lbm_dec_as_u64(lbm_value a) {
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
lbm_uint lbm_dec_as_uint(lbm_value a) {
|
||||||
|
switch (lbm_type_of_functional(a)) {
|
||||||
|
case LBM_TYPE_CHAR:
|
||||||
|
return (lbm_uint) lbm_dec_char(a);
|
||||||
|
case LBM_TYPE_I:
|
||||||
|
return (lbm_uint) lbm_dec_i(a);
|
||||||
|
case LBM_TYPE_U:
|
||||||
|
return (lbm_uint) lbm_dec_u(a);
|
||||||
|
case LBM_TYPE_I32:
|
||||||
|
return (lbm_uint) lbm_dec_i32(a);
|
||||||
|
case LBM_TYPE_U32:
|
||||||
|
return (lbm_uint) lbm_dec_u32(a);
|
||||||
|
case LBM_TYPE_FLOAT:
|
||||||
|
return (lbm_uint) lbm_dec_float(a);
|
||||||
|
case LBM_TYPE_I64:
|
||||||
|
return (lbm_uint) lbm_dec_i64(a);
|
||||||
|
case LBM_TYPE_U64:
|
||||||
|
return (lbm_uint) lbm_dec_u64(a);
|
||||||
|
case LBM_TYPE_DOUBLE:
|
||||||
|
return (lbm_uint) lbm_dec_double(a);
|
||||||
|
}
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
lbm_int lbm_dec_as_int(lbm_value a) {
|
||||||
|
switch (lbm_type_of_functional(a)) {
|
||||||
|
case LBM_TYPE_CHAR:
|
||||||
|
return (lbm_int) lbm_dec_char(a);
|
||||||
|
case LBM_TYPE_I:
|
||||||
|
return (lbm_int) lbm_dec_i(a);
|
||||||
|
case LBM_TYPE_U:
|
||||||
|
return (lbm_int) lbm_dec_u(a);
|
||||||
|
case LBM_TYPE_I32:
|
||||||
|
return (lbm_int) lbm_dec_i32(a);
|
||||||
|
case LBM_TYPE_U32:
|
||||||
|
return (lbm_int) lbm_dec_u32(a);
|
||||||
|
case LBM_TYPE_FLOAT:
|
||||||
|
return (lbm_int)lbm_dec_float(a);
|
||||||
|
case LBM_TYPE_I64:
|
||||||
|
return (lbm_int) lbm_dec_i64(a);
|
||||||
|
case LBM_TYPE_U64:
|
||||||
|
return (lbm_int) lbm_dec_u64(a);
|
||||||
|
case LBM_TYPE_DOUBLE:
|
||||||
|
return (lbm_int) lbm_dec_double(a);
|
||||||
|
}
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
float lbm_dec_as_float(lbm_value a) {
|
float lbm_dec_as_float(lbm_value a) {
|
||||||
|
|
||||||
switch (lbm_type_of_functional(a)) {
|
switch (lbm_type_of_functional(a)) {
|
||||||
|
|
|
@ -92,7 +92,7 @@ lbm_cid eval_cps_load_and_define(lbm_char_channel_t *tokenizer, char *symbol, bo
|
||||||
lbm_uint sym_id;
|
lbm_uint sym_id;
|
||||||
|
|
||||||
if (!lbm_get_symbol_by_name(symbol, &sym_id)) {
|
if (!lbm_get_symbol_by_name(symbol, &sym_id)) {
|
||||||
if (!lbm_add_symbol(symbol, &sym_id)) {
|
if (!lbm_add_symbol_base(symbol, &sym_id,false)) { //ram
|
||||||
//lbm_explicit_free_token_stream(stream);
|
//lbm_explicit_free_token_stream(stream);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
@ -200,7 +200,7 @@ int lbm_define(char *symbol, lbm_value value) {
|
||||||
lbm_uint sym_id;
|
lbm_uint sym_id;
|
||||||
if (lbm_get_eval_state() == EVAL_CPS_STATE_PAUSED) {
|
if (lbm_get_eval_state() == EVAL_CPS_STATE_PAUSED) {
|
||||||
if (!lbm_get_symbol_by_name(symbol, &sym_id)) {
|
if (!lbm_get_symbol_by_name(symbol, &sym_id)) {
|
||||||
if (!lbm_add_symbol_const(symbol, &sym_id)) {
|
if (!lbm_add_symbol_const_base(symbol, &sym_id)) {
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
@ -744,7 +744,7 @@ static int lbm_unflatten_value_internal(lbm_flat_value_t *v, lbm_value *res) {
|
||||||
lbm_uint sym_id;
|
lbm_uint sym_id;
|
||||||
int r = lbm_get_symbol_by_name((char *)(v->buf + v->buf_pos), &sym_id);
|
int r = lbm_get_symbol_by_name((char *)(v->buf + v->buf_pos), &sym_id);
|
||||||
if (!r) {
|
if (!r) {
|
||||||
r = lbm_add_symbol((char *)(v->buf + v->buf_pos), &sym_id);
|
r = lbm_add_symbol_base((char *)(v->buf + v->buf_pos), &sym_id,false); //ram
|
||||||
}
|
}
|
||||||
if (r) {
|
if (r) {
|
||||||
lbm_uint num_bytes = strlen((char*)(v->buf + v->buf_pos)) + 1;
|
lbm_uint num_bytes = strlen((char*)(v->buf + v->buf_pos)) + 1;
|
||||||
|
|
|
@ -416,7 +416,7 @@ static bool add_symbol_to_symtab_flash(lbm_uint name, lbm_uint id) {
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
|
||||||
static int lbm_add_symbol_base(char *name, lbm_uint *id, bool flash) {
|
int lbm_add_symbol_base(char *name, lbm_uint *id, bool flash) {
|
||||||
lbm_uint symbol_name_storage;
|
lbm_uint symbol_name_storage;
|
||||||
if (flash) {
|
if (flash) {
|
||||||
if (!store_symbol_name_flash(name, &symbol_name_storage)) return 0;
|
if (!store_symbol_name_flash(name, &symbol_name_storage)) return 0;
|
||||||
|
@ -431,14 +431,28 @@ static int lbm_add_symbol_base(char *name, lbm_uint *id, bool flash) {
|
||||||
}
|
}
|
||||||
|
|
||||||
int lbm_add_symbol(char *name, lbm_uint* id) {
|
int lbm_add_symbol(char *name, lbm_uint* id) {
|
||||||
return lbm_add_symbol_base(name, id, false);
|
lbm_uint sym_id;
|
||||||
|
if (!lbm_get_symbol_by_name(name, &sym_id)) {
|
||||||
|
return lbm_add_symbol_base(name, id, false);
|
||||||
|
} else {
|
||||||
|
*id = sym_id;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
int lbm_add_symbol_flash(char *name, lbm_uint* id) {
|
int lbm_add_symbol_flash(char *name, lbm_uint* id) {
|
||||||
return lbm_add_symbol_base(name, id, true);
|
lbm_uint sym_id;
|
||||||
|
if (!lbm_get_symbol_by_name(name, &sym_id)) {
|
||||||
|
return lbm_add_symbol_base(name, id, true);
|
||||||
|
} else {
|
||||||
|
*id = sym_id;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
int lbm_add_symbol_const(char *name, lbm_uint* id) {
|
int lbm_add_symbol_const_base(char *name, lbm_uint* id) {
|
||||||
lbm_uint *m = lbm_memory_allocate(3);
|
lbm_uint *m = lbm_memory_allocate(3);
|
||||||
if (m == NULL) return 0;
|
if (m == NULL) return 0;
|
||||||
symbol_table_size_list += 3;
|
symbol_table_size_list += 3;
|
||||||
|
@ -450,6 +464,17 @@ int lbm_add_symbol_const(char *name, lbm_uint* id) {
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
int lbm_add_symbol_const(char *name, lbm_uint* id) {
|
||||||
|
lbm_uint sym_id;
|
||||||
|
if (!lbm_get_symbol_by_name(name, &sym_id)) {
|
||||||
|
return lbm_add_symbol_const_base(name, id);
|
||||||
|
} else {
|
||||||
|
*id = sym_id;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
int lbm_str_to_symbol(char *name, lbm_uint *sym_id) {
|
int lbm_str_to_symbol(char *name, lbm_uint *sym_id) {
|
||||||
if (lbm_get_symbol_by_name(name, sym_id))
|
if (lbm_get_symbol_by_name(name, sym_id))
|
||||||
return 1;
|
return 1;
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
|
|
||||||
echo "BUILDING"
|
echo "BUILDING"
|
||||||
|
|
||||||
make clean
|
# make clean
|
||||||
make
|
make
|
||||||
|
|
||||||
date=$(date +"%Y-%m-%d_%H-%M")
|
date=$(date +"%Y-%m-%d_%H-%M")
|
||||||
|
@ -14,14 +14,14 @@ fi
|
||||||
|
|
||||||
echo "PERFORMING TESTS: " $date
|
echo "PERFORMING TESTS: " $date
|
||||||
|
|
||||||
expected_fails=("test_lisp_code_cps -h 1024 test_take_iota_0.lisp"
|
expected_fails=("test_lisp_code_cps -h 1024 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -s -h 1024 test_take_iota_0.lisp"
|
"test_lisp_code_cps -s -h 1024 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -h 512 test_take_iota_0.lisp"
|
"test_lisp_code_cps -h 512 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -s -h 512 test_take_iota_0.lisp"
|
"test_lisp_code_cps -s -h 512 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -i -h 1024 test_take_iota_0.lisp"
|
"test_lisp_code_cps -i -h 1024 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -i -s -h 1024 test_take_iota_0.lisp"
|
"test_lisp_code_cps -i -s -h 1024 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -i -h 512 test_take_iota_0.lisp"
|
"test_lisp_code_cps -i -h 512 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -i -s -h 512 test_take_iota_0.lisp"
|
"test_lisp_code_cps -i -s -h 512 tests/test_take_iota_0.lisp"
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
@ -85,7 +85,7 @@ test_config=("-h 32768"
|
||||||
for prg in "test_lisp_code_cps" ; do
|
for prg in "test_lisp_code_cps" ; do
|
||||||
for arg in "${test_config[@]}"; do
|
for arg in "${test_config[@]}"; do
|
||||||
echo "Configuration: " $arg
|
echo "Configuration: " $arg
|
||||||
for lisp in *.lisp; do
|
for lisp in tests/*.lisp; do
|
||||||
tmp_file=$(mktemp)
|
tmp_file=$(mktemp)
|
||||||
./$prg $arg $lisp > $tmp_file
|
./$prg $arg $lisp > $tmp_file
|
||||||
result=$?
|
result=$?
|
||||||
|
|
|
@ -16,14 +16,14 @@ fi
|
||||||
echo "PERFORMING TESTS: " $date
|
echo "PERFORMING TESTS: " $date
|
||||||
|
|
||||||
|
|
||||||
expected_fails=("test_lisp_code_cps -h 1024 test_take_iota_0.lisp"
|
expected_fails=("test_lisp_code_cps -h 1024 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -s -h 1024 test_take_iota_0.lisp"
|
"test_lisp_code_cps -s -h 1024 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -h 512 test_take_iota_0.lisp"
|
"test_lisp_code_cps -h 512 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -s -h 512 test_take_iota_0.lisp"
|
"test_lisp_code_cps -s -h 512 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -i -h 1024 test_take_iota_0.lisp"
|
"test_lisp_code_cps -i -h 1024 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -i -s -h 1024 test_take_iota_0.lisp"
|
"test_lisp_code_cps -i -s -h 1024 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -i -h 512 test_take_iota_0.lisp"
|
"test_lisp_code_cps -i -h 512 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -i -s -h 512 test_take_iota_0.lisp"
|
"test_lisp_code_cps -i -s -h 512 tests/test_take_iota_0.lisp"
|
||||||
)
|
)
|
||||||
|
|
||||||
success_count=0
|
success_count=0
|
||||||
|
@ -86,7 +86,7 @@ test_config=("-h 32768"
|
||||||
for prg in "test_lisp_code_cps" ; do
|
for prg in "test_lisp_code_cps" ; do
|
||||||
for arg in "${test_config[@]}"; do
|
for arg in "${test_config[@]}"; do
|
||||||
echo "Configuration: " $arg
|
echo "Configuration: " $arg
|
||||||
for lisp in *.lisp; do
|
for lisp in tests/*.lisp; do
|
||||||
tmp_file=$(mktemp)
|
tmp_file=$(mktemp)
|
||||||
./$prg $arg $lisp > $tmp_file
|
./$prg $arg $lisp > $tmp_file
|
||||||
result=$?
|
result=$?
|
||||||
|
|
|
@ -15,14 +15,14 @@ fi
|
||||||
|
|
||||||
echo "PERFORMING TESTS: " $date
|
echo "PERFORMING TESTS: " $date
|
||||||
|
|
||||||
expected_fails=("test_lisp_code_cps -t 25 -h 1024 test_take_iota_0.lisp"
|
expected_fails=("test_lisp_code_cps -t 25 -h 1024 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -t 25 -s -h 1024 test_take_iota_0.lisp"
|
"test_lisp_code_cps -t 25 -s -h 1024 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -t 25 -h 512 test_take_iota_0.lisp"
|
"test_lisp_code_cps -t 25 -h 512 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -t 25 -s -h 512 test_take_iota_0.lisp"
|
"test_lisp_code_cps -t 25 -s -h 512 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -t 25 -i -h 1024 test_take_iota_0.lisp"
|
"test_lisp_code_cps -t 25 -i -h 1024 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -t 25 -i -s -h 1024 test_take_iota_0.lisp"
|
"test_lisp_code_cps -t 25 -i -s -h 1024 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -t 25 -i -h 512 test_take_iota_0.lisp"
|
"test_lisp_code_cps -t 25 -i -h 512 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -t 25 -i -s -h 512 test_take_iota_0.lisp"
|
"test_lisp_code_cps -t 25 -i -s -h 512 tests/test_take_iota_0.lisp"
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
@ -86,7 +86,7 @@ test_config=("-t 25 -h 32768"
|
||||||
for prg in "test_lisp_code_cps" ; do
|
for prg in "test_lisp_code_cps" ; do
|
||||||
for arg in "${test_config[@]}"; do
|
for arg in "${test_config[@]}"; do
|
||||||
echo "Configuration: " $arg
|
echo "Configuration: " $arg
|
||||||
for lisp in *.lisp; do
|
for lisp in tests/*.lisp; do
|
||||||
tmp_file=$(mktemp)
|
tmp_file=$(mktemp)
|
||||||
./$prg $arg $lisp > $tmp_file
|
./$prg $arg $lisp > $tmp_file
|
||||||
result=$?
|
result=$?
|
||||||
|
|
|
@ -7,14 +7,14 @@ make allrev
|
||||||
|
|
||||||
echo "PERFORMING TESTS:"
|
echo "PERFORMING TESTS:"
|
||||||
|
|
||||||
expected_fails=("test_lisp_code_cps -h 1024 test_take_iota_0.lisp"
|
expected_fails=("test_lisp_code_cps -h 1024 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -s -h 1024 test_take_iota_0.lisp"
|
"test_lisp_code_cps -s -h 1024 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -h 512 test_take_iota_0.lisp"
|
"test_lisp_code_cps -h 512 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -s -h 512 test_take_iota_0.lisp"
|
"test_lisp_code_cps -s -h 512 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -i -h 1024 test_take_iota_0.lisp"
|
"test_lisp_code_cps -i -h 1024 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -i -s -h 1024 test_take_iota_0.lisp"
|
"test_lisp_code_cps -i -s -h 1024 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -i -h 512 test_take_iota_0.lisp"
|
"test_lisp_code_cps -i -h 512 tests/test_take_iota_0.lisp"
|
||||||
"test_lisp_code_cps -i -s -h 512 test_take_iota_0.lisp"
|
"test_lisp_code_cps -i -s -h 512 tests/test_take_iota_0.lisp"
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
|
@ -78,7 +78,7 @@ test_config=("-h 32768"
|
||||||
#"test_lisp_code_cps_nc"
|
#"test_lisp_code_cps_nc"
|
||||||
for prg in "test_lisp_code_cps" ; do
|
for prg in "test_lisp_code_cps" ; do
|
||||||
for arg in "${test_config[@]}"; do
|
for arg in "${test_config[@]}"; do
|
||||||
for lisp in *.lisp; do
|
for lisp in tests/*.lisp; do
|
||||||
|
|
||||||
./$prg $arg $lisp
|
./$prg $arg $lisp
|
||||||
|
|
||||||
|
|
|
@ -740,7 +740,7 @@ int main(int argc, char **argv) {
|
||||||
lbm_pause_eval_with_gc(20);
|
lbm_pause_eval_with_gc(20);
|
||||||
int wait_count = 0;
|
int wait_count = 0;
|
||||||
while (lbm_get_eval_state() != EVAL_CPS_STATE_PAUSED) {
|
while (lbm_get_eval_state() != EVAL_CPS_STATE_PAUSED) {
|
||||||
if (wait_count >= 10) {
|
if (wait_count >= 100) {
|
||||||
printf("Could not pause the evaluator\n");
|
printf("Could not pause the evaluator\n");
|
||||||
return FAIL;
|
return FAIL;
|
||||||
}
|
}
|
||||||
|
|
|
@ -0,0 +1,6 @@
|
||||||
|
|
||||||
|
|
||||||
|
(define a (list 1))
|
||||||
|
(move-to-flash a)
|
||||||
|
|
||||||
|
(check (eq a (list 1)))
|
|
@ -0,0 +1,15 @@
|
||||||
|
|
||||||
|
(define a 1u32)
|
||||||
|
(define b 1.0f32)
|
||||||
|
(define c 1u64)
|
||||||
|
(define d 1.0f64)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(move-to-flash a)
|
||||||
|
(move-to-flash b)
|
||||||
|
|
||||||
|
(check (and (= 1u32 a)
|
||||||
|
(= 1.0f32 b)
|
||||||
|
(= 1u64 c)
|
||||||
|
(= 1.0f64 d)))
|
|
@ -1,21 +0,0 @@
|
||||||
|
|
||||||
(defun repeatq (f n)
|
|
||||||
(if ( = n 0)
|
|
||||||
()
|
|
||||||
(progn
|
|
||||||
f
|
|
||||||
(repeatq f (- n 1)))))
|
|
||||||
|
|
||||||
|
|
||||||
(define apa "apa")
|
|
||||||
(define bepa "bepa")
|
|
||||||
|
|
||||||
(gc)
|
|
||||||
|
|
||||||
(define n (mem-num-free))
|
|
||||||
|
|
||||||
(repeatq '(str-merge apa bepa) 1000)
|
|
||||||
|
|
||||||
(gc)
|
|
||||||
|
|
||||||
(check (= n (mem-num-free)))
|
|