feat(wpcarro/compiler): Support Vector type

Support an array that dynamically resizes itself, and replace usages of `List`,
`Array`, and `Queue` with `Vec`.

Change-Id: I910b140b7c1bdddae40e08f8191986dccbc6fddf
Reviewed-on: https://cl.tvl.fyi/c/depot/+/7080
Tested-by: BuildkiteCI
Reviewed-by: wpcarro <wpcarro@gmail.com>

users/wpcarro/scratch/compiler/expr_parser.ml

@@ -31,24 +31,15 @@ open Parser
 open Inference
 open Debug
 open Prettify
-
-let to_array (q : 'a Queue.t) : 'a array =
-  let result = Array.make (Queue.length q) "" in
-  let i = ref 0 in
-  Queue.iter
-    (fun x ->
-      result.(!i) <- x;
-      i := !i + 1)
-    q;
-  result
+open Vec
 
 type literal = LiteralBool of bool | LiteralInt of int
 
 let ( let* ) = Option.bind
 let map = Option.map
 
-let tokenize (x : string) : token array =
-  let q = Queue.create () in
+let tokenize (x : string) : token vec =
+  let xs = Vec.create () in
   let i = ref 0 in
   while !i < String.length x do
     match x.[!i] with
@@ -62,13 +53,13 @@ let tokenize (x : string) : token array =
         i := !i + 1
       done;
       curr := !curr ^ "\"";
-      Queue.push !curr q;
+      Vec.append !curr xs;
       i := !i + 1
     | '(' ->
-        Queue.push "(" q;
+        Vec.append "(" xs;
         i := !i + 1
     | ')' ->
-        Queue.push ")" q;
+        Vec.append ")" xs;
         i := !i + 1
     | _ ->
         let token = ref "" in
@@ -76,9 +67,9 @@ let tokenize (x : string) : token array =
           token := !token ^ String.make 1 x.[!i];
           i := !i + 1
         done;
-        Queue.push !token q
+        Vec.append !token xs
   done;
-  to_array q
+  xs
 
 let parse_symbol (p : parser) : string option =
   let* x = p#curr in
@@ -108,7 +99,7 @@ let parse_literal (p : parser) : Types.value option =
          p#advance;
          Some (ValueLiteral (LiteralInt n))
       | _ -> 
-        if String.starts_with "\"" x then
+        if String.starts_with ~prefix:"\"" x then
           begin
             p#advance;
             Some (ValueLiteral (LiteralString x))
@@ -158,10 +149,10 @@ and parse_binding (p : parser) : Types.value option =
      Some (Types.ValueBinder (name, value, body))
   | _ -> parse_funcdef p
 
-let print_tokens (xs : string array) =
-  xs |> Array.to_list
-  |> List.map (Printf.sprintf "\"%s\"")
-  |> String.concat ", "
+let print_tokens (xs : string vec) : unit =
+  xs 
+  |> Vec.map (Printf.sprintf "\"%s\"")
+  |> Vec.join ", "
   |> Printf.sprintf "tokens: [ %s ]"
   |> print_string 
   |> print_newline

users/wpcarro/scratch/compiler/parser.ml

@@ -1,24 +1,23 @@
-(*******************************************************************************
+(****************************************************************************** 
  * Defines a generic parser class.
  ******************************************************************************)
 
+open Vec
+
 exception ParseError of string
 
 type token = string
-type state = { i : int; tokens : token array }
+type state = { i : int; tokens : token vec }
 
-let get (i : int) (xs : 'a array) : 'a option =
-  if i >= Array.length xs then None else Some xs.(i)
-
-class parser (tokens : token array) =
+class parser (tokens : token vec) =
   object (self)
-    val mutable tokens : token array = tokens
+    val mutable tokens = tokens
     val mutable i = ref 0
-    method print_state = Printf.sprintf "{ i = %d; }" !i
+
     method advance = i := !i + 1
-    method prev : token option = get (!i - 1) tokens
-    method curr : token option = get !i tokens
-    method next : token option = get (!i + 1) tokens
+    method prev : token option = Vec.get (!i - 1) tokens
+    method curr : token option = Vec.get !i tokens
+    method next : token option = Vec.get (!i + 1) tokens
 
     method consume : token option =
       match self#curr with
@@ -43,6 +42,6 @@ class parser (tokens : token array) =
             end
           else false
 
-    method exhausted : bool = !i >= Array.length tokens
+    method exhausted : bool = !i >= Vec.length tokens
     method state : state = { i = !i; tokens }
   end

users/wpcarro/scratch/compiler/register_vm.ml

@@ -15,6 +15,8 @@
   $ ocamlformat --inplace --enable-outside-detected-project ./register_vm.ml
  *)
 
+open Vec
+
 type reg = X | Y | Res
 type binop = int -> int -> int
 
@@ -41,10 +43,10 @@ type opcode1 =
   | Op1PopAndSet of int
   | Op1Null
 
-type opcodes0 = opcode0 array
-type opcodes1 = opcode1 array
+type opcodes0 = opcode0 vec
+type opcodes1 = opcode1 vec
 
-let registers : int array = Array.make 8 0
+let registers : int vec = Vec.make 8 0
 let stack : int Stack.t = Stack.create ()
 let reg_idx (r : reg) : int = match r with X -> 0 | Y -> 1 | Res -> 2
 
@@ -64,40 +66,26 @@ let print_opcodes0 (xs : opcodes0) : opcodes0 =
           (reg_name rhs)
     | Op0Null -> ()
   in
-  Array.iter print_opcode xs;
+  Vec.iter print_opcode xs;
   xs
 
-(* Mutatively add xs to ys *)
-let add_ops (xs : opcodes0) (ys : opcodes0) (i : int ref) : unit =
-  let j = ref 0 in
-  while xs.(!j) != Op0Null do
-    ys.(!i) <- xs.(!j);
-    i := !i + 1;
-    j := !j + 1
-  done
-
 let rec compile (ast : ast) : opcodes0 =
-  let result : opcodes0 = Array.make 20 Op0Null and i : int ref = ref 0 in
+  let result : opcodes0 = Vec.create () in
   (match ast with
-  | Const x ->
-      result.(!i) <- Op0AssignRegLit (Res, x);
-      i := !i + 1
-  | Add (lhs, rhs) -> compile_bin_op ( + ) lhs rhs result i
-  | Sub (lhs, rhs) -> compile_bin_op ( - ) lhs rhs result i
-  | Mul (lhs, rhs) -> compile_bin_op ( * ) lhs rhs result i
-  | Div (lhs, rhs) -> compile_bin_op ( / ) lhs rhs result i);
+   | Const x -> Vec.append (Op0AssignRegLit (Res, x)) result;
+   | Add (lhs, rhs) -> compile_bin_op ( + ) lhs rhs result
+   | Sub (lhs, rhs) -> compile_bin_op ( - ) lhs rhs result
+   | Mul (lhs, rhs) -> compile_bin_op ( * ) lhs rhs result
+   | Div (lhs, rhs) -> compile_bin_op ( / ) lhs rhs result);
   result
 
-and compile_bin_op (f : binop) (lhs : ast) (rhs : ast) (result : opcodes0)
-    (i : int ref) =
-  add_ops (compile lhs) result i;
-  result.(!i) <- Op0PushReg Res;
-  i := !i + 1;
-  add_ops (compile rhs) result i;
-  result.(!i + 1) <- Op0PopAndSet X;
-  result.(!i) <- Op0AssignRegReg (Y, Res);
-  result.(!i + 2) <- Op0BinOp (f, X, Y, Res);
-  i := !i + 3
+and compile_bin_op (f : binop) (lhs : ast) (rhs : ast) (result : opcodes0) =
+  lhs |> compile |> Vec.append_to result;
+  Vec.append (Op0PushReg Res) result;
+  rhs |> compile |> Vec.append_to result;
+  Vec.append (Op0PopAndSet X) result;
+  Vec.append (Op0AssignRegReg (Y, Res)) result;
+  Vec.append (Op0BinOp (f, X, Y, Res)) result
 
 let compile_registers (xs : opcodes0) : opcodes1 =
   let do_compile x =
@@ -106,34 +94,35 @@ let compile_registers (xs : opcodes0) : opcodes1 =
     | Op0AssignRegReg (dst, src) -> Op1AssignRegReg (reg_idx dst, reg_idx src)
     | Op0PushReg src -> Op1PushReg (reg_idx src)
     | Op0PopAndSet dst -> Op1PopAndSet (reg_idx dst)
-    | Op0BinOp (f, lhs, rhs, dst) ->
-        Op1BinOp (f, reg_idx lhs, reg_idx rhs, reg_idx dst)
+    | Op0BinOp (f, lhs, rhs, dst) -> Op1BinOp (f, reg_idx lhs, reg_idx rhs, reg_idx dst)
     | Op0Null -> Op1Null
   in
-  Array.map do_compile xs
+  Vec.map do_compile xs
 
 let eval (xs : opcodes1) : int =
   let ip = ref 0 in
-  while !ip < Array.length xs do
-    match xs.(!ip) with
+  while !ip < Vec.length xs do
+    match Vec.get_unsafe !ip xs with
     | Op1AssignRegLit (dst, x) ->
-        registers.(dst) <- x;
+        Vec.set dst x registers;
         ip := !ip + 1
     | Op1AssignRegReg (dst, src) ->
-        registers.(dst) <- registers.(src);
+        Vec.set dst (Vec.get_unsafe src registers) registers;
         ip := !ip + 1
     | Op1PushReg src ->
-        Stack.push registers.(src) stack;
+        Stack.push (Vec.get_unsafe src registers) stack;
         ip := !ip + 1
     | Op1PopAndSet dst ->
-        registers.(dst) <- Stack.pop stack;
+        Vec.set dst (Stack.pop stack) registers;
         ip := !ip + 1
     | Op1BinOp (f, lhs, rhs, dst) ->
-        registers.(dst) <- f registers.(lhs) registers.(rhs);
+        let lhs = Vec.get_unsafe lhs registers in
+        let rhs = Vec.get_unsafe rhs registers in
+        Vec.set dst (f lhs rhs) registers;
         ip := !ip + 1
     | Op1Null -> ip := !ip + 1
   done;
-  registers.(reg_idx Res)
+  Vec.get_unsafe (reg_idx Res) registers
 ;;
 
 Add (Mul (Const 2, Div (Const 100, Const 2)), Const 5)

users/wpcarro/scratch/compiler/type_parser.ml

@@ -15,6 +15,7 @@ open Types
 open Prettify
 open Parser
 open Inference
+open Vec
 
 type side = LHS | RHS
 
@@ -23,18 +24,8 @@ let ( let* ) = Option.bind
 let printsub (s : substitution) =
   s |> Debug.substitution |> print_string |> print_newline
 
-let to_array (q : 'a Queue.t) : 'a array =
-  let result = Array.make (Queue.length q) "" in
-  let i = ref 0 in
-  Queue.iter
-    (fun x ->
-      result.(!i) <- x;
-      i := !i + 1)
-    q;
-  result
-
-let tokenize (x : string) : token array =
-  let q = Queue.create () in
+let tokenize (x : string) : token vec =
+  let xs = Vec.create () in
   let i = ref 0 in
   while !i < String.length x do
     match x.[!i] with
@@ -44,9 +35,9 @@ let tokenize (x : string) : token array =
        while (!i < String.length x) && (x.[!i] != ' ') do
          i := !i + 1
        done;
-       Queue.push (String.sub x beg (!i - beg)) q
+       Vec.append (String.sub x beg (!i - beg)) xs
   done;
-  to_array q
+  xs
 
 let rec parse_type (p : parser) : _type option =
   parse_function p
@@ -69,13 +60,13 @@ and parse_variable (p : parser) : _type option =
   | Some x when String.length x = 1 -> p#advance; Some (TypeVariable x)
   | _ -> None
 
-let print_tokens (xs : string array) =
+let print_tokens (xs : string vec) =
   xs
-  |> Array.to_list
-  |> List.map (Printf.sprintf "\"%s\"")
-  |> String.concat ", "
+  |> Vec.map (Printf.sprintf "\"%s\"")
+  |> Vec.join ", "
   |> Printf.sprintf "tokens: [ %s ]"
-  |> print_string |> print_newline
+  |> print_string 
+  |> print_newline
 
 let print_type (t : _type) =
   t |> Debug.type' |> Printf.sprintf "type: %s" |> print_string |> print_newline

users/wpcarro/scratch/compiler/vec.ml

@@ -0,0 +1,127 @@
+(****************************************************************************** 
+ * Similar to Python's list
+ *
+ * - mutable
+ * - dynamically resized
+ * - O(1) read
+ * - O(1) write
+ * - O(1) append (average case)
+ *
+ ******************************************************************************)
+
+type 'a vec = {
+  mutable length: int;
+  mutable capacity: int;
+  mutable xs: 'a array;
+}
+
+(****************************************************************************** 
+ * Constructors
+ ******************************************************************************)
+
+let make (size : int) (seed : 'a) : 'a vec = { 
+  length = size;
+  capacity = size;
+  xs = Array.make size seed;
+}
+
+let create () = {
+  length = 0;
+  capacity = 0;
+  xs = [||];
+}
+
+let from_array (xs : 'a array) : 'a vec = {
+  length = Array.length xs;
+  capacity = Array.length xs;
+  xs = xs;
+}
+
+let from_list (xs : 'a list) : 'a vec = 
+  match xs with
+  | [] -> create ()
+  | y::ys -> 
+    let result = {
+      length = List.length xs;
+      capacity = List.length xs;
+      xs = Array.make (List.length xs) y;
+    } in
+    List.iteri (fun i x -> Array.set result.xs i x) xs;
+    result
+
+(****************************************************************************** 
+ * Miscellaneous
+ ******************************************************************************)
+
+let append (x : 'a) (v : 'a vec) =
+  if v.capacity = 0 then
+    begin
+      v.length <- 1;
+      v.capacity <- 1;
+      v.xs <- [|x|];
+    end
+  else if v.length = v.capacity then
+    begin
+      (* According to Wikipedia, Python uses 1.25 as the growth factor *)
+      let new_cap = v.capacity |> float_of_int |> Float.mul 1.25 |> ceil |> int_of_float in
+      let new_xs = Array.make new_cap x in
+      Array.iteri (fun i x -> Array.set new_xs i x) v.xs;
+      v.capacity <- new_cap;
+      v.xs <- new_xs;
+      Array.set v.xs v.length x;
+      v.length <- v.length + 1;
+    end
+  else
+    begin
+      Array.set v.xs v.length x;
+      v.length <- v.length + 1;
+    end
+
+let get (i : int) (v : 'a vec) : 'a option =
+  if i >= v.length then
+    None
+  else
+    Some v.xs.(i)
+
+let get_unsafe (i : int) (v : 'a vec) : 'a =
+  v.xs.(i)
+
+let set (i : int) (x : 'a) (v : 'a vec) : unit =
+  if i < v.length then
+    Array.set v.xs i x
+
+let length (v : 'a vec) : int = 
+  v.length
+
+let update (i : int) (f : 'a -> 'a) (v : 'a vec) : unit =
+  match get i v with
+  | None -> ()
+  | Some x -> set i (f x) v
+
+let iter (f : 'a -> unit) (v : 'a vec) : unit =
+  let n = ref 0 in
+  while !n < v.length do
+    f v.xs.(!n);
+    n := !n + 1;
+  done
+
+let join (sep : string) (v : string vec) : string =
+  if length v = 0 then
+    ""
+  else
+    let i = ref 1 in
+    let result = ref v.xs.(0) in
+    while !i < v.length do
+      result := !result ^ sep ^ v.xs.(!i);
+      i := !i + 1;
+    done;
+    !result
+
+let map (f : 'a -> 'b) (v : 'a vec) : 'b vec =
+  let result = create () in
+  iter (fun x -> append (f x) result) v;
+  result
+
+let append_to (dst : 'a vec) (xs : 'a vec) : unit =
+  iter (fun x -> append x dst) xs
+