Mercurial > urweb
comparison src/sqlcache.sml @ 2276:c05f9a5e0f0f
Progress on free paths, but consolidation seems to fail more with them.
author | Ziv Scully <ziv@mit.edu> |
---|---|
date | Mon, 09 Nov 2015 13:37:31 -0500 |
parents | ce96e166d938 |
children | b7615e0ac4b0 |
comparison
equal
deleted
inserted
replaced
2275:ce96e166d938 | 2276:c05f9a5e0f0f |
---|---|
1 structure Sqlcache (* DEBUG :> SQLCACHE *) = struct | 1 structure Sqlcache (* DEBUG :> SQLCACHE *) = struct |
2 | 2 |
3 open Mono | 3 open Mono |
4 | 4 |
5 structure IK = struct type ord_key = int val compare = Int.compare end | |
5 structure IS = IntBinarySet | 6 structure IS = IntBinarySet |
6 structure IM = IntBinaryMap | 7 structure IM = IntBinaryMap |
7 structure SK = struct type ord_key = string val compare = String.compare end | 8 structure SK = struct type ord_key = string val compare = String.compare end |
8 structure SS = BinarySetFn(SK) | 9 structure SS = BinarySetFn(SK) |
9 structure SM = BinaryMapFn(SK) | 10 structure SM = BinaryMapFn(SK) |
328 bind = fn (bound, MonoUtil.Exp.RelE _) => bound + 1 | 329 bind = fn (bound, MonoUtil.Exp.RelE _) => bound + 1 |
329 | (bound, _) => bound} | 330 | (bound, _) => bound} |
330 0 | 331 0 |
331 IS.empty | 332 IS.empty |
332 | 333 |
334 (* A path is a number of field projections of a variable. *) | |
335 structure PK = PairKeyFn(structure I = IK structure J = ListKeyFn(SK)) | |
336 structure PS = BinarySetFn(PK) | |
337 | |
338 (* DEBUG *) | |
339 val gunk3 : (PS.set * PS.set) list ref = ref [] | |
340 val gunk4 : (PS.set * PS.set) list ref = ref [] | |
341 | |
342 val pathOfExp = | |
343 let | |
344 fun readFields acc exp = | |
345 acc | |
346 <\obind\> | |
347 (fn fs => | |
348 case #1 exp of | |
349 ERel n => SOME (n, fs) | |
350 | EField (exp, f) => readFields (SOME (f::fs)) exp | |
351 | _ => NONE) | |
352 in | |
353 readFields (SOME []) | |
354 end | |
355 | |
356 fun expOfPath (n, fs) = | |
357 List.foldl (fn (f, exp) => (EField (exp, f), dummyLoc)) (ERel n, dummyLoc) fs | |
358 | |
359 fun freePaths'' bound exp paths = | |
360 case pathOfExp (exp, dummyLoc) of | |
361 NONE => paths | |
362 | SOME (n, fs) => if n < bound then paths else PS.add (paths, (n - bound, fs)) | |
363 | |
364 (* ASK: nicer way? :( *) | |
365 fun freePaths' bound exp = | |
366 case #1 exp of | |
367 EPrim _ => id | |
368 | e as ERel _ => freePaths'' bound e | |
369 | ENamed _ => id | |
370 | ECon (_, _, data) => (case data of NONE => id | SOME e => freePaths' bound e) | |
371 | ENone _ => id | |
372 | ESome (_, e) => freePaths' bound e | |
373 | EFfi _ => id | |
374 | EFfiApp (_, _, args) => | |
375 List.foldl (fn ((e, _), acc) => freePaths' bound e o acc) id args | |
376 | EApp (e1, e2) => freePaths' bound e1 o freePaths' bound e2 | |
377 | EAbs (_, _, _, e) => freePaths' (bound + 1) e | |
378 | EUnop (_, e) => freePaths' bound e | |
379 | EBinop (_, _, e1, e2) => freePaths' bound e1 o freePaths' bound e2 | |
380 | ERecord fields => List.foldl (fn ((_, e, _), acc) => freePaths' bound e o acc) id fields | |
381 | e as EField _ => freePaths'' bound e | |
382 | ECase (e, cases, _) => | |
383 List.foldl (fn ((p, e), acc) => freePaths' (bound + MonoEnv.patBindsN p) e o acc) | |
384 (freePaths' bound e) | |
385 cases | |
386 | EStrcat (e1, e2) => freePaths' bound e1 o freePaths' bound e2 | |
387 | EError (e, _) => freePaths' bound e | |
388 | EReturnBlob {blob, mimeType = e, ...} => | |
389 freePaths' bound e o (case blob of NONE => id | SOME e => freePaths' bound e) | |
390 | ERedirect (e, _) => freePaths' bound e | |
391 | EWrite e => freePaths' bound e | |
392 | ESeq (e1, e2) => freePaths' bound e1 o freePaths' bound e2 | |
393 | ELet (_, _, e1, e2) => freePaths' (bound + 1) e1 o freePaths' bound e2 | |
394 | EClosure (_, es) => List.foldl (fn (e, acc) => freePaths' bound e o acc) id es | |
395 | EQuery {query = e1, body = e2, initial = e3, ...} => | |
396 freePaths' bound e1 o freePaths' (bound + 2) e2 o freePaths' bound e3 | |
397 | EDml (e, _) => freePaths' bound e | |
398 | ENextval e => freePaths' bound e | |
399 | ESetval (e1, e2) => freePaths' bound e1 o freePaths' bound e2 | |
400 | EUnurlify (e, _, _) => freePaths' bound e | |
401 | EJavaScript (_, e) => freePaths' bound e | |
402 | ESignalReturn e => freePaths' bound e | |
403 | ESignalBind (e1, e2) => freePaths' bound e1 o freePaths' bound e2 | |
404 | ESignalSource e => freePaths' bound e | |
405 | EServerCall (e, _, _, _) => freePaths' bound e | |
406 | ERecv (e, _) => freePaths' bound e | |
407 | ESleep e => freePaths' bound e | |
408 | ESpawn e => freePaths' bound e | |
409 | |
410 fun freePaths exp = freePaths' 0 exp PS.empty | |
411 | |
333 datatype unbind = Known of exp | Unknowns of int | 412 datatype unbind = Known of exp | Unknowns of int |
334 | 413 |
335 datatype cacheArg = AsIs of exp | Urlify of exp | 414 datatype cacheArg = AsIs of exp | Urlify of exp |
336 | 415 |
337 structure InvalInfo :> sig | 416 structure InvalInfo (* DEBUG :> sig |
338 type t | 417 type t |
339 type state = {tableToIndices : SIMM.multimap, | 418 type state = {tableToIndices : SIMM.multimap, |
340 indexToInvalInfo : (t * int) IntBinaryMap.map, | 419 indexToInvalInfo : (t * int) IntBinaryMap.map, |
341 ffiInfo : {index : int, params : int} list, | 420 ffiInfo : {index : int, params : int} list, |
342 index : int} | 421 index : int} |
345 val query : t -> Sql.query | 424 val query : t -> Sql.query |
346 val orderArgs : t * IS.set -> cacheArg list | 425 val orderArgs : t * IS.set -> cacheArg list |
347 val unbind : t * unbind -> t option | 426 val unbind : t * unbind -> t option |
348 val union : t * t -> t | 427 val union : t * t -> t |
349 val updateState : t * int * state -> state | 428 val updateState : t * int * state -> state |
350 end = struct | 429 end *) = struct |
351 | 430 |
352 datatype sqlArg = FreeVar of int | Sqlify of string * string * sqlArg * typ | 431 (* Variable, field projections, possible wrapped sqlification FFI call. *) |
432 type sqlArg = int * string list * (string * string * typ) option | |
353 | 433 |
354 type subst = sqlArg IM.map | 434 type subst = sqlArg IM.map |
355 | 435 |
356 (* TODO: store free variables as well? *) | 436 (* TODO: store free variables as well? *) |
357 type t = (Sql.query * subst) list | 437 type t = (Sql.query * subst) list |
359 type state = {tableToIndices : SIMM.multimap, | 439 type state = {tableToIndices : SIMM.multimap, |
360 indexToInvalInfo : (t * int) IntBinaryMap.map, | 440 indexToInvalInfo : (t * int) IntBinaryMap.map, |
361 ffiInfo : {index : int, params : int} list, | 441 ffiInfo : {index : int, params : int} list, |
362 index : int} | 442 index : int} |
363 | 443 |
364 structure AM = BinaryMapFn(struct | 444 structure AK = TripleKeyFn( |
365 type ord_key = sqlArg | 445 structure I = IK |
366 (* Saw this on MLton wiki. *) | 446 structure J = ListKeyFn(SK) |
367 fun ifNotEq (cmp, thunk) = case cmp of | 447 structure K = OptionKeyFn(TripleKeyFn( |
368 EQUAL => thunk () | 448 structure I = SK |
369 | _ => cmp | 449 structure J = SK |
370 fun try f x () = f x | 450 structure K = struct type ord_key = Mono.typ val compare = MonoUtil.Typ.compare end))) |
371 val rec compare = | 451 structure AM = BinaryMapFn(AK) |
372 fn (FreeVar n1, FreeVar n2) => | |
373 Int.compare (n1, n2) | |
374 | (FreeVar _, _) => LESS | |
375 | (_, FreeVar _) => GREATER | |
376 | (Sqlify (m1, x1, arg1, t1), Sqlify (m2, x2, arg2, t2)) => | |
377 String.compare (m1, m2) | |
378 <\ifNotEq\> try String.compare (x1, x2) | |
379 <\ifNotEq\> try MonoUtil.Typ.compare (t1, t2) | |
380 <\ifNotEq\> try compare (arg1, arg2) | |
381 end) | |
382 | 452 |
383 (* Traversal Utilities *) | 453 (* Traversal Utilities *) |
384 (* TODO: get rid of unused ones. *) | 454 (* TODO: get rid of unused ones. *) |
385 | 455 |
386 (* Need lift', etc. because we don't have rank-2 polymorphism. This should | 456 (* Need lift', etc. because we don't have rank-2 polymorphism. This should |
421 IM.foldli (fn (k, v, acc) => lift2 (fn (acc, w) => IM.insert (acc, k, w)) (acc, f (k,v))) | 491 IM.foldli (fn (k, v, acc) => lift2 (fn (acc, w) => IM.insert (acc, k, w)) (acc, f (k,v))) |
422 (pure IM.empty) | 492 (pure IM.empty) |
423 | 493 |
424 fun traverseSubst (ops as (_, pure', lift, _, _, _, lift2')) f = | 494 fun traverseSubst (ops as (_, pure', lift, _, _, _, lift2')) f = |
425 let | 495 let |
426 val rec mp = | 496 fun mp (n, fields, sqlify) = |
427 fn FreeVar n => f n | 497 lift (fn (n', fields', sqlify') => |
428 | Sqlify (m, x, arg, t) => lift (fn mparg => Sqlify (m, x, mparg, t)) (mp arg) | 498 let |
499 fun wrap sq = (n', fields' @ fields, sq) | |
500 in | |
501 case (fields', sqlify', fields, sqlify) of | |
502 (_, NONE, _, NONE) => wrap NONE | |
503 | (_, NONE, _, sq as SOME _) => wrap sq | |
504 (* Last case should suffice because we don't | |
505 project from a sqlified value (which is a | |
506 string). *) | |
507 | (_, sq as SOME _, [], NONE) => wrap sq | |
508 | _ => raise Match | |
509 end) | |
510 (f n) | |
429 in | 511 in |
430 traverseIM ops (fn (_, v) => mp v) | 512 traverseIM ops (fn (_, v) => mp v) |
431 end | 513 end |
432 | 514 |
433 fun monoidOps plus zero = (fn _ => zero, fn _ => zero, | 515 fun monoidOps plus zero = (fn _ => zero, fn _ => zero, |
445 | 527 |
446 val varsOfQuery = foldMapQuery IS.union | 528 val varsOfQuery = foldMapQuery IS.union |
447 IS.empty | 529 IS.empty |
448 (fn e' => freeVars (e', dummyLoc)) | 530 (fn e' => freeVars (e', dummyLoc)) |
449 | 531 |
450 val varsOfSubst = foldMapSubst IS.union IS.empty IS.singleton | 532 fun varsOfSubst subst = foldMapSubst IS.union IS.empty IS.singleton subst |
451 | 533 |
452 val varsOfList = | 534 val varsOfList = |
453 fn [] => IS.empty | 535 fn [] => IS.empty |
454 | (q::qs) => varsOfQuery (List.foldl Sql.Union q qs) | 536 | (q::qs) => varsOfQuery (List.foldl Sql.Union q qs) |
455 | 537 |
456 (* Signature Implementation *) | 538 (* Signature Implementation *) |
457 | 539 |
458 val empty = [] | 540 val empty = [] |
459 | 541 |
460 fun singleton q = [(q, IS.foldl (fn (n, acc) => IM.insert (acc, n, FreeVar n)) | 542 fun singleton q = [(q, IS.foldl (fn (n, acc) => IM.insert (acc, n, (n, [], NONE))) |
461 IM.empty | 543 IM.empty |
462 (varsOfQuery q))] | 544 (varsOfQuery q))] |
463 | 545 |
464 val union = op@ | 546 val union = op@ |
465 | 547 |
475 in | 557 in |
476 (* Maps each arg to a different consecutive integer, starting from 0. *) | 558 (* Maps each arg to a different consecutive integer, starting from 0. *) |
477 AM.map count args | 559 AM.map count args |
478 end | 560 end |
479 | 561 |
480 val rec expOfArg = | 562 fun expOfArg (n, fields, sqlify) = |
481 fn FreeVar n => (ERel n, dummyLoc) | 563 let |
482 | Sqlify (m, x, arg, t) => (EFfiApp (m, x, [(expOfArg arg, t)]), dummyLoc) | 564 val exp = List.foldl (fn (field, exp) => (EField (exp, field), dummyLoc)) |
483 | 565 (ERel n, dummyLoc) |
484 fun orderArgs (qs : t, vars) = | 566 fields |
567 in | |
568 case sqlify of | |
569 NONE => exp | |
570 | SOME (m, x, typ) => (EFfiApp (m, x, [(exp, typ)]), dummyLoc) | |
571 end | |
572 | |
573 fun orderArgs (qs : t, paths) = | |
485 let | 574 let |
486 fun erel n = (ERel n, dummyLoc) | 575 fun erel n = (ERel n, dummyLoc) |
487 val argsMap = sqlArgsMap qs | 576 val argsMap = sqlArgsMap qs |
488 val args = map (expOfArg o #1) (AM.listItemsi argsMap) | 577 val args = map (expOfArg o #1) (AM.listItemsi argsMap) |
489 val invalVars = List.foldl IS.union IS.empty (map freeVars args) | 578 val invalPaths = List.foldl PS.union PS.empty (map freePaths args) |
579 (* DEBUG *) | |
580 val () = gunk3 := (paths, invalPaths) :: !gunk3 | |
490 in | 581 in |
491 (* Put arguments we might invalidate by first. *) | 582 (* Put arguments we might invalidate by first. *) |
492 map AsIs args | 583 map AsIs args |
493 (* TODO: make sure these variables are okay to remove from the argument list. *) | 584 (* TODO: make sure these variables are okay to remove from the argument list. *) |
494 @ map (Urlify o erel) (IS.listItems (IS.difference (vars, invalVars))) | 585 @ map (Urlify o expOfPath) (PS.listItems (PS.difference (paths, invalPaths))) |
495 end | 586 end |
496 | 587 |
497 (* As a kludge, we rename the variables in the query to correspond to the | 588 (* As a kludge, we rename the variables in the query to correspond to the |
498 argument of the cache they're part of. *) | 589 argument of the cache they're part of. *) |
499 fun query (qs : t) = | 590 fun query (qs : t) = |
525 (* We should never reach this case because [updateState] won't | 616 (* We should never reach this case because [updateState] won't |
526 put anything in the state if there are no queries. *) | 617 put anything in the state if there are no queries. *) |
527 | [] => raise Match | 618 | [] => raise Match |
528 end | 619 end |
529 | 620 |
530 val rec argOfExp = | 621 val argOfExp = |
531 fn (ERel n, _) => SOME (FreeVar n) | 622 let |
532 | (EFfiApp ("Basis", x, [(exp, t)]), _) => | 623 fun doFields acc exp = |
533 if String.isPrefix "sqlify" x | 624 acc |
534 then omap (fn arg => Sqlify ("Basis", x, arg, t)) (argOfExp exp) | 625 <\obind\> |
535 else NONE | 626 (fn (fs, sqlify) => |
536 | _ => NONE | 627 case #1 exp of |
628 ERel n => SOME (n, fs, sqlify) | |
629 | EField (exp, f) => doFields (SOME (f::fs, sqlify)) exp | |
630 | _ => NONE) | |
631 in | |
632 fn (EFfiApp ("Basis", x, [(exp, typ)]), _) => | |
633 if String.isPrefix "sqlify" x | |
634 then doFields (SOME ([], SOME ("Basis", x, typ))) exp | |
635 else NONE | |
636 | exp => doFields (SOME ([], NONE)) exp | |
637 end | |
537 | 638 |
538 val unbind1 = | 639 val unbind1 = |
539 fn Known e => | 640 fn Known e => |
540 let | 641 let |
541 val replacement = argOfExp e | 642 val replacement = argOfExp e |
542 in | 643 in |
543 omapSubst (fn 0 => replacement | 644 omapSubst (fn 0 => replacement |
544 | n => SOME (FreeVar (n-1))) | 645 | n => SOME (n-1, [], NONE)) |
545 end | 646 end |
546 | Unknowns k => omapSubst (fn n => if n >= k then NONE else SOME (FreeVar (n-k))) | 647 | Unknowns k => omapSubst (fn n => if n < k then NONE else SOME (n-k, [], NONE)) |
547 | 648 |
548 fun unbind (qs, ub) = | 649 fun unbind (qs, ub) = |
549 case ub of | 650 case ub of |
550 (* Shortcut if nothing's changing. *) | 651 (* Shortcut if nothing's changing. *) |
551 Unknowns 0 => SOME qs | 652 Unknowns 0 => SOME qs |
645 fun fVals marks = valsToFormula marks (table, vals) | 746 fun fVals marks = valsToFormula marks (table, vals) |
646 val modifiedFields = SS.addList (SS.empty, map #1 vals) | 747 val modifiedFields = SS.addList (SS.empty, map #1 vals) |
647 (* TODO: don't use field name hack. *) | 748 (* TODO: don't use field name hack. *) |
648 val markFields = | 749 val markFields = |
649 mapSqexpFields (fn (t, v) => if t = table andalso SS.member (modifiedFields, v) | 750 mapSqexpFields (fn (t, v) => if t = table andalso SS.member (modifiedFields, v) |
650 then ((* DEBUG *) print ("yep" ^ Int.toString (length (!gunk0))); | 751 then Sql.Field (t, v ^ "'") |
651 Sql.Field (t, v ^ "'")) | 752 else Sql.Field (t, v)) |
652 else ((* DEBUG *) print (table ^ " " ^ t ^ "\n"); Sql.Field (t, v))) | |
653 val mark = mapFormulaExps markFields | 753 val mark = mapFormulaExps markFields |
654 in | 754 in |
655 ((Combo (Disj, [Combo (Conj, [fVals (id, markFields), mark fWhere]), | 755 ((Combo (Disj, [Combo (Conj, [fVals (id, markFields), mark fWhere]), |
656 Combo (Conj, [fVals (markFields, id), fWhere])])), | 756 Combo (Conj, [fVals (markFields, id), fWhere])])), |
657 SOME markFields) | 757 SOME markFields) |
658 end | 758 end |
659 | 759 |
660 fun pairToFormulas (query, dml) = | 760 fun pairToFormulas (query, dml) = |
661 let | 761 let |
662 val (fDml, marker) = ((* DEBUG *) print "dml\n"; dmlToFormulaMarker dml) | 762 val (fDml, marker) = dmlToFormulaMarker dml |
663 in | 763 in |
664 (* DEBUG *) print "query\n"; | |
665 (queryToFormula marker query, fDml) | 764 (queryToFormula marker query, fDml) |
666 end | 765 end |
667 | 766 |
668 structure ConflictMaps = struct | 767 structure ConflictMaps = struct |
669 | 768 |
991 | ESeq (_, e) => typOfExp env e | 1090 | ESeq (_, e) => typOfExp env e |
992 | ELet (s, t, e1, e2) => typOfExp (MonoEnv.pushERel env s t (SOME e1)) e2 | 1091 | ELet (s, t, e1, e2) => typOfExp (MonoEnv.pushERel env s t (SOME e1)) e2 |
993 | EClosure _ => NONE | 1092 | EClosure _ => NONE |
994 | EUnurlify (_, t, _) => SOME t | 1093 | EUnurlify (_, t, _) => SOME t |
995 | EQuery {state, ...} => SOME state | 1094 | EQuery {state, ...} => SOME state |
996 | _ => NONE | 1095 | e => NONE |
997 | 1096 |
998 and typOfExp env (e', loc) = typOfExp' env e' | 1097 and typOfExp env (e', loc) = typOfExp' env e' |
999 | 1098 |
1000 | 1099 |
1001 (***********) | 1100 (***********) |
1002 (* Caching *) | 1101 (* Caching *) |
1003 (***********) | 1102 (***********) |
1004 | |
1005 (* | |
1006 | |
1007 To get the invalidations for a dml, we need (each <- is list-monad-y): | |
1008 * table <- dml | |
1009 * cache <- table | |
1010 * query <- cache | |
1011 * inval <- (query, dml), | |
1012 where inval is a list of query argument indices, so | |
1013 * way to change query args in inval to cache args. | |
1014 For now, the last one is just | |
1015 * a map from query arg number to the corresponding free variable (per query) | |
1016 * a map from free variable to cache arg number (per cache). | |
1017 Both queries and caches should have IDs. | |
1018 | |
1019 *) | |
1020 | 1103 |
1021 type state = InvalInfo.state | 1104 type state = InvalInfo.state |
1022 | 1105 |
1023 datatype subexp = Cachable of InvalInfo.t * (state -> exp * state) | Impure of exp | 1106 datatype subexp = Cachable of InvalInfo.t * (state -> exp * state) | Impure of exp |
1024 | 1107 |
1060 end | 1143 end |
1061 | 1144 |
1062 val expSize = MonoUtil.Exp.fold {typ = #2, exp = fn (_, n) => n+1} 0 | 1145 val expSize = MonoUtil.Exp.fold {typ = #2, exp = fn (_, n) => n+1} 0 |
1063 | 1146 |
1064 (* TODO: pick a number. *) | 1147 (* TODO: pick a number. *) |
1065 val sizeWorthCaching = 5 | 1148 val sizeWorthCaching = ~1 |
1066 | 1149 |
1067 val worthCaching = | 1150 val worthCaching = |
1068 fn EQuery _ => true | 1151 fn EQuery _ => true |
1069 | exp' => expSize (exp', dummyLoc) > sizeWorthCaching | 1152 | exp' => expSize (exp', dummyLoc) > sizeWorthCaching |
1070 | 1153 |
1072 case worthCaching exp' <\oguard\> typOfExp' env exp' of | 1155 case worthCaching exp' <\oguard\> typOfExp' env exp' of |
1073 NONE => NONE | 1156 NONE => NONE |
1074 | SOME (TFun _, _) => NONE | 1157 | SOME (TFun _, _) => NONE |
1075 | SOME typ => | 1158 | SOME typ => |
1076 let | 1159 let |
1077 val args = InvalInfo.orderArgs (invalInfo, freeVars (exp', dummyLoc)) | 1160 val args = InvalInfo.orderArgs (invalInfo, freePaths (exp', dummyLoc)) |
1078 val numArgs = length args | 1161 val numArgs = length args |
1079 in (List.foldr (fn (arg, acc) => | 1162 in (List.foldr (fn (arg, acc) => |
1080 acc | 1163 acc |
1081 <\obind\> | 1164 <\obind\> |
1082 (fn args' => | 1165 (fn args' => |
1133 case attempt of | 1216 case attempt of |
1134 NONE => Impure (EQuery q, dummyLoc) | 1217 NONE => Impure (EQuery q, dummyLoc) |
1135 | SOME subexp => subexp | 1218 | SOME subexp => subexp |
1136 end | 1219 end |
1137 | 1220 |
1138 fun cacheTree (effs : IS.set) ((env, exp as (exp', loc)), state) = | 1221 (* DEBUG *) |
1222 (* fun cacheTree (effs : IS.set) ((env, exp as (exp', loc)), state) = *) | |
1223 (* (Print.preface ("cacheTree> ", MonoPrint.p_exp MonoEnv.empty exp); *) | |
1224 (* cacheTree' effs ((env, exp), state)) *) | |
1225 | |
1226 and cacheTree (effs : IS.set) ((env, exp as (exp', loc)), state) = | |
1139 let | 1227 let |
1140 fun wrapBindN (f : exp list -> exp') | 1228 fun wrapBindN (f : exp list -> exp') |
1141 (args : ((MonoEnv.env * exp) * unbind) list) = | 1229 (args : ((MonoEnv.env * exp) * unbind) list) = |
1142 let | 1230 let |
1143 val (subexps, state) = | 1231 val (subexps, state) = |
1298 val doExp = | 1386 val doExp = |
1299 fn dmlExp as EDml (dmlText, failureMode) => | 1387 fn dmlExp as EDml (dmlText, failureMode) => |
1300 let | 1388 let |
1301 (* DEBUG *) | 1389 (* DEBUG *) |
1302 (* val () = gunk2 := dmlText :: !gunk2 *) | 1390 (* val () = gunk2 := dmlText :: !gunk2 *) |
1303 (* val () = Print.preface ("SQLCACHE: ", (MonoPrint.p_exp MonoEnv.empty origDmlText)) *) | 1391 (* val () = Print.preface ("sqlcache> ", (MonoPrint.p_exp MonoEnv.empty origDmlText)) *) |
1304 val inval = | 1392 val inval = |
1305 case Sql.parse Sql.dml dmlText of | 1393 case Sql.parse Sql.dml dmlText of |
1306 SOME dmlParsed => | 1394 SOME dmlParsed => |
1307 SOME (map (fn i => (case IM.find (indexToInvalInfo, i) of | 1395 SOME (map (fn i => (case IM.find (indexToInvalInfo, i) of |
1308 SOME invalInfo => | 1396 SOME invalInfo => |