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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 410, Fri Oct 15 19:31:53 2010 UTC revision 412, Sat Oct 16 15:19:19 2010 UTC
# Line 39  Line 39 
39      structure VSet = V.Set      structure VSet = V.Set
40    
41      datatype token      datatype token
42        = S of string | V of V.var | TY of Ty.ty | TYS of Ty.ty list        = NL | S of string | V of IL.var | VTYS of IL.var list | TY of Ty.ty | TYS of Ty.ty list
43    
44      fun err errBuf toks = let      fun err errBuf toks = let
45            fun tok2str (S s) = s            fun tok2str NL = "\n  ** "
46              | tok2str (V x) = Var.nameOf x              | tok2str (S s) = s
47              | tok2str (TY ty) = TU.toString ty              | 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              | tok2str (TYS []) = "()"              | tok2str (TYS []) = "()"
51              | tok2str (TYS[ty]) = TU.toString ty              | tok2str (TYS[ty]) = Ty.toString ty
52              | tok2str (TYS tys) = String.concat[              | tok2str (TYS tys) = String.concat[
53                    "(", String.concatWith " * " (List.map TU.toString tys), ")"                    "(", String.concatWith " * " (List.map Ty.toString tys), ")"
54                  ]                  ]
55            in            in
56              errBuf := concat ("**** Error: " :: List.map tok2str toks)              errBuf := concat ("**** Error: " :: List.map tok2str toks)
57                :: !errBuf                :: !errBuf
58            end            end
59    
60      fun checkVar errFn bvs x = if VSet.member(x, bvs)      fun chkAssign errFn (bvs, y, rhs) = let
61              fun checkVar x = if VSet.member(bvs, x)
62            then ()            then ()
63            else errFn [S "variable ", V x, " is not bound\n"]                  else errFn [
64                        S "variable ", V x, S " is not bound in", NL,
65      fun chkAssign errFn (bvs, y, rhs) = (                      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 *)            (* check that y is not bound twice *)
73              if VSet.member(y, bvs)                if VSet.member(bvs, y)
74                then errFn [S "variable ", V y, " is bound twice\n"]                  then errFn [
75                        S "variable ", V y, S " is bound twice in", NL,
76                        S(IL.assignToString (y, rhs))
77                      ]
78                else ();                else ();
79              case rhs              case rhs
80               of IL.VAR x => (               of IL.VAR x => (
81                    checkVar bvs x;                      checkVar x;
82                    if Ty.same(V.ty y, V.ty x)                    if Ty.same(V.ty y, V.ty x)
83                      then ()                      then ()
84                      else errFn [                        else tyError (V.ty y, V.ty x))
                         S "type mismatch: ", T(V.ty y), S " <> ",  
                         T (V.ty x), S "\n"  
                       ])  
85                | IL.LIT lit => let                | IL.LIT lit => let
86                    val ty = (case lit                    val ty = (case lit
87                           of IL.Int _ => Ty.IntTy                             of Literal.Int _ => Ty.IntTy
88                            | IL.Float _ => Ty.realTy                              | Literal.Float _ => Ty.realTy
89                            | IL.String _ => Ty.StringTy                              | Literal.String _ => Ty.StringTy
90                            | IL.Bool _ => Ty.BoolTy                              | Literal.Bool _ => Ty.BoolTy
91                          (* end case *))                          (* end case *))
92                    in                    in
93                      if Ty.same(V.ty y, ty)                      if Ty.same(V.ty y, ty)
94                        then ()                        then ()
95                        else errFn [                          else tyError (V.ty y, ty)
                         S "type mismatch: ", T(V.ty y), S " <> ",  
                         T ty, S "\n"  
                       ]  
96                    end                    end
97                | IL.OP(rator, xs) => let                | IL.OP(rator, xs) => let
98                    val (resTy, argTys) = OpTy.sigOf rator                    val (resTy, argTys) = OpTy.sigOf rator
99                    in                    in
100                      List.app (checkVar bvs) xs;                        List.app checkVar xs;
101                      if Ty.same(V.ty y, resTy)                      if Ty.same(V.ty y, resTy)
102                        then ()                        then ()
103                        else errFn [                          else  tyError (V.ty y, resTy);
104                          S "type mismatch: ", T(V.ty y), S " <> ",                        if ListPair.allEq (fn (x, ty) => Ty.same(V.ty x, ty)) (xs, argTys)
                         T resTy, S "\n"  
                       ];  
                     if ListPair.allEq (fn (x, ty) => Ty.same(V.ty x, ty)) (xs, argsTys)  
105                        then ()                        then ()
106                        else (* error *)                          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                    end
112                | IL.CONS xs => (                | IL.CONS xs => (
113                    List.app (checkVar bvs) xs;                      List.app checkVar xs;
114                    case OpTy.typeOfCons (List.map V.ty xs)                    case OpTy.typeOfCons (List.map V.ty xs)
115                     of NONE => (* error *)                       of NONE => errFn [S "invalid ", S(IL.assignToString(y, rhs))]
116                      | SOME ty => if Ty.same(V.ty y, ty)                      | SOME ty => if Ty.same(V.ty y, ty)
117                          then ()                          then ()
118                          else (* error *)                            else tyError (V.ty y, ty)
119                    (* end case *))                    (* end case *))
120              (* end case *);              (* end case *);
121              VSet.add(bvs, y))                VSet.add(bvs, y)
122                end
123    
124      fun checkPhi errFn (bvs, y, xs) = let      fun checkPhi errFn (bvs, y, xs) = let
125            val ty = V.ty y            val ty = V.ty y
126            in            in
127            (* check that y is not bound twice *)            (* check that y is not bound twice *)
128              if VSet.member(y, bvs)              if VSet.member(bvs, y)
129                then errFn [S "variable ", V y, " is bound twice\n"]                then errFn [
130                      S "variable ", V y, S " is bound twice in", NL,
131                      S(IL.phiToString (y, xs))
132                    ]
133                else ();                else ();
134            (* check that rhs vars have the correct type *)            (* check that rhs vars have the correct type *)
135              if List.all (fn x => Ty.same(V.ty x, ty)) xs              if List.all (fn x => Ty.same(V.ty x, ty)) xs
136                then ()                then ()
137                else (* error *)                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            end            end
142    
143    end    end

Legend:
Removed from v.410  
changed lines
  Added in v.412

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