num working for int

7 files changed, 139 insertions, 14 deletions

diff --git a/lib/basis.urs b/lib/basis.urs
index 177554a9..18cd4c37 100644
--- a/lib/basis.urs
+++ b/lib/basis.urs
@@ -18,6 +18,15 @@ val eq_int : eq int
 val eq_string : eq string
 val eq_bool : eq bool
 
+class num
+val neg : t ::: Type -> num t -> t -> t
+val plus : t ::: Type -> num t -> t -> t -> t
+val minus : t ::: Type -> num t -> t -> t -> t
+val times : t ::: Type -> num t -> t -> t -> t
+val div : t ::: Type -> num t -> t -> t -> t
+val mod : t ::: Type -> num t -> t -> t -> t
+val num_int : num int
+
 
 (** String operations *)
 
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 5f430ccf..e0441425 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -614,19 +614,20 @@ fun p_exp' par env (e, loc) =
                           space,
                           p_exp' true env e1])
 
-      | EBinop ("!strcmp", e1, e2) =>
-        box [string "!strcmp(",
-             p_exp env e1,
-             string ",",
-             space,
-             p_exp env e2,
-             string ")"]
       | EBinop (s, e1, e2) =>
-        parenIf par (box [p_exp' true env e1,
-                          space,
-                          string s,
-                          space,
-                          p_exp' true env e2])
+        if Char.isAlpha (String.sub (s, size s - 1)) then
+            box [string s,
+                 p_exp env e1,
+                 string ",",
+                 space,
+                 p_exp env e2,
+                 string ")"]
+        else
+            parenIf par (box [p_exp' true env e1,
+                              space,
+                              string s,
+                              space,
+                              p_exp' true env e2])
 
       | ERecord (i, xes) => box [string "({",
                                  space,
diff --git a/src/monoize.sml b/src/monoize.sml
index 21798b0f..c00695d6 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -100,6 +100,18 @@ fun monoType env =
                     in
                         (L'.TFun (t, (L'.TFun (t, (L'.TFfi ("Basis", "bool"), loc)), loc)), loc)
                     end
+                  | L.CApp ((L.CFfi ("Basis", "num"), _), t) =>
+                    let
+                        val t = mt env dtmap t
+                    in
+                        (L'.TRecord [("Neg", (L'.TFun (t, t), loc)),
+                                     ("Plus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                                     ("Minus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                                     ("Times", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                                     ("Div", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                                     ("Mod", (L'.TFun (t, (L'.TFun (t, t), loc)), loc))],
+                         loc)
+                    end
                   | L.CApp ((L.CFfi ("Basis", "show"), _), t) =>
                     (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc)
                   | L.CApp ((L.CFfi ("Basis", "read"), _), t) =>
@@ -469,6 +481,21 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             (E.errorAt loc "Unsupported expression";
              Print.eprefaces' [("Expression", CorePrint.p_exp env all)];
              (dummyExp, fm))
+
+        fun numTy t =
+            (L'.TRecord [("Neg", (L'.TFun (t, t), loc)),
+                         ("Plus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                         ("Minus", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                         ("Times", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                         ("Div", (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                         ("Mod", (L'.TFun (t, (L'.TFun (t, t), loc)), loc))], loc)
+        fun numEx (t, neg, plus, minus, times, dv, md) =
+            ((L'.ERecord [("Neg", neg, (L'.TFun (t, t), loc)),
+                          ("Plus", plus, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                          ("Minus", minus, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                          ("Times", times, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                          ("Div", dv, (L'.TFun (t, (L'.TFun (t, t), loc)), loc)),
+                          ("Mod", md, (L'.TFun (t, (L'.TFun (t, t), loc)), loc))], loc), fm)
     in
         case e of
             L.EPrim p => ((L'.EPrim p, loc), fm)
@@ -545,6 +572,68 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                  (L'.EBinop ("!strcmp", (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc),
              fm)
 
+          | L.ECApp ((L.EFfi ("Basis", "neg"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("r", numTy t, (L'.TFun (t, t), loc),
+                           (L'.EField ((L'.ERel 0, loc), "Neg"), loc)), loc), fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "plus"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("r", numTy t, (L'.TFun (t, (L'.TFun (t, t), loc)), loc),
+                           (L'.EField ((L'.ERel 0, loc), "Plus"), loc)), loc), fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "minus"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("r", numTy t, (L'.TFun (t, (L'.TFun (t, t), loc)), loc),
+                           (L'.EField ((L'.ERel 0, loc), "Minus"), loc)), loc), fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "times"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("r", numTy t, (L'.TFun (t, (L'.TFun (t, t), loc)), loc),
+                           (L'.EField ((L'.ERel 0, loc), "Times"), loc)), loc), fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "div"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("r", numTy t, (L'.TFun (t, (L'.TFun (t, t), loc)), loc),
+                           (L'.EField ((L'.ERel 0, loc), "Div"), loc)), loc), fm)
+            end
+          | L.ECApp ((L.EFfi ("Basis", "mod"), _), t) =>
+            let
+                val t = monoType env t
+            in
+                ((L'.EAbs ("r", numTy t, (L'.TFun (t, (L'.TFun (t, t), loc)), loc),
+                           (L'.EField ((L'.ERel 0, loc), "Mod"), loc)), loc), fm)
+            end
+          | L.EFfi ("Basis", "num_int") =>
+            let
+                fun intBin s =
+                    (L'.EAbs ("x", (L'.TFfi ("Basis", "int"), loc),
+                              (L'.TFun ((L'.TFfi ("Basis", "int"), loc), (L'.TFfi ("Basis", "int"), loc)), loc),
+                              (L'.EAbs ("y", (L'.TFfi ("Basis", "int"), loc),
+                                        (L'.TFfi ("Basis", "int"), loc),
+                                        (L'.EBinop (s, (L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)
+            in
+                numEx ((L'.TFfi ("Basis", "int"), loc),
+                       (L'.EAbs ("x", (L'.TFfi ("Basis", "int"), loc),
+                                 (L'.TFfi ("Basis", "int"), loc),
+                                 (L'.EUnop ("-", (L'.ERel 0, loc)), loc)), loc),
+                       intBin "+",
+                       intBin "-",
+                       intBin "*",
+                       intBin "/",
+                       intBin "%")
+            end
+                       
           | L.ECApp ((L.EFfi ("Basis", "show"), _), t) =>
             let
                 val t = monoType env t
diff --git a/src/urweb.grm b/src/urweb.grm
index 3511093c..183f9afd 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -158,6 +158,14 @@ fun sql_relop (oper, sqlexp1, sqlexp2, loc) =
         (EApp (e, sqlexp2), loc)
     end
 
+fun native_unop (oper, e1, loc) =
+    let
+        val e = (EVar (["Basis"], oper), loc)
+        val e = (EApp (e, (EWild, loc)), loc)
+    in
+        (EApp (e, e1), loc)
+    end
+
 fun native_op (oper, e1, e2, loc) =
     let
         val e = (EVar (["Basis"], oper), loc)
@@ -183,7 +191,7 @@ fun tagIn bt =
  | SYMBOL of string | CSYMBOL of string
  | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE
  | EQ | COMMA | COLON | DCOLON | TCOLON | DOT | HASH | UNDER | UNDERUNDER | BAR
- | DIVIDE | DOTDOTDOT
+ | PLUS | MINUS | DIVIDE | DOTDOTDOT | MOD
  | CON | LTYPE | VAL | REC | AND | FUN | FOLD | UNIT | KUNIT | CLASS
  | DATATYPE | OF
  | TYPE | NAME
@@ -335,7 +343,8 @@ fun tagIn bt =
 %right ARROW
 %left WITH
 %right PLUSPLUS MINUSMINUS
-%right STAR
+%left PLUS MINUS
+%left STAR DIVIDE MOD
 %left NOT
 %nonassoc TWIDDLE
 %nonassoc DOLLAR
@@ -682,6 +691,12 @@ eexp   : eapps                          (eapps)
                                          end)
        | eexp EQ eexp                   (native_op ("eq", eexp1, eexp2, s (eexp1left, eexp2right)))
        | eexp NE eexp                   (native_op ("ne", eexp1, eexp2, s (eexp1left, eexp2right)))
+       | MINUS eterm                    (native_unop ("neg", eterm, s (MINUSleft, etermright)))
+       | eexp PLUS eexp                 (native_op ("plus", eexp1, eexp2, s (eexp1left, eexp2right)))
+       | eexp MINUS eexp                (native_op ("minus", eexp1, eexp2, s (eexp1left, eexp2right)))
+       | eterm STAR eexp                (native_op ("times", eterm, eexp, s (etermleft, eexpright)))
+       | eexp DIVIDE eexp               (native_op ("div", eexp1, eexp2, s (eexp1left, eexp2right)))
+       | eexp MOD eexp                  (native_op ("mod", eexp1, eexp2, s (eexp1left, eexp2right)))
        | eexp WITH cterm EQ eexp        (EWith (eexp1, cterm, eexp2), s (eexp1left, eexp2right))
 
 eargs  : earg                           (earg)
diff --git a/src/urweb.lex b/src/urweb.lex
index cd6cf66a..a3c34a16 100644
--- a/src/urweb.lex
+++ b/src/urweb.lex
@@ -274,6 +274,11 @@ notags = [^<{\n]+;
 <INITIAL> "<-"        => (Tokens.LARROW (pos yypos, pos yypos + size yytext));
 <INITIAL> ";"         => (Tokens.SEMI (pos yypos, pos yypos + size yytext));
 
+<INITIAL> "+"         => (Tokens.PLUS (pos yypos, pos yypos + size yytext));
+<INITIAL> "-"         => (Tokens.MINUS (pos yypos, pos yypos + size yytext));
+<INITIAL> "/"         => (Tokens.DIVIDE (yypos, yypos + size yytext));
+<INITIAL> "%"         => (Tokens.MOD (pos yypos, pos yypos + size yytext));
+
 <INITIAL> "con"       => (Tokens.CON (pos yypos, pos yypos + size yytext));
 <INITIAL> "type"      => (Tokens.LTYPE (pos yypos, pos yypos + size yytext));
 <INITIAL> "datatype"  => (Tokens.DATATYPE (pos yypos, pos yypos + size yytext));
diff --git a/tests/num.ur b/tests/num.ur
new file mode 100644
index 00000000..6dab5ac3
--- /dev/null
+++ b/tests/num.ur
@@ -0,0 +1,3 @@
+fun main () : transaction page = return <xml><body>
+  {txt _ (-1)}, {txt _ (1 + 1)}, {txt _ (9 - 3)}, {txt _ (9 * 3)}, {txt _ (9 / 3)}, {txt _ (9 % 3)}
+</body></xml>
diff --git a/tests/num.urp b/tests/num.urp
new file mode 100644
index 00000000..50b5ed87
--- /dev/null
+++ b/tests/num.urp
@@ -0,0 +1,3 @@
+debug
+
+num