Mercurial > urweb
comparison src/cjrize.sml @ 182:d11754ffe252
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) |