Prepare for M support

bin/main.ml

···
           if debug then
             Printf.printf "%s\n"
               (exa.labels |> StringMap.to_seq_keys |> List.of_seq |> String.concat ";");
-          Result.iter_error
-            (fun (e : InstResult.error_t) -> print_string (InstResult.show (Error e)))
-            (Vm.run vm))
+          Vm.run vm)
     ();
   print_newline ();
   exit 0

lib/Common.ml

···
   | X
   | T
   | F
+  | M
 
 and r_n =
   | R of register
···
   | HOST of register
   (* Communication *)
   | MODE
+  | VOID_M
   (* File Manipulation *)
   | MAKE
   | GRAB of r_n

lib/OpCode.ml

···
 
 type t = Common.op_code
 
+let is_m_op (op : t) =
+  match op with
+  | COPY (R M, _)
+  | COPY (_, M)
+  | VOID_M ->
+      true
+  | _ -> false
+
 let regInstruction name r = Printf.sprintf "%s %s" name (Register.show r)
 
 let rnInstruction name rn = Printf.sprintf "%s %s" name (Register.show_r_n rn)
···
   | LINK dest -> rnInstruction "LINK" dest
   | HOST dest -> regInstruction "HOST" dest
   | MODE -> "MODE"
+  | VOID_M -> "VOID M"
   | MAKE -> "MAKE"
   | GRAB file -> rnInstruction "GRAB" file
   | FILE dest -> regInstruction "FILE" dest
···
   | HOST _, _ -> false
   | MODE, MODE -> true
   | MODE, _ -> false
+  | VOID_M, VOID_M -> true
+  | VOID_M, _ -> false
   | MAKE, MAKE -> true
   | MAKE, _ -> false
   | GRAB f1, GRAB f2 -> Register.equal_r_n f1 f2

lib/Reader.ml

···
   | [ rn ] -> Result.bind (parse_r_n rn) (fun _ -> Error "NOT ENOUGH ARGS")
   | [ rn; r ] ->
       Result.bind (parse_r_n rn) (fun rn ->
-          Result.bind (parse_register r) (fun r -> Ok (COPY (rn, r))))
+          Result.bind (parse_register r) (fun r ->
+              match (rn, r) with
+              | R src, dest when Register.equal src dest ->
+                  Error "CANNOT REPEAT REGISTERS"
+              | _ -> Ok (COPY (rn, r))))
   | _ -> Error "TOO MANY ARGS"
 
 let math_op op src i dest =

lib/Register.ml

···
   | X -> "X"
   | T -> "T"
   | F -> "F"
+  | M -> "M"
 
 let pp ppf t = Format.fprintf ppf "%s" (show t)
 
···
   | X, X -> true
   | T, T -> true
   | F, F -> true
+  | M, M -> true
   | _ -> false
 
 type r_n = Common.r_n

lib/Vm.ml

···
   | X -> ret exa.x
   | T -> ret exa.t
   | F -> read_file exa
+  | M -> raise Unimplemented
 
 let set_register (exa : Exa.t) (reg : register) (value : Value.t) : inst_result =
   match reg with
···
       exa.t <- value;
       pass ()
   | F -> raise Unimplemented
+  | M -> raise Unimplemented
 
 let value_of_r_n (exa : Exa.t) (rn : Register.r_n) : (Value.t, error_t) result =
   match rn with
···
       match dest with
       | X -> set_register exa dest value
       | T -> set_register exa dest value
-      | F -> write_file exa value)
+      | F -> write_file exa value
+      | M -> raise Unimplemented)
 
 let clamp (i : Value.t) : Value.t =
   match i with
···
   match (exa.f, reg) with
   | None, _ -> runtime_error "NO CURRENT FILE"
   | Some f, F ->
-      if exa.f_pos >= File.length f then runtime_error "CANNNOT VOID PAST END OF FILE"
+      if exa.f_pos >= File.length f then runtime_error "CANNOT VOID PAST END OF FILE"
       else begin
         File.void f exa.f_pos;
         if exa.f_pos > File.length f then exa.f_pos <- File.length f;
···
         | LINK dest -> link exa dest
         | HOST dest -> host exa dest
         | MODE -> mode exa
+        | VOID_M -> pass ()
         | MAKE -> make vm exa
         | GRAB id -> grab exa id
         | FILE dest -> fname exa dest
···
   Dynarray.iter Debugger.disassembleExa vm.exas;
   print_newline ()
 
-let tick (vm : t) : (bool, error_t) result =
+let tick ?(live = ref false) (vm : t) : unit =
+  live := false;
   vm.tick <- vm.tick + 1;
   if vm.debug then debug_print vm;
-  let live = ref (Ok false) in
   let i = ref 0 in
-  with_return (fun return ->
-      Array.iter
-        (fun exa ->
-          match exa with
-          | None -> i := !i + 1
-          | Some exa -> (
-              if exa.dead then (
-                ignore (drop exa);
-                Dynarray.set vm.exas !i None;
-                Host.remove exa.host exa.name)
-              else
-                match execute vm exa with
-                | Ok _ ->
-                    i := !i + 1;
-                    live := Ok true
-                | Error _ as e ->
-                    exa.dead <- true;
-                    return e))
-        (vm.exas |> Dynarray.to_array);
-      !live)
+  Array.iter
+    (fun exa ->
+      match exa with
+      | None -> i := !i + 1
+      | Some exa -> (
+          if exa.dead then (
+            ignore (drop exa);
+            Dynarray.set vm.exas !i None;
+            Host.remove exa.host exa.name)
+          else
+            match execute vm exa with
+            | Ok _ ->
+                i := !i + 1;
+                live := true
+            | Error _ -> exa.dead <- true))
+    (vm.exas |> Dynarray.to_array)
 
-let run (vm : t) : (unit, error_t) result =
-  let live = ref (Ok true) in
-  while Result.is_ok !live && Result.get_ok !live = true do
-    live := tick vm
-  done;
-  Result.map ignore !live
+let run (vm : t) : unit =
+  let live = ref true in
+  while !live do
+    tick vm ~live
+  done

test/End_to_end_test.ml

···
       (match Vm.create_exa vm home "A" code with
       | Error _err -> Alcotest.(check string) "" "" (string_of_int (Random.bits ()))
       | Ok _exa ->
-          test_run vm (fun () ->
-              let f2 =
-                File.create "200" ~contents:[ Int 72; Int 52; Int 4; Int 60; Int 436 ]
-              in
-              Alcotest.check t_file "file has been changed" f2 file));
+          Vm.run vm;
+          let f2 =
+            File.create "200" ~contents:[ Int 72; Int 52; Int 4; Int 60; Int 436 ]
+          in
+          Alcotest.check t_file "file has been changed" f2 file;
+          ());
       ())

test/Helpers.ml

···
 
 let t_error_t = Alcotest.testable InstResult.pp_error_t InstResult.equal_error_t
 
-let test_run (vm : Vm.t) f =
-  match Vm.run vm with
-  | Ok () -> f ()
-  | Error (RUNTIME_ERROR e)
-  | Error (COMPILE_ERROR e) ->
-      Alcotest.(check string) "" (string_of_int (Random.bits ())) e
-
 let context_strs : string list ref = ref []
 
 (** [set_context doc] sets a top-level context for all tests in the current file.

test/Reader_test.ml

···
           Alcotest.check t_parse_result "parse_code" lines expected;
 
           ());
+
+      specify "repeated registers in COPY" (fun () ->
+          let lines = parse_code "COPY X X" in
+          let expected = Error "CANNOT REPEAT REGISTERS" in
+          Alcotest.check t_parse_result "" lines expected;
+          ());
       ())

test/Vm_test.ml

···
       match Vm.create_exa vm host "A" "LINK 800" with
       | Error _err -> Alcotest.(check string) "" "" (string_of_int (Random.bits ()))
       | Ok exa ->
-          ignore (Vm.tick vm);
+          Vm.tick vm;
           Alcotest.(check string) "" exa.host.name "other")
 
 let () =
···
       match Vm.create_exa vm host "A" code with
       | Error _ -> Alcotest.(check string) "" "" (string_of_int (Random.bits ()))
       | Ok _ ->
-          test_run vm (fun () ->
-              let f2 = File.create "200" ~contents:[ Int 100 ] in
-              Alcotest.check t_file "file has been changed" f2 f1;
-              ()))
+          Vm.run vm;
+          let f2 = File.create "200" ~contents:[ Int 100 ] in
+          Alcotest.check t_file "file has been changed" f2 f1;
+          ())

test/dune

···
   utils_test
   helpers)
  (action
-  (run %{test} --expert))
+  (run %{test} --expert -w))
  (libraries exapunks alcotest testo))
 
 (env