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 /MLRISC/trunk/mltree/mltree-check-ty.sml
ViewVC logotype

Annotation of /MLRISC/trunk/mltree/mltree-check-ty.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3038 - (view) (download)

1 : mrainey 3038 (* mltree-check-ty.sml
2 :     *
3 :     * Check that MLRISC programs have consistent types.
4 :     *)
5 :    
6 :     functor MLTreeCheckTy
7 :     (structure T : MLTREE
8 :     val intTy : T.ty (* size of integer word *)) : sig
9 :     val check : T.stm -> bool
10 :     end = struct
11 :    
12 :     exception AmbiguousType
13 :    
14 :     exception TypeError
15 :    
16 :     fun chkEq (ty, tys) = List.all (fn SOME ty' => ty' = ty | NONE => true) tys
17 :    
18 :     fun chkTys (ty, tys) = if chkEq (ty, tys)
19 :     then ty
20 :     else raise TypeError
21 :    
22 :     (* check well-formedness of a list of expressions *)
23 :     fun checkRexps (ty, es) = let
24 :     val tys = List.map (fn e => SOME (checkRexp e) handle AmbiguousType => NONE) es
25 :     in
26 :     chkTys(ty, tys)
27 :     end
28 :    
29 :     and checkRexp (T.REG(ty,_)) = ty
30 :     (* the type of a literal expression depends on its surrounding context *)
31 :     | checkRexp (T.LI _) = raise AmbiguousType
32 :     | checkRexp (T.LABEL _) = intTy
33 :     (* the type of a literal expression depends on its surrounding context *)
34 :     | checkRexp (T.CONST _) = raise AmbiguousType
35 :     | checkRexp (T.LABEXP e) = checkRexp e
36 :     | checkRexp (T.NEG(ty, e)) = checkRexps(ty, [e])
37 :     | checkRexp (T.ADD(ty,e1,e2)) = checkRexps(ty, [e1, e2])
38 :     | checkRexp (T.SUB(ty,e1,e2)) = checkRexps(ty, [e1, e2])
39 :     | checkRexp (T.MULS(ty,e1,e2)) = checkRexps(ty, [e1, e2])
40 :     | checkRexp (T.DIVS(_,ty,e1,e2)) = checkRexps(ty, [e1, e2])
41 :     | checkRexp (T.REMS(_,ty,e1,e2)) = checkRexps(ty, [e1, e2])
42 :     | checkRexp (T.MULU(ty,e1,e2)) = checkRexps(ty, [e1, e2])
43 :     | checkRexp (T.DIVU(ty,e1,e2)) = checkRexps(ty, [e1, e2])
44 :     | checkRexp (T.REMU(ty,e1,e2)) = checkRexps(ty, [e1, e2])
45 :     | checkRexp (T.NEGT(ty,e)) = checkRexps(ty, [e])
46 :     | checkRexp (T.ADDT(ty,e1,e2)) = checkRexps(ty, [e1, e2])
47 :     | checkRexp (T.SUBT(ty,e1,e2)) = checkRexps(ty, [e1, e2])
48 :     | checkRexp (T.MULT(ty,e1,e2)) = checkRexps(ty, [e1, e2])
49 :     | checkRexp (T.DIVT(_,ty,e1,e2)) = checkRexps(ty, [e1, e2])
50 :     | checkRexp (T.ANDB(ty,e1,e2)) = checkRexps(ty, [e1, e2])
51 :     | checkRexp (T.ORB(ty,e1,e2)) = checkRexps(ty, [e1, e2])
52 :     | checkRexp (T.XORB(ty,e1,e2)) = checkRexps(ty, [e1, e2])
53 :     | checkRexp (T.EQVB(ty,e1,e2)) = checkRexps(ty, [e1, e2])
54 :     | checkRexp (T.NOTB(ty,e)) = checkRexps(ty, [e])
55 :     | checkRexp (T.SRA(ty,e1,e2)) = checkRexps(ty, [e1, e2])
56 :     | checkRexp (T.SRL(ty,e1,e2)) = checkRexps(ty, [e1, e2])
57 :     | checkRexp (T.SLL(ty,e1,e2)) = checkRexps(ty, [e1, e2])
58 :     | checkRexp (T.SX(toTy,fromTy,e)) = (checkRexps(fromTy, [e]); toTy)
59 :     | checkRexp (T.ZX(toTy,fromTy,e)) = (checkRexps(fromTy, [e]); toTy)
60 :     | checkRexp (T.CVTF2I(ty,_,_,_)) = ty
61 :     | checkRexp (T.COND(ty,_,_,_)) = ty
62 :     | checkRexp (T.LOAD(ty,_,_)) = ty
63 :     | checkRexp (T.PRED(e,_)) = checkRexp e
64 :     | checkRexp (T.LET(_,e)) = checkRexp e
65 :     | checkRexp (T.REXT(ty,_)) = ty
66 :     | checkRexp (T.MARK(e,_)) = checkRexp e
67 :     | checkRexp (T.OP(ty,_,_)) = ty
68 :     | checkRexp (T.ARG(ty,_,_)) = ty
69 :     | checkRexp (T.$(ty,_,_)) = ty
70 :     | checkRexp (T.PARAM _) = intTy
71 :     | checkRexp (T.BITSLICE(ty,_,_)) = ty
72 :     | checkRexp (T.???) = intTy
73 :    
74 :     fun checkFexp (T.FREG(ty,_)) = ty
75 :     | checkFexp (T.FLOAD(ty,_,_)) = ty
76 :     | checkFexp (T.FADD(ty,_,_)) = ty
77 :     | checkFexp (T.FSUB(ty,_,_)) = ty
78 :     | checkFexp (T.FMUL(ty,_,_)) = ty
79 :     | checkFexp (T.FDIV(ty,_,_)) = ty
80 :     | checkFexp (T.FABS(ty,_)) = ty
81 :     | checkFexp (T.FNEG(ty,_)) = ty
82 :     | checkFexp (T.FSQRT(ty,_)) = ty
83 :     | checkFexp (T.FCOND(ty,_,_,_)) = ty
84 :     | checkFexp (T.CVTI2F(ty,_,_)) = ty
85 :     | checkFexp (T.CVTF2F(ty,_,_)) = ty
86 :     | checkFexp (T.FCOPYSIGN(ty,_,_)) = ty
87 :     | checkFexp (T.FPRED(e,_)) = checkFexp e
88 :     | checkFexp (T.FEXT(ty,_)) = ty
89 :     | checkFexp (T.FMARK(e,_)) = checkFexp e
90 :    
91 :     (* don't care about ambiguous types *)
92 :     fun checkRexpB (ty, e) = checkRexp e = ty handle AmbiguousType => true
93 :    
94 :     fun checkCCexp cce = (case cce
95 :     of T.NOT cce => checkCCexp cce
96 :     | ( T.AND (cce1, cce2) | T.OR (cce1, cce2) | T.XOR (cce1, cce2) | T.EQV (cce1, cce2) ) =>
97 :     checkCCexp cce1 andalso checkCCexp cce2
98 :     | T.CMP (ty, _, e1, e2) => ty = checkRexp e1 andalso ty = checkRexp e2
99 :     | T.FCMP (fty, _, e1, e2) => fty = checkFexp e1 andalso fty = checkFexp e2
100 :     | T.CCMARK (cce, _) => checkCCexp cce
101 :     | T.CCEXT (ty, ccext) => true
102 :     (* end case *))
103 :    
104 :     fun check stm = (case stm
105 :     of T.MV (ty, d, e) => checkRexpB (ty, e)
106 :     | T.CCMV (dst, cce) => checkCCexp cce
107 :     | T.FMV (fty, dst, e) => checkFexp e = fty
108 :     | T.COPY _ => true
109 :     | T.FCOPY _ => true
110 :     | T.JMP (e, _) => checkRexpB (intTy, e)
111 :     | T.BCC (cce, _) => checkCCexp cce
112 :     | T.CALL {funct, ...} => checkRexpB (intTy, funct)
113 :     | T.FLOW_TO (stm, _) => check stm
114 :     | T.RET _ => true
115 :     | T.IF (cce, stm1, stm2) => checkCCexp cce andalso check stm1 andalso check stm2
116 :     | T.STORE (ty, e1, e2, _) => checkRexpB (intTy, e1) andalso checkRexpB(intTy, e2)
117 :     | T.FSTORE (fty, e1, e2, _) => checkRexpB (intTy, e1) andalso fty = checkFexp e2
118 :     | T.REGION (stm, _) => check stm
119 :     | T.SEQ stms => List.all check stms
120 :     | T.DEFINE _ => true
121 :     | T.ANNOTATION (stm, _) => check stm
122 :     | T.EXT _ => true
123 :     | T.LIVE _ => true
124 :     | T.KILL _ => true
125 :     | _ => true
126 :     (* end case *))
127 :     handle TypeError => false
128 :    
129 :     end (* MLTreeCheckTy *)

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