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

;; Issues
;;
;; - depth vs breadth

(module expand-full

(;export
  ;
  expandable?
  expand-if
  expand-depth depth
  expand-breadth breadth
  ;
  expand*
  pretty-print-expand* ppexpand*)

(import scheme)
(import (chicken base))
(import (chicken type))
(import (chicken syntax))
(import (only (chicken platform) feature?))
#; ;NOTE since could be used in a compiled context cannot require a "non-existing" module
(import (only (chicken csi) toplevel-command))
(import (only (chicken pretty-print) pretty-print))
(import (only (srfi 1) proper-list?))
(import (only vector-lib vector-map))

;;

(define (safe-list-map func form)
  (let ((1st (func (car form))))
    (if (null? (cdr form))
      1st
      (cons 1st (func (cdr form)))) ) )

(define (across func form)
  (cond
    ((vector? form) (vector-map (lambda (_ x) (func x)) form))
    ((pair? form)   (safe-list-map func form))
    (else           form)) )

(define (down stpr form expanded)
  (let loop ((form form) (expanded expanded))
    (if (equal? form expanded)
      form
      (loop expanded (across stpr expanded)) ) ) )

(define (breadth xpdr form) (down (cut breadth xpdr <>) form (xpdr (across xpdr form))))

(define (depth xpdr form) (down (cut depth xpdr <>) form (xpdr form)))

;;

(define (expandable? obj) (or (atom? obj) (proper-list? obj)))

(define (expand-if form . args) (if (expandable? form) (apply expand form args) form))

(define (expand-breadth form . args) (breadth (cut apply expand <> args) form))
(define (expand-depth form . args) (depth (cut apply expand-if <> args) form))

(define expand* expand-breadth)

;;

(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