mirror of
https://github.com/justinethier/cyclone.git
synced 2025-07-12 23:37:38 +02:00
DEBUG code for library splicing
This commit is contained in:
parent
ce801e092a
commit
27e2b8dc3f
2 changed files with 45 additions and 13 deletions
19
cyclone.scm
19
cyclone.scm
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Reference in a new issue