Mercurial > urweb

comparison src/iflow.sml @ 1663:0577be31a435

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
First part of changes to avoid depending on C function call argument order of evaluation (omitting normal Ur function calls, so far)
author Adam Chlipala <adam@chlipala.net>
date Sat, 07 Jan 2012 15:56:22 -0500
parents 02fc16faecf3
children cb0f05bdc183
comparison
equal deleted inserted replaced
1662:edf86cef0dba 1663:0577be31a435
1042 Exp (EFfi ("Basis", "sql_known"), _) :: chs => SOME ((), chs) 1042 Exp (EFfi ("Basis", "sql_known"), _) :: chs => SOME ((), chs)
1043 | _ => NONE 1043 | _ => NONE
1044 1044
1045 fun sqlify chs = 1045 fun sqlify chs =
1046 case chs of 1046 case chs of
1047 Exp (EFfiApp ("Basis", f, [e]), _) :: chs => 1047 Exp (EFfiApp ("Basis", f, [(e, _)]), _) :: chs =>
1048 if String.isPrefix "sqlify" f then 1048 if String.isPrefix "sqlify" f then
1049 SOME (e, chs) 1049 SOME (e, chs)
1050 else 1050 else
1051 NONE 1051 NONE
1052 | Exp (ECase (e, [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, NONE), _), 1052 | Exp (ECase (e, [((PCon (_, PConFfi {mod = "Basis", con = "True", ...}, NONE), _),
1857 fun doArgs es = 1857 fun doArgs es =
1858 case es of 1858 case es of
1859 [] => 1859 [] =>
1860 (if s = "set_cookie" then 1860 (if s = "set_cookie" then
1861 case es of 1861 case es of
1862 [_, cname, _, _, _] => 1862 [_, (cname, _), _, _, _] =>
1863 (case #1 cname of 1863 (case #1 cname of
1864 EPrim (Prim.String cname) => 1864 EPrim (Prim.String cname) =>
1865 St.havocCookie cname 1865 St.havocCookie cname
1866 | _ => ()) 1866 | _ => ())
1867 | _ => () 1867 | _ => ()
1868 else 1868 else
1869 (); 1869 ();
1870 k (Recd [])) 1870 k (Recd []))
1871 | e :: es => 1871 | (e, _) :: es =>
1872 evalExp env e (fn e => (St.send (e, loc); doArgs es)) 1872 evalExp env e (fn e => (St.send (e, loc); doArgs es))
1873 in 1873 in
1874 doArgs es 1874 doArgs es
1875 end 1875 end
1876 else if Settings.isEffectful (m, s) andalso not (Settings.isBenignEffectful (m, s)) then 1876 else if Settings.isEffectful (m, s) andalso not (Settings.isBenignEffectful (m, s)) then
1878 else 1878 else
1879 let 1879 let
1880 fun doArgs (es, acc) = 1880 fun doArgs (es, acc) =
1881 case es of 1881 case es of
1882 [] => k (Func (Other (m ^ "." ^ s), rev acc)) 1882 [] => k (Func (Other (m ^ "." ^ s), rev acc))
1883 | e :: es => 1883 | (e, _) :: es =>
1884 evalExp env e (fn e => doArgs (es, e :: acc)) 1884 evalExp env e (fn e => doArgs (es, e :: acc))
1885 in 1885 in
1886 doArgs (es, []) 1886 doArgs (es, [])
1887 end 1887 end
1888 in 1888 in
1902 in 1902 in
1903 St.assert [AReln (Known, [e])]; 1903 St.assert [AReln (Known, [e])];
1904 k e 1904 k e
1905 end 1905 end
1906 | EFfiApp x => doFfi x 1906 | EFfiApp x => doFfi x
1907 | EApp ((EFfi (m, s), _), e) => doFfi (m, s, [e]) 1907 | EApp ((EFfi (m, s), _), e) => doFfi (m, s, [(e, (TRecord [], loc))])
1908 1908
1909 | EApp (e1 as (EError _, _), _) => evalExp env e1 k 1909 | EApp (e1 as (EError _, _), _) => evalExp env e1 k
1910 1910
1911 | EApp (e1, e2) => 1911 | EApp (e1, e2) =>
1912 let 1912 let
2049 | Delete (tab, _) => 2049 | Delete (tab, _) =>
2050 (cs, SS.add (ts, tab)) 2050 (cs, SS.add (ts, tab))
2051 | Update (tab, _, _) => 2051 | Update (tab, _, _) =>
2052 (cs, SS.add (ts, tab))) 2052 (cs, SS.add (ts, tab)))
2053 | EFfiApp ("Basis", "set_cookie", 2053 | EFfiApp ("Basis", "set_cookie",
2054 [_, (EPrim (Prim.String cname), _), 2054 [_, ((EPrim (Prim.String cname), _), _),
2055 _, _, _]) => 2055 _, _, _]) =>
2056 (SS.add (cs, cname), ts) 2056 (SS.add (cs, cname), ts)
2057 | _ => st} 2057 | _ => st}
2058 (SS.empty, SS.empty) b 2058 (SS.empty, SS.empty) b
2059 in 2059 in
2187 k (Var nv) 2187 k (Var nv)
2188 end 2188 end
2189 | ENextval _ => default () 2189 | ENextval _ => default ()
2190 | ESetval _ => default () 2190 | ESetval _ => default ()
2191 2191
2192 | EUnurlify ((EFfiApp ("Basis", "get_cookie", [(EPrim (Prim.String cname), _)]), _), _, _) => 2192 | EUnurlify ((EFfiApp ("Basis", "get_cookie", [((EPrim (Prim.String cname), _), _)]), _), _, _) =>
2193 let 2193 let
2194 val e = Var (St.nextVar ()) 2194 val e = Var (St.nextVar ())
2195 val e' = Func (Other ("cookie/" ^ cname), []) 2195 val e' = Func (Other ("cookie/" ^ cname), [])
2196 in 2196 in
2197 St.assert [AReln (Known, [e]), AReln (Eq, [e, e'])]; 2197 St.assert [AReln (Known, [e]), AReln (Eq, [e, e'])];
2299 | ENone _ => e 2299 | ENone _ => e
2300 | ESome (t, e) => (ESome (t, doExp env e), loc) 2300 | ESome (t, e) => (ESome (t, doExp env e), loc)
2301 | EFfi _ => e 2301 | EFfi _ => e
2302 | EFfiApp (m, f, es) => 2302 | EFfiApp (m, f, es) =>
2303 (case (m, f, es) of 2303 (case (m, f, es) of
2304 ("Basis", "set_cookie", [_, (EPrim (Prim.String cname), _), _, _, _]) => 2304 ("Basis", "set_cookie", [_, ((EPrim (Prim.String cname), _), _), _, _, _]) =>
2305 cookies := SS.add (!cookies, cname) 2305 cookies := SS.add (!cookies, cname)
2306 | _ => (); 2306 | _ => ();
2307 (EFfiApp (m, f, map (doExp env) es), loc)) 2307 (EFfiApp (m, f, map (fn (e, t) => (doExp env e, t)) es), loc))
2308 2308
2309 | EApp (e1, e2) => 2309 | EApp (e1, e2) =>
2310 let 2310 let
2311 fun default () = (EApp (doExp env e1, doExp env e2), loc) 2311 fun default () = (EApp (doExp env e1, doExp env e2), loc)
2312 2312