1 /* Copyright (c) 1982 Regents of the University of California */
2 
3 static char sccsid[] = "@(#)printdecl.c 1.2 02/14/83";
4 
5 /*
6  * Print out the type of a symbol.
7  */
8 
9 #include "defs.h"
10 #include "sym.h"
11 #include "symtab.h"
12 #include "tree.h"
13 #include "btypes.h"
14 #include "classes.h"
15 #include "sym.rep"
16 
17 printdecl(s)
18 SYM *s;
19 {
20     register SYM *t;
21     BOOLEAN semicolon;
22 
23     semicolon = TRUE;
24     switch(s->class) {
25 	case CONST:
26 	    t = rtype(s->type);
27 	    if (t->class == SCAL) {
28 		printf("(enumeration constant, ord %ld)", s->symvalue.iconval);
29 	    } else {
30 		printf("const %s = ", s->symbol);
31 		if (t == t_real) {
32 		    printf("%g", s->symvalue.fconval);
33 		} else {
34 		    printordinal(s->symvalue.iconval, t);
35 		}
36 	    }
37 	    break;
38 
39 	case TYPE:
40 	    printf("type %s = ", s->symbol);
41 	    printtype(s, s->type);
42 	    break;
43 
44 	case VAR:
45 	    if (isparam(s)) {
46 		printf("(parameter) %s : ", s->symbol);
47 	    } else {
48 		printf("var %s : ", s->symbol);
49 	    }
50 	    printtype(s, s->type);
51 	    break;
52 
53 	case REF:
54 	    printf("(var parameter) %s : ", s->symbol);
55 	    printtype(s, s->type);
56 	    break;
57 
58 	case RANGE:
59 	case ARRAY:
60 	case RECORD:
61 	case VARNT:
62 	case PTR:
63 	    printtype(s, s);
64 	    semicolon = FALSE;
65 	    break;
66 
67 	case FVAR:
68 	    printf("(function variable) %s : ", s->symbol);
69 	    printtype(s, s->type);
70 	    break;
71 
72 	case FIELD:
73 	    printf("(field) %s : ", s->symbol);
74 	    printtype(s, s->type);
75 	    break;
76 
77 	case PROC:
78 	    printf("procedure %s", s->symbol);
79 	    listparams(s);
80 	    break;
81 
82 	case PROG:
83 	    printf("program %s", s->symbol);
84 	    t = s->chain;
85 	    if (t != NIL) {
86 		printf("(%s", t->symbol);
87 		for (t = t->chain; t != NIL; t = t->chain) {
88 		    printf(", %s", t->symbol);
89 		}
90 		printf(")");
91 	    }
92 	    break;
93 
94 	case FUNC:
95 	    printf("function %s", s->symbol);
96 	    listparams(s);
97 	    printf(" : ");
98 	    printtype(s, s->type);
99 	    break;
100 
101 	default:
102 	    error("class %s in printdecl", classname(s));
103     }
104     if (semicolon) {
105 	putchar(';');
106     }
107     putchar('\n');
108 }
109 
110 /*
111  * Recursive whiz-bang procedure to print the type portion
112  * of a declaration.  Doesn't work quite right for variant records.
113  *
114  * The symbol associated with the type is passed to allow
115  * searching for type names without getting "type blah = blah".
116  */
117 
118 LOCAL printtype(s, t)
119 SYM *s;
120 SYM *t;
121 {
122     register SYM *tmp;
123     long r0, r1;
124 
125     tmp = findtype(t);
126     if (tmp != NIL && tmp != s) {
127 	printf("%s", tmp->symbol);
128 	return;
129     }
130     switch(t->class) {
131 	case VAR:
132 	case CONST:
133 	case FUNC:
134 	case PROC:
135 	    panic("printtype: class %s", classname(t));
136 	    break;
137 
138 	case ARRAY:
139 	    printf("array[");
140 	    tmp = t->chain;
141 	    for (;;) {
142 		printtype(tmp, tmp);
143 		tmp = tmp->chain;
144 		if (tmp == NIL) {
145 		    break;
146 		}
147 		printf(", ");
148 	    }
149 	    printf("] of ");
150 	    printtype(t, t->type);
151 	    break;
152 
153 	case RECORD:
154 	    printf("record\n");
155 	    if (t->chain != NIL) {
156 		printtype(t->chain, t->chain);
157 	    }
158 	    printf("end");
159 	    break;
160 
161 	case FIELD:
162 	    if (t->chain != NIL) {
163 		printtype(t->chain, t->chain);
164 	    }
165 	    printf("\t%s : ", t->symbol);
166 	    printtype(t, t->type);
167 	    printf(";\n");
168 	    break;
169 
170 	case RANGE:
171 	    r0 = t->symvalue.rangev.lower;
172 	    r1 = t->symvalue.rangev.upper;
173 	    printordinal(r0, rtype(t->type));
174 	    printf("..");
175 	    printordinal(r1, rtype(t->type));
176 	    break;
177 
178 	case PTR:
179 	    putchar('^');
180 	    printtype(t, t->type);
181 	    break;
182 
183 	case TYPE:
184 	    if (t->symbol != NIL) {
185 		printf("%s", t->symbol);
186 	    } else {
187 		printtype(t, t->type);
188 	    }
189 	    break;
190 
191 	case SCAL:
192 	    printf("(");
193 	    t = t->type->chain;
194 	    if (t != NIL) {
195 		printf("%s", t->symbol);
196 		t = t->chain;
197 		while (t != NIL) {
198 		    printf(", %s", t->symbol);
199 		    t = t->chain;
200 		}
201 	    } else {
202 		panic("empty enumeration");
203 	    }
204 	    printf(")");
205 	    break;
206 
207 	default:
208 	    printf("(class %d)", t->class);
209 	    break;
210     }
211 }
212 
213 /*
214  * List the parameters of a procedure or function.
215  * No attempt is made to combine like types.
216  */
217 
218 listparams(s)
219 SYM *s;
220 {
221     SYM *t;
222 
223     if (s->chain != NIL) {
224 	putchar('(');
225 	for (t = s->chain; t != NIL; t = t->chain) {
226 	    switch (t->class) {
227 		case REF:
228 		    printf("var ");
229 		    break;
230 
231 		case FPROC:
232 		    printf("procedure ");
233 		    break;
234 
235 		case FFUNC:
236 		    printf("function ");
237 		    break;
238 
239 		case VAR:
240 		    break;
241 
242 		default:
243 		    panic("unexpected class %d for parameter", t->class);
244 	    }
245 	    printf("%s : ", t->symbol);
246 	    printtype(t, t->type);
247 	    if (t->chain != NIL) {
248 		printf("; ");
249 	    }
250 	}
251 	putchar(')');
252     }
253 }
254