From dec77f282575842ff5369e732c0acfaf99d75037 Mon Sep 17 00:00:00 2001
From: Hugo Herbelin
Date: Thu, 2 Feb 2017 11:19:07 +0100
Subject: Fixing an anomaly with 'pat after cofix.

---
 interp/constrintern.ml | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

(limited to 'interp')

diff --git a/interp/constrintern.ml b/interp/constrintern.ml
index e6340646f5..c916fcd886 100644
--- a/interp/constrintern.ml
+++ b/interp/constrintern.ml
@@ -1602,7 +1602,8 @@ let internalize globalenv env allow_patvar (_, ntnvars as lvar) c =
         let idl_tmp = Array.map
           (fun ((loc,id),bl,ty,_) ->
             let (env',rbl) = List.fold_left intern_local_binder (env,[]) bl in
-            let rbl = List.map (function BDRawDef a -> a | BDPattern _ -> assert false) rbl in
+            let rbl = List.map (function BDRawDef a -> a | BDPattern _ -> 
+                      Loc.raise loc (Stream.Error "pattern with quote not allowed after cofix")) rbl in
             (List.rev rbl,
              intern_type env' ty,env')) dl in
 	let idl = Array.map2 (fun (_,_,_,bd) (b,c,env') ->
-- 
cgit v1.2.3


From 29d7872c0159d2aab7264c0577a2f5a9dc7c90c9 Mon Sep 17 00:00:00 2001
From: Hugo Herbelin
Date: Thu, 9 Feb 2017 18:33:08 +0100
Subject: Turning an anomaly on 'pat into a proper "unsupported" error message.

---
 interp/topconstr.ml | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

(limited to 'interp')

diff --git a/interp/topconstr.ml b/interp/topconstr.ml
index d388376bc2..a397ca82eb 100644
--- a/interp/topconstr.ml
+++ b/interp/topconstr.ml
@@ -60,6 +60,9 @@ let rec cases_pattern_fold_names f a = function
   | CPatPrim _ | CPatAtom _ -> a
   | CPatCast _ -> assert false
 
+let ids_of_pattern =
+  cases_pattern_fold_names Id.Set.add Id.Set.empty
+
 let ids_of_pattern_list =
   List.fold_left
     (Loc.located_fold_left
@@ -173,7 +176,8 @@ let split_at_annot bl na =
               (List.rev ans, LocalRawAssum (r, k, t) :: rest)
             end
 	| LocalRawDef _ as x :: rest -> aux (x :: acc) rest
-        | LocalPattern _ :: rest -> assert false
+        | LocalPattern (loc,_,_) :: rest ->
+            Loc.raise loc (Stream.Error "pattern with quote not allowed after fix")
 	| [] ->
             user_err_loc(loc,"",
 			 str "No parameter named " ++ Nameops.pr_id id ++ str".")
@@ -196,8 +200,9 @@ let map_local_binders f g e bl =
         (map_binder g e nal, LocalRawAssum(nal,k,f e ty)::bl)
     | LocalRawDef((loc,na),ty) ->
         (name_fold g na e, LocalRawDef((loc,na),f e ty)::bl)
-    | LocalPattern _ ->
-        assert false in
+    | LocalPattern (loc,pat,t) ->
+        let ids = ids_of_pattern pat in
+        (Id.Set.fold g ids e, LocalPattern (loc,pat,Option.map (f e) t)::bl) in
   let (e,rbl) = List.fold_left h (e,[]) bl in
   (e, List.rev rbl)
 
-- 
cgit v1.2.3