fix(parser): split fused >> when closing nested applied generics (#131)

The lexer emits ">>" as a single GTGT token (the right-shift operator).
In nested applied generics — `Option<Result<T, E>>` — the inner and
outer closing '>' fuse into that one GTGT, and the LR grammar (which
expects a single GT to close each type-argument list) could not proceed.
This blocked the entire stdlib surface, not just string.affine (#128).

Route Parse_driver's file/expr entry points through Menhir's incremental
API and split a GTGT into two GT tokens *driven by the parser's own
state* (`I.acceptable`): a split happens only when, in the current
state, GT is acceptable but GTGT is not — i.e. we are closing a
type-argument list, where the shift operator is ungrammatical.
Expression `a >> b` is untouched (there GTGT is acceptable). ">>>"
lexes as GTGT then GT and composes via one split plus the trailing GT.

No grammar, lexer, or expression-semantics changes. Adds focused
regression tests (nested >>, >>>, return-position, plus a shift-operator
non-regression guard). Full suite green (218 tests).

Closes #131
Refs #128

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>

Author: hyperpolymath

lib/parse_driver.ml

@@ -6,40 +6,17 @@
 (** Exception for parse errors *)
 exception Parse_error of string * Span.t
 
+module I = Parser.MenhirInterpreter
+
 (** Buffered token stream that provides Menhir-compatible interface *)
 type token_buffer = {
   mutable current_token : Token.t;
   mutable current_span : Span.t;
   mutable next_token : unit -> Token.t * Span.t;
 }
 
-(** Create a Menhir-compatible lexer function from our token stream *)
-let lexer_of_token_stream (next : unit -> Token.t * Span.t) : Lexing.lexbuf -> Parser.token =
-  (* We need to track position for Menhir *)
-  let buf = ref None in
-  let get_next () =
-    match !buf with
-    | Some (tok, span) ->
-        buf := None;
-        (tok, span)
-    | None -> next ()
-  in
-  fun lexbuf ->
-    let (tok, span) = get_next () in
-    (* Update lexbuf positions for Menhir *)
-    lexbuf.Lexing.lex_start_p <- {
-      Lexing.pos_fname = span.Span.file;
-      pos_lnum = span.start_pos.line;
-      pos_bol = span.start_pos.offset - span.start_pos.col + 1;
-      pos_cnum = span.start_pos.offset;
-    };
-    lexbuf.Lexing.lex_curr_p <- {
-      Lexing.pos_fname = span.Span.file;
-      pos_lnum = span.end_pos.line;
-      pos_bol = span.end_pos.offset - span.end_pos.col + 1;
-      pos_cnum = span.end_pos.offset;
-    };
-    (* Convert our token type to Menhir's *)
+(** Convert our token type to Menhir's. *)
+let to_menhir_token (tok : Token.t) : Parser.token =
     match tok with
     | Token.INT n -> Parser.INT n
     | Token.FLOAT f -> Parser.FLOAT f
@@ -146,27 +123,82 @@ let lexer_of_token_stream (next : unit -> Token.t * Span.t) : Lexing.lexbuf -> P
     | Token.ROW_VAR s -> Parser.ROW_VAR s
     | Token.EOF -> Parser.EOF
 
-(** Parse a program from a string *)
-let parse_string ~file content =
-  let token_stream = Lexer.from_string ~file content in
-  let lexbuf = Lexing.from_string content in
-  lexbuf.Lexing.lex_curr_p <- { lexbuf.Lexing.lex_curr_p with pos_fname = file };
-  let lexer = lexer_of_token_stream token_stream in
-  try
-    Parser.program lexer lexbuf
+(** Convert a Span position to a Menhir/Lexing position. *)
+let lexing_pos ~file (p : Span.pos) : Lexing.position =
+  { Lexing.pos_fname = file;
+    pos_lnum = p.Span.line;
+    pos_bol = p.offset - p.col + 1;
+    pos_cnum = p.offset }
+
+(** Create a Menhir-compatible lexer function from our token stream.
+    Retained for any monolithic-API caller; the file/expr entry points
+    below use the incremental driver instead. *)
+let lexer_of_token_stream (next : unit -> Token.t * Span.t) : Lexing.lexbuf -> Parser.token =
+  let buf = ref None in
+  let get_next () =
+    match !buf with
+    | Some (tok, span) -> buf := None; (tok, span)
+    | None -> next ()
+  in
+  fun lexbuf ->
+    let (tok, span) = get_next () in
+    lexbuf.Lexing.lex_start_p <- lexing_pos ~file:span.Span.file span.start_pos;
+    lexbuf.Lexing.lex_curr_p  <- lexing_pos ~file:span.Span.file span.end_pos;
+    to_menhir_token tok
+
+(* The lexer emits ">>" as a single GTGT token (the right-shift operator).
+   In nested applied generics — `Option<Result<T, E>>` — the inner and outer
+   closing '>' fuse into that one GTGT, and the LR grammar, which expects a
+   single GT to close each type-argument list, cannot proceed (issue #131).
+
+   Real LR compilers (rustc, Roslyn) solve this by splitting the token at
+   parse time, *driven by the parser's own state* rather than a lexical
+   guess: a GTGT is re-read as two GT tokens only when, in the current state,
+   the parser would accept GT but not GTGT — i.e. we are closing a type-
+   argument list, where the shift operator is not grammatical.  Expression
+   `a >> b` is untouched: there GTGT is acceptable, so no split happens.
+   `>>>` lexes as GTGT then GT and is handled by one split plus the trailing
+   GT; deeper nestings compose the same way.  This requires the incremental
+   API so we can interrogate the parser via [I.acceptable]. *)
+let drive (type a) ~file
+    (start : Lexing.position -> a I.checkpoint)
+    (next : unit -> Token.t * Span.t) : a =
+  let pending : (Parser.token * Lexing.position * Lexing.position) option ref =
+    ref None in
+  let last_span = ref Span.dummy in
+  let next_triple () =
+    match !pending with
+    | Some t -> pending := None; t
+    | None ->
+        let (tok, span) = next () in
+        last_span := span;
+        let sp = lexing_pos ~file:span.Span.file span.start_pos in
+        let ep = lexing_pos ~file:span.Span.file span.end_pos in
+        (to_menhir_token tok, sp, ep)
+  in
+  let rec run (cp : a I.checkpoint) =
+    match cp with
+    | I.InputNeeded _ ->
+        let (ptok, sp, ep) = next_triple () in
+        let triple =
+          match ptok with
+          | Parser.GTGT
+            when (not (I.acceptable cp Parser.GTGT sp))
+                 && I.acceptable cp Parser.GT sp ->
+              let mid = { sp with Lexing.pos_cnum = sp.Lexing.pos_cnum + 1 } in
+              pending := Some (Parser.GT, mid, ep);
+              (Parser.GT, sp, mid)
+          | _ -> (ptok, sp, ep)
+        in
+        run (I.offer cp triple)
+    | I.Shifting _ | I.AboutToReduce _ -> run (I.resume cp)
+    | I.HandlingError _ | I.Rejected -> raise Parser.Error
+    | I.Accepted v -> v
+  in
+  try run (start (lexing_pos ~file { Span.line = 1; col = 1; offset = 0 }))
   with
   | Parser.Error ->
-      let pos = lexbuf.Lexing.lex_curr_p in
-      let span = Span.make
-        ~file
-        ~start_pos:{ Span.line = pos.pos_lnum;
-                     col = pos.pos_cnum - pos.pos_bol + 1;
-                     offset = pos.pos_cnum }
-        ~end_pos:{ Span.line = pos.pos_lnum;
-                   col = pos.pos_cnum - pos.pos_bol + 1;
-                   offset = pos.pos_cnum }
-      in
-      raise (Parse_error ("Syntax error", span))
+      raise (Parse_error ("Syntax error", !last_span))
   | Parser_errors.Parse_action_error (msg, startpos, endpos) ->
       let span = Span.make
         ~file
@@ -179,6 +211,10 @@ let parse_string ~file content =
       in
       raise (Parse_error (msg, span))
 
+(** Parse a program from a string *)
+let parse_string ~file content =
+  drive ~file Parser.Incremental.program (Lexer.from_string ~file content)
+
 (** Parse a program from a file *)
 let parse_file filename =
   let chan = open_in_bin filename in
@@ -190,33 +226,4 @@ let parse_file filename =
 
 (** Parse a single expression from a string *)
 let parse_expr ~file content =
-  let token_stream = Lexer.from_string ~file content in
-  let lexbuf = Lexing.from_string content in
-  lexbuf.Lexing.lex_curr_p <- { lexbuf.Lexing.lex_curr_p with pos_fname = file };
-  let lexer = lexer_of_token_stream token_stream in
-  try
-    Parser.expr_only lexer lexbuf
-  with
-  | Parser.Error ->
-      let pos = lexbuf.Lexing.lex_curr_p in
-      let span = Span.make
-        ~file
-        ~start_pos:{ Span.line = pos.pos_lnum;
-                     col = pos.pos_cnum - pos.pos_bol + 1;
-                     offset = pos.pos_cnum }
-        ~end_pos:{ Span.line = pos.pos_lnum;
-                   col = pos.pos_cnum - pos.pos_bol + 1;
-                   offset = pos.pos_cnum }
-      in
-      raise (Parse_error ("Syntax error", span))
-  | Parser_errors.Parse_action_error (msg, startpos, endpos) ->
-      let span = Span.make
-        ~file
-        ~start_pos:{ Span.line = startpos.Lexing.pos_lnum;
-                     col = startpos.pos_cnum - startpos.pos_bol + 1;
-                     offset = startpos.pos_cnum }
-        ~end_pos:{ Span.line = endpos.Lexing.pos_lnum;
-                   col = endpos.pos_cnum - endpos.pos_bol + 1;
-                   offset = endpos.pos_cnum }
-      in
-      raise (Parse_error (msg, span))
+  drive ~file Parser.Incremental.expr_only (Lexer.from_string ~file content)

test/test_e2e.ml

@@ -3267,12 +3267,41 @@ let test_tuple_type_still_works () =
     (parse_check_passes
        {|fn first(t: (Int, String)) -> Int { return 0; }|})
 
+(* Issue #131: nested applied generics whose closing '>'s fuse into a single
+   ">>" (or ">>>") token must still parse — the lexer emits GTGT but the
+   driver re-splits it when closing a type-argument list. *)
+let test_angle_nested_gtgt () =
+  Alcotest.(check bool) "Option<Result<T, E>> (>> close) parses + typechecks" true
+    (parse_check_passes
+       {|fn f(o: Option<Result<Int, String>>) -> Int { return 0; }|})
+
+let test_angle_nested_gtgtgt () =
+  Alcotest.(check bool) "Option<Option<Result<T, E>>> (>>> close) parses" true
+    (parse_check_passes
+       {|fn f(o: Option<Option<Result<Int, String>>>) -> Int { return 0; }|})
+
+let test_angle_nested_return_pos () =
+  Alcotest.(check bool) "-> Result<Option<T>, E> nested in return position" true
+    (parse_check_passes
+       {|fn f() -> Result<Option<Int>, String> { return Ok(None); }|})
+
+(* Non-regression: a real right-shift expression must still be one GTGT,
+   not split, since GTGT is grammatical there. *)
+let test_shift_operator_not_split () =
+  Alcotest.(check bool) "a >> b right-shift expression unaffected by #131 fix" true
+    (parse_check_passes
+       {|fn sh(a: Int, b: Int) -> Int { return a >> b; }|})
+
 let type_syntax_sugar_tests = [
   Alcotest.test_case "fn() -> T (zero-arg fn type)"           `Quick test_fn_type_zero_arg;
   Alcotest.test_case "fn(A, B) -> T (multi-arg fn type)"      `Quick test_fn_type_multi_arg;
   Alcotest.test_case "Option<T> (angle brackets, type app)"   `Quick test_angle_brackets_type_app;
   Alcotest.test_case "Result<T, E> (angle brackets, 2 args)"  `Quick test_angle_brackets_two_args;
   Alcotest.test_case "fn f<T> (angle brackets, type params)"  `Quick test_angle_brackets_type_params;
+  Alcotest.test_case "Option<Result<T,E>> (#131 >> close)"    `Quick test_angle_nested_gtgt;
+  Alcotest.test_case "Option<Option<Result<T,E>>> (#131 >>>)" `Quick test_angle_nested_gtgtgt;
+  Alcotest.test_case "-> Result<Option<T>,E> (#131 nested)"   `Quick test_angle_nested_return_pos;
+  Alcotest.test_case "a >> b shift unaffected (#131 guard)"   `Quick test_shift_operator_not_split;
   Alcotest.test_case "(A, B) -> C (multi-arg arrow)"          `Quick test_multi_arg_arrow;
   Alcotest.test_case "(A, B) without arrow remains tuple"     `Quick test_tuple_type_still_works;
 ]