Add LINK, and tests

bin/main.ml

···
   Printexc.record_backtrace true;
   print_newline ();
   let vm = Vm.init ~debug:true () in
-  let host = Host.create "home" 9 in
+  let home = Host.create "home" in
+  let inbox = Host.create "inbox" in
+  let outbox = Host.create "outbox" in
+  Vm.add_host vm home;
+  Vm.add_host vm inbox;
+  Vm.add_host vm outbox;
+  Vm.connect_hosts home [ (800, inbox, -1) ];
+  Vm.connect_hosts inbox [ (800, outbox, -1) ];
   let file = File.create "200" ~contents:[ Int 72; Int 52; Int 4; Int 60 ] in
-  Vm.add_host vm host;
-  Vm.place_file vm host file;
+  Vm.place_file vm inbox file;
   let code =
     {|
-GRAB 200
-COPY F X
-ADDI X F X
-MULI X F X
-SUBI X F X
-COPY X F
-SEEK -9999
-VOID F
-SEEK -3
-FILE T
-  |}
+    LINK 800
+    GRAB 200
+    COPY F X
+    ADDI X F X
+    MULI X F X
+    SUBI X F X
+    COPY X F
+    LINK 800
+    |}
   in
-  (match Vm.create_exa vm host "A" code with
+  (match Vm.create_exa vm home "A" code with
   | Error err -> print_string err
   | Ok _ ->
       Result.iter_error
         (fun (e : InstResult.error_t) -> print_string (InstResult.show (Error e)))
         (Vm.run vm));
   print_newline ();
-
-  let f2 = File.create "300" ~contents:[ Int 72; Int 52; Int 4; Int 60; Int 436 ] in
-  Printf.printf "Results good? %b" (File.equal file f2);
   exit 0

lib/Common.ml

···
   | TEST_LT of r_n * r_n
   | TEST_GT of r_n * r_n
   (* Movement *)
+  | LINK of r_n
   | HOST of register
   (* File Manipulation *)
   | MAKE
···
   name : string;
   grid_size : int;
   mutable grid : obj StringMap.t;
+  mutable links : host IntMap.t;
 }
 
 and value =

lib/Exa.ml

···
    file, You can obtain one at https://mozilla.org/MPL/2.0/. *)
 
 open Common
+
 type t = Common.exa
 
 let create ?(code = Dynarray.create ()) (name : string) (host : host) : t =

lib/File.ml

···
    file, You can obtain one at https://mozilla.org/MPL/2.0/. *)
 
 open Common
+
 type t = Common.file
 
 let file_gensym = ref 0

lib/Host.ml

···
 
 type t = Common.host
 
-let create (name : string) (size : int) : t =
-  { name; grid = StringMap.create 0; grid_size = size }
+type links = (int * t * int) list
+
+let create ?(size = 9) ?(links = []) (name : string) : t =
+  {
+    name;
+    grid = StringMap.create size;
+    grid_size = size;
+    links = links |> List.to_seq |> IntMap.of_seq;
+  }
+
+let show (host : t) : string =
+  Printf.sprintf "{| name = %s; links = [ %s ] |}" host.name
+    (host.links |> IntMap.to_seq
+    |> Seq.map (fun ((i : int), (h : t)) -> Printf.sprintf "(%i %s)" i h.name)
+    |> List.of_seq |> String.concat "; ")
 
 let add (host : t) (obj : Object.t) =
   if StringMap.length host.grid >= host.grid_size then false
···
     | F _ -> None)
 
 let remove (host : t) (name : string) = StringMap.remove host.grid name
+
+let add_links (host : t) (links : links) =
+  List.iter
+    (fun (there, dest, back) ->
+      IntMap.replace host.links there dest;
+      IntMap.replace dest.links back host)
+    links
+
+let get_link (host : t) (link : int) = IntMap.find_opt host.links link

lib/OpCode.ml

···
   | TEST_EQ (left, right) -> testInstruction "TEST" left "=" right
   | TEST_LT (left, right) -> testInstruction "TEST" left "<" right
   | TEST_GT (left, right) -> testInstruction "TEST" left ">" right
+  | LINK dest -> rnInstruction "LINK" dest
   | HOST dest -> regInstruction "HOST" dest
   | MAKE -> "MAKE"
   | GRAB file -> rnInstruction "GRAB" file
···
   | TEST_LT _, _
   | TEST_GT _, _ ->
       false
+  | LINK dest1, LINK dest2 -> Register.equal_r_n dest1 dest2
+  | LINK _, _ -> false
   | HOST r1, HOST r2 -> Register.equal r1 r2
   | HOST _, _ -> false
   | MAKE, MAKE -> true

lib/Reader.ml

···
                     | `TEST_GT -> TEST_GT (left, right)))))
   | _ -> Error "TOO MANY ARGS"
 
+let parse_link args =
+  match args with
+  | [] -> Error "NOT ENOUGH ARGS"
+  | [ rn ] -> Result.bind (parse_r_n rn) (fun rn -> Ok (LINK rn))
+  | _ -> Error "TOO MANY ARGS"
+
+let parse_host args =
+  match args with
+  | [] -> Error "NOT ENOUGH ARGS"
+  | [ r ] -> Result.bind (parse_register r) (fun r -> Ok (HOST r))
+  | _ -> Error "TOO MANY ARGS"
+
 let parse_grab args =
   match args with
   | [] -> Error "NOT ENOUGH ARGS"
···
   | "FJMP" -> parse_mark args
   | "TEST" -> parse_test args
   | "MAKE" -> Ok MAKE
+  | "HOST" -> parse_host args
+  | "LINK" -> parse_link args
   | "GRAB" -> parse_grab args
   | "FILE" -> parse_file args
   | "SEEK" -> parse_seek args

lib/Utils.ml

···
   seq |> List.map fn |> String.concat join
 
 module StringMap = Hashtbl.Make (String)
+module IntMap = Hashtbl.Make (Int)
+
+let merge tab1 tab2 =
+  Hashtbl.(
+    tab2 |> to_seq |> replace_seq tab1;
+    tab1)

lib/Vm.ml

···
 
 let add_host (vm : t) (host : Host.t) : unit = StringMap.add vm.hosts host.name host
 
+let connect_hosts (host : Host.t) links = Host.add_links host links
+
 let add_file (vm : t) (file : File.t) : unit = StringMap.add vm.files file.name file
 
 let place_exa (vm : t) (host : Host.t) (exa : Exa.t) : unit =
···
 let host (exa : Exa.t) (dest : register) : inst_result =
   set_register exa dest (Value.key exa.host.name)
 
+let link (_vm : t) (exa : Exa.t) (dest : r_n) : inst_result =
+  match value_of_r_n exa dest with
+  | Error _ as e -> e
+  | Ok (Key _) -> runtime_error "CANNOT LINK WITH KEYWORD"
+  | Ok (Int i) -> (
+      match Host.get_link exa.host i with
+      | None ->
+          Printf.printf "exa.host: %s\n" (Host.show exa.host);
+          runtime_error "NO MATCHING LINK"
+      | Some dest ->
+          if Host.add dest (E exa) then (
+            Host.remove exa.host exa.name;
+            exa.host <- dest);
+          pass ())
+
 let grab (exa : Exa.t) (src : r_n) : inst_result =
   match value_of_r_n exa src with
   | Error _ as e -> e
···
   match exa.f with
   | None -> runtime_error "NO CURRENT FILE"
   | Some file ->
-      if
-        Host.add exa.host (F file)
-      then (
+      if Host.add exa.host (F file) then (
         exa.f <- None;
         exa.f_pos <- 0;
         pass ())
···
       | TEST_EQ (left, right) -> test_fn exa left test_eq right
       | TEST_LT (left, right) -> test_fn exa left test_lt right
       | TEST_GT (left, right) -> test_fn exa left test_gt right
+      | LINK dest -> link vm exa dest
       | HOST dest -> host exa dest
       | MAKE -> make vm exa
       | GRAB id -> grab exa id

test/End_to_end_test.ml

···
+(* This Source Code Form is subject to the terms of the Mozilla Public
+   License, v. 2.0. If a copy of the MPL was not distributed with this
+   file, You can obtain one at https://mozilla.org/MPL/2.0/. *)
+
+open Exapunks
+open Helpers
+
+let () = set_context __FILE__
+
+let () =
+  specify "tutorial 2" (fun () ->
+      let vm = Vm.init () in
+      let home = Host.create "home" in
+      let inbox = Host.create "inbox" in
+      let outbox = Host.create "outbox" in
+      Vm.add_host vm home;
+      Vm.add_host vm inbox;
+      Vm.add_host vm outbox;
+      Vm.connect_hosts home [ (800, inbox, -1) ];
+      Vm.connect_hosts inbox [ (800, outbox, -1) ];
+      let file = File.create "200" ~contents:[ Int 72; Int 52; Int 4; Int 60 ] in
+      Vm.place_file vm inbox file;
+      let code =
+        {|
+        LINK 800
+        GRAB 200
+        COPY F X
+        ADDI X F X
+        MULI X F X
+        SUBI X F X
+        COPY X F
+        LINK 800
+        |}
+      in
+      (match Vm.create_exa vm home "A" code with
+      | Error e -> Alcotest.(check string) "" e (string_of_int (Random.bits ()))
+      | Ok _exa ->
+          ignore (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/Exapunks_test.ml

···
    License, v. 2.0. If a copy of the MPL was not distributed with this
    file, You can obtain one at https://mozilla.org/MPL/2.0/. *)
 
+open End_to_end_test
 open File_test
 open Reader_test
 open Vm_test

test/Helpers.ml

···
 
 let setup ?(hostsize = 9) (hostname : string) =
   let vm = Vm.init () in
-  let host = Host.create hostname hostsize in
+  let host = Host.create ~size:hostsize hostname in
   Vm.add_host vm host;
   (vm, host)

test/Vm_test.ml

···
       ignore (Vm.host exa X);
       Alcotest.check t_value "correct" exa.x (Value.key "home");
       ())
+
+let () =
+  specify "#link" (fun () ->
+      let vm, host = setup "home" in
+      let dest = Host.create "other" in
+      Vm.add_host vm dest;
+      Vm.connect_hosts host [ (800, dest, -1) ];
+      match Vm.create_exa vm host "A" "LINK 800" with
+      | Error e -> Alcotest.(check string) "" e (string_of_int (Random.bits ()))
+      | Ok exa ->
+          ignore (Vm.tick vm);
+          Alcotest.(check string) "" exa.host.name "other")

test/dune

···
 
 (tests
  (names exapunks_test)
- (modules exapunks_test vm_test file_test reader_test helpers)
+ (modules exapunks_test vm_test file_test reader_test end_to_end_test helpers)
  (action
   (run %{test} --expert))
  (libraries exapunks alcotest testo))