From a13eac935515be8be32b8080aab858c46a6b202a Mon Sep 17 00:00:00 2001
From: letouzey
Date: Fri, 25 Feb 2011 16:43:56 +0000
Subject: Extraction: Add missing parenthesis around emulated pattern-match
 (fix #2478)

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@13861 85f007b7-540e-0410-9357-904b9bb8a0f7
---
 plugins/extraction/haskell.ml | 7 +++++--
 plugins/extraction/ocaml.ml   | 7 +++++--
 plugins/extraction/scheme.ml  | 7 +++++--
 3 files changed, 15 insertions(+), 6 deletions(-)

(limited to 'plugins/extraction')

diff --git a/plugins/extraction/haskell.ml b/plugins/extraction/haskell.ml
index 844b673754..32362d32c6 100644
--- a/plugins/extraction/haskell.ml
+++ b/plugins/extraction/haskell.ml
@@ -151,9 +151,12 @@ let rec pp_expr par env args =
 	  if ids <> [] then named_lams (List.rev ids) e
 	  else dummy_lams (ast_lift 1 e) 1
 	in
-	hov 2 (str (find_custom_match pv) ++ fnl () ++
+	apply
+	  (pp_par par'
+	     (hov 2
+		(str (find_custom_match pv) ++ fnl () ++
 		 prvect (fun tr -> pp_expr true env [] (mkfun tr) ++ fnl ()) pv
-	       ++ pp_expr true env [] t)
+		 ++ pp_expr true env [] t)))
     | MLcase (info,t, pv) ->
       	apply (pp_par par'
 		 (v 0 (str "case " ++ pp_expr false env [] t ++ str " of" ++
diff --git a/plugins/extraction/ocaml.ml b/plugins/extraction/ocaml.ml
index b60eee381b..e4a145586c 100644
--- a/plugins/extraction/ocaml.ml
+++ b/plugins/extraction/ocaml.ml
@@ -245,9 +245,12 @@ let rec pp_expr par env args =
 	  if ids <> [] then named_lams (List.rev ids) e
 	  else dummy_lams (ast_lift 1 e) 1
 	in
-	hov 2 (str (find_custom_match pv) ++ fnl () ++
+	apply
+	  (pp_par par'
+	     (hov 2
+		(str (find_custom_match pv) ++ fnl () ++
 		 prvect (fun tr -> pp_expr true env [] (mkfun tr) ++ fnl ()) pv
-	       ++ pp_expr true env [] t)
+		 ++ pp_expr true env [] t)))
     | MLcase (info, t, pv) ->
 	let expr = if info.m_kind = Coinductive then
 	  (str "Lazy.force" ++ spc () ++ pp_expr true env [] t)
diff --git a/plugins/extraction/scheme.ml b/plugins/extraction/scheme.ml
index 612da13499..c077107136 100644
--- a/plugins/extraction/scheme.ml
+++ b/plugins/extraction/scheme.ml
@@ -99,9 +99,12 @@ let rec pp_expr env args =
 	  if ids <> [] then named_lams (List.rev ids) e
 	  else dummy_lams (ast_lift 1 e) 1
 	in
-	hov 2 (str (find_custom_match pv) ++ fnl () ++
+	apply
+	  (paren
+	     (hov 2
+		(str (find_custom_match pv) ++ fnl () ++
 		 prvect (fun tr -> pp_expr env [] (mkfun tr) ++ fnl ()) pv
-	       ++ pp_expr env [] t)
+		 ++ pp_expr env [] t)))
      | MLcase (info,t, pv) ->
 	let e =
 	  if info.m_kind <> Coinductive then pp_expr env [] t
-- 
cgit v1.2.3