From johnw at newartisans.com Tue Dec 2 21:22:55 2014 From: johnw at newartisans.com (John Wiegley) Date: Tue, 02 Dec 2014 15:22:55 -0600 Subject: New implementation draft for -XStaticPointers In-Reply-To: ("Facundo =?utf-8?Q?Dom=C3=ADnguez=22's?= message of "Tue, 2 Dec 2014 19:06:12 -0200") References: Message-ID: >>>>> Facundo Dom?nguez writes: > We are pleased to announce a new implementation draft of the > StaticPointers extension [1]. Very nice, thank you! John From carter.schonwald at gmail.com Tue Dec 2 21:39:49 2014 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Tue, 2 Dec 2014 16:39:49 -0500 Subject: New implementation draft for -XStaticPointers In-Reply-To: References: Message-ID: Hey Facundo... the merge window for 7.10 closed a few days ago. (i myself have some work thats missed that merge window too) that said, great work and I look forward to helping with the code review. -Carter On Tue, Dec 2, 2014 at 4:22 PM, John Wiegley wrote: > >>>>> Facundo Dom?nguez writes: > > > We are pleased to announce a new implementation draft of the > > StaticPointers extension [1]. > > Very nice, thank you! > > John > _______________________________________________ > Glasgow-haskell-users mailing list > Glasgow-haskell-users at haskell.org > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users > -------------- next part -------------- An HTML attachment was scrubbed... URL: From george.colpitts at gmail.com Wed Dec 3 22:53:40 2014 From: george.colpitts at gmail.com (George Colpitts) Date: Wed, 3 Dec 2014 18:53:40 -0400 Subject: ANNOUNCE: GHC 7.8.4 Release Candidate 1 In-Reply-To: <87bnnu3ufg.fsf@gnu.org> References: <87bnnu3ufg.fsf@gnu.org> Message-ID: Would it be possible to get a RC for the Mac up at https://downloads.haskell.org/~ghc/7.8.4-rc1/ ? Thanks George On Wed, Nov 26, 2014 at 10:31 AM, Herbert Valerio Riedel wrote: > On 2014-11-26 at 12:40:37 +0100, Sven Panne wrote: > > 2014-11-25 20:46 GMT+01:00 Austin Seipp : > >> We are pleased to announce the first release candidate for GHC 7.8.4: > >> > >> https://downloads.haskell.org/~ghc/7.8.4-rc1/ [...] > > > > Would it be possible to get the RC on > > https://launchpad.net/~hvr/+archive/ubuntu/ghc? This way one could > > easily test things on Travis CI. > > I'll put a 7.8.4rc .deb up soon (probably right after the GHC 7.10 > branch has been created) > _______________________________________________ > Glasgow-haskell-users mailing list > Glasgow-haskell-users at haskell.org > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users > -------------- next part -------------- An HTML attachment was scrubbed... URL: From qdunkan at gmail.com Thu Dec 4 18:50:10 2014 From: qdunkan at gmail.com (Evan Laforge) Date: Thu, 4 Dec 2014 10:50:10 -0800 Subject: confusing type error Message-ID: I recently got a confusing error msg, and reduced it to a small case: f1 :: Monad m => m Bool f1 = f2 0 0 'a' f2 :: Monad m => Int -> Float -> m Bool f2 = undefined >From this, it's clear that f2 is being given an extra Char argument it didn't ask for. However, the error msg (ghc 7.8.3) is: Couldn't match type ?m Bool? with ?Bool? Expected type: Char -> m Bool Actual type: Char -> Bool Relevant bindings include f1 :: m Bool (bound at Bug.hs:4:1) The function ?f2? is applied to three arguments, but its type ?Int -> Float -> Char -> Bool? has only three In the expression: f2 0 0 'a' In an equation for ?f1?: f1 = f2 0 0 'a' The confusing part is that 'f2' was applied to three arguments, but it's type has only three. It includes the Char in expected and actual types, and implies that the type of 'f2' includes the Char. So I took quite a while to realize that the type of 'f2' in fact *didn't* expect a Char (and had an 'm'), so that the "but its type" is *not* in fact its declared type. I suppose it infers a type for 'f2' based on its use, and that then becomes the "actual" type, but it seems less confusing if it picked the declared type of 'f2' as its actual type. Perhaps this is working as intended, but it it is confusing! Especially the part about "expected three but got three". Ideally I'd like to see "too many arguments" or at least "expected (Char -> m Bool) but actually 'm Bool'". Actually I'd expect the other way: "expected 'm Bool' but got (Char -> m Bool)' but I think ghc has always done it backwards from how I expect. It looks like it's substituting (->) for 'm', so maybe it's one of those things where ((->) a) is also a monad. From eir at cis.upenn.edu Thu Dec 4 19:53:48 2014 From: eir at cis.upenn.edu (Richard Eisenberg) Date: Thu, 4 Dec 2014 14:53:48 -0500 Subject: confusing type error In-Reply-To: References: Message-ID: <2BBF7ED4-9F12-435E-82C3-2C8676F09929@cis.upenn.edu> This seems straightforwardly to be a bug, to me. HEAD gives the same behavior you report below. Please post on the bug tracker at https://ghc.haskell.org/trac/ghc/newticket Thanks! Richard On Dec 4, 2014, at 1:50 PM, Evan Laforge wrote: > I recently got a confusing error msg, and reduced it to a small case: > > f1 :: Monad m => m Bool > f1 = f2 0 0 'a' > > f2 :: Monad m => Int -> Float -> m Bool > f2 = undefined > > From this, it's clear that f2 is being given an extra Char argument it > didn't ask for. However, the error msg (ghc 7.8.3) is: > > Couldn't match type ?m Bool? with ?Bool? > Expected type: Char -> m Bool > Actual type: Char -> Bool > Relevant bindings include f1 :: m Bool (bound at Bug.hs:4:1) > The function ?f2? is applied to three arguments, > but its type ?Int -> Float -> Char -> Bool? has only three > In the expression: f2 0 0 'a' > In an equation for ?f1?: f1 = f2 0 0 'a' > > The confusing part is that 'f2' was applied to three arguments, but > it's type has only three. It includes the Char in expected and actual > types, and implies that the type of 'f2' includes the Char. So I took > quite a while to realize that the type of 'f2' in fact *didn't* expect > a Char (and had an 'm'), so that the "but its type" is *not* in fact > its declared type. > > I suppose it infers a type for 'f2' based on its use, and that then > becomes the "actual" type, but it seems less confusing if it picked > the declared type of 'f2' as its actual type. Perhaps this is working > as intended, but it it is confusing! Especially the part about > "expected three but got three". > > Ideally I'd like to see "too many arguments" or at least "expected > (Char -> m Bool) but actually 'm Bool'". Actually I'd expect the > other way: "expected 'm Bool' but got (Char -> m Bool)' but I think > ghc has always done it backwards from how I expect. It looks like > it's substituting (->) for 'm', so maybe it's one of those things > where ((->) a) is also a monad. > _______________________________________________ > Glasgow-haskell-users mailing list > Glasgow-haskell-users at haskell.org > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users > From byorgey at gmail.com Thu Dec 4 20:00:05 2014 From: byorgey at gmail.com (Brent Yorgey) Date: Thu, 4 Dec 2014 15:00:05 -0500 Subject: confusing type error In-Reply-To: References: Message-ID: Int -> Float -> Char -> Bool *is* in fact a valid type for f2, since ((->) Char) is a Monad. However, I agree the error message is confusing, especially the "expected n, but got n" part. -Brent On Thu, Dec 4, 2014 at 1:50 PM, Evan Laforge wrote: > I recently got a confusing error msg, and reduced it to a small case: > > f1 :: Monad m => m Bool > f1 = f2 0 0 'a' > > f2 :: Monad m => Int -> Float -> m Bool > f2 = undefined > > From this, it's clear that f2 is being given an extra Char argument it > didn't ask for. However, the error msg (ghc 7.8.3) is: > > Couldn't match type ?m Bool? with ?Bool? > Expected type: Char -> m Bool > Actual type: Char -> Bool > Relevant bindings include f1 :: m Bool (bound at Bug.hs:4:1) > The function ?f2? is applied to three arguments, > but its type ?Int -> Float -> Char -> Bool? has only three > In the expression: f2 0 0 'a' > In an equation for ?f1?: f1 = f2 0 0 'a' > > The confusing part is that 'f2' was applied to three arguments, but > it's type has only three. It includes the Char in expected and actual > types, and implies that the type of 'f2' includes the Char. So I took > quite a while to realize that the type of 'f2' in fact *didn't* expect > a Char (and had an 'm'), so that the "but its type" is *not* in fact > its declared type. > > I suppose it infers a type for 'f2' based on its use, and that then > becomes the "actual" type, but it seems less confusing if it picked > the declared type of 'f2' as its actual type. Perhaps this is working > as intended, but it it is confusing! Especially the part about > "expected three but got three". > > Ideally I'd like to see "too many arguments" or at least "expected > (Char -> m Bool) but actually 'm Bool'". Actually I'd expect the > other way: "expected 'm Bool' but got (Char -> m Bool)' but I think > ghc has always done it backwards from how I expect. It looks like > it's substituting (->) for 'm', so maybe it's one of those things > where ((->) a) is also a monad. > _______________________________________________ > Glasgow-haskell-users mailing list > Glasgow-haskell-users at haskell.org > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users > -------------- next part -------------- An HTML attachment was scrubbed... URL: From migmit at gmail.com Thu Dec 4 20:59:39 2014 From: migmit at gmail.com (migmit) Date: Thu, 4 Dec 2014 23:59:39 +0300 Subject: confusing type error In-Reply-To: References: Message-ID: <3D342993-B7DD-4ABB-A89E-24A83B0D4BDB@gmail.com> I don't see a bug here. f2 is perfectly OK, so, let's examine f1 more closely. It tries to get `m Bool` by applying f1 to three arguments: 0, 0, and 'a'. Now, since `f2` has the type `Int -> Float -> n Bool`, where `n` is of kind `* -> *` (and an instance of `Monad` class, but it's not yet the time to look for instances), we have `f2 0 :: Float -> n Bool` and `f2 0 0 :: n Bool`. Since that is applied to 'a', Haskell deduces that the last type should be something like `Char -> Something` ? or, equivalently, `(->) Char Something`. Therefore, it can see that `n` is in fact `(->) Char` and `Something` is `Bool`. Therefore, `f2 0 0 'a' :: Bool`. But it is expecting `m Bool`, not `Bool` ? which is exactly what an error message says. ?????????? ? iPad > 4 ???. 2014 ?., ? 21:50, Evan Laforge ???????(?): > > I recently got a confusing error msg, and reduced it to a small case: > > f1 :: Monad m => m Bool > f1 = f2 0 0 'a' > > f2 :: Monad m => Int -> Float -> m Bool > f2 = undefined > > From this, it's clear that f2 is being given an extra Char argument it > didn't ask for. However, the error msg (ghc 7.8.3) is: > > Couldn't match type ?m Bool? with ?Bool? > Expected type: Char -> m Bool > Actual type: Char -> Bool > Relevant bindings include f1 :: m Bool (bound at Bug.hs:4:1) > The function ?f2? is applied to three arguments, > but its type ?Int -> Float -> Char -> Bool? has only three > In the expression: f2 0 0 'a' > In an equation for ?f1?: f1 = f2 0 0 'a' > > The confusing part is that 'f2' was applied to three arguments, but > it's type has only three. It includes the Char in expected and actual > types, and implies that the type of 'f2' includes the Char. So I took > quite a while to realize that the type of 'f2' in fact *didn't* expect > a Char (and had an 'm'), so that the "but its type" is *not* in fact > its declared type. > > I suppose it infers a type for 'f2' based on its use, and that then > becomes the "actual" type, but it seems less confusing if it picked > the declared type of 'f2' as its actual type. Perhaps this is working > as intended, but it it is confusing! Especially the part about > "expected three but got three". > > Ideally I'd like to see "too many arguments" or at least "expected > (Char -> m Bool) but actually 'm Bool'". Actually I'd expect the > other way: "expected 'm Bool' but got (Char -> m Bool)' but I think > ghc has always done it backwards from how I expect. It looks like > it's substituting (->) for 'm', so maybe it's one of those things > where ((->) a) is also a monad. > _______________________________________________ > Glasgow-haskell-users mailing list > Glasgow-haskell-users at haskell.org > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users From shumovichy at gmail.com Thu Dec 4 21:21:16 2014 From: shumovichy at gmail.com (Yuras Shumovich) Date: Fri, 05 Dec 2014 00:21:16 +0300 Subject: confusing type error In-Reply-To: <2BBF7ED4-9F12-435E-82C3-2C8676F09929@cis.upenn.edu> References: <2BBF7ED4-9F12-435E-82C3-2C8676F09929@cis.upenn.edu> Message-ID: <1417728076.2751.1.camel@gmail.com> It seems to be an instance of https://ghc.haskell.org/trac/ghc/ticket/7869 But it is fixed (both in HEAD and 7.8). Probably the fix is partial? On Thu, 2014-12-04 at 14:53 -0500, Richard Eisenberg wrote: > This seems straightforwardly to be a bug, to me. HEAD gives the same behavior you report below. Please post on the bug tracker at https://ghc.haskell.org/trac/ghc/newticket > > Thanks! > Richard > > On Dec 4, 2014, at 1:50 PM, Evan Laforge wrote: > > > I recently got a confusing error msg, and reduced it to a small case: > > > > f1 :: Monad m => m Bool > > f1 = f2 0 0 'a' > > > > f2 :: Monad m => Int -> Float -> m Bool > > f2 = undefined > > > > From this, it's clear that f2 is being given an extra Char argument it > > didn't ask for. However, the error msg (ghc 7.8.3) is: > > > > Couldn't match type ?m Bool? with ?Bool? > > Expected type: Char -> m Bool > > Actual type: Char -> Bool > > Relevant bindings include f1 :: m Bool (bound at Bug.hs:4:1) > > The function ?f2? is applied to three arguments, > > but its type ?Int -> Float -> Char -> Bool? has only three > > In the expression: f2 0 0 'a' > > In an equation for ?f1?: f1 = f2 0 0 'a' > > > > The confusing part is that 'f2' was applied to three arguments, but > > it's type has only three. It includes the Char in expected and actual > > types, and implies that the type of 'f2' includes the Char. So I took > > quite a while to realize that the type of 'f2' in fact *didn't* expect > > a Char (and had an 'm'), so that the "but its type" is *not* in fact > > its declared type. > > > > I suppose it infers a type for 'f2' based on its use, and that then > > becomes the "actual" type, but it seems less confusing if it picked > > the declared type of 'f2' as its actual type. Perhaps this is working > > as intended, but it it is confusing! Especially the part about > > "expected three but got three". > > > > Ideally I'd like to see "too many arguments" or at least "expected > > (Char -> m Bool) but actually 'm Bool'". Actually I'd expect the > > other way: "expected 'm Bool' but got (Char -> m Bool)' but I think > > ghc has always done it backwards from how I expect. It looks like > > it's substituting (->) for 'm', so maybe it's one of those things > > where ((->) a) is also a monad. > > _______________________________________________ > > Glasgow-haskell-users mailing list > > Glasgow-haskell-users at haskell.org > > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users > > > > _______________________________________________ > Glasgow-haskell-users mailing list > Glasgow-haskell-users at haskell.org > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users From qdunkan at gmail.com Thu Dec 4 21:23:42 2014 From: qdunkan at gmail.com (Evan Laforge) Date: Thu, 4 Dec 2014 13:23:42 -0800 Subject: confusing type error In-Reply-To: <3D342993-B7DD-4ABB-A89E-24A83B0D4BDB@gmail.com> References: <3D342993-B7DD-4ABB-A89E-24A83B0D4BDB@gmail.com> Message-ID: On Thu, Dec 4, 2014 at 12:59 PM, migmit wrote: > It tries to get `m Bool` by applying f1 to three arguments: 0, 0, and 'a'. Now, since `f2` has the type `Int -> Float -> n Bool`, where `n` is of kind `* -> *` (and an instance of `Monad` class, but it's not yet the time to look for instances), we have `f2 0 :: Float -> n Bool` and `f2 0 0 :: n Bool`. Since that is applied to 'a', Haskell deduces that the last type should be something like `Char -> Something` ? or, equivalently, `(->) Char Something`. Therefore, it can see that `n` is in fact `(->) Char` and `Something` is `Bool`. Therefore, `f2 0 0 'a' :: Bool`. But it is expecting `m Bool`, not `Bool` ? which is exactly what an error message says. Right, that's what I suspected was happening. The confusion arrises because it guesses that 'm' should be (->), and that deduction then leads to a dead-end. But when it reports the problem, it uses its guessed 'm', rather that backing up to the declared value. But surely always backing up to the declared unspecialized value is no good either, because then you get vague errors. All the compiler knows is that when it simplifies as far as it can, it winds up with a /= b, it doesn't know that I would have been surprised by its path a few steps back. But arity errors are common, and intentionally instantiating a prefix type constructor like 'm a' as (->) is probably much less common. So perhaps there could be a heuristic that treats (->) specially and includes an extra clause in the error if it unified a type variable to (->)? I suspect the "expected n but got n" error is also due to the same thing, it counts arrows on one side but inferred arrows on the other? Or something? In any case, it seems like the two sides are counting inconsistently. From alexander.vershilov at gmail.com Thu Dec 4 22:50:19 2014 From: alexander.vershilov at gmail.com (Alexander V Vershilov) Date: Fri, 5 Dec 2014 02:50:19 +0400 Subject: Proving properties of type-level natural numbers obtained from user input In-Reply-To: <7DEE4B6F-3B6C-4E3B-A91C-57D27CBC44D5@cis.upenn.edu> References: <59442EC1-0552-4767-A578-6B02CF805823@cis.upenn.edu> <7DEE4B6F-3B6C-4E3B-A91C-57D27CBC44D5@cis.upenn.edu> Message-ID: Hi, Richard Can you give some ideas or where to read how to properly use signletons and unary naturals in order to be able to express such constraints? Thanks -- Alexander On 30 November 2014 at 23:26, Richard Eisenberg wrote: > Hi Alexander, > > Nice idea to test against the set of known values. That's more type-safe than anything I've thought of. I agree that it's a bit of a painful construction, but I don't think we can do better with type-lits, as there is limited reasoning ability that GHC can manage. If you want to switch to unary naturals (`data Nat = Zero | Succ Nat`), then this can be built somewhat nicely with singletons and without unsafeCoerce. But, of course, unary naturals are very slow. > > By the way, the bug in the Proof2 version is a bug in GHC 7.8.3 (only in .3 -- not in .2 or in the soon-to-be .4) that allows you to write unsaturated type families that don't work. Saying `LessThan255` without a parameter should be a syntax error, but that check was accidentally turned off for 7.8.3, leading to a bogus type error. > > Thanks for sharing this work! > Richard > > On Nov 28, 2014, at 5:27 PM, Alexander V Vershilov wrote: > >> Hi, Bas, Richard. >> >> I've played a bit with example, obvously first approach contained bugs, >> but seems that I have fixed it and here I have 2 approaches, one uses >> unsafeCoerce (as Richard suggested) another is safe but with bad complexity: >> >> Full file is quite big, so I'm not inlining it in mail, but here is a link: >> >> https://github.com/qnikst/haskell-fun/blob/master/typelevel-literals/Proof.lhs >> >> I wonder how far it's possible to go with singletons approach that I have >> not tried yet. >> >> -- >> Alexander >> >> On 26 November 2014 at 10:15, Bas van Dijk wrote: >>> Hi Alexander, >>> >>> Thanks for your answer! This provides a lot of ideas how to proceed. >>> >>> I'm unsure about the following though: >>> >>>> lessThen :: KnownNat m => SomeNat -> Proxy m -> Maybe (Proof (n <= m) (Proxy n)) >>>> lessThen (SomeNat p) k >>>> | natVal p <= natVal k = Just (Proof $ Tagged (Proxy :: Proxy n)) >>>> | otherwise = Nothing >>> >>> Doesn't this mean lessThen returns a Proxy n for all (n :: Nat) and >>> not just the Nat inside the SomeNat? >>> >>> I also see that p is only used for comparing it to k. It's not used to >>> produce the return value. >>> >>> Cheers, >>> >>> Bas >>> >>> On 25 November 2014 at 19:55, Alexander V Vershilov >>> wrote: >>>> Hi, Richard, Bas. >>>> >>>> Maybe I didn't spell it properly but my point was to create a data >>>> type that carry a proof >>>> without exposing it's constructor and having clever constructor only, >>>> then the only place >>>> where you need to check will be that constructor. >>>> >>>> Also it's possible to write in slightly clearer, but again it's >>>> possible to make a mistake here >>>> and it will be a false proof. >>>> >>>>> lessThen :: KnownNat m => SomeNat -> Proxy m -> Maybe (Proof (n <= m) (Proxy n)) >>>>> lessThen (SomeNat p) k >>>>> | natVal p <= natVal k = Just (Proof $ Tagged (Proxy :: Proxy n)) >>>>> | otherwise = Nothing >>>> >>>> Of cause solution using singletons could solve this problem much better. >>>> >>>> -- >>>> Alexander >>>> >>>> On 25 November 2014 at 21:34, Richard Eisenberg wrote: >>>>> Hi Bas, >>>>> >>>>> I believe to do this "right", you would need singleton types. Then, when you discover that the number is bounded by 255, you would also discover that the type is bounded by 255, and you'd be home free. >>>>> >>>>> Unfortunately, I there isn't currently a way to do comparison on GHC.TypeLits Nats with singletons. (There is a module Data.Singletons.TypeLits in the `singletons` package, but there's a comment telling me TODO in the part where comparison should be implemented.) If it were implemented, it would have to use unsafeCoerce, as there's no built-in mechanism connecting runtime numbers with TypeLits. >>>>> >>>>> If I were you, I would just write `g` using unsafeCoerce in the right spot, instead of bothering with all the singletons, which would have to use unsafety anyway. >>>>> >>>>> The solution Alexander provides below doesn't quite build a proof, I think. Tellingly, if we omit the `natVal p <= 255` check, everything else still compiles. Thus, the `Proof` type he uses can be built even if the fact proven is false. That said, I don't know if my solution is any better, crucially relying on unsafeCoerce. >>>>> >>>>> Richard >>>>> >>>>> On Nov 25, 2014, at 4:52 AM, Alexander V Vershilov wrote: >>>>> >>>>>> Hi, >>>>>> >>>>>> Following approach can work, the idea is to define a type that will >>>>>> carry a proof (constraint) that we want to check. Here I have reused >>>>>> Data.Tagged, but it's possible to introduce your own with concrete >>>>>> constraints. >>>>>> >>>>>>> {-# LANGUAGE DataKinds #-} >>>>>>> {-# LANGUAGE GADTs #-} >>>>>>> {-# LANGUAGE TypeOperators #-} >>>>>>> {-# LANGUAGE KindSignatures #-} >>>>>>> {-# LANGUAGE PolyKinds #-} >>>>>>> {-# LANGUAGE UndecidableInstances #-} >>>>>>> import GHC.TypeLits >>>>>>> import GHC.Exts >>>>>>> import Data.Proxy >>>>>>> import Data.Tagged >>>>>>> import System.Environment >>>>>> >>>>>> New constraint carrying data type >>>>>> >>>>>>> newtype Proof a b = Proof { unProof :: Tagged a b } >>>>>> >>>>>> Runtime check for unknown naturals >>>>>> >>>>>>> fromSome :: SomeNat -> Maybe (Proof (n <= 255) (Proxy n)) >>>>>>> fromSome (SomeNat p) >>>>>>> | natVal p <= 255 = Just (Proof $ Tagged (Proxy :: Proxy n)) >>>>>>> | otherwise = Nothing >>>>>> >>>>>> Compiletime converter for known naturals >>>>>> >>>>>>> fromKnown :: (KnownNat n, n <= 255) => Proxy n -> Proof (n <= 255) (Proxy n) >>>>>>> fromKnown n = Proof $ Tagged n >>>>>> >>>>>> Function to test: >>>>>> >>>>>>> f2 :: (c ~ (n <= 255)) => Proof c (Proxy n) -> () >>>>>>> f2 _ = () >>>>>> >>>>>> Example of use: >>>>>> >>>>>>> main :: IO () >>>>>>> main = do >>>>>>> [arg] <- getArgs >>>>>>> let n = read arg :: Integer >>>>>>> >>>>>>> case someNatVal n of >>>>>>> Nothing -> error "Input is not a natural number!" >>>>>>> Just sn -> case fromSome sn of >>>>>>> Just p -> return $ f2 p >>>>>>> _ -> error "Input if larger than 255" >>>>>> >>>>>> >>>>>> On 25 November 2014 at 10:51, Bas van Dijk wrote: >>>>>>> Hi, >>>>>>> >>>>>>> I have another type-level programming related question: >>>>>>> >>>>>>>> {-# LANGUAGE GADTs #-} >>>>>>>> {-# LANGUAGE TypeOperators #-} >>>>>>>> {-# LANGUAGE ScopedTypeVariables #-} >>>>>>>> {-# LANGUAGE KindSignatures #-} >>>>>>>> >>>>>>>> import GHC.TypeLits >>>>>>> >>>>>>> Say I have a Proxy p of some type-level natural number: >>>>>>> >>>>>>>> p :: forall (n :: Nat). Proxy n >>>>>>>> p = Proxy >>>>>>> >>>>>>> Imagine I get p from user input like this: >>>>>>> >>>>>>>> main :: IO () >>>>>>>> main = do >>>>>>>> [arg] <- getArgs >>>>>>>> let n = read arg :: Integer >>>>>>>> >>>>>>>> case someNatVal n of >>>>>>>> Nothing -> error "Input is not a natural number!" >>>>>>>> Just (SomeNat (p :: Proxy n)) -> ... >>>>>>> >>>>>>> I also have a function f which takes a proxy of a natural number but >>>>>>> it has the additional constraint that the number should be lesser than >>>>>>> or equal to 255: >>>>>>> >>>>>>>> f :: forall (n :: Nat). (n <= 255) => proxy n -> () >>>>>>>> f _ = () >>>>>>> >>>>>>> How do I apply f to p? >>>>>>> >>>>>>> Obviously, applying it directly gives the type error: >>>>>>> >>>>>>>> f p >>>>>>> :179:1: >>>>>>> Couldn't match expected type ?'True? with actual type ?n0 <=? 255? >>>>>>> The type variable ?n0? is ambiguous >>>>>>> In the expression: f p >>>>>>> In an equation for ?it?: it = f p >>>>>>> >>>>>>> I imagine I somehow need to construct some Proof object using a function g like: >>>>>>> >>>>>>>> g :: forall (n :: Nat). proxy n -> Proof >>>>>>>> g _ = ... >>>>>>> >>>>>>> Where the Proof constructor encapsulates the (n <= 255) constraint: >>>>>>> >>>>>>>> data Proof where >>>>>>>> NoProof :: Proof >>>>>>>> Proof :: forall (n :: Nat). (n <= 255) >>>>>>>> => Proxy n -> Proof >>>>>>> >>>>>>> With g in hand I can construct c which patterns matches on g p and >>>>>>> when there's a Proof the (n <= 255) constraint will be in scope which >>>>>>> allows applying f to p: >>>>>>> >>>>>>>> c :: () >>>>>>>> c = case g p of >>>>>>>> NoProof -> error "Input is bigger than 255!" >>>>>>>> Proof p -> f p >>>>>>> >>>>>>> But how do I define g? >>>>>>> >>>>>>> Cheers, >>>>>>> >>>>>>> Bas >>>>>>> _______________________________________________ >>>>>>> Glasgow-haskell-users mailing list >>>>>>> Glasgow-haskell-users at haskell.org >>>>>>> http://www.haskell.org/mailman/listinfo/glasgow-haskell-users >>>>>> >>>>>> >>>>>> >>>>>> -- >>>>>> Alexander >>>>>> _______________________________________________ >>>>>> Glasgow-haskell-users mailing list >>>>>> Glasgow-haskell-users at haskell.org >>>>>> http://www.haskell.org/mailman/listinfo/glasgow-haskell-users >>>>>> >>>>> >>>> >>>> >>>> >>>> -- >>>> Alexander >> >> >> >> -- >> Alexander >> > -- Alexander From eir at cis.upenn.edu Fri Dec 5 14:49:02 2014 From: eir at cis.upenn.edu (Richard Eisenberg) Date: Fri, 5 Dec 2014 09:49:02 -0500 Subject: confusing type error In-Reply-To: References: <3D342993-B7DD-4ABB-A89E-24A83B0D4BDB@gmail.com> Message-ID: The reason I said "That's a bug!" so confidently is because of the "expected n but got n" part. Even if everything else is OK, we need to fix that one bit. And I tend to agree about using heuristics to report better error messages in the presence of instantiating a type variable with (->). I've been caught and confused by that, too. Richard On Dec 4, 2014, at 4:23 PM, Evan Laforge wrote: > On Thu, Dec 4, 2014 at 12:59 PM, migmit wrote: >> It tries to get `m Bool` by applying f1 to three arguments: 0, 0, and 'a'. Now, since `f2` has the type `Int -> Float -> n Bool`, where `n` is of kind `* -> *` (and an instance of `Monad` class, but it's not yet the time to look for instances), we have `f2 0 :: Float -> n Bool` and `f2 0 0 :: n Bool`. Since that is applied to 'a', Haskell deduces that the last type should be something like `Char -> Something` ? or, equivalently, `(->) Char Something`. Therefore, it can see that `n` is in fact `(->) Char` and `Something` is `Bool`. Therefore, `f2 0 0 'a' :: Bool`. But it is expecting `m Bool`, not `Bool` ? which is exactly what an error message says. > > Right, that's what I suspected was happening. The confusion arrises > because it guesses that 'm' should be (->), and that deduction then > leads to a dead-end. But when it reports the problem, it uses its > guessed 'm', rather that backing up to the declared value. > > But surely always backing up to the declared unspecialized value is no > good either, because then you get vague errors. All the compiler > knows is that when it simplifies as far as it can, it winds up with a > /= b, it doesn't know that I would have been surprised by its path a > few steps back. > > But arity errors are common, and intentionally instantiating a prefix > type constructor like 'm a' as (->) is probably much less common. So > perhaps there could be a heuristic that treats (->) specially and > includes an extra clause in the error if it unified a type variable to > (->)? > > I suspect the "expected n but got n" error is also due to the same > thing, it counts arrows on one side but inferred arrows on the other? > Or something? In any case, it seems like the two sides are counting > inconsistently. > _______________________________________________ > Glasgow-haskell-users mailing list > Glasgow-haskell-users at haskell.org > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users > From gergo at erdi.hu Fri Dec 5 14:55:14 2014 From: gergo at erdi.hu (=?UTF-8?B?RHIuIMOJUkRJIEdlcmfFkQ==?=) Date: Fri, 5 Dec 2014 22:55:14 +0800 Subject: confusing type error In-Reply-To: References: <3D342993-B7DD-4ABB-A89E-24A83B0D4BDB@gmail.com> Message-ID: But it says `expected Char -> Bool, got Char -> m Bool', note the `m' type constructor in the second one. So it's not `n' vs. `n'. On Dec 5, 2014 10:50 PM, "Richard Eisenberg" wrote: > The reason I said "That's a bug!" so confidently is because of the > "expected n but got n" part. Even if everything else is OK, we need to fix > that one bit. > > And I tend to agree about using heuristics to report better error messages > in the presence of instantiating a type variable with (->). I've been > caught and confused by that, too. > > Richard > > On Dec 4, 2014, at 4:23 PM, Evan Laforge wrote: > > > On Thu, Dec 4, 2014 at 12:59 PM, migmit wrote: > >> It tries to get `m Bool` by applying f1 to three arguments: 0, 0, and > 'a'. Now, since `f2` has the type `Int -> Float -> n Bool`, where `n` is of > kind `* -> *` (and an instance of `Monad` class, but it's not yet the time > to look for instances), we have `f2 0 :: Float -> n Bool` and `f2 0 0 :: n > Bool`. Since that is applied to 'a', Haskell deduces that the last type > should be something like `Char -> Something` ? or, equivalently, `(->) Char > Something`. Therefore, it can see that `n` is in fact `(->) Char` and > `Something` is `Bool`. Therefore, `f2 0 0 'a' :: Bool`. But it is expecting > `m Bool`, not `Bool` ? which is exactly what an error message says. > > > > Right, that's what I suspected was happening. The confusion arrises > > because it guesses that 'm' should be (->), and that deduction then > > leads to a dead-end. But when it reports the problem, it uses its > > guessed 'm', rather that backing up to the declared value. > > > > But surely always backing up to the declared unspecialized value is no > > good either, because then you get vague errors. All the compiler > > knows is that when it simplifies as far as it can, it winds up with a > > /= b, it doesn't know that I would have been surprised by its path a > > few steps back. > > > > But arity errors are common, and intentionally instantiating a prefix > > type constructor like 'm a' as (->) is probably much less common. So > > perhaps there could be a heuristic that treats (->) specially and > > includes an extra clause in the error if it unified a type variable to > > (->)? > > > > I suspect the "expected n but got n" error is also due to the same > > thing, it counts arrows on one side but inferred arrows on the other? > > Or something? In any case, it seems like the two sides are counting > > inconsistently. > > _______________________________________________ > > Glasgow-haskell-users mailing list > > Glasgow-haskell-users at haskell.org > > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users > > > > _______________________________________________ > Glasgow-haskell-users mailing list > Glasgow-haskell-users at haskell.org > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users > -------------- next part -------------- An HTML attachment was scrubbed... URL: From byorgey at gmail.com Fri Dec 5 15:50:06 2014 From: byorgey at gmail.com (Brent Yorgey) Date: Fri, 5 Dec 2014 10:50:06 -0500 Subject: confusing type error In-Reply-To: References: <3D342993-B7DD-4ABB-A89E-24A83B0D4BDB@gmail.com> Message-ID: I think Richard is referring to "The function ?f2? is applied to three arguments, but its type ?Int -> Float -> Char -> Bool? has only three". Note "applied to three ... but ... only three". Here n = three. -Brent On Fri, Dec 5, 2014 at 9:55 AM, Dr. ?RDI Gerg? wrote: > But it says `expected Char -> Bool, got Char -> m Bool', note the `m' type > constructor in the second one. So it's not `n' vs. `n'. > On Dec 5, 2014 10:50 PM, "Richard Eisenberg" wrote: > >> The reason I said "That's a bug!" so confidently is because of the >> "expected n but got n" part. Even if everything else is OK, we need to fix >> that one bit. >> >> And I tend to agree about using heuristics to report better error >> messages in the presence of instantiating a type variable with (->). I've >> been caught and confused by that, too. >> >> Richard >> >> On Dec 4, 2014, at 4:23 PM, Evan Laforge wrote: >> >> > On Thu, Dec 4, 2014 at 12:59 PM, migmit wrote: >> >> It tries to get `m Bool` by applying f1 to three arguments: 0, 0, and >> 'a'. Now, since `f2` has the type `Int -> Float -> n Bool`, where `n` is of >> kind `* -> *` (and an instance of `Monad` class, but it's not yet the time >> to look for instances), we have `f2 0 :: Float -> n Bool` and `f2 0 0 :: n >> Bool`. Since that is applied to 'a', Haskell deduces that the last type >> should be something like `Char -> Something` ? or, equivalently, `(->) Char >> Something`. Therefore, it can see that `n` is in fact `(->) Char` and >> `Something` is `Bool`. Therefore, `f2 0 0 'a' :: Bool`. But it is expecting >> `m Bool`, not `Bool` ? which is exactly what an error message says. >> > >> > Right, that's what I suspected was happening. The confusion arrises >> > because it guesses that 'm' should be (->), and that deduction then >> > leads to a dead-end. But when it reports the problem, it uses its >> > guessed 'm', rather that backing up to the declared value. >> > >> > But surely always backing up to the declared unspecialized value is no >> > good either, because then you get vague errors. All the compiler >> > knows is that when it simplifies as far as it can, it winds up with a >> > /= b, it doesn't know that I would have been surprised by its path a >> > few steps back. >> > >> > But arity errors are common, and intentionally instantiating a prefix >> > type constructor like 'm a' as (->) is probably much less common. So >> > perhaps there could be a heuristic that treats (->) specially and >> > includes an extra clause in the error if it unified a type variable to >> > (->)? >> > >> > I suspect the "expected n but got n" error is also due to the same >> > thing, it counts arrows on one side but inferred arrows on the other? >> > Or something? In any case, it seems like the two sides are counting >> > inconsistently. >> > _______________________________________________ >> > Glasgow-haskell-users mailing list >> > Glasgow-haskell-users at haskell.org >> > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users >> > >> >> _______________________________________________ >> Glasgow-haskell-users mailing list >> Glasgow-haskell-users at haskell.org >> http://www.haskell.org/mailman/listinfo/glasgow-haskell-users >> > > _______________________________________________ > Glasgow-haskell-users mailing list > Glasgow-haskell-users at haskell.org > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From eir at cis.upenn.edu Mon Dec 8 18:09:04 2014 From: eir at cis.upenn.edu (Richard Eisenberg) Date: Mon, 8 Dec 2014 13:09:04 -0500 Subject: Proving properties of type-level natural numbers obtained from user input In-Reply-To: References: <59442EC1-0552-4767-A578-6B02CF805823@cis.upenn.edu> <7DEE4B6F-3B6C-4E3B-A91C-57D27CBC44D5@cis.upenn.edu> Message-ID: Sadly, I don't have a go-to place for this stuff. Perhaps it will be helpful to see an example of this in action? Here is my unary version of this: > {-# LANGUAGE TemplateHaskell, DataKinds, PolyKinds, TypeFamilies, > ScopedTypeVariables, TypeOperators, UndecidableInstances, > GADTs, RankNTypes #-} > {-# OPTIONS_GHC -ftype-function-depth=300 -fcontext-stack=300 #-} > > import Data.Singletons.TH > import GHC.TypeLits hiding ( Nat ) > > $(singletons [d| > data Nat = Zero | Succ Nat > > leNat :: Nat -> Nat -> Bool > leNat Zero _ = True > leNat (Succ _) Zero = False > leNat (Succ a) (Succ b) = a `leNat` b > |]) > > -- | Singletons's 'withSomeSing' is what we want, but a bug in 7.8.3 doesn't > -- let it work without a specialized type for 'Nat's > withSomeNat :: Nat -> (forall (n :: Nat). Sing n -> r) -> r > withSomeNat = withSomeSing > > -- | Conveniently generate unary naturals > type family U n where > U 0 = Zero > U n = Succ (U (n-1)) > > toNat :: Integer -> Maybe Nat > toNat n | n < 0 = Nothing > | otherwise = Just $ go n > where > go 0 = Zero > go n = Succ (go (n-1)) > > type Bound = U 255 > > -- easier to test in GHCi than a proper 'main' > go :: Integer -> IO () > go n = > case toNat n of > Nothing -> putStrLn "Input is not a natural number!" > Just nat -> putStrLn $ withSomeNat nat $ \ snat -> > case snat `sLeNat` (sing :: Sing Bound) of > STrue -> f snat > SFalse -> "Didn't work" > > f :: forall proxy (n :: Nat). (n `LeNat` Bound) ~ True => proxy n -> String > f _ = "It worked!" I'm happy to answer questions, but it's hard to know how much detail to use in a description of the code. I hope this helps, Richard On Dec 4, 2014, at 5:50 PM, Alexander V Vershilov wrote: > Hi, Richard > > Can you give some ideas or where to read how to properly use signletons > and unary naturals in order to be able to express such constraints? > > Thanks > -- > Alexander > > On 30 November 2014 at 23:26, Richard Eisenberg wrote: >> Hi Alexander, >> >> Nice idea to test against the set of known values. That's more type-safe than anything I've thought of. I agree that it's a bit of a painful construction, but I don't think we can do better with type-lits, as there is limited reasoning ability that GHC can manage. If you want to switch to unary naturals (`data Nat = Zero | Succ Nat`), then this can be built somewhat nicely with singletons and without unsafeCoerce. But, of course, unary naturals are very slow. >> >> By the way, the bug in the Proof2 version is a bug in GHC 7.8.3 (only in .3 -- not in .2 or in the soon-to-be .4) that allows you to write unsaturated type families that don't work. Saying `LessThan255` without a parameter should be a syntax error, but that check was accidentally turned off for 7.8.3, leading to a bogus type error. >> >> Thanks for sharing this work! >> Richard >> >> On Nov 28, 2014, at 5:27 PM, Alexander V Vershilov wrote: >> >>> Hi, Bas, Richard. >>> >>> I've played a bit with example, obvously first approach contained bugs, >>> but seems that I have fixed it and here I have 2 approaches, one uses >>> unsafeCoerce (as Richard suggested) another is safe but with bad complexity: >>> >>> Full file is quite big, so I'm not inlining it in mail, but here is a link: >>> >>> https://github.com/qnikst/haskell-fun/blob/master/typelevel-literals/Proof.lhs >>> >>> I wonder how far it's possible to go with singletons approach that I have >>> not tried yet. >>> >>> -- >>> Alexander >>> >>> On 26 November 2014 at 10:15, Bas van Dijk wrote: >>>> Hi Alexander, >>>> >>>> Thanks for your answer! This provides a lot of ideas how to proceed. >>>> >>>> I'm unsure about the following though: >>>> >>>>> lessThen :: KnownNat m => SomeNat -> Proxy m -> Maybe (Proof (n <= m) (Proxy n)) >>>>> lessThen (SomeNat p) k >>>>> | natVal p <= natVal k = Just (Proof $ Tagged (Proxy :: Proxy n)) >>>>> | otherwise = Nothing >>>> >>>> Doesn't this mean lessThen returns a Proxy n for all (n :: Nat) and >>>> not just the Nat inside the SomeNat? >>>> >>>> I also see that p is only used for comparing it to k. It's not used to >>>> produce the return value. >>>> >>>> Cheers, >>>> >>>> Bas >>>> >>>> On 25 November 2014 at 19:55, Alexander V Vershilov >>>> wrote: >>>>> Hi, Richard, Bas. >>>>> >>>>> Maybe I didn't spell it properly but my point was to create a data >>>>> type that carry a proof >>>>> without exposing it's constructor and having clever constructor only, >>>>> then the only place >>>>> where you need to check will be that constructor. >>>>> >>>>> Also it's possible to write in slightly clearer, but again it's >>>>> possible to make a mistake here >>>>> and it will be a false proof. >>>>> >>>>>> lessThen :: KnownNat m => SomeNat -> Proxy m -> Maybe (Proof (n <= m) (Proxy n)) >>>>>> lessThen (SomeNat p) k >>>>>> | natVal p <= natVal k = Just (Proof $ Tagged (Proxy :: Proxy n)) >>>>>> | otherwise = Nothing >>>>> >>>>> Of cause solution using singletons could solve this problem much better. >>>>> >>>>> -- >>>>> Alexander >>>>> >>>>> On 25 November 2014 at 21:34, Richard Eisenberg wrote: >>>>>> Hi Bas, >>>>>> >>>>>> I believe to do this "right", you would need singleton types. Then, when you discover that the number is bounded by 255, you would also discover that the type is bounded by 255, and you'd be home free. >>>>>> >>>>>> Unfortunately, I there isn't currently a way to do comparison on GHC.TypeLits Nats with singletons. (There is a module Data.Singletons.TypeLits in the `singletons` package, but there's a comment telling me TODO in the part where comparison should be implemented.) If it were implemented, it would have to use unsafeCoerce, as there's no built-in mechanism connecting runtime numbers with TypeLits. >>>>>> >>>>>> If I were you, I would just write `g` using unsafeCoerce in the right spot, instead of bothering with all the singletons, which would have to use unsafety anyway. >>>>>> >>>>>> The solution Alexander provides below doesn't quite build a proof, I think. Tellingly, if we omit the `natVal p <= 255` check, everything else still compiles. Thus, the `Proof` type he uses can be built even if the fact proven is false. That said, I don't know if my solution is any better, crucially relying on unsafeCoerce. >>>>>> >>>>>> Richard >>>>>> >>>>>> On Nov 25, 2014, at 4:52 AM, Alexander V Vershilov wrote: >>>>>> >>>>>>> Hi, >>>>>>> >>>>>>> Following approach can work, the idea is to define a type that will >>>>>>> carry a proof (constraint) that we want to check. Here I have reused >>>>>>> Data.Tagged, but it's possible to introduce your own with concrete >>>>>>> constraints. >>>>>>> >>>>>>>> {-# LANGUAGE DataKinds #-} >>>>>>>> {-# LANGUAGE GADTs #-} >>>>>>>> {-# LANGUAGE TypeOperators #-} >>>>>>>> {-# LANGUAGE KindSignatures #-} >>>>>>>> {-# LANGUAGE PolyKinds #-} >>>>>>>> {-# LANGUAGE UndecidableInstances #-} >>>>>>>> import GHC.TypeLits >>>>>>>> import GHC.Exts >>>>>>>> import Data.Proxy >>>>>>>> import Data.Tagged >>>>>>>> import System.Environment >>>>>>> >>>>>>> New constraint carrying data type >>>>>>> >>>>>>>> newtype Proof a b = Proof { unProof :: Tagged a b } >>>>>>> >>>>>>> Runtime check for unknown naturals >>>>>>> >>>>>>>> fromSome :: SomeNat -> Maybe (Proof (n <= 255) (Proxy n)) >>>>>>>> fromSome (SomeNat p) >>>>>>>> | natVal p <= 255 = Just (Proof $ Tagged (Proxy :: Proxy n)) >>>>>>>> | otherwise = Nothing >>>>>>> >>>>>>> Compiletime converter for known naturals >>>>>>> >>>>>>>> fromKnown :: (KnownNat n, n <= 255) => Proxy n -> Proof (n <= 255) (Proxy n) >>>>>>>> fromKnown n = Proof $ Tagged n >>>>>>> >>>>>>> Function to test: >>>>>>> >>>>>>>> f2 :: (c ~ (n <= 255)) => Proof c (Proxy n) -> () >>>>>>>> f2 _ = () >>>>>>> >>>>>>> Example of use: >>>>>>> >>>>>>>> main :: IO () >>>>>>>> main = do >>>>>>>> [arg] <- getArgs >>>>>>>> let n = read arg :: Integer >>>>>>>> >>>>>>>> case someNatVal n of >>>>>>>> Nothing -> error "Input is not a natural number!" >>>>>>>> Just sn -> case fromSome sn of >>>>>>>> Just p -> return $ f2 p >>>>>>>> _ -> error "Input if larger than 255" >>>>>>> >>>>>>> >>>>>>> On 25 November 2014 at 10:51, Bas van Dijk wrote: >>>>>>>> Hi, >>>>>>>> >>>>>>>> I have another type-level programming related question: >>>>>>>> >>>>>>>>> {-# LANGUAGE GADTs #-} >>>>>>>>> {-# LANGUAGE TypeOperators #-} >>>>>>>>> {-# LANGUAGE ScopedTypeVariables #-} >>>>>>>>> {-# LANGUAGE KindSignatures #-} >>>>>>>>> >>>>>>>>> import GHC.TypeLits >>>>>>>> >>>>>>>> Say I have a Proxy p of some type-level natural number: >>>>>>>> >>>>>>>>> p :: forall (n :: Nat). Proxy n >>>>>>>>> p = Proxy >>>>>>>> >>>>>>>> Imagine I get p from user input like this: >>>>>>>> >>>>>>>>> main :: IO () >>>>>>>>> main = do >>>>>>>>> [arg] <- getArgs >>>>>>>>> let n = read arg :: Integer >>>>>>>>> >>>>>>>>> case someNatVal n of >>>>>>>>> Nothing -> error "Input is not a natural number!" >>>>>>>>> Just (SomeNat (p :: Proxy n)) -> ... >>>>>>>> >>>>>>>> I also have a function f which takes a proxy of a natural number but >>>>>>>> it has the additional constraint that the number should be lesser than >>>>>>>> or equal to 255: >>>>>>>> >>>>>>>>> f :: forall (n :: Nat). (n <= 255) => proxy n -> () >>>>>>>>> f _ = () >>>>>>>> >>>>>>>> How do I apply f to p? >>>>>>>> >>>>>>>> Obviously, applying it directly gives the type error: >>>>>>>> >>>>>>>>> f p >>>>>>>> :179:1: >>>>>>>> Couldn't match expected type ?'True? with actual type ?n0 <=? 255? >>>>>>>> The type variable ?n0? is ambiguous >>>>>>>> In the expression: f p >>>>>>>> In an equation for ?it?: it = f p >>>>>>>> >>>>>>>> I imagine I somehow need to construct some Proof object using a function g like: >>>>>>>> >>>>>>>>> g :: forall (n :: Nat). proxy n -> Proof >>>>>>>>> g _ = ... >>>>>>>> >>>>>>>> Where the Proof constructor encapsulates the (n <= 255) constraint: >>>>>>>> >>>>>>>>> data Proof where >>>>>>>>> NoProof :: Proof >>>>>>>>> Proof :: forall (n :: Nat). (n <= 255) >>>>>>>>> => Proxy n -> Proof >>>>>>>> >>>>>>>> With g in hand I can construct c which patterns matches on g p and >>>>>>>> when there's a Proof the (n <= 255) constraint will be in scope which >>>>>>>> allows applying f to p: >>>>>>>> >>>>>>>>> c :: () >>>>>>>>> c = case g p of >>>>>>>>> NoProof -> error "Input is bigger than 255!" >>>>>>>>> Proof p -> f p >>>>>>>> >>>>>>>> But how do I define g? >>>>>>>> >>>>>>>> Cheers, >>>>>>>> >>>>>>>> Bas >>>>>>>> _______________________________________________ >>>>>>>> Glasgow-haskell-users mailing list >>>>>>>> Glasgow-haskell-users at haskell.org >>>>>>>> http://www.haskell.org/mailman/listinfo/glasgow-haskell-users >>>>>>> >>>>>>> >>>>>>> >>>>>>> -- >>>>>>> Alexander >>>>>>> _______________________________________________ >>>>>>> Glasgow-haskell-users mailing list >>>>>>> Glasgow-haskell-users at haskell.org >>>>>>> http://www.haskell.org/mailman/listinfo/glasgow-haskell-users >>>>>>> >>>>>> >>>>> >>>>> >>>>> >>>>> -- >>>>> Alexander >>> >>> >>> >>> -- >>> Alexander >>> >> > > > > -- > Alexander > From jhala at cs.ucsd.edu Mon Dec 8 18:45:55 2014 From: jhala at cs.ucsd.edu (Ranjit Jhala) Date: Mon, 8 Dec 2014 10:45:55 -0800 Subject: Proving properties of type-level natural numbers obtained from user input In-Reply-To: References: <59442EC1-0552-4767-A578-6B02CF805823@cis.upenn.edu> <7DEE4B6F-3B6C-4E3B-A91C-57D27CBC44D5@cis.upenn.edu> Message-ID: Dear Alexander, FWIW, this sort of thing is quite straightforward with LiquidHaskell: http://goto.ucsd.edu:8090/index.html#?demo=permalink%2F1418064183.hs or, the code below: ----- {-@ LIQUID "--no-termination" @-} module Nat255 where -- | Define a predicate for valid integers {-@ predicate IsValid X = 0 <= X && X < 255 @-} -- | Use the predicate to define a refinement type (subset) of valid integers {-@ type Valid = {v:Int | IsValid v} @-} -- | A function that checks whether a given Int is indeed valid {-@ isValid :: n:Int -> {v:Bool | Prop v <=> IsValid n} @-} isValid n = 0 <= n && n < (255 :: Int) -- | A function that can only be called with Valid Ints. {-@ workWithValidNumber :: Valid -> IO () @-} workWithValidNumber n = putStrLn $ "This is a valid number" ++ show (n :: Int) -- | This is fine... ok = workWithValidNumber 12 -- | ... But this is not. notOk = workWithValidNumber 257 -- | Finally the top level loop that inputs a number, tests it -- and calls `workWithValidNumber` if the number is valid. loop = do putStrLn "Enter Number between 0 and 255" n <- readLn :: IO Int if isValid n then workWithValidNumber n else putStrLn "Humph, bad input, try again!" >> loop -------------- next part -------------- An HTML attachment was scrubbed... URL: From qdunkan at gmail.com Wed Dec 10 05:10:47 2014 From: qdunkan at gmail.com (Evan Laforge) Date: Tue, 9 Dec 2014 21:10:47 -0800 Subject: confusing type error In-Reply-To: References: <3D342993-B7DD-4ABB-A89E-24A83B0D4BDB@gmail.com> Message-ID: I was going to ask if I should go ahead and file a bug anyway, but I just noticed commit 09b7943321f89b945d10f8a914f4c2cbf73dff91 seems to fix it. Many thanks to Yuras! On Fri, Dec 5, 2014 at 7:50 AM, Brent Yorgey wrote: > I think Richard is referring to "The function ?f2? is applied to three > arguments, > but its type ?Int -> Float -> Char -> Bool? has only three". Note > "applied to three ... but ... only three". Here n = three. > > -Brent > > On Fri, Dec 5, 2014 at 9:55 AM, Dr. ?RDI Gerg? wrote: >> >> But it says `expected Char -> Bool, got Char -> m Bool', note the `m' type >> constructor in the second one. So it's not `n' vs. `n'. >> >> On Dec 5, 2014 10:50 PM, "Richard Eisenberg" wrote: >>> >>> The reason I said "That's a bug!" so confidently is because of the >>> "expected n but got n" part. Even if everything else is OK, we need to fix >>> that one bit. >>> >>> And I tend to agree about using heuristics to report better error >>> messages in the presence of instantiating a type variable with (->). I've >>> been caught and confused by that, too. >>> >>> Richard >>> >>> On Dec 4, 2014, at 4:23 PM, Evan Laforge wrote: >>> >>> > On Thu, Dec 4, 2014 at 12:59 PM, migmit wrote: >>> >> It tries to get `m Bool` by applying f1 to three arguments: 0, 0, and >>> >> 'a'. Now, since `f2` has the type `Int -> Float -> n Bool`, where `n` is of >>> >> kind `* -> *` (and an instance of `Monad` class, but it's not yet the time >>> >> to look for instances), we have `f2 0 :: Float -> n Bool` and `f2 0 0 :: n >>> >> Bool`. Since that is applied to 'a', Haskell deduces that the last type >>> >> should be something like `Char -> Something` ? or, equivalently, `(->) Char >>> >> Something`. Therefore, it can see that `n` is in fact `(->) Char` and >>> >> `Something` is `Bool`. Therefore, `f2 0 0 'a' :: Bool`. But it is expecting >>> >> `m Bool`, not `Bool` ? which is exactly what an error message says. >>> > >>> > Right, that's what I suspected was happening. The confusion arrises >>> > because it guesses that 'm' should be (->), and that deduction then >>> > leads to a dead-end. But when it reports the problem, it uses its >>> > guessed 'm', rather that backing up to the declared value. >>> > >>> > But surely always backing up to the declared unspecialized value is no >>> > good either, because then you get vague errors. All the compiler >>> > knows is that when it simplifies as far as it can, it winds up with a >>> > /= b, it doesn't know that I would have been surprised by its path a >>> > few steps back. >>> > >>> > But arity errors are common, and intentionally instantiating a prefix >>> > type constructor like 'm a' as (->) is probably much less common. So >>> > perhaps there could be a heuristic that treats (->) specially and >>> > includes an extra clause in the error if it unified a type variable to >>> > (->)? >>> > >>> > I suspect the "expected n but got n" error is also due to the same >>> > thing, it counts arrows on one side but inferred arrows on the other? >>> > Or something? In any case, it seems like the two sides are counting >>> > inconsistently. >>> > _______________________________________________ >>> > Glasgow-haskell-users mailing list >>> > Glasgow-haskell-users at haskell.org >>> > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users >>> > >>> >>> _______________________________________________ >>> Glasgow-haskell-users mailing list >>> Glasgow-haskell-users at haskell.org >>> http://www.haskell.org/mailman/listinfo/glasgow-haskell-users >> >> >> _______________________________________________ >> Glasgow-haskell-users mailing list >> Glasgow-haskell-users at haskell.org >> http://www.haskell.org/mailman/listinfo/glasgow-haskell-users >> > > > _______________________________________________ > Glasgow-haskell-users mailing list > Glasgow-haskell-users at haskell.org > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users > From carter.schonwald at gmail.com Sat Dec 13 19:53:38 2014 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Sat, 13 Dec 2014 14:53:38 -0500 Subject: ANNOUNCE: GHC 7.8.4 Release Candidate 1 In-Reply-To: References: <87bnnu3ufg.fsf@gnu.org> Message-ID: Thomas and I have found some bugs in HPC on OSX, and we're in the midst of tracking those down, Those fixes should get into 7.8.4 and 7.10 both. Currently HPC on OSX is broken in pretty fundamental ways, and thats not ok! -Carter On Wed, Dec 3, 2014 at 5:53 PM, George Colpitts wrote: > > Would it be possible to get a RC for the Mac up at > https://downloads.haskell.org/~ghc/7.8.4-rc1/ ? > > Thanks > George > > > On Wed, Nov 26, 2014 at 10:31 AM, Herbert Valerio Riedel > wrote: > >> On 2014-11-26 at 12:40:37 +0100, Sven Panne wrote: >> > 2014-11-25 20:46 GMT+01:00 Austin Seipp : >> >> We are pleased to announce the first release candidate for GHC 7.8.4: >> >> >> >> https://downloads.haskell.org/~ghc/7.8.4-rc1/ [...] >> > >> > Would it be possible to get the RC on >> > https://launchpad.net/~hvr/+archive/ubuntu/ghc? This way one could >> > easily test things on Travis CI. >> >> I'll put a 7.8.4rc .deb up soon (probably right after the GHC 7.10 >> branch has been created) >> _______________________________________________ >> Glasgow-haskell-users mailing list >> Glasgow-haskell-users at haskell.org >> http://www.haskell.org/mailman/listinfo/glasgow-haskell-users >> > > > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://www.haskell.org/mailman/listinfo/ghc-devs > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From mikolaj at well-typed.com Sat Dec 13 21:56:18 2014 From: mikolaj at well-typed.com (Mikolaj Konarski) Date: Sat, 13 Dec 2014 22:56:18 +0100 Subject: ANNOUNCE: GHC 7.8.4 Release Candidate 1 In-Reply-To: References: <87bnnu3ufg.fsf@gnu.org> Message-ID: On Sat, Dec 13, 2014 at 8:53 PM, Carter Schonwald wrote: > Thomas and I have found some bugs in HPC on OSX, and we're in the midst of > tracking those down, You mean these are regressions? If they are introduced in one of the non-blocker fixes in 7.8.4, we can probably just revert them. Anyway, thanks a lot for testing. Cheers, Mikolaj From mikolaj at well-typed.com Sat Dec 13 22:07:32 2014 From: mikolaj at well-typed.com (Mikolaj Konarski) Date: Sat, 13 Dec 2014 23:07:32 +0100 Subject: ANNOUNCE: GHC 7.8.4 Release Candidate 1 In-Reply-To: References: <87bnnu3ufg.fsf@gnu.org> Message-ID: OK. In that case, let's remember to get *that* version of cabal into 7.8.4. /me conditions himself with chocolate to help the remembering On Sat, Dec 13, 2014 at 11:02 PM, Thomas Tuegel wrote: > On Sat, Dec 13, 2014 at 3:56 PM, Mikolaj Konarski > wrote: >> On Sat, Dec 13, 2014 at 8:53 PM, Carter Schonwald >> wrote: >>> Thomas and I have found some bugs in HPC on OSX, and we're in the midst of >>> tracking those down, >> >> You mean these are regressions? If they are introduced >> in one of the non-blocker fixes in 7.8.4, we can probably >> just revert them. Anyway, thanks a lot for testing. > > Sorry, these are not regressions. It's really a bug in Cabal which > will be fixed in 1.22. When Carter wrote this, we thought the problem > was with the GHC side of HPC because of some very vague error > messages. > > -- > Thomas Tuegel > From brandon.m.simmons at gmail.com Mon Dec 15 21:21:51 2014 From: brandon.m.simmons at gmail.com (Brandon Simmons) Date: Mon, 15 Dec 2014 16:21:51 -0500 Subject: Behavior of touch# Message-ID: The `primitive` package exports a lifted version of the undocumented `touch#` http://hackage.haskell.org/package/ghc-prim-0.3.1.0/docs/GHC-Prim.html which has type: touch :: PrimMonad m => a -> m () I'd like to know if this works correctly in general, or will it suffer from the same gotches w/r/t unboxing as with addFinalizer and Weak references? i.e. must it only be passed an unboxed type? Brandon From carter.schonwald at gmail.com Tue Dec 16 06:43:13 2014 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Tue, 16 Dec 2014 01:43:13 -0500 Subject: Behavior of touch# In-Reply-To: References: Message-ID: the point of touch is to prevent premature GC, it actually gets erased at the CMM level i believe. That is, it only makes sense to apply touch to lifted types on the heap! On Mon, Dec 15, 2014 at 4:21 PM, Brandon Simmons < brandon.m.simmons at gmail.com> wrote: > > The `primitive` package exports a lifted version of the undocumented > `touch#` > > http://hackage.haskell.org/package/ghc-prim-0.3.1.0/docs/GHC-Prim.html > > which has type: > > touch :: PrimMonad m => a -> m () > > I'd like to know if this works correctly in general, or will it suffer > from the same gotches w/r/t unboxing as with addFinalizer and Weak > references? i.e. must it only be passed an unboxed type? > > Brandon > _______________________________________________ > Glasgow-haskell-users mailing list > Glasgow-haskell-users at haskell.org > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users > -------------- next part -------------- An HTML attachment was scrubbed... URL: From carter.schonwald at gmail.com Tue Dec 16 06:45:16 2014 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Tue, 16 Dec 2014 01:45:16 -0500 Subject: Behavior of touch# In-Reply-To: References: Message-ID: https://github.com/ghc/ghc/blob/8c10b67ba049477cc9ed23e61f5bd119e1cefc29/compiler/cmm/CmmMachOp.hs#L556 and https://github.com/ghc/ghc/blob/8c10b67ba049477cc9ed23e61f5bd119e1cefc29/compiler/nativeGen/X86/CodeGen.hs#L1731 spell it out a bit more so touch is preserved through the CMM level, and then gets erased when doing final code gen. Its meant to ensure on heap pointers remain reachable On Tue, Dec 16, 2014 at 1:43 AM, Carter Schonwald < carter.schonwald at gmail.com> wrote: > > the point of touch is to prevent premature GC, it actually gets erased at > the CMM level i believe. > That is, it only makes sense to apply touch to lifted types on the heap! > > On Mon, Dec 15, 2014 at 4:21 PM, Brandon Simmons < > brandon.m.simmons at gmail.com> wrote: >> >> The `primitive` package exports a lifted version of the undocumented >> `touch#` >> >> >> http://hackage.haskell.org/package/ghc-prim-0.3.1.0/docs/GHC-Prim.html >> >> which has type: >> >> touch :: PrimMonad m => a -> m () >> >> I'd like to know if this works correctly in general, or will it suffer >> from the same gotches w/r/t unboxing as with addFinalizer and Weak >> references? i.e. must it only be passed an unboxed type? >> >> Brandon >> _______________________________________________ >> Glasgow-haskell-users mailing list >> Glasgow-haskell-users at haskell.org >> http://www.haskell.org/mailman/listinfo/glasgow-haskell-users >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From simonpj at microsoft.com Tue Dec 16 09:00:10 2014 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Tue, 16 Dec 2014 09:00:10 +0000 Subject: Behavior of touch# In-Reply-To: References: Message-ID: <618BE556AADD624C9C918AA5D5911BEF3F402813@DB3PRD3001MB020.064d.mgd.msft.net> Would it make sense to elaborate the Haddock docs to explain stuff here? Simon From: Glasgow-haskell-users [mailto:glasgow-haskell-users-bounces at haskell.org] On Behalf Of Carter Schonwald Sent: 16 December 2014 06:45 To: Brandon Simmons Cc: glasgow-haskell-users Subject: Re: Behavior of touch# https://github.com/ghc/ghc/blob/8c10b67ba049477cc9ed23e61f5bd119e1cefc29/compiler/cmm/CmmMachOp.hs#L556 and https://github.com/ghc/ghc/blob/8c10b67ba049477cc9ed23e61f5bd119e1cefc29/compiler/nativeGen/X86/CodeGen.hs#L1731 spell it out a bit more so touch is preserved through the CMM level, and then gets erased when doing final code gen. Its meant to ensure on heap pointers remain reachable On Tue, Dec 16, 2014 at 1:43 AM, Carter Schonwald > wrote: the point of touch is to prevent premature GC, it actually gets erased at the CMM level i believe. That is, it only makes sense to apply touch to lifted types on the heap! On Mon, Dec 15, 2014 at 4:21 PM, Brandon Simmons > wrote: The `primitive` package exports a lifted version of the undocumented `touch#` http://hackage.haskell.org/package/ghc-prim-0.3.1.0/docs/GHC-Prim.html which has type: touch :: PrimMonad m => a -> m () I'd like to know if this works correctly in general, or will it suffer from the same gotches w/r/t unboxing as with addFinalizer and Weak references? i.e. must it only be passed an unboxed type? Brandon _______________________________________________ Glasgow-haskell-users mailing list Glasgow-haskell-users at haskell.org http://www.haskell.org/mailman/listinfo/glasgow-haskell-users -------------- next part -------------- An HTML attachment was scrubbed... URL: From rasfar at gmail.com Fri Dec 19 13:07:33 2014 From: rasfar at gmail.com (Andrew Seniuk) Date: Fri, 19 Dec 2014 07:07:33 -0600 Subject: ANN: deepseq-bounded, seqaid, leaky Message-ID: This trio of related packages explores strictness control in a variety of ways. deepseq-bounded provides classes and generic functions to artificially force evaluation, to extents controlled by static or dynamic configuration. seqaid puts that into practise, providing a GHC plugin to auto-instrument your package with a strictness harness, which is dynamically optimisable during runtime. This is supported directly in the GHC compilation pipeline, without requiring (or performing!) any edits to your sources. leaky is a minimal, prototypic executable that leaks space under current state-of-the-art compilation (GHC 7.8.3 -O2, at the present time). deepseq-bounded hackage: https://hackage.haskell.org/package/deepseq-bounded homepage: http://www.fremissant.net/deepseq-bounded seqaid hackage: https://hackage.haskell.org/package/seqaid homepage: http://www.fremissant.net/seqaid leaky hackage: https://hackage.haskell.org/package/leaky homepage: http://www.fremissant.net/leaky Reddit discussion for the three together: http://www.reddit.com/r/haskell/comments/2ps8f5/ann_deepseqbounded_seqaid_leaky/ Easiest way to try them all, is to install seqaid and run the demo: cabal install seqaid seqaid demo This tests seqaid on a local copy of the leaky source package. It turned out to be routine to extend deepseq-bounded and seqaid to dynamically configurable parallelisation (paraid?). Many other wrappers could be explored, too! Maybe seqaid should be renamed to koolaid or something... It's a pretty complicated system, and just first release, so there's bound to be lots of problems. I've not set up a bug tracker, but will maintain a casual list of bugs and feature requests at http://www.fremissant.net/seqaid/trac and will set up a proper tracker if there's interest. Any isssues (or comments), I'm here, or on the reddit discussion (or email). Andrew Seniuk rasfar on #haskell -------------- next part -------------- An HTML attachment was scrubbed... URL: From rasfar at gmail.com Fri Dec 19 14:01:12 2014 From: rasfar at gmail.com (Andrew Seniuk) Date: Fri, 19 Dec 2014 08:01:12 -0600 Subject: ANN: deepseq-bounded, seqaid, leaky In-Reply-To: References: Message-ID: Sorry, that was my first Reddit post and I messed up. Please use this link http://www.reddit.com/r/haskell/comments/2pscxh/ann_deepseqbounded_seqaid_leaky/ -Andrew On Fri, Dec 19, 2014 at 7:07 AM, Andrew Seniuk wrote: > This trio of related packages explores strictness control in a variety of > ways. > > deepseq-bounded provides classes and generic functions to artificially > force evaluation, to extents controlled by static or dynamic configuration. > > seqaid puts that into practise, providing a GHC plugin to auto-instrument > your package with a strictness harness, which is dynamically optimisable > during runtime. This is supported directly in the GHC compilation > pipeline, without requiring (or performing!) any edits to your sources. > > leaky is a minimal, prototypic executable that leaks space under current > state-of-the-art compilation (GHC 7.8.3 -O2, at the present time). > > deepseq-bounded > hackage: https://hackage.haskell.org/package/deepseq-bounded > homepage: http://www.fremissant.net/deepseq-bounded > > seqaid > hackage: https://hackage.haskell.org/package/seqaid > homepage: http://www.fremissant.net/seqaid > > leaky > hackage: https://hackage.haskell.org/package/leaky > homepage: http://www.fremissant.net/leaky > > Reddit discussion for the three together: > > http://www.reddit.com/r/haskell/comments/2ps8f5/ann_deepseqbounded_seqaid_leaky/ > > Easiest way to try them all, is to install seqaid and run the demo: > > cabal install seqaid > seqaid demo > > This tests seqaid on a local copy of the leaky source package. > > It turned out to be routine to extend deepseq-bounded and seqaid to > dynamically configurable parallelisation (paraid?). Many other wrappers > could be explored, too! Maybe seqaid should be renamed to koolaid or > something... > > It's a pretty complicated system, and just first release, so there's bound > to be lots of problems. I've not set up a bug tracker, but will maintain a > casual list of bugs and feature requests at > > http://www.fremissant.net/seqaid/trac > > and will set up a proper tracker if there's interest. > > Any isssues (or comments), I'm here, or on the reddit discussion (or > email). > > Andrew Seniuk > rasfar on #haskell > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From alexander.vershilov at gmail.com Fri Dec 19 22:53:16 2014 From: alexander.vershilov at gmail.com (Alexander V Vershilov) Date: Sat, 20 Dec 2014 02:53:16 +0400 Subject: Proving properties of type-level natural numbers obtained from user input In-Reply-To: References: <59442EC1-0552-4767-A578-6B02CF805823@cis.upenn.edu> <7DEE4B6F-3B6C-4E3B-A91C-57D27CBC44D5@cis.upenn.edu> Message-ID: Richard, Ranjit, Thanks for providing your solutions. -- Alexander. On 8 December 2014 at 21:45, Ranjit Jhala wrote: > Dear Alexander, > > FWIW, this sort of thing is quite straightforward with LiquidHaskell: > > http://goto.ucsd.edu:8090/index.html#?demo=permalink%2F1418064183.hs > > or, the code below: > > ----- > > {-@ LIQUID "--no-termination" @-} > > module Nat255 where > > -- | Define a predicate for valid integers > > {-@ predicate IsValid X = 0 <= X && X < 255 @-} > > -- | Use the predicate to define a refinement type (subset) of valid > integers > > {-@ type Valid = {v:Int | IsValid v} @-} > > -- | A function that checks whether a given Int is indeed valid > > {-@ isValid :: n:Int -> {v:Bool | Prop v <=> IsValid n} @-} > isValid n = 0 <= n && n < (255 :: Int) > > -- | A function that can only be called with Valid Ints. > > {-@ workWithValidNumber :: Valid -> IO () @-} > workWithValidNumber n = putStrLn $ "This is a valid number" ++ show (n :: > Int) > > -- | This is fine... > ok = workWithValidNumber 12 > > -- | ... But this is not. > notOk = workWithValidNumber 257 > > -- | Finally the top level loop that inputs a number, tests it > -- and calls `workWithValidNumber` if the number is valid. > > loop = do putStrLn "Enter Number between 0 and 255" > n <- readLn :: IO Int > if isValid n > then workWithValidNumber n > else putStrLn "Humph, bad input, try again!" >> loop > -- Alexander From rasfar at gmail.com Sun Dec 21 22:20:30 2014 From: rasfar at gmail.com (Andrew Seniuk) Date: Sun, 21 Dec 2014 16:20:30 -0600 Subject: ANN: deepseq-bounded, seqaid, leaky In-Reply-To: References: Message-ID: Finally, in case the lack of constraints on dependencies put anyone off, please note that all deps in all three projects now have minimum and maximum bounds. Also, I should take this chance to note that there were no cache controls in the homepages linked above, so please force reloads in your browser to see latest versions. (The pages /now/ have caching prevention so this should not be necessary again.) And, it's nice to share your thoughts, don't you think? -Andrew On Fri, Dec 19, 2014 at 8:01 AM, Andrew Seniuk wrote: > Sorry, that was my first Reddit post and I messed up. > > Please use this link > http://www.reddit.com/r/haskell/comments/2pscxh/ann_deepseqbounded_seqaid_leaky/ > > -Andrew > > On Fri, Dec 19, 2014 at 7:07 AM, Andrew Seniuk wrote: > >> This trio of related packages explores strictness control in a variety of >> ways. >> >> deepseq-bounded provides classes and generic functions to artificially >> force evaluation, to extents controlled by static or dynamic configuration. >> >> seqaid puts that into practise, providing a GHC plugin to auto-instrument >> your package with a strictness harness, which is dynamically optimisable >> during runtime. This is supported directly in the GHC compilation >> pipeline, without requiring (or performing!) any edits to your sources. >> >> leaky is a minimal, prototypic executable that leaks space under current >> state-of-the-art compilation (GHC 7.8.3 -O2, at the present time). >> >> deepseq-bounded >> hackage: https://hackage.haskell.org/package/deepseq-bounded >> homepage: http://www.fremissant.net/deepseq-bounded >> >> seqaid >> hackage: https://hackage.haskell.org/package/seqaid >> homepage: http://www.fremissant.net/seqaid >> >> leaky >> hackage: https://hackage.haskell.org/package/leaky >> homepage: http://www.fremissant.net/leaky >> >> Reddit discussion for the three together: >> >> http://www.reddit.com/r/haskell/comments/2ps8f5/ann_deepseqbounded_seqaid_leaky/ >> >> Easiest way to try them all, is to install seqaid and run the demo: >> >> cabal install seqaid >> seqaid demo >> >> This tests seqaid on a local copy of the leaky source package. >> >> It turned out to be routine to extend deepseq-bounded and seqaid to >> dynamically configurable parallelisation (paraid?). Many other wrappers >> could be explored, too! Maybe seqaid should be renamed to koolaid or >> something... >> >> It's a pretty complicated system, and just first release, so there's >> bound to be lots of problems. I've not set up a bug tracker, but will >> maintain a casual list of bugs and feature requests at >> >> http://www.fremissant.net/seqaid/trac >> >> and will set up a proper tracker if there's interest. >> >> Any isssues (or comments), I'm here, or on the reddit discussion (or >> email). >> >> Andrew Seniuk >> rasfar on #haskell >> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From dnspies at gmail.com Tue Dec 23 10:59:28 2014 From: dnspies at gmail.com (David Spies) Date: Tue, 23 Dec 2014 03:59:28 -0700 Subject: What to do when garbage collector is slow? Message-ID: I have a program that, to all appearances, is behaving properly. It uses very little memory to run, it has the profile I would expect looking at +RTS -hc. I have no reason to believe there is a memory leak (in the sense that it's not lazily holding on to things it no longer needs or strictly generating things it doesn't need yet). But it's slow, and according to -sstderr, most of the time is spent garbage-collecting. Why is the garbage-collector consuming so much running time? How can I deal with it? The program is a solution to this problem: https://open.kattis.com/problems/tourist The input data can be found here: http://heim.ifi.uio.no/~db/nm-i-programmering/nm2004/testdata/h.in -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: Main.hs Type: text/x-haskell Size: 2442 bytes Desc: not available URL: From austin at well-typed.com Tue Dec 23 13:12:39 2014 From: austin at well-typed.com (Austin Seipp) Date: Tue, 23 Dec 2014 07:12:39 -0600 Subject: ANNOUNCE: GHC version 7.8.4 Message-ID: ============================================================== The (Interactive) Glasgow Haskell Compiler -- version 7.8.4 ============================================================== The GHC Team is pleased to announce a new patchlevel release of GHC, 7.8.4. This is an important bugfix release relative to 7.8.3 (with over 30 defects fixed), so we highly recommend upgrading from the previous 7.8 releases. The full release notes are here: https://downloads.haskell.org/~ghc/7.8.4/docs/html/users_guide/release-7-8-4.html How to get it ~~~~~~~~~~~~~ The easy way is to go to the web page, which should be self-explanatory: https://www.haskell.org/ghc/ We supply binary builds in the native package format for many platforms, and the source distribution is available from the same place. Packages will appear as they are built - if the package for your system isn't available yet, please try again later. Background ~~~~~~~~~~ Haskell is a standard lazy functional programming language. GHC is a state-of-the-art programming suite for Haskell. Included is an optimising compiler generating good code for a variety of platforms, together with an interactive system for convenient, quick development. The distribution includes space and time profiling facilities, a large collection of libraries, and support for various language extensions, including concurrency, exceptions, and foreign language interfaces (C, whatever). GHC is distributed under a BSD-style open source license. A wide variety of Haskell related resources (tutorials, libraries, specifications, documentation, compilers, interpreters, references, contact information, links to research groups) are available from the Haskell home page (see below). On-line GHC-related resources ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Relevant URLs on the World-Wide Web: GHC home page http://www.haskell.org/ghc/ GHC developers' home page http://ghc.haskell.org/trac/ghc/ Haskell home page http://www.haskell.org/ Supported Platforms ~~~~~~~~~~~~~~~~~~~ The list of platforms we support, and the people responsible for them, is here: http://ghc.haskell.org/trac/ghc/wiki/Platforms http://ghc.haskell.org/trac/ghc/wiki/CodeOwners Ports to other platforms are possible with varying degrees of difficulty. The Building Guide describes how to go about porting to a new platform: http://ghc.haskell.org/trac/ghc/wiki/Building Developers ~~~~~~~~~~ We welcome new contributors. Instructions on accessing our source code repository, and getting started with hacking on GHC, are available from the GHC's developer's site run by Trac: http://ghc.haskell.org/trac/ghc/ Mailing lists ~~~~~~~~~~~~~ We run mailing lists for GHC users and bug reports; to subscribe, use the web interfaces at http://www.haskell.org/mailman/listinfo/glasgow-haskell-users http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs There are several other haskell and ghc-related mailing lists on www.haskell.org; for the full list, see http://www.haskell.org/mailman/listinfo/ Some GHC developers hang out on #haskell on IRC, too: http://www.haskell.org/haskellwiki/IRC_channel Please report bugs using our bug tracking system. Instructions on reporting bugs can be found here: http://www.haskell.org/ghc/reportabug Hashes & Signatures ~~~~~~~~~~~~~~~~~ On https://downloads.haskell.org/~ghc/7.8.4/ you will find a signed copy of the SHA256 hashes for the tarballs, using my GPG key (keyid 0x3B58D86F). -- Regards, Austin Seipp, Haskell Consultant Well-Typed LLP, http://www.well-typed.com/ From austin at well-typed.com Tue Dec 23 14:36:16 2014 From: austin at well-typed.com (Austin Seipp) Date: Tue, 23 Dec 2014 08:36:16 -0600 Subject: ANNOUNCE: GHC 7.10.1 Release Candidate 1 Message-ID: We are pleased to announce the first release candidate for GHC 7.10.1: https://downloads.haskell.org/~ghc/7.10.1-rc1/ This includes the source tarball and bindists for 64bit/32bit Linux and Windows. Binary builds for other platforms will be available shortly. (CentOS 6.5 binaries are not available at this time like they were for 7.8.x). These binaries and tarballs have an accompanying SHA256SUMS file signed by my GPG key id (0x3B58D86F). We plan to make the 7.10.1 release sometime in February of 2015. We expect another RC to occur during January of 2015. Please test as much as possible; bugs are much cheaper if we find them before the release! -- Regards, Austin Seipp, Haskell Consultant Well-Typed LLP, http://www.well-typed.com/ From austin at well-typed.com Tue Dec 23 14:39:26 2014 From: austin at well-typed.com (Austin Seipp) Date: Tue, 23 Dec 2014 08:39:26 -0600 Subject: HEADS UP: Tickets have been triaged a bit Message-ID: Hi *, As many of you will probably notice, I have bulk modified a lot of Trac tickets and moved their milestone out. You might be wondering why; the reasoning is that since 7.10.1 RC1 is out (see other email), we need to start prioritizing what gets done. So, I moved all tickets that were a) set to 7.10.1 milestone, b) not closed, and c) had below 'high priority', to the 7.12.1 milestone. There are some tickets in 'normal' that probably should be moved back. If you're CC'd on a ticket and think it should be fixed for 7.10.1, please: - Set the milestone back to 7.10.1 - And if you can, take ownership! GHC HQ will probably only have time to organize efforts to take on the most high priority tickets - so any help you can offer is always appreciated. You can see the current list of tickets here. We'll put notes on the page at the top as time goes on to keep people up to date. https://ghc.haskell.org/trac/ghc/wiki/Status/GHC-7.10.1 -- Regards, Austin Seipp, Haskell Consultant Well-Typed LLP, http://www.well-typed.com/ From dominic at steinitz.org Tue Dec 23 15:46:29 2014 From: dominic at steinitz.org (Dominic Steinitz) Date: Tue, 23 Dec 2014 15:46:29 +0000 Subject: CPP Help (was Re: Latest Template Haskell Breaks Package) In-Reply-To: <60A94643-234C-4EB7-A381-2E3263DB4E52@steinitz.org> References: <1632C06F-E358-4F91-B8E7-0DA1F9706099@steinitz.org> <60A94643-234C-4EB7-A381-2E3263DB4E52@steinitz.org> Message-ID: <7071FF06-77F5-40CE-A55C-B2A6C751F192@steinitz.org> 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 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 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 at 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/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 >>> > From carter.schonwald at gmail.com Tue Dec 23 15:54:31 2014 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Tue, 23 Dec 2014 10:54:31 -0500 Subject: CPP Help (was Re: Latest Template Haskell Breaks Package) In-Reply-To: <7071FF06-77F5-40CE-A55C-B2A6C751F192@steinitz.org> References: <1632C06F-E358-4F91-B8E7-0DA1F9706099@steinitz.org> <60A94643-234C-4EB7-A381-2E3263DB4E52@steinitz.org> <7071FF06-77F5-40CE-A55C-B2A6C751F192@steinitz.org> Message-ID: 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 at 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-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 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 at 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/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: From allbery.b at gmail.com Tue Dec 23 15:58:20 2014 From: allbery.b at gmail.com (Brandon Allbery) Date: Tue, 23 Dec 2014 10:58:20 -0500 Subject: CPP Help (was Re: Latest Template Haskell Breaks Package) In-Reply-To: <7071FF06-77F5-40CE-A55C-B2A6C751F192@steinitz.org> References: <1632C06F-E358-4F91-B8E7-0DA1F9706099@steinitz.org> <60A94643-234C-4EB7-A381-2E3263DB4E52@steinitz.org> <7071FF06-77F5-40CE-A55C-B2A6C751F192@steinitz.org> Message-ID: 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 at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From dominic at steinitz.org Tue Dec 23 16:10:11 2014 From: dominic at steinitz.org (Dominic Steinitz) Date: Tue, 23 Dec 2014 16:10:11 +0000 Subject: CPP Help (was Re: Latest Template Haskell Breaks Package) In-Reply-To: References: <1632C06F-E358-4F91-B8E7-0DA1F9706099@steinitz.org> <60A94643-234C-4EB7-A381-2E3263DB4E52@steinitz.org> <7071FF06-77F5-40CE-A55C-B2A6C751F192@steinitz.org> Message-ID: <53C9BA7D-38C7-4079-8E15-D32F5B751341@steinitz.org> 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 at steinitz.org http://idontgetoutmuch.wordpress.com On 23 Dec 2014, at 15:58, Brandon Allbery wrote: > 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 at gmail.com ballbery at sinenomine.net > unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From dominic at steinitz.org Tue Dec 23 16:11:11 2014 From: dominic at steinitz.org (Dominic Steinitz) Date: Tue, 23 Dec 2014 16:11:11 +0000 Subject: CPP Help (was Re: Latest Template Haskell Breaks Package) In-Reply-To: References: <1632C06F-E358-4F91-B8E7-0DA1F9706099@steinitz.org> <60A94643-234C-4EB7-A381-2E3263DB4E52@steinitz.org> <7071FF06-77F5-40CE-A55C-B2A6C751F192@steinitz.org> Message-ID: <8455B402-28AF-4882-ABB9-797C8050F1A3@steinitz.org> > $ 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 wrote: > 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 at 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-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 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 at 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/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: From allbery.b at gmail.com Tue Dec 23 16:14:57 2014 From: allbery.b at gmail.com (Brandon Allbery) Date: Tue, 23 Dec 2014 11:14:57 -0500 Subject: CPP Help (was Re: Latest Template Haskell Breaks Package) In-Reply-To: <53C9BA7D-38C7-4079-8E15-D32F5B751341@steinitz.org> References: <1632C06F-E358-4F91-B8E7-0DA1F9706099@steinitz.org> <60A94643-234C-4EB7-A381-2E3263DB4E52@steinitz.org> <7071FF06-77F5-40CE-A55C-B2A6C751F192@steinitz.org> <53C9BA7D-38C7-4079-8E15-D32F5B751341@steinitz.org> Message-ID: 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 at gmail.com ballbery at sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net -------------- next part -------------- An HTML attachment was scrubbed... URL: From jwlato at gmail.com Tue Dec 23 16:40:43 2014 From: jwlato at gmail.com (John Lato) Date: Tue, 23 Dec 2014 16:40:43 +0000 Subject: What to do when garbage collector is slow? References: Message-ID: Can't try your code now, but have you tried using threadscope? Just a thought, but maybe the garbage collection is blocked waiting for a thread to finish. -------------- next part -------------- An HTML attachment was scrubbed... URL: From jwlato at gmail.com Tue Dec 23 16:43:48 2014 From: jwlato at gmail.com (John Lato) Date: Tue, 23 Dec 2014 16:43:48 +0000 Subject: What to do when garbage collector is slow? References: Message-ID: Ah, just took a look. I think my suggestion is unlikely to be correct. On 08:40, Tue, Dec 23, 2014 John Lato wrote: > Can't try your code now, but have you tried using threadscope? Just a > thought, but maybe the garbage collection is blocked waiting for a thread > to finish. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From carter.schonwald at gmail.com Tue Dec 23 17:47:24 2014 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Tue, 23 Dec 2014 12:47:24 -0500 Subject: ANNOUNCE: GHC version 7.8.4 In-Reply-To: References: Message-ID: Heres a OS X build that should work with >= 10.7 http://www.wellposed.com/opensource/ghc/releasebuild-unofficial/ghc-7.8.4-x86_64-apple-darwin.tar.bz2 and the sha 512 shasum -a512 ghc-7.8.4-x86_64-apple-darwin.tar.bz2 c6e76a2cd7ec7820d071ef1f417981845bb86c4c8337a57431136a375cbd0695fe810ec10963109ab1971d1a0ab80318c62d71b95eddb5657800cac296a260bd ghc-7.8.4-x86_64-apple-darwin.tar.bz2 On Tue, Dec 23, 2014 at 8:12 AM, Austin Seipp wrote: > ============================================================== > The (Interactive) Glasgow Haskell Compiler -- version 7.8.4 > ============================================================== > > The GHC Team is pleased to announce a new patchlevel release of GHC, 7.8.4. > > This is an important bugfix release relative to 7.8.3 (with over 30 > defects fixed), so we highly recommend upgrading from the previous 7.8 > releases. > > The full release notes are here: > > > https://downloads.haskell.org/~ghc/7.8.4/docs/html/users_guide/release-7-8-4.html > > How to get it > ~~~~~~~~~~~~~ > > The easy way is to go to the web page, which should be self-explanatory: > > https://www.haskell.org/ghc/ > > We supply binary builds in the native package format for many > platforms, and the source distribution is available from the same > place. > > Packages will appear as they are built - if the package for your > system isn't available yet, please try again later. > > > Background > ~~~~~~~~~~ > > Haskell is a standard lazy functional programming language. > > GHC is a state-of-the-art programming suite for Haskell. Included is > an optimising compiler generating good code for a variety of > platforms, together with an interactive system for convenient, quick > development. The distribution includes space and time profiling > facilities, a large collection of libraries, and support for various > language extensions, including concurrency, exceptions, and foreign > language interfaces (C, whatever). GHC is distributed under a > BSD-style open source license. > > A wide variety of Haskell related resources (tutorials, libraries, > specifications, documentation, compilers, interpreters, references, > contact information, links to research groups) are available from the > Haskell home page (see below). > > > On-line GHC-related resources > ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ > > Relevant URLs on the World-Wide Web: > > GHC home page http://www.haskell.org/ghc/ > GHC developers' home page http://ghc.haskell.org/trac/ghc/ > Haskell home page http://www.haskell.org/ > > > Supported Platforms > ~~~~~~~~~~~~~~~~~~~ > > The list of platforms we support, and the people responsible for them, > is here: > > http://ghc.haskell.org/trac/ghc/wiki/Platforms > http://ghc.haskell.org/trac/ghc/wiki/CodeOwners > > Ports to other platforms are possible with varying degrees of > difficulty. The Building Guide describes how to go about porting to a > new platform: > > http://ghc.haskell.org/trac/ghc/wiki/Building > > > Developers > ~~~~~~~~~~ > > We welcome new contributors. Instructions on accessing our source > code repository, and getting started with hacking on GHC, are > available from the GHC's developer's site run by Trac: > > http://ghc.haskell.org/trac/ghc/ > > > Mailing lists > ~~~~~~~~~~~~~ > > We run mailing lists for GHC users and bug reports; to subscribe, use > the web interfaces at > > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users > http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs > > There are several other haskell and ghc-related mailing lists on > www.haskell.org; for the full list, see > > http://www.haskell.org/mailman/listinfo/ > > Some GHC developers hang out on #haskell on IRC, too: > > http://www.haskell.org/haskellwiki/IRC_channel > > Please report bugs using our bug tracking system. Instructions on > reporting bugs can be found here: > > http://www.haskell.org/ghc/reportabug > > > Hashes & Signatures > ~~~~~~~~~~~~~~~~~ > > On https://downloads.haskell.org/~ghc/7.8.4/ you will find a signed > copy of the SHA256 hashes for the tarballs, using my GPG key (keyid > 0x3B58D86F). > > -- > Regards, > > Austin Seipp, Haskell Consultant > Well-Typed LLP, http://www.well-typed.com/ > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://www.haskell.org/mailman/listinfo/ghc-devs > -------------- next part -------------- An HTML attachment was scrubbed... URL: From kazu at iij.ad.jp Wed Dec 24 02:12:00 2014 From: kazu at iij.ad.jp (Kazu Yamamoto (=?iso-2022-jp?B?GyRCOzNLXE9CSScbKEI=?=)) Date: Wed, 24 Dec 2014 11:12:00 +0900 (JST) Subject: ANNOUNCE: GHC 7.10.1 Release Candidate 1 In-Reply-To: References: Message-ID: <20141224.111200.2221307343344178430.kazu@iij.ad.jp> Hi, If I understand correctly, OverloadedRecordFields has not been merged yet. Are there any chances to merge it into GHC 7.10.1? --Kazu > We are pleased to announce the first release candidate for GHC 7.10.1: > > https://downloads.haskell.org/~ghc/7.10.1-rc1/ > > This includes the source tarball and bindists for 64bit/32bit Linux > and Windows. Binary builds for other platforms will be available > shortly. (CentOS 6.5 binaries are not available at this time like they > were for 7.8.x). These binaries and tarballs have an accompanying > SHA256SUMS file signed by my GPG key id (0x3B58D86F). > > We plan to make the 7.10.1 release sometime in February of 2015. We > expect another RC to occur during January of 2015. > > Please test as much as possible; bugs are much cheaper if we find them > before the release! > > -- > Regards, > > Austin Seipp, Haskell Consultant > Well-Typed LLP, http://www.well-typed.com/ > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://www.haskell.org/mailman/listinfo/ghc-devs From greg at gregweber.info Wed Dec 24 03:35:35 2014 From: greg at gregweber.info (Greg Weber) Date: Tue, 23 Dec 2014 19:35:35 -0800 Subject: ANNOUNCE: GHC 7.10.1 Release Candidate 1 In-Reply-To: <20141224.111200.2221307343344178430.kazu@iij.ad.jp> References: <20141224.111200.2221307343344178430.kazu@iij.ad.jp> Message-ID: No, it is a big change and the merge window is closed now. This question was just asked on reddit: http://www.reddit.com/r/haskell/comments/2pnjdk/is_overloadedrecordfields_getting_it_into_7101/ On Tue, Dec 23, 2014 at 6:12 PM, Kazu Yamamoto wrote: > Hi, > > If I understand correctly, OverloadedRecordFields has not been merged > yet. Are there any chances to merge it into GHC 7.10.1? > > --Kazu > > > We are pleased to announce the first release candidate for GHC 7.10.1: > > > > https://downloads.haskell.org/~ghc/7.10.1-rc1/ > > > > This includes the source tarball and bindists for 64bit/32bit Linux > > and Windows. Binary builds for other platforms will be available > > shortly. (CentOS 6.5 binaries are not available at this time like they > > were for 7.8.x). These binaries and tarballs have an accompanying > > SHA256SUMS file signed by my GPG key id (0x3B58D86F). > > > > We plan to make the 7.10.1 release sometime in February of 2015. We > > expect another RC to occur during January of 2015. > > > > Please test as much as possible; bugs are much cheaper if we find them > > before the release! > > > > -- > > Regards, > > > > Austin Seipp, Haskell Consultant > > Well-Typed LLP, http://www.well-typed.com/ > > _______________________________________________ > > ghc-devs mailing list > > ghc-devs at haskell.org > > http://www.haskell.org/mailman/listinfo/ghc-devs > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://www.haskell.org/mailman/listinfo/ghc-devs > -------------- next part -------------- An HTML attachment was scrubbed... URL: From kazu at iij.ad.jp Wed Dec 24 04:32:20 2014 From: kazu at iij.ad.jp (Kazu Yamamoto (=?iso-2022-jp?B?GyRCOzNLXE9CSScbKEI=?=)) Date: Wed, 24 Dec 2014 13:32:20 +0900 (JST) Subject: ANNOUNCE: GHC 7.10.1 Release Candidate 1 In-Reply-To: References: <20141224.111200.2221307343344178430.kazu@iij.ad.jp> Message-ID: <20141224.133220.1032171133533014509.kazu@iij.ad.jp> > No, it is a big change and the merge window is closed now. This question > was just asked on reddit: > http://www.reddit.com/r/haskell/comments/2pnjdk/is_overloadedrecordfields_getting_it_into_7101/ Greg, thank you for this info. But it is really disappointing. I was silent about this because it is promised that ORF is included in GHC 7.10. If I knew that active feedback was necessary, I could be vocal. --Kazu From f at mazzo.li Wed Dec 24 09:50:56 2014 From: f at mazzo.li (Francesco Mazzoli) Date: Wed, 24 Dec 2014 10:50:56 +0100 Subject: CPP Help (was Re: Latest Template Haskell Breaks Package) In-Reply-To: References: <1632C06F-E358-4F91-B8E7-0DA1F9706099@steinitz.org> <60A94643-234C-4EB7-A381-2E3263DB4E52@steinitz.org> <7071FF06-77F5-40CE-A55C-B2A6C751F192@steinitz.org> <53C9BA7D-38C7-4079-8E15-D32F5B751341@steinitz.org> Message-ID: 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 at gmail.com ballbery at sinenomine.net > unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://www.haskell.org/mailman/listinfo/libraries > From f at mazzo.li Wed Dec 24 09:52:48 2014 From: f at mazzo.li (Francesco Mazzoli) Date: Wed, 24 Dec 2014 10:52:48 +0100 Subject: CPP Help (was Re: Latest Template Haskell Breaks Package) In-Reply-To: References: <1632C06F-E358-4F91-B8E7-0DA1F9706099@steinitz.org> <60A94643-234C-4EB7-A381-2E3263DB4E52@steinitz.org> <7071FF06-77F5-40CE-A55C-B2A6C751F192@steinitz.org> <53C9BA7D-38C7-4079-8E15-D32F5B751341@steinitz.org> Message-ID: 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 wrote: > 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 at gmail.com ballbery at sinenomine.net >> unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net >> >> _______________________________________________ >> Libraries mailing list >> Libraries at haskell.org >> http://www.haskell.org/mailman/listinfo/libraries >> From carter.schonwald at gmail.com Wed Dec 24 15:57:06 2014 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Wed, 24 Dec 2014 10:57:06 -0500 Subject: ANNOUNCE: GHC version 7.8.4 In-Reply-To: References: Message-ID: sure, please verify first. (also make sure haddock etc works for you, i had to remove a haddock binary from ~/.cabal/bin before haddocks were building correctly for me) On Wed, Dec 24, 2014 at 10:52 AM, Alfredo Di Napoli < alfredo.dinapoli at gmail.com> wrote: > Thanks Carter! > > I have just asked basically about it on Reddit, in the announce thread. > I'll give it a spin, and if it works I will share the link (if you are ok > with that!) on the > same Reddit post. > > Alfredo > > > On Tuesday, 23 December 2014, Carter Schonwald > wrote: > > Heres a OS X build that should work with >= 10.7 > > > http://www.wellposed.com/opensource/ghc/releasebuild-unofficial/ghc-7.8.4-x86_64-apple-darwin.tar.bz2 > > > > and the sha 512 > > shasum -a512 ghc-7.8.4-x86_64-apple-darwin.tar.bz2 > > > c6e76a2cd7ec7820d071ef1f417981845bb86c4c8337a57431136a375cbd0695fe810ec10963109ab1971d1a0ab80318c62d71b95eddb5657800cac296a260bd > ghc-7.8.4-x86_64-apple-darwin.tar.bz2 > > On Tue, Dec 23, 2014 at 8:12 AM, Austin Seipp > wrote: > > > > ============================================================== > > The (Interactive) Glasgow Haskell Compiler -- version 7.8.4 > > ============================================================== > > > > The GHC Team is pleased to announce a new patchlevel release of GHC, > 7.8.4. > > > > This is an important bugfix release relative to 7.8.3 (with over 30 > > defects fixed), so we highly recommend upgrading from the previous 7.8 > > releases. > > > > The full release notes are here: > > > > > https://downloads.haskell.org/~ghc/7.8.4/docs/html/users_guide/release-7-8-4.html > > > > How to get it > > ~~~~~~~~~~~~~ > > > > The easy way is to go to the web page, which should be self-explanatory: > > > > https://www.haskell.org/ghc/ > > > > We supply binary builds in the native package format for many > > platforms, and the source distribution is available from the same > > place. > > > > Packages will appear as they are built - if the package for your > > system isn't available yet, please try again later. > > > > > > Background > > ~~~~~~~~~~ > > > > Haskell is a standard lazy functional programming language. > > > > GHC is a state-of-the-art programming suite for Haskell. Included is > > an optimising compiler generating good code for a variety of > > platforms, together with an interactive system for convenient, quick > > development. The distribution includes space and time profiling > > facilities, a large collection of libraries, and support for various > > language extensions, including concurrency, exceptions, and foreign > > language interfaces (C, whatever). GHC is distributed under a > > BSD-style open source license. > > > > A wide variety of Haskell related resources (tutorials, libraries, > > specifications, documentation, compilers, interpreters, references, > > contact information, links to research groups) are available from the > > Haskell home page (see below). > > > > > > On-line GHC-related resources > > ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ > > > > Relevant URLs on the World-Wide Web: > > > > GHC home page http://www.haskell.org/ghc/ > > GHC developers' home page http://ghc.haskell.org/trac/ghc/ > > Haskell home page http://www.haskell.org/ > > > > > > Supported Platforms > > ~~~~~~~~~~~~~~~~~~~ > > > > The list of platforms we support, and the people responsible for them, > > is here: > > > > http://ghc.haskell.org/trac/ghc/wiki/Platforms > > http://ghc.haskell.org/trac/ghc/wiki/CodeOwners > > > > Ports to other platforms are possible with varying degrees of > > difficulty. The Building Guide describes how to go about porting to a > > new platform: > > > > http://ghc.haskell.org/trac/ghc/wiki/Building > > > > > > Developers > > ~~~~~~~~~~ > > > > We welcome new contributors. Instructions on accessing our source > > code repository, and getting started with hacking on GHC, are > > available from the GHC's developer's site run by Trac: > > > > http://ghc.haskell.org/trac/ghc/ > > > > > > Mailing lists > > ~~~~~~~~~~~~~ > > > > We run mailing lists for GHC users and bug reports; to subscribe, use > > the web interfaces at > > > > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users > > http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs > > > > There are several other haskell and ghc-related mailing lists on > > www.haskell.org; for the full list, see > > > > http://www.haskell.org/mailman/listinfo/ > > > > Some GHC developers hang out on #haskell on IRC, too: > > > > http://www.haskell.org/haskellwiki/IRC_channel > > > > Please report bu > -------------- next part -------------- An HTML attachment was scrubbed... URL: From dominic at steinitz.org Thu Dec 25 07:20:47 2014 From: dominic at steinitz.org (Dominic Steinitz) Date: Thu, 25 Dec 2014 07:20:47 +0000 Subject: CPP Help (was Re: Latest Template Haskell Breaks Package) In-Reply-To: References: <1632C06F-E358-4F91-B8E7-0DA1F9706099@steinitz.org> <60A94643-234C-4EB7-A381-2E3263DB4E52@steinitz.org> <7071FF06-77F5-40CE-A55C-B2A6C751F192@steinitz.org> <53C9BA7D-38C7-4079-8E15-D32F5B751341@steinitz.org> Message-ID: <12997EFF-79A3-4E53-89E1-A04CE805BB0D@steinitz.org> 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 at steinitz.org http://idontgetoutmuch.wordpress.com From ezyang at mit.edu Sat Dec 27 15:16:45 2014 From: ezyang at mit.edu (Edward Z. Yang) Date: Sat, 27 Dec 2014 10:16:45 -0500 Subject: ANNOUNCE: GHC 7.10.1 Release Candidate 1 In-Reply-To: <549abfa5.4458b40a.5c8e.ffff896b@mx.google.com> References: <549abfa5.4458b40a.5c8e.ffff896b@mx.google.com> Message-ID: <1419693186-sup-7586@sabre> Hello lonetiger, I don't think any relevant logic changed in 7.10; however, this commit may be relevant: commit 8fb03bfd768ea0d5c666bbe07a50cb05214bbe92 Author: Ian Lynagh Sun Mar 18 11:42:31 2012 Committer: Ian Lynagh Sun Mar 18 11:42:31 2012 Original File: compiler/typecheck/TcForeign.lhs If we say we're treating StdCall as CCall, then actually do so But this warning should have applied even on older versions of GHC. Are you running x86_64 Windows? stdcall is specific to x86_32. Edward Excerpts from lonetiger's message of 2014-12-24 08:24:52 -0500: > Hi, > > > I?ve had some issues building this (and the git HEAD), it seems that the config.guess and config.sub in the libffi tarball is old, it doesn?t detect the platform when building with msys2. I had to unpack the tarfile and update the files, after this it correctly built. > > > Then I proceeded to try to make a shared library and got the following warning: > > > ManualCheck.hs:18:1: Warning: > the 'stdcall' calling convention is unsupported on this platform, > treating as ccall > When checking declaration: > foreign export stdcall "testFoo" testFooA :: CInt -> IO (FooPtr) > > > > Does this mean that GHC no longer supports stdcall on windows? or could this be related to issue I had building? > > > Regards, > > Tamar > > > > > > From: Austin Seipp > Sent: ?Tuesday?, ?December? ?23?, ?2014 ?15?:?36 > To: ghc-devs at haskell.org, glasgow-haskell-users at haskell.org > > > > > > We are pleased to announce the first release candidate for GHC 7.10.1: > > https://downloads.haskell.org/~ghc/7.10.1-rc1/ > > This includes the source tarball and bindists for 64bit/32bit Linux > and Windows. Binary builds for other platforms will be available > shortly. (CentOS 6.5 binaries are not available at this time like they > were for 7.8.x). These binaries and tarballs have an accompanying > SHA256SUMS file signed by my GPG key id (0x3B58D86F). > > We plan to make the 7.10.1 release sometime in February of 2015. We > expect another RC to occur during January of 2015. > > Please test as much as possible; bugs are much cheaper if we find them > before the release! > From maoe at foldr.in Sun Dec 28 10:47:07 2014 From: maoe at foldr.in (Mitsutoshi Aoe) Date: Sun, 28 Dec 2014 19:47:07 +0900 Subject: Changes to the type checker with respect to UndecidableInstances Message-ID: <68089B9E-CEBD-4555-A178-99E858231606@foldr.in> Hi, I found a difference between GHC 7.6.3 and 7.8.3 with respect to UndecidableInstances. https://gist.github.com/maoe/57a4346eb36aee159916 7.6.3 requires UndecidableInstances to compile this snippet whereas 7.8.3 doesn't. What has changed in the type checker? Mitsutoshi -------------- next part -------------- An HTML attachment was scrubbed... URL: From gale at sefer.org Sun Dec 28 18:38:47 2014 From: gale at sefer.org (Yitzchak Gale) Date: Sun, 28 Dec 2014 20:38:47 +0200 Subject: GHC 7.4.2 on Ubuntu Trusty In-Reply-To: <1414533995-sup-9843@sabre> References: <20141022105441.GA14512@machine> <87a94n808i.fsf@gmail.com> <1414533995-sup-9843@sabre> Message-ID: Resurrecting this thread: My impression was that Edward's suggestion was a simple and obvious solution to the problem of previous GHC versions quickly becoming orphaned and unbuildable. But Austin thought that this thread was stuck. Would Edward's suggestion be difficult to implement for any reason? Specifically, right now would be the time to do it, and it would mean: 1. Create a 7.8.5 branch. 2. Tweak the stage 1 Haskell sources to build with 7.10 and tag 3. Create only a source tarball and upload it to the download site Thanks, Yitz On Wed, Oct 29, 2014 at 12:10 AM, Edward Z. Yang wrote: > Excerpts from Yitzchak Gale's message of 2014-10-28 13:58:08 -0700: >> How about this: Currently, every GHC source distribution >> requires no later than its own version of GHC for bootstrapping. >> Going backwards, that chops up the sequence of GHC versions >> into tiny incompatible pieces - there is no way to start with a >> working GHC and work backwards to an older version by compiling >> successively older GHC sources. >> >> If instead each GHC could be compiled using at least one >> subsequent version, the chain would not be broken. I.e., >> always provide a compatibility flag or some other reasonably >> simple mechanism that would enable the current GHC to >> compile the source code of at least the last previous released >> version. > > Here is an alternate proposal: when we make a new major version release, > we should also make a minor version release of the previous series, which > is prepped so that it can compile from the new major version. If it > is the case that one version of the compiler can compile any other > version in the same series, this would be sufficient to go backwards. > > Concretely, the action plan is very simple too: take 7.6 and apply as > many patches as is necessary to make it compile from 7.8, and cut > a release with those patches. > > Edward From chengang31 at gmail.com Sun Dec 28 03:41:45 2014 From: chengang31 at gmail.com (cg) Date: Sun, 28 Dec 2014 11:41:45 +0800 Subject: ANNOUNCE: GHC 7.10.1 Release Candidate 1 In-Reply-To: <549abfa5.4458b40a.5c8e.ffff896b@mx.google.com> References: <549abfa5.4458b40a.5c8e.ffff896b@mx.google.com> Message-ID: > *From:* Austin Seipp > *Sent:* ?Tuesday?, ?December? ?23?, ?2014 ?15?:?36 > *To:* ghc-devs at haskell.org , > glasgow-haskell-users at haskell.org > > We are pleased to announce the first release candidate for GHC 7.10.1: > > https://downloads.haskell.org/~ghc/7.10.1-rc1/ > Besides downloading a tarball, can I checkout it using git? I tried using sync-all as described on wiki [1] to checkout it: ./sync-all checkout ghc-7.10 but it seems it doesn't work, there are error message like: error: pathspec 'ghc-7.10' did not match any file(s) known to git. [1] https://ghc.haskell.org/trac/ghc/wiki/WorkingConventions/Releases From simonpj at microsoft.com Mon Dec 29 10:29:23 2014 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Mon, 29 Dec 2014 10:29:23 +0000 Subject: ANNOUNCE: GHC 7.10.1 Release Candidate 1 In-Reply-To: <20141224.111200.2221307343344178430.kazu@iij.ad.jp> References: <20141224.111200.2221307343344178430.kazu@iij.ad.jp> Message-ID: <618BE556AADD624C9C918AA5D5911BEF5628E269@DB3PRD3001MB020.064d.mgd.msft.net> | If I understand correctly, OverloadedRecordFields has not been merged | yet. Are there any chances to merge it into GHC 7.10.1? I'm afraid not. The situation is that Adam has a fairly complete patch for overloaded record fields, but neither he nor I are happy with it. It makes some fairly complicated and pervasive changes, and feels like a sledgehammer to crack a nut. We'd scheduled for Adam to spend a day at MSR for us to work on it together, but Adam had to cancel. We'll hopefully re-arrange. Meanwhile it'd be motivating to know who, if anyone, is actively keen on it. Kazu is presumably one. I expect there are others, but I couldn't list them. Simon | | --Kazu | | > We are pleased to announce the first release candidate for GHC 7.10.1: | > | > https://downloads.haskell.org/~ghc/7.10.1-rc1/ | > | > This includes the source tarball and bindists for 64bit/32bit Linux | > and Windows. Binary builds for other platforms will be available | > shortly. (CentOS 6.5 binaries are not available at this time like they | > were for 7.8.x). These binaries and tarballs have an accompanying | > SHA256SUMS file signed by my GPG key id (0x3B58D86F). | > | > We plan to make the 7.10.1 release sometime in February of 2015. We | > expect another RC to occur during January of 2015. | > | > Please test as much as possible; bugs are much cheaper if we find them | > before the release! | > | > -- | > Regards, | > | > Austin Seipp, Haskell Consultant | > Well-Typed LLP, http://www.well-typed.com/ | > _______________________________________________ | > ghc-devs mailing list | > ghc-devs at haskell.org | > http://www.haskell.org/mailman/listinfo/ghc-devs | _______________________________________________ | ghc-devs mailing list | ghc-devs at haskell.org | http://www.haskell.org/mailman/listinfo/ghc-devs From Christian.Maeder at dfki.de Mon Dec 29 13:53:39 2014 From: Christian.Maeder at dfki.de (Christian Maeder) Date: Mon, 29 Dec 2014 14:53:39 +0100 Subject: [Haskell-beginners] ghc prelude home In-Reply-To: References: <201412281449.sBSEnpbk007869@coolidge.cs.dartmouth.edu> <8761cvg17y.fsf@gmail.com> <1419792360.304034.207381885.45DCCAB6@webmail.messagingengine.com> Message-ID: <54A15CE3.2070501@dfki.de> 23 December 2014 GHC 7.8.4 Released! https://www.haskell.org/ghc/ So 7.8.4 is out! Only the download subpage https://www.haskell.org/ghc/download is not updated yet. Also http://downloads.haskell.org/~ghc/latest/ still refers to http://downloads.haskell.org/~ghc/7.8.3/ (and has a funny 7.8.4 subdirectory). I send this also to glasgow-haskell-users to reach someone who can fix this. Cheers Christian Am 28.12.2014 um 22:28 schrieb Yitzchak Gale: > Yes, sorry, neither 7.8.4 nor 7.10.1 is actually out yet. > They are both release candidates, and will be out soon. > > Thanks, > Yitz > > On Sun, Dec 28, 2014 at 9:50 PM, Antoine Latter wrote: >> I don't think GHC 7.10 is out yet: https://www.haskell.org/ghc/download >> >> Although that page doesn't have 7.8.4 on it. > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://www.haskell.org/mailman/listinfo/beginners > From dominic at steinitz.org Mon Dec 29 15:40:38 2014 From: dominic at steinitz.org (Dominic Steinitz) Date: Mon, 29 Dec 2014 15:40:38 +0000 Subject: ANNOUNCE: GHC 7.10.1 Release Candidate 1 In-Reply-To: References: Message-ID: I counted about 10 people (including me) who appear to be actively keen on it on reddit: http://www.reddit.com/r/haskell/comments/2pnjdk/is_overloadedrecordfields_getting_it_into_7101/. I would guess there are others. Dominic Steinitz dominic at steinitz.org http://idontgetoutmuch.wordpress.com On 29 Dec 2014, at 12:00, glasgow-haskell-users-request at haskell.org wrote: > > Message: 3 > Date: Mon, 29 Dec 2014 10:29:23 +0000 > From: Simon Peyton Jones > To: Kazu Yamamoto , "ghc-devs at haskell.org" > , "glasgow-haskell-users at haskell.org" > > Subject: RE: ANNOUNCE: GHC 7.10.1 Release Candidate 1 > Message-ID: > <618BE556AADD624C9C918AA5D5911BEF5628E269 at DB3PRD3001MB020.064d.mgd.msft.net> > > Content-Type: text/plain; charset="us-ascii" > > | If I understand correctly, OverloadedRecordFields has not been merged > | yet. Are there any chances to merge it into GHC 7.10.1? > > I'm afraid not. The situation is that Adam has a fairly complete patch for overloaded record fields, but neither he nor I are happy with it. It makes some fairly complicated and pervasive changes, and feels like a sledgehammer to crack a nut. We'd scheduled for Adam to spend a day at MSR for us to work on it together, but Adam had to cancel. We'll hopefully re-arrange. > > Meanwhile it'd be motivating to know who, if anyone, is actively keen on it. Kazu is presumably one. I expect there are others, but I couldn't list them. > From simonpj at microsoft.com Tue Dec 30 10:56:18 2014 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Tue, 30 Dec 2014 10:56:18 +0000 Subject: Changes to the type checker with respect to UndecidableInstances In-Reply-To: <68089B9E-CEBD-4555-A178-99E858231606@foldr.in> References: <68089B9E-CEBD-4555-A178-99E858231606@foldr.in> Message-ID: <618BE556AADD624C9C918AA5D5911BEF5628EDF8@DB3PRD3001MB020.064d.mgd.msft.net> UndecidableInstances is supposed to be needed if GHC can't prove that the instance declarations terminate. But here it can be sure they terminate. GHC 7.6.3 didn't realise this. I'll modify the user manual to be clearer on this point. Simon From: Glasgow-haskell-users [mailto:glasgow-haskell-users-bounces at haskell.org] On Behalf Of Mitsutoshi Aoe Sent: 28 December 2014 10:47 To: glasgow-haskell-users at haskell.org Subject: Changes to the type checker with respect to UndecidableInstances Hi, I found a difference between GHC 7.6.3 and 7.8.3 with respect to UndecidableInstances. https://gist.github.com/maoe/57a4346eb36aee159916 7.6.3 requires UndecidableInstances to compile this snippet whereas 7.8.3 doesn't. What has changed in the type checker? Mitsutoshi -------------- next part -------------- An HTML attachment was scrubbed... URL: