Mercurial > urweb
comparison src/cjrize.sml @ 181:31dfab1d4050
Cjrize ECon
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 03 Aug 2008 11:17:33 -0400 |
parents | c7a5c8e0a0e0 |
children | d11754ffe252 |
comparison
equal
deleted
inserted
replaced
180:c7a5c8e0a0e0 | 181:31dfab1d4050 |
---|---|
101 end | 101 end |
102 | L.TFfi mx => ((L'.TFfi mx, loc), sm) | 102 | L.TFfi mx => ((L'.TFfi mx, loc), sm) |
103 | 103 |
104 val dummye = (L'.EPrim (Prim.Int 0), ErrorMsg.dummySpan) | 104 val dummye = (L'.EPrim (Prim.Int 0), ErrorMsg.dummySpan) |
105 | 105 |
106 fun cifyPatCon pc = | |
107 case pc of | |
108 L.PConVar n => L'.PConVar n | |
109 | L.PConFfi mx => L'.PConFfi mx | |
110 | |
111 fun cifyPat (p, loc) = | |
112 case p of | |
113 L.PWild => (L'.PWild, loc) | |
114 | L.PVar x => (L'.PVar x, loc) | |
115 | L.PPrim p => (L'.PPrim p, loc) | |
116 | L.PCon (pc, po) => (L'.PCon (cifyPatCon pc, Option.map cifyPat po), loc) | |
117 | L.PRecord xps => (L'.PRecord (map (fn (x, p) => (x, cifyPat p)) xps), loc) | |
118 | |
106 fun cifyExp ((e, loc), sm) = | 119 fun cifyExp ((e, loc), sm) = |
107 case e of | 120 case e of |
108 L.EPrim p => ((L'.EPrim p, loc), sm) | 121 L.EPrim p => ((L'.EPrim p, loc), sm) |
109 | L.ERel n => ((L'.ERel n, loc), sm) | 122 | L.ERel n => ((L'.ERel n, loc), sm) |
110 | L.ENamed n => ((L'.ENamed n, loc), sm) | 123 | L.ENamed n => ((L'.ENamed n, loc), sm) |
111 | L.ECon _ => raise Fail "Cjrize ECon" | 124 | L.ECon (n, eo) => |
125 let | |
126 val (eo, sm) = | |
127 case eo of | |
128 NONE => (NONE, sm) | |
129 | SOME e => | |
130 let | |
131 val (e, sm) = cifyExp (e, sm) | |
132 in | |
133 (SOME e, sm) | |
134 end | |
135 in | |
136 ((L'.ECon (n, eo), loc), sm) | |
137 end | |
112 | L.EFfi mx => ((L'.EFfi mx, loc), sm) | 138 | L.EFfi mx => ((L'.EFfi mx, loc), sm) |
113 | L.EFfiApp (m, x, es) => | 139 | L.EFfiApp (m, x, es) => |
114 let | 140 let |
115 val (es, sm) = ListUtil.foldlMap cifyExp sm es | 141 val (es, sm) = ListUtil.foldlMap cifyExp sm es |
116 in | 142 in |
151 val (e, sm) = cifyExp (e, sm) | 177 val (e, sm) = cifyExp (e, sm) |
152 in | 178 in |
153 ((L'.EField (e, x), loc), sm) | 179 ((L'.EField (e, x), loc), sm) |
154 end | 180 end |
155 | 181 |
156 | L.ECase _ => raise Fail "Cjrize ECase" | 182 | L.ECase (e, pes, t) => |
183 let | |
184 val (e, sm) = cifyExp (e, sm) | |
185 val (pes, sm) = ListUtil.foldlMap | |
186 (fn ((p, e), sm) => | |
187 let | |
188 val (e, sm) = cifyExp (e, sm) | |
189 in | |
190 ((cifyPat p, e), sm) | |
191 end) sm pes | |
192 val (t, sm) = cifyTyp (t, sm) | |
193 in | |
194 ((L'.ECase (e, pes, t), loc), sm) | |
195 end | |
157 | 196 |
158 | L.EStrcat (e1, e2) => | 197 | L.EStrcat (e1, e2) => |
159 let | 198 let |
160 val (e1, sm) = cifyExp (e1, sm) | 199 val (e1, sm) = cifyExp (e1, sm) |
161 val (e2, sm) = cifyExp (e2, sm) | 200 val (e2, sm) = cifyExp (e2, sm) |