CPP Help (was Re: Latest Template Haskell Breaks Package)

Ok I have a cut down version of the problem and am cross posting to glasgow-haskell-users. To restate the problem: this is from code that has not been changed for 2 years. I get
Examples.hs:42:42: Parse error in pattern: con Failed, modules loaded: none.
Any help would be very gratefully received.
{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FunctionalDependencies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances, OverlappingInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-} {-# LANGUAGE RankNTypes, ScopedTypeVariables #-} {-# LANGUAGE MagicHash, BangPatterns, UnboxedTuples #-} {-# LANGUAGE TemplateHaskell, CPP #-}
module Examples where
import GHC.Prim import GHC.Exts import GHC.Types import GHC.Word import GHC.Int
class Touchable a where touch :: a -> IO ()
instance Touchable Bool where touch b = IO (\s -> case touch# b s of s' -> (# s', () #)) {-# INLINE touch #-}
#define TOUCHABLE_INST(ty,con) \ instance Touchable ty where { \ touch (con x#) = IO (\s -> case touch# x# s of s' -> (# s', () #)); \ {-# INLINE touch #-}; \ }
TOUCHABLE_INST(Int, I#)
#define PRIM_COMP_INST(ty,con,le,ge) \ instance PrimitiveOrd ty where { \ minM' (con a#) (con b#) = \ IO (\s -> \ let r# = if le a# b# then a# else b# \ in case touch# r# s of s' -> (# s', (con r#) #)); \ }
PRIM_COMP_INST(Int, I#, (<=#), (>=#))
Dominic Steinitz
dominic@steinitz.org
http://idontgetoutmuch.wordpress.com
On 23 Dec 2014, at 15:06, Dominic Steinitz
Hi Erik,
Thank you very much. With that clue the compilation now doesn’t fail at that particular point.
The bad news is it now fails to compile this module
https://hackage.haskell.org/package/yarr-1.3.2/docs/src/Data-Yarr-Utils-Prim...
with a parse error(!). Not only do I not have much experience with TH but this has now exposed my ignorance of CPP.
Data/Yarr/Utils/Primitive.hs:119:126: Parse error in pattern: con
If I comment out the last four lines
PRIM_COMP_INST(Int, I#, (<=#), (>=#)) PRIM_COMP_INST(Char, C#, leChar#, geChar#) PRIM_COMP_INST(Word, W#, leWord#, geWord#) PRIM_COMP_INST(Double, D#, (<=##), (>=##)) PRIM_COMP_INST(Float, F#, leFloat#, geFloat#)
then the module compiles but of course then the whole package does *not* compile.
Did something change in 7.8.3 with regard to CPP (this code has not been modified for at least two years)?
Thanks once again.
Dominic Steinitz dominic@steinitz.org http://idontgetoutmuch.wordpress.com
On 23 Dec 2014, at 13:42, Erik Hesselink
wrote: Hi Dominic,
It looks like just a representation change: a TySynEqn is a data type containing a [Type] and a Type, and those were the original two arguments. So it looks like with a little bit of CPP, you could support both versions. Something like
#if MIN_VERSION_template_haskell(2,9,0) ... #else ... #endif
In general, I think each major release of template haskell has quite some breaking changes, but I don't know of any place where they're enumerated. The GHC changelog only has a couple of high level bullet points.
Regards,
Erik
On Tue, Dec 23, 2014 at 2:20 PM, Dominic Steinitz
wrote: I realise I should have sent this to the libraries list.
Dominic Steinitz dominic@steinitz.org http://idontgetoutmuch.wordpress.com
Begin forwarded message:
From: Dominic Steinitz
Subject: Latest Template Haskell Breaks Package Date: 23 December 2014 13:14:26 GMT To: Haskell-Cafe Hello Fellow Haskellers,
I have become a maintainer for yarr (https://hackage.haskell.org/package/yarr). This no longer compiles with ghc-7.8.3 because it specifies base == 4.6. Relaxing this to base >=4.6 && <4.8 tells me I need a newer version of Template Haskell
rejecting: template-haskell-2.7.0.0, 2.6.0.0, 2.5.0.0, 2.4.0.1, 2.4.0.0, 2.3.0.1, 2.3.0.0, 2.2.0.0 (conflict: yarr => template-haskell>=2.8 && <2.9)
If I now relax the constraint for Template Haskell I get a compiler error as there has been a breaking change from Template Haskell 2.9 to 2.10.
Data/Yarr/Utils/FixedVector/VecTuple.hs:45:16: Couldn't match expected type ‘TypeQ -> Q Dec’ with actual type ‘Q Dec’ The function ‘tySynInstD’ is applied to three arguments, but its type ‘Name -> TySynEqnQ -> DecQ’ has only two
And indeed looking at the changes in http://git.haskell.org/packages/template-haskell.git/commitdiff/ccd7891c536b... I can see that the function in question has changed.
-tySynInstD :: Name -> [TypeQ] -> TypeQ -> DecQ -tySynInstD tc tys rhs = +tySynInstD :: Name -> [TySynEqnQ] -> DecQ +tySynInstD tc eqns =
Did I miss some announcement of this breaking change and the advice on what to do about it?
If I did can someone please point me at the relevant document. If not then I feel sad and would be very grateful if someone could help me as I know very little about Template Haskell.
Many thanks
Dominic Steinitz dominic@steinitz.org http://idontgetoutmuch.wordpress.com
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

what version of cabal-install are you using?
On Tue, Dec 23, 2014 at 10:46 AM, Dominic Steinitz
Ok I have a cut down version of the problem and am cross posting to glasgow-haskell-users.
To restate the problem: this is from code that has not been changed for 2 years. I get
Examples.hs:42:42: Parse error in pattern: con Failed, modules loaded: none.
Any help would be very gratefully received.
{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FunctionalDependencies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances, OverlappingInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-} {-# LANGUAGE RankNTypes, ScopedTypeVariables #-} {-# LANGUAGE MagicHash, BangPatterns, UnboxedTuples #-} {-# LANGUAGE TemplateHaskell, CPP #-}
module Examples where
import GHC.Prim import GHC.Exts import GHC.Types import GHC.Word import GHC.Int
class Touchable a where touch :: a -> IO ()
instance Touchable Bool where touch b = IO (\s -> case touch# b s of s' -> (# s', () #)) {-# INLINE touch #-}
#define TOUCHABLE_INST(ty,con) \ instance Touchable ty where { \ touch (con x#) = IO (\s -> case touch# x# s of s' -> (# s', () #)); \ {-# INLINE touch #-}; \ }
TOUCHABLE_INST(Int, I#)
#define PRIM_COMP_INST(ty,con,le,ge) \ instance PrimitiveOrd ty where { \ minM' (con a#) (con b#) = \ IO (\s -> \ let r# = if le a# b# then a# else b# \ in case touch# r# s of s' -> (# s', (con r#) #)); \ }
PRIM_COMP_INST(Int, I#, (<=#), (>=#))
Dominic Steinitz dominic@steinitz.org http://idontgetoutmuch.wordpress.com
On 23 Dec 2014, at 15:06, Dominic Steinitz
wrote: Hi Erik,
Thank you very much. With that clue the compilation now doesn’t fail at that particular point.
The bad news is it now fails to compile this module
https://hackage.haskell.org/package/yarr-1.3.2/docs/src/Data-Yarr-Utils-Prim...
with a parse error(!). Not only do I not have much experience with TH
but this has now exposed my ignorance of CPP.
Data/Yarr/Utils/Primitive.hs:119:126: Parse error in pattern: con
If I comment out the last four lines
PRIM_COMP_INST(Int, I#, (<=#), (>=#)) PRIM_COMP_INST(Char, C#, leChar#, geChar#) PRIM_COMP_INST(Word, W#, leWord#, geWord#) PRIM_COMP_INST(Double, D#, (<=##), (>=##)) PRIM_COMP_INST(Float, F#, leFloat#, geFloat#)
then the module compiles but of course then the whole package does *not*
compile.
Did something change in 7.8.3 with regard to CPP (this code has not been
modified for at least two years)?
Thanks once again.
Dominic Steinitz dominic@steinitz.org http://idontgetoutmuch.wordpress.com
On 23 Dec 2014, at 13:42, Erik Hesselink
wrote: Hi Dominic,
It looks like just a representation change: a TySynEqn is a data type containing a [Type] and a Type, and those were the original two arguments. So it looks like with a little bit of CPP, you could support both versions. Something like
#if MIN_VERSION_template_haskell(2,9,0) ... #else ... #endif
In general, I think each major release of template haskell has quite some breaking changes, but I don't know of any place where they're enumerated. The GHC changelog only has a couple of high level bullet points.
Regards,
Erik
On Tue, Dec 23, 2014 at 2:20 PM, Dominic Steinitz
I realise I should have sent this to the libraries list.
Dominic Steinitz dominic@steinitz.org http://idontgetoutmuch.wordpress.com
Begin forwarded message:
From: Dominic Steinitz
Subject: Latest Template Haskell Breaks Package Date: 23 December 2014 13:14:26 GMT To: Haskell-Cafe Hello Fellow Haskellers,
I have become a maintainer for yarr (https://hackage.haskell.org/package/yarr). This no longer compiles with ghc-7.8.3 because it specifies base == 4.6. Relaxing this to base =4.6 && <4.8 tells me I need a newer version of Template Haskell
rejecting: template-haskell-2.7.0.0, 2.6.0.0, 2.5.0.0, 2.4.0.1, 2.4.0.0, 2.3.0.1, 2.3.0.0, 2.2.0.0 (conflict: yarr => template-haskell>=2.8 && <2.9)
If I now relax the constraint for Template Haskell I get a compiler error as there has been a breaking change from Template Haskell 2.9 to 2.10.
Data/Yarr/Utils/FixedVector/VecTuple.hs:45:16: Couldn't match expected type ‘TypeQ -> Q Dec’ with actual type ‘Q Dec’ The function ‘tySynInstD’ is applied to three arguments, but its type ‘Name -> TySynEqnQ -> DecQ’ has only two
And indeed looking at the changes in
http://git.haskell.org/packages/template-haskell.git/commitdiff/ccd7891c536b...
I can see that the function in question has changed.
-tySynInstD :: Name -> [TypeQ] -> TypeQ -> DecQ -tySynInstD tc tys rhs = +tySynInstD :: Name -> [TySynEqnQ] -> DecQ +tySynInstD tc eqns =
Did I miss some announcement of this breaking change and the advice on what to do about it?
If I did can someone please point me at the relevant document. If not
wrote: then I
feel sad and would be very grateful if someone could help me as I know very little about Template Haskell.
Many thanks
Dominic Steinitz dominic@steinitz.org http://idontgetoutmuch.wordpress.com
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

$ cabal --version cabal-install version 1.19.1 using version 1.19.1 of the Cabal library
Dominic Steinitz
dominic@steinitz.org
http://idontgetoutmuch.wordpress.com
On 23 Dec 2014, at 15:54, Carter Schonwald
what version of cabal-install are you using?
On Tue, Dec 23, 2014 at 10:46 AM, Dominic Steinitz
wrote: Ok I have a cut down version of the problem and am cross posting to glasgow-haskell-users. To restate the problem: this is from code that has not been changed for 2 years. I get
Examples.hs:42:42: Parse error in pattern: con Failed, modules loaded: none.
Any help would be very gratefully received.
{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FunctionalDependencies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances, OverlappingInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-} {-# LANGUAGE RankNTypes, ScopedTypeVariables #-} {-# LANGUAGE MagicHash, BangPatterns, UnboxedTuples #-} {-# LANGUAGE TemplateHaskell, CPP #-}
module Examples where
import GHC.Prim import GHC.Exts import GHC.Types import GHC.Word import GHC.Int
class Touchable a where touch :: a -> IO ()
instance Touchable Bool where touch b = IO (\s -> case touch# b s of s' -> (# s', () #)) {-# INLINE touch #-}
#define TOUCHABLE_INST(ty,con) \ instance Touchable ty where { \ touch (con x#) = IO (\s -> case touch# x# s of s' -> (# s', () #)); \ {-# INLINE touch #-}; \ }
TOUCHABLE_INST(Int, I#)
#define PRIM_COMP_INST(ty,con,le,ge) \ instance PrimitiveOrd ty where { \ minM' (con a#) (con b#) = \ IO (\s -> \ let r# = if le a# b# then a# else b# \ in case touch# r# s of s' -> (# s', (con r#) #)); \ }
PRIM_COMP_INST(Int, I#, (<=#), (>=#))
Dominic Steinitz dominic@steinitz.org http://idontgetoutmuch.wordpress.com
On 23 Dec 2014, at 15:06, Dominic Steinitz
wrote: Hi Erik,
Thank you very much. With that clue the compilation now doesn’t fail at that particular point.
The bad news is it now fails to compile this module
https://hackage.haskell.org/package/yarr-1.3.2/docs/src/Data-Yarr-Utils-Prim...
with a parse error(!). Not only do I not have much experience with TH but this has now exposed my ignorance of CPP.
Data/Yarr/Utils/Primitive.hs:119:126: Parse error in pattern: con
If I comment out the last four lines
PRIM_COMP_INST(Int, I#, (<=#), (>=#)) PRIM_COMP_INST(Char, C#, leChar#, geChar#) PRIM_COMP_INST(Word, W#, leWord#, geWord#) PRIM_COMP_INST(Double, D#, (<=##), (>=##)) PRIM_COMP_INST(Float, F#, leFloat#, geFloat#)
then the module compiles but of course then the whole package does *not* compile.
Did something change in 7.8.3 with regard to CPP (this code has not been modified for at least two years)?
Thanks once again.
Dominic Steinitz dominic@steinitz.org http://idontgetoutmuch.wordpress.com
On 23 Dec 2014, at 13:42, Erik Hesselink
wrote: Hi Dominic,
It looks like just a representation change: a TySynEqn is a data type containing a [Type] and a Type, and those were the original two arguments. So it looks like with a little bit of CPP, you could support both versions. Something like
#if MIN_VERSION_template_haskell(2,9,0) ... #else ... #endif
In general, I think each major release of template haskell has quite some breaking changes, but I don't know of any place where they're enumerated. The GHC changelog only has a couple of high level bullet points.
Regards,
Erik
On Tue, Dec 23, 2014 at 2:20 PM, Dominic Steinitz
wrote: I realise I should have sent this to the libraries list.
Dominic Steinitz dominic@steinitz.org http://idontgetoutmuch.wordpress.com
Begin forwarded message:
From: Dominic Steinitz
Subject: Latest Template Haskell Breaks Package Date: 23 December 2014 13:14:26 GMT To: Haskell-Cafe Hello Fellow Haskellers,
I have become a maintainer for yarr (https://hackage.haskell.org/package/yarr). This no longer compiles with ghc-7.8.3 because it specifies base == 4.6. Relaxing this to base >=4.6 && <4.8 tells me I need a newer version of Template Haskell
rejecting: template-haskell-2.7.0.0, 2.6.0.0, 2.5.0.0, 2.4.0.1, 2.4.0.0, 2.3.0.1, 2.3.0.0, 2.2.0.0 (conflict: yarr => template-haskell>=2.8 && <2.9)
If I now relax the constraint for Template Haskell I get a compiler error as there has been a breaking change from Template Haskell 2.9 to 2.10.
Data/Yarr/Utils/FixedVector/VecTuple.hs:45:16: Couldn't match expected type ‘TypeQ -> Q Dec’ with actual type ‘Q Dec’ The function ‘tySynInstD’ is applied to three arguments, but its type ‘Name -> TySynEqnQ -> DecQ’ has only two
And indeed looking at the changes in http://git.haskell.org/packages/template-haskell.git/commitdiff/ccd7891c536b... I can see that the function in question has changed.
-tySynInstD :: Name -> [TypeQ] -> TypeQ -> DecQ -tySynInstD tc tys rhs = +tySynInstD :: Name -> [TySynEqnQ] -> DecQ +tySynInstD tc eqns =
Did I miss some announcement of this breaking change and the advice on what to do about it?
If I did can someone please point me at the relevant document. If not then I feel sad and would be very grateful if someone could help me as I know very little about Template Haskell.
Many thanks
Dominic Steinitz dominic@steinitz.org http://idontgetoutmuch.wordpress.com
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

On Tue, Dec 23, 2014 at 10:46 AM, Dominic Steinitz
To restate the problem: this is from code that has not been changed for 2 years. I get
Examples.hs:42:42: Parse error in pattern: con Failed, modules loaded: none.
I think I see the problem. Are you by any chance on a machine which has clang as its default C compiler (OS X, FreeBSD 9.3?/10.x/STABLE/CURRENT, possibly others)? cpp will in that case malfunction because it won't substitute macro parameters after the single quote:
minM' (con a#) (con b#) = \
-- brandon s allbery kf8nh sine nomine associates allbery.b@gmail.com ballbery@sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net

How very clever of you and thank you very much. Changing ‘ to 1 does fix the problem. I would have thought this would work
cabal install --with-gcc=gcc-4.9
But sadly I still got the same error.
Do I need a special version of cpphs?
Dominic Steinitz
dominic@steinitz.org
http://idontgetoutmuch.wordpress.com
On 23 Dec 2014, at 15:58, Brandon Allbery
On Tue, Dec 23, 2014 at 10:46 AM, Dominic Steinitz
wrote: To restate the problem: this is from code that has not been changed for 2 years. I get Examples.hs:42:42: Parse error in pattern: con Failed, modules loaded: none.
I think I see the problem. Are you by any chance on a machine which has clang as its default C compiler (OS X, FreeBSD 9.3?/10.x/STABLE/CURRENT, possibly others)? cpp will in that case malfunction because it won't substitute macro parameters after the single quote:
minM' (con a#) (con b#) = \
-- brandon s allbery kf8nh sine nomine associates allbery.b@gmail.com ballbery@sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net

On Tue, Dec 23, 2014 at 11:10 AM, Dominic Steinitz
How very clever of you and thank you very much. Changing ‘ to 1 does fix the problem.
I would have thought this would work
cabal install --with-gcc=gcc-4.9
But sadly I still got the same error.
I think that changes the gcc cabal uses to compile C code, but does not affect how ghc invokes cpp. Or put otherwise, there are too many ways that a C compiler can be dragged into the build pipeline (building C code explicitly [via cabal or via ghc foo.c, two different cases], wrapped FFI calls in ghc, -fvia-C, CPP, ...). -- brandon s allbery kf8nh sine nomine associates allbery.b@gmail.com ballbery@sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net

You can specify the pre-processor in the `ghc-options' field in the
cabal file, e.g.
ghc-options: -pgmPcpphs
Francesco
On 23 December 2014 at 17:14, Brandon Allbery
On Tue, Dec 23, 2014 at 11:10 AM, Dominic Steinitz
wrote: How very clever of you and thank you very much. Changing ‘ to 1 does fix the problem.
I would have thought this would work
cabal install --with-gcc=gcc-4.9
But sadly I still got the same error.
I think that changes the gcc cabal uses to compile C code, but does not affect how ghc invokes cpp. Or put otherwise, there are too many ways that a C compiler can be dragged into the build pipeline (building C code explicitly [via cabal or via ghc foo.c, two different cases], wrapped FFI calls in ghc, -fvia-C, CPP, ...).
-- brandon s allbery kf8nh sine nomine associates allbery.b@gmail.com ballbery@sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

I forgot to mention that `cpphs' can mimick gcc's cpp, with the flag
`-cpp'. In Agda we have
ghc-options: -pgmPcpphs -optP--cpp
Francesco
On 24 December 2014 at 10:50, Francesco Mazzoli
You can specify the pre-processor in the `ghc-options' field in the cabal file, e.g.
ghc-options: -pgmPcpphs
Francesco
On 23 December 2014 at 17:14, Brandon Allbery
wrote: On Tue, Dec 23, 2014 at 11:10 AM, Dominic Steinitz
wrote: How very clever of you and thank you very much. Changing ‘ to 1 does fix the problem.
I would have thought this would work
cabal install --with-gcc=gcc-4.9
But sadly I still got the same error.
I think that changes the gcc cabal uses to compile C code, but does not affect how ghc invokes cpp. Or put otherwise, there are too many ways that a C compiler can be dragged into the build pipeline (building C code explicitly [via cabal or via ghc foo.c, two different cases], wrapped FFI calls in ghc, -fvia-C, CPP, ...).
-- brandon s allbery kf8nh sine nomine associates allbery.b@gmail.com ballbery@sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

Thank you very much everyone. I now have a version of yarr which compiles under ghc 7.8.3. I have yet to do the conditional compilation hackery to support back versions but then I can make a release. What a great community :-) Dominic Steinitz dominic@steinitz.org http://idontgetoutmuch.wordpress.com
participants (4)
-
Brandon Allbery
-
Carter Schonwald
-
Dominic Steinitz
-
Francesco Mazzoli