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

WIP

Browse source
This commit is contained in:
Justin Ethier 2016-05-02 21:35:45 -04:00
parent 27e2b8dc3f
commit 6b017bf6b0
1 changed files with 23 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

@ -756,9 +756,12 @@
; expand : exp -> exp ; expand : exp -> exp
(define (expand exp env) (define (expand exp env)
(define (log e) (define (log e)
(display (list 'expand e) (current-error-port)) (display
(list 'expand e 'env
(env:frame-variables (env:first-frame env)))
(current-error-port))
(newline (current-error-port))) (newline (current-error-port)))
(log exp) ;(log exp)
;(trace:error `(expand ,exp)) ;(trace:error `(expand ,exp))
(cond (cond
((const? exp) exp) ((const? exp) exp)
@ -876,7 +879,9 @@
;; 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)
(define (log e) (define (log e)
(display (list 'expand-body e) (current-error-port)) (display (list 'expand-body e 'env
(env:frame-variables (env:first-frame env)))
(current-error-port))
(newline (current-error-port))) (newline (current-error-port)))
(if (null? exp) (if (null? exp)
@ -890,10 +895,10 @@
(ref? this-exp) (ref? this-exp)
(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)) (expand-body (cons this-exp result) (cdr exp) env))
((define? this-exp) ((define? this-exp)
(log this-exp) ;(log this-exp)
(expand-body (expand-body
(cons (cons
(expand this-exp env) (expand this-exp env)
@ -904,7 +909,7 @@
(lambda? this-exp) (lambda? this-exp)
(set!? this-exp) (set!? this-exp)
(if? this-exp)) (if? this-exp))
(log (car this-exp)) ;(log (car this-exp))
(expand-body (expand-body
(cons (cons
(expand this-exp env) (expand this-exp env)
@ -915,7 +920,7 @@
((begin? this-exp) ((begin? this-exp)
(let* ((expr this-exp) (let* ((expr this-exp)
(begin-exprs (begin->exps expr))) (begin-exprs (begin->exps expr)))
(log (car this-exp)) ;(log (car this-exp))
(expand-body (expand-body
result result
(append begin-exprs (cdr exp)) (append begin-exprs (cdr exp))
@ -923,14 +928,21 @@
((app? this-exp) ((app? this-exp)
(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 (env:lookup (caar exp) env #f)))
(log `(DONE WITH env:lookup ,(caar exp) ,val ,(tagged-list? 'macro val))) ;; This step is taking a long time on (scheme base) - possibly because
;; it is not using compiled macros???
;;
;; Note that with (expand) the top-level expressions are expanded in
;; reverse order due to the map, whereas they are expanded in-order
;; by expand-body due to the explicit recursion.
;;
;(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,
;; including nested begins ;; including nested begins
(let ((expanded (macro:expand this-exp val env))) (let ((expanded (macro:expand this-exp val env)))
(log `(DONE WITH macro:expand)) ;(log `(DONE WITH macro:expand))
(expand-body (expand-body
result result
(cons (cons
@ -947,7 +959,7 @@
(cdr exp) (cdr exp)
env)))) env))))
(else (else
(log 'app) ;(log 'app)
(expand-body (expand-body
(cons (cons
(map (map