Use Finger Tree and Integer Maps as data structures for L0

.gitignore

@@ -2,3 +2,5 @@
 _build
 *.opam
 result
+*.cmi
+*.cmo

bin/dune

@@ -6,5 +6,5 @@
 (executable
  (name main)
  (public_name karuta)
- (libraries ast)
+ (libraries lib)
  (package karuta))

bin/main.ml

@@ -1 +1 @@
-let () = Ast.say_hi ()
+let () = Lib.Ast.say_hi ()

dune-project

@@ -18,6 +18,6 @@
 (package
  (name karuta)
  (synopsis "A compiler for a statically-typed relational programming language")
- (depends ocaml dune menhir batteries)
+ (depends ocaml dune menhir (batteries (>= 3.8.0)))
  (tags
   (prolog logic compiler relational warren)))

flake.nix

@@ -72,6 +72,8 @@
             src = sources.ocaml;
 
             buildInputs = [
+              ocamlPackages.menhir
+              ocamlPackages.batteries
               # Ocaml package dependencies needed to build go here.
             ];
 
@@ -143,27 +145,6 @@
               touch $out
             '';
 
-          # Check documentation generation
-          dune-doc = legacyPackages.runCommand "check-dune-doc"
-            {
-              ODOC_WARN_ERROR = "true";
-              nativeBuildInputs = [
-                ocamlPackages.dune_3
-                ocamlPackages.ocaml
-                ocamlPackages.odoc
-              ];
-            }
-            ''
-              echo "checking ocaml documentation"
-              dune build \
-                --display=short \
-                --no-print-directory \
-                --root="${sources.ocaml}" \
-                --build-dir="$(pwd)/_build" \
-                @doc
-              touch $out
-            '';
-
           # Check Nix formatting
           nixpkgs-fmt = legacyPackages.runCommand "check-nixpkgs-fmt"
             { nativeBuildInputs = [ legacyPackages.nixpkgs-fmt ]; }
@@ -202,9 +183,6 @@
               ocamlPackages.ocamlformat-rpc-lib
               # Fancy REPL thing
               ocamlPackages.utop
-              # Libraries
-              ocamlPackages.menhir
-              ocamlPackages.batteries
             ];
 
             # Tools from packages

lib/dune

@@ -4,7 +4,9 @@
 ; - https://dune.readthedocs.io/en/stable/dune-files.html#library
 
 (library
- (name ast)
+ (name lib)
+ (modules ast evaluator)
+ (libraries batteries)
  (package karuta))
 
 (documentation

lib/evaluator.ml

@@ -6,16 +6,18 @@ let question (_program : Ast.t) (_query : Ast.t) : Ast.t Map.t list =
   failwith "Not Implemented"
 
 module Heap = struct
-  type 'a t = 'a Seq.t
+  module FT = BatFingerTree
 
-  let push (heap : 'a t) (data : 'a) = Seq.cons data heap
-  let pop (heap : 'a t) = if Seq.is_empty heap then heap else Seq.drop 1 heap
+  type 'a t = 'a FT.t
 
-  let top (heap : 'a t) =
-    Option.map (function value, _ -> value) @@ Seq.uncons heap
+  let push = FT.snoc
+  let pop = FT.init
+  let top = FT.last
 
   let put (elem : 'a) (index : int) (heap : 'a t) : 'a t =
-    failwith "Not implemented"
+    FT.set heap index elem
+
+  let empty = FT.empty
 end
 
 module AbstractMachine = struct
@@ -24,43 +26,39 @@ module AbstractMachine = struct
   end
 
   open Cell
+  module FT = BatFingerTree
+  module IM = BatIMap
 
   type computer = {
     heap : Cell.t Heap.t;
-    registers : Cell.t list;
+    registers : Cell.t IM.t;
     h_register : int;
   }
 
-  (* Creates a new structure on the heap *)
   let put_structure (index_of_register : int) (functor_label, functor_arity)
       { heap; registers; h_register } =
-    let stru = Structure (h_register + 1) in
+    let structure = Structure (h_register + 1) in
     let func = Functor (functor_label, functor_arity) in
     let heap =
-      Heap.put func (h_register + 1) @@ Heap.put stru h_register heap
-    in
-    let registers =
-      List.mapi
-        (fun i elem -> if i = index_of_register then stru else elem)
-        registers
+      Heap.put func (h_register + 1) @@ Heap.put structure h_register heap
     in
+    let registers = IM.add index_of_register structure registers in
     let h_register = h_register + 2 in
     { heap; registers; h_register }
 
   let set_variable (index_of_register : int) { heap; registers; h_register } =
     let reference = Reference h_register in
     let heap = Heap.put reference h_register heap in
-    let registers =
-      List.mapi
-        (fun i elem -> if i = index_of_register then reference else elem)
-        registers
-    in
+    let registers = IM.add index_of_register reference registers in
     let h_register = h_register + 1 in
     { heap; registers; h_register }
 
   let set_value (index_of_register : int) { heap; registers; h_register } =
-    let value_of_register = List.nth registers index_of_register in
+    let value_of_register = IM.find index_of_register registers in
     let heap = Heap.put value_of_register h_register heap in
     let h_register = h_register + 1 in
     { heap; registers; h_register }
+
+  let initialize () : computer =
+    { heap = Heap.empty; registers = IM.empty ~eq:( = ); h_register = 0 }
 end

test/dune

@@ -5,8 +5,8 @@
 
 (test
  (name say_hi)
- (package karuta)
- (libraries ast))
+ (libraries lib)
+ (package karuta))
 
 ; More information on Cram tests can be found in the Dune documentation:
 ;

test/say_hi.ml

@@ -1 +1 @@
-let () = Ast.say_hi ()
+let () = Lib.Ast.say_hi ()