summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-12-08 10:46:50 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-12-08 10:46:50 -0500
commit778b73af8cd74791c5d2f8cc520d82e3b4e1f5de (patch)
tree7a41d068fbf90d72aa9a1aea897a2143c247f276
parentc1d821782a8d7948c52d01863508eabe42bd89e9 (diff)
Context globals; ctype functions
-rw-r--r--include/urweb.h18
-rw-r--r--lib/js/urweb.js14
-rw-r--r--lib/ur/basis.urs18
-rw-r--r--lib/ur/char.ur16
-rw-r--r--lib/ur/char.urs16
-rw-r--r--src/c/urweb.c101
-rw-r--r--src/compiler.sml9
-rw-r--r--src/settings.sml13
8 files changed, 203 insertions, 2 deletions
diff --git a/include/urweb.h b/include/urweb.h
index 9884a3ca..76bb9f25 100644
--- a/include/urweb.h
+++ b/include/urweb.h
@@ -229,4 +229,22 @@ extern char *uw_sqlsuffixChar;
extern char *uw_sqlsuffixBlob;
extern char *uw_sqlfmtUint4;
+void *uw_get_global(uw_context, char *name);
+void uw_set_global(uw_context, char *name, void *data, void (*free)(void*));
+
+uw_Basis_bool uw_Basis_isalnum(uw_context, uw_Basis_char);
+uw_Basis_bool uw_Basis_isalpha(uw_context, uw_Basis_char);
+uw_Basis_bool uw_Basis_isblank(uw_context, uw_Basis_char);
+uw_Basis_bool uw_Basis_iscntrl(uw_context, uw_Basis_char);
+uw_Basis_bool uw_Basis_isdigit(uw_context, uw_Basis_char);
+uw_Basis_bool uw_Basis_isgraph(uw_context, uw_Basis_char);
+uw_Basis_bool uw_Basis_islower(uw_context, uw_Basis_char);
+uw_Basis_bool uw_Basis_isprint(uw_context, uw_Basis_char);
+uw_Basis_bool uw_Basis_ispunct(uw_context, uw_Basis_char);
+uw_Basis_bool uw_Basis_isspace(uw_context, uw_Basis_char);
+uw_Basis_bool uw_Basis_isupper(uw_context, uw_Basis_char);
+uw_Basis_bool uw_Basis_isxdigit(uw_context, uw_Basis_char);
+uw_Basis_char uw_Basis_tolower(uw_context, uw_Basis_char);
+uw_Basis_char uw_Basis_toupper(uw_context, uw_Basis_char);
+
#endif
diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index 863271d9..15c9df7e 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -23,6 +23,20 @@ function mod(x, y) { return x % y; }
function lt(x, y) { return x < y; }
function le(x, y) { return x <= y; }
+// Characters
+
+function isLower(c) { return c >= 'a' && c <= 'z'; }
+function isUpper(c) { return c >= 'A' && c <= 'Z'; }
+function isAlpha(c) { return isLower(c) || isUpper(c); }
+function isDigit(c) { return c >= '0' && c <= '9'; }
+function isAlnum(c) { return isAlpha(c) || isDigit(c); }
+function isBlank(c) { return c == ' ' || c == '\t'; }
+function isSpace(c) { return isBlank(c) || c == '\r' || c == '\n'; }
+function isXdigit(c) { return isDigit(c) || (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F'); }
+function toLower(c) { return c.toLowercase(); }
+function toUpper(c) { return c.toUppercase(); }
+
+
// Lists
function cons(v, ls) {
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 31aa4cdd..200d9896 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -52,6 +52,24 @@ val ord_time : ord time
val mkOrd : t ::: Type -> {Lt : t -> t -> bool, Le : t -> t -> bool} -> ord t
+(** Character operations *)
+
+val isalnum : char -> bool
+val isalpha : char -> bool
+val isblank : char -> bool
+val iscntrl : char -> bool
+val isdigit : char -> bool
+val isgraph : char -> bool
+val islower : char -> bool
+val isprint : char -> bool
+val ispunct : char -> bool
+val isspace : char -> bool
+val isupper : char -> bool
+val isxdigit : char -> bool
+val tolower : char -> char
+val toupper : char -> char
+
+
(** String operations *)
val strlen : string -> int
diff --git a/lib/ur/char.ur b/lib/ur/char.ur
new file mode 100644
index 00000000..29e181e6
--- /dev/null
+++ b/lib/ur/char.ur
@@ -0,0 +1,16 @@
+type t = char
+
+val isAlnum = Basis.isalnum
+val isAlpha = Basis.isalpha
+val isBlank = Basis.isblank
+val isCntrl = Basis.iscntrl
+val isDigit = Basis.isdigit
+val isGraph = Basis.isgraph
+val isLower = Basis.islower
+val isPrint = Basis.isprint
+val isPunct = Basis.ispunct
+val isSpace = Basis.isspace
+val isUpper = Basis.isupper
+val isXdigit = Basis.isxdigit
+val toLower = Basis.tolower
+val toUpper = Basis.toupper
diff --git a/lib/ur/char.urs b/lib/ur/char.urs
new file mode 100644
index 00000000..02e55632
--- /dev/null
+++ b/lib/ur/char.urs
@@ -0,0 +1,16 @@
+type t = char
+
+val isAlnum : t -> bool
+val isAlpha : t -> bool
+val isBlank : t -> bool
+val isCntrl : t -> bool
+val isDigit : t -> bool
+val isGraph : t -> bool
+val isLower : t -> bool
+val isPrint : t -> bool
+val isPunct : t -> bool
+val isSpace : t -> bool
+val isUpper : t -> bool
+val isXdigit : t -> bool
+val toLower : t -> t
+val toUpper : t -> t
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 007c4125..407c622c 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -341,6 +341,12 @@ typedef struct {
uw_callback commit, rollback, free;
} transactional;
+typedef struct {
+ char *name;
+ void *data;
+ void (*free)(void*);
+} global;
+
struct uw_context {
char *(*get_header)(void *, const char *);
void *get_header_data;
@@ -374,6 +380,9 @@ struct uw_context {
transactional *transactionals;
size_t n_transactionals, used_transactionals;
+ global *globals;
+ size_t n_globals;
+
char error_message[ERROR_BUF_LEN];
};
@@ -424,6 +433,9 @@ uw_context uw_init() {
ctx->transactionals = malloc(0);
ctx->n_transactionals = ctx->used_transactionals = 0;
+ ctx->globals = malloc(0);
+ ctx->n_globals = 0;
+
return ctx;
}
@@ -450,6 +462,9 @@ void uw_free(uw_context ctx) {
for (i = 0; i < ctx->n_deltas; ++i)
buf_free(&ctx->deltas[i].msgs);
+ for (i = 0; i < ctx->n_globals; ++i)
+ ctx->globals[i].free(ctx->globals[i].data);
+
free(ctx);
}
@@ -3092,3 +3107,89 @@ const uw_Basis_time minTime = 0;
uw_Basis_time uw_Basis_now(uw_context ctx) {
return time(NULL);
}
+
+void *uw_get_global(uw_context ctx, char *name) {
+ int i;
+
+ for (i = 0; i < ctx->n_globals; ++i)
+ if (!strcmp(name, ctx->globals[i].name))
+ return ctx->globals[i].data;
+
+ return NULL;
+}
+
+void uw_set_global(uw_context ctx, char *name, void *data, void (*free)(void*)) {
+ int i;
+
+ if (data == NULL) uw_error(ctx, FATAL, "NULL data value for global '%s'", name);
+
+ for (i = 0; i < ctx->n_globals; ++i)
+ if (!strcmp(name, ctx->globals[i].name)) {
+ if (ctx->globals[i].data)
+ ctx->globals[i].free(ctx->globals[i].data);
+ ctx->globals[i].data = data;
+ ctx->globals[i].free = free;
+ return;
+ }
+
+ ++ctx->n_globals;
+ ctx->globals = realloc(ctx->globals, ctx->n_globals * sizeof(global));
+ ctx->globals[ctx->n_globals-1].name = name;
+ ctx->globals[ctx->n_globals-1].data = data;
+ ctx->globals[ctx->n_globals-1].free = free;
+}
+
+uw_Basis_bool uw_Basis_isalnum(uw_context ctx, uw_Basis_char c) {
+ return isalnum(c);
+}
+
+uw_Basis_bool uw_Basis_isalpha(uw_context ctx, uw_Basis_char c) {
+ return isalpha(c);
+}
+
+uw_Basis_bool uw_Basis_isblank(uw_context ctx, uw_Basis_char c) {
+ return isblank(c);
+}
+
+uw_Basis_bool uw_Basis_iscntrl(uw_context ctx, uw_Basis_char c) {
+ return iscntrl(c);
+}
+
+uw_Basis_bool uw_Basis_isdigit(uw_context ctx, uw_Basis_char c) {
+ return isdigit(c);
+}
+
+uw_Basis_bool uw_Basis_isgraph(uw_context ctx, uw_Basis_char c) {
+ return isgraph(c);
+}
+
+uw_Basis_bool uw_Basis_islower(uw_context ctx, uw_Basis_char c) {
+ return islower(c);
+}
+
+uw_Basis_bool uw_Basis_isprint(uw_context ctx, uw_Basis_char c) {
+ return isprint(c);
+}
+
+uw_Basis_bool uw_Basis_ispunct(uw_context ctx, uw_Basis_char c) {
+ return ispunct(c);
+}
+
+uw_Basis_bool uw_Basis_isspace(uw_context ctx, uw_Basis_char c) {
+ return isspace(c);
+}
+uw_Basis_bool uw_Basis_isupper(uw_context ctx, uw_Basis_char c) {
+ return isupper(c);
+}
+
+uw_Basis_bool uw_Basis_isxdigit(uw_context ctx, uw_Basis_char c) {
+ return isxdigit(c);
+}
+
+uw_Basis_char uw_Basis_tolower(uw_context ctx, uw_Basis_char c) {
+ return tolower(c);
+}
+
+uw_Basis_char uw_Basis_toupper(uw_context ctx, uw_Basis_char c) {
+ return toupper(c);
+}
diff --git a/src/compiler.sml b/src/compiler.sml
index 0d61b361..c8059c6e 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -508,7 +508,14 @@ fun parseUrp' fname =
| SOME _ => ErrorMsg.error "Duplicate 'timeout' directive";
timeout := SOME (valOf (Int.fromString arg)))
| "ffi" => ffi := relify arg :: !ffi
- | "link" => link := relifyA arg :: !link
+ | "link" => let
+ val arg = if size arg >= 2 andalso String.substring (arg, 0, 2) = "-l" then
+ arg
+ else
+ relifyA arg
+ in
+ link := arg :: !link
+ end
| "include" => headers := relifyA arg :: !headers
| "script" => scripts := arg :: !scripts
| "clientToServer" => clientToServer := ffiS () :: !clientToServer
diff --git a/src/settings.sml b/src/settings.sml
index 4b226a7b..f5d5a3ab 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -168,7 +168,18 @@ val jsFuncsBase = basisM [("alert", "alert"),
("strchr", "schr"),
("substring", "ssub"),
("strcspn", "sspn"),
- ("kc", "kc")]
+ ("kc", "kc"),
+
+ ("islower", "isLower"),
+ ("isupper", "isUpper"),
+ ("isalpha", "isAlpha"),
+ ("isdigit", "isDigit"),
+ ("isalnum", "isAlnum"),
+ ("isblank", "isBlank"),
+ ("isspace", "isSpace"),
+ ("isxdigit", "isXdigit"),
+ ("tolower", "toLower"),
+ ("toupper", "toUpper")]
val jsFuncs = ref jsFuncsBase
fun setJsFuncs ls = jsFuncs := foldl (fn ((k, v), m) => M.insert (m, k, v)) jsFuncsBase ls
fun jsFunc x = M.find (!jsFuncs, x)