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

hax0rz..ugh + next name? test in macro.mes.

Browse source
This commit is contained in:
Jan Nieuwenhuizen 2016-07-17 11:37:22 +02:00
parent 40bbb3dff1
commit 341d064a34
3 changed files with 224 additions and 178 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
macro.mes
View file

@ -58,9 +58,18 @@
)
(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)
(define name? symbol?)
(display "YEAH:")
(display n-a)
(display (name? n-a))
(newline)
'(lambda (. i) ;;(i r c)
(display "transformers")
@ -70,8 +79,7 @@
;; (define (foo) (display "Footje") (newline) 'f-f-f)
;; foo
;;"blaat"
)
;;(let ())
)))
)
(display "calling s-r")

20
mes.c
View file

@ -291,6 +291,17 @@ 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));
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
else if ((macro = assq (car (fn), cdr (assq (&scm_macro, a)))) != &scm_f) {
#if DEBUG
@ -302,13 +313,18 @@ apply_env_ (scm *fn, scm *x, scm *a)
display (cdr (fn));
puts ("");
#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
printf ("APPLY MACRO GOT: ==> ");
display (r);
puts ("");
#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 apply_env_ (eval (cdr (macro), a), x, a);
//return eval (apply_env_ (cdr (macro), x, a), a);

34
syntax.mes
View file

@ -6,6 +6,8 @@
;;(display thing)
(newline))
(define (member x lst)
(display "MEMBER x=") (display x) (newline) (memq x lst))
(display "mes:define-syntax...")
;;(define (caddr x) (car (cdr (cdr x))))
@ -81,9 +83,31 @@
(newline)
(mes:define-syntax syntax-rules
(let ()
;;begin
(;; 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?)
;; (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 (segment-pattern? pattern)
@ -97,10 +121,8 @@
(memq (cadr pattern) indicators-for-zero-or-more)))
(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 %compare (r '%compare))
@ -265,7 +287,7 @@
;; `(cons ,(make-transformer rules)
;; ',(find-free-names-in-syntax-rules subkeywords rules))
(make-transformer rules))))
(make-transformer rules)))))
(mes:define-syntax mes:or