Mercurial > urweb

changeset 1571:f403e129c276

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Primitive int/float functions: ceil, float, round, trunc
author Adam Chlipala <adam@chlipala.net>
date Sat, 08 Oct 2011 17:23:58 -0400
parents c7d0328ba777
children 5530a8075b62
files include/urweb.h lib/js/urweb.js lib/ur/basis.urs src/c/urweb.c src/monoize.sml src/settings.sml
diffstat 6 files changed, 61 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- a/include/urweb.h	Sat Oct 08 14:16:13 2011 -0400
+++ b/include/urweb.h	Sat Oct 08 17:23:58 2011 -0400
@@ -348,4 +348,9 @@
 
 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
--- a/lib/js/urweb.js	Sat Oct 08 14:16:13 2011 -0400
+++ b/lib/js/urweb.js	Sat Oct 08 17:23:58 2011 -0400
@@ -93,6 +93,25 @@
 }
 
 
+// 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) {
--- a/lib/ur/basis.urs	Sat Oct 08 14:16:13 2011 -0400
+++ b/lib/ur/basis.urs	Sat Oct 08 17:23:58 2011 -0400
@@ -145,6 +145,14 @@
 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
--- a/src/c/urweb.c	Sat Oct 08 14:16:13 2011 -0400
+++ b/src/c/urweb.c	Sat Oct 08 17:23:58 2011 -0400
@@ -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 @@
 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);
+}
--- a/src/monoize.sml	Sat Oct 08 14:16:13 2011 -0400
+++ b/src/monoize.sml	Sat Oct 08 17:23:58 2011 -0400
@@ -1356,6 +1356,13 @@
             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
--- a/src/settings.sml	Sat Oct 08 14:16:13 2011 -0400
+++ b/src/settings.sml	Sat Oct 08 17:23:58 2011 -0400
@@ -270,6 +270,11 @@
                           ("debug", "alert"),
                           ("naughtyDebug", "alert"),
 
+                          ("floatFromInt", "float"),
+                          ("ceil", "ceil"),
+                          ("trunc", "trunc"),
+                          ("round", "round"),
+
                           ("now", "now"),
                           ("timeToString", "showTime"),
                           ("htmlifyTime", "showTime"),