From 0e05c750288835240f585b6750b8ed7f809d10bb Mon Sep 17 00:00:00 2001
From: Louis Gesbert <louis.gesbert@ocamlpro.com>
Date: Fri, 21 Jun 2024 12:09:40 +0200
Subject: [PATCH] Internal typing: print the faulty program when debug is
 enabled

Since the typing error happened on generated code, it's hard to debug without
printing it.
---
 compiler/shared_ast/typing.ml | 24 +++++++++++++-----------
 1 file changed, 13 insertions(+), 11 deletions(-)

diff --git a/compiler/shared_ast/typing.ml b/compiler/shared_ast/typing.ml
index 91cce748..0fd92d49 100644
--- a/compiler/shared_ast/typing.ml
+++ b/compiler/shared_ast/typing.ml
@@ -1108,18 +1108,20 @@ let program ?fail_on_any ?assume_op_types ?(internal_check=false) prg =
     if internal_check then
       fun f ->
         try Message.with_delayed_errors f with
-        | Message.CompilerErrors errs ->
+        | Message.CompilerError _ | Message.CompilerErrors _ as exc ->
           let bt = Printexc.get_raw_backtrace () in
-          Printexc.raise_with_backtrace
-            (Message.CompilerErrors
-               (List.map Message.Content.to_internal_error errs))
-            bt
-        | Message.CompilerError err ->
-          let bt = Printexc.get_raw_backtrace () in
-          Printexc.raise_with_backtrace
-            (Message.CompilerError
-               (Message.Content.to_internal_error err))
-            bt
+          let err = match exc with
+            | Message.CompilerError err ->
+              Message.CompilerError
+                (Message.Content.to_internal_error err)
+            | Message.CompilerErrors errs ->
+              Message.CompilerErrors
+                (List.map Message.Content.to_internal_error errs)
+            | _ -> assert false
+          in
+          Message.debug "Faulty intermediate program:@ %a"
+            (Print.program ~debug:true) prg;
+          Printexc.raise_with_backtrace err bt
     else
       fun f -> Message.with_delayed_errors f
   in