1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
(* COPYRIGHT (c) 1996 AT&T Bell Laboratories *)
(* reconstruct.sml *)
structure Reconstruct : sig val expType : Absyn.exp -> Types.ty end =
struct
structure TU = TypesUtil
open Absyn (* ElabUtil *) VarCon Types CoreBasicTypes TypesUtil
fun bug msg = ErrorMsg.impossible("Reconstruct: "^msg)
infix -->
fun reduceType(POLYty{tyfun=TYFUN{body,arity},...}) = headReduceType body
| reduceType ty = headReduceType ty
(* expType : Absyn.exp -> Types.ty
assertion: returned ty is a monotype (i.e. not POLYty)
*)
fun expType(VARexp(ref(VALvar{typ=ref ty,...}),insttvs)) =
(case ty
of POLYty{tyfun,...} => TU.applyTyfun(tyfun,map VARty insttvs)
| _ => ty)
| expType(VARexp _) = bug "varexp"
| expType(CONexp(DATACON{typ,...},insttvs)) =
(case typ
of POLYty{tyfun,...} => TU.applyTyfun(tyfun,map VARty insttvs)
| _ => typ)
| expType(INTexp (_, t)) = t
| expType(WORDexp (_, t)) = t
| expType(REALexp _) = realTy
| expType(STRINGexp _) = stringTy
| expType(CHARexp _) = charTy
| expType(RECORDexp fields) =
let fun extract(LABEL{name,...},exp) = (name,expType exp)
in recordTy(map extract (sortFields fields))
end
| expType(SELECTexp (LABEL{name,...},e)) =
(case TU.projectField (name, reduceType(expType e))
of SOME ty => ty
| NONE => bug "expType: SELECTexp")
| expType(VECTORexp(nil,vty)) = CONty(vectorTycon,[vty])
| expType(VECTORexp((a::_),vty)) = CONty(vectorTycon,[vty])
| expType(PACKexp(e, t, _)) = t
| expType(APPexp(rator,rand)) =
(case reduceType(expType rator)
of CONty(_,[_,t]) => t
| POLYty _ => bug "poly-rator"
| WILDCARDty => bug "wildcard-rator"
| UNDEFty => bug "undef-rator"
| IBOUND _ => bug "ibound-rator"
| VARty _ => bug "varty-rator"
| _ => bug "rator")
| expType(HANDLEexp(e,h)) = expType e
| expType(RAISEexp(e,t)) = t
| expType(CASEexp(_,RULE(_,e)::_,_)) = expType e
| expType(CASEexp(_,nil,_)) = bug "expType(CASEexp(_,nil,_))"
| expType(IFexp {thenCase,...}) = expType thenCase
| expType(ANDALSOexp _) = boolTy
| expType(ORELSEexp _) = boolTy
| expType(WHILEexp _) = unitTy
| expType(FNexp(RULE(_,e)::_, ty)) = ty --> expType e
| expType(FNexp(nil, ty)) = bug "expType(FNexp(nil,ty))"
| expType(LETexp(_,e)) = expType e
| expType(SEQexp [a]) = expType a
| expType(SEQexp (_::rest)) = expType(SEQexp rest)
| expType(SEQexp nil) = bug "expType(SEQexp nil)"
| expType(CONSTRAINTexp(e,ty)) = expType e
| expType(MARKexp(e,_)) = expType e
end (* structure Reconstruct *)
|
