Mercurial > urweb

comparison src/mono_reduce.sml @ 258:40c33706d887

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Avoid unnecessary WHERE clause
author Adam Chlipala <adamc@hcoop.net>
date Sun, 31 Aug 2008 15:32:31 -0400
parents 7f6620853c36
children bacd0ba869e1
comparison
equal deleted inserted replaced
257:32f9212583b2 258:40c33706d887
88 r 88 r
89 end 89 end
90 90
91 fun typ c = c 91 fun typ c = c
92 92
93 datatype result = Yes of E.env | No | Maybe
94
93 fun match (env, p : pat, e : exp) = 95 fun match (env, p : pat, e : exp) =
94 case (#1 p, #1 e) of 96 case (#1 p, #1 e) of
95 (PWild, _) => SOME env 97 (PWild, _) => Yes env
96 | (PVar (x, t), _) => SOME (E.pushERel env x t (SOME e)) 98 | (PVar (x, t), _) => Yes (E.pushERel env x t (SOME e))
97 99
98 | (PPrim p, EPrim p') => 100 | (PPrim p, EPrim p') =>
99 if Prim.equal (p, p') then 101 if Prim.equal (p, p') then
100 SOME env 102 Yes env
101 else 103 else
102 NONE 104 No
103 105
104 | (PCon (_, PConVar n1, NONE), ECon (_, PConVar n2, NONE)) => 106 | (PCon (_, PConVar n1, NONE), ECon (_, PConVar n2, NONE)) =>
105 if n1 = n2 then 107 if n1 = n2 then
106 SOME env 108 Yes env
107 else 109 else
108 NONE 110 No
109 111
110 | (PCon (_, PConVar n1, SOME p), ECon (_, PConVar n2, SOME e)) => 112 | (PCon (_, PConVar n1, SOME p), ECon (_, PConVar n2, SOME e)) =>
111 if n1 = n2 then 113 if n1 = n2 then
112 match (env, p, e) 114 match (env, p, e)
113 else 115 else
114 NONE 116 No
115 117
116 | (PCon (_, PConFfi {mod = m1, con = con1, ...}, NONE), ECon (_, PConFfi {mod = m2, con = con2, ...}, NONE)) => 118 | (PCon (_, PConFfi {mod = m1, con = con1, ...}, NONE), ECon (_, PConFfi {mod = m2, con = con2, ...}, NONE)) =>
117 if m1 = m2 andalso con1 = con2 then 119 if m1 = m2 andalso con1 = con2 then
118 SOME env 120 Yes env
119 else 121 else
120 NONE 122 No
121 123
122 | (PCon (_, PConFfi {mod = m1, con = con1, ...}, SOME ep), ECon (_, PConFfi {mod = m2, con = con2, ...}, SOME e)) => 124 | (PCon (_, PConFfi {mod = m1, con = con1, ...}, SOME ep), ECon (_, PConFfi {mod = m2, con = con2, ...}, SOME e)) =>
123 if m1 = m2 andalso con1 = con2 then 125 if m1 = m2 andalso con1 = con2 then
124 match (env, p, e) 126 match (env, p, e)
125 else 127 else
126 NONE 128 No
127 129
128 | (PRecord xps, ERecord xes) => 130 | (PRecord xps, ERecord xes) =>
129 let 131 let
130 fun consider (xps, env) = 132 fun consider (xps, env) =
131 case xps of 133 case xps of
132 [] => SOME env 134 [] => Yes env
133 | (x, p, _) :: rest => 135 | (x, p, _) :: rest =>
134 case List.find (fn (x', _, _) => x' = x) xes of 136 case List.find (fn (x', _, _) => x' = x) xes of
135 NONE => NONE 137 NONE => No
136 | SOME (_, e, _) => 138 | SOME (_, e, _) =>
137 case match (env, p, e) of 139 case match (env, p, e) of
138 NONE => NONE 140 No => No
139 | SOME env => consider (rest, env) 141 | Maybe => Maybe
142 | Yes env => consider (rest, env)
140 in 143 in
141 consider (xps, env) 144 consider (xps, env)
142 end 145 end
143 146
144 | _ => NONE 147 | _ => Maybe
145 148
146 fun exp env e = 149 fun exp env e =
147 case e of 150 case e of
148 ERel n => 151 ERel n =>
149 (case E.lookupERel env n of 152 (case E.lookupERel env n of
161 #1 (reduceExp env (ELet (x, t, e2, e1), loc)) 164 #1 (reduceExp env (ELet (x, t, e2, e1), loc))
162 else 165 else
163 #1 (reduceExp env (subExpInExp (0, e2) e1))) 166 #1 (reduceExp env (subExpInExp (0, e2) e1)))
164 167
165 | ECase (disc, pes, _) => 168 | ECase (disc, pes, _) =>
166 (case ListUtil.search (fn (p, body) => 169 let
167 case match (env, p, disc) of 170 fun search pes =
168 NONE => NONE 171 case pes of
169 | SOME env => SOME (#1 (reduceExp env body))) pes of 172 [] => e
170 NONE => e 173 | (p, body) :: pes =>
171 | SOME e' => e') 174 case match (env, p, disc) of
175 No => search pes
176 | Maybe => e
177 | Yes env => #1 (reduceExp env body)
178 in
179 search pes
180 end
172 181
173 | EField ((ERecord xes, _), x) => 182 | EField ((ERecord xes, _), x) =>
174 (case List.find (fn (x', _, _) => x' = x) xes of 183 (case List.find (fn (x', _, _) => x' = x) xes of
175 SOME (_, e, _) => #1 e 184 SOME (_, e, _) => #1 e
176 | NONE => e) 185 | NONE => e)