[GHC] #10697: Change template-haskell API to allow NOUNPACK, lazy annotations

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: | Owner: RyanGlScott | Type: feature | Status: new request | Priority: normal | Milestone: Component: Template | Version: 7.10.1 Haskell | Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: #8347 Differential Revisions: | -------------------------------------+------------------------------------- Currently, the {{{template-haskell}}} API is lagging behind what is possible with GHC's strictness annotations in data types, especially since the advent of {{{StrictData}}}. Currently, {{{template-haskell}}} has {{{Strict}}}: {{{#!hs data Strict = IsStrict | NotStrict | Unpacked }}} But it appears that there are actually nine different combinations of packedness and strictness annotations: {{{#!hs data A = A Int -- No unpackedness, no strictness data A = A !Int -- No unpackedness, strict data A = A ~Int -- No unpackedness, lazy data A = A {-# NOUNPACK #-} A Int -- NOUNPACK, no strictness data A = A {-# NOUNPACK #-} A !Int -- NOUNPACK, strict data A = A {-# NOUNPACK #-} A ~Int -- NOUNPACK, lazy data A = A {-# UNPACK #-} A Int -- UNPACK, no strictness data A = A {-# UNPACK #-} A !Int -- UNPACK, strict data A = A {-# UNPACK #-} A ~Int -- UNPACK, lazy }}} It seems like the most consistent thing to do would be change {{{Strict}}} and add {{{Unpack}}} to the {{{template-haskell}}} API: {{{#!hs data Strict = IsStrict | NotStrict | IsLazy data Unpack = Unpack | NoUnpack | NotUnpacked type UnpackStrictType = (Unpack, Strict, Type) type VarUnpackStrictType = (Name, Unpack, Strict, Type) }}} And so on. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Revisions: -------------------------------------+------------------------------------- Changes (by RyanGlScott): * related: #8347 => #5290, #8347 -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:1 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by RyanGlScott: Old description:
Currently, the {{{template-haskell}}} API is lagging behind what is possible with GHC's strictness annotations in data types, especially since the advent of {{{StrictData}}}. Currently, {{{template-haskell}}} has {{{Strict}}}:
{{{#!hs data Strict = IsStrict | NotStrict | Unpacked }}}
But it appears that there are actually nine different combinations of packedness and strictness annotations:
{{{#!hs data A = A Int -- No unpackedness, no strictness data A = A !Int -- No unpackedness, strict data A = A ~Int -- No unpackedness, lazy data A = A {-# NOUNPACK #-} A Int -- NOUNPACK, no strictness data A = A {-# NOUNPACK #-} A !Int -- NOUNPACK, strict data A = A {-# NOUNPACK #-} A ~Int -- NOUNPACK, lazy data A = A {-# UNPACK #-} A Int -- UNPACK, no strictness data A = A {-# UNPACK #-} A !Int -- UNPACK, strict data A = A {-# UNPACK #-} A ~Int -- UNPACK, lazy }}}
It seems like the most consistent thing to do would be change {{{Strict}}} and add {{{Unpack}}} to the {{{template-haskell}}} API:
{{{#!hs data Strict = IsStrict | NotStrict | IsLazy
data Unpack = Unpack | NoUnpack | NotUnpacked
type UnpackStrictType = (Unpack, Strict, Type)
type VarUnpackStrictType = (Name, Unpack, Strict, Type) }}}
And so on.
New description: Currently, the {{{template-haskell}}} API is lagging behind what is possible with GHC's strictness annotations in data types, especially since the advent of {{{StrictData}}}. Currently, {{{template-haskell}}} has {{{Strict}}}: {{{#!hs data Strict = IsStrict | NotStrict | Unpacked }}} But it appears that there are actually nine different combinations of packedness and strictness annotations: {{{#!hs data A = A Int -- No unpackedness, no strictness data A = A !Int -- No unpackedness, strict data A = A ~Int -- No unpackedness, lazy data A = A {-# NOUNPACK #-} Int -- NOUNPACK, no strictness data A = A {-# NOUNPACK #-} !Int -- NOUNPACK, strict data A = A {-# NOUNPACK #-} ~Int -- NOUNPACK, lazy data A = A {-# UNPACK #-} Int -- UNPACK, no strictness data A = A {-# UNPACK #-} !Int -- UNPACK, strict data A = A {-# UNPACK #-} ~Int -- UNPACK, lazy }}} It seems like the most consistent thing to do would be change {{{Strict}}} and add {{{Unpack}}} to the {{{template-haskell}}} API: {{{#!hs data Strict = IsStrict | IsLazy | NoStrictAnnot data Unpack = Unpack | NoUnpack | NoUnpackAnnot type UnpackStrict = (Unpack, Strict) type UnpackStrictType = (UnpackStrict, Type) type VarUnpackStrictType = (Name, UnpackStrict, Type) type StrictType = UnpackStrictType type VarStrictType = VarUnpackStrictType }}} And so on. -- -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:2 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * cc: adamse (added) Comment: It turns out that even without considering `NOUNPACK`, `Strict` and `TemplateHaskell` don't play well together at the moment. This code: {{{#!hs {-# LANGUAGE StrictData, TemplateHaskell #-} import Language.Haskell.TH data T a = T !a a ~a $(return []) main :: IO () main = putStrLn $(reify ''T >>= stringE . show) }}} produces this output (prettied up a bit): {{{#!hs TyConI (DataD [] Main.T [KindedTV a_1627391747 StarT] [NormalC Main.T [ (IsStrict, VarT a_1627391747) , (NotStrict,VarT a_1627391747) , (NotStrict,VarT a_1627391747) ]] []) }}} Which is pretty darn misleading, since the second argument is actually strict! That being said, I'm not exactly sure what it ''should'' output here. One might could argue is should be `(IsStrict, NotStrict, IsLazy)`, but then again, the definition of `NotStrict` depends on whether `StrictData` is enabled or not. If we output `(Strict, NotStrict, IsLazy)`, then would splicing the TH code for that datatype into a module without `StrictData` fail (since `IsLazy` implies a laziness annotation)? Perhaps TH should check whether `StrictData` is on and splice accordingly. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:3 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by adamse): I remember discussing this during development, but I don't remember why no change was made. I think someone (Simon?) said that the TH ast is supposed to represent source code and therefore your suggestion makes sense to me! -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:4 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Yes, TH is supposed to reflect source code. So if source code can have bangs and twiddles, than TH should too. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:5 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): What I'm still very unsure about is how we should handle strictness in `reify` versus handling strictness during splicing. When spicing in a data declaration, we should probably interpret it as literally as possible. For example, {{{#!hs [d| data U = U {-# UNPACK #-} Int |] }}} should splice just that, even though GHC would notice that a field is marked `{-# UNPACK #-}` without a strictness annotation, emit a warning, and then change that field to lazy afterwards. (On a side note, TH currently doesn't parse `{-# UNPACK #-}` annotations, but that would be easy to fix.) On the other hand, if we were to define a datatype [http://git.haskell.org/ghc.git/blob/688069ca83e949b9bde9883af7df26114e2f9bc0... like this]: {{{#!hs data T = MkT !Int {-# UNPACK #-} !Int Bool }}} and call `reify ''T`, the strictness annotations would probably be meaningless by themselves. You'd need to know whether `-O`, `-funbox- strict-fields`, and/or `-XStrictData` were enabled to get the full story. I believe this is why internally, GHC distinguishes between [http://git.haskell.org/ghc.git/blob/688069ca83e949b9bde9883af7df26114e2f9bc0... HsSrcBangs] (strictness annotations as the user wrote) and [http://git.haskell.org/ghc.git/blob/688069ca83e949b9bde9883af7df26114e2f9bc0... HsImplBangs] (strictness annotations as GHC interprets them). With TH, we can cheat a little bit by using the [https://phabricator.haskell.org/D1200 forthcoming] `isExtEnabled` functionality to query whether `StrictData` is turned on, but for a [https://ghc.haskell.org/trac/ghc/ticket/10716 similar ticket] involving the ability to lookup strictness via generics, we have no such escape hatch. We should probably come up with a satisfying answer to this question so we can have a uniform treatment of strictness reification. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:6 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Well, data constructors do record their `HsSrcBangs` as well as their impl-bangs. {{{ dataConSrcBangs :: DataCon -> [HsSrcBang] dataConSrcBangs = dcSrcBangs }}} So can't you just reify those? Then you get back what the user wrote, which seems reasonable for reification. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:7 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): The problem is that the info in `HsSrcBangs` may not reflect what is actually going on in some cases. Let's suppose a user wanted to write a TH function that checks if every argument of a data constructor is unpacked. If the user wrote this: {{{#!hs data T = T !Int Int }}} then how would the user know for sure if the fields are actually unpacked? If `-funbox-strict-fields` is on, then the first argument is unpacked, but if not, it's strict but not unpacked. If `-funbox-strict-fields` ''and'' `-XStrict` is on, then ''both'' would be unpacked. But if the user relied on `HsSrcBangs`, they would be mislead into believing that the first argument always is strict (but not unpacked) and the second argument is always lazy. This situation kind of reminds me of TH's `TyVarBndr` in that `PlainTV` represents a type variable without an explicit kind variable, which should only be used during splicing. Afterwards, a kind is inferred, so reifying the datatype back gives you a `KindedTV` instead. Perhaps we should do something similar with strictness annotations? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:8 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by adamse): But if
TH is supposed to reflect source code
it is clear to the user of TH that the GHC could do more things to the code. I think this is true: a datatype will always be *at least* as strict and unpacked as `HsSrcBangs`/reification says. (relatedly I wonder if I can get GHC to tell me what strictness/unpackedness is ultimately choosen, as a debugging tool) -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:9 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott):
(relatedly I wonder if I can get GHC to tell me what strictness/unpackedness is ultimately choosen, as a debugging tool)
You can, with [http://git.haskell.org/ghc.git/blob/f4f00c0f28f3c21eb6f1396f48058c430c4e9b30... dataConImplBangs]. [http://git.haskell.org/ghc.git/blob/f4f00c0f28f3c21eb6f1396f48058c430c4e9b30... HsImplBang] only has three possible configurations: `HsLazy`, `HsStrict`, and `HsUnpack`. This is more or less what TH tries to do right now, except in a half-baked way. For example, if you try to splice in a datatype with an argument that is both unpacked and lazy, it will just revert to `NotStrict`. (It doesn't take `-XStrict` or `-funbox-strict-fields` into account, however.) I strongly feel that we need to include both the `HsSrcBang` and `HsImplBang` information in Template Haskell (and probably in generics, if we fix [https://ghc.haskell.org/trac/ghc/ticket/10716 this issue]). Otherwise, we are misleading users. I don't like the idea of having to look up whether a dynamic flag is turned on or not (via `isExtEnabled` or otherwise) to know for sure what something's strictness is. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:10 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by adamse):
You can, with dataConImplBangs. HsImplBang only has three possible configurations: HsLazy, HsStrict, and HsUnpack.
I'm well aware, I was thinking more of some debug flag to give GHC: perhaps `-ddump-dataconrep`. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:11 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Right, I probably should have you'd know all about `HsImplBang`. Better safe than sorry. :) If no one has any objections, I'd like to take back my earlier proposal and instead propose this be the redesign for strictness in TH: {{{#!hs data SourceStrictness = NoSourceStrictness | SourceLazy | SourceStrict data SourceUnpackedness = NoSourceUnpackedness | SourceNoUnpack | SourceUnpack data DecidedStrictness = DecidedLazy | DecidedStrict | DecidedUnpack data Bang = PendingBang SourceStrictness | DecidedBang SourceStrictness DecidedStrictness type BangType = (Bang, Type) type VarBangType = (Name, Bang, Type) type StrictType = BangType type VarStrictType = VarBangType }}} The tricky part is distinguishing between strictness at the point of splicing and strictness post-compilation. I attempt to do this with the `Bang` data type, which has two constructors for these purposes. I would also propose that attempting to splice in a datatype with a `DecidedBang` value would lead to a warning and silently revert to a `PendingBang` value (after all, what GHC decides is the right `Bang` completely depends on the environment!) -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:12 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): It's fine to make ''both'' source-code ''and'' GHC-decision information available to reification in TH. But you may want to consider making the latter come via some "info" structure returned by reification, rather than trying to put it in a TH `Decl`. Why? * If you put it in a TH `Decl` you are forced into this `Pending` vs `Decided` sum type which is ugly. * It'll conflict with #11081 (introspective TH) -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:13 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: patch Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Rev(s): Phab:D1603 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch * differential: => Phab:D1603 -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:14 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: patch Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Rev(s): Phab:D1603 Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Sorry for being late to the conversation here. I find the comment:12 proposal to be a bit baroque. Let's examine the principles at play: 1. TH quotes should faithfully turn user-written syntax into the TH AST. But it's not obliged to deal with meaningless user-written syntax. Are all nine possibilities enumerated in the original post meaningful? I don't think so. (Does `{-# UNPACK #-} ~blah` ever make sense?) If it makes the design of TH harder, I don't think we need to deal with the non-meaningful combinations. But, all else being equal, being able to represent what the user wrote is helpful. 2. Splicing should respect what extensions are on in the splicing module, ''not'' the quoting module. When splicing a quote, GHC should behave exactly as if the code were copied and pasted from the quote to the splice. 3. Reification, as implemented, is a lie. GHC does not save the actual syntax the user wrote and so does a best-effort approximation. It's always going to be a bit wrong, at least until we're giving users a `TyCon` directly (which I'm not suggesting here). In addition to these bedrock principles (which, I'll admit, I've just made up on the spot; if we like them, we should enshrine these or something similar somewhere), I'd like to add 4. Reification should behave identically no matter what extensions are enabled. Anything else seems doomed to endlessly befuddle users. Given these design principles, I favor the original proposal the most. It's straightforward enough to programmatically generate, to programmatically examine, and for humans to understand. I think I favor an implementation of reification that never returns `NoStrictAnnot` and never returns `NoUnpackAnnot`; that is, it tells you precisely what GHC is doing, all the time. This has the noted downside that laziness annotations will cause compilation problems without `StrictData`. So we also add new (quite straightforward, pure) functions that make a reified data declaration suitable for `-XNoStrictData` or `-XStrictData`. Perhaps with Phab:D1200 complete (extension checking), we can offer a function that just does the right thing. This reification problem is quite similar (as you point out) to kind annotations on type variable binders. A few versions ago, reification used `PlainTV` for all `*`-kinded variables and `KindedTV` for others. But this was just bogus, and now there are a lot more kind signatures. Of course, this means that reified code might not always compile if spliced -- just like what I'm proposing about strictness, etc. What do we think? I have not looked at the implementation, as we haven't settled on a design. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:15 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: patch Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Rev(s): Phab:D1603 Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): I will admit that I got a little too ambitious with my proposal in comment:12, which Simon noted. TH splices should never be altered if given "bad" input like what I had proposed. I like Simon's idea of granting the user the ability to reify a constructor's fields' strictness after compilation, which I incorporated in Phab:D1603. I'll go ahead and post the updated design here so we have a common point to reference in this discussion. Here is the API that concerns reification of data types, which coincides precisely with the strictness annotations a user writes in source code (i.e., `HsSrcBang`): {{{#!hs data SourceUnpackedness = NoSourceUnpackedness | SourceNoUnpack | SourceUnpack data SourceStrictness = NoSourceStrictness | SourceLazy | SourceStrict data Con = NormalC Name [BangType] | RecC Name [VarBangType] | InfixC BangType Name BangType | ForallC [TyVarBndr] Cxt Con data Bang = Bang SourceUnpackedness SourceStrictness type BangType = (Bang, Type) type VarBangType = (Name, Bang, Type) }}} There is also a similar API for discovering what GHC actually turns these strictness/unpackedness combinations into after compilation (i.e., `HsImplBang`), which can be affected by `-XStrictData`, `-funbox-strict- fields`, etc. {{{#!hs data DecidedStrictness = DecidedLazy | DecidedStrict | DecidedUnpack class Monad m => Quasi m where ... qReifyConStrictness :: Con -> m [DecidedStrictness] }}}
1. TH quotes should faithfully turn user-written syntax into the TH AST.
But it's not obliged to deal with meaningless user-written syntax. Are all nine possibilities enumerated in the original post meaningful? I don't
Agreed. think so. (Does `{-# UNPACK #-} ~blah` ever make sense?) If it makes the design of TH harder, I don't think we need to deal with the non-meaningful combinations. But, all else being equal, being able to represent what the user wrote is helpful. I somewhat disagree here. TH splices should produce syntactically valid code, but there's no guarantee that code that it will be meaningful. After all, you could conceivably splice in something like `foo :: Maybe -> Maybe`. You're right in that internally, GHC doesn't think all nine combinations are compatible. In fact, `HsImplBang` only has three combinations: strict, lazy, and unpacked. But the source language is much richer, and it would be difficult to graft `{-# NOUNPACK #-}` and laziness annotations onto Template Haskell without acknowledging that unpackedness annotations and strictness annotations can be used independently of each other in source code. Not only that, you can't always tell what GHC will produce just from examining the unpackedness and strictness annotations alone; it's also affected by language extensions, optimization levels, and other inscrutable factors. That's why GHC keeps track of `HsSrcBang` information even after it's determined what the `HsImplBang`s are. If it didn't, there'd be no way things like GHCi could tell you how the original data type was written in source code, since that information could have been distorted. For these reasons, I feel strongly that we need to be able to express all combinations of annotations, even if some of them aren't meaningful to GHC.
2. Splicing should respect what extensions are on in the splicing module, ''not'' the quoting module. When splicing a quote, GHC should behave exactly as if the code were copied and pasted from the quote to the splice.
3. Reification, as implemented, is a lie. GHC does not save the actual syntax the user wrote and so does a best-effort approximation. It's always going to be a bit wrong, at least until we're giving users a `TyCon`
Also agreed. I moved the `DecidedStrictness` stuff out of the AST so that this property would be preserved. directly (which I'm not suggesting here). True, but I think that as long as property 2 holds, this isn't a big deal. Not only that, but TH's `SourceStrictness`, `SourceUnpackedness`, and `DecidedStrictness` are in one-to-one correspondence with GHC's `SrcStrictness`, `SrcUnpackedness`, and `HsImplBang`, respectively, so we don't have to lie in this particular case.
4. Reification should behave identically no matter what extensions are enabled. Anything else seems doomed to endlessly befuddle users.
I think I favor an implementation of reification that never returns `NoStrictAnnot` and never returns `NoUnpackAnnot`; that is, it tells you
This reification problem is quite similar (as you point out) to kind annotations on type variable binders. A few versions ago, reification used `PlainTV` for all `*`-kinded variables and `KindedTV` for others. But this was just bogus, and now there are a lot more kind signatures. Of course,
I feel like you need to be more specific here before I can respond to this. Are you referring to reification of what the user ''wrote'', or reification of GHC-specific info that depends on compilation settings? If it's the former, I agree, but not if it's the latter. precisely what GHC is doing, all the time. This has the noted downside that laziness annotations will cause compilation problems without `StrictData`. So we also add new (quite straightforward, pure) functions that make a reified data declaration suitable for `-XNoStrictData` or `-XStrictData`. Perhaps with Phab:D1200 complete (extension checking), we can offer a function that just does the right thing. Again, are you referring to the source strictness or the GHC-decided strictness here? If it's the decided strictness, then as you say, it doesn't make sense to return "no strictness". If it's the source strictness, adding a "no strictness" option is, IMO, unavoidable (see my response to point 1). this means that reified code might not always compile if spliced -- just like what I'm proposing about strictness, etc. Upon further thought, I don't think this comparison is a very good one. `TyVarBndr` is special because it's possible to write type variables without kind signatures and have GHC infer them; that is, there's a special input form for splicing that never appears in the reified output. Strictness, on the other hand, has special ''output'' forms that should never appear in the spliced input. Going the other way is problematic, and for that reason, I adopted Simon's suggestion of splitting off the `DecidedStrictness` stuff and moving it to a `reifyConStrictness` function. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:16 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: patch Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Rev(s): Phab:D1603 Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): By the way, I'm open to ideas on what to color the bikeshed: * I'm not sure if `SourceStrictness` and `SourceUnpackedness` should have three constructors each, or if we should just remove `NoSourceStrictness`/`NoSourceUnpackedness` and just use `Nothing` to represent a lack of an annotation (e.g., `Just SourceStrict` for a `!` annotation, `Nothing` for no annotation). * What to name `SourceStrictness` and `SourceUnpackedness`. Other names I contemplated were `data AnnStrictness = StrictAnnotation | LazyAnnotation | NoStrictnessAnnotation` and `data AnnUnpackedness = NoUnpackAnnotation | UnpackAnnotation | NoUnpackednessAnnotation`. * What to name `DecidedStrictness`. I also considered `data ImplStrictness = ImplStrict | ImplLazy | ImplUnpack`. Or perhaps we should just re-use the already existing `data Strict = IsLazy | IsStrict | Unpack`? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:17 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: patch Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Rev(s): Phab:D1603 Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Replying to [comment:16 RyanGlScott]:
I will admit that I got a little too ambitious with my proposal in comment:12, which Simon noted. TH splices should never be altered if given "bad" input like what I had proposed. I like Simon's idea of granting the user the ability to reify a constructor's fields' strictness after compilation, which I incorporated in Phab:D1603.
Yes, that may be a good middle ground.
I'll go ahead and post the updated design here so we have a common point
to reference in this discussion. Here is the API that concerns reification of data types, which coincides precisely with the strictness annotations a user writes in source code (i.e., `HsSrcBang`):
{{{#!hs data SourceUnpackedness = NoSourceUnpackedness | SourceNoUnpack | SourceUnpack
data SourceStrictness = NoSourceStrictness | SourceLazy | SourceStrict
data Con = NormalC Name [BangType] | RecC Name [VarBangType] | InfixC BangType Name BangType | ForallC [TyVarBndr] Cxt Con
data Bang = Bang SourceUnpackedness SourceStrictness
type BangType = (Bang, Type) type VarBangType = (Name, Bang, Type) }}}
There is also a similar API for discovering what GHC actually turns
these strictness/unpackedness combinations into after compilation (i.e., `HsImplBang`), which can be affected by `-XStrictData`, `-funbox-strict- fields`, etc.
{{{#!hs data DecidedStrictness = DecidedLazy | DecidedStrict | DecidedUnpack
class Monad m => Quasi m where ... qReifyConStrictness :: Con -> m [DecidedStrictness] }}}
This might be more useful taking a `Name` instead of a `Con`. I imagine it has to just extract the name and look it up anyway, no? Or does it apply the extensions currently enabled to the `Con` definition and report back what GHC would decide if the declaration were given? That seems a bit silly.
1. TH quotes should faithfully turn user-written syntax into the TH
AST.
Agreed.
But it's not obliged to deal with meaningless user-written syntax. ...
I somewhat disagree here. TH splices should produce syntactically valid
code, but there's no guarantee that code that it will be meaningful. After all, you could conceivably splice in something like `foo :: Maybe -> Maybe`. You're talking about splices; I'm talking about quotes. Yes, splices need to deal with whatever the TH AST provides it, producing compilation errors as appropriate. But I don't think quoting does. For example `[| x $$$ y %%% z |]` fails if `$$$` and `%%%` are both non-fix operators of the same precedence. And the TH AST even has the ability to represent that one! (Via `UInfixE`.) So I maintain that quoting doesn't need to deal with nonsensical code, if that makes things easier.
You're right in that internally, GHC doesn't think all nine combinations
are compatible. In fact, `HsImplBang` only has three combinations: strict, lazy, and unpacked. But the source language is much richer, and it would be difficult to graft `{-# NOUNPACK #-}` and laziness annotations onto Template Haskell without acknowledging that unpackedness annotations and strictness annotations can be used independently of each other in source code. I agree. Especially with the various flags that can affect this behavior.
Not only that, you can't always tell what GHC will produce just from
examining the unpackedness and strictness annotations alone; it's also affected by language extensions, optimization levels, and other inscrutable factors. That's why GHC keeps track of `HsSrcBang` information even after it's determined what the `HsImplBang`s are. If it didn't, there'd be no way things like GHCi could tell you how the original data type was written in source code, since that information could have been distorted.
For these reasons, I feel strongly that we need to be able to express
all combinations of annotations, even if some of them aren't meaningful to GHC. I'm not at all disagreeing here. Just saying that it's not the only option. But perhaps this isn't worth debating, as I do tend to agree that representing the source Haskell straightforwardly works out nicely in this case.
4. Reification should behave identically no matter what extensions are
enabled. Anything else seems doomed to endlessly befuddle users.
I feel like you need to be more specific here before I can respond to
this. Are you referring to reification of what the user ''wrote'', or reification of GHC-specific info that depends on compilation settings? If it's the former, I agree, but not if it's the latter. I'm saying that if I reify `Foo`, I should get the same results no matter what extensions are enabled at the point of reification. Of course, if you change the extensions at `Foo`'s definition site, then that substantively changes the definition of `Foo` and should change the output of reification. I can't distinguish between your two cases, I'm afraid. Reification never promises to get back what the user wrote -- it gives you what GHC knows.
I think I favor an implementation of reification that never returns
`NoStrictAnnot` and never returns `NoUnpackAnnot`; that is, it tells you precisely what GHC is doing, all the time. This has the noted downside that laziness annotations will cause compilation problems without `StrictData`. So we also add new (quite straightforward, pure) functions that make a reified data declaration suitable for `-XNoStrictData` or `-XStrictData`. Perhaps with Phab:D1200 complete (extension checking), we can offer a function that just does the right thing.
Again, are you referring to the source strictness or the GHC-decided
strictness here? If it's the decided strictness, then as you say, it doesn't make sense to return "no strictness". If it's the source strictness, adding a "no strictness" option is, IMO, unavoidable (see my response to point 1). Reification talks about compiled things, not source things. The fact that it returns information using surface syntax is the "lie". So this is GHC- decided strictness.
This reification problem is quite similar (as you point out) to kind
annotations on type variable binders. A few versions ago, reification used `PlainTV` for all `*`-kinded variables and `KindedTV` for others. But this was just bogus, and now there are a lot more kind signatures. Of course, this means that reified code might not always compile if spliced -- just like what I'm proposing about strictness, etc.
Upon further thought, I don't think this comparison is a very good one.
`TyVarBndr` is special because it's possible to write type variables without kind signatures and have GHC infer them; that is, there's a special input form for splicing that never appears in the reified output. Strictness, on the other hand, has special ''output'' forms that should never appear in the spliced input. Going the other way is problematic, and for that reason, I adopted Simon's suggestion of splitting off the `DecidedStrictness` stuff and moving it to a `reifyConStrictness` function. I don't agree here. Strictness does not need to have special output forms. It just needs to use unambiguous forms like (unpacked/strict), (not- unpacked/strict) and (not-unpacked/lazy), and never return that it doesn't know. On the other hand, there are 6 extra input forms. Exactly like `TyVarBndr`. You've chosen to implement this asymmetry by introducing new output forms. The same could have been done for `TyVarBndr`, by never giving kind annotations and instead requiring users to reify type variables to get their kinds. I prefer the current behavior. Might strictness be different? That is, might it be easier to reify strictness instead of include it in reified `Con`s? Perhaps. But it's yet another datatype and yet another function in `Quasi`, when we have the ability to say exactly what we want right in the `Con`. With the right flags set, you could even round-trip the reified `Con`s. To be honest, I don't feel strongly about a special reification function vs. returning the info right in the `Con`. But it does seem to me that this is design choice and is not a forced decision. I favor (weakly) returning the info right in the `Con`, just to lessen the footprint of this feature. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:18 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: patch Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Rev(s): Phab:D1603 Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Replying to [comment:18 goldfire]:
This might be more useful taking a `Name` instead of a `Con`. I imagine it has to just extract the name and look it up anyway, no? Or does it apply the extensions currently enabled to the `Con` definition and report back what GHC would decide if the declaration were given? That seems a bit silly.
You're right, all it does is extract the `Name` and look it up. I opted for `qReifyConStrictness` to take a `Con` instead of a `Name` simply because you'd be less likely to pass it a bad `Name`, but then again, there are several other `Quasi` functions that are easy to pass bad `Name`s, so I'll change the it to `qReifyConStrictness :: Name -> m [DecidedStrictness]` for consistency's sake. To broadly address the rest of your comments: I called `DecidedStrictness` a "special output form" because I don't really feel like the strictness that GHC infers during compilation is comparable to unpackedness/strictness annotations. We ''could'' try to pursue a design where we unify `Bang` with `DecidedStrictness`, i.e., something like this: {{{#!hs data Strict = IsStrict | IsLazy | Unpack -- This must used with !, so it only needs one constructor | NoUnpackIsStrict | NoUnpackIsLazy | NoUnpack | NoAnnotation }}} but I don't feel like this is the right design. Why? 1. The naming just feels downright awkward (which is why I favored splitting it up). 2. There's a major issue with splicing in a datatype constructed from the TH AST. For example, if we splice this: {{{ DataD [] ''T [] [NormalC 'T [(NoAnnotation,ConT ''Int)]] [] }}} and later reify `T`, what would we get back as the strictness of its field? If we get back `NoAnnotation`, we lose the fact that GHC inferred it to be lazy/strict/etc. If we get back, say, `IsLazy`, we lose the fact that there wasn't an annotation in the first place. We could try putting both things in a `Con`, but I can't figure out a way to do it that makes sense. If we include both the user-marked strictness and the GHC-decided strictness information in a `Con`, then how would we splice in the example TH AST written above? {{{ DataD [] ''T [] [NormalC 'T [({- Source -} NoAnnotation,{- Decided -} ???,ConT ''Int)]] [] }}} It is this precisely this scenario where including the GHC-decided strictness seems to fall flat, IMO. Here, you have to put something in `???`'s place which GHC won't use, and even worse, reifying `T` after splicing it would possibly give you back something different in `???`'s place! Maybe there would be a way to make it work, but I can't see it, which is why I felt the most pertinent choice was to make `DecidedStrictness` into something which could only be reified. If you see another way that's more natural, please let me know! -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:19 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: patch Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Rev(s): Phab:D1603 Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): OK. I relent. :) -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:20 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations
-------------------------------------+-------------------------------------
Reporter: RyanGlScott | Owner:
Type: feature request | Status: patch
Priority: normal | Milestone:
Component: Template Haskell | Version: 7.10.1
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture:
| Unknown/Multiple
Type of failure: None/Unknown | Test Case:
Blocked By: | Blocking:
Related Tickets: #5290, #8347 | Differential Rev(s): Phab:D1603
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by Ben Gamari

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: closed Priority: normal | Milestone: Component: Template Haskell | Version: 7.10.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Rev(s): Phab:D1603 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => closed * resolution: => fixed -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:22 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations
-------------------------------------+-------------------------------------
Reporter: RyanGlScott | Owner:
Type: feature request | Status: closed
Priority: normal | Milestone: 8.0.1
Component: Template Haskell | Version: 7.10.1
Resolution: fixed | Keywords:
Operating System: Unknown/Multiple | Architecture:
| Unknown/Multiple
Type of failure: None/Unknown | Test Case:
Blocked By: | Blocking:
Related Tickets: #5290, #8347 | Differential Rev(s): Phab:D1603
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by Ben Gamari

#10697: Change template-haskell API to allow NOUNPACK, lazy annotations -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: Type: feature request | Status: closed Priority: normal | Milestone: 8.0.1 Component: Template Haskell | Version: 7.10.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #5290, #8347 | Differential Rev(s): Phab:D1603 Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): I've merged `TemplateHaskell: revive isStrict, notStrict and unpacked` to `ghc-8.0` as b8d32e2f620d4f70bc3fffb791676b3a56ca26bd. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10697#comment:25 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler
participants (1)
-
GHC