CPP Help (was Re: Latest Template Haskell Breaks Package)
Dominic Steinitz
dominic at steinitz.org
Tue Dec 23 16:11:11 UTC 2014
> $ cabal --version
> cabal-install version 1.19.1
> using version 1.19.1 of the Cabal library
Dominic Steinitz
dominic at steinitz.org
http://idontgetoutmuch.wordpress.com
On 23 Dec 2014, at 15:54, Carter Schonwald <carter.schonwald at gmail.com> wrote:
> what version of cabal-install are you using?
>
> On Tue, Dec 23, 2014 at 10:46 AM, Dominic Steinitz <dominic at steinitz.org> 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 at steinitz.org
> http://idontgetoutmuch.wordpress.com
>
> On 23 Dec 2014, at 15:06, Dominic Steinitz <dominic at steinitz.org> 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-Primitive.html#clampM%27
> >
> > 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 at steinitz.org
> > http://idontgetoutmuch.wordpress.com
> >
> > On 23 Dec 2014, at 13:42, Erik Hesselink <hesselink at gmail.com> 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 <dominic at steinitz.org> wrote:
> >>> I realise I should have sent this to the libraries list.
> >>>
> >>> Dominic Steinitz
> >>> dominic at steinitz.org
> >>> http://idontgetoutmuch.wordpress.com
> >>>
> >>> Begin forwarded message:
> >>>
> >>> From: Dominic Steinitz <dominic at steinitz.org>
> >>> Subject: Latest Template Haskell Breaks Package
> >>> Date: 23 December 2014 13:14:26 GMT
> >>> To: Haskell-Cafe <haskell-cafe at haskell.org>
> >>>
> >>> 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/ccd7891c536b29b8bea96eb92520f46e21390e39
> >>> 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 at steinitz.org
> >>> http://idontgetoutmuch.wordpress.com
> >>>
> >>>
> >>>
> >>> _______________________________________________
> >>> Libraries mailing list
> >>> Libraries at haskell.org
> >>> http://www.haskell.org/mailman/listinfo/libraries
> >>>
> >
>
> _______________________________________________
> Libraries mailing list
> Libraries at haskell.org
> http://www.haskell.org/mailman/listinfo/libraries
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/glasgow-haskell-users/attachments/20141223/83c98a40/attachment-0001.html>
More information about the Glasgow-haskell-users
mailing list