DEBUG code for library splicing

This commit is contained in:
Justin Ethier 2016-04-30 04:13:55 -04:00
parent ce801e092a
commit 27e2b8dc3f
2 changed files with 45 additions and 13 deletions

View file

@ -144,12 +144,21 @@
(macro:load-env! *defined-macros* (create-environment '() '())) (macro:load-env! *defined-macros* (create-environment '() '()))
;; Expand macros ;; Expand macros
; New code, does not compile scheme/base.sld yet:
(set! input-program (set! input-program
((if program? (cond
expand-lambda-body (program?
expand) (expand-lambda-body input-program (macro:get-env)))
input-program (else
(macro:get-env))) (lambda->exp (car
(expand `(begin ,@input-program) (macro:get-env)))))))
; Old code, works
;(set! input-program
; ((if program?
; expand-lambda-body
; expand)
; input-program
; (macro:get-env)))
(trace:info "---------------- after macro expansion:") (trace:info "---------------- after macro expansion:")
(trace:info input-program) ;pretty-print (trace:info input-program) ;pretty-print

View file

@ -755,6 +755,10 @@
;TODO: modify this whole section to use macros:get-env instead of *defined-macros*. macro:get-env becomes the mac-env. any new scopes need to extend that env, and an env parameter needs to be added to (expand). any macros defined with define-syntax use that env as their mac-env (how to store that)? ;TODO: modify this whole section to use macros:get-env instead of *defined-macros*. macro:get-env becomes the mac-env. any new scopes need to extend that env, and an env parameter needs to be added to (expand). any macros defined with define-syntax use that env as their mac-env (how to store that)?
; expand : exp -> exp ; expand : exp -> exp
(define (expand exp env) (define (expand exp env)
(define (log e)
(display (list 'expand e) (current-error-port))
(newline (current-error-port)))
(log exp)
;(trace:error `(expand ,exp)) ;(trace:error `(expand ,exp))
(cond (cond
((const? exp) exp) ((const? exp) exp)
@ -871,6 +875,10 @@
;; 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)
(define (log e)
(display (list 'expand-body e) (current-error-port))
(newline (current-error-port)))
(if (null? exp) (if (null? exp)
(reverse result) (reverse result)
(let ((this-exp (car exp))) (let ((this-exp (car exp)))
@ -882,12 +890,21 @@
(ref? this-exp) (ref? this-exp)
(quote? this-exp) (quote? this-exp)
(define-c? this-exp)) (define-c? this-exp))
(log this-exp)
(expand-body (cons this-exp result) (cdr exp) env)) (expand-body (cons this-exp result) (cdr exp) env))
((or (define? this-exp) ((define? this-exp)
(define-syntax? this-exp) (log this-exp)
(expand-body
(cons
(expand this-exp env)
result)
(cdr exp)
env))
((or (define-syntax? this-exp)
(lambda? this-exp) (lambda? this-exp)
(set!? this-exp) (set!? this-exp)
(if? this-exp)) (if? this-exp))
(log (car this-exp))
(expand-body (expand-body
(cons (cons
(expand this-exp env) (expand this-exp env)
@ -898,6 +915,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))
(expand-body (expand-body
result result
(append begin-exprs (cdr exp)) (append begin-exprs (cdr exp))
@ -905,16 +923,20 @@
((app? this-exp) ((app? this-exp)
(cond (cond
((symbol? (caar exp)) ((symbol? (caar 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)))
(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
(expand-body (let ((expanded (macro:expand this-exp val env)))
result (log `(DONE WITH macro:expand))
(cons (expand-body
(macro:expand this-exp val env) result
(cdr exp)) (cons
env) expanded ;(macro:expand this-exp val env)
(cdr exp))
env))
;; No macro, use main expand function to process ;; No macro, use main expand function to process
(expand-body (expand-body
(cons (cons
@ -925,6 +947,7 @@
(cdr exp) (cdr exp)
env)))) env))))
(else (else
(log 'app)
(expand-body (expand-body
(cons (cons
(map (map