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

macro hax0rz

Browse source
This commit is contained in:
Jan Nieuwenhuizen 2016-07-27 00:32:30 +02:00
parent ccb1d842f3
commit 56fcde0966
2 changed files with 11 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
base.mes
View file

@ -18,6 +18,9 @@
;;; You should have received a copy of the GNU General Public License ;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>. ;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define (identity x) x)
(define else #t)
(define (not x) (define (not x)
(cond (x #f) (cond (x #f)
(#t #t))) (#t #t)))

10
mes.c
View file

@ -159,6 +159,8 @@ eq_p (scm *x, scm *y)
&& atom_p (y) == &scm_t && atom_p (y) == &scm_t
&& x->type != CHAR && x->type != CHAR
&& y->type != CHAR && y->type != CHAR
&& x->type != MACRO
&& y->type != MACRO
&& x->type != NUMBER && x->type != NUMBER
&& y->type != NUMBER && y->type != NUMBER
&& x->type != STRING && x->type != STRING
@ -392,6 +394,9 @@ eval (scm *e, scm *a)
return define (e, a); return define (e, a);
if (car (e) == &symbol_set_x) if (car (e) == &symbol_set_x)
return set_env_x (cadr (e), eval (caddr (e), a), a); return set_env_x (cadr (e), eval (caddr (e), a), a);
if ((macro = assq (&symbol_sc_expand, a)) != &scm_f)
if (cdr (macro) != &scm_f)
return eval (apply_env (cdr (macro), e, a), a);
if ((macro = lookup_macro (car (e), a)) != &scm_f) if ((macro = lookup_macro (car (e), a)) != &scm_f)
return eval (apply_env (macro, cdr (e), a), a); return eval (apply_env (macro, cdr (e), a), a);
if (car (e) == &symbol_unquote) if (car (e) == &symbol_unquote)
@ -542,11 +547,12 @@ make_char (int x)
} }
scm * scm *
make_macro (scm *x) //int make_macro (scm *x, char *name)
{ {
scm *p = malloc (sizeof (scm)); scm *p = malloc (sizeof (scm));
p->type = MACRO; p->type = MACRO;
p->macro = x; p->macro = x;
p->name = name;
return p; return p;
} }
@ -1312,7 +1318,7 @@ define (scm *x, scm *a)
e = eval (make_lambda (cdadr (x), cddr (x)), p); e = eval (make_lambda (cdadr (x), cddr (x)), p);
} }
if (eq_p (car (x), &symbol_define_macro) == &scm_t) if (eq_p (car (x), &symbol_define_macro) == &scm_t)
e = make_macro (e); e = make_macro (e, name->name);
scm *entry = cons (name, e); scm *entry = cons (name, e);
scm *aa = cons (entry, &scm_nil); scm *aa = cons (entry, &scm_nil);
set_cdr_x (aa, cdr (a)); set_cdr_x (aa, cdr (a));