blob: 6077f570b9dc7fdcb9414b0291a607f82566db83 (
about) (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
;;; print-flic.scm -- printers for FLIC structures
;;;
;;; author : Sandra Loosemore
;;; date : 30 Mar 1992
;;;
;;;
;;; For now, printing of FLIC structures is controlled by the same
;;; *print-ast-syntax* variable as for AST structures.
;;; Maybe eventually this should use its own variable.
(define-syntax (define-flic-printer type lambda-list . body)
`(define-ast-printer ,type ,lambda-list ,@body))
(define-flic-printer flic-lambda (object xp)
(with-ast-block (xp)
(write-string "\\ " xp)
(write-ordinary-list (flic-lambda-vars object) xp)
(write-string " ->" xp)
(write-whitespace xp)
(write (flic-lambda-body object) xp)))
(define-flic-printer flic-let (object xp)
(pprint-logical-block (xp '() "" "") ; no extra indentation
(write-string "let " xp)
(write-layout-rule (flic-let-bindings object) xp
(lambda (v xp)
(with-ast-block (xp)
(write v xp)
(write-string " =" xp)
(write-whitespace xp)
(write (var-value v) xp))))
(write-whitespace xp)
(write-string "in " xp)
(write (flic-let-body object) xp)))
(define-flic-printer flic-app (object xp)
(with-ast-block (xp)
(maybe-paren-flic-object (flic-app-fn object) xp)
(write-whitespace xp)
(write-flic-list (flic-app-args object) xp)))
(define (maybe-paren-flic-object object xp)
(cond ((or (flic-ref? object)
(flic-const? object)
(flic-pack? object))
(write object xp))
(else
(write-char #\( xp)
(write object xp)
(write-char #\) xp))))
(define (write-flic-list objects xp)
(write-delimited-list objects xp (function maybe-paren-flic-object) "" "" ""))
(define-flic-printer flic-ref (object xp)
(write (flic-ref-var object) xp))
(define-flic-printer flic-const (object xp)
(write (flic-const-value object) xp))
(define-flic-printer flic-pack (object xp)
(write-string "pack/" xp)
(write (flic-pack-con object) xp))
(define-flic-printer flic-case-block (object xp)
(with-ast-block (xp)
(write-string "case-block " xp)
(write (flic-case-block-block-name object) xp)
(write-whitespace xp)
(write-layout-rule (flic-case-block-exps object) xp (function write))))
(define-flic-printer flic-return-from (object xp)
(with-ast-block (xp)
(write-string "return-from " xp)
(write (flic-return-from-block-name object) xp)
(write-whitespace xp)
(write (flic-return-from-exp object) xp)))
(define-flic-printer flic-and (object xp)
(with-ast-block (xp)
(write-string "and " xp)
(write-layout-rule (flic-and-exps object) xp (function write))))
(define-flic-printer flic-if (object xp)
(with-ast-block (xp)
(write-string "if " xp)
(write (flic-if-test-exp object) xp)
(write-whitespace xp)
(with-ast-block (xp)
(write-string "then" xp)
(write-whitespace xp)
(write (flic-if-then-exp object) xp))
(write-whitespace xp)
(with-ast-block (xp)
(write-string "else" xp)
(write-whitespace xp)
(write (flic-if-else-exp object) xp))
))
(define-flic-printer flic-sel (object xp)
(with-ast-block (xp)
(write-string "sel/" xp)
(write (flic-sel-con object) xp)
(write-char #\/ xp)
(write (flic-sel-i object) xp)
(write-whitespace xp)
(write (flic-sel-exp object) xp)))
(define-flic-printer flic-is-constructor (object xp)
(with-ast-block (xp)
(write-string "is-constructor/" xp)
(write (flic-is-constructor-con object) xp)
(write-whitespace xp)
(write (flic-is-constructor-exp object) xp)))
(define-flic-printer flic-con-number (object xp)
(with-ast-block (xp)
(write-string "con/" xp)
(write (flic-con-number-type object) xp)
(write-whitespace xp)
(write (flic-con-number-exp object) xp)))
(define-flic-printer flic-void (object xp)
(declare (ignore object))
(write-string "Void" xp))
|
