| 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 |
Parent Directory
| 
Revision Log
| 
Patch
