Squashed 'lispBM/lispBM/' changes from 0a69a489..83d186cc

83d186cc define can now be used to bind #var variables
3012709f Spawn takes an optional first argument that specifies stack size

git-subtree-dir: lispBM/lispBM
git-subtree-split: 83d186cc62a82fc333a15677a876a7a5cd7e8253

include/lbm_version.h

@@ -29,8 +29,12 @@
 
 /* Change log */
 
-/* Feb 14 2022: version 0.3.0
-   Extensions are stored in an array and occupy a range of dedicated symbol values. 
+/* Feb 16 2022: version 0.3.0
+   - #var variables with more efficient storage and lookup.
+     variables are set using `setvar`.
+   - Spawn optionally takes a number argument before the closure argument
+     to specify stack size.
+   - Extensions are stored in an array and occupy a range of dedicated symbol values.
 
 /* Feb 14 2022: version 0.2.0
    Added GEQ >= and LEQ <= comparisons.

src/eval_cps.c

@@ -49,6 +49,7 @@
 #define MATCH             12
 #define MATCH_MANY        13
 #define READ              14
+#define SET_VARIABLE      17
 
 #define CHECK_STACK(x)                          \
   if (!(x)) {                                   \
@@ -889,14 +890,21 @@ static inline void eval_define(eval_context_t *ctx) {
   lbm_value key = lbm_car(lbm_cdr(ctx->curr_exp));
   lbm_value val_exp = lbm_car(lbm_cdr(lbm_cdr(ctx->curr_exp)));
 
-  if ((lbm_type_of(key) == LBM_VAL_TYPE_SYMBOL) &&
-      (lbm_dec_sym(key) >= RUNTIME_SYMBOLS_START)) {
+  if (lbm_type_of(key) == LBM_VAL_TYPE_SYMBOL) {
+    lbm_uint sym_val = lbm_dec_sym(key);
 
+    if ((sym_val >= VARIABLE_SYMBOLS_START) &&
+        (sym_val <  VARIABLE_SYMBOLS_END)) {
+      CHECK_STACK(lbm_push_u32_2(&ctx->K, key, lbm_enc_u(SET_VARIABLE)));
+      ctx->curr_exp = val_exp;
+      return;
+    } else if (sym_val >= RUNTIME_SYMBOLS_START) {
       CHECK_STACK(lbm_push_u32_2(&ctx->K, key, lbm_enc_u(SET_GLOBAL_ENV)));
       ctx->curr_exp = val_exp;
-  } else {
-    error_ctx(lbm_enc_sym(SYM_EERROR));
+      return;
     }
+  }
+  error_ctx(lbm_enc_sym(SYM_EERROR));
   return;
 }
 
@@ -1106,12 +1114,23 @@ static inline void cont_set_global_env(eval_context_t *ctx){
   *lbm_get_env_ptr() = new_env;
   ctx->r = key;
 
-  if (!ctx->done)
+  //if (!ctx->done)
   ctx->app_cont = true;
 
   return;
 }
 
+static inline void cont_set_var(eval_context_t *ctx) {
+  lbm_value key;
+  lbm_value val = ctx->r;
+  lbm_pop_u32(&ctx->K, &key);
+
+  ctx->r = lbm_set_var(lbm_dec_sym(key), val);
+  ctx->app_cont = true;
+  return;
+}
+
+
 static inline void cont_progn_rest(eval_context_t *ctx) {
   lbm_value rest;
   lbm_value env;
@@ -1226,12 +1245,23 @@ static inline void cont_application(eval_context_t *ctx) {
         ctx->app_cont = true;
         break;
     case SYM_SPAWN: {
-      if (!lbm_is_closure(fun_args[1]) ||
+
+      lbm_uint stack_size = EVAL_CPS_DEFAULT_STACK_SIZE;
+      lbm_uint closure_pos = 1;
+
+      if (lbm_dec_u(count) >= 2 &&
+          lbm_is_number(fun_args[1]) &&
+          lbm_is_closure(fun_args[2])) {
+        stack_size = lbm_dec_as_u(fun_args[1]);
+        closure_pos = 2;
+      }
+
+      if (!lbm_is_closure(fun_args[closure_pos]) ||
           lbm_dec_u(count) < 1) {
         error_ctx(lbm_enc_sym(SYM_EERROR));
       }
 
-      lbm_value cdr_fun = lbm_cdr(fun_args[1]);
+      lbm_value cdr_fun = lbm_cdr(fun_args[closure_pos]);
       lbm_value cddr_fun = lbm_cdr(cdr_fun);
       lbm_value cdddr_fun = lbm_cdr(cddr_fun);
       lbm_value params  = lbm_car(cdr_fun);
@@ -1239,9 +1269,9 @@ static inline void cont_application(eval_context_t *ctx) {
       lbm_value clo_env = lbm_car(cdddr_fun);
 
       lbm_value curr_param = params;
-      lbm_uint i = 2;
+      lbm_uint i = closure_pos + 1;
       while (lbm_type_of(curr_param) == LBM_PTR_TYPE_CONS &&
-          i <= lbm_dec_u(count)) {
+             i <= (lbm_dec_u(count) - (closure_pos - 1))) {
 
         lbm_value entry;
         WITH_GC(entry,lbm_cons(lbm_car(curr_param),fun_args[i]), clo_env,NIL);
@@ -1262,7 +1292,7 @@ static inline void cont_application(eval_context_t *ctx) {
 
       lbm_cid cid = lbm_create_ctx(program,
                                    clo_env,
-                                   EVAL_CPS_DEFAULT_STACK_SIZE);
+                                   stack_size);
       ctx->r = lbm_enc_i(cid);
       ctx->app_cont = true;
     } break;
@@ -1812,6 +1842,7 @@ static inline void cont_read(eval_context_t *ctx) {
   }
 }
 
+
 /*********************************************************/
 /* Evaluator step function                               */
 
@@ -1841,6 +1872,7 @@ static void evaluation_step(void){
     case MATCH:            cont_match(ctx); return;
     case MATCH_MANY:       cont_match_many(ctx); return;
     case READ:             cont_read(ctx); return;
+    case SET_VARIABLE:     cont_set_var(ctx); return;
     default:
       error_ctx(lbm_enc_sym(SYM_EERROR));
       return;

src/symrepr.c

@@ -130,12 +130,12 @@ special_sym const special_symbols[NUM_SPECIAL_SYMBOLS] =  {
   {"array-write"    , SYM_ARRAY_WRITE},
 //  {"array-create"   , SYM_ARRAY_CREATE},
   {"type-of"        , SYM_TYPE_OF},
-  {"sym-to-str"     , SYM_SYMBOL_TO_STRING},
-  {"str-to-sym"     , SYM_STRING_TO_SYMBOL},
-  {"sym-to-u"       , SYM_SYMBOL_TO_UINT},
-  {"u-to-sym"       , SYM_UINT_TO_SYMBOL},
-  {"set-car"        , SYM_SET_CAR},
-  {"set-cdr"        , SYM_SET_CDR},
+  {"sym2str"        , SYM_SYMBOL_TO_STRING},
+  {"str2sym"        , SYM_STRING_TO_SYMBOL},
+  {"sym2u"          , SYM_SYMBOL_TO_UINT},
+  {"u2sym"          , SYM_UINT_TO_SYMBOL},
+  {"setcar"         , SYM_SET_CAR},
+  {"setcdr"         , SYM_SET_CDR},
 
   {"shl"            , SYM_SHL},
   {"shr"            , SYM_SHR},
@@ -144,7 +144,7 @@ special_sym const special_symbols[NUM_SPECIAL_SYMBOLS] =  {
   {"bitwise-xor"    , SYM_BITWISE_XOR},
   {"bitwise-not"    , SYM_BITWISE_NOT},
 
-  {"set-var"        , SYM_SETVAR},
+  {"setvar"         , SYM_SETVAR},
 
   // Streams
 //  {"stream-get"     , SYM_STREAM_GET},

tests/test_refmut_1.lisp

@@ -2,7 +2,7 @@
 
 (define a (cons 1 2))
 
-(set-car a 199)
+(setcar a 199)
 
 (and (= (car a) 199) (= (cdr a) 2))
 

tests/test_refmut_2.lisp

@@ -2,7 +2,7 @@
 
 (define a (cons 1 2))
 
-(set-cdr a 199)
+(setcdr a 199)
 
 (and (= (car a) 1) (= (cdr a) 199))
 

tests/test_refmut_3.lisp

@@ -1,6 +1,6 @@
 
 (define a 1)
 
-(define r (set-car a 999))
+(define r (setcar a 999))
 
 (and (not r) (= a 1))

tests/test_refmut_4.lisp

@@ -1,6 +1,6 @@
 
 (define a 1)
 
-(define r (set-cdr a 999))
+(define r (setcdr a 999))
 
 (and (not r) (= a 1))

tests/test_refmut_5.lisp

@@ -1,5 +1,5 @@
 (define a (cons 1 2))
 
-(set-car a (cons 7 8))
+(setcar a (cons 7 8))
 
 (= a (cons (cons 7 8) 2))

tests/test_refmut_6.lisp

@@ -1,5 +1,5 @@
 (define a (cons 1 2))
 
-(set-cdr a (cons 7 8))
+(setcdr a (cons 7 8))
 
 (= a (cons 1 (cons 7 8)))

tests/test_refmut_7.lisp

@@ -1,3 +1,3 @@
 (let  ((a (cons 1 2)))
-     (progn (set-car a 10)
+     (progn (setcar a 10)
 	    (= (and (car a 10) (cdr a 2))))) 

tests/test_refmut_8.lisp

@@ -1,3 +1,3 @@
 (let  ((a (cons 1 2)))
-     (progn (set-cdr a 10)
+     (progn (setcdr a 10)
 	    (= (and (car a 1) (cdr a 10)))))