comparison src/monoize.sml @ 1293:acabf3935060

tryDml
author Adam Chlipala <adam@chlipala.net>
date Sun, 05 Sep 2010 14:00:57 -0400
parents a671c986f517
children b4480a56cab7
comparison
equal deleted inserted replaced
1292:a671c986f517 1293:acabf3935060
1746 1746
1747 | L.EFfiApp ("Basis", "dml", [e]) => 1747 | L.EFfiApp ("Basis", "dml", [e]) =>
1748 let 1748 let
1749 val (e, fm) = monoExp (env, st, fm) e 1749 val (e, fm) = monoExp (env, st, fm) e
1750 in 1750 in
1751 ((L'.EDml e, loc), 1751 ((L'.EDml (e, L'.Error), loc),
1752 fm)
1753 end
1754
1755 | L.EFfiApp ("Basis", "tryDml", [e]) =>
1756 let
1757 val (e, fm) = monoExp (env, st, fm) e
1758 in
1759 ((L'.EDml (e, L'.None), loc),
1752 fm) 1760 fm)
1753 end 1761 end
1754 1762
1755 | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "insert"), _), fields), _), _) => 1763 | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "insert"), _), fields), _), _) =>
1756 (case monoType env (L.TRecord fields, loc) of 1764 (case monoType env (L.TRecord fields, loc) of
4012 target), loc) 4020 target), loc)
4013 4021
4014 val e = 4022 val e =
4015 foldl (fn ((x, v), e) => 4023 foldl (fn ((x, v), e) =>
4016 (L'.ESeq ( 4024 (L'.ESeq (
4017 (L'.EDml (L'.EStrcat ( 4025 (L'.EDml ((L'.EStrcat (
4018 (L'.EPrim (Prim.String ("UPDATE uw_" 4026 (L'.EPrim (Prim.String ("UPDATE uw_"
4019 ^ tab 4027 ^ tab
4020 ^ " SET uw_" 4028 ^ " SET uw_"
4021 ^ x 4029 ^ x
4022 ^ " = NULL WHERE ")), loc), 4030 ^ " = NULL WHERE ")), loc),
4023 cond (x, v)), loc), loc), 4031 cond (x, v)), loc), L'.Error), loc),
4024 e), loc)) 4032 e), loc))
4025 e nullable 4033 e nullable
4026 4034
4027 val e = 4035 val e =
4028 case notNullable of 4036 case notNullable of
4037 cond eb), loc)), loc)) 4045 cond eb), loc)), loc))
4038 (L'.EStrcat ((L'.EPrim (Prim.String ("DELETE FROM uw_" 4046 (L'.EStrcat ((L'.EPrim (Prim.String ("DELETE FROM uw_"
4039 ^ tab 4047 ^ tab
4040 ^ " WHERE ")), loc), 4048 ^ " WHERE ")), loc),
4041 cond eb), loc) 4049 cond eb), loc)
4042 ebs), loc), 4050 ebs, L'.Error), loc),
4043 e), loc) 4051 e), loc)
4044 in 4052 in
4045 e 4053 e
4046 end 4054 end
4047 | _ => e 4055 | _ => e
4065 val e = 4073 val e =
4066 case nullable of 4074 case nullable of
4067 [] => e 4075 [] => e
4068 | (x, _) :: ebs => 4076 | (x, _) :: ebs =>
4069 (L'.ESeq ( 4077 (L'.ESeq (
4070 (L'.EDml (L'.EPrim (Prim.String 4078 (L'.EDml ((L'.EPrim (Prim.String
4071 (foldl (fn ((x, _), s) => 4079 (foldl (fn ((x, _), s) =>
4072 s ^ ", uw_" ^ x ^ " = NULL") 4080 s ^ ", uw_" ^ x ^ " = NULL")
4073 ("UPDATE uw_" 4081 ("UPDATE uw_"
4074 ^ tab 4082 ^ tab
4075 ^ " SET uw_" 4083 ^ " SET uw_"
4076 ^ x 4084 ^ x
4077 ^ " = NULL") 4085 ^ " = NULL")
4078 ebs)), loc), loc), 4086 ebs)), loc), L'.Error), loc),
4079 e), loc) 4087 e), loc)
4080 4088
4081 val e = 4089 val e =
4082 case notNullable of 4090 case notNullable of
4083 [] => e 4091 [] => e
4084 | eb :: ebs => 4092 | eb :: ebs =>
4085 (L'.ESeq ( 4093 (L'.ESeq (
4086 (L'.EDml (L'.EPrim (Prim.String ("DELETE FROM uw_" 4094 (L'.EDml ((L'.EPrim (Prim.String ("DELETE FROM uw_"
4087 ^ tab)), loc), loc), 4095 ^ tab)), loc), L'.Error), loc),
4088 e), loc) 4096 e), loc)
4089 in 4097 in
4090 e 4098 e
4091 end 4099 end
4092 | _ => e 4100 | _ => e