diff options
| author |  letouzey <letouzey@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2012-08-07 19:30:59 +0000 |
|---|---|---|
| committer | letouzey <letouzey@85f007b7-540e-0410-9357-904b9bb8a0f7> | 2012-08-07 19:30:59 +0000 |
| commit | 4a6b89e79d67bdaf4d0c07ae5d15c6b6154d3e30 (patch) | |
| tree | 770d17119055ce404a93e2dfec1ad039758719f7 | |
| parent | c7365ac4a36e6e7cc90582f38cd6f9adc2d88f1f (diff) | |
Avoid Pp.std_ppcmds in Misctypes.sort_info
Otherwise, after a Set Printing Universes we may end on
a comparison of Pp.std_ppcmds, which may fail on functional
values (cf. Constrextern.check_same_type), as notice by Pierre-Marie
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@15697 85f007b7-540e-0410-9357-904b9bb8a0f7
| -rw-r--r-- | intf/misctypes.mli | 2 | ||||
| -rw-r--r-- | pretyping/detyping.ml | 6 | ||||
| -rw-r--r-- | printing/ppconstr.ml | 2 |
3 files changed, 7 insertions, 3 deletions
diff --git a/intf/misctypes.mli b/intf/misctypes.mli index b9f5a6dbe..e8164c02d 100644 --- a/intf/misctypes.mli +++ b/intf/misctypes.mli @@ -37,7 +37,7 @@ type 'id move_location = (** Sorts *) -type sort_info = Pp.std_ppcmds option +type sort_info = string option type glob_sort = GProp | GSet | GType of sort_info (** Casts *) diff --git a/pretyping/detyping.ml b/pretyping/detyping.ml index 7ed29ba39..95709e6f7 100644 --- a/pretyping/detyping.ml +++ b/pretyping/detyping.ml @@ -370,7 +370,11 @@ let detype_case computable detype detype_eqns testdep avoid data p c bl = let detype_sort = function | Prop Null -> GProp | Prop Pos -> GSet - | Type u -> GType (if !print_universes then Some (Univ.pr_uni u) else None) + | Type u -> + GType + (if !print_universes + then Some (Pp.string_of_ppcmds (Univ.pr_uni u)) + else None) type binder_kind = BProd | BLambda | BLetIn diff --git a/printing/ppconstr.ml b/printing/ppconstr.ml index 38f5fc1c6..0948b31f3 100644 --- a/printing/ppconstr.ml +++ b/printing/ppconstr.ml @@ -113,7 +113,7 @@ let pr_in_comment pr x = str "(* " ++ pr x ++ str " *)" let pr_glob_sort = function | GProp -> str "Prop" | GSet -> str "Set" - | GType u -> hov 0 (str "Type" ++ pr_opt (pr_in_comment (fun x->x)) u) + | GType u -> hov 0 (str "Type" ++ pr_opt (pr_in_comment str) u) let pr_id = pr_id let pr_name = pr_name |