Mercurial > urweb

comparison src/jscomp.sml @ 585:35471f067980

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Reactive record pattern
author Adam Chlipala <adamc@hcoop.net>
date Thu, 01 Jan 2009 11:04:09 -0500
parents 101eb0058136
children 1c969230ee7f
comparison
equal deleted inserted replaced
584:101eb0058136 585:35471f067980
152 | #"\\" => "\\\\" 152 | #"\\" => "\\\\"
153 | ch => String.str ch) s 153 | ch => String.str ch) s
154 ^ "\"") 154 ^ "\"")
155 | _ => str (Prim.toString p) 155 | _ => str (Prim.toString p)
156 156
157 fun jsPat inner (p, _) succ fail = 157 fun jsPat depth inner (p, _) succ fail =
158 case p of 158 case p of
159 PWild => succ 159 PWild => succ
160 | PVar _ => strcat [str ("(_" ^ Int.toString (len + inner) ^ "=d,"), 160 | PVar _ => strcat [str ("(_" ^ Int.toString (len + inner) ^ "=d" ^ Int.toString depth ^ ","),
161 succ, 161 succ,
162 str ")"] 162 str ")"]
163 | PPrim p => strcat [str "(d==", 163 | PPrim p => strcat [str ("(d" ^ Int.toString depth ^ "=="),
164 jsPrim p, 164 jsPrim p,
165 str "?", 165 str "?",
166 succ, 166 succ,
167 str ":", 167 str ":",
168 fail, 168 fail,
171 | PRecord xps => 171 | PRecord xps =>
172 let 172 let
173 val (_, succ) = foldl 173 val (_, succ) = foldl
174 (fn ((x, p, _), (inner, succ)) => 174 (fn ((x, p, _), (inner, succ)) =>
175 (inner + E.patBindsN p, 175 (inner + E.patBindsN p,
176 jsPat inner p succ fail)) 176 strcat [str ("(d" ^ Int.toString (depth+1) ^ "=d"
177 ^ Int.toString depth ^ "._" ^ x ^ ","),
178 jsPat (depth+1) inner p succ fail,
179 str ")"]))
177 (inner, succ) xps 180 (inner, succ) xps
178 in 181 in
179 succ 182 succ
180 end 183 end
181 | PNone _ => strcat [str "(d?", 184 | PNone _ => strcat [str ("(d" ^ Int.toString depth ^ "?"),
182 fail, 185 fail,
183 str ":", 186 str ":",
184 succ, 187 succ,
185 str ")"] 188 str ")"]
186 | PSome (_, p) => strcat [str "(d?", 189 | PSome (_, p) => strcat [str ("(d" ^ Int.toString depth ^ "?"),
187 jsPat inner p succ fail, 190 jsPat depth inner p succ fail,
188 str ":", 191 str ":",
189 fail, 192 fail,
190 str ")"] 193 str ")"]
191 in 194 in
192 case #1 e of 195 case #1 e of
283 end 286 end
284 | EAbs (_, _, _, e) => 287 | EAbs (_, _, _, e) =>
285 let 288 let
286 val locals = List.tabulate 289 val locals = List.tabulate
287 (varDepth e, 290 (varDepth e,
288 fn i => str ("var _" ^ Int.toString (len + inner + i) ^ ";")) 291 fn i => str ("var _" ^ Int.toString (len + inner + i + 1) ^ ";"))
289 val (e, st) = jsE (inner + 1) (e, st) 292 val (e, st) = jsE (inner + 1) (e, st)
290 in 293 in
291 (strcat (str ("function(_" 294 (strcat (str ("function(_"
292 ^ Int.toString (len + inner) 295 ^ Int.toString (len + inner)
293 ^ "){") 296 ^ "){")
367 val fail = 370 val fail =
368 if i = plen - 1 then 371 if i = plen - 1 then
369 str "pf()" 372 str "pf()"
370 else 373 else
371 str ("c" ^ Int.toString (i+1) ^ "()") 374 str ("c" ^ Int.toString (i+1) ^ "()")
372 val c = jsPat inner p e fail 375 val c = jsPat 0 inner p e fail
373 in 376 in
374 (strcat [str ("c" ^ Int.toString i ^ "=function(){return "), 377 (strcat [str ("c" ^ Int.toString i ^ "=function(){return "),
375 c, 378 c,
376 str "},"], 379 str "},"],
377 st) 380 st)
380 383
381 val (e, st) = jsE inner (e, st) 384 val (e, st) = jsE inner (e, st)
382 in 385 in
383 (strcat (str "(" 386 (strcat (str "("
384 :: List.revAppend (cases, 387 :: List.revAppend (cases,
385 [str "d=", 388 [str "d0=",
386 e, 389 e,
387 str ",c0())"])), st) 390 str ",c0())"])), st)
388 end 391 end
389 392
390 | EStrcat (e1, e2) => 393 | EStrcat (e1, e2) =>