| 195 |
in (ts, typeIn ve' eb) |
in (ts, typeIn ve' eb) |
| 196 |
end |
end |
| 197 |
|
|
| 198 |
|
(* There are lvars hidden in Access.conrep, used by dcon. |
| 199 |
|
* These functions just make sure that they are defined in the |
| 200 |
|
* current environemnent; we don't bother to typecheck them properly |
| 201 |
|
* because supposedly conrep will go away... |
| 202 |
|
*) |
| 203 |
|
fun checkAccess (DA.LVAR v) = ignore (typeofVar v) |
| 204 |
|
| checkAccess (DA.PATH (a,_)) = checkAccess a |
| 205 |
|
| checkAccess _ = () |
| 206 |
|
|
| 207 |
|
fun checkConrep (DA.EXN a) = |
| 208 |
|
checkAccess a |
| 209 |
|
| checkConrep (DA.SUSP (SOME (a1,a2))) = |
| 210 |
|
(checkAccess a1; |
| 211 |
|
checkAccess a2) |
| 212 |
|
| checkConrep _ = |
| 213 |
|
() |
| 214 |
|
|
| 215 |
fun chkSnglInst (fp as (le,s)) (lt,ts) = |
fun chkSnglInst (fp as (le,s)) (lt,ts) = |
| 216 |
if null ts then lt |
if null ts then lt |
| 217 |
else case ltTyApp fp (lt,ts,kenv) |
else case ltTyApp fp (lt,ts,kenv) |
| 302 |
fun g lt = (ltMatch (le,"SWITCH branch 1") (lt,selLty); venv) |
fun g lt = (ltMatch (le,"SWITCH branch 1") (lt,selLty); venv) |
| 303 |
fun brLts (c,e) = let |
fun brLts (c,e) = let |
| 304 |
val venv' = case c |
val venv' = case c |
| 305 |
of DATAcon ((_,_,lt), ts, v) => let |
of DATAcon ((_,conrep,lt), ts, v) => let |
| 306 |
|
val _ = checkConrep conrep |
| 307 |
val fp = (le,"SWITCH DECON") |
val fp = (le,"SWITCH DECON") |
| 308 |
val ct = chkSnglInst fp (lt,ts) |
val ct = chkSnglInst fp (lt,ts) |
| 309 |
val nts = ltFnAppR fp (ct, [selLty]) |
val nts = ltFnAppR fp (ct, [selLty]) |
| 327 |
| NONE => (); |
| NONE => (); |
| 328 |
ts |
ts |
| 329 |
end |
end |
| 330 |
| CON ((_,_,lt), ts, u, lv, e) => |
| CON ((_,conrep,lt), ts, u, lv, e) => |
| 331 |
typeWithBindingToSingleRsltOfInstAndApp ("CON",lt,ts,[u],lv) e |
(checkConrep conrep; |
| 332 |
|
typeWithBindingToSingleRsltOfInstAndApp ("CON",lt,ts,[u],lv) e) |
| 333 |
| RECORD (rk,vs,lv,e) => let |
| RECORD (rk,vs,lv,e) => let |
| 334 |
val lt = case rk |
val lt = case rk |
| 335 |
of RK_VECTOR t => let |
of RK_VECTOR t => let |
| 392 |
typeWith (lv, rt) e) |
typeWith (lv, rt) e) |
| 393 |
| _ => bug "unexpected WCAST in typecheck") |
| _ => bug "unexpected WCAST in typecheck") |
| 394 |
else bug "unexpected WCAST in typecheck" |
else bug "unexpected WCAST in typecheck" |
| 395 |
| PRIMOP ((_,_,lt,ts), vs, lv, e) => |
| PRIMOP ((dc,_,lt,ts), vs, lv, e) => let |
| 396 |
|
(* There are lvars hidden inside dicts, which we didn't check |
| 397 |
|
* before. This is a first-order check that they at least |
| 398 |
|
* are bound to something; for now we don't care about their |
| 399 |
|
* types. (I'm not sure what the rules should look like) |
| 400 |
|
* --league, 10 april 1998. |
| 401 |
|
*) |
| 402 |
|
fun checkDict (SOME {default, table}) = |
| 403 |
|
(typeofVar default; |
| 404 |
|
app (ignore o typeofVar o #2) table) |
| 405 |
|
| checkDict (NONE : dict option) = () |
| 406 |
|
in |
| 407 |
|
checkDict dc; |
| 408 |
typeWithBindingToSingleRsltOfInstAndApp ("PRIMOP",lt,ts,vs,lv) e |
typeWithBindingToSingleRsltOfInstAndApp ("PRIMOP",lt,ts,vs,lv) e |
| 409 |
|
end |
| 410 |
(* |
(* |
| 411 |
| GENOP (dict, (_,lt,ts), vs, lv, e) => |
| GENOP (dict, (_,lt,ts), vs, lv, e) => |
| 412 |
(* verify dict ? *) |
(* verify dict ? *) |
Parent Directory
| 
Revision Log
| 
Patch
