artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

hack to print (current-module).

Browse source
This commit is contained in:
Jan Nieuwenhuizen 2016-07-09 14:58:37 +02:00
parent 989cbab16a
commit 1c6ac2b9b6
2 changed files with 15 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
mes.c
View file

@ -82,6 +82,7 @@ scm scm_symbol_unquote = {ATOM, "unquote"};
#if MACROS #if MACROS
scm scm_macro = {ATOM, "*macro*"}; scm scm_macro = {ATOM, "*macro*"};
#endif #endif
scm scm_symbol_current_module = {ATOM, "current-module"};
// PRIMITIVES // PRIMITIVES
@ -278,6 +279,8 @@ apply_ (scm *fn, scm *x, scm *a)
#endif #endif
if (atom_p (fn) != &scm_f) if (atom_p (fn) != &scm_f)
{ {
if (fn == &scm_symbol_current_module) // FIXME
return a;
if (builtin_p (fn) == &scm_t) if (builtin_p (fn) == &scm_t)
return call (fn, x); return call (fn, x);
return apply (eval (fn, a), x, a); return apply (eval (fn, a), x, a);
@ -884,7 +887,8 @@ initial_environment ()
// //
a = add_environment (a, "*macro*", &scm_nil); a = add_environment (a, "*macro*", &scm_nil);
a = add_environment (a, "*dot*", &scm_dot); a = add_environment (a, "*dot*", &scm_dot);
a = add_environment (a, "current-module", &scm_symbol_current_module);
return a; return a;
} }
@ -905,6 +909,14 @@ define (scm *x, scm *a)
scm * scm *
define_macro (scm *x, scm *a) define_macro (scm *x, scm *a)
{ {
#if DEBUG
printf ("\nc:define_macro a=");
scm *aa =cons (&scm_macro,
cons (define_lambda (x, a),
cdr (assoc (&scm_macro, a))));
display (aa);
puts ("");
#endif
return cons (&scm_macro, return cons (&scm_macro,
cons (define_lambda (x, a), cons (define_lambda (x, a),
cdr (assoc (&scm_macro, a)))); cdr (assoc (&scm_macro, a))));

2
mes.mes
View file

@ -92,6 +92,8 @@
(cond (cond
((atom fn) ((atom fn)
(cond (cond
((eq fn 'current-module) ;; FIXME
(c:apply current-module '() a))
((builtin fn) ((builtin fn)
(call fn x)) (call fn x))
(#t (apply (eval fn a) x a)))) (#t (apply (eval fn a) x a))))