prt-pg
0 ;Mercredi 8 Mai 2002 17:36:47 file : prt-pg ;
1
2 ; ------ pretty-print, par [pg];
3 ; 18-Jan-82 : prettyfie les fonctions tracees.;
4 ;(setq --x-- careful);
5 ;(setq careful ());
6
7 (setq --x-- 'careful careful nil)
8
9 (df pretty (l) (mapc l (lambda (f) (terpri) (pprint f))))
10
11 (de pprint (f ;; x)
12 (status print 3)
13 ; bit 0 : '"' , bit 1 : pas d'espace.;
14 (setq lmargin 0)
15 (setq x (cdr (assoc (ftyp f) '((7 . de) (8 . df) (9 . macro)))))
16 (and x (p-p [x f . (or (get f 'trace) (fval f))]))
17 (terpri)
18 (status print 0)
19 f)
20
21 (de p-p (l ;; x xx)
22 (status print 3)
23 ; pour les appels exterieurs;
24 (cond
25 ((null l) (princh "()"))
26 ((atom l) (prin1 l))
27 ((and (eq (car l) quote) (null (cddr l))) (princh "'") (p-p (cadr l)))
28 (t
29 (if (and (listp (car l)) (eq (caar l) lambda))
30 (setq
31 l
32 ['let
33 (let ((v (cadar l)) (a (cdr l)))
34 (if (null v) nil [[(nextl v) (nextl a)] . (self v a)]))
35 . (cddar l)]))
36 (setq xx (outpos))
37 (princh "(")
38 (p-p (car l))
39 ; attention a un non-atome en tete;
40 (selectq (and (litatom (setq x (nextl l))) (get x 'ptyp))
41 (1 ; format PROGN ; (p-progn))
42 (2 ; format WHILE ; (p-p1) (p-progn t))
43 (3 ; format DEF ; (p-p1) (p-p1) (p-progn t))
44 (4 ; format COND ; (p-cond))
45 (5 ; format SELECTQ ; (p-p1) (p-cond))
46 (t ; format standard ; (t+3) (while (listp l) (p-p1)) (t-3)))
47 (and l (princh " . ") (princh l))
48 (princh ")"))))
49
50 (de p-p1 () (princh " ") (p-p (nextl l)))
51
52 (de t+3 () (setq lmargin (+ lmargin 3)))
53
54 (de t-3 () (setq lmargin (- lmargin 3)))
55
56 (de p-progn (?)
57 (if (and (null (cdr l)) (null ?))
58 (p-p1)
59 ; un seul argument;
60 (t+3)
61 ; plusieurs;
62 (while (listp l) (if (> lmargin (outpos)) (outpos lmargin) (terpri)) (p-p (nextl l)))
63 (t-3)))
64
65 (de p-cond ()
66 (t+3)
67 (while (listp l)
68 (terpri)
69 (princh "(")
70 (let (l (nextl l)) (p-p (nextl l)) (if l (p-progn)))
71 (princh ")"))
72 (t-3))
73
74 (mapc '(progn ; type progn; prog1 and exit or) (lambda (x) (put x 'ptyp 1)))
75
76 (mapc '(lambda ; type lambda; escape if ifn let mapc mapcar while until) (lambda (x) (put x 'ptyp 2)))
77
78 (mapc '(de ; type def; df dm dmc) (lambda (x) (put x 'ptyp 3)))
79
80 (mapc '(cond ; type cond;) (lambda (x) (put x 'ptyp 4)))
81
82 (mapc '(selectq ; type selectq;) (lambda (x) (put x 'ptyp 5)))
83
84 (mapc '(setq ; type setq multiple;) (lambda (x) (put x 'ptyp 6)))
85
86 ;(de e () (sh "ed pretty.vlisp") (lib pretty));
87
Cross Reference
p-cond de 65
p-p de 21
p-p1 de 50
p-progn de 56
pprint de 11
pretty df 9
t+3 de 52
t-3 de 54
1 --x-- 7
2 ? 56 57
3 a 33 34 34
4 f 9 9 11 15 16 16 16 19
5 l 9 9 21 25 26 26 27 27 27 29 29 31 33 33 35
38 40 46 47 47 50 57 62 62 67 70 70 70 70
6 macro 15
7 p-cond 44 45 65
8 p-p 16 21 27 38 50 62 70
9 p-p1 42 43 43 45 46 50 58
10 p-progn 41 42 43 56 70
11 pprint 9 11
12 pretty 9
13 ptyp 40 74 76 78 80 82 84
14 t+3 46 52 60 66
15 t-3 46 54 63 72
16 trace 16
17 v 33 34 34 34
18 x 11 15 16 16 21 40 40 74 74 76 76 78 78 80 80
82 82 84 84
19 xx 21 36
;Mercredi 8 Mai 2002 17:36:47 end of file : prt-pg ;