summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-09-09 08:15:46 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-09-09 08:15:46 -0400
commit3b86930c9adf12117a7cc600a20288020e2660f5 (patch)
tree1df04b9ac5d1ea383a6c6c572d2a707bd3ceee69
parent2b5e957c78d47ae6d66ee2f70435b827d1644a4f (diff)
Find chances to use mstrcat()
-rw-r--r--include/urweb.h1
-rw-r--r--src/c/urweb.c20
-rw-r--r--src/cjr_print.sml18
3 files changed, 39 insertions, 0 deletions
diff --git a/include/urweb.h b/include/urweb.h
index 0aec813f..b6531a39 100644
--- a/include/urweb.h
+++ b/include/urweb.h
@@ -120,6 +120,7 @@ uw_Basis_int uw_Basis_strlen(uw_context, const char *);
uw_Basis_char uw_Basis_strsub(uw_context, const char *, uw_Basis_int);
uw_Basis_string uw_Basis_strsuffix(uw_context, const char *, uw_Basis_int);
uw_Basis_string uw_Basis_strcat(uw_context, const char *, const char *);
+uw_Basis_string uw_Basis_mstrcat(uw_context ctx, ...);
uw_Basis_int *uw_Basis_strindex(uw_context, const char *, uw_Basis_char);
uw_Basis_string uw_Basis_strchr(uw_context, const char *, uw_Basis_char);
uw_Basis_int uw_Basis_strcspn(uw_context, const char *, const char *);
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 651cef17..774c5797 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -2836,3 +2836,23 @@ uw_Basis_string uw_Basis_unAs(uw_context ctx, uw_Basis_string s) {
return r;
}
+uw_Basis_string uw_Basis_mstrcat(uw_context ctx, ...) {
+ va_list ap;
+ size_t len = 1;
+ char *s, *r, *s2;
+
+ va_start(ap, ctx);
+ for (s = va_arg(ap, char*); s; s = va_arg(ap, char*))
+ len += strlen(s);
+ va_end(ap);
+
+ r = uw_malloc(ctx, len);
+ va_start(ap, ctx);
+ for (s2 = r, s = va_arg(ap, char*); s; s = va_arg(ap, char*))
+ while (*s)
+ *s2++ = *s++;
+ va_end(ap);
+ *s2 = 0;
+
+ return r;
+}
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 0fd6339d..c6406cef 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -1468,6 +1468,24 @@ fun p_exp' par env (e, loc) =
| EApp ((EReturnBlob {blob, mimeType, t = (TFun (_, ran), _)}, loc), _) =>
p_exp env (EReturnBlob {blob = blob, mimeType = mimeType, t = ran}, loc)
+ | EFfiApp ("Basis", "strcat", [e1, e2]) =>
+ let
+ fun flatten e =
+ case #1 e of
+ EFfiApp ("Basis", "strcat", [e1, e2]) => flatten e1 @ flatten e2
+ | _ => [e]
+ in
+ case flatten e1 @ flatten e2 of
+ [e1, e2] => box [string "uw_Basis_strcat(ctx, ",
+ p_exp env e1,
+ string ",",
+ p_exp env e2,
+ string ")"]
+ | es => box [string "uw_Basis_mstrcat(ctx, ",
+ p_list (p_exp env) es,
+ string ", NULL)"]
+ end
+
| EFfiApp (m, x, []) => box [string "uw_",
p_ident m,
string "_",