Arc Forumnew | comments | leaders | submitlogin
simple arbitrary sexp pretty printer
11 points by drcode 5851 days ago | 5 comments
The pretty printer included in arc (in the file pprint.arc) is designed for pretty printing source code, not arbitrary sexpressions.

Here, instead, is a pretty printer optimized for just prettifying sexpressions- Useful for prettying your sexp data before saving it to a file or showing it to a user.

It has one config variable, oneline-sexp, which determines how long a line should be before it is split. This is not a "hard" limit- The program won't break strings or other non-list structures to meet this limit. Also, this limit does not count the indentation, so deeply nested sexps don't start becoming anorexically skinny to meet an artificial line break... The goal here is to make the data easier to grok, not meet a hard column width.

  (= oneline-sexp* 30)
  
  (def ppr-sexp (sexp)
    (prn)
    (map [prn (string:n-of car._ #\space) cdr._]
         ((afn (sexp)
            (withs (tw tostring:write
                    x tw.sexp)
              (if (or (<= len.x oneline-sexp*) atom.sexp dotted.sexp) (list:cons 0 x)
                  (with (y (map self sexp)
                         psh (fn (n lst)
                               (map [cons (+ n car._) cdr._] lst))
                         endit [let l (last _)
                                   (= cdr.l (string cdr.l #\)))
                                 _])
                    (if (acons:car sexp) (let q (psh 1 (apply join (cdr:car y) cdr.y))
                                           (cons (cons 0 (string #\( 
                                                                 (cdr:caar y) 
                                                                 (unless q 
                                                                         #\))))
                                                 (when q 
                                                   (endit q))))
                        (is 1 (len sexp)) (list (cons 0 (string #\( (tw car.sexp) #\))))
                        (and (is 2 (len sexp)) (is 1 (len cadr.y))) (list (cons 0 (string #\( (tw car.sexp) #\space (tw cadr.sexp) #\))))
                        (let b (string #\( (tw car.sexp) #\space)
                          (cons (cons 0 (string b (cdr:car:car:cdr y)))
                                (endit:psh len.b (apply join (cdr:cadr y) cddr.y)))))))))
          sexp)))
Here is the output of running the function against its own sexp:

  arc> (ppr-sexp '(def ...))

  (def ppr-sexp
       (sexp)
       (prn)
       (map (make-br-fn (prn (string:n-of car._ #\space)
                             cdr._))
            ((afn (sexp)
                  (withs (tw tostring:write x tw.sexp)
                         (if (or (<= len.x oneline-sexp*)
                                 atom.sexp
                                 dotted.sexp)
                             (list:cons 0 x)
                             (with (y (map self sexp)
                                      psh
                                      (fn (n lst)
                                          (map (make-br-fn (cons (+ n car._) cdr._))  
                                               lst))
                                      endit
                                      (make-br-fn (let l
                                                       (last _)
                                                       (= cdr.l (string cdr.l #\)))  
                                                       _)))
                                   (if (acons:car sexp)
                                       (let q
                                            (psh 1
                                                 (apply join (cdr:car y) cdr.y))  
                                            (cons (cons 0
                                                        (string #\(
                                                                (cdr:caar y)
                                                                (unless q #\))))
                                                  (when q (endit q))))
                                       (is 1 (len sexp))
                                       (list (cons 0
                                                   (string #\( (tw car.sexp) #\))))  
                                       (and (is 2 (len sexp))
                                            (is 2 len y))
                                       (list (cons 0
                                                   (string #\(
                                                           (tw car.sexp)
                                                           #\space
                                                           (tw cadr.sexp)
                                                           #\))))
                                       (let b
                                            (string #\(
                                                    (tw car.sexp)
                                                    #\space)
                                            (cons (cons 0
                                                        (string b (cdr:car:car:cdr y)))
                                                  (endit:psh len.b
                                                             (apply join
                                                                    (cdr:cadr y)
                                                                    cddr.y)))))))))
             sexp)))


3 points by almkglor 5851 days ago | link

looks nice. How about pushing it on nex3's git?

-----

7 points by drcode 5851 days ago | link

now pushed to git in pprint.arc

-----

1 point by drcode 5851 days ago | link

sure- i don't have time right now but will in the near future (unless someone else beats me to it...)

Would I put something like this in it's own .arc or is there an appropriate place for a function like this in the git version?

-----

1 point by almkglor 5851 days ago | link

pprint.arc, maybe?

-----

1 point by drcode 5851 days ago | link

can't argue with that :)

-----