# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1294787092 18000
# Node ID 9a721f0722d32ec7e6d7399eec4152f7d63a383c
# Parent  3913cbfd72e9ddcb2f01b9ede3370cbb840ca11f
Some more string parsing functions; naughtyDebug

diff -r 3913cbfd72e9 -r 9a721f0722d3 include/urweb.h
--- a/include/urweb.h	Tue Jan 11 14:03:54 2011 -0500
+++ b/include/urweb.h	Tue Jan 11 18:04:52 2011 -0500
@@ -291,6 +291,7 @@
 void uw_check_deadline(uw_context);
 
 uw_Basis_unit uw_Basis_debug(uw_context, uw_Basis_string);
+uw_Basis_int uw_Basis_naughtyDebug(uw_context, uw_Basis_string);
 
 void uw_set_client_data(uw_context, void *);
 
diff -r 3913cbfd72e9 -r 9a721f0722d3 lib/ur/basis.urs
--- a/lib/ur/basis.urs	Tue Jan 11 14:03:54 2011 -0500
+++ b/lib/ur/basis.urs	Tue Jan 11 18:04:52 2011 -0500
@@ -857,5 +857,6 @@
 val also : sql_policy -> sql_policy -> sql_policy
 
 val debug : string -> transaction unit
+val naughtyDebug : string -> int
 
 val rand : transaction int
diff -r 3913cbfd72e9 -r 9a721f0722d3 lib/ur/string.ur
--- a/lib/ur/string.ur	Tue Jan 11 14:03:54 2011 -0500
+++ b/lib/ur/string.ur	Tue Jan 11 18:04:52 2011 -0500
@@ -24,17 +24,31 @@
 
 fun substring s {Start = start, Len = len} = Basis.substring s start len
 
+fun seek s ch =
+    case index s ch of
+        None => None
+      | Some i => Some (suffix s (i + 1))
+fun mseek {Haystack = s, Needle = chs} =
+    case mindex {Haystack = s, Needle = chs} of
+        None => None
+      | Some i => Some (sub s i, suffix s (i + 1))
+
 fun split s ch =
     case index s ch of
         None => None
       | Some i => Some (substring s {Start = 0, Len = i},
-                        substring s {Start = i + 1, Len = length s - i - 1})
+                        suffix s (i + 1))
+fun split' s ch =
+    case index s ch of
+        None => None
+      | Some i => Some (substring s {Start = 0, Len = i},
+                        suffix s i)
 fun msplit {Haystack = s, Needle = chs} =
     case mindex {Haystack = s, Needle = chs} of
         None => None
       | Some i => Some (substring s {Start = 0, Len = i},
                         sub s i,
-                        substring s {Start = i + 1, Len = length s - i - 1})
+                        suffix s (i + 1))
 
 fun all f s =
     let
diff -r 3913cbfd72e9 -r 9a721f0722d3 lib/ur/string.urs
--- a/lib/ur/string.urs	Tue Jan 11 14:03:54 2011 -0500
+++ b/lib/ur/string.urs	Tue Jan 11 18:04:52 2011 -0500
@@ -17,7 +17,11 @@
 
 val substring : t -> {Start : int, Len : int} -> string
 
+val seek : t -> char -> option string
+val mseek : {Haystack : t, Needle : t} -> option (char * string)
+
 val split : t -> char -> option (string * string)
+val split' : t -> char -> option (string * string) (* The matched character is kept at the beginning of the suffix. *)
 val msplit : {Haystack : t, Needle : t} -> option (string * char * string)
 
 val all : (char -> bool) -> string -> bool
diff -r 3913cbfd72e9 -r 9a721f0722d3 src/c/urweb.c
--- a/src/c/urweb.c	Tue Jan 11 14:03:54 2011 -0500
+++ b/src/c/urweb.c	Tue Jan 11 18:04:52 2011 -0500
@@ -1176,7 +1176,7 @@
 
     if (new_heap != b->start) {
       b->start = new_heap;
-      uw_error(ctx, UNLIMITED_RETRY, "Couldn't allocate new %s contiguously", desc);
+      uw_error(ctx, UNLIMITED_RETRY, "Couldn't allocate new %s contiguously; increasing size to %llu", desc, (unsigned long long)next);
     }
 
     b->start = new_heap;
@@ -3602,6 +3602,11 @@
 
 size_t uw_database_max = SIZE_MAX;
 
+uw_Basis_int uw_Basis_naughtyDebug(uw_context ctx, uw_Basis_string s) {
+  fprintf(stderr, "%s\n", s);
+  return 0;
+}
+
 uw_Basis_unit uw_Basis_debug(uw_context ctx, uw_Basis_string s) {
   if (ctx->log_debug)
     ctx->log_debug(ctx->logger_data, "%s\n", s);
diff -r 3913cbfd72e9 -r 9a721f0722d3 src/settings.sml
--- a/src/settings.sml	Tue Jan 11 14:03:54 2011 -0500
+++ b/src/settings.sml	Tue Jan 11 18:04:52 2011 -0500
@@ -138,6 +138,7 @@
                         "onServerError",
                         "kc",
                         "debug",
+                        "naughtyDebug",
                         "rand"]
 
 val benign = ref benignBase