Mercurial > urweb

annotate src/cjr_print.sml @ 201:f2cac0dba9bf

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Consolidating compiler phase interface and adding timing
author Adam Chlipala <adamc@hcoop.net>
date Tue, 12 Aug 2008 14:40:07 -0400
parents 5dbba661deab
children 71bafe66dbe1
rev   line source
adamc@29 1 (* Copyright (c) 2008, Adam Chlipala
adamc@29 2 * All rights reserved.
adamc@29 3 *
adamc@29 4 * Redistribution and use in source and binary forms, with or without
adamc@29 5 * modification, are permitted provided that the following conditions are met:
adamc@29 6 *
adamc@29 7 * - Redistributions of source code must retain the above copyright notice,
adamc@29 8 * this list of conditions and the following disclaimer.
adamc@29 9 * - Redistributions in binary form must reproduce the above copyright notice,
adamc@29 10 * this list of conditions and the following disclaimer in the documentation
adamc@29 11 * and/or other materials provided with the distribution.
adamc@29 12 * - The names of contributors may not be used to endorse or promote products
adamc@29 13 * derived from this software without specific prior written permission.
adamc@29 14 *
adamc@29 15 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
adamc@29 16 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
adamc@29 17 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
adamc@29 18 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
adamc@29 19 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
adamc@29 20 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
adamc@29 21 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
adamc@29 22 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
adamc@29 23 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
adamc@29 24 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
adamc@29 25 * POSSIBILITY OF SUCH DAMAGE.
adamc@29 26 *)
adamc@29 27
adamc@29 28 (* Pretty-printing C jr. *)
adamc@29 29
adamc@29 30 structure CjrPrint :> CJR_PRINT = struct
adamc@29 31
adamc@29 32 open Print.PD
adamc@29 33 open Print
adamc@29 34
adamc@29 35 open Cjr
adamc@29 36
adamc@29 37 structure E = CjrEnv
adamc@29 38 structure EM = ErrorMsg
adamc@29 39
adamc@144 40 structure SK = struct
adamc@144 41 type ord_key = string
adamc@144 42 val compare = String.compare
adamc@144 43 end
adamc@144 44
adamc@144 45 structure SS = BinarySetFn(SK)
adamc@144 46 structure SM = BinaryMapFn(SK)
adamc@144 47 structure IS = IntBinarySet
adamc@144 48
adamc@144 49 structure CM = BinaryMapFn(struct
adamc@144 50 type ord_key = char
adamc@144 51 val compare = Char.compare
adamc@144 52 end)
adamc@144 53
adamc@29 54 val debug = ref false
adamc@29 55
adamc@196 56 val dummyTyp = (TDatatype (Enum, 0, ref []), ErrorMsg.dummySpan)
adamc@29 57
adamc@29 58 fun p_typ' par env (t, loc) =
adamc@29 59 case t of
adamc@101 60 TTop => string "void*"
adamc@109 61 | TFun (t1, t2) => parenIf par (box [p_typ' true env t2,
adamc@109 62 space,
adamc@109 63 string "(*)",
adamc@109 64 space,
adamc@109 65 string "(",
adamc@109 66 p_typ env t1,
adamc@109 67 string ")"])
adamc@29 68 | TRecord i => box [string "struct",
adamc@29 69 space,
adamc@29 70 string "__lws_",
adamc@29 71 string (Int.toString i)]
adamc@188 72 | TDatatype (Enum, n, _) =>
adamc@188 73 (box [string "enum",
adamc@188 74 space,
adamc@188 75 string ("__lwe_" ^ #1 (E.lookupDatatype env n) ^ "_" ^ Int.toString n)]
adamc@188 76 handle CjrEnv.UnboundNamed _ => string ("__lwd_UNBOUND__" ^ Int.toString n))
adamc@198 77 | TDatatype (Option, n, xncs) =>
adamc@198 78 (case ListUtil.search #3 (!xncs) of
adamc@198 79 NONE => raise Fail "CjrPrint: TDatatype marked Option has no constructor with an argument"
adamc@198 80 | SOME t =>
adamc@198 81 case #1 t of
adamc@198 82 TDatatype _ => p_typ' par env t
adamc@199 83 | TFfi ("Basis", "string") => p_typ' par env t
adamc@198 84 | _ => box [p_typ' par env t,
adamc@198 85 string "*"])
adamc@188 86 | TDatatype (Default, n, _) =>
adamc@165 87 (box [string "struct",
adamc@165 88 space,
adamc@166 89 string ("__lwd_" ^ #1 (E.lookupDatatype env n) ^ "_" ^ Int.toString n ^ "*")]
adamc@166 90 handle CjrEnv.UnboundNamed _ => string ("__lwd_UNBOUND__" ^ Int.toString n))
adamc@53 91 | TFfi (m, x) => box [string "lw_", string m, string "_", string x]
adamc@29 92
adamc@29 93 and p_typ env = p_typ' false env
adamc@29 94
adamc@29 95 fun p_rel env n = string ("__lwr_" ^ #1 (E.lookupERel env n) ^ "_" ^ Int.toString (E.countERels env - n - 1))
adamc@29 96 handle CjrEnv.UnboundRel _ => string ("__lwr_UNBOUND_" ^ Int.toString (E.countERels env - n - 1))
adamc@29 97
adamc@109 98 fun p_enamed env n =
adamc@109 99 string ("__lwn_" ^ #1 (E.lookupENamed env n) ^ "_" ^ Int.toString n)
adamc@109 100 handle CjrEnv.UnboundNamed _ => string ("__lwn_UNBOUND_" ^ Int.toString n)
adamc@109 101
adamc@182 102 fun p_con_named env n =
adamc@182 103 string ("__lwc_" ^ #1 (E.lookupConstructor env n) ^ "_" ^ Int.toString n)
adamc@182 104 handle CjrEnv.UnboundNamed _ => string ("__lwc_UNBOUND_" ^ Int.toString n)
adamc@182 105
adamc@182 106 fun p_pat_preamble env (p, _) =
adamc@182 107 case p of
adamc@182 108 PWild => (box [],
adamc@182 109 env)
adamc@182 110 | PVar (x, t) => (box [p_typ env t,
adamc@182 111 space,
adamc@182 112 string "__lwr_",
adamc@182 113 string x,
adamc@182 114 string "_",
adamc@182 115 string (Int.toString (E.countERels env)),
adamc@182 116 string ";",
adamc@182 117 newline],
adamc@196 118 E.pushERel env x t)
adamc@182 119 | PPrim _ => (box [], env)
adamc@188 120 | PCon (_, _, NONE) => (box [], env)
adamc@188 121 | PCon (_, _, SOME p) => p_pat_preamble env p
adamc@182 122 | PRecord xps =>
adamc@182 123 foldl (fn ((_, p, _), (pp, env)) =>
adamc@182 124 let
adamc@182 125 val (pp', env) = p_pat_preamble env p
adamc@182 126 in
adamc@182 127 (box [pp', pp], env)
adamc@182 128 end) (box [], env) xps
adamc@182 129
adamc@182 130 fun p_patCon env pc =
adamc@182 131 case pc of
adamc@182 132 PConVar n => p_con_named env n
adamc@186 133 | PConFfi {mod = m, con, ...} => string ("lw_" ^ m ^ "_" ^ con)
adamc@182 134
adamc@182 135 fun p_pat (env, exit, depth) (p, _) =
adamc@182 136 case p of
adamc@182 137 PWild =>
adamc@182 138 (box [], env)
adamc@182 139 | PVar (x, t) =>
adamc@182 140 (box [string "__lwr_",
adamc@182 141 string x,
adamc@182 142 string "_",
adamc@182 143 string (Int.toString (E.countERels env)),
adamc@182 144 space,
adamc@182 145 string "=",
adamc@182 146 space,
adamc@182 147 string "disc",
adamc@182 148 string (Int.toString depth),
adamc@182 149 string ";"],
adamc@182 150 E.pushERel env x t)
adamc@182 151 | PPrim (Prim.Int n) =>
adamc@182 152 (box [string "if",
adamc@182 153 space,
adamc@182 154 string "(disc",
adamc@182 155 string (Int.toString depth),
adamc@182 156 space,
adamc@182 157 string "!=",
adamc@182 158 space,
adamc@182 159 Prim.p_t (Prim.Int n),
adamc@182 160 string ")",
adamc@182 161 space,
adamc@182 162 exit],
adamc@182 163 env)
adamc@182 164 | PPrim (Prim.String s) =>
adamc@182 165 (box [string "if",
adamc@182 166 space,
adamc@182 167 string "(strcmp(disc",
adamc@182 168 string (Int.toString depth),
adamc@182 169 string ",",
adamc@182 170 space,
adamc@182 171 Prim.p_t (Prim.String s),
adamc@182 172 string "))",
adamc@182 173 space,
adamc@182 174 exit],
adamc@182 175 env)
adamc@182 176 | PPrim _ => raise Fail "CjrPrint: Disallowed PPrim primitive"
adamc@182 177
adamc@188 178 | PCon (dk, pc, po) =>
adamc@182 179 let
adamc@182 180 val (p, env) =
adamc@182 181 case po of
adamc@182 182 NONE => (box [], env)
adamc@182 183 | SOME p =>
adamc@182 184 let
adamc@182 185 val (p, env) = p_pat (env, exit, depth + 1) p
adamc@182 186
adamc@182 187 val (x, to) = case pc of
adamc@182 188 PConVar n =>
adamc@182 189 let
adamc@182 190 val (x, to, _) = E.lookupConstructor env n
adamc@182 191 in
adamc@196 192 ("lw_" ^ x, to)
adamc@182 193 end
adamc@188 194 | PConFfi {mod = m, con, arg, ...} =>
adamc@188 195 ("lw_" ^ m ^ "_" ^ con, arg)
adamc@182 196
adamc@182 197 val t = case to of
adamc@182 198 NONE => raise Fail "CjrPrint: Constructor mismatch"
adamc@182 199 | SOME t => t
adamc@182 200 in
adamc@182 201 (box [string "{",
adamc@182 202 newline,
adamc@182 203 p_typ env t,
adamc@182 204 space,
adamc@182 205 string "disc",
adamc@182 206 string (Int.toString (depth + 1)),
adamc@182 207 space,
adamc@182 208 string "=",
adamc@182 209 space,
adamc@198 210 case dk of
adamc@198 211 Enum => raise Fail "CjrPrint: Looking at argument of no-argument constructor"
adamc@198 212 | Default => box [string "disc",
adamc@198 213 string (Int.toString depth),
adamc@198 214 string "->data.",
adamc@198 215 string x]
adamc@198 216 | Option =>
adamc@198 217 case #1 t of
adamc@198 218 TDatatype _ => box [string "disc",
adamc@198 219 string (Int.toString depth)]
adamc@199 220 | TFfi ("Basis", "string") => box [string "disc",
adamc@199 221 string (Int.toString depth)]
adamc@198 222 | _ => box [string "*disc",
adamc@198 223 string (Int.toString depth)],
adamc@182 224 string ";",
adamc@182 225 newline,
adamc@182 226 p,
adamc@182 227 newline,
adamc@182 228 string "}"],
adamc@182 229 env)
adamc@182 230 end
adamc@182 231 in
adamc@182 232 (box [string "if",
adamc@182 233 space,
adamc@182 234 string "(disc",
adamc@182 235 string (Int.toString depth),
adamc@198 236 case (dk, po) of
adamc@198 237 (Enum, _) => box [space,
adamc@198 238 string "!=",
adamc@198 239 space,
adamc@198 240 p_patCon env pc]
adamc@198 241 | (Default, _) => box [string "->tag",
adamc@198 242 space,
adamc@198 243 string "!=",
adamc@198 244 space,
adamc@198 245 p_patCon env pc]
adamc@198 246 | (Option, NONE) => box [space,
adamc@198 247 string "!=",
adamc@198 248 space,
adamc@198 249 string "NULL"]
adamc@198 250 | (Option, SOME _) => box [space,
adamc@198 251 string "==",
adamc@198 252 space,
adamc@198 253 string "NULL"],
adamc@182 254 string ")",
adamc@182 255 space,
adamc@182 256 exit,
adamc@182 257 newline,
adamc@182 258 p],
adamc@182 259 env)
adamc@182 260 end
adamc@182 261
adamc@182 262 | PRecord xps =>
adamc@182 263 let
adamc@182 264 val (xps, env) =
adamc@182 265 ListUtil.foldlMap (fn ((x, p, t), env) =>
adamc@182 266 let
adamc@182 267 val (p, env) = p_pat (env, exit, depth + 1) p
adamc@182 268
adamc@182 269 val p = box [string "{",
adamc@182 270 newline,
adamc@182 271 p_typ env t,
adamc@182 272 space,
adamc@182 273 string "disc",
adamc@182 274 string (Int.toString (depth + 1)),
adamc@182 275 space,
adamc@182 276 string "=",
adamc@182 277 space,
adamc@182 278 string "disc",
adamc@182 279 string (Int.toString depth),
adamc@196 280 string ".__lwf_",
adamc@182 281 string x,
adamc@182 282 string ";",
adamc@182 283 newline,
adamc@182 284 p,
adamc@182 285 newline,
adamc@182 286 string "}"]
adamc@182 287 in
adamc@182 288 (p, env)
adamc@182 289 end) env xps
adamc@182 290 in
adamc@182 291 (p_list_sep newline (fn x => x) xps,
adamc@182 292 env)
adamc@182 293 end
adamc@182 294
adamc@182 295 local
adamc@182 296 val count = ref 0
adamc@182 297 in
adamc@182 298 fun newGoto () =
adamc@182 299 let
adamc@182 300 val r = !count
adamc@182 301 in
adamc@182 302 count := r + 1;
adamc@182 303 string ("L" ^ Int.toString r)
adamc@182 304 end
adamc@182 305 end
adamc@182 306
adamc@185 307 fun patConInfo env pc =
adamc@185 308 case pc of
adamc@185 309 PConVar n =>
adamc@185 310 let
adamc@185 311 val (x, _, dn) = E.lookupConstructor env n
adamc@185 312 val (dx, _) = E.lookupDatatype env dn
adamc@185 313 in
adamc@185 314 ("__lwd_" ^ dx ^ "_" ^ Int.toString dn,
adamc@196 315 "__lwc_" ^ x ^ "_" ^ Int.toString n,
adamc@196 316 "lw_" ^ x)
adamc@185 317 end
adamc@186 318 | PConFfi {mod = m, datatyp, con, ...} =>
adamc@185 319 ("lw_" ^ m ^ "_" ^ datatyp,
adamc@196 320 "lw_" ^ m ^ "_" ^ con,
adamc@196 321 "lw_" ^ con)
adamc@185 322
adamc@182 323 fun p_exp' par env (e, loc) =
adamc@29 324 case e of
adamc@29 325 EPrim p => Prim.p_t p
adamc@29 326 | ERel n => p_rel env n
adamc@109 327 | ENamed n => p_enamed env n
adamc@188 328 | ECon (Enum, pc, _) => p_patCon env pc
adamc@198 329 | ECon (Option, pc, NONE) => string "NULL"
adamc@198 330 | ECon (Option, pc, SOME e) =>
adamc@198 331 let
adamc@198 332 val to = case pc of
adamc@198 333 PConVar n => #2 (E.lookupConstructor env n)
adamc@198 334 | PConFfi {arg, ...} => arg
adamc@198 335
adamc@198 336 val t = case to of
adamc@198 337 NONE => raise Fail "CjrPrint: ECon argument status mismatch"
adamc@198 338 | SOME t => t
adamc@198 339 in
adamc@198 340 case #1 t of
adamc@198 341 TDatatype _ => p_exp' par env e
adamc@199 342 | TFfi ("Basis", "string") => p_exp' par env e
adamc@198 343 | _ => box [string "({",
adamc@198 344 newline,
adamc@198 345 p_typ env t,
adamc@198 346 space,
adamc@198 347 string "*tmp",
adamc@198 348 space,
adamc@198 349 string "=",
adamc@198 350 space,
adamc@198 351 string "lw_malloc(ctx, sizeof(",
adamc@198 352 p_typ env t,
adamc@198 353 string "));",
adamc@198 354 newline,
adamc@198 355 string "*tmp",
adamc@198 356 space,
adamc@198 357 string "=",
adamc@198 358 p_exp' par env e,
adamc@198 359 string ";",
adamc@198 360 newline,
adamc@198 361 string "tmp;",
adamc@198 362 newline,
adamc@198 363 string "})"]
adamc@198 364 end
adamc@188 365 | ECon (Default, pc, eo) =>
adamc@181 366 let
adamc@196 367 val (xd, xc, xn) = patConInfo env pc
adamc@181 368 in
adamc@182 369 box [string "({",
adamc@181 370 newline,
adamc@181 371 string "struct",
adamc@181 372 space,
adamc@185 373 string xd,
adamc@181 374 space,
adamc@181 375 string "*tmp",
adamc@181 376 space,
adamc@181 377 string "=",
adamc@181 378 space,
adamc@185 379 string "lw_malloc(ctx, sizeof(struct ",
adamc@185 380 string xd,
adamc@181 381 string "));",
adamc@181 382 newline,
adamc@181 383 string "tmp->tag",
adamc@181 384 space,
adamc@181 385 string "=",
adamc@181 386 space,
adamc@185 387 string xc,
adamc@181 388 string ";",
adamc@181 389 newline,
adamc@181 390 case eo of
adamc@181 391 NONE => box []
adamc@185 392 | SOME e => box [string "tmp->data.",
adamc@196 393 string xn,
adamc@181 394 space,
adamc@181 395 string "=",
adamc@181 396 space,
adamc@181 397 p_exp env e,
adamc@181 398 string ";",
adamc@181 399 newline],
adamc@181 400 string "tmp;",
adamc@181 401 newline,
adamc@181 402 string "})"]
adamc@181 403 end
adamc@109 404
adamc@53 405 | EFfi (m, x) => box [string "lw_", string m, string "_", string x]
adamc@53 406 | EFfiApp (m, x, es) => box [string "lw_",
adamc@53 407 string m,
adamc@53 408 string "_",
adamc@53 409 string x,
adamc@117 410 string "(ctx, ",
adamc@53 411 p_list (p_exp env) es,
adamc@53 412 string ")"]
adamc@129 413 | EApp (e1, e2) =>
adamc@129 414 let
adamc@129 415 fun unravel (f, acc) =
adamc@129 416 case #1 f of
adamc@129 417 EApp (f', arg) => unravel (f', arg :: acc)
adamc@129 418 | _ => (f, acc)
adamc@129 419
adamc@129 420 val (f, args) = unravel (e1, [e2])
adamc@129 421 in
adamc@129 422 parenIf par (box [p_exp' true env e1,
adamc@129 423 string "(ctx,",
adamc@129 424 space,
adamc@129 425 p_list_sep (box [string ",", space]) (p_exp env) args,
adamc@129 426 string ")"])
adamc@129 427 end
adamc@29 428
adamc@29 429 | ERecord (i, xes) => box [string "({",
adamc@29 430 space,
adamc@29 431 string "struct",
adamc@29 432 space,
adamc@29 433 string ("__lws_" ^ Int.toString i),
adamc@29 434 space,
adamc@181 435 string "tmp",
adamc@29 436 space,
adamc@29 437 string "=",
adamc@29 438 space,
adamc@29 439 string "{",
adamc@29 440 p_list (fn (_, e) =>
adamc@29 441 p_exp env e) xes,
adamc@29 442 string "};",
adamc@29 443 space,
adamc@181 444 string "tmp;",
adamc@29 445 space,
adamc@29 446 string "})" ]
adamc@29 447 | EField (e, x) =>
adamc@29 448 box [p_exp' true env e,
adamc@182 449 string ".__lwf_",
adamc@29 450 string x]
adamc@29 451
adamc@182 452 | ECase (e, pes, {disc, result}) =>
adamc@182 453 let
adamc@182 454 val final = newGoto ()
adamc@182 455
adamc@182 456 val body = foldl (fn ((p, e), body) =>
adamc@182 457 let
adamc@182 458 val exit = newGoto ()
adamc@182 459 val (pr, _) = p_pat_preamble env p
adamc@182 460 val (p, env) = p_pat (env,
adamc@182 461 box [string "goto",
adamc@182 462 space,
adamc@182 463 exit,
adamc@182 464 string ";"],
adamc@182 465 0) p
adamc@182 466 in
adamc@182 467 box [body,
adamc@182 468 box [string "{",
adamc@182 469 newline,
adamc@182 470 pr,
adamc@182 471 newline,
adamc@182 472 p,
adamc@182 473 newline,
adamc@182 474 string "result",
adamc@182 475 space,
adamc@182 476 string "=",
adamc@182 477 space,
adamc@182 478 p_exp env e,
adamc@182 479 string ";",
adamc@182 480 newline,
adamc@182 481 string "goto",
adamc@182 482 space,
adamc@182 483 final,
adamc@182 484 string ";",
adamc@182 485 newline,
adamc@182 486 string "}"],
adamc@182 487 newline,
adamc@182 488 exit,
adamc@182 489 string ":",
adamc@182 490 newline]
adamc@182 491 end) (box []) pes
adamc@182 492 in
adamc@182 493 box [string "({",
adamc@182 494 newline,
adamc@182 495 p_typ env disc,
adamc@182 496 space,
adamc@182 497 string "disc0",
adamc@182 498 space,
adamc@182 499 string "=",
adamc@182 500 space,
adamc@182 501 p_exp env e,
adamc@182 502 string ";",
adamc@182 503 newline,
adamc@182 504 p_typ env result,
adamc@182 505 space,
adamc@182 506 string "result;",
adamc@182 507 newline,
adamc@182 508 body,
adamc@182 509 string "lw_error(ctx, FATAL, \"",
adamc@182 510 string (ErrorMsg.spanToString loc),
adamc@182 511 string ": pattern match failure\");",
adamc@182 512 newline,
adamc@182 513 final,
adamc@182 514 string ":",
adamc@182 515 space,
adamc@182 516 string "result;",
adamc@182 517 newline,
adamc@182 518 string "})"]
adamc@182 519 end
adamc@181 520
adamc@117 521 | EWrite e => box [string "(lw_write(ctx, ",
adamc@102 522 p_exp env e,
adamc@102 523 string "), lw_unit_v)"]
adamc@102 524
adamc@106 525 | ESeq (e1, e2) => box [string "(",
adamc@106 526 p_exp env e1,
adamc@106 527 string ",",
adamc@106 528 space,
adamc@106 529 p_exp env e2,
adamc@106 530 string ")"]
adamc@106 531
adamc@29 532 and p_exp env = p_exp' false env
adamc@29 533
adamc@129 534 fun p_fun env (fx, n, args, ran, e) =
adamc@129 535 let
adamc@129 536 val nargs = length args
adamc@129 537 val env' = foldl (fn ((x, dom), env) => E.pushERel env x dom) env args
adamc@129 538 in
adamc@129 539 box [string "static",
adamc@129 540 space,
adamc@129 541 p_typ env ran,
adamc@129 542 space,
adamc@129 543 string ("__lwn_" ^ fx ^ "_" ^ Int.toString n),
adamc@129 544 string "(",
adamc@129 545 p_list_sep (box [string ",", space]) (fn x => x)
adamc@129 546 (string "lw_context ctx" :: ListUtil.mapi (fn (i, (_, dom)) =>
adamc@129 547 box [p_typ env dom,
adamc@129 548 space,
adamc@129 549 p_rel env' (nargs - i - 1)]) args),
adamc@129 550 string ")",
adamc@129 551 space,
adamc@129 552 string "{",
adamc@129 553 newline,
adamc@129 554 box[string "return(",
adamc@129 555 p_exp env' e,
adamc@129 556 string ");"],
adamc@129 557 newline,
adamc@129 558 string "}"]
adamc@129 559 end
adamc@129 560
adamc@129 561 fun p_decl env (dAll as (d, _) : decl) =
adamc@29 562 case d of
adamc@29 563 DStruct (n, xts) =>
adamc@196 564 let
adamc@196 565 val env = E.declBinds env dAll
adamc@196 566 in
adamc@196 567 box [string "struct",
adamc@196 568 space,
adamc@196 569 string ("__lws_" ^ Int.toString n),
adamc@196 570 space,
adamc@196 571 string "{",
adamc@196 572 newline,
adamc@196 573 p_list_sep (box []) (fn (x, t) => box [p_typ env t,
adamc@196 574 space,
adamc@196 575 string "__lwf_",
adamc@196 576 string x,
adamc@196 577 string ";",
adamc@196 578 newline]) xts,
adamc@196 579 string "};"]
adamc@196 580 end
adamc@188 581 | DDatatype (Enum, x, n, xncs) =>
adamc@188 582 box [string "enum",
adamc@188 583 space,
adamc@188 584 string ("__lwe_" ^ x ^ "_" ^ Int.toString n),
adamc@188 585 space,
adamc@188 586 string "{",
adamc@188 587 space,
adamc@188 588 p_list_sep (box [string ",", space]) (fn (x, n, _) => string ("__lwc_" ^ x ^ "_" ^ Int.toString n)) xncs,
adamc@188 589 space,
adamc@188 590 string "};"]
adamc@198 591 | DDatatype (Option, _, _, _) => box []
adamc@188 592 | DDatatype (Default, x, n, xncs) =>
adamc@165 593 let
adamc@165 594 val xncsArgs = List.mapPartial (fn (x, n, NONE) => NONE
adamc@165 595 | (x, n, SOME t) => SOME (x, n, t)) xncs
adamc@165 596 in
adamc@165 597 box [string "enum",
adamc@165 598 space,
adamc@165 599 string ("__lwe_" ^ x ^ "_" ^ Int.toString n),
adamc@165 600 space,
adamc@165 601 string "{",
adamc@165 602 space,
adamc@165 603 p_list_sep (box [string ",", space]) (fn (x, n, _) => string ("__lwc_" ^ x ^ "_" ^ Int.toString n)) xncs,
adamc@165 604 space,
adamc@165 605 string "};",
adamc@165 606 newline,
adamc@165 607 newline,
adamc@165 608 string "struct",
adamc@165 609 space,
adamc@167 610 string ("__lwd_" ^ x ^ "_" ^ Int.toString n),
adamc@165 611 space,
adamc@165 612 string "{",
adamc@165 613 newline,
adamc@165 614 string "enum",
adamc@165 615 space,
adamc@165 616 string ("__lwe_" ^ x ^ "_" ^ Int.toString n),
adamc@165 617 space,
adamc@165 618 string "tag;",
adamc@165 619 newline,
adamc@165 620 box (case xncsArgs of
adamc@165 621 [] => []
adamc@165 622 | _ => [string "union",
adamc@165 623 space,
adamc@165 624 string "{",
adamc@165 625 newline,
adamc@165 626 p_list_sep newline (fn (x, n, t) => box [p_typ env t,
adamc@165 627 space,
adamc@196 628 string ("lw_" ^ x),
adamc@165 629 string ";"]) xncsArgs,
adamc@165 630 newline,
adamc@165 631 string "}",
adamc@165 632 space,
adamc@165 633 string "data;",
adamc@165 634 newline]),
adamc@165 635 string "};"]
adamc@188 636 end
adamc@29 637
adamc@196 638 | DDatatypeForward _ => box []
adamc@196 639
adamc@29 640 | DVal (x, n, t, e) =>
adamc@29 641 box [p_typ env t,
adamc@29 642 space,
adamc@29 643 string ("__lwn_" ^ x ^ "_" ^ Int.toString n),
adamc@29 644 space,
adamc@29 645 string "=",
adamc@29 646 space,
adamc@29 647 p_exp env e,
adamc@29 648 string ";"]
adamc@129 649 | DFun vi => p_fun env vi
adamc@129 650 | DFunRec vis =>
adamc@29 651 let
adamc@129 652 val env = E.declBinds env dAll
adamc@29 653 in
adamc@129 654 box [p_list_sep newline (fn (fx, n, args, ran, _) =>
adamc@129 655 box [string "static",
adamc@129 656 space,
adamc@129 657 p_typ env ran,
adamc@129 658 space,
adamc@129 659 string ("__lwn_" ^ fx ^ "_" ^ Int.toString n),
adamc@129 660 string "(lw_context,",
adamc@129 661 space,
adamc@129 662 p_list_sep (box [string ",", space])
adamc@129 663 (fn (_, dom) => p_typ env dom) args,
adamc@129 664 string ");"]) vis,
adamc@29 665 newline,
adamc@129 666 p_list_sep newline (p_fun env) vis,
adamc@129 667 newline]
adamc@29 668 end
adamc@29 669
adamc@144 670 datatype 'a search =
adamc@144 671 Found of 'a
adamc@144 672 | NotFound
adamc@144 673 | Error
adamc@120 674
adamc@101 675
adamc@101 676 fun p_file env (ds, ps) =
adamc@29 677 let
adamc@101 678 val (pds, env) = ListUtil.foldlMap (fn (d, env) =>
adamc@31 679 (p_decl env d,
adamc@31 680 E.declBinds env d))
adamc@101 681 env ds
adamc@144 682
adamc@144 683 val fields = foldl (fn ((ek, _, _, ts), fields) =>
adamc@144 684 case ek of
adamc@144 685 Core.Link => fields
adamc@144 686 | Core.Action =>
adamc@144 687 case List.last ts of
adamc@144 688 (TRecord i, _) =>
adamc@144 689 let
adamc@144 690 val xts = E.lookupStruct env i
adamc@144 691 val xtsSet = SS.addList (SS.empty, map #1 xts)
adamc@144 692 in
adamc@144 693 foldl (fn ((x, _), fields) =>
adamc@144 694 let
adamc@144 695 val xtsSet' = Option.getOpt (SM.find (fields, x), SS.empty)
adamc@144 696 in
adamc@144 697 SM.insert (fields, x, SS.union (SS.delete (xtsSet, x),
adamc@144 698 xtsSet'))
adamc@144 699 end) fields xts
adamc@144 700 end
adamc@144 701 | _ => raise Fail "CjrPrint: Last argument of action isn't record")
adamc@144 702 SM.empty ps
adamc@144 703
adamc@144 704 val fnums = SM.foldli (fn (x, xs, fnums) =>
adamc@144 705 let
adamc@144 706 val unusable = SS.foldl (fn (x', unusable) =>
adamc@144 707 case SM.find (fnums, x') of
adamc@144 708 NONE => unusable
adamc@144 709 | SOME n => IS.add (unusable, n))
adamc@144 710 IS.empty xs
adamc@144 711
adamc@144 712 fun findAvailable n =
adamc@144 713 if IS.member (unusable, n) then
adamc@144 714 findAvailable (n + 1)
adamc@144 715 else
adamc@144 716 n
adamc@144 717 in
adamc@144 718 SM.insert (fnums, x, findAvailable 0)
adamc@144 719 end)
adamc@144 720 SM.empty fields
adamc@144 721
adamc@144 722 fun makeSwitch (fnums, i) =
adamc@144 723 case SM.foldl (fn (n, NotFound) => Found n
adamc@144 724 | (n, Error) => Error
adamc@144 725 | (n, Found n') => if n = n' then
adamc@144 726 Found n'
adamc@144 727 else
adamc@144 728 Error) NotFound fnums of
adamc@144 729 NotFound => box [string "return",
adamc@144 730 space,
adamc@144 731 string "-1;"]
adamc@144 732 | Found n => box [string "return",
adamc@144 733 space,
adamc@144 734 string (Int.toString n),
adamc@144 735 string ";"]
adamc@144 736 | Error =>
adamc@144 737 let
adamc@144 738 val cmap = SM.foldli (fn (x, n, cmap) =>
adamc@144 739 let
adamc@144 740 val ch = if i < size x then
adamc@144 741 String.sub (x, i)
adamc@144 742 else
adamc@144 743 chr 0
adamc@144 744
adamc@144 745 val fnums = case CM.find (cmap, ch) of
adamc@144 746 NONE => SM.empty
adamc@144 747 | SOME fnums => fnums
adamc@144 748 val fnums = SM.insert (fnums, x, n)
adamc@144 749 in
adamc@144 750 CM.insert (cmap, ch, fnums)
adamc@144 751 end)
adamc@144 752 CM.empty fnums
adamc@144 753
adamc@144 754 val cmap = CM.listItemsi cmap
adamc@144 755 in
adamc@144 756 case cmap of
adamc@144 757 [(_, fnums)] =>
adamc@144 758 box [string "if",
adamc@144 759 space,
adamc@144 760 string "(name[",
adamc@144 761 string (Int.toString i),
adamc@144 762 string "]",
adamc@144 763 space,
adamc@144 764 string "==",
adamc@144 765 space,
adamc@144 766 string "0)",
adamc@144 767 space,
adamc@144 768 string "return",
adamc@144 769 space,
adamc@144 770 string "-1;",
adamc@144 771 newline,
adamc@144 772 makeSwitch (fnums, i+1)]
adamc@144 773 | _ =>
adamc@144 774 box [string "switch",
adamc@144 775 space,
adamc@144 776 string "(name[",
adamc@144 777 string (Int.toString i),
adamc@144 778 string "])",
adamc@144 779 space,
adamc@144 780 string "{",
adamc@144 781 newline,
adamc@144 782 box (map (fn (ch, fnums) =>
adamc@144 783 box [string "case",
adamc@144 784 space,
adamc@144 785 if ch = chr 0 then
adamc@144 786 string "0:"
adamc@144 787 else
adamc@144 788 box [string "'",
adamc@144 789 string (Char.toString ch),
adamc@144 790 string "':"],
adamc@144 791 newline,
adamc@144 792 makeSwitch (fnums, i+1),
adamc@144 793 newline]) cmap),
adamc@144 794 string "default:",
adamc@144 795 newline,
adamc@144 796 string "return",
adamc@144 797 space,
adamc@144 798 string "-1;",
adamc@144 799 newline,
adamc@144 800 string "}"]
adamc@144 801 end
adamc@144 802
adamc@186 803 fun capitalize s =
adamc@186 804 if s = "" then
adamc@186 805 ""
adamc@186 806 else
adamc@186 807 str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
adamc@186 808
adamc@144 809 fun unurlify (t, loc) =
adamc@144 810 case t of
adamc@186 811 TFfi (m, t) => string ("lw_" ^ m ^ "_unurlify" ^ capitalize t ^ "(ctx, &request)")
adamc@144 812
adamc@144 813 | TRecord 0 => string "lw_unit_v"
adamc@144 814 | TRecord i =>
adamc@144 815 let
adamc@144 816 val xts = E.lookupStruct env i
adamc@144 817 in
adamc@144 818 box [string "({",
adamc@144 819 newline,
adamc@144 820 box (map (fn (x, t) =>
adamc@144 821 box [p_typ env t,
adamc@144 822 space,
adamc@144 823 string x,
adamc@144 824 space,
adamc@144 825 string "=",
adamc@144 826 space,
adamc@144 827 unurlify t,
adamc@144 828 string ";",
adamc@144 829 newline]) xts),
adamc@144 830 string "struct",
adamc@144 831 space,
adamc@144 832 string "__lws_",
adamc@144 833 string (Int.toString i),
adamc@144 834 space,
adamc@181 835 string "tmp",
adamc@144 836 space,
adamc@144 837 string "=",
adamc@144 838 space,
adamc@144 839 string "{",
adamc@144 840 space,
adamc@144 841 p_list_sep (box [string ",", space]) (fn (x, _) => string x) xts,
adamc@144 842 space,
adamc@144 843 string "};",
adamc@144 844 newline,
adamc@181 845 string "tmp;",
adamc@144 846 newline,
adamc@144 847 string "})"]
adamc@144 848 end
adamc@144 849
adamc@188 850 | TDatatype (Enum, i, _) =>
adamc@188 851 let
adamc@188 852 val (x, xncs) = E.lookupDatatype env i
adamc@188 853
adamc@188 854 fun doEm xncs =
adamc@188 855 case xncs of
adamc@188 856 [] => string ("(lw_error(ctx, FATAL, \"Error unurlifying datatype " ^ x ^ "\"), (enum __lwe_"
adamc@188 857 ^ x ^ "_" ^ Int.toString i ^ ")0)")
adamc@188 858 | (x', n, to) :: rest =>
adamc@188 859 box [string "((!strncmp(request, \"",
adamc@188 860 string x',
adamc@188 861 string "\", ",
adamc@188 862 string (Int.toString (size x')),
adamc@188 863 string ") && (request[",
adamc@188 864 string (Int.toString (size x')),
adamc@188 865 string "] == 0 || request[",
adamc@188 866 string (Int.toString (size x')),
adamc@188 867 string ("] == '/')) ? __lwc_" ^ x' ^ "_" ^ Int.toString n),
adamc@188 868 space,
adamc@188 869 string ":",
adamc@188 870 space,
adamc@188 871 doEm rest,
adamc@188 872 string ")"]
adamc@188 873 in
adamc@188 874 doEm xncs
adamc@188 875 end
adamc@188 876
adamc@198 877 | TDatatype (Option, i, xncs) =>
adamc@198 878 let
adamc@198 879 val (x, _) = E.lookupDatatype env i
adamc@198 880
adamc@198 881 val (no_arg, has_arg, t) =
adamc@198 882 case !xncs of
adamc@198 883 [(no_arg, _, NONE), (has_arg, _, SOME t)] =>
adamc@198 884 (no_arg, has_arg, t)
adamc@198 885 | [(has_arg, _, SOME t), (no_arg, _, NONE)] =>
adamc@198 886 (no_arg, has_arg, t)
adamc@198 887 | _ => raise Fail "CjrPrint: unfooify misclassified Option datatype"
adamc@198 888 in
adamc@198 889 box [string "(request[0] == '/' ? ++request : request,",
adamc@198 890 newline,
adamc@198 891 string "((!strncmp(request, \"",
adamc@198 892 string no_arg,
adamc@198 893 string "\", ",
adamc@198 894 string (Int.toString (size no_arg)),
adamc@198 895 string ") && (request[",
adamc@198 896 string (Int.toString (size no_arg)),
adamc@198 897 string "] == 0 || request[",
adamc@198 898 string (Int.toString (size no_arg)),
adamc@198 899 string "] == '/')) ? (request",
adamc@198 900 space,
adamc@198 901 string "+=",
adamc@198 902 space,
adamc@198 903 string (Int.toString (size no_arg)),
adamc@198 904 string ", NULL) : ((!strncmp(request, \"",
adamc@198 905 string has_arg,
adamc@198 906 string "\", ",
adamc@198 907 string (Int.toString (size has_arg)),
adamc@198 908 string ") && (request[",
adamc@198 909 string (Int.toString (size has_arg)),
adamc@198 910 string "] == 0 || request[",
adamc@198 911 string (Int.toString (size has_arg)),
adamc@198 912 string "] == '/')) ? (request",
adamc@198 913 space,
adamc@198 914 string "+=",
adamc@198 915 space,
adamc@198 916 string (Int.toString (size has_arg)),
adamc@200 917 string ", (request[0] == '/' ? ++request : NULL), ",
adamc@200 918 newline,
adamc@198 919
adamc@198 920 case #1 t of
adamc@198 921 TDatatype _ => unurlify t
adamc@199 922 | TFfi ("Basis", "string") => unurlify t
adamc@198 923 | _ => box [string "({",
adamc@198 924 newline,
adamc@198 925 p_typ env t,
adamc@198 926 space,
adamc@198 927 string "*tmp",
adamc@198 928 space,
adamc@198 929 string "=",
adamc@198 930 space,
adamc@198 931 string "lw_malloc(ctx, sizeof(",
adamc@198 932 p_typ env t,
adamc@198 933 string "));",
adamc@198 934 newline,
adamc@198 935 string "*tmp",
adamc@198 936 space,
adamc@198 937 string "=",
adamc@198 938 space,
adamc@198 939 unurlify t,
adamc@198 940 string ";",
adamc@198 941 newline,
adamc@198 942 string "tmp;",
adamc@198 943 newline,
adamc@198 944 string "})"],
adamc@198 945 string ")",
adamc@198 946 newline,
adamc@198 947 string ":",
adamc@198 948 space,
adamc@198 949 string ("(lw_error(ctx, FATAL, \"Error unurlifying datatype " ^ x ^ "\"), NULL))))")]
adamc@198 950 end
adamc@198 951
adamc@188 952 | TDatatype (Default, i, _) =>
adamc@166 953 let
adamc@166 954 val (x, xncs) = E.lookupDatatype env i
adamc@166 955
adamc@166 956 fun doEm xncs =
adamc@166 957 case xncs of
adamc@167 958 [] => string ("(lw_error(ctx, FATAL, \"Error unurlifying datatype " ^ x ^ "\"), NULL)")
adamc@167 959 | (x', n, to) :: rest =>
adamc@167 960 box [string "((!strncmp(request, \"",
adamc@167 961 string x',
adamc@167 962 string "\", ",
adamc@167 963 string (Int.toString (size x')),
adamc@167 964 string ") && (request[",
adamc@167 965 string (Int.toString (size x')),
adamc@167 966 string "] == 0 || request[",
adamc@167 967 string (Int.toString (size x')),
adamc@167 968 string "] == '/')) ? ({",
adamc@166 969 newline,
adamc@167 970 string "struct",
adamc@167 971 space,
adamc@166 972 string ("__lwd_" ^ x ^ "_" ^ Int.toString i),
adamc@166 973 space,
adamc@181 974 string "*tmp = lw_malloc(ctx, sizeof(struct __lwd_",
adamc@167 975 string x,
adamc@167 976 string "_",
adamc@167 977 string (Int.toString i),
adamc@167 978 string "));",
adamc@166 979 newline,
adamc@181 980 string "tmp->tag",
adamc@166 981 space,
adamc@166 982 string "=",
adamc@166 983 space,
adamc@167 984 string ("__lwc_" ^ x' ^ "_" ^ Int.toString n),
adamc@166 985 string ";",
adamc@166 986 newline,
adamc@166 987 string "request",
adamc@166 988 space,
adamc@166 989 string "+=",
adamc@166 990 space,
adamc@167 991 string (Int.toString (size x')),
adamc@166 992 string ";",
adamc@166 993 newline,
adamc@200 994 string "if (request[0] == '/') ++request;",
adamc@200 995 newline,
adamc@166 996 case to of
adamc@166 997 NONE => box []
adamc@197 998 | SOME t => box [string "tmp->data.lw_",
adamc@167 999 string x',
adamc@166 1000 space,
adamc@166 1001 string "=",
adamc@166 1002 space,
adamc@166 1003 unurlify t,
adamc@166 1004 string ";",
adamc@166 1005 newline],
adamc@181 1006 string "tmp;",
adamc@166 1007 newline,
adamc@166 1008 string "})",
adamc@166 1009 space,
adamc@166 1010 string ":",
adamc@166 1011 space,
adamc@166 1012 doEm rest,
adamc@166 1013 string ")"]
adamc@166 1014 in
adamc@166 1015 doEm xncs
adamc@166 1016 end
adamc@166 1017
adamc@144 1018 | _ => (ErrorMsg.errorAt loc "Unable to choose a URL decoding function";
adamc@144 1019 space)
adamc@144 1020
adamc@144 1021
adamc@144 1022 fun p_page (ek, s, n, ts) =
adamc@144 1023 let
adamc@144 1024 val (ts, defInputs, inputsVar) =
adamc@144 1025 case ek of
adamc@144 1026 Core.Link => (ts, string "", string "")
adamc@144 1027 | Core.Action =>
adamc@144 1028 case List.last ts of
adamc@144 1029 (TRecord i, _) =>
adamc@144 1030 let
adamc@144 1031 val xts = E.lookupStruct env i
adamc@144 1032 in
adamc@144 1033 (List.drop (ts, 1),
adamc@144 1034 box [box (map (fn (x, t) => box [p_typ env t,
adamc@144 1035 space,
adamc@144 1036 string "lw_input_",
adamc@144 1037 string x,
adamc@144 1038 string ";",
adamc@144 1039 newline]) xts),
adamc@144 1040 newline,
adamc@144 1041 box (map (fn (x, t) =>
adamc@144 1042 let
adamc@144 1043 val n = case SM.find (fnums, x) of
adamc@144 1044 NONE => raise Fail "CjrPrint: Can't find in fnums"
adamc@144 1045 | SOME n => n
adamc@190 1046
adamc@190 1047 val f = case t of
adamc@190 1048 (TFfi ("Basis", "bool"), _) => "optional_"
adamc@190 1049 | _ => ""
adamc@144 1050 in
adamc@190 1051 box [string "request = lw_get_",
adamc@190 1052 string f,
adamc@190 1053 string "input(ctx, ",
adamc@144 1054 string (Int.toString n),
adamc@144 1055 string ");",
adamc@144 1056 newline,
adamc@144 1057 string "if (request == NULL) {",
adamc@144 1058 newline,
adamc@144 1059 box [string "printf(\"Missing input ",
adamc@144 1060 string x,
adamc@144 1061 string "\\n\");",
adamc@144 1062 newline,
adamc@144 1063 string "exit(1);"],
adamc@144 1064 newline,
adamc@144 1065 string "}",
adamc@144 1066 newline,
adamc@144 1067 string "lw_input_",
adamc@144 1068 string x,
adamc@144 1069 space,
adamc@144 1070 string "=",
adamc@144 1071 space,
adamc@144 1072 unurlify t,
adamc@144 1073 string ";",
adamc@144 1074 newline]
adamc@144 1075 end) xts),
adamc@144 1076 string "struct __lws_",
adamc@144 1077 string (Int.toString i),
adamc@144 1078 space,
adamc@144 1079 string "lw_inputs",
adamc@144 1080 space,
adamc@144 1081 string "= {",
adamc@144 1082 newline,
adamc@144 1083 box (map (fn (x, _) => box [string "lw_input_",
adamc@144 1084 string x,
adamc@144 1085 string ",",
adamc@144 1086 newline]) xts),
adamc@144 1087 string "};",
adamc@144 1088 newline],
adamc@144 1089 box [string ",",
adamc@144 1090 space,
adamc@144 1091 string "lw_inputs"])
adamc@144 1092 end
adamc@144 1093
adamc@144 1094 | _ => raise Fail "CjrPrint: Last argument to an action isn't a record"
adamc@144 1095 in
adamc@144 1096 box [string "if (!strncmp(request, \"",
adamc@144 1097 string (String.toString s),
adamc@144 1098 string "\", ",
adamc@144 1099 string (Int.toString (size s)),
adamc@198 1100 string ") && (request[",
adamc@198 1101 string (Int.toString (size s)),
adamc@198 1102 string "] == 0 || request[",
adamc@198 1103 string (Int.toString (size s)),
adamc@198 1104 string "] == '/')) {",
adamc@144 1105 newline,
adamc@144 1106 string "request += ",
adamc@144 1107 string (Int.toString (size s)),
adamc@144 1108 string ";",
adamc@144 1109 newline,
adamc@144 1110 string "if (*request == '/') ++request;",
adamc@144 1111 newline,
adamc@144 1112 box [string "{",
adamc@144 1113 newline,
adamc@144 1114 box (ListUtil.mapi (fn (i, t) => box [p_typ env t,
adamc@144 1115 space,
adamc@144 1116 string "arg",
adamc@144 1117 string (Int.toString i),
adamc@144 1118 space,
adamc@144 1119 string "=",
adamc@144 1120 space,
adamc@144 1121 unurlify t,
adamc@144 1122 string ";",
adamc@144 1123 newline]) ts),
adamc@144 1124 defInputs,
adamc@144 1125 p_enamed env n,
adamc@144 1126 string "(",
adamc@144 1127 p_list_sep (box [string ",", space])
adamc@144 1128 (fn x => x)
adamc@144 1129 (string "ctx" :: ListUtil.mapi (fn (i, _) => string ("arg" ^ Int.toString i)) ts),
adamc@144 1130 inputsVar,
adamc@144 1131 string ");",
adamc@144 1132 newline,
adamc@144 1133 string "return;",
adamc@144 1134 newline,
adamc@144 1135 string "}",
adamc@144 1136 newline,
adamc@144 1137 string "}"]
adamc@144 1138 ]
adamc@144 1139 end
adamc@144 1140
adamc@144 1141 val pds' = map p_page ps
adamc@29 1142 in
adamc@144 1143 box [string "#include <stdio.h>",
adamc@144 1144 newline,
adamc@144 1145 string "#include <stdlib.h>",
adamc@144 1146 newline,
adamc@144 1147 newline,
adamc@144 1148 string "#include \"lacweb.h\"",
adamc@101 1149 newline,
adamc@101 1150 newline,
adamc@101 1151 p_list_sep newline (fn x => x) pds,
adamc@101 1152 newline,
adamc@144 1153 string "int lw_inputs_len = ",
adamc@144 1154 string (Int.toString (SM.foldl Int.max 0 fnums + 1)),
adamc@144 1155 string ";",
adamc@144 1156 newline,
adamc@144 1157 newline,
adamc@144 1158 string "int lw_input_num(char *name) {",
adamc@144 1159 newline,
adamc@144 1160 makeSwitch (fnums, 0),
adamc@144 1161 string "}",
adamc@144 1162 newline,
adamc@144 1163 newline,
adamc@117 1164 string "void lw_handle(lw_context ctx, char *request) {",
adamc@101 1165 newline,
adamc@101 1166 p_list_sep newline (fn x => x) pds',
adamc@101 1167 newline,
adamc@101 1168 string "}",
adamc@101 1169 newline]
adamc@29 1170 end
adamc@29 1171
adamc@29 1172 end