hax0rz..ugh + next name? test in macro.mes.
This commit is contained in:
parent
40bbb3dff1
commit
341d064a34
12
macro.mes
12
macro.mes
|
@ -58,9 +58,18 @@
|
||||||
)
|
)
|
||||||
|
|
||||||
(d-s s-r
|
(d-s s-r
|
||||||
|
(;; let () ;; syntax-rules uses (let () ...),
|
||||||
|
;; mes doesn't support that yet; use ((lambda () ...))
|
||||||
|
(lambda ()
|
||||||
|
;; syntax-rules uses defines that get closured-in
|
||||||
|
;; mes doesn't support that yet; move down
|
||||||
|
;; (define name? symbol?)
|
||||||
(lambda (. n-a)
|
(lambda (. n-a)
|
||||||
|
(define name? symbol?)
|
||||||
|
|
||||||
(display "YEAH:")
|
(display "YEAH:")
|
||||||
(display n-a)
|
(display n-a)
|
||||||
|
(display (name? n-a))
|
||||||
(newline)
|
(newline)
|
||||||
'(lambda (. i) ;;(i r c)
|
'(lambda (. i) ;;(i r c)
|
||||||
(display "transformers")
|
(display "transformers")
|
||||||
|
@ -70,8 +79,7 @@
|
||||||
;; (define (foo) (display "Footje") (newline) 'f-f-f)
|
;; (define (foo) (display "Footje") (newline) 'f-f-f)
|
||||||
;; foo
|
;; foo
|
||||||
;;"blaat"
|
;;"blaat"
|
||||||
)
|
)))
|
||||||
;;(let ())
|
|
||||||
)
|
)
|
||||||
|
|
||||||
(display "calling s-r")
|
(display "calling s-r")
|
||||||
|
|
20
mes.c
20
mes.c
|
@ -291,6 +291,17 @@ apply_env_ (scm *fn, scm *x, scm *a)
|
||||||
return begin_env (cddr (fn), pairlis (cadr (fn), x, a));
|
return begin_env (cddr (fn), pairlis (cadr (fn), x, a));
|
||||||
else if (car (fn) == &scm_label)
|
else if (car (fn) == &scm_label)
|
||||||
return apply_env (caddr (fn), x, cons (cons (cadr (fn), caddr (fn)), a));
|
return apply_env (caddr (fn), x, cons (cons (cadr (fn), caddr (fn)), a));
|
||||||
|
else if (car (fn)->type == PAIR) {
|
||||||
|
#if DEBUG // FIXME: for macro.mes/syntax.mes this feels *wrong*
|
||||||
|
printf ("APPLY WTF: fn=");
|
||||||
|
display (fn);
|
||||||
|
puts ("");
|
||||||
|
#endif
|
||||||
|
//return apply_env_ (eval_ (fn, a), x, a);
|
||||||
|
scm *e = eval_ (fn, a);
|
||||||
|
return apply_env_ (e, x, a);
|
||||||
|
//return &scm_unspecified;
|
||||||
|
}
|
||||||
#if MACROS
|
#if MACROS
|
||||||
else if ((macro = assq (car (fn), cdr (assq (&scm_macro, a)))) != &scm_f) {
|
else if ((macro = assq (car (fn), cdr (assq (&scm_macro, a)))) != &scm_f) {
|
||||||
#if DEBUG
|
#if DEBUG
|
||||||
|
@ -302,13 +313,18 @@ apply_env_ (scm *fn, scm *x, scm *a)
|
||||||
display (cdr (fn));
|
display (cdr (fn));
|
||||||
puts ("");
|
puts ("");
|
||||||
#endif
|
#endif
|
||||||
scm *r = apply_env (cdr (macro), cdr (fn), a);
|
//scm *r = apply_env (cdr (macro), cdr (fn), a);
|
||||||
|
scm *r = apply_env (eval_ (cdr (macro), a), cdr (fn), a);
|
||||||
#if DEBUG
|
#if DEBUG
|
||||||
printf ("APPLY MACRO GOT: ==> ");
|
printf ("APPLY MACRO GOT: ==> ");
|
||||||
display (r);
|
display (r);
|
||||||
puts ("");
|
puts ("");
|
||||||
#endif
|
#endif
|
||||||
return apply_env (r, x, a);
|
//return apply_env (r, x, a);
|
||||||
|
|
||||||
|
scm *e = eval_ (r, a);
|
||||||
|
return apply_env (e, x, a);
|
||||||
|
|
||||||
//return eval_ (cons (r, x), a);
|
//return eval_ (cons (r, x), a);
|
||||||
//return apply_env_ (eval (cdr (macro), a), x, a);
|
//return apply_env_ (eval (cdr (macro), a), x, a);
|
||||||
//return eval (apply_env_ (cdr (macro), x, a), a);
|
//return eval (apply_env_ (cdr (macro), x, a), a);
|
||||||
|
|
34
syntax.mes
34
syntax.mes
|
@ -6,6 +6,8 @@
|
||||||
;;(display thing)
|
;;(display thing)
|
||||||
(newline))
|
(newline))
|
||||||
|
|
||||||
|
(define (member x lst)
|
||||||
|
(display "MEMBER x=") (display x) (newline) (memq x lst))
|
||||||
(display "mes:define-syntax...")
|
(display "mes:define-syntax...")
|
||||||
|
|
||||||
;;(define (caddr x) (car (cdr (cdr x))))
|
;;(define (caddr x) (car (cdr (cdr x))))
|
||||||
|
@ -81,9 +83,31 @@
|
||||||
(newline)
|
(newline)
|
||||||
|
|
||||||
(mes:define-syntax syntax-rules
|
(mes:define-syntax syntax-rules
|
||||||
(let ()
|
(;; let () ;; syntax-rules uses (let () ...),
|
||||||
;;begin
|
;; mes doesn't support that yet; use ((lambda () ...))
|
||||||
|
(lambda ()
|
||||||
|
|
||||||
|
;; syntax-rules uses defines that get closured-in
|
||||||
|
;; mes doesn't support that yet; move down
|
||||||
|
;; (define name? symbol?)
|
||||||
|
|
||||||
|
;; (define (segment-pattern? pattern)
|
||||||
|
;; (and (segment-template? pattern)
|
||||||
|
;; (or (null? (cddr pattern))
|
||||||
|
;; (syntax-error "segment matching not implemented" pattern))))
|
||||||
|
|
||||||
|
;; (define (segment-template? pattern)
|
||||||
|
;; (and (pair? pattern)
|
||||||
|
;; (pair? (cdr pattern))
|
||||||
|
;; (memq (cadr pattern) indicators-for-zero-or-more)))
|
||||||
|
|
||||||
|
;; (define indicators-for-zero-or-more (list (string->symbol "...") '---))
|
||||||
|
|
||||||
|
(display "BOOO")
|
||||||
|
|
||||||
|
(lambda (exp r c)
|
||||||
|
|
||||||
|
;; FIXME: mes, moved down
|
||||||
(define name? symbol?)
|
(define name? symbol?)
|
||||||
|
|
||||||
(define (segment-pattern? pattern)
|
(define (segment-pattern? pattern)
|
||||||
|
@ -97,10 +121,8 @@
|
||||||
(memq (cadr pattern) indicators-for-zero-or-more)))
|
(memq (cadr pattern) indicators-for-zero-or-more)))
|
||||||
|
|
||||||
(define indicators-for-zero-or-more (list (string->symbol "...") '---))
|
(define indicators-for-zero-or-more (list (string->symbol "...") '---))
|
||||||
|
;; end FIXME
|
||||||
|
|
||||||
(display "BOOO")
|
|
||||||
|
|
||||||
(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 %compare (r '%compare))
|
||||||
|
@ -265,7 +287,7 @@
|
||||||
;; `(cons ,(make-transformer rules)
|
;; `(cons ,(make-transformer rules)
|
||||||
;; ',(find-free-names-in-syntax-rules subkeywords rules))
|
;; ',(find-free-names-in-syntax-rules subkeywords rules))
|
||||||
|
|
||||||
(make-transformer rules))))
|
(make-transformer rules)))))
|
||||||
|
|
||||||
|
|
||||||
(mes:define-syntax mes:or
|
(mes:define-syntax mes:or
|
||||||
|
|
Loading…
Reference in a new issue