Compilerbau & Formale Sprachen: Semantische Analyse
| Compilerbau & Formale Sprachen: Semantische Analyse |
|
|
|
1-- $Id: AbstractSyntax.hs,v 1.14 2001/03/06 21:36:39 uwe Exp $
2
3module PPL.AbstractSyntax where
4
5data Program
6 = Program [GlobDecl] Stmt
7 deriving (Eq, Show)
8
9data Stmt
10 = Assignment [Var] [Expr]
11 | Decl Var Type
12 | FctDecl FctName [ParamDecl] ResType FctBody
13 | ProcDecl FctName [ParamDecl] Stmt
14 | ProcCall Expr
15 | Block [Stmt]
16 | While Expr Stmt
17 | Repeat Stmt Expr
18 | If Expr Stmt Stmt
19 deriving (Eq, Show)
20
21data Expr
22 = UndefVal
23 | IntVal Int
24 | BoolVal Bool
25 | FloatVal Double
26 | StringVal String
27 | EmptyList
28 | Ident String
29 | Call String [Expr]
30 | Opr String [AttrTree]
31 | BlockExpr [Stmt] Expr
32 deriving (Eq, Show)
33
34data Type
35 = UnknownType
36 | AnyType
37 | VoidType
38 | IntType
39 | BoolType
40 | FloatType
41 | PictureType
42 | StringType
43 | ListType Type
44 | FctType Type [Type]
45 deriving (Eq, Show)
46
47type Var = Expr
48type FctName = Expr
49type ParamDecl = Stmt
50type ResType = Type
51type FctBody = Expr
52type GlobDecl = Stmt
53
54type AttrTree = (Expr, Type)
55
|
|
1begin
2 var
3 i, j, k : int
4 := 1, 2, 3;
5
6 -- simple integer arithmetic
7
8 i := -i +j -1 + j * k div (i mod 3);
9 i, j := i max j max k, i min j min k;
10
11 -- simple floating point arithmetic
12
13 begin
14 var
15 x, y, z : float
16 := 1.0, -2.0, +3.0;
17
18 x := -x * y + (z - y) / x * y
19 end;
20
21 -- boolean and relational operators
22
23 begin
24 var
25 a, b, c : boolean
26 := true, false, false;
27
28 a := (i < j) and (j <= k) or b or not c;
29 a := b => c;
30 a := b <=> a and c
31 end;
32
33 -- string expressions
34
35 begin
36 var
37 s1, s2 : string
38 := "hello", "world";
39
40 s1 := s1 + s2 + "\"" + i.toString + "\"";
41
42 write(s1);
43 writeln(s2)
44 end;
45
46 -- list operations
47
48 begin
49 var
50 l1, l2 : list of int
51 := [0, 1, 1, 2, 3, 5, 8, 13], [];
52
53 l2 := l2.append(42)
54 .append(43);
55
56 if l2.empty
57 then
58 l2 := [1, 2, 3]
59 endif;
60
61 l1 := l1.cons(41);
62
63 l1 := l1 + l2 + l1;
64
65 l1 := l1.tail
66 .cons(l1.head)
67 .cons(l1[i])
68 .append(l1[l1.length -1])
69 end;
70
71 -- picture operations
72
73 begin
74 var
75 p1, p2, p3 : picture;
76
77 -- new pictures
78
79 p1 := white(100,200);
80 p2 := grey(0.5, p1.width, p1.height);
81 p3 := black(100,200);
82
83 -- flip and gamma corrections
84
85 p2 := p2.flipVertical
86 .flipHorizontal
87 .gamma(1.5);
88
89 -- same as above with funtional syntax
90
91 p2 := gamma(flipHorizontal(flipVertical(p2)),
92 1.5);
93
94 -- load a picture
95
96 p2 := load("t.pgm");
97
98 -- make negative picture
99
100 p1 := p2.invert;
101
102 -- combine 2 pictures
103
104 p2 := above(sideBySide(p1,p2),
105 sideBySide(p2,p1));
106
107 -- pixelwise arithmetic mean of grey values
108
109 p2 := p1 + p2;
110
111 -- pixelwise difference of grey values
112
113 p2 := p1 - p2;
114
115 -- pixelwise min and max operations
116
117 p1 := p1 max p2 min p3;
118
119 -- store pictures
120
121 store(p1,"p1.pgm");
122
123 p2.store("p2.pgm")
124
125 end;
126
127 -- get command line arguments
128 begin
129 var
130 ls1 : list of string
131 -- not yet implemented: ls1 := getargs()
132 end
133
134end
|
|
1---Program
2 |
3 +---Block
4 |
5 +---Decl
6 | |
7 | +---Ident i
8 | |
9 | +---IntType
10 |
11 +---Decl
12 | |
13 | +---Ident j
14 | |
15 | +---IntType
16 |
17 +---Decl
18 | |
19 | +---Ident k
20 | |
21 | +---IntType
22 |
23 +---Assignment
24 | |
25 | +---Ident i
26 | |
27 | +---Ident j
28 | |
29 | +---Ident k
30 | |
31 | +---IntVal 1
32 | |
33 | +---IntVal 2
34 | |
35 | +---IntVal 3
36 |
37 +---Assignment
38 | |
39 | +---Ident i
40 | |
41 | +---Op +
42 | |
43 | +---Op -
44 | | |
45 | | +---Op +
46 | | | |
47 | | | +---Op -u
48 | | | | |
49 | | | | +---Ident i
50 | | | |
51 | | | +---Ident j
52 | | |
53 | | +---IntVal 1
54 | |
55 | +---Op div
56 | |
57 | +---Op *
58 | | |
59 | | +---Ident j
60 | | |
61 | | +---Ident k
62 | |
63 | +---Op mod
64 | |
65 | +---Ident i
66 | |
67 | +---IntVal 3
68 |
69 +---Assignment
70 | |
71 | +---Ident i
72 | |
73 | +---Ident j
74 | |
75 | +---Op max
76 | | |
77 | | +---Op max
78 | | | |
79 | | | +---Ident i
80 | | | |
81 | | | +---Ident j
82 | | |
83 | | +---Ident k
84 | |
85 | +---Op min
86 | |
87 | +---Op min
88 | | |
89 | | +---Ident i
90 | | |
91 | | +---Ident j
92 | |
93 | +---Ident k
94 |
95 +---Block
96 | |
97 | +---Decl
98 | | |
99 | | +---Ident x
100 | | |
101 | | +---FloatType
102 | |
103 | +---Decl
104 | | |
105 | | +---Ident y
106 | | |
107 | | +---FloatType
108 | |
109 | +---Decl
110 | | |
111 | | +---Ident z
112 | | |
113 | | +---FloatType
114 | |
115 | +---Assignment
116 | | |
117 | | +---Ident x
118 | | |
119 | | +---Ident y
120 | | |
121 | | +---Ident z
122 | | |
123 | | +---FloatVal 1.0
124 | | |
125 | | +---Op -u
126 | | | |
127 | | | +---FloatVal 2.0
128 | | |
129 | | +---Op +u
130 | | |
131 | | +---FloatVal 3.0
132 | |
133 | +---Assignment
134 | |
135 | +---Ident x
136 | |
137 | +---Op +
138 | |
139 | +---Op *
140 | | |
141 | | +---Op -u
142 | | | |
143 | | | +---Ident x
144 | | |
145 | | +---Ident y
146 | |
147 | +---Op *
148 | |
149 | +---Op /
150 | | |
151 | | +---Op -
152 | | | |
153 | | | +---Ident z
154 | | | |
155 | | | +---Ident y
156 | | |
157 | | +---Ident x
158 | |
159 | +---Ident y
160 |
161 +---Block
162 | |
163 | +---Decl
164 | | |
165 | | +---Ident a
166 | | |
167 | | +---BoolType
168 | |
169 | +---Decl
170 | | |
171 | | +---Ident b
172 | | |
173 | | +---BoolType
174 | |
175 | +---Decl
176 | | |
177 | | +---Ident c
178 | | |
179 | | +---BoolType
180 | |
181 | +---Assignment
182 | | |
183 | | +---Ident a
184 | | |
185 | | +---Ident b
186 | | |
187 | | +---Ident c
188 | | |
189 | | +---BoolVal True
190 | | |
191 | | +---BoolVal False
192 | | |
193 | | +---BoolVal False
194 | |
195 | +---Assignment
196 | | |
197 | | +---Ident a
198 | | |
199 | | +---Op or
200 | | |
201 | | +---Op or
202 | | | |
203 | | | +---Op and
204 | | | | |
205 | | | | +---Op <
206 | | | | | |
207 | | | | | +---Ident i
208 | | | | | |
209 | | | | | +---Ident j
210 | | | | |
211 | | | | +---Op <=
212 | | | | |
213 | | | | +---Ident j
214 | | | | |
215 | | | | +---Ident k
216 | | | |
217 | | | +---Ident b
218 | | |
219 | | +---Op not
220 | | |
221 | | +---Ident c
222 | |
223 | +---Assignment
224 | | |
225 | | +---Ident a
226 | | |
227 | | +---Op =>
228 | | |
229 | | +---Ident b
230 | | |
231 | | +---Ident c
232 | |
233 | +---Assignment
234 | |
235 | +---Ident a
236 | |
237 | +---Op <=>
238 | |
239 | +---Ident b
240 | |
241 | +---Op and
242 | |
243 | +---Ident a
244 | |
245 | +---Ident c
246 |
247 +---Block
248 | |
249 | +---Decl
250 | | |
251 | | +---Ident s1
252 | | |
253 | | +---StringType
254 | |
255 | +---Decl
256 | | |
257 | | +---Ident s2
258 | | |
259 | | +---StringType
260 | |
261 | +---Assignment
262 | | |
263 | | +---Ident s1
264 | | |
265 | | +---Ident s2
266 | | |
267 | | +---StringVal "hello"
268 | | |
269 | | +---StringVal "world"
270 | |
271 | +---Assignment
272 | | |
273 | | +---Ident s1
274 | | |
275 | | +---Op +
276 | | |
277 | | +---Op +
278 | | | |
279 | | | +---Op +
280 | | | | |
281 | | | | +---Op +
282 | | | | | |
283 | | | | | +---Ident s1
284 | | | | | |
285 | | | | | +---Ident s2
286 | | | | |
287 | | | | +---StringVal """
288 | | | |
289 | | | +---Op toString
290 | | | |
291 | | | +---Ident i
292 | | |
293 | | +---StringVal """
294 | |
295 | +---ProcCall
296 | | |
297 | | +---Op write
298 | | |
299 | | +---Ident s1
300 | |
301 | +---ProcCall
302 | |
303 | +---Op writeln
304 | |
305 | +---Ident s2
306 |
307 +---Block
308 | |
309 | +---Decl
310 | | |
311 | | +---Ident l1
312 | | |
313 | | +---ListType
314 | | |
315 | | +---IntType
316 | |
317 | +---Decl
318 | | |
319 | | +---Ident l2
320 | | |
321 | | +---ListType
322 | | |
323 | | +---IntType
324 | |
325 | +---Assignment
326 | | |
327 | | +---Ident l1
328 | | |
329 | | +---Ident l2
330 | | |
331 | | +---Op cons
332 | | | |
333 | | | +---Op cons
334 | | | | |
335 | | | | +---Op cons
336 | | | | | |
337 | | | | | +---Op cons
338 | | | | | | |
339 | | | | | | +---Op cons
340 | | | | | | | |
341 | | | | | | | +---Op cons
342 | | | | | | | | |
343 | | | | | | | | +---Op cons
344 | | | | | | | | | |
345 | | | | | | | | | +---Op cons
346 | | | | | | | | | | |
347 | | | | | | | | | | +---EmptyList
348 | | | | | | | | | | |
349 | | | | | | | | | | +---IntVal 13
350 | | | | | | | | | |
351 | | | | | | | | | +---IntVal 8
352 | | | | | | | | |
353 | | | | | | | | +---IntVal 5
354 | | | | | | | |
355 | | | | | | | +---IntVal 3
356 | | | | | | |
357 | | | | | | +---IntVal 2
358 | | | | | |
359 | | | | | +---IntVal 1
360 | | | | |
361 | | | | +---IntVal 1
362 | | | |
363 | | | +---IntVal 0
364 | | |
365 | | +---EmptyList
366 | |
367 | +---Assignment
368 | | |
369 | | +---Ident l2
370 | | |
371 | | +---Op append
372 | | |
373 | | +---Op append
374 | | | |
375 | | | +---Ident l2
376 | | | |
377 | | | +---IntVal 42
378 | | |
379 | | +---IntVal 43
380 | |
381 | +---If
382 | | |
383 | | +---Op empty
384 | | | |
385 | | | +---Ident l2
386 | | |
387 | | +---Block
388 | | | |
389 | | | +---Assignment
390 | | | |
391 | | | +---Ident l2
392 | | | |
393 | | | +---Op cons
394 | | | |
395 | | | +---Op cons
396 | | | | |
397 | | | | +---Op cons
398 | | | | | |
399 | | | | | +---EmptyList
400 | | | | | |
401 | | | | | +---IntVal 3
402 | | | | |
403 | | | | +---IntVal 2
404 | | | |
405 | | | +---IntVal 1
406 | | |
407 | | +---Block
408 | |
409 | +---Assignment
410 | | |
411 | | +---Ident l1
412 | | |
413 | | +---Op cons
414 | | |
415 | | +---Ident l1
416 | | |
417 | | +---IntVal 41
418 | |
419 | +---Assignment
420 | | |
421 | | +---Ident l1
422 | | |
423 | | +---Op +
424 | | |
425 | | +---Op +
426 | | | |
427 | | | +---Ident l1
428 | | | |
429 | | | +---Ident l2
430 | | |
431 | | +---Ident l1
432 | |
433 | +---Assignment
434 | |
435 | +---Ident l1
436 | |
437 | +---Op append
438 | |
439 | +---Op cons
440 | | |
441 | | +---Op cons
442 | | | |
443 | | | +---Op tail
444 | | | | |
445 | | | | +---Ident l1
446 | | | |
447 | | | +---Op head
448 | | | |
449 | | | +---Ident l1
450 | | |
451 | | +---Op [.]
452 | | |
453 | | +---Ident l1
454 | | |
455 | | +---Ident i
456 | |
457 | +---Op [.]
458 | |
459 | +---Ident l1
460 | |
461 | +---Op -
462 | |
463 | +---Op length
464 | | |
465 | | +---Ident l1
466 | |
467 | +---IntVal 1
468 |
469 +---Block
470 | |
471 | +---Decl
472 | | |
473 | | +---Ident p1
474 | | |
475 | | +---PictureType
476 | |
477 | +---Decl
478 | | |
479 | | +---Ident p2
480 | | |
481 | | +---PictureType
482 | |
483 | +---Decl
484 | | |
485 | | +---Ident p3
486 | | |
487 | | +---PictureType
488 | |
489 | +---Assignment
490 | | |
491 | | +---Ident p1
492 | | |
493 | | +---Op white
494 | | |
495 | | +---IntVal 100
496 | | |
497 | | +---IntVal 200
498 | |
499 | +---Assignment
500 | | |
501 | | +---Ident p2
502 | | |
503 | | +---Op grey
504 | | |
505 | | +---FloatVal 0.5
506 | | |
507 | | +---Op width
508 | | | |
509 | | | +---Ident p1
510 | | |
511 | | +---Op height
512 | | |
513 | | +---Ident p1
514 | |
515 | +---Assignment
516 | | |
517 | | +---Ident p3
518 | | |
519 | | +---Op black
520 | | |
521 | | +---IntVal 100
522 | | |
523 | | +---IntVal 200
524 | |
525 | +---Assignment
526 | | |
527 | | +---Ident p2
528 | | |
529 | | +---Op gamma
530 | | |
531 | | +---Op flipHorizontal
532 | | | |
533 | | | +---Op flipVertical
534 | | | |
535 | | | +---Ident p2
536 | | |
537 | | +---FloatVal 1.5
538 | |
539 | +---Assignment
540 | | |
541 | | +---Ident p2
542 | | |
543 | | +---Op gamma
544 | | |
545 | | +---Op flipHorizontal
546 | | | |
547 | | | +---Op flipVertical
548 | | | |
549 | | | +---Ident p2
550 | | |
551 | | +---FloatVal 1.5
552 | |
553 | +---Assignment
554 | | |
555 | | +---Ident p2
556 | | |
557 | | +---Op load
558 | | |
559 | | +---StringVal "t.pgm"
560 | |
561 | +---Assignment
562 | | |
563 | | +---Ident p1
564 | | |
565 | | +---Op invert
566 | | |
567 | | +---Ident p2
568 | |
569 | +---Assignment
570 | | |
571 | | +---Ident p2
572 | | |
573 | | +---Op above
574 | | |
575 | | +---Op sideBySide
576 | | | |
577 | | | +---Ident p1
578 | | | |
579 | | | +---Ident p2
580 | | |
581 | | +---Op sideBySide
582 | | |
583 | | +---Ident p2
584 | | |
585 | | +---Ident p1
586 | |
587 | +---Assignment
588 | | |
589 | | +---Ident p2
590 | | |
591 | | +---Op +
592 | | |
593 | | +---Ident p1
594 | | |
595 | | +---Ident p2
596 | |
597 | +---Assignment
598 | | |
599 | | +---Ident p2
600 | | |
601 | | +---Op -
602 | | |
603 | | +---Ident p1
604 | | |
605 | | +---Ident p2
606 | |
607 | +---Assignment
608 | | |
609 | | +---Ident p1
610 | | |
611 | | +---Op min
612 | | |
613 | | +---Op max
614 | | | |
615 | | | +---Ident p1
616 | | | |
617 | | | +---Ident p2
618 | | |
619 | | +---Ident p3
620 | |
621 | +---ProcCall
622 | | |
623 | | +---Op store
624 | | |
625 | | +---Ident p1
626 | | |
627 | | +---StringVal "p1.pgm"
628 | |
629 | +---ProcCall
630 | |
631 | +---Op store
632 | |
633 | +---Ident p2
634 | |
635 | +---StringVal "p2.pgm"
636 |
637 +---Block
638 |
639 +---Decl
640 |
641 +---Ident ls1
642 |
643 +---ListType
644 |
645 +---StringType
|
|
1---"sequence" (VoidType)
2 |
3 +---"begin" (VoidType)
4 |
5 +---"sequence" (VoidType)
6 |
7 +---"decl" (VoidType)
8 | |
9 | +---"id" i (IntType)
10 |
11 +---"decl" (VoidType)
12 | |
13 | +---"id" j (IntType)
14 |
15 +---"decl" (VoidType)
16 | |
17 | +---"id" k (IntType)
18 |
19 +---":=" (VoidType)
20 | |
21 | +---"id" i (IntType)
22 | |
23 | +---"id" j (IntType)
24 | |
25 | +---"id" k (IntType)
26 | |
27 | +---1 (IntType)
28 | |
29 | +---2 (IntType)
30 | |
31 | +---3 (IntType)
32 |
33 +---":=" (VoidType)
34 | |
35 | +---"id" i (IntType)
36 | |
37 | +---"addi" (IntType)
38 | |
39 | +---"subi" (IntType)
40 | | |
41 | | +---"addi" (IntType)
42 | | | |
43 | | | +---"negi" (IntType)
44 | | | | |
45 | | | | +---"id" i (IntType)
46 | | | |
47 | | | +---"id" j (IntType)
48 | | |
49 | | +---1 (IntType)
50 | |
51 | +---"divi" (IntType)
52 | |
53 | +---"muli" (IntType)
54 | | |
55 | | +---"id" j (IntType)
56 | | |
57 | | +---"id" k (IntType)
58 | |
59 | +---"modi" (IntType)
60 | |
61 | +---"id" i (IntType)
62 | |
63 | +---3 (IntType)
64 |
65 +---":=" (VoidType)
66 | |
67 | +---"id" i (IntType)
68 | |
69 | +---"id" j (IntType)
70 | |
71 | +---"maxi" (IntType)
72 | | |
73 | | +---"maxi" (IntType)
74 | | | |
75 | | | +---"id" i (IntType)
76 | | | |
77 | | | +---"id" j (IntType)
78 | | |
79 | | +---"id" k (IntType)
80 | |
81 | +---"mini" (IntType)
82 | |
83 | +---"mini" (IntType)
84 | | |
85 | | +---"id" i (IntType)
86 | | |
87 | | +---"id" j (IntType)
88 | |
89 | +---"id" k (IntType)
90 |
91 +---"begin" (VoidType)
92 | |
93 | +---"sequence" (VoidType)
94 | |
95 | +---"decl" (VoidType)
96 | | |
97 | | +---"id" x (FloatType)
98 | |
99 | +---"decl" (VoidType)
100 | | |
101 | | +---"id" y (FloatType)
102 | |
103 | +---"decl" (VoidType)
104 | | |
105 | | +---"id" z (FloatType)
106 | |
107 | +---":=" (VoidType)
108 | | |
109 | | +---"id" x (FloatType)
110 | | |
111 | | +---"id" y (FloatType)
112 | | |
113 | | +---"id" z (FloatType)
114 | | |
115 | | +---1.0 (FloatType)
116 | | |
117 | | +---"negf" (FloatType)
118 | | | |
119 | | | +---2.0 (FloatType)
120 | | |
121 | | +---"ident" (FloatType)
122 | | |
123 | | +---3.0 (FloatType)
124 | |
125 | +---":=" (VoidType)
126 | | |
127 | | +---"id" x (FloatType)
128 | | |
129 | | +---"addf" (FloatType)
130 | | |
131 | | +---"mulf" (FloatType)
132 | | | |
133 | | | +---"negf" (FloatType)
134 | | | | |
135 | | | | +---"id" x (FloatType)
136 | | | |
137 | | | +---"id" y (FloatType)
138 | | |
139 | | +---"mulf" (FloatType)
140 | | |
141 | | +---"divf" (FloatType)
142 | | | |
143 | | | +---"subf" (FloatType)
144 | | | | |
145 | | | | +---"id" z (FloatType)
146 | | | | |
147 | | | | +---"id" y (FloatType)
148 | | | |
149 | | | +---"id" x (FloatType)
150 | | |
151 | | +---"id" y (FloatType)
152 | |
153 | +---":=" (VoidType)
154 | | |
155 | | +---"id" x (FloatType)
156 | | |
157 | | +---UndefVal (FloatType)
158 | |
159 | +---":=" (VoidType)
160 | | |
161 | | +---"id" y (FloatType)
162 | | |
163 | | +---UndefVal (FloatType)
164 | |
165 | +---":=" (VoidType)
166 | |
167 | +---"id" z (FloatType)
168 | |
169 | +---UndefVal (FloatType)
170 |
171 +---"begin" (VoidType)
172 | |
173 | +---"sequence" (VoidType)
174 | |
175 | +---"decl" (VoidType)
176 | | |
177 | | +---"id" a (BoolType)
178 | |
179 | +---"decl" (VoidType)
180 | | |
181 | | +---"id" b (BoolType)
182 | |
183 | +---"decl" (VoidType)
184 | | |
185 | | +---"id" c (BoolType)
186 | |
187 | +---":=" (VoidType)
188 | | |
189 | | +---"id" a (BoolType)
190 | | |
191 | | +---"id" b (BoolType)
192 | | |
193 | | +---"id" c (BoolType)
194 | | |
195 | | +---True (BoolType)
196 | | |
197 | | +---False (BoolType)
198 | | |
199 | | +---False (BoolType)
200 | |
201 | +---":=" (VoidType)
202 | | |
203 | | +---"id" a (BoolType)
204 | | |
205 | | +---"or" (BoolType)
206 | | |
207 | | +---"or" (BoolType)
208 | | | |
209 | | | +---"and" (BoolType)
210 | | | | |
211 | | | | +---"lti" (BoolType)
212 | | | | | |
213 | | | | | +---"id" i (IntType)
214 | | | | | |
215 | | | | | +---"id" j (IntType)
216 | | | | |
217 | | | | +---"lei" (BoolType)
218 | | | | |
219 | | | | +---"id" j (IntType)
220 | | | | |
221 | | | | +---"id" k (IntType)
222 | | | |
223 | | | +---"id" b (BoolType)
224 | | |
225 | | +---"not" (BoolType)
226 | | |
227 | | +---"id" c (BoolType)
228 | |
229 | +---":=" (VoidType)
230 | | |
231 | | +---"id" a (BoolType)
232 | | |
233 | | +---"impl" (BoolType)
234 | | |
235 | | +---"id" b (BoolType)
236 | | |
237 | | +---"id" c (BoolType)
238 | |
239 | +---":=" (VoidType)
240 | | |
241 | | +---"id" a (BoolType)
242 | | |
243 | | +---"equiv" (BoolType)
244 | | |
245 | | +---"id" b (BoolType)
246 | | |
247 | | +---"and" (BoolType)
248 | | |
249 | | +---"id" a (BoolType)
250 | | |
251 | | +---"id" c (BoolType)
252 | |
253 | +---":=" (VoidType)
254 | | |
255 | | +---"id" a (BoolType)
256 | | |
257 | | +---UndefVal (BoolType)
258 | |
259 | +---":=" (VoidType)
260 | | |
261 | | +---"id" b (BoolType)
262 | | |
263 | | +---UndefVal (BoolType)
264 | |
265 | +---":=" (VoidType)
266 | |
267 | +---"id" c (BoolType)
268 | |
269 | +---UndefVal (BoolType)
270 |
271 +---"begin" (VoidType)
272 | |
273 | +---"sequence" (VoidType)
274 | |
275 | +---"decl" (VoidType)
276 | | |
277 | | +---"id" s1 (StringType)
278 | |
279 | +---"decl" (VoidType)
280 | | |
281 | | +---"id" s2 (StringType)
282 | |
283 | +---":=" (VoidType)
284 | | |
285 | | +---"id" s1 (StringType)
286 | | |
287 | | +---"id" s2 (StringType)
288 | | |
289 | | +---""hello"" (StringType)
290 | | |
291 | | +---""world"" (StringType)
292 | |
293 | +---":=" (VoidType)
294 | | |
295 | | +---"id" s1 (StringType)
296 | | |
297 | | +---"concs" (StringType)
298 | | |
299 | | +---"concs" (StringType)
300 | | | |
301 | | | +---"concs" (StringType)
302 | | | | |
303 | | | | +---"concs" (StringType)
304 | | | | | |
305 | | | | | +---"id" s1 (StringType)
306 | | | | | |
307 | | | | | +---"id" s2 (StringType)
308 | | | | |
309 | | | | +---""\""" (StringType)
310 | | | |
311 | | | +---"i2s" (StringType)
312 | | | |
313 | | | +---"id" i (IntType)
314 | | |
315 | | +---""\""" (StringType)
316 | |
317 | +---"do" (VoidType)
318 | | |
319 | | +---"write" (VoidType)
320 | | |
321 | | +---"id" s1 (StringType)
322 | |
323 | +---"do" (VoidType)
324 | | |
325 | | +---"writeln" (VoidType)
326 | | |
327 | | +---"id" s2 (StringType)
328 | |
329 | +---":=" (VoidType)
330 | | |
331 | | +---"id" s1 (StringType)
332 | | |
333 | | +---UndefVal (StringType)
334 | |
335 | +---":=" (VoidType)
336 | |
337 | +---"id" s2 (StringType)
338 | |
339 | +---UndefVal (StringType)
340 |
341 +---"begin" (VoidType)
342 | |
343 | +---"sequence" (VoidType)
344 | |
345 | +---"decl" (VoidType)
346 | | |
347 | | +---"id" l1 (ListType IntType)
348 | |
349 | +---"decl" (VoidType)
350 | | |
351 | | +---"id" l2 (ListType IntType)
352 | |
353 | +---":=" (VoidType)
354 | | |
355 | | +---"id" l1 (ListType IntType)
356 | | |
357 | | +---"id" l2 (ListType IntType)
358 | | |
359 | | +---"consl" (ListType IntType)
360 | | | |
361 | | | +---"consl" (ListType IntType)
362 | | | | |
363 | | | | +---"consl" (ListType IntType)
364 | | | | | |
365 | | | | | +---"consl" (ListType IntType)
366 | | | | | | |
367 | | | | | | +---"consl" (ListType IntType)
368 | | | | | | | |
369 | | | | | | | +---"consl" (ListType IntType)
370 | | | | | | | | |
371 | | | | | | | | +---"consl" (ListType IntType)
372 | | | | | | | | | |
373 | | | | | | | | | +---"consl" (ListType IntType)
374 | | | | | | | | | | |
375 | | | | | | | | | | +---[] (ListType IntType)
376 | | | | | | | | | | |
377 | | | | | | | | | | +---13 (IntType)
378 | | | | | | | | | |
379 | | | | | | | | | +---8 (IntType)
380 | | | | | | | | |
381 | | | | | | | | +---5 (IntType)
382 | | | | | | | |
383 | | | | | | | +---3 (IntType)
384 | | | | | | |
385 | | | | | | +---2 (IntType)
386 | | | | | |
387 | | | | | +---1 (IntType)
388 | | | | |
389 | | | | +---1 (IntType)
390 | | | |
391 | | | +---0 (IntType)
392 | | |
393 | | +---[] (ListType IntType)
394 | |
395 | +---":=" (VoidType)
396 | | |
397 | | +---"id" l2 (ListType IntType)
398 | | |
399 | | +---"appendl" (ListType IntType)
400 | | |
401 | | +---"appendl" (ListType IntType)
402 | | | |
403 | | | +---"id" l2 (ListType IntType)
404 | | | |
405 | | | +---42 (IntType)
406 | | |
407 | | +---43 (IntType)
408 | |
409 | +---"if" (VoidType)
410 | | |
411 | | +---"isemptyl" (BoolType)
412 | | | |
413 | | | +---"id" l2 (ListType IntType)
414 | | |
415 | | +---"begin" (VoidType)
416 | | | |
417 | | | +---"sequence" (VoidType)
418 | | | |
419 | | | +---":=" (VoidType)
420 | | | |
421 | | | +---"id" l2 (ListType IntType)
422 | | | |
423 | | | +---"consl" (ListType IntType)
424 | | | |
425 | | | +---"consl" (ListType IntType)
426 | | | | |
427 | | | | +---"consl" (ListType IntType)
428 | | | | | |
429 | | | | | +---[] (ListType IntType)
430 | | | | | |
431 | | | | | +---3 (IntType)
432 | | | | |
433 | | | | +---2 (IntType)
434 | | | |
435 | | | +---1 (IntType)
436 | | |
437 | | +---"begin" (VoidType)
438 | | |
439 | | +---"sequence" (VoidType)
440 | |
441 | +---":=" (VoidType)
442 | | |
443 | | +---"id" l1 (ListType IntType)
444 | | |
445 | | +---"consl" (ListType IntType)
446 | | |
447 | | +---"id" l1 (ListType IntType)
448 | | |
449 | | +---41 (IntType)
450 | |
451 | +---":=" (VoidType)
452 | | |
453 | | +---"id" l1 (ListType IntType)
454 | | |
455 | | +---"concl" (ListType IntType)
456 | | |
457 | | +---"concl" (ListType IntType)
458 | | | |
459 | | | +---"id" l1 (ListType IntType)
460 | | | |
461 | | | +---"id" l2 (ListType IntType)
462 | | |
463 | | +---"id" l1 (ListType IntType)
464 | |
465 | +---":=" (VoidType)
466 | | |
467 | | +---"id" l1 (ListType IntType)
468 | | |
469 | | +---"appendl" (ListType IntType)
470 | | |
471 | | +---"consl" (ListType IntType)
472 | | | |
473 | | | +---"consl" (ListType IntType)
474 | | | | |
475 | | | | +---"taill" (ListType IntType)
476 | | | | | |
477 | | | | | +---"id" l1 (ListType IntType)
478 | | | | |
479 | | | | +---"headl" (IntType)
480 | | | | |
481 | | | | +---"id" l1 (ListType IntType)
482 | | | |
483 | | | +---"indexl" (IntType)
484 | | | |
485 | | | +---"id" l1 (ListType IntType)
486 | | | |
487 | | | +---"id" i (IntType)
488 | | |
489 | | +---"indexl" (IntType)
490 | | |
491 | | +---"id" l1 (ListType IntType)
492 | | |
493 | | +---"subi" (IntType)
494 | | |
495 | | +---"lengthl" (IntType)
496 | | | |
497 | | | +---"id" l1 (ListType IntType)
498 | | |
499 | | +---1 (IntType)
500 | |
501 | +---":=" (VoidType)
502 | | |
503 | | +---"id" l1 (ListType IntType)
504 | | |
505 | | +---UndefVal (ListType IntType)
506 | |
507 | +---":=" (VoidType)
508 | |
509 | +---"id" l2 (ListType IntType)
510 | |
511 | +---UndefVal (ListType IntType)
512 |
513 +---"begin" (VoidType)
514 | |
515 | +---"sequence" (VoidType)
516 | |
517 | +---"decl" (VoidType)
518 | | |
519 | | +---"id" p1 (PictureType)
520 | |
521 | +---"decl" (VoidType)
522 | | |
523 | | +---"id" p2 (PictureType)
524 | |
525 | +---"decl" (VoidType)
526 | | |
527 | | +---"id" p3 (PictureType)
528 | |
529 | +---":=" (VoidType)
530 | | |
531 | | +---"id" p1 (PictureType)
532 | | |
533 | | +---"white" (PictureType)
534 | | |
535 | | +---100 (IntType)
536 | | |
537 | | +---200 (IntType)
538 | |
539 | +---":=" (VoidType)
540 | | |
541 | | +---"id" p2 (PictureType)
542 | | |
543 | | +---"grey" (PictureType)
544 | | |
545 | | +---0.5 (FloatType)
546 | | |
547 | | +---"width" (IntType)
548 | | | |
549 | | | +---"id" p1 (PictureType)
550 | | |
551 | | +---"height" (IntType)
552 | | |
553 | | +---"id" p1 (PictureType)
554 | |
555 | +---":=" (VoidType)
556 | | |
557 | | +---"id" p3 (PictureType)
558 | | |
559 | | +---"black" (PictureType)
560 | | |
561 | | +---100 (IntType)
562 | | |
563 | | +---200 (IntType)
564 | |
565 | +---":=" (VoidType)
566 | | |
567 | | +---"id" p2 (PictureType)
568 | | |
569 | | +---"gamma" (PictureType)
570 | | |
571 | | +---"flipHorizontal" (PictureType)
572 | | | |
573 | | | +---"flipVertical" (PictureType)
574 | | | |
575 | | | +---"id" p2 (PictureType)
576 | | |
577 | | +---1.5 (FloatType)
578 | |
579 | +---":=" (VoidType)
580 | | |
581 | | +---"id" p2 (PictureType)
582 | | |
583 | | +---"gamma" (PictureType)
584 | | |
585 | | +---"flipHorizontal" (PictureType)
586 | | | |
587 | | | +---"flipVertical" (PictureType)
588 | | | |
589 | | | +---"id" p2 (PictureType)
590 | | |
591 | | +---1.5 (FloatType)
592 | |
593 | +---":=" (VoidType)
594 | | |
595 | | +---"id" p2 (PictureType)
596 | | |
597 | | +---"load" (PictureType)
598 | | |
599 | | +---""t.pgm"" (StringType)
600 | |
601 | +---":=" (VoidType)
602 | | |
603 | | +---"id" p1 (PictureType)
604 | | |
605 | | +---"invert" (PictureType)
606 | | |
607 | | +---"id" p2 (PictureType)
608 | |
609 | +---":=" (VoidType)
610 | | |
611 | | +---"id" p2 (PictureType)
612 | | |
613 | | +---"above" (PictureType)
614 | | |
615 | | +---"sideBySide" (PictureType)
616 | | | |
617 | | | +---"id" p1 (PictureType)
618 | | | |
619 | | | +---"id" p2 (PictureType)
620 | | |
621 | | +---"sideBySide" (PictureType)
622 | | |
623 | | +---"id" p2 (PictureType)
624 | | |
625 | | +---"id" p1 (PictureType)
626 | |
627 | +---":=" (VoidType)
628 | | |
629 | | +---"id" p2 (PictureType)
630 | | |
631 | | +---"mean" (PictureType)
632 | | |
633 | | +---"id" p1 (PictureType)
634 | | |
635 | | +---"id" p2 (PictureType)
636 | |
637 | +---":=" (VoidType)
638 | | |
639 | | +---"id" p2 (PictureType)
640 | | |
641 | | +---"diff" (PictureType)
642 | | |
643 | | +---"id" p1 (PictureType)
644 | | |
645 | | +---"id" p2 (PictureType)
646 | |
647 | +---":=" (VoidType)
648 | | |
649 | | +---"id" p1 (PictureType)
650 | | |
651 | | +---"minp" (PictureType)
652 | | |
653 | | +---"maxp" (PictureType)
654 | | | |
655 | | | +---"id" p1 (PictureType)
656 | | | |
657 | | | +---"id" p2 (PictureType)
658 | | |
659 | | +---"id" p3 (PictureType)
660 | |
661 | +---"do" (VoidType)
662 | | |
663 | | +---"store" (VoidType)
664 | | |
665 | | +---"id" p1 (PictureType)
666 | | |
667 | | +---""p1.pgm"" (StringType)
668 | |
669 | +---"do" (VoidType)
670 | | |
671 | | +---"store" (VoidType)
672 | | |
673 | | +---"id" p2 (PictureType)
674 | | |
675 | | +---""p2.pgm"" (StringType)
676 | |
677 | +---":=" (VoidType)
678 | | |
679 | | +---"id" p1 (PictureType)
680 | | |
681 | | +---UndefVal (PictureType)
682 | |
683 | +---":=" (VoidType)
684 | | |
685 | | +---"id" p2 (PictureType)
686 | | |
687 | | +---UndefVal (PictureType)
688 | |
689 | +---":=" (VoidType)
690 | |
691 | +---"id" p3 (PictureType)
692 | |
693 | +---UndefVal (PictureType)
694 |
695 +---"begin" (VoidType)
696 | |
697 | +---"sequence" (VoidType)
698 | |
699 | +---"decl" (VoidType)
700 | | |
701 | | +---"id" ls1 (ListType StringType)
702 | |
703 | +---":=" (VoidType)
704 | |
705 | +---"id" ls1 (ListType StringType)
706 | |
707 | +---UndefVal (ListType StringType)
708 |
709 +---":=" (VoidType)
710 | |
711 | +---"id" i (IntType)
712 | |
713 | +---UndefVal (IntType)
714 |
715 +---":=" (VoidType)
716 | |
717 | +---"id" j (IntType)
718 | |
719 | +---UndefVal (IntType)
720 |
721 +---":=" (VoidType)
722 |
723 +---"id" k (IntType)
724 |
725 +---UndefVal (IntType)
|
|
1-- $Id: SemanticAnalysis.hs,v 1.20 2007-01-11 21:29:59 uwe Exp $
2
3module PPL.SemanticAnalysis where
4
5import PPL.AbstractSyntax
6import PPL.BuiltinFunctions
7
8checkProg :: Program -> AttrTree
9checkProg = checkProg' globalEnv
10
11type Env = [NameSpace]
12type NameSpace = [(String, Descr)]
13
14data Descr
15 = VarDescr Type
16 | FctDescr Type FKind
17 deriving (Eq, Show)
18
19data FKind
20 = SvcFct -- not yet used
21 | UserDef [ParamDecl] FctBody
22 deriving (Eq, Show)
23
24
25checkProg' :: Env -> Program -> AttrTree
26
27checkProg' env (Program gdl st)
28 = (Opr "sequence" (st' : gdl'), VoidType)
29 where
30 env1 = newEnv env gdl
31 st' = checkStmt env1 st
32 gdl' = map (checkGlobalDecl env1) gdl
33
34checkGlobalDecl :: Env -> GlobDecl -> AttrTree
35checkGlobalDecl env (FctDecl fn parlist resType body)
36 = (Opr "fctdecl" (fn' : body' : parlist'), resType)
37 where
38 env1 = newEnv env parlist
39 fn' = (fn, VoidType)
40 body' = checkExpr env1 resType body
41 parlist' = map (checkStmt env1) parlist
42
43checkGlobalDecl env (ProcDecl fn parlist body)
44 = (Opr "fctdecl" (fn' : body' : parlist'), VoidType)
45 where
46 env1 = newEnv env parlist
47 fn' = (fn, VoidType)
48 body' = checkStmt env1 body
49 parlist' = map (checkStmt env1) parlist
50
51
52checkGlobalDecl env st
53 = checkStmt env st
54
55checkStmt :: Env -> Stmt -> AttrTree
56
57checkStmt env (Assignment vs es)
58 | length vs /= length es
59 = error ( "# of variables in left hand side "
60 ++ "of assignment does not match # of expressions"
61 )
62 | otherwise
63 = let
64 vs1 = map (typeExpr env) vs
65 ts1 = map snd vs1
66 es1 = zipWith (checkExpr env) ts1 es
67 in
68 (Opr ":=" (vs1 ++ es1), VoidType)
69
70checkStmt env (Block sl)
71 = let
72 (_env1, stmtl, undefl) = buildEnv env sl
73 in
74 (Opr "begin" [(Opr "sequence" (stmtl ++ undefl)
75 , VoidType)]
76 , VoidType)
77
78checkStmt env (Decl v@(Ident id) _)
79 = (Opr "decl" [(v,t)], VoidType)
80 where
81 VarDescr t = getVarDescr id env
82
83checkStmt env (ProcCall e)
84 = (Opr "do" [e'], VoidType)
85 where
86 e' = checkExpr env VoidType e
87
88checkStmt env (While e s)
89 = (Opr "while" [e', s'], VoidType)
90 where
91 e' = checkExpr env BoolType e
92 s' = checkStmt env s
93
94checkStmt env (Repeat s e)
95 = (Opr "repeat" [s', e'], VoidType)
96 where
97 e' = checkExpr env BoolType e
98 s' = checkStmt env s
99
100checkStmt env (If e s1 s2)
101 = (Opr "if" [e', s1', s2'], VoidType)
102 where
103 e' = checkExpr env BoolType e
104 s1' = checkStmt env s1
105 s2' = checkStmt env s2
106
107checkStmt _env _stmt
108 = error "compiler error: illegal statement"
109
110-- -------------------------------------------------------------------
111-- simple environment
112-- all block local env are stored in a list
113-- head contains local variable descriptions
114-- tail contains global variable descriptions
115
116newEnv :: Env -> [Stmt] -> Env
117newEnv env dl
118 = insDecl ([]:env) dl
119
120insDecl :: Env -> [Stmt] -> Env
121insDecl env []
122 = env
123
124insDecl env ((Decl (Ident id) t):dl)
125 = insDecl (insId env id (varDescr t)) dl
126
127insDecl env ((FctDecl (Ident fn) pl rt body):dl)
128 = insDecl (insId env fn (fctDescr pl rt body)) dl
129
130insDecl env ((ProcDecl (Ident fn) pl body):dl)
131 = insDecl (insId env fn (fctDescr pl VoidType (BlockExpr [body] UndefVal))) dl
132
133insDecl env (_:dl)
134 = insDecl env dl
135
136insId :: Env -> String -> Descr -> Env
137insId env id descr
138 | alreadyDefined id
139 = error ("identifier " ++ id ++ " defined twice")
140 | otherwise
141 = newenv
142 where
143 (locenv:globenv) = env
144 alreadyDefined id' = not . null . (lookupId id') $ [locenv]
145 newlocenv = (id, descr) : locenv
146 newenv = newlocenv : globenv
147
148varDescr :: Type -> Descr
149varDescr t = VarDescr t
150
151fctDescr :: [ParamDecl] -> ResType -> FctBody -> Descr
152fctDescr pl rt body
153 = FctDescr fctType (UserDef pl body)
154 where
155 fctType
156 = FctType rt (map paramType pl)
157 paramType (Decl _ t)
158 = t
159 paramType _
160 = error "compiler error: illegal parameter declaration"
161
162getVarDescr :: String -> Env -> Descr
163getVarDescr id env
164 | isVarDesc d = d
165 | otherwise = error ( "identifier is not a variable: "
166 ++ id )
167 where
168 d = getDescr id env
169
170isVarDesc :: Descr -> Bool
171isVarDesc (VarDescr _) = True
172isVarDesc _ = False
173
174getFctDescr :: String -> Env -> Descr
175getFctDescr id env
176 | isFctDesc d = d
177 | otherwise = error ( "identifier is not a function: "
178 ++ id )
179 where
180 d = getDescr id env
181
182isFctDesc :: Descr -> Bool
183isFctDesc (FctDescr _ _)= True
184isFctDesc _ = False
185
186getDescr :: String -> Env -> Descr
187getDescr id env
188 | null ids
189 = error ("undeclared identifier " ++ id)
190 | otherwise
191 = descr
192 where
193 ids = lookupId id env
194 (_, descr) = head ids
195
196lookupId :: String -> Env -> NameSpace
197lookupId id env
198 = filter ( \(id1,_) -> id1 == id) (concat env)
199
200isDeclared :: String -> Env -> Bool
201isDeclared id
202 = not . null .lookupId id
203
204-- -------------------------------------------------------------------
205
206checkExpr :: Env -> Type -> Expr -> AttrTree
207
208checkExpr env rt e
209 = let
210 e' = typeExpr env e
211 in
212 convertExpr' rt e'
213
214convertExpr' :: Type -> AttrTree -> AttrTree
215convertExpr' rt e@(_, t)
216 | re == illegalConversion
217 = error ("type conflict in expression, got \""
218 ++ show t
219 ++ "\", but \""
220 ++ show rt
221 ++ "\" expected")
222 | otherwise
223 = re
224 where
225 re = convertExpr rt e
226
227
228typeExpr :: Env -> Expr -> AttrTree
229
230typeExpr _ e@(UndefVal)
231 = (e, AnyType)
232
233typeExpr _ e@(IntVal _)
234 = (e, IntType)
235
236typeExpr _ e@(BoolVal _)
237 = (e, BoolType)
238
239typeExpr _ e@(FloatVal _)
240 = (e, FloatType)
241
242typeExpr _ e@(StringVal _)
243 = (e, StringType)
244
245typeExpr _ e@(EmptyList)
246 = (e, ListType AnyType)
247
248typeExpr env e@(Ident id)
249 = (e, t)
250 where
251 VarDescr t = getVarDescr id env
252
253typeExpr env (Call fn args)
254 | isDeclared fn env
255 = (Opr "definedfct" (fne : (check rt'')), rt)
256 where
257 (FctDescr (FctType rt atypes) _fctBody)
258 = getFctDescr fn env
259
260 fne = (StringVal fn, StringType)
261
262 args' = map (typeExpr env) args
263 (args'', rt'') = opTypes rt atypes args'
264
265 check UnknownType
266 = error ("type mismatch of arguments in call of "
267 ++ fn)
268 check _
269 = args''
270
271
272typeExpr env (Call fn args)
273 = (Opr fn'' args'', resType)
274 where
275 args'
276 = map (typeExpr env) args
277 (fn'', (args'', resType))
278 = lookupOp fn args'
279
280typeExpr env (BlockExpr sl re)
281 = let
282 (env1, stmtl, undefl) = buildEnv env sl
283 tre@(_e, t) = typeExpr env1 re
284 in
285 (Opr "begin" [(Opr "sequence" ( stmtl ++ [tre] ++ undefl )
286 , t)]
287 , t)
288
289typeExpr _env _expr
290 = error "compiler error: illegal expression"
291
292buildEnv :: Env -> [Stmt] -> (Env, [AttrTree], [AttrTree])
293buildEnv env sl
294 = let
295 -- take all declaration from list sl
296 dl = filter isDecl sl
297 isDecl (Decl _ _) = True
298 isDecl _ = False
299 -- compute the new local environment
300 env1 = newEnv env dl
301 -- construct the deallocation assignments
302 -- every variable is assigned with undef
303 -- on block exit
304 undefl = map (undefVar env1) dl
305 undefVar env' (Decl v@(Ident _id) _)
306 = (Opr ":=" [ typeExpr env' v
307 , (UndefVal, vt)
308 ], VoidType)
309 where
310 ve = typeExpr env' v
311 vt = snd ve
312 undefVar _env' _e
313 = error "compiler error: in undefVar"
314 in
315 (env1, (map (checkStmt env1) sl), undefl)
316
317-- -------------------------------------------------------------------
318
319lookupOp :: String -> [AttrTree] -> (String, ([AttrTree], Type))
320lookupOp fn argl
321 = evalRes (lookupOps fn argl)
322 where
323 evalRes (res:_)
324 = res
325 evalRes []
326 = error ("function undefined or illegal argument types: " ++ show fn)
327
328lookupOps :: String -> [AttrTree] -> [(String, ([AttrTree], Type))]
329
330lookupOps fn argl
331 = matchtypes
332 where
333 -- lookup fct name
334 fcts = filter (\(fn1,_) -> fn1 == fn) opTypesTable
335 -- check arguments
336 fcttypes = map (\(_, (fn', tf')) -> (fn', tf' argl)) fcts
337 -- filter type clashes
338 matchtypes = filter ((/= noTypeMatch) . snd) fcttypes
339
340
341noTypeMatch :: ([AttrTree], Type)
342noTypeMatch = ([], UnknownType)
343
344opTypes :: Type -> [Type] -> [AttrTree] -> ([AttrTree], Type)
345opTypes rt ts args
346 | length ts /= length args
347 = noTypeMatch
348 | match
349 = (args', rt)
350 | otherwise
351 = noTypeMatch
352 where
353 args' = zipWith convertExpr ts args
354 match = and . map ( \(_,t) -> t /= UnknownType) $ args'
355
356naryFct :: Int -> Type -> [AttrTree] -> ([AttrTree], Type)
357naryFct n t = opTypes t (replicate n t)
358
359naryPred :: Int -> Type -> [AttrTree] -> ([AttrTree], Type)
360naryPred n t = opTypes BoolType (replicate n t)
361
362nullaryFct :: Type -> [AttrTree] -> ([AttrTree], Type)
363unaryFct :: Type -> [AttrTree] -> ([AttrTree], Type)
364binaryFct :: Type -> [AttrTree] -> ([AttrTree], Type)
365
366nullaryFct = naryFct 0
367unaryFct = naryFct 1
368binaryFct = naryFct 2
369
370unaryPred :: Type -> [AttrTree] -> ([AttrTree], Type)
371binaryPred :: Type -> [AttrTree] -> ([AttrTree], Type)
372
373unaryPred = naryPred 1
374binaryPred = naryPred 2
375
376concTypes :: [AttrTree] -> ([AttrTree], Type)
377
378concTypes argl@[(_e1, ListType t1), (_e2, ListType t2)]
379 | t1 == t2
380 ||
381 t1 == AnyType
382 ||
383 t2 == AnyType
384 = (argl, ListType (commonType t1 t2))
385 | otherwise
386 = noTypeMatch
387
388concTypes _argl
389 = error "compiler error: in function concTypes"
390
391commonType :: Type -> Type -> Type
392
393commonType AnyType t2 = t2
394commonType t1 _ = t1
395
396consTypes :: [AttrTree] -> ([AttrTree],Type)
397
398consTypes argl@[(e1,ListType t1),a2@(_e2, t2)]
399 | t1 == t2
400 = (argl, ListType t1)
401 | t1 == AnyType
402 = ([(e1, ListType t2), a2], ListType t2)
403
404consTypes _
405 = noTypeMatch
406
407
408listType :: Type -> [AttrTree] -> ([AttrTree],Type)
409
410listType rt argl@[(_, ListType _)]
411 = (argl, rt)
412
413listType _ _
414 = noTypeMatch
415
416
417listType' :: [AttrTree] -> ([AttrTree],Type)
418
419listType' argl@[(_, lt@(ListType t))]
420 | t == AnyType
421 = error "illegal operation with empty list"
422 | otherwise
423 = (argl, lt)
424
425listType' _
426 = noTypeMatch
427
428
429headType :: [AttrTree] -> ([AttrTree],Type)
430
431headType argl
432 | res == noTypeMatch
433 = res
434 | otherwise
435 = (argl', et)
436 where
437 res = listType' argl
438 (argl', ListType et) = res
439
440
441atType :: [AttrTree] -> ([AttrTree],Type)
442atType argl@[(_, ListType t),(_, IntType)]
443 | t == AnyType
444 = error "illegal operation with empty list"
445 | otherwise
446 = (argl, t)
447
448atType _
449 = noTypeMatch
450
451ifListTypes :: [AttrTree] -> ([AttrTree],Type)
452ifListTypes argl@[ (_e0, BoolType)
453 , (_e1, ListType t1)
454 , (_e2, ListType t2)]
455 | t1 == t2
456 ||
457 t1 == AnyType
458 ||
459 t2 == AnyType
460 = (argl, ListType (commonType t1 t2))
461 | otherwise
462 = noTypeMatch
463
464ifListTypes _argl
465 = error "compiler error: in ifListTypes"
466
467-- -------------------------------------------------------------------
468
469-- implicit type conversions
470
471convertExpr :: Type -> AttrTree -> AttrTree
472
473convertExpr rt e@(_, t)
474 | rt == t = e
475
476convertExpr FloatType e@(_, IntType)
477 = (Opr "i2f" [e], FloatType)
478
479convertExpr t@(ListType _) (e, ListType AnyType)
480 = (e, t)
481
482convertExpr t (e, AnyType)
483 = (e, t)
484
485convertExpr _ (_, _)
486 = illegalConversion
487
488illegalConversion :: AttrTree
489illegalConversion = (UndefVal, UnknownType)
490
491globalEnv :: Env
492globalEnv = []
493
494-- -------------------------------------------------------------------
495
496-- build in operations and functions
497
498opTypesTable :: [(String, (String, [AttrTree] -> ([AttrTree], Type)))]
499opTypesTable =
500 [ ("+", ("addi", intIntToInt)) -- arithmetic ops
501 , ("+", ("addf", floatFloatToFloat))
502 , ("+", ("concs", strStrToStr)) -- string concatenation
503 , ("+", ("mean", picPicToPic)) -- arithm mean of colours
504
505 , ("-", ("subi", intIntToInt))
506 , ("-", ("subf", floatFloatToFloat))
507 , ("-", ("diff", picPicToPic)) -- difference of pixels
508
509 , ("-u", ("negi", intToInt))
510 , ("-u", ("negf", floatToFloat))
511 , ("-u", ("invertp", picToPic))
512
513 , ("+u", ("ident", intToInt))
514 , ("+u", ("ident", floatToFloat))
515 , ("+u", ("ident", picToPic))
516
517 , ("*", ("muli", intIntToInt))
518 , ("*", ("mulf", floatFloatToFloat))
519 , ("*", ("mulp", picPicToPic))
520
521
522 , ("/", ("divf", floatFloatToFloat))
523 , ("div", ("divi", intIntToInt))
524 , ("mod", ("modi", intIntToInt))
525
526 , ("min", ("mini", intIntToInt))
527 , ("min", ("minf", floatFloatToFloat))
528 , ("min", ("minp", picPicToPic))
529 , ("max", ("maxi", intIntToInt))
530 , ("max", ("maxf", floatFloatToFloat))
531 , ("max", ("maxp", picPicToPic))
532 -- boolean ops
533 , ("and", ("and", boolBoolToBool))
534 , ("or", ("or", boolBoolToBool))
535 , ("xor", ("xor", boolBoolToBool))
536 , ("=>", ("impl", boolBoolToBool))
537 , ("<=>", ("equiv", boolBoolToBool))
538 , ("not", ("not", boolToBool))
539
540 -- compare ops
541 , ("=", ("eqi", intIntToBool))
542 , ("=", ("eqf", floatFloatToBool))
543 , ("=", ("eqs", strStrToBool))
544 , ("/=", ("nei", intIntToBool))
545 , ("/=", ("nef", floatFloatToBool))
546 , ("/=", ("nes", strStrToBool))
547
548 , (">", ("gti", intIntToBool))
549 , (">", ("gtf", floatFloatToBool))
550 , (">=", ("gei", intIntToBool))
551 , (">=", ("gef", floatFloatToBool))
552 , ("<", ("lti", intIntToBool))
553 , ("<", ("ltf", floatFloatToBool))
554 , ("<=", ("lei", intIntToBool))
555 , ("<=", ("lef", floatFloatToBool))
556
557 -- conversion ops
558 , ("trunc", ("trunc", floatToInt))
559 , ("round", ("round", floatToInt))
560 , ("toString", ("b2s", boolToStr))
561 , ("toString", ("i2s", intToStr))
562 , ("toString", ("f2s", floatToStr))
563
564 -- list operations
565
566 -- list concatenation
567 , ("+", ("concl", concTypes))
568 , ("cons", ("consl", consTypes))
569 , ("append", ("appendl", consTypes))
570 , ("empty", ("isemptyl", listType BoolType))
571 , ("length", ("lengthl", listType IntType))
572 , ("head", ("headl", headType))
573 , ("tail", ("taill", listType'))
574 , ("[.]", ("indexl", atType))
575
576 -- conditional expression
577 , ("if", ("if", ifInt))
578 , ("if", ("if", ifFloat))
579 , ("if", ("if", ifString))
580 , ("if", ("if", ifPicture))
581 , ("if", ("if", ifListTypes))
582
583 ]
584 ++
585 buildinOps
586 where
587 -- unary
588 boolToBool = unaryFct BoolType
589 boolToStr = opTypes StringType [BoolType]
590 -- intToFloat = opTypes FloatType [IntType]
591 intToInt = unaryFct IntType
592 intToStr = opTypes StringType [IntType]
593 floatToFloat = unaryFct FloatType
594 floatToInt = opTypes IntType [FloatType]
595 floatToStr = opTypes StringType [FloatType]
596 picToPic = unaryFct PictureType
597 -- binary
598 boolBoolToBool = binaryFct BoolType
599 intIntToBool = binaryPred IntType
600 intIntToInt = binaryFct IntType
601 floatFloatToBool = binaryPred FloatType
602 floatFloatToFloat = binaryFct FloatType
603 picPicToPic = binaryFct PictureType
604 strStrToBool = binaryPred StringType
605 strStrToStr = binaryFct StringType
606 ifInt = opTypes IntType [BoolType, IntType, IntType]
607 ifFloat = opTypes FloatType [BoolType, FloatType, FloatType]
608 ifString = opTypes StringType [BoolType, StringType, StringType]
609 ifPicture = opTypes PictureType [BoolType, PictureType, PictureType]
610
611buildinOps :: [(String, (String, [AttrTree] -> ([AttrTree], Type)))]
612buildinOps
613 = map (\ (n, FctType resType argTypes)
614 -> (n, (n, opTypes resType argTypes))) buildinFcts
|
|
1-- $Id: BuiltinFunctions.hs,v 1.5 2001/03/06 21:36:39 uwe Exp $
2
3module PPL.BuiltinFunctions
4 ( buildinFcts ) where
5
6import PPL.AbstractSyntax
7
8buildinFcts :: [(String, Type)]
9buildinFcts
10 = [ ("load", picStr)
11 , ("store", voidPicStr)
12
13 , ("width", intPic)
14 , ("height", intPic)
15 , ("black", picInt2)
16 , ("white", picInt2)
17 , ("grey", picFloatInt2)
18
19 , ("gamma", picPicFloat)
20 , ("invert", picPic)
21 , ("bitmap", picPic)
22 , ("blackAndWhite", picPic)
23 , ("reduceColor", picPicInt)
24 , ("flipVertical", picPic)
25 , ("flipHorizontal", picPic)
26 , ("flipDiagonal", picPic)
27 , ("rotate", picPic)
28 , ("shift", picPicInt2)
29
30 , ("cut", picPicInt4)
31 , ("paste", picPic2Int2)
32 , ("scale", picPicInt2)
33 , ("shrink", picPicInt2)
34 , ("replicate", picPicInt2)
35 , ("resize", picPicInt2)
36 , ("sideBySide", picPic2)
37 , ("above", picPic2)
38 , ("partitionHorizontal", listPicPicInt)
39 , ("partitionVertical", listPicPicInt)
40 , ("splitHorizontal", listPicPicInt)
41 , ("splitVertical", listPicPicInt)
42 , ("mergeHorizontal", picPic2)
43 , ("mergeVertical", picPic2)
44 , ("concatHorizontal", picListPic)
45 , ("concatVertical", picListPic)
46
47 , ("mean", picPic2)
48 , ("diff", picPic2)
49 , ("inverseMean", picPic2)
50 , ("inverseDiff", picPic2)
51
52 , ("exit", voidVoid)
53 , ("dump", voidVoid)
54 , ("abort", voidStr)
55 , ("write", voidStr)
56 , ("writeln", voidStr)
57 , ("getArgs", FctType (ListType StringType) [])
58
59
60 ]
61 where
62 voidVoid = FctType VoidType []
63 voidStr = FctType VoidType [StringType]
64 voidPicStr = FctType VoidType [PictureType, StringType]
65
66 intPic = FctType IntType [PictureType]
67
68 picPic = FctType PictureType [PictureType]
69 picStr = FctType PictureType [StringType]
70 picListPic = FctType PictureType [ListType PictureType]
71
72 picInt2 = FctType PictureType [IntType, IntType]
73 picPic2 = FctType PictureType [PictureType, PictureType]
74 picPicFloat = FctType PictureType [PictureType, FloatType]
75 picPicInt = FctType PictureType [PictureType, IntType]
76 listPicPicInt = FctType (ListType PictureType) [PictureType, IntType]
77
78 picFloatInt2 = FctType PictureType [FloatType, IntType,IntType]
79 picPicInt2 = FctType PictureType [PictureType, IntType,IntType]
80 picPic2Int2 = FctType PictureType [PictureType, PictureType, IntType,IntType]
81 picPicInt4 = FctType PictureType [PictureType, IntType,IntType,IntType,IntType]
82
|
| Letzte Änderung: 14.02.2012 | © Prof. Dr. Uwe Schmidt |
