Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-09 14:07:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

First working version of let-syntax

Browse source
This commit is contained in:
Justin Ethier 2017-11-25 19:03:00 -05:00
parent d590d1bf8b
commit 044d135b84
2 changed files with 25 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
scheme/cyclone/transforms.sld
View file

@ -588,26 +588,35 @@
;; to do loading or expansion of macro bodies
`(define ,name ,(_expand body env rename-env local-env)))))))
((let-syntax? exp)
(let* ((body (cddr exp))
(let* ((body (cons 'begin (cddr exp)))
(bindings (cadr exp))
(bindings-as-macros
(map
(lambda (b)
(let ((name (car b))
(binding (cadr b)))
(cons name (if (tagged-list? 'syntax-rules binding)
(_expand binding env rename-env local-env)
binding))))
(let* ((name (car b))
(binding (cadr b))
(binding-body (cadr binding)))
(cons
name
(list
'macro
(if (tagged-list? 'syntax-rules binding)
;; TODO: is this ok?
(cadr (_expand binding env rename-env local-env))
binding-body)))))
bindings))
; TODO: (new-local-macro-env (append bindings-as-macros local-env))
(new-local-macro-env (append bindings-as-macros local-env))
)
(trace:error `(let-syntax ,bindings-as-macros))
(_expand body env rename-env local-env) ;; TODO: 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
))
((app? exp)
(cond
((symbol? (car exp))
(let ((val (env:lookup (car exp) env #f)))
(let ((val (let ((local (assoc (car exp) local-env)))
(if local
(cdr local)
(env:lookup (car exp) env #f)))))
(if (tagged-list? 'macro val)
(_expand ; Could expand into another macro
(macro:expand exp val env rename-env)
@ -695,7 +704,10 @@
(cond
((symbol? (caar exp))
;(log (car this-exp))
(let ((val (env:lookup (caar exp) env #f)))
(let ((val (let ((local (assoc (caar exp) local-env)))
(if local
(cdr local)
(env:lookup (caar exp) env #f)))))
;(log `(DONE WITH env:lookup ,(caar exp) ,val ,(tagged-list? 'macro val)))
(if (tagged-list? 'macro val)
;; Expand macro here so we can catch begins in the expanded code,

2
tests/let-syntax.scm
View file

@ -9,10 +9,12 @@
;; (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))