changeset 764:7f653298dd66

C FFI compiler options
author Adam Chlipala <adamc@hcoop.net>
date Thu, 30 Apr 2009 17:15:14 -0400
parents af41ec2f302a
children a28982de5645
files .hgignore include/types.h include/urweb.h src/cjr_print.sig src/cjr_print.sml src/compiler.sig src/compiler.sml src/corify.sml src/demo.sml src/jscomp.sml src/monoize.sig src/monoize.sml src/settings.sig src/settings.sml src/sources tests/Makefile tests/cffi.ur tests/cffi.urp tests/cffi.urs tests/test.c tests/test.h tests/test.urs
diffstat 22 files changed, 251 insertions(+), 66 deletions(-) [+]
line wrap: on
line diff
--- a/.hgignore	Thu Apr 30 16:25:27 2009 -0400
+++ b/.hgignore	Thu Apr 30 17:15:14 2009 -0400
@@ -13,7 +13,6 @@
 *.grm.*
 *.o
 
-./Makefile
 src/config.sml
 
 *.exe
@@ -37,3 +36,8 @@
 .depend
 Makefile.coq
 *.vo
+
+syntax: regexp
+
+^Makefile
+^src/coq/Makefile
--- a/include/types.h	Thu Apr 30 16:25:27 2009 -0400
+++ b/include/types.h	Thu Apr 30 17:15:14 2009 -0400
@@ -1,3 +1,6 @@
+#ifndef URWEB_TYPES_H
+#define URWEB_TYPES_H
+
 #include <time.h>
 
 typedef long long uw_Basis_int;
@@ -42,3 +45,4 @@
 #define FLOATS_MAX 100
 #define TIMES_MAX 100
 
+#endif
--- a/include/urweb.h	Thu Apr 30 16:25:27 2009 -0400
+++ b/include/urweb.h	Thu Apr 30 17:15:14 2009 -0400
@@ -1,3 +1,6 @@
+#ifndef URWEB_H
+#define URWEB_H
+
 #include <sys/types.h>
 
 #include "types.h"
@@ -176,3 +179,5 @@
 uw_Basis_int uw_Basis_blobSize(uw_context, uw_Basis_blob);
 
 __attribute__((noreturn)) void uw_return_blob(uw_context, uw_Basis_blob, uw_Basis_string mimeType);
+
+#endif
--- a/src/cjr_print.sig	Thu Apr 30 16:25:27 2009 -0400
+++ b/src/cjr_print.sig	Thu Apr 30 17:15:14 2009 -0400
@@ -36,6 +36,4 @@
     val p_sql : CjrEnv.env -> Cjr.file Print.printer
 
     val debug : bool ref
-
-    val timeout : int ref
 end
--- a/src/cjr_print.sml	Thu Apr 30 16:25:27 2009 -0400
+++ b/src/cjr_print.sml	Thu Apr 30 17:15:14 2009 -0400
@@ -1250,8 +1250,6 @@
         urlify' IS.empty 0 t
     end
 
-val timeout = ref 0
-
 fun p_exp' par env (e, loc) =
     case e of
         EPrim p => Prim.p_t_GCC p
@@ -2832,7 +2830,7 @@
                                     string (case side of
                                                 ServerOnly => ""
                                               | _ => "<script src=\\\""
-                                                     ^ OS.Path.joinDirFile {dir = !Monoize.urlPrefix,
+                                                     ^ OS.Path.joinDirFile {dir = Settings.getUrlPrefix (),
                                                                             file = "app.js"}
                                                      ^ "\\\"></script>\\n"),
                                     string "\");",
@@ -2844,7 +2842,7 @@
                                     string ");",
                                     newline,
                                     string "uw_set_url_prefix(ctx, \"",
-                                    string (!Monoize.urlPrefix),
+                                    string (Settings.getUrlPrefix ()),
                                     string "\");",
                                     newline]),
                      string "uw_set_needs_sig(ctx, ",
@@ -3185,6 +3183,10 @@
              else
                  box [],
              newline,
+             p_list_sep (box []) (fn s => box [string "#include \"",
+                                               string s,
+                                               string "\"",
+                                               newline]) (Settings.getHeaders ()),
              string "#include \"",
              string (OS.Path.joinDirFile {dir = Config.includ,
                                           file = "urweb.h"}),
@@ -3198,7 +3200,7 @@
              string ";",
              newline,
              string "int uw_timeout = ",
-             string (Int.toString (!timeout)),
+             string (Int.toString (Settings.getTimeout ())),
              string ";",
              newline,
              newline,
--- a/src/compiler.sig	Thu Apr 30 16:25:27 2009 -0400
+++ b/src/compiler.sig	Thu Apr 30 17:15:14 2009 -0400
@@ -37,11 +37,14 @@
          sql : string option,
          debug : bool,
          profile : bool,
-         timeout : int
+         timeout : int,
+         ffi : string list,
+         link : string list,
+         headers : string list
     }
     val compile : string -> unit
     val compileC : {cname : string, oname : string, ename : string, libs : string,
-                    profile : bool, debug : bool} -> unit
+                    profile : bool, debug : bool, link : string list} -> unit
 
     type ('src, 'dst) phase
     type ('src, 'dst) transform
--- a/src/compiler.sml	Thu Apr 30 16:25:27 2009 -0400
+++ b/src/compiler.sml	Thu Apr 30 17:15:14 2009 -0400
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008, Adam Chlipala
+(* Copyright (c) 2008-2009, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -25,8 +25,6 @@
  * POSSIBILITY OF SUCH DAMAGE.
  *)
 
-(* Ur/Web language parser *)
-
 structure Compiler :> COMPILER = struct 
 
 structure UrwebLrVals = UrwebLrValsFn(structure Token = LrParser.Token)
@@ -43,7 +41,10 @@
      sql : string option,
      debug : bool,
      profile : bool,
-     timeout : int
+     timeout : int,
+     ffi : string list,
+     link : string list,
+     headers : string list
 }
 
 type ('src, 'dst) phase = {
@@ -201,7 +202,7 @@
               handle LrParser.ParseError => [],
      print = SourcePrint.p_file}    
 
-fun p_job {prefix, database, exe, sql, sources, debug, profile, timeout} =
+fun p_job {prefix, database, exe, sql, sources, debug, profile, timeout, ffi, link, headers} =
     let
         open Print.PD
         open Print
@@ -228,6 +229,9 @@
              string "Timeout: ",
              string (Int.toString timeout),
              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 "Link", space, string s, newline]) link,
              string "Sources:",
              p_list string sources,
              newline]
@@ -251,6 +255,10 @@
                       OS.Path.concat (dir, fname)
                       handle OS.Path.Path => fname
 
+                  val absDir = OS.Path.mkAbsolute {path = dir, relativeTo = OS.FileSys.getDir ()}
+
+                  fun relifyA fname = OS.Path.mkAbsolute {path = fname, relativeTo = absDir}
+
                   fun readSources acc =
                       case TextIO.inputLine inf of
                           NONE => rev acc
@@ -270,21 +278,35 @@
                               readSources acc
                           end
 
-                  fun finish (prefix, database, exe, sql, debug, profile, timeout, sources) =
-                      {prefix = Option.getOpt (prefix, "/"),
-                       database = database,
-                       exe = Option.getOpt (exe, OS.Path.joinBaseExt {base = OS.Path.base filename,
-                                                                      ext = SOME "exe"}),
-                       sql = sql,
-                       debug = debug,
-                       profile = profile,
-                       timeout = Option.getOpt (timeout, 60),
+                  val prefix = ref NONE
+                  val database = ref NONE
+                  val exe = ref NONE
+                  val sql = ref NONE
+                  val debug = ref false
+                  val profile = ref false
+                  val timeout = ref NONE
+                  val ffi = ref []
+                  val link = ref []
+                  val headers = ref []
+
+                  fun finish sources =
+                      {prefix = Option.getOpt (!prefix, "/"),
+                       database = !database,
+                       exe = Option.getOpt (!exe, OS.Path.joinBaseExt {base = OS.Path.base filename,
+                                                                       ext = SOME "exe"}),
+                       sql = !sql,
+                       debug = !debug,
+                       profile = !profile,
+                       timeout = Option.getOpt (!timeout, 60),
+                       ffi = !ffi,
+                       link = !link,
+                       headers = !headers,
                        sources = sources}
 
-                  fun read (prefix, database, exe, sql, debug, profile, timeout) =
+                  fun read () =
                       case TextIO.inputLine inf of
-                          NONE => finish (prefix, database, exe, sql, debug, profile, timeout, [])
-                        | SOME "\n" => finish (prefix, database, exe, sql, debug, profile, timeout, readSources [])
+                          NONE => finish []
+                        | SOME "\n" => finish (readSources [])
                         | SOME line =>
                           let
                               val (cmd, arg) = Substring.splitl (fn x => not (Char.isSpace x)) (Substring.full line)
@@ -293,41 +315,45 @@
                           in
                               case cmd of
                                   "prefix" =>
-                                  (case prefix of
+                                  (case !prefix of
                                        NONE => ()
                                      | SOME _ => ErrorMsg.error "Duplicate 'prefix' directive";
-                                   read (SOME arg, database, exe, sql, debug, profile, timeout))
+                                   prefix := SOME arg)
                                 | "database" =>
-                                  (case database of
+                                  (case !database of
                                        NONE => ()
                                      | SOME _ => ErrorMsg.error "Duplicate 'database' directive";
-                                   read (prefix, SOME arg, exe, sql, debug, profile, timeout))
+                                   database := SOME arg)
                                 | "exe" =>
-                                  (case exe of
+                                  (case !exe of
                                        NONE => ()
                                      | SOME _ => ErrorMsg.error "Duplicate 'exe' directive";
-                                   read (prefix, database, SOME (relify arg), sql, debug, profile, timeout))
+                                   exe := SOME (relify arg))
                                 | "sql" =>
-                                  (case sql of
+                                  (case !sql of
                                        NONE => ()
                                      | SOME _ => ErrorMsg.error "Duplicate 'sql' directive";
-                                   read (prefix, database, exe, SOME (relify arg), debug, profile, timeout))
-                                | "debug" => read (prefix, database, exe, sql, true, profile, timeout)
-                                | "profile" => read (prefix, database, exe, sql, debug, true, timeout)
+                                   sql := SOME (relify arg))
+                                | "debug" => debug := true
+                                | "profile" => profile := true
                                 | "timeout" =>
-                                  (case timeout of
+                                  (case !timeout of
                                        NONE => ()
                                      | SOME _ => ErrorMsg.error "Duplicate 'timeout' directive";
-                                   read (prefix, database, exe, sql, debug, profile, SOME (valOf (Int.fromString arg))))
-                                | _ => (ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
-                                        read (prefix, database, exe, sql, debug, profile, timeout))
+                                   timeout := SOME (valOf (Int.fromString arg)))
+                                | "ffi" => ffi := relify arg :: !ffi
+                                | "link" => link := relifyA arg :: !link
+                                | "include" => headers := relifyA arg :: !headers
+                                | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'");
+                              read ()
                           end
 
-                  val job = read (NONE, NONE, NONE, NONE, false, false, NONE)
+                  val job = read ()
               in
                   TextIO.closeIn inf;
-                  Monoize.urlPrefix := #prefix job;
-                  CjrPrint.timeout := #timeout job;
+                  Settings.setUrlPrefix (#prefix job);
+                  Settings.setTimeout (#timeout job);
+                  Settings.setHeaders (#headers job);
                   job
               end,
     print = p_job
@@ -339,10 +365,24 @@
   | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE)
 
 val parse = {
-    func = fn {database, sources = fnames, ...} : job =>
+    func = fn {database, sources = fnames, ffi, ...} : job =>
               let
                   fun nameOf fname = capitalize (OS.Path.file fname)
 
+                  fun parseFfi fname =
+                      let
+                          val mname = nameOf fname
+                          val urs = OS.Path.joinBaseExt {base = fname, ext = SOME "urs"}
+
+                          val loc = {file = urs,
+                                     first = ErrorMsg.dummyPos,
+                                     last = ErrorMsg.dummyPos}
+
+                          val sgn = (Source.SgnConst (#func parseUrs urs), loc)
+                      in
+                          (Source.DFfiStr (mname, sgn), loc)
+                      end
+
                   fun parseOne fname =
                       let
                           val mname = nameOf fname
@@ -367,12 +407,14 @@
                           (Source.DStr (mname, sgnO, (Source.StrConst ds, loc)), loc)
                       end
 
+                  val dsFfi = map parseFfi ffi
                   val ds = map parseOne fnames
               in
                   let
                       val final = nameOf (List.last fnames)
 
-                      val ds = ds @ [(Source.DExport (Source.StrVar final, ErrorMsg.dummySpan), ErrorMsg.dummySpan)]
+                      val ds = dsFfi @ ds
+                               @ [(Source.DExport (Source.StrVar final, ErrorMsg.dummySpan), ErrorMsg.dummySpan)]
                   in
                       case database of
                           NONE => ds
@@ -605,7 +647,7 @@
 
 val toSqlify = transform sqlify "sqlify" o toMono_opt2
 
-fun compileC {cname, oname, ename, libs, profile, debug} =
+fun compileC {cname, oname, ename, libs, profile, debug, link = link'} =
     let
         val urweb_o = clibFile "urweb.o"
         val driver_o = clibFile "driver.o"
@@ -624,6 +666,8 @@
                 (compile ^ " -g", link ^ " -g")
             else
                 (compile, link)
+
+        val link = foldl (fn (s, link) => link ^ " " ^ s) link link'
     in
         if not (OS.Process.isSuccess (OS.Process.system compile)) then
             print "C compilation failed\n"
@@ -689,7 +733,7 @@
                     end;
 
                 compileC {cname = cname, oname = oname, ename = ename, libs = libs,
-                          profile = #profile job, debug = #debug job};
+                          profile = #profile job, debug = #debug job, link = #link job};
                 
                 cleanup ()
             end
--- a/src/corify.sml	Thu Apr 30 16:25:27 2009 -0400
+++ b/src/corify.sml	Thu Apr 30 17:15:14 2009 -0400
@@ -890,7 +890,7 @@
 
                  val st = St.bindStr st m n (St.ffi m cmap conmap)
              in
-                 (rev ds, St.basisIs (st, n))
+                 (rev ds, if m = "Basis" then St.basisIs (st, n) else st)
              end
            | _ => raise Fail "Non-const signature for FFI structure")
 
--- a/src/demo.sml	Thu Apr 30 16:25:27 2009 -0400
+++ b/src/demo.sml	Thu Apr 30 17:15:14 2009 -0400
@@ -94,7 +94,10 @@
                                              file = "demo.sql"}),
             debug = false,
             timeout = Int.max (#timeout combined, #timeout urp),
-            profile = false
+            profile = false,
+            ffi = [],
+            link = [],
+            headers = []
         }
 
         val parse = Compiler.run (Compiler.transform Compiler.parseUrp "Demo parseUrp")
--- a/src/jscomp.sml	Thu Apr 30 16:25:27 2009 -0400
+++ b/src/jscomp.sml	Thu Apr 30 17:15:14 2009 -0400
@@ -965,7 +965,7 @@
                                 val (ek, st) = jsE inner (ek, st)
                                 val (unurl, st) = unurlifyExp loc (t, st)
                             in
-                                (strcat [str ("rc(cat(\"" ^ !Monoize.urlPrefix ^ "\","),
+                                (strcat [str ("rc(cat(\"" ^ Settings.getUrlPrefix () ^ "\","),
                                          e,
                                          str ("), function(s){var t=s.split(\"/\");var i=0;return "
                                               ^ unurl ^ "},"),
--- a/src/monoize.sig	Thu Apr 30 16:25:27 2009 -0400
+++ b/src/monoize.sig	Thu Apr 30 17:15:14 2009 -0400
@@ -27,8 +27,6 @@
 
 signature MONOIZE = sig
 
-    val urlPrefix : string ref
-
     val monoize : CoreEnv.env -> Core.file -> Mono.file
 
     val liftExpInExp : int -> Mono.exp -> Mono.exp
--- a/src/monoize.sml	Thu Apr 30 16:25:27 2009 -0400
+++ b/src/monoize.sml	Thu Apr 30 17:15:14 2009 -0400
@@ -36,8 +36,6 @@
 structure IM = IntBinaryMap
 structure IS = IntBinarySet
 
-val urlPrefix = ref "/"
-
 val dummyTyp = (L'.TDatatype (0, ref (L'.Enum, [])), E.dummySpan)
 
 structure U = MonoUtil
@@ -376,7 +374,7 @@
                 let
                     val (_, _, _, s) = Env.lookupENamed env fnam
                 in
-                    ((L'.EPrim (Prim.String (!urlPrefix ^ s)), loc), fm)
+                    ((L'.EPrim (Prim.String (Settings.getUrlPrefix () ^ s)), loc), fm)
                 end
               | L'.EClosure (fnam, args) =>
                 let
@@ -399,7 +397,7 @@
                           | _ => (E.errorAt loc "Type mismatch encoding attribute";
                                   (e, fm))
                 in
-                    attrify (args, ft, (L'.EPrim (Prim.String (!urlPrefix ^ s)), loc), fm)
+                    attrify (args, ft, (L'.EPrim (Prim.String (Settings.getUrlPrefix () ^ s)), loc), fm)
                 end
               | _ =>
                 case t of
@@ -1257,7 +1255,8 @@
                 ((L'.EAbs ("c", s, (L'.TFun (t, (L'.TFun (un, un), loc)), loc),
                            (L'.EAbs ("v", t, (L'.TFun (un, un), loc),
                                      (L'.EAbs ("_", un, un,
-                                               (L'.EFfiApp ("Basis", "set_cookie", [(L'.EPrim (Prim.String (!urlPrefix)),
+                                               (L'.EFfiApp ("Basis", "set_cookie", [(L'.EPrim (Prim.String
+                                                                                                   (Settings.getUrlPrefix ())),
                                                                                      loc),
                                                                                     (L'.ERel 2, loc),
                                                                                     e]), loc)),
@@ -3138,14 +3137,7 @@
 
 fun monoize env file =
     let
-        val p = !urlPrefix
-        val () =
-            if p = "" then
-                urlPrefix := "/"
-            else if String.sub (p, size p - 1) <> #"/" then
-                urlPrefix := p ^ "/"
-            else
-                ()
+
 
         (* Calculate which exported functions need cookie signature protection *)
         val rcook = foldl (fn ((d, _), rcook) =>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/settings.sig	Thu Apr 30 17:15:14 2009 -0400
@@ -0,0 +1,39 @@
+(* Copyright (c) 2008-2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+signature SETTINGS = sig
+    
+    val setUrlPrefix : string -> unit
+    val getUrlPrefix : unit -> string
+
+    val setTimeout : int -> unit
+    val getTimeout : unit -> int
+
+    val setHeaders : string list -> unit
+    val getHeaders : unit -> string list
+
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/settings.sml	Thu Apr 30 17:15:14 2009 -0400
@@ -0,0 +1,49 @@
+(* Copyright (c) 2008-2009, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+structure Settings :> SETTINGS = struct
+
+val urlPrefix = ref "/"
+val timeout = ref 0
+val headers = ref ([] : string list)
+
+fun getUrlPrefix () = !urlPrefix
+fun setUrlPrefix p =
+    urlPrefix := (if p = "" then
+                      "/"
+                  else if String.sub (p, size p - 1) <> #"/" then
+                      p ^ "/"
+                  else
+                      p)
+
+fun getTimeout () = !timeout
+fun setTimeout n = timeout := n
+
+fun getHeaders () = !headers
+fun setHeaders ls = headers := ls
+
+end
--- a/src/sources	Thu Apr 30 16:25:27 2009 -0400
+++ b/src/sources	Thu Apr 30 17:15:14 2009 -0400
@@ -13,6 +13,9 @@
 errormsg.sig
 errormsg.sml
 
+settings.sig
+settings.sml
+
 print.sig
 print.sml
 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/Makefile	Thu Apr 30 17:15:14 2009 -0400
@@ -0,0 +1,4 @@
+all: test.o
+
+test.o: test.c
+	gcc -c test.c -o test.o
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/cffi.ur	Thu Apr 30 17:15:14 2009 -0400
@@ -0,0 +1,3 @@
+fun main () = return <xml><body>
+  {[Test.out (Test.frob (Test.create "Hello ") "world!")]}
+</body></xml>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/cffi.urp	Thu Apr 30 17:15:14 2009 -0400
@@ -0,0 +1,6 @@
+debug
+ffi test
+include test.h
+link test.o
+
+cffi
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/cffi.urs	Thu Apr 30 17:15:14 2009 -0400
@@ -0,0 +1,1 @@
+val main : unit -> transaction page
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/test.c	Thu Apr 30 17:15:14 2009 -0400
@@ -0,0 +1,15 @@
+#include "../include/urweb.h"
+
+typedef uw_Basis_string uw_Test_t;
+
+uw_Test_t uw_Test_create(uw_context ctx, uw_Basis_string s) {
+  return s;
+}
+
+uw_Basis_string uw_Test_out(uw_context ctx, uw_Test_t s) {
+  return s;
+}
+
+uw_Test_t uw_Test_frob(uw_context ctx, uw_Test_t s1, uw_Basis_string s2) {
+  return uw_Basis_strcat(ctx, s1, s2);
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/test.h	Thu Apr 30 17:15:14 2009 -0400
@@ -0,0 +1,7 @@
+#include "../include/urweb.h"
+
+typedef uw_Basis_string uw_Test_t;
+
+uw_Test_t uw_Test_create(uw_context, uw_Basis_string);
+uw_Basis_string uw_Test_out(uw_context, uw_Test_t);
+uw_Test_t uw_Test_frob(uw_context, uw_Test_t, uw_Basis_string);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/test.urs	Thu Apr 30 17:15:14 2009 -0400
@@ -0,0 +1,5 @@
+type t
+
+val create : string -> t
+val out : t -> string
+val frob : t -> string -> t