Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-09 22:17:33 +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 ;; 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)))))))
((let-syntax? exp) ((let-syntax? exp)
(let* ((body (cddr exp)) (let* ((body (cons 'begin (cddr exp)))
(bindings (cadr exp)) (bindings (cadr exp))
(bindings-as-macros (bindings-as-macros
(map (map
(lambda (b) (lambda (b)
(let ((name (car b)) (let* ((name (car b))
(binding (cadr b))) (binding (cadr b))
(cons name (if (tagged-list? 'syntax-rules binding) (binding-body (cadr binding)))
(_expand binding env rename-env local-env) (cons
binding)))) name
(list
'macro
(if (tagged-list? 'syntax-rules binding)
;; TODO: is this ok?
(cadr (_expand binding env rename-env local-env))
binding-body)))))
bindings)) 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)) (trace:error `(let-syntax ,new-local-macro-env))
(_expand body env rename-env local-env) ;; TODO: new-local-macro-env (_expand body env rename-env new-local-macro-env) ;; TODO: new-local-macro-env
)) ))
((app? exp) ((app? exp)
(cond (cond
((symbol? (car exp)) ((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) (if (tagged-list? 'macro val)
(_expand ; Could expand into another macro (_expand ; Could expand into another macro
(macro:expand exp val env rename-env) (macro:expand exp val env rename-env)
@ -695,7 +704,10 @@
(cond (cond
((symbol? (caar exp)) ((symbol? (caar exp))
;(log (car this-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))) ;(log `(DONE WITH env:lookup ,(caar exp) ,val ,(tagged-list? 'macro val)))
(if (tagged-list? 'macro val) (if (tagged-list? 'macro val)
;; Expand macro here so we can catch begins in the expanded code, ;; 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)) ;; (given-that if (set! if 'now))
;; if)) ;; => now ;; if)) ;; => now
(write
(let ((x 'outer)) (let ((x 'outer))
(let-syntax ((m (syntax-rules () ((m) x)))) (let-syntax ((m (syntax-rules () ((m) x))))
(let ((x 'inner)) (let ((x 'inner))
(m)))) ;; Should be outer (m)))) ;; Should be outer
)
;(write ;(write
;(let ((x 'outer)) ;(let ((x 'outer))