diff options
| -rw-r--r-- | users/wpcarro/scratch/compiler/expr_parser.ml | 35 | ||||
| -rw-r--r-- | users/wpcarro/scratch/compiler/parser.ml | 23 | ||||
| -rw-r--r-- | users/wpcarro/scratch/compiler/register_vm.ml | 73 | ||||
| -rw-r--r-- | users/wpcarro/scratch/compiler/type_parser.ml | 29 | ||||
| -rw-r--r-- | users/wpcarro/scratch/compiler/vec.ml | 127 |
5 files changed, 192 insertions, 95 deletions
diff --git a/users/wpcarro/scratch/compiler/expr_parser.ml b/users/wpcarro/scratch/compiler/expr_parser.ml index 8ac6756a4af3..797592931a2c 100644 --- a/users/wpcarro/scratch/compiler/expr_parser.ml +++ b/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 diff --git a/users/wpcarro/scratch/compiler/parser.ml b/users/wpcarro/scratch/compiler/parser.ml index 75cbe04a3f72..dc66f2506ed3 100644 --- a/users/wpcarro/scratch/compiler/parser.ml +++ b/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 } - -let get (i : int) (xs : 'a array) : 'a option = - if i >= Array.length xs then None else Some xs.(i) +type state = { i : int; tokens : token vec } -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 diff --git a/users/wpcarro/scratch/compiler/register_vm.ml b/users/wpcarro/scratch/compiler/register_vm.ml index 17d3f558942f..0a573048e77e 100644 --- a/users/wpcarro/scratch/compiler/register_vm.ml +++ b/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) diff --git a/users/wpcarro/scratch/compiler/type_parser.ml b/users/wpcarro/scratch/compiler/type_parser.ml index a11dcdba2b82..99cc8bbc4f4e 100644 --- a/users/wpcarro/scratch/compiler/type_parser.ml +++ b/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 diff --git a/users/wpcarro/scratch/compiler/vec.ml b/users/wpcarro/scratch/compiler/vec.ml new file mode 100644 index 000000000000..549078c5d87a --- /dev/null +++ b/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 + |