summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2010-03-04 13:47:16 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2010-03-04 13:47:16 -0500
commit44dd54e977e98bc68c94d4cccc344d2ee769e8ec (patch)
tree59d474ae7fde02a0d0cd787a576b3f4d25170106
parent46e60fb6904b05340446e12d4a88a090b19b85fa (diff)
Louder jscomp; toUpper/Lower fix for JavaScript
-rw-r--r--lib/js/urweb.js4
-rw-r--r--lib/ur/top.ur8
-rw-r--r--lib/ur/top.urs12
-rw-r--r--src/jscomp.sml6
4 files changed, 26 insertions, 4 deletions
diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index 13e80e30..697f197f 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -33,8 +33,8 @@ 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(); }
+function toLower(c) { return c.toLowerCase(); }
+function toUpper(c) { return c.toUpperCase(); }
// Lists
diff --git a/lib/ur/top.ur b/lib/ur/top.ur
index b6e4f6cf..617423db 100644
--- a/lib/ur/top.ur
+++ b/lib/ur/top.ur
@@ -215,6 +215,14 @@ fun mapX3 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [tf3 :: K -> Type] [ctx :: {
<xml>{f [nm] [t] [rest] ! r1 r2 r3}{acc}</xml>)
<xml/>
+fun query1 [t ::: Name] [fs ::: {Type}] [state ::: Type] (q : sql_query [t = fs] [])
+ (f : $fs -> state -> transaction state) (i : state) =
+ query q (fn r => f r.t) i
+
+fun query1' [t ::: Name] [fs ::: {Type}] [state ::: Type] (q : sql_query [t = fs] [])
+ (f : $fs -> state -> state) (i : state) =
+ query q (fn r s => return (f r.t s)) i
+
fun queryL [tables] [exps] [tables ~ exps] (q : sql_query tables exps) =
query q
(fn r ls => return (r :: ls))
diff --git a/lib/ur/top.urs b/lib/ur/top.urs
index 83f24000..312f230a 100644
--- a/lib/ur/top.urs
+++ b/lib/ur/top.urs
@@ -129,6 +129,18 @@ val queryL : tables ::: {{Type}} -> exps ::: {Type}
sql_query tables exps
-> transaction (list $(exps ++ map (fn fields :: {Type} => $fields) tables))
+val query1 : t ::: Name -> fs ::: {Type} -> state ::: Type
+ -> sql_query [t = fs] []
+ -> ($fs -> state -> transaction state)
+ -> state
+ -> transaction state
+
+val query1' : t ::: Name -> fs ::: {Type} -> state ::: Type
+ -> sql_query [t = fs] []
+ -> ($fs -> state -> state)
+ -> state
+ -> transaction state
+
val queryI : tables ::: {{Type}} -> exps ::: {Type}
-> [tables ~ exps] =>
sql_query tables exps
diff --git a/src/jscomp.sml b/src/jscomp.sml
index ed913168..1e11fa32 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008, Adam Chlipala
+(* Copyright (c) 2008-2010, Adam Chlipala
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
@@ -1173,7 +1173,9 @@ fun process file =
| EJavaScript (m, e') =>
(foundJavaScript := true;
jsExp m outer (e', st)
- handle CantEmbed t => ((*Print.preface ("Can't embed", MonoPrint.p_typ MonoEnv.empty t);*)
+ handle CantEmbed t => ((*ErrorMsg.errorAt loc "Unable to embed type in JavaScript";*)
+ Print.preface ("Can't embed type in JavaScript",
+ MonoPrint.p_typ MonoEnv.empty t);
(e, st)))
| ESignalReturn e =>