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

Improvements to expand-body

Browse source
This commit is contained in:
Justin Ethier 2016-04-30 00:20:01 -04:00
parent be99e732a6
commit e2d158bdd6
1 changed files with 13 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
scheme/cyclone/transforms.sld
View file

@ -876,10 +876,11 @@
;; out why there is an infinite loop when we use this in cyclone.scm ;; out why there is an infinite loop when we use this in cyclone.scm
;; for library compilation (in particular, for scheme base). ;; for library compilation (in particular, for scheme base).
(define (expand-body result exp env) (define (expand-body result exp env)
;(display `(expand-body ,exp) (current-error-port))
(if (null? exp) (if (null? exp)
(reverse result) (reverse result)
(let ((this-exp (car exp))) (let ((this-exp (car exp)))
;(display (list 'expand-body this-exp) (current-error-port))
;(newline (current-error-port))
(cond (cond
((or (const? this-exp) ((or (const? this-exp)
(prim? this-exp) (prim? this-exp)
@ -899,22 +900,22 @@
(cdr exp) (cdr exp)
env)) env))
;; Splice in begin contents and keep expanding body ;; Splice in begin contents and keep expanding body
((begin? (car exp)) ((begin? this-exp)
(let* ((expr (car exp)) (let* ((expr this-exp)
(begin-exprs (begin->exps expr))) (begin-exprs (begin->exps expr)))
(expand-body (expand-body
result result
(append begin-exprs (cdr exp)) (append begin-exprs (cdr exp))
env))) env)))
(else ((app? this-exp)
(let ((macro #f)) (let ((macro #f))
(when (and (app? (car exp)) (when (and (app? this-exp)
(symbol? (caar exp))) (symbol? (caar exp)))
(set! macro (env:lookup (caar exp) env #f))) (set! macro (env:lookup (caar exp) env #f)))
(if (tagged-list? 'macro macro) (if (tagged-list? 'macro macro)
;; Expand macro here so we can catch begins in the expanded code, ;; Expand macro here so we can catch begins in the expanded code,
;; including nested begins ;; including nested begins
(let ((expanded (macro:expand (car exp) macro env))) (let ((expanded (macro:expand this-exp macro env)))
;; Call with expanded macro in case we need to expand again ;; Call with expanded macro in case we need to expand again
(expand-body (expand-body
result result
@ -923,10 +924,14 @@
;; No macro, use main expand function to process ;; No macro, use main expand function to process
(expand-body (expand-body
(cons (cons
(expand (car exp) env) (map
(lambda (expr) (expand expr env))
this-exp)
result) result)
(cdr exp) (cdr exp)
env)))))))) env))))
(else
(error "unknown exp: " this-exp))))))
;; Top-level analysis ;; Top-level analysis