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