From 7993d50d0d1dd029b34745e1ee089d9cf7c5ffbd Mon Sep 17 00:00:00 2001 From: aspiwack Date: Fri, 24 Aug 2012 17:36:36 +0000 Subject: Experimental support for a comment in the files' preamble in extraction. Scheme comments are output on a single line because Ocaml's Format module which serves as a backend to Pp has an integer, rather than a string as identation value, so we cannot make it so that each new line in the comment starts with ";; ". I've tried something with Pp.ifb but it was hackish at best and had somewhat strange results. Known bug: as Pp.std_ppcmds is non-persistent, the comment is actually printed only once per Extraction command, even if it outputs several files. git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@15763 85f007b7-540e-0410-9357-904b9bb8a0f7 --- plugins/extraction/haskell.ml | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) (limited to 'plugins/extraction/haskell.ml') diff --git a/plugins/extraction/haskell.ml b/plugins/extraction/haskell.ml index 1a9f27552..2bc2306f1 100644 --- a/plugins/extraction/haskell.ml +++ b/plugins/extraction/haskell.ml @@ -33,13 +33,19 @@ let keywords = "as"; "qualified"; "hiding" ; "unit" ; "unsafeCoerce" ] Idset.empty -let preamble mod_name used_modules usf = +let pp_comment s = str "-- " ++ s ++ fnl () +let pp_bracket_comment s = str"{- " ++ hov 0 s ++ str" -}" + +let preamble mod_name comment used_modules usf = let pp_import mp = str ("import qualified "^ string_of_modfile mp ^"\n") in (if not usf.magic then mt () else - str "{-# OPTIONS_GHC -cpp -fglasgow-exts #-}\n" ++ - str "{- For Hugs, use the option -F\"cpp -P -traditional\" -}\n\n") + str "{-# OPTIONS_GHC -cpp -fglasgow-exts #-}" ++ fnl () ++ + str "{- For Hugs, use the option -F\"cpp -P -traditional\" -}") + ++ fnl () ++ fnl () + ++ + pp_bracket_comment comment ++ fnl () ++ fnl () ++ str "module " ++ pr_upper_id mod_name ++ str " where" ++ fnl2 () ++ str "import qualified Prelude" ++ fnl () ++ @@ -231,8 +237,6 @@ and pp_function env f t = (*s Pretty-printing of inductive types declaration. *) -let pp_comment s = str "-- " ++ s ++ fnl () - let pp_logical_ind packet = pp_comment (pr_id packet.ip_typename ++ str " : logical inductive") ++ pp_comment (str "with constructors : " ++ @@ -359,7 +363,7 @@ let haskell_descr = { preamble = preamble; pp_struct = pp_struct; sig_suffix = None; - sig_preamble = (fun _ _ _ -> mt ()); + sig_preamble = (fun _ s _ _ -> (pp_bracket_comment s)++fnl()); pp_sig = (fun _ -> mt ()); pp_decl = pp_decl; } -- cgit v1.2.3