Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/Semant/types/reconstruct.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/Semant/types/reconstruct.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 89 - (view) (download)

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

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