aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEmilio Jesus Gallego Arias2018-05-14 15:31:16 +0200
committerEmilio Jesus Gallego Arias2018-05-14 15:31:16 +0200
commit16e01cbeeff7e5835424ecdf8347b01e83e829e8 (patch)
tree1d3e21e4eefa1ec8bb5443f256dbcbf558cd9c3a
parent2dcc280452818a7502d31a415403629baa502bd3 (diff)
parentea271504e92ec30991e9767e0fbe2e536bc3417e (diff)
Merge PR #7502: Fixing little printing bug with "Locate" on recursive notations
-rw-r--r--interp/notation.ml5
-rw-r--r--interp/notation_ops.ml8
-rw-r--r--test-suite/output/Notations3.out10
-rw-r--r--test-suite/output/Notations3.v5
4 files changed, 21 insertions, 7 deletions
diff --git a/interp/notation.ml b/interp/notation.ml
index 20e46bfe3f..e6df7b96c9 100644
--- a/interp/notation.ml
+++ b/interp/notation.ml
@@ -1051,7 +1051,7 @@ let locate_notation prglob ntn scope =
| [] -> str "Unknown notation"
| _ ->
str "Notation" ++ fnl () ++
- prlist (fun (ntn,l) ->
+ prlist_with_sep fnl (fun (ntn,l) ->
let scope = find_default ntn scopes in
prlist
(fun (sc,r,(_,df)) ->
@@ -1060,8 +1060,7 @@ let locate_notation prglob ntn scope =
(if String.equal sc default_scope then mt ()
else (spc () ++ str ": " ++ str sc)) ++
(if Option.equal String.equal (Some sc) scope
- then spc () ++ str "(default interpretation)" else mt ())
- ++ fnl ()))
+ then spc () ++ str "(default interpretation)" else mt ())))
l) ntns
let collect_notation_in_scope scope sc known =
diff --git a/interp/notation_ops.ml b/interp/notation_ops.ml
index 6a282624e4..b806dce0b1 100644
--- a/interp/notation_ops.ml
+++ b/interp/notation_ops.ml
@@ -165,15 +165,15 @@ let glob_constr_of_notation_constr_with_binders ?loc g f e nc =
| NApp (a,args) -> GApp (f e a, List.map (f e) args)
| NList (x,y,iter,tail,swap) ->
let t = f e tail in let it = f e iter in
- let innerl = (ldots_var,t)::(if swap then [] else [x, lt @@ GVar y]) in
+ let innerl = (ldots_var,t)::(if swap then [y, lt @@ GVar x] else []) in
let inner = lt @@ GApp (lt @@ GVar (ldots_var),[subst_glob_vars innerl it]) in
- let outerl = (ldots_var,inner)::(if swap then [x, lt @@ GVar y] else []) in
+ let outerl = (ldots_var,inner)::(if swap then [] else [y, lt @@ GVar x]) in
DAst.get (subst_glob_vars outerl it)
| NBinderList (x,y,iter,tail,swap) ->
let t = f e tail in let it = f e iter in
- let innerl = (ldots_var,t)::(if swap then [] else [x, lt @@ GVar y]) in
+ let innerl = (ldots_var,t)::(if swap then [y, lt @@ GVar x] else []) in
let inner = lt @@ GApp (lt @@ GVar ldots_var,[subst_glob_vars innerl it]) in
- let outerl = (ldots_var,inner)::(if swap then [x, lt @@ GVar y] else []) in
+ let outerl = (ldots_var,inner)::(if swap then [] else [y, lt @@ GVar x]) in
DAst.get (subst_glob_vars outerl it)
| NLambda (na,ty,c) ->
let e',disjpat,na = g e na in GLambda (na,Explicit,f e ty,Option.fold_right (apply_cases_pattern ?loc) disjpat (f e' c))
diff --git a/test-suite/output/Notations3.out b/test-suite/output/Notations3.out
index 304353f559..996af59270 100644
--- a/test-suite/output/Notations3.out
+++ b/test-suite/output/Notations3.out
@@ -231,3 +231,13 @@ fun l : list nat => match l with
: list nat -> list nat
Argument scope is [list_scope]
+Notation
+"'exists' x .. y , p" := ex (fun x => .. (ex (fun y => p)) ..) : type_scope
+(default interpretation)
+"'exists' ! x .. y , p" := ex
+ (unique
+ (fun x => .. (ex (unique (fun y => p))) ..))
+: type_scope (default interpretation)
+Notation
+"( x , y , .. , z )" := pair .. (pair x y) .. z : core_scope
+(default interpretation)
diff --git a/test-suite/output/Notations3.v b/test-suite/output/Notations3.v
index d2d1369468..3cf0c913f7 100644
--- a/test-suite/output/Notations3.v
+++ b/test-suite/output/Notations3.v
@@ -380,3 +380,8 @@ Definition foo (l : list nat) :=
end.
Print foo.
End Issue7110.
+
+Module LocateNotations.
+Locate "exists".
+Locate "( _ , _ , .. , _ )".
+End LocateNotations.