Mercurial > urweb

comparison src/mono_opt.sml @ 874:3c7b48040dcf

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
MySQL demo/sql succeeds in reading no rows
author Adam Chlipala <adamc@hcoop.net>
date Sun, 12 Jul 2009 15:05:40 -0400
parents 493f44759879
children dae141d911d9
comparison
equal deleted inserted replaced
873:41971801b62d 874:3c7b48040dcf
81 str ch 81 str ch
82 else 82 else
83 "%" ^ hexIt ch) 83 "%" ^ hexIt ch)
84 84
85 85
86 fun sqlifyInt n = attrifyInt n ^ "::int8" 86 fun sqlifyInt n = attrifyInt n ^ "::" ^ #p_sql_type (Settings.currentDbms ()) Settings.Int
87 fun sqlifyFloat n = attrifyFloat n ^ "::float8" 87 fun sqlifyFloat n = attrifyFloat n ^ "::" ^ #p_sql_type (Settings.currentDbms ()) Settings.Float
88 88
89 fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'" 89 fun sqlifyString s = #sqlifyString (Settings.currentDbms ()) s
90 | #"\\" => "\\\\" 90
91 | ch => 91 fun unAs s =
92 if Char.isPrint ch then 92 let
93 str ch 93 fun doChars (cs, acc) =
94 else 94 case cs of
95 "\\" ^ StringCvt.padLeft #"0" 3 95 #"T" :: #"." :: cs => doChars (cs, acc)
96 (Int.fmt StringCvt.OCT (ord ch))) 96 | #"'" :: cs => doString (cs, acc)
97 (String.toString s) ^ "'::text" 97 | ch :: cs => doChars (cs, ch :: acc)
98 | [] => String.implode (rev acc)
99
100 and doString (cs, acc) =
101 case cs of
102 #"\\" :: #"\\" :: cs => doString (cs, #"\\" :: #"\\" :: acc)
103 | #"\\" :: #"'" :: cs => doString (cs, #"'" :: #"\\" :: acc)
104 | #"'" :: cs => doChars (cs, #"'" :: acc)
105 | ch :: cs => doString (cs, ch :: acc)
106 | [] => String.implode (rev acc)
107 in
108 doChars (String.explode s, [])
109 end
98 110
99 fun exp e = 111 fun exp e =
100 case e of 112 case e of
101 EPrim (Prim.String s) => 113 EPrim (Prim.String s) =>
102 let 114 let
440 val s = uwify (String.explode s, []) 452 val s = uwify (String.explode s, [])
441 in 453 in
442 EPrim (Prim.String s) 454 EPrim (Prim.String s)
443 end 455 end
444 456
457 | EFfiApp ("Basis", "unAs", [(EPrim (Prim.String s), _)]) =>
458 EPrim (Prim.String (unAs s))
459 | EFfiApp ("Basis", "unAs", [e']) =>
460 let
461 fun parts (e as (_, loc)) =
462 case #1 e of
463 EStrcat (s1, s2) =>
464 (case (parts s1, parts s2) of
465 (SOME p1, SOME p2) => SOME (p1 @ p2)
466 | _ => NONE)
467 | EPrim (Prim.String s) => SOME [(EPrim (Prim.String (unAs s)), loc)]
468 | EFfiApp ("Basis", f, [_]) =>
469 if String.isPrefix "sqlify" f then
470 SOME [e]
471 else
472 NONE
473 | _ => NONE
474 in
475 case parts e' of
476 SOME [e] => #1 e
477 | SOME es =>
478 (case rev es of
479 (e as (_, loc)) :: es => #1 (foldl (fn (e, es) => (EStrcat (e, es), loc)) e es)
480 | [] => raise Fail "MonoOpt impossible nil")
481 | NONE => e
482 end
483
445 | _ => e 484 | _ => e
446 485
447 and optExp e = #1 (U.Exp.map {typ = typ, exp = exp} e) 486 and optExp e = #1 (U.Exp.map {typ = typ, exp = exp} e)
448 487
449 val optimize = U.File.map {typ = typ, exp = exp, decl = decl} 488 val optimize = U.File.map {typ = typ, exp = exp, decl = decl}