Mercurial > urweb
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 |