From ben.franksen at online.de Fri Oct 1 00:40:49 2021 From: ben.franksen at online.de (Ben Franksen) Date: Fri, 1 Oct 2021 02:40:49 +0200 Subject: [Haskell-cafe] Haskell's "historical futurism" needs better writing, not better tools In-Reply-To: References: Message-ID: Am 16.09.21 um 22:52 schrieb Viktor Dukhovni: > I am also curious whether I'm part of the solution or part of the > precipitate. I've recently contributed new documentation for > Data.Foldable and Data.Traversable: > > https://dnssec-stats.ant.isi.edu/~viktor/haskell/docs/libraries/base/Data-Foldable.html#g:7 > https://dnssec-stats.ant.isi.edu/~viktor/haskell/docs/libraries/base/Data-Traversable.html#g:4 > > are these a step in the right direction, or examples of more writing > that sucks? Sorry, but IMO it sucks. "Foldable structures are reduced to a summary value by accumulating contributions to the result one element at a time." The first sentence of the class docs says "The Foldable class represents data structures that can be reduced to a summary value one element at a time." which is more correct and (slightly) more concise with identical meaning. No value added here. Next: "The contribution of each element to the final result is combined with an accumulator via an operator function. [...]" First of all, use of the term "operator function" is confusing. In Haskell an operator is a function, period. Infix versus prefix notation is completely irrelevant here. The whole sentence is formulated in a cryptic and complicated way. It seems to me that what you want to say is "The result is calculated by successively applying the argument function to each element and an accumulator, producing a new accumulator." (*) Your text tries to explain things in a precise manner, but is hampered by insisting that the words "sequence" or "list" must be avoided, even though words like "precede", "follow", "left", and "right" are used all over the place. This understandably leads to awkward formulations. It is much easier to understand the concepts via sequences. The documentation of foldr and foldl has these two lines (**): foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...) They define semantics in a semi-formal notation, which I find succinct and very intuitive. This can be easily generalized to Foldable via 'toList'. Indeed, there is almost nothing about Foldable that cannot be understood once you understand Data.List and the toList method. Even foldMap is (semantically) just (***): foldMap f = foldr mappend mempty . map f . toList = foldl mappend mempty . map f . toList In fact all class methods have simple semantic definitions in terms of the same named functions from Data.List via 'toList'. This makes any further documentation of them redundant. This would also obviate the need to introduce ambiguous terminology like "explicit operator". The next sentence after the example: "The first argument of both is an explicit operator that merges the contribution of an element of the structure with a partial fold over, respectively, either the preceding or following elements of the structure." "merges the contribution of" is a complicated way to say "combines". Again, the semi-formal notation (**) says it all. As does my alternative proposal for the first sentence above (*), which incidentally demonstrates that you are repeating yourself here. The next sentence I could understand on first reading. Nevertheless, the content of everything up to (including) this sentence can be abbreviated, by adding a singe sentence to (*): "The result is calculated by successively applying the argument function to each element and an accumulator, producing a new accumulator. The accumulator is initialized with the second argument." Generally, the text is too long, too verbose, and the wording is too complicated. Some parts e.g. the discussion about "Chirality" (an extremely obscure term that I have never read anywhere before) again serves to illustrate that, semantically, Foldable is not much more than a glorified 'toList', everything else is optimization. Users would be served better by plainly stating it in this way, rather than obscuring it, as if there were kind of "deep" abstraction going on. Expectations of runtime cost should be either explicitly stated in the docs for each method or left out. The "Notes" section adds useful information. The most important documentation for a class, its laws, is (1) not contained in the class docs, (2) not even linked from there, and (3) too cryptic. I would *at least* expect the Monoid newtype wrappers (Endo, Dual, Sum, Product) and their inverses to be hyperlinked to their definition. The way the first two laws are stated in terms of these newtypes makes them harder to understand than necessary, especially for newcomers. My (equivalent) semantic definition of foldMap above (***) in terms of foldr/foldl does not require knowledge about these types and the semantics of their Monoid instances. Yet another aside: apart from trivial reductions to the corresponding function in Data.List using 'toList' (except 'toList' itself as well as 'fold' and 'foldMap'), the only non-trivial law seems to be "If the type is also a Functor instance, it should satisfy foldMap f = fold . fmap f" I may be wrong but it looks to me as if this could be derived by adding one more method 'fromList' that is required to be left inverse of 'toList': fromList :: Foldable a => [a] -> t a fromList . toList = id Of course, for some Foldables (e.g. those with a fixed finite number of elements), fromList would be partial. Is there a sensible (useful, lawful) Foldable instance which has no 'fromList'? I suspect no. In fact I suspect addition of fromList (with the left inverse law) would nicely serve to rule out useless/surprising instances. Cheers Ben -- I would rather have questions that cannot be answered, than answers that cannot be questioned. -- Richard Feynman From ietf-dane at dukhovni.org Fri Oct 1 01:14:36 2021 From: ietf-dane at dukhovni.org (Viktor Dukhovni) Date: Thu, 30 Sep 2021 21:14:36 -0400 Subject: [Haskell-cafe] Haskell's "historical futurism" needs better writing, not better tools In-Reply-To: References: Message-ID: On Fri, Oct 01, 2021 at 02:40:49AM +0200, Ben Franksen wrote: > > I am also curious whether I'm part of the solution or part of the > > precipitate. I've recently contributed new documentation for > > Data.Foldable and Data.Traversable: > > > > https://dnssec-stats.ant.isi.edu/~viktor/haskell/docs/libraries/base/Data-Foldable.html#g:7 > > https://dnssec-stats.ant.isi.edu/~viktor/haskell/docs/libraries/base/Data-Traversable.html#g:4 > > > > are these a step in the right direction, or examples of more writing > > that sucks? > > Sorry, but IMO it sucks. The main goal of the overview was to help users to be able to reason about the behaviour of the class methods, and be able to choose the correct one of (foldr, foldl, or foldl') without forcing an entire list into memory or needlessly generating a long list of lazy thunks. So I don't think that just saying "toList", done quite does the job. That said, given that there are surely sections of prose that could be better, would you care to submit diffs for inclusion in MR 6555? https://gitlab.haskell.org/ghc/ghc/-/merge_requests/6555 you can check out the branch, and send me diffs? Or is it sufficient to change just the particularly egregious sentences you noted? > They define semantics in a semi-formal notation, which I find succinct > and very intuitive. This can be easily generalized to Foldable via > 'toList'. Indeed, there is almost nothing about Foldable that cannot be > understood once you understand Data.List and the toList method. Even > foldMap is (semantically) just (***): Well a balanced Tree can have an efficient corecursive foldl, or a performant 'foldr`', and Sets can know their size statically, and `elem` runs in linear time even in structures that potentially support faster search. And it is perhaps worth asking whether you feel you still have anything you'd like to learn about Foldable, for if not, perhaps the documentation is not for you, and that's fine... > In fact all class methods have simple semantic definitions in terms of > the same named functions from Data.List via 'toList'. But performance may differ radically, and `toList` may diverge for `snocList` when infinite on the left, though that's a rather pathological example. > Expectations of runtime cost should be either explicitly stated in the > docs for each method or left out. That's not enough if users can't reason about the available choices or don't know how to implement performant instances. Function synopses rarely provide enough room for more than a cursory description and a few examples. That's not their role. This is why Unix manpages have both a SYNOPSIS and a DESCRIPTION section. I am quite open to improved language in the overview, and less open to the idea that it is just baggage to throw overboard. In particular, I've had positive feedback on the material, despite perhaps overly turgid prose in some places. Please help to make it crisp. I find absence of overview (DESCRIPTION if you like) sections in many a non-trivial Haskell library to be quite a barrier to working with the library, the synopses alone are rarely enough for my needs. > The most important documentation for a class, its laws, is (1) not > contained in the class docs, (2) not even linked from there, and (3) too > cryptic. The links are fixed in MR 6555, and I've asked David Feuer to contribute prose to clarify the laws, I also find them rather opaque, and left them as is when I wrote the overview. This is a good opportunity to address issues with the laws. > I would *at least* expect the Monoid newtype wrappers (Endo, > Dual, Sum, Product) and their inverses to be hyperlinked to their > definition. Agreed, and some sort of explanatory text... These are inherited from earlier versions of the module which had only the laws and no overview. > I may be wrong but it looks to me as if this could be derived by adding > one more method 'fromList' that is required to be left inverse of 'toList': > > fromList :: Foldable a => [a] -> t a > fromList . toList = id This is roughly the sort of thing one can do with Traversable (recover the structure from its spine and element list, but not its element list alone). The point is that various non-linear (e.g. tree-like) structures with the same element order have distinct "spines". > Of course, for some Foldables (e.g. those with a fixed finite number of > elements), fromList would be partial. And not well defined without a `t ()` spine into which the elements can be inserted. > Is there a sensible (useful, lawful) Foldable instance which has no > 'fromList'? Sure, any tree-like structure where shape is not implied by the element list alone. > I suspect no. In fact I suspect addition of fromList (with the left > inverse law) would nicely serve to rule out useless/surprising > instances. While I don't love harsh critiques, I do recognise that a harsh criticism can be an source of energy that can be harnessed to good ends. Therefore, if you're willing to apply that energy to improving the text, I'd love to work with you. If you feel the document is beyond repair, I'll be disappointed, but I'm willing to accept that. Thanks for taking the time to look it over. -- Viktor. From ben.franksen at online.de Fri Oct 1 01:42:39 2021 From: ben.franksen at online.de (Ben Franksen) Date: Fri, 1 Oct 2021 03:42:39 +0200 Subject: [Haskell-cafe] Haskell's "historical futurism" needs better writing, not better tools In-Reply-To: References: Message-ID: Am 17.09.21 um 07:15 schrieb Michael Turner: > I might have missed your link to "Monoid" because my attention fell on > "monoid mappend". Sorry for that. > > "The contribution of each element to the final result is combined with an > accumulator via an /operator/ function. The operator may be explicitly > provided by the caller as in `foldr` or may be implicit as in `length`. In > the case of `foldMap`, the caller provides a function mapping each element > into a suitable 'Monoid', which makes it possible to merge the per-element > contributions via that monoid's `mappend` function." > > This is a little better, but I'd write it this way, I think. > > "Folds take operators as arguments. In some cases, it's implicit, as > in the function "length". These operators are applied to elements when > lazy evaluation requires it, with a fold 'accumulator' as one of the > operands. 'foldMap' uses a function (implicit? explicit?) that maps > elements into . . . ." The problem you two are both facing is this: you want to describe, abstractly, generally, the common principle behind an ad-hoc lumped-together set of functions. This is very likely to result in contortions and provides you with no insight. You need to realize that these methods are all simple specializations of two or three basic functions. The only reason they are methods of the class is to allow specialized implementations for optimization. Foldable is a very bad example to learn from. IMO its documentation should only describe 'toList', define foldMap and fold in terms of foldr or foldl, and otherwise refer you to the functions in Data.List. These are documented in simple terms. The best description for foldr I have ever come across is this: "foldr f z l replaces in the list l the data constructors [] and (:) with z and f, respectively." Once you understand the list data type and remember that (:) is right associative, this makes foldr totally obvious. Left folds are a bit less immediately intuitive as they go against the "natural" associativity, but you can think of foldl as being the analogue of foldr for "snoc" lists (lists with cheap addition of elements at the right end), but implemented for normal lists. Once you understand that, everything else are trivial specializations, such as sum = foldl' (+) 0 The only real subtlety is foldl vs. foldl' i.e. lazy vs. strict. This is quite difficult to understand, as it requires to go pretty deep into the evaluation model of Haskell, but for a beginner it suffices to know that you probably want to use foldl'. Once you understand how folds and their various specialisations work for lists, generalizing that knowledge to Foldable structures is trivial: just think Data.Foldable.foldr f z l = Data.List.foldr f z (toList l) etc. Cheers Ben -- I would rather have questions that cannot be answered, than answers that cannot be questioned. -- Richard Feynman From anthony.d.clayden at gmail.com Fri Oct 1 03:06:45 2021 From: anthony.d.clayden at gmail.com (Anthony Clayden) Date: Fri, 1 Oct 2021 16:06:45 +1300 Subject: [Haskell-cafe] Pattern guards seen in the wild? Message-ID: Browsing some docos for a completely other purpose, I came across this code: > f' [x, y] | True <- x, True <- y = True > f' _ = False (In User Guide 6.7.4.5 Matching of Pattern Synonyms.) That business with the comma and left-arrows? They're 'Pattern guards', Language Report 2010 section 3.13. That also specs 'local bindings' introduced by `let`. In 10 years of reading Haskell code, I've never seen them. Does anybody use them? Are they more ergonomic than guards as plain Boolean expressions? Are 'local bindings' any different vs shunting the `let` to the rhs of the `=`? I'd write that code as: > f'' [x at True, y at True] = True > f'' _ = False I can see the rhs of the matching arrow could in general be a more complex expression. But to express that you could put a more complex Boolean guard(?) AntC -------------- next part -------------- An HTML attachment was scrubbed... URL: From ietf-dane at dukhovni.org Fri Oct 1 05:29:16 2021 From: ietf-dane at dukhovni.org (Viktor Dukhovni) Date: Fri, 1 Oct 2021 01:29:16 -0400 Subject: [Haskell-cafe] Pattern guards seen in the wild? In-Reply-To: References: Message-ID: On Fri, Oct 01, 2021 at 04:06:45PM +1300, Anthony Clayden wrote: > Browsing some docos for a completely other purpose, I came across this code: > > > f' [x, y] | True <- x, True <- y = True > > f' _ = False > > (In User Guide 6.7.4.5 Matching of Pattern Synonyms.) A fairly synthetic exmaple... > In 10 years of reading Haskell code, I've never seen them. Does anybody use > them? Are they more ergonomic than guards as plain Boolean expressions? Are > 'local bindings' any different vs shunting the `let` to the rhs of the `=`? The pattern guards in the example are far from compelling as written, but I do regularly use them in I hope more natural contexts. > I'd write that code as: > > > f'' [x at True, y at True] = True > > f'' _ = False Or with no guards at all: f'' [x, y] = x && y f'' _ = False More realistic examples: https://github.com/kazu-yamamoto/dns/blob/master/internal/Network/DNS/Decode/Parsers.hs#L46-L49 Or code to process a possibly not yet complete (to be continued) SMTP greeting: smtpGreeting :: Int -> SmtpReply -> SmtpM B.ByteString smtpGreeting _ r | replyCont r = pure B.empty | code <- replyCode r , code `div` 100 /= 2 = B.empty <$ modify' bail code | otherwise = smtpSendHello where bail code s = s { smtpErr = ProtoErr code $ replyText r } which would otherwise be something like: smtpGreeting :: Int -> SmtpReply -> SmtpM B.ByteString smtpGreeting _ r = if replyCont r then pure B.empty else let code = replyCode r in if code `div` 100 == 2 then smtpSendHello else B.empty <$ modify' bail code where bail code s = s { smtpErr = ProtoErr code $ replyText r } but I find the pattern guard form to read "declarative", with less "if then else" baggage and nesting getting in the way of seeing the essential conditions. -- Viktor. From ietf-dane at dukhovni.org Fri Oct 1 06:41:04 2021 From: ietf-dane at dukhovni.org (Viktor Dukhovni) Date: Fri, 1 Oct 2021 02:41:04 -0400 Subject: [Haskell-cafe] Haskell's "historical futurism" needs better writing, not better tools In-Reply-To: References: Message-ID: On Thu, Sep 30, 2021 at 09:14:36PM -0400, Viktor Dukhovni wrote: > > Is there a sensible (useful, lawful) Foldable instance which has no > > 'fromList'? Another salient counter-example, is the Foldable instance of `Map k`, which sequences only the *values* `v` stored in a `Map k v`, forgetting the keys `k`. There is therefore no: fromList :: [v] -> Map k v that could undo: toList :: Map k v -> [v] and for that we'd need the Map spine (key set) its `Traversable` instance: fromValueList :: Ord k => Map k () -> [a] -> Map k a fromValueList = evalState . traverse f where f :: () -> State [v] v f _ = get >>= \ !s -> head s <$ put (tail s) Basically, containers can have a non-trivial "shape" that `toList` "flattens", so it is a one-way operation. --- Switching subtopics to the "Chirality" section, I added it in response to a criticism that earlier text was inaccurate for structures that do not support efficient left-to-right iteration (if you like, have an inefficient or possibly divergent `toList` that might take a long time or forever to return the left-most element). If there's a general feeling that accepting the suggestion to be more accurate was a mistake, the exposition could indeed be shorter if it were fair to assume that all Foldable structures of interest are "left-handed" (can quickly return the left-most element). And that while one can define structures that violate this assumption, they're not a good fit for Foldable and not worthy of explication. -- Viktor. From anthony.d.clayden at gmail.com Fri Oct 1 07:03:16 2021 From: anthony.d.clayden at gmail.com (Anthony Clayden) Date: Fri, 1 Oct 2021 20:03:16 +1300 Subject: [Haskell-cafe] Pattern guards seen in the wild? Message-ID: Thanks Viktor, you've answered (in the negative) one of my follow-on q's which was: isn't the comma just standing for Boolean `&&` ? > which would otherwise be something like: ... I would go: > smtpGreeting :: Int -> SmtpReply -> SmtpM B.ByteString > smtpGreeting _ r = > | replyCont r = pure B.empty > | code `div` 100 /= 2 = B.empty <$ modify' bail code > | otherwise = smtpSendHello > where > code = replyCode r > bail code s = > s { smtpErr = ProtoErr code $ replyText r } > but I find the pattern guard form to read "declarative", Hmm? Your `code <- ...` left-arrow doesn't look at all declarative to me. It's reminiscent of a binding in a do-block, or a 'source' in a comprehension. Strong imperative/sequential overtones. > with less "if then else" baggage and nesting getting in the way of seeing the essential conditions. My suggestion above also avoids "if then else". I guess a case of de gustibus ... To my taste, GHC Haskell is just too bloated/there's too many (equivalent) ways of writing code/there's too many idioms I have to keep up with to read code. It's not that there's anything particularly 'wrong' with any one of them; it's the sheer number of them. I'd have to say patterns/matching suffer a low power to weight ratio, where 'weight' means syntactic clutter and gotcha's: View pattern arrow-from-nowhere, I'm looking at you; pattern signatures double-forall's, empty forall's, double-constraints, I'm looking at you. -------------- next part -------------- An HTML attachment was scrubbed... URL: From x at tomsmeding.com Fri Oct 1 07:04:21 2021 From: x at tomsmeding.com (Tom Smeding) Date: Fri, 01 Oct 2021 07:04:21 +0000 Subject: [Haskell-cafe] Pattern guards seen in the wild? In-Reply-To: References: Message-ID: <60b6a0c6-c8bc-d0cf-1816-a5c1a24b2b0d@tomsmeding.com> On 01/10/2021 07:29, Viktor Dukhovni wrote: > More realistic examples: > > https://github.com/kazu-yamamoto/dns/blob/master/internal/Network/DNS/Decode/Parsers.hs#L46-L49 > > Or code to process a possibly not yet complete (to be continued) SMTP > greeting: > > smtpGreeting :: Int -> SmtpReply -> SmtpM B.ByteString > smtpGreeting _ r > | replyCont r = pure B.empty > | code <- replyCode r > , code `div` 100 /= 2 = B.empty <$ modify' bail code > | otherwise = smtpSendHello > where > bail code s = > s { smtpErr = ProtoErr code $ replyText r } > [...] > > -- > Viktor. Perhaps redundantly, this particular instance of a pattern guard can, in my opinion, be written slightly less suggestively with a 'let' pattern guard (not sure if that's the right name): [...] | let code = replyCode r , code `div` 100 /= 2 = B.empty <$ modify' bail code [...] Non-'let' pattern guards, in my experience, are most useful in two cases: 1. You want to do some additional pattern matching on a non-boolean value after having arrived in an interesting case in a larger pattern-match. For example, in the request URL parsing code in my pastebin-haskell: (Some cases and additional code elided) parseRequest :: Method -> ByteString -> Maybe WhatRequest parseRequest method path = let comps = BS.split (fromIntegral (ord '/')) (trimSlashes path) in case (method, comps) of (GET, []) -> Just GetIndex (GET, [x]) | canBeKey x -> Just (ReadPaste x) -- [...] (GET, ["paste", x]) | canBeKey x -> Just (ReadPasteOld x) (GET, ["highlight.pack.css"]) -> Just HighlightCSS (GET, [x]) | Just (path', mime) <- List.lookup x staticFiles -> Just (StaticFile mime path') (POST, ["paste"]) -> Just StorePaste _ -> Nothing Original code here: https://github.com/tomsmeding/pastebin-haskell/blob/25de4aa531a782ca8c34b409046b414f655f133c/Main.hs#L197 2. Actually a special case of (1.): this is particularly useful with GADTs and "discovered" type evidence, like in https://github.com/AccelerateHS/accelerate/blob/1ab75f1eb01a1b427563808057d46f29d99bb4dc/src/Data/Array/Accelerate/Prelude.hs#L1429 . In general, these pattern guards seem to me the Haskell version of Agda's with-patterns [1], which also allow pattern matching on an _additional_ value after the first pattern match has already found a branch. - Tom [1]: https://agda.readthedocs.io/en/v2.5.2/language/with-abstraction.html From magnus at therning.org Fri Oct 1 07:02:54 2021 From: magnus at therning.org (Magnus Therning) Date: Fri, 01 Oct 2021 09:02:54 +0200 Subject: [Haskell-cafe] Pattern guards seen in the wild? In-Reply-To: References: Message-ID: <87k0ixmdcn.fsf@therning.org> Anthony Clayden writes: > Browsing some docos for a completely other purpose, I came > across this code: > >> f' [x, y] | True <- x, True <- y = True >> f' _ = False > > (In User Guide 6.7.4.5 Matching of Pattern Synonyms.) > > That business with the comma and left-arrows? They're 'Pattern > guards', Language Report 2010 section 3.13. That also specs > 'local > bindings' introduced by `let`. > > In 10 years of reading Haskell code, I've never seen them. Does > anybody use them? Are they more ergonomic than guards as plain > Boolean > expressions? Are 'local bindings' any different vs shunting the > `let` > to the rhs of the `=`? > > I'd write that code as: > >> f'' [x at True, y at True] = True >> f'' _ = False > > I can see the rhs of the matching arrow could in general be a > more > complex expression. But to express that you could put a more > complex > Boolean guard(?) I've used it occasionally, e.g when dealing with exceptions. I think this is the most recent example: ``` lastExceptionHandler :: LoggerSet -> SomeException -> IO () lastExceptionHandler logger e | Just TimeoutThread <- fromException e = return () | otherwise = do logFatalIoS logger $ pack $ "(ws) uncaught exception: " <> displayException e flushLogStr logger ``` (That's the exception handler I installed with `setUncaughtExceptionHandler` in a web service to deal with https://github.com/yesodweb/wai/issues/852) /M -- Magnus Therning OpenPGP: 0x927912051716CE39 email: magnus at therning.org @magthe at mastodon.technology http://magnus.therning.org/ Action is the foundational key to all success. — Pablo Picasso -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 861 bytes Desc: not available URL: From anthony.d.clayden at gmail.com Fri Oct 1 07:27:15 2021 From: anthony.d.clayden at gmail.com (Anthony Clayden) Date: Fri, 1 Oct 2021 20:27:15 +1300 Subject: [Haskell-cafe] Haskell's "historical futurism" needs better writing, not better tools Message-ID: > Switching subtopics to the "Chirality" section, ... I take Ben's point (with which I agree) to be that "Chirality" is an even more obscure word than "Endomorphism". (Except perhaps in the realm of subatomic particle physics.) Grokking this material is hard enough without having to reach for a dictionary. If you mean 'left-biased' vs 'right-biased', or 'from-front' vs 'from-rear' or 'Cons-oriented' vs 'Snoc-oriented', say that. (And I'll be interested to see how anyone explains this without `fromList` jigging their elbow.) Now I can see Foldable structures are abstract, not spatial. But Cons is recursive on its (textually) right operand, whereas `Bin` or `Node` are symmetric between their (textually) left/right recursive operands. I guessed that's what the Chirality section was talking about, so I skimmed the first sentence and skipped on. -------------- next part -------------- An HTML attachment was scrubbed... URL: From ietf-dane at dukhovni.org Fri Oct 1 07:44:58 2021 From: ietf-dane at dukhovni.org (Viktor Dukhovni) Date: Fri, 1 Oct 2021 03:44:58 -0400 Subject: [Haskell-cafe] Haskell's "historical futurism" needs better writing, not better tools In-Reply-To: References: Message-ID: On Fri, Oct 01, 2021 at 08:27:15PM +1300, Anthony Clayden wrote: > > Switching subtopics to the "Chirality" section, ... > > I take Ben's point (with which I agree) to be that "Chirality" is an even > more obscure word than "Endomorphism". (Except perhaps in the realm of > subatomic particle physics.) The word occurred only in the section title, which will now (MR 6555) read: Expectation of efficient left-to-right iteration > Grokking this material is hard enough without having to reach for a > dictionary. If you mean 'left-biased' vs 'right-biased', or > 'from-front' vs 'from-rear' or 'Cons-oriented' vs 'Snoc-oriented', say > that. (And I'll be interested to see how anyone explains this without > `fromList` jigging their elbow.) Yes, of course. > Now I can see Foldable structures are abstract, not spatial. But Cons is > recursive on its (textually) right operand, whereas `Bin` or `Node` are > symmetric between their (textually) left/right recursive operands. I > guessed that's what the Chirality section was talking about, so I skimmed > the first sentence and skipped on. Skipping material a reader feels they already know is fine, it is there for those who might need it, or just as a signal that, yes, I know that you know ... that some structures like to be more difficult than others. -- Viktor. From lemming at henning-thielemann.de Fri Oct 1 07:53:49 2021 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Fri, 1 Oct 2021 09:53:49 +0200 (CEST) Subject: [Haskell-cafe] Haskell's "historical futurism" needs better writing, not better tools In-Reply-To: References: Message-ID: On Fri, 1 Oct 2021, Viktor Dukhovni wrote: > On Fri, Oct 01, 2021 at 08:27:15PM +1300, Anthony Clayden wrote: >> > Switching subtopics to the "Chirality" section, ... >> >> I take Ben's point (with which I agree) to be that "Chirality" is an even >> more obscure word than "Endomorphism". (Except perhaps in the realm of >> subatomic particle physics.) > > The word occurred only in the section title, which will now (MR 6555) read: > > Expectation of efficient left-to-right iteration It seems that the thread has shifted from "historical futurism" to "documentation of Foldable". From tom-lists-haskell-cafe-2017 at jaguarpaw.co.uk Fri Oct 1 09:05:30 2021 From: tom-lists-haskell-cafe-2017 at jaguarpaw.co.uk (Tom Ellis) Date: Fri, 1 Oct 2021 10:05:30 +0100 Subject: [Haskell-cafe] Haskell's "historical futurism" needs better writing, not better tools In-Reply-To: References: Message-ID: <20211001090530.GR15868@cloudinit-builder> On Thu, Sep 30, 2021 at 09:14:36PM -0400, Viktor Dukhovni wrote: > > In fact all class methods have simple semantic definitions in terms of > > the same named functions from Data.List via 'toList'. > > But performance may differ radically, and `toList` may diverge for > `snocList` when infinite on the left, though that's a rather > pathological example. If one can't write Foldable-generic functionality in a way that provides some reasonable uniformity of performance over different instances then one wonders what is point of having Foldable as a typeclass at all. At that point it's just name overloading. Tom From ietf-dane at dukhovni.org Fri Oct 1 09:24:30 2021 From: ietf-dane at dukhovni.org (Viktor Dukhovni) Date: Fri, 1 Oct 2021 05:24:30 -0400 Subject: [Haskell-cafe] Improving the docs (specifically Data.Foldable) In-Reply-To: <20211001090530.GR15868@cloudinit-builder> References: <20211001090530.GR15868@cloudinit-builder> Message-ID: On Fri, Oct 01, 2021 at 10:05:30AM +0100, Tom Ellis wrote: > > But performance may differ radically, and `toList` may diverge for > > `snocList` when infinite on the left, though that's a rather > > pathological example. > > If one can't write Foldable-generic functionality in a way that > provides some reasonable uniformity of performance over different > instances then one wonders what is point of having Foldable as a > typeclass at all. At that point it's just name overloading. This is why I was reluctant originally to say anything about right-biased structures... They break established expectations. I focused mostly on symmetric structures, for which left and right folds should perform identically (if instances properly take advantage of the symmetry), these are I think practical. About right-biased structures I said: https://dnssec-stats.ant.isi.edu/~viktor/haskell/docs/libraries/base/Data-Foldable.html#g:8 Finally, in some less common structures (e.g. snoc lists) right to left iterations are cheaper than left to right. Such structures are poor candidates for a Foldable instance, and are perhaps best handled via their type-specific interfaces. If nevertheless a Foldable instance is provided, the material in the sections that follow applies to these also, by replacing each method with one with the opposite associativity (when available) and switching the order of arguments in the fold's operator. Concrete suggestions to address any issues in this section (now that the title is no longer "Chirality") are welcome (MR 6555). https://gitlab.haskell.org/ghc/ghc/-/merge_requests/6555 -- Viktor. From david.feuer at gmail.com Fri Oct 1 09:35:41 2021 From: david.feuer at gmail.com (David Feuer) Date: Fri, 1 Oct 2021 05:35:41 -0400 Subject: [Haskell-cafe] Improving the docs (specifically Data.Foldable) In-Reply-To: References: <20211001090530.GR15868@cloudinit-builder> Message-ID: Right-biased Foldable instances are perfectly reasonable. Just don't expect fromList, foldr, or foldl' to be good for them. On Fri, Oct 1, 2021, 5:27 AM Viktor Dukhovni wrote: > On Fri, Oct 01, 2021 at 10:05:30AM +0100, Tom Ellis wrote: > > > > But performance may differ radically, and `toList` may diverge for > > > `snocList` when infinite on the left, though that's a rather > > > pathological example. > > > > If one can't write Foldable-generic functionality in a way that > > provides some reasonable uniformity of performance over different > > instances then one wonders what is point of having Foldable as a > > typeclass at all. At that point it's just name overloading. > > This is why I was reluctant originally to say anything about > right-biased structures... They break established expectations. > > I focused mostly on symmetric structures, for which left and right folds > should perform identically (if instances properly take advantage of the > symmetry), these are I think practical. About right-biased structures I > said: > > > https://dnssec-stats.ant.isi.edu/~viktor/haskell/docs/libraries/base/Data-Foldable.html#g:8 > > Finally, in some less common structures (e.g. snoc lists) right > to left iterations are cheaper than left to right. Such > structures are poor candidates for a Foldable instance, and are > perhaps best handled via their type-specific interfaces. If > nevertheless a Foldable instance is provided, the material in > the sections that follow applies to these also, by replacing > each method with one with the opposite associativity (when > available) and switching the order of arguments in the fold's > operator. > > Concrete suggestions to address any issues in this section (now that the > title is no longer "Chirality") are welcome (MR 6555). > > https://gitlab.haskell.org/ghc/ghc/-/merge_requests/6555 > > -- > Viktor. > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From ben.franksen at online.de Fri Oct 1 09:52:53 2021 From: ben.franksen at online.de (Ben Franksen) Date: Fri, 1 Oct 2021 11:52:53 +0200 Subject: [Haskell-cafe] Haskell's "historical futurism" needs better writing, not better tools In-Reply-To: References: Message-ID: Am 01.10.21 um 03:14 schrieb Viktor Dukhovni: > On Fri, Oct 01, 2021 at 02:40:49AM +0200, Ben Franksen wrote: >> They define semantics in a semi-formal notation, which I find succinct >> and very intuitive. This can be easily generalized to Foldable via >> 'toList'. Indeed, there is almost nothing about Foldable that cannot be >> understood once you understand Data.List and the toList method. Even >> foldMap is (semantically) just (***): > > Well a balanced Tree can have an efficient corecursive foldl, or a > performant 'foldr`', and Sets can know their size statically, and `elem` > runs in linear time even in structures that potentially support faster > search. All true, and I think it is important to document these things. The question is: where? This is a general problem with all kinds of generic "container" classes/interfaces, and not limited to Haskell: performance characteristics of methods will vary widely depending on the implementation. In Haskell this includes semantics insofar as bottom / infinite structures are concerned. Documenting the API /itself/ can go only so far before becoming a manual enumeration of all possible implementations one can think of or happens to know about. This clearly doesn't scale, so it would be better to leave it unspecified and attach such documentation to the instances instead. It would help if rendering of instance docs in haddock were improved (as sub-paragraph under the instance instead of to the right of it). > And it is perhaps worth asking whether you feel you still have anything > you'd like to learn about Foldable, for if not, perhaps the > documentation is not for you, and that's fine... I may have earned this remark with the tone of my critique ;-) In case it came over as condescending, please accept my apologies. >> In fact all class methods have simple semantic definitions in terms of >> the same named functions from Data.List via 'toList'. > > But performance may differ radically, and `toList` may diverge for > `snocList` when infinite on the left, though that's a rather > pathological example. > >> Expectations of runtime cost should be either explicitly stated in the >> docs for each method or left out. > > That's not enough if users can't reason about the available choices or > don't know how to implement performant instances. The truth is (and that is what the docs imply but fail to make explicit as that would be too embarrasing): you *cannot* reason about these things. If the implementation (instance) is free to choose whether foldr or foldl is the "natural" fold, then how can I make an informed choice between them for an arbitrary Foldable? If we were to define the semantics in terms of 'toList', then we would acknowledge that Foldable is biased in the same direction as lists are, so behavior would no longer be implementation defined and could be easily reasoned about. > Function synopses > rarely provide enough room for more than a cursory description and > a few examples. That's not their role. This is why Unix manpages > have both a SYNOPSIS and a DESCRIPTION section. > > I am quite open to improved language in the overview, and less open to > the idea that it is just baggage to throw overboard. In particular, > I've had positive feedback on the material, despite perhaps overly > turgid prose in some places. Please help to make it crisp. > > I find absence of overview (DESCRIPTION if you like) sections in many a > non-trivial Haskell library to be quite a barrier to working with the > library, the synopses alone are rarely enough for my needs. I agree. I do like (not too verbose) introduction of concepts when reading docs of a new module. See below for a proposal. >> I may be wrong but it looks to me as if this could be derived by adding >> one more method 'fromList' that is required to be left inverse of 'toList': >> >> fromList :: Foldable a => [a] -> t a >> fromList . toList = id > > This is roughly the sort of thing one can do with Traversable (recover > the structure from its spine and element list, but not its element list > alone). The point is that various non-linear (e.g. tree-like) > structures with the same element order have distinct "spines". [...] >> Is there a sensible (useful, lawful) Foldable instance which has no >> 'fromList'? > > Sure, any tree-like structure where shape is not implied by the element > list alone. Sorry, you are right, of course. I wasn't thinking clearly. Regarding me helping to improve the docs: I have made concrete proposals to re-word the descriptions. But I really think that a large part of the documentation you added comes down to saying: """ As specified, this class is mostly useless, since it does not allow you to reason about the choice of methods (e.g. 'foldr' vs. 'foldl') to use when working with a generic Foldable container. To make this choice, you have to make assumptions about whether it is left-leaning (like lists) or right-leaning (like snoc-lists) or neither (unbiased). The usual assumption is that it is right-leaning or unbiased. This means that all methods can be considered as being defined, semantically, using 'toList' and the corresponding function with the same name from Data.List. (For fold and foldMap, see their default definitions). If you can assume the element type is a Monoid, you can get away by using only the unbiased functions 'fold' and 'foldMap'. This leaves the choice of implementation strategy to the container (instance). """ Cheers Ben -- I would rather have questions that cannot be answered, than answers that cannot be questioned. -- Richard Feynman From ben.franksen at online.de Fri Oct 1 10:34:21 2021 From: ben.franksen at online.de (Ben Franksen) Date: Fri, 1 Oct 2021 12:34:21 +0200 Subject: [Haskell-cafe] Haskell's "historical futurism" needs better writing, not better tools In-Reply-To: References: <010f017beeed148e-35512a1d-0412-45c5-b1ac-ca532fa70f72-000000@us-east-2.amazonses.com> Message-ID: Lambda calculus is a red herring. I don't think it helps a beginner, especially not one who is proficient in various imperative languages. I fully agree with Michael's critique of most popular writings about Haskell. Much of it is riddled with poorly veiled attempts to *sell* Haskell to the reader, instead of clearly explaining how it is just *different*. The choices Haskell makes can be justified, but they also have drawbacks. It is necessary to have knowledge about how Haskell before discussing these matters in a useful way. The right approach to teach beginners is to ask them to suspend judgement. Tell them to just believe that there are reasons why things are how they are (even if it happens to be mere historical inertia). I started teaching myself Haskell at a time when "A gentle introduction to Haskell" was more or less the only available tutorial. I found it fascinating, even though, or perhaps because, I didn't understand anything at first. I kept wondering "but how can I *do* something with this"? It seemed utterly impractical for any "real world" programming. And yet, I could not help admiring the elegance of what was described, so I kept coming back, until it finally clicked and I began to understand. Cheers Ben Am 17.09.21 um 01:32 schrieb Anthony Clayden: > Thank you Richard, I'm quite comfortable with discussing in public whether > my response was appropriate. > > Michael might as well observe early that there's a broad range of views as > to how best to learn Haskell. (And every reason that what works for some > doesn't work for others.) I was sharing my experience. I was also drawing > on observations of q's on StackOverflow, for which there's an > alarming number who think Haskell is just C/C++ spelled funny. (Take the > very first [Haskell] q right now.) > > Learning by 'mentally executing' programs is a workable approach -- but not > if your mental model of execution is a Turing machine. > > And I was observing Michael's actual q on the Beginners list. It's clear to > me: > > * He's trying to translate Haskell to C/C++. > * He thinks Lambda calculus is 'advanced'/complicated/beyond a beginner. > * He hasn't tried Lambda calculus/he didn't say it "wasn't helpful for him". > * He thinks that already knowing a swag of procedural/OOP languages will > help with learning Haskell. > > I'd say all of those are unhelpful blocks to learning. > > Perhaps in my personal 'learning journey' it helped that I was profoundly > dissatisfied with procedural languages (of which I'd worked in over a > dozen); and that I fell across Backus' 'Can Programming be liberated ...?', > then Lambda calculus, before I landed on an actual implementation of those > ideas in Haskell. > > And for sure, my learning approach left me with some misconceptions, that > Richard and others have patiently untangled. > > AntC > > On Fri, 17 Sept 2021 at 02:05, Richard Eisenberg wrote: > >> I just want to pipe up and say I'm not comfortable with this response. >> When I feel this way about writing on a forum, I normally contact the >> author in private, but I think posting publicly here has its merits. I'm >> hoping that the long correspondence AntC and I have had -- often with >> opposing viewpoints but with mutual respect -- with withstand this email. >> >> Michael posted here expressing frustration with his experience learning >> and using Haskell. In my opinion, he has spent too much time reading older >> papers, written by experts for experts -- which Michael is not. I do not >> fault Michael for this: these resources are sometimes what appear when >> searching, and we as a community have done a poor job marshaling our >> educational resources. (Michael, I just thought of a resource you might >> find useful: http://dev.stephendiehl.com/hask/ is an oft-linked resource >> attempting to do that marshaling. I am not vouching for it here, per se, >> but I know others have found it useful.) >> >> However, Michael very specifically said that "just learn lambda-calculus" >> was not helpful for him, and so I think it's unhelpful for someone to >> respond with "just learn lambda-calculus". There are a number of other >> statements in the email below which could be seen as belittling -- also not >> helpful. >> >> ... >> >> In the meantime, I implore us to take all expressed experiences as exactly >> that: the experience of the person writing. And if they say they don't want >> X, please let's not feed them X. :) >> >> Richard >> >> On Sep 16, 2021, at 12:53 AM, Anthony Clayden >> wrote: >> >> Hi Michael, oh dear, oh dear, oh dear. >> >> The seeds of your confusion are very evident from your message. How to >> back you out of whatever deep rabbit-hole you've managed to get your head >> into? >> >>> ... Your average reader (already a programmer) would be better served >> by a comparative approach: Here's how to say something in a couple of >> other programming languages, here's how to say something roughly >> equivalent in Haskell -- BUT, here's how it's subtly different in Haskell. >> >> No. Just no. Haskell is not "subtly different" to (say) Java in the way >> that C++ or C# are different. (I'll leave others to judge how subtly >> different they are.) >> >> Haskell is dramatically and fundamentally different. You can't just >> 'translate' an algorithm from OOP to Haskell. Many newbies try, and there's >> many tales of woe on StackOverflow. Just No. >> >> I really don't know how you could have got any experience with Haskell and >> say "subtly". >> >> I suggest you unlearn everything you think you know about Haskell, and >> strike out in an entirely different direction. The best approach would be >> to spend a few days playing with lambda calculus. (That's what I did before >> tackling Haskell.) >> ... >> >> > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -- I would rather have questions that cannot be answered, than answers that cannot be questioned. -- Richard Feynman From anthony.d.clayden at gmail.com Fri Oct 1 10:48:29 2021 From: anthony.d.clayden at gmail.com (Anthony Clayden) Date: Fri, 1 Oct 2021 23:48:29 +1300 Subject: [Haskell-cafe] Pattern guards seen in the wild? Message-ID: Thank you all for the examples. Hehe real-world data structures are messy. Especially if dictated by systems utilities that don't care for functional programming. In the back of my mind is: do these idioms date from before there were pattern synonyms? Would matching to a pattern synonym give clearer code in the case branching? (Would it be worth declaring a synonym for just one usage?) There's only one of those examples where I feel expressing without the Pattern guard would be awkward. Tom's example 1., whose characteristics are: * There's a long straggly sequence of matchers; * With a particularly awkward branch in the middle, needing sub-analysis of a _component_ of the scrutinee, and only if such a component is present; * If the sub-analysis fails to match, the logic must unnest itself and resume matching at the next branch of the straggle. The awkward branch (slightly reformatted) is > (GET, [x]) | Just (path', mime) <- List.lookup x staticFiles > -> Just (StaticFile mime path') `staticFiles` is a module-wide variable, so matching is looking outside the scrutinee, therefore couldn't be expressed as a pattern synonym. The `lookup` might return a `Nothing`, so the inner pattern match could fail/this is doing more than a 'local binding' with `let`, which "always succeed" says the Language Report. -------------- next part -------------- An HTML attachment was scrubbed... URL: From keith.wygant at gmail.com Fri Oct 1 11:53:07 2021 From: keith.wygant at gmail.com (Keith) Date: Fri, 01 Oct 2021 11:53:07 +0000 Subject: [Haskell-cafe] Cabal or stack in 2021 ? In-Reply-To: References: Message-ID: <028FC53C-B8C2-4441-8647-5F1D7C7C955E@gmail.com> Stack is broken in WSL1, but I can use an older cabal just fine. So now I work on the same projects with stack on my linux laptop and cabal on my Windows desktop. -- Keith Sent from my phone with K-9 Mail. On 18 September 2021 18:52:24 UTC, Alexis Praga wrote: >Hi, > >As an intermediate beginner, I've been back into Haskell for the last >months for a small project, using stack as the building tool. > >Why stack ? A few years back, I learned that it was the "best" way to build >projects to avoid "cabal hell", which I understood at the time as >"managing dependencies with cabal is hard". > >As such, I've use stack since and have been quite happy with it. The >only drawback is that building a project can be quite long. > >This is usually not a problem, except for writing Haskell scripts using >shelly (for example), where the stack layout is a bit impractical for >fast-paced development. A solution is to use `runghc` or a script >interpreter [1]. > >However, I've seen some projects where cabal is used to build directly >instead of cabal, so it looks like the situation improved. > >My question is this: in 2021, is there a reason to switch back to cabal ? > >Thanks, > >[1] https://www.fpcomplete.com/haskell/tutorial/stack-script/ > > >-- > > Alexis Praga -------------- next part -------------- An HTML attachment was scrubbed... URL: From keith.wygant at gmail.com Fri Oct 1 12:30:34 2021 From: keith.wygant at gmail.com (Keith) Date: Fri, 01 Oct 2021 12:30:34 +0000 Subject: [Haskell-cafe] Haskell's "historical futurism" needs better writing, not better tools In-Reply-To: References: Message-ID: <7EF1A2D9-6940-432A-A9E4-56A32346818F@gmail.com> When you're writing generically for Foldable, if you want consistent big-O performance, use `foldMap` or `foldMap'`to project to a Monoid that is ideal for how you want to consume the structure, and suck up the larger constant factors. If you want the best performance for any structure, use the specialized methods (`sum`, `elem`, &c.). And if you're consuming the structure in an intrinsically biased way, use an intrinsically biased fold. -- Keith Sent from my phone with K-9 Mail. On 1 October 2021 09:52:53 UTC, Ben Franksen wrote: >Am 01.10.21 um 03:14 schrieb Viktor Dukhovni: >> On Fri, Oct 01, 2021 at 02:40:49AM +0200, Ben Franksen wrote: >>> They define semantics in a semi-formal notation, which I find succinct >>> and very intuitive. This can be easily generalized to Foldable via >>> 'toList'. Indeed, there is almost nothing about Foldable that cannot be >>> understood once you understand Data.List and the toList method. Even >>> foldMap is (semantically) just (***): >> >> Well a balanced Tree can have an efficient corecursive foldl, or a >> performant 'foldr`', and Sets can know their size statically, and `elem` >> runs in linear time even in structures that potentially support faster >> search. > >All true, and I think it is important to document these things. The >question is: where? > >This is a general problem with all kinds of generic "container" >classes/interfaces, and not limited to Haskell: performance >characteristics of methods will vary widely depending on the >implementation. In Haskell this includes semantics insofar as bottom / >infinite structures are concerned. > >Documenting the API /itself/ can go only so far before becoming a manual >enumeration of all possible implementations one can think of or happens >to know about. This clearly doesn't scale, so it would be better to >leave it unspecified and attach such documentation to the instances instead. > >It would help if rendering of instance docs in haddock were improved (as >sub-paragraph under the instance instead of to the right of it). > >> And it is perhaps worth asking whether you feel you still have anything >> you'd like to learn about Foldable, for if not, perhaps the >> documentation is not for you, and that's fine... > >I may have earned this remark with the tone of my critique ;-) In case >it came over as condescending, please accept my apologies. > >>> In fact all class methods have simple semantic definitions in terms of >>> the same named functions from Data.List via 'toList'. >> >> But performance may differ radically, and `toList` may diverge for >> `snocList` when infinite on the left, though that's a rather >> pathological example. >> >>> Expectations of runtime cost should be either explicitly stated in the >>> docs for each method or left out. >> >> That's not enough if users can't reason about the available choices or >> don't know how to implement performant instances. > >The truth is (and that is what the docs imply but fail to make explicit >as that would be too embarrasing): you *cannot* reason about these >things. If the implementation (instance) is free to choose whether >foldr or foldl is the "natural" fold, then how can I make an informed >choice between them for an arbitrary Foldable? > >If we were to define the semantics in terms of 'toList', then we would >acknowledge that Foldable is biased in the same direction as lists are, >so behavior would no longer be implementation defined and could be >easily reasoned about. > >> Function synopses >> rarely provide enough room for more than a cursory description and >> a few examples. That's not their role. This is why Unix manpages >> have both a SYNOPSIS and a DESCRIPTION section. >> >> I am quite open to improved language in the overview, and less open to >> the idea that it is just baggage to throw overboard. In particular, >> I've had positive feedback on the material, despite perhaps overly >> turgid prose in some places. Please help to make it crisp. >> >> I find absence of overview (DESCRIPTION if you like) sections in many a >> non-trivial Haskell library to be quite a barrier to working with the >> library, the synopses alone are rarely enough for my needs. > >I agree. I do like (not too verbose) introduction of concepts when >reading docs of a new module. See below for a proposal. > >>> I may be wrong but it looks to me as if this could be derived by adding >>> one more method 'fromList' that is required to be left inverse of 'toList': >>> >>> fromList :: Foldable a => [a] -> t a >>> fromList . toList = id >> >> This is roughly the sort of thing one can do with Traversable (recover >> the structure from its spine and element list, but not its element list >> alone). The point is that various non-linear (e.g. tree-like) >> structures with the same element order have distinct "spines". >[...] >>> Is there a sensible (useful, lawful) Foldable instance which has no >>> 'fromList'? >> >> Sure, any tree-like structure where shape is not implied by the element >> list alone. > >Sorry, you are right, of course. I wasn't thinking clearly. > >Regarding me helping to improve the docs: I have made concrete proposals >to re-word the descriptions. But I really think that a large part of the >documentation you added comes down to saying: > >""" >As specified, this class is mostly useless, since it does not allow you >to reason about the choice of methods (e.g. 'foldr' vs. 'foldl') to use >when working with a generic Foldable container. To make this choice, you >have to make assumptions about whether it is left-leaning (like lists) >or right-leaning (like snoc-lists) or neither (unbiased). The usual >assumption is that it is right-leaning or unbiased. This means that all >methods can be considered as being defined, semantically, using 'toList' >and the corresponding function with the same name from Data.List. (For >fold and foldMap, see their default definitions). > >If you can assume the element type is a Monoid, you can get away by >using only the unbiased functions 'fold' and 'foldMap'. This leaves the >choice of implementation strategy to the container (instance). >""" > >Cheers >Ben >-- >I would rather have questions that cannot be answered, than answers that >cannot be questioned. -- Richard Feynman > > >_______________________________________________ >Haskell-Cafe mailing list >To (un)subscribe, modify options or view archives go to: >http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From dominik.schrempf at gmail.com Fri Oct 1 13:01:38 2021 From: dominik.schrempf at gmail.com (Dominik Schrempf) Date: Fri, 01 Oct 2021 15:01:38 +0200 Subject: [Haskell-cafe] Cabal or stack in 2021 ? In-Reply-To: <028FC53C-B8C2-4441-8647-5F1D7C7C955E@gmail.com> References: <028FC53C-B8C2-4441-8647-5F1D7C7C955E@gmail.com> Message-ID: <87bl48zyhh.fsf@gmail.com> I have the opposite problem, in a way. I use cabal-install on my personal computer because it is just much faster, mostly because it uses libraries installed system-wide. However, I use Stack on remote servers because it takes care of installing GHC for me… Personally I would prefer one solution a la `cargo`. Dominik -------------- next part -------------- An HTML attachment was scrubbed... URL: From djsamperi at gmail.com Fri Oct 1 15:23:45 2021 From: djsamperi at gmail.com (Dominick Samperi) Date: Fri, 1 Oct 2021 11:23:45 -0400 Subject: [Haskell-cafe] Stack lock issue Message-ID: Hi, Stack install does its thing in some hashed directory under .stack-work by default, but I want to write to /bin as part of the configure process. I'm trying to do this as follows: -- configure file contains: cd $(stack path --project-root) echo "..." > .bin/foo.sh cd - > cd > stack install I'm doing this under Windows with the born shell in my path. Problem: the use of stack to find the project-root directory is blocked waiting for the outer stack to terminate! This may have something to do with Windows "Device or resource busy" lock. Is there a better way? Thanks, Dominick Virus-free. www.avg.com <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> -------------- next part -------------- An HTML attachment was scrubbed... URL: From ietf-dane at dukhovni.org Fri Oct 1 17:43:26 2021 From: ietf-dane at dukhovni.org (Viktor Dukhovni) Date: Fri, 1 Oct 2021 13:43:26 -0400 Subject: [Haskell-cafe] Improving the docs (specifically Data.Foldable) In-Reply-To: References: Message-ID: On Fri, Oct 01, 2021 at 11:52:53AM +0200, Ben Franksen wrote: > > Well a balanced Tree can have an efficient corecursive foldl, or a > > performant 'foldr`', and Sets can know their size statically, and `elem` > > runs in linear time even in structures that potentially support faster > > search. > > All true, and I think it is important to document these things. The > question is: where? I disagree that everything one should know about Data.Foldable is adequately described in Data.List. At least not without a new overview for Data.List that would cover some of the same ground in that specialised context, and could then be imported by reference. A reader who wants to better understand folds should learn the difference between strict reduction and corecursion, and certainly Data.List is not the best place to discuss tips for construction of Foldable instances. Perhaps the overview could start with a concise version that explains thinking about folds in terms of lists, and notes quickly that one cat typically get by with understanding "foldr", "foldl'" and foldMap. But ultimately one should understand why foldl', how to define instances, why `elem` is stuck doing linear lookup for `Set`, ... Would you like to contribute the "short version" introductory text for the impatient? Different readers will come to the documentation for different needs, most will come for just the synopses, and won't read the Overview, that's fine. If there's a need for a shorter blurb, please contribute. Perhaps the best path forward is to get MR 6555 done and dusted, and then additional MRs can be filed on top of that by those who'd like to see further improvements? -- Viktor. From anthony.d.clayden at gmail.com Sat Oct 2 06:22:29 2021 From: anthony.d.clayden at gmail.com (Anthony Clayden) Date: Sat, 2 Oct 2021 19:22:29 +1300 Subject: [Haskell-cafe] Improving the docs (specifically Data.Foldable) Message-ID: At *Fri Oct 1 01:42:39 UTC 2021* Ben Franksen wrote >> Am 17.09.21 um 07:15 schrieb Michael Turner:>> >>* "The contribution of each element to the final result is combined with an *>>* accumulator via an /operator/ function. The operator may be explicitly *>>* provided by the caller as in `foldr` or may be implicit as in `length`. In *>>* the case of `foldMap`, the caller provides a function mapping each element *>>* into a suitable 'Monoid', which makes it possible to merge the per-element *>>* contributions via that monoid's `mappend` function." *> >>* This is a little better, but I'd write it this way, I think. *>> >>* "Folds take operators as arguments. In some cases, it's implicit, as *>>* in the function "length". These operators are applied to elements when *>>* lazy evaluation requires it, with a fold 'accumulator' as one of the *>>* operands. 'foldMap' uses a function (implicit? explicit?) that maps *>>* elements into . . . ." * > The problem you two are both facing is this: you want to describe, > abstractly, generally, the common principle behind an ad-hoc > lumped-together set of functions. This is very likely to result in > contortions and provides you with no insight. I think neither "ad-hoc" nor "lumped-together" is accurate. For both `Functor t` and `Foldable t` the metaphor is `t` as container. * For `Functor` we wish to preserve the shape/spine and mangle each element irrespective of other content. * For `Foldable` we wish to throw away the shape/spine and return some characteristic of the contents-as-a-whole. (The fold is possibly returning another container/contents, but it won't necessarily be the same `t`; even if it is, the result won't be the same shape/spine.) There are some frequent use-cases for "characteristic of the contents-as-a-whole": count, sum, min/max, is-element. So it makes sense to provide (possibly optimised) methods. Yes the insight is that there's a common principle. But the optimising devil is in the detail. The devilish detail is that although we're going to throw away the shape/spine, knowing its organising principle will help navigating it effectively. Otherwise we could stick with List as container -- but as Ref [1] points out, that's hardly ever wise. For somebody coming to the docos to generate their own `instance Foldable`, thinking in terms of `toList` might help in getting the right result; it won't explain why they'd want to use something other than a List. -------------- next part -------------- An HTML attachment was scrubbed... URL: From tom-lists-haskell-cafe-2017 at jaguarpaw.co.uk Sat Oct 2 13:58:01 2021 From: tom-lists-haskell-cafe-2017 at jaguarpaw.co.uk (Tom Ellis) Date: Sat, 2 Oct 2021 14:58:01 +0100 Subject: [Haskell-cafe] Seeking community input on change to Haskell.org Downloads page Message-ID: <20211002135801.GA25169@cloudinit-builder> The Haskell.org committee is considering a change to the [Haskell.org Downloads page]. The change is being reviewed in a [GitHub PR]. The specifics of the change are to replace Chocolatey with ghcup as the preferred installation method of GHC, cabal-install and haskell-language-server on Windows. The overall effect is that the install instructions become common over Windows, Linux and MacOS. The Chocolatey install method is mentioned further down the page. (The PR does not impinge on Stack. The Stack instructions remain unchanged.) The committee would welcome input from any interested parties, particularly those who have familiarity with Chocolatey, or ghcup on Windows, or both. You are welcome to comment on the [PR itself][GitHub PR] (or this thread if absolutely necessary). Thanks to @bodigrim for the PR. [Haskell.org Downloads page]: https://www.haskell.org/downloads/ [GitHub PR]: https://github.com/haskell-infra/www.haskell.org/pull/125 From branimir.maksimovic at gmail.com Sat Oct 2 14:19:56 2021 From: branimir.maksimovic at gmail.com (Branimir Maksimovic) Date: Sat, 2 Oct 2021 16:19:56 +0200 Subject: [Haskell-cafe] Seeking community input on change to Haskell.org Downloads page In-Reply-To: <20211002135801.GA25169@cloudinit-builder> References: <20211002135801.GA25169@cloudinit-builder> Message-ID: <71959D0E-1C08-41A5-A130-4C11F01B26DA@gmail.com> Go for it, absolute support of mine for that! Greets, Branimir. > On 02.10.2021., at 15:58, Tom Ellis wrote: > > The Haskell.org committee is considering a change to the [Haskell.org > Downloads page]. The change is being reviewed in a [GitHub PR]. > > The specifics of the change are to replace Chocolatey with ghcup as > the preferred installation method of GHC, cabal-install and > haskell-language-server on Windows. The overall effect is that the > install instructions become common over Windows, Linux and MacOS. The > Chocolatey install method is mentioned further down the page. (The PR > does not impinge on Stack. The Stack instructions remain unchanged.) > > The committee would welcome input from any interested parties, > particularly those who have familiarity with Chocolatey, or ghcup on > Windows, or both. You are welcome to comment on the [PR itself][GitHub > PR] (or this thread if absolutely necessary). > > Thanks to @bodigrim for the PR. > > [Haskell.org Downloads page]: https://www.haskell.org/downloads/ > [GitHub PR]: > https://github.com/haskell-infra/www.haskell.org/pull/125 > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From ietf-dane at dukhovni.org Sat Oct 2 19:01:37 2021 From: ietf-dane at dukhovni.org (Viktor Dukhovni) Date: Sat, 2 Oct 2021 15:01:37 -0400 Subject: [Haskell-cafe] Improving the docs (specifically Data.Foldable) In-Reply-To: References: Message-ID: On Sat, Oct 02, 2021 at 07:22:29PM +1300, Anthony Clayden wrote: > > The problem you two are both facing is this: you want to describe, > > abstractly, generally, the common principle behind an ad-hoc > > lumped-together set of functions. This is very likely to result in > > contortions and provides you with no insight. > > I think neither "ad-hoc" nor "lumped-together" is accurate. > > For both `Functor t` and `Foldable t` the metaphor is `t` as container. > > * For `Functor` we wish to preserve the shape/spine and mangle each > element irrespective of other content. > > * For `Foldable` we wish to throw away the shape/spine and return some > characteristic of the contents-as-a-whole. > > (The fold is possibly returning another container/contents, but it > won't necessarily be the same `t`; even if it is, the result won't be > the same shape/spine.) This a nice concise summary. Do you think it would be helpful to say something based on this in the Foldable overview documentation. We could even attempt to say something along these lines in Traversable, where we keep the shape spine like in Functor, but get to thread Applicative "effects" as we go, and so can end up with zero or more than one copy of the structure when all's said and done. The "effects" can involve state, and so how a element is mapped could depend on prior elements. Traversable structures `t a` can be recovered from their shape/spine `t ()` and element list `[a]`. -- Viktor. {-# LANGUAGE ScopedTypeVariables #-} import Control.Monad.State.Strict import Control.Monad.Trans.Class import Data.Functor.Identity (Identity(..)) import Data.Coerce import qualified Data.List as L -- | Combine a spine @t ()@ and its element list to yield @t a at . -- Returns `Nothing` when the element count does not match the spine recomp :: forall t a. Traversable t => (t (), [a]) -> Maybe (t a) recomp (ta, s) = runStateT (traverse f ta) s >>= (<$) <$> fst <*> guard . null . snd where f :: () -> StateT [a] Maybe a f _ = get >>= lift . L.uncons >>= (<$) <$> fst <*> put . snd -- | Transform @t a@ to its spine @t ()@ and its element list @[a]@ decomp :: forall a t. Traversable t => t a -> (t (), [a]) decomp = go where go :: t a -> (t (), [a]) go t = reverse <$> coerce (traverse @t @(State [a]) @a @()) f t z where f :: a -> State [a] () f = modify . (:) z = [] :: [a] From anka.213 at gmail.com Sun Oct 3 05:04:26 2021 From: anka.213 at gmail.com (=?utf-8?Q?Andreas_K=C3=A4llberg?=) Date: Sun, 3 Oct 2021 13:04:26 +0800 Subject: [Haskell-cafe] Examples of Continuation monad that impossible to understand and maintain? In-Reply-To: References: <6E7245AA-AC07-4B68-BFBE-A1B012A8303F@icloud.com> <40C9B7EE-3F6F-4A63-AEDA-E1B9B4E02C37@mac.com> <1DDE28D3-0BAC-4B09-9286-D6106BC2C8E8@icloud.com> Message-ID: You can even implement goto on top of Cont. See for example this: https://www.reddit.com/r/haskell/comments/1jk06q/goto_in_haskell/ > On 1 Sep 2021, at 15:55, Isaac Elliott wrote: > > I don't have any examples. Given that Cont essentially implements unstructured control flow, I think that examples of `goto` misuse would apply by analogy. > > On Wed, 1 Sep 2021, 4:31 pm YueCompl via Haskell-Cafe, > wrote: > I can understand the purpose if it is advising against overusing surface syntax in CPS, but here the approach is to hide continuation beneath the beloved do notation on the surface, and monad laws plus possibly further laws to be added, will make it safer to program programs by end programmers. > > I do realize CPS is powerful yet dangerous (unsafe), abuse of CPS could be easy and quite unintentional, but what about abuse of "Continuation monad"? > >> On 2021-08-31, at 22:46, Jeff Clites via Haskell-Cafe > wrote: >> >> Based on the preceding paragraph, I think that by “abuse” it means overuse, as in using CPS when you could have used straightforward code. I can imagine someone doing at the source code level the sort of things that would be done by a CPS-based compiler (converting everything possible to CPS), and ending up with a mess. >> >> For example, imagine you started with this code snippet: >> >> let x = f a >> y = g x >> in h x y >> >> If you fully convert that to CPS you’d end up with 3 continuations (I think) and it would be much harder to understand. And adding an additional let binding later might involve a bunch of restructuring. >> >> I assume it just means that sort of thing. When someone first learns about continuations and their generality, it can be tempting to go overboard. >> >> Jeff >> >> On Aug 31, 2021, at 3:03 AM, YueCompl via Haskell-Cafe > wrote: >> >>> Dear Cafe, >>> >>> I'm wrapping up my CPS codebase to provide some monadic interface, it appears almost the Cont monad, so the following statement is a pretty valid caveat to me now: >>> >>> > Abuse of the Continuation monad can produce code that is impossible to understand and maintain. >>> >>> Which can be viewed in context of Hackage at: https://hackage.haskell.org/package/mtl/docs/Control-Monad-Cont.html#:~:text=Abuse%20of%20the%20Continuation%20monad%20can%20produce%20code%20that%20is%20impossible%20to%20understand%20and%20maintain >>> >>> But I can't find concrete examples demonstrating the "impossible to understand and maintain" situation, in figuring out what pitfalls I'd rather to avoid. >>> >>> Please share what you know about it, many appreciations! >>> >>> Background of my CPS necessarity: >>> >>> Library code need to delegate STM transaction boundary delimitation to (scripting) application code, though `inlineSTM :: STM a -> m a` can be used to force some action to be within current tx, the usual `>>=` binding should honor whether a separate `atomically` tx should be issued for its rhs computation, as specified by the scripting context. >>> >>> Thanks, >>> Compl >>> >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> To (un)subscribe, modify options or view archives go to: >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>> Only members subscribed via the mailman list are allowed to post. >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From svenpanne at gmail.com Sun Oct 3 13:44:09 2021 From: svenpanne at gmail.com (Sven Panne) Date: Sun, 3 Oct 2021 15:44:09 +0200 Subject: [Haskell-cafe] Seeking community input on change to Haskell.org Downloads page In-Reply-To: <20211002135801.GA25169@cloudinit-builder> References: <20211002135801.GA25169@cloudinit-builder> Message-ID: Am Sa., 2. Okt. 2021 um 15:59 Uhr schrieb Tom Ellis < tom-lists-haskell-cafe-2017 at jaguarpaw.co.uk>: > The Haskell.org committee is considering a change to the [Haskell.org > Downloads page]. The change is being reviewed in a [GitHub PR]. [...] > What's the current state of affairs regarding duplicate toolchains? If one follows the suggestions on the PR and installs most things via GHCup and installs stack separately, don't you download and install all GHC versions twice? IIRC, this was the case in the past, but I might be wrong. If that's still the case, some warnings about that might be appropriate on the download page, because this duplication would waste hundreds of GB on disk... -------------- next part -------------- An HTML attachment was scrubbed... URL: From svenpanne at gmail.com Sun Oct 3 13:59:19 2021 From: svenpanne at gmail.com (Sven Panne) Date: Sun, 3 Oct 2021 15:59:19 +0200 Subject: [Haskell-cafe] Seeking community input on change to Haskell.org Downloads page In-Reply-To: References: <20211002135801.GA25169@cloudinit-builder> Message-ID: Am So., 3. Okt. 2021 um 15:44 Uhr schrieb Sven Panne : > [...] this duplication would waste hundreds of GB on disk... > This should have been "MB" instead of "GB". GHC installations are big, but not *that* big. :-} -------------- next part -------------- An HTML attachment was scrubbed... URL: From stuart.hungerford at gmail.com Mon Oct 4 03:35:19 2021 From: stuart.hungerford at gmail.com (Stuart Hungerford) Date: Mon, 4 Oct 2021 14:35:19 +1100 Subject: [Haskell-cafe] Vectors, vector spaces and type-level Haskell Message-ID: Greetings Haskellers, I'd like to model in Haskell two-dimensional vectors that "belong to" or "have an ambient space of" a two dimensional vector space. I'm also ignoring for now the issue of which field the vector space is over. I realize this is not strictly necessary to just start using 2D vectors, but I would like to bring the vector space in as a first class concept. Looking at for example this approach: https://hackage.haskell.org/package/linear-1.21.7/docs/Linear-V2.html, I get the impression this is likely to need some kind of type-level construct? e.g. type families or type-level literals? I haven't started learning yet about Haskell type-level programming so I thought I'd ask for advice first to see how this could be done idiomatically in Haskell either with or without type-level concepts. TIA, Stu From branimir.maksimovic at gmail.com Mon Oct 4 05:25:04 2021 From: branimir.maksimovic at gmail.com (Branimir Maksimovic) Date: Mon, 4 Oct 2021 07:25:04 +0200 Subject: [Haskell-cafe] Vectors, vector spaces and type-level Haskell In-Reply-To: References: Message-ID: 2d vector space is generated by two base vectors, if, which are orthogonal, that is normalised. They generate any other vector in that space. Greetings, Branimir. > On 04.10.2021., at 05:35, Stuart Hungerford wrote: > > Greetings Haskellers, > > I'd like to model in Haskell two-dimensional vectors that "belong to" > or "have an ambient space of" a two dimensional vector space. I'm also > ignoring for now the issue of which field the vector space is over. I > realize this is not strictly necessary to just start using 2D vectors, > but I would like to bring the vector space in as a first class > concept. > > Looking at for example this approach: > https://hackage.haskell.org/package/linear-1.21.7/docs/Linear-V2.html, > I get the impression this is likely to need some kind of type-level > construct? e.g. type families or type-level literals? > > I haven't started learning yet about Haskell type-level programming so > I thought I'd ask for advice first to see how this could be done > idiomatically in Haskell either with or without type-level concepts. > > TIA, > > Stu > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From stuart.hungerford at gmail.com Mon Oct 4 07:38:06 2021 From: stuart.hungerford at gmail.com (Stuart Hungerford) Date: Mon, 4 Oct 2021 18:38:06 +1100 Subject: [Haskell-cafe] Vectors, vector spaces and type-level Haskell In-Reply-To: References: Message-ID: On Mon, 4 Oct 2021 at 4:25 pm, Branimir Maksimovic < branimir.maksimovic at gmail.com> wrote: > 2d vector space is generated by two base vectors, if, which are orthogonal, > that is normalised. They generate any other vector in that space. Yes, so I would be looking to somehow tie the 2 basis vectors back to a 2D vector space. Or indeed n basis vectors to an n-vector space. Thanks, Stu > -------------- next part -------------- An HTML attachment was scrubbed... URL: From branimir.maksimovic at gmail.com Mon Oct 4 07:45:30 2021 From: branimir.maksimovic at gmail.com (Branimir Maksimovic) Date: Mon, 4 Oct 2021 09:45:30 +0200 Subject: [Haskell-cafe] Vectors, vector spaces and type-level Haskell In-Reply-To: References: Message-ID: <00D133D8-F6E8-4CC9-B3FC-5F56583C389F@gmail.com> > On 04.10.2021., at 09:38, Stuart Hungerford wrote: > > On Mon, 4 Oct 2021 at 4:25 pm, Branimir Maksimovic > wrote: > 2d vector space is generated by two base vectors, if, which are orthogonal, > that is normalised. They generate any other vector in that space. > > Yes, so I would be looking to somehow tie the 2 basis vectors back to a 2D vector space. Or indeed n basis vectors to an n-vector space. Space is generated by base vectors, think in that way… With vector addition and scalar multiplication you get third vector. so dimension is number of different directions of base vectors. So, easy... > > Thanks, > > Stu > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From stuart.hungerford at gmail.com Mon Oct 4 07:55:22 2021 From: stuart.hungerford at gmail.com (Stuart Hungerford) Date: Mon, 4 Oct 2021 18:55:22 +1100 Subject: [Haskell-cafe] Vectors, vector spaces and type-level Haskell In-Reply-To: <00D133D8-F6E8-4CC9-B3FC-5F56583C389F@gmail.com> References: <00D133D8-F6E8-4CC9-B3FC-5F56583C389F@gmail.com> Message-ID: On Mon, Oct 4, 2021 at 6:45 PM Branimir Maksimovic wrote: > On 04.10.2021., at 09:38, Stuart Hungerford wrote: > > On Mon, 4 Oct 2021 at 4:25 pm, Branimir Maksimovic wrote: >> >> 2d vector space is generated by two base vectors, if, which are orthogonal, >> that is normalised. They generate any other vector in that space. > > Yes, so I would be looking to somehow tie the 2 basis vectors back to a 2D vector space. Or indeed n basis vectors to an n-vector space. > > > Space is generated by base vectors, think in that way… > With vector addition and scalar multiplication you get third vector. > so dimension is number of different directions of base vectors. > So, easy... Thanks Branimir I appreciate you taking the time to reply to what could be a silly question. Perhaps I haven't explained what I'm looking for very well. I know about the vector and scalar operations the vector space inherits from the underlying abelian group and field of scalars. Including the basis of linearly independent vectors that generates all vectors in the space. What I'd like to do is use the Haskell type system to encode those operations so I can't--for example--use a two dimensional and three dimensional vector in the same operation, or "ask" a vector what its "ambient" vector space is and have those operations checked at compile time. I've avoided learning about type-level programming in Haskell so far, but it may be time to delve deeper... Thanks again, Stu From branimir.maksimovic at gmail.com Mon Oct 4 08:02:25 2021 From: branimir.maksimovic at gmail.com (Branimir Maksimovic) Date: Mon, 4 Oct 2021 10:02:25 +0200 Subject: [Haskell-cafe] Vectors, vector spaces and type-level Haskell In-Reply-To: References: <00D133D8-F6E8-4CC9-B3FC-5F56583C389F@gmail.com> Message-ID: > On 04.10.2021., at 09:55, Stuart Hungerford wrote: > > On Mon, Oct 4, 2021 at 6:45 PM Branimir Maksimovic > > wrote: > >> On 04.10.2021., at 09:38, Stuart Hungerford wrote: >> >> On Mon, 4 Oct 2021 at 4:25 pm, Branimir Maksimovic wrote: >>> >>> 2d vector space is generated by two base vectors, if, which are orthogonal, >>> that is normalised. They generate any other vector in that space. >> >> Yes, so I would be looking to somehow tie the 2 basis vectors back to a 2D vector space. Or indeed n basis vectors to an n-vector space. >> >> >> Space is generated by base vectors, think in that way… >> With vector addition and scalar multiplication you get third vector. >> so dimension is number of different directions of base vectors. >> So, easy... > > Thanks Branimir I appreciate you taking the time to reply to what > could be a silly question. Perhaps I haven't explained what I'm > looking for very well. > > I know about the vector and scalar operations the vector space > inherits from the underlying abelian group and field of scalars. > Including the basis of linearly independent vectors that generates all > vectors in the space. > > What I'd like to do is use the Haskell type system to encode those > operations so I can't--for example--use a two dimensional and three > dimensional vector in the same operation, or "ask" a vector what its > "ambient" vector space is and have those operations checked at compile > time. > > I've avoided learning about type-level programming in Haskell so far, > but it may be time to delve deeper... > > Thanks again, > > Stu Well vector is tuple 3d space 3 tuples of 3 elements each representing 3 directions in 3d space eg. Types can be anything, but same, so you could represent with a 3 lists also. i dunno what you mean by type checking? You have type checking already. Greets, Branimir (and thanks) -------------- next part -------------- An HTML attachment was scrubbed... URL: From x at tomsmeding.com Mon Oct 4 09:13:38 2021 From: x at tomsmeding.com (Tom Smeding) Date: Mon, 04 Oct 2021 09:13:38 +0000 Subject: [Haskell-cafe] Vectors, vector spaces and type-level Haskell In-Reply-To: References: <00D133D8-F6E8-4CC9-B3FC-5F56583C389F@gmail.com> Message-ID: <2b192e28-6a45-329e-0f99-204f9e5fe1d0@tomsmeding.com> Dear Stuart, The V2 and V3 etc. types provided by the linear package (which you already found) model vectors in 2- and 3-dimensional real vector spaces, over the field given by their 'a' type parameter. Wanting to add a vector from a 2-dimensional vector space over 'a' and a vector from a 3-dimensional vector space over 'b' entails adding a 'V2 a' and 'V3 b'; those are distinct types. The vector space of 'V2 a' is morally 'a^2'. It seems this satisfies what you want. Are there other guarantees you want enforced at compile time that this cannot give you? - Tom On 04/10/2021 09:55, Stuart Hungerford wrote: > On Mon, Oct 4, 2021 at 6:45 PM Branimir Maksimovic > wrote: > >> On 04.10.2021., at 09:38, Stuart Hungerford wrote: >> >> On Mon, 4 Oct 2021 at 4:25 pm, Branimir Maksimovic wrote: >>> >>> 2d vector space is generated by two base vectors, if, which are orthogonal, >>> that is normalised. They generate any other vector in that space. >> >> Yes, so I would be looking to somehow tie the 2 basis vectors back to a 2D vector space. Or indeed n basis vectors to an n-vector space. >> >> >> Space is generated by base vectors, think in that way… >> With vector addition and scalar multiplication you get third vector. >> so dimension is number of different directions of base vectors. >> So, easy... > > Thanks Branimir I appreciate you taking the time to reply to what > could be a silly question. Perhaps I haven't explained what I'm > looking for very well. > > I know about the vector and scalar operations the vector space > inherits from the underlying abelian group and field of scalars. > Including the basis of linearly independent vectors that generates all > vectors in the space. > > What I'd like to do is use the Haskell type system to encode those > operations so I can't--for example--use a two dimensional and three > dimensional vector in the same operation, or "ask" a vector what its > "ambient" vector space is and have those operations checked at compile > time. > > I've avoided learning about type-level programming in Haskell so far, > but it may be time to delve deeper... > > Thanks again, > > Stu > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > From ben.franksen at online.de Mon Oct 4 09:42:42 2021 From: ben.franksen at online.de (Ben Franksen) Date: Mon, 4 Oct 2021 11:42:42 +0200 Subject: [Haskell-cafe] Improving the docs (specifically Data.Foldable) In-Reply-To: References: Message-ID: Am 01.10.21 um 19:43 schrieb Viktor Dukhovni: > On Fri, Oct 01, 2021 at 11:52:53AM +0200, Ben Franksen wrote: > >>> Well a balanced Tree can have an efficient corecursive foldl, or a >>> performant 'foldr`', and Sets can know their size statically, and `elem` >>> runs in linear time even in structures that potentially support faster >>> search. >> >> All true, and I think it is important to document these things. The >> question is: where? > > I disagree that everything one should know about Data.Foldable is > adequately described in Data.List. At least not without a new overview > for Data.List that would cover some of the same ground in that > specialised context, and could then be imported by reference. > > A reader who wants to better understand folds should learn the > difference between strict reduction and corecursion, and certainly > Data.List is not the best place to discuss tips for construction of > Foldable instances. I already admitted elsewhere that my initial position (reduce semantics to that of lists) was too idealistic. My remark above was about attaching the documentation of runtime behaviors for specific instances to those instances. > But ultimately one should understand why foldl', For lists this is explained in Data.List (though perhaps could use a bit of elaboration). For the general case, as mention before by me and others, this cannot be answered in general unless you know which Foldable you are dealing with or at least make certain assumptions about how instances are implemented. > how to define > instances, How do I define Foldable for snoc-lists? There are two choices: - Isomorphic to that for lists, i.e. from right to left, to conform to common expectations about runtime/bottom behavior for the left/right folds? - Or from left to right, such that foldr is problematic and foldr' the recommended one? > why `elem` is stuck doing linear lookup for `Set`, ... Agreed, the docs should definitely mentioned that neither `elem` nor in fact any other method can be better than linear. > Different readers will come to the documentation for different needs, By all means, add advice for writing instances (under a heading that says so). However, I claim that the vast majority of readers will want to know how to use the class methods in their code or understand why some code they try to understand uses a specific method. This is what the bulk of the docs should be about. Unfortunately there doesn't seem to be consensus in the community about the general semantics of the left/right associative folds. Contributing to the docs makes no sense for me until these questions are resolved. Cheers Ben -- I would rather have questions that cannot be answered, than answers that cannot be questioned. -- Richard Feynman From ben.franksen at online.de Mon Oct 4 10:01:20 2021 From: ben.franksen at online.de (Ben Franksen) Date: Mon, 4 Oct 2021 12:01:20 +0200 Subject: [Haskell-cafe] Haskell reference documentation, laws first or laws last? In-Reply-To: <7E95F060-6A82-4F5C-94D8-B21458C672BF@gmail.com> References: <7E95F060-6A82-4F5C-94D8-B21458C672BF@gmail.com> Message-ID: Class laws are not only neccessary to write correct instances. They are also extremely important documentation for users! For instance, one of the three Monad laws says that do x <- doSomething return x = doSomething You cannot refactor monadic code without relying on that law. Cheers Ben Am 17.09.21 um 23:04 schrieb Keith: > Perhaps it would make sense to have a 'using the class' section and a 'writing instances' section. > The first would focus on more concrete and intuitive examples. > The second would explain how and why to follow the laws, maybe with specific ways to avoid pitfalls and extra work (e.g. when you can and can't DeriveFoldable, when to use `foldMapDefault` when to define only `foldr` or `foldMap` or to use `toList` to define others. > > It's super important that folks gan define legal instances so things don't brow up in their faces (e.g. an Applicative instance that zips but defines `pure` as a singleton). But often all they need to know is `DeriveTraversable` exists and works as long as you don't define things in strange ways (like conceptually reversed lists). > --Keith > Sent from my phone with K-9 Mail. > > On 17 September 2021 08:30:37 UTC, Ignat Insarov wrote: >> Hello Viktor. >> >> Thank you for your continuous effort. >> >> I have been writing Haskell for years now and even getting paid for >> it. I care nothing for the laws — I rarely apply equational reasoning. >> I am a visual person, to me intuitive grasp is the tool of choice. I >> also know a few newcomers to Haskell and I am certain they make zero >> use of the laws. >> >> My thus informed view is that laws are fine in the end and useless at the start. >> >> On Fri, 17 Sept 2021 at 04:48, Viktor Dukhovni wrote: >>> >>> On Thu, Sep 16, 2021 at 06:51:42PM -0400, David Feuer wrote: >>> >>>> The last time I went to look at the laws it took me a couple minutes to >>>> find them. I use them to write instances. Pretty important, IMO. >>> >>> I agree the laws are important to document, I just don't think they >>> belong at the top of the module. The beginner to intermediate users >>> will be using the library and existing instances for some time before >>> they start to write their own instances. >>> >>> If more modules adopt something like the style of the new Data.Foldable, >>> experienced users will know to look for the laws at the end, if not >>> still present at the top of the module. >>> >>> Of course perhaps the community would prefer the original Laws first >>> format, I'm fine with that emerging as the consensus. Perhaps worthy >>> of a separate thread (made it so). >>> >>> Of course the conjectured users who might most benefit from not being >>> intimidated by being exposed to laws before they're ready to understand >>> them might not be present on this forum... >>> >>> -- >>> Viktor. >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> To (un)subscribe, modify options or view archives go to: >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>> Only members subscribed via the mailman list are allowed to post. >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. >> >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. -- I would rather have questions that cannot be answered, than answers that cannot be questioned. -- Richard Feynman From ben.franksen at online.de Mon Oct 4 10:45:36 2021 From: ben.franksen at online.de (Ben Franksen) Date: Mon, 4 Oct 2021 12:45:36 +0200 Subject: [Haskell-cafe] Haskell-Cafe Digest, Vol 217, Issue 17 In-Reply-To: References: Message-ID: Am 17.09.21 um 05:53 schrieb Michael Turner: > No. I started here: > > https://www.stwing.upenn.edu/~wlovas/hudak/aug.pdf > > I'd like to use this parsing technique for natural language. I had no > intention of translating Haskell to C/C++ unless it turned out to > matter for performance. What I didn't realize starting out in trying > to understand that code is that it's horribly written code, and > underdocumented. Well, that's research papers for you. They are not tutorials for the programming language they use to illustrate their ideas. Nor are they intended primarily to show well-designed code. (There *are* a fair number of exceptions, especially those that are published under the "functional pearl" rubric.) > 'g' as a function name, a name not clearly related to > any meaning? It is a common idiom in Haskell to use a simple generic name like "go" or "doit" when you defer the bulk of the definition of a function to a local helper, reducing the main function definition to a trivial one-liner. I agree that using a single-letter name such as "g" for this purpose is bad style. > Oh, and how about this type signature: > > app :: (TTree -> TTree -> Tree) -> TTree -> TTree -> [TTree] Yes, a type synonym here would have helped making the intention clearer. Again, research paper vs. carefully engineered code. I am working in an electron accelerator, you should see the sort of mess physicists build as prototypes (and write their papers about). What I do when i am confronted with such code is to refactor it until it is in a form I find easier to understand. It seems you arrived at a similar method for yourself. Cheers Ben -- I would rather have questions that cannot be answered, than answers that cannot be questioned. -- Richard Feynman From ben.franksen at online.de Mon Oct 4 11:26:12 2021 From: ben.franksen at online.de (Ben Franksen) Date: Mon, 4 Oct 2021 13:26:12 +0200 Subject: [Haskell-cafe] Better writing about Haskell through multi-metaphor learning In-Reply-To: References: Message-ID: Am 18.09.21 um 04:56 schrieb Michael Turner: > Or, you can tell them, "Just learn lambda calculus, then study monads > algebraically, and here's a side dish of category theory while I'm it. > Bon appetit." How's that working for you, guys? It doesn't work for > me. And I don't think it's because I can't do the math. It's that I > often write code to see whether I'm thinking about a problem the right > way. Same here. > I'm no star hacker, but "workflow" feels like it will make my > fingertips smarter. "Programmable semicolon" feels like it will make > my fingertips smarter. You think top-down mathematically? I'd venture that most mathematicians don't use such a purely formal top-down approach when thinking about a problem. Intuition about concepts is very important. Mathematical writing often gives the wrong impression that in order to understand a new concept, you just have to read the formal definition and then make logical deductions. This is not how it works in practice and those who are honest will readily admit that. You need to study concrete examples, and you need to work through exercises to develop true understanding. As for monads, even though I do like the "overloaded semicolon" metaphor, the crucial point is not the sequencing as such, but rather how to express capturing and referencing intermediate results *in a statically typed fashion*. Cheers Ben -- I would rather have questions that cannot be answered, than answers that cannot be questioned. -- Richard Feynman From ben.franksen at online.de Mon Oct 4 12:56:05 2021 From: ben.franksen at online.de (Ben Franksen) Date: Mon, 4 Oct 2021 14:56:05 +0200 Subject: [Haskell-cafe] On finding the right exposition... In-Reply-To: References: Message-ID: Am 19.09.21 um 05:00 schrieb Anthony Clayden: > Aside: to this day, that sort of ad-hoc syntax makes me gag. K&R should be > publicly flogged on a regular basis. And for so many other reasons, too, like mandating a preprocessor (with a complex, operationally defined semantics) simply because they couldn't be bothered to design a (simple, 1st order) module system. And lots of inconsistencies and special cases. Like functions can be declared to return void but trying to actually do so (return void) is an error. Or that void is indeed a keyword and not a typedef for "struct {}". Talking of inconsistencies, Haskell is not without some of those. For instance, I never understood why (->) is right associative in types, but (=>) is not and you are instead supposed to pack constraints in a tuple. (It works in some simple cases but not consistently.) Cheers Ben -- I would rather have questions that cannot be answered, than answers that cannot be questioned. -- Richard Feynman From frederic-emmanuel.picca at synchrotron-soleil.fr Mon Oct 4 13:26:08 2021 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Mon, 4 Oct 2021 13:26:08 +0000 Subject: [Haskell-cafe] list of range Message-ID: Hello, I need to parse a commande line which allows user to describe indices like this 1 -> only one indice 1-5 -> [1..5] 1-5 6-10 ...-> [1..5] ++ [6..10] My question is what it the best type in order to store this information ? Range Int = Range Int | RangeFromTo Int Int | Range Int <+> Range Int At some point I would like to add the possibility to have multiples Indices with the ',' 1,3,5 -> [1,3,5] list of indices This type is used at some point as a List. My question is, are you aware of a similar type in the standar library. This is the kind of information tahth w should parse when we request to print pages. (list of pages to print). Cheers Frederic From merijn at inconsistent.nl Mon Oct 4 13:45:22 2021 From: merijn at inconsistent.nl (Merijn Verstraaten) Date: Mon, 4 Oct 2021 15:45:22 +0200 Subject: [Haskell-cafe] list of range In-Reply-To: References: Message-ID: <85E6696E-21E0-4AE0-A96D-2499C9E4560E@inconsistent.nl> Sounds like you want something along the lines of https://hackage.haskell.org/package/data-interval Which has types for open/closed intervals and sets/maps of them. Cheers, Merijn > On 4 Oct 2021, at 15:26, PICCA Frederic-Emmanuel wrote: > > Hello, I need to parse a commande line which allows user to describe indices like this > > 1 -> only one indice > 1-5 -> [1..5] > 1-5 6-10 ...-> [1..5] ++ [6..10] > > My question is what it the best type in order to store this information ? > > Range Int = Range Int > | RangeFromTo Int Int > | Range Int <+> Range Int > > At some point I would like to add the possibility to have multiples Indices with the ',' > 1,3,5 -> [1,3,5] list of indices > > This type is used at some point as a List. > > My question is, are you aware of a similar type in the standar library. > This is the kind of information tahth w should parse when we request to print pages. (list of pages to print). > > Cheers > > > Frederic > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 833 bytes Desc: Message signed with OpenPGP URL: From ruben.astud at gmail.com Mon Oct 4 13:53:56 2021 From: ruben.astud at gmail.com (Ruben Astudillo) Date: Mon, 4 Oct 2021 10:53:56 -0300 Subject: [Haskell-cafe] Massaging data from the `extensible` package Message-ID: Hello cafe I have been enjoying the `extensible` package [1] for extensible records and variants, kudos to the author. I have had a problem of not understanding how to "massage" data from one representation to another. To exemplify, suppose I have the following two extensible records {-# language OverloadedLabels #-} import Data.Extensible import Control.Lens type Ext1 = Record '[ "field1" >: String, "field2" >: Integer ] type Ext2 = Record '[ "field1" >: Text, "field2" >: Double ] and I want to map some piece of data between these two types. Currently I am projecting each field individually like this ex1 :: Ext1 ex1 = #field1 @= "hello" <: #field2 @= 2.71 <: nil currentMap :: Ext1 -> Ext2 currentMap s = #field1 @= T.pack (view #field1 s) <: #field2 @= fromInteger (view #field2 s) <: nil For data types with few fields it is not so bad. But I have to do this transformation of data types generated from TH, I am dealing with a few dozens. The transformations are always from `String -> Text` and `Integer -> Double`. I would like to write a high lever combinator that grabs an extensible record, transforms each `String` field on a `Text` one and does the same with `Integer -> Double`. Most of the combinators for transforming the data deal with natural transformations, such as hmap, hsequence and the like. The closest one to what I want is `hfoldMapFor` where I have to define a class with instances for all the types the extensible record has, but it doesn't let me change the type of the result. Does anyone have an idea on how to solve this? Thanks for your time. [1]: https://hackage.haskell.org/package/extensible -- Rubén. (pgp: 4EE9 28F7 932E F4AD) From branimir.maksimovic at gmail.com Mon Oct 4 13:57:55 2021 From: branimir.maksimovic at gmail.com (Branimir Maksimovic) Date: Mon, 4 Oct 2021 15:57:55 +0200 Subject: [Haskell-cafe] list of range In-Reply-To: References: Message-ID: <01E52483-38DE-4FE4-B418-21FB833D2602@gmail.com> List of tuples, map then zip, or in Rust enumerate… Greets,branimir. > On 04.10.2021., at 15:26, PICCA Frederic-Emmanuel wrote: > > Hello, I need to parse a commande line which allows user to describe indices like this > > 1 -> only one indice > 1-5 -> [1..5] > 1-5 6-10 ...-> [1..5] ++ [6..10] > > My question is what it the best type in order to store this information ? > > Range Int = Range Int > | RangeFromTo Int Int > | Range Int <+> Range Int > > At some point I would like to add the possibility to have multiples Indices with the ',' > 1,3,5 -> [1,3,5] list of indices > > This type is used at some point as a List. > > My question is, are you aware of a similar type in the standar library. > This is the kind of information tahth w should parse when we request to print pages. (list of pages to print). > > Cheers > > > Frederic > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From branimir.maksimovic at gmail.com Mon Oct 4 14:00:07 2021 From: branimir.maksimovic at gmail.com (Branimir Maksimovic) Date: Mon, 4 Oct 2021 16:00:07 +0200 Subject: [Haskell-cafe] Massaging data from the `extensible` package In-Reply-To: References: Message-ID: write generic function then map that function. Greets, branimir > On 04.10.2021., at 15:53, Ruben Astudillo wrote: > > Hello cafe > > I have been enjoying the `extensible` package [1] for extensible records and > variants, kudos to the author. I have had a problem of not understanding how > to "massage" data from one representation to another. To exemplify, suppose > I have the following two extensible records > > {-# language OverloadedLabels #-} > > import Data.Extensible > import Control.Lens > > type Ext1 = Record '[ "field1" >: String, "field2" >: Integer ] > type Ext2 = Record '[ "field1" >: Text, "field2" >: Double ] > > and I want to map some piece of data between these two types. Currently I am > projecting each field individually like this > > ex1 :: Ext1 > ex1 = #field1 @= "hello" <: #field2 @= 2.71 <: nil > > currentMap :: Ext1 -> Ext2 > currentMap s = > #field1 @= T.pack (view #field1 s) > <: #field2 @= fromInteger (view #field2 s) > <: nil > > For data types with few fields it is not so bad. But I have to do this > transformation of data types generated from TH, I am dealing with a few > dozens. The transformations are always from `String -> Text` and `Integer -> > Double`. I would like to write a high lever combinator that grabs an > extensible record, transforms each `String` field on a `Text` one and does > the same with `Integer -> Double`. > > Most of the combinators for transforming the data deal with natural > transformations, such as hmap, hsequence and the like. The closest one to > what I want is `hfoldMapFor` where I have to define a class with instances > for all the types the extensible record has, but it doesn't let me change > the type of the result. Does anyone have an idea on how to solve this? > > Thanks for your time. > > [1]: https://hackage.haskell.org/package/extensible > > -- > Rubén. (pgp: 4EE9 28F7 932E F4AD) > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From ruben.astud at gmail.com Mon Oct 4 15:03:01 2021 From: ruben.astud at gmail.com (Ruben Astudillo) Date: Mon, 4 Oct 2021 12:03:01 -0300 Subject: [Haskell-cafe] Massaging data from the `extensible` package In-Reply-To: References: Message-ID: On 04-10-21 11:00, Branimir Maksimovic wrote: > write generic function then map that function. Records are not Generic and hmap cannot change the type even with Typeable as a constrain. -- Rubén. (pgp: 4EE9 28F7 932E F4AD) From ruben.astud at gmail.com Mon Oct 4 15:04:41 2021 From: ruben.astud at gmail.com (Ruben Astudillo) Date: Mon, 4 Oct 2021 12:04:41 -0300 Subject: [Haskell-cafe] Massaging data from the `extensible` package In-Reply-To: References: Message-ID: On 04-10-21 11:00, Branimir Maksimovic wrote: > write generic function then map that function. Records are not Generic and hmap cannot change the type even with Typeable as a constrain. -- Rubén. (pgp: 4EE9 28F7 932E F4AD) From branimir.maksimovic at gmail.com Mon Oct 4 15:05:03 2021 From: branimir.maksimovic at gmail.com (Branimir Maksimovic) Date: Mon, 4 Oct 2021 17:05:03 +0200 Subject: [Haskell-cafe] Massaging data from the `extensible` package In-Reply-To: References: Message-ID: <6C919ECA-836C-4D27-9AD9-D34533D9B7D1@gmail.com> Then change approach, map type to type you are recognizing pattern already.. Greets, Branimir. > On 04.10.2021., at 17:03, Ruben Astudillo wrote: > > On 04-10-21 11:00, Branimir Maksimovic wrote: >> write generic function then map that function. > > Records are not Generic and hmap cannot change the type even with Typeable > as a constrain. > > -- > Rubén. (pgp: 4EE9 28F7 932E F4AD) From lemming at henning-thielemann.de Mon Oct 4 16:02:19 2021 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Mon, 4 Oct 2021 18:02:19 +0200 (CEST) Subject: [Haskell-cafe] list of range In-Reply-To: References: Message-ID: On Mon, 4 Oct 2021, PICCA Frederic-Emmanuel wrote: > Hello, I need to parse a commande line which allows user to describe indices like this > > 1 -> only one indice > 1-5 -> [1..5] > 1-5 6-10 ...-> [1..5] ++ [6..10] > > My question is what it the best type in order to store this information ? Is it necessary to preserve the structure of separate ranges or would it be ok to just store [Int] or Set Int? From lemming at henning-thielemann.de Mon Oct 4 16:05:31 2021 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Mon, 4 Oct 2021 18:05:31 +0200 (CEST) Subject: [Haskell-cafe] Vectors, vector spaces and type-level Haskell In-Reply-To: References: Message-ID: <7069535-c825-447d-8cd2-b6c4207e532e@henning-thielemann.de> On Mon, 4 Oct 2021, Stuart Hungerford wrote: > I'd like to model in Haskell two-dimensional vectors that "belong to" > or "have an ambient space of" a two dimensional vector space. If you only need two dimensional vectors, you might be happy with Data.Complex. From frederic-emmanuel.picca at synchrotron-soleil.fr Mon Oct 4 16:10:42 2021 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Mon, 4 Oct 2021 16:10:42 +0000 Subject: [Haskell-cafe] list of range In-Reply-To: References: , Message-ID: > Is it necessary to preserve the structure of separate ranges or would it > be ok to just store [Int] or Set Int? I think that it is efficient to keep the structure, but since haskell is lazy, I am wondering, if the best solution would not be to create the Set of Int. (An Ordered Set). the next step of the process, is for each index, to open a file corresponding to the index. In this file there is a bunch of images. At the end we have a Set associated to a number of images. This is the stream of images I have to treat. I split this into chunck and process each of them in parallel via a mapConcurrently. I do not know if this help... cheers Frederic From lemming at henning-thielemann.de Mon Oct 4 16:12:13 2021 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Mon, 4 Oct 2021 18:12:13 +0200 (CEST) Subject: [Haskell-cafe] Nested (=>) (Was: On finding the right exposition...) In-Reply-To: References: Message-ID: On Mon, 4 Oct 2021, Ben Franksen wrote: > Talking of inconsistencies, Haskell is not without some of those. For > instance, I never understood why (->) is right associative in types, but > (=>) is not and you are instead supposed to pack constraints in a tuple. > (It works in some simple cases but not consistently.) I use nested (=>) frequently. GHC allows it in type signatures but not in super-class constraints. Would be cool to be allowed everywhere, as it supports the "terminator syntax style". From lemming at henning-thielemann.de Mon Oct 4 16:27:12 2021 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Mon, 4 Oct 2021 18:27:12 +0200 (CEST) Subject: [Haskell-cafe] list of range In-Reply-To: References: , Message-ID: <38964b3e-c5a7-aa26-468-8998c2f4d2a0@henning-thielemann.de> On Mon, 4 Oct 2021, PICCA Frederic-Emmanuel wrote: >> Is it necessary to preserve the structure of separate ranges or would it >> be ok to just store [Int] or Set Int? > > I think that it is efficient to keep the structure, but since haskell is lazy, I am wondering, if the best solution > would not be to create the Set of Int. (An Ordered Set). Set Int is not lazy. [Int] is lazy, but it is inefficient for eliminating duplicates. IntSet is also strict, but internally it is almost a bit vector, i.e. storage efficient. If the ranges are really large, then you might need data-interval&friends. However, a list of numbers of image files might not be that large, and IntSet will probably be a good choice. From frederic-emmanuel.picca at synchrotron-soleil.fr Mon Oct 4 16:32:20 2021 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Mon, 4 Oct 2021 16:32:20 +0000 Subject: [Haskell-cafe] list of range In-Reply-To: <38964b3e-c5a7-aa26-468-8998c2f4d2a0@henning-thielemann.de> References: , , <38964b3e-c5a7-aa26-468-8998c2f4d2a0@henning-thielemann.de> Message-ID: > Set Int is not lazy. [Int] is lazy, but it is inefficient for eliminating > duplicates. IntSet is also strict, but internally it is almost a bit > vector, i.e. storage efficient. If the ranges are really large, then you > might need data-interval&friends. However, a list of numbers of image > files might not be that large, and IntSet will probably be a good choice. We have 100 files with 3000 images. 300000 * 4 bytes = 1.2 M is it that big ? From tom-lists-haskell-cafe-2017 at jaguarpaw.co.uk Mon Oct 4 16:36:33 2021 From: tom-lists-haskell-cafe-2017 at jaguarpaw.co.uk (Tom Ellis) Date: Mon, 4 Oct 2021 17:36:33 +0100 Subject: [Haskell-cafe] Terminator syntax style (Was: Nested (=>) (Was: On finding the right exposition...)) In-Reply-To: References: Message-ID: <20211004163633.GG512@cloudinit-builder> On Mon, Oct 04, 2021 at 06:12:13PM +0200, Henning Thielemann wrote: > On Mon, 4 Oct 2021, Ben Franksen wrote: > > > Talking of inconsistencies, Haskell is not without some of those. For > > instance, I never understood why (->) is right associative in types, but > > (=>) is not and you are instead supposed to pack constraints in a tuple. > > (It works in some simple cases but not consistently.) > > I use nested (=>) frequently. GHC allows it in type signatures but not in > super-class constraints. Would be cool to be allowed everywhere, as it > supports the "terminator syntax style". Could you say what "terminator syntax style" is? I'm not finding any hits on popular search engines. From lemming at henning-thielemann.de Mon Oct 4 16:42:14 2021 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Mon, 4 Oct 2021 18:42:14 +0200 (CEST) Subject: [Haskell-cafe] list of range In-Reply-To: References: , , <38964b3e-c5a7-aa26-468-8998c2f4d2a0@henning-thielemann.de> Message-ID: <42bcc062-985f-5841-82fa-8879503fa933@henning-thielemann.de> On Mon, 4 Oct 2021, PICCA Frederic-Emmanuel wrote: >> Set Int is not lazy. [Int] is lazy, but it is inefficient for eliminating >> duplicates. IntSet is also strict, but internally it is almost a bit >> vector, i.e. storage efficient. If the ranges are really large, then you >> might need data-interval&friends. However, a list of numbers of image >> files might not be that large, and IntSet will probably be a good choice. > > We have 100 files with 3000 images. > > 300000 * 4 bytes = 1.2 M > > is it that big ? I am afraid, I still do not understand where you need the list of Ranges. In the original post you said, you want to parse a list of ranges like the one for pages to print in a printer dialog. Is it to select files from the 100 ones or is it to select images from the 300,000 ones? In the first case I would use IntMap, in the latter case I would use Interval data structures. From frederic-emmanuel.picca at synchrotron-soleil.fr Mon Oct 4 16:48:37 2021 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Mon, 4 Oct 2021 16:48:37 +0000 Subject: [Haskell-cafe] list of range In-Reply-To: <42bcc062-985f-5841-82fa-8879503fa933@henning-thielemann.de> References: , , <38964b3e-c5a7-aa26-468-8998c2f4d2a0@henning-thielemann.de> , <42bcc062-985f-5841-82fa-8879503fa933@henning-thielemann.de> Message-ID: > I am afraid, I still do not understand where you need the list of Ranges. > In the original post you said, you want to parse a list of ranges like the > one for pages to print in a printer dialog. Is it to select files from the > 100 ones or is it to select images from the 300,000 ones? In the first > case I would use IntMap, in the latter case I would use Interval data > structures. Yes exactly these range are there to select an hundred files from a series of thousans :). then for each file I have the number of images. at the end I have a dedicated type called Chunk which allows to split the stream But you are right at this stage I do not need the initial range, since I already have the file name and the number of image Cheers data Chunk n a = Chunk !a !n !n deriving instance (Show n, Show a) => Show (Chunk n a) cweight :: Num n => Chunk n a -> n cweight (Chunk _ l h) = h - l csplit :: Num n => Chunk n a -> n -> (Chunk n a, Chunk n a) csplit (Chunk a l h) n = (Chunk a l (l + n), Chunk a (l+n) h) chunk :: (Num n, Ord n) => n -> [Chunk n a] -> [[Chunk n a]] chunk target = go target target where go :: (Num n, Ord n) => n -> n -> [Chunk n a] -> [[Chunk n a]] go _ _ [] = [] go tgt gap [x] = golast tgt gap x go tgt gap ~(x:xs) = let gap' = gap - cweight x in if | gap' > 0 -> cons1 x $ go tgt gap' xs | gap' == 0 -> [x] : go tgt tgt xs | (x1, x2) <- csplit x gap -> [x1] : go tgt tgt (x2 : xs) cons1 x cs = (x : Prelude.head cs) : tail cs golast tgt gap x = if | cweight x <= gap -> [[x]] | (x1, x2) <- csplit x gap -> [x1] : golast tgt tgt x2 {-# SPECIALIZE chunk :: Int -> [Chunk Int FilePath] -> [[Chunk Int FilePath]] #-} From lemming at henning-thielemann.de Mon Oct 4 17:04:54 2021 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Mon, 4 Oct 2021 19:04:54 +0200 (CEST) Subject: [Haskell-cafe] Terminator syntax style (Was: Nested (=>) (Was: On finding the right exposition...)) In-Reply-To: <20211004163633.GG512@cloudinit-builder> References: <20211004163633.GG512@cloudinit-builder> Message-ID: On Mon, 4 Oct 2021, Tom Ellis wrote: > On Mon, Oct 04, 2021 at 06:12:13PM +0200, Henning Thielemann wrote: >> >> I use nested (=>) frequently. GHC allows it in type signatures but not in >> super-class constraints. Would be cool to be allowed everywhere, as it >> supports the "terminator syntax style". > > Could you say what "terminator syntax style" is? I'm not finding any > hits on popular search engines. https://wiki.haskell.org/Terminator_vs._separator From ben.franksen at online.de Mon Oct 4 20:16:59 2021 From: ben.franksen at online.de (Ben Franksen) Date: Mon, 4 Oct 2021 22:16:59 +0200 Subject: [Haskell-cafe] Pattern guards seen in the wild? In-Reply-To: <60b6a0c6-c8bc-d0cf-1816-a5c1a24b2b0d@tomsmeding.com> References: <60b6a0c6-c8bc-d0cf-1816-a5c1a24b2b0d@tomsmeding.com> Message-ID: Am 01.10.21 um 09:04 schrieb Tom Smeding: > 2. Actually a special case of (1.): this is particularly useful with > GADTs and "discovered" type evidence, like in > https://github.com/AccelerateHS/accelerate/blob/1ab75f1eb01a1b427563808057d46f29d99bb4dc/src/Data/Array/Accelerate/Prelude.hs#L1429 > . Yes, exactly. It is not allowed to do that in let-bindings (including where-clauses), only in case matches, pattern guards, and monadic binds. Cheers Ben -- I would rather have questions that cannot be answered, than answers that cannot be questioned. -- Richard Feynman From stuart.hungerford at gmail.com Mon Oct 4 22:01:19 2021 From: stuart.hungerford at gmail.com (Stuart Hungerford) Date: Tue, 5 Oct 2021 09:01:19 +1100 Subject: [Haskell-cafe] Vectors, vector spaces and type-level Haskell In-Reply-To: <7069535-c825-447d-8cd2-b6c4207e532e@henning-thielemann.de> References: <7069535-c825-447d-8cd2-b6c4207e532e@henning-thielemann.de> Message-ID: On Tue, Oct 5, 2021 at 3:05 AM Henning Thielemann wrote: > > I'd like to model in Haskell two-dimensional vectors that "belong to" > > or "have an ambient space of" a two dimensional vector space. > > If you only need two dimensional vectors, you might be happy with > Data.Complex. I hadn't thought of that -- thanks. Stu From stuart.hungerford at gmail.com Mon Oct 4 22:06:19 2021 From: stuart.hungerford at gmail.com (Stuart Hungerford) Date: Tue, 5 Oct 2021 09:06:19 +1100 Subject: [Haskell-cafe] Vectors, vector spaces and type-level Haskell In-Reply-To: References: Message-ID: On Mon, Oct 4, 2021 at 2:35 PM Stuart Hungerford wrote: > I'd like to model in Haskell two-dimensional vectors that "belong to" > or "have an ambient space of" a two dimensional vector space. I'm also > ignoring for now the issue of which field the vector space is over. I > realize this is not strictly necessary to just start using 2D vectors, > but I would like to bring the vector space in as a first class > concept. After much googling and searching Hackage, I found these references useful (note that "vectors" in these references sometimes refer to arrays of fixed length and sometimes to elements of a vector space): https://mmhaskell.com/machine-learning/dependent-types https://serokell.io/blog/dimensions-and-haskell-introduction https://hackage.haskell.org/package/linear-1.20.4/docs/Linear-V2.html http://mstksg.github.io/hmatrix/Numeric-LinearAlgebra-Static.html https://hackage.haskell.org/package/vector-space-0.16/docs/Data-VectorSpace.html https://hackage.haskell.org/package/fixed-vector-1.2.0.0/docs/Data-Vector-Fixed.html https://diagrams.github.io/doc/vector.html Stu From stuart.hungerford at gmail.com Mon Oct 4 22:13:28 2021 From: stuart.hungerford at gmail.com (Stuart Hungerford) Date: Tue, 5 Oct 2021 09:13:28 +1100 Subject: [Haskell-cafe] Haskell-Cafe Digest, Vol 218, Issue 5 In-Reply-To: References: Message-ID: On Mon, Oct 4, 2021 at 11:10 PM wrote: > [...] > The V2 and V3 etc. types provided by the linear package (which you > already found) model vectors in 2- and 3-dimensional real vector spaces, > over the field given by their 'a' type parameter. Wanting to add a > vector from a 2-dimensional vector space over 'a' and a vector from a > 3-dimensional vector space over 'b' entails adding a 'V2 a' and 'V3 b'; > those are distinct types. The vector space of 'V2 a' is morally 'a^2'. > > It seems this satisfies what you want. Are there other guarantees you > want enforced at compile time that this cannot give you? Thanks Tom -- you're right this is enough for compile time guarantees. This need to encode dimensionality into a type seems to be a compelling use-case for type-level numbers or other type-level capabilities (which I've avoided learning about until now). Stu From lemming at henning-thielemann.de Mon Oct 4 22:14:14 2021 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Tue, 5 Oct 2021 00:14:14 +0200 (CEST) Subject: [Haskell-cafe] Vectors, vector spaces and type-level Haskell In-Reply-To: References: Message-ID: <3e758ecc-1db8-3570-6671-a1385e17db2@henning-thielemann.de> On Tue, 5 Oct 2021, Stuart Hungerford wrote: > On Mon, Oct 4, 2021 at 2:35 PM Stuart Hungerford > wrote: > >> I'd like to model in Haskell two-dimensional vectors that "belong to" >> or "have an ambient space of" a two dimensional vector space. I'm also >> ignoring for now the issue of which field the vector space is over. I >> realize this is not strictly necessary to just start using 2D vectors, >> but I would like to bring the vector space in as a first class >> concept. > > After much googling and searching Hackage, I found these references > useful (note that "vectors" in these references sometimes refer to > arrays of fixed length and sometimes to elements of a vector space): > > https://mmhaskell.com/machine-learning/dependent-types > > https://serokell.io/blog/dimensions-and-haskell-introduction > > https://hackage.haskell.org/package/linear-1.20.4/docs/Linear-V2.html > > http://mstksg.github.io/hmatrix/Numeric-LinearAlgebra-Static.html You may also use https://hackage.haskell.org/package/comfort-array with https://hackage.haskell.org/package/comfort-array-0.5.1/docs/Data-Array-Comfort-Shape.html#t:Enumeration or https://hackage.haskell.org/package/comfort-array-shape-0.0/docs/Data-Array-Comfort-Shape-Static.html and https://hackage.haskell.org/package/lapack But it will be overkill for two-dimensional vectors. From stuart.hungerford at gmail.com Mon Oct 4 23:11:02 2021 From: stuart.hungerford at gmail.com (Stuart Hungerford) Date: Tue, 5 Oct 2021 10:11:02 +1100 Subject: [Haskell-cafe] Vectors, vector spaces and type-level Haskell In-Reply-To: <3e758ecc-1db8-3570-6671-a1385e17db2@henning-thielemann.de> References: <3e758ecc-1db8-3570-6671-a1385e17db2@henning-thielemann.de> Message-ID: On Tue, 5 Oct 2021 at 9:14 am, Henning Thielemann < lemming at henning-thielemann.de> wrote: > > […] > You may also use > https://hackage.haskell.org/package/comfort-array > > with > > https://hackage.haskell.org/package/comfort-array-0.5.1/docs/Data-Array-Comfort-Shape.html#t:Enumeration > or > > https://hackage.haskell.org/package/comfort-array-shape-0.0/docs/Data-Array-Comfort-Shape-Static.html > > and > https://hackage.haskell.org/package/lapack > > But it will be overkill for two-dimensional vectors. > Thanks—will check those out. Stu -------------- next part -------------- An HTML attachment was scrubbed... URL: From anthony.d.clayden at gmail.com Tue Oct 5 05:28:15 2021 From: anthony.d.clayden at gmail.com (Anthony Clayden) Date: Tue, 5 Oct 2021 18:28:15 +1300 Subject: [Haskell-cafe] On finding the right exposition... Message-ID: > ... I never understood why (->) is right associative in types, but (=>) is not and you are instead supposed to pack constraints in a tuple. `-XRankNTypes` enables something called Rank 1 types, which accepts this: > foo :: Ord a => Num b => a -> Show b => b > -- foo :: (Ord a, Num b, Show b) => a -> b -- inferred/canonical We should also have: > bar :: forall a. forall {- empty -}. forall b. blah > -- bar :: forall a b. blah -- equivalent But `PatternSynonyms` drives a cart and horses through that: you must have exactly 2 `... => ... => ...` and exactly 2 `forall`s (possibly empty) -- that is, if you explicitly quantify at all. Or you can go: > MyPat :: Num a => a -> Baz a -- which is shorthand for > MyPat :: Num a => () => a -> Baz a -- which is equiv to > MyPat :: Num a => Num a => a -> Baz a > MyPat :: () => Num a => a -> Baz a -- this means something different -------------- next part -------------- An HTML attachment was scrubbed... URL: From ben.franksen at online.de Tue Oct 5 05:31:56 2021 From: ben.franksen at online.de (Ben Franksen) Date: Tue, 5 Oct 2021 07:31:56 +0200 Subject: [Haskell-cafe] Nested (=>) (Was: On finding the right exposition...) In-Reply-To: References: Message-ID: Am 04.10.21 um 18:12 schrieb Henning Thielemann: > On Mon, 4 Oct 2021, Ben Franksen wrote: >> Talking of inconsistencies, Haskell is not without some of those. For >> instance, I never understood why (->) is right associative in types, >> but (=>) is not and you are instead supposed to pack constraints in a >> tuple. (It works in some simple cases but not consistently.) > > I use nested (=>) frequently. GHC allows it in type signatures but not > in super-class constraints. Would be cool to be allowed everywhere, as > it supports the "terminator syntax style". I am having second thoughts. The analogy of => with -> breaks down when you consider that the order of constraints never matters. Despite the tuple-like notation, I guess the better intuition is that constraints are always sets, "," is union, and simple constraints are singleton sets. This also works better when using constraint synonyms such as type OrderedNum a = (Num a, Ordered a) I can write f :: (OrderedNum a, Floating a) => a -> a which would otherwise be a nested tuple? Cheers Ben -- I would rather have questions that cannot be answered, than answers that cannot be questioned. -- Richard Feynman From fumiexcel at gmail.com Tue Oct 5 07:13:04 2021 From: fumiexcel at gmail.com (Fumiaki Kinoshita) Date: Tue, 5 Oct 2021 16:13:04 +0900 Subject: [Haskell-cafe] Massaging data from the `extensible` package In-Reply-To: References: Message-ID: By design, extensible does not provide combinators that change the set of field names (aside from cons and append). Such combinators can easily be abused and make the code difficult to reason about. Matrix multiplication is one reasonable way to define a dimension-changing transformation. This example demonstrates a function that changes the field from Int to Bool. runMatrix requires the resulting record to be a Monoid, but it can trivially be provided by changing the wrapper type from Identity to First. ``` {-# LANGUAGE TypeOperators, PolyKinds, FlexibleContexts, DataKinds #-} import Data.Extensible import Data.Monoid newtype Row g h xs c = Row { unRow :: Comp ((->) (g c)) h :* xs } runMatrix :: Monoid (h :* ys) => Row g h ys :* xs -> g :* xs -> h :* ys runMatrix mat r = hfoldMap getConst $ hzipWith (\x (Row y) -> Const $ hmap (\(Comp f) -> f x) y) r mat isEven :: First :* '[Int] -> First :* '[Bool] isEven = runMatrix $ Row (Comp (fmap (==0)) <: nil) <: nil ``` 2021年10月4日(月) 22:54 Ruben Astudillo : > Hello cafe > > I have been enjoying the `extensible` package [1] for extensible records > and > variants, kudos to the author. I have had a problem of not understanding > how > to "massage" data from one representation to another. To exemplify, suppose > I have the following two extensible records > > {-# language OverloadedLabels #-} > > import Data.Extensible > import Control.Lens > > type Ext1 = Record '[ "field1" >: String, "field2" >: Integer ] > type Ext2 = Record '[ "field1" >: Text, "field2" >: Double ] > > and I want to map some piece of data between these two types. Currently I > am > projecting each field individually like this > > ex1 :: Ext1 > ex1 = #field1 @= "hello" <: #field2 @= 2.71 <: nil > > currentMap :: Ext1 -> Ext2 > currentMap s = > #field1 @= T.pack (view #field1 s) > <: #field2 @= fromInteger (view #field2 s) > <: nil > > For data types with few fields it is not so bad. But I have to do this > transformation of data types generated from TH, I am dealing with a few > dozens. The transformations are always from `String -> Text` and `Integer > -> > Double`. I would like to write a high lever combinator that grabs an > extensible record, transforms each `String` field on a `Text` one and does > the same with `Integer -> Double`. > > Most of the combinators for transforming the data deal with natural > transformations, such as hmap, hsequence and the like. The closest one to > what I want is `hfoldMapFor` where I have to define a class with instances > for all the types the extensible record has, but it doesn't let me change > the type of the result. Does anyone have an idea on how to solve this? > > Thanks for your time. > > [1]: https://hackage.haskell.org/package/extensible > > -- > Rubén. (pgp: 4EE9 28F7 932E F4AD) > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From douglas.mcilroy at dartmouth.edu Tue Oct 5 15:59:25 2021 From: douglas.mcilroy at dartmouth.edu (Douglas McIlroy) Date: Tue, 5 Oct 2021 11:59:25 -0400 Subject: [Haskell-cafe] On finding the right exposition Message-ID: >> Aside: to this day, that sort of ad-hoc syntax makes me gag. K&R should be > publicly flogged on a regular basis. > And for so many other reasons, too, like mandating a preprocessor (with > a complex, operationally defined semantics) simply because they couldn't > be bothered to design a (simple, 1st order) module system. Manners, please. Such immoderate words have no place on this mailing list. Doug From lists at richarde.dev Tue Oct 5 16:00:47 2021 From: lists at richarde.dev (Richard Eisenberg) Date: Tue, 5 Oct 2021 16:00:47 +0000 Subject: [Haskell-cafe] More Nested =>s (was: On finding the right exposition...) In-Reply-To: References: Message-ID: <010f017c512f9f18-14e4eb1b-b412-40e3-8656-1c4ed63a9748-000000@us-east-2.amazonses.com> Because things on the internet live forever, I want to correct a few small misunderstandings here: > On Oct 5, 2021, at 1:28 AM, Anthony Clayden wrote: > `-XRankNTypes` enables something called Rank 1 types, which accepts this: The -XRankNTypes extension is a bit of an unfortunate name. My best understanding is: Ranks are cumulative: all rank-0 types are rank-1 types, all rank-0 and rank-1 types are rank-2 types, etc. A rank-0 type has no quantification (that is, no "forall", implicit or explicit). Examples: > ex1 :: Int -> Int > ex2 :: Bool -> String -> [Int] Non-examples: > ex3 :: [a] -> Int > ex4 :: String -> a > ex5 :: forall a. a -> a > ex6 :: a -> Bool > ex7 :: (forall a. a -> a -> a) -> Int -> Int A rank-1 type includes the above and can quantify type variables only at the top level or to the right of arrows. (That is, the `forall` can be the right child of an arrow node in the abstract syntax tree.) Examples: > ex8 :: a -> a > ex9 :: forall a. a -> a > ex10 :: a -> b -> a > ex11 :: forall a. forall b. a -> b -> a > ex12 :: forall a. a -> forall b. b -> a > ex13 :: Int -> forall a. a -> a -> a > ex14 :: forall a. Int Non-examples: > ex15 :: (forall a. a -> a -> a) -> Int -> Int > ex16 :: (forall a b. a -> b -> a) -> Int A rank-2 type includes the above and can quantify type variables to the left of one arrow. (That is, the `forall` can be within the left child of an arrow node in the abstract syntax tree, as long as that arrow node is not within the left child of any other arrow node.) Examples: > ex17 :: (forall a. a -> a -> a) -> Int -> Int > ex18 :: (forall a b. a -> b -> a) -> () > ex19 :: forall r. (forall a. a -> a -> r) -> r > ex20 :: Int -> (forall a. a -> a -> a) -> Int > ex21 :: (Int -> forall a. a -> a) -> Bool Non-example: > ex21 :: ((forall a. a -> a) -> Int) -> Bool A rank-3 type includes the above and can quantify type variables to the left of two arrows. (That is, the `forall` can be within the left child of an arrow node that is within the left child of an arrow node, as long as that last arrow node is not within the left child of any other arrow node.) Example: > ex22 :: ((forall a. a -> a) -> Int) -> Bool Non-example: > ex23 :: Int -> (((forall a. a -> a) -> Bool) -> Double) -> Char And so on. GHC considers constraint quantification (that is, =>) to be similar to variable quantification. So, in GHC parlance, we lump any constraints in with variable quantification when considering the rank of a type. We would thus consider > ex24 :: forall a. (Show a => a -> a) -> a -> String to be a rank-2 type, even though a type theorist would call it a rank-1 type. Haskell98 allows a subset of rank-1 types; this subset uses what is called prenex quantification. A prenex-quantified type has all of its variable (and, in GHC, constraint) quantification all the way at the top, not under any arrows at all. Examples of prenex quantification: > ex25 :: a -> a > ex26 :: forall a b. a -> b -> a > ex27 :: Show a => a -> String Non-examples: > ex28 :: Int -> forall a. a -> a > ex29 :: Show a => Ord a => a -> Int GHC's -XRankNTypes extension allows types of arbitrary rank, and those which are non-prenex. So, > ex30 :: Show a => Num a => Eq a => a -> a -> Bool is rank-1, but it is non-prenex. It thus requires the -XRankNTypes extension. This is why RankNTypes is perhaps a poor name: it does more than allow higher-rank types. It allows non-prenex types, too. (All types higher that are not rank-1 are also non-prenex.) > > > foo :: Ord a => Num b => a -> Show b => b As AntC says, this type is rank-1, and yet it needs -XRankNTypes. However, all prenex rank-1 types are accepted without any extension. > > bar :: forall a. forall {- empty -}. forall b. blah > > -- bar :: forall a b. blah -- equivalent These are mostly equivalent. The only difference is how -XScopedTypeVariables treats them: the first one will bring `a` into scope in the body of `bar`, while the second has both `a` and `b` in scope in the body of `bar`. > > But `PatternSynonyms` drives a cart and horses through that: Yes! Pattern synonym type signatures are not types. They are Something Else, which I'll call a patsyn-type. A patsyn-type has 6 components: - Universally quantified variables are inputs to the pattern. We must know how to instantiate these to use the pattern. - Required constraints are inputs to the pattern. We must satisfy these constraints to use the pattern. - Existentially quantified variables are outputs of the pattern. After the pattern match is successful, these type variables are bound. - Provided constraints are outputs of the pattern. After the pattern match is successful, we can assume the truth of these constraints. - Arguments are the types of the variables bound by the pattern. - The result type of the pattern is the type of the thing being pattern-matched against (aka the "scrutinee"). > you must have exactly 2 `... => ... => ...` Not quite: - If you have 0 =>s, then we assume that there are no required constraints, no existentially quantified variables, and no provided constraints. - If you have 1 =>, then the constraints to its left are required. Any forall to its immediate right lists the existentially quantified variables. There are no provided constraints. - If you have 2 =>s, then the constraints to the left of the first one are the required ones, the constraints to the left of the second one are the provided ones. - If you have 3 or more =>s, then the result type is a quantified type. This is quite strange, but possible, if you, say, have a view pattern whose function has a higher-rank type: > data Eqy a = Eq a => MkEqy > > blah :: (Num a => a) -> Eqy a > blah _ = undefined > > pattern P :: Show a => Eq a => Num a => a > pattern P <- (blah -> MkEqy) This is accepted by GHC 8.10.5. > and exactly 2 `forall`s (possibly empty) -- that is, if you explicitly quantify at all. Or you can go: > > > MyPat :: Num a => a -> Baz a -- which is shorthand for > > MyPat :: Num a => () => a -> Baz a -- which is equiv to Yes. These signatures are equivalent. > > MyPat :: Num a => Num a => a -> Baz a But this is something else. This MyPat has a provided constraint Num a, where as the others did not. > > MyPat :: () => Num a => a -> Baz a -- this means something different This is also something else: this has no required constraint at all. I hope this is helpful! Richard > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From olf at aatal-apotheke.de Tue Oct 5 19:36:36 2021 From: olf at aatal-apotheke.de (Olaf Klinke) Date: Tue, 5 Oct 2021 21:36:36 +0200 (CEST) Subject: [Haskell-cafe] Rank2Types in let bindings Message-ID: Dear Cafe, apologies if this is a duplicate question. I want to define an element of a Rank-2 type, use its specialization and then return the general thing. Apparently this is not possible without a newtype. {-# LANGUAGE RankNTypes #-} newtype General = General { useGeneral :: forall a. Integral a => a -> Bool } doesNotWork :: General doesNotWork = let g = even :: forall a. Integral a => a -> Bool b = specializeGeneral g in General g doesWork :: General doesWork = let g = General even b = specializeGeneral (useGeneral g) in g specializeGeneral :: (Int -> Bool) -> Bool specializeGeneral p = p 5 I was under the impression that one can always use a more general type where a more special type is needed. In `doesNotWork` above, despite the explicit Rank-2 type annotation, usage in `specializeGeneral` apparently makes the compiler infer the type of `g` to be (Int -> Bool) and complains that `a` can not me matched with `Bool`. What gets me is that the compiler error is at `General g`, so the compiler must have ignored my Rank-2 type annotation. Should it be allowed to do that? Olaf From lysxia at gmail.com Tue Oct 5 19:50:00 2021 From: lysxia at gmail.com (Li-yao Xia) Date: Tue, 5 Oct 2021 15:50:00 -0400 Subject: [Haskell-cafe] Rank2Types in let bindings In-Reply-To: References: Message-ID: <0ee5156c-64a7-04db-41e4-fde8841933a9@gmail.com> Hi Olaf, This is the monomorphism restriction. g is a binding without a signature, so it gets specialized. The type annotation is part of the body of g, but if you want to generalize g it should be a separate declaration let g :: forall ... g = ... On 10/5/2021 3:36 PM, Olaf Klinke wrote: > Dear Cafe, > > apologies if this is a duplicate question. I want to define an element > of a Rank-2 type, use its specialization and then return the general > thing. Apparently this is not possible without a newtype. > > {-# LANGUAGE RankNTypes #-} > newtype General = General { >    useGeneral :: forall a. Integral a => a -> Bool >    } > > doesNotWork :: General > doesNotWork = let >         g = even :: forall a. Integral a => a -> Bool >         b = specializeGeneral g >         in General g > > doesWork :: General > doesWork = let >         g = General even >         b = specializeGeneral (useGeneral g) >         in g > > specializeGeneral :: (Int -> Bool) -> Bool > specializeGeneral p = p 5 > > I was under the impression that one can always use a more general type > where a more special type is needed. In `doesNotWork` above, despite the > explicit Rank-2 type annotation, usage in `specializeGeneral` apparently > makes the compiler infer the type of `g` to be (Int -> Bool) and > complains that `a` can not me matched with `Bool`. What gets me is that > the compiler error is at `General g`, so the compiler must have ignored > my Rank-2 type annotation. Should it be allowed to do that? > > Olaf > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From michael.eugene.turner at gmail.com Wed Oct 6 13:55:16 2021 From: michael.eugene.turner at gmail.com (Michael Turner) Date: Wed, 6 Oct 2021 22:55:16 +0900 Subject: [Haskell-cafe] Public floggings Message-ID: >> Aside: to this day, that sort of ad-hoc syntax makes me gag. K&R should be > publicly flogged on a regular basis. Since I'm to blame for raising the subject that turned into a thread about "the right exposition", I hereby surrender myself to be flogged in lieu of the intended. I've deserved it for years, just for how I've found perversely delightful ways to use the C preprocessor. Especially token-pasting. K&R (the book) was almost indecent exposure -- it left nothing to the imagination. As opposed to most writing on Haskell, where I'm befuddled because it's not at all obvious how it does its thing. It's like you're not /supposed/ to know. But K&R let it all hang out, and for that reason, I loved it. Whip me, beat me, make me write C code. Because that's just the kind of pervert I am. Still, sometimes. Regards, Michael Turner Executive Director Project Persephone 1-25-33 Takadanobaba Shinjuku-ku Tokyo 169-0075 Mobile: +81 (90) 5203-8682 turner at projectpersephone.org Understand - http://www.projectpersephone.org/ Join - http://www.facebook.com/groups/ProjectPersephone/ Donate - http://www.patreon.com/ProjectPersephone Volunteer - https://github.com/ProjectPersephone "Love does not consist in gazing at each other, but in looking outward together in the same direction." -- Antoine de Saint-Exupéry From branimir.maksimovic at gmail.com Wed Oct 6 21:29:54 2021 From: branimir.maksimovic at gmail.com (Branimir Maksimovic) Date: Wed, 6 Oct 2021 23:29:54 +0200 Subject: [Haskell-cafe] mine sockets lib vs yesod In-Reply-To: References: <92299499-8D63-4176-9975-62CC87C62FE3@gmail.com> Message-ID: Oh gosh, my test wasn’t fair. I tested mine on Linux, while yesod on macOS, and seems that macOS has much weaker tcp stack, as I have found out now… Greets, Branimir. > On 27.09.2021., at 12:16, Branimir Maksimovic wrote: > > > >> On 27.09.2021., at 12:13, Mikolaj Konarski wrote: >> >> Hi Branimir, >> >>> I guess that if I port it to Haskell purely from CPP, I won’t have problems with copyright? >> >> I will retain exactly the same copyright it had. To get rid of the old >> copyright, you'd need to clean-room re-implement it (you yell ideas >> from another room and somebody implements them in Haskell not having >> seen the CPP code beforehand). > > OK. > >> >>> if using -threaded performance is *worse*. >> >> This is normal. You trade performance for the ability to pre-empt >> (e.g., not get stuck on blocking FFI). >> >> Kind regards, >> Mikolaj > > I will implement it whole in Haskell, in async fashion as it seems with > current hardware bandwith is saturated with just single CPU/Core. > > Greettings, Branimir. From douglas.mcilroy at dartmouth.edu Thu Oct 7 14:54:43 2021 From: douglas.mcilroy at dartmouth.edu (Douglas McIlroy) Date: Thu, 7 Oct 2021 10:54:43 -0400 Subject: [Haskell-cafe] Terminator syntax style (Was: Nested (=>) (Was: On finding the right exposition...)) Message-ID: >> Could you say what "terminator syntax style" is? I'm not finding any >> hits on popular search engines. > https://wiki.haskell.org/Terminator_vs._separator Apropos of "finding the right exposition", consider this definition in the cited wiki article: Separator: There is a symbol between each element. The more carefully you read this the more it becomes nonsense. 1, "Each element" is an individual. You can't put something between an individual. 2 The defining sentence states a property of a representation of a sequence. It fails to indicate that "separator" is the symbol's role. In fact what's being defined is "separator notation", not the bare word "separator". The proper usage appears only later in the article. It should be employed throughout--most importantly in the title and the definition. The same goes for "terminator". Doug From olf at aatal-apotheke.de Thu Oct 7 17:26:03 2021 From: olf at aatal-apotheke.de (Olaf Klinke) Date: Thu, 07 Oct 2021 19:26:03 +0200 Subject: [Haskell-cafe] Monomorphism restriction [Was: Rank2Types in let bindings] Message-ID: <3a603c93156d4064e4273fd2792004e4ac35efa6.camel@aatal-apotheke.de> > > {-# LANGUAGE RankNTypes #-} > > newtype General = General { > > useGeneral :: forall a. Integral a => a -> Bool > > } > > > > doesNotWork :: General > > doesNotWork = let > > g = even :: forall a. Integral a => a -> Bool > > b = specializeGeneral g > > in General g > > > > doesWork :: General > > doesWork = let > > g = General even > > b = specializeGeneral (useGeneral g) > > in g > > > > specializeGeneral :: (Int -> Bool) -> Bool > > specializeGeneral p = p 5 > > > > I was under the impression that one can always use a more general type > > where a more special type is needed. In `doesNotWork` above, despite the > > explicit Rank-2 type annotation, usage in `specializeGeneral` apparently > > makes the compiler infer the type of `g` to be (Int -> Bool) and > > complains that `a` can not me matched with `Bool`. What gets me is that > > the compiler error is at `General g`, so the compiler must have ignored > > my Rank-2 type annotation. Should it be allowed to do that? > > > > Olaf > > Hi Olaf, > > This is the monomorphism restriction. g is a binding without a > signature, so it gets specialized. The type annotation is part of the > body of g, but if you want to generalize g it should be a separate > declaration > > let g :: forall ... > g = ... > Oh, thanks! I should have suspected. But somehow I feel my type annotation should have circumvented the monomorphism restriction. So g = even is a pattern binding and therefore subject to monomorphism restriction, regardless of following type annotation? So thanks for teaching me that it is not irrelevant where to place a type annotation. To this day I believed that name = expression :: type and name :: type name = expression are equivalent because one is syntactic sugar for the other. Do the two give rise to different elements in the abstract syntax tree? Am I the only one who finds this odd? Which Haskell book should I have read to be aware of this? The Consequences part in Section 4.5.5 of the Haskell report mentions the distinction between function an pattern bindings, but is not clear about the position of the type annotation. It merely states "the user must be careful to affix these [pattern bindings] with type signatures to retain full overloading". Olaf From allbery.b at gmail.com Thu Oct 7 17:35:59 2021 From: allbery.b at gmail.com (Brandon Allbery) Date: Thu, 7 Oct 2021 13:35:59 -0400 Subject: [Haskell-cafe] Monomorphism restriction [Was: Rank2Types in let bindings] In-Reply-To: <3a603c93156d4064e4273fd2792004e4ac35efa6.camel@aatal-apotheke.de> References: <3a603c93156d4064e4273fd2792004e4ac35efa6.camel@aatal-apotheke.de> Message-ID: And just to complicate things more, there is also MonoLocalBinds which monomorphizes certain let bindings and is turned on by some extensions (iirc including type families) because they get much harder to type otherwise. On Thu, Oct 7, 2021 at 1:30 PM Olaf Klinke wrote: > > > > {-# LANGUAGE RankNTypes #-} > > > newtype General = General { > > > useGeneral :: forall a. Integral a => a -> Bool > > > } > > > > > > doesNotWork :: General > > > doesNotWork = let > > > g = even :: forall a. Integral a => a -> Bool > > > b = specializeGeneral g > > > in General g > > > > > > doesWork :: General > > > doesWork = let > > > g = General even > > > b = specializeGeneral (useGeneral g) > > > in g > > > > > > specializeGeneral :: (Int -> Bool) -> Bool > > > specializeGeneral p = p 5 > > > > > > I was under the impression that one can always use a more general type > > > where a more special type is needed. In `doesNotWork` above, despite > the > > > explicit Rank-2 type annotation, usage in `specializeGeneral` > apparently > > > makes the compiler infer the type of `g` to be (Int -> Bool) and > > > complains that `a` can not me matched with `Bool`. What gets me is > that > > > the compiler error is at `General g`, so the compiler must have > ignored > > > my Rank-2 type annotation. Should it be allowed to do that? > > > > > > Olaf > > > > Hi Olaf, > > > > This is the monomorphism restriction. g is a binding without a > > signature, so it gets specialized. The type annotation is part of > the > > body of g, but if you want to generalize g it should be a separate > > declaration > > > > let g :: forall ... > > g = ... > > > > Oh, thanks! I should have suspected. But somehow I feel my type > annotation should have circumvented the monomorphism restriction. So > g = even > is a pattern binding and therefore subject to monomorphism restriction, > regardless of following type annotation? > > So thanks for teaching me that it is not irrelevant where to place a > type annotation. To this day I believed that > name = expression :: type > and > name :: type > name = expression > are equivalent because one is syntactic sugar for the other. Do the two > give rise to different elements in the abstract syntax tree? Am I the > only one who finds this odd? Which Haskell book should I have read to > be aware of this? The Consequences part in Section 4.5.5 of the Haskell > report mentions the distinction between function an pattern bindings, > but is not clear about the position of the type annotation. It merely > states "the user must be careful to affix these [pattern bindings] with > type signatures to retain full overloading". > > Olaf > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -- brandon s allbery kf8nh allbery.b at gmail.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From anthony.d.clayden at gmail.com Thu Oct 7 19:52:51 2021 From: anthony.d.clayden at gmail.com (Anthony Clayden) Date: Fri, 8 Oct 2021 08:52:51 +1300 Subject: [Haskell-cafe] Public floggings Message-ID: > how I've found perversely delightful ways to use the C preprocessor. Especially token-pasting. Then boy! do I have an offer for you/you'll be like a pig in muck. There's a Haskell compiler written in C++, using all the tricks you love: * #define nested inside #if, so you're never quite sure which version of a macro is in play. * #defines that expand to a series of assignments and routine calls. * Module-wide and global variables that get updated as side-effects of routine calls (as well as those routines passing back results) * All data structures being cons pairs deeply nested, typically routines poke into hd(hd(tl(e))) or some such. Someone's generously put the source online https://github.com/FranklinChen/hugs98-plus-Sep2006/tree/master/src You can load it up into Visual Studio, and produce a genuine Windows executable with a Haskell REPL. (Ah, silly me, of course you'd want the familiar *nix command line -- that's even easier.) And there's real work you could contribute to https://mail.haskell.org/pipermail/hugs-bugs/2021-October/thread.html Enjoy! -------------- next part -------------- An HTML attachment was scrubbed... URL: From amindfv at mailbox.org Fri Oct 8 02:15:07 2021 From: amindfv at mailbox.org (Ttt Mmm) Date: Fri, 8 Oct 2021 04:15:07 +0200 (CEST) Subject: [Haskell-cafe] Partially applied type synonyms Message-ID: <1567260498.44559.1633659307563@office.mailbox.org> I was surprised to find the below code doesn't typecheck even with -XLiberalTypeSynonyms. Am I missing something or is this really not possible? Thanks, Tom --- {-# LANGUAGE FlexibleInstances, KindSignatures, LiberalTypeSynonyms, StandaloneDeriving #-} -- This works: data Foo s x = Foo (s x) x deriving (Eq) -- This replacement doesn't: {- data Foo' sx x = Foo' sx x deriving (Eq) type Foo (s :: * -> *) (x :: *) = Foo' (s x) x -} data Bar (m :: * -> *) = Bar (m Int) -- Neither of these typecheck: x :: Bar (Foo Maybe) x = undefined deriving instance Eq (Bar (Foo Maybe)) -------------- next part -------------- An HTML attachment was scrubbed... URL: From anthony.d.clayden at gmail.com Fri Oct 8 03:33:07 2021 From: anthony.d.clayden at gmail.com (Anthony Clayden) Date: Fri, 8 Oct 2021 16:33:07 +1300 Subject: [Haskell-cafe] Partially applied type synonyms Message-ID: > I was surprised to find the below code doesn't typecheck even with -XLiberalTypeSynonyms. Am I missing something or is this really not possible? Reading the error message would help: * The type synonym `Foo' should have 2 arguments, but has been given 1 -XLiberalTypeSynonyms relaxes the 'saturated application' rule a little https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/liberal_type_synonyms.html?highlight=type%20synonym#liberalised-type-synonyms "You can apply a type synonym to a partially applied type synonym:" But that isn't what you're doing. The docs say that still " ... malformedness ... * Partially-applied type synonym." Type Synonyms are not functions. Think of them as 'macro' expansions. Possibly your `Bar` could be a type synonym, taking `(Foo Maybe)` as an argument in the `instance Eq`. What type is it exactly that you want to derive an instance for? -------------- next part -------------- An HTML attachment was scrubbed... URL: From amindfv at mailbox.org Fri Oct 8 07:05:21 2021 From: amindfv at mailbox.org (Ttt Mmm) Date: Fri, 8 Oct 2021 09:05:21 +0200 (CEST) Subject: [Haskell-cafe] Partially applied type synonyms In-Reply-To: References: Message-ID: <2005357356.45920.1633676721562@office.mailbox.org> > On 10/08/2021 5:33 AM Anthony Clayden wrote: > > > > > I was surprised to find the below code doesn't typecheck even with -XLiberalTypeSynonyms. Am I missing something or is this really not possible? > > > Reading the error message would help: > > * The type synonym `Foo' should have 2 arguments, but has been given 1 > I'm not sure what in my question made it seem like I hadn't read this error message. With my code as written I can't apply both arguments, and I'm trying to solve the problem in front of me given that fact. > -XLiberalTypeSynonyms relaxes the 'saturated application' rule a little https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/liberal_type_synonyms.html?highlight=type%20synonym#liberalised-type-synonyms > > "You can apply a type synonym to a partially applied type synonym:" > > But that isn't what you're doing. The docs say that still > > " ... malformedness ... * Partially-applied type synonym." > > Type Synonyms are not functions. Think of them as 'macro' expansions. > Interestingly I get an almost identical error when defining Foo as a type family, which seems a lot more akin to a function. > Possibly your `Bar` could be a type synonym, taking `(Foo Maybe)` as an argument in the `instance Eq`. > Thank you for this concrete suggestion. I'd actually tried variations on this before asking on the list, and I've tried a few more just now, but I'm very willing to believe I'm simply not looking in the right place. Certainly a simple `type Bar' x = Bar x` isn't changing anything. > What type is it exactly that you want to derive an instance for? > Other than excluding unnecessary details, I've provided code that's pretty similar to the real code I'm working on. The biggest difference is that `Bar` is actually defined more like: data Bar (m :: * -> *) = Bar { a :: m Int, b :: m Bool, c :: m Double } So it really does need to take a `* -> *` type Thanks, Tom > _______________________________________________Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From branimir.maksimovic at gmail.com Fri Oct 8 07:18:49 2021 From: branimir.maksimovic at gmail.com (Branimir Maksimovic) Date: Fri, 8 Oct 2021 09:18:49 +0200 Subject: [Haskell-cafe] Partially applied type synonyms In-Reply-To: <1567260498.44559.1633659307563@office.mailbox.org> References: <1567260498.44559.1633659307563@office.mailbox.org> Message-ID: bmaxa at Branimirs-Air haskell % ghc -O2 dtchk.hs Loaded package environment from /Users/bmaxa/.ghc/aarch64-darwin-8.10.7/environments/default [1 of 1] Compiling Main ( dtchk.hs, dtchk.o ) Linking dtchk ... bmaxa at Branimirs-Air haskell % ./dtchk dtchk: Prelude.undefined CallStack (from HasCallStack): error, called at libraries/base/GHC/Err.hs:79:14 in base:GHC.Err undefined, called at dtchk.hs:10:5 in main:Main bmaxa at Branimirs-Air haskell % cat dtchk.hs {-# LANGUAGE FlexibleInstances, KindSignatures, LiberalTypeSynonyms, StandaloneDeriving, FlexibleContexts #-} data Foo sx x = Foo sx x deriving (Eq,Show) data Bar (m :: * -> *) = Bar (m Int) deriving instance Show a => Show (Bar (Foo a)) x :: Bar (Foo (Maybe Int)) x = undefined deriving instance Eq a => Eq (Bar (Foo a)) main = print x Greets, Branimir. > On 08.10.2021., at 04:15, Ttt Mmm via Haskell-Cafe wrote: > > {-# LANGUAGE FlexibleInstances, KindSignatures, LiberalTypeSynonyms, StandaloneDeriving #-} > -- This works: > data Foo s x = Foo (s x) x > deriving (Eq) > -- This replacement doesn't: > {- > data Foo' sx x = Foo' sx x > deriving (Eq) > type Foo (s :: * -> *) (x :: *) = Foo' (s x) x > -} > data Bar (m :: * -> *) = Bar (m Int) > > -- Neither of these typecheck: > x :: Bar (Foo Maybe) > x = undefined > deriving instance Eq (Bar (Foo Maybe)) -------------- next part -------------- An HTML attachment was scrubbed... URL: From compl.yue at icloud.com Fri Oct 8 11:53:57 2021 From: compl.yue at icloud.com (YueCompl) Date: Fri, 8 Oct 2021 19:53:57 +0800 Subject: [Haskell-cafe] Examples of Continuation monad that impossible to understand and maintain? In-Reply-To: References: <6E7245AA-AC07-4B68-BFBE-A1B012A8303F@icloud.com> <40C9B7EE-3F6F-4A63-AEDA-E1B9B4E02C37@mac.com> <1DDE28D3-0BAC-4B09-9286-D6106BC2C8E8@icloud.com> Message-ID: <16CF9A42-BA26-4FEF-9F9B-571B32F3C8AF@icloud.com> No surprise that both "goto" and "continuation" are enemies of "structured programming". But the reddit post says that Python generators can also be used to implement "goto", which I don't get how? I'd regard generator as a "safe" control flow mechanism w.r.t. structured programming, can it really escape? How? > On 2021-10-03, at 13:04, Andreas Källberg wrote: > > You can even implement goto on top of Cont. See for example this: https://www.reddit.com/r/haskell/comments/1jk06q/goto_in_haskell/ > >> On 1 Sep 2021, at 15:55, Isaac Elliott > wrote: >> >> I don't have any examples. Given that Cont essentially implements unstructured control flow, I think that examples of `goto` misuse would apply by analogy. >> >> On Wed, 1 Sep 2021, 4:31 pm YueCompl via Haskell-Cafe, > wrote: >> I can understand the purpose if it is advising against overusing surface syntax in CPS, but here the approach is to hide continuation beneath the beloved do notation on the surface, and monad laws plus possibly further laws to be added, will make it safer to program programs by end programmers. >> >> I do realize CPS is powerful yet dangerous (unsafe), abuse of CPS could be easy and quite unintentional, but what about abuse of "Continuation monad"? >> >>> On 2021-08-31, at 22:46, Jeff Clites via Haskell-Cafe > wrote: >>> >>> Based on the preceding paragraph, I think that by “abuse” it means overuse, as in using CPS when you could have used straightforward code. I can imagine someone doing at the source code level the sort of things that would be done by a CPS-based compiler (converting everything possible to CPS), and ending up with a mess. >>> >>> For example, imagine you started with this code snippet: >>> >>> let x = f a >>> y = g x >>> in h x y >>> >>> If you fully convert that to CPS you’d end up with 3 continuations (I think) and it would be much harder to understand. And adding an additional let binding later might involve a bunch of restructuring. >>> >>> I assume it just means that sort of thing. When someone first learns about continuations and their generality, it can be tempting to go overboard. >>> >>> Jeff >>> >>> On Aug 31, 2021, at 3:03 AM, YueCompl via Haskell-Cafe > wrote: >>> >>>> Dear Cafe, >>>> >>>> I'm wrapping up my CPS codebase to provide some monadic interface, it appears almost the Cont monad, so the following statement is a pretty valid caveat to me now: >>>> >>>> > Abuse of the Continuation monad can produce code that is impossible to understand and maintain. >>>> >>>> Which can be viewed in context of Hackage at: https://hackage.haskell.org/package/mtl/docs/Control-Monad-Cont.html#:~:text=Abuse%20of%20the%20Continuation%20monad%20can%20produce%20code%20that%20is%20impossible%20to%20understand%20and%20maintain >>>> >>>> But I can't find concrete examples demonstrating the "impossible to understand and maintain" situation, in figuring out what pitfalls I'd rather to avoid. >>>> >>>> Please share what you know about it, many appreciations! >>>> >>>> Background of my CPS necessarity: >>>> >>>> Library code need to delegate STM transaction boundary delimitation to (scripting) application code, though `inlineSTM :: STM a -> m a` can be used to force some action to be within current tx, the usual `>>=` binding should honor whether a separate `atomically` tx should be issued for its rhs computation, as specified by the scripting context. >>>> >>>> Thanks, >>>> Compl >>>> >>>> _______________________________________________ >>>> Haskell-Cafe mailing list >>>> To (un)subscribe, modify options or view archives go to: >>>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>>> Only members subscribed via the mailman list are allowed to post. >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> To (un)subscribe, modify options or view archives go to: >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>> Only members subscribed via the mailman list are allowed to post. >> >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From lists at richarde.dev Fri Oct 8 14:54:51 2021 From: lists at richarde.dev (Richard Eisenberg) Date: Fri, 8 Oct 2021 14:54:51 +0000 Subject: [Haskell-cafe] Partially applied type synonyms In-Reply-To: <1567260498.44559.1633659307563@office.mailbox.org> References: <1567260498.44559.1633659307563@office.mailbox.org> Message-ID: <010f017c606655c2-4f67de86-28e4-4d5e-accb-18276967e777-000000@us-east-2.amazonses.com> Hello Tom, Type synonyms must be fully applied. You could try > newtype Foo (s :: * -> *) (x :: *) = MkFoo (Foo' (s x) x) to make something that does not need to be fully applied -- but now you have to worry about the pesky MkFoo constructor. It's hard for me to suggest something else without understanding your use-case better. Sorry! Hope this helps, Richard > On Oct 7, 2021, at 10:15 PM, Ttt Mmm via Haskell-Cafe wrote: > > I was surprised to find the below code doesn't typecheck even with -XLiberalTypeSynonyms. Am I missing something or is this really not possible? > > Thanks, > Tom > > --- > > {-# LANGUAGE FlexibleInstances, KindSignatures, LiberalTypeSynonyms, StandaloneDeriving #-} > -- This works: > data Foo s x = Foo (s x) x > deriving (Eq) > -- This replacement doesn't: > {- > data Foo' sx x = Foo' sx x > deriving (Eq) > type Foo (s :: * -> *) (x :: *) = Foo' (s x) x > -} > data Bar (m :: * -> *) = Bar (m Int) > > -- Neither of these typecheck: > x :: Bar (Foo Maybe) > x = undefined > deriving instance Eq (Bar (Foo Maybe)) > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From emilypi at cohomolo.gy Fri Oct 8 23:36:13 2021 From: emilypi at cohomolo.gy (Emily Pillmore) Date: Fri, 08 Oct 2021 23:36:13 +0000 Subject: [Haskell-cafe] [ANN] Cabal-3.4.1.0, cabal-install-3.4.1.0, Cabal-3.6.2.0, and cabal-install-3.6.2.0 Message-ID: Hello Haskell, The Cabal team is excited to announce the release of `Cabal-3.6.2.0`, and `cabal-install-3.6.2.0`. ## Changelog for `Cabal-3.6.2.0` and `cabal-install-3.6.2.0` This is the fifth release of the 3.0 release series for both packages. This minor version release introduces a set of fixes for some regressions seen when the tool interacts with `autoconf`, as well as some fixes for regressions to the way Paths_ modules interact with non-standard preludes: - Making Paths_ modules work with non-standard preludes again [#5962]( https://github.com/haskell/cabal/issues/5962 ) - Generate Paths_ module with qualified Data.List.last import so that compatibility with non-standard preludes is not regressed compared to cabal 3.4. - Windows: redo the fix to breakage caused by new autoconf; the wrong fix made cabal sometimes fail with old autoconf [#7494]( https://github.com/haskell/cabal/issues/7494 ) [#7649]( https://github.com/haskell/cabal/issues/7649 ) - Reverts #7510 that failed on Windows when used with pre-generated scripts included in packages such as network, time, process. - Adds a subtler fix/workaround for the deficiencies of new autoconf versions on Windows. **IMPORTANT NOTE**: The last bug affects configuration files generated with `autoconf-2.70` or later. They will not work with `cabal-3.4.0.0`. Please either upgrade to `3.4.1.0` or the new `3.6.2.0` releases. I'd like to thank the many contributors who offered patches, tickets, and other help in the preparation of this release. We appreciate all of your help! Happy hacking! -------------- next part -------------- An HTML attachment was scrubbed... URL: From amindfv at mailbox.org Fri Oct 8 23:56:41 2021 From: amindfv at mailbox.org (Ttt Mmm) Date: Sat, 9 Oct 2021 01:56:41 +0200 (CEST) Subject: [Haskell-cafe] Partially applied type synonyms In-Reply-To: <010f017c606655c2-4f67de86-28e4-4d5e-accb-18276967e777-000000@us-east-2.amazonses.com> References: <1567260498.44559.1633659307563@office.mailbox.org> <010f017c606655c2-4f67de86-28e4-4d5e-accb-18276967e777-000000@us-east-2.amazonses.com> Message-ID: <1761049569.54840.1633737401117@office.mailbox.org> > On 10/08/2021 4:54 PM Richard Eisenberg wrote: > > > Hello Tom, > > Type synonyms must be fully applied. You could try > > > newtype Foo (s :: * -> *) (x :: *) = MkFoo (Foo' (s x) x) > > to make something that does not need to be fully applied -- but now you have to worry about the pesky MkFoo constructor. > > It's hard for me to suggest something else without understanding your use-case better. Sorry! > Thanks for the suggestions! A newtype is something I'd very much like to avoid due to the wrapping/unwrapping complexity you mention. Here's an example that's hopefully clearer and more motivating; comments inline: {-# LANGUAGE KindSignatures #-} import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet import Data.Set (Set) import qualified Data.Set as Set -- Start with this definition: data Var s x = Var { xs :: s x , getX :: s x -> Maybe x } x :: Var Set Double x = Var (Set.fromList [1,2,3]) Set.lookupMax data Person m = Person { name :: m String , age :: m Int } person0 :: Person (Var Set) person0 = Person { name = Var (Set.fromList ["alice", "bob"]) Set.lookupMin , age = Var (Set.fromList [20,30]) Set.lookupMin } varMay :: Person (Var Set) -> Person Maybe varMay (Person nm ag) = Person (getX nm (xs nm)) (getX ag (xs ag)) -- So far so good. But what if you want to define a version of 'Var' that uses 'IntSet' internally? -- An attempt would be to comment out the definition of 'Var' above and instead say: {- data Var' sx x = Var { xs :: sx , getX :: sx -> Maybe x } type Var s x = Var' (s x) x y :: Var' IntSet Int y = Var (IntSet.fromList [1,2,3]) (fmap fst . IntSet.minView) -} -- 'varMay' works with a generalized type signature (though I don't need it to have one): -- varMay :: Person (Var' sx) -> Person Maybe -- But I can't define 'person0' -- To be clear, I think I can understand why e.g. a type synonym wouldn't work, but i can't find something that would work in its place > Hope this helps, > Richard > > > On Oct 7, 2021, at 10:15 PM, Ttt Mmm via Haskell-Cafe wrote: > > > > I was surprised to find the below code doesn't typecheck even with -XLiberalTypeSynonyms. Am I missing something or is this really not possible? > > > > Thanks, > > Tom > > > > --- > > > > {-# LANGUAGE FlexibleInstances, KindSignatures, LiberalTypeSynonyms, StandaloneDeriving #-} > > -- This works: > > data Foo s x = Foo (s x) x > > deriving (Eq) > > -- This replacement doesn't: > > {- > > data Foo' sx x = Foo' sx x > > deriving (Eq) > > type Foo (s :: * -> *) (x :: *) = Foo' (s x) x > > -} > > data Bar (m :: * -> *) = Bar (m Int) > > > > -- Neither of these typecheck: > > x :: Bar (Foo Maybe) > > x = undefined > > deriving instance Eq (Bar (Foo Maybe)) > > > > _______________________________________________ > > Haskell-Cafe mailing list > > To (un)subscribe, modify options or view archives go to: > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > Only members subscribed via the mailman list are allowed to post. From branimir.maksimovic at gmail.com Sat Oct 9 02:14:34 2021 From: branimir.maksimovic at gmail.com (Branimir Maksimovic) Date: Sat, 9 Oct 2021 04:14:34 +0200 Subject: [Haskell-cafe] Partially applied type synonyms In-Reply-To: <1761049569.54840.1633737401117@office.mailbox.org> References: <1567260498.44559.1633659307563@office.mailbox.org> <010f017c606655c2-4f67de86-28e4-4d5e-accb-18276967e777-000000@us-east-2.amazonses.com> <1761049569.54840.1633737401117@office.mailbox.org> Message-ID: <7E471D73-BED2-4B7F-BBD9-05AC6F9A32DB@gmail.com> {-# LANGUAGE KindSignatures,FlexibleInstances #-} import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet import Data.Set (Set) import qualified Data.Set as Set import Maybes -- Start with this definition: data Var s x = Var { xs :: s x , getX :: s x -> Maybe x } x :: Var Set Double x = Var (Set.fromList [1,2,3]) Set.lookupMax data Person m = Person { name :: m String , age :: m Int } person0 :: Person (Var Set) person0 = Person { name = Var (Set.fromList ["alice", "bob"]) Set.lookupMin , age = Var (Set.fromList [20,30]) Set.lookupMin } varMay :: Person (Var Set) -> Person Maybe varMay (Person nm ag) = Person (getX nm (xs nm)) (getX ag (xs ag)) instance Show (Var' IntSet Int) where show (Var' a b) = show a data Var' a b = Var'{ xs' :: a ,getX' :: a -> Maybe b } y :: Var' IntSet Int y = Var' (IntSet.fromList [1,2,3]) (fmap fst . IntSet.minView) main = print y > On 09.10.2021., at 01:56, Ttt Mmm via Haskell-Cafe wrote: > > {-# LANGUAGE KindSignatures #-} > > import Data.IntSet (IntSet) > import qualified Data.IntSet as IntSet > import Data.Set (Set) > import qualified Data.Set as Set > > -- Start with this definition: > data Var s x > = Var { > xs :: s x > , getX :: s x -> Maybe x > } > > x :: Var Set Double > x = Var (Set.fromList [1,2,3]) Set.lookupMax > > data Person m > = Person { > name :: m String > , age :: m Int > } > > person0 :: Person (Var Set) > person0 = Person { > name = Var (Set.fromList ["alice", "bob"]) Set.lookupMin > , age = Var (Set.fromList [20,30]) Set.lookupMin > } > > varMay :: Person (Var Set) -> Person Maybe > varMay (Person nm ag) = > Person (getX nm (xs nm)) (getX ag (xs ag)) > > -- So far so good. But what if you want to define a version of 'Var' that uses 'IntSet' internally? > > -- An attempt would be to comment out the definition of 'Var' above and instead say: > {- > data Var' sx x > = Var { > xs :: sx > , getX :: sx -> Maybe x > } > > type Var s x = Var' (s x) x > > y :: Var' IntSet Int > y = Var (IntSet.fromList [1,2,3]) (fmap fst . IntSet.minView) > -} -------------- next part -------------- An HTML attachment was scrubbed... URL: From amindfv at mailbox.org Sat Oct 9 05:04:53 2021 From: amindfv at mailbox.org (Ttt Mmm) Date: Sat, 9 Oct 2021 07:04:53 +0200 (CEST) Subject: [Haskell-cafe] Partially applied type synonyms In-Reply-To: <7E471D73-BED2-4B7F-BBD9-05AC6F9A32DB@gmail.com> References: <1567260498.44559.1633659307563@office.mailbox.org> <010f017c606655c2-4f67de86-28e4-4d5e-accb-18276967e777-000000@us-east-2.amazonses.com> <1761049569.54840.1633737401117@office.mailbox.org> <7E471D73-BED2-4B7F-BBD9-05AC6F9A32DB@gmail.com> Message-ID: <566179745.55008.1633755893362@office.mailbox.org> > On 10/09/2021 4:14 AM Branimir Maksimovic wrote: > > > {-# LANGUAGE KindSignatures,FlexibleInstances #-} > > import Data.IntSet (IntSet) > import qualified Data.IntSet as IntSet > import Data.Set (Set) > import qualified Data.Set as Set > import Maybes > -- Start with this definition: > data Var s x > = Var { > xs :: s x > , getX :: s x -> Maybe x > } > > x :: Var Set Double > x = Var (Set.fromList [1,2,3]) Set.lookupMax > > data Person m > = Person { > name :: m String > , age :: m Int > } > > person0 :: Person (Var Set) > person0 = Person { > name = Var (Set.fromList ["alice", "bob"]) Set.lookupMin > , age = Var (Set.fromList [20,30]) Set.lookupMin > } > > varMay :: Person (Var Set) -> Person Maybe > varMay (Person nm ag) = > Person (getX nm (xs nm)) (getX ag (xs ag)) > > instance Show (Var' IntSet Int) > where > show (Var' a b) = show a > data Var' a b = Var'{ > xs' :: a > ,getX' :: a -> Maybe b > } > y :: Var' IntSet Int > y = Var' (IntSet.fromList [1,2,3]) (fmap fst . IntSet.minView) > Thanks for this suggestion, but here Var' is defined as a totally separate type than Var, whereas I want/need Var to be defined in terms of Var'. Cheers, Tom > main = print y > > > > > On 09.10.2021., at 01:56, Ttt Mmm via Haskell-Cafe wrote: > > > > {-# LANGUAGE KindSignatures #-} > > > > import Data.IntSet (IntSet) > > import qualified Data.IntSet as IntSet > > import Data.Set (Set) > > import qualified Data.Set as Set > > > > -- Start with this definition: > > data Var s x > > = Var { > > xs :: s x > > , getX :: s x -> Maybe x > > } > > > > x :: Var Set Double > > x = Var (Set.fromList [1,2,3]) Set.lookupMax > > > > data Person m > > = Person { > > name :: m String > > , age :: m Int > > } > > > > person0 :: Person (Var Set) > > person0 = Person { > > name = Var (Set.fromList ["alice", "bob"]) Set.lookupMin > > , age = Var (Set.fromList [20,30]) Set.lookupMin > > } > > > > varMay :: Person (Var Set) -> Person Maybe > > varMay (Person nm ag) = > > Person (getX nm (xs nm)) (getX ag (xs ag)) > > > > -- So far so good. But what if you want to define a version of 'Var' that uses 'IntSet' internally? > > > > -- An attempt would be to comment out the definition of 'Var' above and instead say: > > {- > > data Var' sx x > > = Var { > > xs :: sx > > , getX :: sx -> Maybe x > > } > > > > type Var s x = Var' (s x) x > > > > y :: Var' IntSet Int > > y = Var (IntSet.fromList [1,2,3]) (fmap fst . IntSet.minView) > > -} > > > > > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From branimir.maksimovic at gmail.com Sat Oct 9 06:25:41 2021 From: branimir.maksimovic at gmail.com (Branimir Maksimovic) Date: Sat, 9 Oct 2021 08:25:41 +0200 Subject: [Haskell-cafe] Partially applied type synonyms In-Reply-To: <566179745.55008.1633755893362@office.mailbox.org> References: <1567260498.44559.1633659307563@office.mailbox.org> <010f017c606655c2-4f67de86-28e4-4d5e-accb-18276967e777-000000@us-east-2.amazonses.com> <1761049569.54840.1633737401117@office.mailbox.org> <7E471D73-BED2-4B7F-BBD9-05AC6F9A32DB@gmail.com> <566179745.55008.1633755893362@office.mailbox.org> Message-ID: <04F732EF-A66F-43BE-B3E3-73BDE2F0EEE5@gmail.com> > On 09.10.2021., at 07:04, Ttt Mmm wrote: > >> >> On 10/09/2021 4:14 AM Branimir Maksimovic wrote: >> >> >> {-# LANGUAGE KindSignatures,FlexibleInstances #-} >> >> import Data.IntSet (IntSet) >> import qualified Data.IntSet as IntSet >> import Data.Set (Set) >> import qualified Data.Set as Set >> import Maybes >> -- Start with this definition: >> data Var s x >> = Var { >> xs :: s x >> , getX :: s x -> Maybe x >> } >> >> x :: Var Set Double >> x = Var (Set.fromList [1,2,3]) Set.lookupMax >> >> data Person m >> = Person { >> name :: m String >> , age :: m Int >> } >> >> person0 :: Person (Var Set) >> person0 = Person { >> name = Var (Set.fromList ["alice", "bob"]) Set.lookupMin >> , age = Var (Set.fromList [20,30]) Set.lookupMin >> } >> >> varMay :: Person (Var Set) -> Person Maybe >> varMay (Person nm ag) = >> Person (getX nm (xs nm)) (getX ag (xs ag)) >> >> instance Show (Var' IntSet Int) >> where >> show (Var' a b) = show a >> data Var' a b = Var'{ >> xs' :: a >> ,getX' :: a -> Maybe b >> } >> y :: Var' IntSet Int >> y = Var' (IntSet.fromList [1,2,3]) (fmap fst . IntSet.minView) > > Thanks for this suggestion, but here Var' is defined as a totally separate type than Var, whereas I want/need Var to be defined in terms of Var'. > Why, what do mean by that? they are unrelated types as IntSet has one var less then Set? > Cheers, > Tom Greets, Branimir, > >> main = print y >> >>> On 09.10.2021., at 01:56, Ttt Mmm via Haskell-Cafe > wrote: >>> >>> {-# LANGUAGE KindSignatures #-} >>> >>> import Data.IntSet (IntSet) >>> import qualified Data.IntSet as IntSet >>> import Data.Set (Set) >>> import qualified Data.Set as Set >>> >>> -- Start with this definition: >>> data Var s x >>> = Var { >>> xs :: s x >>> , getX :: s x -> Maybe x >>> } >>> >>> x :: Var Set Double >>> x = Var (Set.fromList [1,2,3]) Set.lookupMax >>> >>> data Person m >>> = Person { >>> name :: m String >>> , age :: m Int >>> } >>> >>> person0 :: Person (Var Set) >>> person0 = Person { >>> name = Var (Set.fromList ["alice", "bob"]) Set.lookupMin >>> , age = Var (Set.fromList [20,30]) Set.lookupMin >>> } >>> >>> varMay :: Person (Var Set) -> Person Maybe >>> varMay (Person nm ag) = >>> Person (getX nm (xs nm)) (getX ag (xs ag)) >>> >>> -- So far so good. But what if you want to define a version of 'Var' that uses 'IntSet' internally? >>> >>> -- An attempt would be to comment out the definition of 'Var' above and instead say: >>> {- >>> data Var' sx x >>> = Var { >>> xs :: sx >>> , getX :: sx -> Maybe x >>> } >>> >>> type Var s x = Var' (s x) x >>> >>> y :: Var' IntSet Int >>> y = Var (IntSet.fromList [1,2,3]) (fmap fst . IntSet.minView) >>> -} -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Tue Oct 12 06:02:37 2021 From: david.feuer at gmail.com (David Feuer) Date: Tue, 12 Oct 2021 02:02:37 -0400 Subject: [Haskell-cafe] [ANN] linear-generics Message-ID: I am pleased to announce the release of a new package, linear-generics[*], based on GHC.Generics and the venerable generic-deriving. The killer features: 1. Generic1 representations associate compositions the right way around, which is to say the *left* way around, meaning no more inefficient fmaps or pesky Functor constraints. 2. to, from, to1, and from1 are multiplicity polymorphic, so you can use them in all your fancy new linearly typed code. The package includes Template Haskell-based deriving, based closely on generic-deriving, which is the recommended way to write instances. There is also a limited, somewhat unsafe, and somewhat inefficient way using provided DerivingVia targets. Many thanks to Arnaud Spiwack and Ryan Scott for valuable advice and assistance. [*] https://hackage.haskell.org/package/linear-generics -------------- next part -------------- An HTML attachment was scrubbed... URL: From benjamin.redelings at gmail.com Tue Oct 12 19:35:22 2021 From: benjamin.redelings at gmail.com (Benjamin Redelings) Date: Tue, 12 Oct 2021 15:35:22 -0400 Subject: [Haskell-cafe] Resources on how to implement (Haskell 98) kind-checking? Message-ID: <34939fd9-e592-315a-114b-f1f6d1fef686@gmail.com> Hi, 1. I'm looking for resources that describe how to implement kind Haskell 98 checking.  Does anyone have any suggestions? * I've looked at the PolyKinds paper, but it doesn't cover type classes. * I've looked at the source code to GHC, but it is hard to follow for a variety of reasons.  It isn't laid out like an algorithm description, and the complexity to handle options like PolyKinds and DataKinds makes the code harder to follow. 2. One question that came up is how to handle type variables that are present in class methods, but are not type class parameters. If there are multiple types/classes in a single recursive group, the kind of such type variables might not be fully resolved until a later type-or-class is processed.  Is there a recommended approach? I can see two ways to proceed: i) First determine the kinds of all the data types, classes, and type synonyms.  Then perform a second pass over each type or class to determine the kinds of type variables (in class methods) that are not type class parameters. ii) Alternatively, record the kind of each type variable as it is encountered -- even though such kinds may contain unification kind variables.  After visiting all types-or-classes in the recursive group, replace any kind variables with their definition, or with a * if there is no definition. I've currently implement approach i), which requires doing kind inference on class methods twice.  Is this the recommended approach? 3. Also, is Haskell 98 kind checking the same as Haskell 2010 kind checking? -BenRI From carter.schonwald at gmail.com Wed Oct 13 12:49:28 2021 From: carter.schonwald at gmail.com (Carter Schonwald) Date: Wed, 13 Oct 2021 08:49:28 -0400 Subject: [Haskell-cafe] Resources on how to implement (Haskell 98) kind-checking? In-Reply-To: <34939fd9-e592-315a-114b-f1f6d1fef686@gmail.com> References: <34939fd9-e592-315a-114b-f1f6d1fef686@gmail.com> Message-ID: I believe you can treat kind chekcing /inference in the H98 setting as another instance of hindley Milner type inference where the types are the terms, and kinds are the types. And where there are no user lambdas. So it’s only “combinator” definitions as introduced by user defined type class and type and data definitions. Moreover, I think you can limit yourself to considering it a sort of simply typed calculus for the purposes of using a unification approach. ESP since poly kinds aren’t there. I hope that helps, but if not please ask more! On Tue, Oct 12, 2021 at 3:37 PM Benjamin Redelings < benjamin.redelings at gmail.com> wrote: > Hi, > > 1. I'm looking for resources that describe how to implement kind Haskell > 98 checking. Does anyone have any suggestions? > > * I've looked at the PolyKinds paper, but it doesn't cover type classes. > > * I've looked at the source code to GHC, but it is hard to follow for a > variety of reasons. It isn't laid out like an algorithm description, > and the complexity to handle options like PolyKinds and DataKinds makes > the code harder to follow. > > > 2. One question that came up is how to handle type variables that are > present in class methods, but are not type class parameters. If there > are multiple types/classes in a single recursive group, the kind of such > type variables might not be fully resolved until a later type-or-class > is processed. Is there a recommended approach? > > I can see two ways to proceed: > > i) First determine the kinds of all the data types, classes, and type > synonyms. Then perform a second pass over each type or class to > determine the kinds of type variables (in class methods) that are not > type class parameters. > > ii) Alternatively, record the kind of each type variable as it is > encountered -- even though such kinds may contain unification kind > variables. After visiting all types-or-classes in the recursive group, > replace any kind variables with their definition, or with a * if there > is no definition. > > I've currently implement approach i), which requires doing kind > inference on class methods twice. Is this the recommended approach? > > > 3. Also, is Haskell 98 kind checking the same as Haskell 2010 kind > checking? > > -BenRI > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Wed Oct 13 12:58:43 2021 From: david.feuer at gmail.com (David Feuer) Date: Wed, 13 Oct 2021 08:58:43 -0400 Subject: [Haskell-cafe] Resources on how to implement (Haskell 98) kind-checking? In-Reply-To: <34939fd9-e592-315a-114b-f1f6d1fef686@gmail.com> References: <34939fd9-e592-315a-114b-f1f6d1fef686@gmail.com> Message-ID: Haskell 2010 defines virtually the same language as Haskell 98. The differences are too trivial to worry about. One spot you may wish to follow GHC (and I think Hugs, at least) rather than the Report: https://ghc.gitlab.haskell.org/ghc/doc/users_guide/bugs.html#typechecking-of-recursive-binding-groups On Tue, Oct 12, 2021, 3:37 PM Benjamin Redelings < benjamin.redelings at gmail.com> wrote: > Hi, > > 1. I'm looking for resources that describe how to implement kind Haskell > 98 checking. Does anyone have any suggestions? > > * I've looked at the PolyKinds paper, but it doesn't cover type classes. > > * I've looked at the source code to GHC, but it is hard to follow for a > variety of reasons. It isn't laid out like an algorithm description, > and the complexity to handle options like PolyKinds and DataKinds makes > the code harder to follow. > > > 2. One question that came up is how to handle type variables that are > present in class methods, but are not type class parameters. If there > are multiple types/classes in a single recursive group, the kind of such > type variables might not be fully resolved until a later type-or-class > is processed. Is there a recommended approach? > > I can see two ways to proceed: > > i) First determine the kinds of all the data types, classes, and type > synonyms. Then perform a second pass over each type or class to > determine the kinds of type variables (in class methods) that are not > type class parameters. > > ii) Alternatively, record the kind of each type variable as it is > encountered -- even though such kinds may contain unification kind > variables. After visiting all types-or-classes in the recursive group, > replace any kind variables with their definition, or with a * if there > is no definition. > > I've currently implement approach i), which requires doing kind > inference on class methods twice. Is this the recommended approach? > > > 3. Also, is Haskell 98 kind checking the same as Haskell 2010 kind > checking? > > -BenRI > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From 78emil at gmail.com Wed Oct 13 19:22:55 2021 From: 78emil at gmail.com (Emil Axelsson) Date: Wed, 13 Oct 2021 21:22:55 +0200 Subject: [Haskell-cafe] Resources on how to implement (Haskell 98) kind-checking? In-Reply-To: <34939fd9-e592-315a-114b-f1f6d1fef686@gmail.com> References: <34939fd9-e592-315a-114b-f1f6d1fef686@gmail.com> Message-ID: Maybe Typing Haskell in Haskell is what you're looking for? / Emil Den 2021-10-12 kl. 21:35, skrev Benjamin Redelings: > Hi, > > 1. I'm looking for resources that describe how to implement kind > Haskell 98 checking.  Does anyone have any suggestions? > > * I've looked at the PolyKinds paper, but it doesn't cover type classes. > > * I've looked at the source code to GHC, but it is hard to follow for > a variety of reasons.  It isn't laid out like an algorithm > description, and the complexity to handle options like PolyKinds and > DataKinds makes the code harder to follow. > > > 2. One question that came up is how to handle type variables that are > present in class methods, but are not type class parameters. If there > are multiple types/classes in a single recursive group, the kind of > such type variables might not be fully resolved until a later > type-or-class is processed.  Is there a recommended approach? > > I can see two ways to proceed: > > i) First determine the kinds of all the data types, classes, and type > synonyms.  Then perform a second pass over each type or class to > determine the kinds of type variables (in class methods) that are not > type class parameters. > > ii) Alternatively, record the kind of each type variable as it is > encountered -- even though such kinds may contain unification kind > variables.  After visiting all types-or-classes in the recursive > group, replace any kind variables with their definition, or with a * > if there is no definition. > > I've currently implement approach i), which requires doing kind > inference on class methods twice.  Is this the recommended approach? > > > 3. Also, is Haskell 98 kind checking the same as Haskell 2010 kind > checking? > > -BenRI > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From apoorv-ingle at uiowa.edu Wed Oct 13 19:49:59 2021 From: apoorv-ingle at uiowa.edu (Ingle, Apoorv N) Date: Wed, 13 Oct 2021 19:49:59 +0000 Subject: [Haskell-cafe] [External] Resources on how to implement (Haskell 98) kind-checking? In-Reply-To: References: <34939fd9-e592-315a-114b-f1f6d1fef686@gmail.com> Message-ID: <582D1DA7-EBBE-4E52-8683-7444C2FE606D@uiowa.edu> Along with what Emil suggests, Sec 4. of A system of constructor classes: overloading and implicit higher-order polymorphism[1] may also be useful. — Apoorv [1]: http://web.cecs.pdx.edu/~mpj/pubs/fpca93.pdf On Oct 13, 2021, at 14:22, Emil Axelsson <78emil at gmail.com> wrote: Maybe Typing Haskell in Haskell is what you're looking for? / Emil Den 2021-10-12 kl. 21:35, skrev Benjamin Redelings: Hi, 1. I'm looking for resources that describe how to implement kind Haskell 98 checking. Does anyone have any suggestions? * I've looked at the PolyKinds paper, but it doesn't cover type classes. * I've looked at the source code to GHC, but it is hard to follow for a variety of reasons. It isn't laid out like an algorithm description, and the complexity to handle options like PolyKinds and DataKinds makes the code harder to follow. 2. One question that came up is how to handle type variables that are present in class methods, but are not type class parameters. If there are multiple types/classes in a single recursive group, the kind of such type variables might not be fully resolved until a later type-or-class is processed. Is there a recommended approach? I can see two ways to proceed: i) First determine the kinds of all the data types, classes, and type synonyms. Then perform a second pass over each type or class to determine the kinds of type variables (in class methods) that are not type class parameters. ii) Alternatively, record the kind of each type variable as it is encountered -- even though such kinds may contain unification kind variables. After visiting all types-or-classes in the recursive group, replace any kind variables with their definition, or with a * if there is no definition. I've currently implement approach i), which requires doing kind inference on class methods twice. Is this the recommended approach? 3. Also, is Haskell 98 kind checking the same as Haskell 2010 kind checking? -BenRI _______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post. _______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From spam at scientician.net Wed Oct 13 20:01:10 2021 From: spam at scientician.net (Bardur Arantsson) Date: Wed, 13 Oct 2021 22:01:10 +0200 Subject: [Haskell-cafe] Public floggings In-Reply-To: References: Message-ID: On 06/10/2021 15.55, Michael Turner wrote: >>> Aside: to this day, that sort of ad-hoc syntax makes me gag. K&R should be >> publicly flogged on a regular basis. > > Since I'm to blame for raising the subject that turned into a thread > about "the right exposition", I hereby surrender myself to be flogged > in lieu of the intended. I've deserved it for years, just for how I've > found perversely delightful ways to use the C preprocessor. Especially > token-pasting. > > K&R (the book) was almost indecent exposure -- it left nothing to the > imagination. As opposed to most writing on Haskell, where I'm > befuddled because it's not at all obvious how it does its thing. It's > like you're not /supposed/ to know. But K&R let it all hang out, and > for that reason, I loved it. Whip me, beat me, make me write C code. > Because that's just the kind of pervert I am. Still, sometimes. > Boost.PP says hi! :D Cheers, From benjamin.redelings at gmail.com Thu Oct 14 14:13:46 2021 From: benjamin.redelings at gmail.com (Benjamin Redelings) Date: Thu, 14 Oct 2021 10:13:46 -0400 Subject: [Haskell-cafe] Resources on how to implement (Haskell 98) kind-checking? In-Reply-To: <34939fd9-e592-315a-114b-f1f6d1fef686@gmail.com> References: <34939fd9-e592-315a-114b-f1f6d1fef686@gmail.com> Message-ID: <3b91afc5-0aaa-eefd-c917-143a8e7bc1c8@gmail.com> 4. So, apparently GHC takes neither of these options, instead it does: iii) Represent kinds with modifiable variables.  Substitution can be implemented by modifying kind variables in-place.  This is called "zonking" in the GHC sources. This solves a small mystery for me, since I previously think that zonking was replacing remaining kind variables with '*'.  And indeed this seems to be an example of zonking, but not what zonking is. 5. It turns out that the Technical Supplement to the PolyKinds paper (Kind Inference for Datatypes) does have more detail. -BenRI On 10/12/21 3:35 PM, Benjamin Redelings wrote: > Hi, > > 1. I'm looking for resources that describe how to implement kind > Haskell 98 checking.  Does anyone have any suggestions? > > * I've looked at the PolyKinds paper, but it doesn't cover type classes. > > * I've looked at the source code to GHC, but it is hard to follow for > a variety of reasons.  It isn't laid out like an algorithm > description, and the complexity to handle options like PolyKinds and > DataKinds makes the code harder to follow. > > > 2. One question that came up is how to handle type variables that are > present in class methods, but are not type class parameters. If there > are multiple types/classes in a single recursive group, the kind of > such type variables might not be fully resolved until a later > type-or-class is processed.  Is there a recommended approach? > > I can see two ways to proceed: > > i) First determine the kinds of all the data types, classes, and type > synonyms.  Then perform a second pass over each type or class to > determine the kinds of type variables (in class methods) that are not > type class parameters. > > ii) Alternatively, record the kind of each type variable as it is > encountered -- even though such kinds may contain unification kind > variables.  After visiting all types-or-classes in the recursive > group, replace any kind variables with their definition, or with a * > if there is no definition. > > I've currently implement approach i), which requires doing kind > inference on class methods twice.  Is this the recommended approach? > > > 3. Also, is Haskell 98 kind checking the same as Haskell 2010 kind > checking? > > -BenRI > > From benjamin.redelings at gmail.com Thu Oct 14 14:24:16 2021 From: benjamin.redelings at gmail.com (Benjamin Redelings) Date: Thu, 14 Oct 2021 10:24:16 -0400 Subject: [Haskell-cafe] [External] Resources on how to implement (Haskell 98) kind-checking? In-Reply-To: <582D1DA7-EBBE-4E52-8683-7444C2FE606D@uiowa.edu> References: <34939fd9-e592-315a-114b-f1f6d1fef686@gmail.com> <582D1DA7-EBBE-4E52-8683-7444C2FE606D@uiowa.edu> Message-ID: <9d967e65-e4b7-2b27-aabf-8bf49d5c56fd@gmail.com> Thanks!  Yes, that introduces the idea that requires kind inference. Interestingly, it contains a (kind-aware) type-inference algorithm, but no kind inference algorithm! Perhaps kind-inference is considered too "obvious" to require an algorithm.  The closest it comes is the rule: C :: k' -> k   and   C' :: k'  => C C' :: k This is helpful, but it would probably be beneficial for better documentation to exist SOMEWHERE. -BenRI On 10/13/21 3:49 PM, Ingle, Apoorv N wrote: > Along with what Emil suggests, > Sec 4. of A system of constructor classes: overloading and implicit > higher-order polymorphism[1] may also be useful. > > — Apoorv > > [1]: http://web.cecs.pdx.edu/~mpj/pubs/fpca93.pdf > > >> On Oct 13, 2021, at 14:22, Emil Axelsson <78emil at gmail.com> wrote: >> >> Maybe Typing Haskell in Haskell >> >> is what you're looking for? >> >> / Emil >> Den 2021-10-12 kl. 21:35, skrev Benjamin Redelings: >>> Hi, >>> >>> 1. I'm looking for resources that describe how to implement kind >>> Haskell 98 checking.  Does anyone have any suggestions? >>> >>> * I've looked at the PolyKinds paper, but it doesn't cover type >>> classes. >>> >>> * I've looked at the source code to GHC, but it is hard to follow >>> for a variety of reasons.  It isn't laid out like an algorithm >>> description, and the complexity to handle options like PolyKinds and >>> DataKinds makes the code harder to follow. >>> >>> >>> 2. One question that came up is how to handle type variables that >>> are present in class methods, but are not type class parameters. If >>> there are multiple types/classes in a single recursive group, the >>> kind of such type variables might not be fully resolved until a >>> later type-or-class is processed.  Is there a recommended approach? >>> >>> I can see two ways to proceed: >>> >>> i) First determine the kinds of all the data types, classes, and >>> type synonyms.  Then perform a second pass over each type or class >>> to determine the kinds of type variables (in class methods) that are >>> not type class parameters. >>> >>> ii) Alternatively, record the kind of each type variable as it is >>> encountered -- even though such kinds may contain unification kind >>> variables.  After visiting all types-or-classes in the recursive >>> group, replace any kind variables with their definition, or with a * >>> if there is no definition. >>> >>> I've currently implement approach i), which requires doing kind >>> inference on class methods twice.  Is this the recommended approach? >>> >>> >>> 3. Also, is Haskell 98 kind checking the same as Haskell 2010 kind >>> checking? >>> >>> -BenRI >>> >>> >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> To (un)subscribe, modify options or view archives go to: >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>> Only members subscribed via the mailman list are allowed to post. >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From benjamin.redelings at gmail.com Thu Oct 14 14:26:00 2021 From: benjamin.redelings at gmail.com (Benjamin Redelings) Date: Thu, 14 Oct 2021 10:26:00 -0400 Subject: [Haskell-cafe] Resources on how to implement (Haskell 98) kind-checking? In-Reply-To: References: <34939fd9-e592-315a-114b-f1f6d1fef686@gmail.com> Message-ID: <3a5f54d2-f282-0f7b-658e-1be30b8a5c81@gmail.com> Thanks!  Good point. For kind inference, I think that point won't come in to play unless I add CUSK's, which are not yet on the radar.  For type-inference though that is a good point. -BenRI On 10/13/21 8:58 AM, David Feuer wrote: > Haskell 2010 defines virtually the same language as Haskell 98. The > differences are too trivial to worry about. One spot you may wish to > follow GHC (and I think Hugs, at least) rather than the Report: > https://ghc.gitlab.haskell.org/ghc/doc/users_guide/bugs.html#typechecking-of-recursive-binding-groups > > On Tue, Oct 12, 2021, 3:37 PM Benjamin Redelings > wrote: > > Hi, > > 1. I'm looking for resources that describe how to implement kind > Haskell > 98 checking.  Does anyone have any suggestions? > > * I've looked at the PolyKinds paper, but it doesn't cover type > classes. > > * I've looked at the source code to GHC, but it is hard to follow > for a > variety of reasons.  It isn't laid out like an algorithm description, > and the complexity to handle options like PolyKinds and DataKinds > makes > the code harder to follow. > > > 2. One question that came up is how to handle type variables that are > present in class methods, but are not type class parameters. If there > are multiple types/classes in a single recursive group, the kind > of such > type variables might not be fully resolved until a later > type-or-class > is processed.  Is there a recommended approach? > > I can see two ways to proceed: > > i) First determine the kinds of all the data types, classes, and type > synonyms.  Then perform a second pass over each type or class to > determine the kinds of type variables (in class methods) that are not > type class parameters. > > ii) Alternatively, record the kind of each type variable as it is > encountered -- even though such kinds may contain unification kind > variables.  After visiting all types-or-classes in the recursive > group, > replace any kind variables with their definition, or with a * if > there > is no definition. > > I've currently implement approach i), which requires doing kind > inference on class methods twice.  Is this the recommended approach? > > > 3. Also, is Haskell 98 kind checking the same as Haskell 2010 kind > checking? > > -BenRI > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From allbery.b at gmail.com Thu Oct 14 14:28:55 2021 From: allbery.b at gmail.com (Brandon Allbery) Date: Thu, 14 Oct 2021 10:28:55 -0400 Subject: [Haskell-cafe] [External] Resources on how to implement (Haskell 98) kind-checking? In-Reply-To: <9d967e65-e4b7-2b27-aabf-8bf49d5c56fd@gmail.com> References: <34939fd9-e592-315a-114b-f1f6d1fef686@gmail.com> <582D1DA7-EBBE-4E52-8683-7444C2FE606D@uiowa.edu> <9d967e65-e4b7-2b27-aabf-8bf49d5c56fd@gmail.com> Message-ID: At this point you might want to ask on ghc-devs. They might ask you to document what you find out, though. On Thu, Oct 14, 2021 at 10:25 AM Benjamin Redelings < benjamin.redelings at gmail.com> wrote: > Thanks! Yes, that introduces the idea that requires kind inference. > > Interestingly, it contains a (kind-aware) type-inference algorithm, but no > kind inference algorithm! > > Perhaps kind-inference is considered too "obvious" to require an > algorithm. The closest it comes is the rule: > > C :: k' -> k and C' :: k' => C C' :: k > > This is helpful, but it would probably be beneficial for better > documentation to exist SOMEWHERE. > > -BenRI > On 10/13/21 3:49 PM, Ingle, Apoorv N wrote: > > Along with what Emil suggests, > Sec 4. of A system of constructor classes: overloading and implicit > higher-order polymorphism[1] may also be useful. > > — Apoorv > > [1]: http://web.cecs.pdx.edu/~mpj/pubs/fpca93.pdf > > > On Oct 13, 2021, at 14:22, Emil Axelsson <78emil at gmail.com> wrote: > > Maybe Typing Haskell in Haskell > > is what you're looking for? > > / Emil > > Den 2021-10-12 kl. 21:35, skrev Benjamin Redelings: > > Hi, > > 1. I'm looking for resources that describe how to implement kind Haskell > 98 checking. Does anyone have any suggestions? > > * I've looked at the PolyKinds paper, but it doesn't cover type classes. > > * I've looked at the source code to GHC, but it is hard to follow for a > variety of reasons. It isn't laid out like an algorithm description, and > the complexity to handle options like PolyKinds and DataKinds makes the > code harder to follow. > > > 2. One question that came up is how to handle type variables that are > present in class methods, but are not type class parameters. If there are > multiple types/classes in a single recursive group, the kind of such type > variables might not be fully resolved until a later type-or-class is > processed. Is there a recommended approach? > > I can see two ways to proceed: > > i) First determine the kinds of all the data types, classes, and type > synonyms. Then perform a second pass over each type or class to determine > the kinds of type variables (in class methods) that are not type class > parameters. > > ii) Alternatively, record the kind of each type variable as it is > encountered -- even though such kinds may contain unification kind > variables. After visiting all types-or-classes in the recursive group, > replace any kind variables with their definition, or with a * if there is > no definition. > > I've currently implement approach i), which requires doing kind inference > on class methods twice. Is this the recommended approach? > > > 3. Also, is Haskell 98 kind checking the same as Haskell 2010 kind > checking? > > -BenRI > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -- brandon s allbery kf8nh allbery.b at gmail.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From benjamin.redelings at gmail.com Thu Oct 14 14:39:27 2021 From: benjamin.redelings at gmail.com (Benjamin Redelings) Date: Thu, 14 Oct 2021 10:39:27 -0400 Subject: [Haskell-cafe] [External] Resources on how to implement (Haskell 98) kind-checking? In-Reply-To: References: <34939fd9-e592-315a-114b-f1f6d1fef686@gmail.com> <582D1DA7-EBBE-4E52-8683-7444C2FE606D@uiowa.edu> <9d967e65-e4b7-2b27-aabf-8bf49d5c56fd@gmail.com> Message-ID: Thanks, I didn't know about that list. I would be happy to document what I find out, though I'm sure other people would need to correct it. -BenRI On 10/14/21 10:28 AM, Brandon Allbery wrote: > At this point you might want to ask on ghc-devs. They might ask you to > document what you find out, though. > > On Thu, Oct 14, 2021 at 10:25 AM Benjamin Redelings > wrote: > > Thanks!  Yes, that introduces the idea that requires kind inference. > > Interestingly, it contains a (kind-aware) type-inference > algorithm, but no kind inference algorithm! > > Perhaps kind-inference is considered too "obvious" to require an > algorithm.  The closest it comes is the rule: > > C :: k' -> k   and   C' :: k'  => C C' :: k > > This is helpful, but it would probably be beneficial for better > documentation to exist SOMEWHERE. > > -BenRI > > On 10/13/21 3:49 PM, Ingle, Apoorv N wrote: >> Along with what Emil suggests, >> Sec 4. of A system of constructor classes: overloading and >> implicit higher-order polymorphism[1] may also be useful. >> >> — Apoorv >> >> [1]: http://web.cecs.pdx.edu/~mpj/pubs/fpca93.pdf >> >> >>> On Oct 13, 2021, at 14:22, Emil Axelsson <78emil at gmail.com> wrote: >>> >>> Maybe Typing Haskell in Haskell >>> >>> is what you're looking for? >>> >>> / Emil >>> Den 2021-10-12 kl. 21:35, skrev Benjamin Redelings: >>>> Hi, >>>> >>>> 1. I'm looking for resources that describe how to implement >>>> kind Haskell 98 checking.  Does anyone have any suggestions? >>>> >>>> * I've looked at the PolyKinds paper, but it doesn't cover type >>>> classes. >>>> >>>> * I've looked at the source code to GHC, but it is hard to >>>> follow for a variety of reasons.  It isn't laid out like an >>>> algorithm description, and the complexity to handle options >>>> like PolyKinds and DataKinds makes the code harder to follow. >>>> >>>> >>>> 2. One question that came up is how to handle type variables >>>> that are present in class methods, but are not type class >>>> parameters. If there are multiple types/classes in a single >>>> recursive group, the kind of such type variables might not be >>>> fully resolved until a later type-or-class is processed.  Is >>>> there a recommended approach? >>>> >>>> I can see two ways to proceed: >>>> >>>> i) First determine the kinds of all the data types, classes, >>>> and type synonyms.  Then perform a second pass over each type >>>> or class to determine the kinds of type variables (in class >>>> methods) that are not type class parameters. >>>> >>>> ii) Alternatively, record the kind of each type variable as it >>>> is encountered -- even though such kinds may contain >>>> unification kind variables.  After visiting all >>>> types-or-classes in the recursive group, replace any kind >>>> variables with their definition, or with a * if there is no >>>> definition. >>>> >>>> I've currently implement approach i), which requires doing kind >>>> inference on class methods twice.  Is this the recommended >>>> approach? >>>> >>>> >>>> 3. Also, is Haskell 98 kind checking the same as Haskell 2010 >>>> kind checking? >>>> >>>> -BenRI >>>> >>>> >>>> _______________________________________________ >>>> Haskell-Cafe mailing list >>>> To (un)subscribe, modify options or view archives go to: >>>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>>> Only members subscribed via the mailman list are allowed to post. >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> To (un)subscribe, modify options or view archives go to: >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>> Only members subscribed via the mailman list are allowed to post. >> > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. > > > > -- > brandon s allbery kf8nh > allbery.b at gmail.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From apoorv-ingle at uiowa.edu Thu Oct 14 16:11:00 2021 From: apoorv-ingle at uiowa.edu (Ingle, Apoorv N) Date: Thu, 14 Oct 2021 16:11:00 +0000 Subject: [Haskell-cafe] [External] Resources on how to implement (Haskell 98) kind-checking? In-Reply-To: <9d967e65-e4b7-2b27-aabf-8bf49d5c56fd@gmail.com> References: <34939fd9-e592-315a-114b-f1f6d1fef686@gmail.com> <582D1DA7-EBBE-4E52-8683-7444C2FE606D@uiowa.edu> <9d967e65-e4b7-2b27-aabf-8bf49d5c56fd@gmail.com> Message-ID: And I happened to bump into Sec 4. of Kind Inference for Datatypes[1] It atleast has the heading kind checking for H98 — Apoorv [1]: https://arxiv.org/abs/1911.06153 On Oct 14, 2021, at 09:24, Benjamin Redelings > wrote: Thanks! Yes, that introduces the idea that requires kind inference. Interestingly, it contains a (kind-aware) type-inference algorithm, but no kind inference algorithm! Perhaps kind-inference is considered too "obvious" to require an algorithm. The closest it comes is the rule: C :: k' -> k and C' :: k' => C C' :: k This is helpful, but it would probably be beneficial for better documentation to exist SOMEWHERE. -BenRI On 10/13/21 3:49 PM, Ingle, Apoorv N wrote: Along with what Emil suggests, Sec 4. of A system of constructor classes: overloading and implicit higher-order polymorphism[1] may also be useful. — Apoorv [1]: http://web.cecs.pdx.edu/~mpj/pubs/fpca93.pdf On Oct 13, 2021, at 14:22, Emil Axelsson <78emil at gmail.com> wrote: Maybe Typing Haskell in Haskell is what you're looking for? / Emil Den 2021-10-12 kl. 21:35, skrev Benjamin Redelings: Hi, 1. I'm looking for resources that describe how to implement kind Haskell 98 checking. Does anyone have any suggestions? * I've looked at the PolyKinds paper, but it doesn't cover type classes. * I've looked at the source code to GHC, but it is hard to follow for a variety of reasons. It isn't laid out like an algorithm description, and the complexity to handle options like PolyKinds and DataKinds makes the code harder to follow. 2. One question that came up is how to handle type variables that are present in class methods, but are not type class parameters. If there are multiple types/classes in a single recursive group, the kind of such type variables might not be fully resolved until a later type-or-class is processed. Is there a recommended approach? I can see two ways to proceed: i) First determine the kinds of all the data types, classes, and type synonyms. Then perform a second pass over each type or class to determine the kinds of type variables (in class methods) that are not type class parameters. ii) Alternatively, record the kind of each type variable as it is encountered -- even though such kinds may contain unification kind variables. After visiting all types-or-classes in the recursive group, replace any kind variables with their definition, or with a * if there is no definition. I've currently implement approach i), which requires doing kind inference on class methods twice. Is this the recommended approach? 3. Also, is Haskell 98 kind checking the same as Haskell 2010 kind checking? -BenRI _______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post. _______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From keith.wygant at gmail.com Thu Oct 14 20:05:42 2021 From: keith.wygant at gmail.com (Keith) Date: Thu, 14 Oct 2021 20:05:42 +0000 Subject: [Haskell-cafe] Bug in Data.Bits.shift? Message-ID: <2B91CE26-427E-40BC-8C9E-F6306B78C175@gmail.com> As currently defined, `shift x minBound` calls `shiftR` with a negative displacement. This would avoid that: ``` shift x n | n >= 0 = shiftL x n | n == minBound = shiftR (shiftR x maxBound) 1 | otherwise = shiftR x (-n) ``` P.S. Philosophically, `rotate` on a negative `Integer` should do sign extension in the least significant bits (though by the description of `rotate` it should not...). — Sent from my phone with K-9 Mail. -------------- next part -------------- An HTML attachment was scrubbed... URL: From simonpj at microsoft.com Thu Oct 14 21:44:02 2021 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Thu, 14 Oct 2021 21:44:02 +0000 Subject: [Haskell-cafe] Resources on how to implement (Haskell 98) kind-checking? In-Reply-To: <3b91afc5-0aaa-eefd-c917-143a8e7bc1c8@gmail.com> References: <34939fd9-e592-315a-114b-f1f6d1fef686@gmail.com> <3b91afc5-0aaa-eefd-c917-143a8e7bc1c8@gmail.com> Message-ID: You might also find this talk helpful. https://www.microsoft.com/en-us/research/publication/type-inference-as-constraint-solving-how-ghcs-type-inference-engine-actually-works/ And this paper: https://www.microsoft.com/en-us/research/publication/outsideinx-modular-type-inference-with-local-assumptions/ The former is in tutorial form, but lacks a proper paper to back it up. The latter is a proper paper, but its focus is on *local* constraints which is more than you need right now. You might also enjoy Ningning Xie's thesis, https://xnning.github.io/papers/Thesis.pdf and her paper "Kind inference for data types" https://xnning.github.io/papers/kind-inference.pdf which are all about kind inference. Simon PS: I am leaving Microsoft at the end of November 2021, at which point simonpj at microsoft.com will cease to work. Use simon.peytonjones at gmail.com instead. (For now, it just forwards to simonpj at microsoft.com.) | -----Original Message----- | From: Haskell-Cafe On Behalf Of | Benjamin Redelings | Sent: 14 October 2021 15:14 | To: Haskell Cafe | Subject: Re: [Haskell-cafe] Resources on how to implement (Haskell 98) | kind-checking? | | 4. So, apparently GHC takes neither of these options, instead it does: | | iii) Represent kinds with modifiable variables.  Substitution can be | implemented by modifying kind variables in-place.  This is called | "zonking" in the GHC sources. | | This solves a small mystery for me, since I previously think that | zonking was replacing remaining kind variables with '*'.  And indeed | this seems to be an example of zonking, but not what zonking is. | | 5. It turns out that the Technical Supplement to the PolyKinds paper | (Kind Inference for Datatypes) does have more detail. | | -BenRI | | | | On 10/12/21 3:35 PM, Benjamin Redelings wrote: | > Hi, | > | > 1. I'm looking for resources that describe how to implement kind | > Haskell 98 checking.  Does anyone have any suggestions? | > | > * I've looked at the PolyKinds paper, but it doesn't cover type | classes. | > | > * I've looked at the source code to GHC, but it is hard to follow | for | > a variety of reasons.  It isn't laid out like an algorithm | > description, and the complexity to handle options like PolyKinds and | > DataKinds makes the code harder to follow. | > | > | > 2. One question that came up is how to handle type variables that | are | > present in class methods, but are not type class parameters. If | there | > are multiple types/classes in a single recursive group, the kind of | > such type variables might not be fully resolved until a later | > type-or-class is processed.  Is there a recommended approach? | > | > I can see two ways to proceed: | > | > i) First determine the kinds of all the data types, classes, and | type | > synonyms.  Then perform a second pass over each type or class to | > determine the kinds of type variables (in class methods) that are | not | > type class parameters. | > | > ii) Alternatively, record the kind of each type variable as it is | > encountered -- even though such kinds may contain unification kind | > variables.  After visiting all types-or-classes in the recursive | > group, replace any kind variables with their definition, or with a * | > if there is no definition. | > | > I've currently implement approach i), which requires doing kind | > inference on class methods twice.  Is this the recommended approach? | > | > | > 3. Also, is Haskell 98 kind checking the same as Haskell 2010 kind | > checking? | > | > -BenRI | > | > | _______________________________________________ | Haskell-Cafe mailing list | To (un)subscribe, modify options or view archives go to: | https://nam06.safelinks.protection.outlook.com/?url=http%3A%2F%2Fmail. | haskell.org%2Fcgi-bin%2Fmailman%2Flistinfo%2Fhaskell- | cafe&data=04%7C01%7Csimonpj%40microsoft.com%7Ca5f05a143187488dc9e9 | 08d98f1cf5fc%7C72f988bf86f141af91ab2d7cd011db47%7C1%7C0%7C637698177117 | 544440%7CUnknown%7CTWFpbGZsb3d8eyJWIjoiMC4wLjAwMDAiLCJQIjoiV2luMzIiLCJ | BTiI6Ik1haWwiLCJXVCI6Mn0%3D%7C3000&sdata=nbrfIYORY0IfrnCIv4OAY89Bn | wdd6QjWNhWuGYm3Ngk%3D&reserved=0 | Only members subscribed via the mailman list are allowed to post. From seph at codex.scot Fri Oct 15 20:22:10 2021 From: seph at codex.scot (Seph Shewell Brockway) Date: Fri, 15 Oct 2021 21:22:10 +0100 Subject: [Haskell-cafe] Bug in Data.Bits.shift? In-Reply-To: <2B91CE26-427E-40BC-8C9E-F6306B78C175@gmail.com> References: <2B91CE26-427E-40BC-8C9E-F6306B78C175@gmail.com> Message-ID: <20211015202210.vzl666srlcw474os@leviathan> On Thu, Oct 14, 2021 at 08:05:42PM +0000, Keith wrote: > As currently defined, `shift x minBound` calls `shiftR` with a negative displacement. > > This would avoid that: > ``` > shift x n > | n >= 0 = shiftL x n > | n == minBound = shiftR (shiftR x maxBound) 1 > | otherwise = shiftR x (-n) > ``` That would require `Bits` to be a subclass of both `Ord` and `Bounded`; currently it is only a subclass of `Eq`, and I’d want to be very cautious about changing that. Regards, Seph -- Seph Shewell Brockway, BSc MSc (Glas.) Pronouns: she/her From seph at codex.scot Fri Oct 15 20:33:04 2021 From: seph at codex.scot (Seph Shewell Brockway) Date: Fri, 15 Oct 2021 21:33:04 +0100 Subject: [Haskell-cafe] Bug in Data.Bits.shift? In-Reply-To: <20211015202210.vzl666srlcw474os@leviathan> References: <2B91CE26-427E-40BC-8C9E-F6306B78C175@gmail.com> <20211015202210.vzl666srlcw474os@leviathan> Message-ID: <20211015203304.pfw2t2kzf6g3jqu6@leviathan> On Fri, Oct 15, 2021 at 09:22:10PM +0100, Seph Shewell Brockway wrote: > That would require `Bits` to be a subclass of both `Ord` and `Bounded`; > currently it is only a subclass of `Eq`, and I’d want to be very cautious > about changing that. Sorry, completely mixed up the two arguments to `shift`. Don’t mind me. S -- Seph Shewell Brockway, BSc MSc (Glas.) Pronouns: she/her From markus.l2ll at gmail.com Sat Oct 16 09:55:21 2021 From: markus.l2ll at gmail.com (=?UTF-8?B?TWFya3VzIEzDpGxs?=) Date: Sat, 16 Oct 2021 12:55:21 +0300 Subject: [Haskell-cafe] Downsides to disabling unticked-promoted-constructor warning? Message-ID: Hi! Is there any consensus on unticked promoted constructors -- are they generally safe to use? Currently the warning is part of -Wall, but having promoted constructors unticked is just aesthetically nicer. Thanks, -- Markus Läll -------------- next part -------------- An HTML attachment was scrubbed... URL: From xnningxie at gmail.com Sat Oct 16 16:04:36 2021 From: xnningxie at gmail.com (Ningning Xie) Date: Sat, 16 Oct 2021 17:04:36 +0100 Subject: [Haskell-cafe] Resources on how to implement (Haskell 98) kind-checking? In-Reply-To: References: <34939fd9-e592-315a-114b-f1f6d1fef686@gmail.com> <3b91afc5-0aaa-eefd-c917-143a8e7bc1c8@gmail.com> Message-ID: Hi Benjamin, Glad to know that you're looking at the kind inference algorithm for Haskell! Hope you enjoyed our kind inference paper and its technical supplement. As mentioned in the email thread, for Haskell 98, the type inference algorithm is essentially a variant of type inference for simply typed lambda calculus (STLC), as kinds are only *, * -> *, etc (as analogous to int, int -> int, etc in STLC). To me, the most exciting parts of Haskell 98 kind inference are (1) pinpointing precisely what happens to mutually recursive declarations, (2) the formalism of "defaulting" (i.e., what happens to unconstrained kind unification variables when you have no polymorphism? In Haskell 98, they are by default solved by *), and (3) the subtle interaction between (1) and (2): you got different kinds for a declaration depending on whether or not it is mutually recursive with another declaration (as explained in Section 4.3 in the kind inference paper). In the related work (Section 9) of the kind inference paper we have also compared with the paper "A system of constructor classes: overloading and implicit higher-order polymorphism" in terms of the kind inference algorithm. You might find the paragraph helpful: Jones [1995] proposed a homogeneous kind-preserving unification between two > types. Kinds κ are defined only as * or κ1 → κ2. As the kind system is much > simpler, kind-preserving unification ≈κ is simply subscripted by the kind, > and working out the kinds is straightforward. Our unification subsumes > Jones’s algorithm. My thesis contains further explanations and clarifications for the idea of "promotion" used in the paper. Please feel free to let me know if you have any questions and I'd be happy to help! Cheers, Ningning On Thu, 14 Oct 2021 at 22:48, Simon Peyton Jones via Haskell-Cafe < haskell-cafe at haskell.org> wrote: > You might also find this talk helpful. > > https://www.microsoft.com/en-us/research/publication/type-inference-as-constraint-solving-how-ghcs-type-inference-engine-actually-works/ > > And this paper: > https://www.microsoft.com/en-us/research/publication/outsideinx-modular-type-inference-with-local-assumptions/ > > The former is in tutorial form, but lacks a proper paper to back it up. > The latter is a proper paper, but its focus is on *local* constraints which > is more than you need right now. > > You might also enjoy Ningning Xie's thesis, > https://xnning.github.io/papers/Thesis.pdf > and her paper "Kind inference for data types" > https://xnning.github.io/papers/kind-inference.pdf > which are all about kind inference. > > Simon > > PS: I am leaving Microsoft at the end of November 2021, at which point > simonpj at microsoft.com will cease to work. Use simon.peytonjones at gmail.com > instead. (For now, it just forwards to simonpj at microsoft.com.) > > | -----Original Message----- > | From: Haskell-Cafe On Behalf Of > | Benjamin Redelings > | Sent: 14 October 2021 15:14 > | To: Haskell Cafe > | Subject: Re: [Haskell-cafe] Resources on how to implement (Haskell 98) > | kind-checking? > | > | 4. So, apparently GHC takes neither of these options, instead it does: > | > | iii) Represent kinds with modifiable variables. Substitution can be > | implemented by modifying kind variables in-place. This is called > | "zonking" in the GHC sources. > | > | This solves a small mystery for me, since I previously think that > | zonking was replacing remaining kind variables with '*'. And indeed > | this seems to be an example of zonking, but not what zonking is. > | > | 5. It turns out that the Technical Supplement to the PolyKinds paper > | (Kind Inference for Datatypes) does have more detail. > | > | -BenRI > | > | > | > | On 10/12/21 3:35 PM, Benjamin Redelings wrote: > | > Hi, > | > > | > 1. I'm looking for resources that describe how to implement kind > | > Haskell 98 checking. Does anyone have any suggestions? > | > > | > * I've looked at the PolyKinds paper, but it doesn't cover type > | classes. > | > > | > * I've looked at the source code to GHC, but it is hard to follow > | for > | > a variety of reasons. It isn't laid out like an algorithm > | > description, and the complexity to handle options like PolyKinds and > | > DataKinds makes the code harder to follow. > | > > | > > | > 2. One question that came up is how to handle type variables that > | are > | > present in class methods, but are not type class parameters. If > | there > | > are multiple types/classes in a single recursive group, the kind of > | > such type variables might not be fully resolved until a later > | > type-or-class is processed. Is there a recommended approach? > | > > | > I can see two ways to proceed: > | > > | > i) First determine the kinds of all the data types, classes, and > | type > | > synonyms. Then perform a second pass over each type or class to > | > determine the kinds of type variables (in class methods) that are > | not > | > type class parameters. > | > > | > ii) Alternatively, record the kind of each type variable as it is > | > encountered -- even though such kinds may contain unification kind > | > variables. After visiting all types-or-classes in the recursive > | > group, replace any kind variables with their definition, or with a * > | > if there is no definition. > | > > | > I've currently implement approach i), which requires doing kind > | > inference on class methods twice. Is this the recommended approach? > | > > | > > | > 3. Also, is Haskell 98 kind checking the same as Haskell 2010 kind > | > checking? > | > > | > -BenRI > | > > | > > | _______________________________________________ > | Haskell-Cafe mailing list > | To (un)subscribe, modify options or view archives go to: > | https://nam06.safelinks.protection.outlook.com/?url=http%3A%2F%2Fmail. > | haskell.org%2Fcgi-bin%2Fmailman%2Flistinfo%2Fhaskell- > | cafe&data=04%7C01%7Csimonpj%40microsoft.com%7Ca5f05a143187488dc9e9 > | 08d98f1cf5fc%7C72f988bf86f141af91ab2d7cd011db47%7C1%7C0%7C637698177117 > | 544440%7CUnknown%7CTWFpbGZsb3d8eyJWIjoiMC4wLjAwMDAiLCJQIjoiV2luMzIiLCJ > | BTiI6Ik1haWwiLCJXVCI6Mn0%3D%7C3000&sdata=nbrfIYORY0IfrnCIv4OAY89Bn > | wdd6QjWNhWuGYm3Ngk%3D&reserved=0 > | Only members subscribed via the mailman list are allowed to post. > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From adam at well-typed.com Sat Oct 16 21:57:11 2021 From: adam at well-typed.com (Adam Gundry) Date: Sat, 16 Oct 2021 22:57:11 +0100 Subject: [Haskell-cafe] Downsides to disabling unticked-promoted-constructor warning? In-Reply-To: References: Message-ID: <4fb715f8-0acd-5b9b-98cf-77c8521b9a09@well-typed.com> Hi, On 16/10/2021 10:55, Markus Läll wrote: > Is there any consensus on unticked promoted constructors -- are they > generally safe to use? > > Currently the warning is part of -Wall, but having promoted constructors > unticked is just aesthetically nicer. I don't know if there is a consensus, but I have long been of the opinion that -Wunticked-promoted-constructors should be dropped from -Wall and that GHC should not insert ticks when printing inferred types unless including them is necessary for disambiguation. In particular, as a library author I want to use DataKinds without my users having to know or care what it does. You can sometimes hide the ticks by defining a type synonym, e.g. data T = MkT type MkT = 'MkT but there are cases where GHC exposes the difference still, e.g. if you mention MkT in a class instance head. Cheers, Adam -- Adam Gundry, Haskell Consultant Well-Typed LLP, https://www.well-typed.com/ Registered in England & Wales, OC335890 118 Wymering Mansions, Wymering Road, London W9 2NF, England From mail at joachim-breitner.de Sun Oct 17 11:53:43 2021 From: mail at joachim-breitner.de (Joachim Breitner) Date: Sun, 17 Oct 2021 13:53:43 +0200 Subject: [Haskell-cafe] Bug in Data.Bits.shift? In-Reply-To: <2B91CE26-427E-40BC-8C9E-F6306B78C175@gmail.com> References: <2B91CE26-427E-40BC-8C9E-F6306B78C175@gmail.com> Message-ID: <0a57ed4654022a207c089fab3b2b55f85b4d4700.camel@joachim-breitner.de> Hi, Am Donnerstag, dem 14.10.2021 um 20:05 +0000 schrieb Keith: > As currently defined, `shift x minBound` calls `shiftR` with a negative > displacement. > > This would avoid that: > ``` > shift x n >  | n >= 0 = shiftL x n >  | n == minBound = shiftR (shiftR x maxBound) 1 >  | otherwise = shiftR x (-n) > ``` thanks, yes, this looks like a bug to me: ghci> shift (-2) (-20000) :: Integer -1 ghci> shift (-2) minBound :: Integer -2 ghci> shift (-2) (-20000) :: Int -1 ghci> shift (-2) minBound :: Int -2 Maybe report it at https://gitlab.haskell.org/ghc/ghc/issues/new (once the gitlab is up again), or even supply a patch. Cheers, Joachim -- Joachim Breitner mail at joachim-breitner.de http://www.joachim-breitner.de/ From lists at richarde.dev Mon Oct 18 02:19:43 2021 From: lists at richarde.dev (Richard Eisenberg) Date: Mon, 18 Oct 2021 02:19:43 +0000 Subject: [Haskell-cafe] Downsides to disabling unticked-promoted-constructor warning? In-Reply-To: References: Message-ID: <010f017c913294bc-a535be27-8b69-4064-9858-49d83feab7ee-000000@us-east-2.amazonses.com> As its author, I think -Wunticked-promoted-constructors is a misfeature. It was motivated by the fact that writing [True] when you mean '[True] produces a cascade of obscure kind errors, and so I thought it was good to encourage people to always write the ticks. But the feature does not achieve its goal: because errors squelch warnings, we do not see the warnings if there are any errors. Furthermore, I agree with Adam's post that I've come to prefer a style where we leave off the ticks (where possible). Bottom line: feel free to turn this warning off. Richard > On Oct 16, 2021, at 5:55 AM, Markus Läll wrote: > > Hi! > > Is there any consensus on unticked promoted constructors -- are they generally safe to use? > > Currently the warning is part of -Wall, but having promoted constructors unticked is just aesthetically nicer. > > > Thanks, > > -- > Markus Läll > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From andreeac at comp.nus.edu.sg Mon Oct 18 07:06:38 2021 From: andreeac at comp.nus.edu.sg (Andreea Costea) Date: Mon, 18 Oct 2021 15:06:38 +0800 Subject: [Haskell-cafe] Looking for ESOP'22 AEC members Message-ID: <8b6784b9ddc118679f8eb4ab09c035fa@comp.nus.edu.sg> For the first time since its foundation, ESOP will carry out an Artifact Evaluation process. The goal is to share with the community the research artefacts of papers accepted to its research track, acknowledging those works which have been rigorously implemented, tested and documented. To this purpose, we are looking for motivated students and postdocs to be members of the ESOP 2022 Artifact Evaluation Committee (AEC). The primary responsibility of an AEC member is to run the associated tools and confirm the results reported in the papers. If you know someone suitable for this role, please nominate them in the following form (or share the form with them for self-nomination): https://t.co/Jqa7edDqTg?amp=1 Come join us in this effort! Kind Regards, Andreea Costea and KC Sivaramakrishnan, AEC Co-Chairs of ESOP 2022 From lemming at henning-thielemann.de Mon Oct 18 10:47:49 2021 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Mon, 18 Oct 2021 12:47:49 +0200 (CEST) Subject: [Haskell-cafe] GDB and ticks Message-ID: <12262ccf-336f-1da3-d8e4-14cda5ebca57@henning-thielemann.de> I am stepping through a Haskell program using the GNU debugger GDB and see function calls to handle_tick, handleProfTick, stopTicker all over the place. It sounds like they would manage profiling, but I compiled the executable without profiling. From sylvain at haskus.fr Mon Oct 18 12:13:24 2021 From: sylvain at haskus.fr (Sylvain Henry) Date: Mon, 18 Oct 2021 14:13:24 +0200 Subject: [Haskell-cafe] GDB and ticks In-Reply-To: <12262ccf-336f-1da3-d8e4-14cda5ebca57@henning-thielemann.de> References: <12262ccf-336f-1da3-d8e4-14cda5ebca57@henning-thielemann.de> Message-ID: <9a48d945-ec72-67f8-80a6-03fe5df5c494@haskus.fr> The timer isn't only used for profiling, it is used for scheduling too. You can disable it with `+RTS -V0` (cf https://ghc.gitlab.haskell.org/ghc/doc/users_guide/debug-info.html#tutorial) On 18/10/2021 12:47, Henning Thielemann wrote: > > I am stepping through a Haskell program using the GNU debugger GDB and > see function calls to handle_tick, handleProfTick, stopTicker all over > the place. It sounds like they would manage profiling, but I compiled > the executable without profiling. > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From mikolaj at well-typed.com Mon Oct 18 12:28:34 2021 From: mikolaj at well-typed.com (Mikolaj Konarski) Date: Mon, 18 Oct 2021 14:28:34 +0200 Subject: [Haskell-cafe] GDB and ticks In-Reply-To: <9a48d945-ec72-67f8-80a6-03fe5df5c494@haskus.fr> References: <12262ccf-336f-1da3-d8e4-14cda5ebca57@henning-thielemann.de> <9a48d945-ec72-67f8-80a6-03fe5df5c494@haskus.fr> Message-ID: Oh, might it be why my pet roguelike game is running at 20% higher frames per second without -threaded? Would these tick calls be removed in non-threaded RTS? On Mon, Oct 18, 2021 at 2:18 PM Sylvain Henry wrote: > > The timer isn't only used for profiling, it is used for scheduling too. > You can disable it with `+RTS -V0` (cf > https://ghc.gitlab.haskell.org/ghc/doc/users_guide/debug-info.html#tutorial) > > On 18/10/2021 12:47, Henning Thielemann wrote: > > > > I am stepping through a Haskell program using the GNU debugger GDB and > > see function calls to handle_tick, handleProfTick, stopTicker all over > > the place. It sounds like they would manage profiling, but I compiled > > the executable without profiling. > > _______________________________________________ > > Haskell-Cafe mailing list > > To (un)subscribe, modify options or view archives go to: > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > > Only members subscribed via the mailman list are allowed to post. > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From sylvain at haskus.fr Mon Oct 18 12:56:57 2021 From: sylvain at haskus.fr (Sylvain Henry) Date: Mon, 18 Oct 2021 14:56:57 +0200 Subject: [Haskell-cafe] GDB and ticks In-Reply-To: References: <12262ccf-336f-1da3-d8e4-14cda5ebca57@henning-thielemann.de> <9a48d945-ec72-67f8-80a6-03fe5df5c494@haskus.fr> Message-ID: <7bdfac3f-2513-2d0f-af25-ffd6c9713db4@haskus.fr> Probably not: the timer is also enabled in the non-threaded RTS. As a guess, you could try disabling the idle GC with `+RTS -I0` with the threaded RTS. On 18/10/2021 14:28, Mikolaj Konarski wrote: > Oh, might it be why my pet roguelike game is running at 20% higher > frames per second without -threaded? Would these tick calls be removed > in non-threaded RTS? > > On Mon, Oct 18, 2021 at 2:18 PM Sylvain Henry wrote: >> The timer isn't only used for profiling, it is used for scheduling too. >> You can disable it with `+RTS -V0` (cf >> https://ghc.gitlab.haskell.org/ghc/doc/users_guide/debug-info.html#tutorial) >> >> On 18/10/2021 12:47, Henning Thielemann wrote: >>> I am stepping through a Haskell program using the GNU debugger GDB and >>> see function calls to handle_tick, handleProfTick, stopTicker all over >>> the place. It sounds like they would manage profiling, but I compiled >>> the executable without profiling. >>> _______________________________________________ >>> Haskell-Cafe mailing list >>> To (un)subscribe, modify options or view archives go to: >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >>> Only members subscribed via the mailman list are allowed to post. >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From lemming at henning-thielemann.de Mon Oct 18 14:14:20 2021 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Mon, 18 Oct 2021 16:14:20 +0200 (CEST) Subject: [Haskell-cafe] GDB and ticks In-Reply-To: <9a48d945-ec72-67f8-80a6-03fe5df5c494@haskus.fr> References: <12262ccf-336f-1da3-d8e4-14cda5ebca57@henning-thielemann.de> <9a48d945-ec72-67f8-80a6-03fe5df5c494@haskus.fr> Message-ID: <701a11d-188b-f760-9fce-25acbf989ae@henning-thielemann.de> On Mon, 18 Oct 2021, Sylvain Henry wrote: > The timer isn't only used for profiling, it is used for scheduling too. > You can disable it with `+RTS -V0` (cf > https://ghc.gitlab.haskell.org/ghc/doc/users_guide/debug-info.html#tutorial) Cool, this works! From donn at avvanta.com Mon Oct 18 14:27:28 2021 From: donn at avvanta.com (Donn Cave) Date: Mon, 18 Oct 2021 07:27:28 -0700 (PDT) Subject: [Haskell-cafe] GDB and ticks In-Reply-To: <701a11d-188b-f760-9fce-25acbf989ae@henning-thielemann.de> References: <12262ccf-336f-1da3-d8e4-14cda5ebca57@henning-thielemann.de><9a48d945-ec72-67f8-80a6-03fe5df5c494@haskus.fr><701a11d-188b-f760-9fce-25acbf989ae@henning-thielemann.de> Message-ID: <20211018142728.5AB8F276C41@mail.avvanta.com> quoth Henning Thielemann > On Mon, 18 Oct 2021, Sylvain Henry wrote: > > The timer isn't only used for profiling, it is used for scheduling too. > > You can disable it with `+RTS -V0` (cf > > https://ghc.gitlab.haskell.org/ghc/doc/users_guide/debug-info.html#tutorial) > > Cool, this works! What does it break? Just about anything I'd run that was written in Haskell must run this way, to avoid fatal interrupts in things like socket I/O, so it's essentially a default - everything must be built with -rtsopts, and run with GHCRTS=-V0 environment. Donn From allbery.b at gmail.com Mon Oct 18 14:31:49 2021 From: allbery.b at gmail.com (Brandon Allbery) Date: Mon, 18 Oct 2021 10:31:49 -0400 Subject: [Haskell-cafe] GDB and ticks In-Reply-To: <20211018142728.5AB8F276C41@mail.avvanta.com> References: <12262ccf-336f-1da3-d8e4-14cda5ebca57@henning-thielemann.de> <9a48d945-ec72-67f8-80a6-03fe5df5c494@haskus.fr> <701a11d-188b-f760-9fce-25acbf989ae@henning-thielemann.de> <20211018142728.5AB8F276C41@mail.avvanta.com> Message-ID: Sadly, it also comes with a price: everything including GCs runs at every context switch instead of waiting for an appropriate number of ticks to pass. (That said, I've also been bitten by the interrupt issue.) On Mon, Oct 18, 2021 at 10:28 AM Donn Cave wrote: > quoth Henning Thielemann > > On Mon, 18 Oct 2021, Sylvain Henry wrote: > > > The timer isn't only used for profiling, it is used for scheduling > too. > > > You can disable it with `+RTS -V0` (cf > > > > https://ghc.gitlab.haskell.org/ghc/doc/users_guide/debug-info.html#tutorial > ) > > > > Cool, this works! > > What does it break? Just about anything I'd run that was written in > Haskell must run this way, to avoid fatal interrupts in things like > socket I/O, so it's essentially a default - everything must be built > with -rtsopts, and run with GHCRTS=-V0 environment. > > Donn > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -- brandon s allbery kf8nh allbery.b at gmail.com -------------- next part -------------- An HTML attachment was scrubbed... URL: From mikolaj at well-typed.com Mon Oct 18 14:44:38 2021 From: mikolaj at well-typed.com (Mikolaj Konarski) Date: Mon, 18 Oct 2021 16:44:38 +0200 Subject: [Haskell-cafe] GDB and ticks In-Reply-To: References: <12262ccf-336f-1da3-d8e4-14cda5ebca57@henning-thielemann.de> <9a48d945-ec72-67f8-80a6-03fe5df5c494@haskus.fr> <701a11d-188b-f760-9fce-25acbf989ae@henning-thielemann.de> <20211018142728.5AB8F276C41@mail.avvanta.com> Message-ID: I've just done some non-scientific benchmarks that show that in code with a lot of (I presume) unsafe FFI calls such as buffered `putStr` on Linux, performance can drop by half and even more with `+RTS -V0`. I can share if anybody is interested. BTW, this is orthogonal to `-threaded` which in my benchmarks slows no-FFI code with a few threads by 20%, safe FFI calls-heavy code (SDL2 graphics) by 50% and speeds up unsafe FFI-heavy code (`putStr`). On Mon, Oct 18, 2021 at 4:35 PM Brandon Allbery wrote: > > Sadly, it also comes with a price: everything including GCs runs at every context switch instead of waiting for an appropriate number of ticks to pass. (That said, I've also been bitten by the interrupt issue.) > > On Mon, Oct 18, 2021 at 10:28 AM Donn Cave wrote: >> >> quoth Henning Thielemann >> > On Mon, 18 Oct 2021, Sylvain Henry wrote: >> > > The timer isn't only used for profiling, it is used for scheduling too. >> > > You can disable it with `+RTS -V0` (cf >> > > https://ghc.gitlab.haskell.org/ghc/doc/users_guide/debug-info.html#tutorial) >> > >> > Cool, this works! >> >> What does it break? Just about anything I'd run that was written in >> Haskell must run this way, to avoid fatal interrupts in things like >> socket I/O, so it's essentially a default - everything must be built >> with -rtsopts, and run with GHCRTS=-V0 environment. >> >> Donn >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. > > > > -- > brandon s allbery kf8nh > allbery.b at gmail.com > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From sylvain at haskus.fr Mon Oct 18 15:32:30 2021 From: sylvain at haskus.fr (Sylvain Henry) Date: Mon, 18 Oct 2021 17:32:30 +0200 Subject: [Haskell-cafe] GDB and ticks In-Reply-To: <20211018142728.5AB8F276C41@mail.avvanta.com> References: <12262ccf-336f-1da3-d8e4-14cda5ebca57@henning-thielemann.de> <9a48d945-ec72-67f8-80a6-03fe5df5c494@haskus.fr> <701a11d-188b-f760-9fce-25acbf989ae@henning-thielemann.de> <20211018142728.5AB8F276C41@mail.avvanta.com> Message-ID: On 18/10/2021 16:27, Donn Cave wrote: > > What does it break? Just about anything I'd run that was written in > Haskell must run this way, to avoid fatal interrupts in things like > socket I/O, so it's essentially a default - everything must be built > with -rtsopts, and run with GHCRTS=-V0 environment. It shouldn't be necessary on Linux: since 2016 [1] the RTS uses timerfd which doesn't use signals and avoids interrupting other I/O. Sylvain [1] https://github.com/ghc/ghc/commit/120b9cdb31878ecee442c0a4bb9532a9d30c0c64 From cdsmith at gmail.com Tue Oct 19 02:03:12 2021 From: cdsmith at gmail.com (Chris Smith) Date: Mon, 18 Oct 2021 22:03:12 -0400 Subject: [Haskell-cafe] You're invited to the October virtual Haskell CoHack Message-ID: Hi everyone, This Saturday, I’m once again hosting a virtual Haskell CoHack. In the past, we’ve had a great time with groups here working on various projects, whether it’s learning Haskell, hacking on GHC, writing documentation, making progress on personal projects, or just hanging out to chat with like-minded folk. You should consider coming if you would be excited to meet fellow Haskell programmers and work or learn together with them. There are details, including times, on the meetup page: https://www.meetup.com/NY-Haskell/events/280998863 -------------- next part -------------- An HTML attachment was scrubbed... URL: From adam at well-typed.com Wed Oct 20 12:28:18 2021 From: adam at well-typed.com (Adam Gundry) Date: Wed, 20 Oct 2021 13:28:18 +0100 Subject: [Haskell-cafe] Downsides to disabling unticked-promoted-constructor warning? In-Reply-To: <010f017c913294bc-a535be27-8b69-4064-9858-49d83feab7ee-000000@us-east-2.amazonses.com> References: <010f017c913294bc-a535be27-8b69-4064-9858-49d83feab7ee-000000@us-east-2.amazonses.com> Message-ID: I've created a ticket to request disabling this warning by default: https://gitlab.haskell.org/ghc/ghc/-/issues/20531 I'm not sure if this needs a full ghc-proposal. Cheers, Adam On 18/10/2021 03:19, Richard Eisenberg wrote: > As its author, I think -Wunticked-promoted-constructors is a misfeature. It was motivated by the fact that writing [True] when you mean '[True] produces a cascade of obscure kind errors, and so I thought it was good to encourage people to always write the ticks. But the feature does not achieve its goal: because errors squelch warnings, we do not see the warnings if there are any errors. Furthermore, I agree with Adam's post that I've come to prefer a style where we leave off the ticks (where possible). > > Bottom line: feel free to turn this warning off. > > Richard > >> On Oct 16, 2021, at 5:55 AM, Markus Läll wrote: >> >> Hi! >> >> Is there any consensus on unticked promoted constructors -- are they generally safe to use? >> >> Currently the warning is part of -Wall, but having promoted constructors unticked is just aesthetically nicer. >> >> >> Thanks, >> >> -- >> Markus Läll -- Adam Gundry, Haskell Consultant Well-Typed LLP, https://www.well-typed.com/ Registered in England & Wales, OC335890 118 Wymering Mansions, Wymering Road, London W9 2NF, England From markus.l2ll at gmail.com Thu Oct 21 16:13:55 2021 From: markus.l2ll at gmail.com (=?UTF-8?B?TWFya3VzIEzDpGxs?=) Date: Thu, 21 Oct 2021 19:13:55 +0300 Subject: [Haskell-cafe] Downsides to disabling unticked-promoted-constructor warning? In-Reply-To: References: <010f017c913294bc-a535be27-8b69-4064-9858-49d83feab7ee-000000@us-east-2.amazonses.com> Message-ID: Hi and thank you both! For disambiguation the tick may be required for syntactically empty and one element lists, right? As only these can be ambiguous at locations where a type is expected. On Wed, Oct 20, 2021 at 3:29 PM Adam Gundry wrote: > I've created a ticket to request disabling this warning by default: > https://gitlab.haskell.org/ghc/ghc/-/issues/20531 > > I'm not sure if this needs a full ghc-proposal. > > Cheers, > > Adam > > > > On 18/10/2021 03:19, Richard Eisenberg wrote: > > As its author, I think -Wunticked-promoted-constructors is a misfeature. > It was motivated by the fact that writing [True] when you mean '[True] > produces a cascade of obscure kind errors, and so I thought it was good to > encourage people to always write the ticks. But the feature does not > achieve its goal: because errors squelch warnings, we do not see the > warnings if there are any errors. Furthermore, I agree with Adam's post > that I've come to prefer a style where we leave off the ticks (where > possible). > > > > Bottom line: feel free to turn this warning off. > > > > Richard > > > >> On Oct 16, 2021, at 5:55 AM, Markus Läll wrote: > >> > >> Hi! > >> > >> Is there any consensus on unticked promoted constructors -- are they > generally safe to use? > >> > >> Currently the warning is part of -Wall, but having promoted > constructors unticked is just aesthetically nicer. > >> > >> > >> Thanks, > >> > >> -- > >> Markus Läll > > > -- > Adam Gundry, Haskell Consultant > Well-Typed LLP, https://www.well-typed.com/ > > Registered in England & Wales, OC335890 > 118 Wymering Mansions, Wymering Road, London W9 2NF, England > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -- Markus Läll -------------- next part -------------- An HTML attachment was scrubbed... URL: From david.feuer at gmail.com Thu Oct 21 16:21:30 2021 From: david.feuer at gmail.com (David Feuer) Date: Thu, 21 Oct 2021 12:21:30 -0400 Subject: [Haskell-cafe] Downsides to disabling unticked-promoted-constructor warning? In-Reply-To: References: <010f017c913294bc-a535be27-8b69-4064-9858-49d83feab7ee-000000@us-east-2.amazonses.com> Message-ID: There can also be ambiguities in type families. For example, data T = T type family Fam a where Fam Int = T Do we have Fam :: Type -> Type or Fam :: Type -> T? On Thu, Oct 21, 2021, 12:15 PM Markus Läll wrote: > Hi and thank you both! > > For disambiguation the tick may be required for syntactically empty and > one element lists, right? As only these can be ambiguous at locations where > a type is expected. > > > On Wed, Oct 20, 2021 at 3:29 PM Adam Gundry wrote: > >> I've created a ticket to request disabling this warning by default: >> https://gitlab.haskell.org/ghc/ghc/-/issues/20531 >> >> I'm not sure if this needs a full ghc-proposal. >> >> Cheers, >> >> Adam >> >> >> >> On 18/10/2021 03:19, Richard Eisenberg wrote: >> > As its author, I think -Wunticked-promoted-constructors is a >> misfeature. It was motivated by the fact that writing [True] when you mean >> '[True] produces a cascade of obscure kind errors, and so I thought it was >> good to encourage people to always write the ticks. But the feature does >> not achieve its goal: because errors squelch warnings, we do not see the >> warnings if there are any errors. Furthermore, I agree with Adam's post >> that I've come to prefer a style where we leave off the ticks (where >> possible). >> > >> > Bottom line: feel free to turn this warning off. >> > >> > Richard >> > >> >> On Oct 16, 2021, at 5:55 AM, Markus Läll >> wrote: >> >> >> >> Hi! >> >> >> >> Is there any consensus on unticked promoted constructors -- are they >> generally safe to use? >> >> >> >> Currently the warning is part of -Wall, but having promoted >> constructors unticked is just aesthetically nicer. >> >> >> >> >> >> Thanks, >> >> >> >> -- >> >> Markus Läll >> >> >> -- >> Adam Gundry, Haskell Consultant >> Well-Typed LLP, https://www.well-typed.com/ >> >> Registered in England & Wales, OC335890 >> 118 Wymering Mansions, Wymering Road, London W9 2NF, England >> _______________________________________________ >> Haskell-Cafe mailing list >> To (un)subscribe, modify options or view archives go to: >> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe >> Only members subscribed via the mailman list are allowed to post. > > > > -- > Markus Läll > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From matthias.gudemann at gmail.com Thu Oct 21 18:40:45 2021 From: matthias.gudemann at gmail.com (=?UTF-8?Q?Matthias_G=C3=BCdemann?=) Date: Thu, 21 Oct 2021 20:40:45 +0200 Subject: [Haskell-cafe] Type inference for lambda function Message-ID: Hi cafe, today while explaining lambda functions I came across this case which I don't really understand. This is what I get using ghci λ> :t (\a b -> a + b) (\a b -> a + b) :: Num a => a -> a -> a but when loading a .hs file with just this function (without signature) add = \a b -> a + b I get λ> :t add add :: Integer -> Integer -> Integer but I can explicitly define add to have this type: add :: Num a => a -> a -> a add = \a b -> a + b Also ghc infers this polymorphic type for example for add0 a = \b -> a + b Why is the type of add without a signature inferred to Integer and not Num a? Best regards Matthias From ietf-dane at dukhovni.org Thu Oct 21 18:47:18 2021 From: ietf-dane at dukhovni.org (Viktor Dukhovni) Date: Thu, 21 Oct 2021 14:47:18 -0400 Subject: [Haskell-cafe] Type inference for lambda function In-Reply-To: References: Message-ID: On Thu, Oct 21, 2021 at 08:40:45PM +0200, Matthias Güdemann wrote: > This is what I get using ghci > > λ> :t (\a b -> a + b) > (\a b -> a + b) :: Num a => a -> a -> a > > but when loading a .hs file with just this function (without signature) > > add = \a b -> a + b > > I get > > λ> :t add > add :: Integer -> Integer -> Integer Compare: $ ghci -XNoMonomorphismRestriction λ> x = \a b -> a + b λ> :t x x :: Num a => a -> a -> a with $ ghci -XMonomorphismRestriction λ> x = \a b -> a + b λ> :t x x :: Integer -> Integer -> Integer -- Viktor. From david.feuer at gmail.com Thu Oct 21 18:48:05 2021 From: david.feuer at gmail.com (David Feuer) Date: Thu, 21 Oct 2021 14:48:05 -0400 Subject: [Haskell-cafe] Type inference for lambda function In-Reply-To: References: Message-ID: This is the dreaded monomorphism restriction, which is turned on by default in modules but turned off by default in GHCi. Because your function is not "syntactically" a function (i.e., there are no arguments to the left of the = sign), and has no type signature, the type checker insists on it having a monomorphic type. Unless there's a use of it in the module forcing it to a particular type, the defaulting rules come into play, and a variable with a `Num` constraint defaults, by default, to `Integer`. On Thu, Oct 21, 2021, 2:41 PM Matthias Güdemann wrote: > Hi cafe, > > today while explaining lambda functions I came across this case which > I don't really understand. > > This is what I get using ghci > > λ> :t (\a b -> a + b) > (\a b -> a + b) :: Num a => a -> a -> a > > but when loading a .hs file with just this function (without signature) > > add = \a b -> a + b > > I get > > λ> :t add > add :: Integer -> Integer -> Integer > > but I can explicitly define add to have this type: > > add :: Num a => a -> a -> a > add = \a b -> a + b > > Also ghc infers this polymorphic type for example for > > add0 a = \b -> a + b > > Why is the type of add without a signature inferred to Integer and not Num > a? > > Best regards > Matthias > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From matthias.gudemann at gmail.com Thu Oct 21 19:00:48 2021 From: matthias.gudemann at gmail.com (=?UTF-8?Q?Matthias_G=C3=BCdemann?=) Date: Thu, 21 Oct 2021 21:00:48 +0200 Subject: [Haskell-cafe] Type inference for lambda function In-Reply-To: References: Message-ID: Hi David and Victor, thanks for pointing this out. That explains it. best regards Matthias From dj112358 at outlook.com Fri Oct 22 14:47:44 2021 From: dj112358 at outlook.com (David James) Date: Fri, 22 Oct 2021 14:47:44 +0000 Subject: [Haskell-cafe] Numerics (was: Re: Trouble with asinh) In-Reply-To: References: Message-ID: Hi all – I now have fixes for all the issues I’m aware of. However, it’s quite possible I’ve made a mistake somewhere (either in the new code or the testing), so if anyone would like to help review either please let me know. Group 1 issues (real numbers in Windows, where the defects are in mingw-w64: I’ve raised issue #20424 for this. The fixes (commits 66ba5f32 and 021dffb8a) have been made in mingw-w64 and are getting integrated into Haskell soon. Group 2 issues (complex numbers, where the defects are in Complex.hs). I’ve raised issue #20425 for this and have the code fixes here. The new code changes many of the functions (I’ve given examples in the issue) and adds a few. I’ve also put the Haddock output here. (It now defines and gives an explanation of the branch cuts). I’ve also put some diagrams here illustrating some of the problems. I’ve done about as much testing as I can think of, using the code here. Ideally I’d bulk-test against a reliable independent source, but can’t find one. AFAICT WolframAlpha, Excel, gnumeric, CLISP don’t support negative zeros. Python seems to, but cmath has incorrect branch cuts (cmath.sqrt(-4-0j) gives 2j). Matlab also seems deficient in a number of areas. (Hmmm: maybe no one cares about these working correctly??) Sorry about the delay in sending this, David. -------------- next part -------------- An HTML attachment was scrubbed... URL: From zoran.bosnjak at via.si Fri Oct 22 14:56:59 2021 From: zoran.bosnjak at via.si (Zoran =?utf-8?Q?Bo=C5=A1njak?=) Date: Fri, 22 Oct 2021 14:56:59 +0000 (UTC) Subject: [Haskell-cafe] unexpected compile error with wrapped HList In-Reply-To: <1247324638.471.1634911331740.JavaMail.zimbra@via.si> References: <1247324638.471.1634911331740.JavaMail.zimbra@via.si> Message-ID: <1885593209.505.1634914619671.JavaMail.zimbra@via.si> Hello members, I am struggling to compile the snippet below. GHC version is 8.10.4. If I try to construct the 'Variation' (with the type signature), I am getting an unexpected error. (see the comments in the code below). The error is only present if the HList is empty. I would appreciate a suggestion how to fix it. regards, Zoran --- {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE PolyKinds #-} module Test where import Data.Kind data (a::k1) :<< (b::k2) infixr 5 :<< data HList (ts :: [Type]) where HNil :: HList '[] HCons :: x -> HList xs -> HList (x ': xs) data TVariation = TVariation1 | TVariation2 data Variation vt where Variation1 :: HList ts -> Variation ('TVariation1 :<< ts) Variation2 :: HList ts -> Variation ('TVariation2 :<< ts) -- This works as expected, including the explicit type signature. x1 :: Variation ('TVariation1 :<< '[()]) x1 = Variation1 (HCons () HNil) -- But the following 2 cases do not work as expected. -- 1. problem: -- This 'x0' type is inferred by GHC, -- but when specified as such, it won't compile. {- • Couldn't match type ‘k’ with ‘*’ ‘k’ is a rigid type variable bound by the type signature for: x0 :: forall k. Variation ('TVariation1 :<< '[]) at adhoc/test.hs:39:1-38 Expected type: Variation ((:<<) @TVariation @[k] 'TVariation1 ('[] @k)) Actual type: Variation ((:<<) @TVariation @[*] 'TVariation1 ('[] @*)) • In the expression: Variation1 HNil In an equation for ‘x0’: x0 = Variation1 HNil • Relevant bindings include x0 :: Variation ('TVariation1 :<< '[]) (bound at adhoc/test.hs:40:1) -} x0 :: Variation ('TVariation1 :<< '[]) x0 = Variation1 HNil class Empty t where mkEmpty :: t -- 2. problem: -- This instance declaration reports the same problem (as in x0 above). instance Empty (Variation ('TVariation1 :<< '[])) where mkEmpty = Variation1 HNil From david.feuer at gmail.com Fri Oct 22 15:18:46 2021 From: david.feuer at gmail.com (David Feuer) Date: Fri, 22 Oct 2021 11:18:46 -0400 Subject: [Haskell-cafe] unexpected compile error with wrapped HList In-Reply-To: <1885593209.505.1634914619671.JavaMail.zimbra@via.si> References: <1247324638.471.1634911331740.JavaMail.zimbra@via.si> <1885593209.505.1634914619671.JavaMail.zimbra@via.si> Message-ID: Your type signature is more polykinded than your definition. Remember that [] :: [a] or, with explicit promotion, '[] :: [a] You write x0 :: Variation ('TVariation1 :<< '[]) x0 = Variation1 HNil Your signature more explicitly means x0 :: forall a. Variation ('TVariation1 :<< ('[] :: [a])) But `HNil` is *not* polykinded—it can only produce HList ('[] :: [Type]). So you need to be a little more specific somewhere. One option: data (a::k1) :<< (b::[Type]) Another option: x0 :: Variation ('TVariation1 :<< ('[] :: [Type])) On Fri, Oct 22, 2021, 10:59 AM Zoran Bošnjak wrote: > Hello members, > I am struggling to compile the snippet below. > GHC version is 8.10.4. > > If I try to construct the 'Variation' (with the type signature), I am > getting an unexpected error. > (see the comments in the code below). The error is only present if the > HList is empty. > I would appreciate a suggestion how to fix it. > > regards, > Zoran > > --- > {-# LANGUAGE DataKinds #-} > {-# LANGUAGE GADTs #-} > {-# LANGUAGE FlexibleContexts #-} > {-# LANGUAGE FlexibleInstances #-} > {-# LANGUAGE TypeOperators #-} > {-# LANGUAGE PolyKinds #-} > > module Test where > > import Data.Kind > > data (a::k1) :<< (b::k2) > infixr 5 :<< > > data HList (ts :: [Type]) where > HNil :: HList '[] > HCons :: x -> HList xs -> HList (x ': xs) > > data TVariation = TVariation1 | TVariation2 > > data Variation vt where > Variation1 :: HList ts -> Variation ('TVariation1 :<< ts) > Variation2 :: HList ts -> Variation ('TVariation2 :<< ts) > > -- This works as expected, including the explicit type signature. > x1 :: Variation ('TVariation1 :<< '[()]) > x1 = Variation1 (HCons () HNil) > > -- But the following 2 cases do not work as expected. > > -- 1. problem: > -- This 'x0' type is inferred by GHC, > -- but when specified as such, it won't compile. > {- > • Couldn't match type ‘k’ with ‘*’ > ‘k’ is a rigid type variable bound by > the type signature for: > x0 :: forall k. Variation ('TVariation1 :<< '[]) > at adhoc/test.hs:39:1-38 > Expected type: Variation > ((:<<) @TVariation @[k] 'TVariation1 ('[] @k)) > Actual type: Variation > ((:<<) @TVariation @[*] 'TVariation1 ('[] @*)) > • In the expression: Variation1 HNil > In an equation for ‘x0’: x0 = Variation1 HNil > • Relevant bindings include > x0 :: Variation ('TVariation1 :<< '[]) > (bound at adhoc/test.hs:40:1) > -} > x0 :: Variation ('TVariation1 :<< '[]) > x0 = Variation1 HNil > > class Empty t where > mkEmpty :: t > > -- 2. problem: > -- This instance declaration reports the same problem (as in x0 above). > instance Empty (Variation ('TVariation1 :<< '[])) where > mkEmpty = Variation1 HNil > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From leah at vuxu.org Fri Oct 22 16:20:35 2021 From: leah at vuxu.org (Leah Neukirchen) Date: Fri, 22 Oct 2021 18:20:35 +0200 Subject: [Haskell-cafe] Munich Haskell Meeting, 2021-10-26 @ 19:30 Message-ID: <874k992fqk.fsf@vuxu.org> Dear all, next week, our monthly Munich Haskell Meeting will take place again on Tuesday, October 26 at Augustiner-Gaststätte Rumpler(!!) at 19h30. For details see here: http://muenchen.haskell.bayern/dates.html If you plan to join, please add yourself to this dudle until Tuesday 12:00 so we can reserve enough seats! 3G rules apply. It is OK to add yourself to the dudle anonymously or pseudonymously. https://dudle.inf.tu-dresden.de/haskell-munich-oct-2021/ Everybody is welcome! cu, -- Leah Neukirchen https://leahneukirchen.org/ From albert+haskell at zeitkraut.de Sat Oct 23 06:05:11 2021 From: albert+haskell at zeitkraut.de (Albert Krewinkel) Date: Sat, 23 Oct 2021 08:05:11 +0200 Subject: [Haskell-cafe] [ANN] hslua 2.0.0, bridging Haskell and Lua Message-ID: <87k0i46zu0.fsf@zeitkraut.de> I am pleased to announce the release of [HsLua] 2.0.0; a collection of packages offering (bidirectional) glue and abstractions bridging Haskell and Lua. HsLua is a featureful framework, enabling Haskell programmers to combine the embeddable scripting language Lua with code written Haskell. This new release is an almost complete rewrite and offers better performance, cleaner types, and adds more abstraction helpers. It supports exposing data and functions from Haskell to Lua in a convenient and structured way. Probably the best-known real world use case of HsLua is [pandoc], the universal document converter, where it serves as the central building block for [Lua filters] and custom writers. Contributions are welcome. [HsLua]: https://hslua.org [pandoc]: https://pandoc.org [Lua filters]: https://pandoc.org/lua-filters.html -- Albert Krewinkel GPG: 8eed e3e2 e8c5 6f18 81fe e836 388d c0b2 1f63 1124 From b at chreekat.net Sat Oct 23 06:06:35 2021 From: b at chreekat.net (Bryan Richter) Date: Sat, 23 Oct 2021 09:06:35 +0300 Subject: [Haskell-cafe] Numerics (was: Re: Trouble with asinh) In-Reply-To: References: Message-ID: Hi David, I have one suggestion for the haddocks. I made a solid effort to wade into the explanation of branch cuts and negative zeros, but I never managed to figure out why I should care. ;) In other words: tl;dr. Would it be possible to write a pithy few words right at the beginning as an introduction that motivates the topic? If, as you say, few other languages take the subject into account, it's very likely that few programmers take it into account either. In general, as a math-conscious member of the community, I'm happy to see this kind of work being accomplished, so thanks! -Bryan On Fri, 22 Oct 2021, 17.48 David James, wrote: > Hi all – I now have fixes for all the issues I’m aware of. However, it’s > quite possible I’ve made a mistake somewhere (either in the new code or the > testing), so if anyone would like to help review either please let me know. > > > > *Group 1 issues* (real numbers in Windows, where the defects are in > mingw-w64: I’ve raised issue #20424 > for this. The fixes > (commits 66ba5f32 > > and 021dffb8a > ) > have been made in mingw-w64 and are getting integrated into Haskell soon. > > > > *Group 2 issues* (complex numbers, where the defects are in Complex.hs). > I’ve raised issue #20425 > for this and have the > code fixes here > . > The new code changes many of the functions (I’ve given examples in the > issue) and adds a few. I’ve also put the Haddock output here > . > (It now defines and gives an explanation of the branch cuts). I’ve also put > some diagrams here > > illustrating some of the problems. > > > > I’ve done about as much testing as I can think of, using the code here > . > Ideally I’d bulk-test against a reliable independent source, but can’t find > one. AFAICT WolframAlpha > , Excel, gnumeric, > CLISP don’t support negative zeros. Python > seems to, but cmath has incorrect branch cuts (cmath.sqrt(-4-0j) gives 2j). > Matlab > > also seems deficient in a number of areas. (Hmmm: maybe no one cares about > these working correctly??) > > > > Sorry about the delay in sending this, David. > > > > > > > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From dj112358 at outlook.com Mon Oct 25 13:08:09 2021 From: dj112358 at outlook.com (David James) Date: Mon, 25 Oct 2021 13:08:09 +0000 Subject: [Haskell-cafe] Numerics (was: Re: Trouble with asinh) In-Reply-To: References: Message-ID: Hi – thanks for your suggestion, though it’s a bit of a challenge! Do you know of an example where the existing haddocks have something similar? The branch cuts and behaviour of negative zeros are just part of the spec for what the functions do. Hence I would expect that anyone who reads the Data.Complex page should want to know about them. (Else it’s a bit like saying “I want to use sqrt but have no interest in knowing that it will only return a positive value”). Here’s my best attempt at pithy so far: Data.Complex Complex numbers that comply with the LIA standards with regard to signed zeros and branch cuts. Branch Cuts & Principle Values The “inverse” complex functions (such as sqrt, log, asin, which are mathematically multivalued) return only a single principal value within a defined range. In general, inverse(fn z) == z only when z is within the defined range. The inverse functions are continuous throughout the complex plane except for discontinuities at certain lines on the axes called “branch cuts”. The ranges and branch cuts comply with the LIA standards and are detailed below. In particular, two (==) points on a branch cut will map to different points on the range boundary if they have zeros of different signs. In some cases this allows apparently identical expressions to be computationally equivalent, for example sqrt(z/(z-1)) * sqrt(1/(z-1)) and sqrt z / (z-1), although detailed analysis is required to determine the behaviour and equivalence of expressions in general. Note that currently in Haskell: f1 z = sqrt(z/(z-1)) * sqrt(1/(z-1)) f1 ((-4) :+ 0) = 0.0 :+ 0.4 f2 z = sqrt z / (z-1) f2 ((-4) :+ 0) = 0.0 :+ (-0.4) Negative zeros (which GHC supports) provide a mechanism to address this, but only if sqrt makes correct use of it for points on the branch (which it currently does not – hence my proposed fixes, which also address other issues such as overflow, etc). [If you’re also asking about -0.0 in non-complex functions, here’s an example: f x = atan(1/x) Mathematically, f x is undefined at x=0. But, in Haskell, we get f 0 = 1.57.. and f(-0) = -1.57. This mirrors the maths f(x) -> pi/2 as x -> 0 from above, and f(x) -> -pi/2 as x -> 0 from below. (Whether this is what’s required is for the programmer/analyst to determine, depending on the problem being solved).] Sorry, a not very pithy response 😊 Regards, David. From: Bryan Richter Sent: 23 October 2021 07:06 To: David James Cc: Haskell Cafe Subject: Re: [Haskell-cafe] Numerics (was: Re: Trouble with asinh) Hi David, I have one suggestion for the haddocks. I made a solid effort to wade into the explanation of branch cuts and negative zeros, but I never managed to figure out why I should care. ;) In other words: tl;dr. Would it be possible to write a pithy few words right at the beginning as an introduction that motivates the topic? If, as you say, few other languages take the subject into account, it's very likely that few programmers take it into account either. In general, as a math-conscious member of the community, I'm happy to see this kind of work being accomplished, so thanks! -Bryan On Fri, 22 Oct 2021, 17.48 David James, > wrote: Hi all – I now have fixes for all the issues I’m aware of. However, it’s quite possible I’ve made a mistake somewhere (either in the new code or the testing), so if anyone would like to help review either please let me know. Group 1 issues (real numbers in Windows, where the defects are in mingw-w64: I’ve raised issue #20424 for this. The fixes (commits 66ba5f32 and 021dffb8a) have been made in mingw-w64 and are getting integrated into Haskell soon. Group 2 issues (complex numbers, where the defects are in Complex.hs). I’ve raised issue #20425 for this and have the code fixes here. The new code changes many of the functions (I’ve given examples in the issue) and adds a few. I’ve also put the Haddock output here. (It now defines and gives an explanation of the branch cuts). I’ve also put some diagrams here illustrating some of the problems. I’ve done about as much testing as I can think of, using the code here. Ideally I’d bulk-test against a reliable independent source, but can’t find one. AFAICT WolframAlpha, Excel, gnumeric, CLISP don’t support negative zeros. Python seems to, but cmath has incorrect branch cuts (cmath.sqrt(-4-0j) gives 2j). Matlab also seems deficient in a number of areas. (Hmmm: maybe no one cares about these working correctly??) Sorry about the delay in sending this, David. _______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post. -------------- next part -------------- An HTML attachment was scrubbed... URL: From lists at richarde.dev Tue Oct 26 13:53:57 2021 From: lists at richarde.dev (Richard Eisenberg) Date: Tue, 26 Oct 2021 13:53:57 +0000 Subject: [Haskell-cafe] Type inference for lambda function In-Reply-To: References: Message-ID: <010f017cbce10b46-4c27de87-6b7a-4122-9de3-ac98f4e2dd0e-000000@us-east-2.amazonses.com> > On Oct 21, 2021, at 2:48 PM, David Feuer wrote: > > This is the dreaded monomorphism restriction, which is turned on by default in modules but turned off by default in GHCi. Because your function is not "syntactically" a function (i.e., there are no arguments to the left of the = sign), and has no type signature, the type checker insists on it having a monomorphic type. Unless there's a use of it in the module forcing it to a particular type, the defaulting rules come into play, and a variable with a `Num` constraint defaults, by default, to `Integer`. Indeed -- but I will offer a tiny nuance: the type checker only insists that the type has no constraints, not that it is fully monomorphic. That is, writing `myId = id` will produce a polymorphic myId because there are no constraints on id, while `myPlus = (+)` will be monomorphic because of the constraint on (+). Richard -------------- next part -------------- An HTML attachment was scrubbed... URL: From gaitadennis at gmail.com Tue Oct 26 16:13:36 2021 From: gaitadennis at gmail.com (Dennis Gaita) Date: Tue, 26 Oct 2021 19:13:36 +0300 Subject: [Haskell-cafe] simple word processor Message-ID: -1 I am new to haskell and I need to create a simple word processor. It needs to read text from the cmd and implement functions that would edit functions found in the text so some other text.All functions in the text are odered. Each function i.e section,table,figures and ref must be located and numbered independently based on the order of occurence. Since tables and figures are within the sections function(just like a book), when a new section is encountered you will reset the value of tables and figures. So i did a loop where the tables and figures are inside the section loop when searching for the functions. The functions all start with this '' character (escape character) and must be replaced with text using this method: \Section{title}{id}: -> "Section n: title". Where n is the section number. \table{title}{id} : -> "Table n.m : title". Where n is the number of the last section encountered and m is the table number. And so on. I need help because my code isn't running.This is the code: import Text.Format import Data.Text.Internal.Search import Data.Text s = count . "section" -- count number of occurences of a certain word t = count . "table" f = count . "Figure" r = count . "ref" forLoop :: Int - Int - Int - Int forLoop s value = if i < s then forLoop (i + 1) format "Section{title}{id}" [show i, show {title}] then replace "Section{i}{title}" "Section {i}:{title}" else value forLoop t value = if j < t then forLoop (j + 1) format "table{title}{id}" [show i.j, show {title}] --change the text then replace "table{i}.{j}{title}" "Table {i}.{j} : {title}" else value forLoop f value = if k < f then forLoop (k + 1) format "figure{title}{id}" [show i.k, show {title}] --change the text then replace "Figure{title}{id}" "Figure {i}.{k} : {title}" else value if "ref{id}" == "table{title}" then forLoop r value = if l < r then forLoop (l + 1) format "ref{id}" [show {title}] --change the text then replace "ref{id}" "see {title} {i}.{j}" else value else Nothing if "ref{id}" == "Figure{title}" then forLoop r value = if m < r then forLoop (m + 1) format "ref{id}" [show {title}] --change the text then replace "ref{id}" "see {title} {i}.{m}" else value else Nothing if "ref{id}" == "Section{title}" then forLoop r value = if n < r then forLoop(n+1) format "ref{id}" [show{title}] then replace "ref{id}" "see {title} {i}" else value else nothing -------------- next part -------------- An HTML attachment was scrubbed... URL: From frederic-emmanuel.picca at synchrotron-soleil.fr Wed Oct 27 09:18:42 2021 From: frederic-emmanuel.picca at synchrotron-soleil.fr (PICCA Frederic-Emmanuel) Date: Wed, 27 Oct 2021 09:18:42 +0000 Subject: [Haskell-cafe] type inference and FFI Message-ID: Hello, I have a bunch of C method that I need to call like this c'foo_unit16_t :: Ptr Word16 -> IO r c'foo_uint32_t :: Ptr Word32 -> IO r ... These methodes are called from a method like this process :: NativeType t => Dataframe t => IO r process df = do ... case typeof t of WORD16 -> c'foo_unit16_t ... WORD32 -> c'foo_uint32_t ... Since there is type erasure, I would like to know what is the best way to write this process method. thanks for you help Frederic From sylvain at haskus.fr Wed Oct 27 10:00:38 2021 From: sylvain at haskus.fr (Sylvain Henry) Date: Wed, 27 Oct 2021 12:00:38 +0200 Subject: [Haskell-cafe] type inference and FFI In-Reply-To: References: Message-ID: Hi, With a type-class maybe? class Foo a where   foo :: Ptr a -> IO r -- not sure what is your `r` instance Foo Word16 where foo = c'foo_uint16_t instance Foo Word32 where foo = c'foo_uint32_t Sylvain On 27/10/2021 11:18, PICCA Frederic-Emmanuel wrote: > Hello, I have a bunch of C method that I need to call like this > > c'foo_unit16_t :: Ptr Word16 -> IO r > c'foo_uint32_t :: Ptr Word32 -> IO r > ... > > These methodes are called from a method like this > > > process :: NativeType t => Dataframe t => IO r > process df = do > ... > > case typeof t of > WORD16 -> c'foo_unit16_t ... > WORD32 -> c'foo_uint32_t ... > > Since there is type erasure, I would like to know what is the best way to write this process method. > > thanks for you help > > Frederic > _______________________________________________ > Haskell-Cafe mailing list > To (un)subscribe, modify options or view archives go to: > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe > Only members subscribed via the mailman list are allowed to post. From allbery.b at gmail.com Wed Oct 27 16:38:09 2021 From: allbery.b at gmail.com (Brandon Allbery) Date: Wed, 27 Oct 2021 12:38:09 -0400 Subject: [Haskell-cafe] xmonad 0.17.0, xmonad-contrib 0.17.0 released! Message-ID: ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ XMONAD AND XMONAD-CONTRIB 0.17.0 ARE AVAILABLE ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ New versions of xmonad and xmonad-contrib have been released. Check out our [download page] for instructions on where to get them. It's been a little over 3 years since xmonad 0.15, and a little over 2 years since xmonad-contrib 0.16. A lot has happened. This post is an overview of the most important changes. To celebrate this milestone, we would like to announce a contest for a new xmonad logo (see section 3). Last but not least, in section 4 we're looking to raise funds to keep the XMonad project and community alive and relevant in the next decade. With the [final X.Org Server 21.1 release] being announced today, there are some obvious challenges ahead of us. [download page]: [final X.Org Server 21.1 release]: 1 xmonad 0.17.0 ═══════════════ This release includes 156 non-merge commits by 22 contributors! For a full summary of all the changes, see [xmonad's CHANGES.md] file. [xmonad's CHANGES.md]: 1.1 Major Breaking Changes ────────────────────────── • `util/GenerateManpage.hs' is no longer distributed in the tarball. 1.2 Selected Features and Improvements ────────────────────────────────────── • Migrated `X.L.LayoutCombinators.(|||)' into `XMonad.Layout', providing the ability to directly jump to a layout with the `JumpToLayout' message. • Improved handling of XDG directories. 1. If all three of xmonad's environment variables (`XMONAD_DATA_DIR', `XMONAD_CONFIG_DIR', and `XMONAD_CACHE_DIR') are set, use them. 2. If there is a build script called `build' (see [here] for usage examples) or configuration `xmonad.hs' in `~/.xmonad', set all three directories to `~/.xmonad'. 3. Otherwise, use the `xmonad' directory in `XDG_DATA_HOME', `XDG_CONFIG_HOME', and `XDG_CACHE_HOME' (or their respective fallbacks). These directories are created if necessary. In the cases of 1. and 3., the build script or executable is expected to be in the config dir. Additionally, the xmonad config binary and intermediate object files were moved to the cache directory (only relevant if using XDG or `XMONAD_CACHE_DIR'). • Recompilation now detects `stack.yaml' (can be a symlink) alongside `xmonad.hs' and switches to using `stack ghc'. Additionally, deprecation warnings during recompilation are no longer suppressed. These can still be suppressed manually using an `OPTIONS_GHC' pragma with `-Wno-deprecations'. [here]: 2 xmonad-contrib 0.17.0 ═══════════════════════ This release includes 582 non-merge commits by 57 contributors! For a full summary of all the changes, see [xmonad-contrib's CHANGES.md] file. [xmonad-contrib's CHANGES.md]: 2.1 Major Breaking Changes ────────────────────────── • All modules that export bitmap fonts as their default • If xmonad is compiled with XFT support (the default), use an XFT font instead. The previous default expected an X11 misc font (PCF), which is not supported in pango 1.44 anymore and thus some distributions have stopped shipping these. • All modules still exporting a `defaultFoo' constructor • All of these were now removed. You can use the re-exported `def' from `Data.Default' instead. • `XMonad.Hooks.StatusBar', `XMonad.Hooks.StatusBar.PP' (previously `XMonad.Hooks.DynamicLog') and `XMonad.Util.Run' • `spawnPipe' no longer uses binary mode handles and defaults to the current locale encoding instead, `xmonadPropLog' and `xmonadPropLog'' now encode their input string in UTF-8, and `dynamicLogString' no longer encodes its output in UTF-8. When these functions are used together, everything should continue to work as it always has, but in isolation behaviour might change. To get the old `spawnPipe' behaviour, `spawnPipeWithNoEncoding' can now be used, and `spawnPipeWithUtf8Encoding' was added as well to force UTF-8 regardless of locale. • `XMonad.Hooks.DynamicLog' will be deprecated soon in favor of `XMonad.Hooks.StatusBar' which offers a nicer and easier to use interface for status bars. Laptop users who (dis)connect external monitors dynamically should definitely try this new interface: `XMonad.Hooks.DynamicBars' has been deprecated already. • `XMonad.Hooks.EwmhDesktops' • It is no longer recommended to use standalone hooks directly: Instead of `ewmhDesktopsStartup', `ewmhDesktopsLogHook(Custom)' and `ewmhDesktopsEventHook(Custom)', users should now use the `ewmh' combinator. The `Custom' variants have been replaced by a [more composable interface] which now also allows simply marking windows that request focus as urgent instead of immediately focusing them. Instead of `fullscreenEventHook', use `ewmhFullscreen', which now advertises fullscreen support to applications, fixing fullscreen in [mpv] and many others. • `XMonad.Hooks.Script' • `execScriptHook' now has an `X' constraint (was: `MonadIO'), due to changes in how the xmonad core handles XDG directories. • `XMonad.Actions.WorkspaceNames' • The type of `getWorkspaceNames' was changed to fit into the new `ppRename' field of `PP'. [more composable interface]: [mpv]: 2.2 Selected Features and Improvements ────────────────────────────────────── • `XMonad.Actions.EasyMotion' A new module that allows selection of visible screens using a key chord—inspired by [vim-easymotion]. See the animation in the vim-easymotion repo to get some idea of the functionality of this EasyMotion module. • `XMonad.Prompt.OrgMode' A prompt for interacting with [org-mode]. It can be used to quickly save TODOs, NOTEs, and the like with the additional capability to schedule/deadline a task, or use the primary selection as the contents of the note. • `XMonad.Hooks.StatusBar' A new module, providing a nicer, composable interface for status bars that replaces `XMonad.Hooks.DynamicLog' and `XMonad.Hooks.DynamicBars'. Supports property-based as well as pipe-based status bars, multiple status bars (Xinerama), and takes care of restarting the bars as needed. • `XMonad.Hooks.Rescreen' A new module, providing custom hooks for screen (xrandr) configuration changes. These are used internally by `XMonad.Hooks.StatusBar' to restart status bars/systrays after xrandr, and can also be used to invoke xrandr or autorandr when an output is (dis)connected. • `XMonad.Util.Hacks' A collection of hacks and fixes that should be easily accessible to users, like a fix for the fullscreen behaviour of chromium based applications when using windowed fullscreen, or a fix to make certain Java applications play more nicely with xmonad. • `XMonad.Hooks.WindowSwallowing' A new module to implement window swallowing; optionally via sublayouting. Hide parent windows like terminals when opening other programs (like image viewers) from within them, restoring them once the child application closes. • `XMonad.Util.ClickableWorkspaces' A new module providing `clickablePP', which when applied to the `PP' pretty-printer used by `XMonad.Hooks.StatusBar.PP', will make the workspace tags clickable in XMobar (for switching focus). Note that `XMonad.Layout.IndependentScreens' and `XMonad.Actions.WorkspaceNames' now also use the same composable `ppRename' interface as `XMonad.Util.ClickableWorkspaces' so it's much easier to use them with one another. • `XMonad.Util.Loggers' • Added `logTitles' to log all window titles (focused and unfocused ones) on the focused workspace, as well as `logTitlesOnScreen' as a screen-specific variant thereof. • `XMonad.Actions.TopicSpace' • Added `TopicItem', as well as the helper functions `topicNames', `tiActions', `tiDirs', `noAction', and `inHome' for a drastically simpler specification of topics. • `XMonad.Hooks.ServerMode' • To make it easier to use, the `xmonadctl' client is now included in `scripts/'. [vim-easymotion]: [org-mode]: 3 Logo Contest ══════════════ We'd also like to announce a contest to create a new xmonad logo to replace the current one. If you want to participate, please submit at most /three/ logos (in SVG format) to [this GitHub Discussion] by the 31st of January. Please do not vote for a logo yet—voting will start after the above deadline. Your logo will need to be licensed under a suitable freely distributable license; for example, the CC BY-SA 4.0. The prize for the winner is `$100'! For voting, we will use an [instant-runoff] type system. In short: • Users rank a minimum of three submissions according to their preferences in decreasing order. • If a logo wins a majority of first-preference votes (> 50%) it is chosen. • If not, we eliminate the logo with the least amount of first preference votes, exposing the second preference of those who voted for it. • Rinse and repeat until we have a majority. • If at the end of all that we still don't have a majority, we will act as a tiebreaker and internally vote for a winner from the remaining logos. We will retain veto power in case of inappropriate logos. Team members whose submitted entries are amongst the remaining choices will not partake in the potential tiebreaking vote. [this GitHub Discussion]: https://github.com/xmonad/xmonad/discussions/343 [instant-runoff]: 4 Looking for Funding ═════════════════════ TL;DR: We would love your support to keep xmonad alive! You can support us via [GitHub Sponsors] and the [Open Collective] is our fiscal host such that our funds are fully transparent. [GitHub Sponsors]: [Open Collective]: XMonad has been around since 2007 and has a great track record in stability. There's an active, vibrant community of users and developers who help each other and contribute fixes and extensions. Keeping this community organized, reviewing and merging contributions and responding to bug reports is almost a full-time job, however, not to mention doing actual development. We've been struggling to find volunteers to do all this work, especially the less exciting bits like documentation. Despite that struggle, we managed to repay a portion of our technological and organizational debt over the last year, and to pick up the [pace of development]. We're worried about the sustainability of that pace, however. As with the previous generations of maintainers, our studies and sabbaticals won't last forever. Your help is needed to keep the project alive and well! We'd like to raise enough funds to enable at least one core developer to work on XMonad full-time (or several part-time). To learn more about our plans for the future, see our [GitHub Sponsors] profile. Thanks to [one unexpected appearance on the Hacker News front page], we already gathered a couple dozen sponsors who donate in total over $300 a month. We're incredibly grateful for this support! Our fiscal host is the [Open Source Collective], so our budget is fully transparent on [our Collective's page]. If you also want to aid our efforts going forward, please consider becoming a supporter as well. We accept both monthly and one-time donations through [GitHub Sponsors] and [Open Collective]. Thank you! [pace of development]: https://xmonad.org/images/xmonad-0-17/commits.svg [GitHub Sponsors]: [one unexpected appearance on the Hacker News front page]: [Open Source Collective]: [our Collective's page]: [Open Collective]: -- brandon s allbery kf8nh allbery.b at gmail.com From olf at aatal-apotheke.de Wed Oct 27 19:09:34 2021 From: olf at aatal-apotheke.de (Olaf Klinke) Date: Wed, 27 Oct 2021 21:09:34 +0200 Subject: [Haskell-cafe] simple word processor Message-ID: <60c62b88d120254bd53527b706e8d858e9659aee.camel@aatal-apotheke.de> > I am new to haskell and I need to create a simple word processor. It needs > to read text from the cmd and implement functions that would edit functions > found in the text so some other text.All functions in the text are odered. > Each function i.e section,table,figures and ref must be located and > numbered independently based on the order of occurence. Since tables and > figures are within the sections function(just like a book), when a new > section is encountered you will reset the value of tables and figures. So i > did a loop where the tables and figures are inside the section loop when > searching for the functions. The functions all start with this '' character > (escape character) and must be replaced with text using this method: > \Section{title}{id}: -> "Section n: title". Where n is the section number. > \table{title}{id} : -> "Table n.m : title". Where n is the number of the > last section encountered and m is the table number. And so on. Let me try to break your problem into sub-problems. 1. You have text where some patterns have meaning to your particular application (e.g. "\Section{title}{id}"). 2. When knowing this structure, you want to transform it from front to back while updating some counters. 3. Once that transformation is done, you want to write the structure back into a plain text. How to approach: 1. is addressed with parsers. There are plenty to choose from, e.g. parsec, attoparsec, megaparsec to name just tree applicative-style libraries. A parser looks for patterns in plain text and transforms it into a more stuctured type. The structured type may be somethig like data Block a = SomeText Text | Section Text a | Table Text s | etc. The parsing function will have a type similar to Text -> Either ParseError [Block ()] where () stands for a numbering that is not yet known. 2. May be modeled as a stateful traversal. First define a state with all the counters, say data Counters = Counters { theSection :: Int, theTable :: Int} Next define a traversal function Block () -> State Counters (Block Text) where the unknown numbering () is replaced with the appropriate Text- representation of theSection or (theSection,theTable) etc. Finally, traverse your parsed list of Blocks with this traversal. 3. essentially requires a Show instance for your (Block Text) type together with concatenation. Steps 1-3 will be combined like follows. fmap ((=<<) show . flip evalState start . traverse number) . parse where parser :: Text -> Either ParseError [Block ()] start :: Counters number :: Block () -> State Counters (Block Text) "traversal" -> hoogle for Data.Traversable "stateful" -> hoogle for Control.Monad.State Olaf From lemming at henning-thielemann.de Fri Oct 29 07:14:44 2021 From: lemming at henning-thielemann.de (Henning Thielemann) Date: Fri, 29 Oct 2021 09:14:44 +0200 (CEST) Subject: [Haskell-cafe] German live interview about experiences with functional programming, today 12:00 Message-ID: https://www.heise.de/news/software-architektur-tv-Funktionale-Programmierung-in-der-Praxis-6228851.html From ben at well-typed.com Fri Oct 29 15:44:42 2021 From: ben at well-typed.com (Ben Gamari) Date: Fri, 29 Oct 2021 11:44:42 -0400 Subject: [Haskell-cafe] [ANNOUNCE] GHC 9.2.1 now available Message-ID: <87lf2bu98a.fsf@smart-cactus.org> Hi all, The GHC developers are very happy to at long last announce the availability of GHC 9.2.1. Binary distributions, source distributions, and documentation are available at https://downloads.haskell.org/ghc/9.2.1 GHC 9.2 brings a number of exciting features including: * A native code generation backend for AArch64, significantly speeding compilation time on ARM platforms like the Apple M1. * Many changes in the area of records, including the new `RecordDotSyntax` and `NoFieldSelectors` language extensions, as well as Support for `DuplicateRecordFields` with `PatternSynonyms`. * Introduction of the new `GHC2021` language extension set, giving users convenient access to a larger set of language extensions which have been long considered stable. * Merging of `ghc-exactprint` into the GHC tree, providing infrastructure for source-to-source program rewriting out-of-the-box. * Introduction of a `BoxedRep` `RuntimeRep`, allowing for polymorphism over levity of boxed objects (#17526) * Implementation of the `UnliftedDataTypes` extension, allowing users to define types which do not admit lazy evaluation ([proposal]) * The new [`-hi` profiling] mechanism which provides significantly improved insight into thunk leaks. * Support for the `ghc-debug` out-of-process heap inspection library [ghc-debug] * Significant improvements in the bytecode interpreter, allowing more programs to be efficently run in GHCi and Template Haskell splices. * Support for profiling of pinned objects with the cost-centre profiler (#7275) * Faster compilation and a smaller memory footprint * Introduction of Haddock documentation support in TemplateHaskell (#5467) Finally, thank you to Microsoft Research, GitHub, IOHK, the Zw3rk stake pool, Tweag I/O, Serokell, Equinix, SimSpace, and other anonymous contributors whose on-going financial and in-kind support has facilitated GHC maintenance and release management over the years. Moreover, this release would not have been possible without the hundreds of open-source contributors whose work comprise this release. As always, do open a [ticket] if you see anything amiss. Happy testing, - Ben [apple-m1]: https://www.haskell.org/ghc/blog/20210309-apple-m1-story.html [proposal]: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0265-unlifted-datatypes.rst [-hi profiling]: https://well-typed.com/blog/2021/01/first-look-at-hi-profiling-mode/ [ghc-debug]: http://ghc.gitlab.haskell.org/ghc-debug/ [ticket]: https://gitlab.haskell.org/ghc/ghc/-/issues/new -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 905 bytes Desc: not available URL: From jcb at inf.ed.ac.uk Sat Oct 30 11:06:35 2021 From: jcb at inf.ed.ac.uk (Julian Bradfield) Date: Sat, 30 Oct 2021 12:06:35 +0100 Subject: [Haskell-cafe] ghci's choice of names for type variables In-Reply-To: <24957.7178.240402.919556@high.stevens-bradfield.com> References: <24957.7178.240402.919556@high.stevens-bradfield.com> Message-ID: <24957.10043.722085.174446@high.stevens-bradfield.com> I have tried to answer this by google and the list archives, but without success, though it wouldn't surprise me if there is a post buried somewhere. This is GHCI 8.10.7. When ghci infers types, it sometimes produces types with "a", with "t", and with "p" (and maybe others), as in the following set of examples: Prelude> h (x : xs) = x Prelude> :t h h :: [a] -> a Prelude> foo f x = not(f x) Prelude> :t foo foo :: (t -> Bool) -> t -> Bool Prelude> bar f x = (f x) + 1 Prelude> :t bar bar :: Num a => (t -> a) -> t -> a Prelude> barb f x g y = (f x)+(g y) Prelude> :t barb barb :: Num a => (t1 -> a) -> t1 -> (t2 -> a) -> t2 -> a Prelude> gar f x = f x Prelude> :t gar gar :: (t1 -> t2) -> t1 -> t2 Prelude> fooa x = x Prelude> :t fooa fooa :: p -> p What is its rationale? I have attempted to find it in the typechecker code, and I see things that suggest "t" is something to do with tau types (monotypes?), and "p" has something to do with levels, but going from basic Haskell and a modest theoretical acquaintance with System F to being able to read the GHCi type-checker is several steps too far! Can somebody give me a brief explanation of what's going on? In particular, is there actual information about the types in the choice of letters, or is it just incidental information about the way type inference proceeded? Thanks, Julian. -- The University of Edinburgh is a charitable body, registered in Scotland, with registration number SC005336. From mail at joachim-breitner.de Sat Oct 30 13:50:56 2021 From: mail at joachim-breitner.de (Joachim Breitner) Date: Sat, 30 Oct 2021 15:50:56 +0200 Subject: [Haskell-cafe] ghci's choice of names for type variables In-Reply-To: <24957.10043.722085.174446@high.stevens-bradfield.com> References: <24957.7178.240402.919556@high.stevens-bradfield.com> <24957.10043.722085.174446@high.stevens-bradfield.com> Message-ID: Hi, Am Samstag, dem 30.10.2021 um 12:06 +0100 schrieb Julian Bradfield: > I have tried to answer this by google and the list archives, but > without success, though it wouldn't surprise me if there is a post > buried somewhere. I don’t know of such a post, so it’s good that you are starting the discussion! I think you looked at the right piece of code: The type inference deals with metavariables which it instantiates to concrete types as it knows more, and this is the source or these names: metaInfoToTyVarName :: MetaInfo -> FastString metaInfoToTyVarName meta_info = case meta_info of TauTv -> fsLit "t" TyVarTv -> fsLit "a" RuntimeUnkTv -> fsLit "r" CycleBreakerTv -> fsLit "b" And here is the explanation for these: data MetaInfo = TauTv -- This MetaTv is an ordinary unification variable -- A TauTv is always filled in with a tau-type, which -- never contains any ForAlls. | TyVarTv -- A variant of TauTv, except that it should not be -- unified with a type, only with a type variable -- See Note [TyVarTv] in GHC.Tc.Utils.TcMType | RuntimeUnkTv -- A unification variable used in the GHCi debugger. -- It /is/ allowed to unify with a polytype, unlike TauTv | CycleBreakerTv -- Used to fix occurs-check problems in Givens -- See Note [Type variable cycles] in -- GHC.Tc.Solver.Canonical But the type checker also tries to preserves names, and in your example Prelude> h (x : xs) = x Prelude> :t h h :: [a] -> a I _think_ this is an `a` because the list type is declared roughtly like follows data [a] = [] | a:[a] If we’d define the data type with a different type variable, ghc will happily use that: Prelude> data Foo hello = Foo hello Prelude> h (Foo x) = x Prelude> :t h h :: Foo hello -> hello So I think all examples where you use existing definitions (:, +) the type variables likely comes from there. And the others produce either t’s or p’s. For the "p", the relevant code is newMetaTyVarTyAtLevel :: TcLevel -> TcKind -> TcM TcType newMetaTyVarTyAtLevel tc_lvl kind = do { details <- newTauTvDetailsAtLevel tc_lvl ; name <- newMetaTyVarName (fsLit "p") ; return (mkTyVarTy (mkTcTyVar name kind details)) } but my knowledge of the type checker isn’t good enough to tell you in which situations this is used, and when to expect "p" and when to expect "t". And maybe GHC shouldn’t use "p" there, and simply consistently use "t", so that users aren’t even tempted to think about this… Ok, this was less comprehensive than I hoped for, but maybe others can pick up this thread Cheers, Joachim -- Joachim Breitner mail at joachim-breitner.de http://www.joachim-breitner.de/ From johannes.waldmann at htwk-leipzig.de Sat Oct 30 13:47:11 2021 From: johannes.waldmann at htwk-leipzig.de (Johannes Waldmann) Date: Sat, 30 Oct 2021 15:47:11 +0200 Subject: [Haskell-cafe] ghci's choice of names for type variables Message-ID: Just from observing the behaviour (not the source) - it seems that ghci tries to use the variables from the declaration of the/a function, type, or class that is being used. Prelude> data T c = T c Prelude> h x y = (T x, T y) Prelude> :t h h :: c1 -> c2 -> (T c1, T c2) Prelude> f :: foo -> foo ; f x = x Prelude> g = f Prelude> :t g g :: foo -> foo In the Haskell Standard, type variables are a, b, ... mostly (always?), hence you get `a` for anything with lists and Num. If there's no type to refer to, then your examples show that it's using t or p, but I don't know how. Prelude> i x = x Prelude> :t i i :: p -> p Prelude> k x y = x Prelude> :t k k :: p1 -> p2 -> p1 Prelude> s x y z = x z (y z) Prelude> :t s s :: (t1 -> t2 -> t3) -> (t1 -> t2) -> t1 -> t3 interesting! - J.W. From johannes.waldmann at htwk-leipzig.de Sat Oct 30 14:00:09 2021 From: johannes.waldmann at htwk-leipzig.de (Johannes Waldmann) Date: Sat, 30 Oct 2021 16:00:09 +0200 Subject: [Haskell-cafe] ghci's choice of names for type variables In-Reply-To: References: Message-ID: <2e5eed91-ec49-9444-11df-ad1a17d04437@htwk-leipzig.de> it's using `p` for "pristine" (unused) variables, and `t` for everything that went through the unifier because of usage in some function call? Prelude> f a b c d e = b d Prelude> :t f f :: p1 -> (t1 -> t2) -> p2 -> t1 -> p3 -> t2 - J.W. From jcb at inf.ed.ac.uk Sat Oct 30 14:50:16 2021 From: jcb at inf.ed.ac.uk (Julian Bradfield) Date: Sat, 30 Oct 2021 15:50:16 +0100 (BST) Subject: [Haskell-cafe] ghci's choice of names for type variables References: <24957.7178.240402.919556@high.stevens-bradfield.com> <24957.10043.722085.174446@high.stevens-bradfield.com> Message-ID: <20211030145016.ADF837E4EE@home.stevens-bradfield.com> On 2021-10-30, Joachim Breitner wrote: > But the type checker also tries to preserves names, and in your example > > Prelude> h (x : xs) = x > Prelude> :t h > h :: [a] -> a > > I _think_ this is an `a` because the list type is declared roughtly > like follows > > data [a] = [] | a:[a] Yes, Johannes also suggested that (though I missed it in my first reading of his message). > TyVarTv -> fsLit "a" > | TyVarTv -- A variant of TauTv, except that it should not be > -- unified with a type, only with a type variable > -- See Note [TyVarTv] in GHC.Tc.Utils.TcMType The TyVarTv's which are named "a" appear, it says, only in kind signatures and partial type signatures, neither of which I understand, so presumably don't use. > And the others produce either t’s or p’s. For the "p", the relevant > code is > > newMetaTyVarTyAtLevel :: TcLevel -> TcKind -> TcM TcType > newMetaTyVarTyAtLevel tc_lvl kind > = do { details <- newTauTvDetailsAtLevel tc_lvl > ; name <- newMetaTyVarName (fsLit "p") > ; return (mkTyVarTy (mkTcTyVar name kind details)) } > > but my knowledge of the type checker isn’t good enough to tell you in > which situations this is used, and when to expect "p" and when to > expect "t". And maybe GHC shouldn’t use "p" there, and simply > consistently use "t", so that users aren’t even tempted to think about > this… Likewise, I can't work out what's going on here. -- The University of Edinburgh is a charitable body, registered in Scotland, with registration number SC005336. From andrew.lelechenko at gmail.com Sat Oct 30 20:13:18 2021 From: andrew.lelechenko at gmail.com (Andrew Lelechenko) Date: Sat, 30 Oct 2021 21:13:18 +0100 Subject: [Haskell-cafe] New CLC proposal process Message-ID: <6690A80D-A825-4FB5-8A6A-21078B793556@gmail.com> I'm happy to announce that Core Libraries Committee has completed post-election reboot and now has a new home at https://github.com/haskell/core-libraries-committee and a new GitHub-based process: https://github.com/haskell/core-libraries-committee/blob/main/PROPOSALS.md . From now on proposals to change base should be raised as GitHub issues instead of emails to libraries at . Best regards, Andrew -------------- next part -------------- An HTML attachment was scrubbed... URL: From ben.franksen at online.de Sun Oct 31 18:16:17 2021 From: ben.franksen at online.de (Ben Franksen) Date: Sun, 31 Oct 2021 19:16:17 +0100 Subject: [Haskell-cafe] Type inference for lambda function In-Reply-To: <010f017cbce10b46-4c27de87-6b7a-4122-9de3-ac98f4e2dd0e-000000@us-east-2.amazonses.com> References: <010f017cbce10b46-4c27de87-6b7a-4122-9de3-ac98f4e2dd0e-000000@us-east-2.amazonses.com> Message-ID: The MonomorphismRestriction should be eliminated from the next Haskell standard. Am 26.10.21 um 15:53 schrieb Richard Eisenberg: >> On Oct 21, 2021, at 2:48 PM, David Feuer >> wrote: >> >> This is the dreaded monomorphism restriction, which is turned on by >> default in modules but turned off by default in GHCi. Because your >> function is not "syntactically" a function (i.e., there are no >> arguments to the left of the = sign), and has no type signature, >> the type checker insists on it having a monomorphic type. Unless >> there's a use of it in the module forcing it to a particular type, >> the defaulting rules come into play, and a variable with a `Num` >> constraint defaults, by default, to `Integer`. > > Indeed -- but I will offer a tiny nuance: the type checker only > insists that the type has no constraints, not that it is fully > monomorphic. That is, writing `myId = id` will produce a polymorphic > myId because there are no constraints on id, while `myPlus = (+)` > will be monomorphic because of the constraint on (+). -- I would rather have questions that cannot be answered, than answers that cannot be questioned. -- Richard Feynman