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/branches/primop-branch/src/compiler/DebugProf/types/reconstruct.sml
ViewVC logotype

Annotation of /sml/branches/primop-branch/src/compiler/DebugProf/types/reconstruct.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1476 - (view) (download)

1 : blume 903 (* 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 CoreBasicTypes 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 : macqueen 1377 fun expType(VARexp(ref(VALvar{typ=ref ty,...}),ty')) = ty'
18 :     (* PRIMOP
19 : blume 903 (case ty
20 :     of POLYty{tyfun,...} => TU.applyTyfun(tyfun,insttys)
21 :     | _ => ty)
22 : macqueen 1377 *)
23 : blume 903 | expType(VARexp _) = bug "varexp"
24 : macqueen 1476 | expType(CONexp(DATACON{typ,...},ty')) = ty'
25 :     (* PRIMOP
26 : blume 903 (case typ
27 :     of POLYty{tyfun,...} => TU.applyTyfun(tyfun,insttys)
28 :     | _ => typ)
29 : macqueen 1476 *)
30 : blume 903 | expType(INTexp _) = intTy
31 :     | expType(WORDexp _) = wordTy
32 :     | expType(STRINGexp _) = stringTy
33 :     | expType(CHARexp _) = charTy
34 :     | expType(REALexp _) = realTy
35 :     | expType(RECORDexp fields) =
36 :     let fun extract(LABEL{name,...},exp) = (name,expType exp)
37 :     in recordTy(map extract (sortFields fields))
38 :     end
39 :     | expType(VECTORexp(nil,vty)) = CONty(vectorTycon,[vty])
40 :     | expType(VECTORexp((a::_),vty)) = CONty(vectorTycon,[vty])
41 :     | expType(PACKexp(e, t, _)) = t
42 :     | expType(SEQexp [a]) = expType a
43 :     | expType(SEQexp (_::rest)) = expType(SEQexp rest)
44 :     | expType(APPexp(rator,rand)) =
45 :     (case reduceType(expType rator)
46 :     of CONty(_,[_,t]) => t
47 :     | POLYty _ => bug "poly-rator"
48 :     | WILDCARDty => bug "wildcard-rator"
49 :     | UNDEFty => bug "undef-rator"
50 :     | IBOUND _ => bug "ibound-rator"
51 :     | VARty _ => bug "varty-rator"
52 :     | _ => bug "rator")
53 :     | expType(CONSTRAINTexp(e,ty)) = expType e
54 :     | expType(HANDLEexp(e,h)) = expType e
55 :     | expType(RAISEexp(e,t)) = t
56 :     | expType(LETexp(_,e)) = expType e
57 :     | expType(CASEexp(_,RULE(_,e)::_,_)) = expType e
58 :     | expType(FNexp(RULE(_,e)::_, ty)) = ty --> expType e
59 :     | expType(MARKexp(e,_)) = expType e
60 :     | expType _ = bug "expType"
61 :    
62 :     end (* structure Reconstruct *)
63 :    
64 :    

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