Mercurial > urweb
changeset 766:df09c95085f8
More FFI compiler options
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sat, 02 May 2009 12:10:43 -0400 |
| parents | a28982de5645 |
| children | d27ed5ddeb52 |
| files | src/cjr_print.sml src/compiler.sig src/compiler.sml src/demo.sml src/settings.sig src/settings.sml tests/cffi.ur tests/cffi.urp tests/test.c tests/test.h tests/test.js tests/test.urs |
| diffstat | 12 files changed, 47 insertions(+), 2 deletions(-) [+] |
line wrap: on
line diff
--- a/src/cjr_print.sml Sat May 02 11:27:26 2009 -0400 +++ b/src/cjr_print.sml Sat May 02 12:10:43 2009 -0400 @@ -2839,6 +2839,8 @@ ^ OS.Path.joinDirFile {dir = Settings.getUrlPrefix (), file = "app.js"} ^ "\\\"></script>\\n"), + p_list (fn x => string ("<script src=\\\"" ^ x ^ "\\\"></script>")) + (Settings.getScripts ()), string "\");", newline, string "uw_set_needs_push(ctx, ",
--- a/src/compiler.sig Sat May 02 11:27:26 2009 -0400 +++ b/src/compiler.sig Sat May 02 12:10:43 2009 -0400 @@ -41,6 +41,7 @@ ffi : string list, link : string list, headers : string list, + scripts : string list, clientToServer : Settings.ffi list, effectful : Settings.ffi list, clientOnly : Settings.ffi list,
--- a/src/compiler.sml Sat May 02 11:27:26 2009 -0400 +++ b/src/compiler.sml Sat May 02 12:10:43 2009 -0400 @@ -45,6 +45,7 @@ ffi : string list, link : string list, headers : string list, + scripts : string list, clientToServer : Settings.ffi list, effectful : Settings.ffi list, clientOnly : Settings.ffi list, @@ -208,7 +209,7 @@ print = SourcePrint.p_file} fun p_job {prefix, database, exe, sql, sources, debug, profile, - timeout, ffi, link, headers, + timeout, ffi, link, headers, scripts, clientToServer, effectful, clientOnly, serverOnly, jsFuncs} = let open Print.PD @@ -241,6 +242,7 @@ newline, p_list_sep (box []) (fn s => box [string "Ffi", space, string s, newline]) ffi, p_list_sep (box []) (fn s => box [string "Header", space, string s, newline]) headers, + p_list_sep (box []) (fn s => box [string "Script", space, string s, newline]) scripts, p_list_sep (box []) (fn s => box [string "Link", space, string s, newline]) link, p_ffi "ClientToServer" clientToServer, p_ffi "Effectful" effectful, @@ -305,6 +307,7 @@ val ffi = ref [] val link = ref [] val headers = ref [] + val scripts = ref [] val clientToServer = ref [] val effectful = ref [] val clientOnly = ref [] @@ -323,6 +326,7 @@ ffi = rev (!ffi), link = rev (!link), headers = rev (!headers), + scripts = rev (!scripts), clientToServer = rev (!clientToServer), effectful = rev (!effectful), clientOnly = rev (!clientOnly), @@ -387,6 +391,7 @@ | "ffi" => ffi := relify arg :: !ffi | "link" => link := relifyA arg :: !link | "include" => headers := relifyA arg :: !headers + | "script" => scripts := arg :: !scripts | "clientToServer" => clientToServer := ffiS () :: !clientToServer | "effectful" => effectful := ffiS () :: !effectful | "clientOnly" => clientOnly := ffiS () :: !clientOnly @@ -402,6 +407,7 @@ Settings.setUrlPrefix (#prefix job); Settings.setTimeout (#timeout job); Settings.setHeaders (#headers job); + Settings.setScripts (#scripts job); Settings.setClientToServer (#clientToServer job); Settings.setEffectful (#effectful job); Settings.setClientOnly (#clientOnly job);
--- a/src/demo.sml Sat May 02 11:27:26 2009 -0400 +++ b/src/demo.sml Sat May 02 12:10:43 2009 -0400 @@ -98,6 +98,7 @@ ffi = [], link = [], headers = [], + scripts = [], clientToServer = [], effectful = [], clientOnly = [],
--- a/src/settings.sig Sat May 02 11:27:26 2009 -0400 +++ b/src/settings.sig Sat May 02 12:10:43 2009 -0400 @@ -39,6 +39,10 @@ val setHeaders : string list -> unit val getHeaders : unit -> string list + (* Which extra JavaScript URLs should be included? *) + val setScripts : string list -> unit + val getScripts : unit -> string list + type ffi = string * string (* Which FFI types may be sent from clients to servers? *)
--- a/src/settings.sml Sat May 02 11:27:26 2009 -0400 +++ b/src/settings.sml Sat May 02 12:10:43 2009 -0400 @@ -30,6 +30,7 @@ val urlPrefix = ref "/" val timeout = ref 0 val headers = ref ([] : string list) +val scripts = ref ([] : string list) fun getUrlPrefix () = !urlPrefix fun setUrlPrefix p = @@ -46,6 +47,9 @@ fun getHeaders () = !headers fun setHeaders ls = headers := ls +fun getScripts () = !scripts +fun setScripts ls = scripts := ls + type ffi = string * string structure K = struct
--- a/tests/cffi.ur Sat May 02 11:27:26 2009 -0400 +++ b/tests/cffi.ur Sat May 02 12:10:43 2009 -0400 @@ -1,6 +1,12 @@ +fun printer () = Test.foo + fun effect () = Test.print; - return <xml/> + return <xml><body> + <button value="Remote" onclick={printer ()}/> + <button value="Local" onclick={Test.bar "Hoho"}/> + <button value="Either" onclick={Test.print}/> + </body></xml> fun main () = return <xml><body> {[Test.out (Test.frob (Test.create "Hello ") "world!")]}
--- a/tests/cffi.urp Sat May 02 11:27:26 2009 -0400 +++ b/tests/cffi.urp Sat May 02 12:10:43 2009 -0400 @@ -1,7 +1,12 @@ debug ffi test include test.h +script http://localhost/test/test.js link test.o effectful Test.print +serverOnly Test.foo +clientOnly Test.bar +jsFunc Test.print=print +jsFunc Test.bar=bar cffi
--- a/tests/test.c Sat May 02 11:27:26 2009 -0400 +++ b/tests/test.c Sat May 02 12:10:43 2009 -0400 @@ -20,3 +20,8 @@ printf("Hi there!\n"); return uw_unit_v; } + +uw_Basis_unit uw_Test_foo(uw_context ctx) { + printf("FOO!\n"); + return uw_unit_v; +}
--- a/tests/test.h Sat May 02 11:27:26 2009 -0400 +++ b/tests/test.h Sat May 02 12:10:43 2009 -0400 @@ -7,3 +7,4 @@ uw_Test_t uw_Test_frob(uw_context, uw_Test_t, uw_Basis_string); uw_Basis_unit uw_Test_print(uw_context); +uw_Basis_unit uw_Test_foo(uw_context);