;;;; expand-full.scm  -*- Scheme -*-
;;;; Kon Lovett, Jul '18
;;;; Kon Lovett, Apr '09

;;;

(module expand-full

(;export
  expand*
  pretty-print-expand* ppexpand*)

(import scheme
  (chicken base)
  (chicken type)
  (chicken syntax)
  (only (chicken platform) feature?)
  ;(only (chicken csi) toplevel-command)
  (only (chicken pretty-print) pretty-print)
  (only (srfi 1) proper-list? map!)
  (only vector-lib vector-map))

;;

(: expand (* #!rest --> *))
;
(define (expand* form . args)
  (let expand-loop ((form form))
    (let ((expanded (apply expand form args)))
      ;
      (define (walk obj)
        (cond
          ((null? obj)
            '() )
          ((proper-list? obj)
            (map expand-loop obj) )
          ((pair? obj)
            (cons (expand-loop (car obj)) (expand-loop (cdr obj))) )
          ((vector? obj)
            (vector-map (lambda (_ x) (expand-loop x)) obj) )
          (else
            obj ) ) )
      ;
      (if (equal? form expanded)
        form
        (walk expanded) ) ) ) )

;;

(: pretty-print-expand* (* #!rest --> *))
;
(define (pretty-print-expand* form . args)
  (pretty-print (strip-syntax (apply expand* form args)))
  (void) )

(define ppexpand* pretty-print-expand*)

;;;

(when (feature? 'csi)
  (chicken.csi#toplevel-command 'x*
    ;FIXME need apropos like csi argument handler
    (lambda () (ppexpand* (read)))
    ",x* EXP           Pretty print, almost fully, expanded expression EXP") )

) ;module expand-full