Squashed 'lispBM/lispBM/' changes from 4233bafe..1b286c45

1b286c45 variable_not_bound error prints the variable that is not bound
edc731ae Atomic behaves as progn does now
73ddfc5a removed the type-based pattern binders, ?i, ?i32 ...

git-subtree-dir: lispBM/lispBM
git-subtree-split: 1b286c454af350df93fda02f86e356861e06a399

doc/lbmref.md

@@ -1209,45 +1209,6 @@ An example that evaluates to 19.
 
 ---
 
-### ?i
-
-The `?i` pattern matches an integer (28bit integer on 32bit platforms
-and a 56bit integer on 64bit platforms) and binds that value to a
-variable.  Using the ?i pattern is done as `(?i var)` and the part
-of the expression that matches is bound to the `var`.
-
-The following example evaluates to `not-an-i`.
-```clj
-(match 3.14
-       ( (?i n) (+ n 1))
-       ( _ 'not-an-i))
-```
-The example below evaluates to 5.
-```clj
-(match 4
-       ( (?i n) (+ n 1))
-       ( _ 'not-an-i))
-```
-
-
----
-
-### ?u
-
-The `?u` pattern matches any unsigned and binds that value to a variable.
-Using the ?u pattern is done as `(?u var)` and the part of the expression
-that matches is bound to the `var`.
-
----
-
-### ?float
-
-The `?float` pattern matches any float and binds that value to a
-variable.  Using the `?float` pattern is done as `(?float var)` and
-the part of the expression that matches is bound to the `var`.
-
----
-
 ## Concurrency
 
 The concurrency support in LispBM is provided by the set of functions,
@@ -1318,17 +1279,16 @@ is number indicating at least how many microseconds the process should sleep.
 
 ### atomic
 
-`atomic` can be used to execute a LispBM expression without allowing
+`atomic` can be used to execute a LispBM one or more expression without allowing
-the runtime system to switch task during the time that takes.
+the runtime system to switch task during that time.
 
 An example that atomically perfoms operations a,b and c.
 
 ```clj
 (atomic
-   (progn
      a
      b
-     c))
+     c)
 ```
 ---
 

include/heap.h

@@ -722,16 +722,7 @@ static inline bool lbm_is_macro(lbm_value exp) {
 static inline bool lbm_is_match_binder(lbm_value exp) {
   return ((lbm_type_of(exp) == LBM_TYPE_CONS) &&
           (lbm_type_of(lbm_car(exp)) == LBM_TYPE_SYMBOL) &&
-          ((lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_ANY) ||
+          ((lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_ANY)));
-           (lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_I) ||
-           (lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_U) ||
-           (lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_I32) ||
-           (lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_U32) ||
-           (lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_FLOAT) ||
-           (lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_I64) ||
-           (lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_U64) ||
-           (lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_DOUBLE) ||
-           (lbm_dec_sym(lbm_car(exp)) == SYM_MATCH_CONS)));
 }
 
 static inline bool lbm_is_comma_qualified_symbol(lbm_value exp) {

include/lbm_defines.h

@@ -141,15 +141,6 @@
 
 #define SYM_NO_MATCH       0x40
 #define SYM_MATCH_ANY      0x41
-#define SYM_MATCH_I        0x42
-#define SYM_MATCH_U        0x43
-#define SYM_MATCH_U32      0x44
-#define SYM_MATCH_I32      0x45
-#define SYM_MATCH_FLOAT    0x46
-#define SYM_MATCH_CONS     0x47
-#define SYM_MATCH_U64      0x48
-#define SYM_MATCH_I64      0x49
-#define SYM_MATCH_DOUBLE   0x4A
 
 // Type identifying symbols
 #define SYM_TYPE_LIST      0x50

src/eval_cps.c

@@ -305,6 +305,11 @@ void print_error_message(lbm_value error, unsigned int row, unsigned int col) {
 
   lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES, error);
   printf_callback("***\tError:\t%s\n", buf);
+  if (lbm_is_symbol(error) &&
+      error == ENC_SYM_NOT_FOUND) {
+    lbm_print_value(buf, ERROR_MESSAGE_BUFFER_SIZE_BYTES, ctx_running->curr_exp);
+    printf_callback("***\t\t%s\n",buf);
+  }
 
   if (lbm_is_symbol(error) &&
       error == ENC_SYM_RERROR) {
@@ -920,88 +925,6 @@ static bool match(lbm_value p, lbm_value e, lbm_value *env, bool *gc) {
         return true;
       }
       break;
-    case SYM_MATCH_I:
-      if (lbm_type_of(e) == LBM_TYPE_I) {
-        if (lbm_dec_sym(var) == SYM_DONTCARE) {
-          return true;
-        } else {
-          break;
-        }
-      }
-      return false;
-    case SYM_MATCH_U:
-      if (lbm_type_of(e) == LBM_TYPE_U) {
-        if (lbm_dec_sym(var) == SYM_DONTCARE) {
-          return true;
-        } else {
-          break;
-        }
-      }
-      return false;
-    case SYM_MATCH_I32:
-      if (lbm_type_of(e) == LBM_TYPE_I32) {
-        if (lbm_dec_sym(var) == SYM_DONTCARE) {
-          return true;
-        } else {
-          break;
-        }
-      }
-      return false;
-    case SYM_MATCH_U32:
-      if (lbm_type_of(e) == LBM_TYPE_U32) {
-        if (lbm_dec_sym(var) == SYM_DONTCARE) {
-          return true;
-        } else {
-          break;
-        }
-      }
-      return false;
-
-    case SYM_MATCH_FLOAT:
-      if (lbm_type_of(e) == LBM_TYPE_FLOAT) {
-        if (lbm_dec_sym(var) == SYM_DONTCARE) {
-          return true;
-        } else {
-          break;
-        }
-      }
-      return false;
-    case SYM_MATCH_U64:
-      if (lbm_type_of(e) == LBM_TYPE_U64) {
-        if (lbm_dec_sym(var) == SYM_DONTCARE) {
-          return true;
-        } else {
-          break;
-        }
-      }
-      return false;
-    case SYM_MATCH_I64:
-      if (lbm_type_of(e) == LBM_TYPE_I64) {
-        if (lbm_dec_sym(var) == SYM_DONTCARE) {
-          return true;
-        } else {
-          break;
-        }
-      }
-      return false;
-    case SYM_MATCH_DOUBLE:
-      if (lbm_type_of(e) == LBM_TYPE_DOUBLE) {
-        if (lbm_dec_sym(var) == SYM_DONTCARE) {
-          return true;
-        } else {
-          break;
-        }
-      }
-      return false;
-    case SYM_MATCH_CONS:
-      if (lbm_type_of(e) == LBM_TYPE_CONS) {
-        if (lbm_dec_sym(var) == SYM_DONTCARE) {
-          return true;
-        } else {
-          break;
-        }
-      }
-      return false;
     default: /* this should be an error case */
       return false;
     }
@@ -1223,6 +1146,30 @@ static void eval_selfevaluating(eval_context_t *ctx) {
   ctx->app_cont = true;
 }
 
+static void eval_progn(eval_context_t *ctx) {
+  lbm_value exps = lbm_cdr(ctx->curr_exp);
+  lbm_value env  = ctx->curr_env;
+
+  if (lbm_is_cons(exps)) {
+    lbm_uint *sptr = lbm_stack_reserve(&ctx->K, 3);
+    if (!sptr) {
+      error_ctx(ENC_SYM_STACK_ERROR);
+      return;
+    }
+    sptr[0] = env;
+    sptr[1] = lbm_cdr(exps);
+    sptr[2] = PROGN_REST;
+    ctx->curr_exp = lbm_car(exps);
+    ctx->curr_env = env;
+    if (lbm_is_symbol(sptr[1])) /* The only symbol it can be is nil */
+      lbm_stack_drop(&ctx->K, 3);
+  } else if (lbm_is_symbol_nil(exps)) {
+    ctx->r = ENC_SYM_NIL;
+    ctx->app_cont = true;
+  } else {
+    error_ctx(ENC_SYM_EERROR);
+  }
+}
 
 static void eval_atomic(eval_context_t *ctx) {
   if (is_atomic) {
@@ -1233,8 +1180,7 @@ static void eval_atomic(eval_context_t *ctx) {
 
   CHECK_STACK(lbm_push(&ctx->K, EXIT_ATOMIC));
   is_atomic = true;
-  ctx->curr_exp = lbm_cadr(ctx->curr_exp);
+  eval_progn(ctx);
-  /*NOTE:  ctx->app_cont = false; */
 }
 
 
@@ -1307,31 +1253,6 @@ static void eval_define(eval_context_t *ctx) {
   return;
 }
 
-static void eval_progn(eval_context_t *ctx) {
-  lbm_value exps = lbm_cdr(ctx->curr_exp);
-  lbm_value env  = ctx->curr_env;
-
-  if (lbm_is_cons(exps)) {
-    lbm_uint *sptr = lbm_stack_reserve(&ctx->K, 3);
-    if (!sptr) {
-      error_ctx(ENC_SYM_STACK_ERROR);
-      return;
-    }
-    sptr[0] = env;
-    sptr[1] = lbm_cdr(exps);
-    sptr[2] = PROGN_REST;
-    ctx->curr_exp = lbm_car(exps);
-    ctx->curr_env = env;
-    if (lbm_is_symbol(sptr[1])) /* The only symbol it can be is nil */
-      lbm_stack_drop(&ctx->K, 3);
-  } else if (lbm_is_symbol_nil(exps)) {
-    ctx->r = ENC_SYM_NIL;
-    ctx->app_cont = true;
-  } else {
-    error_ctx(ENC_SYM_EERROR);
-  }
-}
-
 // (closure params body env)
 static lbm_value mk_closure(lbm_value env, lbm_value body, lbm_value params) {
   if (lbm_heap_num_free() < 4) {

src/symrepr.c

@@ -63,15 +63,6 @@ special_sym const special_symbols[] =  {
 
   // pattern matching
   {"?"          , SYM_MATCH_ANY},
-  {"?i"         , SYM_MATCH_I},
-  {"?u"         , SYM_MATCH_U},
-  {"?u32"       , SYM_MATCH_U32},
-  {"?i32"       , SYM_MATCH_I32},
-  {"?float"     , SYM_MATCH_FLOAT},
-  {"?cons"      , SYM_MATCH_CONS},
-  {"?u64"       , SYM_MATCH_U64},
-  {"?i64"       , SYM_MATCH_I64},
-  {"?double"    , SYM_MATCH_DOUBLE},
 
   // Error symbols with parsable names
   {"no_match"           , SYM_NO_MATCH},

src/tokpar.c

@@ -125,15 +125,6 @@ const matcher fixed_size_tokens[NUM_FIXED_SIZE_TOKENS] = {
   {"`", TOKBACKQUOTE, 1},
   {",@", TOKCOMMAAT, 2},
   {",", TOKCOMMA, 1},
-  {"?double" , TOKMATCHDOUBLE, 7},
-  {"?float", TOKMATCHFLOAT, 6},
-  {"?cons", TOKMATCHCONS, 5},
-  {"?u64", TOKMATCHU64, 4},
-  {"?i64", TOKMATCHI64, 4},
-  {"?u32", TOKMATCHU32, 4},
-  {"?i32", TOKMATCHI32, 4},
-  {"?i", TOKMATCHI28, 2},
-  {"?u", TOKMATCHU28, 2},
   {"?", TOKMATCHANY, 1}
 };
 
@@ -595,33 +586,6 @@ lbm_value lbm_get_next_token(lbm_char_channel_t *chan, bool peek) {
     case TOKCOMMA:
       res = lbm_enc_sym(SYM_COMMA);
       break;
-    case TOKMATCHI28:
-      res = lbm_enc_sym(SYM_MATCH_I);
-      break;
-    case TOKMATCHU28:
-      res = lbm_enc_sym(SYM_MATCH_U);
-      break;
-    case TOKMATCHI32:
-      res = lbm_enc_sym(SYM_MATCH_I32);
-      break;
-    case TOKMATCHU32:
-      res = lbm_enc_sym(SYM_MATCH_U32);
-      break;
-    case TOKMATCHFLOAT:
-      res = lbm_enc_sym(SYM_MATCH_FLOAT);
-      break;
-    case TOKMATCHU64:
-      res = lbm_enc_sym(SYM_MATCH_U64);
-      break;
-    case TOKMATCHI64:
-      res = lbm_enc_sym(SYM_MATCH_I64);
-      break;
-    case TOKMATCHDOUBLE:
-      res = lbm_enc_sym(SYM_MATCH_DOUBLE);
-      break;
-    case TOKMATCHCONS:
-      res = lbm_enc_sym(SYM_MATCH_CONS);
-      break;
     case TOKMATCHANY:
       res = lbm_enc_sym(SYM_MATCH_ANY);
       break;

tests/test_atomic_2.lisp

@@ -0,0 +1,7 @@
+(define foo (lambda ()
+              (atomic (+ 1 2 3)
+                      (+ 1 2 4)
+                      (+ 2 4 8)
+                      (+ 3 6 12))))
+
+(= (foo) 21)

tests/test_atomic_3.lisp

@@ -0,0 +1,7 @@
+(define foo (lambda ()
+              (atomic (progn (+ 1 2 3)
+                             (+ 1 2 4)
+                             (+ 2 4 8)
+                             (+ 3 6 12)))))
+
+(= (foo) 21)

tests/test_atomic_4.lisp

@@ -0,0 +1,7 @@
+(define foo (lambda ()
+              (atomic (progn (+ 1 2 3)
+                             (+ 1 2 4))
+                      (progn (+ 2 4 8)
+                             (+ 3 6 12)))))
+
+(= (foo) 21)

tests/test_match_3.lisp

@@ -2,7 +2,7 @@
 (define f (lambda (ls)
 	    (match ls
 		   ( nil 0 )
-		   ( (?cons c) (+ (car c) (f (cdr c))))
+		   ( ( (? c) . (? cd)) (+ c (f c)))
 		   ( _ 'error-not-a-list))))
 
 (eq (f 'kurt) 'error-not-a-list)

tests/test_match_6.lisp

@@ -1,9 +1,9 @@
 
 (defun f (x)
-  (match x
+  (match (type-of x)
-	 ((?i64 a) (+ 1 a))
+	 (type-i64 (+ 1 x))
-	 ((?u64 a) (+ 2 a))
+	 (type-u64 (+ 2 x))
-	 ((?double a) (+ 3 a))))
+	 (type-double (+ 3 x))))
 
 
 (and (= (f 1i64) 2i64)