;;;; expand-full.scm
;;;; Kon Lovett, Apr '09

(declare
  (usual-integrations)
  (fixnum)
  (inline)
  (local)
  (no-bound-checks)
  (no-procedure-checks))

;;;

(module expand-full (expand* pretty-print-expand* ppexpand*)

(import scheme chicken
  (only csi toplevel-command)
  (only extras pretty-print)
  (only srfi-1 map!))

(require-library extras srfi-1)

;;;

;;

(define (expand* form #!optional se)

  ; expand while expanding
  (define (exp form)
    (let ((form* (expand* form se)))
      (if (equal? form form*) form
          (exp form*) ) ) )

  (let ((form (expand form se)))
    (if (pair? form) (map! exp form)
        form ) ) )

;;

(define (pretty-print-expand* form . args)
  (pretty-print (strip-syntax (apply expand* form args)))
  (void) )

(define ppexpand* pretty-print-expand*)

;;;

(when (feature? csi:)
  (toplevel-command 'x*
    (lambda () (ppexpand* (read)))
    ",x* EXP           Pretty print fully expanded expression EXP") )

) ;module expand-full