mirror of https://github.com/rusefi/bldc.git
Squashed 'lispBM/lispBM/' changes from 418272ad..7bd15759
7bd15759 added clean.lisp 512cf8bc small improvements to repl make situtation. needs some work still 7231e200 added a build flag CLEAN_UP_CLOSURES that makes LBM clean the environment (and copy) of closures as they are created. This is slow, but nice on some theoretical level fdfc63ff remove undocumented experimental feature of match 11fda640 added set-union to set-extensions 04215849 stack operation consolidation 1d3ef1eb slight code deduplication pass 5fb4e996 added some missing comparisons to lbmref 02be461c started on a extension library for the set datatype and moved member into that extension lib git-subtree-dir: lispBM/lispBM git-subtree-split: 7bd1575901a23ebdfde2dea60051049b0a69d837
This commit is contained in:
Benjamin Vedder
parent
19a0a7cc3f
commit
df2034b2cb
|
|
@ -861,6 +861,9 @@
|
|||
comp-not-eq
|
||||
comp-=
|
||||
comp->
|
||||
comp-<
|
||||
comp->=
|
||||
comp-<=
|
||||
)
|
||||
))
|
||||
|
||||
|
|
@ -1819,18 +1822,6 @@
|
|||
))
|
||||
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"
|
||||
(list
|
||||
|
|
@ -1918,7 +1909,6 @@
|
|||
lists-setcdr
|
||||
lists-take
|
||||
lists-drop
|
||||
lists-member
|
||||
lists-reverse
|
||||
lists-rotate
|
||||
lists-merge
|
||||
|
|
|
|||
362
doc/lbmref.md
362
doc/lbmref.md
|
|
@ -1299,6 +1299,306 @@ nil
|
|||
|
||||
|
||||
|
||||
---
|
||||
|
||||
|
||||
### <
|
||||
|
||||
Less than comparison. A less than comparison has the form `(> expr1 ... exprN)` and evaluates to `t` if expr1 is less than all of expr2 ... exprN.
|
||||
|
||||
<table>
|
||||
<tr>
|
||||
<td> Example </td> <td> Result </td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
(< 5 2)
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
nil
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
(< 5 2)
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
nil
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
(< 3.140000f32 1)
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
nil
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
(< 1 3.140000f32)
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
t
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
</tr>
|
||||
</table>
|
||||
|
||||
|
||||
|
||||
|
||||
---
|
||||
|
||||
|
||||
### >=
|
||||
|
||||
Greater than or equal comparison. A greater than comparison has the form `(>= expr1 ... exprN)` and evaluates to `t` if expr1 is greater than or equal to all of expr2 ... exprN.
|
||||
|
||||
<table>
|
||||
<tr>
|
||||
<td> Example </td> <td> Result </td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
(>= 1 1)
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
t
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
(>= 5 2)
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
t
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
(>= 2 5)
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
nil
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
(>= 3.140000f32 1)
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
t
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
(>= 1 3.140000f32)
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
nil
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
</tr>
|
||||
</table>
|
||||
|
||||
|
||||
|
||||
|
||||
---
|
||||
|
||||
|
||||
### <=
|
||||
|
||||
Less than or equal comparison. A less than or equal comparison has the form `(<= expr1 ... exprN)` and evaluates to `t` if expr1 is less than or equal to all of expr2 ... exprN.
|
||||
|
||||
<table>
|
||||
<tr>
|
||||
<td> Example </td> <td> Result </td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
(<= 1 1)
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
t
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
(<= 5 2)
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
nil
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
(<= 2 5)
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
t
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
(<= 3.140000f32 1)
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
nil
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
(<= 1 3.140000f32)
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
<td>
|
||||
|
||||
```clj
|
||||
t
|
||||
```
|
||||
|
||||
|
||||
</td>
|
||||
</tr>
|
||||
</table>
|
||||
|
||||
|
||||
|
||||
|
||||
---
|
||||
|
||||
## Boolean operators
|
||||
|
|
@ -4757,7 +5057,7 @@ The `setcar` is a destructive update of the car field of a cons-cell.
|
|||
|
||||
|
||||
```clj
|
||||
(define apa '(1 . 2))
|
||||
(define apa '(42 . 2))
|
||||
(setcar apa 42)
|
||||
apa
|
||||
|
||||
|
|
@ -4819,7 +5119,7 @@ The `setcdr` is a destructive update of the cdr field of a cons-cell.
|
|||
|
||||
|
||||
```clj
|
||||
(define apa '(1 . 2))
|
||||
(define apa '(1 . 42))
|
||||
(setcdr apa 42)
|
||||
apa
|
||||
|
||||
|
|
@ -4941,58 +5241,6 @@ 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>
|
||||
|
||||
|
||||
|
||||
|
||||
---
|
||||
|
||||
|
||||
|
|
@ -5342,7 +5590,7 @@ The `setassoc` function destructively updates a key-value mapping in an alist. T
|
|||
|
||||
|
||||
```clj
|
||||
(define apa (list '(1 . horse) '(2 . donkey) '(3 . shark)))
|
||||
(define apa (list '(1 . horse) '(2 . llama) '(3 . shark)))
|
||||
(setassoc apa 2 'llama)
|
||||
|
||||
```
|
||||
|
|
@ -5844,7 +6092,7 @@ To clear a byte array the function bufclear can be used `(bufclear arr optByte o
|
|||
<td>
|
||||
|
||||
```clj
|
||||
(define data [255 255 255 255 255 255 255 255])
|
||||
(define data [255 170 170 170 170 170 1 1])
|
||||
```
|
||||
|
||||
|
||||
|
|
@ -5852,7 +6100,7 @@ To clear a byte array the function bufclear can be used `(bufclear arr optByte o
|
|||
<td>
|
||||
|
||||
```clj
|
||||
[255 255 255 255 255 255 255 255]
|
||||
[255 170 170 170 170 170 1 1]
|
||||
```
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,36 @@
|
|||
/*
|
||||
Copyright 2022 Joel Svensson svenssonjoel@yahoo.se
|
||||
|
||||
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
|
||||
the Free Software Foundation, either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
/* The set extensions adds a set datatype based upon lists. */
|
||||
|
||||
|
||||
#ifndef SET_EXTENSIONS_H_
|
||||
#define SET_EXTENSIONS_H_
|
||||
|
||||
#include <stdbool.h>
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
bool lbm_set_extensions_init(void);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
|
|
@ -312,7 +312,6 @@
|
|||
#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.
|
||||
|
|
@ -536,6 +535,5 @@
|
|||
#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
|
||||
|
|
|
|||
|
|
@ -23,7 +23,8 @@ LISPBM_SRC = $(LISPBM)/src/env.c \
|
|||
$(LISPBM)/src/extensions/runtime_extensions.c \
|
||||
$(LISPBM)/src/extensions/matvec_extensions.c \
|
||||
$(LISPBM)/src/extensions/random_extensions.c \
|
||||
$(LISPBM)/src/extensions/loop_extensions.c
|
||||
$(LISPBM)/src/extensions/loop_extensions.c \
|
||||
$(LISPBM)/src/extensions/set_extensions.c
|
||||
|
||||
|
||||
LISPBM_INC = -I$(LISPBM)/include \
|
||||
|
|
|
|||
|
|
@ -20,12 +20,18 @@ ifdef HEAP_VIS
|
|||
CCFLAGS += -DVISUALIZE_HEAP
|
||||
endif
|
||||
|
||||
improved_closures: CCFLAGS += -m32 -DCLEAN_UP_CLOSURES
|
||||
improved_closures: repl clean_cl.h
|
||||
|
||||
all: CCFLAGS += -m32
|
||||
all: repl
|
||||
|
||||
all64: CCFLAGS += -DLBM64
|
||||
all64: repl
|
||||
|
||||
clean_cl.h: clean.lisp
|
||||
./repl --store_env="clean_cl.env" --src=clean.lisp --terminate
|
||||
xxd -i clean_cl.env clean_cl.h
|
||||
|
||||
install: all
|
||||
mkdir -p ~/.local/bin
|
||||
|
|
|
|||
|
|
@ -0,0 +1,27 @@
|
|||
|
||||
(define get-vars (lambda (body)
|
||||
(match (type-of body)
|
||||
( type-symbol (set-insert nil body))
|
||||
( type-list (set-union (get-vars (car body)) (get-vars (cdr body))))
|
||||
( _ nil)
|
||||
)))
|
||||
|
||||
(define pick-out (lambda (vars env)
|
||||
(match env
|
||||
( nil nil )
|
||||
( ((? b) . (? bs)) (member vars (car b)) (cons b (pick-out vars bs)))
|
||||
( ( _ . (? bs)) (pick-out vars bs))
|
||||
)))
|
||||
|
||||
(define clean-cl-env (lambda (clo)
|
||||
(setix clo 3 (pick-out (get-vars (ix clo 2))
|
||||
(ix clo 3)))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
150
repl/clean_cl.h
150
repl/clean_cl.h
|
|
@ -1,95 +1,61 @@
|
|||
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,
|
||||
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, 0x6e, 0x69, 0x6c, 0x00, 0x01, 0x03,
|
||||
0x62, 0x6f, 0x64, 0x79, 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
|
||||
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;
|
||||
unsigned int clean_cl_env_len = 689;
|
||||
|
|
|
|||
23
repl/repl.c
23
repl/repl.c
|
|
@ -31,10 +31,6 @@
|
|||
#include "lispbm.h"
|
||||
#include "lbm_flat_value.h"
|
||||
#include "lbm_prof.h"
|
||||
#include "extensions/array_extensions.h"
|
||||
#include "extensions/string_extensions.h"
|
||||
#include "extensions/math_extensions.h"
|
||||
#include "extensions/runtime_extensions.h"
|
||||
|
||||
#include "lbm_custom_type.h"
|
||||
#include "lbm_channel.h"
|
||||
|
|
@ -42,7 +38,9 @@
|
|||
|
||||
#include "repl_exts.h"
|
||||
#include "repl_defines.h"
|
||||
#ifdef CLEAN_UP_CLOSURES
|
||||
#include "clean_cl.h"
|
||||
#endif
|
||||
|
||||
|
||||
#define GC_STACK_SIZE 256
|
||||
|
|
@ -64,7 +62,6 @@ 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);
|
||||
|
|
@ -309,7 +306,6 @@ 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'},
|
||||
|
|
@ -320,7 +316,6 @@ 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 {
|
||||
|
|
@ -386,7 +381,6 @@ 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" \
|
||||
|
|
@ -414,9 +408,6 @@ void parse_opts(int argc, char **argv) {
|
|||
case SILENT_MODE:
|
||||
silent_mode = true;
|
||||
break;
|
||||
case LOAD_LIB_CLEAN_CL:
|
||||
load_lib_clean_cl=true;
|
||||
break;
|
||||
default:
|
||||
break;
|
||||
}
|
||||
|
|
@ -534,12 +525,12 @@ 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;
|
||||
}
|
||||
#ifdef CLEAN_UP_CLOSURES
|
||||
if (!load_flat_library(clean_cl_env, clean_cl_env_len)) {
|
||||
printf("Error loading a flat library\n");
|
||||
return 1;
|
||||
}
|
||||
#endif
|
||||
|
||||
if (pthread_create(&lispbm_thd, NULL, eval_thd_wrapper, NULL)) {
|
||||
printf("Error creating evaluation thread\n");
|
||||
|
|
|
|||
|
|
@ -23,6 +23,11 @@
|
|||
#include <dirent.h>
|
||||
#include <sys/time.h>
|
||||
#include <sys/wait.h>
|
||||
#include "extensions/array_extensions.h"
|
||||
#include "extensions/string_extensions.h"
|
||||
#include "extensions/math_extensions.h"
|
||||
#include "extensions/runtime_extensions.h"
|
||||
#include "extensions/set_extensions.h"
|
||||
|
||||
// Macro expanders
|
||||
|
||||
|
|
@ -556,6 +561,9 @@ int init_exts(void) {
|
|||
if (!lbm_runtime_extensions_init(false)) {
|
||||
return 0;
|
||||
}
|
||||
if (!lbm_set_extensions_init()) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
lbm_add_extension("unsafe-call-system", ext_unsafe_call_system);
|
||||
lbm_add_extension("exec", ext_exec);
|
||||
|
|
|
|||
185
src/eval_cps.c
185
src/eval_cps.c
|
|
@ -539,6 +539,38 @@ static void stack_push_4(lbm_stack_t *s, lbm_uint v1, lbm_uint v2, lbm_uint v3,
|
|||
error_ctx(ENC_SYM_STACK_ERROR);
|
||||
}
|
||||
|
||||
static void stack_push_5(lbm_stack_t *s, lbm_uint v1, lbm_uint v2, lbm_uint v3, lbm_uint v4, lbm_uint v5) {
|
||||
if (s->sp + 4 < s->size) {
|
||||
lbm_uint *t = &s->data[s->sp];
|
||||
t[0] = v1;
|
||||
t[1] = v2;
|
||||
t[2] = v3;
|
||||
t[3] = v4;
|
||||
t[4] = v5;
|
||||
s->sp += 5;
|
||||
if (s->sp > s->max_sp) s->max_sp = s->sp;
|
||||
return;
|
||||
}
|
||||
error_ctx(ENC_SYM_STACK_ERROR);
|
||||
}
|
||||
|
||||
static void stack_push_6(lbm_stack_t *s, lbm_uint v1, lbm_uint v2, lbm_uint v3, lbm_uint v4, lbm_uint v5, lbm_uint v6) {
|
||||
if (s->sp + 5 < s->size) {
|
||||
lbm_uint *t = &s->data[s->sp];
|
||||
t[0] = v1;
|
||||
t[1] = v2;
|
||||
t[2] = v3;
|
||||
t[3] = v4;
|
||||
t[4] = v5;
|
||||
t[5] = v6;
|
||||
s->sp += 6;
|
||||
if (s->sp > s->max_sp) s->max_sp = s->sp;
|
||||
return;
|
||||
}
|
||||
error_ctx(ENC_SYM_STACK_ERROR);
|
||||
}
|
||||
|
||||
|
||||
static void get_car_and_cdr(lbm_value a, lbm_value *a_car, lbm_value *a_cdr) {
|
||||
if (lbm_is_ptr(a)) {
|
||||
lbm_cons_t *cell = lbm_ref_cell(a);
|
||||
|
|
@ -1058,28 +1090,20 @@ static void error_ctx_base(lbm_value err_val, bool has_at, lbm_value at, unsigne
|
|||
lbm_value msg = lbm_cons(err_val, ENC_SYM_NIL);
|
||||
msg = lbm_cons(lbm_enc_i(ctx_running->id), msg);
|
||||
msg = lbm_cons(ENC_SYM_EXIT_ERROR, msg);
|
||||
if (lbm_is_symbol_merror(msg)) {
|
||||
// If this happens something is pretty seriously wrong.
|
||||
print_error_message(err_val,
|
||||
has_at,
|
||||
at,
|
||||
row,
|
||||
column,
|
||||
ctx_running->row0,
|
||||
ctx_running->row1);
|
||||
} else {
|
||||
if (!lbm_is_symbol_merror(msg)) {
|
||||
lbm_find_receiver_and_send(ctx_running->parent, msg);
|
||||
goto error_ctx_base_done;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
print_error_message(err_val,
|
||||
has_at,
|
||||
at,
|
||||
row,
|
||||
column,
|
||||
ctx_running->row0,
|
||||
ctx_running->row1);
|
||||
}
|
||||
print_error_message(err_val,
|
||||
has_at,
|
||||
at,
|
||||
row,
|
||||
column,
|
||||
ctx_running->row0,
|
||||
ctx_running->row1);
|
||||
error_ctx_base_done:
|
||||
ctx_running->r = err_val;
|
||||
finish_ctx();
|
||||
longjmp(error_jmp_buf, 1);
|
||||
|
|
@ -1496,16 +1520,6 @@ static bool match(lbm_value p, lbm_value e, lbm_value *env, bool *gc) {
|
|||
return true;
|
||||
}
|
||||
|
||||
/* Comma-qualification experiment. */
|
||||
if (lbm_is_comma_qualified_symbol(p)) {
|
||||
lbm_value sym = get_cadr(p);
|
||||
lbm_value val = lbm_env_lookup(sym, *env);
|
||||
if (lbm_is_symbol(SYM_NOT_FOUND)) {
|
||||
return false;
|
||||
}
|
||||
return struct_eq(val, e);
|
||||
}
|
||||
|
||||
if (lbm_is_symbol(p)) {
|
||||
if (lbm_dec_sym(p) == SYM_DONTCARE) return true;
|
||||
return (p == e);
|
||||
|
|
@ -1771,7 +1785,19 @@ static void eval_define(eval_context_t *ctx) {
|
|||
static void eval_lambda(eval_context_t *ctx) {
|
||||
lbm_value cdr = get_cdr(ctx->curr_exp);
|
||||
ctx->r = allocate_closure(get_car(cdr), get_cadr(cdr), ctx->curr_env);
|
||||
#ifdef CLEAN_UP_CLOSURES
|
||||
// Todo, lookup once and cache.
|
||||
lbm_uint sym_id = 0;
|
||||
if (lbm_get_symbol_by_name("clean-cl-env", &sym_id)) {
|
||||
lbm_value tail = cons_with_gc(ctx->r, ENC_SYM_NIL, ENC_SYM_NIL);
|
||||
lbm_value app = cons_with_gc(lbm_enc_sym(sym_id), tail, tail);
|
||||
ctx->curr_exp = app;
|
||||
} else {
|
||||
ctx->app_cont = true;
|
||||
}
|
||||
#else
|
||||
ctx->app_cont = true;
|
||||
#endif
|
||||
}
|
||||
|
||||
// (if cond-expr then-expr else-expr)
|
||||
|
|
@ -3618,10 +3644,12 @@ static void cont_read_next_token(eval_context_t *ctx) {
|
|||
case TOKOPENPAR:
|
||||
sptr[0] = ENC_SYM_NIL;
|
||||
sptr[1] = ENC_SYM_NIL;
|
||||
stack_push_2(&ctx->K,
|
||||
stack_push_5(&ctx->K,
|
||||
stream,
|
||||
READ_APPEND_CONTINUE);
|
||||
stack_push_3(&ctx->K, stream, lbm_enc_u(0), READ_NEXT_TOKEN);
|
||||
READ_APPEND_CONTINUE,
|
||||
stream,
|
||||
lbm_enc_u(0),
|
||||
READ_NEXT_TOKEN);
|
||||
ctx->r = ENC_SYM_OPENPAR;
|
||||
return;
|
||||
case TOKCLOSEPAR: {
|
||||
|
|
@ -3678,22 +3706,12 @@ static void cont_read_next_token(eval_context_t *ctx) {
|
|||
lbm_stack_drop(&ctx->K, 2);
|
||||
ctx->r = ENC_SYM_CLOSEPAR;
|
||||
return;
|
||||
case TOKCONSTSTART:
|
||||
ctx->flags |= EVAL_CPS_CONTEXT_FLAG_CONST;
|
||||
sptr[0] = stream;
|
||||
sptr[1] = lbm_enc_u(0);
|
||||
stack_push(&ctx->K, READ_NEXT_TOKEN);
|
||||
ctx->app_cont = true;
|
||||
return;
|
||||
case TOKCONSTSTART: /* fall through */
|
||||
case TOKCONSTEND:
|
||||
ctx->flags &= ~EVAL_CPS_CONTEXT_FLAG_CONST;
|
||||
sptr[0] = stream;
|
||||
sptr[1] = lbm_enc_u(0);
|
||||
stack_push(&ctx->K, READ_NEXT_TOKEN);
|
||||
ctx->app_cont = true;
|
||||
return;
|
||||
case TOKCONSTSYMSTR:
|
||||
ctx->flags |= EVAL_CPS_CONTEXT_FLAG_CONST_SYMBOL_STRINGS;
|
||||
if (match == TOKCONSTSTART) ctx->flags |= EVAL_CPS_CONTEXT_FLAG_CONST;
|
||||
if (match == TOKCONSTEND) ctx->flags &= ~EVAL_CPS_CONTEXT_FLAG_CONST;
|
||||
if (match == TOKCONSTSYMSTR) ctx->flags |= EVAL_CPS_CONTEXT_FLAG_CONST_SYMBOL_STRINGS;
|
||||
sptr[0] = stream;
|
||||
sptr[1] = lbm_enc_u(0);
|
||||
stack_push(&ctx->K, READ_NEXT_TOKEN);
|
||||
|
|
@ -3914,8 +3932,11 @@ static void cont_read_start_array(eval_context_t *ctx) {
|
|||
}
|
||||
|
||||
sptr[0] = array;
|
||||
stack_push_3(&ctx->K, lbm_enc_u(initial_size), lbm_enc_u(0), stream);
|
||||
stack_push(&ctx->K, READ_APPEND_ARRAY);
|
||||
stack_push_4(&ctx->K,
|
||||
lbm_enc_u(initial_size),
|
||||
lbm_enc_u(0),
|
||||
stream,
|
||||
READ_APPEND_ARRAY);
|
||||
ctx->app_cont = true;
|
||||
} else {
|
||||
lbm_channel_reader_close(str);
|
||||
|
|
@ -3990,8 +4011,11 @@ static void cont_read_append_continue(eval_context_t *ctx) {
|
|||
ctx->app_cont = true;
|
||||
return;
|
||||
case SYM_DOT:
|
||||
stack_push(&ctx->K, READ_DOT_TERMINATE);
|
||||
stack_push_3(&ctx->K, stream, lbm_enc_u(0), READ_NEXT_TOKEN);
|
||||
stack_push_4(&ctx->K,
|
||||
READ_DOT_TERMINATE,
|
||||
stream,
|
||||
lbm_enc_u(0),
|
||||
READ_NEXT_TOKEN);
|
||||
ctx->app_cont = true;
|
||||
return;
|
||||
}
|
||||
|
|
@ -4011,8 +4035,11 @@ static void cont_read_append_continue(eval_context_t *ctx) {
|
|||
sptr[0] = first_cell;
|
||||
sptr[1] = last_cell;
|
||||
sptr[2] = stream; // unchanged.
|
||||
stack_push(&ctx->K, READ_APPEND_CONTINUE);
|
||||
stack_push_3(&ctx->K, stream, lbm_enc_u(0), READ_NEXT_TOKEN);
|
||||
stack_push_4(&ctx->K,
|
||||
READ_APPEND_CONTINUE,
|
||||
stream,
|
||||
lbm_enc_u(0),
|
||||
READ_NEXT_TOKEN);
|
||||
ctx->app_cont = true;
|
||||
}
|
||||
|
||||
|
|
@ -4035,15 +4062,23 @@ static void cont_read_eval_continue(eval_context_t *ctx) {
|
|||
ctx->app_cont = true;
|
||||
return;
|
||||
case SYM_DOT:
|
||||
stack_push(&ctx->K, READ_DOT_TERMINATE);
|
||||
stack_push_3(&ctx->K, stream, lbm_enc_u(0), READ_NEXT_TOKEN);
|
||||
stack_push_4(&ctx->K,
|
||||
READ_DOT_TERMINATE,
|
||||
stream,
|
||||
lbm_enc_u(0),
|
||||
READ_NEXT_TOKEN);
|
||||
ctx->app_cont = true;
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
stack_push_3(&ctx->K, stream, env, READ_EVAL_CONTINUE);
|
||||
stack_push_3(&ctx->K, stream, lbm_enc_u(1), READ_NEXT_TOKEN);
|
||||
stack_push_6(&ctx->K,
|
||||
stream,
|
||||
env,
|
||||
READ_EVAL_CONTINUE,
|
||||
stream,
|
||||
lbm_enc_u(1),
|
||||
READ_NEXT_TOKEN);
|
||||
|
||||
ctx->curr_env = env;
|
||||
ctx->curr_exp = ctx->r;
|
||||
|
|
@ -4095,11 +4130,13 @@ static void cont_read_dot_terminate(eval_context_t *ctx) {
|
|||
if (lbm_is_cons(last_cell)) {
|
||||
lbm_set_cdr(last_cell, ctx->r);
|
||||
ctx->r = first_cell;
|
||||
stack_push_3(&ctx->K,
|
||||
stack_push_6(&ctx->K,
|
||||
stream,
|
||||
ctx->r,
|
||||
READ_EXPECT_CLOSEPAR);
|
||||
stack_push_3(&ctx->K, stream, lbm_enc_u(0), READ_NEXT_TOKEN);
|
||||
READ_EXPECT_CLOSEPAR,
|
||||
stream,
|
||||
lbm_enc_u(0),
|
||||
READ_NEXT_TOKEN);
|
||||
ctx->app_cont = true;
|
||||
} else {
|
||||
lbm_channel_reader_close(str);
|
||||
|
|
@ -4379,8 +4416,12 @@ static void cont_move_val_to_flash_dispatch(eval_context_t *ctx) {
|
|||
if (lbm_is_cons(val)) {
|
||||
lbm_value flash_cell = ENC_SYM_NIL;
|
||||
handle_flash_status(request_flash_storage_cell(val, &flash_cell));
|
||||
stack_push_4(&ctx->K, flash_cell, flash_cell, get_cdr(val), MOVE_LIST_TO_FLASH);
|
||||
stack_push(&ctx->K, MOVE_VAL_TO_FLASH_DISPATCH);
|
||||
stack_push_5(&ctx->K,
|
||||
flash_cell,
|
||||
flash_cell,
|
||||
get_cdr(val),
|
||||
MOVE_LIST_TO_FLASH,
|
||||
MOVE_VAL_TO_FLASH_DISPATCH);
|
||||
ctx->r = get_car(val);
|
||||
ctx->app_cont = true;
|
||||
return;
|
||||
|
|
@ -4466,8 +4507,9 @@ static void cont_move_list_to_flash(eval_context_t *ctx) {
|
|||
handle_flash_status(write_const_cdr(lst, rest_cell));
|
||||
sptr[1] = rest_cell;
|
||||
sptr[2] = get_cdr(val);
|
||||
stack_push(&ctx->K, MOVE_LIST_TO_FLASH);
|
||||
stack_push(&ctx->K, MOVE_VAL_TO_FLASH_DISPATCH);
|
||||
stack_push_2(&ctx->K,
|
||||
MOVE_LIST_TO_FLASH,
|
||||
MOVE_VAL_TO_FLASH_DISPATCH);
|
||||
ctx->r = get_car(val);
|
||||
} else {
|
||||
sptr[0] = fst;
|
||||
|
|
@ -4576,9 +4618,10 @@ static void cont_qq_expand(eval_context_t *ctx) {
|
|||
lbm_dec_sym(car_val) == SYM_COMMAAT) {
|
||||
error_ctx(ENC_SYM_RERROR);
|
||||
} else {
|
||||
stack_push_2(&ctx->K, ctx->r, QQ_APPEND);
|
||||
stack_push_2(&ctx->K, cdr_val, QQ_EXPAND);
|
||||
stack_push_2(&ctx->K, car_val, QQ_EXPAND_LIST);
|
||||
stack_push_6(&ctx->K,
|
||||
ctx->r, QQ_APPEND,
|
||||
cdr_val, QQ_EXPAND,
|
||||
car_val, QQ_EXPAND_LIST);
|
||||
ctx->app_cont = true;
|
||||
ctx->r = ENC_SYM_NIL;
|
||||
}
|
||||
|
|
@ -4620,6 +4663,7 @@ static void cont_qq_expand_list(eval_context_t* ctx) {
|
|||
lbm_value l;
|
||||
lbm_pop(&ctx->K, &l);
|
||||
|
||||
ctx->app_cont = true;
|
||||
switch(lbm_type_of(l)) {
|
||||
case LBM_TYPE_CONS: {
|
||||
lbm_value car_val = get_car(l);
|
||||
|
|
@ -4629,19 +4673,17 @@ static void cont_qq_expand_list(eval_context_t* ctx) {
|
|||
lbm_value tl = cons_with_gc(get_car(cdr_val), ENC_SYM_NIL, ENC_SYM_NIL);
|
||||
lbm_value tmp = cons_with_gc(ENC_SYM_LIST, tl, ENC_SYM_NIL);
|
||||
ctx->r = append(ctx->r, tmp);
|
||||
ctx->app_cont = true;
|
||||
return;
|
||||
} else if (lbm_type_of(car_val) == LBM_TYPE_SYMBOL &&
|
||||
lbm_dec_sym(car_val) == SYM_COMMAAT) {
|
||||
ctx->r = get_car(cdr_val);
|
||||
ctx->app_cont = true;
|
||||
return;
|
||||
} else {
|
||||
stack_push(&ctx->K, QQ_LIST);
|
||||
stack_push_2(&ctx->K, ctx->r, QQ_APPEND);
|
||||
stack_push_2(&ctx->K, cdr_val, QQ_EXPAND);
|
||||
stack_push_2(&ctx->K, car_val, QQ_EXPAND_LIST);
|
||||
ctx->app_cont = true;
|
||||
stack_push_6(&ctx->K,
|
||||
ctx->r, QQ_APPEND,
|
||||
cdr_val, QQ_EXPAND,
|
||||
car_val, QQ_EXPAND_LIST);
|
||||
ctx->r = ENC_SYM_NIL;
|
||||
}
|
||||
|
||||
|
|
@ -4651,7 +4693,6 @@ static void cont_qq_expand_list(eval_context_t* ctx) {
|
|||
lbm_value tl = cons_with_gc(a_list, ENC_SYM_NIL, ENC_SYM_NIL);
|
||||
lbm_value tmp = cons_with_gc(ENC_SYM_QUOTE, tl, ENC_SYM_NIL);
|
||||
ctx->r = append(ctx->r, tmp);
|
||||
ctx->app_cont = true;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -0,0 +1,112 @@
|
|||
/*
|
||||
Copyright 2024 Joel Svensson svenssonjoel@yahoo.se
|
||||
|
||||
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
|
||||
the Free Software Foundation, either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
#include "extensions/set_extensions.h"
|
||||
|
||||
#include "extensions.h"
|
||||
#include "fundamental.h"
|
||||
|
||||
#define ABORT_ON_MERROR(X) if ((X) == ENC_SYM_MERROR) return ENC_SYM_MERROR;
|
||||
|
||||
static lbm_value ext_member(lbm_value *args, lbm_uint argn);
|
||||
static lbm_value ext_set_insert(lbm_value *args, lbm_uint argn);
|
||||
static lbm_value ext_set_union(lbm_value *args, lbm_uint argn);
|
||||
|
||||
bool lbm_set_extensions_init(void) {
|
||||
bool res = true;
|
||||
res = res && lbm_add_extension("member", ext_member);
|
||||
res = res && lbm_add_extension("set-insert", ext_set_insert);
|
||||
res = res && lbm_add_extension("set-union", ext_set_union);
|
||||
return res;
|
||||
}
|
||||
|
||||
static lbm_value ext_member(lbm_value *args, lbm_uint argn) {
|
||||
lbm_value res = ENC_SYM_TERROR;
|
||||
if (argn == 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;
|
||||
}
|
||||
|
||||
static lbm_value set_insert(lbm_value set, lbm_value val) {
|
||||
|
||||
lbm_value end = ENC_SYM_NIL;
|
||||
lbm_value start = ENC_SYM_NIL;
|
||||
|
||||
lbm_value curr = set;
|
||||
while (lbm_is_cons(curr)) {
|
||||
lbm_value h = lbm_car(curr);
|
||||
if (struct_eq(lbm_car(curr), val)) {
|
||||
return set;
|
||||
}
|
||||
lbm_value cell = lbm_cons(h, ENC_SYM_NIL);
|
||||
ABORT_ON_MERROR(cell);
|
||||
if (end == ENC_SYM_NIL) {
|
||||
end = cell;
|
||||
start = cell;
|
||||
} else {
|
||||
lbm_set_cdr(end, cell);
|
||||
end = cell;
|
||||
}
|
||||
curr = lbm_cdr(curr);
|
||||
}
|
||||
lbm_value v = lbm_cons(val, ENC_SYM_NIL);
|
||||
ABORT_ON_MERROR(v);
|
||||
if (end == ENC_SYM_NIL) {
|
||||
end = v;
|
||||
start = v;
|
||||
} else {
|
||||
lbm_set_cdr(end, v);
|
||||
end = v;
|
||||
}
|
||||
return start;
|
||||
}
|
||||
|
||||
/* extends a copy of the input set with the new element. */
|
||||
static lbm_value ext_set_insert(lbm_value *args, lbm_uint argn) {
|
||||
lbm_value res = ENC_SYM_TERROR;
|
||||
if (argn == 2 && lbm_is_list(args[0])) {
|
||||
res = set_insert(args[0], args[1]);
|
||||
}
|
||||
return res;
|
||||
}
|
||||
|
||||
|
||||
static lbm_value ext_set_union(lbm_value *args, lbm_uint argn) {
|
||||
lbm_value res = ENC_SYM_TERROR;
|
||||
if (argn == 2 && lbm_is_list(args[0]) && lbm_is_list(args[1])) {
|
||||
lbm_value curr = args[0];
|
||||
lbm_value set = args[1];
|
||||
|
||||
while (lbm_is_cons(curr)) {
|
||||
set = set_insert(set, lbm_car(curr));
|
||||
ABORT_ON_MERROR(set);
|
||||
curr = lbm_cdr(curr);
|
||||
}
|
||||
return set;
|
||||
}
|
||||
return res;
|
||||
}
|
||||
|
|
@ -1317,24 +1317,6 @@ 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,
|
||||
|
|
@ -1394,5 +1376,4 @@ const fundamental_fun fundamental_table[] =
|
|||
fundamental_reg_event_handler,
|
||||
fundamental_take,
|
||||
fundamental_drop,
|
||||
fundamental_member,
|
||||
};
|
||||
|
|
|
|||
|
|
@ -210,7 +210,6 @@ 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},
|
||||
|
|
|
|||
|
|
@ -1,6 +0,0 @@
|
|||
|
||||
|
||||
;; 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))))
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
|
||||
(check (eq nil (member (list 1 2 3) 4)))
|
||||
|
|
@ -1 +0,0 @@
|
|||
(check (eq nil (member '() 1)))
|
||||
Loading…
Reference in New Issue