From ict2102 at columbia.edu Sat Jan 2 02:14:31 2021 From: ict2102 at columbia.edu (Ian Treyball) Date: Fri, 1 Jan 2021 21:14:31 -0500 Subject: Consideration to add `ordering` function to `Data.Ord` Message-ID: Good day, In short, I think it would be nice to add the following ordering function to the Data.Ord module: -- | Case analysis for the 'Ordering' type. @'ordering' x y z o @ evaluates to @x@ -- when @o@ is 'LT', @y@ when @o@ is EQ, and evaluates to @z@ when @o@ is 'GT'. ordering :: a -> a -> a -> Ordering -> a ordering lt _ _ LT = lt ordering _ eq _ EQ = eq ordering _ _ gt GT = gt This would be essentially analogous to the bool function from Data.Bool: bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t Because the bool function is the case-analysis for the Bool data type, and the order of the parameters matches the order in which the constructors are defined: Data Bool = False | True I decided it would be consistent to follow the same approach for the ordering implementation and so I use the particular ordering (no pun intended) for the parameters to also match the order of the constructors: Data Ordering = LT | EQ | GT I will also add an example use case, here is how show could be implemented using the proposed function (of course, we momentarily assume it is not derived, for sake of simplicity): instance Show Ordering where show :: Ordering -> String show = ordering "LT" "EQ" "GT" Please let me know if you would wish for me to share more compelling examples, I have a few, but they are longer (so not here included for brevity's sake). I hope the formatting comes out okay, I will link to a gist[1], just in case. If this sounds acceptable, please let me know how to proceed (would this fall under "Core Libraries Proposal"[2]? I don't necessarily see adding this function as a breaking change, so I'm not sure, but I can surely fill one out if it's appropriate); otherwise, thank you for your time and consideration. Respectfully, Ian Treyball [1] https://gist.github.com/subttle/b49762a929f25e349381ef161bbc33d0 [2] https://github.com/haskell-core/core-libraries-proposals From george at wils.online Sun Jan 3 10:47:35 2021 From: george at wils.online (George Wilson) Date: Sun, 3 Jan 2021 20:47:35 +1000 Subject: Proposal: Export Solo from Data.Tuple In-Reply-To: References: Message-ID: +1 On Thu, 31 Dec 2020 at 04:58, chessai wrote: > > +1 > > On Wed, Dec 30, 2020, 12:32 David Feuer wrote: >> >> GHC.Tuple now exports >> >> data Solo a = Solo a >> >> for use as the canonical lifted unary tuple. I propose to export it >> from Data.Tuple. >> >> David >> _______________________________________________ >> 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 george at wils.online Sun Jan 3 11:01:44 2021 From: george at wils.online (George Wilson) Date: Sun, 3 Jan 2021 21:01:44 +1000 Subject: Proposal: Add 'Foldable1' to base In-Reply-To: <54e2ee88-fb33-67cb-f51b-05be8b6e03e4@gmail.com> References: <54e2ee88-fb33-67cb-f51b-05be8b6e03e4@gmail.com> Message-ID: I like David's more conservative class size. I would prefer to see the semigroupoids classes renamed [1] before they get added to base, since it's much harder to rename them once they're there. However, it's not clear to me that there's the required will to move forward with such a gargantuan renaming effort (semigroupoids is depended on directly and transitively by a lot of hackage). There was a recent attempt that didn't gain traction [2]. I would also prefer that the renaming and the move to base are two discrete steps -- not combined, since that would make the migration awkward and unpleasant (migrating to a differently-named class from a different package). I want to see the spirit of this happen, but overall I'm -1 on this proposal at this time. [1] https://github.com/ekmett/semigroupoids/issues/26 [2] https://github.com/ekmett/semigroupoids/pull/90 Cheers, George On Fri, 11 Dec 2020 at 22:37, Tony Morris wrote: > > Delete head1 and last1 and you'll get my +1. > > (they are better written as optics, when we also get Apply into base) > > On 12/10/20 4:37 PM, Reed Mullanix wrote: > > With the recent discussion around the addition of 'intersection' to containers, > > I think it might be a good time to re-open the discussion surrounding adding > > 'Foldable1' to base. > > > > For context, 'Foldable1' would be a subclass of 'Foldable' that abstracts > > folds over non-empty containers. Alternatively, it can be seen as a method > > of combining together the elements of a container using a semigroup. > > The contents of this class have been discussed previously (See [1,2]), > > and the version presented in this proposal is taken from [1]. > > > > class Foldable t => Foldable1 t where > > {-# MINIMAL foldMap1 | foldr1map #-} > > > > fold1 :: Semigroup m => t m -> m > > > > -- the defining member, like foldMap but only asking for Semigroup > > foldMap1 :: Semigroup m => (a -> m) -> t a -> m > > > > -- strict foldMap1, cf foldMap' > > foldMap1' :: Semigroup m => (a -> m) -> t a -> m > > > > -- analogue of toList > > toNonEmpty :: t a -> NonEmpty a > > > > -- left&right, strict&non-strict folds > > foldr1 :: (a -> a -> a) -> t a -> a > > foldr1' :: (a -> a -> a) -> t a -> a > > foldl1 :: (a -> a -> a) -> t a -> a > > foldl1' :: (a -> a -> a) -> t a -> a > > > > -- these can have efficient implementation for NonEmptySet > > maximum1 :: Ord a => t a -> a > > minimum1 :: Ord a => t a -> a > > > > -- head1 have efficient implementation for NonEmpty and Tree > > -- last1 for symmetry > > head1 :: t a -> a > > last1 :: t a -> a > > > > -- fold variants with premap. > > -- Without this map, we cannot implement foldl using foldr etc. > > foldrMap1 :: (a -> b) -> (b -> b -> b) -> t a -> b > > foldlMap1' :: (a -> b) -> (b -> b -> b) -> t a -> b > > foldlMap1 :: (a -> b) -> (b -> b -> b) -> t a -> b > > foldrMap1' :: (a -> b) -> (b -> b -> b) -> t a -> b > > > > > > This has a couple of benefits. On the practical side, we can provide > > total alternatives > > to existing partial functions (IE: 'foldr1' and friends). It also > > enables us to fold > > over containers using a semigroup instance, which comes up suprisingly often. > > > > Naming: > > -------------------------------------------------------------------------------- > > Historically, the biggest source of controversy with this proposal has > > been over the > > name. The class currently exists in semigroupoids [3] under the name > > 'Foldable1', though > > there was some discussion around renaming it to 'SemiFoldable' [4]. > > However, if we keep > > the name unchanged, it makes the migration path nice and > > straightforward, and the possible > > name conflict with Data.Functor.Classes seems unlikely. > > > > Migration: > > -------------------------------------------------------------------------------- > > If we decide to go with 'Foldable1' as the name, we should be able to > > perform this change with > > 0 breakage. > > > > References: > > [1] https://mail.haskell.org/pipermail/libraries/2019-November/030059.html > > [2] https://gitlab.haskell.org/ghc/ghc/-/issues/13573 > > [3] https://hackage.haskell.org/package/semigroupoids-5.3.4/docs/Data-Semigroup-Foldable.html#t:Foldable1 > > [4] https://github.com/ekmett/semigroupoids/issues/26 > > _______________________________________________ > > 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 carter.schonwald at gmail.com Sun Jan 3 15:59:29 2021 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Sun, 3 Jan 2021 10:59:29 -0500 Subject: can/should Functor have a quantified coercible constraint? Message-ID: Hey everyone! for context, I have some code where I was seeing how far coerce lets me go to avoid doing wrappers for certain codes, i found i had to write the following (mapping an operation over to its newtyped sibling) ``` -- > :t QRA.wither --- forall a b f . Applicative f => (a -> f (Maybe b)) -> RAList a -> f (RAList b) --- wither :: forall a b f . (Applicative f, (forall c d . Coercible c d => Coercible (f c) (f d)) ) => (a -> f (Maybe b)) -> RAList a -> f (RAList b) wither = \f la -> coerce $ QRA.wither f $ coerce la ``` i'd much rather be able to write ``` wither :: forall a b f . (Applicative f) => (a -> f (Maybe b)) -> RAList a -> f (RAList b) wither = \f la -> coerce $ QRA.wither f $ coerce la ``` this seems like it'd be best done via something like changing the functor class definition to ``` class (forall c d . Coercible c d => Coercible (f c) (f d)) ) => Functor f where .. ``` is there any specific reason why this is not feasible? I cant think of a GADT where this wouldn't be totally safe to do (because unlike in foldable, f is in both the domain and co-domain), but maybe i'm not being imaginative enough? look forward to learning what our obstacles are to making this happen for ghc 9.2 :) -Carter -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Sun Jan 3 16:08:51 2021 From: david.feuer at gmail.com (David Feuer) Date: Sun, 3 Jan 2021 11:08:51 -0500 Subject: can/should Functor have a quantified coercible constraint? In-Reply-To: References: Message-ID: You're not being very imaginative at all. Try out, oh, `StateT s Maybe`. Or play around with a nice fake functor like the magma used to implement `traverseBia` in `bifunctors`—pretty sure that won't work out. On Sun, Jan 3, 2021, 11:00 AM Carter Schonwald wrote: > Hey everyone! > > for context, I have some code where I was seeing how far coerce lets me go > to avoid doing wrappers for certain codes, > > i found i had to write the following (mapping an operation over to its > newtyped sibling) > > ``` > -- > :t QRA.wither > --- forall a b f . Applicative f => (a -> f (Maybe b)) -> RAList a -> f > (RAList b) > --- > wither :: forall a b f . (Applicative f, (forall c d . Coercible c d => > Coercible (f c) (f d)) ) => > (a -> f (Maybe b)) -> RAList a -> f (RAList b) > wither = \f la -> coerce $ QRA.wither f $ coerce la > ``` > > i'd much rather be able to write > ``` > wither :: forall a b f . (Applicative f) => > (a -> f (Maybe b)) -> RAList a -> f (RAList b) > wither = \f la -> coerce $ QRA.wither f $ coerce la > ``` > > > this seems like it'd be best done via something like changing the functor > class definition to > > ``` > class (forall c d . Coercible c d => Coercible (f c) (f d)) ) => Functor > f where .. > ``` > > is there any specific reason why this is not feasible? I cant think of a > GADT where this wouldn't be totally safe to do (because unlike in foldable, > f is in both the domain and co-domain), but maybe i'm not being imaginative > enough? > > look forward to learning what our obstacles are to making this happen for > ghc 9.2 :) > > -Carter > > _______________________________________________ > 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 carter.schonwald at gmail.com Sun Jan 3 16:31:18 2021 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Sun, 3 Jan 2021 11:31:18 -0500 Subject: can/should Functor have a quantified coercible constraint? In-Reply-To: References: Message-ID: Hey David, could you exposit what would go wrong? a concrete proof witness or explanation would help me a lot. other people might benefit too. for the stateT s Maybe a, perhaps i'm still waking up this AM, so let me try newtype StateT s m a = StateT {runStateT :: s -> m (a, s)} so this should expand to '(s -> Maybe (a,s)),' but the coerce would be on the 'a' here ... so i'm not seeing the issue? the latter example seem to boil down to "a free appplicative/functor Gadt" with some extra bits, though i've not worked through to seeing the unsafety for the latter examples, the definitions are the following : traverseBia :: (Traversable t , Biapplicative p ) => (a -> p b c ) -> t a -> p (t b ) (t c )traverseBia = inline (traverseBiaWith traverse) -------- traverseBiaWith :: forall p a b c s t . Biapplicative p => (forall f x . Applicative f => (a -> f x ) -> s -> f (t x )) -> (a -> p b c ) -> s -> p (t b ) (t c )traverseBiaWith trav p s = smash p (trav One s ) ------- smash :: forall p t a b c . Biapplicative p => (a -> p b c ) -> (forall x . Mag a x (t x )) -> p (t b ) (t c )smash p m = go m m where go :: forall x y . Mag a b x -> Mag a c y -> p x y go (Pure t ) (Pure u ) = bipure t u go (Map f x ) (Map g y ) = bimap f g (go x y ) go (Ap fs xs ) (Ap gs ys ) = go fs gs <<*>> go xs ys #if MIN_VERSION_base(4,10,0) go (LiftA2 f xs ys ) (LiftA2 g zs ws ) = biliftA2 f g (go xs zs ) (go ys ws ) #endif go (One x ) (One _) = p x go _ _ = impossibleError ---- and then the magma is -- This is used to reify a traversal for 'traverseBia'. It's a somewhat-- bogus 'Functor' and 'Applicative' closely related to 'Magma' from the-- @lens@ package. Valid traversals don't use (<$), (<*), or (*>), so-- we leave them out. We offer all the rest of the Functor and Applicative-- operations to improve performance: we generally want to keep the structure-- as small as possible. We might even consider using RULES to widen lifts-- when we can:---- liftA2 f x y <*> z ==> liftA3 f x y z,---- etc., up to the pointer tagging limit. But we do need to be careful. I don't-- *think* GHC will ever inline the traversal into the go function (because that-- would duplicate work), but if it did, and if different RULES fired for the-- two copies, everything would break horribly.---- Note: if it's necessary for some reason, we *could* relax GADTs to-- ExistentialQuantification by changing the type of One to---- One :: (b -> c) -> a -> Mag a b c---- where the function will always end up being id. But we allocate a *lot*-- of One constructors, so this would definitely be bad for performance.data Mag a b t where Pure :: t -> Mag a b t Map :: (x -> t ) -> Mag a b x -> Mag a b t Ap :: Mag a b (t -> u ) -> Mag a b t -> Mag a b u #if MIN_VERSION_base(4,10,0) LiftA2 :: (t -> u -> v ) -> Mag a b t -> Mag a b u -> Mag a b v #endif One :: a -> Mag a b b instance Functor (Mag a b ) where fmap = Map instance Applicative (Mag a b ) where pure = Pure (<*>) = Ap #if MIN_VERSION_base(4,10,0) liftA2 = LiftA2 #endif On Sun, Jan 3, 2021 at 11:09 AM David Feuer wrote: > You're not being very imaginative at all. Try out, oh, `StateT s Maybe`. > Or play around with a nice fake functor like the magma used to implement > `traverseBia` in `bifunctors`—pretty sure that won't work out. > > On Sun, Jan 3, 2021, 11:00 AM Carter Schonwald > wrote: > >> Hey everyone! >> >> for context, I have some code where I was seeing how far coerce lets me >> go to avoid doing wrappers for certain codes, >> >> i found i had to write the following (mapping an operation over to its >> newtyped sibling) >> >> ``` >> -- > :t QRA.wither >> --- forall a b f . Applicative f => (a -> f (Maybe b)) -> RAList a -> f >> (RAList b) >> --- >> wither :: forall a b f . (Applicative f, (forall c d . Coercible c d => >> Coercible (f c) (f d)) ) => >> (a -> f (Maybe b)) -> RAList a -> f (RAList b) >> wither = \f la -> coerce $ QRA.wither f $ coerce la >> ``` >> >> i'd much rather be able to write >> ``` >> wither :: forall a b f . (Applicative f) => >> (a -> f (Maybe b)) -> RAList a -> f (RAList b) >> wither = \f la -> coerce $ QRA.wither f $ coerce la >> ``` >> >> >> this seems like it'd be best done via something like changing the functor >> class definition to >> >> ``` >> class (forall c d . Coercible c d => Coercible (f c) (f d)) ) => >> Functor f where .. >> ``` >> >> is there any specific reason why this is not feasible? I cant think of a >> GADT where this wouldn't be totally safe to do (because unlike in foldable, >> f is in both the domain and co-domain), but maybe i'm not being imaginative >> enough? >> >> look forward to learning what our obstacles are to making this happen for >> ghc 9.2 :) >> >> -Carter >> >> _______________________________________________ >> 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 carter.schonwald at gmail.com Sun Jan 3 16:35:53 2021 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Sun, 3 Jan 2021 11:35:53 -0500 Subject: can/should Functor have a quantified coercible constraint? In-Reply-To: References: Message-ID: i guess the issue lies with the `One ` construtor? but the comment along side this datatype already states that its treated as being "unsafe coerced" already! so i dont quite see it as creating further issues? On Sun, Jan 3, 2021 at 11:31 AM Carter Schonwald wrote: > Hey David, > could you exposit what would go wrong? a concrete proof witness or > explanation would help me a lot. other people might benefit too. > > > for the stateT s Maybe a, perhaps i'm still waking up this AM, so let me > try > newtype StateT s m a = StateT {runStateT :: s -> m (a, s)} > > so this should expand to > '(s -> Maybe (a,s)),' > but the coerce would be on the 'a' here ... so i'm not seeing the issue? > > > > the latter example seem to boil down to "a free appplicative/functor Gadt" > with some extra bits, though i've not worked through to seeing the unsafety > for the latter examples, the definitions are the following : > > traverseBia :: (Traversable t , Biapplicative p ) => (a -> p b c ) -> t a -> p (t b ) (t c )traverseBia = inline (traverseBiaWith traverse) > -------- > traverseBiaWith :: forall p a b c s t . Biapplicative p => (forall f x . Applicative f => (a -> f x ) -> s -> f (t x )) -> (a -> p b c ) -> s -> p (t b ) (t c )traverseBiaWith trav p s = smash p (trav One s ) > ------- > smash :: forall p t a b c . Biapplicative p => (a -> p b c ) -> (forall x . Mag a x (t x )) -> p (t b ) (t c )smash p m = go m m where go :: forall x y . Mag a b x -> Mag a c y -> p x y go (Pure t ) (Pure u ) = bipure t u go (Map f x ) (Map g y ) = bimap f g (go x y ) go (Ap fs xs ) (Ap gs ys ) = go fs gs <<*>> go xs ys > #if MIN_VERSION_base(4,10,0) go (LiftA2 f xs ys ) (LiftA2 g zs ws ) = biliftA2 f g (go xs zs ) (go ys ws ) > #endif go (One x ) (One _) = p x go _ _ = impossibleError > > ---- and then the magma is > -- This is used to reify a traversal for 'traverseBia'. It's a somewhat-- bogus 'Functor' and 'Applicative' closely related to 'Magma' from the-- @lens@ package. Valid traversals don't use (<$), (<*), or (*>), so-- we leave them out. We offer all the rest of the Functor and Applicative-- operations to improve performance: we generally want to keep the structure-- as small as possible. We might even consider using RULES to widen lifts-- when we can:---- liftA2 f x y <*> z ==> liftA3 f x y z,---- etc., up to the pointer tagging limit. But we do need to be careful. I don't-- *think* GHC will ever inline the traversal into the go function (because that-- would duplicate work), but if it did, and if different RULES fired for the-- two copies, everything would break horribly.---- Note: if it's necessary for some reason, we *could* relax GADTs to-- ExistentialQuantification by changing the type of One to---- One :: (b -> c) -> a -> Mag a b c---- where the function will always end up being id. But we allocate a *lot*-- of One constructors, so this would definitely be bad for performance.data Mag a b t where Pure :: t -> Mag a b t Map :: (x -> t ) -> Mag a b x -> Mag a b t Ap :: Mag a b (t -> u ) -> Mag a b t -> Mag a b u > #if MIN_VERSION_base(4,10,0) LiftA2 :: (t -> u -> v ) -> Mag a b t -> Mag a b u -> Mag a b v > #endif One :: a -> Mag a b b instance Functor (Mag a b ) where fmap = Map instance Applicative (Mag a b ) where pure = Pure (<*>) = Ap > #if MIN_VERSION_base(4,10,0) liftA2 = LiftA2 > #endif > > > > > On Sun, Jan 3, 2021 at 11:09 AM David Feuer wrote: > >> You're not being very imaginative at all. Try out, oh, `StateT s Maybe`. >> Or play around with a nice fake functor like the magma used to implement >> `traverseBia` in `bifunctors`—pretty sure that won't work out. >> >> On Sun, Jan 3, 2021, 11:00 AM Carter Schonwald < >> carter.schonwald at gmail.com> wrote: >> >>> Hey everyone! >>> >>> for context, I have some code where I was seeing how far coerce lets me >>> go to avoid doing wrappers for certain codes, >>> >>> i found i had to write the following (mapping an operation over to its >>> newtyped sibling) >>> >>> ``` >>> -- > :t QRA.wither >>> --- forall a b f . Applicative f => (a -> f (Maybe b)) -> RAList a -> f >>> (RAList b) >>> --- >>> wither :: forall a b f . (Applicative f, (forall c d . Coercible c d => >>> Coercible (f c) (f d)) ) => >>> (a -> f (Maybe b)) -> RAList a -> f (RAList b) >>> wither = \f la -> coerce $ QRA.wither f $ coerce la >>> ``` >>> >>> i'd much rather be able to write >>> ``` >>> wither :: forall a b f . (Applicative f) => >>> (a -> f (Maybe b)) -> RAList a -> f (RAList b) >>> wither = \f la -> coerce $ QRA.wither f $ coerce la >>> ``` >>> >>> >>> this seems like it'd be best done via something like changing the >>> functor class definition to >>> >>> ``` >>> class (forall c d . Coercible c d => Coercible (f c) (f d)) ) => >>> Functor f where .. >>> ``` >>> >>> is there any specific reason why this is not feasible? I cant think of a >>> GADT where this wouldn't be totally safe to do (because unlike in foldable, >>> f is in both the domain and co-domain), but maybe i'm not being imaginative >>> enough? >>> >>> look forward to learning what our obstacles are to making this happen >>> for ghc 9.2 :) >>> >>> -Carter >>> >>> _______________________________________________ >>> 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 oleg.grenrus at iki.fi Sun Jan 3 17:01:48 2021 From: oleg.grenrus at iki.fi (Oleg Grenrus) Date: Sun, 3 Jan 2021 19:01:48 +0200 Subject: can/should Functor have a quantified coercible constraint? In-Reply-To: References: Message-ID: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi>     Prelude Control.Monad.Trans.State> :i StateT     type role StateT nominal representational nominal Note, `StateT` is nominal in last argument (a). Thus if (forall c d. Coercible ...) where a Functor superclass, Functor (and thus Monad) wouldn't be definable for StateT. That would be... unfortunate. Until there are "higher roles" Functor cannot be Coercible1. It would rule very simple code. (OTOH Mag can be repaired, https://oleg.fi/gists/posts/2019-07-31-fmap-coerce-coerce.html#functor-should-be-parametric). - Oleg On 3.1.2021 18.31, Carter Schonwald wrote: > Hey David, > could you exposit what would go wrong? a concrete proof witness or > explanation would help me a lot. other people might benefit too. > > > for the stateT s Maybe a, perhaps i'm still waking up this AM, so let > me try > newtype StateT s m a = StateT {runStateT :: s -> m (a, s)} > > so this should expand to  > '(s -> Maybe (a,s)),' > but the coerce would be on the 'a' here ... so i'm not seeing the issue? > > > > the latter example seem to boil down to "a free appplicative/functor > Gadt" with some extra bits, though i've not worked through to seeing > the unsafety > for the latter examples, the definitions are the following : > traverseBia > ::(Traversablet > ,Biapplicative > p > )=>(a > ->p > b > c > )->t > a > ->p > (t > b > )(t > c > )traverseBia > =inline(traverseBiaWith > traverse)-------- > traverseBiaWith > ::forallp > a > b > c > s > t > .Biapplicative > p > =>(forallf > x > .Applicativef > =>(a > ->f > x > )->s > ->f > (t > x > ))->(a > ->p > b > c > )->s > ->p > (t > b > )(t > c > )traverseBiaWith > trav > p > s > =smash > p > (trav > One > s > ) > ------- smash > ::forallp > t > a > b > c > .Biapplicative > p > =>(a > ->p > b > c > )->(forallx > .Mag > a > x > (t > x > ))->p > (t > b > )(t > c > )smash > p > m > =go > m > m > wherego > ::forallx > y > .Mag > a > b > x > ->Mag > a > c > y > ->p > x > y > go > (Pure > t > )(Pure > u > )=bipure > t > u > go > (Map > f > x > )(Map > g > y > )=bimapf > g > (go > x > y > )go > (Ap > fs > xs > )(Ap > gs > ys > )=go > fs > gs > <<*>> > go > xs > ys > #if > MIN_VERSION_base(4,10,0) go > (LiftA2 > f > xs > ys > )(LiftA2 > g > zs > ws > )=biliftA2 > f > g > (go > xs > zs > )(go > ys > ws > )#endif > go > (One > x > )(One > _)=p > x > go > __=impossibleError > > ---- and then the magma is -- This is used to reify a traversal for > 'traverseBia'. It's a somewhat-- bogus 'Functor' and 'Applicative' > closely related to 'Magma' from the-- @lens@ package. Valid traversals > don't use (<$), (<*), or (*>), so-- we leave them out. We offer all > the rest of the Functor and Applicative-- operations to improve > performance: we generally want to keep the structure-- as small as > possible. We might even consider using RULES to widen lifts-- when we > can:---- liftA2 f x y <*> z ==> liftA3 f x y z,---- etc., up to the > pointer tagging limit. But we do need to be careful. I don't-- *think* > GHC will ever inline the traversal into the go function (because > that-- would duplicate work), but if it did, and if different RULES > fired for the-- two copies, everything would break horribly.---- Note: > if it's necessary for some reason, we *could* relax GADTs to-- > ExistentialQuantification by changing the type of One to---- One :: (b > -> c) -> a -> Mag a b c---- where the function will always end up > being id. But we allocate a *lot*-- of One constructors, so this would > definitely be bad for performance.dataMag > a > b > t > wherePure > ::t > ->Mag > a > b > t > Map > ::(x > ->t > )->Mag > a > b > x > ->Mag > a > b > t > Ap > ::Mag > a > b > (t > ->u > )->Mag > a > b > t > ->Mag > a > b > u > #if > MIN_VERSION_base(4,10,0) LiftA2 > ::(t > ->u > ->v > )->Mag > a > b > t > ->Mag > a > b > u > ->Mag > a > b > v > #endif > One > ::a > ->Mag > a > b > b > instanceFunctor(Mag > a > b > )wherefmap=Map > instanceApplicative(Mag > a > b > )wherepure=Pure > (<*>)=Ap > #if > MIN_VERSION_base(4,10,0) liftA2=LiftA2 > #endif > > > On Sun, Jan 3, 2021 at 11:09 AM David Feuer > wrote: > > You're not being very imaginative at all. Try out, oh, `StateT s > Maybe`. Or play around with a nice fake functor like the magma > used to implement `traverseBia` in `bifunctors`—pretty sure that > won't work out. > > On Sun, Jan 3, 2021, 11:00 AM Carter Schonwald > > > wrote: > > Hey everyone! > > for context, I have some code where I was seeing how far > coerce lets me go to avoid doing wrappers for certain codes, > > i found i had to write the following (mapping an operation > over to its newtyped sibling) > > ``` > -- > :t QRA.wither > --- forall a b f . Applicative f => (a -> f (Maybe b)) -> > RAList a -> f (RAList b) > --- > wither :: forall a b f . (Applicative f, (forall c d .  > Coercible c d => Coercible (f c) (f d))  ) => >         (a -> f (Maybe b)) -> RAList a -> f (RAList b) > wither = \f la ->    coerce     $ QRA.wither f $ coerce la > ``` > > i'd much rather be able to write > ``` > wither :: forall a b f . (Applicative f) => >         (a -> f (Maybe b)) -> RAList a -> f (RAList b) > wither = \f la ->    coerce     $ QRA.wither f $ coerce la > ``` > > > this seems like it'd be best done via something like changing > the functor class definition to > > ``` > class (forall c d .  Coercible c d => Coercible (f c) (f d)) >  ) => Functor f where .. > ``` > > is there any specific reason why this is not feasible? I cant > think of a GADT where this wouldn't be totally safe to do > (because unlike in foldable, f is in both the domain and > co-domain), but maybe i'm not being imaginative enough? > > look forward to learning what our obstacles are to making this > happen for ghc 9.2 :) > > -Carter > > _______________________________________________ > 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 david.feuer at gmail.com Sun Jan 3 17:08:46 2021 From: david.feuer at gmail.com (David Feuer) Date: Sun, 3 Jan 2021 12:08:46 -0500 Subject: can/should Functor have a quantified coercible constraint? In-Reply-To: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> Message-ID: Mag uses the One it does for efficiency/compactness. Coercible constraints aren't unpacked in data constructors, sadly. If you're looking for more examples of slightly-invalid but useful Functors, the first place I'd check (beyond the very-Mag-like things in lens that inspired Mag) is Roman Cheplyaka's regex-applicative. I don't know if his lifts coercions or not (haven't looked in a while) but it does some similarly illegitimate things for good reasons. On Sun, Jan 3, 2021, 12:03 PM Oleg Grenrus wrote: > Prelude Control.Monad.Trans.State> :i StateT > type role StateT nominal representational nominal > > Note, `StateT` is nominal in last argument (a). Thus if (forall c d. > Coercible ...) where a Functor superclass, Functor (and thus Monad) > wouldn't be definable for StateT. That would be... unfortunate. > > Until there are "higher roles" Functor cannot be Coercible1. It would rule > very simple code. > (OTOH Mag can be repaired, > https://oleg.fi/gists/posts/2019-07-31-fmap-coerce-coerce.html#functor-should-be-parametric > ). > > - Oleg > > On 3.1.2021 18.31, Carter Schonwald wrote: > > Hey David, > could you exposit what would go wrong? a concrete proof witness or > explanation would help me a lot. other people might benefit too. > > > for the stateT s Maybe a, perhaps i'm still waking up this AM, so let me > try > newtype StateT s m a = StateT {runStateT :: s -> m (a, s)} > > so this should expand to > '(s -> Maybe (a,s)),' > but the coerce would be on the 'a' here ... so i'm not seeing the issue? > > > > the latter example seem to boil down to "a free appplicative/functor Gadt" > with some extra bits, though i've not worked through to seeing the unsafety > for the latter examples, the definitions are the following : > > traverseBia :: (Traversable t , Biapplicative p ) => (a -> p b c ) -> t a -> p (t b ) (t c )traverseBia = inline (traverseBiaWith traverse) > --------traverseBiaWith :: forall p a b c s t . Biapplicative p => (forall f x . Applicative f => (a -> f x ) -> s -> f (t x )) -> (a -> p b c ) -> s -> p (t b ) (t c )traverseBiaWith trav p s = smash p (trav One s ) > -------smash :: forall p t a b c . Biapplicative p => (a -> p b c ) -> (forall x . Mag a x (t x )) -> p (t b ) (t c )smash p m = go m m where go :: forall x y . Mag a b x -> Mag a c y -> p x y go (Pure t ) (Pure u ) = bipure t u go (Map f x ) (Map g y ) = bimap f g (go x y ) go (Ap fs xs ) (Ap gs ys ) = go fs gs <<*>> go xs ys > #if MIN_VERSION_base(4,10,0) go (LiftA2 f xs ys ) (LiftA2 g zs ws ) = biliftA2 f g (go xs zs ) (go ys ws ) > #endif go (One x ) (One _) = p x go _ _ = impossibleError > > ---- and then the magma is -- This is used to reify a traversal for 'traverseBia'. It's a somewhat-- bogus 'Functor' and 'Applicative' closely related to 'Magma' from the-- @lens@ package. Valid traversals don't use (<$), (<*), or (*>), so-- we leave them out. We offer all the rest of the Functor and Applicative-- operations to improve performance: we generally want to keep the structure-- as small as possible. We might even consider using RULES to widen lifts-- when we can:---- liftA2 f x y <*> z ==> liftA3 f x y z,---- etc., up to the pointer tagging limit. But we do need to be careful. I don't-- *think* GHC will ever inline the traversal into the go function (because that-- would duplicate work), but if it did, and if different RULES fired for the-- two copies, everything would break horribly.---- Note: if it's necessary for some reason, we *could* relax GADTs to-- ExistentialQuantification by changing the type of One to---- One :: (b -> c) -> a -> Mag a b c---- where the function will always end up being id. But we allocate a *lot*-- of One constructors, so this would definitely be bad for performance.data Mag a b t where Pure :: t -> Mag a b t Map :: (x -> t ) -> Mag a b x -> Mag a b t Ap :: Mag a b (t -> u ) -> Mag a b t -> Mag a b u > #if MIN_VERSION_base(4,10,0) LiftA2 :: (t -> u -> v ) -> Mag a b t -> Mag a b u -> Mag a b v > #endif One :: a -> Mag a b b instance Functor (Mag a b ) where fmap = Map instance Applicative (Mag a b ) where pure = Pure (<*>) = Ap > #if MIN_VERSION_base(4,10,0) liftA2 = LiftA2 > #endif > > > > On Sun, Jan 3, 2021 at 11:09 AM David Feuer wrote: > >> You're not being very imaginative at all. Try out, oh, `StateT s Maybe`. >> Or play around with a nice fake functor like the magma used to implement >> `traverseBia` in `bifunctors`—pretty sure that won't work out. >> >> On Sun, Jan 3, 2021, 11:00 AM Carter Schonwald < >> carter.schonwald at gmail.com> wrote: >> >>> Hey everyone! >>> >>> for context, I have some code where I was seeing how far coerce lets me >>> go to avoid doing wrappers for certain codes, >>> >>> i found i had to write the following (mapping an operation over to its >>> newtyped sibling) >>> >>> ``` >>> -- > :t QRA.wither >>> --- forall a b f . Applicative f => (a -> f (Maybe b)) -> RAList a -> f >>> (RAList b) >>> --- >>> wither :: forall a b f . (Applicative f, (forall c d . Coercible c d => >>> Coercible (f c) (f d)) ) => >>> (a -> f (Maybe b)) -> RAList a -> f (RAList b) >>> wither = \f la -> coerce $ QRA.wither f $ coerce la >>> ``` >>> >>> i'd much rather be able to write >>> ``` >>> wither :: forall a b f . (Applicative f) => >>> (a -> f (Maybe b)) -> RAList a -> f (RAList b) >>> wither = \f la -> coerce $ QRA.wither f $ coerce la >>> ``` >>> >>> >>> this seems like it'd be best done via something like changing the >>> functor class definition to >>> >>> ``` >>> class (forall c d . Coercible c d => Coercible (f c) (f d)) ) => >>> Functor f where .. >>> ``` >>> >>> is there any specific reason why this is not feasible? I cant think of a >>> GADT where this wouldn't be totally safe to do (because unlike in foldable, >>> f is in both the domain and co-domain), but maybe i'm not being imaginative >>> enough? >>> >>> look forward to learning what our obstacles are to making this happen >>> for ghc 9.2 :) >>> >>> -Carter >>> >>> _______________________________________________ >>> Libraries mailing list >>> Libraries at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries >>> >> > _______________________________________________ > 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 oleg.grenrus at iki.fi Sun Jan 3 17:12:16 2021 From: oleg.grenrus at iki.fi (Oleg Grenrus) Date: Sun, 3 Jan 2021 19:12:16 +0200 Subject: can/should Functor have a quantified coercible constraint? In-Reply-To: References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> Message-ID: <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> I think Mag, regex-applicative etc. examples are all reparable. The main culprit is however StateT and a like, as you pointed out. It's meaningless to discuss Mag if we cannot even write Functor m => Functor (StateT s m). > Coercible constraints aren't unpacked in data constructors Aren't they zero-width at run time? That's IMO a bug if that is not true. - Oleg On 3.1.2021 19.08, David Feuer wrote: > Mag uses the One it does for efficiency/compactness. Coercible > constraints aren't unpacked in data constructors, sadly. If you're > looking for more examples of slightly-invalid but useful Functors, the > first place I'd check (beyond the very-Mag-like things in lens that > inspired Mag) is Roman Cheplyaka's regex-applicative. I don't know if > his lifts coercions or not (haven't looked in a while) but it does > some similarly illegitimate things for good reasons. > > On Sun, Jan 3, 2021, 12:03 PM Oleg Grenrus > wrote: > >     Prelude Control.Monad.Trans.State> :i StateT >     type role StateT nominal representational nominal > > Note, `StateT` is nominal in last argument (a). Thus if (forall c > d. Coercible ...) where a Functor superclass, Functor (and thus > Monad) wouldn't be definable for StateT. That would be... unfortunate. > > Until there are "higher roles" Functor cannot be Coercible1. It > would rule very simple code. > (OTOH Mag can be repaired, > https://oleg.fi/gists/posts/2019-07-31-fmap-coerce-coerce.html#functor-should-be-parametric). > > - Oleg > > On 3.1.2021 18.31, Carter Schonwald wrote: >> Hey David, >> could you exposit what would go wrong? a concrete proof witness >> or explanation would help me a lot. other people might benefit too. >> >> >> for the stateT s Maybe a, perhaps i'm still waking up this AM, so >> let me try >> newtype StateT s m a = StateT {runStateT :: s -> m (a, s)} >> >> so this should expand to  >> '(s -> Maybe (a,s)),' >> but the coerce would be on the 'a' here ... so i'm not seeing the >> issue? >> >> >> >> the latter example seem to boil down to "a free >> appplicative/functor Gadt" with some extra bits, though i've not >> worked through to seeing the unsafety >> for the latter examples, the definitions are the following : >> traverseBia >> ::(Traversablet >> ,Biapplicative >> p >> )=>(a >> ->p >> b >> c >> )->t >> a >> ->p >> (t >> b >> )(t >> c >> )traverseBia >> =inline(traverseBiaWith >> traverse)-------- >> traverseBiaWith >> ::forallp >> a >> b >> c >> s >> t >> .Biapplicative >> p >> =>(forallf >> x >> .Applicativef >> =>(a >> ->f >> x >> )->s >> ->f >> (t >> x >> ))->(a >> ->p >> b >> c >> )->s >> ->p >> (t >> b >> )(t >> c >> )traverseBiaWith >> trav >> p >> s >> =smash >> p >> (trav >> One >> s >> ) >> ------- smash >> ::forallp >> t >> a >> b >> c >> .Biapplicative >> p >> =>(a >> ->p >> b >> c >> )->(forallx >> .Mag >> a >> x >> (t >> x >> ))->p >> (t >> b >> )(t >> c >> )smash >> p >> m >> =go >> m >> m >> wherego >> ::forallx >> y >> .Mag >> a >> b >> x >> ->Mag >> a >> c >> y >> ->p >> x >> y >> go >> (Pure >> t >> )(Pure >> u >> )=bipure >> t >> u >> go >> (Map >> f >> x >> )(Map >> g >> y >> )=bimapf >> g >> (go >> x >> y >> )go >> (Ap >> fs >> xs >> )(Ap >> gs >> ys >> )=go >> fs >> gs >> <<*>> >> go >> xs >> ys >> #if >> MIN_VERSION_base(4,10,0) go >> (LiftA2 >> f >> xs >> ys >> )(LiftA2 >> g >> zs >> ws >> )=biliftA2 >> f >> g >> (go >> xs >> zs >> )(go >> ys >> ws >> )#endif >> go >> (One >> x >> )(One >> _)=p >> x >> go >> __=impossibleError >> >> ---- and then the magma is -- This is used to reify a traversal >> for 'traverseBia'. It's a somewhat-- bogus 'Functor' and >> 'Applicative' closely related to 'Magma' from the-- @lens@ >> package. Valid traversals don't use (<$), (<*), or (*>), so-- we >> leave them out. We offer all the rest of the Functor and >> Applicative-- operations to improve performance: we generally >> want to keep the structure-- as small as possible. We might even >> consider using RULES to widen lifts-- when we can:---- liftA2 f x >> y <*> z ==> liftA3 f x y z,---- etc., up to the pointer tagging >> limit. But we do need to be careful. I don't-- *think* GHC will >> ever inline the traversal into the go function (because that-- >> would duplicate work), but if it did, and if different RULES >> fired for the-- two copies, everything would break horribly.---- >> Note: if it's necessary for some reason, we *could* relax GADTs >> to-- ExistentialQuantification by changing the type of One to---- >> One :: (b -> c) -> a -> Mag a b c---- where the function will >> always end up being id. But we allocate a *lot*-- of One >> constructors, so this would definitely be bad for >> performance.dataMag >> a >> b >> t >> wherePure >> ::t >> ->Mag >> a >> b >> t >> Map >> ::(x >> ->t >> )->Mag >> a >> b >> x >> ->Mag >> a >> b >> t >> Ap >> ::Mag >> a >> b >> (t >> ->u >> )->Mag >> a >> b >> t >> ->Mag >> a >> b >> u >> #if >> MIN_VERSION_base(4,10,0) LiftA2 >> ::(t >> ->u >> ->v >> )->Mag >> a >> b >> t >> ->Mag >> a >> b >> u >> ->Mag >> a >> b >> v >> #endif >> One >> ::a >> ->Mag >> a >> b >> b >> instanceFunctor(Mag >> a >> b >> )wherefmap=Map >> instanceApplicative(Mag >> a >> b >> )wherepure=Pure >> (<*>)=Ap >> #if >> MIN_VERSION_base(4,10,0) liftA2=LiftA2 >> #endif >> >> >> On Sun, Jan 3, 2021 at 11:09 AM David Feuer >> > wrote: >> >> You're not being very imaginative at all. Try out, oh, >> `StateT s Maybe`. Or play around with a nice fake functor >> like the magma used to implement `traverseBia` in >> `bifunctors`—pretty sure that won't work out. >> >> On Sun, Jan 3, 2021, 11:00 AM Carter Schonwald >> > > wrote: >> >> Hey everyone! >> >> for context, I have some code where I was seeing how far >> coerce lets me go to avoid doing wrappers for certain codes, >> >> i found i had to write the following (mapping an >> operation over to its newtyped sibling) >> >> ``` >> -- > :t QRA.wither >> --- forall a b f . Applicative f => (a -> f (Maybe b)) -> >> RAList a -> f (RAList b) >> --- >> wither :: forall a b f . (Applicative f, (forall c d .  >> Coercible c d => Coercible (f c) (f d))  ) => >>         (a -> f (Maybe b)) -> RAList a -> f (RAList b) >> wither = \f la ->    coerce     $ QRA.wither f $ coerce la >> ``` >> >> i'd much rather be able to write >> ``` >> wither :: forall a b f . (Applicative f) => >>         (a -> f (Maybe b)) -> RAList a -> f (RAList b) >> wither = \f la ->    coerce     $ QRA.wither f $ coerce la >> ``` >> >> >> this seems like it'd be best done via something like >> changing the functor class definition to >> >> ``` >> class (forall c d .  Coercible c d => Coercible (f c) (f >> d))  ) => Functor f where .. >> ``` >> >> is there any specific reason why this is not feasible? I >> cant think of a GADT where this wouldn't be totally safe >> to do (because unlike in foldable, f is in both the >> domain and co-domain), but maybe i'm not being >> imaginative enough? >> >> look forward to learning what our obstacles are to making >> this happen for ghc 9.2 :) >> >> -Carter >> >> _______________________________________________ >> 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 david.feuer at gmail.com Sun Jan 3 17:18:48 2021 From: david.feuer at gmail.com (David Feuer) Date: Sun, 3 Jan 2021 12:18:48 -0500 Subject: can/should Functor have a quantified coercible constraint? In-Reply-To: <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> Message-ID: Coercible is a lifted constraint wrapping the unlifted constraint, which I remember is spelled either ~#r or some other permutation of those characters. Last I looked, Coercible was *not* unpacked in data constructors. On Sun, Jan 3, 2021, 12:12 PM Oleg Grenrus wrote: > I think Mag, regex-applicative etc. examples are all reparable. The main > culprit is however StateT and a like, as you pointed out. It's meaningless > to discuss Mag if we cannot even write Functor m => Functor (StateT s m). > > > Coercible constraints aren't unpacked in data constructors > > Aren't they zero-width at run time? That's IMO a bug if that is not true. > > - Oleg > On 3.1.2021 19.08, David Feuer wrote: > > Mag uses the One it does for efficiency/compactness. Coercible constraints > aren't unpacked in data constructors, sadly. If you're looking for more > examples of slightly-invalid but useful Functors, the first place I'd check > (beyond the very-Mag-like things in lens that inspired Mag) is Roman > Cheplyaka's regex-applicative. I don't know if his lifts coercions or not > (haven't looked in a while) but it does some similarly illegitimate things > for good reasons. > > On Sun, Jan 3, 2021, 12:03 PM Oleg Grenrus wrote: > >> Prelude Control.Monad.Trans.State> :i StateT >> type role StateT nominal representational nominal >> >> Note, `StateT` is nominal in last argument (a). Thus if (forall c d. >> Coercible ...) where a Functor superclass, Functor (and thus Monad) >> wouldn't be definable for StateT. That would be... unfortunate. >> >> Until there are "higher roles" Functor cannot be Coercible1. It would >> rule very simple code. >> (OTOH Mag can be repaired, >> https://oleg.fi/gists/posts/2019-07-31-fmap-coerce-coerce.html#functor-should-be-parametric >> ). >> >> - Oleg >> >> On 3.1.2021 18.31, Carter Schonwald wrote: >> >> Hey David, >> could you exposit what would go wrong? a concrete proof witness or >> explanation would help me a lot. other people might benefit too. >> >> >> for the stateT s Maybe a, perhaps i'm still waking up this AM, so let me >> try >> newtype StateT s m a = StateT {runStateT :: s -> m (a, s)} >> >> so this should expand to >> '(s -> Maybe (a,s)),' >> but the coerce would be on the 'a' here ... so i'm not seeing the issue? >> >> >> >> the latter example seem to boil down to "a free appplicative/functor >> Gadt" with some extra bits, though i've not worked through to seeing the >> unsafety >> for the latter examples, the definitions are the following : >> >> traverseBia :: (Traversable t , Biapplicative p ) => (a -> p b c ) -> t a -> p (t b ) (t c )traverseBia = inline (traverseBiaWith traverse) >> --------traverseBiaWith :: forall p a b c s t . Biapplicative p => (forall f x . Applicative f => (a -> f x ) -> s -> f (t x )) -> (a -> p b c ) -> s -> p (t b ) (t c )traverseBiaWith trav p s = smash p (trav One s ) >> -------smash :: forall p t a b c . Biapplicative p => (a -> p b c ) -> (forall x . Mag a x (t x )) -> p (t b ) (t c )smash p m = go m m where go :: forall x y . Mag a b x -> Mag a c y -> p x y go (Pure t ) (Pure u ) = bipure t u go (Map f x ) (Map g y ) = bimap f g (go x y ) go (Ap fs xs ) (Ap gs ys ) = go fs gs <<*>> go xs ys >> #if MIN_VERSION_base(4,10,0) go (LiftA2 f xs ys ) (LiftA2 g zs ws ) = biliftA2 f g (go xs zs ) (go ys ws ) >> #endif go (One x ) (One _) = p x go _ _ = impossibleError >> >> ---- and then the magma is -- This is used to reify a traversal for 'traverseBia'. It's a somewhat-- bogus 'Functor' and 'Applicative' closely related to 'Magma' from the-- @lens@ package. Valid traversals don't use (<$), (<*), or (*>), so-- we leave them out. We offer all the rest of the Functor and Applicative-- operations to improve performance: we generally want to keep the structure-- as small as possible. We might even consider using RULES to widen lifts-- when we can:---- liftA2 f x y <*> z ==> liftA3 f x y z,---- etc., up to the pointer tagging limit. But we do need to be careful. I don't-- *think* GHC will ever inline the traversal into the go function (because that-- would duplicate work), but if it did, and if different RULES fired for the-- two copies, everything would break horribly.---- Note: if it's necessary for some reason, we *could* relax GADTs to-- ExistentialQuantification by changing the type of One to---- One :: (b -> c) -> a -> Mag a b c---- where the function will always end up being id. But we allocate a *lot*-- of One constructors, so this would definitely be bad for performance.data Mag a b t where Pure :: t -> Mag a b t Map :: (x -> t ) -> Mag a b x -> Mag a b t Ap :: Mag a b (t -> u ) -> Mag a b t -> Mag a b u >> #if MIN_VERSION_base(4,10,0) LiftA2 :: (t -> u -> v ) -> Mag a b t -> Mag a b u -> Mag a b v >> #endif One :: a -> Mag a b b instance Functor (Mag a b ) where fmap = Map instance Applicative (Mag a b ) where pure = Pure (<*>) = Ap >> #if MIN_VERSION_base(4,10,0) liftA2 = LiftA2 >> #endif >> >> >> >> On Sun, Jan 3, 2021 at 11:09 AM David Feuer >> wrote: >> >>> You're not being very imaginative at all. Try out, oh, `StateT s Maybe`. >>> Or play around with a nice fake functor like the magma used to implement >>> `traverseBia` in `bifunctors`—pretty sure that won't work out. >>> >>> On Sun, Jan 3, 2021, 11:00 AM Carter Schonwald < >>> carter.schonwald at gmail.com> wrote: >>> >>>> Hey everyone! >>>> >>>> for context, I have some code where I was seeing how far coerce lets me >>>> go to avoid doing wrappers for certain codes, >>>> >>>> i found i had to write the following (mapping an operation over to its >>>> newtyped sibling) >>>> >>>> ``` >>>> -- > :t QRA.wither >>>> --- forall a b f . Applicative f => (a -> f (Maybe b)) -> RAList a -> f >>>> (RAList b) >>>> --- >>>> wither :: forall a b f . (Applicative f, (forall c d . Coercible c d >>>> => Coercible (f c) (f d)) ) => >>>> (a -> f (Maybe b)) -> RAList a -> f (RAList b) >>>> wither = \f la -> coerce $ QRA.wither f $ coerce la >>>> ``` >>>> >>>> i'd much rather be able to write >>>> ``` >>>> wither :: forall a b f . (Applicative f) => >>>> (a -> f (Maybe b)) -> RAList a -> f (RAList b) >>>> wither = \f la -> coerce $ QRA.wither f $ coerce la >>>> ``` >>>> >>>> >>>> this seems like it'd be best done via something like changing the >>>> functor class definition to >>>> >>>> ``` >>>> class (forall c d . Coercible c d => Coercible (f c) (f d)) ) => >>>> Functor f where .. >>>> ``` >>>> >>>> is there any specific reason why this is not feasible? I cant think of >>>> a GADT where this wouldn't be totally safe to do (because unlike in >>>> foldable, f is in both the domain and co-domain), but maybe i'm not being >>>> imaginative enough? >>>> >>>> look forward to learning what our obstacles are to making this happen >>>> for ghc 9.2 :) >>>> >>>> -Carter >>>> >>>> _______________________________________________ >>>> Libraries mailing list >>>> Libraries at haskell.org >>>> http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries >>>> >>> >> _______________________________________________ >> 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 carter.schonwald at gmail.com Sun Jan 3 18:02:18 2021 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Sun, 3 Jan 2021 13:02:18 -0500 Subject: can/should Functor have a quantified coercible constraint? In-Reply-To: <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> Message-ID: Isn’t the issue here the first orderness of the current roles system in ghc? In which case what technological issues should be fixed? That we can’t do this because of limitations in the role system and I feel that doing this sortah change would *force* this to be prioritized. This limitation is a misfeature, how can we make this get addressed sooner rather than later? Is this somewhere where Eg Haskell foundation or something could help? On Sun, Jan 3, 2021 at 12:15 PM Oleg Grenrus wrote: > I think Mag, regex-applicative etc. examples are all reparable. The main > culprit is however StateT and a like, as you pointed out. It's meaningless > to discuss Mag if we cannot even write Functor m => Functor (StateT s m). > > > Coercible constraints aren't unpacked in data constructors > > Aren't they zero-width at run time? That's IMO a bug if that is not true. > > > > - Oleg > On 3.1.2021 19.08, David Feuer wrote: > > Mag uses the One it does for efficiency/compactness. Coercible constraints > aren't unpacked in data constructors, sadly. If you're looking for more > examples of slightly-invalid but useful Functors, the first place I'd check > (beyond the very-Mag-like things in lens that inspired Mag) is Roman > Cheplyaka's regex-applicative. I don't know if his lifts coercions or not > (haven't looked in a while) but it does some similarly illegitimate things > for good reasons. > > On Sun, Jan 3, 2021, 12:03 PM Oleg Grenrus wrote: > >> Prelude Control.Monad.Trans.State> :i StateT >> type role StateT nominal representational nominal >> >> Note, `StateT` is nominal in last argument (a). Thus if (forall c d. >> Coercible ...) where a Functor superclass, Functor (and thus Monad) >> wouldn't be definable for StateT. That would be... unfortunate. >> >> Until there are "higher roles" Functor cannot be Coercible1. It would >> rule very simple code. >> (OTOH Mag can be repaired, >> https://oleg.fi/gists/posts/2019-07-31-fmap-coerce-coerce.html#functor-should-be-parametric >> ). >> >> - Oleg >> >> On 3.1.2021 18.31, Carter Schonwald wrote: >> >> Hey David, >> could you exposit what would go wrong? a concrete proof witness or >> explanation would help me a lot. other people might benefit too. >> >> >> for the stateT s Maybe a, perhaps i'm still waking up this AM, so let me >> try >> newtype StateT s m a = StateT {runStateT :: s -> m (a, s)} >> >> so this should expand to >> '(s -> Maybe (a,s)),' >> but the coerce would be on the 'a' here ... so i'm not seeing the issue? >> >> >> >> the latter example seem to boil down to "a free appplicative/functor >> Gadt" with some extra bits, though i've not worked through to seeing the >> unsafety >> for the latter examples, the definitions are the following : >> >> traverseBia :: (Traversable t , Biapplicative p ) => (a -> p b c ) -> t a -> p (t b ) (t c )traverseBia = inline (traverseBiaWith traverse) >> --------traverseBiaWith :: forall p a b c s t . Biapplicative p => (forall f x . Applicative f => (a -> f x ) -> s -> f (t x )) -> (a -> p b c ) -> s -> p (t b ) (t c )traverseBiaWith trav p s = smash p (trav One s ) >> -------smash :: forall p t a b c . Biapplicative p => (a -> p b c ) -> (forall x . Mag a x (t x )) -> p (t b ) (t c )smash p m = go m m where go :: forall x y . Mag a b x -> Mag a c y -> p x y go (Pure t ) (Pure u ) = bipure t u go (Map f x ) (Map g y ) = bimap f g (go x y ) go (Ap fs xs ) (Ap gs ys ) = go fs gs <<*>> go xs ys >> #if MIN_VERSION_base(4,10,0) go (LiftA2 f xs ys ) (LiftA2 g zs ws ) = biliftA2 f g (go xs zs ) (go ys ws ) >> #endif go (One x ) (One _) = p x go _ _ = impossibleError >> >> ---- and then the magma is -- This is used to reify a traversal for 'traverseBia'. It's a somewhat-- bogus 'Functor' and 'Applicative' closely related to 'Magma' from the-- @lens@ package. Valid traversals don't use (<$), (<*), or (*>), so-- we leave them out. We offer all the rest of the Functor and Applicative-- operations to improve performance: we generally want to keep the structure-- as small as possible. We might even consider using RULES to widen lifts-- when we can:---- liftA2 f x y <*> z ==> liftA3 f x y z,---- etc., up to the pointer tagging limit. But we do need to be careful. I don't-- *think* GHC will ever inline the traversal into the go function (because that-- would duplicate work), but if it did, and if different RULES fired for the-- two copies, everything would break horribly.---- Note: if it's necessary for some reason, we *could* relax GADTs to-- ExistentialQuantification by changing the type of One to---- One :: (b -> c) -> a -> Mag a b c---- where the function will always end up being id. But we allocate a *lot*-- of One constructors, so this would definitely be bad for performance.data Mag a b t where Pure :: t -> Mag a b t Map :: (x -> t ) -> Mag a b x -> Mag a b t Ap :: Mag a b (t -> u ) -> Mag a b t -> Mag a b u >> #if MIN_VERSION_base(4,10,0) LiftA2 :: (t -> u -> v ) -> Mag a b t -> Mag a b u -> Mag a b v >> #endif One :: a -> Mag a b b instance Functor (Mag a b ) where fmap = Map instance Applicative (Mag a b ) where pure = Pure (<*>) = Ap >> #if MIN_VERSION_base(4,10,0) liftA2 = LiftA2 >> #endif >> >> >> >> On Sun, Jan 3, 2021 at 11:09 AM David Feuer >> wrote: >> >>> You're not being very imaginative at all. Try out, oh, `StateT s Maybe`. >>> Or play around with a nice fake functor like the magma used to implement >>> `traverseBia` in `bifunctors`—pretty sure that won't work out. >>> >>> On Sun, Jan 3, 2021, 11:00 AM Carter Schonwald < >>> carter.schonwald at gmail.com> wrote: >>> >>>> Hey everyone! >>>> >>>> for context, I have some code where I was seeing how far coerce lets me >>>> go to avoid doing wrappers for certain codes, >>>> >>>> i found i had to write the following (mapping an operation over to its >>>> newtyped sibling) >>>> >>>> ``` >>>> -- > :t QRA.wither >>>> --- forall a b f . Applicative f => (a -> f (Maybe b)) -> RAList a -> f >>>> (RAList b) >>>> --- >>>> wither :: forall a b f . (Applicative f, (forall c d . Coercible c d >>>> => Coercible (f c) (f d)) ) => >>>> (a -> f (Maybe b)) -> RAList a -> f (RAList b) >>>> wither = \f la -> coerce $ QRA.wither f $ coerce la >>>> ``` >>>> >>>> i'd much rather be able to write >>>> ``` >>>> wither :: forall a b f . (Applicative f) => >>>> (a -> f (Maybe b)) -> RAList a -> f (RAList b) >>>> wither = \f la -> coerce $ QRA.wither f $ coerce la >>>> ``` >>>> >>>> >>>> this seems like it'd be best done via something like changing the >>>> functor class definition to >>>> >>>> ``` >>>> class (forall c d . Coercible c d => Coercible (f c) (f d)) ) => >>>> Functor f where .. >>>> ``` >>>> >>>> is there any specific reason why this is not feasible? I cant think of >>>> a GADT where this wouldn't be totally safe to do (because unlike in >>>> foldable, f is in both the domain and co-domain), but maybe i'm not being >>>> imaginative enough? >>>> >>>> look forward to learning what our obstacles are to making this happen >>>> for ghc 9.2 :) >>>> >>>> -Carter >>>> >>>> _______________________________________________ >>>> Libraries mailing list >>>> Libraries at haskell.org >>>> http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries >>>> >>> >> _______________________________________________ >> 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 >> > _______________________________________________ > 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 carter.schonwald at gmail.com Sun Jan 3 18:25:02 2021 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Sun, 3 Jan 2021 13:25:02 -0500 Subject: can/should Functor have a quantified coercible constraint? In-Reply-To: References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> Message-ID: So like, for stateT, isn’t the “fix” adding suport for higher order role annotations to surface Haskell? On Sun, Jan 3, 2021 at 1:02 PM Carter Schonwald wrote: > Isn’t the issue here the first orderness of the current roles system in > ghc? In which case what technological issues should be fixed? That we > can’t do this because of limitations in the role system and I feel that > doing this sortah change would *force* this to be prioritized. > > This limitation is a misfeature, how can we make this get addressed sooner > rather than later? Is this somewhere where Eg Haskell foundation or > something could help? > > On Sun, Jan 3, 2021 at 12:15 PM Oleg Grenrus wrote: > >> I think Mag, regex-applicative etc. examples are all reparable. The main >> culprit is however StateT and a like, as you pointed out. It's meaningless >> to discuss Mag if we cannot even write Functor m => Functor (StateT s m). >> >> > Coercible constraints aren't unpacked in data constructors >> >> Aren't they zero-width at run time? That's IMO a bug if that is not true. >> >> >> >> - Oleg >> On 3.1.2021 19.08, David Feuer wrote: >> >> Mag uses the One it does for efficiency/compactness. Coercible >> constraints aren't unpacked in data constructors, sadly. If you're looking >> for more examples of slightly-invalid but useful Functors, the first place >> I'd check (beyond the very-Mag-like things in lens that inspired Mag) is >> Roman Cheplyaka's regex-applicative. I don't know if his lifts coercions or >> not (haven't looked in a while) but it does some similarly illegitimate >> things for good reasons. >> >> On Sun, Jan 3, 2021, 12:03 PM Oleg Grenrus wrote: >> >>> Prelude Control.Monad.Trans.State> :i StateT >>> type role StateT nominal representational nominal >>> >>> Note, `StateT` is nominal in last argument (a). Thus if (forall c d. >>> Coercible ...) where a Functor superclass, Functor (and thus Monad) >>> wouldn't be definable for StateT. That would be... unfortunate. >>> >>> Until there are "higher roles" Functor cannot be Coercible1. It would >>> rule very simple code. >>> (OTOH Mag can be repaired, >>> https://oleg.fi/gists/posts/2019-07-31-fmap-coerce-coerce.html#functor-should-be-parametric >>> ). >>> >>> - Oleg >>> >>> On 3.1.2021 18.31, Carter Schonwald wrote: >>> >>> Hey David, >>> could you exposit what would go wrong? a concrete proof witness or >>> explanation would help me a lot. other people might benefit too. >>> >>> >>> for the stateT s Maybe a, perhaps i'm still waking up this AM, so let me >>> try >>> newtype StateT s m a = StateT {runStateT :: s -> m (a, s)} >>> >>> so this should expand to >>> '(s -> Maybe (a,s)),' >>> but the coerce would be on the 'a' here ... so i'm not seeing the issue? >>> >>> >>> >>> the latter example seem to boil down to "a free appplicative/functor >>> Gadt" with some extra bits, though i've not worked through to seeing the >>> unsafety >>> for the latter examples, the definitions are the following : >>> >>> traverseBia :: (Traversable t , Biapplicative p ) => (a -> p b c ) -> t a -> p (t b ) (t c )traverseBia = inline (traverseBiaWith traverse) >>> --------traverseBiaWith :: forall p a b c s t . Biapplicative p => (forall f x . Applicative f => (a -> f x ) -> s -> f (t x )) -> (a -> p b c ) -> s -> p (t b ) (t c )traverseBiaWith trav p s = smash p (trav One s ) >>> -------smash :: forall p t a b c . Biapplicative p => (a -> p b c ) -> (forall x . Mag a x (t x )) -> p (t b ) (t c )smash p m = go m m where go :: forall x y . Mag a b x -> Mag a c y -> p x y go (Pure t ) (Pure u ) = bipure t u go (Map f x ) (Map g y ) = bimap f g (go x y ) go (Ap fs xs ) (Ap gs ys ) = go fs gs <<*>> go xs ys >>> #if MIN_VERSION_base(4,10,0) go (LiftA2 f xs ys ) (LiftA2 g zs ws ) = >>> >>> -------------- next part -------------- An HTML attachment was scrubbed... URL: From carter.schonwald at gmail.com Sun Jan 3 19:40:43 2021 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Sun, 3 Jan 2021 14:40:43 -0500 Subject: can/should Functor have a quantified coercible constraint? In-Reply-To: References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> Message-ID: In particular; the original design for roles was to attach role info to the kinds of types. See https://www.seas.upenn.edu/~sweirich/papers/popl163af-weirich.pdf from 2011 Since ghc now has pervasive annotations on types internally via the linearity work, enriching those with role information may be a tad more tractable than it was at the time On Sun, Jan 3, 2021 at 1:25 PM Carter Schonwald wrote: > So like, for stateT, isn’t the “fix” adding suport for higher order role > annotations to surface Haskell? > > On Sun, Jan 3, 2021 at 1:02 PM Carter Schonwald < > carter.schonwald at gmail.com> wrote: > >> Isn’t the issue here the first orderness of the current roles system in >> ghc? In which case what technological issues should be fixed? That we >> can’t do this because of limitations in the role system and I feel that >> doing this sortah change would *force* this to be prioritized. >> >> This limitation is a misfeature, how can we make this get addressed >> sooner rather than later? Is this somewhere where Eg Haskell foundation or >> something could help? >> >> On Sun, Jan 3, 2021 at 12:15 PM Oleg Grenrus wrote: >> >>> I think Mag, regex-applicative etc. examples are all reparable. The main >>> culprit is however StateT and a like, as you pointed out. It's meaningless >>> to discuss Mag if we cannot even write Functor m => Functor (StateT s m). >>> >>> > Coercible constraints aren't unpacked in data constructors >>> >>> Aren't they zero-width at run time? That's IMO a bug if that is not true. >>> >>> >>> >>> - Oleg >>> On 3.1.2021 19.08, David Feuer wrote: >>> >>> Mag uses the One it does for efficiency/compactness. Coercible >>> constraints aren't unpacked in data constructors, sadly. If you're looking >>> for more examples of slightly-invalid but useful Functors, the first place >>> I'd check (beyond the very-Mag-like things in lens that inspired Mag) is >>> Roman Cheplyaka's regex-applicative. I don't know if his lifts coercions or >>> not (haven't looked in a while) but it does some similarly illegitimate >>> things for good reasons. >>> >>> On Sun, Jan 3, 2021, 12:03 PM Oleg Grenrus wrote: >>> >>>> Prelude Control.Monad.Trans.State> :i StateT >>>> type role StateT nominal representational nominal >>>> >>>> Note, `StateT` is nominal in last argument (a). Thus if (forall c d. >>>> Coercible ...) where a Functor superclass, Functor (and thus Monad) >>>> wouldn't be definable for StateT. That would be... unfortunate. >>>> >>>> Until there are "higher roles" Functor cannot be Coercible1. It would >>>> rule very simple code. >>>> (OTOH Mag can be repaired, >>>> https://oleg.fi/gists/posts/2019-07-31-fmap-coerce-coerce.html#functor-should-be-parametric >>>> ). >>>> >>>> - Oleg >>>> >>>> On 3.1.2021 18.31, Carter Schonwald wrote: >>>> >>>> Hey David, >>>> could you exposit what would go wrong? a concrete proof witness or >>>> explanation would help me a lot. other people might benefit too. >>>> >>>> >>>> for the stateT s Maybe a, perhaps i'm still waking up this AM, so let >>>> me try >>>> newtype StateT s m a = StateT {runStateT :: s -> m (a, s)} >>>> >>>> so this should expand to >>>> '(s -> Maybe (a,s)),' >>>> but the coerce would be on the 'a' here ... so i'm not seeing the issue? >>>> >>>> >>>> >>>> the latter example seem to boil down to "a free appplicative/functor >>>> Gadt" with some extra bits, though i've not worked through to seeing the >>>> unsafety >>>> for the latter examples, the definitions are the following : >>>> >>>> traverseBia :: (Traversable t , Biapplicative p ) => (a -> p b c ) -> t a -> p (t b ) (t c )traverseBia = inline (traverseBiaWith traverse) >>>> --------traverseBiaWith :: forall p a b c s t . Biapplicative p => (forall f x . Applicative f => (a -> f x ) -> s -> f (t x )) -> (a -> p b c ) -> s -> p (t b ) (t c )traverseBiaWith trav p s = smash p (trav One s ) >>>> -------smash :: forall p t a b c . Biapplicative p => (a -> p b c ) -> (forall x . Mag a x (t x )) -> p (t b ) (t c )smash p m = go m m where go :: forall x y . Mag a b x -> Mag a c y -> p x y go (Pure t ) (Pure u ) = bipure t u go (Map f x ) (Map g y ) = bimap f g (go x y ) go (Ap fs xs ) (Ap gs ys ) = go fs gs <<*>> go xs ys >>>> #if MIN_VERSION_base(4,10,0) go (LiftA2 f xs ys ) (LiftA2 g zs ws ) = >>>> >>>> -------------- next part -------------- An HTML attachment was scrubbed... URL: From carter.schonwald at gmail.com Mon Jan 4 02:18:02 2021 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Sun, 3 Jan 2021 21:18:02 -0500 Subject: can/should Functor have a quantified coercible constraint? In-Reply-To: References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> Message-ID: i think its worth emphasizing that ghc today uses a simplification of the original 2011 paper... so revisiting it and seeing if the original design is worthwhile may be easier than you'd expect! for my own purposes, i'm doing the approach below / inline for now ;) wither :: forall a b f . (Applicative f) => (a -> f (Maybe b)) -> RAList a -> f (RAList b) wither = \f la -> coerceWith coerceThroughFunctor $ QRA.wither f $ coerce la --- -- applicatives / functors can be coerced under, i have spoken {- for context, i otherwise need to do the following : wither :: forall a b f . (Applicative f, (forall c d . Coercible c d => Coercible (f c) (f d)) ) => (a -> f (Maybe b)) -> RAList a -> f (RAList b) wither = \f la -> coerce $ QRA.wither f $ coerce la -} {-#INLINE coerceThroughFunctor #-} coerceThroughFunctor :: forall a b f. (Coercible a b, Functor f) => (Coercion (f a) (f b)) coerceThroughFunctor = (unsafeCoerce (Coercion :: Coercion a b )) :: (Coercion (f a) (f b)) On Sun, Jan 3, 2021 at 2:40 PM Carter Schonwald wrote: > In particular; the original design for roles was to attach role info to > the kinds of types. See > https://www.seas.upenn.edu/~sweirich/papers/popl163af-weirich.pdf from > 2011 > > Since ghc now has pervasive annotations on types internally via the > linearity work, enriching those with role information may be a tad more > tractable than it was at the time > > On Sun, Jan 3, 2021 at 1:25 PM Carter Schonwald < > carter.schonwald at gmail.com> wrote: > >> So like, for stateT, isn’t the “fix” adding suport for higher order role >> annotations to surface Haskell? >> >> On Sun, Jan 3, 2021 at 1:02 PM Carter Schonwald < >> carter.schonwald at gmail.com> wrote: >> >>> Isn’t the issue here the first orderness of the current roles system in >>> ghc? In which case what technological issues should be fixed? That we >>> can’t do this because of limitations in the role system and I feel that >>> doing this sortah change would *force* this to be prioritized. >>> >>> This limitation is a misfeature, how can we make this get addressed >>> sooner rather than later? Is this somewhere where Eg Haskell foundation or >>> something could help? >>> >>> On Sun, Jan 3, 2021 at 12:15 PM Oleg Grenrus >>> wrote: >>> >>>> I think Mag, regex-applicative etc. examples are all reparable. The >>>> main culprit is however StateT and a like, as you pointed out. It's >>>> meaningless to discuss Mag if we cannot even write Functor m => Functor >>>> (StateT s m). >>>> >>>> > Coercible constraints aren't unpacked in data constructors >>>> >>>> Aren't they zero-width at run time? That's IMO a bug if that is not >>>> true. >>>> >>>> >>>> >>>> - Oleg >>>> On 3.1.2021 19.08, David Feuer wrote: >>>> >>>> Mag uses the One it does for efficiency/compactness. Coercible >>>> constraints aren't unpacked in data constructors, sadly. If you're looking >>>> for more examples of slightly-invalid but useful Functors, the first place >>>> I'd check (beyond the very-Mag-like things in lens that inspired Mag) is >>>> Roman Cheplyaka's regex-applicative. I don't know if his lifts coercions or >>>> not (haven't looked in a while) but it does some similarly illegitimate >>>> things for good reasons. >>>> >>>> On Sun, Jan 3, 2021, 12:03 PM Oleg Grenrus wrote: >>>> >>>>> Prelude Control.Monad.Trans.State> :i StateT >>>>> type role StateT nominal representational nominal >>>>> >>>>> Note, `StateT` is nominal in last argument (a). Thus if (forall c d. >>>>> Coercible ...) where a Functor superclass, Functor (and thus Monad) >>>>> wouldn't be definable for StateT. That would be... unfortunate. >>>>> >>>>> Until there are "higher roles" Functor cannot be Coercible1. It would >>>>> rule very simple code. >>>>> (OTOH Mag can be repaired, >>>>> https://oleg.fi/gists/posts/2019-07-31-fmap-coerce-coerce.html#functor-should-be-parametric >>>>> ). >>>>> >>>>> - Oleg >>>>> >>>>> On 3.1.2021 18.31, Carter Schonwald wrote: >>>>> >>>>> Hey David, >>>>> could you exposit what would go wrong? a concrete proof witness or >>>>> explanation would help me a lot. other people might benefit too. >>>>> >>>>> >>>>> for the stateT s Maybe a, perhaps i'm still waking up this AM, so let >>>>> me try >>>>> newtype StateT s m a = StateT {runStateT :: s -> m (a, s)} >>>>> >>>>> so this should expand to >>>>> '(s -> Maybe (a,s)),' >>>>> but the coerce would be on the 'a' here ... so i'm not seeing the >>>>> issue? >>>>> >>>>> >>>>> >>>>> the latter example seem to boil down to "a free appplicative/functor >>>>> Gadt" with some extra bits, though i've not worked through to seeing the >>>>> unsafety >>>>> for the latter examples, the definitions are the following : >>>>> >>>>> traverseBia :: (Traversable t , Biapplicative p ) => (a -> p b c ) -> t a -> p (t b ) (t c )traverseBia = inline (traverseBiaWith traverse) >>>>> --------traverseBiaWith :: forall p a b c s t . Biapplicative p => (forall f x . Applicative f => (a -> f x ) -> s -> f (t x )) -> (a -> p b c ) -> s -> p (t b ) (t c )traverseBiaWith trav p s = smash p (trav One s ) >>>>> -------smash :: forall p t a b c . Biapplicative p => (a -> p b c ) -> (forall x . Mag a x (t x )) -> p (t b ) (t c )smash p m = go m m where go :: forall x y . Mag a b x -> Mag a c y -> p x y go (Pure t ) (Pure u ) = bipure t u go (Map f x ) (Map g y ) = bimap f g (go x y ) go (Ap fs xs ) (Ap gs ys ) = go fs gs <<*>> go xs ys >>>>> #if MIN_VERSION_base(4,10,0) go (LiftA2 f xs ys ) (LiftA2 g zs ws ) = >>>>> >>>>> -------------- next part -------------- An HTML attachment was scrubbed... URL: From john.ericson at obsidian.systems Mon Jan 4 06:59:49 2021 From: john.ericson at obsidian.systems (John Ericson) Date: Mon, 4 Jan 2021 01:59:49 -0500 Subject: Improving the instances of Data.Functor.{Product,Sum} In-Reply-To: <661b20b7-20a9-09db-9585-2cdd4a853f69@obsidian.systems> References: <661b20b7-20a9-09db-9585-2cdd4a853f69@obsidian.systems> Message-ID: With the recent approval of https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4527, I thought it might be good to revisit this. I implemented my plan in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4727. I point a hope the concrete implementation will make clear is that the flexible contexts and quantified constraints are *complementing*, not *competing*. You can do the flexible instance without the quantified constraint, but if you do the breakage will be worse, and the only newly-allowed programs will be dubious ones that did the *1 instance but forgot the corresponding regular instance. I hope we can make progress here, John On 5/19/20 10:51 AM, John Ericson wrote: >> >> The different results are: >> * FlexibleContexts approach: `(Eq (Maybe (f a)), Eq [f a])` >> * Eq1 typeclass: `(Eq1 f, Eq a)` >> * Quantified Constraints: `(forall x. Eq x => Eq (f x), Eq a)` >> > So if (per my plan[1]) `Eq1` has the quantified constraints > super-class,than Andrew Martin's second two options will imply the > first one. So it seems that the FlexibleContexts choice --- asking for > precisely what is needed --- is the best option, dare I say a > principle type. > >> I think we should pre address any maturity issues or composition/ >> generality concerns before folding quantified constraint  instances >> into base > > I am with you Carter, but the only issues with quantified constraints > we've discussed is around (~) and Coercible, but both shouldn't apply > here, so I think that's a red-herring. > > In particular, only the *1 classes would have a *wanted* quantified > constraint via super class (so just one imposed on instances). > Everything else would just use FlexibleContexts or stay the same. > [Extra given constraints do not in and of themselves pose inference > problems.] > > It is because the *1 classes do not involve (~) or Coercible, or have > anything like a `Type -> Constraint` parameters that could be > substituted for (partially applied) (~) or Coercible, that those > concerns shouldn't apply. > > John > > [1]: So nobody need waste their time looking it up, the super class is > (forall x. Eq x => Eq (f x)) => Eq1 f > > > _______________________________________________ > 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 roma at ro-che.info Mon Jan 4 10:50:20 2021 From: roma at ro-che.info (Roman Cheplyaka) Date: Mon, 4 Jan 2021 12:50:20 +0200 Subject: can/should Functor have a quantified coercible constraint? In-Reply-To: References: Message-ID: <936ed7a9-c033-cc28-cd65-e5bd1d8cd2c9@ro-che.info> On 03/01/2021 17.59, Carter Schonwald wrote: > this seems like it'd be best done via something like changing the > functor class definition to > > ``` > class (forall c d .  Coercible c d => Coercible (f c) (f d))  ) => > Functor f where .. > ``` I think it's important we keep the definitions of Functor and other fundamental classes understandable by newcomers, and this change would make the definition look scary for a marginal benefit. Roman From carter.schonwald at gmail.com Mon Jan 4 13:56:29 2021 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Mon, 4 Jan 2021 08:56:29 -0500 Subject: can/should Functor have a quantified coercible constraint? In-Reply-To: <936ed7a9-c033-cc28-cd65-e5bd1d8cd2c9@ro-che.info> References: <936ed7a9-c033-cc28-cd65-e5bd1d8cd2c9@ro-che.info> Message-ID: So this actually is a very good point! Happily, the technological steps needed to resolve issues that other comments so far have raised point to a better fix! Borrowing from the 2011 paper, we would write the following ‘’’ class Functor (f : Type/representational -> Type) where ‘’’ Basically this then pushes the info into kind signatures. As was originally intended. And role inferred/ annotated kind signatures provides a mechanism for gnd to work again for monad transformers and unvoxed vector On Mon, Jan 4, 2021 at 5:50 AM Roman Cheplyaka wrote: > On 03/01/2021 17.59, Carter Schonwald wrote: > > this seems like it'd be best done via something like changing the > > functor class definition to > > > > ``` > > class (forall c d . Coercible c d => Coercible (f c) (f d)) ) => > > Functor f where .. > > ``` > > I think it's important we keep the definitions of Functor and other > fundamental classes understandable by newcomers, and this change would > make the definition look scary for a marginal benefit. > > Roman > _______________________________________________ > 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 rae at richarde.dev Mon Jan 4 14:00:22 2021 From: rae at richarde.dev (Richard Eisenberg) Date: Mon, 4 Jan 2021 14:00:22 +0000 Subject: can/should Functor have a quantified coercible constraint? In-Reply-To: References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> Message-ID: <010f0176cdb2e82b-44e9c76c-44e7-4ba5-aaa7-4b7ebd1bbeaf-000000@us-east-2.amazonses.com> > On Jan 3, 2021, at 1:02 PM, Carter Schonwald wrote: > > This limitation is a misfeature, how can we make this get addressed sooner rather than later? Is this somewhere where Eg Haskell foundation or something could help? Lifting the limitation would be nice, but it's a lot of work. First, we need an updated theory for Core, with a type safety proof. This proof is essential: it's what our safety as a language depends on. Then, we'd need to implement it. I'm more worried about the former than the latter. > i think its worth emphasizing that ghc today uses a simplification of the original 2011 paper... Yes, that was originally true, but the current formulation goes beyond the 2011 paper in some respects. See section 7.1 of https://richarde.dev/papers/2016/coercible-jfp/coercible-jfp.pdf . Roman writes: > I think it's important we keep the definitions of Functor and other fundamental classes understandable by newcomers, and this change would make the definition look scary for a marginal benefit. This is tough. I've considered a Functor definition like the one Carter proposes before. I would personally rather come up with the best definition first, then figure out how to make it palatable to newcomers second. For example, we could write (today) > type Representational f = forall a b. Coercible a b => Coercible (f a) (f b) and then the class constraint looks more pleasant. Or we could create ways of suppressing confusing information. Or there are other solutions. Depending on the benefit of the change (here or elsewhere), I would advocate holding off on making the change until we can support it without disrupting the newcomer story. But I wouldn't want to abandon the idea of an improvement a priori just because of a disruption to the newcomer experience. Richard -------------- next part -------------- An HTML attachment was scrubbed... URL: From carter.schonwald at gmail.com Mon Jan 4 14:12:48 2021 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Mon, 4 Jan 2021 09:12:48 -0500 Subject: can/should Functor have a quantified coercible constraint? In-Reply-To: <010f0176cdb2e82b-44e9c76c-44e7-4ba5-aaa7-4b7ebd1bbeaf-000000@us-east-2.amazonses.com> References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> <010f0176cdb2e82b-44e9c76c-44e7-4ba5-aaa7-4b7ebd1bbeaf-000000@us-east-2.amazonses.com> Message-ID: Thx for the link. I’ll take a look at your suggested reading. What are ways I could help progress whatever’s needed to get to a nice ending? On Mon, Jan 4, 2021 at 9:00 AM Richard Eisenberg wrote: > > > On Jan 3, 2021, at 1:02 PM, Carter Schonwald > wrote: > > This limitation is a misfeature, how can we make this get addressed sooner > rather than later? Is this somewhere where Eg Haskell foundation or > something could help? > > > Lifting the limitation would be nice, but it's a lot of work. First, we > need an updated theory for Core, with a type safety proof. This proof is > essential: it's what our safety as a language depends on. Then, we'd need > to implement it. I'm more worried about the former than the latter. > > > i think its worth emphasizing that ghc today uses a simplification of > the original 2011 paper... > > Yes, that was originally true, but the current formulation goes beyond the > 2011 paper in some respects. See section 7.1 of > https://richarde.dev/papers/2016/coercible-jfp/coercible-jfp.pdf. > > Roman writes: > > > I think it's important we keep the definitions of Functor and other > fundamental classes understandable by newcomers, and this change would > make the definition look scary for a marginal benefit. > > This is tough. I've considered a Functor definition like the one Carter > proposes before. I would personally rather come up with the best definition > first, then figure out how to make it palatable to newcomers second. For > example, we could write (today) > > > type Representational f = forall a b. Coercible a b => Coercible (f a) > (f b) > > and then the class constraint looks more pleasant. Or we could create ways > of suppressing confusing information. Or there are other solutions. > Depending on the benefit of the change (here or elsewhere), I would > advocate holding off on making the change until we can support it without > disrupting the newcomer story. But I wouldn't want to abandon the idea of > an improvement a priori just because of a disruption to the newcomer > experience. > > Richard > -------------- next part -------------- An HTML attachment was scrubbed... URL: From john.ericson at obsidian.systems Mon Jan 4 14:40:58 2021 From: john.ericson at obsidian.systems (John Ericson) Date: Mon, 4 Jan 2021 09:40:58 -0500 Subject: can/should Functor have a quantified coercible constraint? In-Reply-To: References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> <010f0176cdb2e82b-44e9c76c-44e7-4ba5-aaa7-4b7ebd1bbeaf-000000@us-east-2.amazonses.com> Message-ID: <7f303323-73ff-97b1-9d5e-5888b662e483@obsidian.systems> I talked to Carter a bit on IRC for my progress on that front, but I thought maybe this would be a good time to mention this more widely - The constraint side is iffy. Local constraints and constraint kinds make it hard to have some sort of codata guardedness / cotermination checking argument for higher order coercion "instances" that doesn't also need to apply to the constraint system at large, which makes it quite laborious to increase expressive power without trade-offs like no local quantified constraints. (Yay mission creep.) - The core side looks good. Cale and I pretty confident in the "coercions as fixed points of products", with {0, 1, multiplication, and exponentiation, limits} passing my cardinality sniff test that coercions still have no computational content and thus can be erased. - Additionally, I am less but decently confident (though I haven't talked to Cale about this) that the existing role admissibility solver can be repurposed to produce those (to-be-erased) terms rather than just merely deciding the admissibility of (opaque) axiomatic coercions. This change would have no expressive power implications one way or the other, but complete the "theory refactor" so that the "sans-nth" version could be said to work end to end. So tl;dr I /can't/ actually do anything to help Carter's problem at the moment, but I think I can get David's https://github.com/ghc-proposals/ghc-proposals/pull/276 over the finish line, with the side benefit of loosening things up and getting us closer so the higher-order roles problem seems less out of reach. I have revised my "progress report" wildly since I started thinking about these things, but with the latest ratchet back, I think I finally have a stable prediction. Cheers, John On 1/4/21 9:12 AM, Carter Schonwald wrote: > Thx for  the link.  I’ll take a look at your suggested reading. > > What are ways I could help progress whatever’s needed to get to a nice > ending? > > On Mon, Jan 4, 2021 at 9:00 AM Richard Eisenberg > wrote: > > > >> On Jan 3, 2021, at 1:02 PM, Carter Schonwald >> > >> wrote: >> >> This limitation is a misfeature, how can we make this get >> addressed sooner rather than later? Is this somewhere where Eg >> Haskell foundation or something could help? > > Lifting the limitation would be nice, but it's a lot of work. > First, we need an updated theory for Core, with a type safety > proof. This proof is essential: it's what our safety as a language > depends on. Then, we'd need to implement it. I'm more worried > about the former than the latter. > > > i think its worth emphasizing that ghc today uses a > simplification of the original 2011 paper... > > Yes, that was originally true, but the current formulation goes > beyond the 2011 paper in some respects. See section 7.1 of > https://richarde.dev/papers/2016/coercible-jfp/coercible-jfp.pdf > . > > Roman writes: > > > I think it's important we keep the definitions of Functor and other > fundamental classes understandable by newcomers, and this change would > make the definition look scary for a marginal benefit. > > This is tough. I've considered a Functor definition like the one > Carter proposes before. I would personally rather come up with the > best definition first, then figure out how to make it palatable to > newcomers second. For example, we could write (today) > > > type Representational f = forall a b. Coercible a b => Coercible > (f a) (f b) > > and then the class constraint looks more pleasant. Or we could > create ways of suppressing confusing information. Or there are > other solutions. Depending on the benefit of the change (here or > elsewhere), I would advocate holding off on making the change > until we can support it without disrupting the newcomer story. But > I wouldn't want to abandon the idea of an improvement a priori > just because of a disruption to the newcomer experience. > > Richard > > > _______________________________________________ > 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 keith.wygant at gmail.com Fri Jan 8 16:52:33 2021 From: keith.wygant at gmail.com (Keith) Date: Fri, 08 Jan 2021 16:52:33 +0000 Subject: Misleading strictness annotations in Data.List.NonEmpty In-Reply-To: <7f303323-73ff-97b1-9d5e-5888b662e483@obsidian.systems> References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> <010f0176cdb2e82b-44e9c76c-44e7-4ba5-aaa7-4b7ebd1bbeaf-000000@us-east-2.amazonses.com> <7f303323-73ff-97b1-9d5e-5888b662e483@obsidian.systems> Message-ID: <1F52DA8C-EA71-4E8D-BEAD-E65E4F225576@gmail.com> Currently: head ~(a :| _) = a tail ~(_ :| as) = as But head and tail are both strict. At best the '~'s have no effect. Should I open a PR to change it to head (a :| _) = a tail (_ :| as) = as or maybe even more clearly head !(a :l _) = a tail !(_ :| as) = as ? --Keith Sent from my phone with K-9 Mail. On January 4, 2021 2:40:58 PM UTC, John Ericson wrote: >I talked to Carter a bit on IRC for my progress on that front, but I >thought maybe this would be a good time to mention this more widely > >- The constraint side is iffy. Local constraints and constraint kinds >make it hard to have some sort of codata guardedness / cotermination >checking argument for higher order coercion "instances" that doesn't >also need to apply to the constraint system at large, which makes it >quite laborious to increase expressive power without trade-offs like no >local quantified constraints. (Yay mission creep.) > >- The core side looks good. Cale and I pretty confident in the >"coercions as fixed points of products", with {0, 1, multiplication, and >exponentiation, limits} passing my cardinality sniff test that coercions >still have no computational content and thus can be erased. > >- Additionally, I am less but decently confident (though I haven't >talked to Cale about this) that the existing role admissibility solver >can be repurposed to produce those (to-be-erased) terms rather than just >merely deciding the admissibility of (opaque) axiomatic coercions. This >change would have no expressive power implications one way or the other, >but complete the "theory refactor" so that the "sans-nth" version could >be said to work end to end. > >So tl;dr I /can't/ actually do anything to help Carter's problem at the >moment, but I think I can get David's >https://github.com/ghc-proposals/ghc-proposals/pull/276 over the finish >line, with the side benefit of loosening things up and getting us closer >so the higher-order roles problem seems less out of reach. > >I have revised my "progress report" wildly since I started thinking >about these things, but with the latest ratchet back, I think I finally >have a stable prediction. > >Cheers, > >John > >On 1/4/21 9:12 AM, Carter Schonwald wrote: >> Thx for  the link.  I’ll take a look at your suggested reading. >> >> What are ways I could help progress whatever’s needed to get to a nice >> ending? >> >> On Mon, Jan 4, 2021 at 9:00 AM Richard Eisenberg > > wrote: >> >> >> >>> On Jan 3, 2021, at 1:02 PM, Carter Schonwald >>> > >>> wrote: >>> >>> This limitation is a misfeature, how can we make this get >>> addressed sooner rather than later? Is this somewhere where Eg >>> Haskell foundation or something could help? >> >> Lifting the limitation would be nice, but it's a lot of work. >> First, we need an updated theory for Core, with a type safety >> proof. This proof is essential: it's what our safety as a language >> depends on. Then, we'd need to implement it. I'm more worried >> about the former than the latter. >> >> > i think its worth emphasizing that ghc today uses a >> simplification of the original 2011 paper... >> >> Yes, that was originally true, but the current formulation goes >> beyond the 2011 paper in some respects. See section 7.1 of >> https://richarde.dev/papers/2016/coercible-jfp/coercible-jfp.pdf >> . >> >> Roman writes: >> >> > I think it's important we keep the definitions of Functor and other >> fundamental classes understandable by newcomers, and this change would >> make the definition look scary for a marginal benefit. >> >> This is tough. I've considered a Functor definition like the one >> Carter proposes before. I would personally rather come up with the >> best definition first, then figure out how to make it palatable to >> newcomers second. For example, we could write (today) >> >> > type Representational f = forall a b. Coercible a b => Coercible >> (f a) (f b) >> >> and then the class constraint looks more pleasant. Or we could >> create ways of suppressing confusing information. Or there are >> other solutions. Depending on the benefit of the change (here or >> elsewhere), I would advocate holding off on making the change >> until we can support it without disrupting the newcomer story. But >> I wouldn't want to abandon the idea of an improvement a priori >> just because of a disruption to the newcomer experience. >> >> Richard >> >> >> _______________________________________________ >> 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 Jan 8 17:07:25 2021 From: david.feuer at gmail.com (David Feuer) Date: Fri, 8 Jan 2021 12:07:25 -0500 Subject: Misleading strictness annotations in Data.List.NonEmpty In-Reply-To: <1F52DA8C-EA71-4E8D-BEAD-E65E4F225576@gmail.com> References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> <010f0176cdb2e82b-44e9c76c-44e7-4ba5-aaa7-4b7ebd1bbeaf-000000@us-east-2.amazonses.com> <7f303323-73ff-97b1-9d5e-5888b662e483@obsidian.systems> <1F52DA8C-EA71-4E8D-BEAD-E65E4F225576@gmail.com> Message-ID: The first one. Neither twiddles nor bangs are useful or add clarity. On Fri, Jan 8, 2021, 11:53 AM Keith wrote: > Currently: > > head ~(a :| _) = a > tail ~(_ :| as) = as > > But head and tail are both strict. At best the '~'s have no effect. > > Should I open a PR to change it to > > head (a :| _) = a > tail (_ :| as) = as > > or maybe even more clearly > > head !(a :l _) = a > tail !(_ :| as) = as > > ? > --Keith > Sent from my phone with K-9 Mail. > > On January 4, 2021 2:40:58 PM UTC, John Ericson > wrote: >> >> I talked to Carter a bit on IRC for my progress on that front, but I >> thought maybe this would be a good time to mention this more widely >> >> - The constraint side is iffy. Local constraints and constraint kinds >> make it hard to have some sort of codata guardedness / cotermination >> checking argument for higher order coercion "instances" that doesn't also >> need to apply to the constraint system at large, which makes it quite >> laborious to increase expressive power without trade-offs like no local >> quantified constraints. (Yay mission creep.) >> >> - The core side looks good. Cale and I pretty confident in the "coercions >> as fixed points of products", with {0, 1, multiplication, and >> exponentiation, limits} passing my cardinality sniff test that coercions >> still have no computational content and thus can be erased. >> >> - Additionally, I am less but decently confident (though I haven't talked >> to Cale about this) that the existing role admissibility solver can be >> repurposed to produce those (to-be-erased) terms rather than just merely >> deciding the admissibility of (opaque) axiomatic coercions. This change >> would have no expressive power implications one way or the other, but >> complete the "theory refactor" so that the "sans-nth" version could be said >> to work end to end. >> >> So tl;dr I *can't* actually do anything to help Carter's problem at the >> moment, but I think I can get David's >> https://github.com/ghc-proposals/ghc-proposals/pull/276 over the finish >> line, with the side benefit of loosening things up and getting us closer so >> the higher-order roles problem seems less out of reach. >> >> I have revised my "progress report" wildly since I started thinking about >> these things, but with the latest ratchet back, I think I finally have a >> stable prediction. >> >> Cheers, >> >> John >> On 1/4/21 9:12 AM, Carter Schonwald wrote: >> >> Thx for the link. I’ll take a look at your suggested reading. >> >> What are ways I could help progress whatever’s needed to get to a nice >> ending? >> >> On Mon, Jan 4, 2021 at 9:00 AM Richard Eisenberg >> wrote: >> >>> >>> >>> On Jan 3, 2021, at 1:02 PM, Carter Schonwald >>> wrote: >>> >>> This limitation is a misfeature, how can we make this get addressed >>> sooner rather than later? Is this somewhere where Eg Haskell foundation or >>> something could help? >>> >>> >>> Lifting the limitation would be nice, but it's a lot of work. First, we >>> need an updated theory for Core, with a type safety proof. This proof is >>> essential: it's what our safety as a language depends on. Then, we'd need >>> to implement it. I'm more worried about the former than the latter. >>> >>> > i think its worth emphasizing that ghc today uses a simplification of >>> the original 2011 paper... >>> >>> Yes, that was originally true, but the current formulation goes beyond >>> the 2011 paper in some respects. See section 7.1 of >>> https://richarde.dev/papers/2016/coercible-jfp/coercible-jfp.pdf. >>> >>> Roman writes: >>> >>> > I think it's important we keep the definitions of Functor and other >>> fundamental classes understandable by newcomers, and this change would >>> make the definition look scary for a marginal benefit. >>> >>> This is tough. I've considered a Functor definition like the one Carter >>> proposes before. I would personally rather come up with the best definition >>> first, then figure out how to make it palatable to newcomers second. For >>> example, we could write (today) >>> >>> > type Representational f = forall a b. Coercible a b => Coercible (f a) >>> (f b) >>> >>> and then the class constraint looks more pleasant. Or we could create >>> ways of suppressing confusing information. Or there are other solutions. >>> Depending on the benefit of the change (here or elsewhere), I would >>> advocate holding off on making the change until we can support it without >>> disrupting the newcomer story. But I wouldn't want to abandon the idea of >>> an improvement a priori just because of a disruption to the newcomer >>> experience. >>> >>> Richard >>> >> >> _______________________________________________ >> 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 tom-lists-haskell-cafe-2017 at jaguarpaw.co.uk Fri Jan 8 17:11:07 2021 From: tom-lists-haskell-cafe-2017 at jaguarpaw.co.uk (Tom Ellis) Date: Fri, 8 Jan 2021 17:11:07 +0000 Subject: Misleading strictness annotations in Data.List.NonEmpty In-Reply-To: <1F52DA8C-EA71-4E8D-BEAD-E65E4F225576@gmail.com> References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> <010f0176cdb2e82b-44e9c76c-44e7-4ba5-aaa7-4b7ebd1bbeaf-000000@us-east-2.amazonses.com> <7f303323-73ff-97b1-9d5e-5888b662e483@obsidian.systems> <1F52DA8C-EA71-4E8D-BEAD-E65E4F225576@gmail.com> Message-ID: <20210108171107.GJ14716@cloudinit-builder> On Fri, Jan 08, 2021 at 04:52:33PM +0000, Keith wrote: > Currently: > > head ~(a :| _) = a > tail ~(_ :| as) = as > > But head and tail are both strict. At best the '~'s have no effect. > > Should I open a PR to change it to > > head (a :| _) = a > tail (_ :| as) = as I would support that. It would be nice if GHC warned about misleading lazy patterns. > or maybe even more clearly > > head !(a :l _) = a > tail !(_ :| as) = as Why do you say "more clearly"? Every pattern match is strict, more or less by definition[1] so I don't see how a bang pattern adds anything. If this is more clear then shouldn't we make the case to do it to *every* pattern match everywhere? Tom [1] with the exception of weird edge cases around pattern synonyms: pattern Pat :: p pattern Pat <- _ pattern LPat :: a -> Maybe a pattern LPat a <- ~(Just a) f :: a -> Int f Pat = 1 f _ = 2 f' :: a -> Int f' !Pat = 1 f' _ = 2 g :: Maybe a -> Int g (LPat _) = 1 g _ = 2 g' :: Maybe a -> Int g' (LPat _) = 1 g' _ = 2 From lemming at henning-thielemann.de Fri Jan 8 17:13:31 2021 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Fri, 8 Jan 2021 18:13:31 +0100 (CET) Subject: Misleading strictness annotations in Data.List.NonEmpty In-Reply-To: <1F52DA8C-EA71-4E8D-BEAD-E65E4F225576@gmail.com> References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> <010f0176cdb2e82b-44e9c76c-44e7-4ba5-aaa7-4b7ebd1bbeaf-000000@us-east-2.amazonses.com> <7f303323-73ff-97b1-9d5e-5888b662e483@obsidian.systems> <1F52DA8C-EA71-4E8D-BEAD-E65E4F225576@gmail.com> Message-ID: On Fri, 8 Jan 2021, Keith wrote: > Currently: > > head ~(a :| _) = a > tail ~(_ :| as) = as > > But head and tail are both strict. At best the '~'s have no effect. > > Should I open a PR to change it to > > head (a :| _) = a > tail (_ :| as) = as > > or maybe even more clearly > > head !(a :l _) = a > tail !(_ :| as) = as > > ? The last one would trigger the "redundant bang pattern" warning that is going to be implemented/released: https://gitlab.haskell.org/ghc/ghc/issues/17340 From keith.wygant at gmail.com Fri Jan 8 18:36:58 2021 From: keith.wygant at gmail.com (Keith) Date: Fri, 08 Jan 2021 18:36:58 +0000 Subject: Misleading strictness annotations in Data.List.NonEmpty In-Reply-To: References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> <010f0176cdb2e82b-44e9c76c-44e7-4ba5-aaa7-4b7ebd1bbeaf-000000@us-east-2.amazonses.com> <7f303323-73ff-97b1-9d5e-5888b662e483@obsidian.systems> <1F52DA8C-EA71-4E8D-BEAD-E65E4F225576@gmail.com> Message-ID: <003BBD36-5772-458A-B2DE-8579B0921F76@gmail.com> Thanks, will do. On January 8, 2021 5:07:25 PM UTC, David Feuer wrote: >The first one. Neither twiddles nor bangs are useful or add clarity. > >On Fri, Jan 8, 2021, 11:53 AM Keith wrote: > >> Currently: >> >> head ~(a :| _) = a >> tail ~(_ :| as) = as >> >> But head and tail are both strict. At best the '~'s have no effect. >> >> Should I open a PR to change it to >> >> head (a :| _) = a >> tail (_ :| as) = as >> >> or maybe even more clearly >> >> head !(a :l _) = a >> tail !(_ :| as) = as >> >> ? >> --Keith >> Sent from my phone with K-9 Mail. Good to know! Wasn't aware that that was in the works. And sorry for accidentally threading this onto something unrelated. -- Keith Sent from my phone with K-9 Mail. On January 8, 2021 5:13:31 PM UTC, Henning Thielemann wrote: > >On Fri, 8 Jan 2021, Keith wrote: > >> Currently: >> >> head ~(a :| _) = a >> tail ~(_ :| as) = as >> >> But head and tail are both strict. At best the '~'s have no effect. >> >> Should I open a PR to change it to >> >> head (a :| _) = a >> tail (_ :| as) = as >> >> or maybe even more clearly >> >> head !(a :l _) = a >> tail !(_ :| as) = as >> >> ? > >The last one would trigger the "redundant bang pattern" warning that is >going to be implemented/released: > https://gitlab.haskell.org/ghc/ghc/issues/17340 From keith.wygant at gmail.com Fri Jan 8 19:26:18 2021 From: keith.wygant at gmail.com (Keith) Date: Fri, 08 Jan 2021 19:26:18 +0000 Subject: Misleading strictness annotations in Data.List.NonEmpty In-Reply-To: <003BBD36-5772-458A-B2DE-8579B0921F76@gmail.com> References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> <010f0176cdb2e82b-44e9c76c-44e7-4ba5-aaa7-4b7ebd1bbeaf-000000@us-east-2.amazonses.com> <7f303323-73ff-97b1-9d5e-5888b662e483@obsidian.systems> <1F52DA8C-EA71-4E8D-BEAD-E65E4F225576@gmail.com> <003BBD36-5772-458A-B2DE-8579B0921F76@gmail.com> Message-ID: <0D78ACC3-DCD8-42C7-B28E-2886DC5C957D@gmail.com> There are a couple other ones that I'm less sure about. cons: a <| ~(b :| bs) = a :| b : bs Unsugared this is a <| bs = a :| (case bs of b :| _ -> b ) : case bs of _ :| bs -> bs Would this make more sense? a <| bs = a :| case bs of b :| bs' -> b : bs' Then cons x undefined = x :| undefined not x :| undefined : undefined groupBy1 matches strictly, could be lazy. (Is this a performance issue or an oversight?) — Sent from my phone with K-9 Mail. On January 8, 2021 6:36:58 PM UTC, Keith wrote: >Thanks, will do. > >On January 8, 2021 5:07:25 PM UTC, David Feuer wrote: >>The first one. Neither twiddles nor bangs are useful or add clarity. >> >>On Fri, Jan 8, 2021, 11:53 AM Keith wrote: >> >>> Currently: >>> >>> head ~(a :| _) = a >>> tail ~(_ :| as) = as >>> >>> But head and tail are both strict. At best the '~'s have no effect. >>> >>> Should I open a PR to change it to >>> >>> head (a :| _) = a >>> tail (_ :| as) = as >>> >>> or maybe even more clearly >>> >>> head !(a :l _) = a >>> tail !(_ :| as) = as >>> >>> ? >>> --Keith >>> Sent from my phone with K-9 Mail. > > >Good to know! Wasn't aware that that was in the works. > >And sorry for accidentally threading this onto something unrelated. > >-- Keith >Sent from my phone with K-9 Mail. > >On January 8, 2021 5:13:31 PM UTC, Henning Thielemann wrote: >> >>On Fri, 8 Jan 2021, Keith wrote: >> >>> Currently: >>> >>> head ~(a :| _) = a >>> tail ~(_ :| as) = as >>> >>> But head and tail are both strict. At best the '~'s have no effect. >>> >>> Should I open a PR to change it to >>> >>> head (a :| _) = a >>> tail (_ :| as) = as >>> >>> or maybe even more clearly >>> >>> head !(a :l _) = a >>> tail !(_ :| as) = as >>> >>> ? >> >>The last one would trigger the "redundant bang pattern" warning that is >>going to be implemented/released: >> https://gitlab.haskell.org/ghc/ghc/issues/17340 -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Fri Jan 8 19:33:08 2021 From: david.feuer at gmail.com (David Feuer) Date: Fri, 8 Jan 2021 14:33:08 -0500 Subject: Misleading strictness annotations in Data.List.NonEmpty In-Reply-To: <0D78ACC3-DCD8-42C7-B28E-2886DC5C957D@gmail.com> References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> <010f0176cdb2e82b-44e9c76c-44e7-4ba5-aaa7-4b7ebd1bbeaf-000000@us-east-2.amazonses.com> <7f303323-73ff-97b1-9d5e-5888b662e483@obsidian.systems> <1F52DA8C-EA71-4E8D-BEAD-E65E4F225576@gmail.com> <003BBD36-5772-458A-B2DE-8579B0921F76@gmail.com> <0D78ACC3-DCD8-42C7-B28E-2886DC5C957D@gmail.com> Message-ID: I agree that your implementation of (<|) is more reasonable. I'll take a look at groupBy1 in a bit. On Fri, Jan 8, 2021 at 2:27 PM Keith wrote: > > There are a couple other ones that I'm less sure about. > > cons: > a <| ~(b :| bs) = a :| b : bs > > Unsugared this is > a <| bs = a :| > (case bs of b :| _ -> b ) : > case bs of _ :| bs -> bs > > Would this make more sense? > a <| bs = a :| case bs of b :| bs' -> b : bs' > > Then > cons x undefined = x :| undefined > not > x :| undefined : undefined > > > groupBy1 matches strictly, could be lazy. (Is this a performance issue or an oversight?) > — > Sent from my phone with K-9 Mail. > > On January 8, 2021 6:36:58 PM UTC, Keith wrote: >> >> Thanks, will do. >> >> On January 8, 2021 5:07:25 PM UTC, David Feuer wrote: >>> >>> The first one. Neither twiddles nor bangs are useful or add clarity. >>> >>> On Fri, Jan 8, 2021, 11:53 AM Keith wrote: >>> >>>> Currently: >>>> >>>> head ~(a :| _) = a >>>> tail ~(_ :| as) = as >>>> >>>> But head and tail are both strict. At best the '~'s have no effect. >>>> >>>> Should I open a PR to change it to >>>> >>>> head (a :| _) = a >>>> tail (_ :| as) = as >>>> >>>> or maybe even more clearly >>>> >>>> head !(a :l _) = a >>>> tail !(_ :| as) = as >>>> >>>> ? >>>> --Keith >>>> Sent from my phone with K-9 Mail. >> >> >> >> Good to know! Wasn't aware that that was in the works. >> >> And sorry for accidentally threading this onto something unrelated. >> >> -- Keith >> Sent from my phone with K-9 Mail. >> >> On January 8, 2021 5:13:31 PM UTC, Henning Thielemann wrote: >>> >>> >>> On Fri, 8 Jan 2021, Keith wrote: >>> >>>> Currently: >>>> >>>> head ~(a :| _) = a >>>> tail ~(_ :| as) = as >>>> >>>> But head and tail are both strict. At best the '~'s have no effect. >>>> >>>> Should I open a PR to change it to >>>> >>>> head (a :| _) = a >>>> tail (_ :| as) = as >>>> >>>> or maybe even more clearly >>>> >>>> head !(a :l _) = a >>>> tail !(_ :| as) = as >>>> >>>> ? >>> >>> >>> The last one would trigger the "redundant bang pattern" warning that is >>> going to be implemented/released: >>> https://gitlab.haskell.org/ghc/ghc/issues/17340 > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries From david.feuer at gmail.com Fri Jan 8 19:37:53 2021 From: david.feuer at gmail.com (David Feuer) Date: Fri, 8 Jan 2021 14:37:53 -0500 Subject: Misleading strictness annotations in Data.List.NonEmpty In-Reply-To: References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> <010f0176cdb2e82b-44e9c76c-44e7-4ba5-aaa7-4b7ebd1bbeaf-000000@us-east-2.amazonses.com> <7f303323-73ff-97b1-9d5e-5888b662e483@obsidian.systems> <1F52DA8C-EA71-4E8D-BEAD-E65E4F225576@gmail.com> <003BBD36-5772-458A-B2DE-8579B0921F76@gmail.com> <0D78ACC3-DCD8-42C7-B28E-2886DC5C957D@gmail.com> Message-ID: Well, more reasonable from a performance standpoint anyway. Semantically, it makes sense as it is. On Fri, Jan 8, 2021 at 2:33 PM David Feuer wrote: > > I agree that your implementation of (<|) is more reasonable. I'll take > a look at groupBy1 in a bit. > > On Fri, Jan 8, 2021 at 2:27 PM Keith wrote: > > > > There are a couple other ones that I'm less sure about. > > > > cons: > > a <| ~(b :| bs) = a :| b : bs > > > > Unsugared this is > > a <| bs = a :| > > (case bs of b :| _ -> b ) : > > case bs of _ :| bs -> bs > > > > Would this make more sense? > > a <| bs = a :| case bs of b :| bs' -> b : bs' > > > > Then > > cons x undefined = x :| undefined > > not > > x :| undefined : undefined > > > > > > groupBy1 matches strictly, could be lazy. (Is this a performance issue or an oversight?) > > — > > Sent from my phone with K-9 Mail. > > > > On January 8, 2021 6:36:58 PM UTC, Keith wrote: > >> > >> Thanks, will do. > >> > >> On January 8, 2021 5:07:25 PM UTC, David Feuer wrote: > >>> > >>> The first one. Neither twiddles nor bangs are useful or add clarity. > >>> > >>> On Fri, Jan 8, 2021, 11:53 AM Keith wrote: > >>> > >>>> Currently: > >>>> > >>>> head ~(a :| _) = a > >>>> tail ~(_ :| as) = as > >>>> > >>>> But head and tail are both strict. At best the '~'s have no effect. > >>>> > >>>> Should I open a PR to change it to > >>>> > >>>> head (a :| _) = a > >>>> tail (_ :| as) = as > >>>> > >>>> or maybe even more clearly > >>>> > >>>> head !(a :l _) = a > >>>> tail !(_ :| as) = as > >>>> > >>>> ? > >>>> --Keith > >>>> Sent from my phone with K-9 Mail. > >> > >> > >> > >> Good to know! Wasn't aware that that was in the works. > >> > >> And sorry for accidentally threading this onto something unrelated. > >> > >> -- Keith > >> Sent from my phone with K-9 Mail. > >> > >> On January 8, 2021 5:13:31 PM UTC, Henning Thielemann wrote: > >>> > >>> > >>> On Fri, 8 Jan 2021, Keith wrote: > >>> > >>>> Currently: > >>>> > >>>> head ~(a :| _) = a > >>>> tail ~(_ :| as) = as > >>>> > >>>> But head and tail are both strict. At best the '~'s have no effect. > >>>> > >>>> Should I open a PR to change it to > >>>> > >>>> head (a :| _) = a > >>>> tail (_ :| as) = as > >>>> > >>>> or maybe even more clearly > >>>> > >>>> head !(a :l _) = a > >>>> tail !(_ :| as) = as > >>>> > >>>> ? > >>> > >>> > >>> The last one would trigger the "redundant bang pattern" warning that is > >>> going to be implemented/released: > >>> https://gitlab.haskell.org/ghc/ghc/issues/17340 > > > > _______________________________________________ > > Libraries mailing list > > Libraries at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries From david.feuer at gmail.com Fri Jan 8 19:41:37 2021 From: david.feuer at gmail.com (David Feuer) Date: Fri, 8 Jan 2021 14:41:37 -0500 Subject: Misleading strictness annotations in Data.List.NonEmpty In-Reply-To: <0D78ACC3-DCD8-42C7-B28E-2886DC5C957D@gmail.com> References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> <010f0176cdb2e82b-44e9c76c-44e7-4ba5-aaa7-4b7ebd1bbeaf-000000@us-east-2.amazonses.com> <7f303323-73ff-97b1-9d5e-5888b662e483@obsidian.systems> <1F52DA8C-EA71-4E8D-BEAD-E65E4F225576@gmail.com> <003BBD36-5772-458A-B2DE-8579B0921F76@gmail.com> <0D78ACC3-DCD8-42C7-B28E-2886DC5C957D@gmail.com> Message-ID: Yeah, the more I think about it, the more I like your stricter (<|). I don't see any really useful laziness to add to groupBy1. What were you thinking of? On Fri, Jan 8, 2021 at 2:27 PM Keith wrote: > > There are a couple other ones that I'm less sure about. > > cons: > a <| ~(b :| bs) = a :| b : bs > > Unsugared this is > a <| bs = a :| > (case bs of b :| _ -> b ) : > case bs of _ :| bs -> bs > > Would this make more sense? > a <| bs = a :| case bs of b :| bs' -> b : bs' > > Then > cons x undefined = x :| undefined > not > x :| undefined : undefined > > > groupBy1 matches strictly, could be lazy. (Is this a performance issue or an oversight?) > — > Sent from my phone with K-9 Mail. > > On January 8, 2021 6:36:58 PM UTC, Keith wrote: >> >> Thanks, will do. >> >> On January 8, 2021 5:07:25 PM UTC, David Feuer wrote: >>> >>> The first one. Neither twiddles nor bangs are useful or add clarity. >>> >>> On Fri, Jan 8, 2021, 11:53 AM Keith wrote: >>> >>>> Currently: >>>> >>>> head ~(a :| _) = a >>>> tail ~(_ :| as) = as >>>> >>>> But head and tail are both strict. At best the '~'s have no effect. >>>> >>>> Should I open a PR to change it to >>>> >>>> head (a :| _) = a >>>> tail (_ :| as) = as >>>> >>>> or maybe even more clearly >>>> >>>> head !(a :l _) = a >>>> tail !(_ :| as) = as >>>> >>>> ? >>>> --Keith >>>> Sent from my phone with K-9 Mail. >> >> >> >> Good to know! Wasn't aware that that was in the works. >> >> And sorry for accidentally threading this onto something unrelated. >> >> -- Keith >> Sent from my phone with K-9 Mail. >> >> On January 8, 2021 5:13:31 PM UTC, Henning Thielemann wrote: >>> >>> >>> On Fri, 8 Jan 2021, Keith wrote: >>> >>>> Currently: >>>> >>>> head ~(a :| _) = a >>>> tail ~(_ :| as) = as >>>> >>>> But head and tail are both strict. At best the '~'s have no effect. >>>> >>>> Should I open a PR to change it to >>>> >>>> head (a :| _) = a >>>> tail (_ :| as) = as >>>> >>>> or maybe even more clearly >>>> >>>> head !(a :l _) = a >>>> tail !(_ :| as) = as >>>> >>>> ? >>> >>> >>> The last one would trigger the "redundant bang pattern" warning that is >>> going to be implemented/released: >>> https://gitlab.haskell.org/ghc/ghc/issues/17340 > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries From david.feuer at gmail.com Fri Jan 8 19:43:37 2021 From: david.feuer at gmail.com (David Feuer) Date: Fri, 8 Jan 2021 14:43:37 -0500 Subject: Misleading strictness annotations in Data.List.NonEmpty In-Reply-To: <1F52DA8C-EA71-4E8D-BEAD-E65E4F225576@gmail.com> References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> <010f0176cdb2e82b-44e9c76c-44e7-4ba5-aaa7-4b7ebd1bbeaf-000000@us-east-2.amazonses.com> <7f303323-73ff-97b1-9d5e-5888b662e483@obsidian.systems> <1F52DA8C-EA71-4E8D-BEAD-E65E4F225576@gmail.com> Message-ID: (!!) also has a confusing ~ in it; best remove that too. On Fri, Jan 8, 2021 at 11:53 AM Keith wrote: > > Currently: > > head ~(a :| _) = a > tail ~(_ :| as) = as > > But head and tail are both strict. At best the '~'s have no effect. > > Should I open a PR to change it to > > head (a :| _) = a > tail (_ :| as) = as > > or maybe even more clearly > > head !(a :l _) = a > tail !(_ :| as) = as > > ? > --Keith > Sent from my phone with K-9 Mail. > > On January 4, 2021 2:40:58 PM UTC, John Ericson wrote: >> >> I talked to Carter a bit on IRC for my progress on that front, but I thought maybe this would be a good time to mention this more widely >> >> - The constraint side is iffy. Local constraints and constraint kinds make it hard to have some sort of codata guardedness / cotermination checking argument for higher order coercion "instances" that doesn't also need to apply to the constraint system at large, which makes it quite laborious to increase expressive power without trade-offs like no local quantified constraints. (Yay mission creep.) >> >> - The core side looks good. Cale and I pretty confident in the "coercions as fixed points of products", with {0, 1, multiplication, and exponentiation, limits} passing my cardinality sniff test that coercions still have no computational content and thus can be erased. >> >> - Additionally, I am less but decently confident (though I haven't talked to Cale about this) that the existing role admissibility solver can be repurposed to produce those (to-be-erased) terms rather than just merely deciding the admissibility of (opaque) axiomatic coercions. This change would have no expressive power implications one way or the other, but complete the "theory refactor" so that the "sans-nth" version could be said to work end to end. >> >> So tl;dr I can't actually do anything to help Carter's problem at the moment, but I think I can get David's https://github.com/ghc-proposals/ghc-proposals/pull/276 over the finish line, with the side benefit of loosening things up and getting us closer so the higher-order roles problem seems less out of reach. >> >> I have revised my "progress report" wildly since I started thinking about these things, but with the latest ratchet back, I think I finally have a stable prediction. >> >> Cheers, >> >> John >> >> On 1/4/21 9:12 AM, Carter Schonwald wrote: >> >> Thx for the link. I’ll take a look at your suggested reading. >> >> What are ways I could help progress whatever’s needed to get to a nice ending? >> >> On Mon, Jan 4, 2021 at 9:00 AM Richard Eisenberg wrote: >>> >>> >>> >>> On Jan 3, 2021, at 1:02 PM, Carter Schonwald wrote: >>> >>> This limitation is a misfeature, how can we make this get addressed sooner rather than later? Is this somewhere where Eg Haskell foundation or something could help? >>> >>> >>> Lifting the limitation would be nice, but it's a lot of work. First, we need an updated theory for Core, with a type safety proof. This proof is essential: it's what our safety as a language depends on. Then, we'd need to implement it. I'm more worried about the former than the latter. >>> >>> > i think its worth emphasizing that ghc today uses a simplification of the original 2011 paper... >>> >>> Yes, that was originally true, but the current formulation goes beyond the 2011 paper in some respects. See section 7.1 of https://richarde.dev/papers/2016/coercible-jfp/coercible-jfp.pdf. >>> >>> Roman writes: >>> >>> > I think it's important we keep the definitions of Functor and other >>> fundamental classes understandable by newcomers, and this change would >>> make the definition look scary for a marginal benefit. >>> >>> This is tough. I've considered a Functor definition like the one Carter proposes before. I would personally rather come up with the best definition first, then figure out how to make it palatable to newcomers second. For example, we could write (today) >>> >>> > type Representational f = forall a b. Coercible a b => Coercible (f a) (f b) >>> >>> and then the class constraint looks more pleasant. Or we could create ways of suppressing confusing information. Or there are other solutions. Depending on the benefit of the change (here or elsewhere), I would advocate holding off on making the change until we can support it without disrupting the newcomer story. But I wouldn't want to abandon the idea of an improvement a priori just because of a disruption to the newcomer experience. >>> >>> Richard >> >> >> _______________________________________________ >> 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 oleg.grenrus at iki.fi Fri Jan 8 19:44:31 2021 From: oleg.grenrus at iki.fi (Oleg Grenrus) Date: Fri, 8 Jan 2021 21:44:31 +0200 Subject: Misleading strictness annotations in Data.List.NonEmpty In-Reply-To: References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> <010f0176cdb2e82b-44e9c76c-44e7-4ba5-aaa7-4b7ebd1bbeaf-000000@us-east-2.amazonses.com> <7f303323-73ff-97b1-9d5e-5888b662e483@obsidian.systems> <1F52DA8C-EA71-4E8D-BEAD-E65E4F225576@gmail.com> <003BBD36-5772-458A-B2DE-8579B0921F76@gmail.com> <0D78ACC3-DCD8-42C7-B28E-2886DC5C957D@gmail.com> Message-ID: <30b9c4c6-4f80-39e5-95ee-12afa7371b42@iki.fi> Note also -- | @since 4.9.0.0 instance Foldable NonEmpty where   foldr f z ~(a :| as) = f a (List.foldr f z as)   foldl f z (a :| as) = List.foldl f (f z a) as   foldl1 f (a :| as) = List.foldl f a as   -- GHC isn't clever enough to transform the default definition   -- into anything like this, so we'd end up shuffling a bunch of   -- Maybes around.   foldr1 f (p :| ps) = foldr go id ps p     where       go x r prev = f prev (r x)   -- We used to say   --   --   length (_ :| as) = 1 + length as   --   -- but the default definition is better, counting from 1.   --   -- The default definition also works great for null and foldl'.   -- As usual for cons lists, foldr' is basically hopeless.   foldMap f ~(a :| as) = f a `mappend` foldMap f as   fold ~(m :| ms) = m `mappend` fold ms   toList ~(a :| as) = a : as Plenty of irrefutable patterns. On 8.1.2021 21.41, David Feuer wrote: > Yeah, the more I think about it, the more I like your stricter (<|). I > don't see any really useful laziness to add to groupBy1. What were you > thinking of? > > On Fri, Jan 8, 2021 at 2:27 PM Keith wrote: >> There are a couple other ones that I'm less sure about. >> >> cons: >> a <| ~(b :| bs) = a :| b : bs >> >> Unsugared this is >> a <| bs = a :| >> (case bs of b :| _ -> b ) : >> case bs of _ :| bs -> bs >> >> Would this make more sense? >> a <| bs = a :| case bs of b :| bs' -> b : bs' >> >> Then >> cons x undefined = x :| undefined >> not >> x :| undefined : undefined >> >> >> groupBy1 matches strictly, could be lazy. (Is this a performance issue or an oversight?) >> — >> Sent from my phone with K-9 Mail. >> >> On January 8, 2021 6:36:58 PM UTC, Keith wrote: >>> Thanks, will do. >>> >>> On January 8, 2021 5:07:25 PM UTC, David Feuer wrote: >>>> The first one. Neither twiddles nor bangs are useful or add clarity. >>>> >>>> On Fri, Jan 8, 2021, 11:53 AM Keith wrote: >>>> >>>>> Currently: >>>>> >>>>> head ~(a :| _) = a >>>>> tail ~(_ :| as) = as >>>>> >>>>> But head and tail are both strict. At best the '~'s have no effect. >>>>> >>>>> Should I open a PR to change it to >>>>> >>>>> head (a :| _) = a >>>>> tail (_ :| as) = as >>>>> >>>>> or maybe even more clearly >>>>> >>>>> head !(a :l _) = a >>>>> tail !(_ :| as) = as >>>>> >>>>> ? >>>>> --Keith >>>>> Sent from my phone with K-9 Mail. >>> >>> >>> Good to know! Wasn't aware that that was in the works. >>> >>> And sorry for accidentally threading this onto something unrelated. >>> >>> -- Keith >>> Sent from my phone with K-9 Mail. >>> >>> On January 8, 2021 5:13:31 PM UTC, Henning Thielemann wrote: >>>> >>>> On Fri, 8 Jan 2021, Keith wrote: >>>> >>>>> Currently: >>>>> >>>>> head ~(a :| _) = a >>>>> tail ~(_ :| as) = as >>>>> >>>>> But head and tail are both strict. At best the '~'s have no effect. >>>>> >>>>> Should I open a PR to change it to >>>>> >>>>> head (a :| _) = a >>>>> tail (_ :| as) = as >>>>> >>>>> or maybe even more clearly >>>>> >>>>> head !(a :l _) = a >>>>> tail !(_ :| as) = as >>>>> >>>>> ? >>>> >>>> The last one would trigger the "redundant bang pattern" warning that is >>>> going to be implemented/released: >>>> https://gitlab.haskell.org/ghc/ghc/issues/17340 >> _______________________________________________ >> 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 david.feuer at gmail.com Fri Jan 8 19:45:11 2021 From: david.feuer at gmail.com (David Feuer) Date: Fri, 8 Jan 2021 14:45:11 -0500 Subject: Misleading strictness annotations in Data.List.NonEmpty In-Reply-To: References: <01f7b98f-dad5-2978-1d3f-ddb3f70d4206@iki.fi> <27207ef0-8db5-2a2c-8656-1b111c1f7048@iki.fi> <010f0176cdb2e82b-44e9c76c-44e7-4ba5-aaa7-4b7ebd1bbeaf-000000@us-east-2.amazonses.com> <7f303323-73ff-97b1-9d5e-5888b662e483@obsidian.systems> <1F52DA8C-EA71-4E8D-BEAD-E65E4F225576@gmail.com> Message-ID: zip and zipWith also look excessively lazy to my eyes. On Fri, Jan 8, 2021 at 2:43 PM David Feuer wrote: > > (!!) also has a confusing ~ in it; best remove that too. > > On Fri, Jan 8, 2021 at 11:53 AM Keith wrote: > > > > Currently: > > > > head ~(a :| _) = a > > tail ~(_ :| as) = as > > > > But head and tail are both strict. At best the '~'s have no effect. > > > > Should I open a PR to change it to > > > > head (a :| _) = a > > tail (_ :| as) = as > > > > or maybe even more clearly > > > > head !(a :l _) = a > > tail !(_ :| as) = as > > > > ? > > --Keith > > Sent from my phone with K-9 Mail. > > > > On January 4, 2021 2:40:58 PM UTC, John Ericson wrote: > >> > >> I talked to Carter a bit on IRC for my progress on that front, but I thought maybe this would be a good time to mention this more widely > >> > >> - The constraint side is iffy. Local constraints and constraint kinds make it hard to have some sort of codata guardedness / cotermination checking argument for higher order coercion "instances" that doesn't also need to apply to the constraint system at large, which makes it quite laborious to increase expressive power without trade-offs like no local quantified constraints. (Yay mission creep.) > >> > >> - The core side looks good. Cale and I pretty confident in the "coercions as fixed points of products", with {0, 1, multiplication, and exponentiation, limits} passing my cardinality sniff test that coercions still have no computational content and thus can be erased. > >> > >> - Additionally, I am less but decently confident (though I haven't talked to Cale about this) that the existing role admissibility solver can be repurposed to produce those (to-be-erased) terms rather than just merely deciding the admissibility of (opaque) axiomatic coercions. This change would have no expressive power implications one way or the other, but complete the "theory refactor" so that the "sans-nth" version could be said to work end to end. > >> > >> So tl;dr I can't actually do anything to help Carter's problem at the moment, but I think I can get David's https://github.com/ghc-proposals/ghc-proposals/pull/276 over the finish line, with the side benefit of loosening things up and getting us closer so the higher-order roles problem seems less out of reach. > >> > >> I have revised my "progress report" wildly since I started thinking about these things, but with the latest ratchet back, I think I finally have a stable prediction. > >> > >> Cheers, > >> > >> John > >> > >> On 1/4/21 9:12 AM, Carter Schonwald wrote: > >> > >> Thx for the link. I’ll take a look at your suggested reading. > >> > >> What are ways I could help progress whatever’s needed to get to a nice ending? > >> > >> On Mon, Jan 4, 2021 at 9:00 AM Richard Eisenberg wrote: > >>> > >>> > >>> > >>> On Jan 3, 2021, at 1:02 PM, Carter Schonwald wrote: > >>> > >>> This limitation is a misfeature, how can we make this get addressed sooner rather than later? Is this somewhere where Eg Haskell foundation or something could help? > >>> > >>> > >>> Lifting the limitation would be nice, but it's a lot of work. First, we need an updated theory for Core, with a type safety proof. This proof is essential: it's what our safety as a language depends on. Then, we'd need to implement it. I'm more worried about the former than the latter. > >>> > >>> > i think its worth emphasizing that ghc today uses a simplification of the original 2011 paper... > >>> > >>> Yes, that was originally true, but the current formulation goes beyond the 2011 paper in some respects. See section 7.1 of https://richarde.dev/papers/2016/coercible-jfp/coercible-jfp.pdf. > >>> > >>> Roman writes: > >>> > >>> > I think it's important we keep the definitions of Functor and other > >>> fundamental classes understandable by newcomers, and this change would > >>> make the definition look scary for a marginal benefit. > >>> > >>> This is tough. I've considered a Functor definition like the one Carter proposes before. I would personally rather come up with the best definition first, then figure out how to make it palatable to newcomers second. For example, we could write (today) > >>> > >>> > type Representational f = forall a b. Coercible a b => Coercible (f a) (f b) > >>> > >>> and then the class constraint looks more pleasant. Or we could create ways of suppressing confusing information. Or there are other solutions. Depending on the benefit of the change (here or elsewhere), I would advocate holding off on making the change until we can support it without disrupting the newcomer story. But I wouldn't want to abandon the idea of an improvement a priori just because of a disruption to the newcomer experience. > >>> > >>> Richard > >> > >> > >> _______________________________________________ > >> 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 ietf-dane at dukhovni.org Fri Jan 8 19:50:46 2021 From: ietf-dane at dukhovni.org (Viktor Dukhovni) Date: Fri, 8 Jan 2021 14:50:46 -0500 Subject: Misleading strictness annotations in Data.List.NonEmpty In-Reply-To: <30b9c4c6-4f80-39e5-95ee-12afa7371b42@iki.fi> References: <010f0176cdb2e82b-44e9c76c-44e7-4ba5-aaa7-4b7ebd1bbeaf-000000@us-east-2.amazonses.com> <7f303323-73ff-97b1-9d5e-5888b662e483@obsidian.systems> <1F52DA8C-EA71-4E8D-BEAD-E65E4F225576@gmail.com> <003BBD36-5772-458A-B2DE-8579B0921F76@gmail.com> <0D78ACC3-DCD8-42C7-B28E-2886DC5C957D@gmail.com> <30b9c4c6-4f80-39e5-95ee-12afa7371b42@iki.fi> Message-ID: On Fri, Jan 08, 2021 at 09:44:31PM +0200, Oleg Grenrus wrote: > Note also > > -- | @since 4.9.0.0 > instance Foldable NonEmpty where >   foldr f z ~(a :| as) = f a (List.foldr f z as) >   foldl f z (a :| as) = List.foldl f (f z a) as >   foldl1 f (a :| as) = List.foldl f a as > >   -- GHC isn't clever enough to transform the default definition >   -- into anything like this, so we'd end up shuffling a bunch of >   -- Maybes around. >   foldr1 f (p :| ps) = foldr go id ps p >     where >       go x r prev = f prev (r x) > >   -- We used to say >   -- >   --   length (_ :| as) = 1 + length as >   -- >   -- but the default definition is better, counting from 1. >   -- >   -- The default definition also works great for null and foldl'. >   -- As usual for cons lists, foldr' is basically hopeless. > >   foldMap f ~(a :| as) = f a `mappend` foldMap f as >   fold ~(m :| ms) = m `mappend` fold ms >   toList ~(a :| as) = a : as > > Plenty of irrefutable patterns. Do any of these make "mfix" more usable for NonEmpty? Or are they just superfluous? With just one constructor, is there any downside to an irrefutable pattern? -- Viktor. From oleg.grenrus at iki.fi Fri Jan 8 19:59:37 2021 From: oleg.grenrus at iki.fi (Oleg Grenrus) Date: Fri, 8 Jan 2021 21:59:37 +0200 Subject: Misleading strictness annotations in Data.List.NonEmpty In-Reply-To: References: <010f0176cdb2e82b-44e9c76c-44e7-4ba5-aaa7-4b7ebd1bbeaf-000000@us-east-2.amazonses.com> <7f303323-73ff-97b1-9d5e-5888b662e483@obsidian.systems> <1F52DA8C-EA71-4E8D-BEAD-E65E4F225576@gmail.com> <003BBD36-5772-458A-B2DE-8579B0921F76@gmail.com> <0D78ACC3-DCD8-42C7-B28E-2886DC5C957D@gmail.com> <30b9c4c6-4f80-39e5-95ee-12afa7371b42@iki.fi> Message-ID: <538e0f1c-bf97-cfba-bad7-dddeac69aec0@iki.fi> I'd expect that anyone who uses mfix with NonEmpty as result would use explicit (and irrefutable) pattern matching. But yes, changing these might make some code break. I'm not confident at all it won't make some code less efficient too, by forcing the structure of NonEmpty too early. So I would like that this thread is only about changing `head` and `tail` and not let scope creep. OR we hold this and let Keith come up with more complete NonEmpty implementation change. - Oleg On 8.1.2021 21.50, Viktor Dukhovni wrote: > On Fri, Jan 08, 2021 at 09:44:31PM +0200, Oleg Grenrus wrote: >> Note also >> >> -- | @since 4.9.0.0 >> instance Foldable NonEmpty where >>   foldr f z ~(a :| as) = f a (List.foldr f z as) >>   foldl f z (a :| as) = List.foldl f (f z a) as >>   foldl1 f (a :| as) = List.foldl f a as >> >>   -- GHC isn't clever enough to transform the default definition >>   -- into anything like this, so we'd end up shuffling a bunch of >>   -- Maybes around. >>   foldr1 f (p :| ps) = foldr go id ps p >>     where >>       go x r prev = f prev (r x) >> >>   -- We used to say >>   -- >>   --   length (_ :| as) = 1 + length as >>   -- >>   -- but the default definition is better, counting from 1. >>   -- >>   -- The default definition also works great for null and foldl'. >>   -- As usual for cons lists, foldr' is basically hopeless. >> >>   foldMap f ~(a :| as) = f a `mappend` foldMap f as >>   fold ~(m :| ms) = m `mappend` fold ms >>   toList ~(a :| as) = a : as >> >> Plenty of irrefutable patterns. > Do any of these make "mfix" more usable for NonEmpty? Or are they just > superfluous? With just one constructor, is there any downside to an > irrefutable pattern? > From david.feuer at gmail.com Fri Jan 8 20:03:00 2021 From: david.feuer at gmail.com (David Feuer) Date: Fri, 8 Jan 2021 15:03:00 -0500 Subject: Misleading strictness annotations in Data.List.NonEmpty In-Reply-To: <538e0f1c-bf97-cfba-bad7-dddeac69aec0@iki.fi> References: <010f0176cdb2e82b-44e9c76c-44e7-4ba5-aaa7-4b7ebd1bbeaf-000000@us-east-2.amazonses.com> <7f303323-73ff-97b1-9d5e-5888b662e483@obsidian.systems> <1F52DA8C-EA71-4E8D-BEAD-E65E4F225576@gmail.com> <003BBD36-5772-458A-B2DE-8579B0921F76@gmail.com> <0D78ACC3-DCD8-42C7-B28E-2886DC5C957D@gmail.com> <30b9c4c6-4f80-39e5-95ee-12afa7371b42@iki.fi> <538e0f1c-bf97-cfba-bad7-dddeac69aec0@iki.fi> Message-ID: I think removing the annotations that don't change anything can be done in a GHC MR without discussion on this list. I think the discussion on things that change strictness can and should continue here. On Fri, Jan 8, 2021, 2:59 PM Oleg Grenrus wrote: > I'd expect that anyone who uses mfix with NonEmpty as result would use > explicit (and irrefutable) pattern matching. > > But yes, changing these might make some code break. I'm not confident at > all it won't make some code less efficient too, by forcing the structure > of NonEmpty too early. > > So I would like that this thread is only about changing `head` and > `tail` and not let scope creep. > OR we hold this and let Keith come up with more complete NonEmpty > implementation change. > > - Oleg > > On 8.1.2021 21.50, Viktor Dukhovni wrote: > > On Fri, Jan 08, 2021 at 09:44:31PM +0200, Oleg Grenrus wrote: > >> Note also > >> > >> -- | @since 4.9.0.0 > >> instance Foldable NonEmpty where > >> foldr f z ~(a :| as) = f a (List.foldr f z as) > >> foldl f z (a :| as) = List.foldl f (f z a) as > >> foldl1 f (a :| as) = List.foldl f a as > >> > >> -- GHC isn't clever enough to transform the default definition > >> -- into anything like this, so we'd end up shuffling a bunch of > >> -- Maybes around. > >> foldr1 f (p :| ps) = foldr go id ps p > >> where > >> go x r prev = f prev (r x) > >> > >> -- We used to say > >> -- > >> -- length (_ :| as) = 1 + length as > >> -- > >> -- but the default definition is better, counting from 1. > >> -- > >> -- The default definition also works great for null and foldl'. > >> -- As usual for cons lists, foldr' is basically hopeless. > >> > >> foldMap f ~(a :| as) = f a `mappend` foldMap f as > >> fold ~(m :| ms) = m `mappend` fold ms > >> toList ~(a :| as) = a : as > >> > >> Plenty of irrefutable patterns. > > Do any of these make "mfix" more usable for NonEmpty? Or are they just > > superfluous? With just one constructor, is there any downside to an > > irrefutable pattern? > > > _______________________________________________ > 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 oleg.grenrus at iki.fi Fri Jan 8 20:08:52 2021 From: oleg.grenrus at iki.fi (Oleg Grenrus) Date: Fri, 8 Jan 2021 22:08:52 +0200 Subject: Misleading strictness annotations in Data.List.NonEmpty In-Reply-To: References: <010f0176cdb2e82b-44e9c76c-44e7-4ba5-aaa7-4b7ebd1bbeaf-000000@us-east-2.amazonses.com> <7f303323-73ff-97b1-9d5e-5888b662e483@obsidian.systems> <1F52DA8C-EA71-4E8D-BEAD-E65E4F225576@gmail.com> <003BBD36-5772-458A-B2DE-8579B0921F76@gmail.com> <0D78ACC3-DCD8-42C7-B28E-2886DC5C957D@gmail.com> <30b9c4c6-4f80-39e5-95ee-12afa7371b42@iki.fi> <538e0f1c-bf97-cfba-bad7-dddeac69aec0@iki.fi> Message-ID: <86db8a00-5b76-d897-3dc1-0f39468f5546@iki.fi> Agreed. But to make discussion more productive I suggest that someone (you, Keith?) goes through the list and makes concrete suggestion for each point. It's not that long. ghc/libraries % git grep ':|' | grep '~' base/Control/Monad/Fix.hs:             ~(x :| _) -> x :| mfix (neTail . f) base/Control/Monad/Fix.hs:      neHead ~(a :| _) = a base/Control/Monad/Fix.hs:      neTail ~(_ :| as) = as base/Data/Foldable.hs:  foldr f z ~(a :| as) = f a (List.foldr f z as) base/Data/Foldable.hs:  foldMap f ~(a :| as) = f a `mappend` foldMap f as base/Data/Foldable.hs:  fold ~(m :| ms) = m `mappend` fold ms base/Data/Foldable.hs:  toList ~(a :| as) = a : as base/Data/List/NonEmpty.hs:uncons ~(a :| as) = (a, nonEmpty as) base/Data/List/NonEmpty.hs:head ~(a :| _) = a base/Data/List/NonEmpty.hs:tail ~(_ :| as) = as base/Data/List/NonEmpty.hs:last ~(a :| as) = List.last (a : as) base/Data/List/NonEmpty.hs:init ~(a :| as) = List.init (a : as) base/Data/List/NonEmpty.hs:a <| ~(b :| bs) = a :| b : bs base/Data/List/NonEmpty.hs:toList ~(a :| as) = a : as base/Data/List/NonEmpty.hs:map f ~(a :| as) = f a :| fmap f as base/Data/List/NonEmpty.hs:scanl1 f ~(a :| as) = fromList (List.scanl f a as) base/Data/List/NonEmpty.hs:scanr1 f ~(a :| as) = fromList (List.scanr1 f (a:as)) base/Data/List/NonEmpty.hs:intersperse a ~(b :| bs) = b :| case bs of base/Data/List/NonEmpty.hs:(!!) ~(x :| xs) n base/Data/List/NonEmpty.hs:zip ~(x :| xs) ~(y :| ys) = (x, y) :| List.zip xs ys base/Data/List/NonEmpty.hs:zipWith f ~(x :| xs) ~(y :| ys) = f x y :| List.zipWith f xs ys base/Data/Traversable.hs:  traverse f ~(a :| as) = liftA2 (:|) (f a) (traverse f as) base/GHC/Base.hs:        (a :| as) <> ~(b :| bs) = a :| (as ++ b : bs) base/GHC/Base.hs:  fmap f ~(a :| as) = f a :| fmap f as base/GHC/Base.hs:  b <$ ~(_ :| as)   = b   :| (b <$ as) base/GHC/Base.hs:  ~(a :| as) >>= f = b :| (bs ++ bs') base/GHC/Base.hs:          toList ~(c :| cs) = c : cs base/GHC/Exts.hs:  toList ~(a :| as) = a : as On 8.1.2021 22.03, David Feuer wrote: > I think removing the annotations that don't change anything can be > done in a GHC MR without discussion on this list. I think the > discussion on things that change strictness can and should continue here. > > On Fri, Jan 8, 2021, 2:59 PM Oleg Grenrus > wrote: > > I'd expect that anyone who uses mfix with NonEmpty as result would use > explicit (and irrefutable) pattern matching. > > But yes, changing these might make some code break. I'm not > confident at > all it won't make some code less efficient too, by forcing the > structure > of NonEmpty too early. > > So I would like that this thread is only about changing `head` and > `tail` and not let scope creep. > OR we hold this and let Keith come up with more complete NonEmpty > implementation change. > > - Oleg > > On 8.1.2021 21.50, Viktor Dukhovni wrote: > > On Fri, Jan 08, 2021 at 09:44:31PM +0200, Oleg Grenrus wrote: > >> Note also > >> > >> -- | @since 4.9.0.0 > >> instance Foldable NonEmpty where > >>   foldr f z ~(a :| as) = f a (List.foldr f z as) > >>   foldl f z (a :| as) = List.foldl f (f z a) as > >>   foldl1 f (a :| as) = List.foldl f a as > >> > >>   -- GHC isn't clever enough to transform the default definition > >>   -- into anything like this, so we'd end up shuffling a bunch of > >>   -- Maybes around. > >>   foldr1 f (p :| ps) = foldr go id ps p > >>     where > >>       go x r prev = f prev (r x) > >> > >>   -- We used to say > >>   -- > >>   --   length (_ :| as) = 1 + length as > >>   -- > >>   -- but the default definition is better, counting from 1. > >>   -- > >>   -- The default definition also works great for null and foldl'. > >>   -- As usual for cons lists, foldr' is basically hopeless. > >> > >>   foldMap f ~(a :| as) = f a `mappend` foldMap f as > >>   fold ~(m :| ms) = m `mappend` fold ms > >>   toList ~(a :| as) = a : as > >> > >> Plenty of irrefutable patterns. > > Do any of these make "mfix" more usable for NonEmpty?  Or are > they just > > superfluous?  With just one constructor, is there any downside to an > > irrefutable pattern? > > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > From oleg.grenrus at iki.fi Fri Jan 8 20:15:26 2021 From: oleg.grenrus at iki.fi (Oleg Grenrus) Date: Fri, 8 Jan 2021 22:15:26 +0200 Subject: Misleading strictness annotations in Data.List.NonEmpty In-Reply-To: <86db8a00-5b76-d897-3dc1-0f39468f5546@iki.fi> References: <010f0176cdb2e82b-44e9c76c-44e7-4ba5-aaa7-4b7ebd1bbeaf-000000@us-east-2.amazonses.com> <7f303323-73ff-97b1-9d5e-5888b662e483@obsidian.systems> <1F52DA8C-EA71-4E8D-BEAD-E65E4F225576@gmail.com> <003BBD36-5772-458A-B2DE-8579B0921F76@gmail.com> <0D78ACC3-DCD8-42C7-B28E-2886DC5C957D@gmail.com> <30b9c4c6-4f80-39e5-95ee-12afa7371b42@iki.fi> <538e0f1c-bf97-cfba-bad7-dddeac69aec0@iki.fi> <86db8a00-5b76-d897-3dc1-0f39468f5546@iki.fi> Message-ID: The semigroup instance for example looks like an mistake. (There is no comment). And it's the same in semigroups package https://github.com/ekmett/semigroups/blob/738e343a4384994903131190b6bfd50e40c7c4f6/src-ghc7/Data/Semigroup.hs#L440-L441 It always was this way, https://github.com/ekmett/semigroups/commit/3b37f1600bb0eec49d453c2ffcda1eb0fcaad800 I don't remember whether the irrefutable patterns were discussed when Semigroup + NonEmpty was moved to base. (I haven't followed libraries closed then). - Oleg On 8.1.2021 22.08, Oleg Grenrus wrote: > Agreed. > > But to make discussion more productive I suggest that someone (you, > Keith?) goes through the list and makes concrete suggestion for each > point. It's not that long. > > ghc/libraries % git grep ':|' | grep '~' > base/Control/Monad/Fix.hs:             ~(x :| _) -> x :| mfix (neTail . f) > base/Control/Monad/Fix.hs:      neHead ~(a :| _) = a > base/Control/Monad/Fix.hs:      neTail ~(_ :| as) = as > base/Data/Foldable.hs:  foldr f z ~(a :| as) = f a (List.foldr f z as) > base/Data/Foldable.hs:  foldMap f ~(a :| as) = f a `mappend` foldMap f as > base/Data/Foldable.hs:  fold ~(m :| ms) = m `mappend` fold ms > base/Data/Foldable.hs:  toList ~(a :| as) = a : as > base/Data/List/NonEmpty.hs:uncons ~(a :| as) = (a, nonEmpty as) > base/Data/List/NonEmpty.hs:head ~(a :| _) = a > base/Data/List/NonEmpty.hs:tail ~(_ :| as) = as > base/Data/List/NonEmpty.hs:last ~(a :| as) = List.last (a : as) > base/Data/List/NonEmpty.hs:init ~(a :| as) = List.init (a : as) > base/Data/List/NonEmpty.hs:a <| ~(b :| bs) = a :| b : bs > base/Data/List/NonEmpty.hs:toList ~(a :| as) = a : as > base/Data/List/NonEmpty.hs:map f ~(a :| as) = f a :| fmap f as > base/Data/List/NonEmpty.hs:scanl1 f ~(a :| as) = fromList (List.scanl f > a as) > base/Data/List/NonEmpty.hs:scanr1 f ~(a :| as) = fromList (List.scanr1 f > (a:as)) > base/Data/List/NonEmpty.hs:intersperse a ~(b :| bs) = b :| case bs of > base/Data/List/NonEmpty.hs:(!!) ~(x :| xs) n > base/Data/List/NonEmpty.hs:zip ~(x :| xs) ~(y :| ys) = (x, y) :| > List.zip xs ys > base/Data/List/NonEmpty.hs:zipWith f ~(x :| xs) ~(y :| ys) = f x y :| > List.zipWith f xs ys > base/Data/Traversable.hs:  traverse f ~(a :| as) = liftA2 (:|) (f a) > (traverse f as) > base/GHC/Base.hs:        (a :| as) <> ~(b :| bs) = a :| (as ++ b : bs) > base/GHC/Base.hs:  fmap f ~(a :| as) = f a :| fmap f as > base/GHC/Base.hs:  b <$ ~(_ :| as)   = b   :| (b <$ as) > base/GHC/Base.hs:  ~(a :| as) >>= f = b :| (bs ++ bs') > base/GHC/Base.hs:          toList ~(c :| cs) = c : cs > base/GHC/Exts.hs:  toList ~(a :| as) = a : as > > On 8.1.2021 22.03, David Feuer wrote: >> I think removing the annotations that don't change anything can be >> done in a GHC MR without discussion on this list. I think the >> discussion on things that change strictness can and should continue here. >> >> On Fri, Jan 8, 2021, 2:59 PM Oleg Grenrus > > wrote: >> >> I'd expect that anyone who uses mfix with NonEmpty as result would use >> explicit (and irrefutable) pattern matching. >> >> But yes, changing these might make some code break. I'm not >> confident at >> all it won't make some code less efficient too, by forcing the >> structure >> of NonEmpty too early. >> >> So I would like that this thread is only about changing `head` and >> `tail` and not let scope creep. >> OR we hold this and let Keith come up with more complete NonEmpty >> implementation change. >> >> - Oleg >> >> On 8.1.2021 21.50, Viktor Dukhovni wrote: >> > On Fri, Jan 08, 2021 at 09:44:31PM +0200, Oleg Grenrus wrote: >> >> Note also >> >> >> >> -- | @since 4.9.0.0 >> >> instance Foldable NonEmpty where >> >>   foldr f z ~(a :| as) = f a (List.foldr f z as) >> >>   foldl f z (a :| as) = List.foldl f (f z a) as >> >>   foldl1 f (a :| as) = List.foldl f a as >> >> >> >>   -- GHC isn't clever enough to transform the default definition >> >>   -- into anything like this, so we'd end up shuffling a bunch of >> >>   -- Maybes around. >> >>   foldr1 f (p :| ps) = foldr go id ps p >> >>     where >> >>       go x r prev = f prev (r x) >> >> >> >>   -- We used to say >> >>   -- >> >>   --   length (_ :| as) = 1 + length as >> >>   -- >> >>   -- but the default definition is better, counting from 1. >> >>   -- >> >>   -- The default definition also works great for null and foldl'. >> >>   -- As usual for cons lists, foldr' is basically hopeless. >> >> >> >>   foldMap f ~(a :| as) = f a `mappend` foldMap f as >> >>   fold ~(m :| ms) = m `mappend` fold ms >> >>   toList ~(a :| as) = a : as >> >> >> >> Plenty of irrefutable patterns. >> > Do any of these make "mfix" more usable for NonEmpty?  Or are >> they just >> > superfluous?  With just one constructor, is there any downside to an >> > irrefutable pattern? >> > >> _______________________________________________ >> 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 andreas.abel at ifi.lmu.de Sun Jan 10 20:27:01 2021 From: andreas.abel at ifi.lmu.de (Andreas Abel) Date: Sun, 10 Jan 2021 21:27:01 +0100 Subject: Maintenance of text-icu (Bryan O'Sullivan) Message-ID: <3bb5fa8c-478e-e404-7ffb-a0a2a7de0e5f@ifi.lmu.de> Package text-icu (Bryan O'Sullivan) seems to be unmaintained since 2017 https://github.com/haskell/text-icu/issues/30 with the last release in 2015 https://hackage.haskell.org/package/text-icu-0.7.0.1 Unfortunately, the latest release is incompatible with ICU 68. Has anyone heard from Bryan recently? I mean, he is a Haskell celebrity... His last activity on github.com was in August 2017. Anyone interested in maintaining this package? Since Agda depends on text-icu, I could stand in as a temporary maintainer to at least merge the most important pull requests, until there is a new maintainer. Best regards, Andreas From ietf-dane at dukhovni.org Sun Jan 10 21:36:32 2021 From: ietf-dane at dukhovni.org (Viktor Dukhovni) Date: Sun, 10 Jan 2021 16:36:32 -0500 Subject: Maintenance of text-icu (Bryan O'Sullivan) In-Reply-To: <3bb5fa8c-478e-e404-7ffb-a0a2a7de0e5f@ifi.lmu.de> References: <3bb5fa8c-478e-e404-7ffb-a0a2a7de0e5f@ifi.lmu.de> Message-ID: On Sun, Jan 10, 2021 at 09:27:01PM +0100, Andreas Abel wrote: > Package text-icu (Bryan O'Sullivan) seems to be unmaintained since 2017 > > https://github.com/haskell/text-icu/issues/30 > > with the last release in 2015 > > https://hackage.haskell.org/package/text-icu-0.7.0.1 > > Unfortunately, the latest release is incompatible with ICU 68. > > Has anyone heard from Bryan recently? I mean, he is a Haskell > celebrity... His last activity on github.com was in August 2017. > > Anyone interested in maintaining this package? If it turns out that Brian is no longer going be looking after the project, or would be happy to share the burden, I'd be interested in co-maintaining it. I think it is generally best to have more than one active maintainer for a mature package. My interest in this space is largely via DNS and IDNA2008, where for my own projects I'm maintaining a private fork of idna-hs (abandoned by its original maintainer), which depends on text-icu via stringprep (though perhaps only needed for IDNA2003, which should no longer be used). -- Viktor. From george at wils.online Mon Jan 11 09:07:22 2021 From: george at wils.online (George Wilson) Date: Mon, 11 Jan 2021 19:07:22 +1000 Subject: Adding partial foldl1' to Foldable? In-Reply-To: References: Message-ID: I am sympathetic to the completeness argument, but I would prefer that we not add more partial functions to base. Having foldl1 and foldr1 in Foldable in the first place is something I consider a wart. Hopefully we can remove them in the future. Would it make sense to omit foldl1/foldr1/foldl1'/foldr1' entirely from your explanation? Then it would be future-proofed against such removal :) Cheers, George On Mon, 21 Dec 2020 at 08:16, Viktor Dukhovni wrote: > > > Given that Foldable currently has: > > - foldr and foldr' > - foldl and foldl' > - foldMap and foldMap' > > and also has only: > > - foldr1 > - foldl1 > > it seems natural to ask whether there it should also have a strict > variant of at least foldl1, since the non-strict variant has rather > limited applicability, and users would/should in most cases want/use > the strict `foldl1'` instead. > > -- > Viktor. > > P.S. I just joined the list today, but noticed that coincidentally, there's > already a recent dicussion of Foldable1, which rather overlaps with this > question, and perhaps the partial `foldr1` and `foldl1` should be seen > as deprecated, once a suitable class of non-empty containers provides > total variants. But perhaps on the other hand, given that the partial > functions already exist, perhaps adding the strict companions is > warranted? > > I am asking because I am writing some expository prose for > Data.Foldable, to go at the bottom of the document, structurally along > the lines of what I contributed for Data.Traversable, but with a fairly > different focus. The goal is draw careful distinctions between > strict recursive and lazy corecursive reductions, explaining their > proper usage and typical implementations. The "missing" `foldl1'` > was something I ran into while working on part of the writeup. > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries From george at wils.online Mon Jan 11 09:10:01 2021 From: george at wils.online (George Wilson) Date: Mon, 11 Jan 2021 19:10:01 +1000 Subject: Consideration to add `ordering` function to `Data.Ord` In-Reply-To: References: Message-ID: I am weakly in favour of this. Having catamorphisms for these basic types seems handy, although I think I would personally almost always use a pattern match in the case of Ordering. Cheers, George On Sat, 2 Jan 2021 at 12:15, Ian Treyball wrote: > > Good day, > > In short, I think it would be nice to add the following ordering > function to the Data.Ord module: > > -- | Case analysis for the 'Ordering' type. @'ordering' x y z o @ > evaluates to @x@ > -- when @o@ is 'LT', @y@ when @o@ is EQ, and evaluates to @z@ when @o@ is 'GT'. > ordering :: a -> a -> a -> Ordering -> a > ordering lt _ _ LT = lt > ordering _ eq _ EQ = eq > ordering _ _ gt GT = gt > > This would be essentially analogous to the bool function from Data.Bool: > > bool :: a -> a -> Bool -> a > bool f _ False = f > bool _ t True = t > > Because the bool function is the case-analysis for the Bool data type, > and the order of the parameters matches the order in which the > constructors are defined: > > Data Bool = False | True > > I decided it would be consistent to follow the same approach for the > ordering implementation and so I use the particular ordering (no pun > intended) for the parameters to also match the order of the > constructors: > > Data Ordering = LT | EQ | GT > > I will also add an example use case, here is how show could be > implemented using the proposed function (of course, we momentarily > assume it is not derived, for sake of simplicity): > > instance Show Ordering where > show :: Ordering -> String > show = ordering "LT" "EQ" "GT" > > Please let me know if you would wish for me to share more compelling > examples, I have a few, but they are longer (so not here included for > brevity's sake). > > I hope the formatting comes out okay, I will link to a gist[1], just in case. > > If this sounds acceptable, please let me know how to proceed (would > this fall under "Core Libraries Proposal"[2]? I don't necessarily see > adding this function as a breaking change, so I'm not sure, but I can > surely fill one out if it's appropriate); otherwise, thank you for > your time and consideration. > > Respectfully, > > Ian Treyball > > [1] https://gist.github.com/subttle/b49762a929f25e349381ef161bbc33d0 > > [2] https://github.com/haskell-core/core-libraries-proposals > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries From andreas.abel at ifi.lmu.de Mon Jan 11 09:15:02 2021 From: andreas.abel at ifi.lmu.de (Andreas Abel) Date: Mon, 11 Jan 2021 10:15:02 +0100 Subject: Maintenance of text-icu (Bryan O'Sullivan) In-Reply-To: References: <3bb5fa8c-478e-e404-7ffb-a0a2a7de0e5f@ifi.lmu.de> Message-ID: > I think it is generally best to have more than one > active maintainer for a mature package. Agreed. The easiest would be that Bryan O'Sullivan, if he surfaces again, gives us write access to his bos/text-icu repo on github (for the continuity of issues/PRs---I don't think one can fork a repo including issues/PRs), and upload rights on hackage. On 2021-01-10 22:36, Viktor Dukhovni wrote: > On Sun, Jan 10, 2021 at 09:27:01PM +0100, Andreas Abel wrote: > >> Package text-icu (Bryan O'Sullivan) seems to be unmaintained since 2017 >> >> https://github.com/haskell/text-icu/issues/30 >> >> with the last release in 2015 >> >> https://hackage.haskell.org/package/text-icu-0.7.0.1 >> >> Unfortunately, the latest release is incompatible with ICU 68. >> >> Has anyone heard from Bryan recently? I mean, he is a Haskell >> celebrity... His last activity on github.com was in August 2017. >> >> Anyone interested in maintaining this package? > > If it turns out that Brian is no longer going be looking after the > project, or would be happy to share the burden, I'd be interested in > co-maintaining it. I think it is generally best to have more than one > active maintainer for a mature package. > > My interest in this space is largely via DNS and IDNA2008, where for my > own projects I'm maintaining a private fork of idna-hs (abandoned by its > original maintainer), which depends on text-icu via stringprep (though > perhaps only needed for IDNA2003, which should no longer be used). > From simonpj at microsoft.com Mon Jan 11 09:39:22 2021 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Mon, 11 Jan 2021 09:39:22 +0000 Subject: Maintenance of text-icu (Bryan O'Sullivan) In-Reply-To: References: <3bb5fa8c-478e-e404-7ffb-a0a2a7de0e5f@ifi.lmu.de> Message-ID: Bryan helpfully transferred ownership of * attoparsec * criterion * statistics * double-conversion * math-functions * aeson * text-icu * mwc-random * wreq * critbit * text-format Haskell.org (as a holding mechanism) on 8 Dec. This was a holding mechanism while we figure out who the new maintainers should be. Ben Gamari knows about this -- ask him. But I think Bryan is now out of the critical path. Simon | -----Original Message----- | From: Libraries On Behalf Of Andreas | Abel | Sent: 11 January 2021 09:15 | To: libraries at haskell.org | Subject: Re: Maintenance of text-icu (Bryan O'Sullivan) | | > I think it is generally best to have more than one > active | maintainer for a mature package. | | Agreed. | | The easiest would be that Bryan O'Sullivan, if he surfaces again, | gives us write access to his bos/text-icu repo on github (for the | continuity of issues/PRs---I don't think one can fork a repo including | issues/PRs), and upload rights on hackage. | | On 2021-01-10 22:36, Viktor Dukhovni wrote: | > On Sun, Jan 10, 2021 at 09:27:01PM +0100, Andreas Abel wrote: | > | >> Package text-icu (Bryan O'Sullivan) seems to be unmaintained since | >> 2017 | >> | >> | >> | https://nam06.safelinks.protection.outlook.com/?url=https%3A%2F%2Fgit | >> hub.com%2Fhaskell%2Ftext- | icu%2Fissues%2F30&data=04%7C01%7Csimonpj | >> | %40microsoft.com%7Cd15004dda7fa42fb7d6908d8b6116cc8%7C72f988bf86f141a | >> | f91ab2d7cd011db47%7C1%7C0%7C637459533267394277%7CUnknown%7CTWFpbGZsb3 | >> | d8eyJWIjoiMC4wLjAwMDAiLCJQIjoiV2luMzIiLCJBTiI6Ik1haWwiLCJXVCI6Mn0%3D% | >> | 7C1000&sdata=7CZn6bc4LTJXsymIlYGYG13A%2FjRJvgVKfOtX2b53%2B64%3D&a | >> mp;reserved=0 | >> | >> with the last release in 2015 | >> | >> | >> | https://nam06.safelinks.protection.outlook.com/?url=https%3A%2F%2Fhac | >> kage.haskell.org%2Fpackage%2Ftext-icu- | 0.7.0.1&data=04%7C01%7Csimo | >> | npj%40microsoft.com%7Cd15004dda7fa42fb7d6908d8b6116cc8%7C72f988bf86f1 | >> | 41af91ab2d7cd011db47%7C1%7C0%7C637459533267394277%7CUnknown%7CTWFpbGZ | >> | sb3d8eyJWIjoiMC4wLjAwMDAiLCJQIjoiV2luMzIiLCJBTiI6Ik1haWwiLCJXVCI6Mn0% | >> | 3D%7C1000&sdata=%2BDHszCPCt9faTEv3Hl77UFoHuEzpIojwN4Uc5oOiplk%3D& | >> amp;reserved=0 | >> | >> Unfortunately, the latest release is incompatible with ICU 68. | >> | >> Has anyone heard from Bryan recently? I mean, he is a Haskell | >> celebrity... His last activity on github.com was in August 2017. | >> | >> Anyone interested in maintaining this package? | > | > If it turns out that Brian is no longer going be looking after the | > project, or would be happy to share the burden, I'd be interested in | > co-maintaining it. I think it is generally best to have more than | one | > active maintainer for a mature package. | > | > My interest in this space is largely via DNS and IDNA2008, where for | > my own projects I'm maintaining a private fork of idna-hs (abandoned | > by its original maintainer), which depends on text-icu via | stringprep | > (though perhaps only needed for IDNA2003, which should no longer be | used). | > | _______________________________________________ | Libraries mailing list | Libraries at haskell.org | https://nam06.safelinks.protection.outlook.com/?url=http%3A%2F%2Fmail. | haskell.org%2Fcgi- | bin%2Fmailman%2Flistinfo%2Flibraries&data=04%7C01%7Csimonpj%40micr | osoft.com%7Cd15004dda7fa42fb7d6908d8b6116cc8%7C72f988bf86f141af91ab2d7 | cd011db47%7C1%7C0%7C637459533267404274%7CUnknown%7CTWFpbGZsb3d8eyJWIjo | iMC4wLjAwMDAiLCJQIjoiV2luMzIiLCJBTiI6Ik1haWwiLCJXVCI6Mn0%3D%7C1000& | ;sdata=2v4XLw12o5NDzaqOEqPPoe080O7Mt0jQyCwkaogJKuo%3D&reserved=0 From andreas.abel at ifi.lmu.de Mon Jan 11 10:56:25 2021 From: andreas.abel at ifi.lmu.de (Andreas Abel) Date: Mon, 11 Jan 2021 11:56:25 +0100 Subject: Maintenance of text-icu (Bryan O'Sullivan) In-Reply-To: References: <3bb5fa8c-478e-e404-7ffb-a0a2a7de0e5f@ifi.lmu.de> Message-ID: <6f07330f-268a-dc80-8f39-5a1921ae2798@ifi.lmu.de> Thanks Simon, for the update! (I hope it is nothing bad.) @Ben: Could you set us up? (And would that include write permissions on bos/text-icu or a new repo?) On 2021-01-11 10:39, Simon Peyton Jones wrote: > Bryan helpfully transferred ownership of > > * attoparsec > * criterion > * statistics > * double-conversion > * math-functions > * aeson > * text-icu > * mwc-random > * wreq > * critbit > * text-format > > Haskell.org (as a holding mechanism) on 8 Dec. This was a holding mechanism while we figure out who the new maintainers should be. Ben Gamari knows about this -- ask him. But I think Bryan is now out of the critical path. > > Simon > > | -----Original Message----- > | From: Libraries On Behalf Of Andreas > | Abel > | Sent: 11 January 2021 09:15 > | To: libraries at haskell.org > | Subject: Re: Maintenance of text-icu (Bryan O'Sullivan) > | > | > I think it is generally best to have more than one > active > | maintainer for a mature package. > | > | Agreed. > | > | The easiest would be that Bryan O'Sullivan, if he surfaces again, > | gives us write access to his bos/text-icu repo on github (for the > | continuity of issues/PRs---I don't think one can fork a repo including > | issues/PRs), and upload rights on hackage. > | > | On 2021-01-10 22:36, Viktor Dukhovni wrote: > | > On Sun, Jan 10, 2021 at 09:27:01PM +0100, Andreas Abel wrote: > | > > | >> Package text-icu (Bryan O'Sullivan) seems to be unmaintained since > | >> 2017 > | >> > | >> > | >> > | https://nam06.safelinks.protection.outlook.com/?url=https%3A%2F%2Fgit > | >> hub.com%2Fhaskell%2Ftext- > | icu%2Fissues%2F30&data=04%7C01%7Csimonpj > | >> > | %40microsoft.com%7Cd15004dda7fa42fb7d6908d8b6116cc8%7C72f988bf86f141a > | >> > | f91ab2d7cd011db47%7C1%7C0%7C637459533267394277%7CUnknown%7CTWFpbGZsb3 > | >> > | d8eyJWIjoiMC4wLjAwMDAiLCJQIjoiV2luMzIiLCJBTiI6Ik1haWwiLCJXVCI6Mn0%3D% > | >> > | 7C1000&sdata=7CZn6bc4LTJXsymIlYGYG13A%2FjRJvgVKfOtX2b53%2B64%3D&a > | >> mp;reserved=0 > | >> > | >> with the last release in 2015 > | >> > | >> > | >> > | https://nam06.safelinks.protection.outlook.com/?url=https%3A%2F%2Fhac > | >> kage.haskell.org%2Fpackage%2Ftext-icu- > | 0.7.0.1&data=04%7C01%7Csimo > | >> > | npj%40microsoft.com%7Cd15004dda7fa42fb7d6908d8b6116cc8%7C72f988bf86f1 > | >> > | 41af91ab2d7cd011db47%7C1%7C0%7C637459533267394277%7CUnknown%7CTWFpbGZ > | >> > | sb3d8eyJWIjoiMC4wLjAwMDAiLCJQIjoiV2luMzIiLCJBTiI6Ik1haWwiLCJXVCI6Mn0% > | >> > | 3D%7C1000&sdata=%2BDHszCPCt9faTEv3Hl77UFoHuEzpIojwN4Uc5oOiplk%3D& > | >> amp;reserved=0 > | >> > | >> Unfortunately, the latest release is incompatible with ICU 68. > | >> > | >> Has anyone heard from Bryan recently? I mean, he is a Haskell > | >> celebrity... His last activity on github.com was in August 2017. > | >> > | >> Anyone interested in maintaining this package? > | > > | > If it turns out that Brian is no longer going be looking after the > | > project, or would be happy to share the burden, I'd be interested in > | > co-maintaining it. I think it is generally best to have more than > | one > | > active maintainer for a mature package. > | > > | > My interest in this space is largely via DNS and IDNA2008, where for > | > my own projects I'm maintaining a private fork of idna-hs (abandoned > | > by its original maintainer), which depends on text-icu via > | stringprep > | > (though perhaps only needed for IDNA2003, which should no longer be > | used). > | > > | _______________________________________________ > | Libraries mailing list > | Libraries at haskell.org > | https://nam06.safelinks.protection.outlook.com/?url=http%3A%2F%2Fmail. > | haskell.org%2Fcgi- > | bin%2Fmailman%2Flistinfo%2Flibraries&data=04%7C01%7Csimonpj%40micr > | osoft.com%7Cd15004dda7fa42fb7d6908d8b6116cc8%7C72f988bf86f141af91ab2d7 > | cd011db47%7C1%7C0%7C637459533267404274%7CUnknown%7CTWFpbGZsb3d8eyJWIjo > | iMC4wLjAwMDAiLCJQIjoiV2luMzIiLCJBTiI6Ik1haWwiLCJXVCI6Mn0%3D%7C1000& > | ;sdata=2v4XLw12o5NDzaqOEqPPoe080O7Mt0jQyCwkaogJKuo%3D&reserved=0 > From tikhon at jelv.is Mon Jan 11 20:15:06 2021 From: tikhon at jelv.is (Tikhon Jelvis) Date: Mon, 11 Jan 2021 12:15:06 -0800 Subject: Consideration to add `ordering` function to `Data.Ord` In-Reply-To: References: Message-ID: This seems good for consistency since we provide corresponding functions for other basic types (bool, maybe, either). Sticking to consistent patterns would make Haskell's libraries easier to learn. On Mon, Jan 11, 2021 at 1:11 AM George Wilson wrote: > I am weakly in favour of this. > Having catamorphisms for these basic types seems handy, although I > think I would personally almost always use a pattern match in the case > of Ordering. > > Cheers, > George > > On Sat, 2 Jan 2021 at 12:15, Ian Treyball wrote: > > > > Good day, > > > > In short, I think it would be nice to add the following ordering > > function to the Data.Ord module: > > > > -- | Case analysis for the 'Ordering' type. @'ordering' x y z o @ > > evaluates to @x@ > > -- when @o@ is 'LT', @y@ when @o@ is EQ, and evaluates to @z@ when @o@ > is 'GT'. > > ordering :: a -> a -> a -> Ordering -> a > > ordering lt _ _ LT = lt > > ordering _ eq _ EQ = eq > > ordering _ _ gt GT = gt > > > > This would be essentially analogous to the bool function from Data.Bool: > > > > bool :: a -> a -> Bool -> a > > bool f _ False = f > > bool _ t True = t > > > > Because the bool function is the case-analysis for the Bool data type, > > and the order of the parameters matches the order in which the > > constructors are defined: > > > > Data Bool = False | True > > > > I decided it would be consistent to follow the same approach for the > > ordering implementation and so I use the particular ordering (no pun > > intended) for the parameters to also match the order of the > > constructors: > > > > Data Ordering = LT | EQ | GT > > > > I will also add an example use case, here is how show could be > > implemented using the proposed function (of course, we momentarily > > assume it is not derived, for sake of simplicity): > > > > instance Show Ordering where > > show :: Ordering -> String > > show = ordering "LT" "EQ" "GT" > > > > Please let me know if you would wish for me to share more compelling > > examples, I have a few, but they are longer (so not here included for > > brevity's sake). > > > > I hope the formatting comes out okay, I will link to a gist[1], just in > case. > > > > If this sounds acceptable, please let me know how to proceed (would > > this fall under "Core Libraries Proposal"[2]? I don't necessarily see > > adding this function as a breaking change, so I'm not sure, but I can > > surely fill one out if it's appropriate); otherwise, thank you for > > your time and consideration. > > > > Respectfully, > > > > Ian Treyball > > > > [1] https://gist.github.com/subttle/b49762a929f25e349381ef161bbc33d0 > > > > [2] https://github.com/haskell-core/core-libraries-proposals > > _______________________________________________ > > 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 david.feuer at gmail.com Fri Jan 15 20:05:13 2021 From: david.feuer at gmail.com (David Feuer) Date: Fri, 15 Jan 2021 15:05:13 -0500 Subject: Proposal: Add atomic IORef operations to Data.IORef Message-ID: GHC.IORef currently exports atomicModifyIORef2 :: IORef a -> (a -> (a,b)) -> IO (a, (a, b)) atomicSwapIORef :: IORef a -> a -> IO a atomicModifyIORef2 is a lot like atomicModifyIORef, but it returns both the old value in the IORef and the full result of applying the user-supplied function to that. This is a pretty thin wrapper around the newish atomicModifyMutVar2# primop, which has replaced the less powerful atomicModifyMutVar#. atomicSwapIORef atomically installs a user-supplied value in an IORef and returns the old value. It is currently implemented using atomicModifyIORef2, but it can and should be reimplemented using its own, more efficient primop. I propose to add both of these functions to Data.IORef. David From chessai1996 at gmail.com Fri Jan 15 20:10:40 2021 From: chessai1996 at gmail.com (chessai) Date: Fri, 15 Jan 2021 14:10:40 -0600 Subject: Proposal: Add atomic IORef operations to Data.IORef In-Reply-To: References: Message-ID: +1 with sufficient documentation On Fri, Jan 15, 2021, 14:06 David Feuer wrote: > GHC.IORef currently exports > > atomicModifyIORef2 :: IORef a -> (a -> (a,b)) -> IO (a, (a, b)) > atomicSwapIORef :: IORef a -> a -> IO a > > atomicModifyIORef2 is a lot like atomicModifyIORef, but it returns > both the old value in the IORef and the full result of applying the > user-supplied function to that. This is a pretty thin wrapper around > the newish atomicModifyMutVar2# primop, which has replaced the less > powerful atomicModifyMutVar#. > > atomicSwapIORef atomically installs a user-supplied value in an IORef > and returns the old value. It is currently implemented using > atomicModifyIORef2, but it can and should be reimplemented using its > own, more efficient primop. > > I propose to add both of these functions to Data.IORef. > > David > _______________________________________________ > 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 alexey at kuleshevi.ch Fri Jan 15 20:18:58 2021 From: alexey at kuleshevi.ch (Alexey Kuleshevich) Date: Fri, 15 Jan 2021 20:18:58 +0000 Subject: Proposal: Add atomic IORef operations to Data.IORef In-Reply-To: References: Message-ID: Both of these functions are lazy with respect to the new value being written into the IORef, which is a horrible default for atomic operations. That is why atomicModifyIORef is a source of memory leaks and terrible performance, which is also why atomicModifyIORef' is almost always used instead. So +1 from me on adding strict versions of these functions that force new value to whnf, but -1 for adding these lazy versions as they are currently defined in GHC.IORef Alexey. ‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐ On Friday, January 15, 2021 11:05 PM, David Feuer wrote: > GHC.IORef currently exports > > atomicModifyIORef2 :: IORef a -> (a -> (a,b)) -> IO (a, (a, b)) > atomicSwapIORef :: IORef a -> a -> IO a > > atomicModifyIORef2 is a lot like atomicModifyIORef, but it returns > both the old value in the IORef and the full result of applying the > user-supplied function to that. This is a pretty thin wrapper around > the newish atomicModifyMutVar2# primop, which has replaced the less > powerful atomicModifyMutVar#. > > atomicSwapIORef atomically installs a user-supplied value in an IORef > and returns the old value. It is currently implemented using > atomicModifyIORef2, but it can and should be reimplemented using its > own, more efficient primop. > > I propose to add both of these functions to Data.IORef. > > David > > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries From david.feuer at gmail.com Fri Jan 15 20:29:37 2021 From: david.feuer at gmail.com (David Feuer) Date: Fri, 15 Jan 2021 15:29:37 -0500 Subject: Proposal: Add atomic IORef operations to Data.IORef In-Reply-To: References: Message-ID: I disagree. I believe we should offer both atomicModifyIORef2 and an atomicModifyIORef2'. The latter should force the new value in the IORef but, unlike atomicModifyIORef', should not force the returned value. Or if you and others prefer, we could offer a strict atomicModifyIORef and a lazy atomicModifyIORef2Lazy. As a Haskell programmer, I really don't want totally polymorphic values getting forced behind my back. It's actually possible to write an even lazier version that doesn't even force the function result pair, but I don't think that's a very useful idea. One other thing: the natural approach to atomicModifyIORef2' uses a "half-strict pair" type data HSPair a b = HSPair !a b atomicModifyIORef2' :: IORef a -> (a -> HSPair a b) -> IO (a, HSPair a b) I don't know to what extent users are willing to tolerate such an extra datatype. Side note: the peculiarly strict behavior of atomicModifyIORef' is a result of the poor design of the old atomicModifyMutVar# primop. On Fri, Jan 15, 2021 at 3:19 PM Alexey Kuleshevich wrote: > > Both of these functions are lazy with respect to the new value being written into the IORef, which is a horrible default for atomic operations. That is why atomicModifyIORef is a source of memory leaks and terrible performance, which is also why atomicModifyIORef' is almost always used instead. > > So +1 from me on adding strict versions of these functions that force new value to whnf, but -1 for adding these lazy versions as they are currently defined in GHC.IORef > > > Alexey. > > > ‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐ > On Friday, January 15, 2021 11:05 PM, David Feuer wrote: > > > GHC.IORef currently exports > > > > atomicModifyIORef2 :: IORef a -> (a -> (a,b)) -> IO (a, (a, b)) > > atomicSwapIORef :: IORef a -> a -> IO a > > > > atomicModifyIORef2 is a lot like atomicModifyIORef, but it returns > > both the old value in the IORef and the full result of applying the > > user-supplied function to that. This is a pretty thin wrapper around > > the newish atomicModifyMutVar2# primop, which has replaced the less > > powerful atomicModifyMutVar#. > > > > atomicSwapIORef atomically installs a user-supplied value in an IORef > > and returns the old value. It is currently implemented using > > atomicModifyIORef2, but it can and should be reimplemented using its > > own, more efficient primop. > > > > I propose to add both of these functions to Data.IORef. > > > > David > > > > Libraries mailing list > > Libraries at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > > From david.feuer at gmail.com Fri Jan 15 20:36:11 2021 From: david.feuer at gmail.com (David Feuer) Date: Fri, 15 Jan 2021 15:36:11 -0500 Subject: Proposal: Add atomic IORef operations to Data.IORef In-Reply-To: <0c94c479-7ae6-4f4e-83fa-0544a18e427a@Spark> References: <0c94c479-7ae6-4f4e-83fa-0544a18e427a@Spark> Message-ID: Please do feel free to suggest a better name. I would certainly have named it better had I been able to think of one. On Fri, Jan 15, 2021 at 3:33 PM wrote: > > I would suggest better naming that suffixing with '2', if the suggestion was to add them with the same names as GHC.IORef > On 15 Jan 2021, 20:05 +0000, David Feuer , wrote: > > GHC.IORef currently exports > > > atomicModifyIORef2 :: IORef a -> (a -> (a,b)) -> IO (a, (a, b)) > > atomicSwapIORef :: IORef a -> a -> IO a > > > atomicModifyIORef2 is a lot like atomicModifyIORef, but it returns > > both the old value in the IORef and the full result of applying the > > user-supplied function to that. This is a pretty thin wrapper around > > the newish atomicModifyMutVar2# primop, which has replaced the less > > powerful atomicModifyMutVar#. > > > atomicSwapIORef atomically installs a user-supplied value in an IORef > > and returns the old value. It is currently implemented using > > atomicModifyIORef2, but it can and should be reimplemented using its > > own, more efficient primop. > > > I propose to add both of these functions to Data.IORef. > > > David > > _______________________________________________ > > Libraries mailing list > > Libraries at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries From alexey at kuleshevi.ch Fri Jan 15 20:38:20 2021 From: alexey at kuleshevi.ch (Alexey Kuleshevich) Date: Fri, 15 Jan 2021 20:38:20 +0000 Subject: Proposal: Add atomic IORef operations to Data.IORef In-Reply-To: References: Message-ID: I totally agree with everything that you just said. Sorry, I should have said originally "-1 for adding JUST these lazy versions". As long as there are strict versions (whatever the names they might get, IMHO Lazy suffix is nice) and a warning on lazy versions about leaking memory, then I am 100% on board as well. Also +1 on not forcing the result. Alexey. ‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐ On Friday, January 15, 2021 11:29 PM, David Feuer wrote: > I disagree. I believe we should offer both atomicModifyIORef2 and an > atomicModifyIORef2'. The latter should force the new value in the > IORef but, unlike atomicModifyIORef', should not force the returned > value. Or if you and others prefer, we could offer a strict > atomicModifyIORef and a lazy atomicModifyIORef2Lazy. As a Haskell > programmer, I really don't want totally polymorphic values getting > forced behind my back. It's actually possible to write an even lazier > version that doesn't even force the function result pair, but I don't > think that's a very useful idea. > > One other thing: the natural approach to atomicModifyIORef2' uses a > "half-strict pair" type > > data HSPair a b = HSPair !a b > atomicModifyIORef2' :: IORef a -> (a -> HSPair a b) -> IO (a, HSPair a b) > > I don't know to what extent users are willing to tolerate such an > extra datatype. > > Side note: the peculiarly strict behavior of atomicModifyIORef' is a > result of the poor design of the old atomicModifyMutVar# primop. > > On Fri, Jan 15, 2021 at 3:19 PM Alexey Kuleshevich alexey at kuleshevi.ch wrote: > > > Both of these functions are lazy with respect to the new value being written into the IORef, which is a horrible default for atomic operations. That is why atomicModifyIORef is a source of memory leaks and terrible performance, which is also why atomicModifyIORef' is almost always used instead. > > So +1 from me on adding strict versions of these functions that force new value to whnf, but -1 for adding these lazy versions as they are currently defined in GHC.IORef > > Alexey. > > ‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐ > > On Friday, January 15, 2021 11:05 PM, David Feuer david.feuer at gmail.com wrote: > > > > > GHC.IORef currently exports > > > atomicModifyIORef2 :: IORef a -> (a -> (a,b)) -> IO (a, (a, b)) > > > atomicSwapIORef :: IORef a -> a -> IO a > > > atomicModifyIORef2 is a lot like atomicModifyIORef, but it returns > > > both the old value in the IORef and the full result of applying the > > > user-supplied function to that. This is a pretty thin wrapper around > > > the newish atomicModifyMutVar2# primop, which has replaced the less > > > powerful atomicModifyMutVar#. > > > atomicSwapIORef atomically installs a user-supplied value in an IORef > > > and returns the old value. It is currently implemented using > > > atomicModifyIORef2, but it can and should be reimplemented using its > > > own, more efficient primop. > > > I propose to add both of these functions to Data.IORef. > > > David > > > Libraries mailing list > > > Libraries at haskell.org > > > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries From david.feuer at gmail.com Fri Jan 15 21:01:35 2021 From: david.feuer at gmail.com (David Feuer) Date: Fri, 15 Jan 2021 16:01:35 -0500 Subject: Proposal: Add atomic IORef operations to Data.IORef In-Reply-To: References: Message-ID: Cool. Do you also want a strict atomicSwapIORef'? On Fri, Jan 15, 2021 at 3:38 PM Alexey Kuleshevich wrote: > > I totally agree with everything that you just said. Sorry, I should have said originally "-1 for adding JUST these lazy versions". As long as there are strict versions (whatever the names they might get, IMHO Lazy suffix is nice) and a warning on lazy versions about leaking memory, then I am 100% on board as well. Also +1 on not forcing the result. > > Alexey. > > ‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐ > On Friday, January 15, 2021 11:29 PM, David Feuer wrote: > > > I disagree. I believe we should offer both atomicModifyIORef2 and an > > atomicModifyIORef2'. The latter should force the new value in the > > IORef but, unlike atomicModifyIORef', should not force the returned > > value. Or if you and others prefer, we could offer a strict > > atomicModifyIORef and a lazy atomicModifyIORef2Lazy. As a Haskell > > programmer, I really don't want totally polymorphic values getting > > forced behind my back. It's actually possible to write an even lazier > > version that doesn't even force the function result pair, but I don't > > think that's a very useful idea. > > > > One other thing: the natural approach to atomicModifyIORef2' uses a > > "half-strict pair" type > > > > data HSPair a b = HSPair !a b > > atomicModifyIORef2' :: IORef a -> (a -> HSPair a b) -> IO (a, HSPair a b) > > > > I don't know to what extent users are willing to tolerate such an > > extra datatype. > > > > Side note: the peculiarly strict behavior of atomicModifyIORef' is a > > result of the poor design of the old atomicModifyMutVar# primop. > > > > On Fri, Jan 15, 2021 at 3:19 PM Alexey Kuleshevich alexey at kuleshevi.ch wrote: > > > > > Both of these functions are lazy with respect to the new value being written into the IORef, which is a horrible default for atomic operations. That is why atomicModifyIORef is a source of memory leaks and terrible performance, which is also why atomicModifyIORef' is almost always used instead. > > > So +1 from me on adding strict versions of these functions that force new value to whnf, but -1 for adding these lazy versions as they are currently defined in GHC.IORef > > > Alexey. > > > ‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐ > > > On Friday, January 15, 2021 11:05 PM, David Feuer david.feuer at gmail.com wrote: > > > > > > > GHC.IORef currently exports > > > > atomicModifyIORef2 :: IORef a -> (a -> (a,b)) -> IO (a, (a, b)) > > > > atomicSwapIORef :: IORef a -> a -> IO a > > > > atomicModifyIORef2 is a lot like atomicModifyIORef, but it returns > > > > both the old value in the IORef and the full result of applying the > > > > user-supplied function to that. This is a pretty thin wrapper around > > > > the newish atomicModifyMutVar2# primop, which has replaced the less > > > > powerful atomicModifyMutVar#. > > > > atomicSwapIORef atomically installs a user-supplied value in an IORef > > > > and returns the old value. It is currently implemented using > > > > atomicModifyIORef2, but it can and should be reimplemented using its > > > > own, more efficient primop. > > > > I propose to add both of these functions to Data.IORef. > > > > David > > > > Libraries mailing list > > > > Libraries at haskell.org > > > > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > > From alexey at kuleshevi.ch Fri Jan 15 21:13:54 2021 From: alexey at kuleshevi.ch (Alexey Kuleshevich) Date: Fri, 15 Jan 2021 21:13:54 +0000 Subject: Proposal: Add atomic IORef operations to Data.IORef In-Reply-To: References: Message-ID: Despite that this one is easy `atomicSwapIORef' ref !a = atomicSwapIORef ref a` I think it is important to include it. I also think `atomicWriteIORef'` should be added as well. Point is that most of the time in a concurrent setup it is the thread that does the IORef modification should be responsible for computing the value that is being written. This is important not only for performance but also for error handling. Alexey. ‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐ On Saturday, January 16, 2021 12:01 AM, David Feuer wrote: > Cool. Do you also want a strict atomicSwapIORef'? > > On Fri, Jan 15, 2021 at 3:38 PM Alexey Kuleshevich alexey at kuleshevi.ch wrote: > > > I totally agree with everything that you just said. Sorry, I should have said originally "-1 for adding JUST these lazy versions". As long as there are strict versions (whatever the names they might get, IMHO Lazy suffix is nice) and a warning on lazy versions about leaking memory, then I am 100% on board as well. Also +1 on not forcing the result. > > Alexey. > > ‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐ > > On Friday, January 15, 2021 11:29 PM, David Feuer david.feuer at gmail.com wrote: > > > > > I disagree. I believe we should offer both atomicModifyIORef2 and an > > > atomicModifyIORef2'. The latter should force the new value in the > > > IORef but, unlike atomicModifyIORef', should not force the returned > > > value. Or if you and others prefer, we could offer a strict > > > atomicModifyIORef and a lazy atomicModifyIORef2Lazy. As a Haskell > > > programmer, I really don't want totally polymorphic values getting > > > forced behind my back. It's actually possible to write an even lazier > > > version that doesn't even force the function result pair, but I don't > > > think that's a very useful idea. > > > One other thing: the natural approach to atomicModifyIORef2' uses a > > > "half-strict pair" type > > > data HSPair a b = HSPair !a b > > > atomicModifyIORef2' :: IORef a -> (a -> HSPair a b) -> IO (a, HSPair a b) > > > I don't know to what extent users are willing to tolerate such an > > > extra datatype. > > > Side note: the peculiarly strict behavior of atomicModifyIORef' is a > > > result of the poor design of the old atomicModifyMutVar# primop. > > > On Fri, Jan 15, 2021 at 3:19 PM Alexey Kuleshevich alexey at kuleshevi.ch wrote: > > > > > > > Both of these functions are lazy with respect to the new value being written into the IORef, which is a horrible default for atomic operations. That is why atomicModifyIORef is a source of memory leaks and terrible performance, which is also why atomicModifyIORef' is almost always used instead. > > > > So +1 from me on adding strict versions of these functions that force new value to whnf, but -1 for adding these lazy versions as they are currently defined in GHC.IORef > > > > Alexey. > > > > ‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐ > > > > On Friday, January 15, 2021 11:05 PM, David Feuer david.feuer at gmail.com wrote: > > > > > > > > > GHC.IORef currently exports > > > > > atomicModifyIORef2 :: IORef a -> (a -> (a,b)) -> IO (a, (a, b)) > > > > > atomicSwapIORef :: IORef a -> a -> IO a > > > > > atomicModifyIORef2 is a lot like atomicModifyIORef, but it returns > > > > > both the old value in the IORef and the full result of applying the > > > > > user-supplied function to that. This is a pretty thin wrapper around > > > > > the newish atomicModifyMutVar2# primop, which has replaced the less > > > > > powerful atomicModifyMutVar#. > > > > > atomicSwapIORef atomically installs a user-supplied value in an IORef > > > > > and returns the old value. It is currently implemented using > > > > > atomicModifyIORef2, but it can and should be reimplemented using its > > > > > own, more efficient primop. > > > > > I propose to add both of these functions to Data.IORef. > > > > > David > > > > > Libraries mailing list > > > > > Libraries at haskell.org > > > > > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries From david.feuer at gmail.com Fri Jan 15 21:23:36 2021 From: david.feuer at gmail.com (David Feuer) Date: Fri, 15 Jan 2021 16:23:36 -0500 Subject: Proposal: Add atomic IORef operations to Data.IORef In-Reply-To: References: Message-ID: The error handling situation for modification operations is somewhat deceptive. Unlike MVar operations, where the modifying thread can be fully responsible for exceptions, a thread can *try* to force the modified IORef value, but it may *actually* be forced by another thread if that thread gets there first. Someone using atomicModifyIORef2' should be very careful not to produce bottom as the new IORef value. Similarly, they must not use unsafePerformIO to produce the result if the IO in question must be performed in a particular thread. On Fri, Jan 15, 2021, 4:13 PM Alexey Kuleshevich wrote: > Despite that this one is easy `atomicSwapIORef' ref !a = atomicSwapIORef > ref a` I think it is important to include it. I also think > `atomicWriteIORef'` should be added as well. Point is that most of the time > in a concurrent setup it is the thread that does the IORef modification > should be responsible for computing the value that is being written. This > is important not only for performance but also for error handling. > > Alexey. > > > ‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐ > On Saturday, January 16, 2021 12:01 AM, David Feuer > wrote: > > > Cool. Do you also want a strict atomicSwapIORef'? > > > > On Fri, Jan 15, 2021 at 3:38 PM Alexey Kuleshevich alexey at kuleshevi.ch > wrote: > > > > > I totally agree with everything that you just said. Sorry, I should > have said originally "-1 for adding JUST these lazy versions". As long as > there are strict versions (whatever the names they might get, IMHO Lazy > suffix is nice) and a warning on lazy versions about leaking memory, then I > am 100% on board as well. Also +1 on not forcing the result. > > > Alexey. > > > ‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐ > > > On Friday, January 15, 2021 11:29 PM, David Feuer > david.feuer at gmail.com wrote: > > > > > > > I disagree. I believe we should offer both atomicModifyIORef2 and an > > > > atomicModifyIORef2'. The latter should force the new value in the > > > > IORef but, unlike atomicModifyIORef', should not force the returned > > > > value. Or if you and others prefer, we could offer a strict > > > > atomicModifyIORef and a lazy atomicModifyIORef2Lazy. As a Haskell > > > > programmer, I really don't want totally polymorphic values getting > > > > forced behind my back. It's actually possible to write an even lazier > > > > version that doesn't even force the function result pair, but I don't > > > > think that's a very useful idea. > > > > One other thing: the natural approach to atomicModifyIORef2' uses a > > > > "half-strict pair" type > > > > data HSPair a b = HSPair !a b > > > > atomicModifyIORef2' :: IORef a -> (a -> HSPair a b) -> IO (a, HSPair > a b) > > > > I don't know to what extent users are willing to tolerate such an > > > > extra datatype. > > > > Side note: the peculiarly strict behavior of atomicModifyIORef' is a > > > > result of the poor design of the old atomicModifyMutVar# primop. > > > > On Fri, Jan 15, 2021 at 3:19 PM Alexey Kuleshevich > alexey at kuleshevi.ch wrote: > > > > > > > > > Both of these functions are lazy with respect to the new value > being written into the IORef, which is a horrible default for atomic > operations. That is why atomicModifyIORef is a source of memory leaks and > terrible performance, which is also why atomicModifyIORef' is almost always > used instead. > > > > > So +1 from me on adding strict versions of these functions that > force new value to whnf, but -1 for adding these lazy versions as they are > currently defined in GHC.IORef > > > > > Alexey. > > > > > ‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐ > > > > > On Friday, January 15, 2021 11:05 PM, David Feuer > david.feuer at gmail.com wrote: > > > > > > > > > > > GHC.IORef currently exports > > > > > > atomicModifyIORef2 :: IORef a -> (a -> (a,b)) -> IO (a, (a, b)) > > > > > > atomicSwapIORef :: IORef a -> a -> IO a > > > > > > atomicModifyIORef2 is a lot like atomicModifyIORef, but it > returns > > > > > > both the old value in the IORef and the full result of applying > the > > > > > > user-supplied function to that. This is a pretty thin wrapper > around > > > > > > the newish atomicModifyMutVar2# primop, which has replaced the > less > > > > > > powerful atomicModifyMutVar#. > > > > > > atomicSwapIORef atomically installs a user-supplied value in an > IORef > > > > > > and returns the old value. It is currently implemented using > > > > > > atomicModifyIORef2, but it can and should be reimplemented using > its > > > > > > own, more efficient primop. > > > > > > I propose to add both of these functions to Data.IORef. > > > > > > David > > > > > > 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 Wed Jan 20 17:54:30 2021 From: chessai1996 at gmail.com (chessai) Date: Wed, 20 Jan 2021 09:54:30 -0800 Subject: expose strlen from Foreign.C.String Message-ID: I've wanted the following before: foreign import ccall unsafe "strlen" cstringLength# :: Addr# -> Int# cstringLength :: CString -> Int cstringLength (Ptr s) = I# (cstringLength# s) A natural place for this seems to be Foreign.C.String. Thoughts? From george at wils.online Wed Jan 20 22:38:48 2021 From: george at wils.online (George Wilson) Date: Thu, 21 Jan 2021 08:38:48 +1000 Subject: expose strlen from Foreign.C.String In-Reply-To: References: Message-ID: Seems reasonable to me. On Thu, 21 Jan 2021 at 03:55, chessai wrote: > > I've wanted the following before: > > foreign import ccall unsafe "strlen" > cstringLength# :: Addr# -> Int# > > cstringLength :: CString -> Int > cstringLength (Ptr s) = I# (cstringLength# s) > > A natural place for this seems to be Foreign.C.String. > > Thoughts? > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries From ietf-dane at dukhovni.org Wed Jan 20 23:00:58 2021 From: ietf-dane at dukhovni.org (Viktor Dukhovni) Date: Wed, 20 Jan 2021 18:00:58 -0500 Subject: expose strlen from Foreign.C.String In-Reply-To: References: Message-ID: On Wed, Jan 20, 2021 at 09:54:30AM -0800, chessai wrote: > I've wanted the following before: > > foreign import ccall unsafe "strlen" > cstringLength# :: Addr# -> Int# > > cstringLength :: CString -> Int > cstringLength (Ptr s) = I# (cstringLength# s) > > A natural place for this seems to be Foreign.C.String. Why a new FFI call, rather than `cstringLength#` from ghc-prim: GHC.CString (as of GHC 9.0.1): 9.0.1-notes.rst: ``ghc-prim`` library 9.0.1-notes.rst: ~~~~~~~~~~~~~~~~~~~~ 9.0.1-notes.rst: 9.0.1-notes.rst: - Add a known-key ``cstringLength#`` to ``GHC.CString`` that is eligible 9.0.1-notes.rst: for constant folding by a built-in rule. ghc-prim/changelog.md: - Add known-key `cstringLength#` to `GHC.CString`. This is just the ghc-prim/changelog.md: C function `strlen`, but a built-in rewrite rule allows GHC to ghc-prim/changelog.md: compute the result at compile time when the argument is known. CString.hs: -- | Compute the length of a NUL-terminated string. This address CString.hs: -- must refer to immutable memory. GHC includes a built-in rule for CString.hs: -- constant folding when the argument is a statically-known literal. CString.hs: -- That is, a core-to-core pass reduces the expression CString.hs: -- @cstringLength# "hello"#@ to the constant @5#@. CString.hs: cstringLength# :: Addr# -> Int# CString.hs: {-# INLINE[0] cstringLength# #-} CString.hs: cstringLength# = c_strlen Which is in turn re-exported by GHC.Exts: GHC/Exts.hs: -- * CString GHC/Exts.hs: unpackCString#, GHC/Exts.hs: unpackAppendCString#, GHC/Exts.hs: unpackFoldrCString#, GHC/Exts.hs: unpackCStringUtf8#, GHC/Exts.hs: unpackNBytes#, GHC/Exts.hs: cstringLength#, It is perhaps somewhat disappointing that the cstringLength# optimisations for `bytestring` (in master) aren't included in the `bytestring` version in 9.0.1. -- Viktor. From chessai1996 at gmail.com Thu Jan 21 03:39:19 2021 From: chessai1996 at gmail.com (chessai) Date: Wed, 20 Jan 2021 21:39:19 -0600 Subject: expose strlen from Foreign.C.String In-Reply-To: References: Message-ID: I forgot about that addition. In that case we would just need the lifted wrapper On Wed, Jan 20, 2021, 17:01 Viktor Dukhovni wrote: > On Wed, Jan 20, 2021 at 09:54:30AM -0800, chessai wrote: > > > I've wanted the following before: > > > > foreign import ccall unsafe "strlen" > > cstringLength# :: Addr# -> Int# > > > > cstringLength :: CString -> Int > > cstringLength (Ptr s) = I# (cstringLength# s) > > > > A natural place for this seems to be Foreign.C.String. > > Why a new FFI call, rather than `cstringLength#` from ghc-prim: GHC.CString > (as of GHC 9.0.1): > > 9.0.1-notes.rst: ``ghc-prim`` library > 9.0.1-notes.rst: ~~~~~~~~~~~~~~~~~~~~ > 9.0.1-notes.rst: > 9.0.1-notes.rst: - Add a known-key ``cstringLength#`` to > ``GHC.CString`` that is eligible > 9.0.1-notes.rst: for constant folding by a built-in rule. > > ghc-prim/changelog.md: - Add known-key `cstringLength#` to > `GHC.CString`. This is just the > ghc-prim/changelog.md: C function `strlen`, but a built-in rewrite > rule allows GHC to > ghc-prim/changelog.md: compute the result at compile time when the > argument is known. > > CString.hs: -- | Compute the length of a NUL-terminated string. This > address > CString.hs: -- must refer to immutable memory. GHC includes a > built-in rule for > CString.hs: -- constant folding when the argument is a > statically-known literal. > CString.hs: -- That is, a core-to-core pass reduces the expression > CString.hs: -- @cstringLength# "hello"#@ to the constant @5#@. > CString.hs: cstringLength# :: Addr# -> Int# > CString.hs: {-# INLINE[0] cstringLength# #-} > CString.hs: cstringLength# = c_strlen > > Which is in turn re-exported by GHC.Exts: > > GHC/Exts.hs: -- * CString > GHC/Exts.hs: unpackCString#, > GHC/Exts.hs: unpackAppendCString#, > GHC/Exts.hs: unpackFoldrCString#, > GHC/Exts.hs: unpackCStringUtf8#, > GHC/Exts.hs: unpackNBytes#, > GHC/Exts.hs: cstringLength#, > > It is perhaps somewhat disappointing that the cstringLength# > optimisations for `bytestring` (in master) aren't included in the > `bytestring` version in 9.0.1. > > -- > Viktor. > _______________________________________________ > 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 ietf-dane at dukhovni.org Thu Jan 21 04:02:20 2021 From: ietf-dane at dukhovni.org (Viktor Dukhovni) Date: Thu, 21 Jan 2021 02:02:20 -0200 Subject: expose strlen from Foreign.C.String In-Reply-To: References: Message-ID: <8D77202E-4E74-441F-AE68-16B15A2361CD@dukhovni.org> > On Jan 21, 2021, at 1:39 AM, chessai wrote: >> On Wed, Jan 20, 2021, 17:01 Viktor Dukhovni wrote: >>> On Wed, Jan 20, 2021 at 09:54:30AM -0800, chessai wrote: >>> >>> I've wanted the following before: >>> >>> foreign import ccall unsafe "strlen" >>> cstringLength# :: Addr# -> Int# >>> >>> cstringLength :: CString -> Int >>> cstringLength (Ptr s) = I# (cstringLength# s) >>> >>> A natural place for this seems to be Foreign.C.String. >> >> Why a new FFI call, rather than `cstringLength#` from ghc-prim: GHC.CString >> (as of GHC 9.0.1): > > I forgot about that addition. In that case we would just need the lifted wrapper No worries, sure the lifted wrapper makes sense, and Foreign.C.String does look like a reasonable place in which to define, and from which to export it. -- Viktor. From andrew.thaddeus at gmail.com Thu Jan 21 23:49:33 2021 From: andrew.thaddeus at gmail.com (Andrew Martin) Date: Thu, 21 Jan 2021 18:49:33 -0500 Subject: expose strlen from Foreign.C.String In-Reply-To: <8D77202E-4E74-441F-AE68-16B15A2361CD@dukhovni.org> References: <8D77202E-4E74-441F-AE68-16B15A2361CD@dukhovni.org> Message-ID: <7B5A8BCD-DB94-4F14-A17E-024F88F0F6A5@gmail.com> Both the unboxed variant and the wrapper are only sound on primitive string literals. You cannot use them on anything that was allocated at runtime, only on stuff baked into the rodata section. This is a pretty onerous restriction. What use case did you have in mind? Sent from my iPhone > On Jan 20, 2021, at 11:02 PM, Viktor Dukhovni wrote: > >  >> >>> On Jan 21, 2021, at 1:39 AM, chessai wrote: >>> On Wed, Jan 20, 2021, 17:01 Viktor Dukhovni wrote: >>>> On Wed, Jan 20, 2021 at 09:54:30AM -0800, chessai wrote: >>>> >>>> I've wanted the following before: >>>> >>>> foreign import ccall unsafe "strlen" >>>> cstringLength# :: Addr# -> Int# >>>> >>>> cstringLength :: CString -> Int >>>> cstringLength (Ptr s) = I# (cstringLength# s) >>>> >>>> A natural place for this seems to be Foreign.C.String. >>> >>> Why a new FFI call, rather than `cstringLength#` from ghc-prim: GHC.CString >>> (as of GHC 9.0.1): >> >> I forgot about that addition. In that case we would just need the lifted wrapper > > No worries, sure the lifted wrapper makes sense, and Foreign.C.String does > look like a reasonable place in which to define, and from which to export it. > > -- > Viktor. > > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries From zemyla at gmail.com Fri Jan 22 00:44:44 2021 From: zemyla at gmail.com (Zemyla) Date: Thu, 21 Jan 2021 18:44:44 -0600 Subject: expose strlen from Foreign.C.String In-Reply-To: <7B5A8BCD-DB94-4F14-A17E-024F88F0F6A5@gmail.com> References: <8D77202E-4E74-441F-AE68-16B15A2361CD@dukhovni.org> <7B5A8BCD-DB94-4F14-A17E-024F88F0F6A5@gmail.com> Message-ID: That doesn't sound right. I don't think it allocates any data on the heap which could cause reallocation and move an unpinned ByteArray#, which is the only way I can think it would be unsafe. On Thu, Jan 21, 2021, 17:50 Andrew Martin wrote: > Both the unboxed variant and the wrapper are only sound on primitive > string literals. You cannot use them on anything that was allocated at > runtime, only on stuff baked into the rodata section. This is a pretty > onerous restriction. What use case did you have in mind? > > Sent from my iPhone > > > On Jan 20, 2021, at 11:02 PM, Viktor Dukhovni > wrote: > > > >  > >> > >>> On Jan 21, 2021, at 1:39 AM, chessai wrote: > >>> On Wed, Jan 20, 2021, 17:01 Viktor Dukhovni > wrote: > >>>> On Wed, Jan 20, 2021 at 09:54:30AM -0800, chessai wrote: > >>>> > >>>> I've wanted the following before: > >>>> > >>>> foreign import ccall unsafe "strlen" > >>>> cstringLength# :: Addr# -> Int# > >>>> > >>>> cstringLength :: CString -> Int > >>>> cstringLength (Ptr s) = I# (cstringLength# s) > >>>> > >>>> A natural place for this seems to be Foreign.C.String. > >>> > >>> Why a new FFI call, rather than `cstringLength#` from ghc-prim: > GHC.CString > >>> (as of GHC 9.0.1): > >> > >> I forgot about that addition. In that case we would just need the > lifted wrapper > > > > No worries, sure the lifted wrapper makes sense, and Foreign.C.String > does > > look like a reasonable place in which to define, and from which to > export it. > > > > -- > > Viktor. > > > > _______________________________________________ > > 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 andrew.thaddeus at gmail.com Fri Jan 22 13:45:54 2021 From: andrew.thaddeus at gmail.com (Andrew Martin) Date: Fri, 22 Jan 2021 08:45:54 -0500 Subject: expose strlen from Foreign.C.String In-Reply-To: References: Message-ID: This is unsound: x <- malloc ... memcpy ... copy a nul-terminated string into x let len = cstringLength x free x Because GHC can float the let binding down to where it is used after free. Sent from my iPhone > On Jan 21, 2021, at 7:45 PM, Zemyla wrote: > >  > That doesn't sound right. I don't think it allocates any data on the heap which could cause reallocation and move an unpinned ByteArray#, which is the only way I can think it would be unsafe. > >> On Thu, Jan 21, 2021, 17:50 Andrew Martin wrote: >> Both the unboxed variant and the wrapper are only sound on primitive string literals. You cannot use them on anything that was allocated at runtime, only on stuff baked into the rodata section. This is a pretty onerous restriction. What use case did you have in mind? >> >> Sent from my iPhone >> >> > On Jan 20, 2021, at 11:02 PM, Viktor Dukhovni wrote: >> > >> >  >> >> >> >>> On Jan 21, 2021, at 1:39 AM, chessai wrote: >> >>> On Wed, Jan 20, 2021, 17:01 Viktor Dukhovni wrote: >> >>>> On Wed, Jan 20, 2021 at 09:54:30AM -0800, chessai wrote: >> >>>> >> >>>> I've wanted the following before: >> >>>> >> >>>> foreign import ccall unsafe "strlen" >> >>>> cstringLength# :: Addr# -> Int# >> >>>> >> >>>> cstringLength :: CString -> Int >> >>>> cstringLength (Ptr s) = I# (cstringLength# s) >> >>>> >> >>>> A natural place for this seems to be Foreign.C.String. >> >>> >> >>> Why a new FFI call, rather than `cstringLength#` from ghc-prim: GHC.CString >> >>> (as of GHC 9.0.1): >> >> >> >> I forgot about that addition. In that case we would just need the lifted wrapper >> > >> > No worries, sure the lifted wrapper makes sense, and Foreign.C.String does >> > look like a reasonable place in which to define, and from which to export it. >> > >> > -- >> > Viktor. >> > >> > _______________________________________________ >> > 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 carter.schonwald at gmail.com Fri Jan 22 20:12:42 2021 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Fri, 22 Jan 2021 15:12:42 -0500 Subject: expose strlen from Foreign.C.String In-Reply-To: References: Message-ID: andrew! this is a really good point. would the with# or touch# combinators be needed to fix it (to force gc liveness?)? OR would we need to have the foreign c call defined to have an -> IO result, then use unsafePerformIO to "purefy it correctly"? i think the best way to explain *why* the proposed definition runs into trouble is to look at how we annotate delicate/complicated prims in primops are annotated https://gitlab.haskell.org/ghc/ghc/-/blob/4bb9a349b5d002463b9fc4e9a3b6dbf77ea7c085/compiler/GHC/Builtin/primops.txt.pp#L139-178 otoh, the last time i was playing with an ostensibly pure primop that had really delicate effect ordering, the prefetch stuff in the NCG, my conclusion was that it *needed* explicit state tokens to make sure it didn't get reordered, and for this primop that pure version would need to be via unsafeperformio i think On Fri, Jan 22, 2021 at 8:46 AM Andrew Martin wrote: > This is unsound: > > x <- malloc ... > memcpy ... copy a nul-terminated string into x > let len = cstringLength x > free x > > Because GHC can float the let binding down to where it is used after free. > > Sent from my iPhone > > On Jan 21, 2021, at 7:45 PM, Zemyla wrote: > >  > That doesn't sound right. I don't think it allocates any data on the heap > which could cause reallocation and move an unpinned ByteArray#, which is > the only way I can think it would be unsafe. > > On Thu, Jan 21, 2021, 17:50 Andrew Martin > wrote: > >> Both the unboxed variant and the wrapper are only sound on primitive >> string literals. You cannot use them on anything that was allocated at >> runtime, only on stuff baked into the rodata section. This is a pretty >> onerous restriction. What use case did you have in mind? >> >> Sent from my iPhone >> >> > On Jan 20, 2021, at 11:02 PM, Viktor Dukhovni >> wrote: >> > >> >  >> >> >> >>> On Jan 21, 2021, at 1:39 AM, chessai wrote: >> >>> On Wed, Jan 20, 2021, 17:01 Viktor Dukhovni >> wrote: >> >>>> On Wed, Jan 20, 2021 at 09:54:30AM -0800, chessai wrote: >> >>>> >> >>>> I've wanted the following before: >> >>>> >> >>>> foreign import ccall unsafe "strlen" >> >>>> cstringLength# :: Addr# -> Int# >> >>>> >> >>>> cstringLength :: CString -> Int >> >>>> cstringLength (Ptr s) = I# (cstringLength# s) >> >>>> >> >>>> A natural place for this seems to be Foreign.C.String. >> >>> >> >>> Why a new FFI call, rather than `cstringLength#` from ghc-prim: >> GHC.CString >> >>> (as of GHC 9.0.1): >> >> >> >> I forgot about that addition. In that case we would just need the >> lifted wrapper >> > >> > No worries, sure the lifted wrapper makes sense, and Foreign.C.String >> does >> > look like a reasonable place in which to define, and from which to >> export it. >> > >> > -- >> > Viktor. >> > >> > _______________________________________________ >> > 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 ietf-dane at dukhovni.org Fri Jan 22 20:31:22 2021 From: ietf-dane at dukhovni.org (Viktor Dukhovni) Date: Fri, 22 Jan 2021 15:31:22 -0500 Subject: expose strlen from Foreign.C.String In-Reply-To: References: Message-ID: On Fri, Jan 22, 2021 at 08:45:54AM -0500, Andrew Martin wrote: > x <- malloc ... > memcpy ... copy a nul-terminated string into x > let len = cstringLength x > free x Isn't this broadly true for general uses of CString? Which is why we have `withCString`: https://hackage.haskell.org/package/base-4.14.1.0/docs/Foreign-C-String.html#v:withCString Is there any particularly different about the proposed `cstringLength`? Are you suggesting that it should have an "IO Int" result type to force sequencing? Is this warranted? Shouldn't users of CString (Ptr CChar) be already aware of the liveness issue in general. -- Viktor. From andrew.thaddeus at gmail.com Fri Jan 22 21:56:33 2021 From: andrew.thaddeus at gmail.com (Andrew Martin) Date: Fri, 22 Jan 2021 16:56:33 -0500 Subject: expose strlen from Foreign.C.String In-Reply-To: References: Message-ID: > > Are you suggesting that it should have an "IO Int" result type to force > sequencing? Is this warranted? > Yes. This is warranted. That's why Foreign.Storable.peek has IO in its result type. On any CString with a finite lifetime, it is necessary to sequence any reads and writes, and IO is the way this is done in base. By contrast, on a CString that is both immutable and has an infinite lifetime, we do not need to sequence reads. What kinds of CStrings fit the bill? Only those backed by primitive string literals. So, for example, if you have: myString :: CString myString = Ptr "foobar"# Since, myString is backed by something in the rodata section of a binary (meaning that it will never change and it will never be deallocated), then we do not care if reads get floated around. There are no functions in base for unsequenced reads, but in primitive, you'll find Data.Primitive.Ptr.indexOffPtr, which is unsequenced. So something like this would be ok: someOctet :: Word8 someOctet = Data.Primitive.Ptr.indexOffPtr myString 3 The cstringLength# in GHC.CString is similar to indexOffPtr. In fact, it could be implemented using indexOffPtr. The reason that cstringLength# exists (and in base of all places) is so that a built-in rewrite rule perform this transformation: cstringLength "foobar"# ==> 6# This will eventually be used to great effect in bytestring. See https://github.com/haskell/bytestring/pull/191. To get back to the original question, I think that any user-facing cstringLength function should probably be: cstringLength :: CString -> IO Int We need a separate FFI call that returns its result in IO to accomplish this. But this just be done in base rather than ghc-prim. There are no interesting rewrite rules that exist for such a function. On Fri, Jan 22, 2021 at 3:31 PM Viktor Dukhovni wrote: > On Fri, Jan 22, 2021 at 08:45:54AM -0500, Andrew Martin wrote: > > > x <- malloc ... > > memcpy ... copy a nul-terminated string into x > > let len = cstringLength x > > free x > > Isn't this broadly true for general uses of CString? Which is why we > have `withCString`: > > > https://hackage.haskell.org/package/base-4.14.1.0/docs/Foreign-C-String.html#v:withCString > > Is there any particularly different about the proposed `cstringLength`? > > Are you suggesting that it should have an "IO Int" result type to force > sequencing? Is this warranted? Shouldn't users of CString (Ptr CChar) > be already aware of the liveness issue in general. > > -- > Viktor. > _______________________________________________ > Libraries mailing list > Libraries at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries > -- -Andrew Thaddeus Martin -------------- next part -------------- An HTML attachment was scrubbed... URL: From ietf-dane at dukhovni.org Fri Jan 22 23:09:04 2021 From: ietf-dane at dukhovni.org (Viktor Dukhovni) Date: Fri, 22 Jan 2021 18:09:04 -0500 Subject: expose strlen from Foreign.C.String In-Reply-To: <7B5A8BCD-DB94-4F14-A17E-024F88F0F6A5@gmail.com> Message-ID: On Fri, Jan 22, 2021 at 04:56:33PM -0500, Andrew Martin wrote: > This will eventually be used to great effect in bytestring. See > https://github.com/haskell/bytestring/pull/191. Yes, you might recall that I'm well aware of that (already merged) PR, indeed that's how I happened to recall that cstringLength# is present in 9.0. > To get back to the original question, I think that any user-facing > cstringLength function should probably be: > > cstringLength :: CString -> IO Int > > We need a separate FFI call that returns its result in IO to > accomplish this. But this just be done in base rather than ghc-prim. > There are no interesting rewrite rules that exist for such a function. So I guess your suggestion in response to @chessai's original post: >> On Wed, Jan 20, 2021 at 09:54:30AM -0800, chessai wrote: >> >> I've wanted the following before: >> >> foreign import ccall unsafe "strlen" >> cstringLength# :: Addr# -> Int# >> >> cstringLength :: CString -> Int >> cstringLength (Ptr s) = I# (cstringLength# s) >> >> A natural place for this seems to be Foreign.C.String. would be to instead directly implement the lifted FFI variant: foreign import ccall unsafe "strlen" cstringLength :: CString -> IO Int which probably would not need a wrapper and can be exported directly. module Main (main) where import Control.Monad ( (>=>) ) import Foreign.C.String (CString, withCString) foreign import ccall unsafe "strlen" cstringLength :: CString -> IO Int main :: IO () main = withCString "Hello, World!" $ cstringLength >=> print The cost of this safety net is that it results in more sequencing than is strictly necessary. It is enough for the enclosing IO action to not embed the length in its result in some not yet fully evaluated thunk. I guess @chessai can let us know whether the more strictly sequenced variant meets his needs. -- Viktor. From chessai1996 at gmail.com Sat Jan 23 02:04:23 2021 From: chessai1996 at gmail.com (chessai) Date: Fri, 22 Jan 2021 20:04:23 -0600 Subject: expose strlen from Foreign.C.String In-Reply-To: References: <7B5A8BCD-DB94-4F14-A17E-024F88F0F6A5@gmail.com> Message-ID: I agree with Andrew, let's just export the lifted ffi call This suits my needs, but, regardless of my needs, seems like a perfectly sensible addition to Foreign.C.String Concrete addition: foreign import unsafe "strlen" cstringLength :: CString -> IO Int On Fri, Jan 22, 2021, 17:09 Viktor Dukhovni wrote: > On Fri, Jan 22, 2021 at 04:56:33PM -0500, Andrew Martin wrote: > > > This will eventually be used to great effect in bytestring. See > > https://github.com/haskell/bytestring/pull/191. > > Yes, you might recall that I'm well aware of that (already merged) PR, > indeed that's how I happened to recall that cstringLength# is present > in 9.0. > > > To get back to the original question, I think that any user-facing > > cstringLength function should probably be: > > > > cstringLength :: CString -> IO Int > > > > We need a separate FFI call that returns its result in IO to > > accomplish this. But this just be done in base rather than ghc-prim. > > There are no interesting rewrite rules that exist for such a function. > > So I guess your suggestion in response to @chessai's original post: > > >> On Wed, Jan 20, 2021 at 09:54:30AM -0800, chessai wrote: > >> > >> I've wanted the following before: > >> > >> foreign import ccall unsafe "strlen" > >> cstringLength# :: Addr# -> Int# > >> > >> cstringLength :: CString -> Int > >> cstringLength (Ptr s) = I# (cstringLength# s) > >> > >> A natural place for this seems to be Foreign.C.String. > > would be to instead directly implement the lifted FFI variant: > > foreign import ccall unsafe "strlen" > cstringLength :: CString -> IO Int > > which probably would not need a wrapper and can be exported directly. > > module Main (main) where > import Control.Monad ( (>=>) ) > import Foreign.C.String (CString, withCString) > > foreign import ccall unsafe "strlen" > cstringLength :: CString -> IO Int > > main :: IO () > main = withCString "Hello, World!" $ cstringLength >=> print > > The cost of this safety net is that it results in more sequencing than > is strictly necessary. It is enough for the enclosing IO action to not > embed the length in its result in some not yet fully evaluated thunk. > > I guess @chessai can let us know whether the more strictly sequenced > variant meets his needs. > > -- > Viktor. > _______________________________________________ > 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 Sat Jan 23 02:07:22 2021 From: emertens at gmail.com (Eric Mertens) Date: Fri, 22 Jan 2021 18:07:22 -0800 Subject: expose strlen from Foreign.C.String In-Reply-To: References: <7B5A8BCD-DB94-4F14-A17E-024F88F0F6A5@gmail.com> Message-ID: <8674A39B-05D9-42C0-AFFC-DF50D1CF88C4@gmail.com> I’m on board with this import, but we’ll need to get the type right if we’re going to bind to libc’s strlen directly foreign import unsafe "strlen" cstringLength :: CString -> IO CSize > On Jan 22, 2021, at 6:04 PM, chessai wrote: > > I agree with Andrew, let's just export the lifted ffi call > > This suits my needs, but, regardless of my needs, seems like a perfectly sensible addition to Foreign.C.String > > Concrete addition: > > foreign import unsafe "strlen" > cstringLength :: CString -> IO Int > > > On Fri, Jan 22, 2021, 17:09 Viktor Dukhovni > wrote: > On Fri, Jan 22, 2021 at 04:56:33PM -0500, Andrew Martin wrote: > > > This will eventually be used to great effect in bytestring. See > > https://github.com/haskell/bytestring/pull/191 . > > Yes, you might recall that I'm well aware of that (already merged) PR, > indeed that's how I happened to recall that cstringLength# is present > in 9.0. > > > To get back to the original question, I think that any user-facing > > cstringLength function should probably be: > > > > cstringLength :: CString -> IO Int > > > > We need a separate FFI call that returns its result in IO to > > accomplish this. But this just be done in base rather than ghc-prim. > > There are no interesting rewrite rules that exist for such a function. > > So I guess your suggestion in response to @chessai's original post: > > >> On Wed, Jan 20, 2021 at 09:54:30AM -0800, chessai wrote: > >> > >> I've wanted the following before: > >> > >> foreign import ccall unsafe "strlen" > >> cstringLength# :: Addr# -> Int# > >> > >> cstringLength :: CString -> Int > >> cstringLength (Ptr s) = I# (cstringLength# s) > >> > >> A natural place for this seems to be Foreign.C.String. > > would be to instead directly implement the lifted FFI variant: > > foreign import ccall unsafe "strlen" > cstringLength :: CString -> IO Int > > which probably would not need a wrapper and can be exported directly. > > module Main (main) where > import Control.Monad ( (>=>) ) > import Foreign.C.String (CString, withCString) > > foreign import ccall unsafe "strlen" > cstringLength :: CString -> IO Int > > main :: IO () > main = withCString "Hello, World!" $ cstringLength >=> print > > The cost of this safety net is that it results in more sequencing than > is strictly necessary. It is enough for the enclosing IO action to not > embed the length in its result in some not yet fully evaluated thunk. > > I guess @chessai can let us know whether the more strictly sequenced > variant meets his needs. > > -- > Viktor. > _______________________________________________ > 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 ietf-dane at dukhovni.org Sat Jan 23 02:34:18 2021 From: ietf-dane at dukhovni.org (Viktor Dukhovni) Date: Fri, 22 Jan 2021 21:34:18 -0500 Subject: expose strlen from Foreign.C.String In-Reply-To: <8674A39B-05D9-42C0-AFFC-DF50D1CF88C4@gmail.com> References: <7B5A8BCD-DB94-4F14-A17E-024F88F0F6A5@gmail.com> <8674A39B-05D9-42C0-AFFC-DF50D1CF88C4@gmail.com> Message-ID: On Fri, Jan 22, 2021 at 06:07:22PM -0800, Eric Mertens wrote: > I’m on board with this import, but we’ll need to get the type right if > we’re going to bind to libc’s strlen directly > > foreign import unsafe "strlen" > cstringLength :: CString -> IO CSize Yes, definitely. The final all-nits-addressed variant would be: foreign import ccall unsafe "string.h strlen" cstringLength :: CString -> IO CSize which is differs from the example in section 8.4.3 of the Haskell 2010 report https://www.haskell.org/onlinereport/haskell2010/haskellch8.html#x15-1590008.4.3 foreign import ccall "string.h strlen" cstrlen :: Ptr CChar -> IO CSize only in the addition of "unsafe" and the name of the resulting function. -- Viktor. From ietf-dane at dukhovni.org Sat Jan 23 03:07:28 2021 From: ietf-dane at dukhovni.org (Viktor Dukhovni) Date: Fri, 22 Jan 2021 22:07:28 -0500 Subject: Bikeshedding the cstringLength name? Message-ID: An equivalent function of course already exists outside base: $ hoogle 'CString -> IO CSize' Data.ByteString.Internal c_strlen :: CString -> IO CSize unsurprisingly defined as: foreign import ccall unsafe "string.h strlen" c_strlen :: CString -> IO CSize Would it make sense to give the proposed new Foreign.C.Types function the same "c_strlen" name? And then at some point in the future, Data.ByteString.Internal can just re-export it? Would using `cstringLength`, as proposed, be too confusable with the `cstringLength#` primop? -- Viktor. From george at wils.online Mon Jan 25 01:22:56 2021 From: george at wils.online (George Wilson) Date: Mon, 25 Jan 2021 11:22:56 +1000 Subject: Proposal: Add atomic IORef operations to Data.IORef In-Reply-To: References: Message-ID: +1 for inclusion of these On Sat, 16 Jan 2021 at 07:25, David Feuer wrote: > > The error handling situation for modification operations is somewhat deceptive. Unlike MVar operations, where the modifying thread can be fully responsible for exceptions, a thread can *try* to force the modified IORef value, but it may *actually* be forced by another thread if that thread gets there first. Someone using atomicModifyIORef2' should be very careful not to produce bottom as the new IORef value. Similarly, they must not use unsafePerformIO to produce the result if the IO in question must be performed in a particular thread. > > On Fri, Jan 15, 2021, 4:13 PM Alexey Kuleshevich wrote: >> >> Despite that this one is easy `atomicSwapIORef' ref !a = atomicSwapIORef ref a` I think it is important to include it. I also think `atomicWriteIORef'` should be added as well. Point is that most of the time in a concurrent setup it is the thread that does the IORef modification should be responsible for computing the value that is being written. This is important not only for performance but also for error handling. >> >> Alexey. >> >> >> ‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐ >> On Saturday, January 16, 2021 12:01 AM, David Feuer wrote: >> >> > Cool. Do you also want a strict atomicSwapIORef'? >> > >> > On Fri, Jan 15, 2021 at 3:38 PM Alexey Kuleshevich alexey at kuleshevi.ch wrote: >> > >> > > I totally agree with everything that you just said. Sorry, I should have said originally "-1 for adding JUST these lazy versions". As long as there are strict versions (whatever the names they might get, IMHO Lazy suffix is nice) and a warning on lazy versions about leaking memory, then I am 100% on board as well. Also +1 on not forcing the result. >> > > Alexey. >> > > ‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐ >> > > On Friday, January 15, 2021 11:29 PM, David Feuer david.feuer at gmail.com wrote: >> > > >> > > > I disagree. I believe we should offer both atomicModifyIORef2 and an >> > > > atomicModifyIORef2'. The latter should force the new value in the >> > > > IORef but, unlike atomicModifyIORef', should not force the returned >> > > > value. Or if you and others prefer, we could offer a strict >> > > > atomicModifyIORef and a lazy atomicModifyIORef2Lazy. As a Haskell >> > > > programmer, I really don't want totally polymorphic values getting >> > > > forced behind my back. It's actually possible to write an even lazier >> > > > version that doesn't even force the function result pair, but I don't >> > > > think that's a very useful idea. >> > > > One other thing: the natural approach to atomicModifyIORef2' uses a >> > > > "half-strict pair" type >> > > > data HSPair a b = HSPair !a b >> > > > atomicModifyIORef2' :: IORef a -> (a -> HSPair a b) -> IO (a, HSPair a b) >> > > > I don't know to what extent users are willing to tolerate such an >> > > > extra datatype. >> > > > Side note: the peculiarly strict behavior of atomicModifyIORef' is a >> > > > result of the poor design of the old atomicModifyMutVar# primop. >> > > > On Fri, Jan 15, 2021 at 3:19 PM Alexey Kuleshevich alexey at kuleshevi.ch wrote: >> > > > >> > > > > Both of these functions are lazy with respect to the new value being written into the IORef, which is a horrible default for atomic operations. That is why atomicModifyIORef is a source of memory leaks and terrible performance, which is also why atomicModifyIORef' is almost always used instead. >> > > > > So +1 from me on adding strict versions of these functions that force new value to whnf, but -1 for adding these lazy versions as they are currently defined in GHC.IORef >> > > > > Alexey. >> > > > > ‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐ >> > > > > On Friday, January 15, 2021 11:05 PM, David Feuer david.feuer at gmail.com wrote: >> > > > > >> > > > > > GHC.IORef currently exports >> > > > > > atomicModifyIORef2 :: IORef a -> (a -> (a,b)) -> IO (a, (a, b)) >> > > > > > atomicSwapIORef :: IORef a -> a -> IO a >> > > > > > atomicModifyIORef2 is a lot like atomicModifyIORef, but it returns >> > > > > > both the old value in the IORef and the full result of applying the >> > > > > > user-supplied function to that. This is a pretty thin wrapper around >> > > > > > the newish atomicModifyMutVar2# primop, which has replaced the less >> > > > > > powerful atomicModifyMutVar#. >> > > > > > atomicSwapIORef atomically installs a user-supplied value in an IORef >> > > > > > and returns the old value. It is currently implemented using >> > > > > > atomicModifyIORef2, but it can and should be reimplemented using its >> > > > > > own, more efficient primop. >> > > > > > I propose to add both of these functions to Data.IORef. >> > > > > > David >> > > > > > 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 john.ericson at obsidian.systems Mon Jan 25 17:33:32 2021 From: john.ericson at obsidian.systems (John Ericson) Date: Mon, 25 Jan 2021 12:33:32 -0500 Subject: Improving the instances of Data.Functor.{Product,Sum} In-Reply-To: References: <661b20b7-20a9-09db-9585-2cdd4a853f69@obsidian.systems> Message-ID: <2aff32a8-37e9-d4e8-8238-78025c5b28ed@obsidian.systems> Bump. It looks like both my MR (!4727) and this email went unnoticed? On 1/4/21 1:59 AM, John Ericson wrote: > > With the recent approval of > https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4527, I thought it > might be good to revisit this. I implemented my plan in > https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4727. > > I point a hope the concrete implementation will make clear is that the > flexible contexts and quantified constraints are *complementing*, not > *competing*. You can do the flexible instance without the quantified > constraint, but if you do the breakage will be worse, and the only > newly-allowed programs will be dubious ones that did the *1 instance > but forgot the corresponding regular instance. > > I hope we can make progress here, > > John > > On 5/19/20 10:51 AM, John Ericson wrote: >>> >>> The different results are: >>> * FlexibleContexts approach: `(Eq (Maybe (f a)), Eq [f a])` >>> * Eq1 typeclass: `(Eq1 f, Eq a)` >>> * Quantified Constraints: `(forall x. Eq x => Eq (f x), Eq a)` >>> >> So if (per my plan[1]) `Eq1` has the quantified constraints >> super-class,than Andrew Martin's second two options will imply the >> first one. So it seems that the FlexibleContexts choice --- asking >> for precisely what is needed --- is the best option, dare I say a >> principle type. >> >>> I think we should pre address any maturity issues or composition/ >>> generality concerns before folding quantified constraint  instances >>> into base >> >> I am with you Carter, but the only issues with quantified constraints >> we've discussed is around (~) and Coercible, but both shouldn't apply >> here, so I think that's a red-herring. >> >> In particular, only the *1 classes would have a *wanted* quantified >> constraint via super class (so just one imposed on instances). >> Everything else would just use FlexibleContexts or stay the same. >> [Extra given constraints do not in and of themselves pose inference >> problems.] >> >> It is because the *1 classes do not involve (~) or Coercible, or have >> anything like a `Type -> Constraint` parameters that could be >> substituted for (partially applied) (~) or Coercible, that those >> concerns shouldn't apply. >> >> John >> >> [1]: So nobody need waste their time looking it up, the super class >> is (forall x. Eq x => Eq (f x)) => Eq1 f >> >> >> _______________________________________________ >> 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 ekmett at gmail.com Tue Jan 26 04:09:01 2021 From: ekmett at gmail.com (Edward Kmett) Date: Mon, 25 Jan 2021 20:09:01 -0800 Subject: Bikeshedding the cstringLength name? In-Reply-To: References: Message-ID: In general, for good or evil, Haskell generally decided to roll its own names for everything to do with the outside world. Like I said, good or evil, because it leads to a consistent feel to the API, unlike, say something like PHP, but does raise the bar to initial entry into the language a bit. On the other hand, it strikes me as a worst of all choices to wind up with 1-2 functions that comply with outside naming, while everything else carries on as usual, because now users are in the business of memorizing exceptions rather than writing code. Internally libraries often adopt a c_foo or other mangling convention for their own FFI'd guts, but it isn't a thing base does. I'd be more interested in one of the myriad alternative base/prelude projects picking up and running with what it looks like when the names of everything look like something out of gcc, than I would be particularly interested in bikeshedding this one name into a very "unhaskelly" form. Names matching primitives modulo a hash is pretty universal as well. -Edward On Fri, Jan 22, 2021 at 7:07 PM Viktor Dukhovni wrote: > An equivalent function of course already exists outside base: > > $ hoogle 'CString -> IO CSize' > Data.ByteString.Internal c_strlen :: CString -> IO CSize > > unsurprisingly defined as: > > foreign import ccall unsafe "string.h strlen" c_strlen > :: CString -> IO CSize > > Would it make sense to give the proposed new Foreign.C.Types function > the same "c_strlen" name? And then at some point in the future, > Data.ByteString.Internal can just re-export it? > > Would using `cstringLength`, as proposed, be too confusable with the > `cstringLength#` primop? > > -- > Viktor. > _______________________________________________ > 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 ietf-dane at dukhovni.org Tue Jan 26 04:59:18 2021 From: ietf-dane at dukhovni.org (Viktor Dukhovni) Date: Mon, 25 Jan 2021 23:59:18 -0500 Subject: Bikeshedding the cstringLength name? In-Reply-To: References: Message-ID: On Mon, Jan 25, 2021 at 08:09:01PM -0800, Edward Kmett wrote: > [...Sound argument for consistency of style...] > > Names matching primitives modulo a hash is pretty universal as well. Just on this one point, the reason I contemplated something different than `cstringLength` and was led to `bytestring` as a possible model, was because the primop is differs subtly from the new lifted function by being "pure" (and is then only safe for compiled-in constants). Since the proposed lifted variant changes not only the levity but also the purity, I thought it worth asking whether that could be a source of confusion, with some users accidentally misusing the primop, expecting only a difference in levity. But likely I let my imagination run wild. The proposed name is fine. -- Viktor.