From harendra.kumar at gmail.com Wed Apr 1 08:20:12 2020 From: harendra.kumar at gmail.com (Harendra Kumar) Date: Wed, 1 Apr 2020 13:50:12 +0530 Subject: Fusing loops by specializing on functions with SpecConstr? In-Reply-To: <296140F4-DCAC-4ACD-80F8-6F99B37C7316@gmail.com> References: <2E809F34-633F-4089-BEED-F38929F8BFD0@gmail.com> <296140F4-DCAC-4ACD-80F8-6F99B37C7316@gmail.com> Message-ID: On Wed, 1 Apr 2020 at 02:49, Alexis King wrote: > > I’ve been trying to figure out if it would be possible to help the > optimizer out by annotating the program with special combinators like the > existing ones provided by GHC.Magic. However, I haven’t been able to come > up with anything yet that seems like it would actually work. > You may want to take a look at https://github.com/composewell/fusion-plugin which uses annotations to help GHC fuse, not specifically what you want but might possibly be relevant to your work. https://github.com/composewell/streamly relies heavily on case-of-case and SpecConstr for stream fusion. There are several cases that GHC is unable to fuse currently. We use a "Fuse" annotation to tell GHC that any function involving this type must be inlined so that fusion can occur reliably. With the help of fusion-plugin we have been able to fuse almost every known case in streamly till now. -harendra -------------- next part -------------- An HTML attachment was scrubbed... URL: From sgraf1337 at gmail.com Wed Apr 1 08:21:21 2020 From: sgraf1337 at gmail.com (Sebastian Graf) Date: Wed, 1 Apr 2020 10:21:21 +0200 Subject: Fusing loops by specializing on functions with SpecConstr? In-Reply-To: <208D122C-E0E7-4B28-969B-19A792E358C5@gmail.com> References: <2E809F34-633F-4089-BEED-F38929F8BFD0@gmail.com> <296140F4-DCAC-4ACD-80F8-6F99B37C7316@gmail.com> <208D122C-E0E7-4B28-969B-19A792E358C5@gmail.com> Message-ID: > > Looking at the optimized core, it’s true that the conversion of Maybe to > Either and back again gets eliminated, which is wonderful! But what’s less > wonderful is the value passed around through `s`: > > mapMaybeSF > = \ (@ a) (@ b) (f :: SF a b) -> > case f of { SF @ s f2 s2 -> > SF > (\ (a1 :: Maybe a) (ds2 :: ((), ((), (((), (((), (((), s), > ())), ((), ((), ())))), ((), ()))))) -> > That is indeed true. But note that as long as you manage to inline `mapMaybeSF`, the final `runSF` will only allocate once on the "edge" of each iteration, all intermediate allocations will have been fused away. But the allocation of these non-sense records seems unfortunate. Optimisation-wise, I see two problems here: 1. `mapMaybeSF` is already too huge to inline without INLINE. That is because its lambda isn't floated out to the top-level, which is because of the existential @s (that shouldn't be a problem), but also its mention of f2. The fact that f2 occurs free rather than as an argument makes the simplifier specialise `mapMaybeSF` for it, so if it were floated out (thereby necessarily lambda-lifted) to top-level, then we'd lose the ability to specialise without SpecConstr (which currently only applies to recursive functions anyway). 2. The lambda isn't let-bound (which is probably a consequence of the previous point), so it isn't strictness analysed and we have no W/W split. If we had, I imagine we would have a worker of type `s -> ...` here. W/W is unnecessary if we manage to inline the function anyway, but I'm pretty certain we won't inline for larger programs (like `mapMaybeSF` already), in which case every failure to inline leaves behind such a residue of records. So this already seems quite brittle. Maybe a very targeted optimisation that gets rid of the boring ((), _) wrappers could be worthwhile, given that a potential caller is never able to construct such a thing themselves. But that very much hinges on being able to prove that in fact every such ((), _) constructed in the function itself terminates. There are a few ways I can think of in which we as the programmer could have been smarter, though: - Simply by specialising `SF` for the `()` case: data SF a b where SFState :: !(a -> s -> Step s b) -> !s -> SF a b SFNoState :: !(a -> Step () b) -> SF a b And then implementing every action 2^n times, where n is the number of `SF` arguments. That undoubtly leads to even more code bloat. - An alternative that I'm a little uncertain would play out would be data SMaybe a = SNothing | SJust !a data SF a b where SF :: !(SMaybe (s :~: ()) -> !(a -> s -> Step s b) -> !s -> SF a b and try match on the proof everywhere needed to justify e.g. in `(.)` only storing e.g. s1 instead of (s1, s2). Basically do some type algebra in the implementation. - An even simpler thing would be to somehow use `Void#` (which should have been named `Unit#`), but I think that doesn't work due to runtime rep polymorphism restrictions. I think there is lots that can be done to tune this idea. Am Mi., 1. Apr. 2020 um 01:16 Uhr schrieb Alexis King : > > On Mar 31, 2020, at 17:05, Sebastian Graf wrote: > > > > Yeah, SPEC is quite unreliable, because IIRC at some point it's either > consumed or irrelevant. But none of the combinators you mentioned should > rely on SpecConstr! They are all non-recursive, so the Simplifier will take > care of "specialisation". And it works just fine, I just tried it > > Ah! You are right, I did not read carefully enough and misinterpreted. > That approach is clever, indeed. I had tried something similar with a CPS > encoding, but the piece I was missing was using the existential to tie the > final knot. > > I have tried it out on some of my experiments. It’s definitely a > significant improvement, but it isn’t perfect. Here’s a small example: > > mapMaybeSF :: SF a b -> SF (Maybe a) (Maybe b) > mapMaybeSF f = proc v -> case v of > Just x -> do > y <- f -< x > returnA -< Just y > Nothing -> returnA -< Nothing > > Looking at the optimized core, it’s true that the conversion of Maybe to > Either and back again gets eliminated, which is wonderful! But what’s less > wonderful is the value passed around through `s`: > > mapMaybeSF > = \ (@ a) (@ b) (f :: SF a b) -> > case f of { SF @ s f2 s2 -> > SF > (\ (a1 :: Maybe a) (ds2 :: ((), ((), (((), (((), (((), s), > ())), ((), ((), ())))), ((), ()))))) -> > > Yikes! GHC has no obvious way to clean this type up, so it will just grow > indefinitely, and we end up doing a dozen pattern-matches in the body > followed by another dozen allocations, just wrapping and unwrapping tuples. > > Getting rid of that seems probably a lot more tractable than fusing the > recursive loops, but I’m still not immediately certain how to do it. GHC > would have to somehow deduce that `s` is existentially-bound, so it can > rewrite something like > > SF (\a ((), x) -> ... Yield ((), y) b ...) ((), s) > > to > > SF (\a x -> ... Yield y b) s > > by parametricity. Is that an unreasonable ask? I don’t know! > > Another subtlety I considered involves recursive arrows, where I currently > depend on laziness in (|||). Here’s one example: > > mapSF :: SF a b -> SF [a] [b] > mapSF f = proc xs -> case xs of > x:xs -> do > y <- f -< x > ys <- mapSF f -< xs > returnA -< (y:ys) > [] -> returnA -< [] > > Currently, GHC will just compile this to `mapSF f = mapSF f` under your > implementation, since (|||) and (>>>) are both strict. However, I think > this is not totally intractable—we can easily introduce an explicit `lazy` > combinator to rein in strictness: > > lazy :: SF a b -> SF a b > lazy sf0 = SF g (Unit sf0) where > g a (Unit sf1) = case runSF sf1 a of > (b, sf2) -> Yield (Unit sf2) b > > And now we can write `lazy (mapSF f)` at the point of the recursive call > to avoid the infinite loop. This defeats some optimizations, of course, but > `mapSF` is fundamentally recursive, so there’s only so much we can really > expect. > > So perhaps my needs here are less ambitious, after all! Getting rid of all > those redundant tuples is my next question, but that’s rather unrelated > from what we’ve been talking about so far. > > Alexis -------------- next part -------------- An HTML attachment was scrubbed... URL: From lexi.lambda at gmail.com Wed Apr 1 08:36:00 2020 From: lexi.lambda at gmail.com (Alexis King) Date: Wed, 1 Apr 2020 03:36:00 -0500 Subject: Fusing loops by specializing on functions with SpecConstr? In-Reply-To: References: <2E809F34-633F-4089-BEED-F38929F8BFD0@gmail.com> <296140F4-DCAC-4ACD-80F8-6F99B37C7316@gmail.com> <208D122C-E0E7-4B28-969B-19A792E358C5@gmail.com> Message-ID: > On Apr 1, 2020, at 03:21, Sebastian Graf wrote: > > That is indeed true. But note that as long as you manage to inline `mapMaybeSF`, the final `runSF` will only allocate once on the "edge" of each iteration, all intermediate allocations will have been fused away. But the allocation of these non-sense records seems unfortunate. Yes, that is technically true, but note that even if we inline mapMaybeSF, those nonsense records don’t go away, they just bubble up to the “fringe” of the enclosing computation. And consider how tiny mapMaybeSF is: I shudder to think how enormous that “fringe” would be for a large program written in SF! (And of course, nothing prevents the runSF itself from appearing in a loop—quite probable, in fact, given its use in the hypothetical `lazy` combinator.) > So this already seems quite brittle. Maybe a very targeted optimisation that gets rid of the boring ((), _) wrappers could be worthwhile, given that a potential caller is never able to construct such a thing themselves. But that very much hinges on being able to prove that in fact every such ((), _) constructed in the function itself terminates. Yes, that is a good point. I concede that seems much less tractable than I had initially hoped. Still, as you suggest, it does seem plausible that a different encoding could avoid this problem. I will experiment with a few different things and get back to you if I find anything interesting (assuming you don’t beat me to it first!). From mail at joachim-breitner.de Wed Apr 1 18:37:16 2020 From: mail at joachim-breitner.de (Joachim Breitner) Date: Wed, 01 Apr 2020 20:37:16 +0200 Subject: Fusing loops by specializing on functions with SpecConstr? In-Reply-To: References: <2E809F34-633F-4089-BEED-F38929F8BFD0@gmail.com> <296140F4-DCAC-4ACD-80F8-6F99B37C7316@gmail.com> Message-ID: Hi, I think most of the docs about exitification are the notes in the Exitify module, and then there is the original ticket at https://gitlab.haskell.org/ghc/ghc/issues/14152 I don’t immediately see the connection to SpecConstr on function values, though, so I don't really know what’s tickling your neurons right now. Cheers, Joachim Am Dienstag, den 31.03.2020, 22:49 +0000 schrieb Simon Peyton Jones: > Joachim: this conversation is triggering some hind-brain neurons > related to exitification, or something like that. I recall that we > discovered we could get some surprising fusion of recursive functions > expressed as join points. Something like f . g . h > where h loops for a while and returns, and same for g and f. Then > the call to g landed up in the return branch of h, and same for f. > > But I can’t find anything in writing. The Exitify module doesn’t say much. I thought we had a wiki page but I can’t find it. Can you remember? > > Thanks > > Simon > > From: Alexis King > Sent: 31 March 2020 22:18 > To: Sebastian Graf ; Simon Peyton Jones > Cc: ghc-devs > Subject: Re: Fusing loops by specializing on functions with SpecConstr? > > Sebastian and Simon, > > Thank you both for your responses—they are all quite helpful! I agree with both of you that figuring out how to do this kind of specialization without any guidance from the programmer seems rather intractable. It’s too hard to divine where it would actually be beneficial, and even if you could, it seems likely that other optimizations would get in the way of it actually working out. > > I’ve been trying to figure out if it would be possible to help the optimizer out by annotating the program with special combinators like the existing ones provided by GHC.Magic. However, I haven’t been able to come up with anything yet that seems like it would actually work. > > > On Mar 31, 2020, at 06:12, Simon Peyton Jones wrote: > > > > Wow – tricky stuff! I would never have thought of trying to optimise that program, but it’s fascinating that you get lots and lots of them from FRP. > > > For context, the reason you get all these tiny loops is that arrowized FRP uses the Arrow and ArrowChoice interfaces to build its programs, and those interfaces use tiny combinator functions like these: > > first :: Arrow a => a b c -> a (b, d) (c, d) > (***) :: Arrow a => a b d -> a c e -> a (b, c) (d, e) > (|||) :: ArrowChoice a => a b d -> a c d -> a (Either b c) d > > This means you end up with programs built out of dozens or hundreds of uses of these tiny combinators. You get code that looks like > > first (left (arr f >>> g ||| right h) *** second i) > > and this is a textbook situation where you want to specialize and inline all the combinators! For arrows without this tricky recursion, doing that works as intended, and GHC’s simplifier will do what it’s supposed to, and you get fast code. > > But with FRP, each of these combinators is recursive. This means you often get really awful code that looks like this: > > arr (\case { Nothing -> Left (); Just x -> Right x }) >>> (f ||| g) > > This converts a Maybe to an Either, then branches on it. It’s analogous to writing something like this in direct-style code: > > let y = case x of { Nothing -> Left (); Just x -> Right x } > in case y of { Left () -> f; Right x -> g x } > > We really want the optimizer to eliminate the intermediate Either and just branch on it directly, and if GHC could fuse these tiny recursive loops, it could! But without that, all this pointless shuffling of values around remains in the optimized program. > > > > I wonder whether it’d be possible to adjust the FRP library to generate easier-to-optimise code. Probably not, but worth asking. > > > I think it’s entirely possible to somehow annotate these combinators to communicate this information to the optimizer, but I don’t know what the annotations ought to look like. (That’s the research part!) > > But I’m not very optimistic about getting the library to generate easier-to-optimize code with the tools available today. Sebastian’s example of SF2 and stream fusion sort of works, but in my experience, something like that doesn’t handle enough cases well enough to work on real arrow programs. > > > Unrolling one layer of a recursive function. That seems harder: how we know to *stop* unrolling as we successively simplify? One idea: do one layer of unrolling by hand, perhaps even in FRP source code: > > add1rec = SF (\a -> let !b = a+1 in (b,add1rec)) > > add1 = SF (\a -> let !b = a+1 in (b,add1rec)) > > > Yes, I was playing with the idea at one point of some kind of RULE that inserts GHC.Magic.inline on the specialized RHS. That way the programmer could ask for the unrolling explicitly, as otherwise it seems unreasonable to ask the compiler to figure it out. > > > On Mar 31, 2020, at 08:08, Sebastian Graf wrote: > > > > We can formulate SF as a classic Stream that needs an `a` to produce its next element of type `b` like this (SF2 below) > > > This is a neat trick, though I’ve had trouble getting it to work reliably in my experiments (even though I was using GHC.Types.SPEC). That said, I also feel like I don’t understand the subtleties of SpecConstr very well, so it could have been my fault. > > The more fundamental problem I’ve found with that approach is that it doesn’t do very well for arrow combinators like (***) and (|||), which come up very often in arrow programs but rarely in streaming. Fusing long chains of first/second/left/right is actually pretty easy with ordinary RULEs, but (***) and (|||) are much harder, since they have multiple continuations. > > It seems at first appealing to rewrite `f *** g` into `first f >>> second g`, which solves the immediate problem, but this is actually a lot less efficient after repeated rewritings. You end up rewriting `(f ||| g) *** h` into `first (left f) >>> first (right g) >>> second h`, turning two distinct branches into four, and larger programs have much worse exponential blowups. > > So that’s where I’ve gotten stuck! I’ve been toying with the idea of thinking about expression “shells”, so if you have something like > > first (a ||| b) >>> c *** second (d ||| e) >>> f > > then you have a “shell” of the shape > > first (● ||| ●) >>> ● *** second (● ||| ●) >>> ● > > which theoretically serves as a key for the specialization. You can then generate a specialization and a rule: > > $s a b c d e f = ... > {-# RULE forall a b c d e f. > first (a ||| b) >>> c *** second (d ||| e) >>> f = $s a b c d e f #-} > > The question then becomes: how do you specify what these shells are, and how do you specify how to transform the shell into a specialized function? I don’t know, but it’s something a Core plugin could theoretically do. Maybe it makes sense for this domain-specific optimization to be a Core pass that runs before the simplifier, like the typeclass specializer currently is, but I haven’t explored that yet. > > Alexis -- Joachim Breitner mail at joachim-breitner.de http://www.joachim-breitner.de/ From simonpj at microsoft.com Wed Apr 1 20:10:52 2020 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Wed, 1 Apr 2020 20:10:52 +0000 Subject: Fusing loops by specializing on functions with SpecConstr? In-Reply-To: References: <2E809F34-633F-4089-BEED-F38929F8BFD0@gmail.com> <296140F4-DCAC-4ACD-80F8-6F99B37C7316@gmail.com> Message-ID: Thanks. Perhaps I was thinking of Section 5 of the join-point paper https://www.microsoft.com/en-us/research/publication/compiling-without-continuations/ That's about compositions of tiny tail recursive loops. Alexis, just conceivably this might be relevant to your thinking on FRP ... but I'm waving my arms here so might be wide of the mark. Simon | -----Original Message----- | From: ghc-devs On Behalf Of Joachim | Breitner | Sent: 01 April 2020 19:37 | To: ghc-devs | Subject: Re: Fusing loops by specializing on functions with SpecConstr? | | Hi, | | I think most of the docs about exitification are the notes in the Exitify | module, and then there is the original ticket at | https://nam06.safelinks.protection.outlook.com/?url=https%3A%2F%2Fgitlab.h | askell.org%2Fghc%2Fghc%2Fissues%2F14152&data=02%7C01%7Csimonpj%40micro | soft.com%7C8e5db80efc0f407af9c308d7d66bcd58%7C72f988bf86f141af91ab2d7cd011 | db47%7C1%7C0%7C637213630817542428&sdata=TBb6lzmIJvtHOQLwpsyFLPi2BEF%2B | B66piMGTgcV%2Bkls%3D&reserved=0 | | I don’t immediately see the connection to SpecConstr on function values, | though, so I don't really know what’s tickling your neurons right now. | | Cheers, | Joachim | | | Am Dienstag, den 31.03.2020, 22:49 +0000 schrieb Simon Peyton Jones: | > Joachim: this conversation is triggering some hind-brain neurons | > related to exitification, or something like that. I recall that we | > discovered we could get some surprising fusion of recursive functions | > expressed as join points. Something like f . g . h | > where h loops for a while and returns, and same for g and f. Then the | > call to g landed up in the return branch of h, and same for f. | > | > But I can’t find anything in writing. The Exitify module doesn’t say | much. I thought we had a wiki page but I can’t find it. Can you remember? | > | > Thanks | > | > Simon | > | > From: Alexis King | > Sent: 31 March 2020 22:18 | > To: Sebastian Graf ; Simon Peyton Jones | > | > Cc: ghc-devs | > Subject: Re: Fusing loops by specializing on functions with SpecConstr? | > | > Sebastian and Simon, | > | > Thank you both for your responses—they are all quite helpful! I agree | with both of you that figuring out how to do this kind of specialization | without any guidance from the programmer seems rather intractable. It’s | too hard to divine where it would actually be beneficial, and even if you | could, it seems likely that other optimizations would get in the way of it | actually working out. | > | > I’ve been trying to figure out if it would be possible to help the | optimizer out by annotating the program with special combinators like the | existing ones provided by GHC.Magic. However, I haven’t been able to come | up with anything yet that seems like it would actually work. | > | > > On Mar 31, 2020, at 06:12, Simon Peyton Jones | wrote: | > > | > > Wow – tricky stuff! I would never have thought of trying to optimise | that program, but it’s fascinating that you get lots and lots of them from | FRP. | > | > | > For context, the reason you get all these tiny loops is that arrowized | FRP uses the Arrow and ArrowChoice interfaces to build its programs, and | those interfaces use tiny combinator functions like these: | > | > first :: Arrow a => a b c -> a (b, d) (c, d) | > (***) :: Arrow a => a b d -> a c e -> a (b, c) (d, e) | > (|||) :: ArrowChoice a => a b d -> a c d -> a (Either b c) d | > | > This means you end up with programs built out of dozens or hundreds of | > uses of these tiny combinators. You get code that looks like | > | > first (left (arr f >>> g ||| right h) *** second i) | > | > and this is a textbook situation where you want to specialize and inline | all the combinators! For arrows without this tricky recursion, doing that | works as intended, and GHC’s simplifier will do what it’s supposed to, and | you get fast code. | > | > But with FRP, each of these combinators is recursive. This means you | often get really awful code that looks like this: | > | > arr (\case { Nothing -> Left (); Just x -> Right x }) >>> (f ||| | > g) | > | > This converts a Maybe to an Either, then branches on it. It’s analogous | to writing something like this in direct-style code: | > | > let y = case x of { Nothing -> Left (); Just x -> Right x } | > in case y of { Left () -> f; Right x -> g x } | > | > We really want the optimizer to eliminate the intermediate Either and | just branch on it directly, and if GHC could fuse these tiny recursive | loops, it could! But without that, all this pointless shuffling of values | around remains in the optimized program. | > | > | > > I wonder whether it’d be possible to adjust the FRP library to | generate easier-to-optimise code. Probably not, but worth asking. | > | > | > I think it’s entirely possible to somehow annotate these combinators | > to communicate this information to the optimizer, but I don’t know | > what the annotations ought to look like. (That’s the research part!) | > | > But I’m not very optimistic about getting the library to generate | easier-to-optimize code with the tools available today. Sebastian’s | example of SF2 and stream fusion sort of works, but in my experience, | something like that doesn’t handle enough cases well enough to work on | real arrow programs. | > | > > Unrolling one layer of a recursive function. That seems harder: how | we know to *stop* unrolling as we successively simplify? One idea: do one | layer of unrolling by hand, perhaps even in FRP source code: | > > add1rec = SF (\a -> let !b = a+1 in (b,add1rec)) | > > add1 = SF (\a -> let !b = a+1 in (b,add1rec)) | > | > | > Yes, I was playing with the idea at one point of some kind of RULE that | inserts GHC.Magic.inline on the specialized RHS. That way the programmer | could ask for the unrolling explicitly, as otherwise it seems unreasonable | to ask the compiler to figure it out. | > | > > On Mar 31, 2020, at 08:08, Sebastian Graf wrote: | > > | > > We can formulate SF as a classic Stream that needs an `a` to produce | > > its next element of type `b` like this (SF2 below) | > | > | > This is a neat trick, though I’ve had trouble getting it to work | reliably in my experiments (even though I was using GHC.Types.SPEC). That | said, I also feel like I don’t understand the subtleties of SpecConstr | very well, so it could have been my fault. | > | > The more fundamental problem I’ve found with that approach is that it | doesn’t do very well for arrow combinators like (***) and (|||), which | come up very often in arrow programs but rarely in streaming. Fusing long | chains of first/second/left/right is actually pretty easy with ordinary | RULEs, but (***) and (|||) are much harder, since they have multiple | continuations. | > | > It seems at first appealing to rewrite `f *** g` into `first f >>> | second g`, which solves the immediate problem, but this is actually a lot | less efficient after repeated rewritings. You end up rewriting `(f ||| g) | *** h` into `first (left f) >>> first (right g) >>> second h`, turning two | distinct branches into four, and larger programs have much worse | exponential blowups. | > | > So that’s where I’ve gotten stuck! I’ve been toying with the idea of | > thinking about expression “shells”, so if you have something like | > | > first (a ||| b) >>> c *** second (d ||| e) >>> f | > | > then you have a “shell” of the shape | > | > first (● ||| ●) >>> ● *** second (● ||| ●) >>> ● | > | > which theoretically serves as a key for the specialization. You can then | generate a specialization and a rule: | > | > $s a b c d e f = ... | > {-# RULE forall a b c d e f. | > first (a ||| b) >>> c *** second (d ||| e) >>> f = $s a b | > c d e f #-} | > | > The question then becomes: how do you specify what these shells are, and | how do you specify how to transform the shell into a specialized function? | I don’t know, but it’s something a Core plugin could theoretically do. | Maybe it makes sense for this domain-specific optimization to be a Core | pass that runs before the simplifier, like the typeclass specializer | currently is, but I haven’t explored that yet. | > | > Alexis | -- | Joachim Breitner | mail at joachim-breitner.de | | https://nam06.safelinks.protection.outlook.com/?url=http%3A%2F%2Fwww.joach | im- | breitner.de%2F&data=02%7C01%7Csimonpj%40microsoft.com%7C8e5db80efc0f40 | 7af9c308d7d66bcd58%7C72f988bf86f141af91ab2d7cd011db47%7C1%7C0%7C6372136308 | 17542428&sdata=%2B7hEhV9tXg7UmRrW6UaWH471SnLPLpWjj6XJLfNifsM%3D&re | served=0 | | | _______________________________________________ | ghc-devs mailing list | ghc-devs at haskell.org | https://nam06.safelinks.protection.outlook.com/?url=http%3A%2F%2Fmail.hask | ell.org%2Fcgi-bin%2Fmailman%2Flistinfo%2Fghc- | devs&data=02%7C01%7Csimonpj%40microsoft.com%7C8e5db80efc0f407af9c308d7 | d66bcd58%7C72f988bf86f141af91ab2d7cd011db47%7C1%7C0%7C637213630817542428&a | mp;sdata=rb23g0%2Bmo%2FQ1dld5ecqCHQcJZ0hb7ms9VMP%2B5nTpAk4%3D&reserved | =0 From simonpj at microsoft.com Wed Apr 1 20:21:06 2020 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Wed, 1 Apr 2020 20:21:06 +0000 Subject: Fusing loops by specializing on functions with SpecConstr? In-Reply-To: References: <2E809F34-633F-4089-BEED-F38929F8BFD0@gmail.com> <296140F4-DCAC-4ACD-80F8-6F99B37C7316@gmail.com> Message-ID: I have started a wiki page for join points here https://gitlab.haskell.org/ghc/ghc/-/wikis/Join-points-in-GHC Do add to it Simon | -----Original Message----- | From: ghc-devs On Behalf Of Joachim | Breitner | Sent: 01 April 2020 19:37 | To: ghc-devs | Subject: Re: Fusing loops by specializing on functions with SpecConstr? | | Hi, | | I think most of the docs about exitification are the notes in the Exitify | module, and then there is the original ticket at | https://nam06.safelinks.protection.outlook.com/?url=https%3A%2F%2Fgitlab.h | askell.org%2Fghc%2Fghc%2Fissues%2F14152&data=02%7C01%7Csimonpj%40micro | soft.com%7C8e5db80efc0f407af9c308d7d66bcd58%7C72f988bf86f141af91ab2d7cd011 | db47%7C1%7C0%7C637213630817542428&sdata=TBb6lzmIJvtHOQLwpsyFLPi2BEF%2B | B66piMGTgcV%2Bkls%3D&reserved=0 | | I don’t immediately see the connection to SpecConstr on function values, | though, so I don't really know what’s tickling your neurons right now. | | Cheers, | Joachim | | | Am Dienstag, den 31.03.2020, 22:49 +0000 schrieb Simon Peyton Jones: | > Joachim: this conversation is triggering some hind-brain neurons | > related to exitification, or something like that. I recall that we | > discovered we could get some surprising fusion of recursive functions | > expressed as join points. Something like f . g . h | > where h loops for a while and returns, and same for g and f. Then the | > call to g landed up in the return branch of h, and same for f. | > | > But I can’t find anything in writing. The Exitify module doesn’t say | much. I thought we had a wiki page but I can’t find it. Can you remember? | > | > Thanks | > | > Simon | > | > From: Alexis King | > Sent: 31 March 2020 22:18 | > To: Sebastian Graf ; Simon Peyton Jones | > | > Cc: ghc-devs | > Subject: Re: Fusing loops by specializing on functions with SpecConstr? | > | > Sebastian and Simon, | > | > Thank you both for your responses—they are all quite helpful! I agree | with both of you that figuring out how to do this kind of specialization | without any guidance from the programmer seems rather intractable. It’s | too hard to divine where it would actually be beneficial, and even if you | could, it seems likely that other optimizations would get in the way of it | actually working out. | > | > I’ve been trying to figure out if it would be possible to help the | optimizer out by annotating the program with special combinators like the | existing ones provided by GHC.Magic. However, I haven’t been able to come | up with anything yet that seems like it would actually work. | > | > > On Mar 31, 2020, at 06:12, Simon Peyton Jones | wrote: | > > | > > Wow – tricky stuff! I would never have thought of trying to optimise | that program, but it’s fascinating that you get lots and lots of them from | FRP. | > | > | > For context, the reason you get all these tiny loops is that arrowized | FRP uses the Arrow and ArrowChoice interfaces to build its programs, and | those interfaces use tiny combinator functions like these: | > | > first :: Arrow a => a b c -> a (b, d) (c, d) | > (***) :: Arrow a => a b d -> a c e -> a (b, c) (d, e) | > (|||) :: ArrowChoice a => a b d -> a c d -> a (Either b c) d | > | > This means you end up with programs built out of dozens or hundreds of | > uses of these tiny combinators. You get code that looks like | > | > first (left (arr f >>> g ||| right h) *** second i) | > | > and this is a textbook situation where you want to specialize and inline | all the combinators! For arrows without this tricky recursion, doing that | works as intended, and GHC’s simplifier will do what it’s supposed to, and | you get fast code. | > | > But with FRP, each of these combinators is recursive. This means you | often get really awful code that looks like this: | > | > arr (\case { Nothing -> Left (); Just x -> Right x }) >>> (f ||| | > g) | > | > This converts a Maybe to an Either, then branches on it. It’s analogous | to writing something like this in direct-style code: | > | > let y = case x of { Nothing -> Left (); Just x -> Right x } | > in case y of { Left () -> f; Right x -> g x } | > | > We really want the optimizer to eliminate the intermediate Either and | just branch on it directly, and if GHC could fuse these tiny recursive | loops, it could! But without that, all this pointless shuffling of values | around remains in the optimized program. | > | > | > > I wonder whether it’d be possible to adjust the FRP library to | generate easier-to-optimise code. Probably not, but worth asking. | > | > | > I think it’s entirely possible to somehow annotate these combinators | > to communicate this information to the optimizer, but I don’t know | > what the annotations ought to look like. (That’s the research part!) | > | > But I’m not very optimistic about getting the library to generate | easier-to-optimize code with the tools available today. Sebastian’s | example of SF2 and stream fusion sort of works, but in my experience, | something like that doesn’t handle enough cases well enough to work on | real arrow programs. | > | > > Unrolling one layer of a recursive function. That seems harder: how | we know to *stop* unrolling as we successively simplify? One idea: do one | layer of unrolling by hand, perhaps even in FRP source code: | > > add1rec = SF (\a -> let !b = a+1 in (b,add1rec)) | > > add1 = SF (\a -> let !b = a+1 in (b,add1rec)) | > | > | > Yes, I was playing with the idea at one point of some kind of RULE that | inserts GHC.Magic.inline on the specialized RHS. That way the programmer | could ask for the unrolling explicitly, as otherwise it seems unreasonable | to ask the compiler to figure it out. | > | > > On Mar 31, 2020, at 08:08, Sebastian Graf wrote: | > > | > > We can formulate SF as a classic Stream that needs an `a` to produce | > > its next element of type `b` like this (SF2 below) | > | > | > This is a neat trick, though I’ve had trouble getting it to work | reliably in my experiments (even though I was using GHC.Types.SPEC). That | said, I also feel like I don’t understand the subtleties of SpecConstr | very well, so it could have been my fault. | > | > The more fundamental problem I’ve found with that approach is that it | doesn’t do very well for arrow combinators like (***) and (|||), which | come up very often in arrow programs but rarely in streaming. Fusing long | chains of first/second/left/right is actually pretty easy with ordinary | RULEs, but (***) and (|||) are much harder, since they have multiple | continuations. | > | > It seems at first appealing to rewrite `f *** g` into `first f >>> | second g`, which solves the immediate problem, but this is actually a lot | less efficient after repeated rewritings. You end up rewriting `(f ||| g) | *** h` into `first (left f) >>> first (right g) >>> second h`, turning two | distinct branches into four, and larger programs have much worse | exponential blowups. | > | > So that’s where I’ve gotten stuck! I’ve been toying with the idea of | > thinking about expression “shells”, so if you have something like | > | > first (a ||| b) >>> c *** second (d ||| e) >>> f | > | > then you have a “shell” of the shape | > | > first (● ||| ●) >>> ● *** second (● ||| ●) >>> ● | > | > which theoretically serves as a key for the specialization. You can then | generate a specialization and a rule: | > | > $s a b c d e f = ... | > {-# RULE forall a b c d e f. | > first (a ||| b) >>> c *** second (d ||| e) >>> f = $s a b | > c d e f #-} | > | > The question then becomes: how do you specify what these shells are, and | how do you specify how to transform the shell into a specialized function? | I don’t know, but it’s something a Core plugin could theoretically do. | Maybe it makes sense for this domain-specific optimization to be a Core | pass that runs before the simplifier, like the typeclass specializer | currently is, but I haven’t explored that yet. | > | > Alexis | -- | Joachim Breitner | mail at joachim-breitner.de | | https://nam06.safelinks.protection.outlook.com/?url=http%3A%2F%2Fwww.joach | im- | breitner.de%2F&data=02%7C01%7Csimonpj%40microsoft.com%7C8e5db80efc0f40 | 7af9c308d7d66bcd58%7C72f988bf86f141af91ab2d7cd011db47%7C1%7C0%7C6372136308 | 17542428&sdata=%2B7hEhV9tXg7UmRrW6UaWH471SnLPLpWjj6XJLfNifsM%3D&re | served=0 | | | _______________________________________________ | ghc-devs mailing list | ghc-devs at haskell.org | https://nam06.safelinks.protection.outlook.com/?url=http%3A%2F%2Fmail.hask | ell.org%2Fcgi-bin%2Fmailman%2Flistinfo%2Fghc- | devs&data=02%7C01%7Csimonpj%40microsoft.com%7C8e5db80efc0f407af9c308d7 | d66bcd58%7C72f988bf86f141af91ab2d7cd011db47%7C1%7C0%7C637213630817542428&a | mp;sdata=rb23g0%2Bmo%2FQ1dld5ecqCHQcJZ0hb7ms9VMP%2B5nTpAk4%3D&reserved | =0 From ben at smart-cactus.org Wed Apr 1 20:27:12 2020 From: ben at smart-cactus.org (Ben Gamari) Date: Wed, 01 Apr 2020 16:27:12 -0400 Subject: License for grammar In-Reply-To: References: Message-ID: <87r1x79cki.fsf@smart-cactus.org> Евгений Слободкин writes: > Hi all! > > I implemented Haskell grammar for ANTLRv4 based on HaskellReport 2010 > and GHC source (Parser.y and Lexer.x files). > > Link: https://github.com/antlr/grammars-v4/blob/master/haskell/Haskell.g4 > > Could someone please help me figuring out which license this grammar > should be published on? GHC is BSD-3, so you are fairly free to choose the license of your choice. I would probably just retain the BSD-3 license unless you have reason to do otherwise. Cheers, - Ben -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From matthewtpickering at gmail.com Thu Apr 2 10:03:53 2020 From: matthewtpickering at gmail.com (Matthew Pickering) Date: Thu, 2 Apr 2020 11:03:53 +0100 Subject: Advice implementing new constraint entailment rules In-Reply-To: References: Message-ID: Where exactly do you mean about "stepping inside an implication"? For the program foo = [|| show ||] My first attempt to use implication constraints was to create an implication with G = [] W = [Show a @ 2] and then canonicalise to remove CodeC constraints. I hope the evidence would get directly written into the right place and hence be stage correct but we still generate stage incorrect let bindings. For example: foo d = let dShow = $$d in [|| let dShow' = dShow in show dShow' ||] I need foo d = [|| let dShow = $$d in show dShow ||] The other possibilities I could think of based on your hint are: * Capture Ws when leaving a quote, and create a quote with G = [Show a @ 2] W = [CodeC (Show a) @ 1] (and have no canonicalisation step). This doesn't seem much different to what I already have. * When stepping inside an implication which increase the stage, look in the inert set for any `CodeC` constraints and create givens for the next stage by applying splices. A call would be good to clear this up. Cheers, Matt On Mon, Mar 30, 2020 at 11:31 PM Simon Peyton Jones wrote: > > Do you know about implication constraints? If not, look back at the OutsideIn(X) paper. > > An implication constraint carries with it the place to put its Given bindings: see the ic_binds field of Constraint.Implication. And that is exactly what you want. > > I suspect you'll want an implication to carry a stage, as well as its skolem vars and givens. When stepping inside an implication that would trigger the unwapping of CodeC constraints from outside. > > We could have a Skype call to discuss if you like > > Simon > > | -----Original Message----- > | From: Matthew Pickering > | Sent: 27 March 2020 22:33 > | To: Simon Peyton Jones > | Cc: GHC developers > | Subject: Re: Advice implementing new constraint entailment rules > | > | I have made some progress towards the implementation but am stuck on how > | to get the right desugaring. > | > | For example if the source program is > | > | foo :: CodeC (Show a) => Code (a -> String) foo = [| show |] > | > | Then the current approach is to canonicalise all the constraints to remove > | the `CodeC`. The issue with this I have found is that the evidence gets > | bound in the wrong place: > | > | ``` > | foo d = let d' = $d in [| show d' |] > | ``` > | > | It should rather be > | > | ``` > | foo d = [| let d' = $d in show d' |] > | ``` > | > | Now I am trying to think of ways to make the evidence binding be bound in > | the right place. So there are a few things I thought of, > | > | 1. Attempt to float evidence bindings back inwards to the right level > | after they are solved, this doesn't feel great as they are floated > | outwards already. > | 2. Don't canonicalise the constraints in the normal manner, when leaving > | the context of a quote, capture the wanted constraints (in this example > | Show a) and emit a (CodeC (Show a)) constraint whilst inserting the > | evidence binding inside the quote. > | > | I prefer option 2 but inside `WantedConstraints` there are `Ct`s which may > | be already canonicalised. Trying a few examples shows me that the `Show a` > | constraint in this example is not canonicalised already but it feels a bit > | dirty to dig into a `Ct` to find non canonical constraints to re-emit. > | > | Any hints about how to make sure the evidence is bound in the correct > | place? > | > | Matt > | > | On Thu, Mar 5, 2020 at 9:24 AM Simon Peyton Jones > | wrote: > | > > | > Hi Matt > | > > | > I think you are right to say that we need to apply proper staging to the > | constraint solver. But I don't understand your constraint rewriting > | rules. > | > > | > Before moving to the implementation, could we discuss the specification? > | You already have some typeset rules in a paper of some kind, which I > | commented on some time ago. Could you elaborate those rules with class > | constraints? Then we'd have something tangible to debate. > | > > | > Thanks > | > > | > Simon > | > > | > | -----Original Message----- > | > | From: ghc-devs On Behalf Of Matthew > | > | Pickering > | > | Sent: 05 March 2020 08:16 > | > | To: GHC developers > | > | Subject: Advice implementing new constraint entailment rules > | > | > | > | Hello, > | > | > | > | I am attempting to implement two new constraint entailment rules > | > | which dictate how to implement a new constraint form "CodeC" can be > | > | used to satisfy constraints. > | > | > | > | The main idea is that all constraints store the level they they are > | > | introduced and required (in the Template Haskell sense of level) and > | > | that only constraints of the right level can be used. > | > | > | > | The "CodeC" constraint form allows the level of constraints to be > | > | manipulated. > | > | > | > | Therefore the two rules > | > | > | > | In order to implement this I want to add two constraint rewriting > | > | rules in the following way: > | > | > | > | 1. If in a given, `CodeC C @ n` ~> `C @ n+1` 2. If in a wanted > | > | `CodeC C @ n` -> `C @ n - 1` > | > | > | > | Can someone give me some pointers about the specific part of the > | > | constraint solver where I should add these rules? I am unsure if > | > | this rewriting of wanted constraints already occurs or not. > | > | > | > | Cheers, > | > | > | > | Matt > | > | _______________________________________________ > | > | ghc-devs mailing list > | > | ghc-devs at haskell.org > | > | > | > | https://nam06.safelinks.protection.outlook.com/?url=http%3A%2F%2Fmai > | > | l.hask > | > | ell.org%2Fcgi-bin%2Fmailman%2Flistinfo%2Fghc- > | > | > | > | devs&data=02%7C01%7Csimonpj%40microsoft.com%7C52ec5ca4f50c496b25 > | > | e808d7 > | > | c0dd8534%7C72f988bf86f141af91ab2d7cd011db47%7C1%7C0%7C63718992996353 > | > | 0670&a > | > | > | > | mp;sdata=0T2O%2FaAcIU9Yl61x2uPzl4zUG4P3jl6iA97baIDlSsM%3D&reserv > | > | ed=0 From klebinger.andreas at gmx.at Fri Apr 3 20:26:57 2020 From: klebinger.andreas at gmx.at (Andreas Klebinger) Date: Fri, 3 Apr 2020 22:26:57 +0200 Subject: Module Renaming: GHC.Core.Op Message-ID: <1505f897-48ef-52db-891e-2fbada3bd386@gmx.at> Hello devs, While I looked at the renaming a bit when proposed I only just realized we seem to be using Op as a short name for optimize. I find this very unintuitive. Can we spare another letter to make this GHC.Core.Opt instead? We use opt pretty much everywhere else in GHC already. Cheers Andreas From chessai1996 at gmail.com Fri Apr 3 20:48:32 2020 From: chessai1996 at gmail.com (chessai .) Date: Fri, 3 Apr 2020 13:48:32 -0700 Subject: Module Renaming: GHC.Core.Op In-Reply-To: <1505f897-48ef-52db-891e-2fbada3bd386@gmx.at> References: <1505f897-48ef-52db-891e-2fbada3bd386@gmx.at> Message-ID: +1, i always think "opcode" On Fri, Apr 3, 2020, 1:27 PM Andreas Klebinger wrote: > Hello devs, > > While I looked at the renaming a bit when proposed I only just realized > we seem to be using Op as a short name for optimize. > > I find this very unintuitive. Can we spare another letter to make this > GHC.Core.Opt instead? > > We use opt pretty much everywhere else in GHC already. > > Cheers > Andreas > > > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs > -------------- next part -------------- An HTML attachment was scrubbed... URL: From sylvain at haskus.fr Fri Apr 3 21:29:38 2020 From: sylvain at haskus.fr (Sylvain Henry) Date: Fri, 3 Apr 2020 23:29:38 +0200 Subject: Module Renaming: GHC.Core.Op In-Reply-To: <1505f897-48ef-52db-891e-2fbada3bd386@gmx.at> References: <1505f897-48ef-52db-891e-2fbada3bd386@gmx.at> Message-ID: <6c8d616b-6778-7556-c51f-95609856238e@haskus.fr> Hi Andreas, "Op" stands for "Operation" but it's not very obvious (ironically when I started this renaming work one of the motivation was to avoid ambiguous acronyms... failed). The idea was to separate Core types from Core transformations/analyses/passes. I couldn't find something better then "Operation" to sum up the latter category but I concede it's not very good. But perhaps we should do the opposite as we're doing in GHC.Tc: put all the Core types in GHC.Core.Types and move everything operation from GHC.Core.Op to GHC.Core? Cheers, Sylvain On 03/04/2020 22:26, Andreas Klebinger wrote: > Hello devs, > > While I looked at the renaming a bit when proposed I only just realized > we seem to be using Op as a short name for optimize. > > I find this very unintuitive. Can we spare another letter to make this > GHC.Core.Opt instead? > > We use opt pretty much everywhere else in GHC already. > > Cheers > Andreas > > > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs From lexi.lambda at gmail.com Sat Apr 4 01:45:36 2020 From: lexi.lambda at gmail.com (Alexis King) Date: Fri, 3 Apr 2020 20:45:36 -0500 Subject: Fusing loops by specializing on functions with SpecConstr? In-Reply-To: References: <2E809F34-633F-4089-BEED-F38929F8BFD0@gmail.com> <296140F4-DCAC-4ACD-80F8-6F99B37C7316@gmail.com> <208D122C-E0E7-4B28-969B-19A792E358C5@gmail.com> Message-ID: I fiddled with alternative representations for a while and didn’t make any progress—it was too easy to end up with code explosion in the presence of any unknown calls—but I seem to have found a RULES-based approach that works very well on the examples I’ve tried. It’s quite simple, which makes it especially appealing! I started by defining a wrapper around the `SF` constructor to attach rules to: mkSF :: (a -> s -> Step s b) -> s -> SF a b mkSF = SF {-# INLINE CONLIKE [1] mkSF #-} I then changed the definitions of (.), (***), (&&&), (+++), and (&&&) to use `mkSF` instead of `SF`, but I left the other methods alone, so they just use `SF` directly. Then I defined two rewrite rules: {-# RULES "mkSF @((), _)" forall f s. mkSF f ((), s) = SF (\a s1 -> case f a ((), s1) of Step ((), s2) b -> Step s2 b) s "mkSF @(_, ())" forall f s. mkSF f (s, ()) = SF (\a s1 -> case f a (s1, ()) of Step (s2, ()) b -> Step s2 b) s #-} That’s it. These two rules alone are enough to eliminate the redundant tupling. Now the optimized version of `mapMaybeSF` is beautiful! mapMaybeSF = \ @ a @ b f -> case f of { SF @ s f2 s2 -> SF (\ a1 s1 -> case a1 of { Nothing -> case s1 of dt { __DEFAULT -> Step dt Nothing } Just x -> case f2 x s1 of { Step s2' c1 -> Step s2' (Just c1) }}) s2 } So unless this breaks down in some larger situation I’m not aware of, I think this solves my problem without the need for any fancy SpecConstr shenanigans. Many thanks to you, Sebastian, for pointing me in the right direction! Alexis From klebinger.andreas at gmx.at Sat Apr 4 12:56:48 2020 From: klebinger.andreas at gmx.at (Andreas Klebinger) Date: Sat, 4 Apr 2020 14:56:48 +0200 Subject: Module Renaming: GHC.Core.Op In-Reply-To: <6c8d616b-6778-7556-c51f-95609856238e@haskus.fr> References: <1505f897-48ef-52db-891e-2fbada3bd386@gmx.at> <6c8d616b-6778-7556-c51f-95609856238e@haskus.fr> Message-ID: Thanks for the response Sylvain. > put all the Core types in GHC.Core.Types and move everything operation from GHC.Core.Op to GHC.Core? That would work as well. But I still favour the renaming approach. Almost all of these passes are optimization, and the few who are not are just there to support the optimizations so their placements still makes sense. To me anyway. If people reject the renaming your suggestion would still be an improvement over .Op though. Cheers, Andreas Sylvain Henry schrieb am 03.04.2020 um 23:29: > Hi Andreas, > > "Op" stands for "Operation" but it's not very obvious (ironically when > I started this renaming work one of the motivation was to avoid > ambiguous acronyms... failed). > > The idea was to separate Core types from Core > transformations/analyses/passes. I couldn't find something better then > "Operation" to sum up the latter category but I concede it's not very > good. > > But perhaps we should do the opposite as we're doing in GHC.Tc: put > all the Core types in GHC.Core.Types and move everything operation > from GHC.Core.Op to GHC.Core? > > Cheers, > Sylvain > > > On 03/04/2020 22:26, Andreas Klebinger wrote: >> Hello devs, >> >> While I looked at the renaming a bit when proposed I only just realized >> we seem to be using Op as a short name for optimize. >> >> I find this very unintuitive. Can we spare another letter to make this >> GHC.Core.Opt instead? >> >> We use opt pretty much everywhere else in GHC already. >> >> Cheers >> Andreas >> >> >> _______________________________________________ >> ghc-devs mailing list >> ghc-devs at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs From simon.jakobi at googlemail.com Sat Apr 4 23:24:34 2020 From: simon.jakobi at googlemail.com (Simon Jakobi) Date: Sun, 5 Apr 2020 01:24:34 +0200 Subject: Measuring compiler performance Message-ID: Hi devs! I've recently started working on a few compiler perf related tickets, and wondered how to verify that a change actually has a positive impact on compiler performance. I first looked at the wiki for information on this, but didn't find much: https://gitlab.haskell.org/ghc/ghc/-/wikis/performance/compiler doesn't contain any information on how to measure compiler performance The best tip I found was the recommendation in https://gitlab.haskell.org/ghc/ghc/-/wikis/building/running-no-fib to compile nofib/spectral/simple/Main.hs. With -O0 and -O that takes respectively about 1.5s and 5s for me, so the effort is manageable. I've also done full nofib runs, but they take a very long time. A problem in this context is that reliable performance measurements require a quiet machine. Closing my browser, and turning off other programs is – in my perception – rather inconvenient, particularly when I have to do it for a prolonged time. Ideally I wouldn't have to perform these measurements on my local machine at all! Do you usually use a separate machine for this? _Very_ convenient would be some kind of bot whom I could tell e.g. @perf-bot compiler perf …or more concretely @perf-bot compile nofib/spectral/simple/Main.hs …or just @nofib-bot run … or something like that. I've noticed that CI now includes a perf-nofib job. But since it appears to run on a different machine each time, I'm not sure whether it's actually useful for comparing performance. Could it be made more useful by running it consistently on the same dedicated machine? Another question regarding performing compiler perf measurements locally is which build flavour to use: So far I have used the "perf" flavour. A problem here is that a full build seems to take close to an hour. A rebuild with --freeze1 takes ~15 minutes on my machine. Is this the right flavour to use? BTW what's the purpose of the profiled GHC modules built with this flavour which just seem to additionally prolong compile time? I don't see a ghc-prof binary or similar in _build/stage1/bin. Also, what's the status of gipeda? The most recent commit at https://perf.haskell.org/ghc/ is from "about a year ago"? Sorry for this load of questions and complaints! I do believe though that if work on compiler performance was a bit better documented and more convenient, we might see even more progress on that front. :) Cheers, Simon From sylvain at haskus.fr Sun Apr 5 15:57:09 2020 From: sylvain at haskus.fr (Sylvain Henry) Date: Sun, 5 Apr 2020 17:57:09 +0200 Subject: Module Renaming: GHC.Core.Op In-Reply-To: References: <1505f897-48ef-52db-891e-2fbada3bd386@gmx.at> <6c8d616b-6778-7556-c51f-95609856238e@haskus.fr> Message-ID: <46f5550e-cffe-109a-d338-997c015baf44@haskus.fr> > That would work as well. But I still favour the renaming approach. If no one opposes, I'll do the s/GHC.Core.Op/GHC.Core.Opt/ in the next renaming MR (after !2924 is merged). Cheers, Sylvain On 04/04/2020 14:56, Andreas Klebinger wrote: > Thanks for the response Sylvain. > > > put all the Core types in GHC.Core.Types and move everything > operation from GHC.Core.Op to GHC.Core? > > That would work as well. But I still favour the renaming approach. > > Almost all of these passes are optimization, and the few who are not are > just there to support > the optimizations so their placements still makes sense. To me anyway. > > If people reject the renaming your suggestion would still be an > improvement over .Op though. > > Cheers, > Andreas > > Sylvain Henry schrieb am 03.04.2020 um 23:29: >> Hi Andreas, >> >> "Op" stands for "Operation" but it's not very obvious (ironically when >> I started this renaming work one of the motivation was to avoid >> ambiguous acronyms... failed). >> >> The idea was to separate Core types from Core >> transformations/analyses/passes. I couldn't find something better then >> "Operation" to sum up the latter category but I concede it's not very >> good. >> >> But perhaps we should do the opposite as we're doing in GHC.Tc: put >> all the Core types in GHC.Core.Types and move everything operation >> from GHC.Core.Op to GHC.Core? >> >> Cheers, >> Sylvain >> >> >> On 03/04/2020 22:26, Andreas Klebinger wrote: >>> Hello devs, >>> >>> While I looked at the renaming a bit when proposed I only just realized >>> we seem to be using Op as a short name for optimize. >>> >>> I find this very unintuitive. Can we spare another letter to make this >>> GHC.Core.Opt instead? >>> >>> We use opt pretty much everywhere else in GHC already. >>> >>> Cheers >>> Andreas >>> >>> >>> _______________________________________________ >>> ghc-devs mailing list >>> ghc-devs at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs >> _______________________________________________ >> ghc-devs mailing list >> ghc-devs at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs > From sgraf1337 at gmail.com Sun Apr 5 19:00:40 2020 From: sgraf1337 at gmail.com (Sebastian Graf) Date: Sun, 5 Apr 2020 21:00:40 +0200 Subject: Fusing loops by specializing on functions with SpecConstr? In-Reply-To: References: <2E809F34-633F-4089-BEED-F38929F8BFD0@gmail.com> <296140F4-DCAC-4ACD-80F8-6F99B37C7316@gmail.com> <208D122C-E0E7-4B28-969B-19A792E358C5@gmail.com> Message-ID: > > That’s it. These two rules alone are enough to eliminate the redundant > tupling. Now the optimized version of `mapMaybeSF` is beautiful! > Beautiful indeed! That's wonderful to hear. Good luck messing about with your FRP framework! Sebastian Am Sa., 4. Apr. 2020 um 03:45 Uhr schrieb Alexis King : > > I fiddled with alternative representations for a while and didn’t make > any progress—it was too easy to end up with code explosion in the > presence of any unknown calls—but I seem to have found a RULES-based > approach that works very well on the examples I’ve tried. It’s quite > simple, which makes it especially appealing! > > I started by defining a wrapper around the `SF` constructor to attach > rules to: > > mkSF :: (a -> s -> Step s b) -> s -> SF a b > mkSF = SF > {-# INLINE CONLIKE [1] mkSF #-} > > I then changed the definitions of (.), (***), (&&&), (+++), and (&&&) > to use `mkSF` instead of `SF`, but I left the other methods alone, so > they just use `SF` directly. Then I defined two rewrite rules: > > {-# RULES > "mkSF @((), _)" forall f s. mkSF f ((), s) = > SF (\a s1 -> case f a ((), s1) of Step ((), s2) b -> Step s2 b) s > "mkSF @(_, ())" forall f s. mkSF f (s, ()) = > SF (\a s1 -> case f a (s1, ()) of Step (s2, ()) b -> Step s2 b) s > #-} > > That’s it. These two rules alone are enough to eliminate the redundant > tupling. Now the optimized version of `mapMaybeSF` is beautiful! > > mapMaybeSF = \ @ a @ b f -> case f of { SF @ s f2 s2 -> > SF (\ a1 s1 -> case a1 of { > Nothing -> case s1 of dt { __DEFAULT -> Step dt Nothing } > Just x -> case f2 x s1 of { > Step s2' c1 -> Step s2' (Just c1) }}) > s2 } > > So unless this breaks down in some larger situation I’m not aware of, I > think this solves my problem without the need for any fancy SpecConstr > shenanigans. Many thanks to you, Sebastian, for pointing me in the right > direction! > > Alexis -------------- next part -------------- An HTML attachment was scrubbed... URL: From rae at richarde.dev Mon Apr 6 08:32:36 2020 From: rae at richarde.dev (Richard Eisenberg) Date: Mon, 6 Apr 2020 09:32:36 +0100 Subject: Module Renaming: GHC.Core.Op In-Reply-To: <46f5550e-cffe-109a-d338-997c015baf44@haskus.fr> References: <1505f897-48ef-52db-891e-2fbada3bd386@gmx.at> <6c8d616b-6778-7556-c51f-95609856238e@haskus.fr> <46f5550e-cffe-109a-d338-997c015baf44@haskus.fr> Message-ID: I would vote against the GHC.Core.Types directory, because there is the potential for confusion with "types we are declaring" to "this stuff is about Haskell types". As I've posted elsewhere, I'm in strong support of separating definitions about Core from operations on Core. Originally, I thought GHC.Core.Pass would be a good alternative to GHC.Core.Op. Not sure why that was dropped. If all the passes really are optimizations (and why wouldn't they be?), then GHC.Core.Opt would be fine, too. Perhaps we should move GHC.Core.Coercion.Opt to the new place, regardless. Thanks! Richard > On Apr 5, 2020, at 4:57 PM, Sylvain Henry wrote: > > > That would work as well. But I still favour the renaming approach. > > If no one opposes, I'll do the s/GHC.Core.Op/GHC.Core.Opt/ in the next renaming MR (after !2924 is merged). > > Cheers, > Sylvain > > > On 04/04/2020 14:56, Andreas Klebinger wrote: >> Thanks for the response Sylvain. >> >> > put all the Core types in GHC.Core.Types and move everything >> operation from GHC.Core.Op to GHC.Core? >> >> That would work as well. But I still favour the renaming approach. >> >> Almost all of these passes are optimization, and the few who are not are >> just there to support >> the optimizations so their placements still makes sense. To me anyway. >> >> If people reject the renaming your suggestion would still be an >> improvement over .Op though. >> >> Cheers, >> Andreas >> >> Sylvain Henry schrieb am 03.04.2020 um 23:29: >>> Hi Andreas, >>> >>> "Op" stands for "Operation" but it's not very obvious (ironically when >>> I started this renaming work one of the motivation was to avoid >>> ambiguous acronyms... failed). >>> >>> The idea was to separate Core types from Core >>> transformations/analyses/passes. I couldn't find something better then >>> "Operation" to sum up the latter category but I concede it's not very >>> good. >>> >>> But perhaps we should do the opposite as we're doing in GHC.Tc: put >>> all the Core types in GHC.Core.Types and move everything operation >>> from GHC.Core.Op to GHC.Core? >>> >>> Cheers, >>> Sylvain >>> >>> >>> On 03/04/2020 22:26, Andreas Klebinger wrote: >>>> Hello devs, >>>> >>>> While I looked at the renaming a bit when proposed I only just realized >>>> we seem to be using Op as a short name for optimize. >>>> >>>> I find this very unintuitive. Can we spare another letter to make this >>>> GHC.Core.Opt instead? >>>> >>>> We use opt pretty much everywhere else in GHC already. >>>> >>>> Cheers >>>> Andreas >>>> >>>> >>>> _______________________________________________ >>>> ghc-devs mailing list >>>> ghc-devs at haskell.org >>>> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs >>> _______________________________________________ >>> ghc-devs mailing list >>> ghc-devs at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs >> > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs From rae at richarde.dev Mon Apr 6 08:40:17 2020 From: rae at richarde.dev (Richard Eisenberg) Date: Mon, 6 Apr 2020 09:40:17 +0100 Subject: Measuring compiler performance In-Reply-To: References: Message-ID: Because of the fragility of time-based performance tests, I often use allocations as a proxy for time. The number of allocations is very stable. On the down side, it is sometimes possible to reduce allocations while increasing time, so one shouldn't try too hard to blindly optimize allocations. Separately, in order to get measurements, I build Cabal with ghc --make. Cabal is convenient because it is sizeable, real-world, updated, and needs no dependencies. Compiling the full library definitely takes more than 5 seconds, though. I agree that there is plenty of room for improvement here! Richard > On Apr 5, 2020, at 12:24 AM, Simon Jakobi via ghc-devs wrote: > > Hi devs! > > I've recently started working on a few compiler perf related tickets, > and wondered how to verify that a change actually has a positive > impact on compiler performance. > > I first looked at the wiki for information on this, but didn't find much: > > https://gitlab.haskell.org/ghc/ghc/-/wikis/performance/compiler > doesn't contain any information on how to measure compiler performance > > The best tip I found was the recommendation in > https://gitlab.haskell.org/ghc/ghc/-/wikis/building/running-no-fib to > compile nofib/spectral/simple/Main.hs. With -O0 and -O that takes > respectively about 1.5s and 5s for me, so the effort is manageable. > I've also done full nofib runs, but they take a very long time. > > A problem in this context is that reliable performance measurements > require a quiet machine. Closing my browser, and turning off other > programs is – in my perception – rather inconvenient, particularly > when I have to do it for a prolonged time. > > Ideally I wouldn't have to perform these measurements on my local > machine at all! Do you usually use a separate machine for this? _Very_ > convenient would be some kind of bot whom I could tell e.g. > > @perf-bot compiler perf > > …or more concretely > > @perf-bot compile nofib/spectral/simple/Main.hs > > …or just > > @nofib-bot run > > … or something like that. > > I've noticed that CI now includes a perf-nofib job. But since it > appears to run on a different machine each time, I'm not sure whether > it's actually useful for comparing performance. Could it be made more > useful by running it consistently on the same dedicated machine? > > Another question regarding performing compiler perf measurements > locally is which build flavour to use: So far I have used the "perf" > flavour. A problem here is that a full build seems to take close to an > hour. A rebuild with --freeze1 takes ~15 minutes on my machine. Is > this the right flavour to use? > > BTW what's the purpose of the profiled GHC modules built with this > flavour which just seem to additionally prolong compile time? I don't > see a ghc-prof binary or similar in _build/stage1/bin. > > Also, what's the status of gipeda? The most recent commit at > https://perf.haskell.org/ghc/ is from "about a year ago"? > > Sorry for this load of questions and complaints! I do believe though > that if work on compiler performance was a bit better documented and > more convenient, we might see even more progress on that front. :) > > Cheers, > Simon > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs From simonpj at microsoft.com Mon Apr 6 08:52:20 2020 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Mon, 6 Apr 2020 08:52:20 +0000 Subject: Module Renaming: GHC.Core.Op In-Reply-To: <1505f897-48ef-52db-891e-2fbada3bd386@gmx.at> References: <1505f897-48ef-52db-891e-2fbada3bd386@gmx.at> Message-ID: I wondered that too. I'd be happy with "Opt" instead of "Op". Simon | -----Original Message----- | From: ghc-devs On Behalf Of Andreas | Klebinger | Sent: 03 April 2020 21:27 | To: ghc-devs at haskell.org | Subject: Module Renaming: GHC.Core.Op | | Hello devs, | | While I looked at the renaming a bit when proposed I only just realized | we seem to be using Op as a short name for optimize. | | I find this very unintuitive. Can we spare another letter to make this | GHC.Core.Opt instead? | | We use opt pretty much everywhere else in GHC already. | | Cheers | Andreas | | | _______________________________________________ | ghc-devs mailing list | ghc-devs at haskell.org | http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs From klebinger.andreas at gmx.at Mon Apr 6 09:03:07 2020 From: klebinger.andreas at gmx.at (Andreas Klebinger) Date: Mon, 6 Apr 2020 11:03:07 +0200 Subject: Measuring compiler performance In-Reply-To: References: Message-ID: Hi Simon, things I do to measure performance: * compile nofib/spectral/simple/Main.hs, look at instructions (perf) and allocations/time (+RTS -s) * compile nofib as a whole (Use NoFibRuns=0 to avoid running the benchmarks). Look at compile time/allocations. * compile Cabal the library (cd cabal-head/Cabal && ghc Setup.hs -fforce-recomp). Look at allocations time via +RTS -s or instructions using perf. * compile a particular files triggering the case I want to optimize In general: Adjust depending on flags you want to look at. If you optimize the simplifier -O0 will be useless. If you optimize type-checking -O2 will be pointless. And so on. In general I only compile as linking adds overhead which isn't really part of GHC. > Another question regarding performing compiler perf measurements > locally is which build flavour to use: So far I have used the "perf" > flavour. A problem here is that a full build seems to take close to an > hour. A rebuild with --freeze1 takes ~15 minutes on my machine. Is > this the right flavour to use? Personally I use the quick flavour, freeze stage 1 and configure hadrian to pass -O to stage2 unless I know the thing I'm working on will benefit significantly from -O2. That is if I optimize an algorithm -O2 won't really make a difference so I use -O. If I optimize a particular hotspot in the implementation of an algorithm by using bangs it's worthwhile to look at -O2 as well. You can also set particular flags for only specific files using OPTIONS_GHC pragmas. This way you can avoid compiling the whole of GHC with -O/-O2. > Ideally I wouldn't have to perform these measurements on my local > machine at all! Do you usually use a separate machine for this? _Very_ > convenient would be some kind of bot whom I could tell e.g. I use another machine. Others only look at metrics which are less affected by system load like allocations. > Ideally I wouldn't have to perform these measurements on my local > machine at all! Do you usually use a separate machine for this? _Very_ > convenient would be some kind of bot whom I could tell e.g. Various people have come up with scripts to automate the measurements on nofib which get's you closer to this. I discussed with ben and others a few times in the past having a wider framework for collecting compiler performance indicators. But it's a lot of work to get right and once the immediate need is gone those ideas usually get shelved again. > BTW what's the purpose of the profiled GHC modules built with this > flavour which just seem to additionally prolong compile time? I don't > see a ghc-prof binary or similar in _build/stage1/bin. As far as I know if you compile (non-ghc) code using -prof then you will need the ghc library available in the prof way. But it would be good to have the option to disable this. > Also, what's the status of gipeda? The most recent commit at > https://perf.haskell.org/ghc/ is from "about a year ago"? I think the author stopped maintaining it after he switched jobs. So it's currently not useful for investigating performance. But I'm sure he wouldn't object if anyone were to pick it up. Cheers Andreas -------------- next part -------------- An HTML attachment was scrubbed... URL: From simonpj at microsoft.com Mon Apr 6 10:18:44 2020 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Mon, 6 Apr 2020 10:18:44 +0000 Subject: Building libraries with an in-place GHC Message-ID: Devs I want to reproduce #18018, but that needs me to build pandoc with my freshly-built HEAD. I tried this (below) but as you can see that didn't work. What should I do? Thanks Simon bash$ cabal install --with-compiler=/home/simonpj/code/HEAD-3/inplace/bin/ghc-stage2 --package-db=/home/simonpj/code/HEAD-3/inplace/lib/package.conf.d pandoc-2.9.2.1 Resolving dependencies... cabal: Could not resolve dependencies: [__0] trying: pandoc-2.9.2.1 (user goal) [__1] trying: zlib-0.6.2.1 (dependency of pandoc) [__2] trying: base-4.14.0.0/installed-4.14.0.0 (dependency of zlib) [__3] next goal: haddock-library (dependency of pandoc) [__3] rejecting: haddock-library-1.8.0 (conflict: base==4.14.0.0/installed-4.14.0.0, haddock-library => base>=4.7 && <4.14) [__3] skipping: haddock-library-1.7.0, haddock-library-1.6.0, haddock-library-1.5.0.1, haddock-library-1.4.5, haddock-library-1.4.4, haddock-library-1.4.3, haddock-library-1.4.2, haddock-library-1.4.1, haddock-library-1.2.1, haddock-library-1.2.0, haddock-library-1.1.1, haddock-library-1.1.0, haddock-library-1.0.1, haddock-library-1.0.0, haddock-library-1.6.1 (has the same characteristics that caused the previous version to fail: excludes 'base' version 4.14.0.0) [__3] fail (backjumping, conflict set: base, haddock-library, pandoc) After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: pandoc, base, haddock-library, zlib Try running with --minimize-conflict-set to improve the error message. bash$ cabal --version cabal-install version 3.2.0.0 compiled using version 3.2.0.0 of the Cabal library -------------- next part -------------- An HTML attachment was scrubbed... URL: From ryan.gl.scott at gmail.com Mon Apr 6 12:28:08 2020 From: ryan.gl.scott at gmail.com (Ryan Scott) Date: Mon, 6 Apr 2020 08:28:08 -0400 Subject: Building libraries with an in-place GHC Message-ID: Hi Simon, As #18018 says, you need to use head.hackage to reproduce it. This page [1] contains a rather short tutorial on how to use it, but Ben is currently drafting a more detailed tutorial on its use here [2]. This is what I use whenever building any Hackage library with GHC HEAD. Ryan S. ----- [1] https://ghc.gitlab.haskell.org/head.hackage/ [2] https://gitlab.haskell.org/ghc/homepage/-/merge_requests/29 From mail at joachim-breitner.de Mon Apr 6 16:33:21 2020 From: mail at joachim-breitner.de (Joachim Breitner) Date: Mon, 06 Apr 2020 18:33:21 +0200 Subject: Measuring compiler performance In-Reply-To: References: Message-ID: <15beca57faf78ef616d35ded489f47050ecbaa8e.camel@joachim-breitner.de> Hi, Am Montag, den 06.04.2020, 11:03 +0200 schrieb Andreas Klebinger: > > Also, what's the status of gipeda? The most recent commit at > > https://perf.haskell.org/ghc/ is from "about a year ago"? > > > I think the author stopped maintaining it after he switched jobs. So > it's currently not useful > for investigating performance. I think a few things happened. For a while, the dedicated builder (which was a machine on Richard’s university) was down. Then there was a phase where data was collected and the page was generated, but somehow the upload to the web hosting stopped working. Ben started to work on running these things “more properly” as part of Circle CI (but that never finished). And then there is the ways of recording performance data via git notes, which maybe was meant to be fed into gipeda somehow? Somewhere in this confusion (and the fact that there wasn’t much complaining about the lack of this service) it fell off the table. > But I'm sure he wouldn't object if anyone were to pick it up. Definitey not! It seems that “the other” solutions didn’t materialize as quickly as we hoped for, so reactivating perf.haskell.org might be useful. Anybody willing to drive this? Happy to advise! Cheers, Joachim -- Joachim Breitner mail at joachim-breitner.de http://www.joachim-breitner.de/ From ben at well-typed.com Mon Apr 6 19:58:08 2020 From: ben at well-typed.com (Ben Gamari) Date: Mon, 06 Apr 2020 15:58:08 -0400 Subject: Measuring compiler performance In-Reply-To: References: Message-ID: <87imic9yk4.fsf@smart-cactus.org> Simon Jakobi via ghc-devs writes: > Hi devs! > Hi Simon! > I've recently started working on a few compiler perf related tickets, > and wondered how to verify that a change actually has a positive > impact on compiler performance. > > I first looked at the wiki for information on this, but didn't find much: > > https://gitlab.haskell.org/ghc/ghc/-/wikis/performance/compiler > doesn't contain any information on how to measure compiler performance > > The best tip I found was the recommendation in > https://gitlab.haskell.org/ghc/ghc/-/wikis/building/running-no-fib to > compile nofib/spectral/simple/Main.hs. With -O0 and -O that takes > respectively about 1.5s and 5s for me, so the effort is manageable. > I've also done full nofib runs, but they take a very long time. > As Joachim points out, progress on this proceeds in fits and starts. I have a number of pointers to share: * When performing compiler measurements myself I generally use a combination of the following: * nofib * the GHC performance testsuite * what I call the "Cabal test"; namely: $ _build/stage1/bin/ghc -O -ilibraries/Cabal/Cabal \ libraries/Cabal/Cabal/Setup.hs +RTS -s * My WIP nofib branch [1] makes nofib much faster and easier to work with and adds the ability to measure perf counters, in addition to the usual RTS and cachegrind statistics. * My nofib branch produces output in a uniform, easy to consume format and provides a tool for comparing sets of measurements in this format. * My ghc_perf tool [2] is very useful for extracting runtime and perf statistics from Haskell program runs; furthermore, it produces output in the same format as expected by the aforementioned nofib-compare utility. * I have a utility [3] which I use to reproducibly build a set of branches, run the testsuite, nofib, and the Cabal test on each of them. Admittedly it could use a bit of cleanup but it does its job reasonably well, making performance measurement a "set it and forget it" sort of task. * We collect and record a complete set of testsuite statistics (saved to git notes 43]); however, we currently do not import these into gipeda. * We don't currently have a box which can measure reliable timings (since our builders are nearly all virtualised cloud instances). I'm going to need to do some shuffling to change this. * One potentially useful source of performance information (which sadly we currently do not exploit) is the -ddump-timing output produced during head.hackage runs. [1] https://gitlab.haskell.org/ghc/nofib/merge_requests/24 [2] https://gitlab.haskell.org/bgamari/ghc-utils/blob/master/ghc_perf.py [3] https://gitlab.haskell.org/bgamari/ghc-utils/-/tree/master/build-all [4] https://gitlab.haskell.org/ghc/ghc/-/wikis/building/running-tests/performance-tests > A problem in this context is that reliable performance measurements > require a quiet machine. Closing my browser, and turning off other > programs is – in my perception – rather inconvenient, particularly > when I have to do it for a prolonged time. > > Ideally I wouldn't have to perform these measurements on my local > machine at all! Do you usually use a separate machine for this? _Very_ > convenient would be some kind of bot whom I could tell e.g. > Indeed it is inconvenient. I am in the lucky situation that I have another machine locally that can be made reasonably quiet without interfering with my worflow. However, in general > @perf-bot compiler perf > > …or more concretely > > @perf-bot compile nofib/spectral/simple/Main.hs > > …or just > > @nofib-bot run > > … or something like that. > > I've noticed that CI now includes a perf-nofib job. But since it > appears to run on a different machine each time, I'm not sure whether > it's actually useful for comparing performance. Could it be made more > useful by running it consistently on the same dedicated machine? > Indeed, we currently don't have a dedicated machine for timings. However, allocations and executable sizes are still useful. Nevertheless, as noted above I think that we should make more of an effort to measure time. I need to do some shuffling of our runners so we have a quiet bare-metal which can be dedicated to performance measurement. I'll try to get to this in the next day or so. > Another question regarding performing compiler perf measurements > locally is which build flavour to use: So far I have used the "perf" > flavour. A problem here is that a full build seems to take close to an > hour. A rebuild with --freeze1 takes ~15 minutes on my machine. Is > this the right flavour to use? > I think perf is the best option for performance measurement (afterall, we want to know what users would see). However, it is indeed a bit painful. > BTW what's the purpose of the profiled GHC modules built with this > flavour which just seem to additionally prolong compile time? I don't > see a ghc-prof binary or similar in _build/stage1/bin. > Indeed; there is little sense in building profiled modules just for performance measurement. However, I don't believe we currently have a build flavour which provides comparable optimisation but without the profiled way. Perhaps we should add one. > Also, what's the status of gipeda? The most recent commit at > https://perf.haskell.org/ghc/ is from "about a year ago"? > Indeed the machine which was previously providing gipeda builds is sadly no longer around; consequently it's on ice at the moment. I would like to get it going again but recently correctness issues have been taking up more time than I would like to admit. > Sorry for this load of questions and complaints! I do believe though > that if work on compiler performance was a bit better documented and > more convenient, we might see even more progress on that front. :) > Quite alright! Typing out the points above made me realize that there is indeed quite a bit of knowledge that the wiki leaves un-said. Cheers, - Ben -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From simonpj at microsoft.com Mon Apr 6 21:53:31 2020 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Mon, 6 Apr 2020 21:53:31 +0000 Subject: Fusing loops by specializing on functions with SpecConstr? In-Reply-To: References: <2E809F34-633F-4089-BEED-F38929F8BFD0@gmail.com> <296140F4-DCAC-4ACD-80F8-6F99B37C7316@gmail.com> <208D122C-E0E7-4B28-969B-19A792E358C5@gmail.com> Message-ID: Cool -- but please do write a blog post or something to distil what you have learned. I have not followed this thread in detail, and I bet others haven't either. But it'd be a pity for your learning not to be shared somehow! Thanks Simon | -----Original Message----- | From: ghc-devs On Behalf Of Alexis King | Sent: 04 April 2020 02:46 | To: Sebastian Graf | Cc: ghc-devs | Subject: Re: Fusing loops by specializing on functions with SpecConstr? | | | I fiddled with alternative representations for a while and didn’t make any | progress—it was too easy to end up with code explosion in the presence of | any unknown calls—but I seem to have found a RULES-based approach that | works very well on the examples I’ve tried. It’s quite simple, which makes | it especially appealing! | | I started by defining a wrapper around the `SF` constructor to attach | rules to: | | mkSF :: (a -> s -> Step s b) -> s -> SF a b | mkSF = SF | {-# INLINE CONLIKE [1] mkSF #-} | | I then changed the definitions of (.), (***), (&&&), (+++), and (&&&) to | use `mkSF` instead of `SF`, but I left the other methods alone, so they | just use `SF` directly. Then I defined two rewrite rules: | | {-# RULES | "mkSF @((), _)" forall f s. mkSF f ((), s) = | SF (\a s1 -> case f a ((), s1) of Step ((), s2) b -> Step s2 b) s | "mkSF @(_, ())" forall f s. mkSF f (s, ()) = | SF (\a s1 -> case f a (s1, ()) of Step (s2, ()) b -> Step s2 b) s | #-} | | That’s it. These two rules alone are enough to eliminate the redundant | tupling. Now the optimized version of `mapMaybeSF` is beautiful! | | mapMaybeSF = \ @ a @ b f -> case f of { SF @ s f2 s2 -> | SF (\ a1 s1 -> case a1 of { | Nothing -> case s1 of dt { __DEFAULT -> Step dt Nothing } | Just x -> case f2 x s1 of { | Step s2' c1 -> Step s2' (Just c1) }}) | s2 } | | So unless this breaks down in some larger situation I’m not aware of, I | think this solves my problem without the need for any fancy SpecConstr | shenanigans. Many thanks to you, Sebastian, for pointing me in the right | direction! | | Alexis | _______________________________________________ | ghc-devs mailing list | ghc-devs at haskell.org | https://nam06.safelinks.protection.outlook.com/?url=http%3A%2F%2Fmail.hask | ell.org%2Fcgi-bin%2Fmailman%2Flistinfo%2Fghc- | devs&data=02%7C01%7Csimonpj%40microsoft.com%7Cfa33485e4b3643e695fe08d7 | d839ecb9%7C72f988bf86f141af91ab2d7cd011db47%7C1%7C0%7C637215615608529596&a | mp;sdata=CSDPKcz%2BnVuQC%2BitP%2FZXpPpOtcTxUAfe0fxiNZAfTrs%3D&reserved | =0 From trupill at gmail.com Tue Apr 7 12:41:47 2020 From: trupill at gmail.com (Alejandro Serrano Mena) Date: Tue, 7 Apr 2020 14:41:47 +0200 Subject: Uppercase OverloadedLabels Message-ID: Dear Haskell-Café / GHC devs, Is there any reason why the `OverloadedHaskell` extension does not work with labels starting with an uppercase letter? Kind regards, Alejandro -------------- next part -------------- An HTML attachment was scrubbed... URL: From klebinger.andreas at gmx.at Wed Apr 8 08:19:23 2020 From: klebinger.andreas at gmx.at (Andreas Klebinger) Date: Wed, 8 Apr 2020 10:19:23 +0200 Subject: Targeting old Windows versions Message-ID: Hello devs, GHC is planning to use the Large Address Space mode of allocation for future releases on windows. See https://gitlab.haskell.org/ghc/ghc/issues/12576 This is a significant optimization for the GC and well tested as we use it on Linux already. However it will regress memory useage on versions of windows *older* than Windows 8.1/Sever 2012. Please let us know if you are targeting older versions than that either by responding to the mailing list, commenting on the ticket or contacting me directly if you have privacy concerns. Depending on how many people are affected by this change we might consider measures to reduce the impact. Cheers, Andreas From ryan.gl.scott at gmail.com Wed Apr 8 12:09:10 2020 From: ryan.gl.scott at gmail.com (Ryan Scott) Date: Wed, 8 Apr 2020 08:09:10 -0400 Subject: Uppercase OverloadedLabels Message-ID: No particular reason. There is an accepted GHC proposal to relax this restriction [1], as well as an accompanying GHC issue [2], but it has not yet been implemented. Ryan S. ----- [1] https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0170-unrestricted-overloadedlabels.rst [2] https://gitlab.haskell.org/ghc/ghc/issues/11671 -------------- next part -------------- An HTML attachment was scrubbed... URL: From simon.jakobi at googlemail.com Wed Apr 8 15:14:50 2020 From: simon.jakobi at googlemail.com (Simon Jakobi) Date: Wed, 8 Apr 2020 17:14:50 +0200 Subject: Measuring compiler performance In-Reply-To: <87imic9yk4.fsf@smart-cactus.org> References: <87imic9yk4.fsf@smart-cactus.org> Message-ID: Many thanks, Richard, Andreas, Joachim, and Ben, for your responses! I have a few things to try now. :) > * what I call the "Cabal test"; namely: > > $ _build/stage1/bin/ghc -O -ilibraries/Cabal/Cabal \ > libraries/Cabal/Cabal/Setup.hs +RTS -s Thanks for spelling it out like that, Ben! I'm slightly embarrassed to say that I hadn't been aware that I could use GHC directly in this way to build a package! Andreas, you wrote: > In general I only compile as linking adds overhead which isn't really part of GHC. How do I tell GHC to build e.g. nofib/spectral/simple/Main.hs or Cabal without linking? I'll eventually try to distill a wiki page from all this! Cheers, Simon > > * My WIP nofib branch [1] makes nofib much faster and easier to work > with and adds the ability to measure perf counters, in addition to > the usual RTS and cachegrind statistics. > > * My nofib branch produces output in a uniform, easy to consume format > and provides a tool for comparing sets of measurements in this format. > > * My ghc_perf tool [2] is very useful for extracting runtime and perf > statistics from Haskell program runs; furthermore, it produces output > in the same format as expected by the aforementioned nofib-compare > utility. > > * I have a utility [3] which I use to reproducibly build a set of > branches, run the testsuite, nofib, and the Cabal test on each of > them. Admittedly it could use a bit of cleanup but it does its job > reasonably well, making performance measurement a "set it and forget > it" sort of task. > > * We collect and record a complete set of testsuite statistics (saved > to git notes 43]); however, we currently do not import these into > gipeda. > > * We don't currently have a box which can measure reliable timings > (since our builders are nearly all virtualised cloud instances). I'm > going to need to do some shuffling to change this. > > * One potentially useful source of performance information (which sadly > we currently do not exploit) is the -ddump-timing output produced > during head.hackage runs. > > [1] https://gitlab.haskell.org/ghc/nofib/merge_requests/24 > [2] https://gitlab.haskell.org/bgamari/ghc-utils/blob/master/ghc_perf.py > [3] https://gitlab.haskell.org/bgamari/ghc-utils/-/tree/master/build-all > [4] https://gitlab.haskell.org/ghc/ghc/-/wikis/building/running-tests/performance-tests > > > > A problem in this context is that reliable performance measurements > > require a quiet machine. Closing my browser, and turning off other > > programs is – in my perception – rather inconvenient, particularly > > when I have to do it for a prolonged time. > > > > Ideally I wouldn't have to perform these measurements on my local > > machine at all! Do you usually use a separate machine for this? _Very_ > > convenient would be some kind of bot whom I could tell e.g. > > > > Indeed it is inconvenient. I am in the lucky situation that I have > another machine locally that can be made reasonably quiet without > interfering with my worflow. However, in general > > > @perf-bot compiler perf > > > > …or more concretely > > > > @perf-bot compile nofib/spectral/simple/Main.hs > > > > …or just > > > > @nofib-bot run > > > > … or something like that. > > > > I've noticed that CI now includes a perf-nofib job. But since it > > appears to run on a different machine each time, I'm not sure whether > > it's actually useful for comparing performance. Could it be made more > > useful by running it consistently on the same dedicated machine? > > > Indeed, we currently don't have a dedicated machine for timings. > However, allocations and executable sizes are still useful. > > Nevertheless, as noted above I think that we should make more of an > effort to measure time. I need to do some shuffling of our runners so we > have a quiet bare-metal which can be dedicated to performance > measurement. I'll try to get to this in the next day or so. > > > Another question regarding performing compiler perf measurements > > locally is which build flavour to use: So far I have used the "perf" > > flavour. A problem here is that a full build seems to take close to an > > hour. A rebuild with --freeze1 takes ~15 minutes on my machine. Is > > this the right flavour to use? > > > I think perf is the best option for performance measurement (afterall, > we want to know what users would see). However, it is indeed a bit > painful. > > > BTW what's the purpose of the profiled GHC modules built with this > > flavour which just seem to additionally prolong compile time? I don't > > see a ghc-prof binary or similar in _build/stage1/bin. > > > Indeed; there is little sense in building profiled modules just for > performance measurement. However, I don't believe we currently have a > build flavour which provides comparable optimisation but without the > profiled way. Perhaps we should add one. > > > Also, what's the status of gipeda? The most recent commit at > > https://perf.haskell.org/ghc/ is from "about a year ago"? > > > Indeed the machine which was previously providing gipeda builds is sadly > no longer around; consequently it's on ice at the moment. I would like > to get it going again but recently correctness issues have been taking > up more time than I would like to admit. > > > Sorry for this load of questions and complaints! I do believe though > > that if work on compiler performance was a bit better documented and > > more convenient, we might see even more progress on that front. :) > > > Quite alright! Typing out the points above made me realize that there is > indeed quite a bit of knowledge that the wiki leaves un-said. > > Cheers, > > - Ben > From matthewtpickering at gmail.com Wed Apr 8 15:21:02 2020 From: matthewtpickering at gmail.com (Matthew Pickering) Date: Wed, 8 Apr 2020 16:21:02 +0100 Subject: Measuring compiler performance In-Reply-To: References: <87imic9yk4.fsf@smart-cactus.org> Message-ID: Simon, I assume the `-no-link` flag does this. ``` > ghc --show-options | grep link -copy-libs-when-linking -no-link -no-auto-link-packages --print-c-compiler-link-flags ``` Cheers, Matt On Wed, Apr 8, 2020 at 4:15 PM Simon Jakobi via ghc-devs wrote: > > Many thanks, Richard, Andreas, Joachim, and Ben, for your responses! I > have a few things to try now. :) > > > * what I call the "Cabal test"; namely: > > > > $ _build/stage1/bin/ghc -O -ilibraries/Cabal/Cabal \ > > libraries/Cabal/Cabal/Setup.hs +RTS -s > > Thanks for spelling it out like that, Ben! I'm slightly embarrassed to > say that I hadn't been aware that I could use GHC directly in this way > to build a package! > > Andreas, you wrote: > > > In general I only compile as linking adds overhead which isn't really part of GHC. > > How do I tell GHC to build e.g. nofib/spectral/simple/Main.hs or Cabal > without linking? > > I'll eventually try to distill a wiki page from all this! > > Cheers, > Simon > > > > > > > > > * My WIP nofib branch [1] makes nofib much faster and easier to work > > with and adds the ability to measure perf counters, in addition to > > the usual RTS and cachegrind statistics. > > > > * My nofib branch produces output in a uniform, easy to consume format > > and provides a tool for comparing sets of measurements in this format. > > > > * My ghc_perf tool [2] is very useful for extracting runtime and perf > > statistics from Haskell program runs; furthermore, it produces output > > in the same format as expected by the aforementioned nofib-compare > > utility. > > > > * I have a utility [3] which I use to reproducibly build a set of > > branches, run the testsuite, nofib, and the Cabal test on each of > > them. Admittedly it could use a bit of cleanup but it does its job > > reasonably well, making performance measurement a "set it and forget > > it" sort of task. > > > > * We collect and record a complete set of testsuite statistics (saved > > to git notes 43]); however, we currently do not import these into > > gipeda. > > > > * We don't currently have a box which can measure reliable timings > > (since our builders are nearly all virtualised cloud instances). I'm > > going to need to do some shuffling to change this. > > > > * One potentially useful source of performance information (which sadly > > we currently do not exploit) is the -ddump-timing output produced > > during head.hackage runs. > > > > [1] https://gitlab.haskell.org/ghc/nofib/merge_requests/24 > > [2] https://gitlab.haskell.org/bgamari/ghc-utils/blob/master/ghc_perf.py > > [3] https://gitlab.haskell.org/bgamari/ghc-utils/-/tree/master/build-all > > [4] https://gitlab.haskell.org/ghc/ghc/-/wikis/building/running-tests/performance-tests > > > > > > > A problem in this context is that reliable performance measurements > > > require a quiet machine. Closing my browser, and turning off other > > > programs is – in my perception – rather inconvenient, particularly > > > when I have to do it for a prolonged time. > > > > > > Ideally I wouldn't have to perform these measurements on my local > > > machine at all! Do you usually use a separate machine for this? _Very_ > > > convenient would be some kind of bot whom I could tell e.g. > > > > > > > Indeed it is inconvenient. I am in the lucky situation that I have > > another machine locally that can be made reasonably quiet without > > interfering with my worflow. However, in general > > > > > @perf-bot compiler perf > > > > > > …or more concretely > > > > > > @perf-bot compile nofib/spectral/simple/Main.hs > > > > > > …or just > > > > > > @nofib-bot run > > > > > > … or something like that. > > > > > > I've noticed that CI now includes a perf-nofib job. But since it > > > appears to run on a different machine each time, I'm not sure whether > > > it's actually useful for comparing performance. Could it be made more > > > useful by running it consistently on the same dedicated machine? > > > > > Indeed, we currently don't have a dedicated machine for timings. > > However, allocations and executable sizes are still useful. > > > > Nevertheless, as noted above I think that we should make more of an > > effort to measure time. I need to do some shuffling of our runners so we > > have a quiet bare-metal which can be dedicated to performance > > measurement. I'll try to get to this in the next day or so. > > > > > Another question regarding performing compiler perf measurements > > > locally is which build flavour to use: So far I have used the "perf" > > > flavour. A problem here is that a full build seems to take close to an > > > hour. A rebuild with --freeze1 takes ~15 minutes on my machine. Is > > > this the right flavour to use? > > > > > I think perf is the best option for performance measurement (afterall, > > we want to know what users would see). However, it is indeed a bit > > painful. > > > > > BTW what's the purpose of the profiled GHC modules built with this > > > flavour which just seem to additionally prolong compile time? I don't > > > see a ghc-prof binary or similar in _build/stage1/bin. > > > > > Indeed; there is little sense in building profiled modules just for > > performance measurement. However, I don't believe we currently have a > > build flavour which provides comparable optimisation but without the > > profiled way. Perhaps we should add one. > > > > > Also, what's the status of gipeda? The most recent commit at > > > https://perf.haskell.org/ghc/ is from "about a year ago"? > > > > > Indeed the machine which was previously providing gipeda builds is sadly > > no longer around; consequently it's on ice at the moment. I would like > > to get it going again but recently correctness issues have been taking > > up more time than I would like to admit. > > > > > Sorry for this load of questions and complaints! I do believe though > > > that if work on compiler performance was a bit better documented and > > > more convenient, we might see even more progress on that front. :) > > > > > Quite alright! Typing out the points above made me realize that there is > > indeed quite a bit of knowledge that the wiki leaves un-said. > > > > Cheers, > > > > - Ben > > > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs From simon.jakobi at googlemail.com Wed Apr 8 15:34:30 2020 From: simon.jakobi at googlemail.com (Simon Jakobi) Date: Wed, 8 Apr 2020 17:34:30 +0200 Subject: Measuring compiler performance In-Reply-To: References: <87imic9yk4.fsf@smart-cactus.org> Message-ID: Thanks, Matt! That works! Am Mi., 8. Apr. 2020 um 17:21 Uhr schrieb Matthew Pickering : > > Simon, I assume the `-no-link` flag does this. > > ``` > > ghc --show-options | grep link > -copy-libs-when-linking > -no-link > -no-auto-link-packages > --print-c-compiler-link-flags > ``` > > Cheers, > > Matt > > On Wed, Apr 8, 2020 at 4:15 PM Simon Jakobi via ghc-devs > wrote: > > > > Many thanks, Richard, Andreas, Joachim, and Ben, for your responses! I > > have a few things to try now. :) > > > > > * what I call the "Cabal test"; namely: > > > > > > $ _build/stage1/bin/ghc -O -ilibraries/Cabal/Cabal \ > > > libraries/Cabal/Cabal/Setup.hs +RTS -s > > > > Thanks for spelling it out like that, Ben! I'm slightly embarrassed to > > say that I hadn't been aware that I could use GHC directly in this way > > to build a package! > > > > Andreas, you wrote: > > > > > In general I only compile as linking adds overhead which isn't really part of GHC. > > > > How do I tell GHC to build e.g. nofib/spectral/simple/Main.hs or Cabal > > without linking? > > > > I'll eventually try to distill a wiki page from all this! > > > > Cheers, > > Simon > > > > > > > > > > > > > > > > * My WIP nofib branch [1] makes nofib much faster and easier to work > > > with and adds the ability to measure perf counters, in addition to > > > the usual RTS and cachegrind statistics. > > > > > > * My nofib branch produces output in a uniform, easy to consume format > > > and provides a tool for comparing sets of measurements in this format. > > > > > > * My ghc_perf tool [2] is very useful for extracting runtime and perf > > > statistics from Haskell program runs; furthermore, it produces output > > > in the same format as expected by the aforementioned nofib-compare > > > utility. > > > > > > * I have a utility [3] which I use to reproducibly build a set of > > > branches, run the testsuite, nofib, and the Cabal test on each of > > > them. Admittedly it could use a bit of cleanup but it does its job > > > reasonably well, making performance measurement a "set it and forget > > > it" sort of task. > > > > > > * We collect and record a complete set of testsuite statistics (saved > > > to git notes 43]); however, we currently do not import these into > > > gipeda. > > > > > > * We don't currently have a box which can measure reliable timings > > > (since our builders are nearly all virtualised cloud instances). I'm > > > going to need to do some shuffling to change this. > > > > > > * One potentially useful source of performance information (which sadly > > > we currently do not exploit) is the -ddump-timing output produced > > > during head.hackage runs. > > > > > > [1] https://gitlab.haskell.org/ghc/nofib/merge_requests/24 > > > [2] https://gitlab.haskell.org/bgamari/ghc-utils/blob/master/ghc_perf.py > > > [3] https://gitlab.haskell.org/bgamari/ghc-utils/-/tree/master/build-all > > > [4] https://gitlab.haskell.org/ghc/ghc/-/wikis/building/running-tests/performance-tests > > > > > > > > > > A problem in this context is that reliable performance measurements > > > > require a quiet machine. Closing my browser, and turning off other > > > > programs is – in my perception – rather inconvenient, particularly > > > > when I have to do it for a prolonged time. > > > > > > > > Ideally I wouldn't have to perform these measurements on my local > > > > machine at all! Do you usually use a separate machine for this? _Very_ > > > > convenient would be some kind of bot whom I could tell e.g. > > > > > > > > > > Indeed it is inconvenient. I am in the lucky situation that I have > > > another machine locally that can be made reasonably quiet without > > > interfering with my worflow. However, in general > > > > > > > @perf-bot compiler perf > > > > > > > > …or more concretely > > > > > > > > @perf-bot compile nofib/spectral/simple/Main.hs > > > > > > > > …or just > > > > > > > > @nofib-bot run > > > > > > > > … or something like that. > > > > > > > > I've noticed that CI now includes a perf-nofib job. But since it > > > > appears to run on a different machine each time, I'm not sure whether > > > > it's actually useful for comparing performance. Could it be made more > > > > useful by running it consistently on the same dedicated machine? > > > > > > > Indeed, we currently don't have a dedicated machine for timings. > > > However, allocations and executable sizes are still useful. > > > > > > Nevertheless, as noted above I think that we should make more of an > > > effort to measure time. I need to do some shuffling of our runners so we > > > have a quiet bare-metal which can be dedicated to performance > > > measurement. I'll try to get to this in the next day or so. > > > > > > > Another question regarding performing compiler perf measurements > > > > locally is which build flavour to use: So far I have used the "perf" > > > > flavour. A problem here is that a full build seems to take close to an > > > > hour. A rebuild with --freeze1 takes ~15 minutes on my machine. Is > > > > this the right flavour to use? > > > > > > > I think perf is the best option for performance measurement (afterall, > > > we want to know what users would see). However, it is indeed a bit > > > painful. > > > > > > > BTW what's the purpose of the profiled GHC modules built with this > > > > flavour which just seem to additionally prolong compile time? I don't > > > > see a ghc-prof binary or similar in _build/stage1/bin. > > > > > > > Indeed; there is little sense in building profiled modules just for > > > performance measurement. However, I don't believe we currently have a > > > build flavour which provides comparable optimisation but without the > > > profiled way. Perhaps we should add one. > > > > > > > Also, what's the status of gipeda? The most recent commit at > > > > https://perf.haskell.org/ghc/ is from "about a year ago"? > > > > > > > Indeed the machine which was previously providing gipeda builds is sadly > > > no longer around; consequently it's on ice at the moment. I would like > > > to get it going again but recently correctness issues have been taking > > > up more time than I would like to admit. > > > > > > > Sorry for this load of questions and complaints! I do believe though > > > > that if work on compiler performance was a bit better documented and > > > > more convenient, we might see even more progress on that front. :) > > > > > > > Quite alright! Typing out the points above made me realize that there is > > > indeed quite a bit of knowledge that the wiki leaves un-said. > > > > > > Cheers, > > > > > > - Ben > > > > > _______________________________________________ > > ghc-devs mailing list > > ghc-devs at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs From simonpj at microsoft.com Thu Apr 9 10:01:05 2020 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Thu, 9 Apr 2020 10:01:05 +0000 Subject: Safe primops Message-ID: Andreas, Simon, and other back-end-knowledgeable devs Can I draw your attention to this question? https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3011#note_264584 It's about identifying which primops execute in-line without GC, and without thread-switching. Thanks Simon -------------- next part -------------- An HTML attachment was scrubbed... URL: From chessai1996 at gmail.com Thu Apr 9 19:57:06 2020 From: chessai1996 at gmail.com (chessai .) Date: Thu, 9 Apr 2020 12:57:06 -0700 Subject: scavenge_one failures on BCO objects Message-ID: Hi devs, A coworker is experiencing sporadic failures when reloading our project in GHCi, with ``` ghc: internal error: scavenge_one: strange object 23 (GHC version 8.6.5 for x86_64_unknown_linux) Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug cabal: repl failed for mercury-web-backend-0.0.0. The build process terminated with exit code -6 ``` upon a quick inspection it seems that scavenge_one inspects the type of the object, but has no case for BCO (which is 23). I'm guessing there's something weird going on here since this doesn't happen deterministically. I don't have a good intuition for how this scavenging should work for BCO's, or if it should even be possible for BCO's to appear here (i.e. this is a symptom of some other bug). Any thoughts? Thanks From ben at smart-cactus.org Fri Apr 10 02:45:24 2020 From: ben at smart-cactus.org (Ben Gamari) Date: Thu, 09 Apr 2020 22:45:24 -0400 Subject: hadrian.settings recipes Message-ID: <878sj49hz4.fsf@smart-cactus.org> Hi everyone, As you may know, Hadrian's analogue to the make build system's mk/build.mk is hadrian.settings file. While the new mechanism is quite flexible, I often find myself having to look up recipes from previous builds to accomplish common tasks. To try to improve this situation I've started collecting the snippets I need most often on the Wiki [1]. I would invite anyone else who has something to add to do so. Cheers, - Ben [1] https://gitlab.haskell.org/ghc/ghc/-/wikis/building/hadrian#hadriansettings -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From omeragacan at gmail.com Fri Apr 10 05:59:05 2020 From: omeragacan at gmail.com (=?UTF-8?Q?=C3=96mer_Sinan_A=C4=9Facan?=) Date: Fri, 10 Apr 2020 08:59:05 +0300 Subject: scavenge_one failures on BCO objects In-Reply-To: References: Message-ID: Hey chessai, Two comments: - A segfault/runtime panic happening in GC does not mean there's a GC bug. You can easily cause heap corruption with FFI or using unsafe primops, and it's possible for those to cause a crash during GC. - 8.6.5 is quite old, and we've fixed a few GC bugs since that version [1, 2, 3]. [3] is shipped with 8.10, others are only in HEAD currently. So if possible it'd be good to run your program with 8.10, or even better, GHC HEAD, and see if the problem persists. You may want to use head.hackage [4] to make it easier to build your project with GHC HEAD. Hope that helps, Ömer [1]: https://gitlab.haskell.org/ghc/ghc/-/commit/390751768104cd3d2cb57e2037062916476ebd10 [2]: https://gitlab.haskell.org/ghc/ghc/-/commit/cfcc3c9a1f2e4e33bed4c40767f8e7971e331c15 [3]: https://gitlab.haskell.org/ghc/ghc/-/commit/0e57d8a106a61cac11bacb43633b8b4af12d7fdb [4]: http://ghc.gitlab.haskell.org/head.hackage/ chessai . , 9 Nis 2020 Per, 22:57 tarihinde şunu yazdı: > > Hi devs, > > A coworker is experiencing sporadic failures when reloading our > project in GHCi, with > > ``` > ghc: internal error: scavenge_one: strange object 23 > (GHC version 8.6.5 for x86_64_unknown_linux) > Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug > cabal: repl failed for mercury-web-backend-0.0.0. The build process terminated > with exit code -6 > ``` > > upon a quick inspection it seems that scavenge_one inspects the type > of the object, but has no case for BCO (which is 23). I'm guessing > there's something weird going on here since this doesn't happen > deterministically. > > I don't have a good intuition for how this scavenging should work for > BCO's, or if it should even be possible for BCO's to appear here (i.e. > this is a symptom of some other bug). > > Any thoughts? > > Thanks > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs From simonpj at microsoft.com Mon Apr 13 11:00:08 2020 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Mon, 13 Apr 2020 11:00:08 +0000 Subject: HsTick and HsBinTick Message-ID: Friends I think HsTick and HsBinTick are added (only) by GHC.HsToCore.Coverage So I think the cannot occur in HsExpr GhcPs or HcExpr GhcRn If so we should change the data type decl to say this explicitly. Can anyone confirm or deny and add a ticket if so? Simon -------------- next part -------------- An HTML attachment was scrubbed... URL: From krz.gogolewski at gmail.com Mon Apr 13 16:50:14 2020 From: krz.gogolewski at gmail.com (Krzysztof Gogolewski) Date: Mon, 13 Apr 2020 18:50:14 +0200 Subject: HsTick and HsBinTick In-Reply-To: References: Message-ID: I confirm. I added this in the description of https://gitlab.haskell.org/ghc/ghc/issues/16830. Krzysztof On Mon, Apr 13, 2020 at 1:00 PM Simon Peyton Jones via ghc-devs < ghc-devs at haskell.org> wrote: > Friends > > I think HsTick and HsBinTick are added (only) by GHC.HsToCore.Coverage > > So I think the cannot occur in HsExpr GhcPs or HcExpr GhcRn > > If so we should change the data type decl to say this explicitly. > > Can anyone confirm or deny and add a ticket if so? > > Simon > > > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ben at well-typed.com Mon Apr 13 17:51:42 2020 From: ben at well-typed.com (Ben Gamari) Date: Mon, 13 Apr 2020 13:51:42 -0400 Subject: keepAlive# primop In-Reply-To: <04361b3f-4323-7610-1bc1-9a6a90abec2b@haskus.fr> References: <04361b3f-4323-7610-1bc1-9a6a90abec2b@haskus.fr> Message-ID: <875ze39suw.fsf@smart-cactus.org> Ccing ghc-devs@ since this discussion is something of general interest to the community. Sylvain Henry writes: > Simon, Ben, > > I've been reading and thinking about `readRW#` issues which are very > related to issues we have with `keepAlive#` primop. > > To recap, the problem is that we want some transformations (that Simon > has listed in [1]) to consider: > > ``` > case runRW# f of ... > > case keepAlive# k a of ... > ``` > > as if they were really: > > ``` > case f realWorld# of ... > > case a of ... > ``` > > BUT without breaking the semantics of runRW# and keepAlive#. > > I have been thinking about a solution that I have described on the wiki: > https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/with-combinator#option-e-tag-core-case-expression-with-kept-alive-variables > > The idea is to keep a set of variable names in each Core case-expression > that are kept alive during the evaluation of the scrutinee. > > I think it would work very nicely with your `newState#` primop described > in [2], both for `runST` and for `unsafeDupablePerformIO` (details on > the wiki). > > It requires a little more upfront work to adapt the code involving > case-expressions. But it will force us to review all transformations to > check if they are sound when keep-alive sets are not empty, which we > would have to do anyway if we implemented another option. We could start > by disabling transformations involving non-empty keep-alive sets and > iterate to enable the sound ones. > > I would like your opinions on the approach. I may have totally missed > something. Thanks for writing this down! Indeed it is an interesting idea. However, as expressed on IRC, I wonder whether this problem rises to the level where it warrants an adaptation to our Core representation. It feels a bit like the tail is wagging the dog here, especially given how the "tail" here merely exists to support FFI. That being said, this is one of the few options which remain on the table that doesn't require changes to user code. Moreover, the applicability to runRW# is quite intriguing. Another (admittedly, more ad-hoc) option that would avoid modifying Core would be to teach the simplifier about the class of "continuation-passing" primops (e.g. `keepAlive#` and `runRW#`), allowing it to push case analyses into the continuation argument. That is, case keepAlive# x expr of pat -> rhs ~> keepAlive# x (case expr of pat -> rhs) Of course, doing this is a bit tricky since one must rewrite the application of keepAlive# to ensure that the resulting application is well-typed. Admittedly, this doesn't help the runRW# case (although this could presumably be accommodated by touch#'ing the final state token in the runRW# desugaring emitted by CorePrep). On the whole, I'm not a fan of this ad-hoc option. It increases the complexity of the simplifier all to support a single operation. By comparison, the Core extension looks somewhat appealing. Cheers, - Ben [1] https://gitlab.haskell.org/ghc/ghc/-/wikis/proposal/with-combinator#option-e-tag-core-case-expression-with-kept-alive-variables P.S. A minor note: the keepAlive# "pseudo-instruction" mentioned on the Wiki [1] is precisely the touch# operation we have today. -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From matthewtpickering at gmail.com Tue Apr 14 07:44:17 2020 From: matthewtpickering at gmail.com (Matthew Pickering) Date: Tue, 14 Apr 2020 08:44:17 +0100 Subject: HsTick and HsBinTick In-Reply-To: References: Message-ID: FWIW, I fixed some code paths (locally) in the compiler before to not panic when using the `HsTick` constructor as I wanted to generate some code using Template Haskell which contained source notes. This was useful for me for debugging a big explosion in code generation size. On Mon, Apr 13, 2020 at 5:50 PM Krzysztof Gogolewski wrote: > > I confirm. I added this in the description of https://gitlab.haskell.org/ghc/ghc/issues/16830. > Krzysztof > > On Mon, Apr 13, 2020 at 1:00 PM Simon Peyton Jones via ghc-devs wrote: >> >> Friends >> >> I think HsTick and HsBinTick are added (only) by GHC.HsToCore.Coverage >> >> So I think the cannot occur in HsExpr GhcPs or HcExpr GhcRn >> >> If so we should change the data type decl to say this explicitly. >> >> Can anyone confirm or deny and add a ticket if so? >> >> Simon >> >> >> >> _______________________________________________ >> ghc-devs mailing list >> ghc-devs at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs > > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs From simonpj at microsoft.com Tue Apr 14 13:48:08 2020 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Tue, 14 Apr 2020 13:48:08 +0000 Subject: TcTypeNats Message-ID: Sylvain TcTypeNats still exists in compiler/typecheck/ An omission? Simon -------------- next part -------------- An HTML attachment was scrubbed... URL: From sylvain at haskus.fr Tue Apr 14 13:53:14 2020 From: sylvain at haskus.fr (Sylvain Henry) Date: Tue, 14 Apr 2020 15:53:14 +0200 Subject: TcTypeNats In-Reply-To: References: Message-ID: <66a1ea52-2473-8a24-6dbb-8bebddeb14f6@haskus.fr> Hi Simon, Not an omission, it will be moved into GHC.Builtin.Types.Literals with the next renaming MR (!3072). It is only imported by PrelInfo and GHC.IfaceToCore Sylvain On 14/04/2020 15:48, Simon Peyton Jones wrote: > > Sylvain > > TcTypeNats still exists in compiler/typecheck/ > > An omission? > > Simon > -------------- next part -------------- An HTML attachment was scrubbed... URL: From omeragacan at gmail.com Wed Apr 15 09:35:12 2020 From: omeragacan at gmail.com (=?UTF-8?Q?=C3=96mer_Sinan_A=C4=9Facan?=) Date: Wed, 15 Apr 2020 12:35:12 +0300 Subject: Object unloading confusion Message-ID: Hi Simon, I'm looking at object unloading code in CheckUnload.c. My understanding of how unloading works is: - When unloading of an object is requested the object is added to `unloaded_objects`. - When `unloaded_objects` is not empty, after GC, we scan the heap for any references to objects. This is done in `searchHeapBlocks` called by `checkUnload`. - When `searchHeapBlocks` finds a reference to an object code it marks the object code. - After scanning the heap any objects in `unloaded_objects` that are not marked are unloaded. Does this sound right so far? What I'm confused about is `searchHeapBlocks`. As far as I can see it just skips all objects other than stacks. For example here's the code for scanning a constructor: case CONSTR: case CONSTR_NOCAF: case CONSTR_1_0: case CONSTR_0_1: case CONSTR_1_1: case CONSTR_0_2: case CONSTR_2_0: size = sizeW_fromITBL(info); break; So if I see a constructor with a reference to an object code in its payload I'll not mark the object code. This looks wrong to me. I don't understand why we only care about stacks and nothing else. Could you comment on this? Thanks, Ömer From omeragacan at gmail.com Wed Apr 15 12:05:51 2020 From: omeragacan at gmail.com (=?UTF-8?Q?=C3=96mer_Sinan_A=C4=9Facan?=) Date: Wed, 15 Apr 2020 15:05:51 +0300 Subject: Object unloading confusion In-Reply-To: References: Message-ID: To answer my own question > So if I see a constructor with a reference to an object code in its payload > I'll not mark the object code. We don't visit payload as objects pointed from the payload will be visited during the scan later (or they're already visited if they come before the constructor in a block). The 'prim' variable in that code is still a little bit confusing. For example we never check an MVAR for whether it's an unloadable object or not: case MVAR_CLEAN: case MVAR_DIRTY: prim = true; size = sizeW_fromITBL(info); break; ... if (!prim) { checkAddress(addrs,info, s_indices); } Would be good to know why it's fine to not check MVARs and other kinds of objects that we skip in that code. Ömer Ömer Sinan Ağacan , 15 Nis 2020 Çar, 12:35 tarihinde şunu yazdı: > > Hi Simon, > > I'm looking at object unloading code in CheckUnload.c. My understanding of how > unloading works is: > > - When unloading of an object is requested the object is added to > `unloaded_objects`. > - When `unloaded_objects` is not empty, after GC, we scan the heap for any > references to objects. This is done in `searchHeapBlocks` called by > `checkUnload`. > - When `searchHeapBlocks` finds a reference to an object code it marks the > object code. > - After scanning the heap any objects in `unloaded_objects` that are not marked > are unloaded. > > Does this sound right so far? > > What I'm confused about is `searchHeapBlocks`. As far as I can see it just skips > all objects other than stacks. For example here's the code for scanning a > constructor: > > case CONSTR: > case CONSTR_NOCAF: > case CONSTR_1_0: > case CONSTR_0_1: > case CONSTR_1_1: > case CONSTR_0_2: > case CONSTR_2_0: > size = sizeW_fromITBL(info); > break; > > So if I see a constructor with a reference to an object code in its payload I'll > not mark the object code. This looks wrong to me. I don't understand why we only > care about stacks and nothing else. Could you comment on this? > > Thanks, > > Ömer From simonpj at microsoft.com Thu Apr 16 09:26:07 2020 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Thu, 16 Apr 2020 09:26:07 +0000 Subject: T13456 Message-ID: Ben, Omer I find that when running the testsuite, I get the garbage below, for ghci/should_run/T13456. Adding an empty file T13456.stderr seems to fix it in one of my trees, but not in another. Very strange. Any ideas? Simon Framework failures: T13456.run T13456 [Traceback (most recent call last): File "/home/simonpj/code/HEAD-1/testsuite/driver/testlib.py", line 996, in test_common_work do_test(name, way, func, args, files) File "/home/simonpj/code/HEAD-1/testsuite/driver/testlib.py", line 1094, in do_test result = func(*[name,way] + args) File "/home/simonpj/code/HEAD-1/testsuite/driver/testlib.py", line 1213, in ghci_script return simple_run( name, way, cmd, getTestOpts().extra_run_opts ) File "/home/simonpj/code/HEAD-1/testsuite/driver/testlib.py", line 1638, in simple_run stderr=read_stderr(name), File "/home/simonpj/code/HEAD-1/testsuite/driver/testlib.py", line 1808, in read_stderr return in_testdir(name, 'run.stderr').read_text(encoding='UTF-8') File "/usr/lib/python3.6/pathlib.py", line 1196, in read_text with self.open(mode='r', encoding=encoding, errors=errors) as f: File "/usr/lib/python3.6/pathlib.py", line 1183, in open opener=self._opener) File "/usr/lib/python3.6/pathlib.py", line 1037, in _opener return self._accessor.open(self, flags, mode) File "/usr/lib/python3.6/pathlib.py", line 387, in wrapped return strfunc(str(pathobj), *args) FileNotFoundError: [Errno 2] No such file or directory: 'T13456.run/T13456.run.stderr' ] (ghci) -------------- next part -------------- An HTML attachment was scrubbed... URL: From marlowsd at gmail.com Thu Apr 16 11:58:41 2020 From: marlowsd at gmail.com (Simon Marlow) Date: Thu, 16 Apr 2020 12:58:41 +0100 Subject: Object unloading confusion In-Reply-To: References: Message-ID: Hi Omer The point of the heap scan is to find *info pointers* into objects that we want to unload, since we can't unload those. What about static object pointers? Well, those would be found by traversing the static_objects list, which we also do in checkUnload. Except that static_objects doesn't contain all the static objects - that's one of the problems identified by this ticket. Primitive objects can't have an info pointer into a dynamically loaded object, because all their info pointers point into the RTS. Hope that helps! Simon On Wed, 15 Apr 2020 at 13:06, Ömer Sinan Ağacan wrote: > To answer my own question > > > So if I see a constructor with a reference to an object code in its > payload > > I'll not mark the object code. > > We don't visit payload as objects pointed from the payload will be visited > during the scan later (or they're already visited if they come before the > constructor in a block). > > The 'prim' variable in that code is still a little bit confusing. For > example we > never check an MVAR for whether it's an unloadable object or not: > > case MVAR_CLEAN: > case MVAR_DIRTY: > prim = true; > size = sizeW_fromITBL(info); > break; > > ... > > if (!prim) { > checkAddress(addrs,info, s_indices); > } > > Would be good to know why it's fine to not check MVARs and other kinds of > objects that we skip in that code. > > Ömer > > Ömer Sinan Ağacan , 15 Nis 2020 Çar, 12:35 > tarihinde şunu yazdı: > > > > Hi Simon, > > > > I'm looking at object unloading code in CheckUnload.c. My understanding > of how > > unloading works is: > > > > - When unloading of an object is requested the object is added to > > `unloaded_objects`. > > - When `unloaded_objects` is not empty, after GC, we scan the heap for > any > > references to objects. This is done in `searchHeapBlocks` called by > > `checkUnload`. > > - When `searchHeapBlocks` finds a reference to an object code it marks > the > > object code. > > - After scanning the heap any objects in `unloaded_objects` that are not > marked > > are unloaded. > > > > Does this sound right so far? > > > > What I'm confused about is `searchHeapBlocks`. As far as I can see it > just skips > > all objects other than stacks. For example here's the code for scanning a > > constructor: > > > > case CONSTR: > > case CONSTR_NOCAF: > > case CONSTR_1_0: > > case CONSTR_0_1: > > case CONSTR_1_1: > > case CONSTR_0_2: > > case CONSTR_2_0: > > size = sizeW_fromITBL(info); > > break; > > > > So if I see a constructor with a reference to an object code in its > payload I'll > > not mark the object code. This looks wrong to me. I don't understand why > we only > > care about stacks and nothing else. Could you comment on this? > > > > Thanks, > > > > Ömer > -------------- next part -------------- An HTML attachment was scrubbed... URL: From wolfgang-it at jeltsch.info Thu Apr 16 14:38:24 2020 From: wolfgang-it at jeltsch.info (Wolfgang Jeltsch) Date: Thu, 16 Apr 2020 17:38:24 +0300 Subject: GHC documentation outdated Message-ID: <75be77ef8a945063247b7140dea7e13a6dfb34f4.camel@jeltsch.info> Hi! the URL https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/index.html seems to still point to the GHC 8.8.3 documentation. All the best, Wolfgang From svenpanne at gmail.com Thu Apr 16 15:08:11 2020 From: svenpanne at gmail.com (Sven Panne) Date: Thu, 16 Apr 2020 17:08:11 +0200 Subject: GHC documentation outdated In-Reply-To: <75be77ef8a945063247b7140dea7e13a6dfb34f4.camel@jeltsch.info> References: <75be77ef8a945063247b7140dea7e13a6dfb34f4.camel@jeltsch.info> Message-ID: Am Do., 16. Apr. 2020 um 16:38 Uhr schrieb Wolfgang Jeltsch < wolfgang-it at jeltsch.info>: > the URL > > > https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/index.html > > seems to still point to the GHC 8.8.3 documentation. > Even worse: http://hackage.haskell.org/package/base has only documentation for base up to 8.6.x (from Sep 2018, 2 major releases behind), which makes a devastating first impression for newcomers and/or people I'm trying to convince about Haskell. :-( -------------- next part -------------- An HTML attachment was scrubbed... URL: From simonpj at microsoft.com Mon Apr 20 12:00:12 2020 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Mon, 20 Apr 2020 12:00:12 +0000 Subject: T13456 Message-ID: I'm getting this failure (below) from validate fairly consistently. It is often silenced by adding an empty file ghci/should_run/T13456.stderr But it's troubling. Does anyone else see this? How can I debug it? Thanks Simon Framework failures: /tmp/ghctest-31oxzmog/test spaces/ghci/should_run/T13456.run T13456 [Traceback (most recent call last): File "/home/simonpj/code/HEAD-1/testsuite/driver/testlib.py", line 996, in test_common_work do_test(name, way, func, args, files) File "/home/simonpj/code/HEAD-1/testsuite/driver/testlib.py", line 1094, in do_test result = func(*[name,way] + args) File "/home/simonpj/code/HEAD-1/testsuite/driver/testlib.py", line 1213, in ghci_script return simple_run( name, way, cmd, getTestOpts().extra_run_opts ) File "/home/simonpj/code/HEAD-1/testsuite/driver/testlib.py", line 1638, in simple_run stderr=read_stderr(name), File "/home/simonpj/code/HEAD-1/testsuite/driver/testlib.py", line 1808, in read_stderr return in_testdir(name, 'run.stderr').read_text(encoding='UTF-8') File "/usr/lib/python3.6/pathlib.py", line 1196, in read_text with self.open(mode='r', encoding=encoding, errors=errors) as f: File "/usr/lib/python3.6/pathlib.py", line 1183, in open opener=self._opener) File "/usr/lib/python3.6/pathlib.py", line 1037, in _opener return self._accessor.open(self, flags, mode) File "/usr/lib/python3.6/pathlib.py", line 387, in wrapped return strfunc(str(pathobj), *args) FileNotFoundError: [Errno 2] No such file or directory: '/tmp/ghctest-31oxzmog/test spaces/ghci/should_run/T13456.run/T13456.run.stderr' ] (ghci) -------------- next part -------------- An HTML attachment was scrubbed... URL: From ben at well-typed.com Mon Apr 20 17:56:47 2020 From: ben at well-typed.com (Ben Gamari) Date: Mon, 20 Apr 2020 13:56:47 -0400 Subject: T13456 In-Reply-To: References: Message-ID: <87sggy82i8.fsf@smart-cactus.org> Simon Peyton Jones via ghc-devs writes: > I'm getting this failure (below) from validate fairly consistently. > It is often silenced by adding an empty file ghci/should_run/T13456.stderr > But it's troubling. Does anyone else see this? How can I debug it? > Indeed this is odd. I have not seen this in CI or my local builds. It's possible that I have seen it in local builds that were failing for other reasons but ignored it. While I don't know why you are seeing these failures in general, the fact that they are reported as framework failures is arguably a bug. I would argue that we should treat a non-existing .stderr file as we would an empty file. I've opened !3121 fixing this. Hopefully you will see a more helpful error message with this patch. Cheers, - Ben -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From ben at smart-cactus.org Mon Apr 20 19:27:15 2020 From: ben at smart-cactus.org (Ben Gamari) Date: Mon, 20 Apr 2020 15:27:15 -0400 Subject: GHC documentation outdated In-Reply-To: <75be77ef8a945063247b7140dea7e13a6dfb34f4.camel@jeltsch.info> References: <75be77ef8a945063247b7140dea7e13a6dfb34f4.camel@jeltsch.info> Message-ID: <87pnc27yb6.fsf@smart-cactus.org> Wolfgang Jeltsch writes: > Hi! > > the URL > > https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/index.html > > seems to still point to the GHC 8.8.3 documentation. Thanks for the ping! Symlink bumped. Cheers, - Ben -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From ben at smart-cactus.org Mon Apr 20 19:28:30 2020 From: ben at smart-cactus.org (Ben Gamari) Date: Mon, 20 Apr 2020 15:28:30 -0400 Subject: GHC documentation outdated In-Reply-To: References: Message-ID: <87mu767y91.fsf@smart-cactus.org> Sven Panne writes: > Am Do., 16. Apr. 2020 um 16:38 Uhr schrieb Wolfgang Jeltsch < > wolfgang-it at jeltsch.info>: > >> the URL >> >> >> https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/index.html >> >> seems to still point to the GHC 8.8.3 documentation. >> > > Even worse: http://hackage.haskell.org/package/base has only documentation > for base up to 8.6.x (from Sep 2018, 2 major releases behind), which makes > a devastating first impression for newcomers and/or people I'm trying to > convince about Haskell. :-( Indeed, this is a sad state of affairs. I wish I had some magic solution here but sadly there is real work that needs to happen [1] to fix this. Cheers, - Ben [1] https://github.com/haskell/hackage-server/issues/852 -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From omeragacan at gmail.com Tue Apr 21 10:37:38 2020 From: omeragacan at gmail.com (=?UTF-8?Q?=C3=96mer_Sinan_A=C4=9Facan?=) Date: Tue, 21 Apr 2020 13:37:38 +0300 Subject: Recompilation avoidance questions Message-ID: Hi all, I'm currently reading the "recompilation avoidance" wiki page [1], and I have a few questions about the current design. The wiki page says (in the paragraph "Suppose the change to D ...") if a module B re-exports x from module D, changing x in D does not cause any changes in B's interface. I'm wondering why this is the case. To me this doesn't make sense. Anything that can potentially effect users of B should be a part of B's interface. This includes re-exports. I don't understand why there is a difference between normal exports and re-exports. As far as users of the module concerned there's no difference. So I'd expect any changes in re-exports to make a difference in B's interface. The wiki page says (in "Why not do (1)", where (1) refers to making D.x part of B's interface) that this is because sometimes changes in D.x should not cause recompiling B's users. I don't understand why (1) would cause this problem. If we make x a part of B, as if it's defined in B, similar to how we can avoid recompilation of users of B when a definition of B changes but the interface is the same, we could avoid recompiling users when D.x changes. For example, -- B.hs module B where b = 123123 -- Main.hs import B main = print b $ ghc-stage1 Main.hs [1 of 2] Compiling B ( B.hs, B.o ) [2 of 2] Compiling Main ( Main.hs, Main.o ) Linking Main ... Now if I update B and recompile I'll only link Main, won't recompile it: -- B.hs module B where b = 123123 + 12308 $ ghc-stage1 Main.hs [1 of 2] Compiling B ( B.hs, B.o ) Linking Main ... Now suppose B.b was a re-export from D. I don't understand why changing it in D would cause recompiling Main if we make b a part of B's interface. I think what would happen is: because D's interface hash won't change we won't recompile B. No problems at all. Finally, I'm a bit confused about this part > To ensure that A is recompiled, we therefore have two options: > ... > (2) arrange to touch B.hi and C.hi even if they haven't changed. I don't understand how touching is relevant, as far as I understand touching can't force recompilation. Example: $ ghc-stage1 Main.hs [1 of 3] Compiling A ( A.hs, A.o ) [2 of 3] Compiling B ( B.hs, B.o ) [3 of 3] Compiling Main ( Main.hs, Main.o ) Linking Main ... $ touch A.hi $ ghc-stage1 Main.hs $ touch B.hi $ ghc-stage1 Main.hs Am I missing anything? Thanks, Ömer [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/recompilation-avoidance From marlowsd at gmail.com Wed Apr 22 09:02:22 2020 From: marlowsd at gmail.com (Simon Marlow) Date: Wed, 22 Apr 2020 10:02:22 +0100 Subject: Recompilation avoidance questions In-Reply-To: References: Message-ID: On Tue, 21 Apr 2020 at 11:38, Ömer Sinan Ağacan wrote: > Hi all, > > I'm currently reading the "recompilation avoidance" wiki page [1], and I > have a > few questions about the current design. > > The wiki page says (in the paragraph "Suppose the change to D ...") if a > module > B re-exports x from module D, changing x in D does not cause any changes > in B's > interface. > > I'm wondering why this is the case. To me this doesn't make sense. > Anything that > can potentially effect users of B should be a part of B's interface. This > includes re-exports. I don't understand why there is a difference between > normal > exports and re-exports. As far as users of the module concerned there's no > difference. So I'd expect any changes in re-exports to make a difference > in B's > interface. > Yes, that's already the case. Under "Deciding whether to recompile", we say: * If anything else has changed in a way that would affect the results of compiling this module, we must recompile. so that's the basic requirement. We don't want to include the *definitions* of things that are re-exported, because that would bloat interface files a lot. Consider that an interface would have to contain the unfoldings for every exported identifier, and the unfoldings of anything referred to by those unfoldings, and so on. Imagine the size of Prelude.hi! (historical note: it did work this way a long time ago, I think GHC 2.x was when it changed) The wiki page says (in "Why not do (1)", where (1) refers to making D.x > part of > B's interface) here (1) refers to 1. arrange that make knows about the dependency of A on D. which is not the same as making D.x part of B's interface. This section of the wiki page is about "make", incidentally. > that this is because sometimes changes in D.x should not cause > recompiling B's users. I don't understand why (1) would cause this > problem. If > we make x a part of B, as if it's defined in B, similar to how we can avoid > recompilation of users of B when a definition of B changes but the > interface is > the same, we could avoid recompiling users when D.x changes. > > For example, > > -- B.hs > module B where > > b = 123123 > > -- Main.hs > import B > > main = print b > > > $ ghc-stage1 Main.hs > [1 of 2] Compiling B ( B.hs, B.o ) > [2 of 2] Compiling Main ( Main.hs, Main.o ) > Linking Main ... > > Now if I update B and recompile I'll only link Main, won't recompile it: > > -- B.hs > module B where > > b = 123123 + 12308 > > $ ghc-stage1 Main.hs > [1 of 2] Compiling B ( B.hs, B.o ) > Linking Main ... > > Now suppose B.b was a re-export from D. I don't understand why changing it > in D > would cause recompiling Main if we make b a part of B's interface. I think > what > would happen is: because D's interface hash won't change we won't > recompile B. > No problems at all. > I think this all stems from the confusion above. > > Finally, I'm a bit confused about this part > > > To ensure that A is recompiled, we therefore have two options: > > ... > > (2) arrange to touch B.hi and C.hi even if they haven't changed. > > I don't understand how touching is relevant, as far as I understand > touching > can't force recompilation. Example: > > $ ghc-stage1 Main.hs > [1 of 3] Compiling A ( A.hs, A.o ) > [2 of 3] Compiling B ( B.hs, B.o ) > [3 of 3] Compiling Main ( Main.hs, Main.o ) > Linking Main ... > $ touch A.hi > $ ghc-stage1 Main.hs > $ touch B.hi > $ ghc-stage1 Main.hs > > Am I missing anything? > Touching is relevant to "make" only, not ghc --make. Under " Why do we need recompilation avoidance?" there are two sections: "GHCi and --make" and "make", but the formatting doesn't make the structure very clear here. Perhaps this got worse when we migrated to gitlab?. Maybe adding an outline would help make the structure clearer? Cheers Simon > > Thanks, > > Ömer > > [1]: > https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/recompilation-avoidance > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs > -------------- next part -------------- An HTML attachment was scrubbed... URL: From omeragacan at gmail.com Thu Apr 23 07:56:35 2020 From: omeragacan at gmail.com (=?UTF-8?Q?=C3=96mer_Sinan_A=C4=9Facan?=) Date: Thu, 23 Apr 2020 10:56:35 +0300 Subject: "Extensible interface files" work and ANN pragmas Message-ID: The "extensible interface files" [1, 2] work has been discussed at GHC calls a few times and the conclusion was we were going to document why current annotation mechanism (ANN pragmas) are insufficient and we need yet another way to put stuff into interfaces. Unfortunately the MR was merged before that's done and so it's currently undocumented and it's still unclear what's insufficient about ANN pragmas or how the new mechanism differs. I'm currently working on an interface files related patch (#16885) so I have to maintain both of these features now. It'd be good to know why both is necessary. If ANN is no longer useful or needed could we deprecate it in favor of the new mechanism and remove it in a few releases? That's help maintaining the code in the future. Could people involved in this design and patch please document the thought process here? Thanks, Ömer [1]: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/2948 [2]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Extensible-Interface-Files From matthewtpickering at gmail.com Thu Apr 23 08:06:19 2020 From: matthewtpickering at gmail.com (Matthew Pickering) Date: Thu, 23 Apr 2020 09:06:19 +0100 Subject: "Extensible interface files" work and ANN pragmas In-Reply-To: References: Message-ID: I also looked at this patch briefly now and it's my understanding that the intention is to use this for HIE files as well? HIE files currently serialises Names differently to normal interface files (to also include the SrcSpan) and it wasn't clear to me that the current implementation would allow for this. Zubin/Josh could you please comment? Otherwise looks like a nice patch. Cheers, Matt On Thu, Apr 23, 2020 at 8:57 AM Ömer Sinan Ağacan wrote: > > The "extensible interface files" [1, 2] work has been discussed at GHC calls a > few times and the conclusion was we were going to document why current > annotation mechanism (ANN pragmas) are insufficient and we need yet another way > to put stuff into interfaces. > > Unfortunately the MR was merged before that's done and so it's currently > undocumented and it's still unclear what's insufficient about ANN pragmas or how > the new mechanism differs. > > I'm currently working on an interface files related patch (#16885) so I have to > maintain both of these features now. It'd be good to know why both is necessary. > If ANN is no longer useful or needed could we deprecate it in favor of the new > mechanism and remove it in a few releases? That's help maintaining the code in > the future. > > Could people involved in this design and patch please document the thought > process here? > > Thanks, > > Ömer > > [1]: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/2948 > [2]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Extensible-Interface-Files > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs From omeragacan at gmail.com Thu Apr 23 08:17:11 2020 From: omeragacan at gmail.com (=?UTF-8?Q?=C3=96mer_Sinan_A=C4=9Facan?=) Date: Thu, 23 Apr 2020 11:17:11 +0300 Subject: Recompilation avoidance questions In-Reply-To: References: Message-ID: Thanks Simon, > We don't want to include the *definitions* of things that are re-exported, > because that would bloat interface files a lot. I think by definition you mean unfoldings, pragmas, annotations, and rules, right? I'm a bit surprised by this, because this would require tracking transitive dependencies, which is opposite of what we want to do in #16885. If M1 re-exports something from M2 and M0 imports M1 then I think we could consider M2 a direct import, but that complicates the story a little bit. I think we don't have to track *all* transitive deps though, only tracking re-export paths should be enough. So maybe this is not too bad. Ömer Simon Marlow , 22 Nis 2020 Çar, 12:02 tarihinde şunu yazdı: > > On Tue, 21 Apr 2020 at 11:38, Ömer Sinan Ağacan wrote: >> >> Hi all, >> >> I'm currently reading the "recompilation avoidance" wiki page [1], and I have a >> few questions about the current design. >> >> The wiki page says (in the paragraph "Suppose the change to D ...") if a module >> B re-exports x from module D, changing x in D does not cause any changes in B's >> interface. >> >> I'm wondering why this is the case. To me this doesn't make sense. Anything that >> can potentially effect users of B should be a part of B's interface. This >> includes re-exports. I don't understand why there is a difference between normal >> exports and re-exports. As far as users of the module concerned there's no >> difference. So I'd expect any changes in re-exports to make a difference in B's >> interface. > > > Yes, that's already the case. Under "Deciding whether to recompile", we say: > > * If anything else has changed in a way that would affect the results of compiling this module, we must recompile. > > so that's the basic requirement. > > We don't want to include the *definitions* of things that are re-exported, because that would bloat interface files a lot. Consider that an interface would have to contain the unfoldings for every exported identifier, and the unfoldings of anything referred to by those unfoldings, and so on. Imagine the size of Prelude.hi! (historical note: it did work this way a long time ago, I think GHC 2.x was when it changed) > >> The wiki page says (in "Why not do (1)", where (1) refers to making D.x part of >> B's interface) > > > here (1) refers to > > 1. arrange that make knows about the dependency of A on D. > > which is not the same as making D.x part of B's interface. > > This section of the wiki page is about "make", incidentally. > >> >> that this is because sometimes changes in D.x should not cause >> recompiling B's users. I don't understand why (1) would cause this problem. If >> we make x a part of B, as if it's defined in B, similar to how we can avoid >> recompilation of users of B when a definition of B changes but the interface is >> the same, we could avoid recompiling users when D.x changes. >> >> For example, >> >> -- B.hs >> module B where >> >> b = 123123 >> >> -- Main.hs >> import B >> >> main = print b >> >> >> $ ghc-stage1 Main.hs >> [1 of 2] Compiling B ( B.hs, B.o ) >> [2 of 2] Compiling Main ( Main.hs, Main.o ) >> Linking Main ... >> >> Now if I update B and recompile I'll only link Main, won't recompile it: >> >> -- B.hs >> module B where >> >> b = 123123 + 12308 >> >> $ ghc-stage1 Main.hs >> [1 of 2] Compiling B ( B.hs, B.o ) >> Linking Main ... >> >> Now suppose B.b was a re-export from D. I don't understand why changing it in D >> would cause recompiling Main if we make b a part of B's interface. I think what >> would happen is: because D's interface hash won't change we won't recompile B. >> No problems at all. > > > I think this all stems from the confusion above. > >> >> >> Finally, I'm a bit confused about this part >> >> > To ensure that A is recompiled, we therefore have two options: >> > ... >> > (2) arrange to touch B.hi and C.hi even if they haven't changed. >> >> I don't understand how touching is relevant, as far as I understand touching >> can't force recompilation. Example: >> >> $ ghc-stage1 Main.hs >> [1 of 3] Compiling A ( A.hs, A.o ) >> [2 of 3] Compiling B ( B.hs, B.o ) >> [3 of 3] Compiling Main ( Main.hs, Main.o ) >> Linking Main ... >> $ touch A.hi >> $ ghc-stage1 Main.hs >> $ touch B.hi >> $ ghc-stage1 Main.hs >> >> Am I missing anything? > > > Touching is relevant to "make" only, not ghc --make. Under " Why do we need recompilation avoidance?" there are two sections: "GHCi and --make" and "make", but the formatting doesn't make the structure very clear here. Perhaps this got worse when we migrated to gitlab?. Maybe adding an outline would help make the structure clearer? > > Cheers > Simon > >> >> >> Thanks, >> >> Ömer >> >> [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/recompilation-avoidance >> _______________________________________________ >> ghc-devs mailing list >> ghc-devs at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs From sylvain at haskus.fr Thu Apr 23 10:20:23 2020 From: sylvain at haskus.fr (Sylvain Henry) Date: Thu, 23 Apr 2020 12:20:23 +0200 Subject: Spam projects on gitlab Message-ID: Hi, I've just noticed these spam projects on our gitlab: - https://gitlab.haskell.org/craigonaldson/lumaslim - https://gitlab.haskell.org/AnthonyMussen/survey-of-evianne-cream - https://gitlab.haskell.org/RobertoHeard/robertoheard - https://gitlab.haskell.org/salihagenter/commission-based-business-in-india Can someone remove them? Thanks, Sylvain From zubin.duggal at gmail.com Thu Apr 23 10:25:28 2020 From: zubin.duggal at gmail.com (Zubin Duggal) Date: Thu, 23 Apr 2020 15:55:28 +0530 Subject: "Extensible interface files" work and ANN pragmas In-Reply-To: References: Message-ID: <20200423102528.5vf5vfwizen2gcv2@zubin-msi> Yes, Matthew is correct, the symbol table for Names used by HIE files is quite distinct from the usual Iface symbol table for Names. Sharing the HIE symbol table and the Iface symbol table for names will be quite tricky. One crucial difference is that we also save information about local names to the symbol table for HIE files. Here is how names are stored in the HIE symbol table: data HieName = ExternalName !Module !OccName !SrcSpan | LocalName !OccName !SrcSpan | KnownKeyName !Unique And the usual symbol table(KnownKeyNames are implicitly handled as a separate case): type OnDiskName = (UnitId, ModuleName, OccName) So the merge of HIE and HI files will have to be careful about preserving these semantics. For instance, the `Binary` instances for HIE file data structures use putName_, which will have the wrong semantics after this merge. We could possibly get around this by having ExtensibleFields be allowed to override the UserData field of the BinHandle. Thanks to Matthew for bringing this up this important point. - Zubin On 20/04/23 09:06, Matthew Pickering wrote: > I also looked at this patch briefly now and it's my understanding that > the intention is to use this for HIE files as well? > > HIE files currently serialises Names differently to normal interface > files (to also include the SrcSpan) and it wasn't clear to me that the > current implementation would allow for this. > > Zubin/Josh could you please comment? > > Otherwise looks like a nice patch. > > Cheers, > > Matt > > On Thu, Apr 23, 2020 at 8:57 AM Ömer Sinan Ağacan wrote: > > > > The "extensible interface files" [1, 2] work has been discussed at GHC calls a > > few times and the conclusion was we were going to document why current > > annotation mechanism (ANN pragmas) are insufficient and we need yet another way > > to put stuff into interfaces. > > > > Unfortunately the MR was merged before that's done and so it's currently > > undocumented and it's still unclear what's insufficient about ANN pragmas or how > > the new mechanism differs. > > > > I'm currently working on an interface files related patch (#16885) so I have to > > maintain both of these features now. It'd be good to know why both is necessary. > > If ANN is no longer useful or needed could we deprecate it in favor of the new > > mechanism and remove it in a few releases? That's help maintaining the code in > > the future. > > > > Could people involved in this design and patch please document the thought > > process here? > > > > Thanks, > > > > Ömer > > > > [1]: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/2948 > > [2]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Extensible-Interface-Files > > _______________________________________________ > > ghc-devs mailing list > > ghc-devs at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs From marlowsd at gmail.com Thu Apr 23 12:55:23 2020 From: marlowsd at gmail.com (Simon Marlow) Date: Thu, 23 Apr 2020 13:55:23 +0100 Subject: Recompilation avoidance questions In-Reply-To: References: Message-ID: On Thu, 23 Apr 2020 at 09:17, Ömer Sinan Ağacan wrote: > Thanks Simon, > > > We don't want to include the *definitions* of things that are > re-exported, > > because that would bloat interface files a lot. > > I think by definition you mean unfoldings, pragmas, annotations, and rules, > right? > And the types of bindings, and the definitions of types. Everything that is not the name, basically. > I'm a bit surprised by this, because this would require tracking transitive > dependencies, which is opposite of what we want to do in #16885. > Not really. It's just a tradeoff between copying all the definitions (recursively) of things we need into the current module vs. leaving the definitions in the interface of the original module where the entity was defined. Even if we were to copy the definitions of things we depend on into the current module's interface, we still have to know where they came from, and to know when the original definition changes so that we can recompile. So I don't think there would be any difference in which modules we have to list in the current module's interface file usage list. Note: the "usages" in the interface file is different from the "dependencies". We're not proposing to change how "usages" work. The difference is explained in https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/recompilation-avoidance#deciding-whether-to-recompile If M1 re-exports something from M2 and M0 imports M1 then I think we could > consider M2 a direct import, but that complicates the story a little bit. I > think we don't have to track *all* transitive deps though, only tracking > re-export paths should be enough. So maybe this is not too bad. > I think we already arrived at a reasonable design on #16885, what do you think of it? Also, David already listed all the places that would potentially need to change if we no longer include transitive dependencies in `dep_mods`: https://gitlab.haskell.org/ghc/ghc/issues/16885#note_215715 And a useful summary of the background is https://gitlab.haskell.org/ghc/ghc/-/merge_requests/931#note_208414 There was some subsequent discussion on #16885 about how to handle boot modules, and a proposal to fix that. Aside from that, the idea is to just remove transitive dependencies from `dep_mods` and fix up the places that used it, which David listed in that comment. Cheers Simon > > Ömer > > Simon Marlow , 22 Nis 2020 Çar, 12:02 tarihinde şunu > yazdı: > > > > On Tue, 21 Apr 2020 at 11:38, Ömer Sinan Ağacan > wrote: > >> > >> Hi all, > >> > >> I'm currently reading the "recompilation avoidance" wiki page [1], and > I have a > >> few questions about the current design. > >> > >> The wiki page says (in the paragraph "Suppose the change to D ...") if > a module > >> B re-exports x from module D, changing x in D does not cause any > changes in B's > >> interface. > >> > >> I'm wondering why this is the case. To me this doesn't make sense. > Anything that > >> can potentially effect users of B should be a part of B's interface. > This > >> includes re-exports. I don't understand why there is a difference > between normal > >> exports and re-exports. As far as users of the module concerned there's > no > >> difference. So I'd expect any changes in re-exports to make a > difference in B's > >> interface. > > > > > > Yes, that's already the case. Under "Deciding whether to recompile", we > say: > > > > * If anything else has changed in a way that would affect the results of > compiling this module, we must recompile. > > > > so that's the basic requirement. > > > > We don't want to include the *definitions* of things that are > re-exported, because that would bloat interface files a lot. Consider that > an interface would have to contain the unfoldings for every exported > identifier, and the unfoldings of anything referred to by those unfoldings, > and so on. Imagine the size of Prelude.hi! (historical note: it did work > this way a long time ago, I think GHC 2.x was when it changed) > > > >> The wiki page says (in "Why not do (1)", where (1) refers to making D.x > part of > >> B's interface) > > > > > > here (1) refers to > > > > 1. arrange that make knows about the dependency of A on D. > > > > which is not the same as making D.x part of B's interface. > > > > This section of the wiki page is about "make", incidentally. > > > >> > >> that this is because sometimes changes in D.x should not cause > >> recompiling B's users. I don't understand why (1) would cause this > problem. If > >> we make x a part of B, as if it's defined in B, similar to how we can > avoid > >> recompilation of users of B when a definition of B changes but the > interface is > >> the same, we could avoid recompiling users when D.x changes. > >> > >> For example, > >> > >> -- B.hs > >> module B where > >> > >> b = 123123 > >> > >> -- Main.hs > >> import B > >> > >> main = print b > >> > >> > >> $ ghc-stage1 Main.hs > >> [1 of 2] Compiling B ( B.hs, B.o ) > >> [2 of 2] Compiling Main ( Main.hs, Main.o ) > >> Linking Main ... > >> > >> Now if I update B and recompile I'll only link Main, won't recompile it: > >> > >> -- B.hs > >> module B where > >> > >> b = 123123 + 12308 > >> > >> $ ghc-stage1 Main.hs > >> [1 of 2] Compiling B ( B.hs, B.o ) > >> Linking Main ... > >> > >> Now suppose B.b was a re-export from D. I don't understand why changing > it in D > >> would cause recompiling Main if we make b a part of B's interface. I > think what > >> would happen is: because D's interface hash won't change we won't > recompile B. > >> No problems at all. > > > > > > I think this all stems from the confusion above. > > > >> > >> > >> Finally, I'm a bit confused about this part > >> > >> > To ensure that A is recompiled, we therefore have two options: > >> > ... > >> > (2) arrange to touch B.hi and C.hi even if they haven't changed. > >> > >> I don't understand how touching is relevant, as far as I understand > touching > >> can't force recompilation. Example: > >> > >> $ ghc-stage1 Main.hs > >> [1 of 3] Compiling A ( A.hs, A.o ) > >> [2 of 3] Compiling B ( B.hs, B.o ) > >> [3 of 3] Compiling Main ( Main.hs, Main.o ) > >> Linking Main ... > >> $ touch A.hi > >> $ ghc-stage1 Main.hs > >> $ touch B.hi > >> $ ghc-stage1 Main.hs > >> > >> Am I missing anything? > > > > > > Touching is relevant to "make" only, not ghc --make. Under " Why do we > need recompilation avoidance?" there are two sections: "GHCi and --make" > and "make", but the formatting doesn't make the structure very clear here. > Perhaps this got worse when we migrated to gitlab?. Maybe adding an outline > would help make the structure clearer? > > > > Cheers > > Simon > > > >> > >> > >> Thanks, > >> > >> Ömer > >> > >> [1]: > https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/recompilation-avoidance > >> _______________________________________________ > >> ghc-devs mailing list > >> ghc-devs at haskell.org > >> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs > -------------- next part -------------- An HTML attachment was scrubbed... URL: From matthewtpickering at gmail.com Thu Apr 23 15:25:25 2020 From: matthewtpickering at gmail.com (Matthew Pickering) Date: Thu, 23 Apr 2020 16:25:25 +0100 Subject: "Extensible interface files" work and ANN pragmas In-Reply-To: References: <20200423102528.5vf5vfwizen2gcv2@zubin-msi> Message-ID: Hi Josh, I don't think this addresses the points mine or Zubin's email that is it not correct to write a HIE file with a different BinHandle. If you do this then you will end up with a HIE file which contains Names which don't contain any SrcSpan information. If I am misunderstanding then please forgive me. Cheers, Matt On Thu, Apr 23, 2020 at 4:06 PM Josh Meredith wrote: > > Since the current HIE serialisation function writes to a BinHandle, which it initialises itself, the simple way to implement the HIE field would be to change the handle to an argument: > > writeHieFile :: FilePath -> HieFile -> IO () > writeHieFile hie_file_path hiefile = do > bh0 <- openBinMem initBinMemSize > -- Actual serialisation work > > becomes > > writeHieFile :: FilePath -> HieFile -> IO () > writeHieFile hie_file_path hiefile = do > bh0 <- openBinMem initBinMemSize > writeHie hiefile bh0 > > writeHie :: HieFile -> BinHandle -> IO () > writeHie hiefile bh = do > -- Actual serialisation work > > Then the existing discrete file can continue to use writeHieFile, and the field can reuse the existing implementation via writeHie: > > writeIfaceFieldWith :: FieldName -> (BinHandle -> IO ()) -> ModIface -> IO ModIface > > writeHieField :: HieFile -> ModIface -> IO ModIface > writeHieField hiefile iface = writeIfaceFieldWith "ghc/hie" (writeHie hiefile) iface > > I hope this clarifies how I intend these more edge cases to work? > > Cheers, > Josh > > > On Thu, 23 Apr 2020 at 20:25, Zubin Duggal wrote: >> >> Yes, Matthew is correct, the symbol table for Names used by HIE files is >> quite distinct from the usual Iface symbol table for Names. Sharing the HIE >> symbol table and the Iface symbol table for names will be quite tricky. >> >> One crucial difference is that we also save information about local names >> to the symbol table for HIE files. >> >> Here is how names are stored in the HIE symbol table: >> >> data HieName >> = ExternalName !Module !OccName !SrcSpan >> | LocalName !OccName !SrcSpan >> | KnownKeyName !Unique >> >> And the usual symbol table(KnownKeyNames are implicitly handled as a separate case): >> >> type OnDiskName = (UnitId, ModuleName, OccName) >> >> So the merge of HIE and HI files will have to be careful about preserving these >> semantics. For instance, the `Binary` instances for HIE file data structures use >> putName_, which will have the wrong semantics after this merge. We could possibly >> get around this by having ExtensibleFields be allowed to override the UserData >> field of the BinHandle. >> >> Thanks to Matthew for bringing this up this important point. >> >> - Zubin >> >> On 20/04/23 09:06, Matthew Pickering wrote: >> > I also looked at this patch briefly now and it's my understanding that >> > the intention is to use this for HIE files as well? >> > >> > HIE files currently serialises Names differently to normal interface >> > files (to also include the SrcSpan) and it wasn't clear to me that the >> > current implementation would allow for this. >> > >> > Zubin/Josh could you please comment? >> > >> > Otherwise looks like a nice patch. >> > >> > Cheers, >> > >> > Matt >> > >> > On Thu, Apr 23, 2020 at 8:57 AM Ömer Sinan Ağacan wrote: >> > > >> > > The "extensible interface files" [1, 2] work has been discussed at GHC calls a >> > > few times and the conclusion was we were going to document why current >> > > annotation mechanism (ANN pragmas) are insufficient and we need yet another way >> > > to put stuff into interfaces. >> > > >> > > Unfortunately the MR was merged before that's done and so it's currently >> > > undocumented and it's still unclear what's insufficient about ANN pragmas or how >> > > the new mechanism differs. >> > > >> > > I'm currently working on an interface files related patch (#16885) so I have to >> > > maintain both of these features now. It'd be good to know why both is necessary. >> > > If ANN is no longer useful or needed could we deprecate it in favor of the new >> > > mechanism and remove it in a few releases? That's help maintaining the code in >> > > the future. >> > > >> > > Could people involved in this design and patch please document the thought >> > > process here? >> > > >> > > Thanks, >> > > >> > > Ömer >> > > >> > > [1]: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/2948 >> > > [2]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Extensible-Interface-Files >> > > _______________________________________________ >> > > ghc-devs mailing list >> > > ghc-devs at haskell.org >> > > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs From ben at well-typed.com Fri Apr 24 01:42:19 2020 From: ben at well-typed.com (Ben Gamari) Date: Thu, 23 Apr 2020 21:42:19 -0400 Subject: Demand signature grammar Message-ID: <875zdp7j83.fsf@smart-cactus.org> Hello everyone, I routinely find myself having to dig through the Outputable instances in Demand.Types to decipher our joint demand signature syntax. Tonight I finally broke down and extracted a BNF-like grammar summarizing the syntax. It can be found on the Wiki [1]. I hope it is helpful for others as well. Cheers, - Ben [1] https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/demand -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From simonpj at microsoft.com Fri Apr 24 09:24:05 2020 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Fri, 24 Apr 2020 09:24:05 +0000 Subject: Demand signature grammar In-Reply-To: <875zdp7j83.fsf@smart-cactus.org> References: <875zdp7j83.fsf@smart-cactus.org> Message-ID: Great thanks! There is also https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/strictness-analysis and a couple of sub-pages, as you'll see in the index. It'd be good if they were somehow connected together? Simon | -----Original Message----- | From: ghc-devs On Behalf Of Ben Gamari | Sent: 24 April 2020 02:42 | To: GHC developers | Subject: Demand signature grammar | | Hello everyone, | | I routinely find myself having to dig through the Outputable instances | in Demand.Types to decipher our joint demand signature syntax. Tonight I | finally broke down and extracted a BNF-like grammar summarizing the | syntax. It can be found on the Wiki [1]. I hope it is helpful for others | as well. | | Cheers, | | - Ben | | | [1] | https://nam06.safelinks.protection.outlook.com/?url=https%3A%2F%2Fgitlab.h | askell.org%2Fghc%2Fghc%2F- | %2Fwikis%2Fcommentary%2Fcompiler%2Fdemand&data=02%7C01%7Csimonpj%40mic | rosoft.com%7C275ae65931c64c4744f608d7e7f0c80a%7C72f988bf86f141af91ab2d7cd0 | 11db47%7C1%7C0%7C637232893656322382&sdata=49DnYTodrydvbrRQSGwy4AY85o3w | X4sFhM1uH9lewxQ%3D&reserved=0 From lexi.lambda at gmail.com Sun Apr 26 01:40:00 2020 From: lexi.lambda at gmail.com (Alexis King) Date: Sat, 25 Apr 2020 20:40:00 -0500 Subject: Desugaring matches with already-desugared RHSs? Message-ID: <019EC9D0-6788-4DE2-8C07-62BB6436FE02@gmail.com> Hi all, I’m currently in the process of rewriting most of the arrow desugaring code. One of the most awkward parts of the current implementation is the way case commands are desugared. Given a case command like case e1 of A a b -> cmd1 B c -> cmd2 C d e f -> cmd3 the desugarer actually replaces each command on the RHS with an Either-wrapped tuple to get something like this: arr (\env -> case e1 of A a b -> Left (Left (a, b)) B c -> Left (Right c) C d e f -> Right (d, e, f)) >>> ((cmd1 ||| cmd2) ||| cmd3) This means the RHSs of the case expression are really already desugared, and ideally they would be CoreExprs, but matchWrapper expects the RHSs to be HsExprs. The current implementation accommodates this restriction by building fake HsExprs with no location information, but this means the logic for building the tuples in the RHSs has to be duplicated (since other places do want CoreExprs). I was thinking it would be nice to avoid this hack, but I’m not sure what the best way to do it is. One way would be to create a variant of matchWrapper with a type like matchWrapper' :: HsMatchContext GhcRn -> Maybe (LHsExpr GhcTc) -> MatchGroup GhcTc rhs -> (rhs -> DsM CoreExpr) -- how to desugar the RHSs -> DsM ([Id], CoreExpr) and update dsGRHSs to accept an extra argument as well. Then the arrow desugaring code could just pass `return` to matchWrapper' so it wouldn’t touch its RHSs. But I’m not sure if this approach makes sense — nothing else in the desugarer seems to work this way. Is there a better approach I’m not seeing? Thanks, Alexis From ben at smart-cactus.org Sun Apr 26 15:27:37 2020 From: ben at smart-cactus.org (Ben Gamari) Date: Sun, 26 Apr 2020 11:27:37 -0400 Subject: Spam projects on gitlab In-Reply-To: References: Message-ID: <87ftcq5kt5.fsf@smart-cactus.org> Sylvain Henry writes: > Hi, > > I've just noticed these spam projects on our gitlab: > > - https://gitlab.haskell.org/craigonaldson/lumaslim > - https://gitlab.haskell.org/AnthonyMussen/survey-of-evianne-cream > - https://gitlab.haskell.org/RobertoHeard/robertoheard > - https://gitlab.haskell.org/salihagenter/commission-based-business-in-india > > Can someone remove them? > Thanks for mentioning these, Sylvain! I've removed them. Cheers, - Ben -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From simonpj at microsoft.com Mon Apr 27 09:04:02 2020 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Mon, 27 Apr 2020 09:04:02 +0000 Subject: Desugaring matches with already-desugared RHSs? In-Reply-To: <019EC9D0-6788-4DE2-8C07-62BB6436FE02@gmail.com> References: <019EC9D0-6788-4DE2-8C07-62BB6436FE02@gmail.com> Message-ID: Alexis We have data MatchGroup p body = MG { mg_ext :: XMG p body -- Post-typechecker, types of args and result , mg_alts :: Located [LMatch p body] -- The alternatives , mg_origin :: Origin } explicitly parameterised over 'body'. And we use that parameterisation: | HsLam (XLam p) (MatchGroup p (LHsExpr p)) | HsCmdLam (XCmdLam id) (MatchGroup id (LHsCmd id)) -- kappa So it makes perfect sense to me that the desugarer for MatchGroup should be parameterised with a function for desugaring 'body'. (Let's be consistent about whether we use 'rhs' or 'body' for this parmemeterisation.) TL;DR: Yes, what you suggest sounds sensible to me. Simon | -----Original Message----- | From: ghc-devs On Behalf Of Alexis King | Sent: 26 April 2020 02:40 | To: ghc-devs | Subject: Desugaring matches with already-desugared RHSs? | | Hi all, | | I’m currently in the process of rewriting most of the arrow desugaring | code. One of the most awkward parts of the current implementation is | the way case commands are desugared. Given a case command like | | case e1 of | A a b -> cmd1 | B c -> cmd2 | C d e f -> cmd3 | | the desugarer actually replaces each command on the RHS with an | Either-wrapped tuple to get something like this: | | arr (\env -> case e1 of | A a b -> Left (Left (a, b)) | B c -> Left (Right c) | C d e f -> Right (d, e, f)) | >>> ((cmd1 ||| cmd2) ||| cmd3) | | This means the RHSs of the case expression are really already | desugared, and ideally they would be CoreExprs, but matchWrapper | expects the RHSs to be HsExprs. The current implementation | accommodates this restriction by building fake HsExprs with no | location information, but this means the logic for building the tuples | in the RHSs has to be duplicated (since other places do want | CoreExprs). | | I was thinking it would be nice to avoid this hack, but I’m not sure | what the best way to do it is. One way would be to create a variant of | matchWrapper with a type like | | matchWrapper' | :: HsMatchContext GhcRn | -> Maybe (LHsExpr GhcTc) | -> MatchGroup GhcTc rhs | -> (rhs -> DsM CoreExpr) -- how to desugar the RHSs | -> DsM ([Id], CoreExpr) | | and update dsGRHSs to accept an extra argument as well. Then the arrow | desugaring code could just pass `return` to matchWrapper' so it | wouldn’t touch its RHSs. But I’m not sure if this approach makes sense | — nothing else in the desugarer seems to work this way. Is there a | better approach I’m not seeing? | | Thanks, | Alexis | _______________________________________________ | ghc-devs mailing list | ghc-devs at haskell.org | https://nam06.safelinks.protection.outlook.com/?url=http%3A%2F%2Fmail.has | kell.org%2Fcgi-bin%2Fmailman%2Flistinfo%2Fghc- | devs&data=02%7C01%7Csimonpj%40microsoft.com%7C4a68eaa5bad44aef3cdc08d | 7e982ca00%7C72f988bf86f141af91ab2d7cd011db47%7C1%7C0%7C637234620252546061 | &sdata=98tG%2FVS91GWHX4xqIulr7h6H%2Fl%2F2VIDwYmSOAke%2BZ0w%3D&res | erved=0 From lexi.lambda at gmail.com Mon Apr 27 19:29:19 2020 From: lexi.lambda at gmail.com (Alexis King) Date: Mon, 27 Apr 2020 14:29:19 -0500 Subject: =?utf-8?Q?Why_doesn=E2=80=99t_the_simple_optimizer_fuse_casts=3F?= Message-ID: <7612B5A4-626C-457E-B747-38520D42BF2C@gmail.com> This question is spurred by curiosity more than anything else, but I’ve noticed that the simple optimizer doesn’t fuse nested casts, and I’m wondering if there’s any reason it couldn’t. To make what I’m talking about more concrete, suppose we have an expression like this: (x |> co) |> sym co It seems like it would be trivial for simpleOptExpr to fuse the nested casts to get x |> co; sym co and then the coercion optimizer could get rid of it entirely. Moreover, this seems within the spirit of the simple optimizer, since it’s really just “cleaning up” an expression. Is there any reason the simple optimizer doesn’t do this, or is it just something nobody implemented? (For context, I’ve recently been staring at a lot of -ddump-ds output, and there happen to be a bunch of nested casts in the result that are really just noise. It would be nice if the simple optimizer got rid of them for me.) Alexis From rae at richarde.dev Mon Apr 27 21:22:41 2020 From: rae at richarde.dev (Richard Eisenberg) Date: Mon, 27 Apr 2020 22:22:41 +0100 Subject: =?utf-8?Q?Re=3A_Why_doesn=E2=80=99t_the_simple_optimizer_fuse_cas?= =?utf-8?Q?ts=3F?= In-Reply-To: <7612B5A4-626C-457E-B747-38520D42BF2C@gmail.com> References: <7612B5A4-626C-457E-B747-38520D42BF2C@gmail.com> Message-ID: Hi Alexis, Nested casts shouldn't happen. The mkCast function gets rid of them. Someone somewhere is forgetting to call it. If you have a concrete program that leads to nested casts, post a bug report. :) Thanks! Richard > On Apr 27, 2020, at 8:29 PM, Alexis King wrote: > > This question is spurred by curiosity more than anything else, but > I’ve noticed that the simple optimizer doesn’t fuse nested casts, and > I’m wondering if there’s any reason it couldn’t. To make what I’m > talking about more concrete, suppose we have an expression like this: > > (x |> co) |> sym co > > It seems like it would be trivial for simpleOptExpr to fuse the nested > casts to get > > x |> co; sym co > > and then the coercion optimizer could get rid of it entirely. > Moreover, this seems within the spirit of the simple optimizer, since > it’s really just “cleaning up” an expression. Is there any reason the > simple optimizer doesn’t do this, or is it just something nobody > implemented? > > (For context, I’ve recently been staring at a lot of -ddump-ds output, > and there happen to be a bunch of nested casts in the result that are > really just noise. It would be nice if the simple optimizer got rid of > them for me.) > > Alexis > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs From lexi.lambda at gmail.com Mon Apr 27 21:58:05 2020 From: lexi.lambda at gmail.com (Alexis King) Date: Mon, 27 Apr 2020 16:58:05 -0500 Subject: =?utf-8?Q?Re=3A_Why_doesn=E2=80=99t_the_simple_optimizer_fuse_cas?= =?utf-8?Q?ts=3F?= In-Reply-To: References: <7612B5A4-626C-457E-B747-38520D42BF2C@gmail.com> Message-ID: Hi Richard, Nested casts can absolutely happen after the simple optimizer runs. Suppose we produce a desugared expression like: let { y = x `cast` co1 } in y `cast` co2 The simple optimizer will inline y, since it only appears once, so now we have a nested cast. Perhaps you mean you expect the casts to be merged when the simple optimizer gets to the Cast expression itself, but they aren’t, as it doesn’t use mkCast to reconstruct the result: -- from GHC.Core.SimpleOpt.simple_opt_expr go (Cast e co) | isReflCo co' = go e | otherwise = Cast (go e) co' I suppose a really simple fix would be to just use mkCast here instead of Cast, but that wouldn’t be completely satisfying, since the merged coercion wouldn’t be optimized. So you’d have to do something slightly more complicated to detect if the result of `go e` was a cast expression and combine the coercions before calling optCoercion. Whether or not doing that would be a good idea is precisely what I’m asking about. :) Alexis > On Apr 27, 2020, at 16:22, Richard Eisenberg wrote: > > Hi Alexis, > > Nested casts shouldn't happen. The mkCast function gets rid of them. > Someone somewhere is forgetting to call it. If you have a concrete > program that leads to nested casts, post a bug report. :) > > Thanks! > Richard From ben at smart-cactus.org Tue Apr 28 00:07:01 2020 From: ben at smart-cactus.org (Ben Gamari) Date: Mon, 27 Apr 2020 20:07:01 -0400 Subject: Why =?utf-8?Q?doesn=E2=80=99t?= the simple optimizer fuse casts? In-Reply-To: References: <7612B5A4-626C-457E-B747-38520D42BF2C@gmail.com> Message-ID: <87wo604go0.fsf@smart-cactus.org> Alexis King writes: ... > Whether or not doing that would be a good idea is precisely what I’m > asking about. :) > Sounds like it would be worth a quick try. Given that this will get hit by the simplifier eventually anyways I suspect it won't make much of a difference one way or the other. That being said, I've been wrong before... Cheers, - Ben -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: From simonpj at microsoft.com Tue Apr 28 07:50:21 2020 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Tue, 28 Apr 2020 07:50:21 +0000 Subject: T13456 In-Reply-To: References: <87sggy82i8.fsf@smart-cactus.org> Message-ID: Ben I'm still getting framework failures from the testsuite, as below. But now it's not just me: it's CI! See !2600 which is failing in this way. It'd be good to nail this... it seems wrong to have to ignore framework failures when checking that a build validates. Simon | -----Original Message----- | From: Simon Peyton Jones | Sent: 20 April 2020 21:42 | To: Ben Gamari | Subject: RE: T13456 | | Thanks! | | | -----Original Message----- | | From: Ben Gamari | | Sent: 20 April 2020 18:57 | | To: Simon Peyton Jones ; ghc-devs | | Subject: Re: T13456 | | | | Simon Peyton Jones via ghc-devs writes: | | | | > I'm getting this failure (below) from validate fairly consistently. | | > It is often silenced by adding an empty file | | > ghci/should_run/T13456.stderr But it's troubling. Does anyone else | see | | this? How can I debug it? | | > | | Indeed this is odd. I have not seen this in CI or my local builds. It's | | possible that I have seen it in local builds that were failing for | other | | reasons but ignored it. | | | | While I don't know why you are seeing these failures in general, the | fact | | that they are reported as framework failures is arguably a bug. I would | | argue that we should treat a non-existing .stderr file as we would an | | empty file. I've opened !3121 fixing this. Hopefully you will see a | more | | helpful error message with this patch. | | | | Cheers, | | | | - Ben From sylvain at haskus.fr Tue Apr 28 08:24:02 2020 From: sylvain at haskus.fr (Sylvain Henry) Date: Tue, 28 Apr 2020 10:24:02 +0200 Subject: T13456 In-Reply-To: References: <87sggy82i8.fsf@smart-cactus.org> Message-ID: <6ed27094-08b0-e1d5-1b14-37c5581598f6@haskus.fr> Simon !2600 doesn't contain the fix introduced by !3121. You should rebase it. Sylvain On 28/04/2020 09:50, Simon Peyton Jones via ghc-devs wrote: > Ben > > I'm still getting framework failures from the testsuite, as below. > > But now it's not just me: it's CI! See !2600 which is failing in this way. > > It'd be good to nail this... it seems wrong to have to ignore framework failures when checking that a build validates. > > Simon > > | -----Original Message----- > | From: Simon Peyton Jones > | Sent: 20 April 2020 21:42 > | To: Ben Gamari > | Subject: RE: T13456 > | > | Thanks! > | > | | -----Original Message----- > | | From: Ben Gamari > | | Sent: 20 April 2020 18:57 > | | To: Simon Peyton Jones ; ghc-devs | | devs at haskell.org> > | | Subject: Re: T13456 > | | > | | Simon Peyton Jones via ghc-devs writes: > | | > | | > I'm getting this failure (below) from validate fairly consistently. > | | > It is often silenced by adding an empty file > | | > ghci/should_run/T13456.stderr But it's troubling. Does anyone else > | see > | | this? How can I debug it? > | | > > | | Indeed this is odd. I have not seen this in CI or my local builds. It's > | | possible that I have seen it in local builds that were failing for > | other > | | reasons but ignored it. > | | > | | While I don't know why you are seeing these failures in general, the > | fact > | | that they are reported as framework failures is arguably a bug. I would > | | argue that we should treat a non-existing .stderr file as we would an > | | empty file. I've opened !3121 fixing this. Hopefully you will see a > | more > | | helpful error message with this patch. > | | > | | Cheers, > | | > | | - Ben > _______________________________________________ > ghc-devs mailing list > ghc-devs at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs From simonpj at microsoft.com Tue Apr 28 08:36:49 2020 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Tue, 28 Apr 2020 08:36:49 +0000 Subject: T13456 In-Reply-To: <6ed27094-08b0-e1d5-1b14-37c5581598f6@haskus.fr> References: <87sggy82i8.fsf@smart-cactus.org> <6ed27094-08b0-e1d5-1b14-37c5581598f6@haskus.fr> Message-ID: Aha, thanks. I have just done that. | -----Original Message----- | From: Sylvain Henry | Sent: 28 April 2020 09:24 | To: Simon Peyton Jones ; Ben Gamari | Cc: ghc-devs | Subject: Re: T13456 | | Simon | | !2600 doesn't contain the fix introduced by !3121. You should rebase it. | | Sylvain | | | On 28/04/2020 09:50, Simon Peyton Jones via ghc-devs wrote: | > Ben | > | > I'm still getting framework failures from the testsuite, as below. | > | > But now it's not just me: it's CI! See !2600 which is failing in this | way. | > | > It'd be good to nail this... it seems wrong to have to ignore framework | failures when checking that a build validates. | > | > Simon | > | > | -----Original Message----- | > | From: Simon Peyton Jones | > | Sent: 20 April 2020 21:42 | > | To: Ben Gamari | > | Subject: RE: T13456 | > | | > | Thanks! | > | | > | | -----Original Message----- | > | | From: Ben Gamari | > | | Sent: 20 April 2020 18:57 | > | | To: Simon Peyton Jones ; ghc-devs | | devs at haskell.org> | > | | Subject: Re: T13456 | > | | | > | | Simon Peyton Jones via ghc-devs writes: | > | | | > | | > I'm getting this failure (below) from validate fairly | consistently. | > | | > It is often silenced by adding an empty file | > | | > ghci/should_run/T13456.stderr But it's troubling. Does anyone | else | > | see | > | | this? How can I debug it? | > | | > | > | | Indeed this is odd. I have not seen this in CI or my local builds. | It's | > | | possible that I have seen it in local builds that were failing for | > | other | > | | reasons but ignored it. | > | | | > | | While I don't know why you are seeing these failures in general, | the | > | fact | > | | that they are reported as framework failures is arguably a bug. I | would | > | | argue that we should treat a non-existing .stderr file as we would | an | > | | empty file. I've opened !3121 fixing this. Hopefully you will see | a | > | more | > | | helpful error message with this patch. | > | | | > | | Cheers, | > | | | > | | - Ben | > _______________________________________________ | > ghc-devs mailing list | > ghc-devs at haskell.org | > | https://nam06.safelinks.protection.outlook.com/?url=http%3A%2F%2Fmail.has | kell.org%2Fcgi-bin%2Fmailman%2Flistinfo%2Fghc- | devs&data=02%7C01%7Csimonpj%40microsoft.com%7Ca31c492b26c14ca4ed4e08d | 7eb4d85c6%7C72f988bf86f141af91ab2d7cd011db47%7C1%7C0%7C637236590507618218 | &sdata=KQpAeNf4ZH4ajU3FlchAKPnN4x9JxiAHNfhsLIfIldY%3D&reserved=0 From rae at richarde.dev Tue Apr 28 10:09:51 2020 From: rae at richarde.dev (Richard Eisenberg) Date: Tue, 28 Apr 2020 11:09:51 +0100 Subject: =?utf-8?Q?Re=3A_Why_doesn=E2=80=99t_the_simple_optimizer_fuse_cas?= =?utf-8?Q?ts=3F?= In-Reply-To: <87wo604go0.fsf@smart-cactus.org> References: <7612B5A4-626C-457E-B747-38520D42BF2C@gmail.com> <87wo604go0.fsf@smart-cactus.org> Message-ID: <4770C552-BA87-4BE7-A32E-9EC134033001@richarde.dev> > On Apr 28, 2020, at 1:07 AM, Ben Gamari wrote: > > Sounds like it would be worth a quick try. I agree with Ben. I generally expect not to see nested casts -- the Cast constructor should rarely (never?) appear as an expression outside of mkCast. But you're right about the missing optimization opportunity if we do the naive thing. Let us know if you run into trouble with the "quick try"! Richard -------------- next part -------------- An HTML attachment was scrubbed... URL: From simonpj at microsoft.com Tue Apr 28 22:20:53 2020 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Tue, 28 Apr 2020 22:20:53 +0000 Subject: =?utf-8?B?UkU6IFdoeSBkb2VzbuKAmXQgdGhlIHNpbXBsZSBvcHRpbWl6ZXIgZnVzZSBj?= =?utf-8?Q?asts=3F?= In-Reply-To: References: <7612B5A4-626C-457E-B747-38520D42BF2C@gmail.com> Message-ID: Good spot. The very simple optimiser is, well, very simple. So let's not do anything complicated. But could you submit a ticket, and patch, to replace that Cast with mkCast? Thanks! Simon | -----Original Message----- | From: ghc-devs On Behalf Of Alexis King | Sent: 27 April 2020 22:58 | To: Richard Eisenberg | Cc: ghc-devs | Subject: Re: Why doesn’t the simple optimizer fuse casts? | | Hi Richard, | | Nested casts can absolutely happen after the simple optimizer runs. | Suppose we produce a desugared expression like: | | let { y = x `cast` co1 } in y `cast` co2 | | The simple optimizer will inline y, since it only appears once, so now | we have a nested cast. Perhaps you mean you expect the casts to be | merged when the simple optimizer gets to the Cast expression itself, | but they aren’t, as it doesn’t use mkCast to reconstruct the result: | | -- from GHC.Core.SimpleOpt.simple_opt_expr | go (Cast e co) | isReflCo co' = go e | | otherwise = Cast (go e) co' | | I suppose a really simple fix would be to just use mkCast here instead | of Cast, but that wouldn’t be completely satisfying, since the merged | coercion wouldn’t be optimized. So you’d have to do something slightly | more complicated to detect if the result of `go e` was a cast | expression and combine the coercions before calling optCoercion. | | Whether or not doing that would be a good idea is precisely what I’m | asking about. :) | | Alexis | | > On Apr 27, 2020, at 16:22, Richard Eisenberg wrote: | > | > Hi Alexis, | > | > Nested casts shouldn't happen. The mkCast function gets rid of them. | > Someone somewhere is forgetting to call it. If you have a concrete | > program that leads to nested casts, post a bug report. :) | > | > Thanks! | > Richard | _______________________________________________ | ghc-devs mailing list | ghc-devs at haskell.org | https://nam06.safelinks.protection.outlook.com/?url=http%3A%2F%2Fmail.has | kell.org%2Fcgi-bin%2Fmailman%2Flistinfo%2Fghc- | devs&data=02%7C01%7Csimonpj%40microsoft.com%7C825fe41065dd450030e908d | 7eaf61d19%7C72f988bf86f141af91ab2d7cd011db47%7C1%7C0%7C637236215077850647 | &sdata=w%2Fk4JG%2FOmpwPoUAAGqdC62ssQSYcLQioY8T9%2BZ3XS8E%3D&reser | ved=0 From simonpj at microsoft.com Thu Apr 30 16:46:43 2020 From: simonpj at microsoft.com (Simon Peyton Jones) Date: Thu, 30 Apr 2020 16:46:43 +0000 Subject: Connecting the Wolfram Language to Haskell Message-ID: Friends Short summary: can someone familiar with using the GHC API offer advice on getting the Wolfram Language connected to Haskell? Many of you will know of the Wolfram Language, which is IMHO pretty cool and not well enough known. There are lots of interesting things about it, but a huge thing is that it's deeply connected to the vast pile of carefully curated data that Wolfram Research has gathered and organised over several decades. Anyway, they'd like to be able to invoke Haskell code from the Wolfram Language interpreter. But as you'll see below, they are understandably stumbling on the engineering aspects of doing so. Rather than spam Stephen Wolfram himself, I'm cc'ing Todd Gayley who is the team lead. (Hi Todd.) I'd really appreciate it if some of you could help advise him. It would be terrific to have a direct connection between Wolfram and Haskell! Many thanks Simon From: Stephen Wolfram Sent: 01 April 2020 01:49 To: Simon Peyton Jones Subject: Haskell question, etc. Simon --- [...snip...] What brings me to email is a Haskell question: It's probably best that I just forward what my team wants to ask: ========= A powerful feature of the Wolfram Language is that it allows users to evaluate code in other programing languages, returning the results to a Wolfram notebook (https://nam06.safelinks.protection.outlook.com/?url=https%3A%2F%2Freference.wolfram.com%2Flanguage%2Fguide%2FExternalInterpretedLanguageInterfaces.html&data=02%7C01%7Csimonpj%40microsoft.com%7Cb8abce5772944182a1de08d7d5d68940%7C72f988bf86f141af91ab2d7cd011db47%7C1%7C0%7C637212989714565411&sdata=po6qg70bq8f4jbEvTRv6eoQfhLSZ3Fvdj3DBJFpWB%2FY%3D&reserved=0). We have implemented this feature for a number of languages, including Python, NodeJS, Julia, and Ruby. We would very much like to include Haskell in this set, but we have little Haskell expertise, and have hit a stumbling block. We would appreciate it if some Haskell experts could help us out with this feature. We have the following basic line of code for evaluating a string of Haskell code: r <- liftIO $ runInterpreter $ do { setImports ["Prelude"]; eval strToEvaluate} The problem is that this is a one-shot evaluation, and we want a long-lived interactive Haskell session, to which a series of inputs can be directed. We have been told that we have to use GHCi for that, but we don't know how to do it. The basic flow of our functionality is as follows: 1) User calls StartExternalSession["LanguageName"] to launch an interpreter for the language. This process remains running and can be used for multiple calls. 2) User calls ExternalEvaluate[session, "some code"] to execute the given code in the external language and return a result converted into native Wolfram Language types (strings, numbers, lists, associations, etc.) ZeroMQ is used as the transport between Wolfram Language and the external language interpreter, and JSON is the data format we use to return results. Beyond the basics of hooking up GHCi for this type of session use, we also would like assistance in introspection of Haskell results so that they can be sent back to WL in the most useful form. This is the general structure of what we do for other languages: if result is an object return object data else if result is a function return function data else return JSON form of the expression We have attached a simple file of Haskell code that one of our engineers has successfully used to get a basic evaluation of Haskell code from the Wolfram Language, but it uses the single-shot evaluation code that was given above, and so is not suitable. We would appreciate any help that you can give us, or developers or resources you can point us at, to assist in integrating Haskell into our ExternalEvaluate system. ======== Any help greatly appreciated! (Not least because I'd personally like to play with this... :) ) --- Stephen -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: start_Haskell.hs Type: application/octet-stream Size: 1649 bytes Desc: start_Haskell.hs URL: From ben at well-typed.com Thu Apr 30 21:13:18 2020 From: ben at well-typed.com (Ben Gamari) Date: Thu, 30 Apr 2020 17:13:18 -0400 Subject: Connecting the Wolfram Language to Haskell In-Reply-To: References: Message-ID: <87lfmc4qzc.fsf@smart-cactus.org> Simon Peyton Jones via ghc-devs writes: > Friends > > Short summary: can someone familiar with using the GHC API offer > advice on getting the Wolfram Language connected to Haskell? > Hi Todd, et al., This sounds like a great project. I have fond memories of Mathematica from my studies. ... > We have the following basic line of code for evaluating a string of Haskell code: > > r <- liftIO $ runInterpreter $ do { setImports ["Prelude"]; eval strToEvaluate} > > The problem is that this is a one-shot evaluation, and we want a > long-lived interactive Haskell session, to which a series of inputs > can be directed. We have been told that we have to use GHCi for that, > but we don't know how to do it. > It appears that you are using the `hint` library [1] for evaluation. I'll admit that I've not used hint; it looks quite sensible but I do not know what limitations you might encounter. It looks like its approach to error handling may leave something to be desired. Nevertheless, we can work with it for now; if we run into its limitations then the alternative is to use the GHC API directly, as suggested by Simon. > The basic flow of our functionality is as follows: > > 1) User calls StartExternalSession["LanguageName"] to launch an > interpreter for the language. This process remains running and can be > used for multiple calls. > > 2) User calls ExternalEvaluate[session, "some code"] to execute the > given code in the external language and return a result converted into > native Wolfram Language types (strings, numbers, lists, associations, > etc.) > Sure. ... > We have attached a simple file of Haskell code that one of our > engineers has successfully used to get a basic evaluation of Haskell > code from the Wolfram Language, but it uses the single-shot evaluation > code that was given above, and so is not suitable. We would appreciate > any help that you can give us, or developers or resources you can > point us at, to assist in integrating Haskell into our > ExternalEvaluate system. > It looks like you will want to push the `runInterpreter` out of the `forever`. Afterall, you want the interpreter session to persist over multiple requests. Doing this isn't difficult but does require some monad transformer shuffling, which may be unfamiliar to someone coming from another language. I've put up a cleaned up version of your program here [1]; hopefully this is enough to get you started. Do note that this requires a patched version of zeromq4-haskell due to a minor bug [2] which I have fixed [3]. Do note that there is a related effort, iHaskell [4], which provides a Haskell kernel for Jupyter Notebook. This might be a place to draw inspiration from. Let us know how things go and don't hesitate to be in touch if you have questions regarding the GHC API. Cheers, - Ben [1] https://github.com/bgamari/zeromq-hint [2] https://gitlab.com/twittner/zeromq-haskell/-/issues/66 [3] https://gitlab.com/twittner/zeromq-haskell/-/merge_requests/6 [4] https://github.com/gibiansky/IHaskell -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 487 bytes Desc: not available URL: