Add integer arithmetic.

10 files changed, 175 insertions, 22 deletions

diff --git a/bytecode/src/encoding.rs b/bytecode/src/encoding.rs
index eb6633d..8bec753 100644
--- a/bytecode/src/encoding.rs
+++ b/bytecode/src/encoding.rs
@@ -40,6 +40,34 @@ pub struct Exit {
 }
 
 #[derive(Debug, Clone, Copy)]
+pub struct Add {
+    pub out: u8,
+    pub val1: Arg,
+    pub val2: Arg,
+}
+
+#[derive(Debug, Clone, Copy)]
+pub struct Sub {
+    pub out: u8,
+    pub val1: Arg,
+    pub val2: Arg,
+}
+
+#[derive(Debug, Clone, Copy)]
+pub struct Mul {
+    pub out: u8,
+    pub val1: Arg,
+    pub val2: Arg,
+}
+
+#[derive(Debug, Clone, Copy)]
+pub struct Div {
+    pub out: u8,
+    pub val1: Arg,
+    pub val2: Arg,
+}
+
+#[derive(Debug, Clone, Copy)]
 pub enum Op {
     Alloc(Alloc),
     Call,
@@ -47,6 +75,10 @@ pub enum Op {
     Peek(Peek),
     Shuf(Shuf),
     Exit(Exit),
+    Add(Add),
+    Sub(Sub),
+    Mul(Mul),
+    Div(Div),
 }
 
 struct Reader<'a> {
@@ -106,7 +138,7 @@ impl Op {
         let code_byte = r.parse_byte()?;
         let code = code_byte >> 2;
         let arg1_const = code_byte & 2 != 0;
-        // let arg2_const = code_byte & 1 != 0;
+        let arg2_const = code_byte & 1 != 0;
 
         let op = match code {
             1 => {
@@ -142,6 +174,30 @@ impl Op {
                 let val = r.parse_arg(arg1_const)?;
                 Op::Exit(Exit { val })
             }
+            7 => {
+                let out = r.parse_local()?;
+                let val1 = r.parse_arg(arg1_const)?;
+                let val2 = r.parse_arg(arg2_const)?;
+                Op::Add(Add { out, val1, val2 })
+            }
+            8 => {
+                let out = r.parse_local()?;
+                let val1 = r.parse_arg(arg1_const)?;
+                let val2 = r.parse_arg(arg2_const)?;
+                Op::Sub(Sub { out, val1, val2 })
+            }
+            9 => {
+                let out = r.parse_local()?;
+                let val1 = r.parse_arg(arg1_const)?;
+                let val2 = r.parse_arg(arg2_const)?;
+                Op::Mul(Mul { out, val1, val2 })
+            }
+            10 => {
+                let out = r.parse_local()?;
+                let val1 = r.parse_arg(arg1_const)?;
+                let val2 = r.parse_arg(arg2_const)?;
+                Op::Div(Div { out, val1, val2 })
+            }
             _ => {
                 return Err(Box::from(format!("invalid code {}", code)));
             }
diff --git a/bytecode/src/main.rs b/bytecode/src/main.rs
index a4970e0..bbc0ddd 100644
--- a/bytecode/src/main.rs
+++ b/bytecode/src/main.rs
@@ -57,6 +57,45 @@ impl State {
                 };
                 std::process::exit(i as i32);
             }
+            Op::Add(op) => {
+                let Some(v1) = self.read_arg(op.val1).to_int() else {
+                    return Err(Box::from("add needs an int"));
+                };
+                let Some(v2) = self.read_arg(op.val2).to_int() else {
+                    return Err(Box::from("add needs an int"));
+                };
+                self.heap.locals[usize::from(op.out)] = Value::from_int(v1.wrapping_add(v2));
+            }
+            Op::Sub(op) => {
+                let Some(v1) = self.read_arg(op.val1).to_int() else {
+                    return Err(Box::from("sub needs an int"));
+                };
+                let Some(v2) = self.read_arg(op.val2).to_int() else {
+                    return Err(Box::from("sub needs an int"));
+                };
+                self.heap.locals[usize::from(op.out)] = Value::from_int(v1.wrapping_sub(v2));
+            }
+            Op::Mul(op) => {
+                let Some(v1) = self.read_arg(op.val1).to_int() else {
+                    return Err(Box::from("mul needs an int"));
+                };
+                let Some(v2) = self.read_arg(op.val2).to_int() else {
+                    return Err(Box::from("mul needs an int"));
+                };
+                self.heap.locals[usize::from(op.out)] = Value::from_int(v1.wrapping_mul(v2));
+            }
+            Op::Div(op) => {
+                let Some(v1) = self.read_arg(op.val1).to_int() else {
+                    return Err(Box::from("div needs an int"));
+                };
+                let Some(v2) = self.read_arg(op.val2).to_int() else {
+                    return Err(Box::from("div needs an int"));
+                };
+                let Some(res) = v1.checked_div(v2) else {
+                    return Err(Box::from("division by zero"));
+                };
+                self.heap.locals[usize::from(op.out)] = Value::from_int(res);
+            }
         }
         Ok(())
     }
diff --git a/codegen.sml b/codegen.sml
index c7f0f2d..30928d4 100644
--- a/codegen.sml
+++ b/codegen.sml
@@ -144,7 +144,11 @@ struct
             in
               bodyASM @ funcsASM
             end
-        | Syntax.CPrimop (Syntax.PExit, [arg], _, _)=> [Syntax.OExit (translateVal arg)]
+        | Syntax.CPrimop (Syntax.PExit, [arg], _, _) => [Syntax.OExit (translateVal arg)]
+        | Syntax.CPrimop (Syntax.PAdd, [x, y], [res], [k]) => Syntax.OAdd (translate res, translateVal x, translateVal y) :: go k
+        | Syntax.CPrimop (Syntax.PSub, [x, y], [res], [k]) => Syntax.OSub (translate res, translateVal x, translateVal y) :: go k
+        | Syntax.CPrimop (Syntax.PMul, [x, y], [res], [k]) => Syntax.OMul (translate res, translateVal x, translateVal y) :: go k
+        | Syntax.CPrimop (Syntax.PDiv, [x, y], [res], [k]) => Syntax.ODiv (translate res, translateVal x, translateVal y) :: go k
         | _ => raise Fail ("malformed CPS:\n" ^ Syntax.cexpToString expr)
     in go expr
     end
diff --git a/elab.sml b/elab.sml
index 52d0089..cc73c98 100644
--- a/elab.sml
+++ b/elab.sml
@@ -5,6 +5,10 @@ struct
   fun primop (s : string) : Syntax.primop =
     case s of
       "exit" => Syntax.PExit
+    | "add" => Syntax.PAdd
+    | "sub" => Syntax.PSub
+    | "mul" => Syntax.PMul
+    | "div" => Syntax.PDiv
     | _ => raise Fail ("invalid op: " ^ s)
 
   fun elab (env : int StringMap.map) (p : Syntax.expr) : Syntax.lexp =
@@ -41,7 +45,7 @@ struct
         end
     | Syntax.ECase (expr, []) => raise Fail "nonexhaustive match"
     | Syntax.ECase (expr, (pat, body) :: rest) =>
-        if rest <> [] then raise Fail "redundant match" else
+        if not (null rest) then raise Fail "redundant match" else
         let val v = Gensym.new () in
           case pat of
             Syntax.PWild => Syntax.LApp (Syntax.LFn (v, elab env body), elab env expr)
diff --git a/linker.sml b/linker.sml
index c8f67e6..927bf48 100644
--- a/linker.sml
+++ b/linker.sml
@@ -51,28 +51,57 @@ struct
     in
       case oper of
         Syntax.OAlloc (r, v) =>
-          (makeOpcode w 1 (isConst v) false ;
-           writeVar w r ;
-           writeValue w v)
+          ( makeOpcode w 1 (isConst v) false
+          ; writeVar w r
+          ; writeValue w v
+          )
       | Syntax.OCall =>
           makeOpcode w 2 false false
       | Syntax.OPoke (off, p, v) =>
-          (makeOpcode w 3 (isConst v) false ;
-           writeOffset w off ;
-           writeVar w p ;
-           writeValue w v)
+          ( makeOpcode w 3 (isConst v) false
+          ; writeOffset w off
+          ; writeVar w p
+          ; writeValue w v
+          )
       | Syntax.OPeek (r, off, v) =>
-          (makeOpcode w 4 (isConst v) false ;
-           writeVar w r ;
-           writeOffset w off ;
-           writeValue w v)
+          ( makeOpcode w 4 (isConst v) false
+          ; writeVar w r
+          ; writeOffset w off
+          ; writeValue w v
+          )
       | Syntax.OShuf (r, v) =>
-          (makeOpcode w 5 (isConst v) false ;
-           writeVar w r ;
-           writeValue w v)
+          ( makeOpcode w 5 (isConst v) false
+          ; writeVar w r
+          ; writeValue w v
+          )
       | Syntax.OExit v =>
-          (makeOpcode w 6 (isConst v) false ;
-           writeValue w v)
+          ( makeOpcode w 6 (isConst v) false
+          ; writeValue w v
+          )
+      | Syntax.OAdd (r, v1, v2) =>
+          ( makeOpcode w 7 (isConst v1) (isConst v2)
+          ; writeVar w r
+          ; writeValue w v1
+          ; writeValue w v2
+          )
+      | Syntax.OSub (r, v1, v2) =>
+          ( makeOpcode w 8 (isConst v1) (isConst v2)
+          ; writeVar w r
+          ; writeValue w v1
+          ; writeValue w v2
+          )
+      | Syntax.OMul (r, v1, v2) =>
+          ( makeOpcode w 9 (isConst v1) (isConst v2)
+          ; writeVar w r
+          ; writeValue w v1
+          ; writeValue w v2
+          )
+      | Syntax.ODiv (r, v1, v2) =>
+          ( makeOpcode w 10 (isConst v1) (isConst v2)
+          ; writeVar w r
+          ; writeValue w v1
+          ; writeValue w v2
+          )
       | Syntax.OLabel _ => ()
     end
 
diff --git a/syntax.sml b/syntax.sml
index 3e70ba1..b91e0a2 100644
--- a/syntax.sml
+++ b/syntax.sml
@@ -31,7 +31,12 @@ struct
   (* Lambda language *)
   type var = int
 
-  datatype primop = PExit
+  datatype primop =
+    PExit
+  | PAdd
+  | PSub
+  | PMul
+  | PDiv
 
   datatype lexp =
     LVar of var
@@ -64,6 +69,10 @@ struct
   | OPeek of var * int * value
   | OShuf of var * value
   | OExit of value
+  | OAdd of var * value * value
+  | OSub of var * value * value
+  | OMul of var * value * value
+  | ODiv of var * value * value
   | OLabel of var
 
   fun listToString (show : 'a -> string) (l : 'a list) =
@@ -121,6 +130,10 @@ struct
   fun primopToString (x : primop) : string =
     case x of
       PExit => "PExit"
+    | PAdd => "PAdd"
+    | PSub => "PSub"
+    | PMul => "PMul"
+    | PDiv => "PDiv"
 
   fun lexpToString (x : lexp) : string =
     case x of
@@ -156,11 +169,15 @@ struct
 
   fun opcodeToString (oper : opcode) : string =
     case oper of
-      OAlloc (r, s) => "Var " ^ Int.toString r ^ " = OAlloc(" ^ valueToString s ^ ")"
+      OAlloc (r, s) => "Var " ^ Int.toString r ^ " = OAlloc (" ^ valueToString s ^ ")"
     | OCall => "OCall"
     | OPoke (i, p, v) => "Var " ^ Int.toString p ^ "[" ^ Int.toString i ^ "] = " ^ valueToString v
     | OPeek (r, i, p) => "Var " ^ Int.toString r ^ " = " ^ valueToString p ^ "[" ^ Int.toString i ^ "]"
     | OShuf (d, s) => "Var " ^ Int.toString d ^ " = " ^ valueToString s
-    | OExit v => "OExit " ^ valueToString v
+    | OExit v => "OExit (" ^ valueToString v ^ ")"
+    | OAdd (r, v1, v2) => "Var " ^ Int.toString r ^ " = OAdd (" ^ valueToString v1 ^ ", " ^ valueToString v2 ^ ")"
+    | OSub (r, v1, v2) => "Var " ^ Int.toString r ^ " = OSub (" ^ valueToString v1 ^ ", " ^ valueToString v2 ^ ")"
+    | OMul (r, v1, v2) => "Var " ^ Int.toString r ^ " = OMul (" ^ valueToString v1 ^ ", " ^ valueToString v2 ^ ")"
+    | ODiv (r, v1, v2) => "Var " ^ Int.toString r ^ " = ODiv (" ^ valueToString v1 ^ ", " ^ valueToString v2 ^ ")"
     | OLabel l => "OLabel " ^ Int.toString l
 end
diff --git a/tests/07-add.sml b/tests/07-add.sml
new file mode 100644
index 0000000..9892b23
--- /dev/null
+++ b/tests/07-add.sml
@@ -0,0 +1 @@
+val _ = __builtin "exit" (__builtin "add" (40, 2))
diff --git a/tests/08-multiply.sml b/tests/08-multiply.sml
new file mode 100644
index 0000000..d75c316
--- /dev/null
+++ b/tests/08-multiply.sml
@@ -0,0 +1 @@
+val _ = __builtin "exit" (__builtin "mul" (6, 7))
diff --git a/tests/09-subtract.sml b/tests/09-subtract.sml
new file mode 100644
index 0000000..2374816
--- /dev/null
+++ b/tests/09-subtract.sml
@@ -0,0 +1 @@
+val _ = __builtin "exit" (__builtin "sub" (84, 42))
diff --git a/tests/10-divide.sml b/tests/10-divide.sml
new file mode 100644
index 0000000..a701180
--- /dev/null
+++ b/tests/10-divide.sml
@@ -0,0 +1 @@
+val _ = __builtin "exit" (__builtin "div" (84, 2))