Partially-working version of letrec-syntax

This commit is contained in:
Justin Ethier 2017-12-12 19:03:45 -05:00
parent 8301c70e70
commit 4eaa61c0a4
2 changed files with 63 additions and 36 deletions

View file

@ -468,13 +468,12 @@
;;(newline)
(analyze cleaned a-env)))
;; TODO: following is just a placeholder, does not work yet
(define (analyze-letrec-syntax exp a-env)
(let* ((body-env a-env) ;;(env:extend-environment '() '() a-env))
(expanded (expand exp body-env body-env))
(cleaned (macro:cleanup expanded body-env))
(let* ((rename-env (env:extend-environment '() '() '()))
(expanded (expand exp a-env rename-env))
(cleaned (macro:cleanup expanded rename-env))
)
(analyze cleaned body-env)))
(analyze cleaned a-env)))
(define (analyze-syntax exp a-env)
(let ((var (cadr exp)))
@ -955,6 +954,28 @@
;(trace:error `(let-syntax ,new-local-macro-env))
(_expand body env rename-env new-local-macro-env) ;; TODO: new-local-macro-env
))
;; TODO: does not work yet:
((letrec-syntax? exp)
(let* ((body (cons 'begin (cddr exp)))
(body-env (env:extend-environment '() '() env))
(bindings (cadr exp))
;(new-local-macro-env (append bindings-as-macros local-env))
)
(for-each
(lambda (b)
(let* ((name (car b))
(binding (cadr b))
(binding-body (cadr binding))
(macro-val
(list
'macro
(if (macro:syntax-rules? (env:lookup (car binding) body-env #f))
(cadr (_expand binding body-env rename-env local-env))
binding-body))))
(env:define-variable! name macro-val) body-env))
bindings)
(_expand body body-env rename-env local-env) ;;new-local-macro-env) ;; TODO: new-local-macro-env
))
((app? exp)
(cond
((symbol? (car exp))

View file

@ -9,28 +9,28 @@
;(write (my-or2 #t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-syntax my-or (syntax-rules ()
((my-or) #f)
((my-or e) e)
((my-or e1 e2 ...)
(let ((temp e1)) (if temp temp (my-or e2 ...))))))
(write
(let ((x #f)
(y 7)
(temp 8)
(my-let odd?)
(my-if even?))
(my-or x (my-let temp) (my-if y) y))) ;; ==> 7
(define-syntax foo (syntax-rules ()
((_ b)
(bar a b))))
(define-syntax bar (syntax-rules () ((_ c d)
(cons c (let ((c 3))
(list d c 'c))))))
(write
(let ((a 2))
(foo a)))
; (define-syntax my-or (syntax-rules ()
; ((my-or) #f)
; ((my-or e) e)
; ((my-or e1 e2 ...)
; (let ((temp e1)) (if temp temp (my-or e2 ...))))))
; (write
; (let ((x #f)
; (y 7)
; (temp 8)
; (my-let odd?)
; (my-if even?))
; (my-or x (my-let temp) (my-if y) y))) ;; ==> 7
;
; (define-syntax foo (syntax-rules ()
; ((_ b)
; (bar a b))))
; (define-syntax bar (syntax-rules () ((_ c d)
; (cons c (let ((c 3))
; (list d c 'c))))))
; (write
; (let ((a 2))
; (foo a)))
;; Chibi also fails with the same error when this is a let-synatx macro,
;; so it may be that Cyclone works just fine here! Obviously it needs
@ -48,7 +48,10 @@
(my-if even?))
(my-or x (my-let temp) (my-if y) y))) ;; ==> 7
#;(letrec-syntax
;; TODO: below should work with "let" and "if" instead of "my-let" and "my-if"
;; TODO: below does not work in eval - WTF?
(write
(letrec-syntax
((my-or (syntax-rules ()
((my-or) #f)
((my-or e) e)
@ -57,16 +60,19 @@
(let ((x #f)
(y 7)
(temp 8)
(let odd?)
(if even?))
(my-or x (let temp) (if y) y))) ;; ==> 7
(my-let odd?)
(my-if even?))
(my-or x (my-let temp) (my-if y) y))) ;; ==> 7
)
;; From Chibi
#;(let ()
(letrec-syntax ()
(define internal-def 'ok))
internal-def)
;; From Chibi - isn't this a bug though?
;(write
;(let ()
; (letrec-syntax ()
; (define internal-def 'ok))
; internal-def)
;)
;; From Husk:
;;