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

(module expand-full

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

(import scheme)
(import (chicken base))
(import (chicken type))
(import (chicken syntax))
(import (only (chicken platform) feature?))
(import (only (chicken pretty-print) pretty-print))
(import (only (srfi 1) proper-list?))

;;

(define (expand-form xpdr form)
  (define (quote? x) (or (eq? 'quote x) (eq? '##core#quote x)))
  ;expand 1st, then recurse
  (let ((expd (xpdr form)))
    (cond
      ;empty form
      ((null? expd)
        expd )
      ;list form
      ((proper-list? expd)
        ;skip quoted form (skips '(1 2 ...) but ...)
        (if (quote? (car expd))
          expd
          (map (cut expand-form xpdr <>) expd) ) )
      ;improper list form
      ((pair? expd)
        (cons (expand-form xpdr (car expd)) (expand-form xpdr (cdr expd))) )
      ;atom
      (else
        expd ) ) ) )

;;

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

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

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

;;

(define (pretty-print-expand* form . args)
  ;FIXME why strip-syntax on result & not input form?
  (pretty-print (strip-syntax (apply expand* form args)))
  (void) )

(define ppexpand* pretty-print-expand*)

;;;

(when (feature? 'csi)
  ;; Load csi library at runtime here in Chicken 5 only after we confirm
  ;; csi is running. Otherwise chicken.csi load fails.
  (import (only (chicken csi) toplevel-command))
  (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