February 2017 - ghc-tickets

[GHC] #10626: Missed opportunity for SpecConstr
by GHC 10 Feb '17

10 Feb '17

#10626: Missed opportunity for SpecConstr -------------------------------------+------------------------------------- Reporter: simonpj | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Blocked By: Test Case: | Related Tickets: Blocking: | Differential Revisions: | -------------------------------------+------------------------------------- Look at `perf/should_run/T4830`. After `SpecConstr` and optimisation we finally get {{{ Rec { Main.foo_$s$wfoo1 [Occ=LoopBreaker] :: Int# -> Double -> Double -> Double# [GblId, Arity=3, Caf=NoCafRefs, Str=DmdType <L,1*U><L,U><L,U>] Main.foo_$s$wfoo1 = \ (sc_s4eN :: Int#) (sc1_s4eO :: Double) (sc2_s4eP :: Double) -> case sc_s4eN of ds_X1SR { __DEFAULT -> case sc1_s4eO of wild_a1Tf { D# x_a1Th -> case sc2_s4eP of wild1_a1Tj { D# y_a1Tl -> case tagToEnum# @ Bool (<=## x_a1Th y_a1Tl) of _ [Occ=Dead] { False -> Main.foo_$s$wfoo1 (-# ds_X1SR 1#) wild1_a1Tj wild_a1Tf; True -> Main.foo_$s$wfoo1 (-# ds_X1SR 1#) wild_a1Tf wild1_a1Tj } } }; 0# -> case sc1_s4eO of _ [Occ=Dead] { D# x_a1UL -> case sc2_s4eP of _ [Occ=Dead] { D# y_a1UP -> +## x_a1UL y_a1UP } } } end Rec } }}} If we ran `SpecConstr` again we'd specialise this function, because the recursive calls both have boxed arguments. I looked into why `SpecConstr` didn't catch it, and it's because `SpecConstr`'s input looks like this {{{ case case tagToEnum# @ Bool (<=## x_a1Th y_a1Tl) of _ [Occ=Dead] { False -> (wild1_a1Tj, wild_a1Tf); True -> wild_X8 } of r_s4e0 { (ipv_s4e1, ipv_s4e2) -> $wfoo_s4db (I# (-# ds_X1SR 1#)) (Just @ (Double, Double) r_s4e0) }}} Notice the case-of-case which doesn't expose the `Double` boxes of arguments to `$wfoo`. Why is that case-of-case still there? Because of `Note [Single- alternative cases]` in Simplify. Which is clearly a delicate spot so I don't want to meddle with it today. But it's intriguing. Maybe Sequent Core will do better. Note that late demand analysis also catches this case, yielding the (rather good) {{{ Rec { Main.$w$s$wfoo [InlPrag=[0], Occ=LoopBreaker] :: Int# -> Double# -> Double# -> Double# [GblId, Arity=3, Caf=NoCafRefs, Str=DmdType <S,1*U><L,U><L,U>] Main.$w$s$wfoo = \ (w_s4gW :: Int#) (ww_s4h1 :: Double#) (ww1_s4h5 :: Double#) -> case w_s4gW of ds_X1SW { __DEFAULT -> case tagToEnum# @ Bool (<=## ww_s4h1 ww1_s4h5) of _ [Occ=Dead] { False -> Main.$w$s$wfoo (-# ds_X1SW 1#) ww1_s4h5 ww_s4h1; True -> Main.$w$s$wfoo (-# ds_X1SW 1#) ww_s4h1 ww1_s4h5 }; 0# -> +## ww_s4h1 ww1_s4h5 } end Rec } }}} I'm pretty sure that late-demand-analysis should be on with `-O2` but someone should do a nofib run to check. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/10626> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 10

[GHC] #13149: Giving Backpack a Promotion
by GHC 10 Feb '17

10 Feb '17

#13149: Giving Backpack a Promotion -------------------------------------+------------------------------------- Reporter: ezyang | Owner: Type: task | Status: new Priority: normal | Milestone: Research needed Component: Compiler | Version: 8.1 (Type checker) | Keywords: backpack | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This ticket is tracking assumptions the current implementation of Backpack makes about terms and types, which may be violated when more and more term-level things start being lifted into the type level. I don't expect any work to be done on this in the near future, but I'd like to keep track of these breadcrumbs. * We currently assume that it is impossible for a typechecked-only module (that is, one with no Core unfoldings) to refer to a DFun or a coercion axiom. In the absence of promotion, I'm pretty sure this is the case, since there is no way to refer to a term from a type (DFun), and coercions do not ordinarily occur at the type level. With promotion, the situation is murkier. If I understand correctly, `CoercionTy` embeds coercions in types, so in principle it should be possible to end up with a type that refers to a coercion explicitly, when you promote a GADT. However, I haven't tried too hard to find an example source program where this happens. goldfire, perhaps you would know? I can probably turn it into a panic with GHC HEAD. * (Put more problems here) -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13149> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 5

[GHC] #13069: hs-boot files permit default methods in type class
by GHC 10 Feb '17

10 Feb '17

#13069: hs-boot files permit default methods in type class -------------------------------------+------------------------------------- Reporter: ezyang | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.1 (Type checker) | Keywords: backpack hs- | Operating System: Unknown/Multiple boot | Architecture: | Type of failure: GHC accepts Unknown/Multiple | invalid program Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- The documentation claims you are not allowed to do so but the compiler does not reject it. {{{ ezyang@sabre:~$ cat A.hs-boot module A where class C a where f :: a -> a f x = x ezyang@sabre:~$ ghc-head -c A.hs-boot -fforce-recomp ezyang@sabre:~$ ghc-head --version The Glorious Glasgow Haskell Compilation System, version 8.1.20161218 }}} The same problem applies to hsig files (which combust more spectacularly) -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13069> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 5

[GHC] #13067: Abstract closed type families don't work with Backpack
by GHC 10 Feb '17

10 Feb '17

#13067: Abstract closed type families don't work with Backpack -------------------------------------+------------------------------------- Reporter: ezyang | Owner: ezyang Type: bug | Status: new Priority: normal | Milestone: 8.2.1 Component: Compiler | Version: 8.1 (Type checker) | Keywords: backpack | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This should typecheck: {{{ {-# LANGUAGE TypeFamilies #-} unit p where module A where type family ClosedFam a where ClosedFam a = Int unit sig where signature A where type family ClosedFam a where .. unit main where dependency sig[A=p:A] }}} but instead we confusingly report: {{{ foo.bkp:9:9: error: Type constructor ‘ClosedFam’ has conflicting definitions in the module and its hsig file Main module: type family ClosedFam a :: * Hsig file: type family ClosedFam a :: * }}} -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13067> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 1

[GHC] #10681: Teach GHC to interpret all hs files as two types of hs-boot files (abstract types only/full types + values)
by GHC 10 Feb '17

10 Feb '17

#10681: Teach GHC to interpret all hs files as two types of hs-boot files (abstract types only/full types + values) -------------------------------------+------------------------------------- Reporter: ezyang | Owner: ezyang Type: feature | Status: new request | Priority: normal | Milestone: Component: Compiler | Version: 7.11 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Revisions: | -------------------------------------+------------------------------------- This is a new proposal for solving #1409. The big addition here is that we create **two** hs-boot files for each hs file: one that is a full hs-boot file to be imported by hs files to break loops, and a second which only includes abstract types for hs-boot files to import. C.f. #10679 **Discussion.** Here is a slightly goofy `hs-boot` file I've excerpted from GHC: {{{ module Packages where import {-# SOURCE #-} Module (PackageKey) import {-# SOURCE #-} DynFlags (DynFlags) packageKeyPackageIdString :: DynFlags -> PackageKey -> Maybe String }}} The `hs-boot` file must itself import `hs-boot` files, because this boot file is used by `Module` and `DynFlags`; without `{-# SOURCE #-}`, the boot file itself will participate in a cycle! But notice that there is something very interesting: a boot file is ONLY ever interested in importing other modules to get types. Never to import constructors or functions! We can use this observation to give us a mechanical transformation of an `hs` file to an `hs-boot` file, ASSUMING we can define a "second level" of `hs-boot` file to record our abstract types. **Example.** In this example, we have chosen to break the loop from `A`s import to `B`. {{{ module A where import {-# SOURCE #-} B data A = A B f :: A -> Bool f (A (B (A b))) = g b f _ = True module B where import A data B = B A g :: B -> Bool g (B (A (B b))) = f b g _ = False }}} The first-level `hs-boot`s are: {{{ module A where -- not actually used import {-# SOURCE 2 #-} B data A = A B f :: A -> Bool module B where import {-# SOURCE 2 #-} A data B = B A g :: B -> Bool }}} The second-level `hs-boot`s are: {{{ module A where data A module B where -- not actually used data B }}} **Commentary.** Here are some remarks: 1. Because we have to lift the transitive dependencies of anything we `{-# SOURCE #-}` import, it doesn't make sense to have a pragma which explicitly says what to put in the `hs-boot` file; instead, we just put in everything that we *can* handle in an `hs-boot` file (so exclude anything with missing type signatures, type families, etc.) Ideally, these automatic hs-boot files are generated lazily, but they should be reused as necessary. 2. This facility actually makes `{-# SOURCE #-}` a lot more attractive for increasing separate compilation: you can mark an import `{-# SOURCE #-}` to ensure that if its implementation changes, you don't have to recompile this module / you can build the module in parallel with that module. The downside is that when the imported file is modified, we have to regenerate the `hs-boot` stub before we conclude that the types have not changed (as opposed to with separate `hs-boot` files, where a modification to `hs` would not bump the timestamp on `hs-boot`. 3. This seems to definitely suggest that you should never need more than two levels of hs-boot nesting, or perhaps three with kinding. (But maybe someone has a fancy type system feature for which this is not true!) Maybe this applies to signature files too. 4. We can't force the first level of `hs-boot` files to be abstract types, for two reasons: (1) a source file importing the hs-boot file may really need the selector/constructor, and (2) the `hs-boot` files will reflect any cycles from the source files, that's no good! Rolling out to the second level breaks the cycle because abstract types never need any imports. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/10681> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 9

[GHC] #13248: Allow an injective type family RHS to be another injective type family
by GHC 09 Feb '17

09 Feb '17

#13248: Allow an injective type family RHS to be another injective type family -------------------------------------+------------------------------------- Reporter: mniip | Owner: Type: feature | Status: new request | Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 (Type checker) | Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Example use case: {{{#!hs {-# LANGUAGE TypeFamilies, TypeFamilyDependencies, UndecidableInstances #-} type family Foo a = r | r -> a where Foo Int = Char Foo Integer = String type family Bar a = r | r -> a where Bar Char = Double Bar String = Float type family Baz a = r | r -> a where Baz x = Bar (Foo x) }}} 8.0 says: {{{ test.hs:12:9: error: • Type family equation violates injectivity annotation. RHS of injective type family equation cannot be a type family: Baz x = Bar (Foo x) -- Defined at test.hs:12:9 • In the equations for closed type family ‘Baz’ In the type family declaration for ‘Baz’ }}} -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13248> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 2

[GHC] #13204: Core Lint error running testsuite with DEBUG way
by GHC 09 Feb '17

09 Feb '17

#13204: Core Lint error running testsuite with DEBUG way -------------------------------------+------------------------------------- Reporter: dobenour | Owner: Type: bug | Status: new Priority: normal | Milestone: 8.2.1 Component: Compiler | Version: 8.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I was testing Phab:D2996 for benchmarking purposes, and I noticed that some tests failed in the `ghci` way. I re-ran them with the `debug` way, and got a Core Lint failure: {{{ [1 of 1] Compiling Main ( StrictPats.hs, StrictPats.o ) *** Core Lint errors : in result of Simplifier *** <no location info>: warning: [RHS of q_s50e :: Addr#] Recursive or top-level binder has strict demand info: q_s50e Binder's demand info: <L,U> *** Offending Program *** $dIP_s50d :: CallStack [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 300 0}] $dIP_s50d = pushCallStack (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "undefined"#), SrcLoc (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "main"#)) (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "Main"#)) (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "StrictPats.hs"#)) (I# 27#) (I# 14#) (I# 27#) (I# 23#)) emptyCallStack ds_d4Z4 :: forall a. a [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] ds_d4Z4 = \ (@ a_a4SJ) -> undefined @ 'LiftedRep @ a ($dIP_s50d `cast` (Sym (N:IP[0] <"callStack">_N <CallStack>_N) :: (CallStack :: *) ~R# ((?callStack::CallStack) :: Constraint))) a :: Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] a = True b :: Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 330 10}] b = case \ (@ a_a4Hg) -> undefined @ 'LiftedRep @ a ((pushCallStack (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "undefined"#), SrcLoc (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "main"#)) (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "Main"#)) (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "StrictPats.hs"#)) (I# 32#) (I# 14#) (I# 32#) (I# 23#)) emptyCallStack) `cast` (Sym (N:IP[0] <"callStack">_N <CallStack>_N) :: (CallStack :: *) ~R# ((?callStack::CallStack) :: Constraint))) of { __DEFAULT -> True } c :: Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] c = True d :: Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 320 0}] d = case undefined @ 'LiftedRep @ Int ((pushCallStack (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "undefined"#), SrcLoc (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "main"#)) (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "Main"#)) (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "StrictPats.hs"#)) (I# 40#) (I# 17#) (I# 40#) (I# 26#)) emptyCallStack) `cast` (Sym (N:IP[0] <"callStack">_N <CallStack>_N) :: (CallStack :: *) ~R# ((?callStack::CallStack) :: Constraint))) of wild_00 { } e :: Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] e = True f :: Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 320 0}] f = case undefined @ 'IntRep @ Int# ((pushCallStack (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "undefined"#), SrcLoc (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "main"#)) (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "Main"#)) (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "StrictPats.hs"#)) (I# 48#) (I# 14#) (I# 48#) (I# 23#)) emptyCallStack) `cast` (Sym (N:IP[0] <"callStack">_N <CallStack>_N) :: (CallStack :: *) ~R# ((?callStack::CallStack) :: Constraint))) of wild_00 { } g :: Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] g = True h :: Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] h = True i :: Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 320 0}] i = case undefined @ ('TupleRep '['IntRep]) @ (# Int# #) ((pushCallStack (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "undefined"#), SrcLoc (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "main"#)) (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "Main"#)) (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "StrictPats.hs"#)) (I# 60#) (I# 20#) (I# 60#) (I# 29#)) emptyCallStack) `cast` (Sym (N:IP[0] <"callStack">_N <CallStack>_N) :: (CallStack :: *) ~R# ((?callStack::CallStack) :: Constraint))) of wild_00 { } j :: Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 100 0}] j = case irrefutPatError @ 'LiftedRep @ () "StrictPats.hs:64:9-21|True"# of wild_00 { } k :: Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] k = True l :: Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] l = True m :: Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 90 0}] m = case irrefutPatError @ 'LiftedRep @ () "StrictPats.hs:76:9-16|3#"# of wild_00 { } n :: Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 320 0}] n = case undefined @ ('TupleRep '['LiftedRep]) @ (# () #) ((pushCallStack (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "undefined"#), SrcLoc (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "main"#)) (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "Main"#)) (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "StrictPats.hs"#)) (I# 80#) (I# 14#) (I# 80#) (I# 23#)) emptyCallStack) `cast` (Sym (N:IP[0] <"callStack">_N <CallStack>_N) :: (CallStack :: *) ~R# ((?callStack::CallStack) :: Constraint))) of wild_00 { } o :: Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] o = True p :: Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] p = True q_s50e :: Addr# [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 110 0}] q_s50e = "StrictPats.hs:92:9-54|pattern binding"# q :: Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] q = patError @ 'LiftedRep @ Bool q_s50e r :: Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] r = True s :: Bool [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 340 10}] s = case \ (@ a_a3DN) -> let { ds_d4Xb :: (a) [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 320 0}] ds_d4Xb = case undefined @ ('TupleRep '['LiftedRep]) @ (# a #) ((pushCallStack (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "undefined"#), SrcLoc (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "main"#)) (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "Main"#)) (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "StrictPats.hs"#)) (I# 100#) (I# 20#) (I# 100#) (I# 29#)) emptyCallStack) `cast` (Sym (N:IP[0] <"callStack">_N <CallStack>_N) :: (CallStack :: *) ~R# ((?callStack::CallStack) :: Constraint))) of wild_00 { } } in ds_d4Xb of { __DEFAULT -> True } $trModule_s50h :: Addr# [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] $trModule_s50h = "main"# $trModule_s50g :: TrName [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] $trModule_s50g = TrNameS $trModule_s50h $trModule_s50j :: Addr# [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] $trModule_s50j = "Main"# $trModule_s50i :: TrName [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] $trModule_s50i = TrNameS $trModule_s50j $trModule :: Module [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $trModule = Module $trModule_s50g $trModule_s50i bad :: forall a. a -> IO () [LclIdX, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 400 60}] bad = \ (@ a_a4T7) (x_a3ed :: a) -> bindIO @ (Either SomeException a) @ () ($ @ 'LiftedRep @ (IO a) @ (IO (Either SomeException a)) (try @ SomeException @ a $fExceptionSomeException) (evaluate @ a x_a3ed)) (\ (r_a3qv :: Either SomeException a) -> case r_a3qv of { Left ds_d4Zg -> putStrLn (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "Exception thrown as expected."#)); Right ds_d4Zh -> putStrLn (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "Exception not thrown when expected."#)) }) ok :: forall a. a -> IO () [LclIdX, Arity=2, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 160 0}] ok = \ (@ a_a4U0) (x_a37y :: a) -> (\ (eta_B1 :: State# RealWorld) -> ((thenIO @ a @ () (evaluate @ a x_a37y) (putStrLn (build @ Char (\ (@ b_a503) -> unpackFoldrCString# @ b "Evaluation successful."#)))) `cast` (N:IO[0] <()>_R :: (IO () :: *) ~R# ((State# RealWorld -> (# State# RealWorld, () #)) :: *))) eta_B1) `cast` (Sym (N:IO[0] <()>_R) :: ((State# RealWorld -> (# State# RealWorld, () #)) :: *) ~R# (IO () :: *)) main_s5ge :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}] main_s5ge = ok @ Bool a main_s5gg :: IO () [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] main_s5gg = bad @ Bool b main_s5gi :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}] main_s5gi = ok @ Bool c main_s5gk :: IO () [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] main_s5gk = bad @ Bool d main_s5gm :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}] main_s5gm = ok @ Bool e main_s5go :: IO () [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] main_s5go = bad @ Bool f main_s5gq :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}] main_s5gq = ok @ Bool g main_s5gs :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}] main_s5gs = ok @ Bool h main_s5gu :: IO () [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] main_s5gu = bad @ Bool i main_s5gw :: IO () [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] main_s5gw = bad @ Bool j main_s5gy :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}] main_s5gy = ok @ Bool k main_s5gA :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}] main_s5gA = ok @ Bool l main_s5gC :: IO () [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] main_s5gC = bad @ Bool m main_s5gE :: IO () [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] main_s5gE = bad @ Bool n main_s5gG :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}] main_s5gG = ok @ Bool o main_s5gI :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}] main_s5gI = ok @ Bool p main_s5gK :: IO () [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] main_s5gK = bad @ Bool q main_s5gM :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}] main_s5gM = ok @ Bool r main_s5gN :: IO () [LclId, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] main_s5gN = bad @ Bool s main_s5gL :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 60}] main_s5gL = thenIO @ () @ () main_s5gM main_s5gN main_s5gJ :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 60}] main_s5gJ = thenIO @ () @ () main_s5gK main_s5gL main_s5gH :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 60}] main_s5gH = thenIO @ () @ () main_s5gI main_s5gJ main_s5gF :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 60}] main_s5gF = thenIO @ () @ () main_s5gG main_s5gH main_s5gD :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 60}] main_s5gD = thenIO @ () @ () main_s5gE main_s5gF main_s5gB :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 60}] main_s5gB = thenIO @ () @ () main_s5gC main_s5gD main_s5gz :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 60}] main_s5gz = thenIO @ () @ () main_s5gA main_s5gB main_s5gx :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 60}] main_s5gx = thenIO @ () @ () main_s5gy main_s5gz main_s5gv :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 60}] main_s5gv = thenIO @ () @ () main_s5gw main_s5gx main_s5gt :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 60}] main_s5gt = thenIO @ () @ () main_s5gu main_s5gv main_s5gr :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 60}] main_s5gr = thenIO @ () @ () main_s5gs main_s5gt main_s5gp :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 60}] main_s5gp = thenIO @ () @ () main_s5gq main_s5gr main_s5gn :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 60}] main_s5gn = thenIO @ () @ () main_s5go main_s5gp main_s5gl :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 60}] main_s5gl = thenIO @ () @ () main_s5gm main_s5gn main_s5gj :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 60}] main_s5gj = thenIO @ () @ () main_s5gk main_s5gl main_s5gh :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 60}] main_s5gh = thenIO @ () @ () main_s5gi main_s5gj main_s5gf :: IO () [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 60}] main_s5gf = thenIO @ () @ () main_s5gg main_s5gh main :: IO () [LclIdX, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 60}] main = thenIO @ () @ () main_s5ge main_s5gf main :: IO () [LclIdX, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}] main = runMainIO @ () main *** End of Offense *** <no location info>: error: Compilation had errors *** unexpected failure for StrictPats(debug) }}} I could not see how my patch to the interpreter would cause a Core Lint failure, so I am reporting this as a bug. CCing simonpj because this is either a bug in the typechecker, the desugarer, or a core-to-core optimization pass. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13204> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 4

[GHC] #13254: Confusing error message from GHCI - "defined in multiple files" shows the same file
by GHC 09 Feb '17

09 Feb '17

#13254: Confusing error message from GHCI - "defined in multiple files" shows the same file -------------------------------------+------------------------------------- Reporter: ocharles | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 8.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I just had the following very confusing exchange with GHCI: {{{ λ :load Ok, modules loaded: none. λ :load src/Application/Aws.hs Ok, modules loaded: Application.Aws (dist/build/Application/Aws.o). λ private <interactive>:3:1: error: Variable not in scope: private λ :m *Application.Aws module 'Application.Aws' is not interpreted; try ':add *Application.Aws' first λ :add *Application.Aws <no location info>: error: module ‘circuithub-api-0.0.4-EeGo4QUTODrB58BZrr3htj:Application.Aws’ is defined in multiple files: src/Application/Aws.hs src/Application/Aws.hs Failed, modules loaded: Application.Aws (dist/build/Application/Aws.o). λ :! ghc --version The Glorious Glasgow Haskell Compilation System, version 8.1.20161115 }}} This can really be simplified to {{{ λ :load src/Application/Aws.hs Ok, modules loaded: Application.Aws (dist/build/Application/Aws.o). λ :add *Application.Aws <no location info>: error: module ‘circuithub-api-0.0.4-EeGo4QUTODrB58BZrr3htj:Application.Aws’ is defined in multiple files: src/Application/Aws.hs src/Application/Aws.hs Failed, modules loaded: Application.Aws (dist/build/Application/Aws.o). }}} For the record, here is Application.Aws: {{{#!hs {-# LANGUAGE DeriveDataTypeable #-} module Application.Aws ( AwsExtra(..) ) where import Prelude import Data.Data (Data) import Data.ByteString.Char8 import Data.Text data AwsExtra = AwsExtra { awsKey :: ByteString , awsSecret :: ByteString , awsS3AssetsBucket :: Text } deriving (Show,Data) private :: Int private = 42 }}} -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13254> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 1

[GHC] #13158: Pattern synonyms should use type annotation information when typechecking
by GHC 09 Feb '17

09 Feb '17

#13158: Pattern synonyms should use type annotation information when typechecking -------------------------------------+------------------------------------- Reporter: lexi.lambda | Owner: Type: feature | Status: new request | Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 (Type checker) | Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: GHC rejects Unknown/Multiple | valid program Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- With a small boatload of GHC extensions, I can write a view pattern with `Data.Typeable` that will simulate something like case analysis on types: {{{#!hs {-# LANGUAGE GADTs, PatternSynonyms, ScopedTypeVariables, TypeApplications, TypeOperators, ViewPatterns #-} import Data.Typeable viewEqT :: forall b a. (Typeable a, Typeable b) => a -> Maybe ((a :~: b), b) viewEqT x = case eqT @a @b of Just Refl -> Just (Refl, x) Nothing -> Nothing evilId :: Typeable a => a -> a evilId (viewEqT @Int -> Just (Refl, n)) = n + 1 evilId (viewEqT @String -> Just (Refl, str)) = reverse str evilId x = x }}} However, this is ugly. I would like to clean things up with a nice pattern synonym: {{{#!hs pattern EqT :: forall b a. (Typeable a, Typeable b) => (a ~ b) => b -> a pattern EqT x <- (viewEqT @b -> Just (Refl, x)) }}} Sadly, while this pattern typechecks, using it seems to be impossible. This program is rejected: {{{#!hs evilId :: Typeable a => a -> a evilId (EqT (n :: Int)) = n + 1 evilId (EqT (str :: String)) = reverse str evilId x = x }}} Specifically, it produces the following type error: {{{ /private/tmp/wild-patterns-sandbox/library/TypeEqTest.hs:17:9: error: • Could not deduce (Typeable b0) arising from a pattern from the context: Typeable a bound by the type signature for: evilId :: Typeable a => a -> a at library/TypeEqTest.hs:16:1-30 The type variable ‘b0’ is ambiguous • In the pattern: EqT (n :: Int) In an equation for ‘evilId’: evilId (EqT (n :: Int)) = n + 1 /private/tmp/wild-patterns-sandbox/library/TypeEqTest.hs:17:14: error: • Could not deduce: a ~ Int from the context: a ~ b0 bound by a pattern with pattern synonym: EqT :: forall b a. (Typeable a, Typeable b) => a ~ b => b -> a, in an equation for ‘evilId’ at library/TypeEqTest.hs:17:9-22 ‘a’ is a rigid type variable bound by the type signature for: evilId :: forall a. Typeable a => a -> a at library/TypeEqTest.hs:16:11 Expected type: Int Actual type: b0 • When checking that the pattern signature: Int fits the type of its context: b0 In the pattern: n :: Int In the pattern: EqT (n :: Int) • Relevant bindings include evilId :: a -> a (bound at library/TypeEqTest.hs:17:1) /private/tmp/wild-patterns-sandbox/library/TypeEqTest.hs:18:9: error: • Could not deduce (Typeable b1) arising from a pattern from the context: Typeable a bound by the type signature for: evilId :: Typeable a => a -> a at library/TypeEqTest.hs:16:1-30 The type variable ‘b1’ is ambiguous • In the pattern: EqT (str :: String) In an equation for ‘evilId’: evilId (EqT (str :: String)) = reverse str /private/tmp/wild-patterns-sandbox/library/TypeEqTest.hs:18:14: error: • Could not deduce: a ~ String from the context: a ~ b1 bound by a pattern with pattern synonym: EqT :: forall b a. (Typeable a, Typeable b) => a ~ b => b -> a, in an equation for ‘evilId’ at library/TypeEqTest.hs:18:9-27 ‘a’ is a rigid type variable bound by the type signature for: evilId :: forall a. Typeable a => a -> a at library/TypeEqTest.hs:16:11 Expected type: String Actual type: b1 • When checking that the pattern signature: String fits the type of its context: b1 In the pattern: str :: String In the pattern: EqT (str :: String) • Relevant bindings include evilId :: a -> a (bound at library/TypeEqTest.hs:17:1) }}} I would expect the program to typecheck, since in any other context, GHC would not have any trouble inferring the type of `b` for each use of `EqT`. However, it seems that pattern synonyms do not allow me to provide any type information “in”, only get type information “out”. Is there some fundamental limitation that forces this to be the case, or is this just a missing feature? -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13158> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 5

[GHC] #11062: Type families + hs-boot files = panic
by GHC 09 Feb '17

09 Feb '17

#11062: Type families + hs-boot files = panic -------------------------------------+------------------------------------- Reporter: goldfire | Owner: Type: bug | Status: new Priority: high | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I have these modules: A.hs-boot: {{{ {-# LANGUAGE TypeFamilies #-} module A where type family F a }}} B.hs: {{{ {-# LANGUAGE TypeFamilies #-} module B where import {-# SOURCE #-} A type instance F Int = Bool }}} A.hs: {{{ {-# LANGUAGE TypeFamilies #-} module A where import B type family F a }}} And now this happens: {{{ rae:11:50:47 ~/temp/bug> ~/Documents/ghc-cur/inplace/bin/ghc-stage2 --version The Glorious Glasgow Haskell Compilation System, version 7.11.20151104 rae:11:50:50 ~/temp/bug> ~/Documents/ghc-cur/inplace/bin/ghc-stage2 -c A .hs-boot rae:11:50:52 ~/temp/bug> ~/Documents/ghc-cur/inplace/bin/ghc-stage2 -c B.hs rae:11:50:54 ~/temp/bug> ~/Documents/ghc-cur/inplace/bin/ghc-stage2 -c A.hs ghc-stage2: panic! (the 'impossible' happened) (GHC version 7.11.20151104 for x86_64-apple-darwin): tcIfaceGlobal (local): not found: F [] Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug rae:11:50:57 ~/temp/bug> }}} The problem occurs only in one-shot mode. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/11062> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 17