core: Fix error message when macro is missing.
authorJan Nieuwenhuizen <janneke@gnu.org>
Mon, 27 Mar 2017 18:14:48 +0000 (20:14 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Mon, 27 Mar 2017 18:14:48 +0000 (20:14 +0200)
* mes.c (scm_vm_eval_check_func): New symbol.
  (eval_apply): In eval, evaluate car before evlis.  Fixes error
  message when macro match is missing in (match ... (car x)).
  (mes_symbols): Add cell_call_with_values, cell_current_module to environment.
* scaffold/mini-mes.c (eval_apply): Likewise.

mes.c
module/mes/read-0-32.mo
scaffold/mini-mes.c

diff --git a/mes.c b/mes.c
index 48b828b44c1d701f6faef152e1c9e09633bbd33c..8d27985361d25e8b6a886b3244a251f1d37ada00 100644 (file)
--- a/mes.c
+++ b/mes.c
@@ -147,6 +147,7 @@ struct scm scm_vm_eval_null_p = {TSPECIAL, "*vm-eval-null-p*",0};
 
 struct scm scm_vm_eval_set_x = {TSPECIAL, "*vm-eval-set!*",0};
 struct scm scm_vm_eval_macro = {TSPECIAL, "*vm-eval-macro*",0};
+struct scm scm_vm_eval_check_func = {TSPECIAL, "*vm-eval-check-func*",0};
 struct scm scm_vm_eval2 = {TSPECIAL, "*vm-eval2*",0};
 struct scm scm_vm_macro_expand = {TSPECIAL, "core:macro-expand",0};
 struct scm scm_vm_begin = {TSPECIAL, "*vm-begin*",0};
@@ -586,6 +587,7 @@ eval_apply ()
 #endif
     case cell_vm_eval_set_x: goto eval_set_x;
     case cell_vm_eval_macro: goto eval_macro;
+    case cell_vm_eval_check_func: goto eval_check_func;
     case cell_vm_eval2: goto eval2;
     case cell_vm_macro_expand: goto macro_expand;
     case cell_vm_begin: goto begin;
@@ -777,7 +779,9 @@ eval_apply ()
                   }
                 goto eval;
               }
-            push_cc (CDR (r1), r1, r0, cell_vm_eval2); goto evlis;
+            push_cc (car (r1), r1, r0, cell_vm_eval_check_func); goto eval;
+            eval_check_func:
+            push_cc (CDR (r2), r2, r0, cell_vm_eval2); goto evlis;
             eval2:
             r1 = cons (car (r2), r1);
             goto apply;
@@ -986,6 +990,8 @@ mes_symbols () ///((internal))
 #endif
   a = acons (cell_symbol_dot, cell_dot, a);
   a = acons (cell_symbol_begin, cell_begin, a);
+  a = acons (cell_symbol_call_with_values, cell_symbol_call_with_values, a);
+  a = acons (cell_symbol_current_module, cell_symbol_current_module, a);
   a = acons (cell_symbol_call_with_current_continuation, cell_call_with_current_continuation, a);
   a = acons (cell_symbol_sc_expand, cell_f, a);
 
index ed377e94d7b802ac5c219dc6d23ed91accc452d4..78d97a834ddf85f4f968e0ae96154f290492dfaf 100644 (file)
Binary files a/module/mes/read-0-32.mo and b/module/mes/read-0-32.mo differ
index 4b5a5315b1e6563b0c12f1c88a4403d29eb0043e..e25e2c93c96a1fe74ac264630921b11291bfdd09 100644 (file)
@@ -142,6 +142,7 @@ struct scm scm_vm_eval_null_p = {TSPECIAL, "*vm-eval-null-p*",0};
 
 struct scm scm_vm_eval_set_x = {TSPECIAL, "*vm-eval-set!*",0};
 struct scm scm_vm_eval_macro = {TSPECIAL, "*vm-eval-macro*",0};
+struct scm scm_vm_eval_check_func = {TSPECIAL, "*vm-eval-check-func*",0};
 struct scm scm_vm_eval2 = {TSPECIAL, "*vm-eval2*",0};
 struct scm scm_vm_macro_expand = {TSPECIAL, "core:macro-expand",0};
 struct scm scm_vm_begin = {TSPECIAL, "*vm-begin*",0};
@@ -675,6 +676,7 @@ eval_apply ()
 #endif
     case cell_vm_eval_set_x: goto eval_set_x;
     case cell_vm_eval_macro: goto eval_macro;
+    case cell_vm_eval_check_func: goto eval_check_func;
     case cell_vm_eval2: goto eval2;
     case cell_vm_macro_expand: goto macro_expand;
     case cell_vm_begin: goto begin;
@@ -865,7 +867,9 @@ eval_apply ()
                   }
                 goto eval;
               }
-            push_cc (CDR (r1), r1, r0, cell_vm_eval2); goto evlis;
+            push_cc (car (r1), r1, r0, cell_vm_eval_check_func); goto eval;
+            eval_check_func:
+            push_cc (CDR (r2), r2, r0, cell_vm_eval2); goto evlis;
             eval2:
             r1 = cons (car (r2), r1);
             goto apply;
@@ -1549,6 +1553,8 @@ mes_symbols () ///((internal))
 
   a = acons (cell_symbol_dot, cell_dot, a);
   a = acons (cell_symbol_begin, cell_begin, a);
+  a = acons (cell_symbol_call_with_values, cell_symbol_call_with_values, a);
+  a = acons (cell_symbol_current_module, cell_symbol_current_module, a);
   a = acons (cell_symbol_call_with_current_continuation, cell_call_with_current_continuation, a);
   a = acons (cell_symbol_sc_expand, cell_f, a);