/pprint.arc

 1; Pretty-Printing.  Spun off 4 Aug 06.
 2
 3; todo: indentation of long ifs; quasiquote, unquote, unquote-splicing
 4           
 5(= bodops* (fill-table (table)
 6   '(let 2 with 1 while 1 def 2 fn 1 rfn 2 afn 1
 7     when 1 unless 1 after 1 whilet 2 for 3 each 2 whenlet 2 awhen 1
 8     whitepage 0 tag 1 form 1 aform 1 aformh 1 w/link 1 textarea 3
 9   )))
10
11(= oneline* 35) ; print exprs less than this long on one line
12
13; If returns nil, can assume it didn't have to break expr.
14  
15(def ppr (expr (o col 0) (o noindent nil))
16  (if (or (atom expr) (dotted expr))
17       (do (unless noindent (sp col))
18           (write expr)
19           nil)
20      (is (car expr) 'quote)
21       (do (unless noindent (sp col))
22           (pr "'")
23           (ppr (cadr expr) (+ col 1) t))
24      (bodops* (car expr))
25       (do (unless noindent (sp col))
26           (let whole (tostring (write expr))
27             (if (< (len whole) oneline*)
28                 (do (pr whole) nil)
29                 (ppr-progn expr col noindent))))
30      (do (unless noindent (sp col))
31          (let whole (tostring (write expr))
32            (if (< (len whole) oneline*)
33                (do (pr whole) nil)
34                (ppr-call expr col noindent))))))
35
36(def ppr-progn (expr col noindent)
37  (lpar)
38  (let n (bodops* (car expr))
39    (let str (tostring (write-spaced (firstn n expr)))
40      (unless (is n 0) (pr str) (sp))
41      (ppr (expr n) (+ col (len str) 2) t))
42    (map (fn (e) (prn) (ppr e (+ col 2)))
43         (nthcdr (+ n 1) expr)))
44  (rpar)
45  t)
46             
47(def ppr-call (expr col noindent)
48  (lpar)
49  (let carstr (tostring (write (car expr)))
50    (pr carstr)
51    (if (cdr expr)
52        (do (sp)
53            (let broke (ppr (cadr expr) (+ col (len carstr) 2) t)
54              (pprest (cddr expr)
55                      (+ col (len carstr) 2)
56                      (no broke)))
57            t)
58        (do (rpar) t))))
59       
60(def pprest (exprs col (o oneline t))
61  (if (and oneline
62           (all (fn (e)
63                  (or (atom e) (and (is (car e) 'quote) (atom (cadr e)))))
64                exprs))
65      (do (map (fn (e) (pr " ") (write e))
66               exprs)
67          (rpar))
68      (do (when exprs
69            (each e exprs (prn) (ppr e col)))
70          (rpar))))
71                
72(def write-spaced (xs)
73  (when xs
74    (write (car xs))
75    (each x (cdr xs) (pr " ") (write x))))
76  
77(def sp ((o n 1)) (repeat n (pr " ")))
78(def lpar () (pr "("))
79(def rpar () (pr ")"))
80