Mercurial > urweb

comparison src/cjrize.sml @ 182:d11754ffe252

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Compiled pattern matching to C
author Adam Chlipala <adamc@hcoop.net>
date Sun, 03 Aug 2008 12:43:20 -0400
parents 31dfab1d4050
children 19ee24bffbc0
comparison
equal deleted inserted replaced
181:31dfab1d4050 182:d11754ffe252
106 fun cifyPatCon pc = 106 fun cifyPatCon pc =
107 case pc of 107 case pc of
108 L.PConVar n => L'.PConVar n 108 L.PConVar n => L'.PConVar n
109 | L.PConFfi mx => L'.PConFfi mx 109 | L.PConFfi mx => L'.PConFfi mx
110 110
111 fun cifyPat (p, loc) = 111 fun cifyPat ((p, loc), sm) =
112 case p of 112 case p of
113 L.PWild => (L'.PWild, loc) 113 L.PWild => ((L'.PWild, loc), sm)
114 | L.PVar x => (L'.PVar x, loc) 114 | L.PVar (x, t) =>
115 | L.PPrim p => (L'.PPrim p, loc) 115 let
116 | L.PCon (pc, po) => (L'.PCon (cifyPatCon pc, Option.map cifyPat po), loc) 116 val (t, sm) = cifyTyp (t, sm)
117 | L.PRecord xps => (L'.PRecord (map (fn (x, p) => (x, cifyPat p)) xps), loc) 117 in
118 ((L'.PVar (x, t), loc), sm)
119 end
120 | L.PPrim p => ((L'.PPrim p, loc), sm)
121 | L.PCon (pc, NONE) => ((L'.PCon (cifyPatCon pc, NONE), loc), sm)
122 | L.PCon (pc, SOME p) =>
123 let
124 val (p, sm) = cifyPat (p, sm)
125 in
126 ((L'.PCon (cifyPatCon pc, SOME p), loc), sm)
127 end
128 | L.PRecord xps =>
129 let
130 val (xps, sm) = ListUtil.foldlMap (fn ((x, p, t), sm) =>
131 let
132 val (p, sm) = cifyPat (p, sm)
133 val (t, sm) = cifyTyp (t, sm)
134 in
135 ((x, p, t), sm)
136 end) sm xps
137 in
138 ((L'.PRecord xps, loc), sm)
139 end
118 140
119 fun cifyExp ((e, loc), sm) = 141 fun cifyExp ((e, loc), sm) =
120 case e of 142 case e of
121 L.EPrim p => ((L'.EPrim p, loc), sm) 143 L.EPrim p => ((L'.EPrim p, loc), sm)
122 | L.ERel n => ((L'.ERel n, loc), sm) 144 | L.ERel n => ((L'.ERel n, loc), sm)
177 val (e, sm) = cifyExp (e, sm) 199 val (e, sm) = cifyExp (e, sm)
178 in 200 in
179 ((L'.EField (e, x), loc), sm) 201 ((L'.EField (e, x), loc), sm)
180 end 202 end
181 203
182 | L.ECase (e, pes, t) => 204 | L.ECase (e, pes, {disc, result}) =>
183 let 205 let
184 val (e, sm) = cifyExp (e, sm) 206 val (e, sm) = cifyExp (e, sm)
185 val (pes, sm) = ListUtil.foldlMap 207 val (pes, sm) = ListUtil.foldlMap
186 (fn ((p, e), sm) => 208 (fn ((p, e), sm) =>
187 let 209 let
188 val (e, sm) = cifyExp (e, sm) 210 val (e, sm) = cifyExp (e, sm)
211 val (p, sm) = cifyPat (p, sm)
189 in 212 in
190 ((cifyPat p, e), sm) 213 ((p, e), sm)
191 end) sm pes 214 end) sm pes
192 val (t, sm) = cifyTyp (t, sm) 215 val (disc, sm) = cifyTyp (disc, sm)
216 val (result, sm) = cifyTyp (result, sm)
193 in 217 in
194 ((L'.ECase (e, pes, t), loc), sm) 218 ((L'.ECase (e, pes, {disc = disc, result = result}), loc), sm)
195 end 219 end
196 220
197 | L.EStrcat (e1, e2) => 221 | L.EStrcat (e1, e2) =>
198 let 222 let
199 val (e1, sm) = cifyExp (e1, sm) 223 val (e1, sm) = cifyExp (e1, sm)