macros in XSCHEME

[phoenix!crabb@princeton.edu (David W Crabb)]

Below is a commented version of the MACROS.S file which is part of the
xscheme package.  Please let me have comments on the comments
(meta-comments ??) .


------------------------------------------------------------------------

	 ; comments by DWC

; this will become the universal argument to COMPILE
(define (%expand-macros expr)
  (if (pair? expr)
    (if (symbol? (car expr))
      (let ((expander (get (car expr) '%syntax))) ;  prop is put below (2)
        (if expander
	  (expander expr)  ;  <--  THEN clause for defined macros
	  (let ((expander (get (car expr) '%macro))) ; prop is put at (1)
            (if expander
	      (%expand-macros (expander expr)) ;  <-- THEN clause for "macro"
	      (cons (car expr) (%expand-list (cdr expr))))))) ; default
      (%expand-list expr))  ; compound arguments like COND and LET
    expr))  ;  evaluate the atom

(define (%expand-list lyst)   ; a helper function for the universal arg
  (if (pair? lyst)
    (cons (%expand-macros (car lyst)) (%expand-list (cdr lyst)))
    lyst))

(define %compile compile)			      ; was at the top
; Note the destructive re-define following :
(define (compile expr #!optional env)
  (if (default-object? env)
    (%compile (%expand-macros expr))	   ; action of the old compile
    (%compile (%expand-macros expr) env)))

; ** as of now, everything passed to COMPILE will be of the new form.

(put 'macro '%macro
  (lambda (form)
    (list 'put
          (list 'quote (cadr form))
	  (list 'quote '%macro) 			   ; (1)
          (caddr form))))

(macro compiler-syntax
  (lambda (form)
    (list 'put
          (list 'quote (cadr form))
	  (list 'quote '%syntax)			   ; (2)
          (caddr form))))

(macro syntax
  (lambda (form)
    #f))		  ; i.e., not implemented

; *******  This completes the re-integration of COMPILE into
;  MACRO or COMPILER-SYNTAX or default.  Implementation begins here:

(compiler-syntax quote
  (lambda (form) form))
	  
(compiler-syntax lambda
  (lambda (form)
    (cons
      'lambda
      (cons
        (cadr form)
        (%expand-list (cddr form))))))

(compiler-syntax define
  (lambda (form)
    (cons
      'define
      (cons
        (cadr form)
        (%expand-list (cddr form))))))
  
(compiler-syntax set!
  (lambda (form)
    (cons
      'set!
      (cons
        (cadr form)
        (%expand-list (cddr form))))))

(define (%cond-expander lyst)  ; a helper function for what follows immediately
  (cond 		 ; coincidentally the unexpanded COND
      ((pair? lyst)
       (cons
         (if (pair? (car lyst))
           (%expand-list (car lyst))
           (car lyst))
         (%cond-expander (cdr lyst))))
      (else lyst)))

(compiler-syntax cond
  (lambda (form)
    (cons 'cond (%cond-expander (cdr form)))))

;;  the folowing comment block is in the original:
; The following code for expanding let/let*/letrec was donated by:
;
; Harald Hanche-Olsen
; The University of Trondheim
; The Norwegian Institute of Technology
; Division of Mathematics
; N-7034 Trondheim NTH
; Norway

(define (%expand-let-assignment pair) ; a mapper in what follows immediately
  (if (pair? pair)
    (cons
      (car pair)
      (%expand-macros (cdr pair)))
    pair))

(define (%expand-let-form form)  ;
  (cons
    (car form)	   ;  let/let*/letrec
    (cons
      (let ((lyst (cadr form))) ; coincidentally the unexpanded LET
        (if (pair? lyst)
          (map %expand-let-assignment lyst)
          lyst))
      (%expand-list (cddr form)))))

(compiler-syntax let %expand-let-form)
(compiler-syntax let* %expand-let-form)
(compiler-syntax letrec %expand-let-form)

(macro define-integrable
  (lambda (form)
    (cons 'define (cdr form))))

(macro declare
  (lambda (form) #f))		 ; i.e., not implemented


-------------------------------------------------------------------------

David Crabb
crabb@phoenix.princeton.edu