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:
parent
8a13b472e3
commit
c851935d4d
|
@ -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)))))
|
(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)
|
(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)))
|
(map (cut match:substring <> 1) matches)))
|
||||||
|
|
||||||
(define (snarf-functions string)
|
(define (snarf-functions string)
|
||||||
|
|
4
define.c
4
define.c
|
@ -20,7 +20,7 @@
|
||||||
|
|
||||||
#if !BOOT
|
#if !BOOT
|
||||||
scm *
|
scm *
|
||||||
define (scm *x, scm *a)
|
define_env (scm *x, scm *a)
|
||||||
{
|
{
|
||||||
scm *e;
|
scm *e;
|
||||||
scm *name = cadr (x);
|
scm *name = cadr (x);
|
||||||
|
@ -43,7 +43,7 @@ define (scm *x, scm *a)
|
||||||
return entry;
|
return entry;
|
||||||
}
|
}
|
||||||
#else // BOOT
|
#else // BOOT
|
||||||
scm*define (scm *x, scm *a){}
|
scm*define_env (scm *x, scm *a){}
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
scm *
|
scm *
|
||||||
|
|
32
mes.c
32
mes.c
|
@ -86,13 +86,14 @@ scm scm_circular = {SCM, "*circular*"};
|
||||||
scm scm_label = {
|
scm scm_label = {
|
||||||
SCM, "label"};
|
SCM, "label"};
|
||||||
#endif
|
#endif
|
||||||
scm scm_lambda = {SCM, "lambda"};
|
scm scm_begin = {SCM, "begin"};
|
||||||
|
|
||||||
scm symbol_begin = {SCM, "begin"};
|
scm symbol_lambda = {SYMBOL, "lambda"};
|
||||||
scm symbol_if = {SCM, "if"};
|
scm symbol_begin = {SYMBOL, "begin"};
|
||||||
scm symbol_define = {SCM, "define"};
|
scm symbol_if = {SYMBOL, "if"};
|
||||||
|
scm symbol_define = {SYMBOL, "define"};
|
||||||
scm symbol_define_macro = {SCM, "define-macro"};
|
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_quote = {SYMBOL, "quote"};
|
||||||
scm symbol_quasiquote = {SYMBOL, "quasiquote"};
|
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)));
|
return call (&scm_call_with_values_env, append2 (x, cons (a, &scm_nil)));
|
||||||
if (fn == &symbol_current_module) return a;
|
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);
|
scm *p = pairlis (cadr (fn), x, a);
|
||||||
cache_invalidate_range (p, a->cdr);
|
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);
|
cache_invalidate_range (p, a->cdr);
|
||||||
return r;
|
return r;
|
||||||
}
|
}
|
||||||
|
@ -373,7 +374,7 @@ apply_env (scm *fn, scm *x, scm *a)
|
||||||
a = cdr (a);
|
a = cdr (a);
|
||||||
scm *p = pairlis (args, x, a);
|
scm *p = pairlis (args, x, a);
|
||||||
cache_invalidate_range (p, a->cdr);
|
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);
|
cache_invalidate_range (p, a->cdr);
|
||||||
return r;
|
return r;
|
||||||
}
|
}
|
||||||
|
@ -422,8 +423,8 @@ builtin_eval (scm *e, scm *a)
|
||||||
return e;
|
return e;
|
||||||
#endif
|
#endif
|
||||||
if (e->car == &symbol_begin)
|
if (e->car == &symbol_begin)
|
||||||
return begin (e, a);
|
return begin_env (e, a);
|
||||||
if (e->car == &scm_lambda)
|
if (e->car == &symbol_lambda)
|
||||||
return make_closure (cadr (e), cddr (e), assq (&scm_closure, a));
|
return make_closure (cadr (e), cddr (e), assq (&scm_closure, a));
|
||||||
if (e->car == &scm_closure)
|
if (e->car == &scm_closure)
|
||||||
return e;
|
return e;
|
||||||
|
@ -431,9 +432,9 @@ builtin_eval (scm *e, scm *a)
|
||||||
return builtin_if (cdr (e), a);
|
return builtin_if (cdr (e), a);
|
||||||
#if !BOOT
|
#if !BOOT
|
||||||
if (e->car == &symbol_define)
|
if (e->car == &symbol_define)
|
||||||
return define (e, a);
|
return define_env (e, a);
|
||||||
if (e->car == &symbol_define_macro)
|
if (e->car == &symbol_define_macro)
|
||||||
return define (e, a);
|
return define_env (e, a);
|
||||||
#else
|
#else
|
||||||
if (e->car == &symbol_define) {
|
if (e->car == &symbol_define) {
|
||||||
fprintf (stderr, "C DEFINE: ");
|
fprintf (stderr, "C DEFINE: ");
|
||||||
|
@ -496,7 +497,7 @@ sc_expand_env (scm *e, scm *a)
|
||||||
}
|
}
|
||||||
|
|
||||||
scm *
|
scm *
|
||||||
begin (scm *e, scm *a)
|
begin_env (scm *e, scm *a)
|
||||||
{
|
{
|
||||||
scm *r = &scm_unspecified;
|
scm *r = &scm_unspecified;
|
||||||
while (e != &scm_nil) {
|
while (e != &scm_nil) {
|
||||||
|
@ -1106,6 +1107,7 @@ mes_environment () ///((internal))
|
||||||
symbols = cons (&scm_label, symbols);
|
symbols = cons (&scm_label, symbols);
|
||||||
a = cons (cons (&scm_label, &scm_t), a);
|
a = cons (cons (&scm_label, &scm_t), a);
|
||||||
#endif
|
#endif
|
||||||
|
a = cons (cons (&symbol_begin, &scm_begin), a);
|
||||||
|
|
||||||
#include "string.environment.i"
|
#include "string.environment.i"
|
||||||
#include "math.environment.i"
|
#include "math.environment.i"
|
||||||
|
@ -1123,7 +1125,7 @@ mes_environment () ///((internal))
|
||||||
scm *
|
scm *
|
||||||
make_lambda (scm *args, scm *body)
|
make_lambda (scm *args, scm *body)
|
||||||
{
|
{
|
||||||
return cons (&scm_lambda, cons (args, body));
|
return cons (&symbol_lambda, cons (args, body));
|
||||||
}
|
}
|
||||||
|
|
||||||
scm *
|
scm *
|
||||||
|
@ -1151,7 +1153,7 @@ read_file_env (scm *e, scm *a)
|
||||||
scm *
|
scm *
|
||||||
load_file_env (scm *a)
|
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"
|
#include "type.c"
|
||||||
|
|
|
@ -34,6 +34,7 @@ exit $?
|
||||||
|
|
||||||
|
|
||||||
(pass-if "begin" (seq? (begin 'a 'b (+ 1 2)) 3))
|
(pass-if "begin" (seq? (begin 'a 'b (+ 1 2)) 3))
|
||||||
|
(pass-if "lambda" (symbol? 'lambda))
|
||||||
|
|
||||||
(begin (define *top-begin-a* '*top-begin-a*))
|
(begin (define *top-begin-a* '*top-begin-a*))
|
||||||
(pass-if "top begin " (seq? *top-begin-a* '*top-begin-a*))
|
(pass-if "top begin " (seq? *top-begin-a* '*top-begin-a*))
|
||||||
|
|
Loading…
Reference in a new issue