mes.c: another macro clue-bat in apply. now macro.mes equals guile -s macro.mes.
This commit is contained in:
Jan Nieuwenhuizen
parent
c565e2fc22
commit
40bbb3dff1
91
macro.mes
91
macro.mes
|
|
@ -11,30 +11,77 @@
|
|||
;; (display (run 4))
|
||||
;; (newline)
|
||||
|
||||
(define (fm a)
|
||||
(define-macro (a b)
|
||||
(display b)
|
||||
(newline)))
|
||||
;; (define (fm a)
|
||||
;; (define-macro (a b)
|
||||
;; (display b)
|
||||
;; (newline)
|
||||
;; "boo"))
|
||||
|
||||
(display "f-define-macro: ")
|
||||
(fm 'dinges)
|
||||
(a c)
|
||||
;; (display "f-define-macro: ")
|
||||
;; (fm 'dinges)
|
||||
;; (a c)
|
||||
;; (newline)
|
||||
|
||||
|
||||
;; (define-macro (m a)
|
||||
;; `(define-macro (,a b)
|
||||
;; (display "b")
|
||||
;; (display b)
|
||||
;; (newline)))
|
||||
|
||||
;; (display "define-macro: ")
|
||||
;; (m dinges)
|
||||
;; (newline)
|
||||
;; (display "running dinges: ")
|
||||
;; (dinges c)
|
||||
;; (newline)
|
||||
|
||||
|
||||
(define-macro (d-s n t)
|
||||
;; (display "D-S: ")
|
||||
;; (display `(define-macro (,n . a)
|
||||
;; (,t (cons ',n a))))
|
||||
;; (newline)
|
||||
`(define-macro (,n . args)
|
||||
;; (display "CALLING: t: ")
|
||||
;; (display ,t)
|
||||
;; (display " args: ")
|
||||
;; (display (cons ',n a))
|
||||
;; (newline)
|
||||
;; (display "HALLO: ==>")
|
||||
;; (display (,t (cons ',n a)))
|
||||
;; ;; (display "HALLO: ==>")
|
||||
;; ;; (display (,t (cons ',n a)))
|
||||
;; (newline)
|
||||
(,t (cons ',n args))
|
||||
)
|
||||
)
|
||||
|
||||
(d-s s-r
|
||||
(lambda (. n-a)
|
||||
(display "YEAH:")
|
||||
(display n-a)
|
||||
(newline)
|
||||
'(lambda (. i) ;;(i r c)
|
||||
(display "transformers")
|
||||
(newline)
|
||||
''tee-hee-hee
|
||||
)
|
||||
;; (define (foo) (display "Footje") (newline) 'f-f-f)
|
||||
;; foo
|
||||
;;"blaat"
|
||||
)
|
||||
;;(let ())
|
||||
)
|
||||
|
||||
(display "calling s-r")
|
||||
(newline)
|
||||
(d-s when
|
||||
(s-r 0 1 2)
|
||||
)
|
||||
|
||||
|
||||
(define-macro (m a)
|
||||
`(define-macro ;;(,a)
|
||||
(,a b)
|
||||
(display "b")
|
||||
(display b) ;; todo
|
||||
(newline)))
|
||||
|
||||
(display "define-macro: ")
|
||||
(m dinges)
|
||||
(display "calling when")
|
||||
(newline)
|
||||
(display "running dinges: ")
|
||||
(dinges c)
|
||||
(display (when 3 4 5))
|
||||
(newline)
|
||||
|
||||
(newline)
|
||||
3
|
||||
'dun
|
||||
|
|
|
|||
30
mes.c
30
mes.c
|
|
@ -273,6 +273,9 @@ apply_env_ (scm *fn, scm *x, scm *a)
|
|||
printf (" x=");
|
||||
display (x);
|
||||
puts ("");
|
||||
#endif
|
||||
#if MACROS
|
||||
scm *macro;
|
||||
#endif
|
||||
if (atom_p (fn) != &scm_f)
|
||||
{
|
||||
|
|
@ -288,6 +291,30 @@ apply_env_ (scm *fn, scm *x, scm *a)
|
|||
return begin_env (cddr (fn), pairlis (cadr (fn), x, a));
|
||||
else if (car (fn) == &scm_label)
|
||||
return apply_env (caddr (fn), x, cons (cons (cadr (fn), caddr (fn)), a));
|
||||
#if MACROS
|
||||
else if ((macro = assq (car (fn), cdr (assq (&scm_macro, a)))) != &scm_f) {
|
||||
#if DEBUG
|
||||
printf ("APPLY GOTTA MACRO! name=");
|
||||
display (car (fn));
|
||||
printf (" body=");
|
||||
display (cdr (macro));
|
||||
printf (" args=");
|
||||
display (cdr (fn));
|
||||
puts ("");
|
||||
#endif
|
||||
scm *r = apply_env (cdr (macro), cdr (fn), a);
|
||||
#if DEBUG
|
||||
printf ("APPLY MACRO GOT: ==> ");
|
||||
display (r);
|
||||
puts ("");
|
||||
#endif
|
||||
return apply_env (r, x, a);
|
||||
//return eval_ (cons (r, x), a);
|
||||
//return apply_env_ (eval (cdr (macro), a), x, a);
|
||||
//return eval (apply_env_ (cdr (macro), x, a), a);
|
||||
//return eval (apply_env_ (eval (cdr (macro), a), x, a), a);
|
||||
}
|
||||
#endif // MACROS
|
||||
return &scm_unspecified;
|
||||
}
|
||||
|
||||
|
|
@ -831,7 +858,8 @@ display_helper (scm *x, bool cont, char *sep, bool quote)
|
|||
}
|
||||
else if (atom_p (x) == &scm_t) printf ("%s", x->name);
|
||||
|
||||
return &scm_unspecified;
|
||||
//return &scm_unspecified;
|
||||
return x; // FIXME: eval helper for macros
|
||||
}
|
||||
|
||||
// READ
|
||||
|
|
|
|||
19
syntax.mes
19
syntax.mes
|
|
@ -51,9 +51,8 @@
|
|||
;; (newline)
|
||||
`(define-macro (,macro-name . args)
|
||||
(,transformer (cons ',macro-name args)
|
||||
(lambda (x) x)
|
||||
eq?)
|
||||
;;"blaat"
|
||||
(lambda (x) x)
|
||||
eq?)
|
||||
))
|
||||
|
||||
;; (define-macro (mes:define-syntax form expander)
|
||||
|
|
@ -83,7 +82,7 @@
|
|||
|
||||
(mes:define-syntax syntax-rules
|
||||
(let ()
|
||||
;;begin
|
||||
;;begin
|
||||
|
||||
(define name? symbol?)
|
||||
|
||||
|
|
@ -103,7 +102,7 @@
|
|||
|
||||
(lambda (exp r c)
|
||||
|
||||
(define %input (r '%input)) ;Gensym these, if you like.
|
||||
(define %input (r '%input)) ;Gensym these, if you like.
|
||||
(define %compare (r '%compare))
|
||||
(define %rename (r '%rename))
|
||||
(define %tail (r '%tail))
|
||||
|
|
@ -158,7 +157,7 @@
|
|||
(define (process-segment-match input pattern)
|
||||
(let ((conjuncts (process-match '(car l) pattern)))
|
||||
(if (null? conjuncts)
|
||||
`((list? ,input)) ;+++
|
||||
`((list? ,input)) ;+++
|
||||
`((let loop ((l ,input))
|
||||
(or (null? l)
|
||||
(and (pair? l)
|
||||
|
|
@ -176,7 +175,7 @@
|
|||
((segment-pattern? pattern)
|
||||
(process-pattern (car pattern)
|
||||
%temp
|
||||
(lambda (x) ;temp is free in x
|
||||
(lambda (x) ;temp is free in x
|
||||
(mapit (if (eq? %temp x)
|
||||
path ;+++
|
||||
`(map (lambda (,%temp) ,x)
|
||||
|
|
@ -207,11 +206,11 @@
|
|||
(+ rank 1)
|
||||
env))
|
||||
(gen (if (equal? (list x) vars)
|
||||
x ;+++
|
||||
x ;+++
|
||||
`(map (lambda ,vars ,x)
|
||||
,@vars))))
|
||||
(if (null? (cddr template))
|
||||
gen ;+++
|
||||
gen ;+++
|
||||
`(append ,gen ,(process-template (cddr template)
|
||||
rank env)))))))
|
||||
((pair? template)
|
||||
|
|
@ -257,7 +256,7 @@
|
|||
(#t ;;else
|
||||
free)))
|
||||
|
||||
c ;ignored
|
||||
c ;ignored
|
||||
|
||||
(display "HELLO")
|
||||
(newline)
|
||||
|
|
|
|||
Loading…
Reference in a new issue