Mercurial > urweb

comparison src/cjr_print.sml @ 166:a991431b77eb

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Start of unurlify for datatypes
author Adam Chlipala <adamc@hcoop.net>
date Tue, 29 Jul 2008 14:28:44 -0400
parents e52dfb1e6b19
children 2be573fec9a6
comparison
equal deleted inserted replaced
165:e52dfb1e6b19 166:a991431b77eb
51 val compare = Char.compare 51 val compare = Char.compare
52 end) 52 end)
53 53
54 val debug = ref false 54 val debug = ref false
55 55
56 val dummyTyp = (TNamed 0, ErrorMsg.dummySpan) 56 val dummyTyp = (TDatatype 0, ErrorMsg.dummySpan)
57 57
58 fun p_typ' par env (t, loc) = 58 fun p_typ' par env (t, loc) =
59 case t of 59 case t of
60 TTop => string "void*" 60 TTop => string "void*"
61 | TFun (t1, t2) => parenIf par (box [p_typ' true env t2, 61 | TFun (t1, t2) => parenIf par (box [p_typ' true env t2,
67 string ")"]) 67 string ")"])
68 | TRecord i => box [string "struct", 68 | TRecord i => box [string "struct",
69 space, 69 space,
70 string "__lws_", 70 string "__lws_",
71 string (Int.toString i)] 71 string (Int.toString i)]
72 | TNamed n => 72 | TDatatype n =>
73 (box [string "struct", 73 (box [string "struct",
74 space, 74 space,
75 string ("__lwt_" ^ #1 (E.lookupTNamed env n) ^ "_" ^ Int.toString n ^ "*")] 75 string ("__lwd_" ^ #1 (E.lookupDatatype env n) ^ "_" ^ Int.toString n ^ "*")]
76 handle CjrEnv.UnboundNamed _ => string ("__lwt_UNBOUND__" ^ Int.toString n)) 76 handle CjrEnv.UnboundNamed _ => string ("__lwd_UNBOUND__" ^ Int.toString n))
77 | TFfi (m, x) => box [string "lw_", string m, string "_", string x] 77 | TFfi (m, x) => box [string "lw_", string m, string "_", string x]
78 78
79 and p_typ env = p_typ' false env 79 and p_typ env = p_typ' false env
80 80
81 fun p_rel env n = string ("__lwr_" ^ #1 (E.lookupERel env n) ^ "_" ^ Int.toString (E.countERels env - n - 1)) 81 fun p_rel env n = string ("__lwr_" ^ #1 (E.lookupERel env n) ^ "_" ^ Int.toString (E.countERels env - n - 1))
441 string "};", 441 string "};",
442 newline, 442 newline,
443 string "__lw_tmp;", 443 string "__lw_tmp;",
444 newline, 444 newline,
445 string "})"] 445 string "})"]
446 end
447
448 | TDatatype i =>
449 let
450 val (x, xncs) = E.lookupDatatype env i
451
452 fun doEm xncs =
453 case xncs of
454 [] => string "Uh oh"
455 | (x, n, to) :: rest =>
456 box [string "(!strcmp(request, \"",
457 string x,
458 string "\") ? ({",
459 newline,
460 string ("__lwd_" ^ x ^ "_" ^ Int.toString i),
461 space,
462 string "__lw_tmp;",
463 newline,
464 string "__lw_tmp.tag",
465 space,
466 string "=",
467 space,
468 string ("__lwc_" ^ x ^ "_" ^ Int.toString n),
469 string ";",
470 newline,
471 string "request",
472 space,
473 string "+=",
474 space,
475 string (Int.toString (size x)),
476 string ";",
477 newline,
478 case to of
479 NONE => box []
480 | SOME t => box [string "__lw_tmp.data.",
481 string x,
482 space,
483 string "=",
484 space,
485 unurlify t,
486 string ";",
487 newline],
488 string "__lw_tmp;",
489 newline,
490 string "})",
491 space,
492 string ":",
493 space,
494 doEm rest,
495 string ")"]
496 in
497 doEm xncs
446 end 498 end
447 499
448 | _ => (ErrorMsg.errorAt loc "Unable to choose a URL decoding function"; 500 | _ => (ErrorMsg.errorAt loc "Unable to choose a URL decoding function";
449 space) 501 space)
450 502