Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Annotation of /trunk/src/compiler/IL/check-il-fn.sml
ViewVC logotype

Annotation of /trunk/src/compiler/IL/check-il-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 410 - (view) (download)

1 : jhr 369 (* check-il-fn.sml
2 :     *
3 :     * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
4 :     * All rights reserved.
5 :     *
6 :     * Correctness checker for SSA-based ILs.
7 :     *)
8 :    
9 : jhr 405 signature OPERATOR_TY =
10 :     sig
11 :     type rator
12 :     type ty
13 : jhr 369
14 : jhr 410 (* returns the signature of an operator as (rng, dom). *)
15 : jhr 405 val sigOf : rator -> ty * ty list
16 :    
17 : jhr 410 (* return the type of a CONS, where the argument types
18 :     * are given. Returns NONE if the argument types are
19 :     * invalid for the IL.
20 :     *)
21 :     val typeOfCons : ty list -> ty option
22 :    
23 : jhr 405 end
24 :    
25 :     functor CheckILFn (
26 :    
27 :     structure IL : SSA
28 :     structure OpTy : OPERATOR_TY
29 :     where type rator = IL.Op.rator
30 :     where type ty = IL.Ty.ty
31 :    
32 :     ) : sig
33 :    
34 : jhr 369 end = struct
35 :    
36 : jhr 405 structure IL = IL
37 :     structure Ty = IL.Ty
38 :     structure V = IL.Var
39 :     structure VSet = V.Set
40 :    
41 : jhr 410 datatype token
42 :     = S of string | V of V.var | TY of Ty.ty | TYS of Ty.ty list
43 :    
44 :     fun err errBuf toks = let
45 :     fun tok2str (S s) = s
46 :     | tok2str (V x) = Var.nameOf x
47 :     | tok2str (TY ty) = TU.toString ty
48 :     | tok2str (TYS []) = "()"
49 :     | tok2str (TYS[ty]) = TU.toString ty
50 :     | tok2str (TYS tys) = String.concat[
51 :     "(", String.concatWith " * " (List.map TU.toString tys), ")"
52 :     ]
53 :     in
54 :     errBuf := concat ("**** Error: " :: List.map tok2str toks)
55 :     :: !errBuf
56 :     end
57 :    
58 :     fun checkVar errFn bvs x = if VSet.member(x, bvs)
59 : jhr 405 then ()
60 : jhr 410 else errFn [S "variable ", V x, " is not bound\n"]
61 : jhr 405
62 : jhr 410 fun chkAssign errFn (bvs, y, rhs) = (
63 : jhr 405 (* check that y is not bound twice *)
64 :     if VSet.member(y, bvs)
65 : jhr 410 then errFn [S "variable ", V y, " is bound twice\n"]
66 : jhr 405 else ();
67 :     case rhs
68 :     of IL.VAR x => (
69 :     checkVar bvs x;
70 :     if Ty.same(V.ty y, V.ty x)
71 :     then ()
72 : jhr 410 else errFn [
73 :     S "type mismatch: ", T(V.ty y), S " <> ",
74 :     T (V.ty x), S "\n"
75 :     ])
76 : jhr 405 | IL.LIT lit => let
77 :     val ty = (case lit
78 :     of IL.Int _ => Ty.IntTy
79 :     | IL.Float _ => Ty.realTy
80 :     | IL.String _ => Ty.StringTy
81 :     | IL.Bool _ => Ty.BoolTy
82 :     (* end case *))
83 :     in
84 :     if Ty.same(V.ty y, ty)
85 :     then ()
86 : jhr 410 else errFn [
87 :     S "type mismatch: ", T(V.ty y), S " <> ",
88 :     T ty, S "\n"
89 :     ]
90 : jhr 405 end
91 :     | IL.OP(rator, xs) => let
92 :     val (resTy, argTys) = OpTy.sigOf rator
93 :     in
94 :     List.app (checkVar bvs) xs;
95 :     if Ty.same(V.ty y, resTy)
96 :     then ()
97 : jhr 410 else errFn [
98 :     S "type mismatch: ", T(V.ty y), S " <> ",
99 :     T resTy, S "\n"
100 :     ];
101 : jhr 405 if ListPair.allEq (fn (x, ty) => Ty.same(V.ty x, ty)) (xs, argsTys)
102 :     then ()
103 :     else (* error *)
104 :     end
105 :     | IL.CONS xs => (
106 :     List.app (checkVar bvs) xs;
107 : jhr 410 case OpTy.typeOfCons (List.map V.ty xs)
108 :     of NONE => (* error *)
109 :     | SOME ty => if Ty.same(V.ty y, ty)
110 :     then ()
111 :     else (* error *)
112 :     (* end case *))
113 : jhr 405 (* end case *);
114 :     VSet.add(bvs, y))
115 :    
116 : jhr 410 fun checkPhi errFn (bvs, y, xs) = let
117 : jhr 405 val ty = V.ty y
118 :     in
119 :     (* check that y is not bound twice *)
120 :     if VSet.member(y, bvs)
121 : jhr 410 then errFn [S "variable ", V y, " is bound twice\n"]
122 : jhr 405 else ();
123 :     (* check that rhs vars have the correct type *)
124 :     if List.all (fn x => Ty.same(V.ty x, ty)) xs
125 :     then ()
126 :     else (* error *)
127 :     end
128 :    
129 : jhr 369 end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0