summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2011-10-08 17:23:58 -0400
committerGravatar Adam Chlipala <adam@chlipala.net>2011-10-08 17:23:58 -0400
commit8b909d991fe993c711d432cfc9928dc7ffbdbbac (patch)
treeaf5545a16e8c2d7f65737c161285cf78b8ed2d43
parent2b3bec54a0307652646f5ad9deff619b82cb5a91 (diff)
Primitive int/float functions: ceil, float, round, trunc
-rw-r--r--include/urweb.h5
-rw-r--r--lib/js/urweb.js19
-rw-r--r--lib/ur/basis.urs8
-rw-r--r--src/c/urweb.c17
-rw-r--r--src/monoize.sml7
-rw-r--r--src/settings.sml5
6 files changed, 61 insertions, 0 deletions
diff --git a/include/urweb.h b/include/urweb.h
index e0faebf7..219bc207 100644
--- a/include/urweb.h
+++ b/include/urweb.h
@@ -348,4 +348,9 @@ void uw_cutErrorLocation(char *);
uw_Basis_string uw_Basis_fresh(uw_context);
+uw_Basis_float uw_Basis_floatFromInt(uw_context, uw_Basis_int);
+uw_Basis_int uw_Basis_ceil(uw_context, uw_Basis_float);
+uw_Basis_int uw_Basis_trunc(uw_context, uw_Basis_float);
+uw_Basis_int uw_Basis_round(uw_context, uw_Basis_float);
+
#endif
diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index d7149eba..1cfbf0ca 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -93,6 +93,25 @@ function length(ls) {
}
+// Floats
+
+function float(n) {
+ return n;
+}
+
+function trunc(n) {
+ return ~~n;
+}
+
+function ceil(n) {
+ return Math.ceil(n);
+}
+
+function round(n) {
+ return Math.round(n);
+}
+
+
// Time
function showTime(tm) {
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index dc4d9ba2..70c1ef55 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -145,6 +145,14 @@ val signal : t ::: Type -> source t -> signal t
val current : t ::: Type -> signal t -> transaction t
+(** * Floats *)
+
+val float : int -> float
+val ceil : float -> int
+val trunc : float -> int
+val round : float -> int
+
+
(** * Time *)
val now : transaction time
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 0f1634e9..491fb73d 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -16,6 +16,7 @@
#include <openssl/des.h>
#include <openssl/rand.h>
#include <time.h>
+#include <math.h>
#include <pthread.h>
@@ -3956,3 +3957,19 @@ void uw_cutErrorLocation(char *s) {
uw_Basis_string uw_Basis_fresh(uw_context ctx) {
return uw_Basis_htmlifyInt(ctx, ctx->nextId++);
}
+
+uw_Basis_float uw_Basis_floatFromInt(uw_context ctx, uw_Basis_int n) {
+ return n;
+}
+
+uw_Basis_int uw_Basis_ceil(uw_context ctx, uw_Basis_float n) {
+ return ceil(n);
+}
+
+uw_Basis_int uw_Basis_trunc(uw_context ctx, uw_Basis_float n) {
+ return trunc(n);
+}
+
+uw_Basis_int uw_Basis_round(uw_context ctx, uw_Basis_float n) {
+ return round(n);
+}
diff --git a/src/monoize.sml b/src/monoize.sml
index f6ea7255..417bf044 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -1356,6 +1356,13 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
end
| L.EFfiApp ("Basis", "recv", _) => poly ()
+ | L.EFfiApp ("Basis", "float", [e]) =>
+ let
+ val (e, fm) = monoExp (env, st, fm) e
+ in
+ ((L'.EFfiApp ("Basis", "floatFromInt", [e]), loc), fm)
+ end
+
| L.EFfiApp ("Basis", "sleep", [n]) =>
let
val (n, fm) = monoExp (env, st, fm) n
diff --git a/src/settings.sml b/src/settings.sml
index ab1d7f88..f7bb4027 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -270,6 +270,11 @@ val jsFuncsBase = basisM [("alert", "alert"),
("debug", "alert"),
("naughtyDebug", "alert"),
+ ("floatFromInt", "float"),
+ ("ceil", "ceil"),
+ ("trunc", "trunc"),
+ ("round", "round"),
+
("now", "now"),
("timeToString", "showTime"),
("htmlifyTime", "showTime"),