From choener at tbi.univie.ac.at Sun Feb 1 12:18:02 2015 From: choener at tbi.univie.ac.at (Christian =?iso-8859-1?Q?H=F6ner?= zu Siederdissen) Date: Sun, 1 Feb 2015 13:18:02 +0100 Subject: stream fusion, concatMap, exisential seed unboxing Message-ID: <20150201121802.GA2507@workstation.Speedport_W_724V_Typ_A_05011602_00_001> Hi everybody, I'm playing around with concatMap in stream fusion (the vector package to be exact). concatMapM :: Monad m => (a->m (Stream m b)) -> Stream m a -> Stream m b concatMapM f (Stream ...) = ... I can get my concatMap to behave nicely and erase all Stream and Step constructors but due to the existential nature of the Stream seeds, they are re-boxed for the inner stream (which is kind-of annoying given that the seed is immediately unboxed again ;-). seq doesn't help here. Otherwise, fusion happens for streams and vectors, so that is ok. But boxing kills performance, criterion says. Do we have s.th. in place that could help here? Currently I could use the vector-concatMap which creates intermediate arrays, my version which has boxed seeds, or hermit but that is too inconvenient for non-ghc savy users. Viele Gruesse, Christian Fusing concatMapM: concatMapM f (SM.Stream ostep t _) = SM.Stream step (Left t) Unknown where step (Left t) = do r <- ostep t case r of SM.Done -> return $ SM.Done SM.Skip t' -> return $ SM.Skip (Left t') SM.Yield a t' -> do s <- f a return $ SM.Skip (Right (s,t')) step (Right (SM.Stream istep s _,t)) = do r <- istep s case r of SM.Done -> return $ SM.Skip (Left t) SM.Skip s' -> return $ SM.Skip (Right (SM.Stream istep s' Unknown,t)) SM.Yield x s' -> return $ SM.Yield x (Right (SM.Stream istep s' Unknown,t)) {-# INLINE [0] step #-} {-# INLINE [1] concatMapM #-} testConcatMapM :: Int -> Int testConcatMapM k = seq k $ U.unId . SM.foldl' (+) 0 . concatMap (\i -> SM.enumFromTo 5 k) $ SM.enumFromTo 3 k {-# NOINLINE testConcatMapM #-} CORE: testConcatMapM testConcatMapM = \ k_aCA -> let! { I# ipv_s1xv ~ _ <- k_aCA } in ### inner loop letrec { $s$wfoldlM'_loop_s29q $s$wfoldlM'_loop_s29q = \ sc_s29i sc1_s29j sc2_s29k -> ### unboxing let! { I# x_a1LA ~ _ <- sc1_s29j } in case tagToEnum# (<=# x_a1LA ipv_s1xv) of _ { False -> $s$wfoldlM'_loop1_s29c sc_s29i sc2_s29k; True -> $s$wfoldlM'_loop_s29q ### reboxing (+# sc_s29i x_a1LA) (I# (+# x_a1LA 1)) sc2_s29k }; ### outer loop $s$wfoldlM'_loop1_s29c $s$wfoldlM'_loop1_s29c = \ sc_s29a sc1_s29b -> case tagToEnum# (<=# sc1_s29b ipv_s1xv) of _ { False -> sc_s29a; True -> case tagToEnum# (<=# 5 ipv_s1xv) of _ { False -> $s$wfoldlM'_loop1_s29c sc_s29a (+# sc1_s29b 1); ### boxed seed (I# 6) True -> $s$wfoldlM'_loop_s29q (+# sc_s29a 5) (I# 6) (+# sc1_s29b 1) } }; } in let! { __DEFAULT ~ ww_s20G <- $s$wfoldlM'_loop1_s29c 0 3 } in I# ww_s20G From hvr at gnu.org Mon Feb 2 08:37:58 2015 From: hvr at gnu.org (Herbert Valerio Riedel) Date: Mon, 02 Feb 2015 09:37:58 +0100 Subject: ANNOUNCE: GHC 7.10.1 Release Candidate 2 In-Reply-To: (Mark Lentczner's message of "Tue, 27 Jan 2015 19:31:29 -0800") References: Message-ID: <87h9v4vhcp.fsf@gnu.org> Hi Mark, On 2015-01-28 at 04:31:29 +0100, Mark Lentczner wrote: > I've just built a bindist under 10.10, but just normal not expressly llvm. > I'll test this in a bit then post it -- but might be sometime tomorrow > before it is up. How's progress on this btw? Are you also working on a GHC 7.8.4 OSX bindist by any chance? Cheers, hvr From magicloud.magiclouds at gmail.com Mon Feb 2 09:27:27 2015 From: magicloud.magiclouds at gmail.com (Magicloud Magiclouds) Date: Mon, 2 Feb 2015 17:27:27 +0800 Subject: What could be the possible reason of linking errors on "_info" and "_closure"? Message-ID: Hi, I am making a cabal project including a library and a executable using the library. Building the library is fine. But when linking src/main, I got "undefined reference to someFunction1_info" and "someFunction1_closure". -- ??????? ??????? And for G+, please use magiclouds#gmail.com. -------------- next part -------------- An HTML attachment was scrubbed... URL: From magicloud.magiclouds at gmail.com Mon Feb 2 09:28:39 2015 From: magicloud.magiclouds at gmail.com (Magicloud Magiclouds) Date: Mon, 2 Feb 2015 17:28:39 +0800 Subject: What could be the possible reason of linking errors on "_info" and "_closure"? In-Reply-To: References: Message-ID: Sorry, my mistake. I had a misunderstanding of cabal file that I did not expose enough modules. On Mon, Feb 2, 2015 at 5:27 PM, Magicloud Magiclouds < magicloud.magiclouds at gmail.com> wrote: > Hi, > > I am making a cabal project including a library and a executable using > the library. > > Building the library is fine. But when linking src/main, I got > "undefined reference to someFunction1_info" and "someFunction1_closure". > > -- > ??????? > ??????? > > And for G+, please use magiclouds#gmail.com. > -- ??????? ??????? And for G+, please use magiclouds#gmail.com. -------------- next part -------------- An HTML attachment was scrubbed... URL: From hesselink at gmail.com Mon Feb 2 10:58:57 2015 From: hesselink at gmail.com (Erik Hesselink) Date: Mon, 2 Feb 2015 11:58:57 +0100 Subject: ANNOUNCE: GHC 7.10.1 Release Candidate 2 In-Reply-To: <87h9v4vhcp.fsf@gnu.org> References: <87h9v4vhcp.fsf@gnu.org> Message-ID: On Mon, Feb 2, 2015 at 9:37 AM, Herbert Valerio Riedel wrote: > Hi Mark, > > On 2015-01-28 at 04:31:29 +0100, Mark Lentczner wrote: >> I've just built a bindist under 10.10, but just normal not expressly llvm. >> I'll test this in a bit then post it -- but might be sometime tomorrow >> before it is up. > > How's progress on this btw? Are you also working on a GHC 7.8.4 OSX > bindist by any chance? I made a bindist of RC2 (just like I did for RC1) which is here [1]. This was built on 10.9, without anything special for llvm. If anyone wants me to try something or produce a different build, please let me know. Erik [1] https://docs.google.com/a/silk.co/uc?id=0B5E6EvOcuE0nVmJ3WElQZW81b1U&export=download From simonpj at microsoft.com Mon Feb 2 14:48:54 2015 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Mon, 2 Feb 2015 14:48:54 +0000 Subject: stream fusion, concatMap, exisential seed unboxing In-Reply-To: <20150201121802.GA2507@workstation.Speedport_W_724V_Typ_A_05011602_00_001> References: <20150201121802.GA2507@workstation.Speedport_W_724V_Typ_A_05011602_00_001> Message-ID: <618BE556AADD624C9C918AA5D5911BEF562BCD51@DB3PRD3001MB020.064d.mgd.msft.net> I think it'd help you to open a Trac ticket, give a fully-reproducible test case, including instructions for how to reproduce, and say what isn't happening that should happen. What's odd is that loop_s29q looks strict in its Int arg, yet isn't unboxed. There is a way to get the strictness analysis to run twice -flate-dmd-anal. You could try that. Simon | -----Original Message----- | From: Glasgow-haskell-users [mailto:glasgow-haskell-users- | bounces at haskell.org] On Behalf Of Christian H?ner zu Siederdissen | Sent: 01 February 2015 12:18 | To: Glasgow-Haskell-Users | Subject: stream fusion, concatMap, exisential seed unboxing | | Hi everybody, | | I'm playing around with concatMap in stream fusion (the vector package | to be exact). | | concatMapM :: Monad m => (a->m (Stream m b)) -> Stream m a -> Stream m | b concatMapM f (Stream ...) = ... | | I can get my concatMap to behave nicely and erase all Stream and Step | constructors but due to the existential nature of the Stream seeds, | they are re-boxed for the inner stream (which is kind-of annoying | given that the seed is immediately unboxed again ;-). seq doesn't help | here. | | Otherwise, fusion happens for streams and vectors, so that is ok. But | boxing kills performance, criterion says. | | Do we have s.th. in place that could help here? Currently I could use | the vector-concatMap which creates intermediate arrays, my version | which has boxed seeds, or hermit but that is too inconvenient for non- | ghc savy users. | | Viele Gruesse, | Christian | | | | Fusing concatMapM: | | concatMapM f (SM.Stream ostep t _) = SM.Stream step (Left t) Unknown | where step (Left t) = do r <- ostep t | case r of | SM.Done -> return $ SM.Done | SM.Skip t' -> return $ SM.Skip (Left | t') | SM.Yield a t' -> do s <- f a | return $ SM.Skip | (Right (s,t')) | step (Right (SM.Stream istep s _,t)) = do r <- istep s | case r of | SM.Done -> | return $ SM.Skip (Left t) | SM.Skip s' -> | return $ SM.Skip (Right (SM.Stream istep s' Unknown,t)) | SM.Yield x s' -> | return $ SM.Yield x (Right (SM.Stream istep s' Unknown,t)) | {-# INLINE [0] step #-} | {-# INLINE [1] concatMapM #-} | | testConcatMapM :: Int -> Int | testConcatMapM k = seq k $ U.unId | . SM.foldl' (+) 0 | . concatMap (\i -> SM.enumFromTo 5 k) | $ SM.enumFromTo 3 k | {-# NOINLINE testConcatMapM #-} | | CORE: | | testConcatMapM | testConcatMapM = | \ k_aCA -> | let! { I# ipv_s1xv ~ _ <- k_aCA } in ### inner loop | letrec { | $s$wfoldlM'_loop_s29q | $s$wfoldlM'_loop_s29q = | \ sc_s29i sc1_s29j sc2_s29k -> | ### unboxing | let! { I# x_a1LA ~ _ <- sc1_s29j } in | case tagToEnum# (<=# x_a1LA ipv_s1xv) of _ { | False -> $s$wfoldlM'_loop1_s29c sc_s29i sc2_s29k; | True -> | $s$wfoldlM'_loop_s29q | ### reboxing | (+# sc_s29i x_a1LA) (I# (+# x_a1LA 1)) sc2_s29k | }; | ### outer loop | $s$wfoldlM'_loop1_s29c | $s$wfoldlM'_loop1_s29c = | \ sc_s29a sc1_s29b -> | case tagToEnum# (<=# sc1_s29b ipv_s1xv) of _ { | False -> sc_s29a; | True -> | case tagToEnum# (<=# 5 ipv_s1xv) of _ { | False -> $s$wfoldlM'_loop1_s29c sc_s29a (+# sc1_s29b | 1); ### boxed seed (I# 6) | True -> $s$wfoldlM'_loop_s29q (+# sc_s29a 5) (I# 6) | (+# sc1_s29b 1) | } | }; } in | let! { __DEFAULT ~ ww_s20G <- $s$wfoldlM'_loop1_s29c 0 3 } in | I# ww_s20G | | _______________________________________________ | Glasgow-haskell-users mailing list | Glasgow-haskell-users at haskell.org | http://www.haskell.org/mailman/listinfo/glasgow-haskell-users From choener at tbi.univie.ac.at Mon Feb 2 16:02:09 2015 From: choener at tbi.univie.ac.at (Christian =?iso-8859-1?Q?H=F6ner?= zu Siederdissen) Date: Mon, 2 Feb 2015 17:02:09 +0100 Subject: stream fusion, concatMap, exisential seed unboxing In-Reply-To: <618BE556AADD624C9C918AA5D5911BEF562BCD51@DB3PRD3001MB020.064d.mgd.msft.net> References: <20150201121802.GA2507@workstation.Speedport_W_724V_Typ_A_05011602_00_001> <618BE556AADD624C9C918AA5D5911BEF562BCD51@DB3PRD3001MB020.064d.mgd.msft.net> Message-ID: <20150202160209.GA4437@guldendraak.bioinf.uni-leipzig.de> Sure, no problem! Btw. this is not a 'bug' in the usual sense. It is the (neverending) concatMap + stream fusion story. https://ghc.haskell.org/trac/ghc/ticket/915 I'm playing a bit with trying to get GHC to look through the existential seed elements and have it constructor-specialize them. Unfortunately, unbox/spec fails with more complex seeds for now. For the more simple cases like the one below, the extra strictness pass works (cool, thanks!). These are sometimes enough if you have just concatMap (\i -> [i .. j]) stuff. However, if the internal stream state is, say, a pair (i,j), then one of those is not completely unboxed. I guess that *if* we could get the passes to continue unbox'ing and ctor-spec'ing, we could end up with a fully fused concatMap. I'll put a complete git repository with criterion + quickcheck modules up (soonishly ;-). Viele Gruesse, Christian * Simon Peyton Jones [02.02.2015 15:49]: > I think it'd help you to open a Trac ticket, give a fully-reproducible test case, including instructions for how to reproduce, and say what isn't happening that should happen. > > What's odd is that loop_s29q looks strict in its Int arg, yet isn't unboxed. There is a way to get the strictness analysis to run twice -flate-dmd-anal. You could try that. > > Simon > > | -----Original Message----- > | From: Glasgow-haskell-users [mailto:glasgow-haskell-users- > | bounces at haskell.org] On Behalf Of Christian H?ner zu Siederdissen > | Sent: 01 February 2015 12:18 > | To: Glasgow-Haskell-Users > | Subject: stream fusion, concatMap, exisential seed unboxing > | > | Hi everybody, > | > | I'm playing around with concatMap in stream fusion (the vector package > | to be exact). > | > | concatMapM :: Monad m => (a->m (Stream m b)) -> Stream m a -> Stream m > | b concatMapM f (Stream ...) = ... > | > | I can get my concatMap to behave nicely and erase all Stream and Step > | constructors but due to the existential nature of the Stream seeds, > | they are re-boxed for the inner stream (which is kind-of annoying > | given that the seed is immediately unboxed again ;-). seq doesn't help > | here. > | > | Otherwise, fusion happens for streams and vectors, so that is ok. But > | boxing kills performance, criterion says. > | > | Do we have s.th. in place that could help here? Currently I could use > | the vector-concatMap which creates intermediate arrays, my version > | which has boxed seeds, or hermit but that is too inconvenient for non- > | ghc savy users. > | > | Viele Gruesse, > | Christian > | > | > | > | Fusing concatMapM: > | > | concatMapM f (SM.Stream ostep t _) = SM.Stream step (Left t) Unknown > | where step (Left t) = do r <- ostep t > | case r of > | SM.Done -> return $ SM.Done > | SM.Skip t' -> return $ SM.Skip (Left > | t') > | SM.Yield a t' -> do s <- f a > | return $ SM.Skip > | (Right (s,t')) > | step (Right (SM.Stream istep s _,t)) = do r <- istep s > | case r of > | SM.Done -> > | return $ SM.Skip (Left t) > | SM.Skip s' -> > | return $ SM.Skip (Right (SM.Stream istep s' Unknown,t)) > | SM.Yield x s' -> > | return $ SM.Yield x (Right (SM.Stream istep s' Unknown,t)) > | {-# INLINE [0] step #-} > | {-# INLINE [1] concatMapM #-} > | > | testConcatMapM :: Int -> Int > | testConcatMapM k = seq k $ U.unId > | . SM.foldl' (+) 0 > | . concatMap (\i -> SM.enumFromTo 5 k) > | $ SM.enumFromTo 3 k > | {-# NOINLINE testConcatMapM #-} > | > | CORE: > | > | testConcatMapM > | testConcatMapM = > | \ k_aCA -> > | let! { I# ipv_s1xv ~ _ <- k_aCA } in ### inner loop > | letrec { > | $s$wfoldlM'_loop_s29q > | $s$wfoldlM'_loop_s29q = > | \ sc_s29i sc1_s29j sc2_s29k -> > | ### unboxing > | let! { I# x_a1LA ~ _ <- sc1_s29j } in > | case tagToEnum# (<=# x_a1LA ipv_s1xv) of _ { > | False -> $s$wfoldlM'_loop1_s29c sc_s29i sc2_s29k; > | True -> > | $s$wfoldlM'_loop_s29q > | ### reboxing > | (+# sc_s29i x_a1LA) (I# (+# x_a1LA 1)) sc2_s29k > | }; > | ### outer loop > | $s$wfoldlM'_loop1_s29c > | $s$wfoldlM'_loop1_s29c = > | \ sc_s29a sc1_s29b -> > | case tagToEnum# (<=# sc1_s29b ipv_s1xv) of _ { > | False -> sc_s29a; > | True -> > | case tagToEnum# (<=# 5 ipv_s1xv) of _ { > | False -> $s$wfoldlM'_loop1_s29c sc_s29a (+# sc1_s29b > | 1); ### boxed seed (I# 6) > | True -> $s$wfoldlM'_loop_s29q (+# sc_s29a 5) (I# 6) > | (+# sc1_s29b 1) > | } > | }; } in > | let! { __DEFAULT ~ ww_s20G <- $s$wfoldlM'_loop1_s29c 0 3 } in > | I# ww_s20G > | > | _______________________________________________ > | Glasgow-haskell-users mailing list > | Glasgow-haskell-users at haskell.org > | http://www.haskell.org/mailman/listinfo/glasgow-haskell-users From simonpj at microsoft.com Mon Feb 2 17:08:45 2015 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Mon, 2 Feb 2015 17:08:45 +0000 Subject: stream fusion, concatMap, exisential seed unboxing In-Reply-To: <20150202160209.GA4437@guldendraak.bioinf.uni-leipzig.de> References: <20150201121802.GA2507@workstation.Speedport_W_724V_Typ_A_05011602_00_001> <618BE556AADD624C9C918AA5D5911BEF562BCD51@DB3PRD3001MB020.064d.mgd.msft.net> <20150202160209.GA4437@guldendraak.bioinf.uni-leipzig.de> Message-ID: <618BE556AADD624C9C918AA5D5911BEF562BCF43@DB3PRD3001MB020.064d.mgd.msft.net> Ah, well, if it's really the concat/concatMap problem then I'm really not sure how to crack it. But there are lots of smart people on this list, so maybe someone else can. The fewer dependencies your test case has the better. eg Don't use criterion; this stuff is huge: you get 10G of allocation in your test run instead of 10M. Or something. Simon | -----Original Message----- | From: Christian H?ner zu Siederdissen | [mailto:choener at tbi.univie.ac.at] | Sent: 02 February 2015 16:02 | To: Simon Peyton Jones | Cc: Glasgow-Haskell-Users | Subject: Re: stream fusion, concatMap, exisential seed unboxing | | Sure, no problem! | | Btw. this is not a 'bug' in the usual sense. It is the (neverending) | concatMap + stream fusion story. | https://ghc.haskell.org/trac/ghc/ticket/915 | I'm playing a bit with trying to get GHC to look through the | existential seed elements and have it constructor-specialize them. | | Unfortunately, unbox/spec fails with more complex seeds for now. For | the more simple cases like the one below, the extra strictness pass | works (cool, thanks!). These are sometimes enough if you have just | concatMap (\i -> [i .. j]) stuff. | | However, if the internal stream state is, say, a pair (i,j), then one | of those is not completely unboxed. I guess that *if* we could get the | passes to continue unbox'ing and ctor-spec'ing, we could end up with a | fully fused concatMap. | | I'll put a complete git repository with criterion + quickcheck modules | up (soonishly ;-). | | Viele Gruesse, | Christian | | * Simon Peyton Jones [02.02.2015 15:49]: | > I think it'd help you to open a Trac ticket, give a fully- | reproducible test case, including instructions for how to reproduce, | and say what isn't happening that should happen. | > | > What's odd is that loop_s29q looks strict in its Int arg, yet isn't | unboxed. There is a way to get the strictness analysis to run twice - | flate-dmd-anal. You could try that. | > | > Simon | > | > | -----Original Message----- | > | From: Glasgow-haskell-users [mailto:glasgow-haskell-users- | > | bounces at haskell.org] On Behalf Of Christian H?ner zu Siederdissen | > | Sent: 01 February 2015 12:18 | > | To: Glasgow-Haskell-Users | > | Subject: stream fusion, concatMap, exisential seed unboxing | > | | > | Hi everybody, | > | | > | I'm playing around with concatMap in stream fusion (the vector | > | package to be exact). | > | | > | concatMapM :: Monad m => (a->m (Stream m b)) -> Stream m a -> | > | Stream m b concatMapM f (Stream ...) = ... | > | | > | I can get my concatMap to behave nicely and erase all Stream and | > | Step constructors but due to the existential nature of the Stream | > | seeds, they are re-boxed for the inner stream (which is kind-of | > | annoying given that the seed is immediately unboxed again ;-). | seq | > | doesn't help here. | > | | > | Otherwise, fusion happens for streams and vectors, so that is ok. | > | But boxing kills performance, criterion says. | > | | > | Do we have s.th. in place that could help here? Currently I could | > | use the vector-concatMap which creates intermediate arrays, my | > | version which has boxed seeds, or hermit but that is too | > | inconvenient for non- ghc savy users. | > | | > | Viele Gruesse, | > | Christian | > | | > | | > | | > | Fusing concatMapM: | > | | > | concatMapM f (SM.Stream ostep t _) = SM.Stream step (Left t) | Unknown | > | where step (Left t) = do r <- ostep t | > | case r of | > | SM.Done -> return $ SM.Done | > | SM.Skip t' -> return $ SM.Skip | (Left | > | t') | > | SM.Yield a t' -> do s <- f a | > | return $ SM.Skip | > | (Right (s,t')) | > | step (Right (SM.Stream istep s _,t)) = do r <- istep s | > | case r of | > | SM.Done | -> | > | return $ SM.Skip (Left t) | > | SM.Skip s' | -> | > | return $ SM.Skip (Right (SM.Stream istep s' Unknown,t)) | > | SM.Yield x s' | > | -> return $ SM.Yield x (Right (SM.Stream istep s' Unknown,t)) | > | {-# INLINE [0] step #-} | > | {-# INLINE [1] concatMapM #-} | > | | > | testConcatMapM :: Int -> Int | > | testConcatMapM k = seq k $ U.unId | > | . SM.foldl' (+) 0 | > | . concatMap (\i -> SM.enumFromTo 5 k) | > | $ SM.enumFromTo 3 k {-# NOINLINE testConcatMapM | > | #-} | > | | > | CORE: | > | | > | testConcatMapM | > | testConcatMapM = | > | \ k_aCA -> | > | let! { I# ipv_s1xv ~ _ <- k_aCA } in ### inner loop | > | letrec { | > | $s$wfoldlM'_loop_s29q | > | $s$wfoldlM'_loop_s29q = | > | \ sc_s29i sc1_s29j sc2_s29k -> ### unboxing | > | let! { I# x_a1LA ~ _ <- sc1_s29j } in | > | case tagToEnum# (<=# x_a1LA ipv_s1xv) of _ { | > | False -> $s$wfoldlM'_loop1_s29c sc_s29i sc2_s29k; | > | True -> | > | $s$wfoldlM'_loop_s29q ### reboxing | > | (+# sc_s29i x_a1LA) (I# (+# x_a1LA 1)) sc2_s29k | > | }; | > | ### outer loop | > | $s$wfoldlM'_loop1_s29c | > | $s$wfoldlM'_loop1_s29c = | > | \ sc_s29a sc1_s29b -> | > | case tagToEnum# (<=# sc1_s29b ipv_s1xv) of _ { | > | False -> sc_s29a; | > | True -> | > | case tagToEnum# (<=# 5 ipv_s1xv) of _ { | > | False -> $s$wfoldlM'_loop1_s29c sc_s29a (+# | > | sc1_s29b 1); ### boxed seed (I# 6) | > | True -> $s$wfoldlM'_loop_s29q (+# sc_s29a 5) (I# | 6) | > | (+# sc1_s29b 1) | > | } | > | }; } in | > | let! { __DEFAULT ~ ww_s20G <- $s$wfoldlM'_loop1_s29c 0 3 } in | > | I# ww_s20G | > | | > | _______________________________________________ | > | Glasgow-haskell-users mailing list | > | Glasgow-haskell-users at haskell.org | > | http://www.haskell.org/mailman/listinfo/glasgow-haskell-users From simonpj at microsoft.com Mon Feb 2 17:33:33 2015 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Mon, 2 Feb 2015 17:33:33 +0000 Subject: Restricted Template Haskell In-Reply-To: References: Message-ID: <618BE556AADD624C9C918AA5D5911BEF562BD03C@DB3PRD3001MB020.064d.mgd.msft.net> The new TH is already split into two parts as I?m sure you know ? Typed TH is for expressions only, and doesn?t have reify, nor any Q monad. ? Untyped TH is the wild west Typed TH may get some of what you want? Certainly you want to acknowledge the existing split in your own design. The proposal could do with examples to illustrate what the difficulties are. What bad things happen in the Q monad? Can you give examples of reasoning that would be valid in level 1 but not in level 2. etc. More precision please! Simon From: Glasgow-haskell-users [mailto:glasgow-haskell-users-bounces at haskell.org] On Behalf Of Greg Weber Sent: 30 January 2015 23:39 To: ghc-devs at haskell.org; GHC users Cc: David Terei; Maxwell Swadling Subject: Restricted Template Haskell Hello GHC friends! I am starting up a proposal for variants of Template Haskell that restrict what operations are available. The goal is to make TH easier for users to reason about and to allow for an easier compilation story. Here is the proposal page: https://ghc.haskell.org/trac/ghc/wiki/TemplateHaskell/Restricted Right now the proposal does not have any details and the goal is to write out a clear specification. If this sounds interesting to you, let me know or leave some feedback on the wiki. Thanks, Greg Weber -------------- next part -------------- An HTML attachment was scrubbed... URL: From choener at tbi.univie.ac.at Mon Feb 2 18:14:09 2015 From: choener at tbi.univie.ac.at (Christian =?iso-8859-1?Q?H=F6ner?= zu Siederdissen) Date: Mon, 2 Feb 2015 19:14:09 +0100 Subject: stream fusion, concatMap, exisential seed unboxing In-Reply-To: <618BE556AADD624C9C918AA5D5911BEF562BCF43@DB3PRD3001MB020.064d.mgd.msft.net> References: <20150201121802.GA2507@workstation.Speedport_W_724V_Typ_A_05011602_00_001> <618BE556AADD624C9C918AA5D5911BEF562BCD51@DB3PRD3001MB020.064d.mgd.msft.net> <20150202160209.GA4437@guldendraak.bioinf.uni-leipzig.de> <618BE556AADD624C9C918AA5D5911BEF562BCF43@DB3PRD3001MB020.064d.mgd.msft.net> Message-ID: <20150202181409.GA1093@workstation.Speedport_W_724V_Typ_A_05011602_00_001> Yes, I'm kinda hoping that fusion-interested folks might have a comment. Both QuickCheck and Criterion are completely optional. It depends only on base and vector. I'm keeping vector for now, as this allows me to observe if intermediate vectors are fused away, too. Viele Gruesse, Christian * Simon Peyton Jones [02.02.2015 18:09]: > Ah, well, if it's really the concat/concatMap problem then I'm really not sure how to crack it. > > But there are lots of smart people on this list, so maybe someone else can. > > The fewer dependencies your test case has the better. eg Don't use criterion; this stuff is huge: you get 10G of allocation in your test run instead of 10M. Or something. > > Simon > > | -----Original Message----- > | From: Christian H?ner zu Siederdissen > | [mailto:choener at tbi.univie.ac.at] > | Sent: 02 February 2015 16:02 > | To: Simon Peyton Jones > | Cc: Glasgow-Haskell-Users > | Subject: Re: stream fusion, concatMap, exisential seed unboxing > | > | Sure, no problem! > | > | Btw. this is not a 'bug' in the usual sense. It is the (neverending) > | concatMap + stream fusion story. > | https://ghc.haskell.org/trac/ghc/ticket/915 > | I'm playing a bit with trying to get GHC to look through the > | existential seed elements and have it constructor-specialize them. > | > | Unfortunately, unbox/spec fails with more complex seeds for now. For > | the more simple cases like the one below, the extra strictness pass > | works (cool, thanks!). These are sometimes enough if you have just > | concatMap (\i -> [i .. j]) stuff. > | > | However, if the internal stream state is, say, a pair (i,j), then one > | of those is not completely unboxed. I guess that *if* we could get the > | passes to continue unbox'ing and ctor-spec'ing, we could end up with a > | fully fused concatMap. > | > | I'll put a complete git repository with criterion + quickcheck modules > | up (soonishly ;-). > | > | Viele Gruesse, > | Christian > | > | * Simon Peyton Jones [02.02.2015 15:49]: > | > I think it'd help you to open a Trac ticket, give a fully- > | reproducible test case, including instructions for how to reproduce, > | and say what isn't happening that should happen. > | > > | > What's odd is that loop_s29q looks strict in its Int arg, yet isn't > | unboxed. There is a way to get the strictness analysis to run twice - > | flate-dmd-anal. You could try that. > | > > | > Simon > | > > | > | -----Original Message----- > | > | From: Glasgow-haskell-users [mailto:glasgow-haskell-users- > | > | bounces at haskell.org] On Behalf Of Christian H?ner zu Siederdissen > | > | Sent: 01 February 2015 12:18 > | > | To: Glasgow-Haskell-Users > | > | Subject: stream fusion, concatMap, exisential seed unboxing > | > | > | > | Hi everybody, > | > | > | > | I'm playing around with concatMap in stream fusion (the vector > | > | package to be exact). > | > | > | > | concatMapM :: Monad m => (a->m (Stream m b)) -> Stream m a -> > | > | Stream m b concatMapM f (Stream ...) = ... > | > | > | > | I can get my concatMap to behave nicely and erase all Stream and > | > | Step constructors but due to the existential nature of the Stream > | > | seeds, they are re-boxed for the inner stream (which is kind-of > | > | annoying given that the seed is immediately unboxed again ;-). > | seq > | > | doesn't help here. > | > | > | > | Otherwise, fusion happens for streams and vectors, so that is ok. > | > | But boxing kills performance, criterion says. > | > | > | > | Do we have s.th. in place that could help here? Currently I could > | > | use the vector-concatMap which creates intermediate arrays, my > | > | version which has boxed seeds, or hermit but that is too > | > | inconvenient for non- ghc savy users. > | > | > | > | Viele Gruesse, > | > | Christian > | > | > | > | > | > | > | > | Fusing concatMapM: > | > | > | > | concatMapM f (SM.Stream ostep t _) = SM.Stream step (Left t) > | Unknown > | > | where step (Left t) = do r <- ostep t > | > | case r of > | > | SM.Done -> return $ SM.Done > | > | SM.Skip t' -> return $ SM.Skip > | (Left > | > | t') > | > | SM.Yield a t' -> do s <- f a > | > | return $ SM.Skip > | > | (Right (s,t')) > | > | step (Right (SM.Stream istep s _,t)) = do r <- istep s > | > | case r of > | > | SM.Done > | -> > | > | return $ SM.Skip (Left t) > | > | SM.Skip s' > | -> > | > | return $ SM.Skip (Right (SM.Stream istep s' Unknown,t)) > | > | SM.Yield x s' > | > | -> return $ SM.Yield x (Right (SM.Stream istep s' Unknown,t)) > | > | {-# INLINE [0] step #-} > | > | {-# INLINE [1] concatMapM #-} > | > | > | > | testConcatMapM :: Int -> Int > | > | testConcatMapM k = seq k $ U.unId > | > | . SM.foldl' (+) 0 > | > | . concatMap (\i -> SM.enumFromTo 5 k) > | > | $ SM.enumFromTo 3 k {-# NOINLINE testConcatMapM > | > | #-} > | > | > | > | CORE: > | > | > | > | testConcatMapM > | > | testConcatMapM = > | > | \ k_aCA -> > | > | let! { I# ipv_s1xv ~ _ <- k_aCA } in ### inner loop > | > | letrec { > | > | $s$wfoldlM'_loop_s29q > | > | $s$wfoldlM'_loop_s29q = > | > | \ sc_s29i sc1_s29j sc2_s29k -> ### unboxing > | > | let! { I# x_a1LA ~ _ <- sc1_s29j } in > | > | case tagToEnum# (<=# x_a1LA ipv_s1xv) of _ { > | > | False -> $s$wfoldlM'_loop1_s29c sc_s29i sc2_s29k; > | > | True -> > | > | $s$wfoldlM'_loop_s29q ### reboxing > | > | (+# sc_s29i x_a1LA) (I# (+# x_a1LA 1)) sc2_s29k > | > | }; > | > | ### outer loop > | > | $s$wfoldlM'_loop1_s29c > | > | $s$wfoldlM'_loop1_s29c = > | > | \ sc_s29a sc1_s29b -> > | > | case tagToEnum# (<=# sc1_s29b ipv_s1xv) of _ { > | > | False -> sc_s29a; > | > | True -> > | > | case tagToEnum# (<=# 5 ipv_s1xv) of _ { > | > | False -> $s$wfoldlM'_loop1_s29c sc_s29a (+# > | > | sc1_s29b 1); ### boxed seed (I# 6) > | > | True -> $s$wfoldlM'_loop_s29q (+# sc_s29a 5) (I# > | 6) > | > | (+# sc1_s29b 1) > | > | } > | > | }; } in > | > | let! { __DEFAULT ~ ww_s20G <- $s$wfoldlM'_loop1_s29c 0 3 } in > | > | I# ww_s20G > | > | > | > | _______________________________________________ > | > | Glasgow-haskell-users mailing list > | > | Glasgow-haskell-users at haskell.org > | > | http://www.haskell.org/mailman/listinfo/glasgow-haskell-users From greg at gregweber.info Mon Feb 2 19:31:06 2015 From: greg at gregweber.info (Greg Weber) Date: Mon, 2 Feb 2015 11:31:06 -0800 Subject: Restricted Template Haskell In-Reply-To: <618BE556AADD624C9C918AA5D5911BEF562BD03C@DB3PRD3001MB020.064d.mgd.msft.net> References: <618BE556AADD624C9C918AA5D5911BEF562BD03C@DB3PRD3001MB020.064d.mgd.msft.net> Message-ID: Hi Simon, I am just starting the proposal: gathering interested parties and pointers to related information. Thanks for the pointer to Typed Template Haskell. I was actually unaware of the extent to which Typed Template Haskell is restricted. I have not seen any usage of Typed Template Haskell in the wild or been able to use it myself unfortunately due to backwards compatibility needs (once the next GHC release is out libraries will start to consider dropping 7.6 support and we will see more usage, although Ubuntu still ships 7.6 by default). I will study Typed Template Haskell. Greg Weber On Mon, Feb 2, 2015 at 9:33 AM, Simon Peyton Jones wrote: > The new TH is already split into two parts > as > I?m sure you know > > ? Typed TH is for expressions only, and doesn?t have reify, nor > any Q monad. > > ? Untyped TH is the wild west > > > > Typed TH may get some of what you want? Certainly you want to > acknowledge the existing split in your own design. > > > > The proposal could do with examples to illustrate what the difficulties > are. What bad things happen in the Q monad? Can you give examples of > reasoning that would be valid in level 1 but not in level 2. etc. More > precision please! > > > > Simon > > > > *From:* Glasgow-haskell-users [mailto: > glasgow-haskell-users-bounces at haskell.org] *On Behalf Of *Greg Weber > *Sent:* 30 January 2015 23:39 > *To:* ghc-devs at haskell.org; GHC users > *Cc:* David Terei; Maxwell Swadling > *Subject:* Restricted Template Haskell > > > > Hello GHC friends! > > > > I am starting up a proposal for variants of Template Haskell that restrict > what operations are available. The goal is to make TH easier for users to > reason about and to allow for an easier compilation story. > > > > Here is the proposal page: > > https://ghc.haskell.org/trac/ghc/wiki/TemplateHaskell/Restricted > > > > Right now the proposal does not have any details and the goal is to write > out a clear specification. > > If this sounds interesting to you, let me know or leave some feedback on > the wiki. > > > > > > Thanks, > > Greg Weber > > > > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From greg at gregweber.info Tue Feb 3 03:41:42 2015 From: greg at gregweber.info (Greg Weber) Date: Mon, 2 Feb 2015 19:41:42 -0800 Subject: Restricted Template Haskell In-Reply-To: References: <618BE556AADD624C9C918AA5D5911BEF562BD03C@DB3PRD3001MB020.064d.mgd.msft.net> Message-ID: I would like to figure out how to improve the state of TTH documentation. The GHC wiki is usually for things that are changing, and the page is written in that future style, so it makes one wonder if all things are finished or if some things remain unfinished. Some "this is how it is" documentation in the user guide would seem more useful now. But I am not sure if the user guide [1] is even correct because it indicates a type of `Q (TExp a)` where I would expect just `TExp a` from reading the wiki [2]. [1] https://downloads.haskell.org/~ghc/7.8.4/docs/html/users_guide/template-haskell.html [2] https://ghc.haskell.org/trac/ghc/wiki/TemplateHaskell/BlogPostChanges On Mon, Feb 2, 2015 at 11:31 AM, Greg Weber wrote: > Hi Simon, > > I am just starting the proposal: gathering interested parties and pointers > to related information. > Thanks for the pointer to Typed Template Haskell. I was actually unaware > of the extent to which Typed Template Haskell is restricted. I have not > seen any usage of Typed Template Haskell in the wild or been able to use it > myself unfortunately due to backwards compatibility needs (once the next > GHC release is out libraries will start to consider dropping 7.6 support > and we will see more usage, although Ubuntu still ships 7.6 by default). > I will study Typed Template Haskell. > > Greg Weber > > On Mon, Feb 2, 2015 at 9:33 AM, Simon Peyton Jones > wrote: > >> The new TH is already split into two parts >> as >> I?m sure you know >> >> ? Typed TH is for expressions only, and doesn?t have reify, nor >> any Q monad. >> >> ? Untyped TH is the wild west >> >> >> >> Typed TH may get some of what you want? Certainly you want to >> acknowledge the existing split in your own design. >> >> >> >> The proposal could do with examples to illustrate what the difficulties >> are. What bad things happen in the Q monad? Can you give examples of >> reasoning that would be valid in level 1 but not in level 2. etc. More >> precision please! >> >> >> >> Simon >> >> >> >> *From:* Glasgow-haskell-users [mailto: >> glasgow-haskell-users-bounces at haskell.org] *On Behalf Of *Greg Weber >> *Sent:* 30 January 2015 23:39 >> *To:* ghc-devs at haskell.org; GHC users >> *Cc:* David Terei; Maxwell Swadling >> *Subject:* Restricted Template Haskell >> >> >> >> Hello GHC friends! >> >> >> >> I am starting up a proposal for variants of Template Haskell that >> restrict what operations are available. The goal is to make TH easier for >> users to reason about and to allow for an easier compilation story. >> >> >> >> Here is the proposal page: >> >> https://ghc.haskell.org/trac/ghc/wiki/TemplateHaskell/Restricted >> >> >> >> Right now the proposal does not have any details and the goal is to write >> out a clear specification. >> >> If this sounds interesting to you, let me know or leave some feedback on >> the wiki. >> >> >> >> >> >> Thanks, >> >> Greg Weber >> >> >> >> >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From simonpj at microsoft.com Tue Feb 3 11:44:35 2015 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Tue, 3 Feb 2015 11:44:35 +0000 Subject: Restricted Template Haskell In-Reply-To: References: <618BE556AADD624C9C918AA5D5911BEF562BD03C@DB3PRD3001MB020.064d.mgd.msft.net> Message-ID: <618BE556AADD624C9C918AA5D5911BEF562BDD0A@DB3PRD3001MB020.064d.mgd.msft.net> Greg (and everyone else) The TH documentation is even more woeful than I realised. At the very least there should be a section for typed TH and a section for untyped TH in the manual. If I volunteer to write it, it won?t get done. I?m in too many inner loops. But here?s an offer: if someone (or a little group) is willing to play author, I will review and correct. It could be a good way to learn the details! Ideally it would be good to have a compact specification in the user manual, with more detail on the Haskell wiki (where it?s easier for people to edit/improve). For the latter there is already a page here. I?d really appreciate help with this. Simon From: Greg Weber [mailto:greg at gregweber.info] Sent: 03 February 2015 03:42 To: Simon Peyton Jones Cc: ghc-devs at haskell.org; GHC users; David Terei; Maxwell Swadling Subject: Re: Restricted Template Haskell I would like to figure out how to improve the state of TTH documentation. The GHC wiki is usually for things that are changing, and the page is written in that future style, so it makes one wonder if all things are finished or if some things remain unfinished. Some "this is how it is" documentation in the user guide would seem more useful now. But I am not sure if the user guide [1] is even correct because it indicates a type of `Q (TExp a)` where I would expect just `TExp a` from reading the wiki [2]. [1] https://downloads.haskell.org/~ghc/7.8.4/docs/html/users_guide/template-haskell.html [2] https://ghc.haskell.org/trac/ghc/wiki/TemplateHaskell/BlogPostChanges On Mon, Feb 2, 2015 at 11:31 AM, Greg Weber > wrote: Hi Simon, I am just starting the proposal: gathering interested parties and pointers to related information. Thanks for the pointer to Typed Template Haskell. I was actually unaware of the extent to which Typed Template Haskell is restricted. I have not seen any usage of Typed Template Haskell in the wild or been able to use it myself unfortunately due to backwards compatibility needs (once the next GHC release is out libraries will start to consider dropping 7.6 support and we will see more usage, although Ubuntu still ships 7.6 by default). I will study Typed Template Haskell. Greg Weber On Mon, Feb 2, 2015 at 9:33 AM, Simon Peyton Jones > wrote: The new TH is already split into two parts as I?m sure you know ? Typed TH is for expressions only, and doesn?t have reify, nor any Q monad. ? Untyped TH is the wild west Typed TH may get some of what you want? Certainly you want to acknowledge the existing split in your own design. The proposal could do with examples to illustrate what the difficulties are. What bad things happen in the Q monad? Can you give examples of reasoning that would be valid in level 1 but not in level 2. etc. More precision please! Simon From: Glasgow-haskell-users [mailto:glasgow-haskell-users-bounces at haskell.org] On Behalf Of Greg Weber Sent: 30 January 2015 23:39 To: ghc-devs at haskell.org; GHC users Cc: David Terei; Maxwell Swadling Subject: Restricted Template Haskell Hello GHC friends! I am starting up a proposal for variants of Template Haskell that restrict what operations are available. The goal is to make TH easier for users to reason about and to allow for an easier compilation story. Here is the proposal page: https://ghc.haskell.org/trac/ghc/wiki/TemplateHaskell/Restricted Right now the proposal does not have any details and the goal is to write out a clear specification. If this sounds interesting to you, let me know or leave some feedback on the wiki. Thanks, Greg Weber -------------- next part -------------- An HTML attachment was scrubbed... URL: From merijn at inconsistent.nl Thu Feb 5 14:45:32 2015 From: merijn at inconsistent.nl (Merijn Verstraaten) Date: Thu, 5 Feb 2015 15:45:32 +0100 Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion Message-ID: <5F203379-8242-4137-AFA2-91289F2119B6@inconsistent.nl> I've been repeatedly running into problems with overloaded literals and partial conversion functions, so I wrote up an initial proposal (https://ghc.haskell.org/trac/ghc/wiki/ValidateMonoLiterals) and I'd like to commence with the bikeshedding and hearing other opinions :) Cheers, Merijn -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 842 bytes Desc: Message signed with OpenPGP using GPGMail URL: From simonpj at microsoft.com Thu Feb 5 21:48:13 2015 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Thu, 5 Feb 2015 21:48:13 +0000 Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion In-Reply-To: <5F203379-8242-4137-AFA2-91289F2119B6@inconsistent.nl> References: <5F203379-8242-4137-AFA2-91289F2119B6@inconsistent.nl> Message-ID: <618BE556AADD624C9C918AA5D5911BEF562C0405@DB3PRD3001MB020.064d.mgd.msft.net> I'm all for it. Syntax sounds like the main difficulty. Today you could use quasiquotatoin [even| 38 |] and get the same effect as $$(validate 38). But it's still noisy. So: what is the non-noisy scheme you want to propose? You don't quite get to that in the wiki page! Simon | -----Original Message----- | From: ghc-devs [mailto:ghc-devs-bounces at haskell.org] On Behalf Of Merijn | Verstraaten | Sent: 05 February 2015 14:46 | To: ghc-devs at haskell.org; GHC users | Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion | | I've been repeatedly running into problems with overloaded literals and | partial conversion functions, so I wrote up an initial proposal | (https://ghc.haskell.org/trac/ghc/wiki/ValidateMonoLiterals) and I'd like | to commence with the bikeshedding and hearing other opinions :) | | Cheers, | Merijn From merijn at inconsistent.nl Fri Feb 6 10:07:07 2015 From: merijn at inconsistent.nl (Merijn Verstraaten) Date: Fri, 6 Feb 2015 11:07:07 +0100 Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion In-Reply-To: <618BE556AADD624C9C918AA5D5911BEF562C0405@DB3PRD3001MB020.064d.mgd.msft.net> References: <5F203379-8242-4137-AFA2-91289F2119B6@inconsistent.nl> <618BE556AADD624C9C918AA5D5911BEF562C0405@DB3PRD3001MB020.064d.mgd.msft.net> Message-ID: <7BFEA344-05CB-4663-A594-9C4CF25E1D04@inconsistent.nl> And no one of my proofreaders noticed that >.> I would propose to have the extension replace the 'fromString "foo"', 'fromIntegral 5' and 'fromList [1,2,3]' calls (for monomorphic cases) in the AST with the relevant Typed TH splice. I considered quasi-quotation initially too, but there's no quasi quotation syntax for Typed TH. I'm guessing that's just an oversight, but I'd really be in favour of adding a typed quasiquoter too. Similarly to thinking we should have an easier way to obtain Lift instances since, to me at least, it seems that the Lift instance for most ADTs should be fairly trivial? I'll quickly clarify the proposal on the wiki :) Cheers, Merijn > On 5 Feb 2015, at 22:48, Simon Peyton Jones wrote: > > I'm all for it. Syntax sounds like the main difficulty. Today you could use quasiquotatoin > [even| 38 |] > and get the same effect as $$(validate 38). But it's still noisy. > > So: what is the non-noisy scheme you want to propose? You don't quite get to that in the wiki page! > > Simon > > | -----Original Message----- > | From: ghc-devs [mailto:ghc-devs-bounces at haskell.org] On Behalf Of Merijn > | Verstraaten > | Sent: 05 February 2015 14:46 > | To: ghc-devs at haskell.org; GHC users > | Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion > | > | I've been repeatedly running into problems with overloaded literals and > | partial conversion functions, so I wrote up an initial proposal > | (https://ghc.haskell.org/trac/ghc/wiki/ValidateMonoLiterals) and I'd like > | to commence with the bikeshedding and hearing other opinions :) > | > | Cheers, > | Merijn -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 842 bytes Desc: Message signed with OpenPGP using GPGMail URL: From dominique.devriese at cs.kuleuven.be Fri Feb 6 12:13:33 2015 From: dominique.devriese at cs.kuleuven.be (Dominique Devriese) Date: Fri, 6 Feb 2015 13:13:33 +0100 Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion In-Reply-To: <7BFEA344-05CB-4663-A594-9C4CF25E1D04@inconsistent.nl> References: <5F203379-8242-4137-AFA2-91289F2119B6@inconsistent.nl> <618BE556AADD624C9C918AA5D5911BEF562C0405@DB3PRD3001MB020.064d.mgd.msft.net> <7BFEA344-05CB-4663-A594-9C4CF25E1D04@inconsistent.nl> Message-ID: Merijn, Perhaps only for the sake of discussion: have you considered doing something at the type-level instead of using TH? I mean that you could change the type of 42 from `forall a. Num a => a` to `forall a. HasIntLiteral a '42 => a` where HasIntegerLiteral is a type class of kind `* -> 'Integer -> Constraint` and people can instantiate it for their types: class HasIntegerLiteral (a :: *) (k :: 'Integer) where literal :: a The desugarer could then just generate an invocation of "literal". An advantage would be that you don't need TH (although you do need DataKinds and type-level computation). Specifically, type-checking remains decidable and you can do it in safe haskell and so on. I haven't thought this through very far, so there may be other advantages/disadvantages/glaring-holes-in-the-idea that I'm missing. Regards, Dominique 2015-02-06 11:07 GMT+01:00 Merijn Verstraaten : > And no one of my proofreaders noticed that >.> > > I would propose to have the extension replace the 'fromString "foo"', 'fromIntegral 5' and 'fromList [1,2,3]' calls (for monomorphic cases) in the AST with the relevant Typed TH splice. > > I considered quasi-quotation initially too, but there's no quasi quotation syntax for Typed TH. I'm guessing that's just an oversight, but I'd really be in favour of adding a typed quasiquoter too. Similarly to thinking we should have an easier way to obtain Lift instances since, to me at least, it seems that the Lift instance for most ADTs should be fairly trivial? > > I'll quickly clarify the proposal on the wiki :) > > Cheers, > Merijn > >> On 5 Feb 2015, at 22:48, Simon Peyton Jones wrote: >> >> I'm all for it. Syntax sounds like the main difficulty. Today you could use quasiquotatoin >> [even| 38 |] >> and get the same effect as $$(validate 38). But it's still noisy. >> >> So: what is the non-noisy scheme you want to propose? You don't quite get to that in the wiki page! >> >> Simon >> >> | -----Original Message----- >> | From: ghc-devs [mailto:ghc-devs-bounces at haskell.org] On Behalf Of Merijn >> | Verstraaten >> | Sent: 05 February 2015 14:46 >> | To: ghc-devs at haskell.org; GHC users >> | Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion >> | >> | I've been repeatedly running into problems with overloaded literals and >> | partial conversion functions, so I wrote up an initial proposal >> | (https://ghc.haskell.org/trac/ghc/wiki/ValidateMonoLiterals) and I'd like >> | to commence with the bikeshedding and hearing other opinions :) >> | >> | Cheers, >> | Merijn > > > _______________________________________________ > Glasgow-haskell-users mailing list > Glasgow-haskell-users at haskell.org > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users > From merijn at inconsistent.nl Fri Feb 6 12:45:40 2015 From: merijn at inconsistent.nl (Merijn Verstraaten) Date: Fri, 6 Feb 2015 13:45:40 +0100 Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion In-Reply-To: References: <5F203379-8242-4137-AFA2-91289F2119B6@inconsistent.nl> <618BE556AADD624C9C918AA5D5911BEF562C0405@DB3PRD3001MB020.064d.mgd.msft.net> <7BFEA344-05CB-4663-A594-9C4CF25E1D04@inconsistent.nl> Message-ID: <507A1EEF-5C0D-4C5E-B842-B14860DBDA9F@inconsistent.nl> Hi Dominique, I don't see how that would replace the usecase I describe? I'll give you a more concrete example from a library I'm working on. I'm working on a Haskell implementation of ZeroMQ, the ZMTP protocol lets sockets be named by a "binary identifier with length <= 255 and NOT starting with a NUL byte". As a programmer using this library I would have to write these socket identifiers in my source code. Now I have four options: 1) The library just doesn't validate identifiers to be compatible with the protocol (awful!) 2) My library produces a runtime error on every single invocation of the program (if it doesn't satisfy the constraints it will never successfully work) 3) I require a newtype'd input type with a smart constructor, which means the programmer still has to handle the "error" case even though it should never happen for literals written in the source. 4) Using a trick like what I desribed, the above newtype and smart constructor, and check at compile time that it is correct. To be honest, I don't even see how your example would generalise to the rather trivial example using Even? For example, suppose we have "foo :: Even -> SomeData" how would I write "foo 2" using your idea in a way that, at compile time, checks that I'm not passing an invalid literal to foo? As a further aside, your "type checking remains decidable" comment seems to imply that you think that type checking becomes undecidable with what I propose? Can you explain how that could be, considering that it already works in GHC, albeit in a very cumbersome way? As for working with Safe Haskell, I'm all for better Safe Haskell support in TH, but unfortunately I'm already worried about my ability to tackle this proposal, let alone something more ambitious like making TH work better with Safe Haskell, I'll leave that task for someone more familiar with GHC. Cheers, Merijn > On 6 Feb 2015, at 13:13, Dominique Devriese wrote: > > Merijn, > > Perhaps only for the sake of discussion: have you considered doing > something at the type-level instead of using TH? I mean that you could > change the type of 42 from `forall a. Num a => a` to `forall a. > HasIntLiteral a '42 => a` where HasIntegerLiteral is a type class of > kind `* -> 'Integer -> Constraint` and people can instantiate it for > their types: > > class HasIntegerLiteral (a :: *) (k :: 'Integer) where > literal :: a > > The desugarer could then just generate an invocation of "literal". > > An advantage would be that you don't need TH (although you do need > DataKinds and type-level computation). Specifically, type-checking > remains decidable and you can do it in safe haskell and so on. I > haven't thought this through very far, so there may be other > advantages/disadvantages/glaring-holes-in-the-idea that I'm missing. > > Regards, > Dominique > > 2015-02-06 11:07 GMT+01:00 Merijn Verstraaten : >> And no one of my proofreaders noticed that >.> >> >> I would propose to have the extension replace the 'fromString "foo"', 'fromIntegral 5' and 'fromList [1,2,3]' calls (for monomorphic cases) in the AST with the relevant Typed TH splice. >> >> I considered quasi-quotation initially too, but there's no quasi quotation syntax for Typed TH. I'm guessing that's just an oversight, but I'd really be in favour of adding a typed quasiquoter too. Similarly to thinking we should have an easier way to obtain Lift instances since, to me at least, it seems that the Lift instance for most ADTs should be fairly trivial? >> >> I'll quickly clarify the proposal on the wiki :) >> >> Cheers, >> Merijn >> >>> On 5 Feb 2015, at 22:48, Simon Peyton Jones wrote: >>> >>> I'm all for it. Syntax sounds like the main difficulty. Today you could use quasiquotatoin >>> [even| 38 |] >>> and get the same effect as $$(validate 38). But it's still noisy. >>> >>> So: what is the non-noisy scheme you want to propose? You don't quite get to that in the wiki page! >>> >>> Simon >>> >>> | -----Original Message----- >>> | From: ghc-devs [mailto:ghc-devs-bounces at haskell.org] On Behalf Of Merijn >>> | Verstraaten >>> | Sent: 05 February 2015 14:46 >>> | To: ghc-devs at haskell.org; GHC users >>> | Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion >>> | >>> | I've been repeatedly running into problems with overloaded literals and >>> | partial conversion functions, so I wrote up an initial proposal >>> | (https://ghc.haskell.org/trac/ghc/wiki/ValidateMonoLiterals) and I'd like >>> | to commence with the bikeshedding and hearing other opinions :) >>> | >>> | Cheers, >>> | Merijn >> >> >> _______________________________________________ >> Glasgow-haskell-users mailing list >> Glasgow-haskell-users at haskell.org >> http://www.haskell.org/mailman/listinfo/glasgow-haskell-users >> -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 842 bytes Desc: Message signed with OpenPGP using GPGMail URL: From adam at well-typed.com Fri Feb 6 13:20:24 2015 From: adam at well-typed.com (Adam Gundry) Date: Fri, 06 Feb 2015 13:20:24 +0000 Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion In-Reply-To: References: <5F203379-8242-4137-AFA2-91289F2119B6@inconsistent.nl> <618BE556AADD624C9C918AA5D5911BEF562C0405@DB3PRD3001MB020.064d.mgd.msft.net> <7BFEA344-05CB-4663-A594-9C4CF25E1D04@inconsistent.nl> Message-ID: <54D4BF98.3020104@well-typed.com> Hi Dominique, On 06/02/15 12:13, Dominique Devriese wrote: > Perhaps only for the sake of discussion: have you considered doing > something at the type-level instead of using TH? I mean that you could > change the type of 42 from `forall a. Num a => a` to `forall a. > HasIntLiteral a '42 => a` where HasIntegerLiteral is a type class of > kind `* -> 'Integer -> Constraint` and people can instantiate it for > their types: > > class HasIntegerLiteral (a :: *) (k :: 'Integer) where > literal :: a > > The desugarer could then just generate an invocation of "literal". > > An advantage would be that you don't need TH (although you do need > DataKinds and type-level computation). Specifically, type-checking > remains decidable and you can do it in safe haskell and so on. I > haven't thought this through very far, so there may be other > advantages/disadvantages/glaring-holes-in-the-idea that I'm missing. Interestingly, the string version of this would be remarkably similar to the IV class [1] that came up in the redesign of OverloadedRecordFields: class IV (x :: Symbol) a where iv :: a though in this case the plan was to have a special syntax for such literals (e.g. #x). It seems to me that what you would describe would work, and the avoidance of TH is a merit, but the downside is the complexity of implementing even relatively simple validation at the type level (as opposed to just reusing a term-level function). For Merijn's Even example I guess one could do something like this in current GHC: type family IsEven (n :: Nat) :: Bool where IsEven 0 = True IsEven 1 = False IsEven n = n - 2 instance (KnownNat n, IsEven n ~ True) => HasIntegerLiteral Even n where literal = Even (natVal (Proxy :: Proxy n)) but anything interesting to do with strings (e.g. checking that ByteStrings are ASCII) is rather out of reach at present. Adam [1] https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/Redesign#Implicitvalues -- Adam Gundry, Haskell Consultant Well-Typed LLP, http://www.well-typed.com/ From dominique.devriese at cs.kuleuven.be Fri Feb 6 13:41:30 2015 From: dominique.devriese at cs.kuleuven.be (Dominique Devriese) Date: Fri, 6 Feb 2015 14:41:30 +0100 Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion In-Reply-To: <507A1EEF-5C0D-4C5E-B842-B14860DBDA9F@inconsistent.nl> References: <5F203379-8242-4137-AFA2-91289F2119B6@inconsistent.nl> <618BE556AADD624C9C918AA5D5911BEF562C0405@DB3PRD3001MB020.064d.mgd.msft.net> <7BFEA344-05CB-4663-A594-9C4CF25E1D04@inconsistent.nl> <507A1EEF-5C0D-4C5E-B842-B14860DBDA9F@inconsistent.nl> Message-ID: Hi Merijn, 2015-02-06 13:45 GMT+01:00 Merijn Verstraaten : > I don't see how that would replace the usecase I describe? I've written out the Even use case a bit, to hopefully clarify my suggestion. The code is a bit cumbersome and inefficient because I can't use GHC type-lits because some type-level primitives seem to be missing (modulo specifically). Type-level Integers (i.e. a kind with *negative* numbers and literals) would probably also be required for an actual solution. {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DataKinds, KindSignatures, ExplicitForAll, PolyKinds, ScopedTypeVariables, ConstraintKinds, TypeFamilies, GADTs, FlexibleContexts #-} module ValidateMonoLiterals where data Nat where Zero :: Nat Suc :: Nat -> Nat class KnownNat (n :: Nat) where natSing :: forall proxy. proxy n -> Integer instance KnownNat Zero where natSing _ = 0 instance KnownNat k => KnownNat (Suc k) where natSing _ = natSing (Proxy :: Proxy k) + 1 data Proxy (t :: k) = Proxy class HasNatLiteral a (k :: Nat) where literal :: Proxy k -> a data Even = Even Integer class CheckEven (k :: Nat) where instance CheckEven Zero instance CheckEven k => CheckEven (Suc (Suc k)) where instance (KnownNat k, CheckEven k) => HasNatLiteral Even (k :: Nat) where literal _ = Even (fromInteger (natSing (Proxy :: Proxy k))) instance (KnownNat k) => HasNatLiteral Integer k where literal _ = natSing (Proxy :: Proxy k) four :: HasNatLiteral n (Suc (Suc (Suc (Suc Zero)))) => n four = literal (Proxy :: Proxy (Suc (Suc (Suc (Suc Zero))))) three :: HasNatLiteral n (Suc (Suc (Suc Zero))) => n three = literal (Proxy :: Proxy (Suc (Suc (Suc Zero)))) fourI :: Integer fourI = four fourEI :: Even fourEI = four -- fails with "No instance for CheckEven (Suc Zero)" -- threeEI :: Even -- threeEI = three > I'll give you a more concrete example from a library I'm working on. I'm working on a Haskell implementation of ZeroMQ, the ZMTP protocol lets sockets be named by a "binary identifier with length <= 255 and NOT starting with a NUL byte". As a programmer using this library I would have to write these socket identifiers in my source code. Now I have four options: > 1) The library just doesn't validate identifiers to be compatible with the protocol (awful!) > > 2) My library produces a runtime error on every single invocation of the program (if it doesn't satisfy the constraints it will never successfully work) > > 3) I require a newtype'd input type with a smart constructor, which means the programmer still has to handle the "error" case even though it should never happen for literals written in the source. > > 4) Using a trick like what I desribed, the above newtype and smart constructor, and check at compile time that it is correct. Well, I think my suggestion could be used as another alternative. As I mentioned, the compiler could translate the literal 42 to an appropriately typed invocation of HasNatLiteral.literal, so that you could also just write 42 but get the additional compile-time checking. > To be honest, I don't even see how your example would generalise to the rather trivial example using Even? For example, suppose we have "foo :: Even -> SomeData" how would I write "foo 2" using your idea in a way that, at compile time, checks that I'm not passing an invalid literal to foo? See above: the type of foo doesn't change w.r.t. your approach. > As a further aside, your "type checking remains decidable" comment seems to imply that you think that type checking becomes undecidable with what I propose? Can you explain how that could be, considering that it already works in GHC, albeit in a very cumbersome way? What I mean is that meta-programs invoked through TH can always fail to terminate (even though the ones you are using in your example are terminating). Consider what happens if you change the definition of your validate to this (or someone else implements your validateInteger like this for a type): validate :: forall a . Validate a => Integer -> Q (TExp a) validate i = validate (i+1) Regards, Dominique From dominique.devriese at cs.kuleuven.be Fri Feb 6 13:49:29 2015 From: dominique.devriese at cs.kuleuven.be (Dominique Devriese) Date: Fri, 6 Feb 2015 14:49:29 +0100 Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion In-Reply-To: <54D4BF98.3020104@well-typed.com> References: <5F203379-8242-4137-AFA2-91289F2119B6@inconsistent.nl> <618BE556AADD624C9C918AA5D5911BEF562C0405@DB3PRD3001MB020.064d.mgd.msft.net> <7BFEA344-05CB-4663-A594-9C4CF25E1D04@inconsistent.nl> <54D4BF98.3020104@well-typed.com> Message-ID: 2015-02-06 14:20 GMT+01:00 Adam Gundry : > It seems to me that what you would describe would work, and the > avoidance of TH is a merit, but the downside is the complexity of > implementing even relatively simple validation at the type level (as > opposed to just reusing a term-level function). For Merijn's Even > example I guess one could do something like this in current GHC: > > type family IsEven (n :: Nat) :: Bool where > IsEven 0 = True > IsEven 1 = False > IsEven n = n - 2 > > instance (KnownNat n, IsEven n ~ True) > => HasIntegerLiteral Even n where > literal = Even (natVal (Proxy :: Proxy n)) > > but anything interesting to do with strings (e.g. checking that > ByteStrings are ASCII) is rather out of reach at present. Agreed. For the idea to scale, good support for type-level programming with Integers/Strings/... is essential. Something else that would be useful is an unsatisfiable primitive constraint constructor `UnsatisfiableConstraint :: String -> Constraint` that can be used to generate custom error messages. Then one could write something like type family MustBeTrue (t :: Bool) (error :: String) :: Constraint type family MustBeTrue True _ = () type family MustBeTrue False error = UnsatisfiableConstraint error type family MustBeEven (n :: Nat) :: Constraint type family MustBeEven n = MustBeTrue (IsEven n) ("Error in Even literal :'" ++ show n ++ "' is not even!") instance (KnownNat n, MustBeEven n) => HasIntegerLiteral Even n where ... Regards, Dominique From hesselink at gmail.com Fri Feb 6 13:55:59 2015 From: hesselink at gmail.com (Erik Hesselink) Date: Fri, 6 Feb 2015 14:55:59 +0100 Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion In-Reply-To: References: <5F203379-8242-4137-AFA2-91289F2119B6@inconsistent.nl> <618BE556AADD624C9C918AA5D5911BEF562C0405@DB3PRD3001MB020.064d.mgd.msft.net> <7BFEA344-05CB-4663-A594-9C4CF25E1D04@inconsistent.nl> <54D4BF98.3020104@well-typed.com> Message-ID: On Fri, Feb 6, 2015 at 2:49 PM, Dominique Devriese wrote: > Agreed. For the idea to scale, good support for type-level > programming with Integers/Strings/... is essential. Something else > that would be useful is an unsatisfiable primitive constraint > constructor `UnsatisfiableConstraint :: String -> Constraint` that can > be used to generate custom error messages. Then one could write > something like > > type family MustBeTrue (t :: Bool) (error :: String) :: Constraint > type family MustBeTrue True _ = () > type family MustBeTrue False error = UnsatisfiableConstraint error > > type family MustBeEven (n :: Nat) :: Constraint > type family MustBeEven n = MustBeTrue (IsEven n) ("Error in Even > literal :'" ++ show n ++ "' is not even!") > > instance (KnownNat n, MustBeEven n) => HasIntegerLiteral Even n where ... Note that there is a trick to fake this with current GHC: you can write an equality constraint that is false, involving the type level string: > type family MustBeTrue False error = (() ~ error) Erik From merijn at inconsistent.nl Fri Feb 6 15:53:56 2015 From: merijn at inconsistent.nl (Merijn Verstraaten) Date: Fri, 6 Feb 2015 16:53:56 +0100 Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion In-Reply-To: References: <5F203379-8242-4137-AFA2-91289F2119B6@inconsistent.nl> <618BE556AADD624C9C918AA5D5911BEF562C0405@DB3PRD3001MB020.064d.mgd.msft.net> <7BFEA344-05CB-4663-A594-9C4CF25E1D04@inconsistent.nl> <54D4BF98.3020104@well-typed.com> Message-ID: <6C1707A8-8B1F-4F7D-B6FF-A453078AA354@inconsistent.nl> While I am certainly in favour of better and more flexible approaches to enforcing this in the type system (I'm a big fan of all the dependent Haskell/singletons stuff), I don't think this is an appropriate solution here. First off, a lot of interesting and important cases can't feasibly be solved right now (i.e., most things involving strings/lists). More importantly, I think the examples given in this thread so far are FAR beyond the capabilities of beginner/intermediate haskellers, whereas implementing a terminating "String -> Maybe a" is fairly trivial. So in terms of pragmatical usability I think the TH approach is easier to implement in GHC, easier to use by end users and more flexible and powerful than the suggested type families/DataKinds. I'm all in favour of some of the below directions, but pragmatically I think it'll be a while before any of those problems are usable by any beginners. I also realise a lot of people prefer avoiding TH if at all possible, but given that this is an extension that people have to opt into that won't otherwise affect their code, I think that's acceptable. Personally, I'd gladly use TH in exchange for this sort of checking and I've talked to several others that would to. Cheers, Merijn > On 6 Feb 2015, at 14:55, Erik Hesselink wrote: > > On Fri, Feb 6, 2015 at 2:49 PM, Dominique Devriese > wrote: >> Agreed. For the idea to scale, good support for type-level >> programming with Integers/Strings/... is essential. Something else >> that would be useful is an unsatisfiable primitive constraint >> constructor `UnsatisfiableConstraint :: String -> Constraint` that can >> be used to generate custom error messages. Then one could write >> something like >> >> type family MustBeTrue (t :: Bool) (error :: String) :: Constraint >> type family MustBeTrue True _ = () >> type family MustBeTrue False error = UnsatisfiableConstraint error >> >> type family MustBeEven (n :: Nat) :: Constraint >> type family MustBeEven n = MustBeTrue (IsEven n) ("Error in Even >> literal :'" ++ show n ++ "' is not even!") >> >> instance (KnownNat n, MustBeEven n) => HasIntegerLiteral Even n where ... > > Note that there is a trick to fake this with current GHC: you can > write an equality constraint that is false, involving the type level > string: > >> type family MustBeTrue False error = (() ~ error) > > Erik > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://www.haskell.org/mailman/listinfo/ghc-devs -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 842 bytes Desc: Message signed with OpenPGP using GPGMail URL: From ryan.trinkle at gmail.com Fri Feb 6 15:59:39 2015 From: ryan.trinkle at gmail.com (Ryan Trinkle) Date: Fri, 6 Feb 2015 10:59:39 -0500 Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion In-Reply-To: References: <5F203379-8242-4137-AFA2-91289F2119B6@inconsistent.nl> <618BE556AADD624C9C918AA5D5911BEF562C0405@DB3PRD3001MB020.064d.mgd.msft.net> <7BFEA344-05CB-4663-A594-9C4CF25E1D04@inconsistent.nl> <54D4BF98.3020104@well-typed.com> Message-ID: I think the idea of compile-time validation for overloaded literals is fantastic, and doing it with nicer syntax than quasiquoting would really improve things. However, I'm a bit confused about specifically how the requirement that it be monomorphic will play into this. For example, if I have: x = 1 Presumably this will compile, and give a run-time error if I ever instantiate its type to Even. However, if I have: x :: Even x = 1 it will fail to compile? Furthermore, if I have the former, and type inference determines that its type is Even, it sounds like that will also fail to compile, but if type inference determines that its type is forall a. Nat a => a, then it will successfully compile and then fail at runtime. Am I understanding this correctly? Ryan On Fri, Feb 6, 2015 at 8:55 AM, Erik Hesselink wrote: > On Fri, Feb 6, 2015 at 2:49 PM, Dominique Devriese > wrote: > > Agreed. For the idea to scale, good support for type-level > > programming with Integers/Strings/... is essential. Something else > > that would be useful is an unsatisfiable primitive constraint > > constructor `UnsatisfiableConstraint :: String -> Constraint` that can > > be used to generate custom error messages. Then one could write > > something like > > > > type family MustBeTrue (t :: Bool) (error :: String) :: Constraint > > type family MustBeTrue True _ = () > > type family MustBeTrue False error = UnsatisfiableConstraint error > > > > type family MustBeEven (n :: Nat) :: Constraint > > type family MustBeEven n = MustBeTrue (IsEven n) ("Error in Even > > literal :'" ++ show n ++ "' is not even!") > > > > instance (KnownNat n, MustBeEven n) => HasIntegerLiteral Even n where > ... > > Note that there is a trick to fake this with current GHC: you can > write an equality constraint that is false, involving the type level > string: > > > type family MustBeTrue False error = (() ~ error) > > Erik > _______________________________________________ > 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 merijn at inconsistent.nl Fri Feb 6 16:16:43 2015 From: merijn at inconsistent.nl (Merijn Verstraaten) Date: Fri, 6 Feb 2015 17:16:43 +0100 Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion In-Reply-To: References: <5F203379-8242-4137-AFA2-91289F2119B6@inconsistent.nl> <618BE556AADD624C9C918AA5D5911BEF562C0405@DB3PRD3001MB020.064d.mgd.msft.net> <7BFEA344-05CB-4663-A594-9C4CF25E1D04@inconsistent.nl> <54D4BF98.3020104@well-typed.com> Message-ID: <75993583-3304-4CBF-B58D-FE58A2DA6233@inconsistent.nl> Ryan, Unfortunately, yes, you are understanding that correctly. The reason I qualified it with "monomorphic only" is that, I want to avoid breakage that would render the extension practically unusable in real code. Let's say I right now have: foo :: Num a => [a] -> [a] foo = map (+1) I have two options 1) we compile this as currently using fromIntegral and it WILL break for Even or 2) we reject any polymorphic use of literals like this. Given the amount of numerical code relying on the polymorphism of Num, I think the option of not being able to compile Num polymorphic code is completely out of the question. Almost no application would work. I would advocate in favour of not requiring an IsList/IsString instance for the validation class, this would allow you to write a conversion that ONLY converts literals in a validated way and will never successfully convert literals without the extension, since with the extension disabled GHC would try to use the fromList/fromString from the IsString/IsList classes which do not exist. Unfortunately, given how deeply fromIntegral is tied to the Num class I don't see any way to achieve the same for Num. The only option would be to not make Even an instance of Num, that way the same trick as above could work. Removing fromIntegral from Num is obviously not going to happen and without doing that I don't see how we could prevent someone using fromIntegral manually to convert to Even in a way that won't break Num polymorphic functions. If you have any ideas on how to tackle this, I'm all open to hearing them! I agree with you that this is ugly, but I console myself with the thought that being able to check all monomorphic literals is already a drastic improvement over the current state. And in the case of lists and strings we could actually ensure that things work well, since almost no one writes "IsString polymorphic" code. Cheers, Merijn > On 6 Feb 2015, at 16:59, Ryan Trinkle wrote: > > I think the idea of compile-time validation for overloaded literals is fantastic, and doing it with nicer syntax than quasiquoting would really improve things. However, I'm a bit confused about specifically how the requirement that it be monomorphic will play into this. For example, if I have: > > x = 1 > > Presumably this will compile, and give a run-time error if I ever instantiate its type to Even. However, if I have: > > x :: Even > x = 1 > > it will fail to compile? Furthermore, if I have the former, and type inference determines that its type is Even, it sounds like that will also fail to compile, but if type inference determines that its type is forall a. Nat a => a, then it will successfully compile and then fail at runtime. > > Am I understanding this correctly? > > > Ryan > > On Fri, Feb 6, 2015 at 8:55 AM, Erik Hesselink wrote: > On Fri, Feb 6, 2015 at 2:49 PM, Dominique Devriese > wrote: > > Agreed. For the idea to scale, good support for type-level > > programming with Integers/Strings/... is essential. Something else > > that would be useful is an unsatisfiable primitive constraint > > constructor `UnsatisfiableConstraint :: String -> Constraint` that can > > be used to generate custom error messages. Then one could write > > something like > > > > type family MustBeTrue (t :: Bool) (error :: String) :: Constraint > > type family MustBeTrue True _ = () > > type family MustBeTrue False error = UnsatisfiableConstraint error > > > > type family MustBeEven (n :: Nat) :: Constraint > > type family MustBeEven n = MustBeTrue (IsEven n) ("Error in Even > > literal :'" ++ show n ++ "' is not even!") > > > > instance (KnownNat n, MustBeEven n) => HasIntegerLiteral Even n where ... > > Note that there is a trick to fake this with current GHC: you can > write an equality constraint that is false, involving the type level > string: > > > type family MustBeTrue False error = (() ~ error) > > Erik > _______________________________________________ > Glasgow-haskell-users mailing list > Glasgow-haskell-users at haskell.org > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 842 bytes Desc: Message signed with OpenPGP using GPGMail URL: From ryan.trinkle at gmail.com Fri Feb 6 16:38:21 2015 From: ryan.trinkle at gmail.com (Ryan Trinkle) Date: Fri, 6 Feb 2015 11:38:21 -0500 Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion In-Reply-To: <75993583-3304-4CBF-B58D-FE58A2DA6233@inconsistent.nl> References: <5F203379-8242-4137-AFA2-91289F2119B6@inconsistent.nl> <618BE556AADD624C9C918AA5D5911BEF562C0405@DB3PRD3001MB020.064d.mgd.msft.net> <7BFEA344-05CB-4663-A594-9C4CF25E1D04@inconsistent.nl> <54D4BF98.3020104@well-typed.com> <75993583-3304-4CBF-B58D-FE58A2DA6233@inconsistent.nl> Message-ID: My greatest concern here would be that, as an application is maintained, a literal might go from monomorphic to polymorphic, or vice versa, without anybody noticing. It sounds like this could result in a value silently becoming partial, which would be a big problem for application stability; in the opposite case - a partial value becoming a compile-time error - I am somewhat less concerned, but it could still be confusing and disruptive. I would prefer that there be some syntactic indication that I want my literal to be checked at compile time. This syntax could also add whatever monomorphism requirement is needed, and then it would become a compile-time error for the value to become polymorphic. I don't know nearly enough about the type system to know whether this is possible. Also, it seems to me that it might not be so clean as "monomorphic" versus "polymorphic". For example, suppose I have this: newtype PostgresTableName s = PostgresTableName String where 's' is a phantom type representing the DB schema that the name lives in. The validation function is independent of the schema - it simply fails if there are illegal characters in the name, or if the name is too long. So, ideally, ("foo\0bar" :: forall s. PostgresTableName s) would fail at compile time, despite being polymorphic. Ryan On Fri, Feb 6, 2015 at 11:16 AM, Merijn Verstraaten wrote: > Ryan, > > Unfortunately, yes, you are understanding that correctly. > > The reason I qualified it with "monomorphic only" is that, I want to avoid > breakage that would render the extension practically unusable in real code. > > Let's say I right now have: > > foo :: Num a => [a] -> [a] > foo = map (+1) > > I have two options 1) we compile this as currently using fromIntegral and > it WILL break for Even or 2) we reject any polymorphic use of literals like > this. Given the amount of numerical code relying on the polymorphism of > Num, I think the option of not being able to compile Num polymorphic code > is completely out of the question. Almost no application would work. > > I would advocate in favour of not requiring an IsList/IsString instance > for the validation class, this would allow you to write a conversion that > ONLY converts literals in a validated way and will never successfully > convert literals without the extension, since with the extension disabled > GHC would try to use the fromList/fromString from the IsString/IsList > classes which do not exist. > > Unfortunately, given how deeply fromIntegral is tied to the Num class I > don't see any way to achieve the same for Num. The only option would be to > not make Even an instance of Num, that way the same trick as above could > work. Removing fromIntegral from Num is obviously not going to happen and > without doing that I don't see how we could prevent someone using > fromIntegral manually to convert to Even in a way that won't break Num > polymorphic functions. If you have any ideas on how to tackle this, I'm all > open to hearing them! > > I agree with you that this is ugly, but I console myself with the thought > that being able to check all monomorphic literals is already a drastic > improvement over the current state. And in the case of lists and strings we > could actually ensure that things work well, since almost no one writes > "IsString polymorphic" code. > > Cheers, > Merijn > > > On 6 Feb 2015, at 16:59, Ryan Trinkle wrote: > > > > I think the idea of compile-time validation for overloaded literals is > fantastic, and doing it with nicer syntax than quasiquoting would really > improve things. However, I'm a bit confused about specifically how the > requirement that it be monomorphic will play into this. For example, if I > have: > > > > x = 1 > > > > Presumably this will compile, and give a run-time error if I ever > instantiate its type to Even. However, if I have: > > > > x :: Even > > x = 1 > > > > it will fail to compile? Furthermore, if I have the former, and type > inference determines that its type is Even, it sounds like that will also > fail to compile, but if type inference determines that its type is forall > a. Nat a => a, then it will successfully compile and then fail at runtime. > > > > Am I understanding this correctly? > > > > > > Ryan > > > > On Fri, Feb 6, 2015 at 8:55 AM, Erik Hesselink > wrote: > > On Fri, Feb 6, 2015 at 2:49 PM, Dominique Devriese > > wrote: > > > Agreed. For the idea to scale, good support for type-level > > > programming with Integers/Strings/... is essential. Something else > > > that would be useful is an unsatisfiable primitive constraint > > > constructor `UnsatisfiableConstraint :: String -> Constraint` that can > > > be used to generate custom error messages. Then one could write > > > something like > > > > > > type family MustBeTrue (t :: Bool) (error :: String) :: Constraint > > > type family MustBeTrue True _ = () > > > type family MustBeTrue False error = UnsatisfiableConstraint error > > > > > > type family MustBeEven (n :: Nat) :: Constraint > > > type family MustBeEven n = MustBeTrue (IsEven n) ("Error in Even > > > literal :'" ++ show n ++ "' is not even!") > > > > > > instance (KnownNat n, MustBeEven n) => HasIntegerLiteral Even n > where ... > > > > Note that there is a trick to fake this with current GHC: you can > > write an equality constraint that is false, involving the type level > > string: > > > > > type family MustBeTrue False error = (() ~ error) > > > > Erik > > _______________________________________________ > > 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 dan.doel at gmail.com Fri Feb 6 17:24:53 2015 From: dan.doel at gmail.com (Dan Doel) Date: Fri, 6 Feb 2015 12:24:53 -0500 Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion In-Reply-To: References: <5F203379-8242-4137-AFA2-91289F2119B6@inconsistent.nl> <618BE556AADD624C9C918AA5D5911BEF562C0405@DB3PRD3001MB020.064d.mgd.msft.net> <7BFEA344-05CB-4663-A594-9C4CF25E1D04@inconsistent.nl> <54D4BF98.3020104@well-typed.com> <75993583-3304-4CBF-B58D-FE58A2DA6233@inconsistent.nl> Message-ID: Assuming a separate syntax, I believe that the criterion would be as simple as ensuring that no ValidateFoo constraints are left outstanding. The syntax would add the relevant validate call, and type variables involved in a ValidateFoo constraint would not be generalizable, and would have to be defaulted or inferred from elsewhere, similar to the monomorphism restriction. I'm not sure how difficult that would be to implement. I'm not terribly gung ho on this, though. It feels very ad hoc. Making validation vs. non-validation syntactic rather than just based on polymorphism seems somewhat less so, though; so I'd prefer that direction. Finding unused syntax is always a problem, of course. On Fri, Feb 6, 2015 at 11:38 AM, Ryan Trinkle wrote: > My greatest concern here would be that, as an application is maintained, a > literal might go from monomorphic to polymorphic, or vice versa, without > anybody noticing. It sounds like this could result in a value silently > becoming partial, which would be a big problem for application stability; > in the opposite case - a partial value becoming a compile-time error - I am > somewhat less concerned, but it could still be confusing and disruptive. > > I would prefer that there be some syntactic indication that I want my > literal to be checked at compile time. This syntax could also add whatever > monomorphism requirement is needed, and then it would become a compile-time > error for the value to become polymorphic. I don't know nearly enough > about the type system to know whether this is possible. > > Also, it seems to me that it might not be so clean as "monomorphic" versus > "polymorphic". For example, suppose I have this: > > newtype PostgresTableName s = PostgresTableName String > > where 's' is a phantom type representing the DB schema that the name lives > in. The validation function is independent of the schema - it simply fails > if there are illegal characters in the name, or if the name is too long. > So, ideally, ("foo\0bar" :: forall s. PostgresTableName s) would fail at > compile time, despite being polymorphic. > > > Ryan > > On Fri, Feb 6, 2015 at 11:16 AM, Merijn Verstraaten < > merijn at inconsistent.nl> wrote: > >> Ryan, >> >> Unfortunately, yes, you are understanding that correctly. >> >> The reason I qualified it with "monomorphic only" is that, I want to >> avoid breakage that would render the extension practically unusable in real >> code. >> >> Let's say I right now have: >> >> foo :: Num a => [a] -> [a] >> foo = map (+1) >> >> I have two options 1) we compile this as currently using fromIntegral and >> it WILL break for Even or 2) we reject any polymorphic use of literals like >> this. Given the amount of numerical code relying on the polymorphism of >> Num, I think the option of not being able to compile Num polymorphic code >> is completely out of the question. Almost no application would work. >> >> I would advocate in favour of not requiring an IsList/IsString instance >> for the validation class, this would allow you to write a conversion that >> ONLY converts literals in a validated way and will never successfully >> convert literals without the extension, since with the extension disabled >> GHC would try to use the fromList/fromString from the IsString/IsList >> classes which do not exist. >> >> Unfortunately, given how deeply fromIntegral is tied to the Num class I >> don't see any way to achieve the same for Num. The only option would be to >> not make Even an instance of Num, that way the same trick as above could >> work. Removing fromIntegral from Num is obviously not going to happen and >> without doing that I don't see how we could prevent someone using >> fromIntegral manually to convert to Even in a way that won't break Num >> polymorphic functions. If you have any ideas on how to tackle this, I'm all >> open to hearing them! >> >> I agree with you that this is ugly, but I console myself with the thought >> that being able to check all monomorphic literals is already a drastic >> improvement over the current state. And in the case of lists and strings we >> could actually ensure that things work well, since almost no one writes >> "IsString polymorphic" code. >> >> Cheers, >> Merijn >> >> > On 6 Feb 2015, at 16:59, Ryan Trinkle wrote: >> > >> > I think the idea of compile-time validation for overloaded literals is >> fantastic, and doing it with nicer syntax than quasiquoting would really >> improve things. However, I'm a bit confused about specifically how the >> requirement that it be monomorphic will play into this. For example, if I >> have: >> > >> > x = 1 >> > >> > Presumably this will compile, and give a run-time error if I ever >> instantiate its type to Even. However, if I have: >> > >> > x :: Even >> > x = 1 >> > >> > it will fail to compile? Furthermore, if I have the former, and type >> inference determines that its type is Even, it sounds like that will also >> fail to compile, but if type inference determines that its type is forall >> a. Nat a => a, then it will successfully compile and then fail at runtime. >> > >> > Am I understanding this correctly? >> > >> > >> > Ryan >> > >> > On Fri, Feb 6, 2015 at 8:55 AM, Erik Hesselink >> wrote: >> > On Fri, Feb 6, 2015 at 2:49 PM, Dominique Devriese >> > wrote: >> > > Agreed. For the idea to scale, good support for type-level >> > > programming with Integers/Strings/... is essential. Something else >> > > that would be useful is an unsatisfiable primitive constraint >> > > constructor `UnsatisfiableConstraint :: String -> Constraint` that can >> > > be used to generate custom error messages. Then one could write >> > > something like >> > > >> > > type family MustBeTrue (t :: Bool) (error :: String) :: Constraint >> > > type family MustBeTrue True _ = () >> > > type family MustBeTrue False error = UnsatisfiableConstraint error >> > > >> > > type family MustBeEven (n :: Nat) :: Constraint >> > > type family MustBeEven n = MustBeTrue (IsEven n) ("Error in Even >> > > literal :'" ++ show n ++ "' is not even!") >> > > >> > > instance (KnownNat n, MustBeEven n) => HasIntegerLiteral Even n >> where ... >> > >> > Note that there is a trick to fake this with current GHC: you can >> > write an equality constraint that is false, involving the type level >> > string: >> > >> > > type family MustBeTrue False error = (() ~ error) >> > >> > Erik >> > _______________________________________________ >> > 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 adam at well-typed.com Fri Feb 6 20:31:38 2015 From: adam at well-typed.com (Adam Gundry) Date: Fri, 06 Feb 2015 20:31:38 +0000 Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion In-Reply-To: References: <5F203379-8242-4137-AFA2-91289F2119B6@inconsistent.nl> <618BE556AADD624C9C918AA5D5911BEF562C0405@DB3PRD3001MB020.064d.mgd.msft.net> <7BFEA344-05CB-4663-A594-9C4CF25E1D04@inconsistent.nl> <54D4BF98.3020104@well-typed.com> <75993583-3304-4CBF-B58D-FE58A2DA6233@inconsistent.nl> Message-ID: <54D524AA.5070608@well-typed.com> If we go for a separate syntax, what do we gain over normal quasiquotes or $$(validate x)? Sure, literals could be made a little more beautiful, but I'm not sure it justifies stealing more syntax (and what would that syntax be?). Without a separate syntax, I'm not sure I understand the original proposal. The wiki page says "GHC would replace fromString/fromInteger/fromList expressions originating from literals with a Typed TH splice along the lines of validate for all monomorphic cases." What does "all monomorphic cases" mean? Is the idea what GHC would typecheck an expression involving a literal integer, determine that the occurrence had type Even, then evaluate the TH splice *after* typechecking? Whereas if the occurrence had a non-ground type, it would do something else? None of this is particularly persuasive, I'm afraid. Is it worthwhile introducing something new just to avoid having to write a quasiquote? I *am* attracted to the idea of indexed classes in place of IsString/Num class KnownSymbol s => IsIndexedString (a :: *) (s :: Symbol) where fromIndexedString :: a class KnownInteger i => IsIndexedInteger (a :: *) (i :: Integer) where fromIndexedInteger :: a These have a smooth upgrade path from the existing class instances via default fromIndexedString :: (KnownSymbol s, IsString a) => a fromIndexedString = fromString (symbolVal (Proxy :: Proxy s)) default fromIndexedInteger :: (KnownInteger i, Num a) => a fromIndexedInteger = fromInteger (integerVal (Proxy :: Proxy i)) and other instances can take advantage of the additional type information. perhaps we need to bring Dependent Haskell a bit closer before this is justifiable... Adam On 06/02/15 17:24, Dan Doel wrote: > Assuming a separate syntax, I believe that the criterion would be as > simple as ensuring that no ValidateFoo constraints are left outstanding. > The syntax would add the relevant validate call, and type variables > involved in a ValidateFoo constraint would not be generalizable, and > would have to be defaulted or inferred from elsewhere, similar to the > monomorphism restriction. I'm not sure how difficult that would be to > implement. > > I'm not terribly gung ho on this, though. It feels very ad hoc. Making > validation vs. non-validation syntactic rather than just based on > polymorphism seems somewhat less so, though; so I'd prefer that > direction. Finding unused syntax is always a problem, of course. -- Adam Gundry, Haskell Consultant Well-Typed LLP, http://www.well-typed.com/ From qdunkan at gmail.com Fri Feb 6 20:50:10 2015 From: qdunkan at gmail.com (Evan Laforge) Date: Fri, 6 Feb 2015 12:50:10 -0800 Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion In-Reply-To: References: <5F203379-8242-4137-AFA2-91289F2119B6@inconsistent.nl> <618BE556AADD624C9C918AA5D5911BEF562C0405@DB3PRD3001MB020.064d.mgd.msft.net> <7BFEA344-05CB-4663-A594-9C4CF25E1D04@inconsistent.nl> <54D4BF98.3020104@well-typed.com> <75993583-3304-4CBF-B58D-FE58A2DA6233@inconsistent.nl> Message-ID: Would it be feasible to make a lighter-weight mode for quasiquotes that doesn't require the whole "load the module in ghci" runaround? If it didn't need to do that, there wouldn't be much downside to turning it on everywhere. And it would enable lots of QQ conveniences that at least I don't think its worth enabling TH for, due to the ghci hassle. Greg Weber recently asked for input on the idea of restricted TH modes, this seems related. If a splice was pure and had no non-Prelude dependencies, could it be run without ghci loading and stage restrictions? I think it's really awkward how numeric literals use fromInteger and fromRational, and those functions are grouped into Num and Fractional. So if you want to use (+), you also have to accept literals, which means you have to accept anything anyone might type. Has there been any kind of proposal to split fromInteger and fromRational into their own typeclasses analogous to IsString? On Fri, Feb 6, 2015 at 9:24 AM, Dan Doel wrote: > Assuming a separate syntax, I believe that the criterion would be as simple > as ensuring that no ValidateFoo constraints are left outstanding. The syntax > would add the relevant validate call, and type variables involved in a > ValidateFoo constraint would not be generalizable, and would have to be > defaulted or inferred from elsewhere, similar to the monomorphism > restriction. I'm not sure how difficult that would be to implement. > > I'm not terribly gung ho on this, though. It feels very ad hoc. Making > validation vs. non-validation syntactic rather than just based on > polymorphism seems somewhat less so, though; so I'd prefer that direction. > Finding unused syntax is always a problem, of course. > > On Fri, Feb 6, 2015 at 11:38 AM, Ryan Trinkle > wrote: >> >> My greatest concern here would be that, as an application is maintained, a >> literal might go from monomorphic to polymorphic, or vice versa, without >> anybody noticing. It sounds like this could result in a value silently >> becoming partial, which would be a big problem for application stability; in >> the opposite case - a partial value becoming a compile-time error - I am >> somewhat less concerned, but it could still be confusing and disruptive. >> >> I would prefer that there be some syntactic indication that I want my >> literal to be checked at compile time. This syntax could also add whatever >> monomorphism requirement is needed, and then it would become a compile-time >> error for the value to become polymorphic. I don't know nearly enough about >> the type system to know whether this is possible. >> >> Also, it seems to me that it might not be so clean as "monomorphic" versus >> "polymorphic". For example, suppose I have this: >> >> newtype PostgresTableName s = PostgresTableName String >> >> where 's' is a phantom type representing the DB schema that the name lives >> in. The validation function is independent of the schema - it simply fails >> if there are illegal characters in the name, or if the name is too long. >> So, ideally, ("foo\0bar" :: forall s. PostgresTableName s) would fail at >> compile time, despite being polymorphic. >> >> >> Ryan >> >> On Fri, Feb 6, 2015 at 11:16 AM, Merijn Verstraaten >> wrote: >>> >>> Ryan, >>> >>> Unfortunately, yes, you are understanding that correctly. >>> >>> The reason I qualified it with "monomorphic only" is that, I want to >>> avoid breakage that would render the extension practically unusable in real >>> code. >>> >>> Let's say I right now have: >>> >>> foo :: Num a => [a] -> [a] >>> foo = map (+1) >>> >>> I have two options 1) we compile this as currently using fromIntegral and >>> it WILL break for Even or 2) we reject any polymorphic use of literals like >>> this. Given the amount of numerical code relying on the polymorphism of Num, >>> I think the option of not being able to compile Num polymorphic code is >>> completely out of the question. Almost no application would work. >>> >>> I would advocate in favour of not requiring an IsList/IsString instance >>> for the validation class, this would allow you to write a conversion that >>> ONLY converts literals in a validated way and will never successfully >>> convert literals without the extension, since with the extension disabled >>> GHC would try to use the fromList/fromString from the IsString/IsList >>> classes which do not exist. >>> >>> Unfortunately, given how deeply fromIntegral is tied to the Num class I >>> don't see any way to achieve the same for Num. The only option would be to >>> not make Even an instance of Num, that way the same trick as above could >>> work. Removing fromIntegral from Num is obviously not going to happen and >>> without doing that I don't see how we could prevent someone using >>> fromIntegral manually to convert to Even in a way that won't break Num >>> polymorphic functions. If you have any ideas on how to tackle this, I'm all >>> open to hearing them! >>> >>> I agree with you that this is ugly, but I console myself with the thought >>> that being able to check all monomorphic literals is already a drastic >>> improvement over the current state. And in the case of lists and strings we >>> could actually ensure that things work well, since almost no one writes >>> "IsString polymorphic" code. >>> >>> Cheers, >>> Merijn >>> >>> > On 6 Feb 2015, at 16:59, Ryan Trinkle wrote: >>> > >>> > I think the idea of compile-time validation for overloaded literals is >>> > fantastic, and doing it with nicer syntax than quasiquoting would really >>> > improve things. However, I'm a bit confused about specifically how the >>> > requirement that it be monomorphic will play into this. For example, if I >>> > have: >>> > >>> > x = 1 >>> > >>> > Presumably this will compile, and give a run-time error if I ever >>> > instantiate its type to Even. However, if I have: >>> > >>> > x :: Even >>> > x = 1 >>> > >>> > it will fail to compile? Furthermore, if I have the former, and type >>> > inference determines that its type is Even, it sounds like that will also >>> > fail to compile, but if type inference determines that its type is forall a. >>> > Nat a => a, then it will successfully compile and then fail at runtime. >>> > >>> > Am I understanding this correctly? >>> > >>> > >>> > Ryan >>> > >>> > On Fri, Feb 6, 2015 at 8:55 AM, Erik Hesselink >>> > wrote: >>> > On Fri, Feb 6, 2015 at 2:49 PM, Dominique Devriese >>> > wrote: >>> > > Agreed. For the idea to scale, good support for type-level >>> > > programming with Integers/Strings/... is essential. Something else >>> > > that would be useful is an unsatisfiable primitive constraint >>> > > constructor `UnsatisfiableConstraint :: String -> Constraint` that >>> > > can >>> > > be used to generate custom error messages. Then one could write >>> > > something like >>> > > >>> > > type family MustBeTrue (t :: Bool) (error :: String) :: Constraint >>> > > type family MustBeTrue True _ = () >>> > > type family MustBeTrue False error = UnsatisfiableConstraint error >>> > > >>> > > type family MustBeEven (n :: Nat) :: Constraint >>> > > type family MustBeEven n = MustBeTrue (IsEven n) ("Error in Even >>> > > literal :'" ++ show n ++ "' is not even!") >>> > > >>> > > instance (KnownNat n, MustBeEven n) => HasIntegerLiteral Even n >>> > > where ... >>> > >>> > Note that there is a trick to fake this with current GHC: you can >>> > write an equality constraint that is false, involving the type level >>> > string: >>> > >>> > > type family MustBeTrue False error = (() ~ error) >>> > >>> > Erik >>> > _______________________________________________ >>> > 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 Fri Feb 6 22:16:33 2015 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Fri, 6 Feb 2015 17:16:33 -0500 Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion In-Reply-To: References: <5F203379-8242-4137-AFA2-91289F2119B6@inconsistent.nl> <618BE556AADD624C9C918AA5D5911BEF562C0405@DB3PRD3001MB020.064d.mgd.msft.net> <7BFEA344-05CB-4663-A594-9C4CF25E1D04@inconsistent.nl> <54D4BF98.3020104@well-typed.com> <75993583-3304-4CBF-B58D-FE58A2DA6233@inconsistent.nl> Message-ID: Its worth pointing out that when / if luites out of process TH design happens for ghc, TH will be usable in cross compile builds of ghc as well. So we shouldn't let that constraint we have for now dictate future tooling ideas. On Feb 6, 2015 3:50 PM, "Evan Laforge" wrote: > Would it be feasible to make a lighter-weight mode for quasiquotes > that doesn't require the whole "load the module in ghci" runaround? > If it didn't need to do that, there wouldn't be much downside to > turning it on everywhere. And it would enable lots of QQ conveniences > that at least I don't think its worth enabling TH for, due to the ghci > hassle. > > Greg Weber recently asked for input on the idea of restricted TH > modes, this seems related. > > If a splice was pure and had no non-Prelude dependencies, could it be > run without ghci loading and stage restrictions? > > I think it's really awkward how numeric literals use fromInteger and > fromRational, and those functions are grouped into Num and Fractional. > So if you want to use (+), you also have to accept literals, which > means you have to accept anything anyone might type. Has there been > any kind of proposal to split fromInteger and fromRational into their > own typeclasses analogous to IsString? > > On Fri, Feb 6, 2015 at 9:24 AM, Dan Doel wrote: > > Assuming a separate syntax, I believe that the criterion would be as > simple > > as ensuring that no ValidateFoo constraints are left outstanding. The > syntax > > would add the relevant validate call, and type variables involved in a > > ValidateFoo constraint would not be generalizable, and would have to be > > defaulted or inferred from elsewhere, similar to the monomorphism > > restriction. I'm not sure how difficult that would be to implement. > > > > I'm not terribly gung ho on this, though. It feels very ad hoc. Making > > validation vs. non-validation syntactic rather than just based on > > polymorphism seems somewhat less so, though; so I'd prefer that > direction. > > Finding unused syntax is always a problem, of course. > > > > On Fri, Feb 6, 2015 at 11:38 AM, Ryan Trinkle > > wrote: > >> > >> My greatest concern here would be that, as an application is > maintained, a > >> literal might go from monomorphic to polymorphic, or vice versa, without > >> anybody noticing. It sounds like this could result in a value silently > >> becoming partial, which would be a big problem for application > stability; in > >> the opposite case - a partial value becoming a compile-time error - I am > >> somewhat less concerned, but it could still be confusing and disruptive. > >> > >> I would prefer that there be some syntactic indication that I want my > >> literal to be checked at compile time. This syntax could also add > whatever > >> monomorphism requirement is needed, and then it would become a > compile-time > >> error for the value to become polymorphic. I don't know nearly enough > about > >> the type system to know whether this is possible. > >> > >> Also, it seems to me that it might not be so clean as "monomorphic" > versus > >> "polymorphic". For example, suppose I have this: > >> > >> newtype PostgresTableName s = PostgresTableName String > >> > >> where 's' is a phantom type representing the DB schema that the name > lives > >> in. The validation function is independent of the schema - it simply > fails > >> if there are illegal characters in the name, or if the name is too long. > >> So, ideally, ("foo\0bar" :: forall s. PostgresTableName s) would fail at > >> compile time, despite being polymorphic. > >> > >> > >> Ryan > >> > >> On Fri, Feb 6, 2015 at 11:16 AM, Merijn Verstraaten > >> wrote: > >>> > >>> Ryan, > >>> > >>> Unfortunately, yes, you are understanding that correctly. > >>> > >>> The reason I qualified it with "monomorphic only" is that, I want to > >>> avoid breakage that would render the extension practically unusable in > real > >>> code. > >>> > >>> Let's say I right now have: > >>> > >>> foo :: Num a => [a] -> [a] > >>> foo = map (+1) > >>> > >>> I have two options 1) we compile this as currently using fromIntegral > and > >>> it WILL break for Even or 2) we reject any polymorphic use of literals > like > >>> this. Given the amount of numerical code relying on the polymorphism > of Num, > >>> I think the option of not being able to compile Num polymorphic code is > >>> completely out of the question. Almost no application would work. > >>> > >>> I would advocate in favour of not requiring an IsList/IsString instance > >>> for the validation class, this would allow you to write a conversion > that > >>> ONLY converts literals in a validated way and will never successfully > >>> convert literals without the extension, since with the extension > disabled > >>> GHC would try to use the fromList/fromString from the IsString/IsList > >>> classes which do not exist. > >>> > >>> Unfortunately, given how deeply fromIntegral is tied to the Num class I > >>> don't see any way to achieve the same for Num. The only option would > be to > >>> not make Even an instance of Num, that way the same trick as above > could > >>> work. Removing fromIntegral from Num is obviously not going to happen > and > >>> without doing that I don't see how we could prevent someone using > >>> fromIntegral manually to convert to Even in a way that won't break Num > >>> polymorphic functions. If you have any ideas on how to tackle this, > I'm all > >>> open to hearing them! > >>> > >>> I agree with you that this is ugly, but I console myself with the > thought > >>> that being able to check all monomorphic literals is already a drastic > >>> improvement over the current state. And in the case of lists and > strings we > >>> could actually ensure that things work well, since almost no one writes > >>> "IsString polymorphic" code. > >>> > >>> Cheers, > >>> Merijn > >>> > >>> > On 6 Feb 2015, at 16:59, Ryan Trinkle > wrote: > >>> > > >>> > I think the idea of compile-time validation for overloaded literals > is > >>> > fantastic, and doing it with nicer syntax than quasiquoting would > really > >>> > improve things. However, I'm a bit confused about specifically how > the > >>> > requirement that it be monomorphic will play into this. For > example, if I > >>> > have: > >>> > > >>> > x = 1 > >>> > > >>> > Presumably this will compile, and give a run-time error if I ever > >>> > instantiate its type to Even. However, if I have: > >>> > > >>> > x :: Even > >>> > x = 1 > >>> > > >>> > it will fail to compile? Furthermore, if I have the former, and type > >>> > inference determines that its type is Even, it sounds like that will > also > >>> > fail to compile, but if type inference determines that its type is > forall a. > >>> > Nat a => a, then it will successfully compile and then fail at > runtime. > >>> > > >>> > Am I understanding this correctly? > >>> > > >>> > > >>> > Ryan > >>> > > >>> > On Fri, Feb 6, 2015 at 8:55 AM, Erik Hesselink > >>> > wrote: > >>> > On Fri, Feb 6, 2015 at 2:49 PM, Dominique Devriese > >>> > wrote: > >>> > > Agreed. For the idea to scale, good support for type-level > >>> > > programming with Integers/Strings/... is essential. Something else > >>> > > that would be useful is an unsatisfiable primitive constraint > >>> > > constructor `UnsatisfiableConstraint :: String -> Constraint` that > >>> > > can > >>> > > be used to generate custom error messages. Then one could write > >>> > > something like > >>> > > > >>> > > type family MustBeTrue (t :: Bool) (error :: String) :: > Constraint > >>> > > type family MustBeTrue True _ = () > >>> > > type family MustBeTrue False error = UnsatisfiableConstraint > error > >>> > > > >>> > > type family MustBeEven (n :: Nat) :: Constraint > >>> > > type family MustBeEven n = MustBeTrue (IsEven n) ("Error in Even > >>> > > literal :'" ++ show n ++ "' is not even!") > >>> > > > >>> > > instance (KnownNat n, MustBeEven n) => HasIntegerLiteral Even n > >>> > > where ... > >>> > > >>> > Note that there is a trick to fake this with current GHC: you can > >>> > write an equality constraint that is false, involving the type level > >>> > string: > >>> > > >>> > > type family MustBeTrue False error = (() ~ error) > >>> > > >>> > Erik > >>> > _______________________________________________ > >>> > 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 > > > _______________________________________________ > 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 Sat Feb 7 15:10:23 2015 From: george.colpitts at gmail.com (George Colpitts) Date: Sat, 7 Feb 2015 11:10:23 -0400 Subject: ANNOUNCE: GHC 7.10.1 Release Candidate 2 In-Reply-To: References: <87h9v4vhcp.fsf@gnu.org> Message-ID: Thanks Eric, I have the same problem with this as the RC2 I build from source, i.e. Mac specific bug https://ghc.haskell.org/trac/ghc/ticket/10053 : error in ghci calling main after loading compiled code -- Too late for parseStaticFlags: call it before runGhc or runGhcT I have a file mainbug.hs that consists of main = print "hello" I can reproduce it as follows: ghc -dynamic mainbug.hs [1 of 1] Compiling Main ( mainbug.hs, mainbug.o ) Linking mainbug ... bash-3.2$ ghci GHCi, version 7.10.0.20150123: http://www.haskell.org/ghc/ :? for help Prelude> :load mainbug Ok, modules loaded: Main. Prelude Main> :show modules Main ( mainbug.hs, mainbug.o ) Prelude Main> main Too late for parseStaticFlags: call it before runGhc or runGhcT *** Exception: ExitFailure 1 Loading it interpreted works fine: rm mainbug.o bash-3.2$ ghci GHCi, version 7.10.0.20150123: http://www.haskell.org/ghc/ :? for help Prelude> :load mainbug [1 of 1] Compiling Main ( mainbug.hs, interpreted ) Ok, modules loaded: Main. *Main> main "hello" Can anybody else reproduce this bug on their Mac? On Mon, Feb 2, 2015 at 6:58 AM, Erik Hesselink wrote: > On Mon, Feb 2, 2015 at 9:37 AM, Herbert Valerio Riedel > wrote: > > Hi Mark, > > > > On 2015-01-28 at 04:31:29 +0100, Mark Lentczner wrote: > >> I've just built a bindist under 10.10, but just normal not expressly > llvm. > >> I'll test this in a bit then post it -- but might be sometime tomorrow > >> before it is up. > > > > How's progress on this btw? Are you also working on a GHC 7.8.4 OSX > > bindist by any chance? > > I made a bindist of RC2 (just like I did for RC1) which is here [1]. > This was built on 10.9, without anything special for llvm. If anyone > wants me to try something or produce a different build, please let me > know. > > Erik > > [1] > https://docs.google.com/a/silk.co/uc?id=0B5E6EvOcuE0nVmJ3WElQZW81b1U&export=download > _______________________________________________ > 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 merijn at inconsistent.nl Mon Feb 9 09:47:56 2015 From: merijn at inconsistent.nl (Merijn Verstraaten) Date: Mon, 9 Feb 2015 10:47:56 +0100 Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion In-Reply-To: <54D524AA.5070608@well-typed.com> References: <5F203379-8242-4137-AFA2-91289F2119B6@inconsistent.nl> <618BE556AADD624C9C918AA5D5911BEF562C0405@DB3PRD3001MB020.064d.mgd.msft.net> <7BFEA344-05CB-4663-A594-9C4CF25E1D04@inconsistent.nl> <54D4BF98.3020104@well-typed.com> <75993583-3304-4CBF-B58D-FE58A2DA6233@inconsistent.nl> <54D524AA.5070608@well-typed.com> Message-ID: Hi Adam, > On 6 Feb 2015, at 21:31, Adam Gundry wrote: > What does "all monomorphic cases" mean? Is the idea what GHC > would typecheck an expression involving a literal integer, determine > that the occurrence had type Even, then evaluate the TH splice *after* > typechecking? Whereas if the occurrence had a non-ground type, it would > do something else? Yes, Typed TH already runs *after* type checking, which is what allows you to do validation based on the resulting type. The main reason why I was only proposing to do this for monomorphic values is, because, how could you possible validate a polymorphic literal? Which validation function would you use? You could ban polymorphic literals, but that'd involve eliminating most uses of polymorphic Num functions (as I mentioned as another email), which would break so much code it would render the extension unusable in "real" code. I'm open to better ideas on how to tackle this, the main reason I started this discussion is because I don't really like this "polymorphic literals fail at compile time" thing either. I just don't see how to solve it without going all dependent types on the problem. > None of this is particularly persuasive, I'm afraid. Is it worthwhile > introducing something new just to avoid having to write a quasi quote? Actually, I would be mildly ok with quasi quoters, BUT there currently is no Typed TH quasi quoter (as mentioned on the wiki page), additionally, such a quoter does not have access to Lift instances for all but a handful of datatypes until we have a more comprehensive way to generate Lift instances. I think both of these points are also highly relevant for this dicussion. > I *am* attracted to the idea of indexed classes in place of IsString/Num > > class KnownSymbol s => IsIndexedString (a :: *) (s :: Symbol) where > fromIndexedString :: a > > class KnownInteger i => IsIndexedInteger (a :: *) (i :: Integer) where > fromIndexedInteger :: a > These have a smooth upgrade path from the existing class instances via > > default fromIndexedString :: (KnownSymbol s, IsString a) => a > fromIndexedString = fromString (symbolVal (Proxy :: Proxy s)) > > default fromIndexedInteger :: (KnownInteger i, Num a) => a > fromIndexedInteger = fromInteger (integerVal (Proxy :: Proxy i)) > > and other instances can take advantage of the additional type > information. perhaps we need to bring Dependent Haskell a bit closer > before this is justifiable... The main reason I don't like the "dependent haskell" approach or your approach is how much boiler plate it introduces for beginners. ANYONE knows how to write a "String -> Maybe a" function, I barely know how to use your example and I'm very comfortable with the type families/datakinds stuff, how would "ordinary haskellers" use that? Not to mention, how would I use your "IsIndexedString" in real code? It seems you'd need at least a FunDep + cumbersome annotation? Not to mention that it still performs the conversion at runtime (I would *much* rather have a Lift based approach that just splices finished conversions into the resulting program. Cheers, Merijn -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 842 bytes Desc: Message signed with OpenPGP using GPGMail URL: From jan.stolarek at p.lodz.pl Mon Feb 9 15:58:04 2015 From: jan.stolarek at p.lodz.pl (Jan Stolarek) Date: Mon, 9 Feb 2015 16:58:04 +0100 Subject: Injective type families for GHC Message-ID: <201502091658.04383.jan.stolarek@p.lodz.pl> Haskellers, I am finishing work on adding injective type families to GHC. I know that in the past many people have asked for this feature. If you have use cases for injective type families I would appreciate if you could show them to me. My implementation has some restrictions and I want to see how severe these restrictions are from a practical point of view. Janek --- Politechnika ??dzka Tre?? tej wiadomo?ci zawiera informacje przeznaczone tylko dla adresata. Je?eli nie jeste?cie Pa?stwo jej adresatem, b?d? otrzymali?cie j? przez pomy?k? prosimy o powiadomienie o tym nadawcy oraz trwa?e jej usuni?cie. From adam at well-typed.com Mon Feb 9 16:44:49 2015 From: adam at well-typed.com (Adam Gundry) Date: Mon, 09 Feb 2015 16:44:49 +0000 Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion In-Reply-To: References: <5F203379-8242-4137-AFA2-91289F2119B6@inconsistent.nl> <618BE556AADD624C9C918AA5D5911BEF562C0405@DB3PRD3001MB020.064d.mgd.msft.net> <7BFEA344-05CB-4663-A594-9C4CF25E1D04@inconsistent.nl> <54D4BF98.3020104@well-typed.com> <75993583-3304-4CBF-B58D-FE58A2DA6233@inconsistent.nl> <54D524AA.5070608@well-typed.com> Message-ID: <54D8E401.3060606@well-typed.com> Hi Merijn, Thanks for persevering with explaining things to me. :-) On 09/02/15 09:47, Merijn Verstraaten wrote: >> On 6 Feb 2015, at 21:31, Adam Gundry wrote: >> What does "all monomorphic cases" mean? Is the idea what GHC would >> typecheck an expression involving a literal integer, determine that >> the occurrence had type Even, then evaluate the TH splice *after* >> typechecking? Whereas if the occurrence had a non-ground type, it >> would do something else? > > Yes, Typed TH already runs *after* type checking, which is what > allows you to do validation based on the resulting type. The main > reason why I was only proposing to do this for monomorphic values is, > because, how could you possible validate a polymorphic literal? Which > validation function would you use? > > You could ban polymorphic literals, but that'd involve eliminating > most uses of polymorphic Num functions (as I mentioned as another > email), which would break so much code it would render the extension > unusable in "real" code. I'm open to better ideas on how to tackle > this, the main reason I started this discussion is because I don't > really like this "polymorphic literals fail at compile time" thing > either. I just don't see how to solve it without going all dependent > types on the problem. In the absence of a coherent story for polymorphism, I think the right thing to do is to be able to specify a particular validator, rather than try to have type inference determine a monomorphic type and otherwise get stuck... >> None of this is particularly persuasive, I'm afraid. Is it >> worthwhile introducing something new just to avoid having to write >> a quasi quote? > > Actually, I would be mildly ok with quasi quoters, BUT there > currently is no Typed TH quasi quoter (as mentioned on the wiki > page), additionally, such a quoter does not have access to Lift > instances for all but a handful of datatypes until we have a more > comprehensive way to generate Lift instances. I think both of these > points are also highly relevant for this dicussion. ...so is the right solution to introduce Typed TH quasiquoters for expressions? Sorry, I presumed such a thing existed, as Typed TH is rather regrettably underdocumented. Is there any particular difficulty with them, or is it just a Small Matter of Programming? I think the lack of Lift instances is a separate problem; while it looks like 7.10 will be better in this respect and dataToExpQ goes a fair way, I agree that making them easier to generate would be nice. Perhaps a generics-based default method combined with DeriveAnyClass would make "deriving Lift" possible? Adam -- Adam Gundry, Haskell Consultant Well-Typed LLP, http://www.well-typed.com/ From petersen at fedoraproject.org Mon Feb 9 21:49:15 2015 From: petersen at fedoraproject.org (Jens Petersen) Date: Mon, 9 Feb 2015 22:49:15 +0100 Subject: ANNOUNCE: GHC 7.10.1 Release Candidate 2 In-Reply-To: References: Message-ID: On 27 January 2015 at 01:13, Austin Seipp wrote: > We are pleased to announce the second release candidate for GHC 7.10.1: > Thanks, I updated my Fedora ghc-7.10 Copr repo to RC2: https://copr.fedoraproject.org/coprs/petersen/ghc-7.10/ (The build is currently only for Rawhide but I think it should work on Fedora 21 too.) Jens -------------- next part -------------- An HTML attachment was scrubbed... URL: From vogt.adam at gmail.com Tue Feb 10 00:29:21 2015 From: vogt.adam at gmail.com (adam vogt) Date: Mon, 9 Feb 2015 19:29:21 -0500 Subject: [Haskell-cafe] Injective type families for GHC In-Reply-To: <201502091658.04383.jan.stolarek@p.lodz.pl> References: <201502091658.04383.jan.stolarek@p.lodz.pl> Message-ID: Hi Jan, One example is https://github.com/haskell/vector/issues/34 I see lots of potential uses in HList. For example in HZip.hs there's a Zip using type families: type family HZipR (x::[*]) (y::[*]) :: [*] type instance HZipR '[] '[] = '[] type instance HZipR (x ': xs) (y ': ys) = (x,y) ': HZipR xs ys If there was no need to write some additional type families that tell ghc how to find x and y given HZipR x y, then the version using TFs might be as good as the version using FDs (defined in HList.hs) I don't know how realistic this is but a constraint (HLength x ~ HLength y) would ideally have the same result as SameLength x y. Copy-paste into ghci: :set +t -XDataKinds -XFlexibleContexts -XTypeFamilies import Data.HList let desired = Proxy :: SameLength x '[(),()] => Proxy x let current = Proxy :: (HLength y ~ HLength '[(),()]) => Proxy y Prints desired :: Proxy '[y, y1] current :: HLength y ~ 'HSucc ('HSucc 'HZero) => Proxy y Regards, Adam On Mon, Feb 9, 2015 at 10:58 AM, Jan Stolarek wrote: > Haskellers, > > I am finishing work on adding injective type families to GHC. I know that in the past many people > have asked for this feature. If you have use cases for injective type families I would appreciate > if you could show them to me. My implementation has some restrictions and I want to see how > severe these restrictions are from a practical point of view. > > Janek > > --- > Politechnika ??dzka > > Tre?? tej wiadomo?ci zawiera informacje przeznaczone tylko dla adresata. > Je?eli nie jeste?cie Pa?stwo jej adresatem, b?d? otrzymali?cie j? przez pomy?k? > prosimy o powiadomienie o tym nadawcy oraz trwa?e jej usuni?cie. > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe From merijn at inconsistent.nl Tue Feb 10 08:41:22 2015 From: merijn at inconsistent.nl (Merijn Verstraaten) Date: Tue, 10 Feb 2015 09:41:22 +0100 Subject: Proposal: ValidateMonoLiterals - Initial bikeshed discussion In-Reply-To: <54D8E401.3060606@well-typed.com> References: <5F203379-8242-4137-AFA2-91289F2119B6@inconsistent.nl> <618BE556AADD624C9C918AA5D5911BEF562C0405@DB3PRD3001MB020.064d.mgd.msft.net> <7BFEA344-05CB-4663-A594-9C4CF25E1D04@inconsistent.nl> <54D4BF98.3020104@well-typed.com> <75993583-3304-4CBF-B58D-FE58A2DA6233@inconsistent.nl> <54D524AA.5070608@well-typed.com> <54D8E401.3060606@well-typed.com> Message-ID: <44E08944-D81C-4196-B919-5ED217AA18FB@inconsistent.nl> Hi Adam, > On 9 Feb 2015, at 17:44, Adam Gundry wrote: > In the absence of a coherent story for polymorphism, I think the right > thing to do is to be able to specify a particular validator, rather than > try to have type inference determine a monomorphic type and otherwise > get stuck... I was planning to write a TH library for this sort of thing anyway, I was just curious if people had better solutions for the polymorphic story/solutions to take away this annoyance. But maybe a better solution in this direction is Gershom's solution to allow proper compile time functions. > ...so is the right solution to introduce Typed TH quasiquoters for > expressions? Sorry, I presumed such a thing existed, as Typed TH is > rather regrettably underdocumented. Is there any particular difficulty > with them, or is it just a Small Matter of Programming? I don't actually know the answer to this, it was one of the questions I was hoping to answer in this discussion :) > I think the lack of Lift instances is a separate problem; while it looks > like 7.10 will be better in this respect and dataToExpQ goes a fair way, > I agree that making them easier to generate would be nice. Perhaps a > generics-based default method combined with DeriveAnyClass would make > "deriving Lift" possible? It's not directly related to whatever solution we pick, but I do think it's an important issue. There's currently a TH library for deriving them, but from what I've seen about writing them by hand I don't understand how GHC couldn't trivially generate them for most (all?) ADTs. Cheers, Merijn -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 842 bytes Desc: Message signed with OpenPGP using GPGMail URL: From jan.stolarek at p.lodz.pl Tue Feb 10 11:38:10 2015 From: jan.stolarek at p.lodz.pl (Jan Stolarek) Date: Tue, 10 Feb 2015 12:38:10 +0100 Subject: [Haskell-cafe] Injective type families for GHC In-Reply-To: References: <201502091658.04383.jan.stolarek@p.lodz.pl> Message-ID: <201502101238.10719.jan.stolarek@p.lodz.pl> Thank you Adam. > One example is https://github.com/haskell/vector/issues/34 Yes, this looks like an example where injectivity will work. One question here: how does one build vector with GHC HEAD? I tried but failed because of dependencies. > I see lots of potential uses in HList. For example in HZip.hs there's > a Zip using type families: > > type family HZipR (x::[*]) (y::[*]) :: [*] > type instance HZipR '[] '[] = '[] > type instance HZipR (x ': xs) (y ': ys) = (x,y) ': HZipR xs ys Bad news: my current implementation won't allow to declare HZipR as injective. That's because my implementation is conservative and does not permit calling type families by injective type family. > I don't know how realistic this is but a constraint (HLength x ~ > HLength y) would ideally have the same result as SameLength x y. I'm not sure if I understand that part. HLength is not injective. How would injectivity help here? Janek --- Politechnika ??dzka Lodz University of Technology Tre?? tej wiadomo?ci zawiera informacje przeznaczone tylko dla adresata. Je?eli nie jeste?cie Pa?stwo jej adresatem, b?d? otrzymali?cie j? przez pomy?k? prosimy o powiadomienie o tym nadawcy oraz trwa?e jej usuni?cie. This email contains information intended solely for the use of the individual to whom it is addressed. If you are not the intended recipient or if you have received this message in error, please notify the sender and delete it from your system. From simonpj at microsoft.com Tue Feb 10 15:50:02 2015 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Tue, 10 Feb 2015 15:50:02 +0000 Subject: GHC 7.10 Prelude: we need your opinion Message-ID: <618BE556AADD624C9C918AA5D5911BEF562C4A1C@DB3PRD3001MB020.064d.mgd.msft.net> Haskell Friends This email asks for your help in deciding how to proceed with some Prelude changes in GHC 7.10. Please read on, but all the info is also at the survey link, here: http://goo.gl/forms/XP1W2JdfpX. Deadline is 21 Feb. The ?Core Libraries Committee (CLC) is responsible for developing the core libraries that ship with GHC. This is an important but painstaking task, and we owe the CLC a big vote of thanks for taking it on. For over a year the CLC has been working on integrating the Foldable and Traversable classes (shipped in base in GHC 7.8) into the core libraries, and into the Prelude in particular. Detailed planning for GHC 7.10 started in the autumn of 2014, and the CLC went ahead with this integration. Then we had a failure of communication. As these changes affect the Prelude, which is in scope for all users of Haskell, these changes should be held to a higher bar than the regular libraries@ review process. However, the Foldable/Traversable changes were not particularly well signposted. Many people have only recently woken up to them, and some have objected (both in principle and detail). This is an extremely unfortunate situation. On the one hand we are at RC2 for GHC 7.10, so library authors have invested effort in updating their libraries to the new Prelude. On the other, altering the Prelude is in effect altering the language, something we take pretty seriously. We should have had this debate back in 2014, but here we are, and it is unproductive to argue about whose fault it is. We all share responsibility. We need to decide what to do now. A small group of us met by Skype and we've decided to do this: ? Push back GHC 7.10's release by at least a month, to late March. This delay also gives us breathing space to address an unrelated show-stopping bug, Trac #9858. ? Invite input from the Haskell community on which of two approaches to adopt (this survey). The main questions revolve around impact on the Haskell ecosystem (commercial applications, teaching, libraries, etc etc), so we want to ask your opinion rather than guess it. ? Ask Simon Marlow and Simon Peyton Jones to decide which approach to follow for GHC 7.10. Wiki pages have been created summarizing these two primary alternatives, including many more points and counter-points and technical details: ? Overall summary: https://ghc.haskell.org/trac/ghc/wiki/Prelude710 ? Details of Plan List: https://ghc.haskell.org/trac/ghc/wiki/Prelude710/List ? Details of Plan FTP: https://ghc.haskell.org/trac/ghc/wiki/Prelude710/FTP This survey invites your input on which plan we should follow. Would you please ? Read the details of the alternative plans on the three wiki pages above ? Add your response to the survey Please do read the background. Well-informed responses will help. Thank you! DEADLINE: 21 February 2015 Simon PJ -------------- next part -------------- An HTML attachment was scrubbed... URL: From miguelimo38 at yandex.ru Tue Feb 10 15:59:18 2015 From: miguelimo38 at yandex.ru (Miguel Mitrofanov) Date: Tue, 10 Feb 2015 18:59:18 +0300 Subject: [Haskell-cafe] GHC 7.10 Prelude: we need your opinion In-Reply-To: <618BE556AADD624C9C918AA5D5911BEF562C4A1C@DB3PRD3001MB020.064d.mgd.msft.net> References: <618BE556AADD624C9C918AA5D5911BEF562C4A1C@DB3PRD3001MB020.064d.mgd.msft.net> Message-ID: <4445561423583958@web8j.yandex.ru> What were the objections? Especially the principle ones? 10.02.2015, 18:51, "Simon Peyton Jones" : > Haskell Friends > > This email asks for your help in deciding how to proceed with some Prelude changes in GHC 7.10.? Please read on, but all the info is also at the survey link, here: http://goo.gl/forms/XP1W2JdfpX.?? Deadline is 21 Feb. > > The ?Core Libraries Committee (CLC) is responsible for developing the core libraries that ship with GHC. This is an important but painstaking task, and we owe the CLC a big vote of thanks for taking it on. > > For over a year the CLC has been working on integrating the Foldable and Traversable classes (shipped in base in GHC 7.8) into the core libraries, and into the Prelude in particular. Detailed planning for GHC 7.10 started in the autumn of 2014, and the CLC went ahead with this integration. > > Then we had a failure of communication.? As these changes affect the Prelude, which is in scope for all users of Haskell, these changes should be held to a higher bar than the regular libraries@ review process.? However, the Foldable/Traversable changes were not particularly well signposted. Many people have only recently woken up to them, and some have objected (both in principle and detail). > > This is an extremely unfortunate situation. On the one hand we are at RC2 for GHC 7.10, so library authors have invested effort in updating their libraries to the new Prelude. On the other, altering the Prelude is in effect altering the language, something we take pretty seriously. We should have had this debate back in 2014, but here we are, and it is unproductive to argue about whose fault it is. We all share responsibility. > > We need to decide what to do now. A small group of us met by Skype and we've decided to do this: > > ????????? Push back GHC 7.10's release by at least a month, to late March.? This delay also gives us breathing space to address an unrelated show-stopping bug, Trac #9858. > > ????????? Invite input from the Haskell community on which of two approaches to adopt (this survey).? The main questions revolve around impact on the Haskell ecosystem (commercial applications, teaching, libraries, etc etc), so we want to ask your opinion rather than guess it. > > ????????? Ask Simon Marlow and Simon Peyton Jones to decide which approach to follow for GHC 7.10. > > Wiki pages have been created summarizing these two primary alternatives, including many more points and counter-points and technical details: > > ????????? Overall summary: https://ghc.haskell.org/trac/ghc/wiki/Prelude710 > > ????????? Details of Plan List: https://ghc.haskell.org/trac/ghc/wiki/Prelude710/List > > ????????? Details of Plan FTP: https://ghc.haskell.org/trac/ghc/wiki/Prelude710/FTP > > This survey invites your input on which plan we should follow. Would you please > > ????????? Read the details of the alternative plans on the three wiki pages above > > ????????? Add your response to the survey > > Please do read the background.? Well-informed responses will help.? Thank you! > > DEADLINE: 21 February 2015 > > Simon PJ > > , > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe From migmit at gmail.com Tue Feb 10 16:00:29 2015 From: migmit at gmail.com (Miguel) Date: Tue, 10 Feb 2015 17:00:29 +0100 Subject: GHC 7.10 Prelude: we need your opinion In-Reply-To: <618BE556AADD624C9C918AA5D5911BEF562C4A1C@DB3PRD3001MB020.064d.mgd.msft.net> References: <618BE556AADD624C9C918AA5D5911BEF562C4A1C@DB3PRD3001MB020.064d.mgd.msft.net> Message-ID: What were the objections? Especially the principle ones? On Tue, Feb 10, 2015 at 4:50 PM, Simon Peyton Jones wrote: > Haskell Friends > > *This email asks for your help in deciding how to proceed with some > Prelude changes in GHC 7.10. Please read on, but all the info is also at > the survey link, here: http://goo.gl/forms/XP1W2JdfpX > . Deadline is 21 Feb.* > > > > The ?Core Libraries Committee (CLC) is responsible for developing the core > libraries that ship with GHC. This is an important but painstaking task, > and we owe the CLC a big vote of thanks for taking it on. > > For over a year the CLC has been working on integrating the *Foldable and > Traversable classes* (shipped in base in GHC 7.8) into the core > libraries, and into the Prelude in particular. Detailed planning for GHC > 7.10 started in the autumn of 2014, and the CLC went ahead with this > integration. > > Then we had a failure of communication. As these changes affect the > Prelude, which is in scope for all users of Haskell, these changes should > be held to a higher bar than the regular libraries@ review process. > However, the Foldable/Traversable changes were not particularly well > signposted. Many people have only recently woken up to them, and some have > objected (both in principle and detail). > > This is an extremely unfortunate situation. On the one hand we are at RC2 > for GHC 7.10, so library authors have invested effort in updating their > libraries to the new Prelude. On the other, altering the Prelude is in > effect altering the language, something we take pretty seriously. We should > have had this debate back in 2014, but here we are, and it is unproductive > to argue about whose fault it is. We all share responsibility. > > We need to decide what to do now. A small group of us met by Skype and > we've decided to do this: > > ? Push back GHC 7.10's release by at least a month, to late > March. This delay also gives us breathing space to address an unrelated > show-stopping bug, Trac #9858. > > ? Invite input from the Haskell community on which of two > approaches to adopt (this survey ). The > main questions revolve around impact on the Haskell ecosystem (commercial > applications, teaching, libraries, etc etc), so we want to ask your opinion > rather than guess it. > > ? Ask Simon Marlow and Simon Peyton Jones to decide which > approach to follow for GHC 7.10. > > Wiki pages have been created summarizing these two primary alternatives, > including many more points and counter-points and technical details: > > ? Overall summary: > https://ghc.haskell.org/trac/ghc/wiki/Prelude710 > > > ? Details of Plan List: > https://ghc.haskell.org/trac/ghc/wiki/Prelude710/List > > > ? Details of Plan FTP: > https://ghc.haskell.org/trac/ghc/wiki/Prelude710/FTP > > > This survey invites your input on which plan we should follow. Would you > please > > ? Read the details of the alternative plans on the three wiki > pages above > > ? Add your response to the survey > > Please do read the background. Well-informed responses will help. Thank > you! > > *DEADLINE: 21 February 2015* > > Simon PJ > > _______________________________________________ > 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 Feb 10 16:05:21 2015 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Tue, 10 Feb 2015 16:05:21 +0000 Subject: [Haskell-cafe] GHC 7.10 Prelude: we need your opinion In-Reply-To: <4445561423583958@web8j.yandex.ru> References: <618BE556AADD624C9C918AA5D5911BEF562C4A1C@DB3PRD3001MB020.064d.mgd.msft.net> <4445561423583958@web8j.yandex.ru> Message-ID: <618BE556AADD624C9C918AA5D5911BEF562C4AE6@DB3PRD3001MB020.064d.mgd.msft.net> | What were the objections? Especially the principle ones? Please read the info pages, which set out the arguments quite carefully. Also, I spammed several email lists to ensure broad coverage, but it'd be best to debate on the libraries at haskell.org, rather than reply-to-all; that's what it's for. (Which I failed to send the announcement to! I'll fix that.) Simon | -----Original Message----- | From: Miguel Mitrofanov [mailto:miguelimo38 at yandex.ru] | Sent: 10 February 2015 15:59 | To: Simon Peyton Jones; haskell at haskell.org; Haskell Cafe (haskell- | cafe at haskell.org); GHC users; ghc-devs at haskell.org | Subject: Re: [Haskell-cafe] GHC 7.10 Prelude: we need your opinion | | What were the objections? Especially the principle ones? | | 10.02.2015, 18:51, "Simon Peyton Jones" : | > Haskell Friends | > | > This email asks for your help in deciding how to proceed with some | Prelude changes in GHC 7.10.? Please read on, but all the info is also | at the survey link, here: http://goo.gl/forms/XP1W2JdfpX.?? Deadline | is 21 Feb. | > | > The ?Core Libraries Committee (CLC) is responsible for developing the | core libraries that ship with GHC. This is an important but | painstaking task, and we owe the CLC a big vote of thanks for taking | it on. | > | > For over a year the CLC has been working on integrating the Foldable | and Traversable classes (shipped in base in GHC 7.8) into the core | libraries, and into the Prelude in particular. Detailed planning for | GHC 7.10 started in the autumn of 2014, and the CLC went ahead with | this integration. | > | > Then we had a failure of communication.? As these changes affect the | Prelude, which is in scope for all users of Haskell, these changes | should be held to a higher bar than the regular libraries@ review | process.? However, the Foldable/Traversable changes were not | particularly well signposted. Many people have only recently woken up | to them, and some have objected (both in principle and detail). | > | > This is an extremely unfortunate situation. On the one hand we are | at RC2 for GHC 7.10, so library authors have invested effort in | updating their libraries to the new Prelude. On the other, altering | the Prelude is in effect altering the language, something we take | pretty seriously. We should have had this debate back in 2014, but | here we are, and it is unproductive to argue about whose fault it is. | We all share responsibility. | > | > We need to decide what to do now. A small group of us met by Skype | and we've decided to do this: | > | > ????????? Push back GHC 7.10's release by at least a month, to late | March.? This delay also gives us breathing space to address an | unrelated show-stopping bug, Trac #9858. | > | > ????????? Invite input from the Haskell community on which of two | approaches to adopt (this survey).? The main questions revolve around | impact on the Haskell ecosystem (commercial applications, teaching, | libraries, etc etc), so we want to ask your opinion rather than guess | it. | > | > ????????? Ask Simon Marlow and Simon Peyton Jones to decide which | approach to follow for GHC 7.10. | > | > Wiki pages have been created summarizing these two primary | alternatives, including many more points and counter-points and | technical details: | > | > ????????? Overall summary: | https://ghc.haskell.org/trac/ghc/wiki/Prelude710 | > | > ????????? Details of Plan List: | https://ghc.haskell.org/trac/ghc/wiki/Prelude710/List | > | > ????????? Details of Plan FTP: | https://ghc.haskell.org/trac/ghc/wiki/Prelude710/FTP | > | > This survey invites your input on which plan we should follow. Would | you please | > | > ????????? Read the details of the alternative plans on the three | wiki pages above | > | > ????????? Add your response to the survey | > | > Please do read the background.? Well-informed responses will | help.? Thank you! | > | > DEADLINE: 21 February 2015 | > | > Simon PJ | > | > , | > | > _______________________________________________ | > Haskell-Cafe mailing list | > Haskell-Cafe at haskell.org | > http://www.haskell.org/mailman/listinfo/haskell-cafe From vogt.adam at gmail.com Tue Feb 10 22:13:57 2015 From: vogt.adam at gmail.com (adam vogt) Date: Tue, 10 Feb 2015 17:13:57 -0500 Subject: [Haskell-cafe] Injective type families for GHC In-Reply-To: <201502101238.10719.jan.stolarek@p.lodz.pl> References: <201502091658.04383.jan.stolarek@p.lodz.pl> <201502101238.10719.jan.stolarek@p.lodz.pl> Message-ID: On Tue, Feb 10, 2015 at 6:38 AM, Jan Stolarek wrote: >> I don't know how realistic this is but a constraint (HLength x ~ >> HLength y) would ideally have the same result as SameLength x y. > I'm not sure if I understand that part. HLength is not injective. How would injectivity help here? I agree it's not injective. But my impression is that injective TFs pretty much allow ghc to replace a constraint TF a b ~ result with (TF_getResult a b ~ result, TF_getB result a ~ b) Where instances of: type family TF a b | result a -> b, a b -> result -- or whatever the notation actually is define instances of ordinary type families TF_getB and TF_getResult. So it's a move in the same direction to replace (HLength x ~ HLength y) with SameLength x y. While I don't know how the code for SameLength might be derived from the definition of HLength, that substitution seems safe so long as (HLength x ~ HLength y) is still checked. I can see that substitution happening in a type checker plugin, but it would be nice if it was part of the language. Regards, Adam From takenobu.hs at gmail.com Fri Feb 13 10:35:36 2015 From: takenobu.hs at gmail.com (Takenobu Tani) Date: Fri, 13 Feb 2015 19:35:36 +0900 Subject: ANNOUNCE: GHC 7.10.1 Release Candidate 2 In-Reply-To: References: Message-ID: Hi, Does ghc7.10rc2 support for windows 32bit OS (Windows 7) ? I tried to build ghc7.10rc2 [1],[2] on my old 32bit windows to check FTP. Then, the following error has occurred: "C:/MinGW/msys/1.0/home/my/devel/haskell.build.mingw/work8.ghc.7.10.rc2/ghc-7.10.0.20150123/inplace/mingw/bin/ld.exe" -r -o libraries/directory/dist-install/build/HSdirec_3OAebvWY9YTGrbhfMGQ0ml.o libraries/directory/dist-install/build/System/Directory.o libraries/directory/dist-install/build/cbits/directory.o "inplace/bin/ghc-stage1.exe" -hisuf hi -osuf o -hcsuf hc -static -H64m -O0 -fasm -this-package-key proce_9HgSaudU0TAKauLzQHuwnO -hide-all-packages -i -ilibraries/process/. -ilibraries/process/dist-install/build -ilibraries/process/dist-install/build/autogen -Ilibraries/process/dist-install/build -Ilibraries/process/dist-install/build/autogen -Ilibraries/process/include -optP-include -optPlibraries/process/dist-install/build/autogen/cabal_macros.h -package-key Win32_Cjc5QN7bEuvL7SrTr96E5g -package-key base_469rOtLAqwTGFEOGWxSUiQ -package-key deeps_FT5iVCELxOr62eHY0nbvnU -package-key direc_3OAebvWY9YTGrbhfMGQ0ml -package-key filep_1vDJvPDP7mkAk0dVCj6gws -Wall -XHaskell2010 -O -fasm -no-user-package-db -rtsopts -odir libraries/process/dist-install/build -hidir libraries/process/dist-install/build -stubdir libraries/process/dist-install/build -c libraries/process/./System/Process/Internals.hs -o libraries/process/dist-install/build/System/Process/Internals.o libraries\process\System\Process\Internals.hs:36:5: Not in scope: <81>estopDelegateControlC<81>f Perhaps you meant one of these: <81>estartDelegateControlC<81>f (line 467), <81>eendDelegateControlC<81>f (line 470) make[1]: *** [libraries/process/dist-install/build/System/Process/Internals.o] Error 1 make: *** [all] Error 2 I looks like 'stopDelegateControl' is not defined in System\Process\Internals.hs for mingw32_HOST_OS. [1]: https://downloads.haskell.org/~ghc/7.10.1-rc2/ghc-7.10.0.20150123-src.tar.bz2 [2]: https://downloads.haskell.org/~ghc/7.10.1-rc2/ghc-7.10.0.20150123-windows-extra-src.tar.bz2 Regards, Takenobu 2015-01-27 9:13 GMT+09:00 Austin Seipp : > We are pleased to announce the second release candidate for GHC 7.10.1: > > https://downloads.haskell.org/~ghc/7.10.1-rc2/ > > 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. > > 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 > -------------- next part -------------- An HTML attachment was scrubbed... URL: From vogt.adam at gmail.com Sat Feb 14 10:31:23 2015 From: vogt.adam at gmail.com (adam vogt) Date: Sat, 14 Feb 2015 05:31:23 -0500 Subject: type checker plugin does not affect inferred type signatures Message-ID: Hello, Using ghc-7.10 rc1, I am trying to write a type checker plugin that adds wanted constraint which helps ghc to infer more types. However, it seems that the wanted constraints I add don't get added to the inferred type of the declaration, so that I get a type error like: a.hs:1:1: Warning: Could not deduce (SameLength y x) arising from an application from the context (HLength x ~ HLength y) bound by the inferred type of p :: (HLength x ~ HLength y) => Proxy '(y, x) at a.hs:11:1-69 I think ghc should be able to figure out p :: (SameLength x y, HLength x ~ HLength y) => Proxy '(x,y). The code is self-contained: git clone https://github.com/aavogt/HListPlugin cd HListPlugin/ex make Is this approach supposed to be possible, or am I supposed to rewrite things such that I only produce CtGivenS from the plugin? Regards, Adam From adam at well-typed.com Mon Feb 16 09:36:13 2015 From: adam at well-typed.com (Adam Gundry) Date: Mon, 16 Feb 2015 09:36:13 +0000 Subject: type checker plugin does not affect inferred type signatures In-Reply-To: References: Message-ID: <54E1BA0D.6020101@well-typed.com> Hi Adam, It's great to hear that you are trying the plugins functionality, this is exactly the kind of experimentation it's designed for! I'm a little confused about what you're trying to achieve, though. Can you give some examples of code you'd like to be able to write? In general, GHC's type inference algorithm isn't expecting wanted constraints to be produced from givens; confusing things will happen if they are, and it's likely that *less* things will be typeable rather than *more*. Perhaps the plugin infrastructure should prevent you from doing so. It makes sense to produce givens from givens or wanteds from wanteds though. I'd imagine you might want to look for *wanted* constraints (HLength x ~ HLength y) and add an additional *wanted* (SameLength x y). One other thing to note is that plugins are called twice, once to simplify the givens (with empty wanteds), and once to solve the wanteds (https://ghc.haskell.org/trac/ghc/wiki/Plugins/TypeChecker#Callingpluginsfromthetypechecker). Hope this helps, Adam On 14/02/15 10:31, adam vogt wrote: > Hello, > > Using ghc-7.10 rc1, I am trying to write a type checker plugin that > adds wanted constraint which helps ghc to infer more types. However, > it seems that the wanted constraints I add don't get added to the > inferred type of the declaration, so that I get a type error like: > > a.hs:1:1: Warning: > Could not deduce (SameLength y x) arising from an application > from the context (HLength x ~ HLength y) > bound by the inferred type of > p :: (HLength x ~ HLength y) => Proxy '(y, x) > at a.hs:11:1-69 > > I think ghc should be able to figure out p :: (SameLength x y, HLength > x ~ HLength y) => Proxy '(x,y). > > The code is self-contained: > > git clone https://github.com/aavogt/HListPlugin > > cd HListPlugin/ex > > make > > > Is this approach supposed to be possible, or am I supposed to rewrite > things such that I only produce CtGivenS from the plugin? > > Regards, > Adam -- Adam Gundry, Haskell Consultant Well-Typed LLP, http://www.well-typed.com/ From vogt.adam at gmail.com Mon Feb 16 18:52:45 2015 From: vogt.adam at gmail.com (adam vogt) Date: Mon, 16 Feb 2015 13:52:45 -0500 Subject: type checker plugin does not affect inferred type signatures In-Reply-To: <54E1BA0D.6020101@well-typed.com> References: <54E1BA0D.6020101@well-typed.com> Message-ID: Hi Adam, I've added a README which tries to explain things: https://github.com/aavogt/HListPlugin When I produce a wanted constraint from a wanted constraint, things work as I wanted. Thanks for the suggestion! Regards, Adam On Mon, Feb 16, 2015 at 4:36 AM, Adam Gundry wrote: > Hi Adam, > > It's great to hear that you are trying the plugins functionality, this > is exactly the kind of experimentation it's designed for! I'm a little > confused about what you're trying to achieve, though. Can you give some > examples of code you'd like to be able to write? > > In general, GHC's type inference algorithm isn't expecting wanted > constraints to be produced from givens; confusing things will happen if > they are, and it's likely that *less* things will be typeable rather > than *more*. Perhaps the plugin infrastructure should prevent you from > doing so. > > It makes sense to produce givens from givens or wanteds from wanteds > though. I'd imagine you might want to look for *wanted* constraints > (HLength x ~ HLength y) and add an additional *wanted* (SameLength x y). > > One other thing to note is that plugins are called twice, once to > simplify the givens (with empty wanteds), and once to solve the wanteds > (https://ghc.haskell.org/trac/ghc/wiki/Plugins/TypeChecker#Callingpluginsfromthetypechecker). > > Hope this helps, From takenobu.hs at gmail.com Tue Feb 17 12:47:50 2015 From: takenobu.hs at gmail.com (Takenobu Tani) Date: Tue, 17 Feb 2015 21:47:50 +0900 Subject: ANNOUNCE: GHC 7.10.1 Release Candidate 2 In-Reply-To: References: Message-ID: Hi, I modified System/Process/Internals.hs locally and build on MinGW 32bit. Then I was successful to build on 32bit Windows 7. Shall I write a bug report on trac or any? or ghc7.10.1.rc2 will not support 32 bit Windows? Change part is the following: diff -u ghc-7.10.0.20150123/libraries/process/System/Process/ Internals.hs.org ghc-7.10.0.20150123/libraries/process/System/Process/Internals.hs --- ghc-7.10.0.20150123/libraries/process/System/Process/Internals.hs.org 2015-01-19 21:37:52 +0900 +++ ghc-7.10.0.20150123/libraries/process/System/Process/Internals.hs 2015-02-17 13:50:31 +0900 @@ -469,6 +469,9 @@ endDelegateControlC :: ExitCode -> IO () endDelegateControlC _ = return () +stopDelegateControlC :: IO () +stopDelegateControlC = return () + foreign import ccall unsafe "runInteractiveProcess" c_runInteractiveProcess :: CWString Regards, Takenobu 2015-02-13 19:35 GMT+09:00 Takenobu Tani : > Hi, > > Does ghc7.10rc2 support for windows 32bit OS (Windows 7) ? > > I tried to build ghc7.10rc2 [1],[2] on my old 32bit windows to check FTP. > Then, the following error has occurred: > > > "C:/MinGW/msys/1.0/home/my/devel/haskell.build.mingw/work8.ghc.7.10.rc2/ghc-7.10.0.20150123/inplace/mingw/bin/ld.exe" > -r -o > libraries/directory/dist-install/build/HSdirec_3OAebvWY9YTGrbhfMGQ0ml.o > libraries/directory/dist-install/build/System/Directory.o > libraries/directory/dist-install/build/cbits/directory.o > "inplace/bin/ghc-stage1.exe" -hisuf hi -osuf o -hcsuf hc -static -H64m > -O0 -fasm -this-package-key proce_9HgSaudU0TAKauLzQHuwnO > -hide-all-packages -i -ilibraries/process/. > -ilibraries/process/dist-install/build > -ilibraries/process/dist-install/build/autogen > -Ilibraries/process/dist-install/build > -Ilibraries/process/dist-install/build/autogen -Ilibraries/process/include > -optP-include > -optPlibraries/process/dist-install/build/autogen/cabal_macros.h > -package-key Win32_Cjc5QN7bEuvL7SrTr96E5g -package-key > base_469rOtLAqwTGFEOGWxSUiQ -package-key deeps_FT5iVCELxOr62eHY0nbvnU > -package-key direc_3OAebvWY9YTGrbhfMGQ0ml -package-key > filep_1vDJvPDP7mkAk0dVCj6gws -Wall -XHaskell2010 -O -fasm > -no-user-package-db -rtsopts -odir > libraries/process/dist-install/build -hidir > libraries/process/dist-install/build -stubdir > libraries/process/dist-install/build -c > libraries/process/./System/Process/Internals.hs -o > libraries/process/dist-install/build/System/Process/Internals.o > > libraries\process\System\Process\Internals.hs:36:5: > Not in scope: <81>estopDelegateControlC<81>f > Perhaps you meant one of these: > <81>estartDelegateControlC<81>f (line 467), > <81>eendDelegateControlC<81>f (line 470) > make[1]: *** > [libraries/process/dist-install/build/System/Process/Internals.o] Error 1 > make: *** [all] Error 2 > > > > I looks like 'stopDelegateControl' is not defined in > System\Process\Internals.hs for mingw32_HOST_OS. > > > [1]: > https://downloads.haskell.org/~ghc/7.10.1-rc2/ghc-7.10.0.20150123-src.tar.bz2 > [2]: > https://downloads.haskell.org/~ghc/7.10.1-rc2/ghc-7.10.0.20150123-windows-extra-src.tar.bz2 > > > Regards, > Takenobu > > > > > > 2015-01-27 9:13 GMT+09:00 Austin Seipp : > >> We are pleased to announce the second release candidate for GHC 7.10.1: >> >> https://downloads.haskell.org/~ghc/7.10.1-rc2/ >> >> 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. >> >> 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 >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From takenobu.hs at gmail.com Tue Feb 17 13:48:04 2015 From: takenobu.hs at gmail.com (Takenobu Tani) Date: Tue, 17 Feb 2015 22:48:04 +0900 Subject: ANNOUNCE: GHC 7.10.1 Release Candidate 2 In-Reply-To: <87wq3gitc0.fsf@gmail.com> References: <87wq3gitc0.fsf@gmail.com> Message-ID: Hi Herbert, Thank you for your directions. I will send the pull-request after checking the file. Thank you, Takenobu 2015-02-17 22:02 GMT+09:00 Herbert Valerio Riedel : > On 2015-02-17 at 13:47:50 +0100, Takenobu Tani wrote: > > I modified System/Process/Internals.hs locally and build on MinGW 32bit. > > Then I was successful to build on 32bit Windows 7. > > > > Shall I write a bug report on trac or any? or ghc7.10.1.rc2 will not > > support 32 bit Windows? > > Please file a pull-request at https://github.com/haskell/process > > I'm somewhat surprised this wasn't noticed before(?) > -------------- next part -------------- An HTML attachment was scrubbed... URL: From tomberek at gmail.com Wed Feb 18 15:34:05 2015 From: tomberek at gmail.com (Thomas Bereknyei) Date: Wed, 18 Feb 2015 10:34:05 -0500 Subject: ApplicativeDo Message-ID: There is a library for TH: http://hackage.haskell.org/package/applicative-quoters-0.1.0.8 (broken at the moment) There is a proposal at: https://ghc.haskell.org/trac/ghc/wiki/ApplicativeDo Now with AMP, is this worth revisiting? Why or why not? -Tom -------------- next part -------------- An HTML attachment was scrubbed... URL: From vogt.adam at gmail.com Wed Feb 18 16:26:00 2015 From: vogt.adam at gmail.com (adam vogt) Date: Wed, 18 Feb 2015 11:26:00 -0500 Subject: ApplicativeDo In-Reply-To: References: Message-ID: What part of applicative-quoters is broken for you? 0.1.0.8 compiles on ghc-7.8.4 here, and [ado| a <- Just (); b <- Just 2; (a,b) |] evaluates to Just ((),2) as it should. From tomberek at gmail.com Thu Feb 19 13:31:10 2015 From: tomberek at gmail.com (Thomas Bereknyei) Date: Thu, 19 Feb 2015 08:31:10 -0500 Subject: ApplicativeDo In-Reply-To: References: Message-ID: I guess it is not broken, just that it has no maintainer. Regardless, is there any traction for an "ado" language extension? The ApplicativeDo proposal advocates for a "do" that automatically downgrades to Applicative, but that may be too much or powerful. Opt-in via "ado" might be the right answer. In a somewhat related/unrelated question. Is there a mechanism to fork an Arrow into a separate thread? I would assume it would end up looking like: forkArrow :: Arrow a => a b c -> Chan b -> Chan c -> IO () or perhaps :: Arrow a => a b c -> Chan b -> IO (Chan c) Is there any way to manipulate the (Input, Output) pair as an arrow itself along with other arrows that have been "forked". -Tom On Wed, Feb 18, 2015 at 11:26 AM, adam vogt wrote: > What part of applicative-quoters is broken for you? 0.1.0.8 compiles > on ghc-7.8.4 here, and [ado| a <- Just (); b <- Just 2; (a,b) |] > evaluates to Just ((),2) as it should. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From vogt.adam at gmail.com Fri Feb 20 02:48:26 2015 From: vogt.adam at gmail.com (adam vogt) Date: Thu, 19 Feb 2015 21:48:26 -0500 Subject: type checker plugin success depends on whether an expression is manually inlined Message-ID: Hello list, The following file compiles with my plugin. It makes a data family HList have role representational in a way that I believe is safe: https://github.com/aavogt/HListPlugin/blob/master/ex/Coerce.hs#L19 I expect the highlighted line to be acceptable. However, it seems that the plugin never sees anything from line 19, when I uncomment it. Is there something I can do to make that L19 work? Is this a known or intentional limitation of type checker plugins? Thanks, Adam From mietek at bak.io Sat Feb 21 20:19:38 2015 From: mietek at bak.io (=?iso-8859-1?Q?Mi=EBtek_Bak?=) Date: Sat, 21 Feb 2015 20:19:38 +0000 Subject: ANNOUNCE: GHC 7.10.1 Release Candidate 2 In-Reply-To: <6650493F-F6BD-4352-B4F1-5EA0CAE9D868@bak.io> References: <6650493F-F6BD-4352-B4F1-5EA0CAE9D868@bak.io> Message-ID: <61A8F0FD-DA37-4861-BCDD-04891B295C87@bak.io> My previous email was about the x86_64 bindist GHC 7.10.1-rc2. I?ve now added i386 support to Halcyon, and it appears only the x86_64 version works fine on CentOS 6 (6.5), while the i386 version fails to configure: checking for path to top of build tree... utils/ghc-pwd/dist-install/build/tmp/ghc-pwd: symbol lookup error: libraries/integer-gmp2/dist-install/build/libHSinteg_21cuTlnn00eFNd4GMrxOMi-ghc7.10.0.20150123.so: undefined symbol: __gmpn_andn_n configure: error: cannot determine current directory -- Mi?tek On 2015-01-27, at 06:26, Mi?tek Bak wrote: > It appears GHC 7.10.1-rc2 doesn?t support glibc 2.11 ? specifically, 2.11.1 (Ubuntu 10.04 LTS) and 2.11.3 (Debian 6). glibc 2.12 (CentOS 6) seems to work fine. Symptoms include: > > Installing library in > /app/ghc/lib/ghc-7.10.0.20150123/ghc_0kOYffGYd794400D7yvIjm > "/app/ghc/lib/ghc-7.10.0.20150123/bin/ghc-pkg" --force --global-package-db "/app/ghc/lib/ghc-7.10.0.20150123/package.conf.d" update rts/dist/package.conf.install > Reading package info from "rts/dist/package.conf.install" ... done. > "utils/ghc-cabal/dist-install/build/tmp/ghc-cabal-bindist" register libraries/ghc-prim dist-install "/app/ghc/lib/ghc-7.10.0.20150123/bin/ghc" "/app/ghc/lib/ghc-7.10.0.20150123/bin/ghc-pkg" "/app/ghc/lib/ghc-7.10.0.20150123" '' '/app/ghc' '/app/ghc/lib/ghc-7.10.0.20150123' '/app/ghc/share/doc/ghc/html/libraries' NO > Warning: cannot determine version of /app/ghc/lib/ghc-7.10.0.20150123/bin/ghc > : > "" > ghc-cabal: '/app/ghc/lib/ghc-7.10.0.20150123/bin/ghc' exited with an error: > /app/ghc/lib/ghc-7.10.0.20150123/bin/ghc: symbol lookup error: > /app/ghc/lib/ghc-7.10.0.20150123/bin/../rts/libHSrts_thr-ghc7.10.0.20150123.so: > undefined symbol: pthread_setname_np > > The bindist name does mention 'deb7', so perhaps this is all working as intended. However, similarly named bindists for GHC 7.8.* work fine with glibc 2.11. > > > In other news, I?m happy to say Halcyon now supports GHC 7.10.1-rc2 on CentOS 6 and 7, Debian 7, Fedora 19, 20, and 21, and Ubuntu 12 and 14. > https://halcyon.sh/ > > $ halcyon install --ghc-version=7.10.1-rc2 --cabal-version=1.22.0.0 > > > Best, > > -- > Mi?tek > > > > > On 2015-01-27, at 00:13, Austin Seipp wrote: > >> We are pleased to announce the second release candidate for GHC 7.10.1: >> >> https://downloads.haskell.org/~ghc/7.10.1-rc2/ >> >> 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. >> >> 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 > > _______________________________________________ > Glasgow-haskell-users mailing list > Glasgow-haskell-users at haskell.org > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users -------------- next part -------------- A non-text attachment was scrubbed... Name: smime.p7s Type: application/pkcs7-signature Size: 4203 bytes Desc: not available URL: From mietek at bak.io Sat Feb 21 22:01:37 2015 From: mietek at bak.io (=?iso-8859-1?Q?Mi=EBtek_Bak?=) Date: Sat, 21 Feb 2015 22:01:37 +0000 Subject: ANNOUNCE: GHC 7.10.1 Release Candidate 2 In-Reply-To: <61A8F0FD-DA37-4861-BCDD-04891B295C87@bak.io> References: <6650493F-F6BD-4352-B4F1-5EA0CAE9D868@bak.io> <61A8F0FD-DA37-4861-BCDD-04891B295C87@bak.io> Message-ID: GHC 7.10.1-rc2 i386 also fails in the same fashion on Red Hat Enterprise Linux 6.5, which might be more concerning. Both failures appear to be caused by a GMP 4 vs 5 problem, previously reported as Solaris-specific: https://ghc.haskell.org/trac/ghc/ticket/10003 -- Mi?tek On 2015-02-21, at 20:19, Mi?tek Bak wrote: > My previous email was about the x86_64 bindist GHC 7.10.1-rc2. I?ve now added i386 support to Halcyon, and it appears only the x86_64 version works fine on CentOS 6 (6.5), while the i386 version fails to configure: > > checking for path to top of build tree... utils/ghc-pwd/dist-install/build/tmp/ghc-pwd: symbol lookup error: libraries/integer-gmp2/dist-install/build/libHSinteg_21cuTlnn00eFNd4GMrxOMi-ghc7.10.0.20150123.so: undefined symbol: __gmpn_andn_n > configure: error: cannot determine current directory > > > -- > Mi?tek > > > > > On 2015-01-27, at 06:26, Mi?tek Bak wrote: > >> It appears GHC 7.10.1-rc2 doesn?t support glibc 2.11 ? specifically, 2.11.1 (Ubuntu 10.04 LTS) and 2.11.3 (Debian 6). glibc 2.12 (CentOS 6) seems to work fine. Symptoms include: >> >> Installing library in >> /app/ghc/lib/ghc-7.10.0.20150123/ghc_0kOYffGYd794400D7yvIjm >> "/app/ghc/lib/ghc-7.10.0.20150123/bin/ghc-pkg" --force --global-package-db "/app/ghc/lib/ghc-7.10.0.20150123/package.conf.d" update rts/dist/package.conf.install >> Reading package info from "rts/dist/package.conf.install" ... done. >> "utils/ghc-cabal/dist-install/build/tmp/ghc-cabal-bindist" register libraries/ghc-prim dist-install "/app/ghc/lib/ghc-7.10.0.20150123/bin/ghc" "/app/ghc/lib/ghc-7.10.0.20150123/bin/ghc-pkg" "/app/ghc/lib/ghc-7.10.0.20150123" '' '/app/ghc' '/app/ghc/lib/ghc-7.10.0.20150123' '/app/ghc/share/doc/ghc/html/libraries' NO >> Warning: cannot determine version of /app/ghc/lib/ghc-7.10.0.20150123/bin/ghc >> : >> "" >> ghc-cabal: '/app/ghc/lib/ghc-7.10.0.20150123/bin/ghc' exited with an error: >> /app/ghc/lib/ghc-7.10.0.20150123/bin/ghc: symbol lookup error: >> /app/ghc/lib/ghc-7.10.0.20150123/bin/../rts/libHSrts_thr-ghc7.10.0.20150123.so: >> undefined symbol: pthread_setname_np >> >> The bindist name does mention 'deb7', so perhaps this is all working as intended. However, similarly named bindists for GHC 7.8.* work fine with glibc 2.11. >> >> >> In other news, I?m happy to say Halcyon now supports GHC 7.10.1-rc2 on CentOS 6 and 7, Debian 7, Fedora 19, 20, and 21, and Ubuntu 12 and 14. >> https://halcyon.sh/ >> >> $ halcyon install --ghc-version=7.10.1-rc2 --cabal-version=1.22.0.0 >> >> >> Best, >> >> -- >> Mi?tek >> >> >> >> >> On 2015-01-27, at 00:13, Austin Seipp wrote: >> >>> We are pleased to announce the second release candidate for GHC 7.10.1: >>> >>> https://downloads.haskell.org/~ghc/7.10.1-rc2/ >>> >>> 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. >>> >>> 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 >> >> _______________________________________________ >> Glasgow-haskell-users mailing list >> Glasgow-haskell-users at haskell.org >> http://www.haskell.org/mailman/listinfo/glasgow-haskell-users > -------------- next part -------------- A non-text attachment was scrubbed... Name: smime.p7s Type: application/pkcs7-signature Size: 4203 bytes Desc: not available URL: From david.feuer at gmail.com Mon Feb 23 17:45:20 2015 From: david.feuer at gmail.com (David Feuer) Date: Mon, 23 Feb 2015 12:45:20 -0500 Subject: Proposal: Turn on ScopedTypeVariables by default In-Reply-To: References: Message-ID: I know this will be controversial, because it can break (weird) code and because it's not Haskell 2010, but hey, you can't make brain salad without breaking a few heads. ScopedTypeVariables is just awesome for two fundamental reasons: 1. It lets you write type signatures for more things. 2. It lets you write more precise type signatures for many things. As a consequence of those two, 3. It helps you get much better error messages from the type checker. And for all that, 4. It's really easy to use. What do other people think? -------------- next part -------------- An HTML attachment was scrubbed... URL: From afarmer at ittc.ku.edu Mon Feb 23 17:59:22 2015 From: afarmer at ittc.ku.edu (Andrew Farmer) Date: Mon, 23 Feb 2015 11:59:22 -0600 Subject: Proposal: Turn on ScopedTypeVariables by default In-Reply-To: References: Message-ID: I have often thought the same thing. This is probably the language extension I enable the most... a quick grep shows about 40% of my modules. I'm guessing the problem is that its not Haskell 98/2010? I think GHC has a policy to do only what the spec says by default. Is that still true now that AMP is implemented? You could just always include it in the 'extensions' field of your cabal file. Then it will apply to your whole project. On Mon, Feb 23, 2015 at 11:45 AM, David Feuer wrote: > I know this will be controversial, because it can break (weird) code and > because it's not Haskell 2010, but hey, you can't make brain salad without > breaking a few heads. ScopedTypeVariables is just awesome for two > fundamental reasons: > > 1. It lets you write type signatures for more things. > 2. It lets you write more precise type signatures for many things. > > As a consequence of those two, > > 3. It helps you get much better error messages from the type checker. > > And for all that, > > 4. It's really easy to use. > > What do other people think? > > > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs > From allbery.b at gmail.com Mon Feb 23 18:05:37 2015 From: allbery.b at gmail.com (Brandon Allbery) Date: Mon, 23 Feb 2015 13:05:37 -0500 Subject: Proposal: Turn on ScopedTypeVariables by default In-Reply-To: References: Message-ID: On Mon, Feb 23, 2015 at 12:59 PM, Andrew Farmer wrote: > I'm guessing the problem is that its not Haskell 98/2010? I think GHC > has a policy to do only what the spec says by default. Is that still > true now that AMP is implemented? > I think the main worry is that it steals syntax, specifically the `forall` keyword, which is just an identifier in H'98 and H'2010. (And some bikeshedding over `forall` being inappropriate for this use, but I suspect that ship sailed long ago.) -- 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 mblazevic at stilo.com Mon Feb 23 18:59:18 2015 From: mblazevic at stilo.com (=?UTF-8?B?TWFyaW8gQmxhxb5ldmnEhw==?=) Date: Mon, 23 Feb 2015 13:59:18 -0500 Subject: Proposal: Turn on ScopedTypeVariables by default In-Reply-To: References: Message-ID: <54EB7886.5000509@stilo.com> On 15-02-23 12:45 PM, David Feuer wrote: > I know this will be controversial, because it can break (weird) code and > because it's not Haskell 2010, but hey, you can't make brain salad > without breaking a few heads. ScopedTypeVariables is just awesome for > two fundamental reasons: > > 1. It lets you write type signatures for more things. > 2. It lets you write more precise type signatures for many things. > > As a consequence of those two, > > 3. It helps you get much better error messages from the type checker. > > And for all that, > > 4. It's really easy to use. > > What do other people think? I'd love this to happen, but not before it was specified in the next Haskell standard. From ben.franksen at online.de Mon Feb 23 20:09:19 2015 From: ben.franksen at online.de (Ben Franksen) Date: Mon, 23 Feb 2015 21:09:19 +0100 Subject: Proposal: Turn on ScopedTypeVariables by default References: Message-ID: Brandon Allbery wrote: > On Mon, Feb 23, 2015 at 12:59 PM, Andrew Farmer > wrote: > >> I'm guessing the problem is that its not Haskell 98/2010? I think GHC >> has a policy to do only what the spec says by default. Is that still >> true now that AMP is implemented? >> > > I think the main worry is that it steals syntax, specifically the `forall` > keyword, which is just an identifier in H'98 and H'2010. (And some > bikeshedding over `forall` being inappropriate for this use, but I suspect > that ship sailed long ago.) The real problem with this syntax is the irregular and completely unnecessary overloading of the dot. As if the dot weren't overloaded enough! A much better choice would have been forall a b c in ... This could still be changed: we could have both variants in parallel for a while, then slowly deprecate the dot and finally scrap it. Cheers Ben -- "There are two ways of constructing a software design: One way is to make it so simple that there are obviously no deficiencies and the other way is to make it so complicated that there are no obvious deficiencies. The first method is far more difficult." ? C.A.R. Hoare From roma at ro-che.info Tue Feb 24 12:55:32 2015 From: roma at ro-che.info (Roman Cheplyaka) Date: Tue, 24 Feb 2015 14:55:32 +0200 Subject: Proposal: Turn on ScopedTypeVariables by default In-Reply-To: <87fv9vjx3k.fsf@gmail.com> References: <87fv9vjx3k.fsf@gmail.com> Message-ID: <54EC74C4.8050605@ro-che.info> On 24/02/15 14:46, Herbert Valerio Riedel wrote: > On 2015-02-23 at 18:45:20 +0100, David Feuer wrote: >> I know this will be controversial, because it can break (weird) code and >> because it's not Haskell 2010, but hey, you can't make brain salad without >> breaking a few heads. > > Are you suggesting enabling -XScopedTypeVariables for -XHaskell98 and > -XHaskell2010? or rather for the default when neither of those two modes > is explicitly requested? > > Just be warned though: this is somewhat of a trick-question... :-) Maybe in addition to -XHaskell98 and -XHaskell2010 there should also be -XGhcHaskell. ghc already deviates from the standard by default (e.g. -XNondecreasingIndentation). OTOH we probably don't want end up with -fglasgow-exts once again. Roman From ben.franksen at online.de Wed Feb 25 02:05:40 2015 From: ben.franksen at online.de (Ben Franksen) Date: Wed, 25 Feb 2015 03:05:40 +0100 Subject: Record Puns/Wildcards Message-ID: I just noted that code like my_config = default_config {..} where name = "my project" description = "some longer text" gives me a syntax error, even if I have NamedFieldPuns and RecordWildCards extensions enabled. It seems that these extensions only work for record constructors and not for updating values. Is there a special reason puns/wildcards are not allowed in record updates? Cheers Ben -- "There are two ways of constructing a software design: One way is to make it so simple that there are obviously no deficiencies and the other way is to make it so complicated that there are no obvious deficiencies. The first method is far more difficult." ? C.A.R. Hoare From vogt.adam at gmail.com Wed Feb 25 04:13:10 2015 From: vogt.adam at gmail.com (adam vogt) Date: Tue, 24 Feb 2015 23:13:10 -0500 Subject: Record Puns/Wildcards In-Reply-To: References: Message-ID: Hi Ben, With ghc-7.8.4 I get a different error "Empty record update of: default_config" when using a wildcard to update a record. I think you can't use wildcards in record updates because it's harder (for users and for ghc) to figure out which fields are involved when you don't name a constructor. If you don't mind naming the constructor twice, you can do an "update" with: myC = case defC of C { .. } -> C { .. } where a = 2 -- myC == C 2 2 3 -- where we have for example data CType = C { a, b, c :: Int } deriving Show defC = C 1 2 3 If CType had multiple constructors, I think you'd be better off doing the update with NamedFieldPuns syntax (defC { a }), or ordinary update syntax (defC { a = 2 }). Regards, Adam Regards, Adam On Tue, Feb 24, 2015 at 9:05 PM, Ben Franksen wrote: > I just noted that code like > > my_config = default_config {..} where > name = "my project" > description = "some longer text" > > gives me a syntax error, even if I have NamedFieldPuns and RecordWildCards > extensions enabled. It seems that these extensions only work for record > constructors and not for updating values. > > Is there a special reason puns/wildcards are not allowed in record updates? > > Cheers > Ben > -- > "There are two ways of constructing a software design: One way is to > make it so simple that there are obviously no deficiencies and the other > way is to make it so complicated that there are no obvious deficiencies. > The first method is far more difficult." ? C.A.R. Hoare > > > _______________________________________________ > Glasgow-haskell-users mailing list > Glasgow-haskell-users at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/glasgow-haskell-users From carter.schonwald at gmail.com Wed Feb 25 17:22:33 2015 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Wed, 25 Feb 2015 12:22:33 -0500 Subject: [Haskell-cafe] PowerPC variants (GHC 7.8.3) In-Reply-To: <95d7f378e2a3c0bb237f2f14f4f86b95.squirrel@mail.jschneider.net> References: <95d7f378e2a3c0bb237f2f14f4f86b95.squirrel@mail.jschneider.net> Message-ID: Hey Jon, I do know that some of the GHC dev team is probably best equipped to answer your question, i'm cc'ing the ghc dev and users lists so they can jump in and help! -Carter On Wed, Feb 25, 2015 at 7:11 AM, Jon Schneider wrote: > Good morning, > > We have a product with an MPC8544E we might want to target. Also known as > PowerQUICC and e500v2. The ABI is gnuspe rather than gnueabi. > > I have built a powerpc---ghc cross compiler but the thing stopping "hello > world" is a SIGILL happening in StgCRun.c where the stfd and lfd > instructions are used to stash registers. The e500 has different > instructions but that cannot be dropped in trivially because of offset > encoding Commenting these out fixes "hello world" though this surely only > scratches the surface of what would need doing. > > I notice that whereas ARMv5, v6 and v7 appear to be catered for along with > various knobs and whistles there appears to be no such thing for PowerPC. > > Is anybody else out there working on this area ? > > Jon > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ben.franksen at online.de Wed Feb 25 19:58:03 2015 From: ben.franksen at online.de (Ben Franksen) Date: Wed, 25 Feb 2015 20:58:03 +0100 Subject: Record Puns/Wildcards References: Message-ID: adam vogt wrote: > With ghc-7.8.4 I get a different error "Empty record update of: > default_config" when using a wildcard to update a record. Yes. I remembered it wrong, this is the error I get, too (with ghc-7.6.3). > I think you can't use wildcards in record updates because it's harder > (for users and for ghc) to figure out which fields are involved when > you don't name a constructor. Thanks, I think I see the problem now. If there was more than one constructor it could have completely different fields. So, in case of multiple constructors this would be a bad idea. We could make an exception for data types with a single constructor, but perhaps it doesn't make sense to provide extra sugar for this special case. > If you don't mind naming the constructor > twice, you can do an "update" with: > > myC = case defC of > C { .. } -> C { .. } > where a = 2 Nice trick, but I actually do mind the duplication ;-) The reason I asked about this is that I'd like to have a simple way to embed user configuration, preferably without braces and commas and without having to define each possible configuration value (i.e. only those fields that differ from the default). Like xmonad, yi, etc, but simpler and more accessible to non-Haskell-programmers. Really off-topic but on a related note, I never understood why the named field syntax in Haskell does not use semicolon as a separator (instead of comma) and allow indentation to replace braces and separators, as in data X = X field1, field2 :: String field3 :: Int and similar for lists and tuples. Cheers Ben > On Tue, Feb 24, 2015 at 9:05 PM, Ben Franksen > wrote: >> I just noted that code like >> >> my_config = default_config {..} where >> name = "my project" >> description = "some longer text" >> >> gives me a syntax error, even if I have NamedFieldPuns and >> RecordWildCards extensions enabled. It seems that these extensions only >> work for record constructors and not for updating values. >> >> Is there a special reason puns/wildcards are not allowed in record >> updates? >> >> Cheers >> Ben >> -- >> "There are two ways of constructing a software design: One way is to >> make it so simple that there are obviously no deficiencies and the other >> way is to make it so complicated that there are no obvious deficiencies. >> The first method is far more difficult." ? C.A.R. Hoare >> >> >> _______________________________________________ >> Glasgow-haskell-users mailing list >> Glasgow-haskell-users at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/glasgow-haskell-users > _______________________________________________ > Glasgow-haskell-users mailing list > Glasgow-haskell-users at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/glasgow-haskell-users -- "There are two ways of constructing a software design: One way is to make it so simple that there are obviously no deficiencies and the other way is to make it so complicated that there are no obvious deficiencies. The first method is far more difficult." ? C.A.R. Hoare