Mercurial > urweb

comparison src/cjr_print.sml @ 2230:a749acc51ae4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Factor out cache implementation from Sqlcache.
author Ziv Scully <ziv@mit.edu>
date Wed, 06 May 2015 14:50:29 -0400
parents e10881cd92da
children af1585e7d645
comparison
equal deleted inserted replaced
2229:54884b28b6c6 2230:a749acc51ae4
3402 string "static int uw_db_rollback(uw_context ctx) { return 0; };"], 3402 string "static int uw_db_rollback(uw_context ctx) { return 0; };"],
3403 newline, 3403 newline,
3404 newline, 3404 newline,
3405 3405
3406 (* For sqlcache. *) 3406 (* For sqlcache. *)
3407 box (List.map 3407 box (List.map ToyCache.setupQuery (Sqlcache.getFfiInfo ())),
3408 (fn {index, params} =>
3409 let val i = Int.toString index
3410 fun paramRepeat itemi sep =
3411 let
3412 fun f n =
3413 if n < 0 then ""
3414 else if n = 0 then itemi (Int.toString 0)
3415 else f (n-1) ^ sep ^ itemi (Int.toString n)
3416 in
3417 f (params - 1)
3418 end
3419 fun paramRepeatInit itemi sep =
3420 if params = 0 then "" else sep ^ paramRepeat itemi sep
3421 val args = paramRepeatInit (fn p => "uw_Basis_string p" ^ p) ", "
3422 val decls = paramRepeat (fn p => "uw_Basis_string param" ^ i ^ "_"
3423 ^ p ^ " = NULL;")
3424 "\n"
3425 val sets = paramRepeat (fn p => "param" ^ i ^ "_" ^ p
3426 ^ " = strdup(p" ^ p ^ ");")
3427 "\n"
3428 val frees = paramRepeat (fn p => "free(param" ^ i ^ "_" ^ p ^ ");")
3429 "\n"
3430 val eqs = paramRepeatInit (fn p => "strcmp(param" ^ i ^ "_" ^ p
3431 ^ ", p" ^ p ^ ")")
3432 " || "
3433 (* Using [!=] instead of [==] to mimic [strcmp]. *)
3434 val eqsNull = paramRepeatInit (fn p => "(p" ^ p ^ " == NULL || "
3435 ^ "!strcmp(param" ^ i ^ "_"
3436 ^ p ^ ", p" ^ p ^ "))")
3437 " && "
3438 in box [string "static char *cacheQuery",
3439 string i,
3440 string " = NULL;",
3441 newline,
3442 string "static char *cacheWrite",
3443 string i,
3444 string " = NULL;",
3445 newline,
3446 string decls,
3447 newline,
3448 string "static uw_Basis_string uw_Sqlcache_check",
3449 string i,
3450 string "(uw_context ctx",
3451 string args,
3452 string ") {\n if (cacheQuery",
3453 string i,
3454 (* ASK: is returning the pointer okay? Should we duplicate? *)
3455 string " == NULL",
3456 string eqs,
3457 string ") {\n puts(\"SQLCACHE: miss ",
3458 string i,
3459 string ".\");\n uw_recordingStart(ctx);\n return NULL;\n } else {\n puts(\"SQLCACHE: hit ",
3460 string i,
3461 string ".\");\n uw_write(ctx, cacheWrite",
3462 string i,
3463 string ");\n return cacheQuery",
3464 string i,
3465 string ";\n } };",
3466 newline,
3467 string "static uw_unit uw_Sqlcache_store",
3468 string i,
3469 string "(uw_context ctx, uw_Basis_string s",
3470 string args,
3471 string ") {\n free(cacheQuery",
3472 string i,
3473 string "); free(cacheWrite",
3474 string i,
3475 string ");",
3476 newline,
3477 string frees,
3478 newline,
3479 string "cacheQuery",
3480 string i,
3481 string " = strdup(s); cacheWrite",
3482 string i,
3483 string " = uw_recordingRead(ctx);",
3484 newline,
3485 string sets,
3486 newline,
3487 string "puts(\"SQLCACHE: store ",
3488 string i,
3489 string ".\");\n return uw_unit_v;\n };",
3490 newline,
3491 string "static uw_unit uw_Sqlcache_flush",
3492 string i,
3493 string "(uw_context ctx",
3494 string args,
3495 string ") {\n if (cacheQuery",
3496 string i,
3497 string " != NULL",
3498 string eqsNull,
3499 string ") {\n free(cacheQuery",
3500 string i,
3501 string ");\n cacheQuery",
3502 string i,
3503 string " = NULL;\n puts(\"SQLCACHE: flush ",
3504 string i,
3505 string ".\");}\n else { puts(\"SQLCACHE: keep ",
3506 string i,
3507 string ".\"); } return uw_unit_v;\n };",
3508 newline,
3509 newline]
3510 end)
3511 (Sqlcache.getFfiInfo ())),
3512 newline, 3408 newline,
3513 3409
3514 p_list_sep newline (fn x => x) pds, 3410 p_list_sep newline (fn x => x) pds,
3515 newline, 3411 newline,
3516 newline, 3412 newline,