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(-) 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 aa60931752217a7bf0536acae4e7858f48eb8c8e Mon Sep 17 00:00:00 2001 From: Hendrik Tews Date: Mon, 30 Jan 2017 21:08:29 +0100 Subject: fix Emacs compiler warning on '(lambda...) lambda is self-quoting, see elisp manual, section 12.7 Anonymous Functions --- tools/gallina-db.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tools/gallina-db.el b/tools/gallina-db.el index baabebb13a..9664f69f8b 100644 --- a/tools/gallina-db.el +++ b/tools/gallina-db.el @@ -163,7 +163,7 @@ for DB structure." (defun coq-sort-menu-entries (menu) (sort menu - '(lambda (x y) (string< + (lambda (x y) (string< (downcase (elt x 0)) (downcase (elt y 0)))))) -- cgit v1.2.3 From 4ddf3ee41eb6e8faaf223041d2bd42d4c62be58d Mon Sep 17 00:00:00 2001 From: Pierre Letouzey Date: Sat, 4 Feb 2017 01:50:58 +0100 Subject: Extraction: fix complexity issue #5310 A double call to pp_module_type inside Ocaml.pp_specif was causing an complexity blowup when pretty-printing heavily modular extracted code. I wasn't able to figure out why this double call is there. It could be the leftover of some intermediate work in 2007 before commit 350398eae (which introduced global printing phases Pre/Impl/Intf). Anyway I'm reasonably sure that today these two pp_module_type calls produce the exact same pretty-printed signature (even if there's a large bunch of imperative states around). Moreover, this duplicated signature is actually slightly wrong: when we alias a module M with a unambiguous name like Coq__123, the type of Coq__123 should not be an exact copy of the type of M, but rather a "strengthened" version of it (with equality between inductive types). So the best solution is now to use this funny feature of OCaml introduced in 3.12 : module Coq__123 : module type of struct include M end This "module type of struct include" is slightly awkward, but short, correct, and trivial to produce :-). And I doubt anybody will object to the (rare) use of some 3.12 features in extracted code of 2017... --- plugins/extraction/ocaml.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/plugins/extraction/ocaml.ml b/plugins/extraction/ocaml.ml index 3cb3810cbc..13b100fdb6 100644 --- a/plugins/extraction/ocaml.ml +++ b/plugins/extraction/ocaml.ml @@ -618,12 +618,13 @@ let rec pp_specif = function with Not_found -> pp_spec s) | (l,Smodule mt) -> let def = pp_module_type [] mt in - let def' = pp_module_type [] mt in let name = pp_modname (MPdot (top_visible_mp (), l)) in hov 1 (str "module " ++ name ++ str " :" ++ fnl () ++ def) ++ (try let ren = Common.check_duplicate (top_visible_mp ()) l in - fnl () ++ hov 1 (str ("module "^ren^" :") ++ fnl () ++ def') + fnl () ++ + hov 1 (str ("module "^ren^" :") ++ spc () ++ + str "module type of struct include " ++ name ++ str " end") with Not_found -> Pp.mt ()) | (l,Smodtype mt) -> let def = pp_module_type [] mt in -- cgit v1.2.3 From 0929a78f9a663ac2bcdf1294de93797b9fdfefad Mon Sep 17 00:00:00 2001 From: Pierre Letouzey Date: Sat, 4 Feb 2017 01:50:58 +0100 Subject: Extraction: fix complexity issue #5310 A double call to pp_module_type inside Ocaml.pp_specif was causing an complexity blowup when pretty-printing heavily modular extracted code. I wasn't able to figure out why this double call is there. It could be the leftover of some intermediate work in 2007 before commit 350398eae (which introduced global printing phases Pre/Impl/Intf). Anyway I'm reasonably sure that today these two pp_module_type calls produce the exact same pretty-printed signature (even if there's a large bunch of imperative states around). Moreover, this duplicated signature is actually slightly wrong: when we alias a module M with a unambiguous name like Coq__123, the type of Coq__123 should not be an exact copy of the type of M, but rather a "strengthened" version of it (with equality between inductive types). So the best solution is now to use this funny feature of OCaml introduced in 3.12 : module Coq__123 : module type of struct include M end This "module type of struct include" is slightly awkward, but short, correct, and trivial to produce :-). And I doubt anybody will object to the (rare) use of some 3.12 features in extracted code of 2017... --- plugins/extraction/ocaml.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/plugins/extraction/ocaml.ml b/plugins/extraction/ocaml.ml index 1c29a9bc24..5d10cb939d 100644 --- a/plugins/extraction/ocaml.ml +++ b/plugins/extraction/ocaml.ml @@ -618,12 +618,13 @@ let rec pp_specif = function with Not_found -> pp_spec s) | (l,Smodule mt) -> let def = pp_module_type [] mt in - let def' = pp_module_type [] mt in let name = pp_modname (MPdot (top_visible_mp (), l)) in hov 1 (str "module " ++ name ++ str " :" ++ fnl () ++ def) ++ (try let ren = Common.check_duplicate (top_visible_mp ()) l in - fnl () ++ hov 1 (str ("module "^ren^" :") ++ fnl () ++ def') + fnl () ++ + hov 1 (str ("module "^ren^" :") ++ spc () ++ + str "module type of struct include " ++ name ++ str " end") with Not_found -> Pp.mt ()) | (l,Smodtype mt) -> let def = pp_module_type [] mt in -- cgit v1.2.3 From 0b8d185baab95d92a7779482c7861c7be0a8e979 Mon Sep 17 00:00:00 2001 From: Hugo Herbelin Date: Thu, 9 Feb 2017 18:26:33 +0100 Subject: Fixing bug #5346 (an unimplemented application of 'pat). --- test-suite/bugs/closed/5346.v | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) create mode 100644 test-suite/bugs/closed/5346.v diff --git a/test-suite/bugs/closed/5346.v b/test-suite/bugs/closed/5346.v new file mode 100644 index 0000000000..0118c18704 --- /dev/null +++ b/test-suite/bugs/closed/5346.v @@ -0,0 +1,29 @@ +Inductive comp : Type -> Type := +| Ret {T} : forall (v:T), comp T +| Bind {T T'} : forall (p: comp T') (p': T' -> comp T), comp T. + +Notation "'do' x .. y <- p1 ; p2" := + (Bind p1 (fun x => .. (fun y => p2) ..)) + (at level 60, right associativity, + x binder, y binder). + +Definition Fst1 A B (p: comp (A*B)) : comp A := + do '(a, b) <- p; + Ret a. + +Definition Fst2 A B (p: comp (A*B)) : comp A := + match tt with + | _ => Bind p (fun '(a, b) => Ret a) + end. + +Definition Fst3 A B (p: comp (A*B)) : comp A := + match tt with + | _ => do a <- p; + Ret (fst a) + end. + +Definition Fst A B (p: comp (A * B)) : comp A := + match tt with + | _ => do '(a, b) <- p; + Ret a + end. -- 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(-) 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 From 7707396c5010d88c3d0be6ecee816d8da7ed0ee0 Mon Sep 17 00:00:00 2001 From: Hugo Herbelin Date: Thu, 16 Feb 2017 21:55:14 +0100 Subject: Fixing #5339 (anomaly with 'pat in record parameters). --- toplevel/record.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/toplevel/record.ml b/toplevel/record.ml index b8dcf81fde..8d35e5a3da 100644 --- a/toplevel/record.ml +++ b/toplevel/record.ml @@ -108,7 +108,8 @@ let typecheck_params_and_fields def id pl t ps nots fs = List.iter (function LocalRawDef (b, _) -> error default_binder_kind b | LocalRawAssum (ls, bk, ce) -> List.iter (error bk) ls - | LocalPattern _ -> assert false) ps + | LocalPattern (loc,_,_) -> + Loc.raise loc (Stream.Error "pattern with quote not allowed in record parameters.")) ps in let impls_env, ((env1,newps), imps) = interp_context_evars env0 evars ps in let t', template = match t with -- cgit v1.2.3 From e8137ae63b3b19436755f372b595e7343e942894 Mon Sep 17 00:00:00 2001 From: Maxime Dénès Date: Tue, 21 Feb 2017 08:09:56 +0100 Subject: Add empty ltac_plugin file for forward compatibility. This is in preparation for landing of PR#309: Ltac as a plugin --- ltac/ltac.mllib | 1 + ltac/ltac_plugin.ml | 0 ltac/ltac_plugin.mli | 0 3 files changed, 1 insertion(+) create mode 100644 ltac/ltac_plugin.ml create mode 100644 ltac/ltac_plugin.mli diff --git a/ltac/ltac.mllib b/ltac/ltac.mllib index fc51e48ae4..974943ddd6 100644 --- a/ltac/ltac.mllib +++ b/ltac/ltac.mllib @@ -20,3 +20,4 @@ G_rewrite Tauto G_eqdecide G_ltac +Ltac_plugin diff --git a/ltac/ltac_plugin.ml b/ltac/ltac_plugin.ml new file mode 100644 index 0000000000..e69de29bb2 diff --git a/ltac/ltac_plugin.mli b/ltac/ltac_plugin.mli new file mode 100644 index 0000000000..e69de29bb2 -- cgit v1.2.3