From 0af11fc9828cba7cbd121f40a3c8058a3e534a26 Mon Sep 17 00:00:00 2001 From: Benjamin Vedder Date: Tue, 1 Feb 2022 20:40:07 +0100 Subject: [PATCH] Squashed 'lispBM/lispBM/' changes from 748477b9..9559204f 9559204f added lbm_define to allow definitions to be added from C d5390ade added a pause function that performs GC if less than N elements are free 9f7f015b mostly just rearrangements 2e96957d bugfix related to read after changes to array representation. New test added that shows a problem with read-program, this is a bit of a puzzle to solve. Something to ponder on for a while aa6bfff9 can read multiple values from array to a list. 8b8daa6d Nothing of magnitude 313806c9 more preparations for lbm arrays pointing to C memory 9b361ba8 preparing for arrays that are shared between C and lbm. Dont know yet what to do about the possibility of concurrent modifications to these arrays 39257a5a doxy fix renamed files 955a5a2c update to doxy, still lots to do. Rename one file. ae0d140f adding some built in functions for encoding and decoding to and from lists of value representing bytes git-subtree-dir: lispBM/lispBM git-subtree-split: 9559204fcfd0b403fdec524910c10d8bd57d0437 --- benchmarks/bench_chibi/Makefile | 2 +- chibios-examples/repl-ChibiOS/Makefile | 3 +- chibios-examples/xmas_dac/Makefile | 3 +- doc/lbmref.dox | 144 +++++++--- include/compression.h | 3 +- include/env.h | 2 +- include/eval_cps.h | 69 ++--- include/extensions.h | 2 +- include/heap.h | 21 +- include/lbm_c_interop.h | 93 +++++++ include/{lispbm_memory.h => lbm_memory.h} | 9 +- include/{lispbm_types.h => lbm_types.h} | 2 +- include/lispbm.h | 5 +- include/prelude.h | 2 +- include/print.h | 3 +- include/stack.h | 2 +- include/streams.h | 2 +- include/symrepr.h | 16 +- include/tokpar.h | 2 +- lispbm.mk | 5 +- src/compression.c | 2 +- src/env.c | 2 +- src/eval_cps.c | 218 ++------------- src/extensions.c | 2 +- src/fundamental.c | 324 ++++++++++++++-------- src/heap.c | 20 +- src/lbm_c_interop.c | 178 ++++++++++++ src/{lispbm_memory.c => lbm_memory.c} | 11 +- src/print.c | 4 +- src/qq_expand.c | 2 +- src/stack.c | 4 +- src/symrepr.c | 23 +- src/tokpar.c | 6 +- tests/test_decode_0.lisp | 2 + tests/test_encode_0.lisp | 1 + tests/test_encode_1.lisp | 1 + tests/test_encode_2.lisp | 1 + tests/test_ix_0.lisp | 1 + tests/test_ix_1.lisp | 1 + tests/test_ix_2.lisp | 2 + tests/test_lisp_code_cps.c | 11 +- tests/test_match_2.lisp | 2 +- tests/test_read_0.lisp | 1 + tests/test_read_1.lisp | 1 + tests/test_read_2.lisp | 4 + 45 files changed, 762 insertions(+), 452 deletions(-) create mode 100644 include/lbm_c_interop.h rename include/{lispbm_memory.h => lbm_memory.h} (96%) rename include/{lispbm_types.h => lbm_types.h} (98%) create mode 100644 src/lbm_c_interop.c rename src/{lispbm_memory.c => lbm_memory.c} (96%) create mode 100644 tests/test_decode_0.lisp create mode 100644 tests/test_encode_0.lisp create mode 100644 tests/test_encode_1.lisp create mode 100644 tests/test_encode_2.lisp create mode 100644 tests/test_ix_0.lisp create mode 100644 tests/test_ix_1.lisp create mode 100644 tests/test_ix_2.lisp create mode 100644 tests/test_read_0.lisp create mode 100644 tests/test_read_1.lisp create mode 100644 tests/test_read_2.lisp diff --git a/benchmarks/bench_chibi/Makefile b/benchmarks/bench_chibi/Makefile index 9652aabb..69604a3d 100644 --- a/benchmarks/bench_chibi/Makefile +++ b/benchmarks/bench_chibi/Makefile @@ -128,7 +128,7 @@ LBMSRC = ../../src/compression.c \ ../../src/extensions.c \ ../../src/fundamental.c \ ../../src/heap.c \ - ../../src/lispbm_memory.c \ + ../../src/lbm_memory.c \ ../../src/prelude.c \ ../../src/print.c \ ../../src/qq_expand.c \ diff --git a/chibios-examples/repl-ChibiOS/Makefile b/chibios-examples/repl-ChibiOS/Makefile index 9652aabb..20fe3027 100644 --- a/chibios-examples/repl-ChibiOS/Makefile +++ b/chibios-examples/repl-ChibiOS/Makefile @@ -128,7 +128,7 @@ LBMSRC = ../../src/compression.c \ ../../src/extensions.c \ ../../src/fundamental.c \ ../../src/heap.c \ - ../../src/lispbm_memory.c \ + ../../src/lbm_memory.c \ ../../src/prelude.c \ ../../src/print.c \ ../../src/qq_expand.c \ @@ -137,6 +137,7 @@ LBMSRC = ../../src/compression.c \ ../../src/symrepr.c \ ../../src/tokpar.c \ ../../src/lispbm.c \ + ../../src/lbm_c_interop.c \ ../../platform/chibios/src/platform_mutex.c CSRC = $(ALLCSRC) \ diff --git a/chibios-examples/xmas_dac/Makefile b/chibios-examples/xmas_dac/Makefile index fd336a56..a9ebbc03 100644 --- a/chibios-examples/xmas_dac/Makefile +++ b/chibios-examples/xmas_dac/Makefile @@ -128,7 +128,7 @@ LBMSRC = ../../src/env.c \ ../../src/extensions.c \ ../../src/fundamental.c \ ../../src/heap.c \ - ../../src/lispbm_memory.c \ + ../../src/lbm_memory.c \ ../../src/prelude.c \ ../../src/print.c \ ../../src/qq_expand.c \ @@ -137,6 +137,7 @@ LBMSRC = ../../src/env.c \ ../../src/symrepr.c \ ../../src/tokpar.c \ ../../src/lispbm.c \ + ../../src/lbm_c_interop.c \ ../../platform/chibios/src/platform_mutex.c CSRC = $(ALLCSRC) \ diff --git a/doc/lbmref.dox b/doc/lbmref.dox index 36949f6b..eb7b402c 100644 --- a/doc/lbmref.dox +++ b/doc/lbmref.dox @@ -397,11 +397,56 @@ The expression above evaluates to 3 with the side effect that the global environ has been extended with the binding (apa 1). +--- + +\section sec_lists Lists + +

car

+ +--- + +

cdr

+ +--- + +

cons

+ +--- + +

list

+ +--- + +

append

+ +--- + +

ix

+ +--- + +

set-car

+ +--- + +

set-cdr

+ + + +\section sec_arrays Arrays + + +

array-read

+ +--- + +

array-write

+ --- \section sec_pattern Pattern-matching -

match

+

match

Pattern-matching is expressed using match. The form of a match expression is (match expr (pat1 expr1) ... (patN exprN)). Pattern-matching compares @@ -451,7 +496,7 @@ An example that evaluates to 19. (match '(orange 17) ((green (? n)) (+ n 1)) ((orange (? n)) (+ n 2)) - ((blue (?n)) (+ n 3))) + ((blue (? n)) (+ n 3))) \endcode --- @@ -543,40 +588,6 @@ An example that evaluates to 19. --- -

car

- ---- - -

cdr

- ---- - -

cons

- ---- - -

list

- ---- - -

append

- - ---- - -

array-read

- - ---- - -

array-write

- ---- - -

array-create

- ---- -

type-of

--- @@ -597,14 +608,6 @@ An example that evaluates to 19. --- -

set-car

- ---- - -

set-cdr

- ---- -

is-fundamental

--- @@ -711,4 +714,55 @@ An example that evaluates to 19.

sym_nonsense

--- -*/ \ No newline at end of file + +\section sec_low_level Low level operations + +

encode-i32

+ +--- + +

encode-u32

+ +--- + +

encode-float

+ +--- + +

decode

+ +--- + + +*/ + + + + + +

array-create

+ +--- + + +\section sec_streams Streams + +

stream-get

+ +--- + +

stream-more

+ +--- + +

stream-peek

+ +--- + +

stream-drop

+ +--- + +

stream-put

+ +--- diff --git a/include/compression.h b/include/compression.h index 495d0c9e..9d5bd8d0 100644 --- a/include/compression.h +++ b/include/compression.h @@ -21,7 +21,8 @@ #include #include -#include "lispbm_types.h" + +#include "lbm_types.h" typedef struct { uint32_t compressed_bits; diff --git a/include/env.h b/include/env.h index 46ed06fe..884254b7 100644 --- a/include/env.h +++ b/include/env.h @@ -19,7 +19,7 @@ #ifndef ENV_H_ #define ENV_H_ -#include "lispbm_types.h" +#include "lbm_types.h" //environment interface /** Initialize the global environment. This sets the global environment to NIL diff --git a/include/eval_cps.h b/include/eval_cps.h index 95195f13..aa50aa22 100644 --- a/include/eval_cps.h +++ b/include/eval_cps.h @@ -18,8 +18,8 @@ #ifndef EVAL_CPS_H_ #define EVAL_CPS_H_ +#include "lbm_types.h" #include "stack.h" -#include "lispbm_types.h" #define EVAL_CPS_STATE_INIT 0 #define EVAL_CPS_STATE_PAUSED 1 @@ -111,6 +111,11 @@ extern void lbm_run_eval(void); * return value EVAL_CPS_STATE_PAUSED. */ extern void lbm_pause_eval(void); +/** Pause the evaluator and perform GC if needed. + * + * \param num_free Perform GC if there are less than this many elements free on the heap. + */ +extern void lbm_pause_eval_with_gc(uint32_t num_free); /** Perform a single step of evaluation. * The evaluator should be in EVAL_CPS_STATE_PAUSED before running this function. * After taking one step of evaluation, the evaluator will return to being in the @@ -131,6 +136,15 @@ extern void lbm_kill_eval(void); */ extern uint32_t lbm_get_eval_state(void); +/** Create a context and enqueue it as runnable. + * + * \param program The program to evaluate in the context. + * \param env An initial environment. + * \param stack_size Stack size for the context. + * \return + */ +extern lbm_cid lbm_create_ctx(lbm_value program, lbm_value env, uint32_t stack_size); + /* statistics interface */ /** Iterate over all ready contexts and apply function on each context. * @@ -176,54 +190,19 @@ extern void lbm_set_timestamp_us_callback(uint32_t (*fptr)(void)); */ extern void lbm_set_ctx_done_callback(void (*fptr)(eval_context_t *)); -/* loading of programs interface */ -/** Load and schedule a program for execution. +/** Create a token stream for parsing for code * - * \param tokenizer The tokenizer to read the program from. - * \return A context id on success or 0 on failure. + * \param str character stream to convert into a token stream. + * \return token stream. */ -extern lbm_cid lbm_load_and_eval_program(lbm_tokenizer_char_stream_t *tokenizer); -/** Load and schedule an expression for execution. - * - * \param tokenizer The tokenizer to read the expression from. - * \return A context id on success or 0 on failure. - */ -extern lbm_cid lbm_load_and_eval_expression(lbm_tokenizer_char_stream_t *tokenizer); -/** Load a program and bind it to a symbol in the environment. - * - * \param tokenizer The tokenizer to read the program from. - * \param symbol A string with the name you want the binding to have in the environment. - * \return A context id on success or 0 on failure. - */ -extern lbm_cid lbm_load_and_define_program(lbm_tokenizer_char_stream_t *tokenizer, char *symbol); -/** Load an expression and bind it to a symbol in the environment. - * - * \param tokenizer The tokenizer to read the expression from. - * \param symbol A string with the name you want the binding to have in the environment. - * \return A context id on success or 0 on failure. - */ -extern lbm_cid lbm_load_and_define_expression(lbm_tokenizer_char_stream_t *tokenizer, char *symbol); +extern lbm_value lbm_create_token_stream(lbm_tokenizer_char_stream_t *str); -/* Evaluating a definition in a new context */ -/** Create a context for a bound expression and schedule it for execution +/** deliver a message * - * \param symbol The name of the binding to schedule for execution. - * \return A context if on success or 0 on failure. + * \param cid Process to deliver to. + * \param msg Message to deliver + * \return lbm_enc_sym(SYM_NIL) on failure and lbm_enc_sym(SYM_TRUE) on success. */ -extern lbm_cid lbm_eval_defined_expression(char *symbol); -/** Create a context for a bound program and schedule it for execution - * - * \param symbol The name of the binding to schedule for execution. - * \return A context if on success or 0 on failure. - */ -extern lbm_cid lbm_eval_defined_program(char *symbol); +lbm_value lbm_find_receiver_and_send(lbm_cid cid, lbm_value msg); -/* send message from c to LBM process */ -/** Send a message to a process running in the evaluator. - * - * \param cid Context id of the process to send a message to. - * \param msg lbm_value that will be sent to the process. - * \return 1 on success or 0 on failure. - */ -extern int lbm_send_message(lbm_cid cid, lbm_value msg); #endif diff --git a/include/extensions.h b/include/extensions.h index 453be276..6cde14cf 100644 --- a/include/extensions.h +++ b/include/extensions.h @@ -22,7 +22,7 @@ #include "symrepr.h" #include "heap.h" -#include "lispbm_types.h" +#include "lbm_types.h" /** Type representing an extension function. * \param Pointer to array of lbm_values. diff --git a/include/heap.h b/include/heap.h index 62808888..cfa56447 100644 --- a/include/heap.h +++ b/include/heap.h @@ -20,7 +20,8 @@ #define HEAP_H_ #include -#include "lispbm_types.h" + +#include "lbm_types.h" #include "symrepr.h" #include "streams.h" @@ -205,11 +206,12 @@ Aux bits could be used for storing vector size. Up to 30bits should be available #define LBM_VAL_MASK 0xFFFFFFF0u #define LBM_VAL_TYPE_MASK 0x0000000Cu - // gc ptr + // gc ptr #define LBM_VAL_TYPE_SYMBOL 0x00000000u // 00 0 0 +/// Character or byte. #define LBM_VAL_TYPE_CHAR 0x00000004u // 01 0 0 -#define LBM_VAL_TYPE_U 0x00000008u // 11 0 0 -#define LBM_VAL_TYPE_I 0x0000000Cu // 10 0 0 +#define LBM_VAL_TYPE_U 0x00000008u // 10 0 0 +#define LBM_VAL_TYPE_I 0x0000000Cu // 11 0 0 /** Struct representing a heap cons-cell. * @@ -247,8 +249,9 @@ typedef struct { * The header portion of an array stored in array and symbol memory. */ typedef struct { - lbm_type elt_type; // Type of elements: VAL_TYPE_FLOAT, U, I or CHAR - uint32_t size; // Number of elements + lbm_type elt_type; /// Type of elements: VAL_TYPE_FLOAT, U, I or CHAR + uint32_t size; /// Number of elements + uint32_t *data; /// pointer to lbm_memory array or C array. } lbm_array_header_t; /** Initialize heap storage. @@ -557,11 +560,17 @@ static inline bool lbm_is_number(lbm_value x) { lbm_uint t = lbm_type_of(x); return ((t == LBM_VAL_TYPE_I) || (t == LBM_VAL_TYPE_U) || + (t == LBM_VAL_TYPE_CHAR) || (t == LBM_PTR_TYPE_BOXED_I) || (t == LBM_PTR_TYPE_BOXED_U) || (t == LBM_PTR_TYPE_BOXED_F)); } +static inline bool lbm_is_char(lbm_value x) { + lbm_uint t = lbm_type_of(x); + return (t == LBM_VAL_TYPE_CHAR); +} + static inline bool lbm_is_special(lbm_value symrep) { return ((lbm_type_of(symrep) == LBM_VAL_TYPE_SYMBOL) && (lbm_dec_sym(symrep) < MAX_SPECIAL_SYMBOLS)); diff --git a/include/lbm_c_interop.h b/include/lbm_c_interop.h new file mode 100644 index 00000000..397dfc5c --- /dev/null +++ b/include/lbm_c_interop.h @@ -0,0 +1,93 @@ +/* + Copyright 2018, 2020, 2021, 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 . +*/ + +/** \file lbm_c_interop.h */ + +#ifndef LBM_C_INTEROP_H_ +#define LBM_C_INTEROP_H_ + +#include "env.h" +#include "symrepr.h" +#include "eval_cps.h" +#include "heap.h" +#include "streams.h" +#include "tokpar.h" +#include "lbm_memory.h" +#include "heap.h" +#include "lbm_types.h" + + +/** Load and schedule a program for execution. + * + * \param tokenizer The tokenizer to read the program from. + * \return A context id on success or 0 on failure. + */ +extern lbm_cid lbm_load_and_eval_program(lbm_tokenizer_char_stream_t *tokenizer); +/** Load and schedule an expression for execution. + * + * \param tokenizer The tokenizer to read the expression from. + * \return A context id on success or 0 on failure. + */ +extern lbm_cid lbm_load_and_eval_expression(lbm_tokenizer_char_stream_t *tokenizer); +/** Load a program and bind it to a symbol in the environment. + * + * \param tokenizer The tokenizer to read the program from. + * \param symbol A string with the name you want the binding to have in the environment. + * \return A context id on success or 0 on failure. + */ +extern lbm_cid lbm_load_and_define_program(lbm_tokenizer_char_stream_t *tokenizer, char *symbol); +/** Load an expression and bind it to a symbol in the environment. + * + * \param tokenizer The tokenizer to read the expression from. + * \param symbol A string with the name you want the binding to have in the environment. + * \return A context id on success or 0 on failure. + */ +extern lbm_cid lbm_load_and_define_expression(lbm_tokenizer_char_stream_t *tokenizer, char *symbol); + +/* Evaluating a definition in a new context */ +/** Create a context for a bound expression and schedule it for execution + * + * \param symbol The name of the binding to schedule for execution. + * \return A context if on success or 0 on failure. + */ +extern lbm_cid lbm_eval_defined_expression(char *symbol); +/** Create a context for a bound program and schedule it for execution + * + * \param symbol The name of the binding to schedule for execution. + * \return A context if on success or 0 on failure. + */ +extern lbm_cid lbm_eval_defined_program(char *symbol); + +/** Send a message to a process running in the evaluator. + * + * \param cid Context id of the process to send a message to. + * \param msg lbm_value that will be sent to the process. + * \return 1 on success or 0 on failure. + */ +extern int lbm_send_message(lbm_cid cid, lbm_value msg); + +/** Add a definition to the global environment + * + * \param symbol Name to bind the data to. + * \param value The data. + * \return 1 on success and 0 on failure. + */ +extern int lbm_define(char *symbol, lbm_value value); + + + +#endif diff --git a/include/lispbm_memory.h b/include/lbm_memory.h similarity index 96% rename from include/lispbm_memory.h rename to include/lbm_memory.h index b9d994de..c4938340 100644 --- a/include/lispbm_memory.h +++ b/include/lbm_memory.h @@ -1,4 +1,4 @@ -/** \file lispbm_memory.h */ +/** \file lbm_memory.h */ /* Copyright 2020, 2022 Joel Svensson svenssonjoel@yahoo.se @@ -133,4 +133,11 @@ extern uint32_t *lbm_memory_allocate(uint32_t num_words); */ extern int lbm_memory_free(uint32_t *ptr); +/** Check if a pointer points into the lbm_memory + * + * \param ptr + * \return 1 for yes and 0 for no. + */ +extern int lbm_memory_ptr_inside(uint32_t *ptr); + #endif diff --git a/include/lispbm_types.h b/include/lbm_types.h similarity index 98% rename from include/lispbm_types.h rename to include/lbm_types.h index 540b8019..a45574b9 100644 --- a/include/lispbm_types.h +++ b/include/lbm_types.h @@ -1,4 +1,4 @@ -/** \file lispbm_types.h */ +/** \file lbm_types.h */ /* Copyright 2019 Joel Svensson svenssonjoel@yahoo.se diff --git a/include/lispbm.h b/include/lispbm.h index 5ffa390e..15fbfa01 100644 --- a/include/lispbm.h +++ b/include/lispbm.h @@ -27,10 +27,11 @@ #include "print.h" #include "tokpar.h" #include "prelude.h" -#include "lispbm_types.h" -#include "lispbm_memory.h" #include "env.h" #include "compression.h" +#include "lbm_memory.h" +#include "lbm_types.h" +#include "lbm_c_interop.h" /** Initialize lispBM. This function initials all subsystems by calling: * - \ref lbm_memory_init diff --git a/include/prelude.h b/include/prelude.h index 0a1a91b9..5e063226 100644 --- a/include/prelude.h +++ b/include/prelude.h @@ -19,7 +19,7 @@ #ifndef _PRELUDE_H_ #define _PRELUDE_H_ -#include "lispbm_types.h" +#include "lbm_types.h" /** Creates the tokenizer state needed to load the prelude library into the heap. * diff --git a/include/print.h b/include/print.h index d8930dd7..f979dfca 100644 --- a/include/print.h +++ b/include/print.h @@ -21,7 +21,8 @@ #define PRINT_H_ #include -#include "lispbm_types.h" + +#include "lbm_types.h" /** Print an lbm_value into a buffer provided by the user. * If printing fails, the buffer may contain an error message. diff --git a/include/stack.h b/include/stack.h index 26f74b55..847046a5 100644 --- a/include/stack.h +++ b/include/stack.h @@ -24,7 +24,7 @@ #include #include -#include "lispbm_types.h" +#include "lbm_types.h" typedef struct { lbm_uint* data; diff --git a/include/streams.h b/include/streams.h index 9ae35903..7ddd04eb 100644 --- a/include/streams.h +++ b/include/streams.h @@ -24,7 +24,7 @@ #ifndef STREAMS_H_ #define STREAMS_H_ -#include "lispbm_types.h" +#include "lbm_types.h" typedef struct lbm_stream_s{ void *state; /* stream implementation dependent state */ diff --git a/include/symrepr.h b/include/symrepr.h index c9cf62ad..47500793 100644 --- a/include/symrepr.h +++ b/include/symrepr.h @@ -31,7 +31,7 @@ #include #include -#include "lispbm_types.h" +#include "lbm_types.h" // Default and fixed symbol ids #define SYM_NIL 0x0 @@ -125,7 +125,7 @@ #define SYM_ARRAY_READ 0x130 #define SYM_ARRAY_WRITE 0x131 -#define SYM_ARRAY_CREATE 0x132 +//#define SYM_ARRAY_CREATE 0x132 #define SYM_SYMBOL_TO_STRING 0x140 #define SYM_STRING_TO_SYMBOL 0x141 @@ -136,6 +136,18 @@ #define SYM_IS_FUNDAMENTAL 0x150 +#define SYM_IX 0x151 +#define SYM_ENCODE_I32 0x152 +#define SYM_ENCODE_U32 0x153 +#define SYM_ENCODE_FLOAT 0x154 +#define SYM_DECODE 0x155 + +//#define SYM_STREAM_GET 0x160 +//#define SYM_STREAM_MORE 0x161 +//#define SYM_STREAM_PEEK 0x162 +//#define SYM_STREAM_DROP 0x163 +//#define SYM_STREAM_PUT 0x164 + #define SYM_TYPE_OF 0x200 #define FUNDAMENTALS_END 0x200 diff --git a/include/tokpar.h b/include/tokpar.h index 79e1a8fd..7cc74985 100644 --- a/include/tokpar.h +++ b/include/tokpar.h @@ -19,7 +19,7 @@ #ifndef TOKPAR_H_ #define TOKPAR_H_ -#include "lispbm_types.h" +#include "lbm_types.h" /** * State struct for the string tokenizer. diff --git a/lispbm.mk b/lispbm.mk index aae01067..434dfd9f 100644 --- a/lispbm.mk +++ b/lispbm.mk @@ -3,7 +3,7 @@ first_rule: all LISPBM_SRC = $(LISPBM)/src/env.c \ $(LISPBM)/src/fundamental.c \ $(LISPBM)/src/heap.c \ - $(LISPBM)/src/lispbm_memory.c \ + $(LISPBM)/src/lbm_memory.c \ $(LISPBM)/src/print.c \ $(LISPBM)/src/qq_expand.c \ $(LISPBM)/src/stack.c \ @@ -14,7 +14,8 @@ LISPBM_SRC = $(LISPBM)/src/env.c \ $(LISPBM)/src/extensions.c \ $(LISPBM)/src/lispbm.c \ $(LISPBM)/src/eval_cps.c \ - $(LISPBM)/src/streams.c + $(LISPBM)/src/streams.c \ + $(LISPBM)/src/lbm_c_interop.c LISPBM_INC = -I$(LISPBM)/include \ -I$(LISPBM)/src diff --git a/src/compression.c b/src/compression.c index 543169b0..2c9735d4 100644 --- a/src/compression.c +++ b/src/compression.c @@ -17,12 +17,12 @@ #include #include +#include #include #include #include #include "compression.h" -#include "lispbm_types.h" #include "tokpar.h" #define KEY 0 diff --git a/src/env.c b/src/env.c index 6e47df79..0f44498c 100644 --- a/src/env.c +++ b/src/env.c @@ -15,12 +15,12 @@ along with this program. If not, see . */ +#include #include #include "symrepr.h" #include "heap.h" #include "print.h" -#include "lispbm_types.h" lbm_value env_global; diff --git a/src/eval_cps.c b/src/eval_cps.c index a88b3d00..f8a086d5 100644 --- a/src/eval_cps.c +++ b/src/eval_cps.c @@ -15,6 +15,8 @@ along with this program. If not, see . */ +#include +#include #include "symrepr.h" #include "heap.h" #include "env.h" @@ -22,10 +24,8 @@ #include "stack.h" #include "fundamental.h" #include "extensions.h" -#include "lispbm_types.h" #include "exp_kind.h" #include "streams.h" -#include "lispbm_memory.h" #include "tokpar.h" #include "qq_expand.h" @@ -113,6 +113,7 @@ static lbm_value cons_with_gc(lbm_value head, lbm_value tail, lbm_value remember static uint32_t eval_cps_run_state = EVAL_CPS_STATE_INIT; volatile uint32_t eval_cps_next_state = EVAL_CPS_STATE_INIT; +volatile uint32_t eval_cps_next_state_arg = 0; /* On ChibiOs the CH_CFG_ST_FREQUENCY setting in chconf.h sets the @@ -195,7 +196,7 @@ static lbm_value token_stream_put(lbm_stream_t *str, lbm_value v){ return lbm_enc_sym(SYM_NIL); } -lbm_value eval_cps_create_token_stream(lbm_tokenizer_char_stream_t *str) { +lbm_value lbm_create_token_stream(lbm_tokenizer_char_stream_t *str) { lbm_stream_t *stream; @@ -244,8 +245,8 @@ lbm_value token_stream_from_string_value(lbm_value s) { } lbm_create_char_stream_from_string(tok_stream_state, - tok_stream, - str); + tok_stream, + str); stream->state = (void*)tok_stream; stream->more = token_stream_more; @@ -488,7 +489,7 @@ static void yield_ctx(uint32_t sleep_us) { ctx_running = NULL; } -static lbm_cid create_ctx(lbm_value program, lbm_value env, uint32_t stack_size) { +lbm_cid lbm_create_ctx(lbm_value program, lbm_value env, uint32_t stack_size) { if (next_ctx_id == 0) return 0; // overflow of CIDs @@ -546,7 +547,7 @@ static void advance_ctx(void) { } } -static lbm_value find_receiver_and_send(lbm_cid cid, lbm_value msg) { +lbm_value lbm_find_receiver_and_send(lbm_cid cid, lbm_value msg) { eval_context_t *found = NULL; found = lookup_ctx(&blocked, cid); @@ -818,7 +819,7 @@ static inline void eval_symbol(eval_context_t *ctx) { if (lbm_is_special(ctx->curr_exp) || (lbm_get_extension(lbm_dec_sym(ctx->curr_exp)) != NULL)) { - // Special symbols and extension symbols evaluate to themself + // Special symbols and extension symbols evaluate to themselves value = ctx->curr_exp; } else { // If not special, check if there is a binding in the environments @@ -1008,7 +1009,7 @@ static inline void eval_match(eval_context_t *ctx) { rest == NIL) { /* Someone wrote the program (match) */ ctx->app_cont = true; - ctx->r = lbm_enc_sym(SYM_NIL); /* make up new specific symbol? */ + ctx->r = lbm_enc_sym(SYM_NIL); return; } else { CHECK_STACK(lbm_push_u32_2(&ctx->K, lbm_cdr(rest), lbm_enc_u(MATCH))); @@ -1064,12 +1065,6 @@ static inline void eval_receive(eval_context_t *ctx) { ctx_running = NULL; ctx->r = lbm_enc_sym(SYM_NO_MATCH); } - - /* Match messages on mailbox against the patterns */ - /* FATAL_ON_FAIL(ctx->done, push_u32_4(&ctx->K, ctx->curr_exp, car(cdr(pats)), cdr(msgs), enc_u(MATCH_MANY))); */ - /* FATAL_ON_FAIL(ctx->done, push_u32_2(&ctx->K, car(cdr(pats)), enc_u(MATCH))); */ - /* ctx->r = car(msgs); */ - /* ctx->app_cont = true; */ } } return; @@ -1135,7 +1130,7 @@ static inline void cont_spawn_all(eval_context_t *ctx) { lbm_value cid_list; WITH_GC(cid_list, lbm_cons(cid_val, ctx->r), rest, env); - lbm_cid cid = create_ctx(lbm_car(rest), + lbm_cid cid = lbm_create_ctx(lbm_car(rest), env, EVAL_CPS_DEFAULT_STACK_SIZE); if (!cid) { @@ -1299,7 +1294,7 @@ static inline void cont_application(eval_context_t *ctx) { lbm_cid cid = (lbm_cid)lbm_dec_u(fun_args[1]); lbm_value msg = fun_args[2]; - WITH_GC(status, find_receiver_and_send(cid, msg), NIL, NIL); + WITH_GC(status, lbm_find_receiver_and_send(cid, msg), NIL, NIL); } } /* return the status */ @@ -1889,10 +1884,17 @@ static void evaluation_step(void){ return; } -void lbm_pause_eval(void) { +void lbm_pause_eval(void ) { + eval_cps_next_state_arg = 0; eval_cps_next_state = EVAL_CPS_STATE_PAUSED; } +void lbm_pause_eval_with_gc(uint32_t num_free) { + eval_cps_next_state_arg = num_free; + eval_cps_next_state = EVAL_CPS_STATE_PAUSED; +} + + void lbm_step_eval(void) { eval_cps_next_state = EVAL_CPS_STATE_STEP; } @@ -1917,6 +1919,7 @@ void lbm_run_eval(void){ while (eval_running) { + uint32_t prev_state = eval_cps_run_state; eval_cps_run_state = eval_cps_next_state; switch (eval_cps_run_state) { @@ -1927,6 +1930,12 @@ void lbm_run_eval(void){ eval_cps_next_state = EVAL_CPS_STATE_PAUSED; break; case EVAL_CPS_STATE_PAUSED: + if (prev_state != EVAL_CPS_STATE_PAUSED) { + if (lbm_heap_num_free() < eval_cps_next_state_arg) { + gc(NIL, NIL); + } + eval_cps_next_state_arg = 0; + } eval_cps_next_state = EVAL_CPS_STATE_PAUSED; usleep_callback(EVAL_CPS_MIN_SLEEP); continue; /* jump back to start of eval_running loop */ @@ -1977,11 +1986,11 @@ lbm_value evaluate_non_concurrent(void) { } lbm_cid lbm_eval_program(lbm_value lisp) { - return create_ctx(lisp, NIL, 256); + return lbm_create_ctx(lisp, NIL, 256); } lbm_cid lbm_eval_program_ext(lbm_value lisp, unsigned int stack_size) { - return create_ctx(lisp, NIL, stack_size); + return lbm_create_ctx(lisp, NIL, stack_size); } int lbm_eval_init() { @@ -2014,172 +2023,3 @@ int lbm_eval_init() { return res; } -/****************************************************/ -/* Interface for loading and running programs and */ -/* expressions */ - -static lbm_cid eval_cps_load_and_eval(lbm_tokenizer_char_stream_t *tokenizer, bool program) { - - lbm_stream_t *stream = NULL; - - stream = (lbm_stream_t*)lbm_memory_allocate(sizeof(lbm_stream_t) / 4); - if (stream == NULL) { - return 0; // No valid CID is 0 - } - - stream->state = (void*)tokenizer; - stream->more = token_stream_more; - stream->get = token_stream_get; - stream->peek = token_stream_peek; - stream->drop = token_stream_drop; - stream->put = token_stream_put; - - lbm_value lisp_stream = lbm_stream_create(stream); - - if (lbm_type_of(lisp_stream) == LBM_VAL_TYPE_SYMBOL) { - lbm_memory_free((uint32_t*)stream); - return 0; - } - - /* LISP ZONE */ - - lbm_value launcher = lbm_cons(lisp_stream, NIL); - launcher = lbm_cons(lbm_enc_sym(program ? SYM_READ_PROGRAM : SYM_READ), launcher); - lbm_value evaluator = lbm_cons(launcher, NIL); - evaluator = lbm_cons(lbm_enc_sym(program ? SYM_EVAL_PROGRAM : SYM_EVAL), evaluator); - lbm_value start_prg = lbm_cons(evaluator, NIL); - - /* LISP ZONE ENDS */ - - if (lbm_type_of(launcher) != LBM_PTR_TYPE_CONS || - lbm_type_of(evaluator) != LBM_PTR_TYPE_CONS || - lbm_type_of(start_prg) != LBM_PTR_TYPE_CONS ) { - lbm_memory_free((uint32_t*)stream); - return 0; - } - return create_ctx(start_prg, NIL, 256); -} - -lbm_cid lbm_load_and_eval_expression(lbm_tokenizer_char_stream_t *tokenizer) { - return eval_cps_load_and_eval(tokenizer, false); -} - -static lbm_cid eval_cps_load_and_define(lbm_tokenizer_char_stream_t *tokenizer, char *symbol, bool program) { - - lbm_stream_t *stream = NULL; - - stream = (lbm_stream_t*)lbm_memory_allocate(sizeof(lbm_stream_t) / 4); - if (stream == NULL) { - return 0; // No valid CID is 0 - } - - stream->state = (void*)tokenizer; - stream->more = token_stream_more; - stream->get = token_stream_get; - stream->peek = token_stream_peek; - stream->drop = token_stream_drop; - stream->put = token_stream_put; - - lbm_value lisp_stream = lbm_stream_create(stream); - - if (lbm_type_of(lisp_stream) == LBM_VAL_TYPE_SYMBOL) { - lbm_memory_free((uint32_t*)stream); - return 0; - } - - lbm_uint sym_id; - - if (!lbm_get_symbol_by_name(symbol, &sym_id)) { - if (!lbm_add_symbol(symbol, &sym_id)) { - lbm_memory_free((uint32_t*)stream); - return 0; - } - } - - /* LISP ZONE */ - - lbm_value launcher = lbm_cons(lisp_stream, NIL); - launcher = lbm_cons(lbm_enc_sym(program ? SYM_READ_PROGRAM : SYM_READ), launcher); - lbm_value binding = lbm_cons(launcher, NIL); - binding = lbm_cons(lbm_enc_sym(sym_id), binding); - lbm_value definer = lbm_cons(lbm_enc_sym(SYM_DEFINE), binding); - definer = lbm_cons(definer, NIL); - /* LISP ZONE ENDS */ - - if (lbm_type_of(launcher) != LBM_PTR_TYPE_CONS || - lbm_type_of(binding) != LBM_PTR_TYPE_CONS || - lbm_type_of(definer) != LBM_PTR_TYPE_CONS ) { - lbm_memory_free((uint32_t*)stream); - return 0; - } - return create_ctx(definer, NIL, 256); -} - - -lbm_cid lbm_load_and_define_program(lbm_tokenizer_char_stream_t *tokenizer, char *symbol) { - return eval_cps_load_and_define(tokenizer, symbol, true); -} - -lbm_cid lbm_load_and_define_expression(lbm_tokenizer_char_stream_t *tokenizer, char *symbol) { - return eval_cps_load_and_define(tokenizer, symbol, false); -} - -lbm_cid lbm_load_and_eval_program(lbm_tokenizer_char_stream_t *tokenizer) { - return eval_cps_load_and_eval(tokenizer, true); -} - -static lbm_cid lbm_eval_defined(char *symbol, bool program) { - - lbm_uint sym_id; - - if(!lbm_get_symbol_by_name(symbol, &sym_id)) { - // The symbol does not exist, so it cannot be defined - return 0; - } - - lbm_value binding = lbm_env_lookup(lbm_enc_sym(sym_id), *lbm_get_env_ptr()); - - if (lbm_type_of(binding) == LBM_VAL_TYPE_SYMBOL && - lbm_dec_sym(binding) == SYM_NOT_FOUND) { - return 0; - } - - /* LISP ZONE */ - - lbm_value launcher = lbm_cons(lbm_enc_sym(sym_id), NIL); - lbm_value evaluator = launcher; - evaluator = lbm_cons(lbm_enc_sym(program ? SYM_EVAL_PROGRAM : SYM_EVAL), evaluator); - lbm_value start_prg = lbm_cons(evaluator, NIL); - - /* LISP ZONE ENDS */ - - if (lbm_type_of(launcher) != LBM_PTR_TYPE_CONS || - lbm_type_of(evaluator) != LBM_PTR_TYPE_CONS || - lbm_type_of(start_prg) != LBM_PTR_TYPE_CONS ) { - return 0; - } - return create_ctx(start_prg, NIL, 256); -} - -lbm_cid lbm_eval_defined_expression(char *symbol) { - return lbm_eval_defined(symbol, false); -} - -lbm_cid lbm_eval_defined_program(char *symbol) { - return lbm_eval_defined(symbol, true); -} - -int lbm_send_message(lbm_cid cid, lbm_value msg) { - int res = 0; - - if (lbm_get_eval_state() == EVAL_CPS_STATE_PAUSED) { - - lbm_value v = find_receiver_and_send(cid, msg); - - if (lbm_type_of(v) == LBM_VAL_TYPE_SYMBOL && - lbm_dec_sym(v) == SYM_TRUE) { - res = 1; - } - } - return res; -} diff --git a/src/extensions.c b/src/extensions.c index aadd4e11..c19d90c6 100644 --- a/src/extensions.c +++ b/src/extensions.c @@ -16,12 +16,12 @@ along with this program. If not, see . */ +#include #include #include #include #include -#include "lispbm_memory.h" #include "extensions.h" #define SYM 0 diff --git a/src/fundamental.c b/src/fundamental.c index 508ca857..01aad411 100644 --- a/src/fundamental.c +++ b/src/fundamental.c @@ -16,12 +16,12 @@ along with this program. If not, see . */ +#include #include "symrepr.h" #include "stack.h" #include "heap.h" #include "eval_cps.h" #include "print.h" - #include #include @@ -167,17 +167,17 @@ static bool array_equality(lbm_value a, lbm_value b) { switch(a_->elt_type) { case LBM_VAL_TYPE_U: case LBM_PTR_TYPE_BOXED_U: - if (memcmp((char*)a_+8, (char*)b_+8, a_->size * sizeof(lbm_uint)) == 0) return true; + if (memcmp((char*)a_->data, (char*)b_->data, a_->size * sizeof(lbm_uint)) == 0) return true; break; case LBM_VAL_TYPE_I: case LBM_PTR_TYPE_BOXED_I: - if (memcmp((char*)a_+8, (char*)b_+8, a_->size * sizeof(lbm_int)) == 0) return true; + if (memcmp((char*)a_->data, (char*)b_->data, a_->size * sizeof(lbm_int)) == 0) return true; break; case LBM_VAL_TYPE_CHAR: - if (memcmp((char*)a_+8, (char*)b_+8, a_->size) == 0) return true; + if (memcmp((char*)a_->data, (char*)b_->data, a_->size) == 0) return true; break; case LBM_PTR_TYPE_BOXED_F: - if (memcmp((char*)a_+8, (char*)b_+8, a_->size * sizeof(lbm_float)) == 0) return true; + if (memcmp((char*)a_->data, (char*)b_->data, a_->size * sizeof(lbm_float)) == 0) return true; break; default: break; @@ -270,83 +270,89 @@ static int compare(lbm_uint a, lbm_uint b) { void array_read(lbm_value *args, lbm_uint nargs, lbm_uint *result) { (void) nargs; + if (nargs < 2) return; // Args are: array, index lbm_value arr = args[0]; lbm_value index = args[1]; + lbm_value index_end = index; + lbm_value acc = lbm_enc_sym(SYM_NIL); + lbm_value curr = lbm_enc_sym(SYM_EERROR); + bool read_many = false; + + if (nargs > 2) { + index_end = args[2]; + read_many = true; + } // Get array index lbm_uint ix; - lbm_int tmp; + lbm_uint ix_end; - *result = lbm_enc_sym(SYM_EERROR); - switch (lbm_type_of(index)) { - case LBM_VAL_TYPE_U: - ix = lbm_dec_u(index); - break; - case LBM_VAL_TYPE_I: - tmp = (lbm_int)lbm_dec_i(index); - if (tmp < 0) { - *result = lbm_enc_sym(SYM_EERROR); - return; - } - ix = (lbm_uint)tmp; - break; - case LBM_PTR_TYPE_BOXED_U: - ix = lbm_dec_U(index); - break; - case LBM_PTR_TYPE_BOXED_I: - tmp = lbm_dec_I(index); - if (tmp < 0) { - *result = lbm_enc_sym(SYM_EERROR); - return; - } - ix = (lbm_uint) tmp; - break; - default: - *result = lbm_enc_sym(SYM_NIL); + if (lbm_is_number(index) && lbm_is_number(index_end)) { + ix = lbm_dec_as_u(index); + ix_end = lbm_dec_as_u(index_end); + } else { return; } + if (ix > ix_end) { + lbm_uint tmp = ix; + ix = ix_end; + ix_end = tmp; + } + if (lbm_type_of(arr) == LBM_PTR_TYPE_ARRAY) { lbm_array_header_t *array = (lbm_array_header_t*)lbm_car(arr); + uint32_t* data = array->data; - if (ix >= array->size){ - *result = lbm_enc_sym(SYM_NIL); - return; - } + printf("ix: %d, ix_end: %d\n", ix, ix_end); + for (lbm_int i = (lbm_int)ix_end; i >= (lbm_int)ix; i--) { + printf("%d\n", i); + if ((lbm_uint)i >= array->size){ + printf("hmm %d %d\n", i, array->size); + *result = lbm_enc_sym(SYM_NIL); + return; + } - switch(array->elt_type) { - case LBM_VAL_TYPE_CHAR: - *result = lbm_enc_char((lbm_uint) ((char*)array+8)[ix]); - break; - case LBM_VAL_TYPE_U: - *result = lbm_enc_u(((lbm_uint*)array + 2)[ix]); - break; - case LBM_VAL_TYPE_I: - *result = lbm_enc_i(((lbm_int*)array + 2)[ix]); - break; - case LBM_PTR_TYPE_BOXED_U: - *result = lbm_cons(((lbm_uint*)array + 2)[ix], lbm_enc_sym(SYM_BOXED_U_TYPE)); - if (lbm_type_of(*result) == LBM_VAL_TYPE_SYMBOL) return; - *result = lbm_set_ptr_type(*result, LBM_PTR_TYPE_BOXED_U); - break; - case LBM_PTR_TYPE_BOXED_I: - *result = lbm_cons(((lbm_uint*)array + 2)[ix], lbm_enc_sym(SYM_BOXED_I_TYPE)); - if (lbm_type_of(*result) == LBM_VAL_TYPE_SYMBOL) return; - *result = lbm_set_ptr_type(*result, LBM_PTR_TYPE_BOXED_I); - break; - case LBM_PTR_TYPE_BOXED_F: - *result = lbm_cons(((lbm_uint*)array+2)[ix], lbm_enc_sym(SYM_BOXED_F_TYPE)); - if (lbm_type_of(*result) == LBM_VAL_TYPE_SYMBOL) return; - *result = lbm_set_ptr_type(*result, LBM_PTR_TYPE_BOXED_F); - break; - default: - *result = lbm_enc_sym(SYM_EERROR); - return; - } - return; + switch(array->elt_type) { + case LBM_VAL_TYPE_CHAR: + curr = lbm_enc_char((lbm_uint) ((char*)data)[i]); + break; + case LBM_VAL_TYPE_U: + curr = lbm_enc_u(((lbm_uint*)data)[i]); + break; + case LBM_VAL_TYPE_I: + curr = lbm_enc_i(((lbm_int*)data)[i]); + break; + case LBM_PTR_TYPE_BOXED_U: + curr = lbm_cons(((lbm_uint*)data)[i], lbm_enc_sym(SYM_BOXED_U_TYPE)); + if (lbm_type_of(curr) == LBM_VAL_TYPE_SYMBOL) return; + curr = lbm_set_ptr_type(curr, LBM_PTR_TYPE_BOXED_U); + break; + case LBM_PTR_TYPE_BOXED_I: + curr = lbm_cons(((lbm_uint*)data)[i], lbm_enc_sym(SYM_BOXED_I_TYPE)); + if (lbm_type_of(curr) == LBM_VAL_TYPE_SYMBOL) return; + curr = lbm_set_ptr_type(curr, LBM_PTR_TYPE_BOXED_I); + break; + case LBM_PTR_TYPE_BOXED_F: + curr = lbm_cons(((lbm_uint*)data)[i], lbm_enc_sym(SYM_BOXED_F_TYPE)); + if (lbm_type_of(*result) == LBM_VAL_TYPE_SYMBOL) return; + curr = lbm_set_ptr_type(curr, LBM_PTR_TYPE_BOXED_F); + break; + default: + curr = lbm_enc_sym(SYM_EERROR); + break; + } + if (read_many) { + acc = lbm_cons(curr, acc); + } + } /* for i */ + } + if (read_many) { + *result = acc; + } else { + *result = curr; } - *result = lbm_enc_sym(SYM_EERROR); } void array_write(lbm_value *args, lbm_uint nargs, lbm_uint *result) { @@ -355,38 +361,19 @@ void array_write(lbm_value *args, lbm_uint nargs, lbm_uint *result) { lbm_value index = args[1]; lbm_value val = args[2]; lbm_uint ix; - lbm_int tmp; - switch (lbm_type_of(index)) { - case LBM_VAL_TYPE_U: - ix = lbm_dec_u(index); - break; - case LBM_VAL_TYPE_I: - tmp = (lbm_int)lbm_dec_i(index); - if (tmp < 0) { - *result = lbm_enc_sym(SYM_EERROR); - return; - } - ix = (lbm_uint) tmp; - break; - case LBM_PTR_TYPE_BOXED_U: - ix = lbm_car(index); - break; - case LBM_PTR_TYPE_BOXED_I: - tmp = (lbm_int)lbm_car(index); - if (tmp < 0) { - *result = lbm_enc_sym(SYM_EERROR); - return; - } - ix = (lbm_uint) tmp; - break; - default: - *result = lbm_enc_sym(SYM_NIL); + + *result = lbm_enc_sym(SYM_EERROR); + + if (lbm_is_number(index)) { + ix = lbm_dec_as_u(index); + } else { return; } if (lbm_type_of(arr) == LBM_PTR_TYPE_ARRAY) { lbm_array_header_t *array = (lbm_array_header_t*)lbm_car(arr); + if (lbm_type_of(val) != array->elt_type || ix >= array->size) { *result = lbm_enc_sym(SYM_NIL); @@ -395,65 +382,67 @@ void array_write(lbm_value *args, lbm_uint nargs, lbm_uint *result) { switch(array->elt_type) { case LBM_VAL_TYPE_CHAR: { - char * data = (char *)array + 8; + char * data = (char *)array->data; data[ix] = lbm_dec_char(val); break; } case LBM_VAL_TYPE_U: { - lbm_uint* data = (lbm_uint*)array + 2; + lbm_uint* data = (lbm_uint*)array->data; data[ix] = lbm_dec_u(val); break; } case LBM_VAL_TYPE_I: { - lbm_int *data = (lbm_int*)array + 2; + lbm_int *data = (lbm_int*)array->data; data[ix] = lbm_dec_i(val); break; } case LBM_PTR_TYPE_BOXED_U: { - lbm_uint *data = (lbm_uint*)array + 2; + lbm_uint *data = (lbm_uint*)array->data; data[ix] = lbm_dec_U(val); break; } case LBM_PTR_TYPE_BOXED_I: { - lbm_int *data = (lbm_int*)array + 2; + lbm_int *data = (lbm_int*)array->data; data[ix] = lbm_dec_I(val); break; } case LBM_PTR_TYPE_BOXED_F: { //uv = car(val); //memcpy(&v, &uv, sizeof(FLOAT)); - lbm_uint *data = (lbm_uint*)array + 2; + lbm_uint *data = (lbm_uint*)array->data; data[ix] = lbm_car(val); break; } default: - *result = lbm_enc_sym(SYM_EERROR); - return; + // Maybe result should be something else than arr here. + break; } - *result = lbm_enc_sym(SYM_TRUE); + *result = arr; return; } - *result = lbm_enc_sym(SYM_NIL); } -void array_create(lbm_value *args, lbm_uint nargs, lbm_uint *result) { - (void) args; - (void) nargs; - (void) result; - -} +//void array_create(lbm_value *args, lbm_uint nargs, lbm_uint *result) { +// (void) args; +// (void) nargs; +// (void) result; +// +//} -lbm_value index_list(lbm_value l, int n) { - /* TODO: error checking */ +lbm_value index_list(lbm_value l, unsigned int n) { lbm_value curr = l; while ( lbm_type_of(curr) == LBM_PTR_TYPE_CONS && n > 0) { curr = lbm_cdr(curr); n --; } - return lbm_car(curr); + if (lbm_type_of(curr) == LBM_PTR_TYPE_CONS) { + return lbm_car(curr); + } else { + return lbm_enc_sym(SYM_NIL); + } } lbm_value lbm_fundamental(lbm_value* args, lbm_uint nargs, lbm_value op) { @@ -462,6 +451,108 @@ lbm_value lbm_fundamental(lbm_value* args, lbm_uint nargs, lbm_value op) { int cmp_res = -1; switch (lbm_dec_sym(op)) { + case SYM_IX: + if (nargs == 2 && lbm_is_number(args[0])) { + result = index_list(args[1], lbm_dec_as_u(args[0])); + } + break; + case SYM_DECODE: + if (nargs == 1 && (lbm_is_number(args[0]) || + lbm_is_char(args[0]))) { + switch (lbm_type_of(args[0])) { + case LBM_VAL_TYPE_CHAR: + /*fall through*/ + case LBM_VAL_TYPE_I: + /* fall through */ + case LBM_VAL_TYPE_U: { + lbm_uint v = lbm_dec_as_u(args[0]); + result = lbm_cons(lbm_enc_u(v & 0xFF), lbm_enc_sym(SYM_NIL)); + result = lbm_cons(lbm_enc_u(v >> 8 & 0xFF), result); + result = lbm_cons(lbm_enc_u(v >> 16 & 0xFF), result); + result = lbm_cons(lbm_enc_u(v >> 24 & 0xF), result); + } break; + case LBM_PTR_TYPE_BOXED_F: { + lbm_float tmp = lbm_dec_F(args[0]); + lbm_uint v; + memcpy(&v, &tmp, sizeof(lbm_uint)); + result = lbm_cons(lbm_enc_u(v & 0xFF), lbm_enc_sym(SYM_NIL)); + result = lbm_cons(lbm_enc_u(v >> 8 & 0xFF), result); + result = lbm_cons(lbm_enc_u(v >> 16 & 0xFF), result); + result = lbm_cons(lbm_enc_u(v >> 24 & 0xFF), result); + } break; + case LBM_PTR_TYPE_BOXED_I: + /* fall through */ + case LBM_PTR_TYPE_BOXED_U: { + lbm_uint v = lbm_dec_as_u(args[0]); + result = lbm_cons(lbm_enc_u(v & 0xFF), lbm_enc_sym(SYM_NIL)); + result = lbm_cons(lbm_enc_u(v >> 8 & 0xFF), result); + result = lbm_cons(lbm_enc_u(v >> 16 & 0xFF), result); + result = lbm_cons(lbm_enc_u(v >> 24 & 0xFF), result); + } break; + } // close if + }break; + /// Encode a list of up to 4 bytes as an i32 + case SYM_ENCODE_I32: + if (nargs == 1 && lbm_type_of(args[0]) == LBM_PTR_TYPE_CONS) { + lbm_value curr = args[0]; + lbm_uint r = 0; + int n = 4; + while (lbm_type_of(curr) == LBM_PTR_TYPE_CONS && n > 0) { + if (n < 4) r = r << 8; + if (lbm_is_number(lbm_car(curr))) { + uint32_t v = lbm_dec_as_u(lbm_car(curr)); + r |= v; + n --; + curr = lbm_cdr(curr); + } else { + break; + } + } + result = lbm_enc_I((lbm_int)r); + } + break; + /// Encode a list of up to 4 bytes as an U32 + case SYM_ENCODE_U32: + if (nargs == 1 && lbm_type_of(args[0]) == LBM_PTR_TYPE_CONS) { + lbm_value curr = args[0]; + lbm_uint r = 0; + int n = 4; + while (lbm_type_of(curr) == LBM_PTR_TYPE_CONS && n > 0) { + if (n < 4) r = r << 8; + if (lbm_is_number(lbm_car(curr))) { + uint32_t v = lbm_dec_as_u(lbm_car(curr)); + r |= v; + n --; + curr = lbm_cdr(curr); + } else { + break; + } + } + result = lbm_enc_U(r); + } + break; + /// Encode a list of up to 4 bytes as an U32 + case SYM_ENCODE_FLOAT: + if (nargs == 1 && lbm_type_of(args[0]) == LBM_PTR_TYPE_CONS) { + lbm_value curr = args[0]; + lbm_uint r = 0; + lbm_float f; + int n = 4; + while (lbm_type_of(curr) == LBM_PTR_TYPE_CONS && n > 0) { + if (n < 4) r = r << 8; + if (lbm_is_number(lbm_car(curr))) { + uint32_t v = lbm_dec_as_u(lbm_car(curr)); + r |= v; + n --; + curr = lbm_cdr(curr); + } else { + break; + } + } + memcpy(&f,&r, sizeof(lbm_uint)); + result = lbm_enc_F(f); + } + break; case SYM_IS_FUNDAMENTAL: if (nargs < 1 || lbm_type_of(args[0]) != LBM_VAL_TYPE_SYMBOL) @@ -583,7 +674,7 @@ lbm_value lbm_fundamental(lbm_value* args, lbm_uint nargs, lbm_value op) { } for (int i = n-1; i >= 0; i --) { - result = lbm_cons(index_list(a,i), result); + result = lbm_cons(index_list(a,(unsigned int)i), result); if (lbm_type_of(result) == LBM_VAL_TYPE_SYMBOL) break; } @@ -723,10 +814,9 @@ lbm_value lbm_fundamental(lbm_value* args, lbm_uint nargs, lbm_value op) { case SYM_ARRAY_WRITE: array_write(args, nargs, &result); break; - case SYM_ARRAY_CREATE: - array_create(args, nargs, &result); - break; - +// case SYM_ARRAY_CREATE: +// array_create(args, nargs, &result); +// break; case SYM_TYPE_OF: if (nargs != 1) return lbm_enc_sym(SYM_NIL); lbm_value val = args[0]; diff --git a/src/heap.c b/src/heap.c index 0ce73a4f..8711be38 100644 --- a/src/heap.c +++ b/src/heap.c @@ -20,11 +20,11 @@ #include #include #include +#include #include "heap.h" #include "symrepr.h" #include "stack.h" -#include "lispbm_memory.h" #ifdef VISUALIZE_HEAP #include "heap_vis.h" #endif @@ -41,7 +41,7 @@ char *lbm_dec_str(lbm_value val) { lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(val); if (array->elt_type == LBM_VAL_TYPE_CHAR) { - res = (char *)array + 8; + res = (char *)array->data; } } return res; @@ -62,6 +62,8 @@ lbm_uint lbm_dec_as_u(lbm_value a) { lbm_float f_tmp; switch (lbm_type_of(a)) { + case LBM_VAL_TYPE_CHAR: + return (lbm_uint) lbm_dec_char(a); case LBM_VAL_TYPE_I: return (lbm_uint) lbm_dec_i(a); case LBM_VAL_TYPE_U: @@ -83,6 +85,8 @@ lbm_int lbm_dec_as_i(lbm_value a) { lbm_float f_tmp; switch (lbm_type_of(a)) { + case LBM_VAL_TYPE_CHAR: + return (lbm_int) lbm_dec_char(a); case LBM_VAL_TYPE_I: return lbm_dec_i(a); case LBM_VAL_TYPE_U: @@ -104,6 +108,8 @@ lbm_float lbm_dec_as_f(lbm_value a) { lbm_float f_tmp; switch (lbm_type_of(a)) { + case LBM_VAL_TYPE_CHAR: + return (lbm_float) lbm_dec_char(a); case LBM_VAL_TYPE_I: return (lbm_float) lbm_dec_i(a); case LBM_VAL_TYPE_U: @@ -429,8 +435,10 @@ int lbm_gc_sweep_phase(void) { if (lbm_type_of(heap[i].cdr) == LBM_VAL_TYPE_SYMBOL && lbm_dec_sym(heap[i].cdr) == SYM_ARRAY_TYPE) { lbm_array_header_t *arr = (lbm_array_header_t*)heap[i].car; - lbm_memory_free((uint32_t *)arr); - heap_state.gc_recovered_arrays++; + if (lbm_memory_ptr_inside((uint32_t*)arr)) { + lbm_memory_free((uint32_t *)arr); + heap_state.gc_recovered_arrays++; + } } // create pointer to use as new freelist @@ -609,10 +617,12 @@ int lbm_heap_allocate_array(lbm_value *res, unsigned int size, lbm_type type){ allocate_size = size; } - array = (lbm_array_header_t*)lbm_memory_allocate(2 + allocate_size); + array = (lbm_array_header_t*)lbm_memory_allocate(sizeof(lbm_array_header_t) / 4); if (array == NULL) return 0; + array->data = (uint32_t*)lbm_memory_allocate(allocate_size); + array->elt_type = type; array->size = size; diff --git a/src/lbm_c_interop.c b/src/lbm_c_interop.c new file mode 100644 index 00000000..70af0946 --- /dev/null +++ b/src/lbm_c_interop.c @@ -0,0 +1,178 @@ +/* + 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 . +*/ + +#include "lbm_c_interop.h" + + + +/****************************************************/ +/* Interface for loading and running programs and */ +/* expressions */ + +lbm_cid eval_cps_load_and_eval(lbm_tokenizer_char_stream_t *tokenizer, bool program) { + + lbm_value stream = lbm_create_token_stream(tokenizer); + + if (lbm_type_of(stream) == LBM_VAL_TYPE_SYMBOL) { + // TODO: Check what should be done. + return 0; + } + + /* LISP ZONE */ + + lbm_value launcher = lbm_cons(stream, lbm_enc_sym(SYM_NIL)); + launcher = lbm_cons(lbm_enc_sym(program ? SYM_READ_PROGRAM : SYM_READ), launcher); + lbm_value evaluator = lbm_cons(launcher, lbm_enc_sym(SYM_NIL)); + evaluator = lbm_cons(lbm_enc_sym(program ? SYM_EVAL_PROGRAM : SYM_EVAL), evaluator); + lbm_value start_prg = lbm_cons(evaluator, lbm_enc_sym(SYM_NIL)); + + /* LISP ZONE ENDS */ + + if (lbm_type_of(launcher) != LBM_PTR_TYPE_CONS || + lbm_type_of(evaluator) != LBM_PTR_TYPE_CONS || + lbm_type_of(start_prg) != LBM_PTR_TYPE_CONS ) { + lbm_memory_free((uint32_t*)stream); + return 0; + } + return lbm_create_ctx(start_prg, lbm_enc_sym(SYM_NIL), 256); +} + +lbm_cid eval_cps_load_and_define(lbm_tokenizer_char_stream_t *tokenizer, char *symbol, bool program) { + + lbm_value stream = lbm_create_token_stream(tokenizer); + + if (lbm_type_of(stream) == LBM_VAL_TYPE_SYMBOL) { + return 0; + } + + lbm_uint sym_id; + + if (!lbm_get_symbol_by_name(symbol, &sym_id)) { + if (!lbm_add_symbol(symbol, &sym_id)) { + lbm_memory_free((uint32_t*)stream); + return 0; + } + } + + /* LISP ZONE */ + + lbm_value launcher = lbm_cons(stream, lbm_enc_sym(SYM_NIL)); + launcher = lbm_cons(lbm_enc_sym(program ? SYM_READ_PROGRAM : SYM_READ), launcher); + lbm_value binding = lbm_cons(launcher, lbm_enc_sym(SYM_NIL)); + binding = lbm_cons(lbm_enc_sym(sym_id), binding); + lbm_value definer = lbm_cons(lbm_enc_sym(SYM_DEFINE), binding); + definer = lbm_cons(definer, lbm_enc_sym(SYM_NIL)); + /* LISP ZONE ENDS */ + + if (lbm_type_of(launcher) != LBM_PTR_TYPE_CONS || + lbm_type_of(binding) != LBM_PTR_TYPE_CONS || + lbm_type_of(definer) != LBM_PTR_TYPE_CONS ) { + lbm_memory_free((uint32_t*)stream); + return 0; + } + return lbm_create_ctx(definer, lbm_enc_sym(SYM_NIL), 256); +} + +lbm_cid lbm_eval_defined(char *symbol, bool program) { + + lbm_uint sym_id; + + if(!lbm_get_symbol_by_name(symbol, &sym_id)) { + // The symbol does not exist, so it cannot be defined + return 0; + } + + lbm_value binding = lbm_env_lookup(lbm_enc_sym(sym_id), *lbm_get_env_ptr()); + + if (lbm_type_of(binding) == LBM_VAL_TYPE_SYMBOL && + lbm_dec_sym(binding) == SYM_NOT_FOUND) { + return 0; + } + + /* LISP ZONE */ + + lbm_value launcher = lbm_cons(lbm_enc_sym(sym_id), lbm_enc_sym(SYM_NIL)); + lbm_value evaluator = launcher; + evaluator = lbm_cons(lbm_enc_sym(program ? SYM_EVAL_PROGRAM : SYM_EVAL), evaluator); + lbm_value start_prg = lbm_cons(evaluator, lbm_enc_sym(SYM_NIL)); + + /* LISP ZONE ENDS */ + + if (lbm_type_of(launcher) != LBM_PTR_TYPE_CONS || + lbm_type_of(evaluator) != LBM_PTR_TYPE_CONS || + lbm_type_of(start_prg) != LBM_PTR_TYPE_CONS ) { + return 0; + } + return lbm_create_ctx(start_prg, lbm_enc_sym(SYM_NIL), 256); +} + + + +lbm_cid lbm_load_and_eval_expression(lbm_tokenizer_char_stream_t *tokenizer) { + return eval_cps_load_and_eval(tokenizer, false); +} + +lbm_cid lbm_load_and_define_expression(lbm_tokenizer_char_stream_t *tokenizer, char *symbol) { + return eval_cps_load_and_define(tokenizer, symbol, false); +} + +lbm_cid lbm_load_and_eval_program(lbm_tokenizer_char_stream_t *tokenizer) { + return eval_cps_load_and_eval(tokenizer, true); +} + +lbm_cid lbm_load_and_define_program(lbm_tokenizer_char_stream_t *tokenizer, char *symbol) { + return eval_cps_load_and_define(tokenizer, symbol, true); +} + +lbm_cid lbm_eval_defined_expression(char *symbol) { + return lbm_eval_defined(symbol, false); +} + +lbm_cid lbm_eval_defined_program(char *symbol) { + return lbm_eval_defined(symbol, true); +} + +int lbm_send_message(lbm_cid cid, lbm_value msg) { + int res = 0; + + if (lbm_get_eval_state() == EVAL_CPS_STATE_PAUSED) { + + lbm_value v = lbm_find_receiver_and_send(cid, msg); + + if (lbm_type_of(v) == LBM_VAL_TYPE_SYMBOL && + lbm_dec_sym(v) == SYM_TRUE) { + res = 1; + } + } + return res; +} + +int lbm_define(char *symbol, lbm_value value) { + int res = 0; + + lbm_uint sym_id; + if (lbm_get_eval_state() == EVAL_CPS_STATE_PAUSED) { + + if (!lbm_get_symbol_by_name(symbol, &sym_id)) { + if (!lbm_add_symbol(symbol, &sym_id)) { + return 0; + } + } + lbm_env_set(lbm_get_env(), lbm_enc_sym(sym_id), value); + } + return res; +} diff --git a/src/lispbm_memory.c b/src/lbm_memory.c similarity index 96% rename from src/lispbm_memory.c rename to src/lbm_memory.c index 6211f5a1..7334ba94 100644 --- a/src/lispbm_memory.c +++ b/src/lbm_memory.c @@ -15,11 +15,11 @@ along with this program. If not, see . */ +#include #include #include #include -#include "lispbm_memory.h" /* Status bit patterns */ #define FREE_OR_USED 0 //00b @@ -227,3 +227,12 @@ int lbm_memory_free(uint32_t *ptr) { return 0; } + +int lbm_memory_ptr_inside(uint32_t *ptr) { + int r = 0; + + if ((uint32_t)ptr >= (uint32_t)memory && + (uint32_t)ptr < (uint32_t)memory + (memory_size * 4)) + r = 1; + return r; +} diff --git a/src/print.c b/src/print.c index 89d7811c..41b54d85 100644 --- a/src/print.c +++ b/src/print.c @@ -19,11 +19,11 @@ #include #include #include +#include #include "print.h" #include "heap.h" #include "symrepr.h" -#include "lispbm_types.h" #include "stack.h" #define PRINT_STACK_SIZE 128 /* 1 KB */ @@ -246,7 +246,7 @@ int lbm_print_value(char *buf,unsigned int len, lbm_value t) { lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(curr); switch (array->elt_type){ case LBM_VAL_TYPE_CHAR: - r = snprintf(buf + offset, len - offset, "\"%s\"", (char *)(array)+8); + r = snprintf(buf + offset, len - offset, "\"%s\"", (char *)array->data); if ( r > 0) { n = (unsigned int) r; } else { diff --git a/src/qq_expand.c b/src/qq_expand.c index 9b091d46..f8bc2a2f 100644 --- a/src/qq_expand.c +++ b/src/qq_expand.c @@ -24,8 +24,8 @@ */ +#include #include "heap.h" -#include "lispbm_types.h" #include "symrepr.h" #include "stack.h" #include "qq_expand.h" diff --git a/src/stack.c b/src/stack.c index c51922e9..43bcdc8a 100644 --- a/src/stack.c +++ b/src/stack.c @@ -15,12 +15,12 @@ along with this program. If not, see . */ +#include +#include #include #include "stack.h" -#include "lispbm_types.h" #include "print.h" -#include "lispbm_memory.h" int lbm_stack_allocate(lbm_stack_t *s, unsigned int stack_size) { s->data = lbm_memory_allocate(stack_size); diff --git a/src/symrepr.c b/src/symrepr.c index 1d6d4f19..015c139c 100644 --- a/src/symrepr.c +++ b/src/symrepr.c @@ -20,11 +20,11 @@ #include #include #include +#include #include "symrepr.h" -#include "lispbm_memory.h" -#define NUM_SPECIAL_SYMBOLS 88 +#define NUM_SPECIAL_SYMBOLS 92 #define NAME 0 #define ID 1 @@ -124,7 +124,7 @@ special_sym const special_symbols[NUM_SPECIAL_SYMBOLS] = { {"append" , SYM_APPEND}, {"array-read" , SYM_ARRAY_READ}, {"array-write" , SYM_ARRAY_WRITE}, - {"array-create" , SYM_ARRAY_CREATE}, +// {"array-create" , SYM_ARRAY_CREATE}, {"type-of" , SYM_TYPE_OF}, {"sym-to-str" , SYM_SYMBOL_TO_STRING}, {"str-to-sym" , SYM_STRING_TO_SYMBOL}, @@ -132,6 +132,23 @@ special_sym const special_symbols[NUM_SPECIAL_SYMBOLS] = { {"u-to-sym" , SYM_UINT_TO_SYMBOL}, {"set-car" , SYM_SET_CAR}, {"set-cdr" , SYM_SET_CDR}, + + // Streams +// {"stream-get" , SYM_STREAM_GET}, +// {"stream-more" , SYM_STREAM_MORE}, +// {"stream-peek" , SYM_STREAM_PEEK}, +// {"stream-drop" , SYM_STREAM_DROP}, +// {"stream-put" , SYM_STREAM_PUT}, + + // fast access in list + {"ix" , SYM_IX}, + + // Low-level + {"encode-i32" , SYM_ENCODE_I32}, + {"encode-u32" , SYM_ENCODE_U32}, + {"encode-float" , SYM_ENCODE_FLOAT}, + {"decode" , SYM_DECODE}, + {"is-fundamental" , SYM_IS_FUNDAMENTAL} }; diff --git a/src/tokpar.c b/src/tokpar.c index e9337f2d..42647445 100644 --- a/src/tokpar.c +++ b/src/tokpar.c @@ -18,16 +18,16 @@ #include #include #include +#include +#include #include #include #include "tokpar.h" #include "symrepr.h" #include "heap.h" -#include "lispbm_types.h" #include "compression.h" #include "qq_expand.h" -#include "lispbm_memory.h" #include "env.h" #define NOTOKEN 0u @@ -531,7 +531,7 @@ lbm_value lbm_get_next_token(lbm_tokenizer_char_stream_t *str) { // TODO: Proper error checking here! lbm_heap_allocate_array(&res, (unsigned int)(n-2)+1, LBM_VAL_TYPE_CHAR); lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(res); - char *data = (char *)arr + 8; + char *data = (char *)arr->data; memset(data, 0, (unsigned int)((n-2)+1) * sizeof(char)); memcpy(data, sym_str, (unsigned int)(n - 2) * sizeof(char)); return res; diff --git a/tests/test_decode_0.lisp b/tests/test_decode_0.lisp new file mode 100644 index 00000000..8044b723 --- /dev/null +++ b/tests/test_decode_0.lisp @@ -0,0 +1,2 @@ + +(= '(0u28 0u28 255u28 255u28) (decode (- 65536 1))) diff --git a/tests/test_encode_0.lisp b/tests/test_encode_0.lisp new file mode 100644 index 00000000..179b975f --- /dev/null +++ b/tests/test_encode_0.lisp @@ -0,0 +1 @@ +(= 12345678i32 (encode-i32 (decode 12345678i32))) diff --git a/tests/test_encode_1.lisp b/tests/test_encode_1.lisp new file mode 100644 index 00000000..d03518dd --- /dev/null +++ b/tests/test_encode_1.lisp @@ -0,0 +1 @@ +(= 3.14 (encode-float (decode 3.14))) diff --git a/tests/test_encode_2.lisp b/tests/test_encode_2.lisp new file mode 100644 index 00000000..218918f3 --- /dev/null +++ b/tests/test_encode_2.lisp @@ -0,0 +1 @@ +(= 999999u32 (encode-u32 (decode 999999u32))) diff --git a/tests/test_ix_0.lisp b/tests/test_ix_0.lisp new file mode 100644 index 00000000..8a210c62 --- /dev/null +++ b/tests/test_ix_0.lisp @@ -0,0 +1 @@ +(= 7 (ix 3 '(1 2 0 7 3 2 1))) diff --git a/tests/test_ix_1.lisp b/tests/test_ix_1.lisp new file mode 100644 index 00000000..f5cf7b93 --- /dev/null +++ b/tests/test_ix_1.lisp @@ -0,0 +1 @@ +(= nil (ix 100000 '(1 2))) diff --git a/tests/test_ix_2.lisp b/tests/test_ix_2.lisp new file mode 100644 index 00000000..99b45230 --- /dev/null +++ b/tests/test_ix_2.lisp @@ -0,0 +1,2 @@ +(= 45 (ix 45 (iota 100))) + diff --git a/tests/test_lisp_code_cps.c b/tests/test_lisp_code_cps.c index 107c6263..a7a21a88 100644 --- a/tests/test_lisp_code_cps.c +++ b/tests/test_lisp_code_cps.c @@ -25,16 +25,7 @@ #include #include -#include "heap.h" -#include "symrepr.h" -#include "eval_cps.h" -#include "print.h" -#include "tokpar.h" -#include "prelude.h" -#include "compression.h" -#include "lispbm_memory.h" -#include "env.h" -#include "extensions.h" +#include "lispbm.h" #define EVAL_CPS_STACK_SIZE 256 diff --git a/tests/test_match_2.lisp b/tests/test_match_2.lisp index 17dc8a40..218bc30d 100644 --- a/tests/test_match_2.lisp +++ b/tests/test_match_2.lisp @@ -2,7 +2,7 @@ (define f (lambda (ls) (match ls ( nil 0 ) - ( (?cons c) (+ (car c) (f (cdr c)))) + ( ((? x) . (? xs)) (+ x (f xs))) ( _ 'error-not-a-list)))) (= (f '(1 2 3 4)) 10) diff --git a/tests/test_read_0.lisp b/tests/test_read_0.lisp new file mode 100644 index 00000000..d1e24629 --- /dev/null +++ b/tests/test_read_0.lisp @@ -0,0 +1 @@ +(= (read "1") 1) \ No newline at end of file diff --git a/tests/test_read_1.lisp b/tests/test_read_1.lisp new file mode 100644 index 00000000..509b2926 --- /dev/null +++ b/tests/test_read_1.lisp @@ -0,0 +1 @@ +(= (eval (read "(+ 1 2)")) 3) \ No newline at end of file diff --git a/tests/test_read_2.lisp b/tests/test_read_2.lisp new file mode 100644 index 00000000..f8677700 --- /dev/null +++ b/tests/test_read_2.lisp @@ -0,0 +1,4 @@ + +(define prg "(define a 10) (+ a 10)") + +(= (eval-program (read-program prg)) 20) \ No newline at end of file