From spam at scientician.net Sat Sep 1 09:01:19 2018 From: spam at scientician.net (Bardur Arantsson) Date: Sat, 1 Sep 2018 11:01:19 +0200 Subject: Mark partial functions as such In-Reply-To: References: <64929A3E-F090-4E3A-865E-1AF46E023529@cs.brynmawr.edu> <8FAC7383-B509-464A-9009-5D7C8C355538@cs.brynmawr.edu> <5B89606F.3010000@exmail.nottingham.ac.uk> Message-ID: On 31/08/2018 21.14, Tikhon Jelvis wrote: > This is a question of documentation, not type design. You don't have to > consider what exceptions your transitive dependencies might throw—you > need to understand what inputs *do* cause your function to fail. If you > use head in a safe way or have a call to error in an unreachable case, > you shouldn't say anything. On the other hand, if your function fails > when the inputs aren't relatively prime, you should document this > regardless of whether the failure is an exception you throw explicitly, > a result of a partial pattern match or a division by zero four layers of > indirection away. > > I definitely expect the author of a function to understand what inputs > cause that function to fail. If you don't understand this, you simply > don't understand the code you wrote. (Luckily, QuickCheck will probably > find any edge cases you missed when writing the function.) > > Thinking about it a bit more, there's nothing specific to exceptions > here. If your code loops forever when the lengths of the inputs sum to a > multiple of seven, that's pretty handy to know from the documentation!  > > I would also expect the same style of documentation even for errors > expressed in the types with whatever your favorite generalization of > Either happens to be. > Oh, of course, these are good points. My point was simply that it's often a little bit complicated to *document* this in a simple easy to understand way. Regards, From reedmullanix at gmail.com Mon Sep 3 03:38:11 2018 From: reedmullanix at gmail.com (Reed Mullanix) Date: Sun, 2 Sep 2018 20:38:11 -0700 Subject: Proposal: Add mapAccumLM and mapAccumRM to Data.Traversable Message-ID: I propose adding a pair of functions to Data.Traversable: mapAccumLM and mapAccumRM with the type '(Traversable t, Monad m) => (a -> b -> m (a,c)) -> a -> t b -> m (a, t c)'. These would behave exactly the same as mapAccumL and mapAccumR, but would allow the addition of monadic effects. This would allow the traversal of structures with an accumulator, without resorting to using foldlM or foldrM, both of which require the extra boilerplate of reconstructing the structure after applying the action, which can be somewhat frustrating and error-prone. A possible implementation would be to add transformer counterparts to StateL/StateR in Data.Functor.Util: (gist: https://gist.github.com/TOTBWF/dc6020be28df7b00372ab8e507aa54b7) newtype StateLT s m a = StateLT { runStateLT :: s -> m (s,a) } instance (Functor m) => Functor (StateLT s m) where fmap f (StateLT k) = StateLT $ \s -> fmap (\(s',a) -> (s', f a)) $ k s instance Monad m => Applicative (StateLT s m) where pure a = StateLT $ \s -> return (s, a) StateLT kf <*> StateLT kv = StateLT $ \s -> do (s', f) <- kf s (s'', v) <- kv s' return (s'', f v) liftA2 f (StateLT kx) (StateLT ky) = StateLT $ \s -> do (s', x) <- kx s (s'', y) <- ky s' return (s'', f x y) mapAccumLM :: (Monad m, Traversable t) => (a -> b -> m (a,c)) -> a -> t b -> m (a, t c) mapAccumLM f s t = runStateLT (traverse (StateLT . flip f) t) s newtype StateRT s m a = StateRT { runStateRT :: s -> m (s,a) } type StateR s = StateRT s Identity instance (Functor m) => Functor (StateRT s m) where fmap f (StateRT k) = StateRT $ \s -> fmap (\(s',a) -> (s', f a)) $ k s instance Monad m => Applicative (StateRT s m) where pure a = StateRT $ \s -> return (s, a) StateRT kf <*> StateRT kv = StateRT $ \s -> do (s', v) <- kv s (s'', f) <- kf s' return (s'', f v) liftA2 f (StateRT kx) (StateRT ky) = StateRT $ \s -> do (s', y) <- ky s (s'', x) <- kx s' return (s'', f x y) mapAccumRM :: (Monad m, Traversable t) => (a -> b -> m (a,c)) -> a -> t b -> m (a, t c) mapAccumRM f s t = runStateRT (traverse (StateRT . flip f) t) s -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Mon Sep 3 04:22:02 2018 From: david.feuer at gmail.com (David Feuer) Date: Mon, 3 Sep 2018 00:22:02 -0400 Subject: Proposal: Add mapAccumLM and mapAccumRM to Data.Traversable In-Reply-To: References: Message-ID: If I understand you correctly, the main idea here is maLM, maRM :: (Traversable t, Monad m) => (b -> StateT a m c) -> t b -> StateT a m (t c) maLM = traverse maRM f t = getReverse <$> traverse f (Reverse t) where Reverse is from Data.Functor.Reverse. The main annoyance trying to implement the precise functions you've requested from those is really impedance matching between the different argument and result orders. As I see it, there are two problems: 1. The standard StateT uses result pairs that are swapped from the way they should conventionally be. I would speculate that this may derive from a history of thinking about state transformers in the context of parsing, where "the rest of the input" seems like it should sit to the right of the present result. Your StateLT strikes me as the "right" StateT, and I would support its addition to the ecosystem somewhere. 2. The functions you request take their arguments in the "wrong" order. I think it's more natural to go with this type: mapAccumLM, mapAccumRM :: (Traversable t, Monad m) => (b -> a -> m (a,c)) -> t b -> a -> m (a, t c) On Sun, Sep 2, 2018, 11:38 PM Reed Mullanix wrote: > I propose adding a pair of functions to Data.Traversable: mapAccumLM and > mapAccumRM with the type '(Traversable t, Monad m) => (a -> b -> m (a,c)) > -> a -> t b -> m (a, t c)'. These would behave exactly the same as > mapAccumL and mapAccumR, but would allow the addition of monadic effects. > > This would allow the traversal of structures with an accumulator, without > resorting to using foldlM or foldrM, both of which require the extra > boilerplate of reconstructing the structure after applying the action, > which can be somewhat frustrating and error-prone. > > A possible implementation would be to add transformer counterparts to > StateL/StateR in Data.Functor.Util: (gist: > https://gist.github.com/TOTBWF/dc6020be28df7b00372ab8e507aa54b7) > > newtype StateLT s m a = StateLT { runStateLT :: s -> m (s,a) } > > instance (Functor m) => Functor (StateLT s m) where > fmap f (StateLT k) = StateLT $ \s -> fmap (\(s',a) -> (s', f a)) $ k > s > > instance Monad m => Applicative (StateLT s m) where > pure a = StateLT $ \s -> return (s, a) > StateLT kf <*> StateLT kv = StateLT $ \s -> do > (s', f) <- kf s > (s'', v) <- kv s' > return (s'', f v) > liftA2 f (StateLT kx) (StateLT ky) = StateLT $ \s -> do > (s', x) <- kx s > (s'', y) <- ky s' > return (s'', f x y) > > mapAccumLM :: (Monad m, Traversable t) => (a -> b -> m (a,c)) -> a -> > t b -> m (a, t c) > mapAccumLM f s t = runStateLT (traverse (StateLT . flip f) t) s > > newtype StateRT s m a = StateRT { runStateRT :: s -> m (s,a) } > > type StateR s = StateRT s Identity > > instance (Functor m) => Functor (StateRT s m) where > fmap f (StateRT k) = StateRT $ \s -> fmap (\(s',a) -> (s', f a)) $ k > s > > instance Monad m => Applicative (StateRT s m) where > pure a = StateRT $ \s -> return (s, a) > StateRT kf <*> StateRT kv = StateRT $ \s -> do > (s', v) <- kv s > (s'', f) <- kf s' > return (s'', f v) > liftA2 f (StateRT kx) (StateRT ky) = StateRT $ \s -> do > (s', y) <- ky s > (s'', x) <- kx s' > return (s'', f x y) > > mapAccumRM :: (Monad m, Traversable t) => (a -> b -> m (a,c)) -> a -> > t b -> m (a, t c) > mapAccumRM f s t = runStateRT (traverse (StateRT . flip f) t) s > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > -------------- next part -------------- An HTML attachment was scrubbed... URL: From andrew.thaddeus at gmail.com Sat Sep 8 13:34:33 2018 From: andrew.thaddeus at gmail.com (Andrew Martin) Date: Sat, 8 Sep 2018 09:34:33 -0400 Subject: GC-Managed ByteArray Slicing Message-ID: In GHC Haskell, there are two common options for working with bytes in memory: data ByteArray = ByteArray ByteArray# data ByteSlice = ByteSlice ByteArray# Int# Int# The second one, ByteSlice, is roughly what the bytestring library does (but with a ForeignPtr instead of a ByteArray# inside of it). What's unfortunate is that it's difficult to know which of these two types is going to provide better performance for a given application. These heuristics are helpful for guiding the process: 1. The longer the data is going to be around, the better the unsliced variant will be. This point is about space efficiency. The sliced variant needs two extra machine words to hold those indices, plus it holds on to extra bytes from the array that it is slicing into. 2. The shorter the data is going to be around, the better the sliced variant is. This point is about speed of execution. The cost of the unsliced variant is typically a memcpy. If the data is getting GCed quickly anyway, the unsliced copy doesn't save you any space. 3. The shorter the data is, the better the unsliced variant is. 4. The more sharing of the data there is, the better the sliced variant is. But, users have to commit to which one they want to use in their data type definitions, and the data type may be used in different contexts where one or the other is preferable. For example, consider the following: data Student = Student { name :: {-# UNPACK #-} !BytesType , grade :: {-# UNPACK #-} !Int } Which of the two types should we use for BytesType? (For this example, ignore the incorrectness of using bytes to represent text. With either of the two bytes types, it's easy to put a newtype on top that communicates that what's inside is guaranteed to be UTF-8 encoded text). It depends on the usage. For example, consider that we are parsing students from this xml file: Erica Chang 87 Lizbeth Cruz 91 ... Let's say we've got about 1GB of this, and we run a parser on 64KB chunks as they are read from disk. There are two contasting scenarios to consider. If the file is parsed at startup and the resulting array of students is kept in memory for a long time afterward, then the unsliced variant is better. It allows us to throw away all of the bytes corresponding to the xml nodes, which are no longer relevant. The sliced variant, by constrast, would keep the entire contents of the original file in memory. However, if the file is parsed by a SAX-style streaming parser, the students being parsed, processed, and then discarded as they encountered, the sliced variant is better. Slicing wins here because the chunks from the file are discarded shortly after they are encountered. Read "shortly" as "before the next minor GC". In this example, Student was an application-specific data type, so the application author could figure out what they were actually doing with the data and define the data type accordingly. However, this isn't always a solution. What if they needed to use the same type differently in different contexts? What if the type was provided by a library and the library author doesn't know how it will be used? So far, this has just been an explanation of a problem that I've noticed. I understand the problem well, but now I'm going to propose a solution. There are a lot of holes in my understanding of GHC's runtime, so I don't understand if what I'm proposing is actually plausible. What if the GHC's runtime handled the copy decisions for us? What if we had these primitives: data Bytes# sliceBytes# :: Bytes# -> Int# -> Int# -> Bytes# lengthBytes# :: Bytes# -> Int# Slicing causes the runtime to track that there is an additional reference to the byte array but that the offset and length are different. I'm not sure where this information would be stored though. When GC runs, it would copy slices from bytes if the there were no longer any references to the entire array. So a single type could serve the both purposes discussed in the scenario above. I'm not sure what kind of impact this might have on GC time. -- -Andrew Thaddeus Martin -------------- next part -------------- An HTML attachment was scrubbed... URL: From ekmett at gmail.com Sat Sep 8 16:34:30 2018 From: ekmett at gmail.com (Edward Kmett) Date: Sat, 8 Sep 2018 09:34:30 -0700 Subject: GC-Managed ByteArray Slicing In-Reply-To: References: Message-ID: I wouldn't recommend doing this to the existing ByteArray#, but for a separate type it could be nice with some caveats. 1.) It's probably not that you want to copy out slices when there are no references to the whole array but rather that you can keep the smallest containing sub-interval of the Bytes# that contain all references. In your story, if I slice to take its tail and then take that things tail. I'd double my storage requirement after GC for large Bytes# when I drop the reference to the original. This is a bit of an orthogonal strategy to the one you propose, but the one you propose has problems in that I probably should carefully memoize the results per slice somehow to maximize sharing in the result, which complicates the implementation a lot. If on the other hand, these slices are not allowed to nest then you don't have either problem, but that sounds like a nightmare waiting to happen to debug. 2.) You'd probably have a hard time doing the move during GC because you don't really get to know the space of all references in before you have to move to to-space. This is further complicated by multiple generations even if you conspire some way to procrastinate and delay the move til after you move everything else and have found the largest sub-interval for the current generation's references. One way to this would be to do something like track a min/max bound per generation in the object itself of the largest containing intervals that are wanted, and during a gc when you copy the thing from from space to to space you copy over the interval from the min bound from of all generations to the max bound from all generations, then reset the current generations bounds to be something like (maxPos,minPos) and as you find more references to sub-slices it'll grow by continually mutating these secret mutable fields inside the object to tell the next GC how much it can clean things up based solely on the contents referenced from this generation. -Edward On Sat, Sep 8, 2018 at 6:35 AM Andrew Martin wrote: > In GHC Haskell, there are two common options for working with bytes in > memory: > > data ByteArray = ByteArray ByteArray# > data ByteSlice = ByteSlice ByteArray# Int# Int# > > The second one, ByteSlice, is roughly what the bytestring library does > (but with a ForeignPtr instead of a ByteArray# inside of it). What's > unfortunate is that it's difficult to know which of these two types is > going to provide better performance for a given application. These > heuristics are helpful for guiding the process: > > 1. The longer the data is going to be around, the better the unsliced > variant will be. This point is about space efficiency. The sliced variant > needs two extra machine words to hold those indices, plus it holds on to > extra bytes from the array that it is slicing into. > 2. The shorter the data is going to be around, the better the sliced > variant is. This point is about speed of execution. The cost of the > unsliced variant is typically a memcpy. If the data is getting GCed quickly > anyway, the unsliced copy doesn't save you any space. > 3. The shorter the data is, the better the unsliced variant is. > 4. The more sharing of the data there is, the better the sliced > variant is. > > But, users have to commit to which one they want to use in their data type > definitions, and the data type may be used in different contexts where one > or the other is preferable. For example, consider the following: > > data Student = Student > { name :: {-# UNPACK #-} !BytesType > , grade :: {-# UNPACK #-} !Int > } > > Which of the two types should we use for BytesType? (For this example, > ignore the incorrectness of using bytes to represent text. With either of > the two bytes types, it's easy to put a newtype on top that communicates > that what's inside is guaranteed to be UTF-8 encoded text). It depends on > the usage. For example, consider that we are parsing students from this xml > file: > > > > Erica Chang > 87 > > > Lizbeth Cruz > 91 > > ... > > > Let's say we've got about 1GB of this, and we run a parser on 64KB chunks > as they are read from disk. There are two contasting scenarios to consider. > > If the file is parsed at startup and the resulting array of students is > kept in memory for a long time afterward, then the unsliced variant is > better. It allows us to throw away all of the bytes corresponding to the > xml nodes, which are no longer relevant. The sliced variant, by constrast, > would keep the entire contents of the original file in memory. > > However, if the file is parsed by a SAX-style streaming parser, the > students being parsed, processed, and then discarded as they encountered, > the sliced variant is better. Slicing wins here because the chunks from the > file are discarded shortly after they are encountered. Read "shortly" as > "before the next minor GC". > > In this example, Student was an application-specific data type, so the > application author could figure out what they were actually doing with the > data and define the data type accordingly. However, this isn't always a > solution. What if they needed to use the same type differently in different > contexts? What if the type was provided by a library and the library author > doesn't know how it will be used? > > So far, this has just been an explanation of a problem that I've noticed. > I understand the problem well, but now I'm going to propose a solution. > There are a lot of holes in my understanding of GHC's runtime, so I don't > understand if what I'm proposing is actually plausible. > > What if the GHC's runtime handled the copy decisions for us? What if we > had these primitives: > > data Bytes# > sliceBytes# :: Bytes# -> Int# -> Int# -> Bytes# > lengthBytes# :: Bytes# -> Int# > > Slicing causes the runtime to track that there is an additional reference > to the byte array but that the offset and length are different. I'm not > sure where this information would be stored though. When GC runs, it would > copy slices from bytes if the there were no longer any references to the > entire array. So a single type could serve the both purposes discussed in > the scenario above. I'm not sure what kind of impact this might have on GC > time. > > -- > -Andrew Thaddeus Martin > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ndospark320 at gmail.com Mon Sep 17 05:37:58 2018 From: ndospark320 at gmail.com (Dannyu NDos) Date: Mon, 17 Sep 2018 14:37:58 +0900 Subject: Add fixity for (==) and (/=) Message-ID: Given that they are instantized for `Bool`s, they are associative, so it seems approvable to give them a fixity. (Sidenote: For the monoid over (==) I suggested on last May, I stated that it determines if there is an even number of `True`s, but that's wrong. It determines if there is an odd number of `False`s.) -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Mon Sep 17 08:29:13 2018 From: david.feuer at gmail.com (David Feuer) Date: Mon, 17 Sep 2018 04:29:13 -0400 Subject: Add fixity for (==) and (/=) In-Reply-To: References: Message-ID: Please write out the associativity proofs! On Mon, Sep 17, 2018, 1:38 AM Dannyu NDos wrote: > Given that they are instantized for `Bool`s, they are associative, so it > seems approvable to give them a fixity. > > (Sidenote: For the monoid over (==) I suggested on last May, I stated that > it determines if there is an even number of `True`s, but that's wrong. It > determines if there is an odd number of `False`s.) > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ndospark320 at gmail.com Mon Sep 17 09:20:37 2018 From: ndospark320 at gmail.com (Dannyu NDos) Date: Mon, 17 Sep 2018 18:20:37 +0900 Subject: Fwd: Add fixity for (==) and (/=) In-Reply-To: References: Message-ID: ---------- Forwarded message --------- From: Dannyu NDos Date: 2018년 9월 17일 (월) 오후 6:18 Subject: Re: Add fixity for (==) and (/=) To: Proof by truth table (F is False, T is True): p q r (p == q) (q == r) ((p == q) == r) (p == (q == r)) F F F T T F F F F T T F T T F T F F F T T F T T F T F F T F F F T T T T F T F F F F T T F T F F F T T T T T T T That proves associativity of (==). Also note that p /= q ≡ not p == q. Proof: p q (p /= q) (not p) (not p == q) F F F T F F T T T T T F T F T T T F F F And by symmetry of (/=), p /= q ≡ p == not q. Then: (p /= q) /= r ≡ (not p == q) == not r ≡ not p == (q == not r) ≡ p /= (q /= r). Hence (/=) is associative. Q.E.D. -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Mon Sep 17 09:22:09 2018 From: david.feuer at gmail.com (David Feuer) Date: Mon, 17 Sep 2018 05:22:09 -0400 Subject: Add fixity for (==) and (/=) In-Reply-To: References: Message-ID: Looks good to me! Do you have an opinion about infixl vs infixr? On Mon, Sep 17, 2018, 5:21 AM Dannyu NDos wrote: > > > ---------- Forwarded message --------- > From: Dannyu NDos > Date: 2018년 9월 17일 (월) 오후 6:18 > Subject: Re: Add fixity for (==) and (/=) > To: > > > Proof by truth table (F is False, T is True): > p q r (p == q) (q == r) ((p == q) == r) (p == (q == r)) > F F F T T F F > F F T T F T T > F T F F F T T > F T T F T F F > T F F F T T T > T F T F F F F > T T F T F F F > T T T T T T T > That proves associativity of (==). > > Also note that p /= q ≡ not p == q. Proof: > p q (p /= q) (not p) (not p == q) > F F F T F > F T T T T > T F T F T > T T F F F > And by symmetry of (/=), p /= q ≡ p == not q. > > Then: > (p /= q) /= r ≡ (not p == q) == not r ≡ not p == (q == not r) ≡ p /= (q /= > r). > Hence (/=) is associative. > > Q.E.D. > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ndospark320 at gmail.com Mon Sep 17 09:28:52 2018 From: ndospark320 at gmail.com (Dannyu NDos) Date: Mon, 17 Sep 2018 18:28:52 +0900 Subject: Add fixity for (==) and (/=) In-Reply-To: References: Message-ID: Well, infixr is friendlier to parsers. 2018년 9월 17일 (월) 오후 6:22, David Feuer 님이 작성: > Looks good to me! Do you have an opinion about infixl vs infixr? > > Libraries mailing list >> Libraries at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From andrew.lelechenko at gmail.com Mon Sep 17 12:39:58 2018 From: andrew.lelechenko at gmail.com (andrew.lelechenko at gmail.com) Date: Mon, 17 Sep 2018 13:39:58 +0100 Subject: Fwd: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` References: Message-ID: (Alexandre asked me to forward the email below on his behalf, because he is experiencing technical difficulties with this mail list. — Andrew) Greetings CLC; I'm writing this email to propose a change to `Data.Fixed`. Full credit for this idea goes to Bhavik Mehta (@b-mehta on GitHub), who implemented it in this PR for `exact-pi`. In `Data.Fixed` there are several `E`-prefixed datatypes used to represent a certain number of digits of precision in fixed-precision arithmetic. For example, `E1` has 1 decimal place, `E12` has 12. Each of them, `E{0,1,2,3,6,9,12}` is hardcoded. If more precision types are to be provided, they have to be hardcoded as well, and all of these types resemble each other. I think there is room for improvement here. Instead of having ``` data E0 instance HasResolution E0 where resolution _ = 1 ``` and repeating it as many times as there are `E` datatypes, I propose to add the following type: ``` {-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures #-} import GHC.TypeLits (Nat, KnownNat, natVal) data E (n :: Nat) ``` and then do ``` instance KnownNat n => HasResolution (E n) where resolution _ = 10^natVal (undefined :: E n) ``` just once, replacing `data E0` with `type E0 = E 0` (and the same for the rest of them) to continue reexporting these types. `E` should also be exported. I have created a Trac feature request ticket with the same contents as this email, and made a PR to GHC’s repository on GitHub. To finalize, there are a few topics I’d like to raise regarding this change. 1. Does the community find this change beneficial in general? 2. Does the community approve of using DataKinds in a mundane section of the base package? 3. Does everyone accept a small breaking change of E0, E1, etc. from a data type to a type synonym? Or should we go the conservative way and just add E without refactoring E0, E1, etc.? Regards, Alexandre -------------- next part -------------- An HTML attachment was scrubbed... URL: From lemming at henning-thielemann.de Mon Sep 17 18:37:15 2018 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Mon, 17 Sep 2018 20:37:15 +0200 (CEST) Subject: Fwd: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` In-Reply-To: References: Message-ID: On Mon, 17 Sep 2018, andrew.lelechenko at gmail.com wrote: > Instead of having > > ``` > data E0 > > instance HasResolution E0 where >     resolution _ = 1 > ``` > > and repeating it as many times as there are `E` datatypes, I propose to add the following type: > > ``` > {-# LANGUAGE DataKinds      #-} > {-# LANGUAGE KindSignatures #-} > > import GHC.TypeLits (Nat, KnownNat, natVal) > > data E (n :: Nat) > ``` I'd prefer a Haskell 98 solution and simply use type level Peano numbers and define E0, E3 etc. as type synonyms. If this is not sufficiently compatible we could setup a new module. From david.feuer at gmail.com Mon Sep 17 18:44:07 2018 From: david.feuer at gmail.com (David Feuer) Date: Mon, 17 Sep 2018 14:44:07 -0400 Subject: Fwd: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` In-Reply-To: References: Message-ID: Indeed, it's reasonable to mix and match Peano naturals with TypeLits. But that's easily done in a library that exposes a Haskell 98 interface over a TypeLits-based implementation. I don't think everyone should have to pay the potential efficiency price of Peano naturals for the sake of standards purity. On Mon, Sep 17, 2018, 2:37 PM Henning Thielemann < lemming at henning-thielemann.de> wrote: > > On Mon, 17 Sep 2018, andrew.lelechenko at gmail.com wrote: > > > Instead of having > > > > ``` > > data E0 > > > > instance HasResolution E0 where > > resolution _ = 1 > > ``` > > > > and repeating it as many times as there are `E` datatypes, I propose to > add the following type: > > > > ``` > > {-# LANGUAGE DataKinds #-} > > {-# LANGUAGE KindSignatures #-} > > > > import GHC.TypeLits (Nat, KnownNat, natVal) > > > > data E (n :: Nat) > > ``` > > I'd prefer a Haskell 98 solution and simply use type level Peano numbers > and define E0, E3 etc. as type synonyms. If this is not sufficiently > compatible we could setup a new > module._______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > -------------- next part -------------- An HTML attachment was scrubbed... URL: From chr.maeder at web.de Tue Sep 18 09:34:39 2018 From: chr.maeder at web.de (C Maeder) Date: Tue, 18 Sep 2018 11:34:39 +0200 Subject: Add fixity for (==) and (/=) In-Reply-To: References: Message-ID: Hi, infixr seeems right for an equivalence (==) since implication is usually also right associative. Implication "==>" corresponds to "<=" on Bool, which might be confusing. Reverse implication (>=) should be left associative, then. Cheers Christian Am 17.09.2018 um 11:28 schrieb Dannyu NDos: > Well, infixr is friendlier to parsers. > > 2018년 9월 17일 (월) 오후 6:22, David Feuer >님이 작성: > > Looks good to me! Do you have an opinion about infixl vs infixr? > > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > > > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > From emertens at gmail.com Tue Sep 18 15:34:41 2018 From: emertens at gmail.com (Eric Mertens) Date: Tue, 18 Sep 2018 08:34:41 -0700 Subject: Add fixity for (==) and (/=) In-Reply-To: References: Message-ID: Do we have any other good examples where we've got an operator that is considered associative where the result type isn't identical to the argument types? It's much more common to allow the types to vary when there's only one associativity that makes sense for the way an operator is intended to be used. a -> a -> a While it's true that focusing on Bool, (==) satisfies associativity in its truth table, the types don't work out so cleanly. Outside of Bool it starts to matter which associativity you pick. (\x y z -> (x == y) == z) :: Eq a => a -> a -> Bool -> Bool (\x y z -> x == (y == z)) :: Eq a => Bool -> a -> a -> Bool Making == associative is just going to lead to harder to understand code and will require people to memorize which arbitrary choice about the associativity of the operation was selected by the mailing list in order to make sense of the types of code using multiple ==. I see no gain here, and I'd prefer to leave == as is. Best regards, Eric Mertens On Tue, Sep 18, 2018 at 2:34 AM C Maeder wrote: > Hi, > > infixr seeems right for an equivalence (==) since implication is usually > also right associative. > > Implication "==>" corresponds to "<=" on Bool, which might be confusing. > Reverse implication (>=) should be left associative, then. > > Cheers Christian > > Am 17.09.2018 um 11:28 schrieb Dannyu NDos: > > Well, infixr is friendlier to parsers. > > > > 2018년 9월 17일 (월) 오후 6:22, David Feuer > >님이 작성: > > > > Looks good to me! Do you have an opinion about infixl vs infixr? > > > > Libraries mailing list > > Libraries at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > > > > > > > > _______________________________________________ > > Libraries mailing list > > Libraries at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > > > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ndospark320 at gmail.com Tue Sep 18 15:45:49 2018 From: ndospark320 at gmail.com (Dannyu NDos) Date: Wed, 19 Sep 2018 00:45:49 +0900 Subject: Add fixity for (==) and (/=) In-Reply-To: References: Message-ID: Well, the motivation to make them associative was that (==) is logical XNOR, and (/=) is logical XOR. Perhaps we want an alias for Bool-instantization of them. 2018년 9월 19일 (수) 00:34, Eric Mertens 님이 작성: > Do we have any other good examples where we've got an operator that is > considered associative where the result type isn't identical to the > argument types? It's much more common to allow the types to vary when > there's only one associativity that makes sense for the way an operator is > intended to be used. > > a -> a -> a > > While it's true that focusing on Bool, (==) satisfies associativity in its > truth table, the types don't work out so cleanly. Outside of Bool it starts > to matter which associativity you pick. > > (\x y z -> (x == y) == z) :: Eq a => a -> a -> Bool -> Bool > > (\x y z -> x == (y == z)) :: Eq a => Bool -> a -> a -> Bool > > Making == associative is just going to lead to harder to understand code > and will require people to memorize which arbitrary choice about the > associativity of the operation was selected by the mailing list in order to > make sense of the types of code using multiple ==. > > I see no gain here, and I'd prefer to leave == as is. > > Best regards, > Eric Mertens > -------------- next part -------------- An HTML attachment was scrubbed... URL: From rae at cs.brynmawr.edu Tue Sep 18 15:57:17 2018 From: rae at cs.brynmawr.edu (Richard Eisenberg) Date: Tue, 18 Sep 2018 11:57:17 -0400 Subject: Add fixity for (==) and (/=) In-Reply-To: References: Message-ID: <4F8E09FB-3D1D-4F88-A340-9FAB24B691A0@cs.brynmawr.edu> +1 to Eric's argument here. I would prefer to leave these fixities out. Of course, defining Bool-specific instantiations with fixities is a fine idea. Richard > On Sep 18, 2018, at 11:34 AM, Eric Mertens wrote: > > Do we have any other good examples where we've got an operator that is considered associative where the result type isn't identical to the argument types? It's much more common to allow the types to vary when there's only one associativity that makes sense for the way an operator is intended to be used. > > a -> a -> a > > While it's true that focusing on Bool, (==) satisfies associativity in its truth table, the types don't work out so cleanly. Outside of Bool it starts to matter which associativity you pick. > > (\x y z -> (x == y) == z) :: Eq a => a -> a -> Bool -> Bool > > (\x y z -> x == (y == z)) :: Eq a => Bool -> a -> a -> Bool > > > Making == associative is just going to lead to harder to understand code and will require people to memorize which arbitrary choice about the associativity of the operation was selected by the mailing list in order to make sense of the types of code using multiple ==. > > I see no gain here, and I'd prefer to leave == as is. > > Best regards, > Eric Mertens > > > On Tue, Sep 18, 2018 at 2:34 AM C Maeder > wrote: > Hi, > > infixr seeems right for an equivalence (==) since implication is usually > also right associative. > > Implication "==>" corresponds to "<=" on Bool, which might be confusing. > Reverse implication (>=) should be left associative, then. > > Cheers Christian > > Am 17.09.2018 um 11:28 schrieb Dannyu NDos: > > Well, infixr is friendlier to parsers. > > > > 2018년 9월 17일 (월) 오후 6:22, David Feuer > > >>님이 작성: > > > > Looks good to me! Do you have an opinion about infixl vs infixr? > > > > Libraries mailing list > > Libraries at haskell.org > > > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > > > > > > > > _______________________________________________ > > Libraries mailing list > > Libraries at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > > > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries -------------- next part -------------- An HTML attachment was scrubbed... URL: From lennart at augustsson.net Tue Sep 18 15:58:06 2018 From: lennart at augustsson.net (Lennart Augustsson) Date: Tue, 18 Sep 2018 08:58:06 -0700 Subject: Add fixity for (==) and (/=) In-Reply-To: References: Message-ID: The (==) and (/=) operators are non-associative on purpose. Writing x==y==z is much more likely to be a typo than a legitimate use case. We decided to make them non-associative, even though they are associative. (Note that they have fixity already.) On Sun, Sep 16, 2018 at 22:38 Dannyu NDos wrote: > Given that they are instantized for `Bool`s, they are associative, so it > seems approvable to give them a fixity. > > (Sidenote: For the monoid over (==) I suggested on last May, I stated that > it determines if there is an even number of `True`s, but that's wrong. It > determines if there is an odd number of `False`s.) > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > -------------- next part -------------- An HTML attachment was scrubbed... URL: From emertens at gmail.com Tue Sep 18 15:58:18 2018 From: emertens at gmail.com (Eric Mertens) Date: Tue, 18 Sep 2018 08:58:18 -0700 Subject: Add fixity for (==) and (/=) In-Reply-To: References: Message-ID: > On Sep 18, 2018, at 8:45 AM, Dannyu NDos wrote: > > Well, the motivation to make them associative was that (==) is logical XNOR, and (/=) is logical XOR. Perhaps we want an alias for Bool-instantization of them. We already have such an binary operation in base that is associative: xor. >>> import Data.Bits >>> :i xor class Eq a => Bits a where ... xor :: a -> a -> a ... -- Defined in ‘Data.Bits’ >>> True `xor` False `xor` True False The thing that would be missing is an xnor operation in Data.Bits. -- Eric -------------- next part -------------- An HTML attachment was scrubbed... URL: From andrew.lelechenko at gmail.com Wed Sep 19 19:30:29 2018 From: andrew.lelechenko at gmail.com (Andrew Lelechenko) Date: Wed, 19 Sep 2018 20:30:29 +0100 Subject: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` In-Reply-To: References: Message-ID: <480CD53F-02C4-45F0-9588-478AD896FD36@gmail.com> I am fine with the change proposed by Alexandre and I am also OK with DataKinds. Frankly speaking, I cannot think of any practical reason why we should be shy to use this extension. With regards to the amount of breakage, introduced by the change, I grepped the whole Hackage for instance.*\b(E0|Uni|E1|Deci|E2|Centi|E3|Milli|E6|Micro|E9|Nano|E12|Pico)\b There are matching lines in `thyme-0.3.5.5`, but it appears to be instances for Data.Thyme.Internal.Micro.Micro and not for Data.Fixed.Micro. It also matched `units-2.4.1`, `units-defs-2.0.1`, `unittyped-0.1`, `zm-0.3.2`, but again these are Deci/Centi/Milli/Micro/Nano/Pico defined locally. The only relevant match is in xlsx-0.7.2/test/CommonTests.hs: instance Monad m => Serial m (Fixed E12) where ... but it is an instance for Fixed E12 and not for E12 itself. And this module enables FlexibleInstances already. That said, it seems to me that the breaking change, switching E0/E1/… from data type to type synonym, would not actually affect anyone. — Best regards, Andrew > On 17 Sep 2018, at 19:44, David Feuer wrote: > > Indeed, it's reasonable to mix and match Peano naturals with TypeLits. But that's easily done in a library that exposes a Haskell 98 interface over a TypeLits-based implementation. I don't think everyone should have to pay the potential efficiency price of Peano naturals for the sake of standards purity. > > On Mon, Sep 17, 2018, 2:37 PM Henning Thielemann wrote: > > On Mon, 17 Sep 2018, andrew.lelechenko at gmail.com wrote: > > > Instead of having > > > > ``` > > data E0 > > > > instance HasResolution E0 where > > resolution _ = 1 > > ``` > > > > and repeating it as many times as there are `E` datatypes, I propose to add the following type: > > > > ``` > > {-# LANGUAGE DataKinds #-} > > {-# LANGUAGE KindSignatures #-} > > > > import GHC.TypeLits (Nat, KnownNat, natVal) > > > > data E (n :: Nat) > > ``` > > I'd prefer a Haskell 98 solution and simply use type level Peano numbers > and define E0, E3 etc. as type synonyms. If this is not sufficiently > compatible we could setup a new module._______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries From andrew.thaddeus at gmail.com Thu Sep 20 12:50:04 2018 From: andrew.thaddeus at gmail.com (Andrew Martin) Date: Thu, 20 Sep 2018 08:50:04 -0400 Subject: Touching unlifted values Message-ID: The touch# primitive accepts a levity-polymorphic argument. I am wondering if there is ever any difference between using it on a lifted value and an unlifted value. Consider the following: module Lifted where import Control.Monad.ST (runST) import Control.Monad.Primitive (touch) import Data.Int (Int64) import Data.Primitive (newPinnedByteArray,mutableByteArrayContents,readOffAddr,writeOffAddr) computation :: Int64 computation = runST $ do arr <- newPinnedByteArray 8 let addr = mutableByteArrayContents arr writeOffAddr addr 0 (42 :: Int64) i <- readOffAddr addr 0 touch arr return i Calling touch on the mutable byte array is necessary to make sure that the memory that the Addr points doesn't get GCed while we are writing and reading to and from it. Here is the relevant GHC core (compiled with -O2): -- RHS size: {terms: 32, types: 67, coercions: 19, joins: 0/1} computation1 computation1 = \ s1_a24R -> case newPinnedByteArray# 8# (s1_a24R `cast` ) of { (# ipv_a246, ipv1_a247 #) -> let { addr_s273 addr_s273 = byteArrayContents# (ipv1_a247 `cast` ) } in case writeInt64OffAddr# addr_s273 0# 42# ipv_a246 of s'#_a24p { __DEFAULT -> case readInt64OffAddr# addr_s273 0# s'#_a24p of { (# ipv2_a267, ipv3_a268 #) -> case touch# ((MutableByteArray ipv1_a247) `cast` ) (ipv2_a267 `cast` ) of s'_a24K { __DEFAULT -> (# s'_a24K, I64# ipv3_a268 #) } } } } -- RHS size: {terms: 5, types: 30, coercions: 0, joins: 0/0} computation computation = case runRW# computation1 of { (# ipv_a239, ipv1_a23a #) -> ipv1_a23a } Instead, what if we touched the underlying unlifted MutableByteArray#? Here is the code for doing this: {-# language MagicHash #-} {-# language UnboxedTuples #-} module Unlifted ( computation ) where import System.IO.Unsafe (unsafeDupablePerformIO) import Control.Monad.Primitive (unsafePrimToPrim,primitive,PrimState,PrimMonad) import Data.Int (Int64) import Data.Primitive (MutableByteArray(..),newPinnedByteArray,mutableByteArrayContents,readOffAddr,writeOffAddr) import GHC.Exts (touch#,MutableByteArray#) computation :: Int64 computation = unsafeDupablePerformIO $ do arr@(MutableByteArray arr#) <- newPinnedByteArray 8 let addr = mutableByteArrayContents arr writeOffAddr addr 0 (42 :: Int64) i <- readOffAddr addr 0 touchUnlifted arr# return i touchUnlifted :: PrimMonad m => MutableByteArray# (PrimState m) -> m () touchUnlifted x = unsafePrimToPrim $ (primitive (\s -> case touch# x s of { s' -> (# s', () #) }) :: IO ()) GHC generates the following core for this module (again, omitting irrelevant parts): computation1 computation1 = \ s_a49h -> case newPinnedByteArray# 8# (s_a49h `cast` ) of { (# ipv_a48a, ipv1_a48b #) -> let { addr_s4aY addr_s4aY = byteArrayContents# (ipv1_a48b `cast` ) } in case writeInt64OffAddr# addr_s4aY 0# 42# ipv_a48a of s'#_a48A { __DEFAULT -> case readInt64OffAddr# addr_s4aY 0# s'#_a48A of { (# ipv2_a4aq, ipv3_a4ar #) -> case touch# ipv1_a48b (ipv2_a4aq `cast` ) of s'_a2xn { __DEFAULT -> (# s'_a2xn, I64# ipv3_a4ar #) } } } } -- RHS size: {terms: 5, types: 30, coercions: 0, joins: 0/0} computation computation = case runRW# computation1 of { (# ipv_a47X, ipv1_a47Y #) -> ipv1_a47Y } I feel confident that both of these are semantically equivalent. Both uses of touch# should keep the MutableByteArray# alive until we are done using the pointer we extracted from it. What I'm less sure about is whether or not the first one actually does an alloctation for the MutableByteArray data constructor when it calls touch. Is this eliminated in some other stage of compilation? -- -Andrew Thaddeus Martin -------------- next part -------------- An HTML attachment was scrubbed... URL: From carter.schonwald at gmail.com Fri Sep 21 00:28:56 2018 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Thu, 20 Sep 2018 20:28:56 -0400 Subject: Touching unlifted values In-Reply-To: References: Message-ID: Hey Andrew, theres definitely optimizations in ghc that (roughly? i'm not the best expert) unwrap / optimize away single constructor data types in certain cases (haha, cases), I forget the name of the specific optimization, but its a pretty well documented one in ghc I think its the CPR analysis? I could be wrong https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/Demand (i could be wrong though) either way, i seem to recall you'll be at ICFP next week, so thats def a venue i or someone else can help you sleuth it at On Thu, Sep 20, 2018 at 8:50 AM Andrew Martin wrote: > The touch# primitive accepts a levity-polymorphic argument. I am wondering > if there is ever any difference between using it on a lifted value and an > unlifted value. Consider the following: > > module Lifted where > > import Control.Monad.ST (runST) > import Control.Monad.Primitive (touch) > import Data.Int (Int64) > import Data.Primitive > (newPinnedByteArray,mutableByteArrayContents,readOffAddr,writeOffAddr) > > computation :: Int64 > computation = runST $ do > arr <- newPinnedByteArray 8 > let addr = mutableByteArrayContents arr > writeOffAddr addr 0 (42 :: Int64) > i <- readOffAddr addr 0 > touch arr > return i > > Calling touch on the mutable byte array is necessary to make sure that the > memory that the Addr points doesn't get GCed while we are writing and > reading to and from it. Here is the relevant GHC core (compiled with -O2): > > -- RHS size: {terms: 32, types: 67, coercions: 19, joins: 0/1} > computation1 > computation1 > = \ s1_a24R -> > case newPinnedByteArray# 8# (s1_a24R `cast` ) of > { (# ipv_a246, ipv1_a247 #) -> > let { > addr_s273 > addr_s273 = byteArrayContents# (ipv1_a247 `cast` ) } in > case writeInt64OffAddr# addr_s273 0# 42# ipv_a246 of s'#_a24p > { __DEFAULT -> > case readInt64OffAddr# addr_s273 0# s'#_a24p of > { (# ipv2_a267, ipv3_a268 #) -> > case touch# > ((MutableByteArray ipv1_a247) `cast` ) > (ipv2_a267 `cast` ) > of s'_a24K > { __DEFAULT -> > (# s'_a24K, I64# ipv3_a268 #) > } > } > } > } > > -- RHS size: {terms: 5, types: 30, coercions: 0, joins: 0/0} > computation > computation > = case runRW# computation1 of { (# ipv_a239, ipv1_a23a #) -> > ipv1_a23a > } > > Instead, what if we touched the underlying unlifted MutableByteArray#? > Here is the code for doing this: > > {-# language MagicHash #-} > {-# language UnboxedTuples #-} > > module Unlifted > ( computation > ) where > > import System.IO.Unsafe (unsafeDupablePerformIO) > import Control.Monad.Primitive > (unsafePrimToPrim,primitive,PrimState,PrimMonad) > import Data.Int (Int64) > import Data.Primitive > (MutableByteArray(..),newPinnedByteArray,mutableByteArrayContents,readOffAddr,writeOffAddr) > import GHC.Exts (touch#,MutableByteArray#) > > computation :: Int64 > computation = unsafeDupablePerformIO $ do > arr@(MutableByteArray arr#) <- newPinnedByteArray 8 > let addr = mutableByteArrayContents arr > writeOffAddr addr 0 (42 :: Int64) > i <- readOffAddr addr 0 > touchUnlifted arr# > return i > > touchUnlifted :: PrimMonad m => MutableByteArray# (PrimState m) -> m () > touchUnlifted x = unsafePrimToPrim > $ (primitive (\s -> case touch# x s of { s' -> (# s', () #) }) :: IO > ()) > > GHC generates the following core for this module (again, omitting > irrelevant parts): > > computation1 > computation1 > = \ s_a49h -> > case newPinnedByteArray# 8# (s_a49h `cast` ) of > { (# ipv_a48a, ipv1_a48b #) -> > let { > addr_s4aY > addr_s4aY = byteArrayContents# (ipv1_a48b `cast` ) } in > case writeInt64OffAddr# addr_s4aY 0# 42# ipv_a48a of s'#_a48A > { __DEFAULT -> > case readInt64OffAddr# addr_s4aY 0# s'#_a48A of > { (# ipv2_a4aq, ipv3_a4ar #) -> > case touch# ipv1_a48b (ipv2_a4aq `cast` ) of s'_a2xn > { __DEFAULT -> > (# s'_a2xn, I64# ipv3_a4ar #) > } > } > } > } > > -- RHS size: {terms: 5, types: 30, coercions: 0, joins: 0/0} > computation > computation > = case runRW# computation1 of { (# ipv_a47X, ipv1_a47Y #) -> > ipv1_a47Y > } > > I feel confident that both of these are semantically equivalent. Both uses > of touch# should keep the MutableByteArray# alive until we are done using > the pointer we extracted from it. What I'm less sure about is whether or > not the first one actually does an alloctation for the MutableByteArray > data constructor when it calls touch. Is this eliminated in some other > stage of compilation? > > -- > -Andrew Thaddeus Martin > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > -------------- next part -------------- An HTML attachment was scrubbed... URL: From chessai1996 at gmail.com Fri Sep 28 01:20:21 2018 From: chessai1996 at gmail.com (Daniel Cartwright) Date: Thu, 27 Sep 2018 21:20:21 -0400 Subject: Proposal: Add HasCallStack to the partial functions in base Message-ID: I propose to add `HasCallStack` to all partial functions in base, e.g. `fromJust`, `fromRight`, `fromLeft`, etc. Relevant discussion here: https://ghc.haskell.org/trac/ghc/ticket/15559 -------------- next part -------------- An HTML attachment was scrubbed... URL: From vanessa.mchale at iohk.io Fri Sep 28 01:31:30 2018 From: vanessa.mchale at iohk.io (Vanessa McHale) Date: Thu, 27 Sep 2018 20:31:30 -0500 Subject: Proposal: Add HasCallStack to the partial functions in base In-Reply-To: References: Message-ID: What does "etc." mean? The linked ticket suggests that not all such functions would be candidates. I can't imagine fromJust, fromRight, or fromLeft being used in performance-critical code, so perhaps those would be a good start? On 09/27/2018 08:20 PM, Daniel Cartwright wrote: > I propose to add `HasCallStack` to all partial functions in base, e.g. > `fromJust`, `fromRight`, `fromLeft`, etc. > > Relevant discussion here: https://ghc.haskell.org/trac/ghc/ticket/15559 > > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 488 bytes Desc: OpenPGP digital signature URL: From chessai1996 at gmail.com Fri Sep 28 01:32:47 2018 From: chessai1996 at gmail.com (Daniel Cartwright) Date: Thu, 27 Sep 2018 20:32:47 -0500 Subject: Proposal: Add HasCallStack to the partial functions in base In-Reply-To: References: Message-ID: "etc." Means anything else that might be applicable, I just listed 3 off the top of my head. On Thu, Sep 27, 2018, 8:31 PM Vanessa McHale wrote: > What does "etc." mean? The linked ticket suggests that not all such > functions would be candidates. > > I can't imagine fromJust, fromRight, or fromLeft being used in > performance-critical code, so perhaps those would be a good start? > > On 09/27/2018 08:20 PM, Daniel Cartwright wrote: > > I propose to add `HasCallStack` to all partial functions in base, e.g. > `fromJust`, `fromRight`, `fromLeft`, etc. > > Relevant discussion here: https://ghc.haskell.org/trac/ghc/ticket/15559 > > > _______________________________________________ > Libraries mailing listLibraries at haskell.orghttp://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Fri Sep 28 01:33:07 2018 From: david.feuer at gmail.com (David Feuer) Date: Thu, 27 Sep 2018 21:33:07 -0400 Subject: Proposal: Add HasCallStack to the partial functions in base In-Reply-To: References: Message-ID: I mostly think this is a good idea. However, some care is required to prevent performance problems, especially in recursive functions. Watch out in implementation! Also, these partial functions are sometimes used in non-obviously total contexts, such as the implementation of mfix for lists. We should refrain from introducing code bloat for nothing. On Thu, Sep 27, 2018, 9:20 PM Daniel Cartwright wrote: > I propose to add `HasCallStack` to all partial functions in base, e.g. > `fromJust`, `fromRight`, `fromLeft`, etc. > > Relevant discussion here: https://ghc.haskell.org/trac/ghc/ticket/15559 > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > -------------- next part -------------- An HTML attachment was scrubbed... URL: From lemming at henning-thielemann.de Fri Sep 28 05:25:32 2018 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Fri, 28 Sep 2018 07:25:32 +0200 (CEST) Subject: Proposal: Add HasCallStack to the partial functions in base In-Reply-To: References: Message-ID: On Thu, 27 Sep 2018, David Feuer wrote: > I mostly think this is a good idea. However, some care is required to prevent performance problems, especially in > recursive functions. Watch out in implementation! Also, these partial functions are sometimes used in > non-obviously total contexts, such as the implementation of mfix for lists. All partial functions must eventually be used in total contexts - otherwise your program can crash.