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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 412 - (view) (download)
Original Path: trunk/src/compiler/IL/check-il-fn.sml

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 : jhr 412 = NL | S of string | V of IL.var | VTYS of IL.var list | TY of Ty.ty | TYS of Ty.ty list
43 : jhr 410
44 :     fun err errBuf toks = let
45 : jhr 412 fun tok2str NL = "\n ** "
46 :     | tok2str (S s) = s
47 :     | tok2str (V x) = V.toString x
48 :     | tok2str (VTYS xs) = tok2str(TYS(List.map V.ty xs))
49 :     | tok2str (TY ty) = Ty.toString ty
50 : jhr 410 | tok2str (TYS []) = "()"
51 : jhr 412 | tok2str (TYS[ty]) = Ty.toString ty
52 : jhr 410 | tok2str (TYS tys) = String.concat[
53 : jhr 412 "(", String.concatWith " * " (List.map Ty.toString tys), ")"
54 : jhr 410 ]
55 :     in
56 :     errBuf := concat ("**** Error: " :: List.map tok2str toks)
57 :     :: !errBuf
58 :     end
59 :    
60 : jhr 412 fun chkAssign errFn (bvs, y, rhs) = let
61 :     fun checkVar x = if VSet.member(bvs, x)
62 :     then ()
63 :     else errFn [
64 :     S "variable ", V x, S " is not bound in", NL,
65 :     S(IL.assignToString(y, rhs))
66 :     ]
67 :     fun tyError (ty1, ty2) = errFn [
68 :     S "type mismatch in \"", S(IL.assignToString (y, rhs)), S "\"",
69 :     NL, S "lhs: ", TY ty1, NL, S "rhs: ", TY ty2
70 :     ]
71 :     in
72 :     (* check that y is not bound twice *)
73 :     if VSet.member(bvs, y)
74 :     then errFn [
75 :     S "variable ", V y, S " is bound twice in", NL,
76 :     S(IL.assignToString (y, rhs))
77 :     ]
78 :     else ();
79 :     case rhs
80 :     of IL.VAR x => (
81 :     checkVar x;
82 :     if Ty.same(V.ty y, V.ty x)
83 : jhr 405 then ()
84 : jhr 412 else tyError (V.ty y, V.ty x))
85 :     | IL.LIT lit => let
86 :     val ty = (case lit
87 :     of Literal.Int _ => Ty.IntTy
88 :     | Literal.Float _ => Ty.realTy
89 :     | Literal.String _ => Ty.StringTy
90 :     | Literal.Bool _ => Ty.BoolTy
91 :     (* end case *))
92 :     in
93 :     if Ty.same(V.ty y, ty)
94 : jhr 410 then ()
95 : jhr 412 else tyError (V.ty y, ty)
96 :     end
97 :     | IL.OP(rator, xs) => let
98 :     val (resTy, argTys) = OpTy.sigOf rator
99 :     in
100 :     List.app checkVar xs;
101 :     if Ty.same(V.ty y, resTy)
102 :     then ()
103 :     else tyError (V.ty y, resTy);
104 :     if ListPair.allEq (fn (x, ty) => Ty.same(V.ty x, ty)) (xs, argTys)
105 :     then ()
106 :     else errFn [
107 :     S "argument type mismatch in \"", S(IL.assignToString (y, rhs)), S "\"",
108 :     NL, S "expected: ", TYS argTys,
109 :     NL, S "found: ", VTYS xs
110 :     ]
111 :     end
112 :     | IL.CONS xs => (
113 :     List.app checkVar xs;
114 :     case OpTy.typeOfCons (List.map V.ty xs)
115 :     of NONE => errFn [S "invalid ", S(IL.assignToString(y, rhs))]
116 :     | SOME ty => if Ty.same(V.ty y, ty)
117 :     then ()
118 :     else tyError (V.ty y, ty)
119 :     (* end case *))
120 :     (* end case *);
121 :     VSet.add(bvs, y)
122 :     end
123 : jhr 405
124 : jhr 410 fun checkPhi errFn (bvs, y, xs) = let
125 : jhr 405 val ty = V.ty y
126 :     in
127 :     (* check that y is not bound twice *)
128 : jhr 412 if VSet.member(bvs, y)
129 :     then errFn [
130 :     S "variable ", V y, S " is bound twice in", NL,
131 :     S(IL.phiToString (y, xs))
132 :     ]
133 : jhr 405 else ();
134 :     (* check that rhs vars have the correct type *)
135 :     if List.all (fn x => Ty.same(V.ty x, ty)) xs
136 :     then ()
137 : jhr 412 else errFn [
138 :     S "type mismatch in \"", S(IL.phiToString (y, xs)), S "\"",
139 :     NL, S "lhs: ", TY ty, NL, S "rhs: ", VTYS xs
140 :     ]
141 : jhr 405 end
142 :    
143 : jhr 369 end

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