changeset 390:519366a76603

num_float
author Adam Chlipala <adamc@hcoop.net>
date Tue, 21 Oct 2008 10:40:22 -0400 (2008-10-21)
parents acaf9d19fbb7
children fe8f75f7e130
files lib/basis.urs src/cjr_print.sml src/compiler.sml src/monoize.sml tests/num.ur
diffstat 5 files changed, 27 insertions(+), 2 deletions(-) [+]
line wrap: on
line diff
--- a/lib/basis.urs	Tue Oct 21 10:34:07 2008 -0400
+++ b/lib/basis.urs	Tue Oct 21 10:40:22 2008 -0400
@@ -26,6 +26,7 @@
 val div : t ::: Type -> num t -> t -> t -> t
 val mod : t ::: Type -> num t -> t -> t -> t
 val num_int : num int
+val num_float : num float
 
 
 (** String operations *)
--- a/src/cjr_print.sml	Tue Oct 21 10:34:07 2008 -0400
+++ b/src/cjr_print.sml	Tue Oct 21 10:40:22 2008 -0400
@@ -617,6 +617,7 @@
       | EBinop (s, e1, e2) =>
         if Char.isAlpha (String.sub (s, size s - 1)) then
             box [string s,
+                 string "(",
                  p_exp env e1,
                  string ",",
                  space,
@@ -2054,6 +2055,8 @@
              newline,
              string "#include <string.h>",
              newline,
+             string "#include <math.h>",
+             newline,
              string "#include <postgresql/libpq-fe.h>",
              newline,
              newline,
--- a/src/compiler.sml	Tue Oct 21 10:34:07 2008 -0400
+++ b/src/compiler.sml	Tue Oct 21 10:40:22 2008 -0400
@@ -512,7 +512,7 @@
         val driver_o = clibFile "driver.o"
 
         val compile = "gcc -Wstrict-prototypes -Werror -O3 -I include -c " ^ cname ^ " -o " ^ oname
-        val link = "gcc -Werror -O3 -pthread -lpq " ^ urweb_o ^ " " ^ oname ^ " " ^ driver_o ^ " -o " ^ ename
+        val link = "gcc -Werror -O3 -lm -pthread -lpq " ^ urweb_o ^ " " ^ oname ^ " " ^ driver_o ^ " -o " ^ ename
     in
         if not (OS.Process.isSuccess (OS.Process.system compile)) then
             print "C compilation failed\n"
--- a/src/monoize.sml	Tue Oct 21 10:34:07 2008 -0400
+++ b/src/monoize.sml	Tue Oct 21 10:40:22 2008 -0400
@@ -633,6 +633,25 @@
                        intBin "/",
                        intBin "%")
             end
+          | L.EFfi ("Basis", "num_float") =>
+            let
+                fun floatBin s =
+                    (L'.EAbs ("x", (L'.TFfi ("Basis", "float"), loc),
+                              (L'.TFun ((L'.TFfi ("Basis", "float"), loc), (L'.TFfi ("Basis", "float"), loc)), loc),
+                              (L'.EAbs ("y", (L'.TFfi ("Basis", "float"), loc),
+                                        (L'.TFfi ("Basis", "float"), loc),
+                                        (L'.EBinop (s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
+            in
+                numEx ((L'.TFfi ("Basis", "float"), loc),
+                       (L'.EAbs ("x", (L'.TFfi ("Basis", "float"), loc),
+                                 (L'.TFfi ("Basis", "float"), loc),
+                                 (L'.EUnop ("-", (L'.ERel 0, loc)), loc)), loc),
+                       floatBin "+",
+                       floatBin "-",
+                       floatBin "*",
+                       floatBin "/",
+                       floatBin "fmod")
+            end
                        
           | L.ECApp ((L.EFfi ("Basis", "show"), _), t) =>
             let
--- a/tests/num.ur	Tue Oct 21 10:34:07 2008 -0400
+++ b/tests/num.ur	Tue Oct 21 10:40:22 2008 -0400
@@ -1,3 +1,5 @@
 fun main () : transaction page = return <xml><body>
-  {txt _ (-1)}, {txt _ (1 + 1)}, {txt _ (9 - 3)}, {txt _ (9 * 3)}, {txt _ (9 / 3)}, {txt _ (9 % 3)}
+  {txt _ (-1)}, {txt _ (1 + 1)}, {txt _ (9 - 3)}, {txt _ (9 * 3)}, {txt _ (9 / 3)}, {txt _ (9 % 3)}<br/>
+  {txt _ (-1.1)}, {txt _ (1.0 + 1.1)}, {txt _ (9.1 - 3.0)}, {txt _ (9.1 * 3.0)},
+  {txt _ (9.1 / 3.0)}, {txt _ (9.1 % 3.0)}<br/>
 </body></xml>