From a8b4394093e61b050406ca952a6d017ad1c737e4 Mon Sep 17 00:00:00 2001
From: Jason Gross <jgross@mit.edu>
Date: Thu, 14 Mar 2019 16:14:45 -0400
Subject: Add constr_fail and constr_fail_with

Rather than taking the convention that failures during constr
construction emit a type error from `I : I` with the actual error
message `idtac`d above them (because Coq has no way to emit multiple
things on stderr), we instead factor everything through a new
`constr_fail` or `constr_fail_with msg_tac`, which emit more helpful
messages instructing the user to look in `*coq*` or to use `Fail`/`try`
to see the more informative error message.  When we can make our own
version that does both `idtac` and `fail` (c.f.
https://github.com/coq/coq/issues/3913), then we can do something a bit
more sane, hopefully.
---
 src/Util/ListUtil.v           | 4 ++--
 src/Util/Tactics.v            | 1 +
 src/Util/Tactics/ConstrFail.v | 9 +++++++++
 src/Util/Tactics/DebugPrint.v | 4 +++-
 4 files changed, 15 insertions(+), 3 deletions(-)
 create mode 100644 src/Util/Tactics/ConstrFail.v

(limited to 'src/Util')

diff --git a/src/Util/ListUtil.v b/src/Util/ListUtil.v
index ac6575a4f..b7a5292d8 100644
--- a/src/Util/ListUtil.v
+++ b/src/Util/ListUtil.v
@@ -12,6 +12,7 @@ Require Export Crypto.Util.Tactics.BreakMatch.
 Require Export Crypto.Util.Tactics.DestructHead.
 Require Import Crypto.Util.Tactics.SpecializeBy.
 Require Import Crypto.Util.Tactics.RewriteHyp.
+Require Import Crypto.Util.Tactics.ConstrFail.
 Import ListNotations.
 Local Open Scope list_scope.
 
@@ -1910,8 +1911,7 @@ Ltac expand_lists _ :=
   let default_for A :=
       match goal with
       | _ => (eval lazy in (_ : pointed A))
-      | _ => let __ := match goal with _ => idtac "Warning: could not infer a default value for list type" A end in
-             constr:(I : I)
+      | _ => constr_fail_with ltac:(fun _ => idtac "Warning: could not infer a default value for list type" A)
       end in
   let T := lazymatch goal with |- _ = _ :> ?T => T end in
   let v := fresh in
diff --git a/src/Util/Tactics.v b/src/Util/Tactics.v
index 7b378c9bf..30c3ec461 100644
--- a/src/Util/Tactics.v
+++ b/src/Util/Tactics.v
@@ -6,6 +6,7 @@ Require Export Crypto.Util.Tactics.ChangeInAll.
 Require Export Crypto.Util.Tactics.ClearAll.
 Require Export Crypto.Util.Tactics.ClearDuplicates.
 Require Export Crypto.Util.Tactics.ClearbodyAll.
+Require Export Crypto.Util.Tactics.ConstrFail.
 Require Export Crypto.Util.Tactics.Contains.
 Require Export Crypto.Util.Tactics.ConvoyDestruct.
 Require Export Crypto.Util.Tactics.CPSId.
diff --git a/src/Util/Tactics/ConstrFail.v b/src/Util/Tactics/ConstrFail.v
new file mode 100644
index 000000000..fe8a05630
--- /dev/null
+++ b/src/Util/Tactics/ConstrFail.v
@@ -0,0 +1,9 @@
+(** A tactic that executes immediately (during expression evaluation / constr-construction) and fails.  Ideally we can eventually give it a nicer error message.  COQBUG(3913) *)
+
+Ltac constr_fail :=
+  let __ := match goal with _ => fail 1 "Constr construction failed.  Please look at the message log (*coq*, or run your tactic again inside Fail or try) to see more details" end in
+  ().
+
+Ltac constr_fail_with msg_tac :=
+  let __ := match goal with _ => msg_tac () end in
+  constr_fail.
diff --git a/src/Util/Tactics/DebugPrint.v b/src/Util/Tactics/DebugPrint.v
index 3ced23331..97edd0ad9 100644
--- a/src/Util/Tactics/DebugPrint.v
+++ b/src/Util/Tactics/DebugPrint.v
@@ -1,3 +1,5 @@
+Require Import Crypto.Util.Tactics.ConstrFail.
+
 Ltac debuglevel := constr:(0%nat).
 
 Ltac solve_debugfail tac :=
@@ -36,7 +38,7 @@ Ltac constr_run_tac_fail tac :=
   let dummy := match goal with
                | _ => tac ()
                end in
-  constr:(I : I).
+  constr_fail.
 
 Ltac cidtac msg :=
   constr_run_tac ltac:(fun _ => idtac msg).
-- 
cgit v1.2.3