changeset 284:77a28e7430bf

intToString
author Adam Chlipala <adamc@hcoop.net>
date Sun, 07 Sep 2008 10:13:02 -0400
parents c0e4ac23522d
children e89076c41c39
files include/urweb.h lib/basis.urs src/c/urweb.c src/elaborate.sml tests/option.ur tests/option.urp tests/toString.ur tests/toString.urp
diffstat 8 files changed, 40 insertions(+), 5 deletions(-) [+]
line wrap: on
line diff
--- a/include/urweb.h	Sun Sep 07 10:02:27 2008 -0400
+++ b/include/urweb.h	Sun Sep 07 10:13:02 2008 -0400
@@ -67,3 +67,5 @@
 lw_Basis_bool lw_Basis_sqlifyBool(lw_context, lw_Basis_bool);
 
 char *lw_Basis_ensqlBool(lw_Basis_bool);
+
+lw_Basis_string lw_Basis_intToString(lw_context, lw_Basis_int);
--- a/lib/basis.urs	Sun Sep 07 10:02:27 2008 -0400
+++ b/lib/basis.urs	Sun Sep 07 10:13:02 2008 -0400
@@ -6,6 +6,8 @@
 
 datatype bool = False | True
 
+(*datatype option t = None | Some of t*)
+
 
 (** Basic type classes *)
 
@@ -21,6 +23,9 @@
 
 val strcat : string -> string -> string
 
+val intToString : int -> string
+
+
 
 (** SQL *)
 
--- a/src/c/urweb.c	Sun Sep 07 10:02:27 2008 -0400
+++ b/src/c/urweb.c	Sun Sep 07 10:13:02 2008 -0400
@@ -670,3 +670,14 @@
   else
     return (char *)&true;
 }
+
+lw_Basis_string lw_Basis_intToString(lw_context ctx, lw_Basis_int n) {
+  int len;
+  char *r;
+
+  lw_check_heap(ctx, INTS_MAX);
+  r = ctx->heap_front;
+  sprintf(r, "%lld%n", n, &len);
+  ctx->heap_front += len+1;
+  return r;
+}
--- a/src/elaborate.sml	Sun Sep 07 10:02:27 2008 -0400
+++ b/src/elaborate.sml	Sun Sep 07 10:13:02 2008 -0400
@@ -1923,6 +1923,10 @@
             val nxs = length xs - 1
             val t = ListUtil.foldli (fn (i, _, t) => (L'.CApp (t, (L'.CRel (nxs - i), loc)), loc)) t xs
 
+            val (env', denv') = foldl (fn (x, (env', denv')) =>
+                                          (E.pushCRel env' x k,
+                                           D.enter denv')) (env, denv) xs
+
             val (xcs, (used, env, gs)) =
                 ListUtil.foldlMap
                 (fn ((x, to), (used, env, gs)) =>
@@ -1931,9 +1935,9 @@
                                            NONE => (NONE, t, gs)
                                          | SOME t' =>
                                            let
-                                               val (t', tk, gs') = elabCon (env, denv) t'
+                                               val (t', tk, gs') = elabCon (env', denv') t'
                                            in
-                                               checkKind env t' tk k;
+                                               checkKind env' t' tk k;
                                                (SOME t', (L'.TFun (t', t), loc), gs' @ gs)
                                            end
                         val t = foldl (fn (x, t) => (L'.TCFun (L'.Implicit, x, k, t), loc)) t xs
--- a/tests/option.ur	Sun Sep 07 10:02:27 2008 -0400
+++ b/tests/option.ur	Sun Sep 07 10:13:02 2008 -0400
@@ -9,15 +9,15 @@
 
 val show2 = fn x => case x of None => "None'" | Some x => show x
 
-val page = fn x => <html><body>
+val page = fn x => return <html><body>
         {cdata (show x)}
 </body></html>
 
-val page2 = fn x => <html><body>
+val page2 = fn x => return <html><body>
         {cdata (show2 x)}
 </body></html>
 
-val main : unit -> page = fn () => <html><body>
+val main : unit -> transaction page = fn () => return <html><body>
         <li><a link={page none_Hi}>None1</a></li>
         <li><a link={page some_Hi}>Some1</a></li>
         <li><a link={page2 none_some_Hi}>None2</a></li>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/option.urp	Sun Sep 07 10:13:02 2008 -0400
@@ -0,0 +1,5 @@
+debug
+database dbname=test
+exe /tmp/webapp
+
+option
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/toString.ur	Sun Sep 07 10:13:02 2008 -0400
@@ -0,0 +1,3 @@
+fun main () : transaction page = return <html><body>
+        6 = {cdata (intToString 6)}
+</body></html>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/toString.urp	Sun Sep 07 10:13:02 2008 -0400
@@ -0,0 +1,5 @@
+debug
+database dbname=test
+exe /tmp/webapp
+
+toString