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.
This commit is contained in:
Jan Nieuwenhuizen 2016-11-02 10:26:04 +01:00
parent 8a13b472e3
commit c851935d4d
4 changed files with 22 additions and 18 deletions

View file

@ -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)

View file

@ -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 *

32
mes.c
View file

@ -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"

View file

@ -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*))