Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-24 04:25:06 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

WIP

Browse source
This commit is contained in:
Justin Ethier 2018-01-14 18:53:29 -05:00
parent d12b628657
commit 910662135b
2 changed files with 251 additions and 205 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

128
scheme/eval.sld
View file

@ -859,9 +859,15 @@
; expand : exp -> exp ; expand : exp -> exp
(define (expand exp env rename-env) (define (expand exp env rename-env)
(_expand exp env rename-env '())) (_expand exp env rename-env '() '()))
(define (_expand exp env rename-env local-env) ;; Internal implementation of expand
;; exp - Expression to expand
;; env - Environment of the expression
;; rename-env - Environment of variables renamed directly by macros
;; local-env - Local macro definitions, used by let-syntax
;; local-renamed - Renamed local variables introduced by lambda expressions
(define (_expand exp env rename-env local-env local-renamed)
(define (log e) (define (log e)
(display (display
(list 'expand e 'env (list 'expand e 'env
@ -878,28 +884,42 @@
((prim? exp) exp) ((prim? exp) exp)
((ref? exp) exp) ((ref? exp) exp)
((quote? exp) exp) ((quote? exp) exp)
TODO: rename all lambda formals and update rename-env accordingly. ;; TODO: rename all lambda formals and update rename-env accordingly.
will also require renaming refs later on here in expand... ;; will also require renaming refs later on here in expand...
can we use Cyc-er-rename to do this? maybe just use gensym directly as a first-cut ;; can we use Cyc-er-rename to do this? maybe just use gensym directly as a first-cut
TODO: also need to figure out how to deep-copy rename-env and associate it with ;; TODO: also need to figure out how to deep-copy rename-env and associate it with
any defined macro. would need to pull that out when macro is expanded later ;; any defined macro. would need to pull that out when macro is expanded later
((lambda? exp) `(lambda ,(lambda->formals exp) ((lambda? exp)
,@(_expand-body '() (lambda->exp exp) env rename-env local-env) (let* ((args (lambda-formals->list exp))
;,@(map (ltype (lambda-formals-type exp))
; ;; TODO: use extend env here? (a-lookup (map (lambda (a) (cons a (gensym a))) args))
; (lambda (expr) (_expand expr env rename-env local-env)) (new-formals
; (lambda->exp exp)) (list->lambda-formals
)) (map cdr a-lookup)
ltype))
)
`(lambda ,(lambda->formals exp)
;; TODO: want this line instead of the above, but need to solve a crash
;; when compiling unit tests first (!!!)
;`(lambda ,new-formals ;,(lambda->formals exp)
,@(_expand-body
'()
(lambda->exp exp)
env
rename-env
local-env
(append a-lookup local-renamed))
)))
((define? exp) (if (define-lambda? exp) ((define? exp) (if (define-lambda? exp)
(_expand (define->lambda exp) env rename-env local-env) (_expand (define->lambda exp) env rename-env local-env local-renamed)
`(define ,(_expand (define->var exp) env rename-env local-env) `(define ,(_expand (define->var exp) env rename-env local-env local-renamed)
,@(_expand (define->exp exp) env rename-env local-env)))) ,@(_expand (define->exp exp) env rename-env local-env local-renamed))))
((set!? exp) `(set! ,(_expand (set!->var exp) env rename-env local-env) ((set!? exp) `(set! ,(_expand (set!->var exp) env rename-env local-env local-renamed)
,(_expand (set!->exp exp) env rename-env local-env))) ,(_expand (set!->exp exp) env rename-env local-env local-renamed)))
((if-syntax? exp) `(if ,(_expand (if->condition exp) env rename-env local-env) ((if-syntax? exp) `(if ,(_expand (if->condition exp) env rename-env local-env local-renamed)
,(_expand (if->then exp) env rename-env local-env) ,(_expand (if->then exp) env rename-env local-env local-renamed)
,(if (if-else? exp) ,(if (if-else? exp)
(_expand (if->else exp) env rename-env local-env) (_expand (if->else exp) env rename-env local-env local-renamed)
;; Insert default value for missing else clause ;; Insert default value for missing else clause
;; FUTURE: append the empty (unprinted) value ;; FUTURE: append the empty (unprinted) value
;; instead of #f ;; instead of #f
@ -913,8 +933,8 @@ any defined macro. would need to pull that out when macro is expanded later
(cond (cond
((macro:syntax-rules? (env:lookup (car trans) env #f)) ;; Handles renamed 'syntax-rules' identifier ((macro:syntax-rules? (env:lookup (car trans) env #f)) ;; Handles renamed 'syntax-rules' identifier
(_expand (_expand
`(define-syntax ,name ,(_expand trans env rename-env local-env)) `(define-syntax ,name ,(_expand trans env rename-env local-env local-renamed))
env rename-env local-env)) env rename-env local-env local-renamed))
(else (else
;; TODO: for now, do not let a compiled macro be re-defined. ;; TODO: for now, do not let a compiled macro be re-defined.
;; this is a hack for performance compiling (scheme base) ;; this is a hack for performance compiling (scheme base)
@ -936,7 +956,7 @@ any defined macro. would need to pull that out when macro is expanded later
;; TODO: may run into issues with expanding now, before some ;; TODO: may run into issues with expanding now, before some
;; of the macros are defined. may need to make a special pass ;; of the macros are defined. may need to make a special pass
;; to do loading or expansion of macro bodies ;; to do loading or expansion of macro bodies
`(define ,name ,(_expand body env rename-env local-env))))))) `(define ,name ,(_expand body env rename-env local-env local-renamed)))))))
((let-syntax? exp) ((let-syntax? exp)
(let* ((body (cons 'begin (cddr exp))) (let* ((body (cons 'begin (cddr exp)))
(bindings (cadr exp)) (bindings (cadr exp))
@ -962,13 +982,13 @@ any defined macro. would need to pull that out when macro is expanded later
;; Broken for renames, replace w/below: (if (tagged-list? 'syntax-rules binding) ;; Broken for renames, replace w/below: (if (tagged-list? 'syntax-rules binding)
(if (macro:syntax-rules? (env:lookup (car binding) env #f)) (if (macro:syntax-rules? (env:lookup (car binding) env #f))
;; TODO: is this ok? ;; TODO: is this ok?
(cadr (_expand binding env rename-env local-env)) (cadr (_expand binding env rename-env local-env local-renamed))
binding-body))))) binding-body)))))
bindings)) bindings))
(new-local-macro-env (append bindings-as-macros local-env)) (new-local-macro-env (append bindings-as-macros local-env))
) )
;(trace:error `(let-syntax ,new-local-macro-env)) ;(trace:error `(let-syntax ,new-local-macro-env))
(_expand body env rename-env new-local-macro-env) ;; TODO: new-local-macro-env (_expand body env rename-env new-local-macro-env local-renamed) ;; TODO: new-local-macro-env
)) ))
((letrec-syntax? exp) ((letrec-syntax? exp)
(let* ((body (cons 'begin (cddr exp))) (let* ((body (cons 'begin (cddr exp)))
@ -984,11 +1004,11 @@ any defined macro. would need to pull that out when macro is expanded later
(list (list
'macro 'macro
(if (macro:syntax-rules? (env:lookup (car binding) body-env #f)) (if (macro:syntax-rules? (env:lookup (car binding) body-env #f))
(cadr (_expand binding body-env rename-env local-env)) (cadr (_expand binding body-env rename-env local-env local-renamed))
binding-body)))) binding-body))))
(env:define-variable! name macro-val) body-env)) (env:define-variable! name macro-val) body-env))
bindings) bindings)
(_expand body body-env rename-env local-env) (_expand body body-env rename-env local-env local-renamed)
)) ))
((app? exp) ((app? exp)
(cond (cond
@ -1012,13 +1032,13 @@ any defined macro. would need to pull that out when macro is expanded later
(macro:expand exp val env rename-env) (macro:expand exp val env rename-env)
env env
rename-env rename-env
local-env)) local-env local-renamed))
((Cyc-macro? val) ((Cyc-macro? val)
(_expand ; Could expand into another macro (_expand ; Could expand into another macro
(macro:expand exp (list 'macro val) env rename-env) (macro:expand exp (list 'macro val) env rename-env)
env env
rename-env rename-env
local-env)) local-env local-renamed))
;; TODO: if we are doing this, only want to do so if the original variable is a macro. ;; TODO: if we are doing this, only want to do so if the original variable is a macro.
;; this is starting to get overly complicated though. ;; this is starting to get overly complicated though.
;; if nothing else should encapsulate the above lookup into a function and call that ;; if nothing else should encapsulate the above lookup into a function and call that
@ -1033,10 +1053,10 @@ any defined macro. would need to pull that out when macro is expanded later
;;(newline) ;;(newline)
;; (_expand ;; (_expand
;; (cons val (cdr exp)) ;; (cons val (cdr exp))
;; env rename-env local-env)) ;; env rename-env local-env local-renamed))
(else (else
(map (map
(lambda (expr) (_expand expr env rename-env local-env)) (lambda (expr) (_expand expr env rename-env local-env local-renamed))
exp))))) exp)))))
(else (else
;; TODO: note that map does not guarantee that expressions are ;; TODO: note that map does not guarantee that expressions are
@ -1044,7 +1064,7 @@ any defined macro. would need to pull that out when macro is expanded later
;; in reverse order. Might be better to use a fold here and ;; in reverse order. Might be better to use a fold here and
;; elsewhere in (expand). ;; elsewhere in (expand).
(map (map
(lambda (expr) (_expand expr env rename-env local-env)) (lambda (expr) (_expand expr env rename-env local-env local-renamed))
exp)))) exp))))
(else (else
(error "unknown exp: " exp)))) (error "unknown exp: " exp))))
@ -1062,9 +1082,9 @@ any defined macro. would need to pull that out when macro is expanded later
;; Helper to expand a lambda body, so we can splice in any begin's ;; Helper to expand a lambda body, so we can splice in any begin's
(define (expand-body result exp env rename-env) (define (expand-body result exp env rename-env)
(_expand-body result exp env rename-env '())) (_expand-body result exp env rename-env '() '()))
(define (_expand-body result exp env rename-env local-env) (define (_expand-body result exp env rename-env local-env local-renamed)
(define (log e) (define (log e)
(display (list 'expand-body e 'env (display (list 'expand-body e 'env
(env:frame-variables (env:first-frame env))) (env:frame-variables (env:first-frame env)))
@ -1083,7 +1103,7 @@ any defined macro. would need to pull that out when macro is expanded later
(quote? this-exp) (quote? this-exp)
(define-c? this-exp)) (define-c? this-exp))
;(log this-exp) ;(log this-exp)
(_expand-body (cons this-exp result) (cdr exp) env rename-env local-env)) (_expand-body (cons this-exp result) (cdr exp) env rename-env local-env local-renamed))
((define? this-exp) ((define? this-exp)
;(log this-exp) ;(log this-exp)
(_expand-body (_expand-body
@ -1093,7 +1113,7 @@ any defined macro. would need to pull that out when macro is expanded later
(cdr exp) (cdr exp)
env env
rename-env rename-env
local-env)) local-env local-renamed))
((or (define-syntax? this-exp) ((or (define-syntax? this-exp)
(letrec-syntax? this-exp) (letrec-syntax? this-exp)
(let-syntax? this-exp) (let-syntax? this-exp)
@ -1103,12 +1123,12 @@ any defined macro. would need to pull that out when macro is expanded later
;(log (car this-exp)) ;(log (car this-exp))
(_expand-body (_expand-body
(cons (cons
(_expand this-exp env rename-env local-env) (_expand this-exp env rename-env local-env local-renamed)
result) result)
(cdr exp) (cdr exp)
env env
rename-env rename-env
local-env)) local-env local-renamed))
;; Splice in begin contents and keep expanding body ;; Splice in begin contents and keep expanding body
((begin? this-exp) ((begin? this-exp)
(let* ((expr this-exp) (let* ((expr this-exp)
@ -1119,7 +1139,7 @@ any defined macro. would need to pull that out when macro is expanded later
(append begin-exprs (cdr exp)) (append begin-exprs (cdr exp))
env env
rename-env rename-env
local-env))) local-env local-renamed)))
((app? this-exp) ((app? this-exp)
(cond (cond
((symbol? (caar exp)) ((symbol? (caar exp))
@ -1141,7 +1161,7 @@ any defined macro. would need to pull that out when macro is expanded later
(cdr exp)) (cdr exp))
env env
rename-env rename-env
local-env)) local-env local-renamed))
;; No macro, use main expand function to process ;; No macro, use main expand function to process
(_expand-body (_expand-body
(cons (cons
@ -1152,7 +1172,7 @@ any defined macro. would need to pull that out when macro is expanded later
(cdr exp) (cdr exp)
env env
rename-env rename-env
local-env)))) local-env local-renamed))))
(else (else
;(log 'app) ;(log 'app)
(_expand-body (_expand-body
@ -1164,10 +1184,30 @@ any defined macro. would need to pull that out when macro is expanded later
(cdr exp) (cdr exp)
env env
rename-env rename-env
local-env)))) local-env local-renamed))))
(else (else
(error "unknown exp: " this-exp)))))) (error "unknown exp: " this-exp))))))
;; TODO: this is copied from (scheme cyclone transforms) need to relocate both into a common place
(define (list->lambda-formals args type)
(cond
((eq? type 'args:fixed) args)
((eq? type 'args:fixed-with-varargs) (list->pair args))
((eq? type 'args:varargs)
(if (> (length args) 1)
(error `(Too many args for varargs ,args))
(car args)))
(else (error `(Unexpected type ,type)))))
(define (list->pair l)
(let loop ((lst l))
(cond
((not (pair? lst))
lst)
((null? (cdr lst))
(car lst))
(else
(cons (car lst) (loop (cdr lst)))))))
;; Container for built-in macros ;; Container for built-in macros
(define (get-macros) *defined-macros*) (define (get-macros) *defined-macros*)
(define *defined-macros* (list)) (define *defined-macros* (list))

312
tests/let-syntax.scm
View file

@ -1,166 +1,172 @@
(import (scheme base) (scheme write) (scheme cyclone pretty-print)) (import (scheme base) (scheme write) (scheme cyclone pretty-print))
;; Just testing, may want to remove this one once the recursive macro expansion works
; (define-syntax my-or2 (syntax-rules ()
; ((my-or2) #f)
; ((my-or2 e) e)
; ((my-or2 e1 e2 ...)
; (let ((temp e1)) (if temp temp (my-or2 e2 ...))))))
;(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)))
;; 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
;; to be able to handle this macro in letrec-syntax form, though
#;(let-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 ...)))))))
(let ((x #f)
(y 7)
(temp 8)
(my-let odd?)
(my-if even?))
(my-or x (my-let temp) (my-if y) y))) ;; ==> 7
;; TODO: below should work with "let" and "if" instead of "my-let" and "my-if"
;; TODO: below does not work in eval - WTF?
(write (write
(letrec-syntax (let ((x 'outer))
((my-or (syntax-rules () ;(let-syntax ((m (syntax-rules () ((m) x))))
((my-or) #f) (let ((x 'inner))
((my-or e) e) (list)))) ;; Should be outer
((my-or e1 e2 ...) ; )
(let ((temp e1)) (if temp temp (my-or e2 ...))))))) ;;;; Just testing, may want to remove this one once the recursive macro expansion works
(let ((x #f) ;;; (define-syntax my-or2 (syntax-rules ()
(y 7) ;;; ((my-or2) #f)
(temp 8) ;;; ((my-or2 e) e)
(my-let odd?) ;;; ((my-or2 e1 e2 ...)
(my-if even?)) ;;; (let ((temp e1)) (if temp temp (my-or2 e2 ...))))))
(my-or x (my-let temp) (my-if y) y))) ;; ==> 7 ;;;(write (my-or2 #t))
) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; From Chibi - isn't this a bug though?
;(write
;(let ()
; (letrec-syntax ()
; (define internal-def 'ok))
; internal-def)
;)
;; From Husk:
;; ;;
; Examples from the source to R5RS pitfall 3.3 ;;; (define-syntax my-or (syntax-rules ()
;; (assert/equal ;;; ((my-or) #f)
;; (let ((a 1)) ;;; ((my-or e) e)
;; (letrec-syntax ;;; ((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
;;;; to be able to handle this macro in letrec-syntax form, though
;;#;(let-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 ...)))))))
;; (let ((x #f)
;; (y 7)
;; (temp 8)
;; (my-let odd?)
;; (my-if even?))
;; (my-or x (my-let temp) (my-if y) y))) ;; ==> 7
;;
;;;; 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)
;; ((my-or e1 e2 ...)
;; (let ((temp e1)) (if temp temp (my-or e2 ...)))))))
;; (let ((x #f)
;; (y 7)
;; (temp 8)
;; (my-let odd?)
;; (my-if even?))
;; (my-or x (my-let temp) (my-if y) y))) ;; ==> 7
;;)
;;
;;
;;;; From Chibi - isn't this a bug though?
;;;(write
;;;(let ()
;;; (letrec-syntax ()
;;; (define internal-def 'ok))
;;; internal-def)
;;;)
;;
;;;; From Husk:
;;;;
;;; Examples from the source to R5RS pitfall 3.3
;;;; (assert/equal
;;;; (let ((a 1))
;;;; (letrec-syntax
;;;; ((foo (syntax-rules ()
;;;; ((_ b)
;;;; (bar a b))))
;;;; (bar (syntax-rules ()
;;;; ((_ c d)
;;;; (cons c (let ((c 3))
;;;; (list d c 'c)))))))
;;;; (let ((a 2))
;;;; (foo a))))
;;;; '(1 2 3 a))
;;;;
;;;; ; Examples from/based on pitfall 8.3 (assert/equal 1
;;;; (let ((x 1))
;;;; (let-syntax ((foo (syntax-rules () ((_) 2))))
;;;; (define x (foo))
;;;; 3)
;;;; x))
;;;; (assert/equal 1
;;;; (let ((x 1))
;;;; (letrec-syntax ((foo (syntax-rules () ((_) 2)))) (define x (foo))
;;;; 3)
;;;; x))
;;;;
;;;; ; Issue #151 - Preserve hygiene across syntax-rules and ER macros
;;;; (assert/equal
;;;; (let ((unquote 'foo)) `(,'bar))
;;;; '(,'bar))
;;
;;
;;#;(let ((a 1))
;; (let-syntax
;; ;;(letrec-syntax
;; ((foo (syntax-rules () ;; ((foo (syntax-rules ()
;; ((_ b) ;; ((_ b)
;; (bar a b)))) ;; (bar a b))))
;; (bar (syntax-rules () ;; (bar (syntax-rules () ((_ c d)
;; ((_ c d)
;; (cons c (let ((c 3)) ;; (cons c (let ((c 3))
;; (list d c 'c))))))) ;; (list d c 'c)))))))
;; (let ((a 2)) ;; (let ((a 2))
;; (foo a)))) ;; (foo a))))
;; '(1 2 3 a))
;; ;;
;; ; Examples from/based on pitfall 8.3 (assert/equal 1
;; (let ((x 1))
;; (let-syntax ((foo (syntax-rules () ((_) 2))))
;; (define x (foo))
;; 3)
;; x))
;; (assert/equal 1
;; (let ((x 1))
;; (letrec-syntax ((foo (syntax-rules () ((_) 2)))) (define x (foo))
;; 3)
;; x))
;; ;;
;; ; Issue #151 - Preserve hygiene across syntax-rules and ER macros ;;(define-syntax my-let
;; (assert/equal ;; (syntax-rules
;; (let ((unquote 'foo)) `(,'bar)) ;; ()
;; '(,'bar)) ;; ((my-let ((name val) ...) body1 body2 ...)
;; ((lambda (name ...) body1 body2 ...) val ...))
;; ((my-let tag ((name val) ...) body1 body2 ...)
#;(let ((a 1)) ;; ((letrec ((tag (lambda (name ...) body1 body2 ...)))
(let-syntax ;; tag)
;;(letrec-syntax ;; val ...))))
((foo (syntax-rules () ;;(write
((_ b) ;;(my-let ((x 'outer))
(bar a b)))) ;; (let-syntax ((m (syntax-rules () ((m) x))))
(bar (syntax-rules () ((_ c d) ;; (my-let ((x 'inner))
(cons c (let ((c 3)) ;; (m)))) ;; Should be outer
(list d c 'c))))))) ;; )
(let ((a 2)) ;;
(foo a)))) ;;
;;;; (let-syntax ((given-that (syntax-rules ()
;;;; ((given-that test stmt1 stmt2 ...)
(define-syntax my-let ;;;; (if test
(syntax-rules ;;;; (begin stmt1
() ;;;; stmt2 ...))))))
((my-let ((name val) ...) body1 body2 ...) ;;;; (let ((if #t))
((lambda (name ...) body1 body2 ...) val ...)) ;;;; (given-that if (set! if 'now))
((my-let tag ((name val) ...) body1 body2 ...) ;;;; if)) ;; => now
((letrec ((tag (lambda (name ...) body1 body2 ...))) ;;
tag) ;;(write
val ...)))) ;;(let ((x 'outer))
(write ;; (let-syntax ((m (syntax-rules () ((m) x))))
(my-let ((x 'outer)) ;; (let ((x 'inner))
(let-syntax ((m (syntax-rules () ((m) x)))) ;; (m)))) ;; Should be outer
(my-let ((x 'inner)) ;; )
(m)))) ;; Should be outer ;;
) ;;;(write
;;;(let ((x 'outer))
;;; (define-syntax m ;; Testing this out, but let-syntax needs to work, too
;; (let-syntax ((given-that (syntax-rules () ;;; (syntax-rules () ((m) x)))
;; ((given-that test stmt1 stmt2 ...) ;;; (let ((x 'inner))
;; (if test ;;; (m))) ;; Should be outer
;; (begin stmt1 ;;; )
;; stmt2 ...)))))) ;;;
;; (let ((if #t)) ;;;(write (m)) ;; Should be an error, of course
;; (given-that if (set! if 'now))
;; if)) ;; => now
(write
(let ((x 'outer))
(let-syntax ((m (syntax-rules () ((m) x))))
(let ((x 'inner))
(m)))) ;; Should be outer
)
;(write
;(let ((x 'outer))
; (define-syntax m ;; Testing this out, but let-syntax needs to work, too
; (syntax-rules () ((m) x)))
; (let ((x 'inner))
; (m))) ;; Should be outer
; )
;
;(write (m)) ;; Should be an error, of course