Squashed 'lispBM/lispBM/' changes from 6deae379..ccca9778

ccca9778 update lbmred.md
e182bffd changed doc i28 to i
3b277e28 error message printing verbosity level can be toggled between high and low
0f00e692 update one of the call-cc tests
6a377f74 added some tests of call-cc
4f3e8adc update application of a call-cc continuation. zero arguments is ok, will apply to nil. More than 1 argument is an error and terminates the context
50fdd498 small tweaks to repl-cps

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

doc/lbmref.md

@@ -13,7 +13,7 @@ Example adding up two numbers. The result is 3.
 ```
 When adding up values of different types values are converted.
  ```clj
-(+ 1i28 3.14)
+(+ 1i 3.14)
 ```
 The example above evaluates to float value 4.14.<br>
 You can add up multiple values.
@@ -1053,9 +1053,9 @@ will block on a `recv` until there is a matching message in
 the mailbox.
 The `recv` syntax is very similar to [match](./lbmref.md#match).
 
-Example where a process waits for an i28
+Example where a process waits for an integer `?i`.
 ```clj
-(recv ( (?i28 n) (+ n 1) ))
+(recv ( (?i n) (+ n 1) ))
 ```
 
 
@@ -1223,11 +1223,18 @@ variable (symbol) that is neighter bound nor special (built-in function).
 
 ---
 
-### type-i28
+### type-i
+
+A value with type `type-i` occupy 28bits on the 32 bit version of LBM and
+56bits on the 64bit version.
 
 ---
 
-### type-u28
+### type-u
+
+A value with type `type-u` occupy 28bits on the 32 bit version of LBM and
+56bits on the 64bit version.
+
 
 ---
 
@@ -1243,6 +1250,18 @@ variable (symbol) that is neighter bound nor special (built-in function).
 
 ---
 
+### type-i64
+
+---
+
+### type-u64
+
+---
+
+### type-double
+
+---
+
 ### type-array
 
 ---

include/eval_cps.h

@@ -183,6 +183,14 @@ extern void lbm_blocked_iterator(ctx_fun f, void*, void*);
  * \param arg2 Same as above
  */
 extern void lbm_done_iterator(ctx_fun f, void*, void*);
+/** toggle verbosity level of error messages
+ */
+extern void lbm_toggle_verbose(void);
+/** Set verbosity level of lispbm error messages.
+ *
+ * \param verbose Boolean to turn verbose errors on or off.
+ */
+extern void lbm_set_verbose(bool verbose);
 /** Set a usleep callback for use by the evaluator thread.
  *
  * \param fptr Pointer to a sleep function.

include/lbm_version.h

@@ -25,10 +25,14 @@
 /** LBM minor version */
 #define LBM_MINOR_VERSION 5
 /** LBM patch revision */
-#define LBM_PATCH_VERSION 0
+#define LBM_PATCH_VERSION 1
 
 /*! \page changelog Changelog
 
+Apr 02 2022: Version 0.5.1
+ - A continuation created by call-cc can be applied to 0 or 1 argument.
+   If there are 0 arguments an implicit application to nil takes place.
+
 Mar 26 2022: Version (0.5.0)
  - Optimized code-path for closure applications.
  - 64 and 32 bit support from a single source code

repl-cps/repl.c

@@ -97,6 +97,8 @@ int inputline(char *buffer, unsigned int size) {
       continue;
     }
     switch (c) {
+    case 27:
+      break;
     case 127: /* fall through to below */
     case '\b': /* backspace character received */
       if (n > 0)
@@ -252,23 +254,6 @@ static lbm_value ext_range(lbm_value *args, lbm_uint argn) {
 }
 
 
-static lbm_value ext_get_bms_val(lbm_value *args, lbm_uint argn) {
-        lbm_value res = lbm_enc_sym(SYM_EERROR);
-
-        if (argn != 1 && argn != 2) {
-                return lbm_enc_sym(SYM_EERROR);
-        }
-
-        char *name = lbm_dec_str(args[0]);
-
-        if (!name) {
-                return lbm_enc_sym(SYM_EERROR);
-        }
-
-        res = lbm_enc_i(20);
-        return res;
-}
-
 
 /* load a file, caller is responsible for freeing the returned string */
 char * load_file(char *filename) {
@@ -416,13 +401,6 @@ int main(int argc, char **argv) {
   else
     printf("Error adding extension.\n");
 
-
-  res = lbm_add_extension("get-bms-val", ext_get_bms_val);
-  if (res)
-    printf("Extension added.\n");
-  else
-    printf("Error adding extension.\n");
-
   res = lbm_add_extension("range", ext_range);
   if (res)
     printf("Extension added.\n");
@@ -502,6 +480,9 @@ int main(int argc, char **argv) {
 
         printf("started ctx: %"PRI_UINT"\n", cid);
       }
+    } else if (n >= 5 && strncmp(str, ":verb", 5) == 0) {
+      lbm_toggle_verbose();
+      continue;
     } else if (n >= 4 && strncmp(str, ":pon", 4) == 0) {
       allow_print = true;
       continue;

src/eval_cps.c

@@ -221,6 +221,16 @@ static void (*ctx_done_callback)(eval_context_t *) = NULL;
 static int (*printf_callback)(const char *, ...) = NULL;
 static bool (*dynamic_load_callback)(const char *, const char **) = NULL;
 
+static bool lbm_verbose = false;
+
+void lbm_toggle_verbose(void) {
+  lbm_verbose = !lbm_verbose;
+}
+
+void lbm_set_verbose(bool verbose) {
+  lbm_verbose = verbose;
+}
+
 void lbm_set_usleep_callback(void (*fptr)(uint32_t)) {
   usleep_callback = fptr;
 }
@@ -350,27 +360,27 @@ void print_error_message(lbm_value error) {
   printf_callback("***\tError: %s\n\n", buf);
 
   if (ctx_running->error_reason) {
-    printf_callback("Reason:\n%s\n\n", ctx_running->error_reason);
+    printf_callback("Reason:\n\t%s\n\n", ctx_running->error_reason);
   }
+  if (lbm_verbose) {
+    lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES, ctx_running->curr_exp);
+    printf_callback("\tWhile evaluating: %s\n", buf);
+    printf_callback("\tIn context: %d\n", ctx_running->id);
+    printf_callback("\tCurrent intermediate result: %s\n\n", buf);
 
-  lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES, ctx_running->curr_exp);
-  printf_callback("\tWhile evaluating: %s\n", buf);
-  printf_callback("\tIn context: %d\n", ctx_running->id);
-  printf_callback("\tCurrent intermediate result: %s\n\n", buf);
+    print_environments(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES);
+    printf_callback("\n\n");
 
-  print_environments(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES);
-  printf_callback("\n\n");
+    printf_callback("\tError explanation:\n");
+    print_error_explanation(error, buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES);
+    printf_callback("\n\n");
 
-  printf_callback("\tError explanation:\n");
-  print_error_explanation(error, buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES);
-  printf_callback("\n\n");
-
-  printf_callback("\tStack:\n");
-  for (unsigned int i = 0; i < ctx_running->K.sp; i ++) {
-    lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES, ctx_running->K.data[i]);
-    printf_callback("\t\t%s\n", buf);
+    printf_callback("\tStack:\n");
+    for (unsigned int i = 0; i < ctx_running->K.sp; i ++) {
+      lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES, ctx_running->K.data[i]);
+      printf_callback("\t\t%s\n", buf);
+    }
   }
-
   lbm_memory_free(buf32);
 }
 
@@ -1323,11 +1333,15 @@ static inline void eval_lambda(eval_context_t *ctx) {
 
 static inline void eval_if(eval_context_t *ctx) {
 
+  lbm_value cddr = lbm_cdr(lbm_cdr(ctx->curr_exp));
+  lbm_value then_branch = lbm_car(cddr);
+  lbm_value else_branch = lbm_car(lbm_cdr(cddr));
+
   CHECK_STACK(lbm_push_4(&ctx->K,
-                             lbm_car(lbm_cdr(lbm_cdr(lbm_cdr(ctx->curr_exp)))), // Else branch
-                             lbm_car(lbm_cdr(lbm_cdr(ctx->curr_exp))),      // Then branch
-                             ctx->curr_env,
-                             lbm_enc_u(IF)));
+                         else_branch,
+                         then_branch,
+                         ctx->curr_env,
+                         lbm_enc_u(IF)));
   ctx->curr_exp = lbm_car(lbm_cdr(ctx->curr_exp));
 }
 
@@ -1579,7 +1593,9 @@ static inline void cont_application(eval_context_t *ctx) {
   lbm_value count;
   lbm_pop(&ctx->K, &count);
 
-  lbm_uint *fun_args = lbm_get_stack_ptr(&ctx->K, lbm_dec_u(count)+1);
+  lbm_uint arg_count = lbm_dec_u(count);
+
+  lbm_uint *fun_args = lbm_get_stack_ptr(&ctx->K, arg_count+1);
 
   if (fun_args == NULL) {
     ctx->r = lbm_enc_sym(SYM_FATAL_ERROR);
@@ -1594,7 +1610,15 @@ static inline void cont_application(eval_context_t *ctx) {
       error_ctx(lbm_enc_sym(SYM_FATAL_ERROR));
       return;
     }
-    lbm_value arg = fun_args[1];
+
+    lbm_value arg = NIL;
+    if (arg_count == 1) {
+      arg = fun_args[1];
+    } else if (arg_count > 1) {
+      lbm_set_error_reason("A continuation created by call-cc was applied to too many arguments (>1)");
+      error_ctx(lbm_enc_sym(SYM_EERROR));
+      return;
+    }
     lbm_stack_clear(&ctx->K);
 
     lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(c);

tests/test_callcc_1.lisp

@@ -0,0 +1,6 @@
+
+(define f (lambda (x) (+ x 1)))
+
+
+
+(= (f (call-cc (lambda (k) (k 10)))) 11)

tests/test_callcc_2.lisp

@@ -0,0 +1,3 @@
+
+
+(eq (call-cc (lambda (k) (k))) 'nil)

tests/test_callcc_3.lisp

@@ -0,0 +1,9 @@
+
+(define f (lambda (x)
+            (if (= x 0)
+                x
+                ( = 10 
+                (call-cc (lambda (k) (progn (define cc k) (f (- x 1)))))))))
+
+(f 1)
+(cc 10)