Ott filtering with cache rejects parse

[dc-mak]

MWE and repro steps below, OCaml version 5.2.0 (may be related to this: 2672914 )

14:24 ➜  cat tmp.ott
indexvar i ::=

grammar
  terminals :: '' ::=
    | /\   :: :: and {{ tex \wedge }}

  Phi :: 'Phi_' ::=
    | Phi1 /\ ... /\ Phii ::   :: conjunction
14:25 ➜  cat tmp.tex
[[ /\ ]]
14:25 ➜  ott tmp.ott -tex_filter tmp.tex out.tex && cat out.tex
Ott version 0.34   distribution of Mon Dec 30 10:12:45 GMT 2024
 \wedge
14:25 ➜  ott tmp.ott -writesys tmp.cache
Ott version 0.34   distribution of Mon Dec 30 10:12:45 GMT 2024
system definition in file: tmp.cache
14:25 ➜  ott -readsys tmp.cache -tex_filter tmp.tex out.tex
Ott version 0.34   distribution of Mon Dec 30 10:12:45 GMT 2024
Fatal error: exception New_term_parser.Reject_parse
14:30 ➜  ocaml --version
The OCaml toplevel, version 5.2.0

[PeterSewell]

Weird. Does the marshalled thing still actually have (can you check in the IDE?) the type that Brian added?

[dc-mak]

Looks like it...

[dc-mak]

18:57 ➜ OCAMLRUNPARAM=b ott -readsys tmp.cache -tex_filter tmp.tex out.tex
Ott version 0.34   distribution of Mon Dec 30 10:12:45 GMT 2024
Fatal error: exception New_term_parser.Reject_parse
Raised at New_term_parser.build_grammar.enforce_length_constraint.(fun) in file "new_term_parser.ml" (inlined), line 365, characters 10-28
Called from New_term_parser.build_grammar.process_element.(fun) in file "new_term_parser.ml", line 380, characters 42-48
Called from Glr.Make.process_parse_tree.process_rule_node.(fun) in file "glr.ml", line 538, characters 18-45
Called from Stdlib__List.map in file "list.ml", line 87, characters 15-19
Called from Glr.Make.process_parse_tree.process_sym_node in file "glr.ml", line 604, characters 25-70
Called from Glr.Make.process_parse_tree.process_t_or_s_nodes.process in file "glr.ml", line 573, characters 18-39
Called from Glr.Make.process_parse_tree.process_rule_node in file "glr.ml", line 543, characters 10-78
Called from Stdlib__List.map in file "list.ml", line 83, characters 15-19
Called from Glr.Make.process_parse_tree.process_sym_node in file "glr.ml", line 604, characters 25-70
Called from Glr.Make.process_parse_tree.process_t_or_s_nodes.process in file "glr.ml", line 573, characters 18-39
Called from Glr.Make.process_parse_tree.process_rule_node in file "glr.ml", line 543, characters 10-78
Called from Stdlib__List.map in file "list.ml", line 83, characters 15-19
Called from Glr.Make.process_parse_tree.process_sym_node in file "glr.ml", line 604, characters 25-70
Called from Glr.Make.process_parse_tree.process_t_or_s_nodes.process in file "glr.ml", line 573, characters 18-39
Called from Glr.Make.process_parse_tree.process_rule_node in file "glr.ml", line 543, characters 10-78
Called from Stdlib__List.map in file "list.ml", line 83, characters 15-19
Called from Glr.Make.process_parse_tree.process_sym_node in file "glr.ml" (inlined), line 604, characters 25-70
Called from Glr.Make.process_parse_tree.process_component.(fun) in file "glr.ml", line 620, characters 29-48
Re-raised at Glr.Make.process_parse_tree.process_component.(fun) in file "glr.ml", line 620, characters 29-48
Called from Stdlib__List.map in file "list.ml", line 86, characters 15-19
Called from Glr.Make.process_parse_tree.process_component in file "glr.ml", lines 618-626, characters 14-19
Called from Term_parser.make_parser.new_parser in file "term_parser.ml", line 1221, characters 24-49
Called from Term_parser.parse_complete in file "term_parser.ml" (inlined), line 1128, characters 2-51
Called from Term_parser.just_one_parse in file "term_parser.ml", line 1141, characters 12-48
Called from Embed_pp.pp_embed_spec_el in file "embed_pp.ml", line 97, characters 19-79
Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
Called from Main.output_stage.filter in file "main.ml", line 851, characters 4-107
Called from Stdlib__List.iter in file "list.ml", line 112, characters 12-15
Called from Main.output_stage in file "main.ml", line 857, characters 2-52
Called from Main in file "main.ml", line 886, characters 4-64

[dc-mak]

There's two code smells at play here. I don't have the exact references at hand (I'll admit, I asked ChatGPT)

1. Pattern matching on an abstract exception in a functor in src/glr.ml.
2. Marshalling and unmarshalling exception throwing code

Anyways, here's a patch if you want to fix asap, otherwise I'll make this into a PR later.
Would be good to have some regression tests which test the marshalling and unmarshalling as equivalent (across different binary instances).

diff --git a/src/glr.ml b/src/glr.ml
index 43d4e9d..8cd4a1e 100644
--- a/src/glr.ml
+++ b/src/glr.ml
@@ -65,8 +65,6 @@ module type IN =
 sig
   include Parse_table.S
   val debug : bool
-  exception Reject_parse
-  exception Reject_all_parses
 end;;

 module Make (Pt : IN) : S with
@@ -538,7 +536,7 @@ struct
                  (rn.rule_nt.reduce_action rl,
                   idx::injection_children,
                   NTset.add rn.rule_nt.reduce_left loop)::res
-               with Reject_parse ->
+               with Types.Reject_parse ->
                  res)
           (process_t_or_s_nodes idx rn.outgoing rn.rule_nt.reduce_transparent)
           []
@@ -602,7 +600,7 @@ struct
           try
             sn.started <- true;
             List.flatten (List.map process_rule_node sn.possibilities)
-          with Reject_all_parses ->
+          with Types.Reject_all_parses ->
             []
         in
           sn.finished <- true;
diff --git a/src/new_term_parser.ml b/src/new_term_parser.ml
index c8219cb..6b1802f 100644
--- a/src/new_term_parser.ml
+++ b/src/new_term_parser.ml
@@ -245,9 +245,6 @@ module Nt = Nonterminal;;
 module GramTypes = Parse_table.MakeTypes (Gtp);;
 open GramTypes;;

-exception Reject_parse
-exception Reject_all_parses
-
 let rec split l n =
   if n = 0 then
     ([], l)
diff --git a/src/term_parser.ml b/src/term_parser.ml
index 6c2d407..28058d3 100644
--- a/src/term_parser.ml
+++ b/src/term_parser.ml
@@ -1191,8 +1191,6 @@ let make_parser xd : made_parser =
   let module Pt2 =
     struct
       include Pt
-      exception Reject_parse = New_term_parser.Reject_parse;;
-      exception Reject_all_parses = New_term_parser.Reject_all_parses;;
       let debug = false
     end
   in
diff --git a/src/types.ml b/src/types.ml
index f770b73..5ad1f73 100644
--- a/src/types.ml
+++ b/src/types.ml
@@ -39,6 +39,10 @@ exception LemTODO;;

 exception DE1 of string;;

+exception Reject_parse;;
+
+exception Reject_all_parses;;
+
 open Location;;

 (** ************************ *)

[PeterSewell]

• Marshalling and unmarshalling isn't supposed to work across different binaries - is that what's going on in your scenario?
• if not, if the above makes a difference, is it an OCaml bug?
• is the bug independent of the terminal token ?

[dc-mak]

• No, same binary, just different invocations (and different module initialisations).
• That depends entirely on whether (a) one is allowed to pattern match on an exception defined inside a functor argument (b) how exceptions are represented/registered at runtime?
• Yes, the bug is totally independent of the terminal token and is about the exception not being caught inside the functor (inserting print statements on the try and catch demonstrates this). The reason I started to debug this was that I was getting this for another production with a terminal that was much harder to work-around.

My understanding is that exception are extensible variants, and so definining a new exception add an extra variant at runtime, i.e. it is effectful during module creation/initialisation. But the manual doesn't say much on this and neither does the memory representation chapters

https://ocaml.org/manual/5.3/extensiblevariants.html

https://ocaml.org/docs/memory-representation

In the non-cache case, it is defined/registered in New_term_parser module initialisation, and then used by the functor code.

But in the cached case, my guess is that it never runs any module initialisation code from the New_term_parser, so the exception value (captured inside the closure) is raised without being registered for the exception handler.

(There may also be subtleties about matching on an exception from a functor argument, less sure about this.)

[dc-mak]

Doing a little more digging, I think it's to do with the fact that values of extensible variants (including exceptions) are not preserved by marshalling.

• https://ocaml.org/manual/5.3/api/Marshal.html#:~:text=Values%20of%20extensible,work%20as%20expected
• https://stackoverflow.com/a/54872172

There are efforts to lift this restriction:

• Make extensible variants more efficient and mashalable. ocaml/ocaml#13180
• https://github.com/let-def/distwit

I'll be honest, I don't exactly know how the value is getting captured, I think it's via the lookup closure (though I couldn't minimise this in a smaller example from scratch - perhaps the optimiser is too smart for a small example).

15:21 ➜  ./bin/ott tmp.ott -writesys tmp.cache && OCAMLRUNPARAM=b ./bin/ott -readsys tmp.cache -tex_filter tmp.tex out.tex
New_term_parser.Reject_parse has tag 56
Ott version 0.34   distribution of Mon Dec 30 10:12:45 GMT 2024
New_term_parser.Reject_parse maintains tag 56
system definition in file: tmp.cache
New_term_parser.Reject_parse has tag 56
Ott version 0.34   distribution of Mon Dec 30 10:12:45 GMT 2024
New_term_parser.Reject_parse has tag in new_parser 73
New_term_parser.Reject_parse has tag at catch 73
Fatal error: exception New_term_parser.Reject_parse

Diff for printing tags

15:21 ➜  git --no-pager diff
diff --git a/src/glr.ml b/src/glr.ml
index 43d4e9d..78918fd 100644
--- a/src/glr.ml
+++ b/src/glr.ml
@@ -535,6 +535,11 @@ struct
                res
              else
                try
+                 (let () =
+                    let a = [%extension_constructor Reject_parse] in
+                    let name = Obj.Extension_constructor.name a in
+                    let id = string_of_int @@ Obj.Extension_constructor.id a in
+                    print_string (name ^ " has tag at catch " ^ id ^"\n") in ());
                  (rn.rule_nt.reduce_action rl,
                   idx::injection_children,
                   NTset.add rn.rule_nt.reduce_left loop)::res
diff --git a/src/new_term_parser.ml b/src/new_term_parser.ml
index c8219cb..ce58890 100644
--- a/src/new_term_parser.ml
+++ b/src/new_term_parser.ml
@@ -246,7 +246,13 @@ module GramTypes = Parse_table.MakeTypes (Gtp);;
 open GramTypes;;

 exception Reject_parse
-exception Reject_all_parses
+exception Reject_all_parses;;
+
+let () =
+  let a = [%extension_constructor Reject_parse] in
+  let name = Obj.Extension_constructor.name a in
+  let id = string_of_int @@ Obj.Extension_constructor.id a in
+  print_string (name ^ " has tag " ^ id ^"\n");;

 let rec split l n =
   if n = 0 then
diff --git a/src/term_parser.ml b/src/term_parser.ml
index 6c2d407..867fa8d 100644
--- a/src/term_parser.ml
+++ b/src/term_parser.ml
@@ -1193,12 +1193,24 @@ let make_parser xd : made_parser =
       include Pt
       exception Reject_parse = New_term_parser.Reject_parse;;
       exception Reject_all_parses = New_term_parser.Reject_all_parses;;
+
+      let () =
+        let a = [%extension_constructor Reject_parse] in
+        let name = Obj.Extension_constructor.name a in
+        let id = string_of_int @@ Obj.Extension_constructor.id a in
+        print_string (name ^ " maintains tag " ^ id ^"\n")
+
       let debug = false
     end
   in
   let module P = Glr.Make (Pt2) in

   let new_parser ntr concrete s =
+    (let () =
+      let a = [%extension_constructor Pt2.Reject_parse] in
+      let name = Obj.Extension_constructor.name a in
+      let id = string_of_int @@ Obj.Extension_constructor.id a in
+      print_string (name ^ " has tag in new_parser " ^ id ^"\n") in ());
     let index = ref 0 in
     let len = String.length s in
     let get_next () =

[PeterSewell]

ha. I don't recall that caveat being there many years ago.

…

On Mon, 5 May 2025 at 15:25, Dhruv Makwana ***@***.***> wrote: *dc-mak* left a comment (ott-lang/ott#128) <#128 (comment)> Doing a little more digging, I think it's to do with the fact that values of extensible variants (including exceptions) are not preserved by marshalling. - https://ocaml.org/manual/5.3/api/Marshal.html#:~:text=Values%20of%20extensible,work%20as%20expected - https://stackoverflow.com/a/54872172 There are efforts to lift this restriction: - ocaml/ocaml#13180 <ocaml/ocaml#13180> - https://github.com/let-def/distwit I'll be honest, I don't exactly know how the value is getting captured, I think it's via the lookup closure (though I couldn't minimise this in a smaller example from scratch - perhaps the optimiser is too smart for a small example). 15:21 ➜ ./bin/ott tmp.ott -writesys tmp.cache && OCAMLRUNPARAM=b ./bin/ott -readsys tmp.cache -tex_filter tmp.tex out.tex New_term_parser.Reject_parse has tag 56 Ott version 0.34 distribution of Mon Dec 30 10:12:45 GMT 2024 New_term_parser.Reject_parse maintains tag 56 system definition in file: tmp.cache New_term_parser.Reject_parse has tag 56 Ott version 0.34 distribution of Mon Dec 30 10:12:45 GMT 2024 New_term_parser.Reject_parse has tag in new_parser 73 New_term_parser.Reject_parse has tag at catch 73 Fatal error: exception New_term_parser.Reject_parse Diff for printing tags 15:21 ➜ git --no-pager diffdiff --git a/src/glr.ml b/src/glr.ml index 43d4e9d..78918fd 100644--- a/src/glr.ml+++ b/src/glr.ml@@ -535,6 +535,11 @@ struct res else try+ (let () =+ let a = [%extension_constructor Reject_parse] in+ let name = Obj.Extension_constructor.name a in+ let id = string_of_int @@ Obj.Extension_constructor.id a in+ print_string (name ^ " has tag at catch " ^ id ^"\n") in ()); (rn.rule_nt.reduce_action rl, idx::injection_children, NTset.add rn.rule_nt.reduce_left loop)::resdiff --git a/src/new_term_parser.ml b/src/new_term_parser.ml index c8219cb..ce58890 100644--- a/src/new_term_parser.ml+++ b/src/new_term_parser.ml@@ -246,7 +246,13 @@ module GramTypes = Parse_table.MakeTypes (Gtp);; open GramTypes;; exception Reject_parse-exception Reject_all_parses+exception Reject_all_parses;;++let () =+ let a = [%extension_constructor Reject_parse] in+ let name = Obj.Extension_constructor.name a in+ let id = string_of_int @@ Obj.Extension_constructor.id a in+ print_string (name ^ " has tag " ^ id ^"\n");; let rec split l n = if n = 0 thendiff --git a/src/term_parser.ml b/src/term_parser.ml index 6c2d407..867fa8d 100644--- a/src/term_parser.ml+++ b/src/term_parser.ml@@ -1193,12 +1193,24 @@ let make_parser xd : made_parser = include Pt exception Reject_parse = New_term_parser.Reject_parse;; exception Reject_all_parses = New_term_parser.Reject_all_parses;;++ let () =+ let a = [%extension_constructor Reject_parse] in+ let name = Obj.Extension_constructor.name a in+ let id = string_of_int @@ Obj.Extension_constructor.id a in+ print_string (name ^ " maintains tag " ^ id ^"\n")+ let debug = false end in let module P = Glr.Make (Pt2) in let new_parser ntr concrete s =+ (let () =+ let a = [%extension_constructor Pt2.Reject_parse] in+ let name = Obj.Extension_constructor.name a in+ let id = string_of_int @@ Obj.Extension_constructor.id a in+ print_string (name ^ " has tag in new_parser " ^ id ^"\n") in ()); let index = ref 0 in let len = String.length s in let get_next () = — Reply to this email directly, view it on GitHub <#128 (comment)>, or unsubscribe <https://github.com/notifications/unsubscribe-auth/ABFMZZVUZKCDC223QK2ZW4D245YGBAVCNFSM6AAAAAB4KBPM5CVHI2DSMVQWIX3LMV43OSLTON2WKQ3PNVWWK3TUHMZDQNJRGE4DMNBZGY> . You are receiving this because you commented.Message ID: ***@***.***>