cyclone/macro-test.scm

;; A temporary testbed file
(import (scheme base)
        (scheme eval)
        ;(scheme file)
        ;(scheme read)
        (scheme write)
        (scheme cyclone common)
        (scheme cyclone util)
        ;(scheme cyclone cgen)
        (scheme cyclone transforms)
        (scheme cyclone macros)
        ;(scheme cyclone libraries)
        )

(define input-program '(lambda (x) (begin (+ x x) 1 2 3)))

      ;; Load macros for expansion phase
      (let ((macros (filter 
                      (lambda (v) 
                        (macro? (Cyc-get-cvar (cdr v))))
                      (Cyc-global-vars))))
        (set! *defined-macros*
              (append
                macros
                *defined-macros*)))
      (macro:load-env! *defined-macros* (create-environment '() '()))

      ;; Expand macros
      (set! input-program (my-expand input-program (macro:get-env)))
      (write "---------------- after macro expansion:")
      (write input-program) ;pretty-print

;; A first step towards splicing begin, but this doesn't handle
;; begin being introduced as part of a macro
;; may need to add back the define-syntax code and introduce a macro
;; that expands into a begin
(define (expand-body result exp env)
  (cond
   ((null? exp) (reverse result))
   ((begin? (car exp))
    (let* ((expr (car exp))
           (begin-exprs (begin->exps expr))
           (expanded-exprs (map (lambda (expr) (my-expand expr env)) begin-exprs)))
    (expand-body
     (append result (reverse expanded-exprs))
     (cdr exp)
     env)))
   (else
     (expand-body
      (cons 
        (my-expand (car exp) env)
        result)
      (cdr exp)
      env))))

(define (my-expand exp env)
  (cond
    ((const? exp)      exp)
    ((prim? exp)       exp)
    ((ref? exp)        exp)
    ((quote? exp)      exp)
;; TODO: need a way of taking a begin here and splicing its contents
;; into the body
    ((lambda? exp)     `(lambda ,(lambda->formals exp)
                          ,@(expand-body '() (lambda->exp exp) env)
                          ;,@(map 
                          ;  ;; TODO: use extend env here?
                          ;  (lambda (expr) (my-expand expr env))
                          ;  (lambda->exp exp))
                        ))
    ((define? exp)     (if (define-lambda? exp)
                           (my-expand (define->lambda exp) env)
                          `(define ,(my-expand (define->var exp) env)
                                ,@(my-expand (define->exp exp) env))))
    ((set!? exp)       `(set! ,(my-expand (set!->var exp) env)
                              ,(my-expand (set!->exp exp) env)))
    ((if? exp)         `(if ,(my-expand (if->condition exp) env)
                            ,(my-expand (if->then exp) env)
                            ,(if (if-else? exp)
                                 (my-expand (if->else exp) env)
                                 ;; Insert default value for missing else clause
                                 ;; FUTURE: append the empty (unprinted) value
                                 ;; instead of #f
                                 #f)))
    ((app? exp)
     (cond
     ((symbol? (car exp))
      (let ((val (env:lookup (car exp) env #f)))
        (if (tagged-list? 'macro val)
          (my-expand ; Could expand into another macro
            (macro:expand exp val env)
            env)
          (map
            (lambda (expr) (my-expand expr env))
            exp))))

     (else
       (map 
        (lambda (expr) (my-expand expr env))
        exp))))
    (else
      (error "unknown exp: " exp))))