Parser menhir to handmade

CHANGES.md

@@ -2,6 +2,8 @@
 
 ## 1.0.0~beta-1
 
+- [REFACTOR] Replace menhir-based parser with hand-written recursive descent parser
+- [FIX] **Big_int arithmetic support**: All arithmetic, comparison, and math operations now handle arbitrary-precision integers
 - Rename functions for clarity
 - Deprecate `..` syntax, use `descend`
 - Improve REPL completions

Makefile

@@ -120,6 +120,10 @@ demo: ## Generate demo from tape file (usage: make demo FILE=cli-basic)
 bench: ## Run benchmarks
 	./benchmarks/bench.sh
 
+.PHONY: bench-parser
+bench-parser: ## Run parser-only benchmark
+	$(DUNE) exec benchmarks/bench_parser.exe
+
 .PHONY: release
 release: ## Create a new release (usage: make release VERSION=1.2.3)
 	@if [ -z "$(VERSION)" ]; then \

benchmarks/bench_parser.ml

@@ -0,0 +1,99 @@
+let queries =
+  [
+    ("identity", ".");
+    ("field_access", ".foo.bar.baz");
+    ("array_index", ".[0]");
+    ("pipe_chain", ".foo | .bar | .baz | .qux");
+    ("map_simple", "map(.x + 1)");
+    ("arithmetic", "1 + 2 * 3 - 4 / 5 % 6");
+    ("comparison", ". > 5 and . < 10 or . == 0");
+    ("array_construct", "[.[] | {name: .name, city: .address.city}]");
+    ("object_construct", "{a: .x, b: .y, c: (.z | to_string)}");
+    ( "if_then_else",
+      "if . > 0 then \"positive\" elif . < 0 then \"negative\" else \"zero\" \
+       end" );
+    ("reduce", "reduce .[] as $x (0; . + $x)");
+    ("foreach", "[foreach .[] as $x (0; . + $x; .)]");
+    ("fn_def", "fn double: . * 2; fn add1: . + 1; map(double | add1)");
+    ("try_catch", "try .foo catch \"not found\"");
+    ("string_interp", "\"Hello, \\(.name)! Age: \\(.age)\"");
+    ( "complex_real_world",
+      "group_by(.category) | [.[]] | map({category: .[0].category, count: \
+       length, total: (map(.val) | add)})" );
+    ( "nested_functions",
+      "fn fact: if . <= 1 then 1 else . * ((. - 1) | fact) end; 10 | fact" );
+    ( "filter_chain",
+      ".[] | select(.active == true and .age >= 18) | {name: .name, email: \
+       .email}" );
+    ("update_assign", ".foo |= . + 1 | .bar += 2 | .baz -= 3");
+    ("optional_access", ".foo?.bar?[]? | select(. > 0)");
+    ("range_expressions", "[range(0; 10; 2)] | map(. * .)");
+    ( "walk_transform",
+      "walk(if type == \"object\" then with_entries(.key |= to_uppercase) else \
+       . end)" );
+  ]
+
+let warmup_iterations = 1_000
+let iterations = 100_000
+let word_size = Sys.word_size / 8
+
+type result = {
+  elapsed : float;
+  minor_words : float;
+  promoted_words : float;
+  minor_collections : int;
+}
+
+let bench query =
+  for _ = 1 to warmup_iterations do
+    let buf = Sedlexing.Utf8.from_string query in
+    ignore (Parser.program buf)
+  done;
+  Gc.compact ();
+  let before = Gc.quick_stat () in
+  let start = Unix.gettimeofday () in
+  for _ = 1 to iterations do
+    let buf = Sedlexing.Utf8.from_string query in
+    ignore (Parser.program buf)
+  done;
+  let elapsed = Unix.gettimeofday () -. start in
+  let after = Gc.quick_stat () in
+  {
+    elapsed;
+    minor_words = after.minor_words -. before.minor_words;
+    promoted_words = after.promoted_words -. before.promoted_words;
+    minor_collections = after.minor_collections - before.minor_collections;
+  }
+
+let () =
+  let n = Float.of_int iterations in
+  let total_queries = List.length queries in
+  Printf.printf "Parser Benchmark (%d iterations, %d warmup)\n\n" iterations
+    warmup_iterations;
+  Printf.printf "%-22s %8s %8s %8s %6s\n" "Query" "ns/op" "B/op" "prom/op" "GCs";
+  Printf.printf "%s\n" (String.make 56 '-');
+  let total_time = ref 0.0 in
+  let total_minor_w = ref 0.0 in
+  let total_promoted = ref 0.0 in
+  let total_gcs = ref 0 in
+  List.iter
+    (fun (name, query) ->
+      let r = bench query in
+      let ns = r.elapsed /. n *. 1e9 in
+      let bytes = r.minor_words /. n *. Float.of_int word_size in
+      let promoted = r.promoted_words /. n *. Float.of_int word_size in
+      Printf.printf "%-22s %8.0f %8.0f %8.0f %6d\n" name ns bytes promoted
+        r.minor_collections;
+      total_time := !total_time +. r.elapsed;
+      total_minor_w := !total_minor_w +. r.minor_words;
+      total_promoted := !total_promoted +. r.promoted_words;
+      total_gcs := !total_gcs + r.minor_collections)
+    queries;
+  let total_parses = Float.of_int total_queries *. n in
+  Printf.printf "%s\n" (String.make 56 '-');
+  Printf.printf "%-22s %8.0f %8.0f %8.0f %6d\n" "AVERAGE"
+    (!total_time /. total_parses *. 1e9)
+    (!total_minor_w /. total_parses *. Float.of_int word_size)
+    (!total_promoted /. total_parses *. Float.of_int word_size)
+    !total_gcs;
+  Printf.printf "\n%.2fM parses in %.3fs\n" (total_parses /. 1e6) !total_time

benchmarks/dune

@@ -0,0 +1,3 @@
+(executable
+ (name bench_parser)
+ (libraries query-json.core unix sedlex))

cli/test/errors.t

@@ -33,7 +33,7 @@ startswith is deprecated
 
   error[deprecated]: `startswith` is deprecated
     --> startswith("Hello")
-        ^^^^^^^^^^^
+        ^^^^^^^^^^^^^^^^^^^
 
     hint: use `starts_with` instead
 
@@ -51,7 +51,7 @@ endswith is deprecated
 
   error[deprecated]: `endswith` is deprecated
     --> endswith("world")
-        ^^^^^^^^^
+        ^^^^^^^^^^^^^^^^^
 
     hint: use `ends_with` instead
 

dune-project

@@ -1,6 +1,5 @@
 (lang dune 3.17)
 
-(using menhir 2.0)
 (using melange 0.1)
 
 (name query-json)
@@ -33,7 +32,6 @@
   (ocaml (>= 5.4.0))
   (dune (>= 3.17))
   dune-build-info
-  (menhir (>= 20250903))
   (cmdliner (>= 1.1.0))
   sedlex
   ppx_deriving

query-json.opam

@@ -17,7 +17,6 @@ depends: [
   "ocaml" {>= "5.4.0"}
   "dune" {>= "3.17" & >= "3.17"}
   "dune-build-info"
-  "menhir" {>= "20250903"}
   "cmdliner" {>= "1.1.0"}
   "sedlex"
   "ppx_deriving"

source/Ast.ml

@@ -1,12 +1,9 @@
-(* Custom pp for Z.t since ppx_deriving can't derive it *)
-let pp_z fmt z = Format.fprintf fmt "%s" (Z.to_string z)
-
 type literal =
   | Bool of bool (* true *)
   | String of string (* "TEXT" *)
   | Int of int (* small integers that fit in native int *)
   | Int64 of int64 (* large integers that need 64-bit *)
-  | Big_int of Z.t [@printer fun fmt z -> pp_z fmt z]
+  | Big_int of Z.t [@printer fun fmt z -> Z.pp_print fmt z]
     (* huge integers beyond int64 range *)
   | Float of float (* 123.0 - floating point literals *)
   | Null (* null *)

source/Core.ml

@@ -6,70 +6,41 @@ end
 
 let last_position = ref Location.none
 
-exception Lexer_error of string
-
-let provider ~debug buf =
-  let start, _ = Sedlexing.lexing_positions buf in
-  let token =
-    match Lexer.tokenize buf with
-    | Ok t -> t
-    | Error e ->
-        let _, stop = Sedlexing.lexing_positions buf in
-        last_position := { loc_start = start; loc_end = stop };
-        raise (Lexer_error e)
-  in
-  let _, stop = Sedlexing.lexing_positions buf in
-  last_position := { loc_start = start; loc_end = stop };
-  if debug then print_endline (Lexer.show_token token);
-  (token, start, stop)
-
-let menhir = MenhirLib.Convert.Simplified.traditional2revised Parser.program
-
 let position_to_string start end_ =
   Printf.sprintf "[line: %d, char: %d-%d]" start.Lexing.pos_lnum
     (start.Lexing.pos_cnum - start.Lexing.pos_bol)
     (end_.Lexing.pos_cnum - end_.Lexing.pos_bol)
 
 let parse ~debug ~colorize input =
   let buf = Sedlexing.Utf8.from_string input in
-  let next_token () = provider ~debug buf in
-  match menhir next_token with
+  match Parser.program buf with
   | ast ->
       if debug then print_endline (Ast.show_expression ast);
       Ok ast
-  | exception Lexer_error msg ->
-      if debug then (
-        print_endline "Lexer error";
-        print_endline msg);
-      let Location.{ loc_start; loc_end; _ } = !last_position in
+  | exception Error.Parse_error (err, start, end_) ->
+      last_position := { loc_start = start; loc_end = end_ };
       let err =
-        Query_error.lexer_error ~message:msg ~input
-          ~start_pos:loc_start.pos_cnum ~end_pos:loc_end.pos_cnum
+        Error.with_location ~input ~start_pos:start.pos_cnum
+          ~end_pos:end_.pos_cnum err
       in
-      Error (Query_error.format ~colorize err)
+      Error (Error.format ~colorize err)
   | exception Failure msg ->
+      let Location.{ loc_start; loc_end; _ } = !last_position in
       let err =
-        Query_error.semantic_error ~message:msg ~input
-          ~start_pos:!last_position.loc_start.pos_cnum
-          ~end_pos:!last_position.loc_end.pos_cnum
-      in
-      Error (Query_error.format ~colorize err)
-  | exception Query_error.Parse_error (err, start, end_) ->
-      let err =
-        Query_error.with_location ~input ~start_pos:start.pos_cnum
-          ~end_pos:end_.pos_cnum err
+        Error.semantic_error ~message:msg ~input ~start_pos:loc_start.pos_cnum
+          ~end_pos:loc_end.pos_cnum
       in
-      Error (Query_error.format ~colorize err)
+      Error (Error.format ~colorize err)
   | exception _exn ->
       let Location.{ loc_start; loc_end; _ } = !last_position in
       let err =
-        Query_error.parse_error ~input ~start_pos:loc_start.pos_cnum
+        Error.parse_error ~input ~start_pos:loc_start.pos_cnum
           ~end_pos:loc_end.pos_cnum
           ~message:
             (Printf.sprintf "problem parsing at %s"
                (position_to_string loc_start loc_end))
       in
-      Error (Query_error.format ~colorize err)
+      Error (Error.format ~colorize err)
 
 let run ?(debug = false) ?(colorize = true) ?(verbose = false) ?(raw = false)
     ?(summarize = false) query json =