PageRenderTime 6ms CodeModel.GetById 1ms app.highlight 2ms RepoModel.GetById 1ms app.codeStats 0ms

/pprint.arc

http://github.com/alimoeeny/arc
Unknown | 80 lines | 69 code | 11 blank | 0 comment | 0 complexity | 0478213784fb97d09895333cc9eb869f MD5 | raw file
 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