Mercurial > urweb

comparison src/jscomp.sml @ 593:f277f5faebcd

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Injected a record
author Adam Chlipala <adamc@hcoop.net>
date Fri, 02 Jan 2009 12:42:39 -0500
parents a8be5a2068a5
children 55829473f6a7
comparison
equal deleted inserted replaced
592:a8be5a2068a5 593:f277f5faebcd
154 | (_, nameds) => nameds) 154 | (_, nameds) => nameds)
155 IM.empty file 155 IM.empty file
156 156
157 fun str loc s = (EPrim (Prim.String s), loc) 157 fun str loc s = (EPrim (Prim.String s), loc)
158 158
159 fun quoteExp loc (t : typ) e = 159 fun quoteExp loc (t : typ) (e, st) =
160 case #1 t of 160 case #1 t of
161 TSource => strcat loc [str loc "s", 161 TSource => (strcat loc [str loc "s",
162 (EFfiApp ("Basis", "htmlifyInt", [e]), loc)] 162 (EFfiApp ("Basis", "htmlifyInt", [e]), loc)], st)
163 | TRecord [] => str loc "null" 163
164 164 | TRecord [] => (str loc "null", st)
165 | TFfi ("Basis", "string") => (EFfiApp ("Basis", "jsifyString", [e]), loc) 165 | TRecord [(x, t)] =>
166 | TFfi ("Basis", "int") => (EFfiApp ("Basis", "htmlifyInt", [e]), loc) 166 let
167 | TFfi ("Basis", "float") => (EFfiApp ("Basis", "htmlifyFloat", [e]), loc) 167 val (e, st) = quoteExp loc t ((EField (e, x), loc), st)
168 168 in
169 | TFfi ("Basis", "bool") => (ECase (e, 169 (strcat loc [str loc ("{_" ^ x ^ ":"),
170 [((PCon (Enum, PConFfi {mod = "Basis", 170 e,
171 datatyp = "bool", 171 str loc "}"], st)
172 con = "True", 172 end
173 arg = NONE}, NONE), loc), 173 | TRecord ((x, t) :: xts) =>
174 str loc "true"), 174 let
175 ((PCon (Enum, PConFfi {mod = "Basis", 175 val (e', st) = quoteExp loc t ((EField (e, x), loc), st)
176 datatyp = "bool", 176 val (es, st) = ListUtil.foldlMap
177 con = "False", 177 (fn ((x, t), st) =>
178 arg = NONE}, NONE), loc), 178 let
179 str loc "false")], 179 val (e, st) = quoteExp loc t ((EField (e, x), loc), st)
180 {disc = (TFfi ("Basis", "bool"), loc), 180 in
181 result = (TFfi ("Basis", "string"), loc)}), loc) 181 (strcat loc [str loc (",_" ^ x ^ ":"), e], st)
182 end)
183 st xts
184 in
185 (strcat loc (str loc ("{_" ^ x ^ ":")
186 :: e'
187 :: es
188 @ [str loc "}"]), st)
189 end
190
191 | TFfi ("Basis", "string") => ((EFfiApp ("Basis", "jsifyString", [e]), loc), st)
192 | TFfi ("Basis", "int") => ((EFfiApp ("Basis", "htmlifyInt", [e]), loc), st)
193 | TFfi ("Basis", "float") => ((EFfiApp ("Basis", "htmlifyFloat", [e]), loc), st)
194
195 | TFfi ("Basis", "bool") => ((ECase (e,
196 [((PCon (Enum, PConFfi {mod = "Basis",
197 datatyp = "bool",
198 con = "True",
199 arg = NONE}, NONE), loc),
200 str loc "true"),
201 ((PCon (Enum, PConFfi {mod = "Basis",
202 datatyp = "bool",
203 con = "False",
204 arg = NONE}, NONE), loc),
205 str loc "false")],
206 {disc = (TFfi ("Basis", "bool"), loc),
207 result = (TFfi ("Basis", "string"), loc)}), loc),
208 st)
182 209
183 | _ => (EM.errorAt loc "Don't know how to embed type in JavaScript"; 210 | _ => (EM.errorAt loc "Don't know how to embed type in JavaScript";
184 Print.prefaces "Can't embed" [("t", MonoPrint.p_typ MonoEnv.empty t)]; 211 Print.prefaces "Can't embed" [("t", MonoPrint.p_typ MonoEnv.empty t)];
185 str loc "ERROR") 212 (str loc "ERROR", st))
186 213
187 fun jsExp mode skip outer = 214 fun jsExp mode skip outer =
188 let 215 let
189 val len = length outer 216 val len = length outer
190 217
316 (str ("_" ^ var n), st) 343 (str ("_" ^ var n), st)
317 else 344 else
318 let 345 let
319 val n = n - inner 346 val n = n - inner
320 in 347 in
321 (quoteExp (List.nth (outer, n)) (ERel (n - skip), loc), st) 348 quoteExp (List.nth (outer, n)) ((ERel (n - skip), loc), st)
322 end 349 end
323 350
324 | ENamed n => 351 | ENamed n =>
325 let 352 let
326 val st = 353 val st =
505 str ("._" ^ x)], st) 532 str ("._" ^ x)], st)
506 end 533 end
507 534
508 | ECase (e', pes, {result, ...}) => 535 | ECase (e', pes, {result, ...}) =>
509 if closedUpto inner e andalso List.all (fn (_, e) => closedUpto inner e) pes then 536 if closedUpto inner e andalso List.all (fn (_, e) => closedUpto inner e) pes then
510 ((ELet ("js", result, e, quoteExp result (ERel 0, loc)), loc), 537 let
511 st) 538 val (e', st) = quoteExp result ((ERel 0, loc), st)
539 in
540 ((ELet ("js", result, e, e'), loc),
541 st)
542 end
512 else 543 else
513 let 544 let
514 val plen = length pes 545 val plen = length pes
515 546
516 val (cases, st) = ListUtil.foldliMap 547 val (cases, st) = ListUtil.foldliMap