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

12
mes.c
View file

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

2
mes.mes
View file

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