Handled renamed syntax-rules during macro expansion

This commit is contained in:
Justin Ethier 2017-12-06 17:55:49 -05:00
parent 344eb59381
commit b2e9524e70
2 changed files with 26 additions and 7 deletions

View file

@ -922,14 +922,24 @@
(let* ((name (car b))
(binding (cadr b))
(binding-body (cadr binding)))
;(define tmp (env:lookup (car binding) env #f))
;(display "/* ")
;(write `(DEBUG expand let-syntax
; ,(if (tagged-list? 'macro tmp)
; (Cyc-get-cvar (cadr tmp))
; tmp)
; ,syntax-rules))
;(display "*/ ")
;(newline)
(cons
name
(list
'macro
(if (tagged-list? 'syntax-rules binding)
;; TODO: is this ok?
(cadr (_expand binding env rename-env local-env))
binding-body)))))
;; Broken for renames, replace w/below: (if (tagged-list? 'syntax-rules binding)
(if (macro:syntax-rules? (env:lookup (car binding) env #f))
;; TODO: is this ok?
(cadr (_expand binding env rename-env local-env))
binding-body)))))
bindings))
(new-local-macro-env (append bindings-as-macros local-env))
)
@ -975,6 +985,13 @@
(else
(error "unknown exp: " exp))))
(define (macro:syntax-rules? exp)
(eq?
syntax-rules
(if (tagged-list? 'macro exp)
(Cyc-get-cvar (cadr exp))
exp)))
;; Nicer interface to expand-body
(define (expand-lambda-body exp env rename-env)
(expand-body '() exp env rename-env))

View file

@ -1,6 +1,6 @@
;; From:
;; https://github.com/ashinn/chibi-scheme/issues/298
(import (scheme base))
(import (scheme base) (scheme write))
(define-syntax bar
(syntax-rules ()
@ -8,7 +8,9 @@
(let-syntax ((foo (syntax-rules () ((_) 'ok))))
(foo)))))
(define-syntax foo (syntax-rules ()))
;(define-syntax foo (syntax-rules ()))
(write
(bar)
(foo)
)
;(foo)