Mercurial > urweb

comparison src/monoize.sml @ 185:19ee24bffbc0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
FFI datatypes
author Adam Chlipala <adamc@hcoop.net>
date Sun, 03 Aug 2008 17:57:47 -0400
parents c0ea24dcb86f
children 88d46972de53
comparison
equal deleted inserted replaced
184:98c29e3986d3 185:19ee24bffbc0
154 end 154 end
155 | SOME n' => (t, n') 155 | SOME n' => (t, n')
156 end 156 end
157 157
158 end 158 end
159 159
160
161 fun capitalize s =
162 if s = "" then
163 s
164 else
165 str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
160 166
161 fun fooifyExp fk env = 167 fun fooifyExp fk env =
162 let 168 let
163 fun fooify fm (e, tAll as (t, loc)) = 169 fun fooify fm (e, tAll as (t, loc)) =
164 case #1 e of 170 case #1 e of
191 in 197 in
192 attrify (args, ft, (L'.EPrim (Prim.String ("/" ^ s)), loc), fm) 198 attrify (args, ft, (L'.EPrim (Prim.String ("/" ^ s)), loc), fm)
193 end 199 end
194 | _ => 200 | _ =>
195 case t of 201 case t of
196 L'.TFfi ("Basis", "string") => ((L'.EFfiApp ("Basis", fk2s fk ^ "ifyString", [e]), loc), fm) 202 L'.TFfi (m, x) => ((L'.EFfiApp (m, fk2s fk ^ "ify" ^ capitalize x, [e]), loc), fm)
197 | L'.TFfi ("Basis", "int") => ((L'.EFfiApp ("Basis", fk2s fk ^ "ifyInt", [e]), loc), fm)
198 | L'.TFfi ("Basis", "float") => ((L'.EFfiApp ("Basis", fk2s fk ^ "ifyFloat", [e]), loc), fm)
199 | L'.TRecord [] => ((L'.EPrim (Prim.String ""), loc), fm) 203 | L'.TRecord [] => ((L'.EPrim (Prim.String ""), loc), fm)
200 204
201 | L'.TDatatype (i, _) => 205 | L'.TDatatype (i, _) =>
202 let 206 let
203 fun makeDecl n fm = 207 fun makeDecl n fm =
304 in 308 in
305 case e of 309 case e of
306 L.EPrim p => ((L'.EPrim p, loc), fm) 310 L.EPrim p => ((L'.EPrim p, loc), fm)
307 | L.ERel n => ((L'.ERel n, loc), fm) 311 | L.ERel n => ((L'.ERel n, loc), fm)
308 | L.ENamed n => ((L'.ENamed n, loc), fm) 312 | L.ENamed n => ((L'.ENamed n, loc), fm)
309 | L.ECon (n, eo) => 313 | L.ECon (pc, eo) =>
310 let 314 let
311 val (eo, fm) = 315 val (eo, fm) =
312 case eo of 316 case eo of
313 NONE => (NONE, fm) 317 NONE => (NONE, fm)
314 | SOME e => 318 | SOME e =>
316 val (e, fm) = monoExp (env, st, fm) e 320 val (e, fm) = monoExp (env, st, fm) e
317 in 321 in
318 (SOME e, fm) 322 (SOME e, fm)
319 end 323 end
320 in 324 in
321 ((L'.ECon (n, eo), loc), fm) 325 ((L'.ECon (monoPatCon pc, eo), loc), fm)
322 end 326 end
323 | L.EFfi mx => ((L'.EFfi mx, loc), fm) 327 | L.EFfi mx => ((L'.EFfi mx, loc), fm)
324 | L.EFfiApp (m, x, es) => 328 | L.EFfiApp (m, x, es) =>
325 let 329 let
326 val (es, fm) = ListUtil.foldlMap (fn (e, fm) => monoExp (env, st, fm) e) fm es 330 val (es, fm) = ListUtil.foldlMap (fn (e, fm) => monoExp (env, st, fm) e) fm es
414 let 418 let
415 val xp = " " ^ lowercaseFirst x ^ "=\"" 419 val xp = " " ^ lowercaseFirst x ^ "=\""
416 420
417 val fooify = 421 val fooify =
418 case x of 422 case x of
419 "Link" => urlifyExp 423 "Href" => urlifyExp
424 | "Link" => urlifyExp
420 | "Action" => urlifyExp 425 | "Action" => urlifyExp
421 | _ => attrifyExp 426 | _ => attrifyExp
422 427
423 val (e, fm) = fooify env fm (e, t) 428 val (e, fm) = fooify env fm (e, t)
424 in 429 in