core: Quoted internals are symbols.

* mes.c (begin_env): Rename from begin.  Update callers.
  (scm_begin, scm_if, scm_define, scm_set_x): Rename from symbol_*.
  (symbol_begin, symbol_define, symbol_if, scm_lambda, scm_set_x): New symbols.
  (mes_environment): Add them to environment, SYMBOL->SCM.
* define.c (define_env): Rename from define.  Update callers.
* build-aux/mes-snarf.scm: Shadow internals (SCM) by their symbol.

diff --git a/build-aux/mes-snarf.scm b/build-aux/mes-snarf.scm
index bc5456ea8a28dc0cfd90cfd9eed8c4b097631017..02c7f0ef8bdf0619e5b67c235ea8c37b8f3abb64 100755 (executable)
--- a/build-aux/mes-snarf.scm
+++ b/build-aux/mes-snarf.scm
@@ -80,7 +80,8 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e
                    (format #f "scm ~a = {FUNCTION~a, .name=~S, .function~a=&~a};\n" (function-builtin-name f) n (function-scm-name f) n (.name f)))))
 
 (define (snarf-symbols string)
-  (let* ((matches (list-matches "\nscm ([a-z_0-9]+) = [{](SCM|SYMBOL)," string)))
+  (let* ((matches (append (list-matches "\nscm ([a-z_0-9]+) = [{](SCM)," string)
+                          (list-matches "\nscm ([a-z_0-9]+) = [{](SYMBOL)," string))))
     (map (cut match:substring <> 1) matches)))
 
 (define (snarf-functions string)

diff --git a/define.c b/define.c
index fd6c87e336d706de39e37b2dbe1c6ac32e64eb16..50f41eb373640edb81f693cde96b373f81cd5a70 100644 (file)
--- a/define.c
+++ b/define.c
@@ -20,7 +20,7 @@
 
 #if !BOOT
 scm *
-define (scm *x, scm *a)
+define_env (scm *x, scm *a)
 {
   scm *e;
   scm *name = cadr (x);
@@ -43,7 +43,7 @@ define (scm *x, scm *a)
   return entry;
 }
 #else // BOOT
-scm*define (scm *x, scm *a){}
+scm*define_env (scm *x, scm *a){}
 #endif
 
 scm *

diff --git a/mes.c b/mes.c
index 47feb1f7be3eb21a149aa23de8d1158899eac82b..dc35644abc0c44be95312eaf85046504fa5c8f61 100644 (file)
--- a/mes.c
+++ b/mes.c
@@ -86,13 +86,14 @@ scm scm_circular = {SCM, "*circular*"};
 scm scm_label = {
   SCM, "label"};
 #endif
-scm scm_lambda = {SCM, "lambda"};
+scm scm_begin = {SCM, "begin"};
 
-scm symbol_begin = {SCM, "begin"};
-scm symbol_if = {SCM, "if"};
-scm symbol_define = {SCM, "define"};
+scm symbol_lambda = {SYMBOL, "lambda"};
+scm symbol_begin = {SYMBOL, "begin"};
+scm symbol_if = {SYMBOL, "if"};
+scm symbol_define = {SYMBOL, "define"};
 scm symbol_define_macro = {SCM, "define-macro"};
-scm symbol_set_x = {SCM, "set!"};
+scm symbol_set_x = {SYMBOL, "set!"};
 
 scm symbol_quote = {SYMBOL, "quote"};
 scm symbol_quasiquote = {SYMBOL, "quasiquote"};
@@ -359,10 +360,10 @@ apply_env (scm *fn, scm *x, scm *a)
         return call (&scm_call_with_values_env, append2 (x, cons (a, &scm_nil)));
       if (fn == &symbol_current_module) return a;
     }
-  else if (fn->car == &scm_lambda) {
+  else if (fn->car == &symbol_lambda) {
     scm *p = pairlis (cadr (fn), x, a);
     cache_invalidate_range (p, a->cdr);
-    scm *r = begin (cddr (fn), cons (cons (&scm_closure, p), p));
+    scm *r = begin_env (cddr (fn), cons (cons (&scm_closure, p), p));
     cache_invalidate_range (p, a->cdr);
     return r;
   }
@@ -373,7 +374,7 @@ apply_env (scm *fn, scm *x, scm *a)
     a = cdr (a);
     scm *p = pairlis (args, x, a);
     cache_invalidate_range (p, a->cdr);
-    scm *r = begin (body, cons (cons (&scm_closure, p), p));
+    scm *r = begin_env (body, cons (cons (&scm_closure, p), p));
     cache_invalidate_range (p, a->cdr);
     return r;
   }
@@ -422,8 +423,8 @@ builtin_eval (scm *e, scm *a)
         return e;
 #endif
       if (e->car == &symbol_begin)
-        return begin (e, a);
-      if (e->car == &scm_lambda)
+        return begin_env (e, a);
+      if (e->car == &symbol_lambda)
         return make_closure (cadr (e), cddr (e), assq (&scm_closure, a));
       if (e->car == &scm_closure)
         return e;
@@ -431,9 +432,9 @@ builtin_eval (scm *e, scm *a)
         return builtin_if (cdr (e), a);
 #if !BOOT
       if (e->car == &symbol_define)
-        return define (e, a);
+        return define_env (e, a);
       if (e->car == &symbol_define_macro)
-        return define (e, a);
+        return define_env (e, a);
 #else
       if (e->car == &symbol_define) {
         fprintf (stderr, "C DEFINE: ");
@@ -496,7 +497,7 @@ sc_expand_env (scm *e, scm *a)
 }
 
 scm *
-begin (scm *e, scm *a)
+begin_env (scm *e, scm *a)
 {
   scm *r = &scm_unspecified;
   while (e != &scm_nil) {
@@ -1106,6 +1107,7 @@ mes_environment () ///((internal))
   symbols = cons (&scm_label, symbols);
   a = cons (cons (&scm_label, &scm_t), a);
 #endif
+  a = cons (cons (&symbol_begin, &scm_begin), a);
 
 #include "string.environment.i"
 #include "math.environment.i"
@@ -1123,7 +1125,7 @@ mes_environment () ///((internal))
 scm *
 make_lambda (scm *args, scm *body)
 {
-  return cons (&scm_lambda, cons (args, body));
+  return cons (&symbol_lambda, cons (args, body));
 }
 
 scm *
@@ -1151,7 +1153,7 @@ read_file_env (scm *e, scm *a)
 scm *
 load_file_env (scm *a)
 {
-  return begin (read_file_env (read_env (a), a), a);
+  return begin_env (read_file_env (read_env (a), a), a);
 }
 
 #include "type.c"

diff --git a/tests/base.test b/tests/base.test
index 6c32f2115c557c00cdc6f6e8d7c0e171c79c4e59..b9d2ffe5f4962fe275dcda960f7915a183e4a2d2 100755 (executable)
--- a/tests/base.test
+++ b/tests/base.test
@@ -34,6 +34,7 @@ exit $?
 
 
 (pass-if "begin" (seq? (begin 'a 'b (+ 1 2)) 3))
+(pass-if "lambda" (symbol? 'lambda))
 
 (begin (define *top-begin-a* '*top-begin-a*))
 (pass-if "top begin " (seq? *top-begin-a* '*top-begin-a*))