;; ;; problem: work out where a starting column of a form on its starting line, need to add ;; this amount to its indent if it is broken ;; ;; TODO: ;; ;; alternative approach: given a form <expr>, ask <expr> recursively ;; to provide the following: ;; ;; { inline: (… <sub-expr> <sub-expr> …) ;; broken: (… <newline “ ”> <sub-expr> <newline “ ”> <sub-expr> …) } ;; ;; printer returns <inline> if acceptable, otherwise produces <broken>, recursively deciding on <inline> ;; for each <sub-expr> ;; ;; each <newline “ ”> carries the amount of indent required for the containing form, needs to be added to ;; the amount of indent required for outer forms ;; ;; ;; ;; also TODO: ;; ;; use (module pp …) and remove all those prefixes… ;;

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

;; (eq? char “n”) “\n” (def pp/esc-ch (char)

(if (eq? char "\"") "\\\""
    (eq? char "\~") "\\\~"
    (eq? char "\\") "\\\\"
    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)
        (isa 'symbol thing)
        "\~|~(just 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)))

;; 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. (mac pp/def (name args . body)

`(do (hash-set pp/special-forms ',name
               (fun ,args ,@body))
     (dox-add-doc ',name
                  'pp/def
                  (list "pretty-printer for forms starting with ~(quote ,name)")
                  ',args
                  '(pp/def ,name ,args ,@body)
                  (hash))))

(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))”)

(def pp/brace-list-pair (pp (k v) indent) “~k ~(pp v indent)”)

(pp/def brace-list (pp form indent)

"{ ~(joinstr " " (map λe(pprint e (cons " " indent)) (intersperse-splicing pp/newline (pairs: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 “=>” ) (hash-set pp/syntaxes ’at-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 indent)

(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 percent-syntax? (form)

(and (pair? form)
     (sym? (car form))
     (string-match (to-string (car form)) "^%")))

(def pp/breaker (form)

(if (percent-syntax? form)
    (pp/split-form form 1)
    (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
    (string-match (to-string sym) "^%")
    (cons " " 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)))

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

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

(pp src))

;; use ‘pp/unsyntax to convert ’def and ‘mac names back to a symbol ;; so (mac dsl.foo (a1 a2) …) will be documented as “dsl.foo” (def dox-build-def-name (name)

(pp/unsyntax name))