aboutsummaryrefslogtreecommitdiffhomepage
path: root/plugins/extraction/haskell.ml
diff options
context:
space:
mode:
authorGravatar Nickolai Zeldovich <nickolai@csail.mit.edu>2016-02-08 16:08:10 -0500
committerGravatar Nickolai Zeldovich <nickolai@csail.mit.edu>2016-02-19 16:02:30 -0500
commit8bac7b9e0a149cd8f374ac63f33ec4ecfc5ae2d2 (patch)
tree8a1617989f89e2c20b688b2be00b9423220587de /plugins/extraction/haskell.ml
parenta4b457bef4290fed3f2869795f1539de53b3805a (diff)
Fix Haskell extraction for terms over 45 characters long
The Haskell extraction code would allow line-wrapping of the Haskell type definition, which would lead to unparseable Haskell code when the linebreak occured just before the type name. In particular, with a term name of 46 characters or more, the following Coq code: Definition xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx := tt. Extraction Language Haskell. Extraction xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx. would produce: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx :: Unit xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx = Tt which failed to compile with GHC (according to Haskell's indentation rules, the "Unit" line must be indented to be treated as a continuation of the previous line). This patch always forces the type onto a separate line, and ensures that it is always indented by 2 spaces (just like the body of each definition).
Diffstat (limited to 'plugins/extraction/haskell.ml')
-rw-r--r--plugins/extraction/haskell.ml4
1 files changed, 2 insertions, 2 deletions
diff --git a/plugins/extraction/haskell.ml b/plugins/extraction/haskell.ml
index 22519e347..764223621 100644
--- a/plugins/extraction/haskell.ml
+++ b/plugins/extraction/haskell.ml
@@ -346,7 +346,7 @@ let pp_decl = function
in
if void then mt ()
else
- names.(i) ++ str " :: " ++ pp_type false [] typs.(i) ++ fnl () ++
+ hov 2 (names.(i) ++ str " :: " ++ pp_type false [] typs.(i)) ++ fnl () ++
(if is_custom r then
(names.(i) ++ str " = " ++ str (find_custom r))
else
@@ -357,7 +357,7 @@ let pp_decl = function
if is_inline_custom r then mt ()
else
let e = pp_global Term r in
- e ++ str " :: " ++ pp_type false [] t ++ fnl () ++
+ hov 2 (e ++ str " :: " ++ pp_type false [] t) ++ fnl () ++
if is_custom r then
hov 0 (e ++ str " = " ++ str (find_custom r) ++ fnl2 ())
else