Squashed 'lispBM/lispBM/' changes from fbc2d92b..a03e2756

a03e2756 Removal of fatal error generation where nothing fatal is going on
2472e632 Report a certain function application in a better way than just fatal error
1e3cab6c refactor
b345361f rest-args takes an optional numerical argument that is used as an index into the list of rest-args
18b152d4 adding tests to see if rest-args behaves as expected scope-wise
21166396 added a rest-args function that retreives extra arguments passed to a closure (lambda )
7b4f689a update to REPL and integration of dot->png into lbmref.lisp
6a6b39c0 added dot (graph rendering) functionality to lbmref.lisp and added exec extension to repl
51223814 planning section about evaluation rules
8d1b4bd6 lbmref.md is now generated from lbmref.lisp
672117e4 lbmref.lisp
5bf75e45 added more ref-entries to lbmref-lisp
00bdc8f2 additions to lbmref.lisp
3946725a added ref-entries to lbmref.lisp
1f8c0372 added a bunch of ref-entries to the lbmref.lisp
11bfa1e2 added more to lbmref.lisp
e337cc5e added a simplistic pretty printer to lbmref.lisp and a few more ref-entries
a7763e28 added new optional arguments to eval and eval-program for providing an environment to evaluate within
693420d3 added some ref-entries to lbmref.lisp, and some todos
43a2dc62 additions to lbmref.lisp
e91cf72e added to lbmref.lisp
447e1f7b fwrite and fwrite-str now flushes the filehandle after writing an array to file
b8e972a4 additions to lbmref.lisp and test output for github markdown viewer test
5cba626f Additions to lbmref.lisp
2eb8361f added fopen and fwrite extensions to REPL
23a74220 additions lbmref.lisp
86360788 added a ref-entry command to lbmref.lisp
229914ba small additions to lbmref.lisp
100ea80e towards LBM generated lbmref

git-subtree-dir: lispBM/lispBM
git-subtree-split: a03e2756fde8986711e34e9f403b6921d0be9bc4

include/heap.h

@@ -510,6 +510,12 @@ lbm_value lbm_list_append(lbm_value list1, lbm_value list2);
  * \return The list with the n first elements removed.
  */
 lbm_value lbm_list_drop(unsigned int n, lbm_value ls);
+/** Index into a list.
+ * \param l List to index into.
+ * \param n Position to read out of the list.
+ * \return Value at position n of l or nil if out of bounds.
+ */
+lbm_value lbm_index_list(lbm_value l, int32_t n);
 
 // State and statistics
 /** Get a copy of the heap statistics structure.

include/lbm_defines.h

@@ -339,7 +339,7 @@
 #define SYM_SLEEP                 0x30012
 #define SYM_MERGE                 0x30013
 #define SYM_SORT                  0x30014
-
+#define SYM_REST_ARGS             0x30015
 
 #define SYMBOL_KIND(X)          ((X) >> 16)
 #define SYMBOL_KIND_SPECIAL     0
@@ -473,6 +473,7 @@
 #define ENC_SYM_SLEEP                 ENC_SYM(SYM_SLEEP)
 #define ENC_SYM_MERGE                 ENC_SYM(SYM_MERGE)
 #define ENC_SYM_SORT                  ENC_SYM(SYM_SORT)
+#define ENC_SYM_REST_ARGS             ENC_SYM(SYM_REST_ARGS)
 
 #define ENC_SYM_ADD           ENC_SYM(SYM_ADD)
 #define ENC_SYM_SUB           ENC_SYM(SYM_SUB)

include/symrepr.h

@@ -132,6 +132,7 @@ bool lbm_symbol_list_entry_in_flash(char *str);
 
 extern lbm_value symbol_x;
 extern lbm_value symbol_y;
+extern lbm_value symbol_rest_args;
 
 #ifdef __cplusplus
 }

repl/repl_exts.c

@@ -18,8 +18,11 @@
 
 #include "repl_exts.h"
 
+#include <unistd.h>
 #include <stdio.h>
+#include <dirent.h>
 #include <sys/time.h>
+#include <sys/wait.h>
 
 // Macro expanders
 
@@ -362,6 +365,147 @@ lbm_value ext_print(lbm_value *args, lbm_uint argn) {
   return lbm_enc_sym(SYM_TRUE);
 }
 
+// ------------------------------------------------------------
+// File IO
+
+static const char *lbm_file_handle_desc = "File-Handle";
+
+typedef struct {
+  FILE *fp;
+} lbm_file_handle_t;
+
+static bool file_handle_destructor(lbm_uint value) {
+
+  lbm_file_handle_t *h = (lbm_file_handle_t *)value;
+  if (h->fp) {
+    fclose(h->fp);
+  }
+  return true;
+}
+
+static bool is_file_handle(lbm_value h) {
+  return ((lbm_uint)lbm_get_custom_descriptor(h) == (lbm_uint)lbm_file_handle_desc);
+}
+
+static lbm_value ext_fopen(lbm_value *args, lbm_uint argn) {
+
+  lbm_value res = ENC_SYM_TERROR;
+  if (argn == 2 &&
+      lbm_is_array_r(args[0]) &&
+      lbm_is_array_r(args[1])) {
+
+    FILE *fp = NULL;
+
+    char *filename = lbm_dec_str(args[0]);
+    char *mode = lbm_dec_str(args[1]);
+
+    fp = fopen(filename, mode);
+    if (fp) {
+      lbm_file_handle_t *mem = lbm_malloc(sizeof(lbm_file_handle_t));
+      if (!mem) {
+        fclose(fp);
+        return ENC_SYM_MERROR;
+      }
+      mem->fp = fp;
+      lbm_custom_type_create((lbm_uint)mem,
+                             file_handle_destructor,
+                             lbm_file_handle_desc,
+                             &res);
+    } else {
+      return ENC_SYM_NIL;
+    }
+  }
+  return res;
+}
+
+static lbm_value ext_fwrite(lbm_value *args, lbm_uint argn) {
+
+  lbm_value res = ENC_SYM_TERROR;
+  if (argn == 2 &&
+      is_file_handle(args[0]) &&
+      lbm_is_array_r(args[1])) {
+
+    lbm_file_handle_t *h = (lbm_file_handle_t*)lbm_get_custom_value(args[0]);
+    lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[1]);
+    if (array) {
+      fwrite(array->data, 1, array->size, h->fp);
+      fflush(h->fp);
+      res = ENC_SYM_TRUE;
+    } else {
+      res = ENC_SYM_NIL;
+    }
+  }
+  return res;
+
+}
+
+static lbm_value ext_fwrite_str(lbm_value *args, lbm_uint argn) {
+
+  lbm_value res = ENC_SYM_TERROR;
+  if (argn == 2 &&
+      is_file_handle(args[0]) &&
+      lbm_is_array_r(args[1])) {
+
+    lbm_file_handle_t *h = (lbm_file_handle_t*)lbm_get_custom_value(args[0]);
+    lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[1]);
+    if (array) {
+      fwrite(array->data, 1, strlen((char*)array->data), h->fp);
+      fflush(h->fp);
+      res = ENC_SYM_TRUE;
+    } else {
+      res = ENC_SYM_NIL;
+    }
+  }
+  return res;
+
+}
+
+static bool all_arrays(lbm_value *args, lbm_uint argn) {
+  bool r = true;
+  for (uint32_t i = 0; i < argn; i ++) {
+    r = r && lbm_is_array_r(args[i]);
+  }
+  return r;
+}
+
+static lbm_value ext_exec(lbm_value *args, lbm_uint argn) {
+
+  lbm_value res = ENC_SYM_TERROR;
+  int pid;
+  
+  if (all_arrays(args, argn) && argn >= 1) {
+    char **strs = malloc(argn * sizeof(char*) + 1);
+    for (uint32_t i = 0; i < argn; i ++) {
+      strs[i] = lbm_dec_str(args[i]);
+    }
+    strs[argn] = NULL;
+    fflush(stdout);
+    int status = 0;
+    pid = fork();
+    if (pid == 0) {
+      execvp(strs[0], &strs[1]);
+      exit(0);
+    } else {
+      waitpid(pid, &status, 0);
+      res = ENC_SYM_TRUE;
+    }
+  }
+  return res; 
+}
+
+static lbm_value ext_unsafe_call_system(lbm_value *args, lbm_uint argn) {
+
+  lbm_value res = ENC_SYM_TERROR;
+  if (argn == 1 && lbm_is_array_r(args[0])) {
+    int r = system(lbm_dec_str(args[0]));
+    if (r == 0)  {
+      res = ENC_SYM_TRUE;
+    } else {
+      res = lbm_enc_i(r);
+    }
+  }
+  return res;
+}
 
 // ------------------------------------------------------------
 // Init
@@ -381,6 +525,11 @@ int init_exts(void) {
     return 0;
   }
 
+  lbm_add_extension("unsafe-call-system", ext_unsafe_call_system);
+  lbm_add_extension("exec", ext_exec);
+  lbm_add_extension("fopen", ext_fopen);
+  lbm_add_extension("fwrite", ext_fwrite);
+  lbm_add_extension("fwrite-str", ext_fwrite_str);
   lbm_add_extension("print", ext_print);
   lbm_add_extension("systime", ext_systime);
   lbm_add_extension("secs-since", ext_secs_since);

src/eval_cps.c

@@ -91,15 +91,18 @@ static jmp_buf critical_error_jmp_buf;
 #define LOOP_CONDITION        CONTINUATION(42)
 #define MERGE_REST            CONTINUATION(43)
 #define MERGE_LAYER           CONTINUATION(44)
-#define NUM_CONTINUATIONS     45
+#define CLOSURE_ARGS_REST     CONTINUATION(45)
+#define NUM_CONTINUATIONS     46
 
 #define FM_NEED_GC       -1
 #define FM_NO_MATCH      -2
 #define FM_PATTERN_ERROR -3
 
-#define BL_OK             0
-#define BL_NO_MEMORY     -1
-#define BL_INCORRECT_KEY -2
+typedef enum {
+  BL_OK = 0,
+  BL_NO_MEMORY,
+  BL_INCORRECT_KEY
+} binding_location_status;
 
 #define FB_OK             0
 #define FB_TYPE_ERROR    -1
@@ -1807,7 +1810,7 @@ static void eval_move_to_flash(eval_context_t *ctx) {
 }
 
 // Create a named location in an environment to later receive a value.
-static int create_binding_location(lbm_value key, lbm_value *env) {
+static binding_location_status create_binding_location(lbm_value key, lbm_value *env) {
 
   if (lbm_is_symbol(key) &&
       (key == ENC_SYM_NIL ||
@@ -1846,22 +1849,23 @@ static void let_bind_values_eval(lbm_value binds, lbm_value exp, lbm_value env,
   while (lbm_is_cons(curr)) {
     lbm_value new_env_tmp = env;
     lbm_value key = get_caar(curr);
-    int r = create_binding_location(key, &new_env_tmp);
-    if (r < 0) {
+    binding_location_status r = create_binding_location(key, &new_env_tmp);
+    if (r != BL_OK) {
       if (r == BL_NO_MEMORY) {
         new_env_tmp = env;
         lbm_gc_mark_phase(env);
         gc();
         r = create_binding_location(key, &new_env_tmp);
       }
-      if (r < 0) {
-        if (r == BL_INCORRECT_KEY)
-          error_ctx(ENC_SYM_TERROR);
-        else if (r == BL_NO_MEMORY)
+      switch(r) {
+      case BL_OK:
+        break;
+      case BL_NO_MEMORY:
         error_ctx(ENC_SYM_MERROR);
-        else
-          error_ctx(ENC_SYM_FATAL_ERROR);
-        return;
+        break;
+      case BL_INCORRECT_KEY:
+        error_ctx(ENC_SYM_TERROR);
+        break;
       }
     }
     env = new_env_tmp;
@@ -2316,16 +2320,24 @@ static void apply_wait(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
 static void apply_eval(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
   if ( nargs == 1) {
     ctx->curr_exp = args[0];
-    lbm_stack_drop(&ctx->K, nargs+1);
+  } else if (nargs == 2) {
+    ctx->curr_exp = args[1];
+    ctx->curr_env = args[0];
   } else {
     lbm_set_error_reason((char*)lbm_error_str_num_args);
     error_at_ctx(ENC_SYM_EERROR, ENC_SYM_EVAL);
   }
+  lbm_stack_drop(&ctx->K, nargs+1);
 }
 
 static void apply_eval_program(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
-  if (nargs == 1) {
-    lbm_value prg = args[0];
+  int prg_pos = 0;
+  if (nargs == 2) {
+    prg_pos = 1;
+    ctx->curr_env = args[0];
+  }
+  if (nargs == 1 || nargs == 2) {
+    lbm_value prg = args[prg_pos];
     lbm_value app_cont;
     lbm_value app_cont_prg;
     lbm_value new_prg;
@@ -2719,6 +2731,21 @@ static void apply_sort(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
   error_ctx(ENC_SYM_TERROR);
 }
 
+static void apply_rest_args(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
+  lbm_value res;
+  if (lbm_env_lookup_b(&res, ENC_SYM_REST_ARGS, ctx->curr_env)) {
+    if (nargs == 1 && lbm_is_number(args[0])) {
+      int32_t ix = lbm_dec_as_i32(args[0]);
+      res = lbm_index_list(res, ix);
+    }
+    ctx->r = res;
+  } else {
+    ctx->r = ENC_SYM_NIL;
+  }
+  lbm_stack_drop(&ctx->K, nargs+1);
+  ctx->app_cont = true;
+}
+
 /***************************************************/
 /* Application lookup table                        */
 
@@ -2746,6 +2773,7 @@ static const apply_fun fun_table[] =
    apply_sleep,
    apply_merge,
    apply_sort,
+   apply_rest_args,
   };
 
 /***************************************************/
@@ -2793,7 +2821,10 @@ static void application(eval_context_t *ctx, lbm_value *fun_args, lbm_uint arg_c
     fun_table[SYMBOL_IX(fun_val)](&fun_args[1], arg_count, ctx);
     break;
   default:
-    error_ctx(ENC_SYM_FATAL_ERROR);
+    // Symbols that are "special" but not in the way caught above
+    // ends up here.
+    lbm_set_error_reason("Symbol does not represent a function");
+    error_at_ctx(ENC_SYM_EERROR,fun_args[0]);
     break;
   }
 }
@@ -2810,6 +2841,9 @@ static void cont_closure_application_args(eval_context_t *ctx) {
   lbm_value car_params, cdr_params;
   get_car_and_cdr(params, &car_params, &cdr_params);
 
+  bool a_nil = args == ENC_SYM_NIL;
+  bool p_nil = cdr_params == ENC_SYM_NIL;
+
   if (lbm_heap_num_free() < 2) {
     gc();
     if (lbm_heap_num_free() < 2) {
@@ -2830,9 +2864,6 @@ static void cont_closure_application_args(eval_context_t *ctx) {
   heap[cell1_ix].cdr = clo_env;
   clo_env = cell1;
 
-  bool a_nil = args == ENC_SYM_NIL;
-  bool p_nil = cdr_params == ENC_SYM_NIL;
-
   if (!a_nil && !p_nil) {
     lbm_value car_args, cdr_args;
     get_car_and_cdr(args, &car_args, &cdr_args);
@@ -2842,6 +2873,31 @@ static void cont_closure_application_args(eval_context_t *ctx) {
     stack_push(&ctx->K, CLOSURE_ARGS);
     ctx->curr_exp = car_args;
     ctx->curr_env = arg_env;
+  } else if (p_nil && !a_nil) {
+
+    if (lbm_heap_num_free() < 2) {
+      gc();
+      if (lbm_heap_num_free() < 2) {
+        error_ctx(ENC_SYM_MERROR);
+      }
+    }
+    lbm_value rest0 = lbm_heap_state.freelist;
+    lbm_uint rest0_ix = lbm_dec_ptr(rest0);
+    lbm_value rest1 = heap[rest0_ix].cdr;
+    lbm_uint rest1_ix = lbm_dec_ptr(rest1);
+    lbm_heap_state.freelist = heap[rest1_ix].cdr;
+    lbm_heap_state.num_alloc += 2;
+    heap[rest0_ix].car = ENC_SYM_REST_ARGS;
+    heap[rest0_ix].cdr = ENC_SYM_NIL;
+    heap[rest1_ix].car = rest0;
+    heap[rest1_ix].cdr = clo_env;
+    clo_env = rest1;
+    sptr[2] = clo_env;
+    sptr[3] = get_cdr(args);
+    sptr[4] = rest0; // last element of rest_args so far
+    stack_push(&ctx->K, CLOSURE_ARGS_REST);
+    ctx->curr_exp = get_car(args);
+    ctx->curr_env = arg_env;
   } else if (a_nil && p_nil) {
     // Arguments and parameters match up in number
     lbm_stack_drop(&ctx->K, 5);
@@ -2854,6 +2910,43 @@ static void cont_closure_application_args(eval_context_t *ctx) {
 }
 
 
+static void cont_closure_args_rest(eval_context_t *ctx) {
+  lbm_uint* sptr = get_stack_ptr(ctx, 5);
+  lbm_value arg_env = (lbm_value)sptr[0];
+  lbm_value exp     = (lbm_value)sptr[1];
+  lbm_value clo_env = (lbm_value)sptr[2];
+  lbm_value args    = (lbm_value)sptr[3];
+  lbm_value last    = (lbm_value)sptr[4];
+  lbm_cons_t* heap = lbm_heap_state.heap;
+
+  lbm_value binding = lbm_heap_state.freelist;
+  if (binding == ENC_SYM_NIL) {
+    gc();
+    binding = lbm_heap_state.freelist;
+    if (binding == ENC_SYM_NIL) error_ctx(ENC_SYM_MERROR);
+  }
+  lbm_uint binding_ix = lbm_dec_ptr(binding);
+  lbm_heap_state.freelist = heap[binding_ix].cdr;
+  lbm_heap_state.num_alloc += 1;
+  heap[binding_ix].car = ctx->r;
+  heap[binding_ix].cdr = ENC_SYM_NIL;
+
+
+  lbm_set_cdr(last, binding);
+  sptr[4] = binding;
+
+  if (args == ENC_SYM_NIL) {
+    lbm_stack_drop(&ctx->K, 5);
+    ctx->curr_env = clo_env;
+    ctx->curr_exp = exp;
+  } else {
+    stack_push(&ctx->K, CLOSURE_ARGS_REST);
+    sptr[3] = get_cdr(args);
+    ctx->curr_exp = get_car(args);
+    ctx->curr_env = arg_env;
+  }
+}
+
 static void cont_application_args(eval_context_t *ctx) {
   lbm_uint *sptr = get_stack_ptr(ctx, 3);
 
@@ -2983,6 +3076,7 @@ static void cont_match(eval_context_t *ctx) {
 
   if (lbm_is_symbol_nil(patterns)) {
     // no more patterns
+    lbm_stack_drop(&ctx->K, 2);
     ctx->r = ENC_SYM_NO_MATCH;
     ctx->app_cont = true;
   } else if (lbm_is_cons(patterns)) {
@@ -3726,6 +3820,8 @@ static void cont_read_start_array(eval_context_t *ctx) {
       lbm_set_error_reason("Out of memory while reading.");
       lbm_channel_reader_close(str);
       error_ctx(ENC_SYM_FATAL_ERROR);
+      // NOTE: If array is not created evaluation ends here.
+      // Static analysis seems unaware.
     }
 
     sptr[0] = array;
@@ -3750,7 +3846,11 @@ static void cont_read_append_array(eval_context_t *ctx) {
     error_ctx(ENC_SYM_MERROR);
   }
 
-  lbm_array_header_t *arr = (lbm_array_header_t*)get_car(array); // TODO: Check
+  // get_car can return nil. Whose value is 0!
+  // So static Analysis is right about this being a potential NULL pointer.
+  // However, if the array was created correcly to begin with, it should be fine.
+  lbm_value arr_car = get_car(array);
+  lbm_array_header_t *arr = (lbm_array_header_t*)arr_car;
 
   if (lbm_is_number(ctx->r)) {
     ((uint8_t*)arr->data)[ix] = (uint8_t)lbm_dec_as_u32(ctx->r);
@@ -4535,6 +4635,7 @@ static const cont_fun continuations[NUM_CONTINUATIONS] =
     cont_loop_condition,
     cont_merge_rest,
     cont_merge_layer,
+    cont_closure_args_rest,
   };
 
 /*********************************************************/

src/extensions/array_extensions.c

@@ -102,7 +102,6 @@ lbm_value array_extension_unsafe_free_array(lbm_value *args, lbm_uint argn) {
     return res;
   }
   lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
-  if (array == NULL) return ENC_SYM_FATAL_ERROR;
   if (lbm_memory_ptr_inside(array->data)) {
     lbm_memory_free((lbm_uint *)array->data);
     lbm_uint ptr = lbm_dec_ptr(args[0]);
@@ -126,7 +125,6 @@ lbm_value array_extension_buffer_append_i8(lbm_value *args, lbm_uint argn) {
       return res;
     }
     lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
-    if (array == NULL) return ENC_SYM_FATAL_ERROR;
     lbm_uint index = lbm_dec_as_u32(args[1]);
     lbm_int value = lbm_dec_as_i32(args[2]);
 
@@ -161,7 +159,6 @@ lbm_value array_extension_buffer_append_i16(lbm_value *args, lbm_uint argn) {
       return res;
     }
     lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
-    if (array == NULL) return ENC_SYM_FATAL_ERROR;
 
     lbm_uint index = lbm_dec_as_u32(args[1]);
     lbm_int value = lbm_dec_as_i32(args[2]);
@@ -207,7 +204,6 @@ lbm_value array_extension_buffer_append_i24(lbm_value *args, lbm_uint argn) {
       return res;
     }
     lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
-    if (array == NULL) return ENC_SYM_FATAL_ERROR;
 
     lbm_uint index = lbm_dec_as_u32(args[1]);
     lbm_int value = lbm_dec_as_i32(args[2]);
@@ -255,7 +251,6 @@ lbm_value array_extension_buffer_append_i32(lbm_value *args, lbm_uint argn) {
       return res;
     }
     lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
-    if (array == NULL) return ENC_SYM_FATAL_ERROR;
 
     lbm_uint index = lbm_dec_as_u32(args[1]);
     lbm_int value = lbm_dec_as_i32(args[2]);
@@ -298,7 +293,6 @@ lbm_value array_extension_buffer_append_u8(lbm_value *args, lbm_uint argn) {
       return res;
     }
     lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
-    if (array == NULL) return ENC_SYM_FATAL_ERROR;
 
     lbm_uint index = lbm_dec_as_u32(args[1]);
     lbm_uint value = lbm_dec_as_u32(args[2]);
@@ -337,7 +331,6 @@ lbm_value array_extension_buffer_append_u16(lbm_value *args, lbm_uint argn) {
       return res;
     }
     lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
-    if (array == NULL) return ENC_SYM_FATAL_ERROR;
 
     lbm_uint index = lbm_dec_as_u32(args[1]);
     lbm_uint value = lbm_dec_as_u32(args[2]);
@@ -383,7 +376,6 @@ lbm_value array_extension_buffer_append_u24(lbm_value *args, lbm_uint argn) {
       return res;
     }
     lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
-    if (array == NULL) return ENC_SYM_FATAL_ERROR;
 
     lbm_uint index = lbm_dec_as_u32(args[1]);
     lbm_uint value = lbm_dec_as_u32(args[2]);
@@ -431,7 +423,6 @@ lbm_value array_extension_buffer_append_u32(lbm_value *args, lbm_uint argn) {
       return res;
     }
     lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
-    if (array == NULL) return ENC_SYM_FATAL_ERROR;
 
     lbm_uint index = lbm_dec_as_u32(args[1]);
     lbm_uint value = lbm_dec_as_u32(args[2]);
@@ -525,7 +516,6 @@ lbm_value array_extension_buffer_append_f32(lbm_value *args, lbm_uint argn) {
       return res;
     }
     lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
-    if (array == NULL) return ENC_SYM_FATAL_ERROR;
 
     float f_value = (float)lbm_dec_as_float(args[2]);
     lbm_value value = float_to_u(f_value);
@@ -568,7 +558,6 @@ lbm_value array_extension_buffer_get_i8(lbm_value *args, lbm_uint argn) {
       return res;
     }
     lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
-    if (array == NULL) return ENC_SYM_FATAL_ERROR;
 
     lbm_uint index = lbm_dec_as_u32(args[1]);
     lbm_uint value = 0;
@@ -602,7 +591,6 @@ lbm_value array_extension_buffer_get_i16(lbm_value *args, lbm_uint argn) {
       return res;
     }
     lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
-    if (array == NULL) return ENC_SYM_FATAL_ERROR;
 
     lbm_uint index = lbm_dec_as_u32(args[1]);
     lbm_uint value = 0;
@@ -648,7 +636,6 @@ lbm_value array_extension_buffer_get_i32(lbm_value *args, lbm_uint argn) {
       return res;
     }
     lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
-    if (array == NULL) return ENC_SYM_FATAL_ERROR;
 
     lbm_uint index = lbm_dec_as_u32(args[1]);
     uint32_t value = 0;
@@ -690,7 +677,6 @@ lbm_value array_extension_buffer_get_u8(lbm_value *args, lbm_uint argn) {
       return res;
     }
     lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
-    if (array == NULL) return ENC_SYM_FATAL_ERROR;
 
     lbm_uint index = lbm_dec_as_u32(args[1]);
     lbm_int value = 0;
@@ -725,7 +711,6 @@ lbm_value array_extension_buffer_get_u16(lbm_value *args, lbm_uint argn) {
       return res;
     }
     lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
-    if (array == NULL) return ENC_SYM_FATAL_ERROR;
 
     lbm_uint index = lbm_dec_as_u32(args[1]);
     lbm_int value = 0;
@@ -771,7 +756,6 @@ lbm_value array_extension_buffer_get_u24(lbm_value *args, lbm_uint argn) {
       return res;
     }
     lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
-    if (array == NULL) return ENC_SYM_FATAL_ERROR;
 
     lbm_uint index = lbm_dec_as_u32(args[1]);
     lbm_int value = 0;
@@ -820,7 +804,6 @@ lbm_value array_extension_buffer_get_u32(lbm_value *args, lbm_uint argn) {
       return res;
     }
     lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
-    if (array == NULL) return ENC_SYM_FATAL_ERROR;
 
     lbm_uint index = lbm_dec_as_u32(args[1]);
     uint32_t value = 0;
@@ -870,7 +853,6 @@ lbm_value array_extension_buffer_get_f32(lbm_value *args, lbm_uint argn) {
       return res;
     }
     lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
-    if (array == NULL) return ENC_SYM_FATAL_ERROR;
 
     uint32_t index = (uint32_t)lbm_dec_as_u32(args[1]);
     uint32_t value = 0;
@@ -907,7 +889,6 @@ lbm_value array_extension_buffer_length(lbm_value *args, lbm_uint argn) {
   if (argn == 1 &&
       lbm_is_array_r(args[0])) {
     lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]);
-    if (array == NULL) return ENC_SYM_FATAL_ERROR;
     res = lbm_enc_i((lbm_int)array->size);
   }
   return res;

src/extensions/string_extensions.c

@@ -211,12 +211,6 @@ static lbm_value ext_str_split(lbm_value *args, lbm_uint argn) {
   if (!split) {
     if (lbm_is_number(args[1])) {
       step = MAX(lbm_dec_as_i32(args[1]), 1);
-    } else {
-      return ENC_SYM_TERROR;
-    }
-  }
-
-  if (step > 0) {
       lbm_value res = ENC_SYM_NIL;
       int len = (int)strlen(str);
       for (int i = len / step;i >= 0;i--) {
@@ -240,8 +234,10 @@ static lbm_value ext_str_split(lbm_value *args, lbm_uint argn) {
           return ENC_SYM_MERROR;
         }
       }
-
       return res;
+    } else {
+      return ENC_SYM_TERROR;
+    }
   } else {
      lbm_value res = ENC_SYM_NIL;
     const char *s = str;
@@ -257,10 +253,8 @@ static lbm_value ext_str_split(lbm_value *args, lbm_uint argn) {
       } else {
         return ENC_SYM_MERROR;
       }
-
       s += len;
     }
-
     return lbm_list_destructive_reverse(res);
   }
 }
@@ -291,7 +285,7 @@ static lbm_value ext_str_replace(lbm_value *args, lbm_uint argn) {
   }
 
   // See https://stackoverflow.com/questions/779875/what-function-is-to-replace-a-substring-from-a-string-in-c
-  char *result; // the return string
+  //char *result; // the return string
   char *ins;    // the next insert point
   char *tmp;    // varies
   size_t len_rep;  // length of rep (the string to remove)
@@ -316,7 +310,7 @@ static lbm_value ext_str_replace(lbm_value *args, lbm_uint argn) {
   lbm_value lbm_res;
   if (lbm_create_array(&lbm_res, len_res)) {
     lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(lbm_res);
-    tmp = result = (char*)arr->data;
+    tmp = (char*)arr->data;
   } else {
     return ENC_SYM_MERROR;
   }
@@ -503,6 +497,34 @@ static lbm_value ext_str_len(lbm_value *args, lbm_uint argn) {
   return lbm_enc_i((int)strlen_max(str, array->size));
 }
 
+static lbm_value ext_str_replicate(lbm_value *args, lbm_uint argn) {
+  if (argn != 2) {
+    lbm_set_error_reason((char*)lbm_error_str_num_args);
+    return ENC_SYM_EERROR;
+  }
+
+  lbm_value res = ENC_SYM_TERROR;
+
+  if (lbm_is_number(args[0]) &&
+      lbm_is_number(args[1])) {
+    uint32_t len = lbm_dec_as_u32(args[0]);
+    uint8_t c = lbm_dec_as_char(args[1]);
+
+    lbm_value lbm_res;
+    if (lbm_create_array(&lbm_res, len + 1)) {
+      lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(lbm_res);
+      for (unsigned int i = 0;i < len;i++) {
+        ((char*)(arr->data))[i] = (char)c;
+      }
+      ((char*)(arr->data))[len] = '\0';
+      res = lbm_res;
+    } else {
+      res = ENC_SYM_MERROR;
+    }
+  }
+  return res;
+}
+
 
 
 bool lbm_string_extensions_init(void) {
@@ -521,6 +543,7 @@ bool lbm_string_extensions_init(void) {
   res = res && lbm_add_extension("to-str", ext_to_str);
   res = res && lbm_add_extension("to-str-delim", ext_to_str_delim);
   res = res && lbm_add_extension("str-len", ext_str_len);
+  res = res && lbm_add_extension("str-replicate", ext_str_replicate);
 
   return res;
 }

src/fundamental.c

@@ -23,6 +23,7 @@
 #include "env.h"
 #include "lbm_utils.h"
 #include "lbm_custom_type.h"
+#include "lbm_constants.h"
 
 #include <stdio.h>
 #include <math.h>
@@ -334,27 +335,6 @@ static void array_create(lbm_value *args, lbm_uint nargs, lbm_value *result) {
   }
 }
 
-static lbm_value index_list(lbm_value l, int32_t n) {
-  lbm_value curr = l;
-
-  if (n < 0) {
-    int32_t len = (int32_t)lbm_list_length(l);
-    n = len + n;
-    if (n < 0) return ENC_SYM_NIL;
-  }
-
-  while (lbm_is_cons(curr) &&
-          n > 0) {
-    curr = lbm_cdr(curr);
-    n --;
-  }
-  if (lbm_is_cons(curr)) {
-    return lbm_car(curr);
-  } else {
-    return ENC_SYM_NIL;
-  }
-}
-
 static lbm_value assoc_lookup(lbm_value key, lbm_value assoc) {
   lbm_value curr = assoc;
   while (lbm_is_cons(curr)) {
@@ -467,14 +447,13 @@ static lbm_value fundamental_div(lbm_value *args, lbm_uint nargs, eval_context_t
 
 static lbm_value fundamental_mod(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
   (void) ctx;
-
-  lbm_uint res = args[0];
-  for (lbm_uint i = 1; i < nargs; i ++) {
-    res = mod2(res, args[i]);
-    if (lbm_type_of(res) == LBM_TYPE_SYMBOL) {
-      break;
-    }
+  if (nargs != 2) {
+    lbm_set_error_reason((char*)lbm_error_str_num_args);
+    return ENC_SYM_EERROR;
   }
+  lbm_value res = args[0];
+  lbm_value arg2 = args[1];
+  res = mod2(res, arg2);
   return res;
 }
 
@@ -774,7 +753,7 @@ static lbm_value fundamental_append(lbm_value *args, lbm_uint nargs, eval_contex
     }
     curr = args[i];
     for (int j = n-1; j >= 0; j --) {
-      res = lbm_cons(index_list(curr,j),res);
+      res = lbm_cons(lbm_index_list(curr,j),res);
     }
   }
   return(res);
@@ -842,11 +821,13 @@ static lbm_value fundamental_symbol_to_string(lbm_value *args, lbm_uint nargs, e
 static lbm_value fundamental_string_to_symbol(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
   (void) ctx;
   lbm_value result = ENC_SYM_EERROR;
-  if (nargs < 1 ||
-      lbm_is_array_r(args[0]))
-    return result;
+  if (nargs == 1 &&
+      lbm_is_array_r(args[0])) {
     lbm_array_header_t *arr = (lbm_array_header_t *)lbm_car(args[0]);
-  if (!arr) return ENC_SYM_FATAL_ERROR;
+    // TODO: String to symbol, string should be in LBM_memory..
+    // Some better sanity check is possible here.
+    // Check that array points into lbm_memory.
+    // Additionally check that it is a zero-terminated string.
     char *str = (char *)arr->data;
     lbm_uint sym;
     if (lbm_get_symbol_by_name(str, &sym)) {
@@ -854,6 +835,7 @@ static lbm_value fundamental_string_to_symbol(lbm_value *args, lbm_uint nargs, e
     } else if (lbm_add_symbol(str, &sym)) {
       result = lbm_enc_sym(sym);
     }
+  }
   return result;
 }
 
@@ -1009,7 +991,7 @@ static lbm_value fundamental_ix(lbm_value *args, lbm_uint nargs, eval_context_t
   (void) ctx;
   lbm_value result = ENC_SYM_EERROR;
   if (nargs == 2 && IS_NUMBER(args[1])) {
-    result = index_list(args[0], lbm_dec_as_i32(args[1]));
+    result = lbm_index_list(args[0], lbm_dec_as_i32(args[1]));
   }
   return result;
 }

src/heap.c

@@ -536,10 +536,9 @@ lbm_value lbm_heap_allocate_cell(lbm_type ptr_type, lbm_value car, lbm_value cdr
     // all is as it should be (but no free cells)
     return ENC_SYM_MERROR;
   }
-  else {
+  // Unreachable, unless something very wrong
   return ENC_SYM_FATAL_ERROR;
 }
-}
 
 lbm_value lbm_heap_allocate_list(lbm_uint n) {
   if (n == 0) return ENC_SYM_NIL;
@@ -1065,6 +1064,28 @@ lbm_value lbm_list_drop(unsigned int n, lbm_value ls) {
   return curr;
 }
 
+lbm_value lbm_index_list(lbm_value l, int32_t n) {
+  lbm_value curr = l;
+
+  if (n < 0) {
+    int32_t len = (int32_t)lbm_list_length(l);
+    n = len + n;
+    if (n < 0) return ENC_SYM_NIL;
+  }
+
+  while (lbm_is_cons(curr) &&
+          n > 0) {
+    curr = lbm_cdr(curr);
+    n --;
+  }
+  if (lbm_is_cons(curr)) {
+    return lbm_car(curr);
+  } else {
+    return ENC_SYM_NIL;
+  }
+}
+
+
 
 // Arrays are part of the heap module because their lifespan is managed
 // by the garbage collector. The data in the array is not stored

src/symrepr.c

@@ -76,6 +76,7 @@ special_sym const special_symbols[] =  {
   {"sort"         , SYM_SORT},
   {"gc"           , SYM_PERFORM_GC},
   {"loop"         , SYM_LOOP},
+  {"rest-args"    , SYM_REST_ARGS},
 
   // pattern matching
   {"?"          , SYM_MATCH_ANY},
@@ -243,8 +244,8 @@ int lbm_symrepr_init(void) {
   symbol_table_size_strings = 0;
   symbol_table_size_strings_flash = 0;
 
-  lbm_uint x;
-  lbm_uint y;
+  lbm_uint x = 0;
+  lbm_uint y = 0;
   lbm_add_symbol("x", &x);
   lbm_add_symbol("y", &y);
   symbol_x = lbm_enc_sym(x);

tests/test_rest_args_1.lisp

@@ -0,0 +1,6 @@
+
+(defun f (x) (rest-args))
+
+
+
+(check (eq (f 1) nil)) 

tests/test_rest_args_2.lisp

@@ -0,0 +1,6 @@
+
+(defun f (x)
+  (map (lambda (y) (+ x y)) (rest-args) ))
+
+
+(check (eq (f 1 1 1) '(2 2)))

tests/test_rest_args_3.lisp

@@ -0,0 +1,10 @@
+
+
+(defun f (x)
+  (lambda (y) (rest-args)))
+
+
+(define g (f 1 2 3 4 5))
+
+(check (and (eq (g 1) '(2 3 4 5))
+            (eq (g 1 2) '(2))))

tests/test_rest_args_4.lisp

@@ -0,0 +1,10 @@
+
+(defun f (x)
+  (let ( (g (lambda (y) (rest-args))) )
+    (g 1 2 3 4 5 6)
+    ))
+
+
+
+(check (and (eq (f 1) '(2 3 4 5 6))
+            (eq (f 1 2) '(2 3 4 5 6))))