update macro, fix andmap.
This commit is contained in:
parent
c1886195e6
commit
02dc00d11c
|
@ -18,6 +18,7 @@ mes.h: mes.c GNUmakefile
|
|||
scm_name=$$(echo $$name | sed -e 's,_to_,->,' -e 's,_p$$,?,' -e 's,_x$$,!,' -e 's,^builtin_,,' -re 's,(.*)_$$,c:\1,' | sed \
|
||||
-e 's,^divide$$,/,'\
|
||||
-e 's,^is?$$,=,'\
|
||||
-e 's,^greater?$$,>,'\
|
||||
-e 's,^less?$$,<,'\
|
||||
-e 's,^minus$$,-,'\
|
||||
-e 's,^multiply$$,*,'\
|
||||
|
|
31
mes.c
31
mes.c
|
@ -988,6 +988,14 @@ hello_world ()
|
|||
return &scm_unspecified;
|
||||
}
|
||||
|
||||
scm *
|
||||
greater_p (scm *a, scm *b)
|
||||
{
|
||||
assert (a->type == NUMBER);
|
||||
assert (b->type == NUMBER);
|
||||
return a->value > b->value ? &scm_t : &scm_f;
|
||||
}
|
||||
|
||||
scm *
|
||||
less_p (scm *a, scm *b)
|
||||
{
|
||||
|
@ -1123,9 +1131,9 @@ mes_environment ()
|
|||
}
|
||||
|
||||
scm *
|
||||
define_lambda (scm *x)
|
||||
make_lambda (scm *args, scm *body)
|
||||
{
|
||||
return cons (caadr (x), cons (&scm_lambda, cons (cdadr (x), cddr (x))));
|
||||
return cons (&scm_lambda, cons (args, body));
|
||||
}
|
||||
|
||||
scm *
|
||||
|
@ -1133,17 +1141,26 @@ define (scm *x, scm *a)
|
|||
{
|
||||
if (atom_p (cadr (x)) != &scm_f)
|
||||
return cons (cadr (x), eval (caddr (x), a));
|
||||
return define_lambda (x);
|
||||
return cons (caadr (x), make_lambda (cdadr (x), cddr (x)));
|
||||
}
|
||||
|
||||
scm *
|
||||
define_macro (scm *x, scm *a)
|
||||
{
|
||||
#if DEBUG
|
||||
printf ("\nc:define_macro a=");
|
||||
scm *name = caadr (x);
|
||||
scm *args = cdadr (x);
|
||||
scm *body = cddr (x);
|
||||
printf ("\nc:define_macro name=");
|
||||
display (name);
|
||||
printf (" args=");
|
||||
display (args);
|
||||
printf (" body=");
|
||||
display (body);
|
||||
printf ("\nmacro=");
|
||||
scm *aa =cons (&scm_macro,
|
||||
cons (define_lambda (x),
|
||||
cdr (assq (&scm_macro, a))));
|
||||
cons (cons (name, make_lambda (args, body)),
|
||||
cdr (assq (&scm_macro, a))));
|
||||
display (aa);
|
||||
puts ("");
|
||||
#endif
|
||||
|
@ -1152,7 +1169,7 @@ define_macro (scm *x, scm *a)
|
|||
cons (cons (cadr (x), eval (caddr (x), a)),
|
||||
cdr (assq (&scm_macro, a))));
|
||||
return cons (&scm_macro,
|
||||
cons (define_lambda (x),
|
||||
cons (cons (caadr(x), make_lambda (cdadr (x), cddr (x))),
|
||||
cdr (assq (&scm_macro, a))));
|
||||
}
|
||||
|
||||
|
|
29
scm.mes
29
scm.mes
|
@ -38,13 +38,11 @@
|
|||
(#t (memq x (cdr lst)))))
|
||||
(define memv memq)
|
||||
|
||||
(define-macro (and x y)
|
||||
(cond (x y)
|
||||
(#t #f)))
|
||||
|
||||
(define-macro (or x y)
|
||||
(cond (x x)
|
||||
(#t y)))
|
||||
(list 'cond (list x x) (list #t y)))
|
||||
|
||||
(define-macro (and x y)
|
||||
(list 'cond (list x y) (list #t #f)))
|
||||
|
||||
(define (split-params bindings params)
|
||||
(cond ((null? bindings) params)
|
||||
|
@ -82,12 +80,19 @@
|
|||
(cond (x #f)
|
||||
(#t #t)))
|
||||
|
||||
(define-macro (if expr then . else)
|
||||
(cond ((not (eq? (c:eval expr (current-module)) #f))
|
||||
then)
|
||||
(#t
|
||||
(cond ((pair? else) (car else))
|
||||
(#t *unspecified*)))))
|
||||
(define-macro (if expr then else)
|
||||
(list 'cond
|
||||
(list expr then)
|
||||
(list #t else)))
|
||||
|
||||
;;TODO
|
||||
(define-macro (iif expr then . else)
|
||||
(list 'cond
|
||||
(list expr then)
|
||||
(list #t
|
||||
(list 'cond
|
||||
(list (list 'pair? else) (list 'car else))
|
||||
(list #t '*unspecified*)))))
|
||||
|
||||
(define (unspecified-bindings bindings params)
|
||||
(cond ((null? bindings) params)
|
||||
|
|
Loading…
Reference in a new issue