(assign pp/special-forms (hash))
(assign pp/syntaxes      (hash))
(assign pp/newline       (uniq 'newline))
(assign pp/newline/noi   (uniq 'newline/noi))

(def pp/esc-ch (char)
  (if (eq? char "\"") "\\\""
      (eq? char "\~") "\\\~"
      (eq? char "\\") "\\\\"
      (eq? char "\n") "\\n"
      char))

(def pp/esc-str-literal (txt)
  (joinstr "" (map pp/esc-ch (string-split txt))))

(def pp/string-piece (pp)
  (fn (thing)
      (if (isa 'string thing)
          (pp/esc-str-literal thing)
          "\~~(pp thing)")))

(def pp/string-pieces (pp things) "\"~(joinstr "" (map (pp/string-piece pp) things))\"")

(def pp/kv (hsh)
  (map λk(joinstr " "
                  (pp k)
                  (pp hsh.,k))
       (hash-keys hsh)))

(def pp/literal (thing indent)
  (if (eq? thing '||)            "||"
      (eq? thing pp/newline)     "\n~(joinstr " " indent)"
      (eq? thing pp/newline/noi) "\n~(joinstr " " (cdr indent)) "
      (isa 'string thing)        "\"~(pp/esc-str-literal thing)\""
      (isa 'hash thing)          "{ ~(joinstr " " (pp/kv thing)) }"
      (inspect thing)))

(mac pp/def (name args . body)
  ; define a pretty-printer function for forms beginning with the
  ; given name. 'args are usually (form indent), form being the
  ; complete form for pretty-printing, and indent being the current
  ; indent level.
  `(do (hash-set pp/special-forms ',name
                 (fn ,args ,@body))
       (dox-add-doc ',name
                    'pp/def
                    (list "pretty-printer for forms starting with ~(quote ,name)")
                    ',args
                    '(pp/def ,name ,args ,@body))))

(pp/def string-pieces    (pp form indent) (pp/string-pieces pp (cdr form)))
(pp/def quasiquote       (pp form indent) "`~(pp (cadr form) (cons "" indent))" )
(pp/def quote            (pp form indent) "'~(pp (cadr form) (cons "" indent))" )
(pp/def unquote          (pp form indent) ",~(pp (cadr form) (cons "" indent))" )
(pp/def unquote-splicing (pp form indent) ",@~(pp (cadr form) (cons " " indent))")
(pp/def comment          (pp form indent) "; ~(cadr form)\n")
(pp/def prefix-list      (pp form indent) "~(cadr form)~(pp (caddr form))")
(pp/def brace-list       (pp form indent) "{ ~(joinstr " " (map λe(pprint e (cons "  " indent)) (cdr form))) }")

(def pp/unsyntax (form)
  (if (pair? form)
      (let syntax (hash-get pp/syntaxes (car form))
        (if syntax
            (sym:joinstr syntax (map pp/unsyntax (cdr form)))
            (map pp/unsyntax form)))
      form))

(hash-set pp/syntaxes 'percent-syntax "%")
(hash-set pp/syntaxes 'colon-syntax ":")
(hash-set pp/syntaxes 'dot-syntax   ".")
(hash-set pp/syntaxes 'bang-syntax  "!")
(hash-set pp/syntaxes 'ampersand-syntax "&")
(hash-set pp/syntaxes 'dollar-syntax "$")
(hash-set pp/syntaxes 'colon-colon-syntax "::")
(hash-set pp/syntaxes 'arrow-syntax "->")
(hash-set pp/syntaxes 'rocket-syntax "=>" )

(def pp/dotify (form)
  (if (pair? form)
      (cons (pp/dotify:car form)
            (if (pair? (cdr form))
                (pp/dotify (cdr form))
                (no:cdr form)
                nil
                (list '. (cdr form))))
      form))

(def pp/split-form (form n)
  (cons (firstn n form)
        (map list (nthcdr n form))))

(def pp/flatly (form)
  (if (pair? form)
      (let special (hash-get pp/special-forms (car form))
        (if special
            (special pp/flatly form nil)
            "(~(joinstr " " (map pp/flatly form)))"))
      (pp/literal form nil)))

(def pp/breaks? (form)
  (and (pair? form)
       (> (len:pp/flatly form) 40)))

(def pp/breaker (form)
  (if (pair? form)
      (let key (car form)
        (if (or (eq? 'if key)
                (eq? 'cond key))
            (pp/split-form form 2)
            (and (hash-get macs key)
                 (!proper? (dox-args key)))
            (pp/split-form form (list-length:dox-args key))
            (pp/split-form form 2)))
      form))

(def pp/break-pair (form)
  (if (pair? form)
      (if (hash-get pp/special-forms (car form))
          form
          (pp/breaks? form)
          (intersperse-splicing pp/newline
                                (pp/breaker (map pp/break-pair form)))
          form)
      form))

(def pp/cleanup (str)
  (string-replace "\\s+\\n" "\n" (string-replace "\\s+\\Z" "" str)))

(def pp/indent (sym indent)
  (if (or (no sym) (pair? sym))
      indent
      (cons (string-replace "." " " " ~sym") indent)))

(def pprint (form indent)
  (if (pair? form)
      (let special-form (hash-get pp/special-forms (car form))
        (if special-form
            (special-form pp/printer form indent)
            (let new-indent (pp/indent (car form) indent)
              (let contents (joinstr " " (map λe(pprint e new-indent) form))
                "(~contents)"))))
      (pp/literal form indent)))

(def pp/with-args (wargs)
  (if (> (len (pp/flatly wargs)) 40)
      (intersperse-splicing pp/newline/noi
                            (pairs wargs))
      wargs))

(pp/def with (pp form indent)
        (let wargs (pp/with-args (cadr form))
          (let broken (intersperse pp/newline
                                   (map pp/break-pair
                                        (cddr form)))
            (let wbody `(,wargs ,pp/newline ,@broken)
              "(with ~(joinstr " " (map λe(pprint e (cons "     " indent)) wbody)))"))))

(def pp/printer (form indent)
  (if (pair? form)
      (pprint (pp/break-pair form) indent)
      (pp/literal form indent)))

(def pp (form) (pp/cleanup:pp/printer (pp/dotify:pp/unsyntax form) nil))
;; (def pp (form) (inspect form))

(def dox-show-src (src)
  ; use the pretty-printer to elegantly display the given source code
  (pp src))