diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-04-26 12:35:45 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-04-26 12:35:45 -0400 |
| commit | a4d3d754e8b4fc6bad46f414a7d27228ab60107f (patch) | |
| tree | 122ba347fb6260488aaec3aca188e6600d0125f9 /src | |
| parent | 8ae6d29e66997f90e36803d19f5b23b63a9c4a4b (diff) | |
sql_ufunc and octet_length
Diffstat (limited to 'src')
| -rw-r--r-- | src/monoize.sml | 27 | ||||
| -rw-r--r-- | src/urweb.grm | 12 |
2 files changed, 39 insertions, 0 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index 90440807..780f6923 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -201,6 +201,8 @@ fun monoType env = (L'.TRecord [], loc) | L.CApp ((L.CFfi ("Basis", "sql_nfunc"), _), _) => (L'.TFfi ("Basis", "string"), loc) + | L.CApp ((L.CApp ((L.CFfi ("Basis", "sql_ufunc"), _), _), _), _) => + (L'.TFfi ("Basis", "string"), loc) | L.CApp ((L.CFfi ("Basis", "channel"), _), _) => (L'.TFfi ("Basis", "channel"), loc) @@ -1990,6 +1992,31 @@ fun monoExp (env, st, fm) (all as (e, loc)) = end | L.EFfi ("Basis", "sql_current_timestamp") => ((L'.EPrim (Prim.String "CURRENT_TIMESTAMP"), loc), fm) + | L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (L.EFfi ("Basis", "sql_ufunc"), _), + _), _), + _), _), + _), _), + _), _), + _) => + let + val s = (L'.TFfi ("Basis", "string"), loc) + fun sc s = (L'.EPrim (Prim.String s), loc) + in + ((L'.EAbs ("f", s, (L'.TFun (s, s), loc), + (L'.EAbs ("x", s, s, + strcat [(L'.ERel 1, loc), + sc "(", + (L'.ERel 0, loc), + sc ")"]), loc)), loc), + fm) + end + | L.EFfi ("Basis", "sql_octet_length") => ((L'.EPrim (Prim.String "octet_length"), loc), fm) + | (L.ECApp ( (L.ECApp ( (L.ECApp ( diff --git a/src/urweb.grm b/src/urweb.grm index 50d0c803..be67ea7b 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -329,6 +329,7 @@ datatype attr = Class of exp | Normal of con * exp | ofopt of exp | sqlint of exp | sqlagg of string + | fname of exp | texp of exp | fields of con list @@ -1536,6 +1537,17 @@ sqlexp : TRUE (sql_inject (EVar (["Basis"], "True", In in (EApp (e, sqlexp), loc) end) + | fname LPAREN sqlexp RPAREN (let + val loc = s (fnameleft, RPARENright) + + val e = (EVar (["Basis"], "sql_ufunc", Infer), loc) + val e = (EApp (e, fname), loc) + in + (EApp (e, sqlexp), loc) + end) + +fname : SYMBOL (EVar (["Basis"], "sql_" ^ SYMBOL, Infer), s (SYMBOLleft, SYMBOLright)) + | LBRACE eexp RBRACE (eexp) wopt : (sql_inject (EVar (["Basis"], "True", Infer), dummy)) |