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