From ghc-devs at haskell.org Sat Sep 1 10:19:30 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 01 Sep 2018 10:19:30 -0000 Subject: [GHC] #15363: Do some cleaning up of the testsuite driver In-Reply-To: <045.a430f790c6974ee2b2076746bbbf1d29@haskell.org> References: <045.a430f790c6974ee2b2076746bbbf1d29@haskell.org> Message-ID: <060.c3f9a32255d5b15830503598469b0067@haskell.org> #15363: Do some cleaning up of the testsuite driver -------------------------------------+------------------------------------- Reporter: lantti | Owner: lantti Type: task | Status: closed Priority: low | Milestone: 8.8.1 Component: Test Suite | Version: 8.4.3 Resolution: wontfix | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5107 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Phyx-): > To issue 2.: I'd like to add that even timeout.hs itself is not fully functional at the moment, failing to handle interrupts signals, although winbindings.py doesn't do any better job either. Interrupting the test run on Windows works only because mintty simply kills our whole process tree without consulting our code at all, resulting in different but still effective end to the test run (compared to POSIX). The results for the tests already run won't get displayed in that case but fortunately this functionality doesn't strike me as essential. This isn't a testsuite problem. It's simply because mintty suppresses all windows signals in order to implement the pseudo posix signal handlers. Mintty is simply incompatible with windows programs. That's why interfaces like winpty exist but that are ultimately a hack. The simplest solution here is simply not to use mintty. Any other terminal emulator and call bash directly. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 1 12:04:26 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 01 Sep 2018 12:04:26 -0000 Subject: [GHC] #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite In-Reply-To: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> References: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> Message-ID: <061.d25ff15474c2fd97f03cbe74148fee45@haskell.org> #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Yes, I can reliably reproduce this on both machines I've tried on. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 1 14:11:18 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 01 Sep 2018 14:11:18 -0000 Subject: [GHC] #15590: Existentials in newtypes In-Reply-To: <046.bbb94a5d16ee9949a5e64de8def54494@haskell.org> References: <046.bbb94a5d16ee9949a5e64de8def54494@haskell.org> Message-ID: <061.e9fda315ecbb844878780c140c3ab293@haskell.org> #15590: Existentials in newtypes -------------------------------------+------------------------------------- Reporter: NioBium | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #1965 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => duplicate * related: => #1965 Comment: This is a duplicate of #1965, so I'll close this ticket in favor of that one. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 1 14:41:31 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 01 Sep 2018 14:41:31 -0000 Subject: [GHC] #15591: Inconsistent kind variable binder visibility between associated and non-associated type families Message-ID: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> #15591: Inconsistent kind variable binder visibility between associated and non- associated type families -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Keywords: | Operating System: Unknown/Multiple TypeApplications, TypeFamilies | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Consider the following program and GHCi session which uses it: {{{#!hs {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeFamilies #-} module Foo where import Data.Kind type family T1 (x :: f (a :: Type)) class C (a :: Type) where type T2 (x :: f a) }}} {{{ $ ghc2/inplace/bin/ghc-stage2 --interactive Foo.hs -fprint-explicit- foralls GHCi, version 8.7.20180831: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Foo ( Foo.hs, interpreted ) Ok, one module loaded. λ> :kind T1 T1 :: forall (f :: * -> *) a. f a -> * λ> :kind T2 T2 :: forall {a} (f :: * -> *). f a -> * }}} Something is strange about the visibility of `a` in the kinds of `T1` and `T2`. In `T1`, it's visible, but in `T2`, it's not! I would expect them to both be visible, since they were both mentioned by name in each type family's definition. This isn't of much importance at the moment, but it will be once visible kind application lands, as this bug will prevent anyone from instantiating the `a` in `T2` using a kind application. I indicated 8.5 as the version for this ticket since this behavior has changed since GHC 8.4, where you'd get the following: {{{ $ /opt/ghc/8.4.3/bin/ghci Foo.hs -fprint-explicit-foralls GHCi, version 8.4.3: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Foo ( Foo.hs, interpreted ) Ok, one module loaded. λ> :kind T1 T1 :: forall (f :: * -> *) a. f a -> * λ> :kind T2 T2 :: forall (f :: * -> *) a. f a -> * }}} Here, both `a`s are visible. However, it's still wrong in that `a` should be listed before `f` in `T2`'s telescope, since `a` was bound first (in `C`'s class head), before `f`. In that sense, the current behavior is a slight improvement, although we're not fully correct yet. The only difference between `T1` and `T2` is that `T2` is associated with a class, which suggests that there is some difference in code paths between the two that is accounting for this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 1 14:53:48 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 01 Sep 2018 14:53:48 -0000 Subject: [GHC] #15592: Type families without CUSKs cannot be given visible kind variable binders Message-ID: <050.651e6db8a709f8d5b684cf90e6873390@haskell.org> #15592: Type families without CUSKs cannot be given visible kind variable binders -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Keywords: | Operating System: Unknown/Multiple TypeApplications, TypeFamilies, | CUSKs | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Consider the following program and GHCi session which uses it: {{{ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeFamilies #-} module Foo where import Data.Kind type family T1 (x :: Type) (y :: a) :: Type where {} type family T2 x (y :: a) :: Type where {} }}} {{{ $ ghc2/inplace/bin/ghc-stage2 --interactive Foo.hs -fprint-explicit- foralls GHCi, version 8.7.20180831: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Foo ( Foo.hs, interpreted ) Ok, one module loaded. λ> :kind T1 T1 :: forall a. * -> a -> * λ> :kind T2 T2 :: forall {k} {a}. k -> a -> * }}} Note that `T1` quantifies `a` visibly whereas `T2` does not. I find this somewhat surprising, since both `T1` and `T2` explicitly mention `a` in their respective definitions. The only difference between the two is that `T1` has a CUSK while `T2` does not. This isn't of much importance at the moment, but it will be once visible kind application lands, as this will prevent anyone from instantiating the `a` in `T2` using a kind application. It's unclear to me whether this is intended behavior or not. I suppose there might be an unwritten rule that you can't use visible kind application on anything that doesn't have a CUSK, but if this really is the case, we should be upfront about it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 1 15:36:10 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 01 Sep 2018 15:36:10 -0000 Subject: [GHC] #15591: Inconsistent kind variable binder visibility between associated and non-associated type families In-Reply-To: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> References: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> Message-ID: <065.d889272c4e8f2dca5155cf86355753f6@haskell.org> #15591: Inconsistent kind variable binder visibility between associated and non- associated type families -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: | TypeApplications, TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): I have somewhat of an idea why this is happening. The [http://git.haskell.org/ghc.git/blob/565ef4cc036905f9f9801c1e775236bb007b026c:/compiler/rename/RnTypes.hs#l811 bindHsQTyVars] function appears to be partly to blame for this discrepancy. `bindHsQTyVars` (which works over type families, among other things) computes kind variables like so: {{{#!hs implicit_kvs = filter_occs rdr_env bndrs kv_occs }}} Where `filter_occs` is defined as: {{{#!hs filter_occs :: LocalRdrEnv -- In scope -> [Located RdrName] -- Bound here -> [Located RdrName] -- Potential implicit binders -> [Located RdrName] -- Final implicit binders -- Filter out any potential implicit binders that are either -- already in scope, or are explicitly bound here filter_occs rdr_env bndrs occs = filterOut is_in_scope occs where is_in_scope locc@(L _ occ) = isJust (lookupLocalRdrEnv rdr_env occ) || locc `elemRdr` bndrs }}} Note that this filters out any type variable names which appear in `rdr_env`. This environment contains all type variables that have already been bound, which includes any variables that were bound by the class head. Therefore, in our original example, the `a` in `class C (a :: Type)` ends up being filtered out entirely, so by the time we get to typechecking, GHC thinks that `a` is an invisible argument. One idea I had to fix this was to have `filter_occs` also return the class-bound variables so that they could be put at the front of the other kind variables. In other words, this patch: {{{#!diff diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index a78caaf..2163495 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -841,7 +841,7 @@ bindHsQTyVars doc mb_in_doc mb_assoc body_kv_occs hsq_bndrs thing_inside -- Make sure to list the binder kvs before the -- body kvs, as mandated by -- Note [Ordering of implicit variables] - implicit_kvs = filter_occs rdr_env bndrs kv_occs + (cls_bound_nms, implicit_kvs) = filter_occs rdr_env bndrs kv_occs -- Deleting bndrs: See Note [Kind- variable ordering] -- dep_bndrs is the subset of bndrs that are dependent -- i.e. appear in bndr/body_kv_occs @@ -858,13 +858,14 @@ bindHsQTyVars doc mb_in_doc mb_assoc body_kv_occs hsq_bndrs thing_inside ] ; implicit_kv_nms <- mapM (newTyVarNameRn mb_assoc) implicit_kvs + ; let all_implicit_nms = cls_bound_nms ++ implicit_kv_nms ; bindLocalNamesFV implicit_kv_nms $ bindLHsTyVarBndrs doc mb_in_doc mb_assoc hs_tv_bndrs $ \ rn_bndrs -> do { traceRn "bindHsQTyVars" (ppr hsq_bndrs $$ ppr implicit_kv_nms $$ ppr rn_bndrs) ; dep_bndr_nms <- mapM (lookupLocalOccRn . unLoc) dep_bndrs ; thing_inside (HsQTvs { hsq_ext = HsQTvsRn - { hsq_implicit = implicit_kv_nms + { hsq_implicit = all_implicit_nms , hsq_dependent = mkNameSet dep_bndr_nms } , hsq_explicit = rn_bndrs }) all_bound_on_lhs } } @@ -873,14 +874,25 @@ bindHsQTyVars doc mb_in_doc mb_assoc body_kv_occs hsq_bndrs thing_inside filter_occs :: LocalRdrEnv -- In scope -> [Located RdrName] -- Bound here -> [Located RdrName] -- Potential implicit binders - -> [Located RdrName] -- Final implicit binders + -> ([Name], [Located RdrName]) + -- (Class binders, final implicit binders) -- Filter out any potential implicit binders that are either -- already in scope, or are explicitly bound here filter_occs rdr_env bndrs occs - = filterOut is_in_scope occs + = partitionWith is_class_bound $ + filterOut is_implicit occs where - is_in_scope locc@(L _ occ) = isJust (lookupLocalRdrEnv rdr_env occ) - || locc `elemRdr` bndrs + is_class_bound :: Located RdrName + -> Either Name (Located RdrName) + -- Left: a class-bound name + -- Right: bound by the type family itself + is_class_bound locc@(L _ occ) = + case lookupLocalRdrEnv rdr_env occ of + Just n -> Left n + Nothing -> Right locc + + is_implicit :: Located RdrName -> Bool + is_implicit locc = locc `elemRdr` bndrs {- Note [bindHsQTyVars examples] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ }}} That fixes the original program, encouragingly enough: {{{ $ inplace/bin/ghc-stage2 --interactive ../Foo.hs -fprint-explicit-foralls GHCi, version 8.7.20180831: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Foo ( ../Foo.hs, interpreted ) Ok, one module loaded. λ> :kind T2 T2 :: forall a (f :: * -> *). f a -> * }}} However, there's a catch. This causes a single test from the test suite to fail: `T14131`. {{{ =====> T14131(normal) 1 of 1 [0, 0, 0] cd "indexed-types/should_compile/T14131.run" && "/home/rgscott/Software/ghc2/inplace/test spaces/ghc-stage2" -c T14131.hs -dcore-lint -dcmm-lint -no-user-package-db -rtsopts -fno-warn- missed-specialisations -fshow-warning-groups -fdiagnostics-color=never -fno-diagnostics-show-caret -dno-debug-output Compile failed (exit code 1) errors were: T14131.hs:29:3: error: • Type indexes must match class instance head Expected: ZT Actual: ZT Use -fprint-explicit-kinds to see the kind arguments • In the class declaration for ‘Z’ *** unexpected failure for T14131(normal) }}} For reference, here's the full definition of `ZT`: {{{#!hs class Z k where type ZT :: Maybe k type ZT = (Nothing :: Maybe k) }}} If you do use `-fprint-explicit-kinds`, the results aren't much more informative: {{{ [1 of 1] Compiling T14131 ( tests/indexed- types/should_compile/T14131.hs, interpreted ) tests/indexed-types/should_compile/T14131.hs:29:3: error: • Type indexes must match class instance head Expected: ZT k Actual: ZT k • In the class declaration for ‘Z’ | 29 | type ZT = (Nothing :: Maybe k) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ }}} I'm still not sure what's going on here—more investigation is required. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 1 18:59:04 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 01 Sep 2018 18:59:04 -0000 Subject: [GHC] #15576: Hadrian puts its build tree in the wrong place In-Reply-To: <046.775a5c9a9255ff4303e7bb0241f9c28d@haskell.org> References: <046.775a5c9a9255ff4303e7bb0241f9c28d@haskell.org> Message-ID: <061.125b042b30ffd0cb0cf6b0055bc57fd5@haskell.org> #15576: Hadrian puts its build tree in the wrong place -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by snowleopard): We have now removed the symlink traversal logic from Hadrian build scripts, so if you run `hadrian/build.sh` from `/playpen/ghc` the results will appear in `/playpen/ghc/_build`. Could you please check? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 1 20:19:17 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 01 Sep 2018 20:19:17 -0000 Subject: [GHC] #15591: Inconsistent kind variable binder visibility between associated and non-associated type families In-Reply-To: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> References: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> Message-ID: <065.4a0de4146df4a80c078dd68345066f3c@haskell.org> #15591: Inconsistent kind variable binder visibility between associated and non- associated type families -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: | TypeApplications, TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): If nothing else, `ZT` has shown me that my patch in comment:1 isn't sufficient to fix the underlying issue in the first place. If I comment out the default equation for `ZT`, then `:kind ZT` still gives me `forall {k}. Maybe k`, with or without the patch. Back to the drawing board... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 1 20:50:42 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 01 Sep 2018 20:50:42 -0000 Subject: [GHC] #15591: Inconsistent kind variable binder visibility between associated and non-associated type families In-Reply-To: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> References: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> Message-ID: <065.8902c1fa16b8c4013b26f6efe6473ee0@haskell.org> #15591: Inconsistent kind variable binder visibility between associated and non- associated type families -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: | TypeApplications, TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Oops, it just hit me why I was getting `forall {k}. Maybe k` for `ZT`'s kind even after the patch in comment:1 — `ZT` doesn't have a CUSK! (See #15592 for more on this point in particular.) If I change the definition to this: {{{#!hs class Z (k :: Type) where type ZT :: Maybe k type ZT = (Nothing :: Maybe k) }}} //Then// I get `forall k. Maybe k` for the kind of `ZT`, as expected, and the default definition is no longer rejected. Yay! But all is not well yet. There remains the mystery of why the CUSK-less version of `ZT` is being rejected after applying the patch in comment:1. One clue is that if I apply the patch in comment:1 (and comment out the default definition for `ZT`), then GHCi gives me the following kind for `Z`: {{{ Z :: forall {k}. k -> Constraint }}} This doesn't seem right, since without the patch, I get the following kind for `Z`: {{{ Z :: * -> Constraint }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 2 11:38:56 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 02 Sep 2018 11:38:56 -0000 Subject: [GHC] #15593: QuantifiedConstraints: trouble with type family Message-ID: <051.75163c16ae56c0dd5a46403a0d1e4aaa@haskell.org> #15593: QuantifiedConstraints: trouble with type family -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Keywords: | Operating System: Unknown/Multiple QuantifiedConstraints, | ConstraintKinds | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- {{{#!hs {-# Language KindSignatures, TypeFamilies, QuantifiedConstraints, FlexibleInstances #-} import Data.Kind data TreeF a b = T0 | T1 a | T2 b b -- from Data.Reify class MuRef (a :: Type) where type DeRef a :: Type -> Type class (forall xx. DeRef (tree xx) ~ TreeF xx) => MuRef1 tree instance (forall xx. DeRef (tree xx) ~ TreeF xx) => MuRef1 tree }}} fails with {{{ $ ~/code/qc-ghc/inplace/bin/ghc-stage2 --interactive -ignore-dot-ghci 351.hs GHCi, version 8.5.20180128: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( 351.hs, interpreted ) 351.hs:12:10: error: • Couldn't match type ‘DeRef (tree xx)’ with ‘TreeF xx’ arising from the superclasses of an instance declaration • In the instance declaration for ‘MuRef1 tree’ | 12 | instance (forall xx. DeRef (tree xx) ~ TreeF xx) => MuRef1 tree | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Failed, no modules loaded. Prelude> }}} ---- What I want to write: {{{#!hs {-# Language KindSignatures, TypeFamilies, QuantifiedConstraints, FlexibleInstances, DataKinds, TypeInType, MultiParamTypeClasses, UndecidableInstances, AllowAmbiguousTypes #-} import Data.Kind -- from Data.Reify class MuRef (a :: Type) where type DeRef a :: Type -> Type type T = Type type TT = T -> T type TTT = T -> TT class (forall xx. (MuRef (f xx), DeRef (f xx) ~ deRef1 f xx)) => MuRef1 (f :: TT) (deRef1 :: TT -> TTT) instance (forall xx. (MuRef (f xx), DeRef (f xx) ~ deRef1 f xx)) => MuRef1 (f :: TT) (deRef1 :: TT -> TTT) }}} where I am trying to capture [https://hackage.haskell.org/package/folds-0.7.4/docs/src/Data-Fold- Internal.html MuRef1 & DeRef1] {{{#!hs class MuRef1 (f :: TT) where type DeRef1 f :: TTT muRef1 :: proxy (f a) -> Dict (MuRef (f a), DeRef (f a) ~ DeRef1 f a) }}} ---- Workarounds: I think splitting the class alias & quantification does the job (I haven't tested it but it compiles), I want to know if the first two programs are meant to compile or not {{{#!hs {-# Language KindSignatures, TypeFamilies, QuantifiedConstraints, FlexibleInstances, DataKinds, TypeInType, MultiParamTypeClasses, UndecidableInstances, AllowAmbiguousTypes, FlexibleContexts #-} -- .. class (MuRef (f xx), DeRef (f xx) ~ deRef1 f xx) => MuRef1_ f deRef1 xx instance (MuRef (f xx), DeRef (f xx) ~ deRef1 f xx) => MuRef1_ f deRef1 xx class (forall xx. cls xx) => Forall cls instance (forall xx. cls xx) => Forall cls class Forall (MuRef1_ f deRef1) => MuRef1 f deRef1 instance Forall (MuRef1_ f deRef1) => MuRef1 f deRef1 }}} or as a regular type/constraint synonym (at the loss of partial application) {{{#!hs type MuRef1 f deRef1 = (forall xx. (MuRef (f xx), DeRef (f xx) ~ deRef1 f xx)) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 2 12:08:57 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 02 Sep 2018 12:08:57 -0000 Subject: [GHC] #13862: Optional "-v" not allowed with :load in GHCi In-Reply-To: <044.9738400eba372a90ccdc97dcca61b7c9@haskell.org> References: <044.9738400eba372a90ccdc97dcca61b7c9@haskell.org> Message-ID: <059.53b25882386cf63ac8e569b874316154@haskell.org> #13862: Optional "-v" not allowed with :load in GHCi -------------------------------------+------------------------------------- Reporter: vanto | Owner: RolandSenn Type: bug | Status: patch Priority: normal | Milestone: 8.8.1 Component: GHCi | Version: 8.0.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Incorrect | Test Case: make test error/warning at compile-time | TESTS="T13862a T13862b T13862c" Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5122 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RolandSenn): * status: new => patch * testcase: => make test TESTS="T13862a T13862b T13862c" * differential: => Phab:D5122 * milestone: => 8.8.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 2 12:15:14 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 02 Sep 2018 12:15:14 -0000 Subject: [GHC] #15593: QuantifiedConstraints: trouble with type family In-Reply-To: <051.75163c16ae56c0dd5a46403a0d1e4aaa@haskell.org> References: <051.75163c16ae56c0dd5a46403a0d1e4aaa@haskell.org> Message-ID: <066.e9daa2edf0f7c73fb53342446735ee53@haskell.org> #15593: QuantifiedConstraints: trouble with type family -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: | QuantifiedConstraints, | ConstraintKinds Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Unfortunately, this is going to work, since you can't quantify over constraints that are headed by `(~)`. See #15359. GHC HEAD at least gives you a slightly more informative error message about this: {{{ $ /opt/ghc/head/bin/ghci Bug.hs GHCi, version 8.7.20180827: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Main ( Bug.hs, interpreted ) Bug.hs:11:1: error: • Class ‘~’ does not support user-specified instances • In the quantified constraint ‘forall xx. DeRef (tree xx) ~ TreeF xx’ In the context: forall xx. DeRef (tree xx) ~ TreeF xx While checking the super-classes of class ‘MuRef1’ In the class declaration for ‘MuRef1’ | 11 | class (forall xx. DeRef (tree xx) ~ TreeF xx) => MuRef1 tree | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Bug.hs:12:10: error: • Class ‘~’ does not support user-specified instances • In the quantified constraint ‘forall xx. DeRef (tree xx) ~ TreeF xx’ In the instance declaration for ‘MuRef1 tree’ | 12 | instance (forall xx. DeRef (tree xx) ~ TreeF xx) => MuRef1 tree | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 2 13:05:24 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 02 Sep 2018 13:05:24 -0000 Subject: [GHC] #15593: QuantifiedConstraints: trouble with type family In-Reply-To: <051.75163c16ae56c0dd5a46403a0d1e4aaa@haskell.org> References: <051.75163c16ae56c0dd5a46403a0d1e4aaa@haskell.org> Message-ID: <066.e32cdc9732225e508a5b47a806365f89@haskell.org> #15593: QuantifiedConstraints: trouble with type family -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: | QuantifiedConstraints, | ConstraintKinds Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): Oh dear can of worms, what about the workaround then: does that compile on HEAD? I will have to read that ticket {{{#!hs {-# Language KindSignatures, TypeFamilies, QuantifiedConstraints, FlexibleInstances, DataKinds, TypeInType, MultiParamTypeClasses, UndecidableInstances, AllowAmbiguousTypes, FlexibleContexts #-} import Data.Kind class MuRef (a :: Type) where type DeRef a :: Type -> Type class (MuRef (f xx), DeRef (f xx) ~ deRef1 f xx) => MuRef1_ f deRef1 xx instance (MuRef (f xx), DeRef (f xx) ~ deRef1 f xx) => MuRef1_ f deRef1 xx class (forall xx. cls xx) => Forall cls instance (forall xx. cls xx) => Forall cls class Forall (MuRef1_ f deRef1) => MuRef1 f deRef1 instance Forall (MuRef1_ f deRef1) => MuRef1 f deRef1 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 2 13:07:46 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 02 Sep 2018 13:07:46 -0000 Subject: [GHC] #15593: QuantifiedConstraints: trouble with type family In-Reply-To: <051.75163c16ae56c0dd5a46403a0d1e4aaa@haskell.org> References: <051.75163c16ae56c0dd5a46403a0d1e4aaa@haskell.org> Message-ID: <066.251d31ba05c80b8722fc1310befdc858@haskell.org> #15593: QuantifiedConstraints: trouble with type family -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: | QuantifiedConstraints, | ConstraintKinds Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): The program you posted in comment:2 compiles in both GHC 8.6.1 and HEAD. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 2 21:16:03 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 02 Sep 2018 21:16:03 -0000 Subject: [GHC] #15515: Bogus "No instance" error when type families appear in kinds In-Reply-To: <050.0a7c38436bfa328034525623f7135078@haskell.org> References: <050.0a7c38436bfa328034525623f7135078@haskell.org> Message-ID: <065.1f5b0a5c87b64bd1cbb0a8b82379f97d@haskell.org> #15515: Bogus "No instance" error when type families appear in kinds -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.4.3 checker) | Keywords: TypeInType, Resolution: | TypeFamilies Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: 12564 | Blocking: Related Tickets: | Differential Rev(s): Phab:D5068 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Krzysztof Gogolewski ): In [changeset:"6dea7c161e458ddb3ea4afd366887c8d963c6585/ghc" 6dea7c1/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="6dea7c161e458ddb3ea4afd366887c8d963c6585" Reject class instances with type families in kinds Summary: GHC doesn't know how to handle type families that appear in class instances. Unfortunately, GHC didn't reject instances where type families appear in //kinds//, leading to #15515. This is easily rectified by calling `checkValidTypePat` on all arguments to a class in an instance (and not just the type arguments). Test Plan: make test TEST=T15515 Reviewers: bgamari, goldfire, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, carter GHC Trac Issues: #15515 Differential Revision: https://phabricator.haskell.org/D5068 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 2 21:16:03 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 02 Sep 2018 21:16:03 -0000 Subject: [GHC] #641: Cross platform repeatable RTS In-Reply-To: <057.b12a8fc75e6213cfaaf6278431b49a76@haskell.org> References: <057.b12a8fc75e6213cfaaf6278431b49a76@haskell.org> Message-ID: <072.a7001d5d057ea1ea16e3cc1fd5e290bd@haskell.org> #641: Cross platform repeatable RTS -----------------------------------+----------------------- Reporter: cgibbard@… | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Runtime System | Version: 6.4.1 Resolution: fixed | Keywords: Operating System: Linux | Architecture: x86 Type of failure: None/Unknown | -----------------------------------+----------------------- Changes (by Krzysztof Gogolewski ): * failure: => None/Unknown Comment: In [changeset:"ed789516e201e4fad771e5588da47a62e53b42b8/ghc" ed78951/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="ed789516e201e4fad771e5588da47a62e53b42b8" make iToBase62's inner loop stricter in one of its arguments Summary: hadrian's support for dynamic ways is currently broken (see hadrian#641 [1]). The stage 1 GHCs that hadrian produces end up producing bad code for the `iToBase62` function after a few optimisation passes. In the case where `quotRem` returns (overflowError, 0), GHC isn't careful enough to realise q is _|_ and happily inlines, distributes and floats code around until we end up trying to access index `minBound :: Int` of an array of 62 chars, as a result of inlining the definition of `quotRem` for Ints, in particular the minBound branch [2]. I will separately look into reproducing the bad transformation on a small self-contained example and filling a ticket. [1]: https://github.com/snowleopard/hadrian/issues/641 [2]: https://git.haskell.org/ghc.git/blob/HEAD:/libraries/base/GHC/Real.hs#l366 Test Plan: fixes hadrian#641 Reviewers: bgamari, tdammers Reviewed By: tdammers Subscribers: tdammers, rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5106 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 2 21:47:39 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 02 Sep 2018 21:47:39 -0000 Subject: [GHC] #15515: Bogus "No instance" error when type families appear in kinds In-Reply-To: <050.0a7c38436bfa328034525623f7135078@haskell.org> References: <050.0a7c38436bfa328034525623f7135078@haskell.org> Message-ID: <065.f00dbc4bea43ee06db76d09a70a9c4ce@haskell.org> #15515: Bogus "No instance" error when type families appear in kinds -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.4.3 checker) | Keywords: TypeInType, Resolution: fixed | TypeFamilies Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5068 Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: patch => closed * resolution: => fixed * blockedby: 12564 => -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 2 21:50:34 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 02 Sep 2018 21:50:34 -0000 Subject: [GHC] #15594: --abi-hash with Backpack incorrectly loads modules from dependent packages Message-ID: <045.e21f2218ffe754afd2fc42b07fceb19f@haskell.org> #15594: --abi-hash with Backpack incorrectly loads modules from dependent packages -------------------------------------+------------------------------------- Reporter: ezyang | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 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: -------------------------------------+------------------------------------- Repro at: https://github.com/alexbiehl/cabal-backpack-register- repro/blob/master/src/Lib.hs -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 2 22:22:53 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 02 Sep 2018 22:22:53 -0000 Subject: [GHC] #15575: Investigate Haskell rewrite of testsuite driver In-Reply-To: <047.17065377223303ab628d71f18b4e3b0e@haskell.org> References: <047.17065377223303ab628d71f18b4e3b0e@haskell.org> Message-ID: <062.826a571fb7eea6f6822ee5237fa35a3e@haskell.org> #15575: Investigate Haskell rewrite of testsuite driver -------------------------------------+------------------------------------- Reporter: tdammers | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Research | needed Component: Test Suite | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15363 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by lantti): I haven't yet given a proper look to exactly what we would need for the testsuite as whole, but from the actual test cases most (6033/6618) are using the test language and canned functionality provided by the testsuite driver and should be straight-forward to migrate automatically (for example by modifing the existing test language interpreter), some (577/6618) use their own makefiles to do various tasks that might need manual work or elevated levels of smartness to migrate. Few (8/6618) run plain bash commands that probably will be migrated manually just because writing the automation would take longer. For the driver code, I can't yet at this point even start guessing which tools would be the most suitable and which compatibility problems they would have between our supported platforms. Counting the number of special cases and workarounds in the current driver might not be the most fruitful way as our set of tools and libraries would be completely different and have different problem spots. I'll still need to do some reading... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 2 22:39:02 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 02 Sep 2018 22:39:02 -0000 Subject: [GHC] #8441: Allow family instances in an hs-boot file In-Reply-To: <047.1fa915ff10b87e82918754b9e5d340d2@haskell.org> References: <047.1fa915ff10b87e82918754b9e5d340d2@haskell.org> Message-ID: <062.92ba0e326454231184d23cd2798fe988@haskell.org> #8441: Allow family instances in an hs-boot file -------------------------------------+------------------------------------- Reporter: goldfire | Owner: ezyang Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.7 Resolution: | Keywords: backpack, | TypeFamilies, hs-boot Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by ezyang): * priority: low => normal Comment: Bumping priority. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 2 22:41:50 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 02 Sep 2018 22:41:50 -0000 Subject: [GHC] #15595: Stack overflow in withArgs leads to infinite memory-consuming loop Message-ID: <051.e7b5dc4635707a081473bd8c3f2b0afd@haskell.org> #15595: Stack overflow in withArgs leads to infinite memory-consuming loop --------------------------------------+---------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Keywords: | Operating System: Windows Architecture: x86_64 (amd64) | Type of failure: Runtime crash Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: --------------------------------------+---------------------------------- Given the program: {{{#!hs import System.Environment main :: IO () main = do putStrLn "Starting" withArgs (replicate 1000 "") $ return () }}} When run with: {{{ ghc --make WithArgsBug.hs -rtsopts && WithArgsBug +RTS -K1K }}} The program prints out "Starting", then loops forever, taking 1 CPU core and allocating memory (approx 1Gb per min), until the computer is unresponsive. The program does not respond to Ctrl-C and has to be killed from the task manager. The {{{-K1K}}} flag limits the stack to approx 33Kb. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 2 23:18:05 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 02 Sep 2018 23:18:05 -0000 Subject: [GHC] #13930: Cabal configure regresses in space/time In-Reply-To: <046.5b2c9cbc56e2d7d878c20dcde39f4651@haskell.org> References: <046.5b2c9cbc56e2d7d878c20dcde39f4651@haskell.org> Message-ID: <061.c25f935445352fc25fa9e191b6f9ece0@haskell.org> #13930: Cabal configure regresses in space/time -------------------------------------+------------------------------------- Reporter: bgamari | Owner: tdammers Type: bug | Status: closed Priority: highest | Milestone: 8.4.2 Component: Compiler | Version: 8.3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #13982, #5129 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: infoneeded => closed * resolution: => fixed Comment: Closing per [comment:20 comment:20]. Please reopen if this resurfaces. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 2 23:29:40 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 02 Sep 2018 23:29:40 -0000 Subject: [GHC] #14251: LLVM Code Gen messes up registers In-Reply-To: <047.9ece2514d7c7f668525c93ec15fb841a@haskell.org> References: <047.9ece2514d7c7f668525c93ec15fb841a@haskell.org> Message-ID: <062.7c7499cb24df50e49d70bd772250000a@haskell.org> #14251: LLVM Code Gen messes up registers -------------------------------------+------------------------------------- Reporter: angerman | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler (LLVM) | Version: 8.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * milestone: => 8.6.1 Comment: Setting a milestone to increase visibility. If we won't fix it in 8.6 I think this at least deserves a warning in release notes. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 00:36:41 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 00:36:41 -0000 Subject: [GHC] #15594: --abi-hash with Backpack incorrectly loads modules from dependent packages In-Reply-To: <045.e21f2218ffe754afd2fc42b07fceb19f@haskell.org> References: <045.e21f2218ffe754afd2fc42b07fceb19f@haskell.org> Message-ID: <060.8e1d239aa4c4b7f450f42a0cdaa0a1e6@haskell.org> #15594: --abi-hash with Backpack incorrectly loads modules from dependent packages -------------------------------------+------------------------------------- Reporter: ezyang | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: backpack Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5123 Wiki Page: | -------------------------------------+------------------------------------- Changes (by ezyang): * status: new => patch * differential: => Phab:D5123 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 03:23:03 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 03:23:03 -0000 Subject: [GHC] #8441: Allow family instances in an hs-boot file In-Reply-To: <047.1fa915ff10b87e82918754b9e5d340d2@haskell.org> References: <047.1fa915ff10b87e82918754b9e5d340d2@haskell.org> Message-ID: <062.f05936b23382c4cfa398fbbc8c9d8b8c@haskell.org> #8441: Allow family instances in an hs-boot file -------------------------------------+------------------------------------- Reporter: goldfire | Owner: ezyang Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.7 Resolution: | Keywords: backpack, | TypeFamilies, hs-boot Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by ezyang): So, this is actually not so trivial even for Backpack. The problem is that data families turn into a rather delicate constellation of interface declarations, and the way signature merging is written, I have to teach it how to hoover these all up BACK into (deduplciated) FamInsts, so that when I write it out to an interface for the final time, everything is kosher. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 05:37:04 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 05:37:04 -0000 Subject: [GHC] #15596: When a type application cannot be applied to an identifier due to the absence of an explicit type signature, let the error just say so! Message-ID: <046.646cb1a11d74c24248e8bbfec0172f60@haskell.org> #15596: When a type application cannot be applied to an identifier due to the absence of an explicit type signature, let the error just say so! -------------------------------------+------------------------------------- Reporter: kindaro | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Compiler | Version: 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: -------------------------------------+------------------------------------- Consider this code: {{{#!hs {-# language TypeApplications #-} module TypeApplicationsErrorMessage where f = (+) g = f @Integer }}} This is what happens when I try to compile it: {{{#!hs % ghc TypeApplicationsErrorMessage.hs [1 of 1] Compiling TypeApplicationsErrorMessage ( TypeApplicationsErrorMessage.hs, TypeApplicationsErrorMessage.o ) TypeApplicationsErrorMessage.hs:6:5: error: • Cannot apply expression of type ‘a0 -> a0 -> a0’ to a visible type argument ‘Integer’ • In the expression: f @Integer In an equation for ‘g’: g = f @Integer | 6 | g = f @Integer | ^^^^^^^^^^ }}} This error is easily fixed by supplying an explicit type signature to `f`. So, perhaps the error message could just say so? I am observing this with `The Glorious Glasgow Haskell Compilation System, version 8.6.0.20180810`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 08:06:18 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 08:06:18 -0000 Subject: [GHC] #15577: TypeApplications-related infinite loop (GHC 8.6+ only) In-Reply-To: <050.727e460d0083534afd4869db4aa81c30@haskell.org> References: <050.727e460d0083534afd4869db4aa81c30@haskell.org> Message-ID: <065.7065adffe49436379e2ce0210c6c4f25@haskell.org> #15577: TypeApplications-related infinite loop (GHC 8.6+ only) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.5 checker) | Keywords: Resolution: | TypeApplications, TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"2e226a46c422c12f78dc3d3f62fe5a15e22bd986/ghc" 2e226a46/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="2e226a46c422c12f78dc3d3f62fe5a15e22bd986" canCFunEqCan: use isTcReflexiveCo (not isTcReflCo) As Trac #15577 showed, it was possible for a /homo-kinded/ constraint to trigger the /hetero-kinded/ branch of canCFunEqCan, and that triggered an infinite loop. The fix is easier, but there remains a deeper questions: why is the flattener producing giant refexive coercions? }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 08:09:01 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 08:09:01 -0000 Subject: [GHC] #15577: TypeApplications-related infinite loop (GHC 8.6+ only) In-Reply-To: <050.727e460d0083534afd4869db4aa81c30@haskell.org> References: <050.727e460d0083534afd4869db4aa81c30@haskell.org> Message-ID: <065.106e5a6c1ab8c964a68326b7aab466e7@haskell.org> #15577: TypeApplications-related infinite loop (GHC 8.6+ only) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.5 checker) | Keywords: Resolution: | TypeApplications, TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): OK, I've committed a fix -- worth merging. BUT '''please leave the ticket open'''. Richard, Ningning: could you possibly look at whether there's a simple change to `flatten_args` that would eliminate these giant coercions ''in the case where there is literally no flattening to be done?''. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 08:29:10 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 08:29:10 -0000 Subject: [GHC] #15578: Honour INLINE pragmas on 0-arity bindings In-Reply-To: <046.e84edd9f62d6ef84f8f7c7aedfa45ace@haskell.org> References: <046.e84edd9f62d6ef84f8f7c7aedfa45ace@haskell.org> Message-ID: <061.185056892ffd288996c054bbac4cef09@haskell.org> #15578: Honour INLINE pragmas on 0-arity bindings -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15519 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Replying to [comment:7 simonpj]: > Great! Can you also confirm that this change makes `test3` (described in comment:11 of #15519, under "Workarounds") work as fast as `test0`; and does so > * Without removing the INLINE pragma on `testGrammar` > * Without removing the other uses of `testGrammar1` in (say) `test1` Unfortunately, `test3` is still almost as slow as without the patch: {{{ HEAD / test0 377.779049 HEAD / test1 7812.787996 HEAD / test3 7996.584027 patched / test0 372.0234 patched / test1 7540.029795 patched / test3 7654.089574 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 08:50:47 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 08:50:47 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.eccfde053004749c3bb0248ea3b0e456@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Yes, will do. Rebasing the whole thing on `HEAD` is going to be a bit hairy, but no show stopper. One thing I find remarkable is that `Set` doesn't do the existence test, but I guess that's just a matter of prioritizing CPU over RAM that turns out in our disadvantage in this specific case. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 09:11:21 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 09:11:21 -0000 Subject: [GHC] #15597: GHC shouting: panic! Message-ID: <043.c1da4adfeeafab12ccdd82f3e827803b@haskell.org> #15597: GHC shouting: panic! -------------------------------------+------------------------------------- Reporter: tstr | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1 Keywords: TypeInType | Operating System: Linux Architecture: x86_64 | Type of failure: Compile-time (amd64) | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This program makes the impossible happen: {{{#!hs {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeInType #-} import GHC.Types data Bug :: (f x -> Type) -> Type where Bug :: forall (r::h -> forall x. f x -> Type) (a::f x) . (r::((f x -> Type) -> Type) -> forall x. f x -> Type) Bug a -> Bug (r::f x -> Type) }}} And asked for reporting the error: {{{ ghc: panic! (the 'impossible' happened) (GHC version 8.4.1 for x86_64-unknown-linux): piResultTy k_aozeA[tau:1] (x_aozeN[sk:2] |> {co_aozeO}) Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1150:37 in ghc:Outputable pprPanic, called at compiler/types/Type.hs:950:35 in ghc:Type }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 09:18:06 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 09:18:06 -0000 Subject: [GHC] #15071: :set usage in ghci tests breaks platform independence of output In-Reply-To: <046.ca930388c371dd0f2b55a7ae0becdca1@haskell.org> References: <046.ca930388c371dd0f2b55a7ae0becdca1@haskell.org> Message-ID: <061.a0df51add0f1f95184e8339257d589d1@haskell.org> #15071: :set usage in ghci tests breaks platform independence of output -------------------------------------+------------------------------------- Reporter: bgamari | Owner: RolandSenn Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: Test Suite | Version: 8.2.2 Resolution: | Keywords: ci-breakage Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RolandSenn): * owner: (none) => RolandSenn Comment: I'll work on this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 09:45:54 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 09:45:54 -0000 Subject: [GHC] #15597: GHC shouting: panic! In-Reply-To: <043.c1da4adfeeafab12ccdd82f3e827803b@haskell.org> References: <043.c1da4adfeeafab12ccdd82f3e827803b@haskell.org> Message-ID: <058.2e1c2e0df6a24f1b1fdf38ff8d29d934@haskell.org> #15597: GHC shouting: panic! -------------------------------------+------------------------------------- Reporter: tstr | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.4.1 Resolution: duplicate | Keywords: TypeInType Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * resolution: => duplicate Comment: Thanks for reporting. Happily, there are [https://ghc.haskell.org/trac/ghc/search?q=piResultTy many other tickets] about `piResultTy`, all fixed so far as I know. And indeed, this one is fine in HEAD and with GHC 8.6. So I'll close this as a dup. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 10:21:50 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 10:21:50 -0000 Subject: [GHC] #15586: Compilation panic! (the 'impossible' happened) In-Reply-To: <047.72896e9fea2026e837542aaf516ad2e4@haskell.org> References: <047.72896e9fea2026e837542aaf516ad2e4@haskell.org> Message-ID: <062.50133a1d01c43ad236797c79c17cda31@haskell.org> #15586: Compilation panic! (the 'impossible' happened) -------------------------------------+------------------------------------- Reporter: subaruru | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15499 | Differential Rev(s): Phab:D5118 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 11:20:47 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 11:20:47 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.5c864b375b9989b3f2d9be1817fec01d@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): OK, I can confirm that the `1448-accum` version outperforms the `FV` baseline. I'll attempt a rebase now... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 11:50:07 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 11:50:07 -0000 Subject: [GHC] #15595: Stack overflow in withArgs leads to infinite memory-consuming loop In-Reply-To: <051.e7b5dc4635707a081473bd8c3f2b0afd@haskell.org> References: <051.e7b5dc4635707a081473bd8c3f2b0afd@haskell.org> Message-ID: <066.d312085a3db093a8c3df6fa987300367@haskell.org> #15595: Stack overflow in withArgs leads to infinite memory-consuming loop ----------------------------------+-------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 (amd64) Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------+-------------------------------------- Changes (by osa1): * version: 8.4.3 => 8.5 Comment: I did a little bit of debugging -- basically the RTS is throwing a stack overflow exception, but the mutator is then trying to allocate more stack space (maybe because stack overflow exception is somehow masked?), causing a loop. A different variant of this program exits with a stack overflow exception: {{{#!haskell {-# LANGUAGE ForeignFunctionInterface #-} import Foreign.C.Types import Foreign.C.String import Foreign.C import Foreign.Ptr import GHC.Foreign (withCStringsLen) foreign import ccall unsafe "setProgArgv" c_setProgArgv :: CInt -> Ptr CString -> IO () main :: IO () main = do putStrLn "Starting" withCStringsLen utf8 (replicate 1000 "") $ \len css -> do c_setProgArgv (fromIntegral len) css }}} Output: {{{ $ ./Main +RTS -K1K Starting Main: Stack space overflow: current size 33624 bytes. Main: Use `+RTS -Ksize -RTS' to increase it. }}} I don't know why the `withArgs` version doesn't fail with the same error yet, but I think `Note [Throw to self when masked]` is relevant. (Confirmed on GHC HEAD so updating the version) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 11:54:29 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 11:54:29 -0000 Subject: [GHC] #15595: Stack overflow in withArgs leads to infinite memory-consuming loop In-Reply-To: <051.e7b5dc4635707a081473bd8c3f2b0afd@haskell.org> References: <051.e7b5dc4635707a081473bd8c3f2b0afd@haskell.org> Message-ID: <066.435bc2bf04c3a8450f6df0942e7c2ff7@haskell.org> #15595: Stack overflow in withArgs leads to infinite memory-consuming loop ----------------------------------+-------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 (amd64) Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------+-------------------------------------- Comment (by osa1): Right, so this is because the thread is in masked state and stack overflow exception is not actually raised because of this. If I change the program above to this: {{{#!haskell {-# LANGUAGE ForeignFunctionInterface #-} import Foreign.C import Foreign.Ptr import GHC.Foreign (withCStringsLen) import GHC.IO.Encoding (utf8) import Control.Exception (mask_) foreign import ccall unsafe "setProgArgv" c_setProgArgv :: CInt -> Ptr CString -> IO () main :: IO () main = do putStrLn "Starting" mask_ $ withCStringsLen utf8 (replicate 1000 "") $ \len css -> do c_setProgArgv (fromIntegral len) css putStrLn "Done" }}} (only difference is that I added a `mask_`) this also loops. Not sure about what's the right thing to do here ... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 12:00:24 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 12:00:24 -0000 Subject: [GHC] #15595: Stack overflow in withArgs leads to infinite memory-consuming loop In-Reply-To: <051.e7b5dc4635707a081473bd8c3f2b0afd@haskell.org> References: <051.e7b5dc4635707a081473bd8c3f2b0afd@haskell.org> Message-ID: <066.fe3f7fd09be82157eab4e24d45d680d6@haskell.org> #15595: Stack overflow in withArgs leads to infinite memory-consuming loop ----------------------------------+-------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 (amd64) Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------+-------------------------------------- Comment (by osa1): The reason why the original code loops while my first example doesn't is because I don't use `getArgs`. `getArgs` calls this function: {{{#!haskell withProgArgv :: [String] -> IO a -> IO a withProgArgv new_args act = do pName <- System.Environment.getProgName existing_args <- System.Environment.getArgs bracket_ (setProgArgv new_args) (setProgArgv (pName:existing_args)) act }}} The `setProgArgv new_args` part is where we get a stack overflow, but it's evaluated in masked state because of `bracket_`: {{{#!haskell bracket_ before after thing = bracket before (const after) (const thing) bracket before after thing = mask $ \restore -> do a <- before r <- restore (thing a) `onException` after a _ <- after a return r }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 12:11:10 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 12:11:10 -0000 Subject: [GHC] #15592: Type families without CUSKs cannot be given visible kind variable binders In-Reply-To: <050.651e6db8a709f8d5b684cf90e6873390@haskell.org> References: <050.651e6db8a709f8d5b684cf90e6873390@haskell.org> Message-ID: <065.71f21ed3433fd674701075b4b29b0c01@haskell.org> #15592: Type families without CUSKs cannot be given visible kind variable binders -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | TypeApplications, TypeFamilies, | CUSKs Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Yes, I would expect * In T1 * a is `Specified` * In T2 * k is `Inferred` * a is `Specified` See `Note [TyVarBndrs, TyVarBinders, TyConBinders, and visibility]` in `TyCoRep`. Richard, what do you say? (This will start to bite when we get visible kind application.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 12:27:33 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 12:27:33 -0000 Subject: [GHC] #15591: Inconsistent kind variable binder visibility between associated and non-associated type families In-Reply-To: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> References: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> Message-ID: <065.001e37dcee076b8dc279a6d01f68600d@haskell.org> #15591: Inconsistent kind variable binder visibility between associated and non- associated type families -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: | TypeApplications, TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Let's agree the specification first. In this declaration {{{ class C (a :: Type) where type T2 (x :: f a) }}} Then `a` is `Required` for `C`, but presumably it is only `Specified` for `T2`? And what are the rules for Required/Specified/Inferred for type/class declarations that do not have a CUSK? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 12:29:44 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 12:29:44 -0000 Subject: [GHC] #15576: Hadrian puts its build tree in the wrong place In-Reply-To: <046.775a5c9a9255ff4303e7bb0241f9c28d@haskell.org> References: <046.775a5c9a9255ff4303e7bb0241f9c28d@haskell.org> Message-ID: <061.625b18bc08af9a3285373fe62adeac7f@haskell.org> #15576: Hadrian puts its build tree in the wrong place -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > Could you please check? How do I check? I assume I have to update Hadrian somehow? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 12:32:26 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 12:32:26 -0000 Subject: [GHC] #15595: Stack overflow in withArgs leads to infinite memory-consuming loop In-Reply-To: <051.e7b5dc4635707a081473bd8c3f2b0afd@haskell.org> References: <051.e7b5dc4635707a081473bd8c3f2b0afd@haskell.org> Message-ID: <066.fba99d7f4032bbedd634ad262a8e747e@haskell.org> #15595: Stack overflow in withArgs leads to infinite memory-consuming loop ----------------------------------+-------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 (amd64) Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------+-------------------------------------- Comment (by osa1): Here's another reproducer: {{{#!haskell import Control.Exception (mask_) main :: IO () main = mask_ (print (foldl (+) 0 [0 .. 1000000])) }}} If you remove `mask_` this fails with stack overflow (add `+RTS -K1K`). With `mask_` it gets stuck in the same loop as the original program. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 12:45:29 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 12:45:29 -0000 Subject: [GHC] #15591: Inconsistent kind variable binder visibility between associated and non-associated type families In-Reply-To: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> References: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> Message-ID: <065.677de4466ca4e8d091050619de9998d4@haskell.org> #15591: Inconsistent kind variable binder visibility between associated and non- associated type families -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: | TypeApplications, TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): For comment:4's `C`, I would expect {{{ C :: Type -> Constraint -- a is required, but it's not mentioned by name in the kind T2 :: forall (a :: Type) (f :: Type -> Type). f a -> Type }}} In `T2`'s kind, I've put `a` first, because it was already in scope. This parallels the fact that class variables are quantified before other variables in polymorphic methods. Both `a` and `f` should be `Specified`, as they are user-written. The various `Type`s in the kind of `T2` arise from the defaulting behavior of open type families (unchanged in this conversation). The specification of `Specified`/`Inferred` is very simple: if the user has written the variable name in the declaration, the variable is `Specified`. If not, it's `Inferred`. As for the patch: I would expect that the solution to this problem would be in the type-checker, not the renamer. As it stands, I'm pretty sure that the renamer identifies the `a` in these associated type definitions with the same unique as the `a` in the class. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 12:51:56 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 12:51:56 -0000 Subject: [GHC] #15589: Always promoting metavariables during type inference may be wrong In-Reply-To: <047.51146f5adc8f94aa92119170150b76d8@haskell.org> References: <047.51146f5adc8f94aa92119170150b76d8@haskell.org> Message-ID: <062.fe011498d2a4b7ae9d2010ad3a1e2a72@haskell.org> #15589: Always promoting metavariables during type inference may be wrong -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I don't understand your explanation of the problem, but I think I understand the problem you are explaining. Suppose we have {{{ let x :: forall a b (d :: a). SameKind (IfK c b d) d x = undefined in (x, blah) }}} I have changed the `in` part. At the occurrence of `x` are must instantiate x's type. But `x`'s type currently looks like {{{ x :: forall (a :: Type) (b :: kappa[i34]) (d :: a). }}} We can instantiate {{{ a :-> (alpha :: Type) d :-> (delta :: alpha) }}} but what about `b`? We can't possibly have `b :-> (beta :: kappa[i34])`! If we'd solved `kappa[i34] := a` (which will eventually happen), and done so before instantiating `x` at its call site, then we'd have instantiated `b` just like `d`. My conclusion: '''we cannot instantiate any type T from the environment that has any free "internal" unification variables''', where by "internal" mean ones that can be unified with type involving the quantified type variables of T. The current `zonkPromote` stuff achieves this by promoting such variables; but in exchange typing becomes order-dependent (bad), and cannot (currently) take advantage of "ambient" givens. For the order-dependence, instead of the `Refl` match, consider something like {{{ f (y::Proxy c) = ( let x :: forall a b (d :: a). SameKind (IfK c b d) d x = undefined in (x, blah) , y :: Proxy True)) }}} Here we discover that `c` (a unification variable) is `True`, but only after we've looked at the second component of the pair. Hmm. All I can think of is to delay the instantiation of `x` until its type has "settled". That would require us to add instantiation constraints, which we'll want eventually anyway --- impredicative polymorphism certainly requires this, for a very similar reason. I don't see how your "tyars in scope" thing deals with this at all. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 12:53:22 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 12:53:22 -0000 Subject: [GHC] #15591: Inconsistent kind variable binder visibility between associated and non-associated type families In-Reply-To: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> References: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> Message-ID: <065.543fd5d75366697e151b9becdce3b895@haskell.org> #15591: Inconsistent kind variable binder visibility between associated and non- associated type families -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: | TypeApplications, TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): >The specification of Specified/Inferred is very simple: if the user has written the variable name in the declaration, the variable is Specified. If not, it's Inferred. Regardless of CUSK or non-CUSK? I think so, but let's say so explicitly. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 12:56:01 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 12:56:01 -0000 Subject: [GHC] #15592: Type families without CUSKs cannot be given visible kind variable binders In-Reply-To: <050.651e6db8a709f8d5b684cf90e6873390@haskell.org> References: <050.651e6db8a709f8d5b684cf90e6873390@haskell.org> Message-ID: <065.c22b2815ff48e5b3ecc615c430d71f38@haskell.org> #15592: Type families without CUSKs cannot be given visible kind variable binders -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | TypeApplications, TypeFamilies, | CUSKs Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I agree with comment:1. If a user writes the name of the variable, it is `Specified`. Thus, `a` is specified (in both declarations). `k`, unmentioned, is `Inferred`. But I see some trouble ahead. Consider {{{#!hs data VisProxy k (a :: k) = MkVP class D (a :: Proxy j) (b :: Proxy k) c where meth1 :: forall z. D @j @k a b z => z -> Proxy '(a, b) meth2 :: Proxy k j -> Proxy '(a, b, c) }}} The constraint in `meth1` looks like it's redundantly specifying that `D` should be instantiated at `j` and `k`. I say "redundantly" because `D`, without a CUSK, cannot be polymorphically recursive. However, we discover in `meth2` that `j` actually depends on `k`. So (assuming inference succeeds at all, which I don't wish to debate here), we will get `D :: forall (k :: Type) (j :: k). Proxy j -> Proxy k -> Type -> Constraint`. (The `Type` in the third required argument to `D` comes from `z`'s kind in `meth1`.) Bottom line: any use of visible kind application should be considered to be an instance of polymorphic recursion, and thus should be banned in a mutually recursive group on a CUSK-less type. This is true even if the visible kind application is redundant. Do you agree? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 12:57:04 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 12:57:04 -0000 Subject: [GHC] #15591: Inconsistent kind variable binder visibility between associated and non-associated type families In-Reply-To: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> References: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> Message-ID: <065.5e36a7f2a680b5d0596cd7d8e535f392@haskell.org> #15591: Inconsistent kind variable binder visibility between associated and non- associated type families -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: | TypeApplications, TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Regardless of CUSK or non-CUSK. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 13:02:38 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 13:02:38 -0000 Subject: [GHC] #15592: Type families without CUSKs cannot be given visible kind variable binders In-Reply-To: <050.651e6db8a709f8d5b684cf90e6873390@haskell.org> References: <050.651e6db8a709f8d5b684cf90e6873390@haskell.org> Message-ID: <065.d945d2ec07be02c91b2d3a1aac193425@haskell.org> #15592: Type families without CUSKs cannot be given visible kind variable binders -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | TypeApplications, TypeFamilies, | CUSKs Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > Bottom line: any use of visible kind application should be considered to be an instance of polymorphic recursion. Yes, and we (presumably) have exactly same at the term level {{{ reverse (xs :: [a]) = ...(reverse @a ys).... }}} This is illegal. When type checking `reverse`'s RHS we have `reverse :: alpha` in the envt, and you can't type-apply that to anything. If we had a signature {{{ reverse :: [b] -> [b] reverse (xs :: [a]) = ...(reverse @a ys).... }}} that's fine, because the signature puts `reverse :: forall b. [b] -> [b]` into the envt. This might be a useful example to add to the user-manual documetation for visible type application. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 13:03:23 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 13:03:23 -0000 Subject: [GHC] #15591: Inconsistent kind variable binder visibility between associated and non-associated type families In-Reply-To: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> References: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> Message-ID: <065.c31c14628de5f42485909b0bb8ea464e@haskell.org> #15591: Inconsistent kind variable binder visibility between associated and non- associated type families -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: | TypeApplications, TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > Regardless of CUSK or non-CUSK. Good. So one action is to add that to the user manual. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 13:08:27 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 13:08:27 -0000 Subject: [GHC] #15589: Always promoting metavariables during type inference may be wrong In-Reply-To: <047.51146f5adc8f94aa92119170150b76d8@haskell.org> References: <047.51146f5adc8f94aa92119170150b76d8@haskell.org> Message-ID: <062.f040b599145af4f4de147c232869f0a6@haskell.org> #15589: Always promoting metavariables during type inference may be wrong -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): The "tyvars in scope" is a red herring. Or, rather, your approach of linking a unification var to its enclosing implication carries the same data, so there is no difference between our approaches. My comment:3 tersely suggested a way to allow `x`'s instantiation, even before everything has settled. It might be equivalent to your instantiation constraints -- hard to say. (Are these specified in the paper? I don't recall.) Consider this version: {{{ f (y::Proxy c) = let x :: forall a b (d :: a) z. z -> SameKind (IfK c b d) d x = undefined in (x (y :: Proxy True), blah) }}} Now, we get the key bit of information -- that `c` is `True` -- in an argument passed to `x`, which we cannot look at without instantiating `x`. (We need to instantiate `x` before looking at its arguments because perhaps `x` is higher-rank and we'll need to "push down" the polymorphic type of `x`'s argument. Indeed, I could have made my example higher-rank to demonstrate this, but didn't for simplicity.) If the instantiation constraints can handle this case, then they're likely equivalent to what I was thinking about in comment:3. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 13:10:24 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 13:10:24 -0000 Subject: [GHC] #15570: Core transformations generate bad indexCharOffAddr# call In-Reply-To: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> References: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> Message-ID: <063.f14a02e29a418dc5976f39327589e309@haskell.org> #15570: Core transformations generate bad indexCharOffAddr# call -------------------------------------+------------------------------------- Reporter: alpmestan | Owner: alpmestan Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alpmestan): ed789516e201e4fad771e5588da47a62e53b42b8 has been merged, it shows how I got GHC to generate correct code for `iToBase62`'s inner loop, fixing this particular instance of the problem in hadrian's case. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 13:14:18 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 13:14:18 -0000 Subject: [GHC] #15570: Core transformations generate bad indexCharOffAddr# call In-Reply-To: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> References: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> Message-ID: <063.31ef6c82455c49ff5611cfc845e5ac9d@haskell.org> #15570: Core transformations generate bad indexCharOffAddr# call -------------------------------------+------------------------------------- Reporter: alpmestan | Owner: alpmestan Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): A small repro case for the original bug would be super-helpful. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 13:26:13 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 13:26:13 -0000 Subject: [GHC] #15589: Always promoting metavariables during type inference may be wrong In-Reply-To: <047.51146f5adc8f94aa92119170150b76d8@haskell.org> References: <047.51146f5adc8f94aa92119170150b76d8@haskell.org> Message-ID: <062.3b07bcf0246d19e9c5e8cf9633903233@haskell.org> #15589: Always promoting metavariables during type inference may be wrong -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * cc: A.SerranoMena@… (added) Comment: I missed the bit about delayed substitution. Yes, maybe you could do that. It looks like a pretty major complication to me: an entirely new form of type (a delayed substitution) will all the knock-on effects that might ensue. Instantiation constraints would be less expressive but less drastic. They are described in [https://www.microsoft.com/en-us/research/publication /guarded-impredicative-polymorphism/ Guarded impredicative polymorphism] (PLDI'18). I'm adding Alejandro in cc. I'm not sure if the system in that paper could handle the higher rank case of delayed instantiation -- but I think so. The question remains: what to do in the short term. My instinct: '''reject the program'''. We can accept it later, but rejecting now is safe, and can easily be fixed by adding more type annotations. Anything else seems either (a) vulnerable to constraint-solving order or (b) extremely complicated in ill-understood ways. I think "reject the program" means "reject if any variables would be promoted by zonkPromote". -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 14:14:06 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 14:14:06 -0000 Subject: [GHC] #1965: Allow unconstrained existential contexts in newtypes In-Reply-To: <044.685803b9d3f1e49e57aaed63227984b8@haskell.org> References: <044.685803b9d3f1e49e57aaed63227984b8@haskell.org> Message-ID: <059.2030fbd156abdabedfed75b01d56dc20@haskell.org> #1965: Allow unconstrained existential contexts in newtypes -------------------------------------+------------------------------------- Reporter: guest | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 6.8.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): Note that `data A = A !Int` and `newtype A = A Int` have subtly different surface language semantics when they're pattern matched on. What would `case undefined of A _ -> 1` evaluate to? For newtypes, it's `1` whereas for strict data types this would blow up. I guess what I'm saying is: The suggested lowering must preserve `data` semantics and can never behave the same as actual `newtype`s. Semantically, `data` is `data` and `newtype` is `newtype`. It would get rid of the performance implications, though. See this reddit thread for a longer discussion: https://www.reddit.com/r/haskell/comments/6xri4d/whats_the_difference_between_newtype_type_and_data/dmi19pd -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 14:30:24 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 14:30:24 -0000 Subject: [GHC] #15071: :set usage in ghci tests breaks platform independence of output In-Reply-To: <046.ca930388c371dd0f2b55a7ae0becdca1@haskell.org> References: <046.ca930388c371dd0f2b55a7ae0becdca1@haskell.org> Message-ID: <061.26c7551875675e725a9a091e235c405f@haskell.org> #15071: :set usage in ghci tests breaks platform independence of output -------------------------------------+------------------------------------- Reporter: bgamari | Owner: RolandSenn Type: bug | Status: patch Priority: high | Milestone: 8.8.1 Component: Test Suite | Version: 8.2.2 Resolution: | Keywords: ci-breakage Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Windows: make | test TESTS="ghci057 T9293" Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:5125 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RolandSenn): * testcase: => Windows: make test TESTS="ghci057 T9293" * status: new => patch * differential: => Phab:5125 Comment: I checked Harbormaster build log 297356 (https://phabricator.haskell.org/harbormaster/log/view/297356/) of build 52621 (https://phabricator.haskell.org/harbormaster/build/52621/) from Sun, Sep 2, 5:14 PM and found the following: - Two ghci tests (''ghci057'' and ''T9293'') fail because of differences in the stdout file, as described in this ticket. The offending line in stdout is no longer ''-fexternal-dynamic-refs'' but ''-fghci-leak-check''. Both tests specify a ''-fno-ghci-leak-check'' flag, so it's Ok, that '':set'' does not list this flag. I uploaded a patch (https://phabricator.haskell.org/D5125) that changes the expected stdout files. - The test ''ghci024'' is working and does no longer fail. - Two other ghci tests (''T5975a'' and ''T5975b'') fail while setting up the test with ''pre-cmd(touch föøbàr1.hs''). I never encounter problems, when I use German Umlauts in file names. On my Windows machine both tests run successfully. I guess this is not a GHC error, but some issue with your CI machine. Maybe either Windows, MinGW or Python is outdated. On my machine I'm using: - Windows: Edition Windows 10 Home, version 1803, build 17134.228. - msys64: 20180531 - python: 3.6.6 Most of the many other failing tests are a plugin issues and have nothing to do with this ticket! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 14:49:51 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 14:49:51 -0000 Subject: [GHC] #15589: Always promoting metavariables during type inference may be wrong In-Reply-To: <047.51146f5adc8f94aa92119170150b76d8@haskell.org> References: <047.51146f5adc8f94aa92119170150b76d8@haskell.org> Message-ID: <062.7f4bb8c0806e8bd3d6695ff9d601af8e@haskell.org> #15589: Always promoting metavariables during type inference may be wrong -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I'm fine with rejecting such programs (if we agree that doing so is a small infelicity). But I'm totally unsure of how to do this. Your "reject if any variables would be promoted by `zonkPromote`" is wrong on two counts, I'm afraid: 1. The program in question in this ticket doesn't use `zonkPromote` at all -- it goes by way of `kindGeneralizeLocal`. So let's generalize your proposal to be "reject if any variables would be promoted by `zonkPromote` or `kindGeneralizeLocal`". 2. This proposal would reject too many programs. I replaced the `zonkPromoteType` with `zonkTcType` in pattern signatures and found 4 failures in the `typecheck` directory of the testsuite (`should_compile/tc150`, `should_compile/tc194`, `should_compile/tc211`, and `should_fail/tcfail104`). Here is `tc150`: {{{ f v = (\ (x :: forall a. a->a) -> True) id -- 'c' }}} The `RuntimeRep` unification variable in the kind of `a` must be promoted. The other uses of `zonkPromote` are similarly necessary for programs that have long been accepted. On the other hand, it's possible that skipping promotion in `kindGeneralizeLocal` (and just erroring instead) would work. Promotion there happens when there is a constrained unification variable in a type that we can't solve right away. Perhaps we just don't allow those. Simply skipping the promotion in the testsuite finds breakages (assertion failures) only in programs that we already reject, so this wouldn't lead to a regression. But on more thought, I don't think this (= don't promote in `kindGeneralizeLocal`) buys us anything. The goal is to make type checker order-independent. However, this change doesn't do that. In the examples we've been considering, we must take the case where `c` has been unified both before and after processing `x`'s signature. If `c` hasn't yet been unified, our new approach will reject `x`: good. But if `c` ''has'' been unified, the new approach will accept `x`: bad. Bottom line: I don't think it's so simple to detect this corner case. And I don't have a better idea right now, short of delayed substitutions. I don't think the delayed substitutions are really that bad, though. They would not, say, be a new constructor for `TcType`. Instead, they would only be a feature of `MetaTv`: any place but a unification variable can apply the substitution. Just about all our algorithms (e.g. unification) have to treat `MetaTv` specially already. The new treatment would simply apply the substitution as a part of the special processing. I'm not saying there is zero cost here, but that I think the complexity would be localized to `MetaTv` and functions that already process `MetaTv`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 15:01:55 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 15:01:55 -0000 Subject: [GHC] #15596: When a type application cannot be applied to an identifier due to the absence of an explicit type signature, let the error just say so! In-Reply-To: <046.646cb1a11d74c24248e8bbfec0172f60@haskell.org> References: <046.646cb1a11d74c24248e8bbfec0172f60@haskell.org> Message-ID: <061.cd8fc55452eb66e2a816221d853da4c6@haskell.org> #15596: When a type application cannot be applied to an identifier due to the absence of an explicit type signature, let the error just say so! -------------------------------------+------------------------------------- Reporter: kindaro | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): This is most certainly a reasonable request. I don't have time right now to look into how hard this would be to arrange, though... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 15:08:31 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 15:08:31 -0000 Subject: [GHC] #15176: Superclass `Monad m =>` makes program run 100 times slower In-Reply-To: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> References: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> Message-ID: <061.6733e4c3ad687ac14665d9bef5494b94@haskell.org> #15176: Superclass `Monad m =>` makes program run 100 times slower -------------------------------------+------------------------------------- Reporter: danilo2 | Owner: osa1 Type: bug | Status: new Priority: highest | Milestone: 8.8.1 Component: Compiler | Version: 8.4.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * owner: bgamari => osa1 Comment: I'll look into this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 15:12:50 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 15:12:50 -0000 Subject: [GHC] #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory In-Reply-To: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> References: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> Message-ID: <059.5293de5299a85fd427a03e84ce7c2df8@haskell.org> #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory -------------------------------------+------------------------------------- Reporter: int-e | Owner: osa1 Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * owner: (none) => osa1 Comment: I'll look into this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 15:18:42 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 15:18:42 -0000 Subject: [GHC] #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory In-Reply-To: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> References: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> Message-ID: <059.453d3b90fa487445ffcc6c3101b5cb73@haskell.org> #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory -------------------------------------+------------------------------------- Reporter: int-e | Owner: osa1 Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: GHCi | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * version: 8.4.3 => 8.5 Comment: Confirmed that GHCi 7.10.3 runs this in very little memory while GHC HEAD uses about 6G. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 15:25:05 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 15:25:05 -0000 Subject: [GHC] #15570: Core transformations generate bad indexCharOffAddr# call In-Reply-To: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> References: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> Message-ID: <063.3c3c9fa64c28d6551880d30d31e544fb@haskell.org> #15570: Core transformations generate bad indexCharOffAddr# call -------------------------------------+------------------------------------- Reporter: alpmestan | Owner: alpmestan Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I completed comment:3, but then fell over immediately: {{{ simonpj at cam-05-unx:~/tmp$ ~/code/HEAD-3/_build/stage0/bin/ghc -O -fPIC -dynamic -ddump-simpl T15570.hs [1 of 1] Compiling Bug ( T15570.hs, T15570.o ) T15570.hs:3:8: error: Bad interface file: /usr/local/lib/ghc-8.2.2/base-4.10.1.0/Prelude.dyn_hi mismatched interface file versions (wanted "80720180825", got "8022") | 3 | module Bug where | ^^^ T15570.hs:6:1: error: Bad interface file: /usr/local/lib/ghc-8.2.2/ghc- prim-0.5.1.1/GHC/Types.dyn_hi mismatched interface file versions (wanted "80720180825", got "8022") | 6 | import GHC.Types | ^^^^^^^^^^^^^^^^ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 15:25:15 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 15:25:15 -0000 Subject: [GHC] #15596: When a type application cannot be applied to an identifier due to the absence of an explicit type signature, let the error just say so! In-Reply-To: <046.646cb1a11d74c24248e8bbfec0172f60@haskell.org> References: <046.646cb1a11d74c24248e8bbfec0172f60@haskell.org> Message-ID: <061.31315576b1830d64eeb7989866087242@haskell.org> #15596: When a type application cannot be applied to an identifier due to the absence of an explicit type signature, let the error just say so! -------------------------------------+------------------------------------- Reporter: kindaro | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.4.3 checker) | Keywords: Resolution: | TypeApplications Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * keywords: => TypeApplications * failure: None/Unknown => Poor/confusing error message * version: => 8.4.3 * component: Compiler => Compiler (Type checker) * milestone: => 8.8.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 15:26:17 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 15:26:17 -0000 Subject: [GHC] #15570: Core transformations generate bad indexCharOffAddr# call In-Reply-To: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> References: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> Message-ID: <063.28cc6a3b30555f9095fd69f4626e96ba@haskell.org> #15570: Core transformations generate bad indexCharOffAddr# call -------------------------------------+------------------------------------- Reporter: alpmestan | Owner: alpmestan Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): New fact: the stage1 compiler works, however. But the stage0 version does not. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 15:31:35 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 15:31:35 -0000 Subject: [GHC] #15598: RebindableSyntax with RankNTypes and type class method call yields panic. Message-ID: <045.5abcb1896d3c45a60da77075360e380e@haskell.org> #15598: RebindableSyntax with RankNTypes and type class method call yields panic. -------------------------------------+------------------------------------- Reporter: romanb | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.3 Keywords: | Operating System: Linux RebindableSyntax, RankNTypes | Architecture: | Type of failure: Compile-time Unknown/Multiple | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- The following program in a file `ghc-panic.hs` {{{ {-# LANGUAGE GADTSyntax , RankNTypes , RebindableSyntax #-} import Prelude hiding ((>>=)) data InfDo where InfDo :: String -> (forall a. a -> InfDo) -> InfDo prog :: InfDo prog = do _ <- show (42 :: Int) prog where (>>=) = InfDo main :: IO () main = let x = prog in x `seq` return () }}} when loaded into GHCi yields {{{ λ> main ghc: panic! (the 'impossible' happened) (GHC version 8.4.3 for x86_64-unknown-linux): nameModule system $dShow_abfY Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1150:37 in ghc:Outputable pprPanic, called at compiler/basicTypes/Name.hs:241:3 in ghc:Name }}} and separate compilation yields {{{ $ ghc ghc-panic.hs [1 of 1] Compiling Main ( ghc-panic.hs, ghc-panic.o ) ghc: panic! (the 'impossible' happened) (GHC version 8.4.3 for x86_64-unknown-linux): StgCmmEnv: variable not found $dShow_a1qI local binds for: $tcInfDo $trModule $tcInfDo1_r1th $tcInfDo2_r1tH $trModule1_r1tI $trModule2_r1tJ $trModule3_r1tK $trModule4_r1tL sat_s1E4 Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1150:37 in ghc:Outputable pprPanic, called at compiler/codeGen/StgCmmEnv.hs:149:9 in ghc:StgCmmEnv }}} The problem disappears when either the rank-2 type is removed from `InfDo` or when the call to `show` is replaced by a static string. Besides 8.4.3, also reproduced with 8.6.0.20180714 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 15:32:30 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 15:32:30 -0000 Subject: [GHC] #15598: RebindableSyntax with RankNTypes and type class method call yields panic. In-Reply-To: <045.5abcb1896d3c45a60da77075360e380e@haskell.org> References: <045.5abcb1896d3c45a60da77075360e380e@haskell.org> Message-ID: <060.c0f1caab1f4cd2ae6258298770828855@haskell.org> #15598: RebindableSyntax with RankNTypes and type class method call yields panic. -------------------------------------+------------------------------------- Reporter: romanb | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | RebindableSyntax, RankNTypes Operating System: Linux | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by romanb: Old description: > The following program in a file `ghc-panic.hs` > > {{{ > > {-# LANGUAGE > GADTSyntax > , RankNTypes > , RebindableSyntax > #-} > > import Prelude hiding ((>>=)) > > data InfDo where > InfDo :: String -> (forall a. a -> InfDo) -> InfDo > > prog :: InfDo > prog = do > _ <- show (42 :: Int) > prog > where > (>>=) = InfDo > > main :: IO () > main = let x = prog in x `seq` return () > }}} > > when loaded into GHCi yields > > {{{ > λ> main > ghc: panic! (the 'impossible' happened) > (GHC version 8.4.3 for x86_64-unknown-linux): > nameModule > system $dShow_abfY > Call stack: > CallStack (from HasCallStack): > callStackDoc, called at compiler/utils/Outputable.hs:1150:37 in > ghc:Outputable > pprPanic, called at compiler/basicTypes/Name.hs:241:3 in ghc:Name > }}} > > and separate compilation yields > > {{{ > $ ghc ghc-panic.hs > [1 of 1] Compiling Main ( ghc-panic.hs, ghc-panic.o ) > ghc: panic! (the 'impossible' happened) > (GHC version 8.4.3 for x86_64-unknown-linux): > StgCmmEnv: variable not found > $dShow_a1qI > local binds for: > $tcInfDo > $trModule > $tcInfDo1_r1th > $tcInfDo2_r1tH > $trModule1_r1tI > $trModule2_r1tJ > $trModule3_r1tK > $trModule4_r1tL > sat_s1E4 > Call stack: > CallStack (from HasCallStack): > callStackDoc, called at compiler/utils/Outputable.hs:1150:37 in > ghc:Outputable > pprPanic, called at compiler/codeGen/StgCmmEnv.hs:149:9 in > ghc:StgCmmEnv > }}} > > The problem disappears when either the rank-2 type is removed from > `InfDo` or when the call to `show` is replaced by a static string. > > Besides 8.4.3, also reproduced with 8.6.0.20180714 New description: The following program in a file `ghc-panic.hs` {{{#!hs {-# LANGUAGE GADTSyntax , RankNTypes , RebindableSyntax #-} import Prelude hiding ((>>=)) data InfDo where InfDo :: String -> (forall a. a -> InfDo) -> InfDo prog :: InfDo prog = do _ <- show (42 :: Int) prog where (>>=) = InfDo main :: IO () main = let x = prog in x `seq` return () }}} when loaded into GHCi yields {{{ λ> main ghc: panic! (the 'impossible' happened) (GHC version 8.4.3 for x86_64-unknown-linux): nameModule system $dShow_abfY Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1150:37 in ghc:Outputable pprPanic, called at compiler/basicTypes/Name.hs:241:3 in ghc:Name }}} and separate compilation yields {{{ $ ghc ghc-panic.hs [1 of 1] Compiling Main ( ghc-panic.hs, ghc-panic.o ) ghc: panic! (the 'impossible' happened) (GHC version 8.4.3 for x86_64-unknown-linux): StgCmmEnv: variable not found $dShow_a1qI local binds for: $tcInfDo $trModule $tcInfDo1_r1th $tcInfDo2_r1tH $trModule1_r1tI $trModule2_r1tJ $trModule3_r1tK $trModule4_r1tL sat_s1E4 Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1150:37 in ghc:Outputable pprPanic, called at compiler/codeGen/StgCmmEnv.hs:149:9 in ghc:StgCmmEnv }}} The problem disappears when either the rank-2 type is removed from `InfDo` or when the call to `show` is replaced by a static string. Besides 8.4.3, also reproduced with 8.6.0.20180714 -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 15:34:12 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 15:34:12 -0000 Subject: [GHC] #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 In-Reply-To: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> References: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> Message-ID: <058.75464ff3bd830a9b5a25a2a98fb2038b@haskell.org> #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 -------------------------------------+------------------------------------- Reporter: noah | Owner: tdammers Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | accelerate,memory,compile Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: Compile-time | Test Case: accelerate performance bug | 1.2.0 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by tdammers): * owner: (none) => tdammers -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 15:34:30 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 15:34:30 -0000 Subject: [GHC] #15598: RebindableSyntax with RankNTypes and type class method call yields panic. In-Reply-To: <045.5abcb1896d3c45a60da77075360e380e@haskell.org> References: <045.5abcb1896d3c45a60da77075360e380e@haskell.org> Message-ID: <060.e433539ac34cd4626466b0684fb792e4@haskell.org> #15598: RebindableSyntax with RankNTypes and type class method call yields panic. -------------------------------------+------------------------------------- Reporter: romanb | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | RebindableSyntax, RankNTypes Operating System: Linux | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: 14963 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by romanb): * related: => 14963 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 15:36:34 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 15:36:34 -0000 Subject: [GHC] #15598: RebindableSyntax with RankNTypes and type class method call yields panic. In-Reply-To: <045.5abcb1896d3c45a60da77075360e380e@haskell.org> References: <045.5abcb1896d3c45a60da77075360e380e@haskell.org> Message-ID: <060.adb4e303bb81e259befddc487ee7843f@haskell.org> #15598: RebindableSyntax with RankNTypes and type class method call yields panic. -------------------------------------+------------------------------------- Reporter: romanb | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | RebindableSyntax, RankNTypes Operating System: Linux | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: 14963 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by romanb: Old description: > The following program in a file `ghc-panic.hs` > > {{{#!hs > > {-# LANGUAGE > GADTSyntax > , RankNTypes > , RebindableSyntax > #-} > > import Prelude hiding ((>>=)) > > data InfDo where > InfDo :: String -> (forall a. a -> InfDo) -> InfDo > > prog :: InfDo > prog = do > _ <- show (42 :: Int) > prog > where > (>>=) = InfDo > > main :: IO () > main = let x = prog in x `seq` return () > }}} > > when loaded into GHCi yields > > {{{ > λ> main > ghc: panic! (the 'impossible' happened) > (GHC version 8.4.3 for x86_64-unknown-linux): > nameModule > system $dShow_abfY > Call stack: > CallStack (from HasCallStack): > callStackDoc, called at compiler/utils/Outputable.hs:1150:37 in > ghc:Outputable > pprPanic, called at compiler/basicTypes/Name.hs:241:3 in ghc:Name > }}} > > and separate compilation yields > > {{{ > $ ghc ghc-panic.hs > [1 of 1] Compiling Main ( ghc-panic.hs, ghc-panic.o ) > ghc: panic! (the 'impossible' happened) > (GHC version 8.4.3 for x86_64-unknown-linux): > StgCmmEnv: variable not found > $dShow_a1qI > local binds for: > $tcInfDo > $trModule > $tcInfDo1_r1th > $tcInfDo2_r1tH > $trModule1_r1tI > $trModule2_r1tJ > $trModule3_r1tK > $trModule4_r1tL > sat_s1E4 > Call stack: > CallStack (from HasCallStack): > callStackDoc, called at compiler/utils/Outputable.hs:1150:37 in > ghc:Outputable > pprPanic, called at compiler/codeGen/StgCmmEnv.hs:149:9 in > ghc:StgCmmEnv > }}} > > The problem disappears when either the rank-2 type is removed from > `InfDo` or when the call to `show` is replaced by a static string. > > Besides 8.4.3, also reproduced with 8.6.0.20180714 New description: The following program in a file `ghc-panic.hs` {{{#!hs {-# LANGUAGE GADTSyntax , RankNTypes , RebindableSyntax #-} import Prelude hiding ((>>=)) data InfDo where InfDo :: String -> (forall a. a -> InfDo) -> InfDo prog :: InfDo prog = do _ <- show (42 :: Int) prog where (>>=) = InfDo main :: IO () main = let x = prog in x `seq` return () }}} when loaded into GHCi yields {{{ λ> main ghc: panic! (the 'impossible' happened) (GHC version 8.4.3 for x86_64-unknown-linux): nameModule system $dShow_abfY Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1150:37 in ghc:Outputable pprPanic, called at compiler/basicTypes/Name.hs:241:3 in ghc:Name }}} and separate compilation yields {{{ $ ghc ghc-panic.hs [1 of 1] Compiling Main ( ghc-panic.hs, ghc-panic.o ) ghc: panic! (the 'impossible' happened) (GHC version 8.4.3 for x86_64-unknown-linux): StgCmmEnv: variable not found $dShow_a1qI local binds for: $tcInfDo $trModule $tcInfDo1_r1th $tcInfDo2_r1tH $trModule1_r1tI $trModule2_r1tJ $trModule3_r1tK $trModule4_r1tL sat_s1E4 Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1150:37 in ghc:Outputable pprPanic, called at compiler/codeGen/StgCmmEnv.hs:149:9 in ghc:StgCmmEnv }}} The problem disappears when either the rank-2 type is removed from `InfDo` or when the call to `show` is replaced by a static string. Besides 8.4.3, also reproduced with 8.6.0.20180714. I believe it is somewhat related to [https://ghc.haskell.org/trac/ghc/ticket/14963] -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 15:45:59 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 15:45:59 -0000 Subject: [GHC] #14974: 2-fold memory usage regression GHC 8.2.2 -> GHC 8.4.1 compiling `mmark` package In-Reply-To: <042.6f9317183740e6c428dbe334554fec22@haskell.org> References: <042.6f9317183740e6c428dbe334554fec22@haskell.org> Message-ID: <057.53aff26ce66d916960ff604e2c7d5da4@haskell.org> #14974: 2-fold memory usage regression GHC 8.2.2 -> GHC 8.4.1 compiling `mmark` package -------------------------------------+------------------------------------- Reporter: hvr | Owner: davide Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: Compiler | Version: 8.4.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * milestone: => 8.8.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 15:49:05 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 15:49:05 -0000 Subject: [GHC] #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory In-Reply-To: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> References: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> Message-ID: <059.382ce3a74c2b7b00237cd11254c4169c@haskell.org> #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory -------------------------------------+------------------------------------- Reporter: int-e | Owner: osa1 Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: GHCi | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): This regression was introduced between 7.10 and 8.0, and reproducible with 8.4 and HEAD. I compared `+RTS -s` outputs of 7.10 and 8.4. 7.10: {{{ $ ./ghci +RTS -s GHCi, version 7.10.3: http://www.haskell.org/ghc/ :? for help λ:2> sequence_ (replicate 100000000 (return ())) λ:3> Leaving GHCi. 12,844,310,920 bytes allocated in the heap 26,753,232 bytes copied during GC 7,744,552 bytes maximum residency (6 sample(s)) 138,736 bytes maximum slop 18 MB total memory in use (0 MB lost due to fragmentation) Tot time (elapsed) Avg pause Max pause Gen 0 1806 colls, 0 par 0.155s 0.158s 0.0001s 0.0055s Gen 1 6 colls, 0 par 0.096s 0.126s 0.0211s 0.0415s TASKS: 4 (1 bound, 3 peak workers (3 total), using -N1) SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) INIT time 0.000s ( 0.002s elapsed) MUT time 4.065s ( 6.690s elapsed) GC time 0.251s ( 0.285s elapsed) EXIT time 0.020s ( 0.023s elapsed) Total time 4.365s ( 7.000s elapsed) Alloc rate 3,159,574,299 bytes per MUT second Productivity 94.3% of total user, 58.8% of total elapsed gc_alloc_block_sync: 0 whitehole_spin: 0 gen[0].sync: 0 gen[1].sync: 0 }}} 8.4: {{{ $ ghci +RTS -s GHCi, version 8.4.3: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/omer/rcbackup/.ghci λ:1> sequence_ (replicate 100000000 (return ())) λ:2> Leaving GHCi. 12,869,399,120 bytes allocated in the heap 13,233,009,504 bytes copied during GC 4,007,601,416 bytes maximum residency (14 sample(s)) 15,805,176 bytes maximum slop 8652 MB total memory in use (0 MB lost due to fragmentation) Tot time (elapsed) Avg pause Max pause Gen 0 209 colls, 0 par 3.455s 3.486s 0.0167s 0.4864s Gen 1 14 colls, 0 par 7.993s 10.629s 0.7592s 4.4344s TASKS: 4 (1 bound, 3 peak workers (3 total), using -N1) SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) INIT time 0.001s ( 0.001s elapsed) MUT time 4.252s ( 6.710s elapsed) GC time 11.448s ( 14.115s elapsed) EXIT time 0.000s ( 0.005s elapsed) Total time 15.701s ( 20.831s elapsed) Alloc rate 3,026,874,614 bytes per MUT second Productivity 27.1% of total user, 32.2% of total elapsed gc_alloc_block_sync: 0 whitehole_spin: 0 gen[0].sync: 0 gen[1].sync: 0 }}} Observations: - Productivity is 94% vs. 27% - Almost same amount of allocation in GHCs (very minor difference) - 500x max. residency in GHC 8.4 (7,744,552 vs. 4,007,601,416) So I think for some reason GHC 8.4 keeps retains more things which causes more GC cycles and longer pauses. I compared the byte codes generated by both versions and they're identical so I suspect this is either a problem with the interpreter code or some library function. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 15:56:48 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 15:56:48 -0000 Subject: [GHC] #15445: SPECIALIZE one of two identical functions does not fire well In-Reply-To: <047.c1676aaf78d977670954b9a4dbdf798e@haskell.org> References: <047.c1676aaf78d977670954b9a4dbdf798e@haskell.org> Message-ID: <062.7c996cf69154c5d9e66312159356d2cc@haskell.org> #15445: SPECIALIZE one of two identical functions does not fire well -------------------------------------+------------------------------------- Reporter: nobrakal | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: None/Unknown | Test Case: | simplCore/should_compile/T15445 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: closed => new * resolution: fixed => -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 15:59:25 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 15:59:25 -0000 Subject: [GHC] #15445: SPECIALIZE one of two identical functions does not fire well In-Reply-To: <047.c1676aaf78d977670954b9a4dbdf798e@haskell.org> References: <047.c1676aaf78d977670954b9a4dbdf798e@haskell.org> Message-ID: <062.bbc320b69d5589391b8f4a43edaec867@haskell.org> #15445: SPECIALIZE one of two identical functions does not fire well -------------------------------------+------------------------------------- Reporter: nobrakal | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: None/Unknown | Test Case: | simplCore/should_compile/T15445 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Ben had to revert this patch {{{ Revert "Don't inline functions with RULES too early" author Ben Gamari Wed, 1 Aug 2018 11:42:19 +0100 (06:42 -0400) committer Ben Gamari Wed, 1 Aug 2018 11:54:23 +0100 (06:54 -0400) This commit causes significant performance regressions: ``` bytes allocated value is too high: Expected T9872d(normal) bytes allocated: 578498120 +/-5% Lower bound T9872d(normal) bytes allocated: 549573214 Upper bound T9872d(normal) bytes allocated: 607423026 Actual T9872d(normal) bytes allocated: 677179968 Deviation T9872d(normal) bytes allocated: 17.1 % bytes allocated value is too high: Expected T9872c(normal) bytes allocated: 3096670112 +/-5% Lower bound T9872c(normal) bytes allocated: 2941836606 Upper bound T9872c(normal) bytes allocated: 3251503618 Actual T9872c(normal) bytes allocated: 3601872536 Deviation T9872c(normal) bytes allocated: 16.3 % bytes allocated value is too high: Expected T9872b(normal) bytes allocated: 3730686224 +/-5% Lower bound T9872b(normal) bytes allocated: 3544151912 Upper bound T9872b(normal) bytes allocated: 3917220536 Actual T9872b(normal) bytes allocated: 4374298272 Deviation T9872b(normal) bytes allocated: 17.3 % bytes allocated value is too high: Expected T9872a(normal) bytes allocated: 2729927408 +/-5% Lower bound T9872a(normal) bytes allocated: 2593431037 Upper bound T9872a(normal) bytes allocated: 2866423779 Actual T9872a(normal) bytes allocated: 3225788896 Deviation T9872a(normal) bytes allocated: 18.2 % ``` It's not clear that this was intentional so I'm going to revert for now. This reverts commit 2110738b280543698407924a16ac92b6d804dc36. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 16:11:56 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 16:11:56 -0000 Subject: [GHC] #15598: RebindableSyntax with RankNTypes and type class method call yields panic. In-Reply-To: <045.5abcb1896d3c45a60da77075360e380e@haskell.org> References: <045.5abcb1896d3c45a60da77075360e380e@haskell.org> Message-ID: <060.4960c2555040914e4e85703a3edc19b9@haskell.org> #15598: RebindableSyntax with RankNTypes and type class method call yields panic. -------------------------------------+------------------------------------- Reporter: romanb | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | RebindableSyntax, RankNTypes Operating System: Linux | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: 14963 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I think you are right in connecting it with #14963. But your example here is nothing to do with GHCi, nor with `-fdefer-type-errors`, so it's helpful. Lint complains immediately {{{ *** Core Lint errors : in result of Desugar (before optimization) *** : warning: In the expression: show @ Int $dShow_a1rx (I# 42#) $dShow_a1rx :: Show Int [LclId] is out of scope *** Offending Program *** Rec { $dMonad_a1rX :: Monad IO [LclId] $dMonad_a1rX = $fMonadIO $tcInfDo :: TyCon [LclIdX] $tcInfDo = TyCon 14827517540190131426## 17869035366104385648## $trModule (TrNameS "InfDo"#) 0# krep$* $trModule :: Module [LclIdX] $trModule = Module (TrNameS "main"#) (TrNameS "T15598"#) prog :: InfDo [LclIdX] prog = letrec { >>=_aW0 :: String -> (forall a. a -> InfDo) -> InfDo [LclId] >>=_aW0 = letrec { >>=_a1ri :: String -> (forall a. a -> InfDo) -> InfDo [LclId] >>=_a1ri = InfDo; } in >>=_a1ri; } in >>=_aW0 (show @ Int $dShow_a1rx (I# 42#)) (\ (@ a_a1rp) -> let { $dShow_a1rx :: Show Int [LclId] $dShow_a1rx = $fShowInt } in \ (ds_d1De :: a_a1rp) -> prog) main :: IO () [LclIdX] main = letrec { x_a1ca :: InfDo [LclId] x_a1ca = letrec { x_a1rI :: InfDo [LclId] x_a1rI = prog; } in x_a1rI; } in case x_a1ca of x_a1ca { __DEFAULT -> return @ IO $dMonad_a1rX @ () () } end Rec } *** End of Offense *** }}} This is pretty bad. It's all in `tcSyntaxOp`, I believe. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 16:49:28 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 16:49:28 -0000 Subject: [GHC] #15589: Always promoting metavariables during type inference may be wrong In-Reply-To: <047.51146f5adc8f94aa92119170150b76d8@haskell.org> References: <047.51146f5adc8f94aa92119170150b76d8@haskell.org> Message-ID: <062.e59aa26bdcf0e22f293a038d5218d364@haskell.org> #15589: Always promoting metavariables during type inference may be wrong -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > The goal is to make type checker order-independent. However, this change doesn't do that. Darn. You are right. Let's see. Let's think first about `kindGeneralizeLocal`. There are two cases: 1. All the lexically-scoped tyvars mentioned in the type were born as skolems. (By "born as skolems" I mean existentials and ones introduced by the 'foralls' of a type signature.) In that case I claim that "fail if zonkPromote would promote anything" is absolutely predictable, not order- dependent. 2. Some lexically-scoped tyvars were born as meta-tyvars. (Example: ones bound by pattern signatures.) In that case we may discover what type they stand for, adn order is important. Comment:4, `\(y :: Proxy c). blah` is an example. And you are right that if we find out what `c` is early, we'll solve that `If c kappa a ~ a` constraint really easily, and will never "see" a problem. So (short term solution, remember) maybe we should reject such programs outright. I have not yet thought about the non-generalised ones. For the medium term solution, I'm more inclined to the solution in [https://www.microsoft.com/en-us/research/publication/guarded- impredicative-polymorphism/ Guarded impredicative polymorphism], because it's fairly well worked out, and ''also'' addresses another problem (impredicativity). I don't have a clear picture of the ramifications of this delayed-substitution thing. (E.g. what does `alpha[ beta :-> ty ] ~ ty2` do?) It seems like a very big hammer for a corner case. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 17:46:05 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 17:46:05 -0000 Subject: [GHC] #14589: The isUpper function should return true for the '\9438' character In-Reply-To: <045.be5986892fedcb0c824c473665b75261@haskell.org> References: <045.be5986892fedcb0c824c473665b75261@haskell.org> Message-ID: <060.ded85766ee3b60d483019784715c251b@haskell.org> #14589: The isUpper function should return true for the '\9438' character -------------------------------------+------------------------------------- Reporter: mrkkrp | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: libraries/base | Version: 8.2.1 Resolution: | Keywords: unicode Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by lelf): * keywords: => unicode Comment: > I see how this is a bit unfortunate, but I am sure we should not change the semantics of isUpper . Why? It's broken. ⓞ is lowercase. Also it's wrong wrt title-cased ones. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 18:27:19 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 18:27:19 -0000 Subject: [GHC] #15570: Core transformations generate bad indexCharOffAddr# call In-Reply-To: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> References: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> Message-ID: <063.9e17b30d68c29d4ce5e2812166d6b42a@haskell.org> #15570: Core transformations generate bad indexCharOffAddr# call -------------------------------------+------------------------------------- Reporter: alpmestan | Owner: alpmestan Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): No I can repro, I can return to the OP. I'm deeply puzzled about the case-match on `GHC.Real.even3`. But leaving that aside, I'm not so sure that the Core shown in the Description is wrong. After all, suppose we made the call {{{ f -9223372036854775808 }}} Then we'd get into the `n<62` branch, so we'd call `chooseChar62` of that ridiculous number. So semantically, while the code is very strange, it's not actually wrong. '''So why do you get a link error'''? I think that is a bug all by itself. If I write {{{ x = C# (indexCharOffAddr# "foo"# -9223372036854775808#) }}} that might seg-fault at runtime, but it should not cause a link error. ------------------- How can stupid code like this arise? Consider {{{ h :: Int# -> Int# h x = let !t = case x of -1000# -> 4# _ -> x in t +# indexIntOffAddr# "foo"# x) }}} Notice that `h` unconditionally indexes the string with `x` (just like `f` does in the Description); presumably the caller is going to guaranteed that `x` is in bounds. That turns into {{{ h x = case (case x of { -1000 -> 4#; _ -> x }) of t -> t +# indexIntOffAddr# "foo"# x }}} Now case-of-case produces {{{ h x = case x of -1000 -> 4# +# indexIntOffAddr# "foo#" x _ -> x +# indexIntOffAddr# "foo#" x }}} But in the top branch we know that `x` is `-1000`, so we finally get {{{ h x = case x of -1000 -> 4# +# indexIntOffAddr# "foo#" -1000 _ -> x +# indexIntOffAddr# "foo#" x }}} This is, in essence, what is happening in the Description. And it should jolly well be fine. Of course, if the caller never calls the function with `-1000` as the argument, the top branch will never be executed. ------------------ So my claim so far is: the code is correct; and it's a bug that we get a linker error. However the code, while correct, is TERRIBLE. For this function (similar to Description, slightly simplified) {{{ go :: Int -> [Char] -> [Char] go n cs | n < 62 = let !c = chooseChar62 n in c : cs | otherwise = go q cs where !(q, _) = quotRem n 62 }}} HEAD produces the very civilised result {{{ Bug.$wgo [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: Int# -> [Char] -> (# Char, [Char] #) [GblId, Arity=2, Caf=NoCafRefs, Str=, Unf=OtherCon []] Bug.$wgo = \ (ww_s2Ag :: Int#) (w_s2Ad :: [Char]) -> case quotRemInt# ww_s2Ag 62# of { (# ipv_a2yf, ipv1_a2yg #) -> case <# ww_s2Ag 62# of { __DEFAULT -> Bug.$wgo ipv_a2yf w_s2Ad; 1# -> case indexCharOffAddr# lvl_r2Bs ww_s2Ag of wild_X4 { __DEFAULT -> (# GHC.Types.C# wild_X4, w_s2Ad #) } } } }}} while the Hadrian build produces the horrible code similar to that above. I'll look at that next. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 18:46:03 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 18:46:03 -0000 Subject: [GHC] #8763: forM_ [1..N] does not get fused (allocates 50% more) In-Reply-To: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> References: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> Message-ID: <057.28bb7d976957ddbd181e2c2cb56ff3f4@haskell.org> #8763: forM_ [1..N] does not get fused (allocates 50% more) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #7206 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): It turns out that the implementation from comment:60 doesn't get rid of the problem. It seems that the hard earned single call to `c` in `emit True x = I# x \`c\` emit next_ok next` gets duplicated because of case-of- case. The relevant Core began as this expression: {{{ case (case ==# next_ovf_a3hz delta_ovf_a3h0 of lwild_s4fL { __DEFAULT -> GHC.Types.False 1# -> b_a2jS }) of next_ok_a2k8 { __DEFAULT -> c_a2jU (GHC.Types.I# ds_d42Y) (emit_a3hf next_ok_a2k8 next_a3hx) } }}} Now case-of-case comes along and immediately simplifies this to {{{ case ==# next_ovf_a3hz delta_ovf_a3h0 of { __DEFAULT -> case b_a2jS of { __DEFAULT -> c_a2jU (GHC.Types.I# ds_d42Y) (emit_a3hf GHC.Types.False next_a3hx) }; 1# -> case b_a2jS of next_ok_a2k8 { __DEFAULT -> c_a2jU (GHC.Types.I# ds_d42Y) (emit_a3hf next_ok_a2k8 next_a3hx) } } }}} I'm not sure if the intermediate join point is never generated or is just inlined immediately, but I'd very much like this not to duplicate the call to `c`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 18:50:29 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 18:50:29 -0000 Subject: [GHC] #15570: Core transformations generate bad indexCharOffAddr# call In-Reply-To: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> References: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> Message-ID: <063.5b72e6cb49053fe101fcf3a0e19aa717@haskell.org> #15570: Core transformations generate bad indexCharOffAddr# call -------------------------------------+------------------------------------- Reporter: alpmestan | Owner: alpmestan Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): OK, with some help from Andrey I added to `hadrian/src/UserSettings.hs` {{{ verboseCommand :: Predicate verboseCommand = input "//*.hs" }}} Now if I touch `GHC/Real.hs` I get its command line, which is super- helpful; so I can compile with changing flags. Turns out that the reason for the strange `GHC.Real.even3` is that we have {{{ GHC.Real.even4 :: Int GHC.Real.even4 = GHC.Types.I# 1# -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} GHC.Real.even3 :: Int GHC.Real.even3 = negate @ Int GHC.Num.$fNumInt GHC.Real.even4 }}} Wny aren't we negating that constant? '''Turns out that it's because we aren't optimising `GHC.Num`'''!!! It's not surprising that we get terrible code. Here are the command lines printed by Hadrian for `GHC.Num` and `GHC.Real` {{{ -- GHC.Real. Notice that it finishes with -O _build/stage0/bin/ghc -Wall -hisuf dyn_hi -osuf dyn_o -hcsuf dyn_hc -fPIC -dynamic -hide-all-packages -no-user-package-db '-package-db _build/stage1/lib/package.conf.d' '-this-unit-id base-4.12.0.0' '-package- id ghc-prim-0.5.3' '-package-id integer-gmp-1.0.2.0' '-package-id rts-1.0' -i -i_build/stage1/libraries/base/build -i_build/stage1/libraries/base/build/autogen -ilibraries/base/. -Iincludes -I_build/generated -I_build/stage1/libraries/base/build -I_build/stage1/libraries/base/build/include -Ilibraries/base/include -I/home/simonpj/code/HEAD-3/_build/stage1/lib/x86_64-linux- ghc-8.7.20180825/integer-gmp-1.0.2.0/include -I/home/simonpj/code/HEAD-3/_build/stage1/lib/x86_64-linux- ghc-8.7.20180825/rts-1.0/include -I_build/generated -optc- I_build/generated -optP-include -optP_build/stage1/libraries/base/build/autogen/cabal_macros.h -optc-fno- stack-protector -optP-DOPTIMISE_INTEGER_GCD_LCM -odir _build/stage1/libraries/base/build -hidir _build/stage1/libraries/base/build -stubdir _build/stage1/libraries/base/build -Wnoncanonical-monad-instances -optc- Werror=unused-but-set-variable -optc-Wno-error=inline -c libraries/base/GHC/Real.hs -o _build/stage1/libraries/base/build/GHC/Real.dyn_o -O0 -H64m -this-unit-id base -Wcompat -Wnoncanonical-monad-instances -XHaskell2010 -ghcversion- file=/home/simonpj/code/HEAD-3/_build/generated/ghcversion.h -O -Wno- deprecated-flags -Wno-trustworthy-safe -- GHC.Num. The -O is there but it's overridden with -O0 _build/stage0/bin/ghc -Wall -hisuf dyn_hi -osuf dyn_o -hcsuf dyn_hc -fPIC -dynamic -hide-all-packages -no-user-package-db '-package-db _build/stage1/lib/package.conf.d' '-this-unit-id base-4.12.0.0' '-package- id ghc-prim-0.5.3' '-package-id integer-gmp-1.0.2.0' '-package-id rts-1.0' -i -i_build/stage1/libraries/base/build -i_build/stage1/libraries/base/build/autogen -ilibraries/base/. -Iincludes -I_build/generated -I_build/stage1/libraries/base/build -I_build/stage1/libraries/base/build/include -Ilibraries/base/include -I/home/simonpj/code/HEAD-3/_build/stage1/lib/x86_64-linux- ghc-8.7.20180825/integer-gmp-1.0.2.0/include -I/home/simonpj/code/HEAD-3/_build/stage1/lib/x86_64-linux- ghc-8.7.20180825/rts-1.0/include -I_build/generated -optc- I_build/generated -optP-include -optP_build/stage1/libraries/base/build/autogen/cabal_macros.h -optc-fno- stack-protector -optP-DOPTIMISE_INTEGER_GCD_LCM -odir _build/stage1/libraries/base/build -hidir _build/stage1/libraries/base/build -stubdir _build/stage1/libraries/base/build -Wnoncanonical-monad-instances -optc- Werror=unused-but-set-variable -optc-Wno-error=inline -c libraries/base/GHC/Num.hs -o _build/stage1/libraries/base/build/GHC/Num.dyn_o -O0 -H64m -this-unit-id base -Wcompat -Wnoncanonical-monad-instances -XHaskell2010 -ghcversion- file=/home/simonpj/code/HEAD-3/_build/generated/ghcversion.h -O -O0 -fno- ignore-interface-pragmas -Wno-deprecated-flags -Wno-trustworthy-safe }}} Blimey. With `make` we'd be stuck: who is adding that `-O0`? But with Hadrian and it's provenance tracking, it should be easy. But I have no idea where to start: Andrey, Alp, over to you. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 18:53:09 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 18:53:09 -0000 Subject: [GHC] #15599: typeclass inference depends on whether a module is exposed. Message-ID: <047.dd916b476f2fd0f26c1766607c70f5c2@haskell.org> #15599: typeclass inference depends on whether a module is exposed. -------------------------------------+------------------------------------- Reporter: gleachkr | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.3 Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Linux Architecture: | Type of failure: Incorrect result Unknown/Multiple | at runtime Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- My first bug report for GHC: I've found some strange behavior in GHC 8.2.2 relating to typeclass inference. Essentially, for two identical modules, GHC infers for one of them that one typeclass instance applies, and for another that a different instance applies. The only language extensions involved are FlexibleInstances, MultiParamTypeClasses, GADTs, and ScopedTypeVariables. There are no INCOHERENT pragmas involved. The only difference between the two modules is that one of them (the one displaying correct typeclass inference) is an exposed module, while the other is not mentioned in the cabal file. The phenomenon affects other packages that import the original package---they display the incorrect behavior, rather than the correct behavior that the exposed module displays. The original discussion is here: [https://github.com/gleachkr/Carnap/issues/4] My best attempt at a minimal example can be found at [https://github.com/gleachkr/GHC-Repro]. You can run the "test.sh" script included there to see the phenomenon in action. I don't see this behavior in other GHC versions, but I'm told that bug reports for older GHC versions are welcome, so here I am. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 19:19:20 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 19:19:20 -0000 Subject: [GHC] #8763: forM_ [1..N] does not get fused (allocates 50% more) In-Reply-To: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> References: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> Message-ID: <057.d0f2788753bbf47f63990c45d9ec98ba@haskell.org> #8763: forM_ [1..N] does not get fused (allocates 50% more) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #7206 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): This happens even in `-O0`. Not sure how to turn case-of-case of (for debugging reasons), `-fno-case-of-case` dosn't seem to be a thing anymore. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 22:45:36 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 22:45:36 -0000 Subject: [GHC] #15589: Always promoting metavariables during type inference may be wrong In-Reply-To: <047.51146f5adc8f94aa92119170150b76d8@haskell.org> References: <047.51146f5adc8f94aa92119170150b76d8@haskell.org> Message-ID: <062.cf5143f06108e461acb3451ae71d9641@haskell.org> #15589: Always promoting metavariables during type inference may be wrong -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I think there's a third case: there might be a variable born as a skolem that nevertheless mentions unification variables in its kind. This could happen, for example, with a `forall`-bound variable in a partial type signature. I don't see your short-term solution. It sounds like you're saying "forbid lexical meta-tyvars in type signatures" but that's a huge hammer. And it wouldn't even work, because meta-tyvars might be zonked before we can forbid them. Perhaps I'm missing something. Your medium-term solution might work -- I don't have enough of it in my head to analyze. I took a quick look at the paper (Fig. 7, in particular) and have a question: is the new system fully backward-compatible with "Practical type inference"? Here is an example I'm worried about: {{{#!hs polypoly :: ((forall a. a -> a) -> (Int, Char)) -> () polypoly _ = () stuff = polypoly (\f -> (f 5, f 'x')) }}} This is accepted today, right in line with "Practical type inference". But it looks like it wouldn't be accepted by Fig. 7, because that assigns a monotype to any un-annotated lambda. The `f` above must be assigned a polytype. I have not read the paper (since last summer), but a quick glance at the figure provoked this question. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 23:06:10 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 23:06:10 -0000 Subject: [GHC] #15589: Always promoting metavariables during type inference may be wrong In-Reply-To: <047.51146f5adc8f94aa92119170150b76d8@haskell.org> References: <047.51146f5adc8f94aa92119170150b76d8@haskell.org> Message-ID: <062.925eb6b89861d1b1f80337993ab63780@haskell.org> #15589: Always promoting metavariables during type inference may be wrong -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > there might be a variable born as a skolem that nevertheless mentions unification variables in its kind. Rats. Yes, that is true. Also an exisential match on {{{ data T k where MkT :: forall (a :: k). blah -> T k }}} > "forbid lexical meta-tyvars in type signatures" but that's a huge hammer. Yes, that is what I'm saying. Let's review the problem: * We can't instantiate a type signature that contains a meta-variable if that meta-variable might later be instantiated to one of the quantified variables of the signature. (Unless we venture in the uncharted waters of delayed substitutions.) * If we have solved all the constraints arising from the signature, and any free meta-variables are from an outer level, there is no problem -- outer-level variables can't be solved in a way that mentions the inner quantifiers. * But "solving all the constraints" might (in obscure cases) depend on whether or not we have worked out the value of some outer level variable. Thus `If alpha[0] beta[1] Int ~ a[1]`; if `alpha` turns out to be `True` we learn that `beta := a`. * We could reject the obscure situation, but we can't detect when it happens: suppose we unified `alpha := True` much much earlier and zonked it away. * This kind of order-dependence already arises when we use `simplifyInfer` in `NoMonoLocalBinds`; here again, an outer `alpha[0]` might unlock an inner constraint. But with `MonoLocalBinds` (our well-behaved case), it does not happen. We'd like a `MonoLocalBinds` for type signatures, which ensures their good behaviour. But I don't see one, apart from the big hammer of saying that the type can mention only lexically scoped variables whose type and kind are fixed from the moment it comes into scope. (And even that is not a very well-defined statement.) It's very frustrating that there is no simple way to identify a well- behaved subset. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 23:21:56 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 23:21:56 -0000 Subject: [GHC] #8763: forM_ [1..N] does not get fused (allocates 50% more) In-Reply-To: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> References: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> Message-ID: <057.7cf27bd1d9f069c86aa1379748c7cc1b@haskell.org> #8763: forM_ [1..N] does not get fused (allocates 50% more) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #7206 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): What, exactly is "the problem"? You say in comment:69 that something is not a join point, and LLF helps a bit but not enough. Can you give a from-scratch explanation of what the problem is, perhaps assuming that LLF is available if necessary? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 23:23:32 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 23:23:32 -0000 Subject: [GHC] #15600: Bug while writing a simple parser with Parsec Message-ID: <045.78cae442251f60aa716ed2d552bd6a6c@haskell.org> #15600: Bug while writing a simple parser with Parsec -------------------------------------+------------------------------------- Reporter: roehst | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.0.2 Keywords: | Operating System: Unknown/Multiple Architecture: x86_64 | Type of failure: None/Unknown (amd64) | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- {{{#!hs module Main where import Control.Monad.Identity import Control.Monad.State import Data.List import Text.ParserCombinators.Parsec type Name = String data Value = VlInt Int | VlBool Bool deriving Show data Term = TmVal Value | TmVar Name | TmLet Name Term Term | TmAdd Term Term deriving Show parseTerm :: Parser Term parseTerm = parseVal <|> parseVar <|> parseLet <|> parseAdd }}} And then I get: GHCi, version 8.0.2: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( Main.hs, interpreted ) ghc: panic! (the 'impossible' happened) (GHC version 8.0.2 for x86_64-unknown-linux): initTc: unsolved constraints WC {wc_insol = [W] parseVal_a2YR :: t_a2YQ[tau:1] (CHoleCan: parseVal) [W] parseVar_a2YY :: t_a2YX[tau:1] (CHoleCan: parseVar) [W] parseLet_a2Z5 :: t_a2Z4[tau:1] (CHoleCan: parseLet) [W] parseAdd_a2Z8 :: t_a2Z7[tau:1] (CHoleCan: parseAdd)} Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 23:23:48 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 23:23:48 -0000 Subject: [GHC] #15570: Core transformations generate bad indexCharOffAddr# call In-Reply-To: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> References: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> Message-ID: <063.b32d9a897a0f63a247df08b566a3fe08@haskell.org> #15570: Core transformations generate bad indexCharOffAddr# call -------------------------------------+------------------------------------- Reporter: alpmestan | Owner: alpmestan Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15286 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by alpmestan): * cc: snowleopard (added) * related: => #15286 Comment: We explicitly ask for `Num.hs` to be built with `-O0`, [https://github.com/snowleopard/hadrian/blob/a820566c16e1945b02632e68bd54cc351f562ebc/src/Settings/Packages.hs#L35 here]. This is due to #15286. We quite likely want to solve the root of the issue there instead of just building some modules here and there without optimisations. Even more so now that we're seeing that building some important modules with `-O0` can make all sorts of things go wrong. Thanks a lot for the investigation! I'm glad you got hadrian to work properly. #15286 is now standing in the way of really addressing the present ticket. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 23:43:08 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 23:43:08 -0000 Subject: [GHC] #15601: Unexpected compile error on type level lists with a single element Message-ID: <044.512c7d41bd51388e49a0f16de93d34bd@haskell.org> #15601: Unexpected compile error on type level lists with a single element -------------------------------------+------------------------------------- Reporter: erikd | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Incorrect Unknown/Multiple | error/warning at compile-time Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Tried this with ghc 8.0.2, 8.2.2 and 8.4.3 and all give an almost identical error on the following piece of code: {{{#!hs {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} import Data.Singletons.Prelude.List #if MIN_VERSION_singletons(2,4,0) type (a :++ b) = a ++ b #endif data MyType = A | B | C | D | E | F type TypeList1 = ['A, 'B] type TypeList2 = TypeList1 :++ ['C, 'D] -- Everything above is fine, but this line: type TypeList3 = TypeList2 :++ ['F] -- Gives the error: -- -- type-level-list.hs:21:32: error: -- • Expected kind ‘[MyType]’, but ‘[ 'F]’ has kind ‘*’ -- • In the second argument of ‘(:++)’, namely ‘[ 'F]’ -- In the type ‘TypeList2 :++ [ 'F]’ -- In the type declaration for ‘TypeList3’ -- | -- 22 | type TypeList3 = TypeList2 :++ ['F] -- If instead I write it like: type TypeList4 = TypeList2 :++ '[F] -- I get the warning: -- -- type-level-list.hs:33:34: warning: [-Wunticked-promoted- constructors] -- Unticked promoted constructor: ‘F’. -- Use ‘'F’ instead of ‘F’. -- The following actually seems to work, but I don't understand why type level -- lists containing only one element are different. type TypeList5 = TypeList2 :++ '[ 'F] }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 3 23:54:16 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 03 Sep 2018 23:54:16 -0000 Subject: [GHC] #15071: :set usage in ghci tests breaks platform independence of output In-Reply-To: <046.ca930388c371dd0f2b55a7ae0becdca1@haskell.org> References: <046.ca930388c371dd0f2b55a7ae0becdca1@haskell.org> Message-ID: <061.ed19d95aac966ed2e874cff2545f888b@haskell.org> #15071: :set usage in ghci tests breaks platform independence of output -------------------------------------+------------------------------------- Reporter: bgamari | Owner: RolandSenn Type: bug | Status: patch Priority: high | Milestone: 8.8.1 Component: Test Suite | Version: 8.2.2 Resolution: | Keywords: ci-breakage Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Windows: make | test TESTS="ghci057 T9293" Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5125 Wiki Page: | -------------------------------------+------------------------------------- Changes (by potato44): * differential: Phab:5125 => Phab:D5125 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 00:20:11 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 00:20:11 -0000 Subject: [GHC] #15601: Unexpected compile error on type level lists with a single element In-Reply-To: <044.512c7d41bd51388e49a0f16de93d34bd@haskell.org> References: <044.512c7d41bd51388e49a0f16de93d34bd@haskell.org> Message-ID: <059.f342b0496bbb151891945f640f24bd7e@haskell.org> #15601: Unexpected compile error on type level lists with a single element -------------------------------------+------------------------------------- Reporter: erikd | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: invalid | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: new => closed * resolution: => invalid Comment: This is unfortunately by design. When type-level lists were added, the syntax `[a]` was already taken. For example `[Integer]` is a list of integers, kind `*`. It's not a type-level list with one entry, which would be kind `[*]`. If we could start Haskell from scratch I would vote for having `['a', 'b'] :: List Char` instead of `['a', 'b'] :: [Char]` but it's too late to change. See https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html #promoted-list-and-tuple-types -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 00:42:10 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 00:42:10 -0000 Subject: [GHC] #15601: Unexpected compile error on type level lists with a single element In-Reply-To: <044.512c7d41bd51388e49a0f16de93d34bd@haskell.org> References: <044.512c7d41bd51388e49a0f16de93d34bd@haskell.org> Message-ID: <059.eec5fc4e85541a66bfff6f6178024fce@haskell.org> #15601: Unexpected compile error on type level lists with a single element -------------------------------------+------------------------------------- Reporter: erikd | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: invalid | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by erikd): Ok, thanks. The solution for single element lists is to use: {{{ type TypeList5 = TypeList2 :++ '[ 'F] }}} where bot the list and the constructor are ticked *and* there is a space between the open square bracket and the first ticked constructor. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 03:04:19 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 03:04:19 -0000 Subject: [GHC] #15589: Always promoting metavariables during type inference may be wrong In-Reply-To: <047.51146f5adc8f94aa92119170150b76d8@haskell.org> References: <047.51146f5adc8f94aa92119170150b76d8@haskell.org> Message-ID: <062.8bc26e0e570bdace80e4b06e2265888e@haskell.org> #15589: Always promoting metavariables during type inference may be wrong -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): The problem is that you're ruling out several examples in our recent type variables paper. For example (this doesn't actually appear in the paper, but many similar forms do): {{{#!hs prefix (x :: a) yss = map xcons yss where xcons :: [a] -> [a] xcons ys = x : ys }}} Under our recent change to allow patterns to bind meta-tyvars, the type signature here would be rejected. That's really terrible! One sledgehammer of a solution is to disable the eager unifier. Then, refuse to promote in `kindGeneralizeLocal`, issuing errors instead. I do think that would exactly fix the problem. We always assume that the eager unifier is good for performance, but have we ever tested this? Perhaps it doesn't! I still can't help but think that delayed substitutions are the answer here. (The instantiation constraints seem similar. I'm arguing for delayed substitutions only because I've studied them more closely.) Adam used them in his thesis for inference. I thought they were horribly complex and resolutely decided that I would have none of that rubbish in ''my'' thesis. Everything went swimmingly without them until I actually tried to write any proofs. And then, bit by bit, all the complexity Adam discovered painstakingly had to enter. I was really quite displeased with it all, wanting something cheap and cheerful instead. But I finished the experience rather convinced that delayed substitutions are the one true way to do this, having been saddled with them when trying quite hard to avoid them. Perhaps we don't need to implement delayed substitutions directly, if we can come up with a clever implementation trick that's functionally equivalent (like storing implication identities instead of lists of tyvars, noting that the two have equal informational content). Of course, any of this is at least a medium-term solution. The short-term solution may well be to do nothing (other than fix the panic in #15588, which is hopefully quite superficial -- I haven't looked yet). The status quo means we behave unpredictably in some awfully obscure scenarios. This is unabashedly the wrong thing, but I don't think it's ruining anyone's day but ours. When we infer a type, the type is correct, so there's no safety issue here. I think order-dependence in highly obscure code is better than the huge sledgehammers we've been considering here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 03:08:39 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 03:08:39 -0000 Subject: [GHC] #14963: ghci -fdefer-type-errors can't run IO action from another module In-Reply-To: <047.c258bd8a8d43881f32b193f6cbfcf8f0@haskell.org> References: <047.c258bd8a8d43881f32b193f6cbfcf8f0@haskell.org> Message-ID: <062.350546c6cc7984141b35c481648606e7@haskell.org> #14963: ghci -fdefer-type-errors can't run IO action from another module -------------------------------------+------------------------------------- Reporter: elaforge | Owner: tdammers Type: bug | Status: patch Priority: high | Milestone: 8.4.2 Component: GHCi | Version: 8.4.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | ghci/should_run/T14963 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4833 Wiki Page: | Phab:D4830 -------------------------------------+------------------------------------- Comment (by goldfire): See #15598 for another example of trouble in this water. That example might be simpler than this one. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 05:31:21 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 05:31:21 -0000 Subject: [GHC] #10374: Can't build GHC with a dynamic only GHC installation In-Reply-To: <047.5b2f040bca29d3e5d41bd8a4d0f768d7@haskell.org> References: <047.5b2f040bca29d3e5d41bd8a4d0f768d7@haskell.org> Message-ID: <062.093b5a71e1d852cb92affc84542b6c6f@haskell.org> #10374: Can't build GHC with a dynamic only GHC installation -------------------------------------+------------------------------------- Reporter: jessicah | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Build System | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by devurandom): * cc: devurandom (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 05:31:52 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 05:31:52 -0000 Subject: [GHC] #8414: ghc-pkg prevents dynamic library only packages In-Reply-To: <053.c57fa11cf8cece16048f38d65161c630@haskell.org> References: <053.c57fa11cf8cece16048f38d65161c630@haskell.org> Message-ID: <068.2f2dbd31bf9b4151626b0f9a8a672e5e@haskell.org> #8414: ghc-pkg prevents dynamic library only packages -------------------------------------+------------------------------------- Reporter: AndreasVoellmy | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: ghc-pkg | Version: Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by devurandom): * cc: devurandom (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 07:11:32 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 07:11:32 -0000 Subject: [GHC] #15286: "Can't use Natural in base" when compiling GHC.Natural with -O0 In-Reply-To: <048.cfab6e6ea21d7113a33d736cfa0133f3@haskell.org> References: <048.cfab6e6ea21d7113a33d736cfa0133f3@haskell.org> Message-ID: <063.ebf0c86f2c29f1c96d1c11849eb4fa35@haskell.org> #15286: "Can't use Natural in base" when compiling GHC.Natural with -O0 -------------------------------------+------------------------------------- Reporter: alpmestan | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: libraries/base | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4880 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Compiling `Num` with `-O0` will kill numeric performance for every single Haskell program -- it's not acceptable. Does anyone understand what the actual problem is here? Why does it only happen with Hadrian? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 07:12:36 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 07:12:36 -0000 Subject: [GHC] #15570: Core transformations generate bad indexCharOffAddr# call In-Reply-To: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> References: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> Message-ID: <063.8bc21602c1ad414ffbde0d68687d929d@haskell.org> #15570: Core transformations generate bad indexCharOffAddr# call -------------------------------------+------------------------------------- Reporter: alpmestan | Owner: alpmestan Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15286 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > #15286 is now standing in the way of really addressing the present ticket. Well #15286 ''must'' be solved; compiling `Num` with `-00` is not acceptable. But there's another bug: there should not be a linker error with the code above. Let's fix that too. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 07:32:50 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 07:32:50 -0000 Subject: [GHC] #15602: PAP invariant of pointer tagging does not hold Message-ID: <043.62b25bafb1242d8e47aeeb30451990fd@haskell.org> #15602: PAP invariant of pointer tagging does not hold -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: #15508, #13767 Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- The PAP invariant of pointer tagging says > the PAP entry code jumps to the function's entry code, so it must have a tagged pointer to the function closure in R1. We therefore assume that a PAP always contains a tagged pointer to the function closure. (from https://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/HaskellExecution/PointerTagging) As discovered while debugging #15508, this currently does not hold. I tried to fix this in one PAP allocation site in Phab:D5051 but it somehow broke another test. We should review all PAP allocation sites and make sure the invariant holds, and then fix any bugs that this fix reveals. Relevant commits: - 6015a94f9108a502150565577b66c23650796639: Implements pointer tagging - f9c6d53fe997f1c560cda6f346f4b201711df37c: Fixes a PAP allocation site (#13767) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 08:19:29 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 08:19:29 -0000 Subject: [GHC] #15600: Bug while writing a simple parser with Parsec In-Reply-To: <045.78cae442251f60aa716ed2d552bd6a6c@haskell.org> References: <045.78cae442251f60aa716ed2d552bd6a6c@haskell.org> Message-ID: <060.302e192afae3a7235471bef2744a8307@haskell.org> #15600: Bug while writing a simple parser with Parsec -------------------------------------+------------------------------------- Reporter: roehst | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.0.2 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 | (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: new => closed * resolution: => duplicate Comment: Thank you for the report. This has been fixed in GHC 8.2: #13106. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 08:28:20 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 08:28:20 -0000 Subject: [GHC] #15589: Always promoting metavariables during type inference may be wrong In-Reply-To: <047.51146f5adc8f94aa92119170150b76d8@haskell.org> References: <047.51146f5adc8f94aa92119170150b76d8@haskell.org> Message-ID: <062.9d05ccb2e07e809c26a1c5e8a0b0ab49@haskell.org> #15589: Always promoting metavariables during type inference may be wrong -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AlejandroSerrano): Indeed, when working in the ''Guarded impredicativity'' paper we considered delaying instantiations as a solution, which we rejected because it was quite complicated. Applying that solution to this case, the instantiation of {{{ x :: forall (a :: Type) (b :: kappa[i34]) (d :: a). }}} would be forbidden until `kappa[i34]` is known. That entails that `d` is not instantiated either, as it appears later in the time. However, in the paper we do not explicitly mention kind signatures. We assume that if we have a quantified type, we can always instantiate its variables -- we only have to choose whether we instantiate them with some restrictions or not. There is some work to be done to ensure that this kind of scenarios doesn't break the invariants for termination of checking. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 09:09:14 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 09:09:14 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.a55206cd6d384b41159b2a1bd81102a0@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): The code as found on the `wip/T14880-accum` branch now validates, except for one stat failure: `haddock.base` allocates 6.5% more than expected. I don't know whether this patch introduces the regression or the head I rebased on though. This is exactly the same version as `wip/T1448-accum`, but rebased onto `master` and with some fixes to make it build again (the `Coercion` type has changed in the meantime, so I had to add another case branch). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 09:14:57 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 09:14:57 -0000 Subject: [GHC] #13243: make test in non-validate configuration fails with a variety of ghci errors In-Reply-To: <046.050e5e1adf77fffffbf4ae5eeb1ad346@haskell.org> References: <046.050e5e1adf77fffffbf4ae5eeb1ad346@haskell.org> Message-ID: <061.6fd7ca60235dfa4915ebac63ca6136ca@haskell.org> #13243: make test in non-validate configuration fails with a variety of ghci errors -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: GHCi | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by alpmestan): * cc: alpmestan (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 09:42:10 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 09:42:10 -0000 Subject: [GHC] #15570: Core transformations generate bad indexCharOffAddr# call In-Reply-To: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> References: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> Message-ID: <063.ef52997ad5f4f180e1664221811121c3@haskell.org> #15570: Core transformations generate bad indexCharOffAddr# call -------------------------------------+------------------------------------- Reporter: alpmestan | Owner: alpmestan Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15286 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by hsyl20): @[comment:11 alpmestan]: the [https://github.com/snowleopard/hadrian/blob/a820566c16e1945b02632e68bd54cc351f562ebc/src/Settings/Packages.hs#L35 workaround in Hadrian] for #15286 is a bit wrong: you should only have to pass `-fno-omit-interface-pragmas` and `-fno-ignore-interface-pragmas`, not `-O0`. Last time I checked (cf Phab:D4880), it was enough to fix the "quickest" build. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 11:19:05 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 11:19:05 -0000 Subject: [GHC] #15176: Superclass `Monad m =>` makes program run 100 times slower In-Reply-To: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> References: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> Message-ID: <061.a758966d0815b2a81776a538bf44222b@haskell.org> #15176: Superclass `Monad m =>` makes program run 100 times slower -------------------------------------+------------------------------------- Reporter: danilo2 | Owner: osa1 Type: bug | Status: new Priority: highest | Milestone: 8.8.1 Component: Compiler | Version: 8.4.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): I managed to reproduce this. The original instructions no longer work (the git repo disappeared, the branch doesn't exist in the new repo etc.) so here is what I did to reproduce: - Clone https://github.com/luna/luna.git - Run benchmark: `stack bench luna-core` - Apply this patch: {{{ diff --git a/core/src/Data/Graph/Fold/Layer.hs b/core/src/Data/Graph/Fold/Layer.hs index 28d6c6cd..45150ff1 100644 --- a/core/src/Data/Graph/Fold/Layer.hs +++ b/core/src/Data/Graph/Fold/Layer.hs @@ -141,7 +141,7 @@ instance Monad m => Fold.Builder (Scoped s) m (SmallVectorA t alloc n a) -- === FoldableLayers === -- -class LayersFoldableBuilder__ t (layers :: [Type]) m where +class Monad m => LayersFoldableBuilder__ t (layers :: [Type]) m where buildLayersFold__ :: SomePtr -> m (Fold.Result t) -> m (Fold.Result t) instance Monad m => LayersFoldableBuilder__ t '[] m where diff --git a/core/src/Data/Graph/Fold/LayerMap.hs b/core/src/Data/Graph/Fold/LayerMap.hs index 4b12bbf6..e5e54e45 100644 --- a/core/src/Data/Graph/Fold/LayerMap.hs +++ b/core/src/Data/Graph/Fold/LayerMap.hs @@ -117,7 +117,7 @@ instance Monad m => Fold.Builder (Scoped s) m (SmallVectorA t alloc n a) -- === FoldableLayers === -- -class LayersFoldableBuilder__ t (layers :: [Type]) m where +class Monad m => LayersFoldableBuilder__ t (layers :: [Type]) m where buildLayersFold__ :: SomePtr -> m (Fold.Result t) -> m (Fold.Result t) instance Monad m => LayersFoldableBuilder__ t '[] m where diff --git a/core/src/Data/Graph/Fold/Scoped.hs b/core/src/Data/Graph/Fold/Scoped.hs index 2fade0f3..2e6b51df 100644 --- a/core/src/Data/Graph/Fold/Scoped.hs +++ b/core/src/Data/Graph/Fold/Scoped.hs @@ -131,7 +131,7 @@ instance Monad m => Fold.Builder (Scoped t) m (SmallVectorA s alloc n a) -- === FoldableLayers === -- -class LayersFoldableBuilder__ t (layers :: [Type]) m where +class Monad m => LayersFoldableBuilder__ t (layers :: [Type]) m where buildLayersFold__ :: SomePtr -> m (Fold.Result t) -> m (Fold.Result t) instance Monad m => LayersFoldableBuilder__ t '[] m where diff --git a/core/src/Data/Graph/Fold/ScopedMap.hs b/core/src/Data/Graph/Fold/ScopedMap.hs index 217c55a6..4a3d34c8 100644 --- a/core/src/Data/Graph/Fold/ScopedMap.hs +++ b/core/src/Data/Graph/Fold/ScopedMap.hs @@ -129,7 +129,7 @@ instance Monad m => Fold.Builder (ScopedMap s) m (SmallVectorA t alloc n a) -- === FoldableLayers === -- -class LayersFoldableBuilder__ t (layers :: [Type]) m where +class Monad m => LayersFoldableBuilder__ t (layers :: [Type]) m where buildLayersFold__ :: SomePtr -> m (Fold.Result t) -> m (Fold.Result t) instance Monad m => LayersFoldableBuilder__ t '[] m where }}} - Run benchmarks again Most of the benchmarks are not effected, but there are three benchmarks which are effected quite significantly by this change: Before the patch: {{{ benchmarking ir/discovery/generic/10e6 time 61.47 ms (61.14 ms .. 61.80 ms) 1.000 R² (1.000 R² .. 1.000 R²) mean 61.02 ms (60.79 ms .. 61.20 ms) std dev 367.5 μs (224.7 μs .. 582.3 μs) benchmarking ir/discovery/partitions single var/10e6 time 93.94 ms (93.22 ms .. 94.75 ms) 1.000 R² (1.000 R² .. 1.000 R²) mean 93.57 ms (92.95 ms .. 93.94 ms) std dev 746.7 μs (377.0 μs .. 1.245 ms) benchmarking ir/discovery/partitions unify/10e6 time 518.7 ms (508.2 ms .. 523.9 ms) 1.000 R² (1.000 R² .. 1.000 R²) mean 515.6 ms (512.3 ms .. 516.9 ms) std dev 2.350 ms (717.7 μs .. 3.196 ms) variance introduced by outliers: 19% (moderately inflated) }}} After the patch: {{{ benchmarking ir/discovery/generic/10e6 time 1.309 s (1.283 s .. 1.326 s) 1.000 R² (1.000 R² .. 1.000 R²) mean 1.320 s (1.312 s .. 1.334 s) std dev 13.24 ms (767.0 μs .. 16.27 ms) variance introduced by outliers: 19% (moderately inflated) benchmarking ir/discovery/partitions single var/10e6 time 1.355 s (1.351 s .. 1.359 s) 1.000 R² (1.000 R² .. 1.000 R²) mean 1.357 s (1.356 s .. 1.359 s) std dev 1.415 ms (1.209 ms .. 1.452 ms) variance introduced by outliers: 19% (moderately inflated) benchmarking ir/discovery/partitions unify/10e6 time 5.459 s (5.438 s .. 5.501 s) 1.000 R² (1.000 R² .. 1.000 R²) mean 5.444 s (5.435 s .. 5.452 s) std dev 11.24 ms (7.336 ms .. 13.71 ms) variance introduced by outliers: 19% (moderately inflated) }}} Summary: - ir/discovery/generic/10e6: 21x increase - ir/discovery/partitions single var/10e6: 14x increase - ir/discovery/partitions unify/10e6: 10x increase No ideas why yet. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 11:56:39 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 11:56:39 -0000 Subject: [GHC] #8763: forM_ [1..N] does not get fused (allocates 50% more) In-Reply-To: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> References: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> Message-ID: <057.936eaf2ddc63c0bc47e177aface58ed1@haskell.org> #8763: forM_ [1..N] does not get fused (allocates 50% more) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #7206 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): Sure will do. Let's begin with the original problem. There's two functions in [[attachment:reprof.hs]]. One is `f`, having a loop of the `forM_ [2..n] body` form, the other is `g` which has the `forM_ [2,3..n] body` form. The former doesn't allocate (56kB in total), whereas the latter allocates quite a lot (960MB). Why is that? The arithmetic sequences desugar, rewrite and specialise to `build (\c t -> eftIntFB c z 2 n)` and `build (\c z -> efdtIntFB c z 2 3 n)`, respectively. That cancels away with `forM_`'s implementation in terms of `foldr`: {{{ forM_= flip mapM_ mapM_ body = {- definition -} foldr ((>>) . body) (return ()) = {- eta expand the section -} foldr (\x k -> body x >> k) (return ()) = {- (>>) of ST, written as `s -> (a, s)` for lighter syntax -} foldr (\x k s -> case (body x s) of (_, s') -> k s') (return ()) }}} Note how `k` occurs in tail position within the lambda. Now, this cancels with the definition of `ef(d)tIntFB`: {{{ foldr (\x k s -> case (body x s) of (_, s') -> k s') (return ()) . build (\c z -> efdtIntFB c z 2 3 n) = {- foldr/build -} efdtIntFB (\x k s -> case (body x s) of (_, s') -> k s') (return ()) 2 3 n }}} So, that lambda is what is bound to `c` when `ef(d)tIntFB` gets inlined. Now, the implementation of `eftIntFB` only has a single occurrence of `c`, so it will inline properly and bind its `k` parameter (the continuation in tail position) to the recursive `go` call here [[https://github.com/ghc/ghc/blob/fa3143c76ac77ee96fd89559cacc089205abaa20/libraries/base/GHC/Enum.hs#L522]]. The call to `k` turns into a tail call within `go`s body: {{{ go x = I# x `c` if isTrue# (x ==# y) then n else go (x +# 1#) ==> c = \x k s -> case (body x s) of (_, s') -> k s' go x s = case (body (I# x) s) of (_, s') -> if isTrue# (x ==# y) then n s' else go (x +# 1#) s' }}} And `go` can be made a join point. The same isn't possible in the current `efdtIntFB`, because it duplicates `c` by branching on whether to count up or down (and also within the loop itself, anyway): {{{ efdtIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r efdtIntFB c n x1 x2 y | isTrue# (x2 >=# x1) = efdtIntUpFB c n x1 x2 y | otherwise = efdtIntDnFB c n x1 x2 y }}} Now, when `efdtInt{Up,Dn}FB` gets inlined, we end up with a let-bound `c` that still tail-calls its argument `k`, and is even tail-called itself within `go_up`/`go_dn` (here https://github.com/ghc/ghc/blob/fa3143c76ac77ee96fd89559cacc089205abaa20/libraries/base/GHC/Enum.hs#L588): {{{ let c x k s = case (body x s) of (_, s') -> k s' in ... let go_up x | isTrue# (x ># y') = I# x `c` n | otherwise = I# x `c` go_up (x +# delta) }}} Note that `go_up` tail calls `c` and passes itself as the `k` parameter. If `c` was inlined, all would be fine and `go_up` would turn into a join point. That's not the case because `c` is duplicated in `efdtIntFB` and then one more time in `efdtInt{Up,Dn}FB`. My first implementation in comment:52 (for which you provided a simplification in comment:54) dealt with the latter, while the idea in comment:60 is supposed to deal with the former. Sadly, case-of-case seems to undo the painful de-duplication of the `c` parameter (that's what comment:71 is about). Why doesn't LLF help here? Well, lifting out `c` to top-level gets rid of allocations for `c`, but there's still at least the allocation for the thunk for `go_up (x+1)` (the `Int` box goes away because of strictness). Also, the call to `go_up` is still an unknown call, as opposed to the simple join call we would get by inlining `c`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 11:57:18 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 11:57:18 -0000 Subject: [GHC] #8763: forM_ [1..N] does not get fused (allocates 50% more) In-Reply-To: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> References: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> Message-ID: <057.2e703fd0fd51c2553694942363172174@haskell.org> #8763: forM_ [1..N] does not get fused (allocates 50% more) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #7206 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): ---- I can think of another transformation that would save the day here: We just have to put `c` in the same recursive group as `go_up` and recognize the mutual recursive join point. Seems like a better way than to mess with the simplifier and we don't even risk duplication of any code! So {{{ let c x k s = case (body x s) of (_, s') -> k s' in ... let go_up x | isTrue# (x ># y') = I# x `c` n | otherwise = I# x `c` go_up (x +# delta) ==> float `c` inwards into the same recursive group, specialise it for `go_up (x+#delta)` and `n` as `k` (SpecConstr? Would entail seeing tail- calls as kind-of a pattern match for functions) join go_up x | isTrue# (x ># y') = jump c1 (I# x) | otherwise = c2 (I# x) go_up (x +# delta) c1 x s = -- k = n case (body x s) of (_, s') -> n s' c2 x s = -- k = go_up (x +# delta) case (body x s) of (_, s') -> go_up (x +# delta) s' }}} Well, it's probably not SpecConstr that will do the specialisation. Also, why specialise when we could just inline `c`? Seems like we risk duplication of the potentially huge `body` after all. Although the same weakness doesn't apply to the situation in comment:71: It's enough to specialise for the `emit` argument (which serves a similar role as `go_up`) without any specific arguments to see that it's tail called: {{{ let c_a2jU x k s = case (body x s) of (_, s') -> k s' in join emit_a4hf next_ok next = ... case ==# next_ovf_a3hz delta_ovf_a3h0 of { __DEFAULT -> case b_a2jS of { __DEFAULT -> c_a2jU (GHC.Types.I# ds_d42Y) (emit_a3hf GHC.Types.False next_a3hx) }; 1# -> case b_a2jS of next_ok_a2k8 { __DEFAULT -> c_a2jU (GHC.Types.I# ds_d42Y) (emit_a3hf next_ok_a2k8 next_a3hx) } } ==> Specialising `c` for the call pattern `[ds s next_ok next] |> [I# ds, emit next_ok next, s]` as `c'` join c' ds s next_ok next = case (body (I# ds) s) of (_, s') -> emit_a4hf next_ok next s' emit_a4hf next_ok next s = ... case ==# next_ovf_a3hz delta_ovf_a3h0 of { __DEFAULT -> case b_a2jS of { __DEFAULT -> jump c' ds_d42Y GHC.Types.False next_a3hx s }; 1# -> case b_a2jS of next_ok_a2k8 { __DEFAULT -> jump c' ds_d42Y next_ok_a2k8 next_a3hx s } } }}} This latter case is probably a lot easier to handle. Maybe this is worth some specialised pass? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 13:18:22 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 13:18:22 -0000 Subject: [GHC] #15591: Inconsistent kind variable binder visibility between associated and non-associated type families In-Reply-To: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> References: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> Message-ID: <065.74642c31fc70d0267dda894531f066a9@haskell.org> #15591: Inconsistent kind variable binder visibility between associated and non- associated type families -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: | TypeApplications, TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Replying to [comment:5 goldfire]: > As for the patch: I would expect that the solution to this problem would be in the type-checker, not the renamer. As it stands, I'm pretty sure that the renamer identifies the `a` in these associated type definitions with the same unique as the `a` in the class. Well, it does identify the `a` in `T2` to be the same `a` as in `C`. But after it does so, it immediately filters it out! That's problematic, because by the time you reach `kcLHsQTyVars`, the `hsq_implicit` field of the `LHsQTyVars` argument only contains `f`—`a` is no longer within reach. (You can verify this for yourself by compiling this program with `-ddump- tc-trace` and searching for `kcLHsQTyVars: cusk`.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 13:19:12 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 13:19:12 -0000 Subject: [GHC] #15591: Inconsistent kind variable binder visibility between associated and non-associated type families In-Reply-To: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> References: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> Message-ID: <065.d6da400ef20823cfda26ad97bd6c6025@haskell.org> #15591: Inconsistent kind variable binder visibility between associated and non- associated type families -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: | TypeApplications, TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15592 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * related: => #15592 * milestone: 8.6.1 => 8.8.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 13:19:26 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 13:19:26 -0000 Subject: [GHC] #15592: Type families without CUSKs cannot be given visible kind variable binders In-Reply-To: <050.651e6db8a709f8d5b684cf90e6873390@haskell.org> References: <050.651e6db8a709f8d5b684cf90e6873390@haskell.org> Message-ID: <065.30a31275b62bb18214d83ff4309df274@haskell.org> #15592: Type families without CUSKs cannot be given visible kind variable binders -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | TypeApplications, TypeFamilies, | CUSKs Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15591 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * related: => #15591 * milestone: 8.6.1 => 8.8.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 13:20:40 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 13:20:40 -0000 Subject: [GHC] #15176: Superclass `Monad m =>` makes program run 100 times slower In-Reply-To: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> References: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> Message-ID: <061.f7e099e82ef0bbbc259552c3030d26fa@haskell.org> #15176: Superclass `Monad m =>` makes program run 100 times slower -------------------------------------+------------------------------------- Reporter: danilo2 | Owner: osa1 Type: bug | Status: new Priority: highest | Milestone: 8.8.1 Component: Compiler | Version: 8.4.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): So, I've built two versions of the package with `-dump-simpl -dump-to-file -dsuppress-uniques` (which took about an hour to build twice on my i7-8700K desktop). Unfortunately there are 71 modules in this package and none of the files are identical between two versions (there are at least very minor identifier changes) so this is still not easy to debug, but while checking some random files I found some relevant changes between two versions: This expression in the original version: {{{ $dLayersFoldableBuilder__ `cast` (Data.Graph.Fold.Layer.N:LayersFoldableBuilder__[0] _N _N _N :: (LayersFoldableBuilder__ t layers m :: Constraint) ~R# (SomePtr -> m (Fold.Result t) -> m (Fold.Result t) :: *)) }}} becomes this after `Monad =>`: {{{ buildLayersFold__ @ t @ layers @ m $dLayersFoldableBuilder__ }}} If my understanding is correct, in the original version the typeclass dictionary is represented as its method, but with `Monad m =>` it's not as it not has one more field for the `Monad m` dictionary. This means one layer of indirection in the `Monad m =>` version. There are lots of changes similar to this. Not sure if this by itself explains 20x increase in runtime though. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 13:20:56 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 13:20:56 -0000 Subject: [GHC] #15577: TypeApplications-related infinite loop (GHC 8.6+ only) In-Reply-To: <050.727e460d0083534afd4869db4aa81c30@haskell.org> References: <050.727e460d0083534afd4869db4aa81c30@haskell.org> Message-ID: <065.8291344d0af864131b6edf865ddb3a96@haskell.org> #15577: TypeApplications-related infinite loop (GHC 8.6+ only) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: merge Priority: high | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.5 checker) | Keywords: Resolution: | TypeApplications, TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => merge Comment: Marking this as merge so that Ben will see it. (But, as simonpj notes in comment:5, don't actually close this ticket until Richard/Ningning has reviewed it.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 13:31:06 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 13:31:06 -0000 Subject: [GHC] #12356: StaticPointers support in GHCi In-Reply-To: <046.4add1b1a872a2608a03a4c2efa3faa77@haskell.org> References: <046.4add1b1a872a2608a03a4c2efa3faa77@haskell.org> Message-ID: <061.2d1217dd162f3062cd3130320b17de5a@haskell.org> #12356: StaticPointers support in GHCi -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: 8.2.1 Component: Compiler | Version: 8.0.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #12000, #9878 | Differential Rev(s): Phab:D2504, Wiki Page: | Phab:D3663 -------------------------------------+------------------------------------- Comment (by mpickering): Is this fixed? With 8.6.1 {{{ > :set -XStaticPointers : warning: StaticPointers is not supported in GHCi interactive expressions. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 13:33:40 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 13:33:40 -0000 Subject: [GHC] #15471: Polymorphism, typed splices and type inference don't mix In-Reply-To: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> References: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> Message-ID: <064.43fc4fe1673226c56152dfa7115af70f@haskell.org> #15471: Polymorphism, typed splices and type inference don't mix -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by mpickering): Anyone have any ideas about this? Perhaps Simon? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 13:35:56 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 13:35:56 -0000 Subject: [GHC] #15053: Compiler panic on invalid syntax (unterminated pragma) In-Reply-To: <047.d617a7e8bd5e9dac7c56bae30af4b445@haskell.org> References: <047.d617a7e8bd5e9dac7c56bae30af4b445@haskell.org> Message-ID: <062.27013ab7681f6c17b38b56b368f33787@haskell.org> #15053: Compiler panic on invalid syntax (unterminated pragma) -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: RolandSenn Type: bug | Status: patch Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.2.2 (Parser) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: make test crash or panic | TEST=T15053 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4883 Wiki Page: | Phab:D5093 -------------------------------------+------------------------------------- Comment (by Krzysztof Gogolewski ): In [changeset:"df363a646b66f4dd13d63ec70f18e427cabc8878/ghc" df363a6/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="df363a646b66f4dd13d63ec70f18e427cabc8878" Compiler panic on invalid syntax (unterminated pragma) Summary: After a parse error in OPTIONS_GHC issue an error message instead of a compiler panic. Test Plan: make test TEST=T15053 Reviewers: Phyx, thomie, bgamari, monoidal, osa1 Reviewed By: Phyx, monoidal, osa1 Subscribers: tdammers, osa1, rwbarton, carter GHC Trac Issues: #15053 Differential Revision: https://phabricator.haskell.org/D5093 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 13:39:56 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 13:39:56 -0000 Subject: [GHC] #15053: Compiler panic on invalid syntax (unterminated pragma) In-Reply-To: <047.d617a7e8bd5e9dac7c56bae30af4b445@haskell.org> References: <047.d617a7e8bd5e9dac7c56bae30af4b445@haskell.org> Message-ID: <062.8a8cfae1d4888da5e86af36ff2726ce4@haskell.org> #15053: Compiler panic on invalid syntax (unterminated pragma) -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: RolandSenn Type: bug | Status: merge Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.2.2 (Parser) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: make test crash or panic | TEST=T15053 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4883 Wiki Page: | Phab:D5093 -------------------------------------+------------------------------------- Changes (by monoidal): * status: patch => merge -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 13:43:26 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 13:43:26 -0000 Subject: [GHC] #15586: Compilation panic! (the 'impossible' happened) In-Reply-To: <047.72896e9fea2026e837542aaf516ad2e4@haskell.org> References: <047.72896e9fea2026e837542aaf516ad2e4@haskell.org> Message-ID: <062.1eded67093860e4638a5a2ecb22690a0@haskell.org> #15586: Compilation panic! (the 'impossible' happened) -------------------------------------+------------------------------------- Reporter: subaruru | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15499 | Differential Rev(s): Phab:D5118 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Krzysztof Gogolewski ): In [changeset:"a3a1a17ba7ddbc40b093c732e7e3a916b9531eac/ghc" a3a1a17b/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="a3a1a17ba7ddbc40b093c732e7e3a916b9531eac" Add a test for Trac #15586 Summary: The bug is already fixed in master. Test Plan: make test TEST=T15586 Reviewers: bgamari, simonpj Reviewed By: simonpj Subscribers: rwbarton, carter GHC Trac Issues: #15586 Differential Revision: https://phabricator.haskell.org/D5118 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 13:43:53 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 13:43:53 -0000 Subject: [GHC] #15586: Compilation panic! (the 'impossible' happened) In-Reply-To: <047.72896e9fea2026e837542aaf516ad2e4@haskell.org> References: <047.72896e9fea2026e837542aaf516ad2e4@haskell.org> Message-ID: <062.7c66cea6bbc5aef70a12f14939c09ab5@haskell.org> #15586: Compilation panic! (the 'impossible' happened) -------------------------------------+------------------------------------- Reporter: subaruru | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15499 | Differential Rev(s): Phab:D5118 Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: patch => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 13:59:02 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 13:59:02 -0000 Subject: [GHC] #15570: Core transformations generate bad indexCharOffAddr# call In-Reply-To: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> References: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> Message-ID: <063.9160238f224621719c636f13d1de9780@haskell.org> #15570: Core transformations generate bad indexCharOffAddr# call -------------------------------------+------------------------------------- Reporter: alpmestan | Owner: alpmestan Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15286 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): But it's a workaround NOT a fix. Let's fix it properly too please! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 14:01:25 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 14:01:25 -0000 Subject: [GHC] #15176: Superclass `Monad m =>` makes program run 100 times slower In-Reply-To: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> References: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> Message-ID: <061.301d6e3403588942ea0251a08e408358@haskell.org> #15176: Superclass `Monad m =>` makes program run 100 times slower -------------------------------------+------------------------------------- Reporter: danilo2 | Owner: osa1 Type: bug | Status: new Priority: highest | Milestone: 8.8.1 Component: Compiler | Version: 8.4.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I'd use `-ticky` which should rapidly identify the culprit. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 14:43:16 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 14:43:16 -0000 Subject: [GHC] #15603: ref6 example from StaticPointers documentation doesn't type check Message-ID: <049.2f1c9babf7c08f8cf0bfccd75c2c4869@haskell.org> #15603: ref6 example from StaticPointers documentation doesn't type check -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 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: -------------------------------------+------------------------------------- The [https://downloads.haskell.org/~ghc/8.4.3/docs/html/users_guide/glasgow_exts.html?highlight=static%20pointers #extension-StaticPointers documentation] for `StaticPointers` contains the following example. {{{ ref6 y = let x = 1 in static x }}} but this doesn't get accepted by the type checker. {{{ sp.hs:27:23: error: • ‘x’ is used in a static form but it is not closed because it has a non-closed type because it contains the type variables: ‘p_a7KP’ • In the expression: static x In the expression: let x = 1 in static x In an equation for ‘ref6’: ref6 y = let x = 1 in static x | 27 | ref6 y = let x = 1 in static x | ^^^^^^^ }}} I tested on 8.6.1, 8.4.3, 8.2.2, 8.02, 7.10.3 and all fail. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 14:57:09 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 14:57:09 -0000 Subject: [GHC] #15603: ref6 example from StaticPointers documentation doesn't type check In-Reply-To: <049.2f1c9babf7c08f8cf0bfccd75c2c4869@haskell.org> References: <049.2f1c9babf7c08f8cf0bfccd75c2c4869@haskell.org> Message-ID: <064.a5367bbf37a4362671b611470264c83e@haskell.org> #15603: ref6 example from StaticPointers documentation doesn't type check -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by monoidal): This is due to Num. How about changing to `ref6 y = let x = 'a' in static x`? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 15:00:02 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 15:00:02 -0000 Subject: [GHC] #15603: ref6 example from StaticPointers documentation doesn't type check In-Reply-To: <049.2f1c9babf7c08f8cf0bfccd75c2c4869@haskell.org> References: <049.2f1c9babf7c08f8cf0bfccd75c2c4869@haskell.org> Message-ID: <064.063462b3ec436e95099fe6120661e128@haskell.org> #15603: ref6 example from StaticPointers documentation doesn't type check -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): That works. I'm unsure what the `y` is doing in there as well tbh, it doesn't seem to add anything. Adding a top-level type signature to this example doesn't fix the problem but specifying `(1 :: Int)` also fixes it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 15:06:25 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 15:06:25 -0000 Subject: [GHC] #15603: ref6 example from StaticPointers documentation doesn't type check In-Reply-To: <049.2f1c9babf7c08f8cf0bfccd75c2c4869@haskell.org> References: <049.2f1c9babf7c08f8cf0bfccd75c2c4869@haskell.org> Message-ID: <064.f7ac0f672fbcaf30f7522705ce986fa1@haskell.org> #15603: ref6 example from StaticPointers documentation doesn't type check -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by monoidal): Yes, we can remove `y`. Also `ref1` is wrong in the same way. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 15:22:46 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 15:22:46 -0000 Subject: [GHC] #15603: ref6 example from StaticPointers documentation doesn't type check In-Reply-To: <049.2f1c9babf7c08f8cf0bfccd75c2c4869@haskell.org> References: <049.2f1c9babf7c08f8cf0bfccd75c2c4869@haskell.org> Message-ID: <064.3e8f233518f245a446f87df3b65b029e@haskell.org> #15603: ref6 example from StaticPointers documentation doesn't type check -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): You might think so but `ref1` type checks without any type signatures. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 15:31:10 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 15:31:10 -0000 Subject: [GHC] #15603: ref6 example from StaticPointers documentation doesn't type check In-Reply-To: <049.2f1c9babf7c08f8cf0bfccd75c2c4869@haskell.org> References: <049.2f1c9babf7c08f8cf0bfccd75c2c4869@haskell.org> Message-ID: <064.d593a05227683ef4a83746f349394b3a@haskell.org> #15603: ref6 example from StaticPointers documentation doesn't type check -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by monoidal): What do you mean? If I create a file {{{ {-# LANGUAGE StaticPointers #-} ref1 = static 1 }}} then GHCs 8.0-8.4 give an error about missing `Typeable t0` instance (or if monomorphism restriction is disabled, about missing `Num a`) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 15:43:00 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 15:43:00 -0000 Subject: [GHC] #15589: Always promoting metavariables during type inference may be wrong In-Reply-To: <047.51146f5adc8f94aa92119170150b76d8@haskell.org> References: <047.51146f5adc8f94aa92119170150b76d8@haskell.org> Message-ID: <062.8f14aa5375c51915c7f8e075eca4c37a@haskell.org> #15589: Always promoting metavariables during type inference may be wrong -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Here's another idea: if a type signature has any free, lexically-scoped type variables, then treat it like a ''partial'' type signature. That is, used to guide and constrain type inference, but NOT used as the single canonical specification of the type of `x`, nor used to support polymorphic recursion. That's still annoying: we might want polymorphic recursion, and if so how would we get it. But the point about having free unification variables is that we don't really know the type at all, yet. And that's what partial type signatures are all about. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 15:44:03 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 15:44:03 -0000 Subject: [GHC] #15603: ref6 example from StaticPointers documentation doesn't type check In-Reply-To: <049.2f1c9babf7c08f8cf0bfccd75c2c4869@haskell.org> References: <049.2f1c9babf7c08f8cf0bfccd75c2c4869@haskell.org> Message-ID: <064.9b1653101c14167af6bbbbcb30674cf3@haskell.org> #15603: ref6 example from StaticPointers documentation doesn't type check -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): Ah, I had another call to `ref1` in my program which was fixing the type. You're right. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 15:51:06 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 15:51:06 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.e9b8b94af2d3a4989b3d675f586eff8f@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): OK super. Let's commit! (Does it fix the orginal bug? Is there a test case?) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 16:48:24 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 16:48:24 -0000 Subject: [GHC] #15471: Polymorphism, typed splices and type inference don't mix In-Reply-To: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> References: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> Message-ID: <064.9f266393724b8b6a4c41ed7478369140@haskell.org> #15471: Polymorphism, typed splices and type inference don't mix -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by simonpj): Well, we have {{{ teset_foo :: forall p. Q (TExp (p -> p)) }}} When we run a top-level splice, as in `$$(test_foo)`, we're going to run it at compile time; it's like running it in GHCi; it must be a closed expression. So GHC must pick a type to instantiate `p`; and it chooses `Any`. After all, `test_foo` could also have type {{{ test_foo :: forall p. Num p => p -> Q (TExp (p -> p)) }}} and now we must pick a `Num` dictionary to pass to it. I think what you want is for `test_foo` to have type {{{ test_foo :: Q (TExp (forall p. p->p)) }}} but we can't do that. Yet anyway. For a start it'd require impredicative polymorphism. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 16:54:54 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 16:54:54 -0000 Subject: [GHC] #3427: control what sort of entity a deprecated pragma applies to In-Reply-To: <044.6e5c26a8435c2fcde3f9de3ab4769428@haskell.org> References: <044.6e5c26a8435c2fcde3f9de3ab4769428@haskell.org> Message-ID: <059.5cb4a21fb51d72f095c4eff14785c5fc@haskell.org> #3427: control what sort of entity a deprecated pragma applies to -------------------------------------+------------------------------------- Reporter: igloo | Owner: thoughtpolice Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 6.10.4 Resolution: | Keywords: deprecate | warning, newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nineonine): I submitted a patch for review: [https://phabricator.haskell.org/D5126] -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 16:55:24 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 16:55:24 -0000 Subject: [GHC] #3427: control what sort of entity a deprecated pragma applies to In-Reply-To: <044.6e5c26a8435c2fcde3f9de3ab4769428@haskell.org> References: <044.6e5c26a8435c2fcde3f9de3ab4769428@haskell.org> Message-ID: <059.a0d1a2d88c05d96d6f8130f51162cf90@haskell.org> #3427: control what sort of entity a deprecated pragma applies to -------------------------------------+------------------------------------- Reporter: igloo | Owner: thoughtpolice Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 6.10.4 Resolution: | Keywords: deprecate | warning, newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nineonine): I submitted a patch for review: [https://phabricator.haskell.org/D5126] -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 17:04:35 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 17:04:35 -0000 Subject: [GHC] #9173: Better type error messages In-Reply-To: <046.f8f24aa2ddaa3d579bc40f0b6f04f6b7@haskell.org> References: <046.f8f24aa2ddaa3d579bc40f0b6f04f6b7@haskell.org> Message-ID: <061.61aed058f3a7748dbcb1c3e8589c4305@haskell.org> #9173: Better type error messages -------------------------------------+------------------------------------- Reporter: simonpj | Owner: goldfire Type: bug | Status: new Priority: high | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: | TypeErrorMessages Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nineonine): I will give this one a whirl. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 17:12:20 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 17:12:20 -0000 Subject: [GHC] #15570: Core transformations generate bad indexCharOffAddr# call In-Reply-To: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> References: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> Message-ID: <063.26e87d6c20d7ec1e84f2dff4c4629a5b@haskell.org> #15570: Core transformations generate bad indexCharOffAddr# call -------------------------------------+------------------------------------- Reporter: alpmestan | Owner: alpmestan Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15286 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alpmestan): Yes, let's! I'm wrapping up some other work for hadrian right now, I will pick this up right after and look into removing those `-O0`s while still avoiding the problem from #15286. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 17:49:52 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 17:49:52 -0000 Subject: [GHC] #15558: Locally handling an empty constraint In-Reply-To: <050.9e62fddfd8cdd1b00cc8acc9acab3225@haskell.org> References: <050.9e62fddfd8cdd1b00cc8acc9acab3225@haskell.org> Message-ID: <065.7e430e299238de85cafb210e644ac47b@haskell.org> #15558: Locally handling an empty constraint -------------------------------------+------------------------------------- Reporter: Ericson2314 | Owner: (none) Type: task | Status: closed Priority: normal | Milestone: ⊥ Component: Compiler | Version: 8.0.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: gadt/T15558 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ericson2314): OK. I guess new syntax for eliminating an uninhabited constraint is indeed needed. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 17:53:32 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 17:53:32 -0000 Subject: [GHC] #13080: Memory leak caused by nested monadic loops In-Reply-To: <048.4f7713b875928ea0a18ce51d5f94986c@haskell.org> References: <048.4f7713b875928ea0a18ce51d5f94986c@haskell.org> Message-ID: <063.1856ea8a0eaa05144bb4efc665734f05@haskell.org> #13080: Memory leak caused by nested monadic loops -------------------------------------+------------------------------------- Reporter: Feuerbach | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by saurabhnanda): I ''think'' I have been hit by this bug. Is the following going to leak memory due to this bug: {{{ worker :: (AppMonad m) => TChan MyType -> m () worker chan = do mItem <- tryReadTChanIO chan case mItem of Just item -> do processItem item worker chan Nothing -> pure () }}} Can it be fixed by using {{{whileJust_}}} from http://hackage.haskell.org/package/monad-loops-0.4.3/docs/src/Control- Monad-Loops.html#whileJust_ ? {{{ worker :: (AppMonad m) => TChan MyType -> m () worker chan = whileJust_ (tryReadTChanIO chan) processItem }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 19:55:23 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 19:55:23 -0000 Subject: [GHC] #3427: control what sort of entity a deprecated pragma applies to In-Reply-To: <044.6e5c26a8435c2fcde3f9de3ab4769428@haskell.org> References: <044.6e5c26a8435c2fcde3f9de3ab4769428@haskell.org> Message-ID: <059.b2a50b416b941f12606ceb6c30593fc6@haskell.org> #3427: control what sort of entity a deprecated pragma applies to -------------------------------------+------------------------------------- Reporter: igloo | Owner: nineonine Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 6.10.4 Resolution: | Keywords: deprecate | warning, newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by nineonine): * owner: thoughtpolice => nineonine -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 20:25:31 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 20:25:31 -0000 Subject: [GHC] #15071: :set usage in ghci tests breaks platform independence of output In-Reply-To: <046.ca930388c371dd0f2b55a7ae0becdca1@haskell.org> References: <046.ca930388c371dd0f2b55a7ae0becdca1@haskell.org> Message-ID: <061.804d9a8fd8b3e7e5fb18de3f9e1b360e@haskell.org> #15071: :set usage in ghci tests breaks platform independence of output -------------------------------------+------------------------------------- Reporter: bgamari | Owner: RolandSenn Type: bug | Status: patch Priority: high | Milestone: 8.8.1 Component: Test Suite | Version: 8.2.2 Resolution: | Keywords: ci-breakage Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Windows: make | test TESTS="ghci057 T9293" Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5125 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Krzysztof Gogolewski ): In [changeset:"24d610a48acc363c99a278399518c716732b9802/ghc" 24d610a4/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="24d610a48acc363c99a278399518c716732b9802" Fix tests ghci057 and T9293. (#15071) Summary: As both tests specify -fno-ghci-leak-check, the GHCi :set command is not expected to list the -fghci-leak check flag. Test Plan: WINDOWS: make test TESTS="ghci057 T9293" Reviewers: bgamari, monoidal Reviewed By: monoidal Subscribers: rwbarton, carter GHC Trac Issues: #15071 Differential Revision: https://phabricator.haskell.org/D5125 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 20:49:27 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 20:49:27 -0000 Subject: [GHC] #15286: "Can't use Natural in base" when compiling GHC.Natural with -O0 In-Reply-To: <048.cfab6e6ea21d7113a33d736cfa0133f3@haskell.org> References: <048.cfab6e6ea21d7113a33d736cfa0133f3@haskell.org> Message-ID: <063.68bd9c646966c58e81dec40cc7e455c2@haskell.org> #15286: "Can't use Natural in base" when compiling GHC.Natural with -O0 -------------------------------------+------------------------------------- Reporter: alpmestan | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: libraries/base | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4880 Wiki Page: | -------------------------------------+------------------------------------- Comment (by alpmestan): I haven't looked into the actual problem, but hsyl20's instructions from https://ghc.haskell.org/trac/ghc/ticket/15570#comment:13 seem to work, I just opened [https://github.com/snowleopard/hadrian/pull/674 hadrian#674] to get rid of those `-O0`s. This also fixes many failing tests. This doesn't answer anything about the problem though of course. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 20:55:08 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 20:55:08 -0000 Subject: [GHC] #15570: Core transformations generate bad indexCharOffAddr# call In-Reply-To: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> References: <048.6749470bd8e5b16854763831c1951d1e@haskell.org> Message-ID: <063.5ab41bae320c5162393e2f5c93def4fe@haskell.org> #15570: Core transformations generate bad indexCharOffAddr# call -------------------------------------+------------------------------------- Reporter: alpmestan | Owner: alpmestan Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15286 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alpmestan): I wrote https://ghc.haskell.org/trac/ghc/ticket/15286#comment:7 to report that I have a PR up to get rid of those `-O0`s, implementing hsyl20's recommendation, and that it works! (It even fixes some failing tests.) I'm about to turn off my computer, but I guess I can try building our little example from the ticket description tomorrow, using GHC&libs built by hadrian without those `-O0`s, reporting back on the generated Core here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 23:37:47 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 23:37:47 -0000 Subject: [GHC] #8763: forM_ [1..N] does not get fused (allocates 50% more) In-Reply-To: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> References: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> Message-ID: <057.ec2774c574543fa23259a5b51a8317e0@haskell.org> #8763: forM_ [1..N] does not get fused (allocates 50% more) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #7206 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Thanks for the explanation. Try this {{{ forM_2 :: (Foldable t, Monad m) => t a -> (a -> m b) -> m () forM_2 xs f = let c x k = f x >> k {-# INLINE c #-} in foldr c (return ()) xs }}} and use `forM_2` instead of `forM_` in the outer calls in `f` and `g`. I then get good results for both. How does this work? Well by marking `c` as INLINE, I prevent `f` from inlining into it -- remember, the promise of INLINE things is that what you write gets inlined. And this is what we want: `c` is small, just `f x >> k`, and inlining it is very very good. Without the INLINE pragmas on `c` we have something like {{{ let f = BIG in let c x k = f x >> k in BODY }}} Since `f` occurs just once, we inline `f` to give {{{ let c x k = BIG x >> k in BODY }}} and now `c` becomes too big to inline. This is a classic inlining dilemma: do we inline `f` into `c` or `c` into `BODY`? The latter is much better in this case. I think we could build this into the libraries just by changing the definition of `mapM_`. Do you agree? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 23:39:57 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 23:39:57 -0000 Subject: [GHC] #3483: Some mechanism for eliminating "absurd" patterns In-Reply-To: <044.05fb1984acc37eefec1ed6383058af74@haskell.org> References: <044.05fb1984acc37eefec1ed6383058af74@haskell.org> Message-ID: <059.0180b5978268af1fd2ece0f511f8ab53@haskell.org> #3483: Some mechanism for eliminating "absurd" patterns -------------------------------------+------------------------------------- Reporter: ryani | Owner: (none) Type: feature request | Status: new Priority: low | Milestone: Component: Compiler | Version: 6.10.4 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10756 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * related: => #10756 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 4 23:40:18 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 04 Sep 2018 23:40:18 -0000 Subject: [GHC] #10756: Allow users to indicate inaccessible patterns In-Reply-To: <044.44fc866587983798150a57353bc7bdbd@haskell.org> References: <044.44fc866587983798150a57353bc7bdbd@haskell.org> Message-ID: <059.6bfc9c0bc42601cc84b99f5bf6511b4a@haskell.org> #10756: Allow users to indicate inaccessible patterns -------------------------------------+------------------------------------- Reporter: edsko | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #3483 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * related: => #3483 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 02:47:36 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 02:47:36 -0000 Subject: [GHC] #15298: Support spliced function names in type signatures in TH declaration quotes In-Reply-To: <043.1a4a2d0311f0e64366ade2762ccca9ea@haskell.org> References: <043.1a4a2d0311f0e64366ade2762ccca9ea@haskell.org> Message-ID: <058.af21c5cb6d444a506c8559b52c1b358a@haskell.org> #15298: Support spliced function names in type signatures in TH declaration quotes -------------------------------------+------------------------------------- Reporter: ntc2 | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #6089 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tmobile): Wow, just stumbled upon this. It's a rather surprising limitation. Anyone familiar with TH know what it might take to fix this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 03:27:36 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 03:27:36 -0000 Subject: [GHC] #3427: control what sort of entity a deprecated pragma applies to In-Reply-To: <044.6e5c26a8435c2fcde3f9de3ab4769428@haskell.org> References: <044.6e5c26a8435c2fcde3f9de3ab4769428@haskell.org> Message-ID: <059.a8c024760899806ceeb04b4b4d0e4ca9@haskell.org> #3427: control what sort of entity a deprecated pragma applies to -------------------------------------+------------------------------------- Reporter: igloo | Owner: nineonine Type: feature request | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 6.10.4 Resolution: | Keywords: deprecate | warning, newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by nineonine): * status: new => patch -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 04:44:02 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 04:44:02 -0000 Subject: [GHC] #9173: Better type error messages In-Reply-To: <046.f8f24aa2ddaa3d579bc40f0b6f04f6b7@haskell.org> References: <046.f8f24aa2ddaa3d579bc40f0b6f04f6b7@haskell.org> Message-ID: <061.160504937eb3fdc095911125d3431f64@haskell.org> #9173: Better type error messages -------------------------------------+------------------------------------- Reporter: simonpj | Owner: goldfire Type: bug | Status: new Priority: high | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: | TypeErrorMessages Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): See also https://github.com/ghc-proposals/ghc-proposals/pull/156 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 06:30:30 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 06:30:30 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.fec8c4204cdeb35679686a21668c4c91@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): I'm not done merging yet, unfortunately. I have rebased your patch onto the pre-patch master branch, but I still have to combine that with the rest of the #14880 patch, which is a bit tricky because both perform similar refactorings (factor out a private worker function for `tyCoVarsOf`...), but for different reasons. I'm afraid the easiest way is going to be to take the patch as is, and then manually re-engineer the `-accum` change from there. Richard did add some test cases though, and we have the existing tests that highlighted the regression in the first place (one of them is what we've been using throughout here). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 06:43:52 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 06:43:52 -0000 Subject: [GHC] #15176: Superclass `Monad m =>` makes program run 100 times slower In-Reply-To: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> References: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> Message-ID: <061.a3df2c26798e53ea221d13795bf35935@haskell.org> #15176: Superclass `Monad m =>` makes program run 100 times slower -------------------------------------+------------------------------------- Reporter: danilo2 | Owner: osa1 Type: bug | Status: new Priority: highest | Milestone: 8.8.1 Component: Compiler | Version: 8.4.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): I be able to get more useful RTS stats and smaller Core I made a smaller reproducer: {{{#!haskell {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Strict #-} module Main where import Prologue import qualified Control.Monad.Exception as Exception import qualified Data.Graph.Data.Graph.Class as Graph import qualified Data.Graph.Fold.Partition as Partition import qualified Luna.IR as IR import qualified Luna.Pass as Pass import qualified Luna.Pass.Scheduler as Scheduler import Luna.Pass (Pass) import Luna.Pass.Basic (Compilation) type OnDemandPass stage pass m = ( MonadIO m , Typeable pass , Pass.Compile stage pass m , Exception.MonadException Scheduler.Error m ) runPass :: forall stage pass m . OnDemandPass stage pass m => Pass stage pass () -> m () runPass !pass = Scheduler.evalT $ do Scheduler.registerPassFromFunction__ pass Scheduler.runPassSameThreadByType @pass {-# INLINE runPass #-} runPass' :: Pass Compilation Pass.BasicPass () -> IO () runPass' p = Graph.encodeAndEval @Compilation (runPass p) {-# INLINE runPass' #-} partitionsUnify :: Int -> IO () partitionsUnify i = runPass' $ do !a <- IR.var "a" !b <- IR.var "b" !u <- IR.unify a b let go !0 = let !o = pure () in o go !j = do !_ <- Partition.partition u go $! j - 1 go i main :: IO () main = partitionsUnify (10^6) }}} Put this in core/test/Main.hs and add this to luna-core.cabal: {{{ executable bench-test main-is: Main.hs hs-source-dirs: test/ build-depends: ansi-terminal -any, base -any, containers -any, convert -any, deepseq -any, ghc -any, layered-state -any, luna-autovector -any, luna-core -any, luna-cpp-containers -any, luna-data-storable -any, luna-data-typemap -any, luna-exception -any, luna-foreign-utils -any, luna-generic-traversable -any, luna-generic-traversable2 -any, luna-memory-manager -any, luna-memory-pool -any, luna-tuple-utils -any, mtl -any, primitive -any, prologue -any, structs -any, unboxed-ref >=0.4.0.0, vector -any ghc-options: -O2 -ticky -rtsopts -Wall }}} Results: (with and without `Monad =>`) {{{ ============= With Monad => ======================================================= luna git:(master) $ time (cabal-run bench-test +RTS -s) 27,544,258,632 bytes allocated in the heap 19,561,928 bytes copied during GC 205,496 bytes maximum residency (2 sample(s)) 33,152 bytes maximum slop 2 MB total memory in use (0 MB lost due to fragmentation) Tot time (elapsed) Avg pause Max pause Gen 0 26366 colls, 0 par 0.270s 0.268s 0.0000s 0.0008s Gen 1 2 colls, 0 par 0.002s 0.002s 0.0008s 0.0011s INIT time 0.000s ( 0.000s elapsed) MUT time 13.449s ( 13.487s elapsed) GC time 0.272s ( 0.269s elapsed) EXIT time 0.000s ( 0.000s elapsed) Total time 13.721s ( 13.757s elapsed) %GC time 2.0% (2.0% elapsed) Alloc rate 2,048,118,786 bytes per MUT second Productivity 98.0% of total user, 98.0% of total elapsed ( cabal-run bench-test +RTS -s; ) 13,72s user 0,04s system 99% cpu 13,761 total ============= Original ============================================================ luna git:(master) $ time (cabal-run bench-test +RTS -s) 3,952,215,688 bytes allocated in the heap 2,071,824 bytes copied during GC 200,320 bytes maximum residency (2 sample(s)) 33,152 bytes maximum slop 2 MB total memory in use (0 MB lost due to fragmentation) Tot time (elapsed) Avg pause Max pause Gen 0 3790 colls, 0 par 0.042s 0.043s 0.0000s 0.0008s Gen 1 2 colls, 0 par 0.001s 0.002s 0.0009s 0.0010s INIT time 0.000s ( 0.000s elapsed) MUT time 1.595s ( 1.605s elapsed) GC time 0.043s ( 0.044s elapsed) EXIT time 0.000s ( 0.000s elapsed) Total time 1.638s ( 1.650s elapsed) %GC time 2.6% (2.7% elapsed) Alloc rate 2,478,513,730 bytes per MUT second Productivity 97.4% of total user, 97.3% of total elapsed ( cabal-run bench-test +RTS -s; ) 1,64s user 0,01s system 99% cpu 1,654 total }}} I'll now try with `-ticky`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 06:57:25 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 06:57:25 -0000 Subject: [GHC] #13862: Optional "-v" not allowed with :load in GHCi In-Reply-To: <044.9738400eba372a90ccdc97dcca61b7c9@haskell.org> References: <044.9738400eba372a90ccdc97dcca61b7c9@haskell.org> Message-ID: <059.bd7866f98e9e59ced1eebf66499f0ac7@haskell.org> #13862: Optional "-v" not allowed with :load in GHCi -------------------------------------+------------------------------------- Reporter: vanto | Owner: RolandSenn Type: bug | Status: patch Priority: normal | Milestone: 8.8.1 Component: GHCi | Version: 8.0.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Incorrect | Test Case: make test error/warning at compile-time | TESTS="T13862a T13862b T13862c" Blocked By: | Blocking: Related Tickets: #4017 | Differential Rev(s): Phab:D5122 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RolandSenn): * related: => #4017 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 06:58:14 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 06:58:14 -0000 Subject: [GHC] #4017: Unhelpful error message in GHCi In-Reply-To: <046.b126e34ebdc516a2392e1a0dd50d1e4f@haskell.org> References: <046.b126e34ebdc516a2392e1a0dd50d1e4f@haskell.org> Message-ID: <061.fd1273e863bc9136c8facefd19b2c95b@haskell.org> #4017: Unhelpful error message in GHCi -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: lowest | Milestone: Component: Compiler | Version: 6.12.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #13862 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RolandSenn): * related: => #13862 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 07:37:47 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 07:37:47 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.ac5437af6a64c8263643576a1ea13b85@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > I'm afraid the easiest way is going to be to take the patch as is, and then manually re-engineer the -accum change from there. OK. That should be very easy to accomplish. Let me know if you need help (make a branch if so). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 07:59:36 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 07:59:36 -0000 Subject: [GHC] #15599: typeclass inference depends on whether a module is exposed. In-Reply-To: <047.dd916b476f2fd0f26c1766607c70f5c2@haskell.org> References: <047.dd916b476f2fd0f26c1766607c70f5c2@haskell.org> Message-ID: <062.1fd6c9bb5097ca2d9f5ec81e4d1792f8@haskell.org> #15599: typeclass inference depends on whether a module is exposed. -------------------------------------+------------------------------------- Reporter: gleachkr | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.3 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): There's a big indirection through stack and cabal here. e.g. how exactly this command invoke GHC, and what files exist at that moment? {{{ echo "test" | stack repl src/Tests/Good.hs -- 2> /dev/null | grep checkFlag }}} Would it be possible to explain how to repro by one or more invocations of GHC directly? Thanks -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 08:06:13 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 08:06:13 -0000 Subject: [GHC] #15604: Profiling RTS flag `-po` does not work Message-ID: <043.a8270f259e9e5fb95951cf6a253478e8@haskell.org> #15604: Profiling RTS flag `-po` does not work -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Profiling | Version: 8.5 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: -------------------------------------+------------------------------------- The RTS flag documentation says this about `-po`: {{{ empty: -p Time/allocation profile in tree format empty: (output file .prof) empty: -po Override profiling output file name prefix (program name by default) }}} However it current doesn't work as advertised in 8.4 and HEAD. When I use `-po` no file is generated. Reproducer: {{{ $ cat empty.hs main = return () $ ghc-stage2 empty.hs -fforce-recomp -rtsopts -prof [1 of 1] Compiling Main ( empty.hs, empty.o ) Linking empty ... $ ./empty +RTS -poprof $ ls | grep prof $ }}} Just `-p` works: {{{ $ ./empty +RTS -p $ ls | grep prof empty.prof $ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 08:12:24 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 08:12:24 -0000 Subject: [GHC] #15176: Superclass `Monad m =>` makes program run 100 times slower In-Reply-To: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> References: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> Message-ID: <061.7a776c209ccfbe20f4e34f9206b4d163@haskell.org> #15176: Superclass `Monad m =>` makes program run 100 times slower -------------------------------------+------------------------------------- Reporter: danilo2 | Owner: osa1 Type: bug | Status: new Priority: highest | Milestone: 8.8.1 Component: Compiler | Version: 8.4.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * Attachment "original.ticky" added. Ticky output of program in comment:10 without Monad m -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 08:13:12 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 08:13:12 -0000 Subject: [GHC] #15176: Superclass `Monad m =>` makes program run 100 times slower In-Reply-To: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> References: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> Message-ID: <061.65c8a4ec0f4e65dd51196a61c2403d56@haskell.org> #15176: Superclass `Monad m =>` makes program run 100 times slower -------------------------------------+------------------------------------- Reporter: danilo2 | Owner: osa1 Type: bug | Status: new Priority: highest | Milestone: 8.8.1 Component: Compiler | Version: 8.4.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * Attachment "patch.ticky" added. Ticky output of program in comment:10 with Monad m -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 08:14:15 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 08:14:15 -0000 Subject: [GHC] #15176: Superclass `Monad m =>` makes program run 100 times slower In-Reply-To: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> References: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> Message-ID: <061.905c60bb82b2fe1823e8f4883e44a99d@haskell.org> #15176: Superclass `Monad m =>` makes program run 100 times slower -------------------------------------+------------------------------------- Reporter: danilo2 | Owner: osa1 Type: bug | Status: new Priority: highest | Milestone: 8.8.1 Component: Compiler | Version: 8.4.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * Attachment "bench-test-orig.prof" added. Prof output of program in comment:10 without Monad m -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 08:15:35 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 08:15:35 -0000 Subject: [GHC] #15176: Superclass `Monad m =>` makes program run 100 times slower In-Reply-To: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> References: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> Message-ID: <061.1ed1d8d888e827debc93bd61c48df192@haskell.org> #15176: Superclass `Monad m =>` makes program run 100 times slower -------------------------------------+------------------------------------- Reporter: danilo2 | Owner: osa1 Type: bug | Status: new Priority: highest | Milestone: 8.8.1 Component: Compiler | Version: 8.4.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * Attachment "bench-test-patch.prof" added. Prof output of program in comment:10 with Monad m -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 08:20:58 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 08:20:58 -0000 Subject: [GHC] #15176: Superclass `Monad m =>` makes program run 100 times slower In-Reply-To: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> References: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> Message-ID: <061.3f5a7cfe36a42e188d29c376d73a21ed@haskell.org> #15176: Superclass `Monad m =>` makes program run 100 times slower -------------------------------------+------------------------------------- Reporter: danilo2 | Owner: osa1 Type: bug | Status: new Priority: highest | Milestone: 8.8.1 Component: Compiler | Version: 8.4.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): I attached four files for ticky and prof outputs of the program in comment:10 with and wihtout `Monad m =>` patch. I can't make sense of the ticky output -- it's really hard to see what's wrong in a hundred lines long Core function but perhaps someone else can figure it out. One other thing I tried was to test the patch with `-O0`, and the numbers are almost identical: {{{ === ORIGINAL =================================================================== luna git:(master) $ time (cabal-run bench-test +RTS -s) 77,264,754,848 bytes allocated in the heap 114,241,080 bytes copied during GC 240,688 bytes maximum residency (2 sample(s)) 33,152 bytes maximum slop 2 MB total memory in use (0 MB lost due to fragmentation) Tot time (elapsed) Avg pause Max pause Gen 0 74218 colls, 0 par 0.256s 0.246s 0.0000s 0.0002s Gen 1 2 colls, 0 par 0.001s 0.001s 0.0003s 0.0006s INIT time 0.000s ( 0.000s elapsed) MUT time 25.042s ( 25.168s elapsed) GC time 0.257s ( 0.247s elapsed) EXIT time 0.000s ( 0.000s elapsed) Total time 25.298s ( 25.415s elapsed) %GC time 1.0% (1.0% elapsed) Alloc rate 3,085,464,250 bytes per MUT second Productivity 99.0% of total user, 99.0% of total elapsed ( cabal-run bench-test +RTS -s; ) 25,30s user 0,12s system 99% cpu 25,423 total === PATCHED =================================================================== luna git:(master) $ time (cabal-run bench-test +RTS -s) 77,200,755,440 bytes allocated in the heap 114,115,976 bytes copied during GC 241,064 bytes maximum residency (2 sample(s)) 33,152 bytes maximum slop 2 MB total memory in use (0 MB lost due to fragmentation) Tot time (elapsed) Avg pause Max pause Gen 0 74218 colls, 0 par 0.263s 0.254s 0.0000s 0.0002s Gen 1 2 colls, 0 par 0.000s 0.001s 0.0003s 0.0006s INIT time 0.000s ( 0.000s elapsed) MUT time 25.487s ( 25.573s elapsed) GC time 0.263s ( 0.254s elapsed) EXIT time 0.000s ( 0.000s elapsed) Total time 25.750s ( 25.827s elapsed) %GC time 1.0% (1.0% elapsed) Alloc rate 3,029,012,929 bytes per MUT second Productivity 99.0% of total user, 99.0% of total elapsed ( cabal-run bench-test +RTS -s; ) 25,75s user 0,08s system 100% cpu 25,831 total }}} So it seems to me that with the different dictionary representation we're losing some optimization opportunities. I guess we could try to enable all optimizations again (with -O2) and selectively disable single optimization passes to see which one makes these two versions more similar. That may give an idea about which optimization is not applicable with the `Monad m =>` patch. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 08:24:59 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 08:24:59 -0000 Subject: [GHC] #8763: forM_ [1..N] does not get fused (allocates 50% more) In-Reply-To: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> References: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> Message-ID: <057.0fb16f0c7ac9a4b165da9c1913819164@haskell.org> #8763: forM_ [1..N] does not get fused (allocates 50% more) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #7206 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): Yes, that works and seems a lot simpler! I didn't know that `INLINE` works 'both ways', e.g. that we can prevent inlining the body into `c` this way. The only minor downside is that there might be more unidentified cases where such an `INLINE` annotation on a lambda could be beneficial. I'll prepare a patch and benchmark. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 08:25:47 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 08:25:47 -0000 Subject: [GHC] #15176: Superclass `Monad m =>` makes program run 100 times slower In-Reply-To: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> References: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> Message-ID: <061.322e3aab0cf65a20f37cd3d449869c7b@haskell.org> #15176: Superclass `Monad m =>` makes program run 100 times slower -------------------------------------+------------------------------------- Reporter: danilo2 | Owner: osa1 Type: bug | Status: new Priority: highest | Milestone: 8.8.1 Component: Compiler | Version: 8.4.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): When generating .ticky files I do this {{{ ghc -O -ticky -dverbose-core2core -ddump-stg Foo.hs >& Foo.stg ./Foo +RTS -rFoo.ticky }}} The ticky files are utterly useless without the accompanying `-dverbose- core2core -ddump-stg` output, produced in the very same run of GHC. Would you like to do that and upload the results? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 08:30:45 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 08:30:45 -0000 Subject: [GHC] #8763: forM_ [1..N] does not get fused (allocates 50% more) In-Reply-To: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> References: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> Message-ID: <057.480ee233f6ffcc1ac0c8d4ee0ddbfad5@haskell.org> #8763: forM_ [1..N] does not get fused (allocates 50% more) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #7206 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > I didn't know that INLINE works 'both ways', e.g. that we can prevent inlining the body into c this way. Yes, it's super-important that INLINE works like that. Consider {{{ f x = g y = Just (f y) {-# INLINE g #-} }}} where that is the only occurrence of `f`, but there are zillions of occurrences of `g`. You would be jolly annoyed if GHC inlined `` into `g`, and then inlined the new `g` at each of its zillions of call sites!! No: INLINE says "when you see a saturated application of this function, inline ''the RHSI wrote'' at the call site". It might be useful to beef up the documentation of INLINE to explain this, if you felt able to do so. I agree that there may be other places such an INLINE would be desirable. A good start would be a careful Note on `mapM_` explaining from first principles why the local let and INLINE is important. Then others can refer to that Note. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 08:32:06 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 08:32:06 -0000 Subject: [GHC] #15176: Superclass `Monad m =>` makes program run 100 times slower In-Reply-To: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> References: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> Message-ID: <061.80958cb0660ba02759a4359d9787ac33@haskell.org> #15176: Superclass `Monad m =>` makes program run 100 times slower -------------------------------------+------------------------------------- Reporter: danilo2 | Owner: osa1 Type: bug | Status: new Priority: highest | Milestone: 8.8.1 Component: Compiler | Version: 8.4.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): I already have Core outputs, they're 140+ files in total (70+ files for each version) and generating them takes about 30 mins for one version (the program is huge). I'll start generating verbose and STG files now but it'll take a few hours probably (just -ddump-simpl takes 30 minutes). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 08:41:00 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 08:41:00 -0000 Subject: [GHC] #15578: Honour INLINE pragmas on 0-arity bindings In-Reply-To: <046.e84edd9f62d6ef84f8f7c7aedfa45ace@haskell.org> References: <046.e84edd9f62d6ef84f8f7c7aedfa45ace@haskell.org> Message-ID: <061.3dceeb81be5551a37687feb87a0f1c24@haskell.org> #15578: Honour INLINE pragmas on 0-arity bindings -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15519 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): OK here's a better patch {{{ diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs index 68e7290..fe2ae62 100644 --- a/compiler/coreSyn/CoreUnfold.hs +++ b/compiler/coreSyn/CoreUnfold.hs @@ -159,7 +159,8 @@ mkInlineUnfoldingWithArity arity expr guide = UnfWhen { ug_arity = arity , ug_unsat_ok = needSaturated , ug_boring_ok = boring_ok } - boring_ok = inlineBoringOk expr' + boring_ok | arity == 0 = True + | otherwise = inlineBoringOk expr' mkInlinableUnfolding :: DynFlags -> CoreExpr -> Unfolding mkInlinableUnfolding dflags expr diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index c8870c9..b0f6455 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -3402,14 +3402,18 @@ simplStableUnfolding env top_lvl mb_cont id unf rhs_ty Just cont -> simplJoinRhs unf_env id expr cont Nothing -> simplExprC unf_env expr (mkBoringStop rhs_ty) ; case guide of - UnfWhen { ug_arity = arity, ug_unsat_ok = sat_ok } -- Happens for INLINE things + UnfWhen { ug_arity = arity, ug_unsat_ok = sat_ok + , ug_boring_ok = boring_ok } + -- This branch happens for INLINE things -> let guide' = UnfWhen { ug_arity = arity, ug_unsat_ok = sat_ok - , ug_boring_ok = inlineBoringOk expr' } + , ug_boring_ok = boring_ok || inlineBoringOk expr' } -- Refresh the boring-ok flag, in case expr' -- has got small. This happens, notably in the inlinings -- for dfuns for single-method classes; see -- Note [Single-method classes] in TcInstDcls. -- A test case is Trac #4138 + -- But don't forget a boring_ok of True; e.g. see the + -- way it is set in calcUnfoldingGuidanceWithArity in return (mkCoreUnfolding src is_top_lvl expr' guide') -- See Note [Top-level flag on inline rules] in CoreUnfold }}} I'd forgotten about the bit in `Simplify`. Moreover, you do need {{{ test3 = oneShot (runTokenParser testGrammar1) }}} Then I think we get good perf. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 08:44:31 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 08:44:31 -0000 Subject: [GHC] #15519: Minor code refactoring leads to drastic performance degradation In-Reply-To: <046.ad6b341bd87e1814116aa36115f7bc12@haskell.org> References: <046.ad6b341bd87e1814116aa36115f7bc12@haskell.org> Message-ID: <061.4c85683a2bc3a886a299c6983b7fc6bd@haskell.org> #15519: Minor code refactoring leads to drastic performance degradation -------------------------------------+------------------------------------- Reporter: danilo2 | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: SpecConstr Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): To summarise: once we have done #15578, we'll get good perf for {{{ testGrammar1 = {-# INLINE testGrammar1 #-} test3 = oneShot (runTokenParser testGrammar1) }}} * The `INLINE` ensures that `testGrammar1` is inlined even if it is used in many places. * The `oneShot` is, I'm afraid, still necessary. (You can import it from `GHC.Exts`.) It says that GHC doesn't need to worry about sharing the work of `testGrammar1` between, say, two calls `(test3 src1)` and `(test3 src2)`. You should get reliably good perf with these changes. OK? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 09:36:06 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 09:36:06 -0000 Subject: [GHC] #15176: Superclass `Monad m =>` makes program run 100 times slower In-Reply-To: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> References: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> Message-ID: <061.16d796434c34135ff5e02ae13e803fd6@haskell.org> #15176: Superclass `Monad m =>` makes program run 100 times slower -------------------------------------+------------------------------------- Reporter: danilo2 | Owner: osa1 Type: bug | Status: new Priority: highest | Milestone: 8.8.1 Component: Compiler | Version: 8.4.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): No no, don't do that!! Here are the big hitters in the `.ticky` files {{{ ==== Without Monad m (original.ticky) ========= 15000000 984000000 0 2 SS vx{v s21YX} (main:Main) (fun) in r1YhB 9000000 520000000 0 4 pSSS $w$dLayersFoldableBuilder__{v r1YhB} (main:Main) (fun) 24000000 320000000 0 3 SpM main:Main.$w$sgo1{v r19} (fun) 16000000 240000000 0 3 SpM main:Main.$w$sgo3{v r1a} (fun) 4000000 232000000 0 2 SS sat_s2229{v} (main:Main) (fun) in r1YhB 3000000 144000000 0 2 SS sat_s21Zw{v} (main:Main) (fun) in s21YX 9000000 72000000 0 46 ++++++++++++++++++++ luna- core-0.0.6-inplace:Luna.IR.Term.$fStorable1UniTerm10{v rihy9} (fun) 1000000 48000000 0 2 SS lvl1355{v r1Yhx} (main:Main) (fun) 2000000 32000000 0 2 SI lvl1206{v r1Yf3} (main:Main) (fun) 2000000 32000000 0 1 M luna- core-0.0.6-inplace:Luna.IR.Term.$WUniTermVar{v rihwq} (fun) 1000000 24000000 0 2 SI lvl1176{v r1Yez} (main:Main) (fun) 1000000 24000000 0 1 M luna- core-0.0.6-inplace:Luna.IR.Term.$WUniTermUnify{v rihwr} (fun) =========== With Monad m (patched.ticky) ============== 60000000 2496000000 0 7 +++++M. luna- core-0.0.6-inplace:Data.Graph.Fold.Deep.$fLayerBuilderDeepmType_$clayerBuild{v rGoW} (fun) 36000000 1584000000 0 3 >S. $s$fFunctorStateT_$cfmap{v rmuaf} (luna- core-0.0.6-inplace:OCI.Pass.Definition.Class) (fun) 24000000 1152000000 0 1 S sat_s2hor{v} (main:Main) (fun) in r2gUO 20000000 960000000 0 1 S sat_s2hqt{v} (main:Main) (fun) in r2gVh 6000000 480000000 0 3 pSS $wlvl{v r2gUO} (main:Main) (fun) 5000000 400000000 0 3 pSS $wlvl3{v r2gVh} (main:Main) (fun) 8000000 384000000 0 1 S sat_s2hoV{v} (main:Main) (fun) in r2gUQ 6000000 384000000 0 3 SSS $s$fReadertlayerm_$cread__3{v r2hmG} (main:Main) (fun) 6000000 384000000 0 3 SSS $s$fReadertlayerm_$cread__2{v r2hmw} (main:Main) (fun) 24000000 320000000 0 3 SpM main:Main.$w$sgo3{v r8e} (fun) 6000000 288000000 0 3 .SS luna- core-0.0.6-inplace:OCI.Pass.Definition.Class.$fApplicativePass5{v rmu8N} (fun) 12000000 288000000 0 2 .S lvl1{v rmual} (luna-core-0.0.6-inplace:OCI.Pass.Definition.Class) (fun) 16000000 240000000 0 3 SpM main:Main.$w$sgo1{v r8b} (fun) 2000000 160000000 0 3 pSS $wlvl1{v r2gUQ} (main:Main) (fun) 8000000 120000000 0 7 ++++++M $w$cbuild1{v riLVV} (luna-core-0.0.6-inplace:Luna.IR.Term) (fun) 9000000 96000000 0 3 SSM sat_sHlw{v} (luna-core-0.0.6-inplace:Data.Graph.Fold.Deep) (fun) in rGoW 1000000 48000000 0 2 SS lvl1702{v r2hn9} (main:Main) (fun) 2000000 32000000 0 2 SI $cpeekByteOff1{v r3Y9N} (luna-core-0.0.6-inplace:Luna.IR.Term.Core) (fun) 2000000 32000000 0 1 M luna- core-0.0.6-inplace:Luna.IR.Term.$WUniTermVar{v rihWA} (fun) 1000000 32000000 0 1 . sat_siM5u{v} (luna-core-0.0.6-inplace:Luna.IR.Term) (fun) in riLVV }}} So we are getting a log of allocation in * `luna- core-0.0.6-inplace:Data.Graph.Fold.Deep.$fLayerBuilderDeepmType_$clayerBuild` * `$s$fFunctorStateT_$cfmap{v rmuaf} (luna- core-0.0.6-inplace:OCI.Pass.Definition.Class)` Also, in the original version, the big allocation is in Main. So I'd generate `Main.stg` and the STG files for `Data.Graph.Fold.Deep, and perhaps OCI.Pass.Definition.Class.` to begin with -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 10:18:23 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 10:18:23 -0000 Subject: [GHC] #14974: 2-fold memory usage regression GHC 8.2.2 -> GHC 8.4.1 compiling `mmark` package In-Reply-To: <042.6f9317183740e6c428dbe334554fec22@haskell.org> References: <042.6f9317183740e6c428dbe334554fec22@haskell.org> Message-ID: <057.8c01dfd7a7025a7ded8c3af5a45d5faa@haskell.org> #14974: 2-fold memory usage regression GHC 8.2.2 -> GHC 8.4.1 compiling `mmark` package -------------------------------------+------------------------------------- Reporter: hvr | Owner: davide Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: Compiler | Version: 8.4.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by davide): Building mmark With -dShow-passes, I get an increase from 1530MB to 2900MB of allocation for SpecConstr passes. The majority of this is from compiling the Text.MMark.Parser module. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 10:18:28 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 10:18:28 -0000 Subject: [GHC] #15605: Documentation of atomicModifyMutVar# does not show properly Message-ID: <047.ae2f5e80d38d8fb787e8f2b5a032b714@haskell.org> #15605: Documentation of atomicModifyMutVar# does not show properly -------------------------------------+------------------------------------- Reporter: harendra | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: libraries | Version: 8.4.3 (other) | Keywords: ghc-prim | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- The actual documentation in the source is: {{{ -- | Modify the contents of a @MutVar\#@. Note that this isn\'t strictly -- speaking the correct type for this function, it should really be -- @MutVar# s a -> (a -> (a,b)) -> State# s -> (# State# s, b #)@, however -- we don\'t know about pairs here. }}} It actually shows as this in the docs, note the incomplete signature: {{{ Modify the contents of a MutVar#. Note that this isn't strictly speaking the correct type for this function, it should really be MutVar s -> ( s, b #), however we don't know about pairs here. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 10:34:20 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 10:34:20 -0000 Subject: [GHC] #15605: Documentation of atomicModifyMutVar# does not show properly In-Reply-To: <047.ae2f5e80d38d8fb787e8f2b5a032b714@haskell.org> References: <047.ae2f5e80d38d8fb787e8f2b5a032b714@haskell.org> Message-ID: <062.b3e0942498af1a6c53362cea63fa32f0@haskell.org> #15605: Documentation of atomicModifyMutVar# does not show properly -------------------------------------+------------------------------------- Reporter: harendra | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: libraries | Version: 8.4.3 (other) | Resolution: | Keywords: ghc-prim Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by harendra): There are other cases as well, perhaps all cases in which "#" is used more than once in the doc paragraphs should be examined. The documentation between a pair of "#" gets eaten up. For example, the documentation of compactContains# and compactContainsAny# also does not show correctly. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 11:09:26 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 11:09:26 -0000 Subject: [GHC] #15604: Profiling RTS flag `-po` does not work In-Reply-To: <043.a8270f259e9e5fb95951cf6a253478e8@haskell.org> References: <043.a8270f259e9e5fb95951cf6a253478e8@haskell.org> Message-ID: <058.21f6c528580261c03475ebfa535cb698@haskell.org> #15604: Profiling RTS flag `-po` does not work -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Profiling | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5130 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: new => patch * differential: => Phab:D5130 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 11:09:38 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 11:09:38 -0000 Subject: [GHC] #10249: GHCi leaky abstraction: error message mentions `ghciStepIO` In-Reply-To: <051.818ff8bc84030bedfa7f9663d4a7c3ef@haskell.org> References: <051.818ff8bc84030bedfa7f9663d4a7c3ef@haskell.org> Message-ID: <066.efbb7d9d795e4c26692034ac50a80cbe@haskell.org> #10249: GHCi leaky abstraction: error message mentions `ghciStepIO` -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.1 Component: GHCi | Version: 7.10.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Incorrect | Test Case: warning at compile-time | ghci/scripts/T10249 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D1527, Wiki Page: | Phab:D1528 -------------------------------------+------------------------------------- Comment (by simonpj): Gah. I had a quick look, and it's fiddly. When you write {{{ a <- e }}} at the prompt, we get into `TcRnDriver.tcUserStmt`; in the second equation (i.e. not the `BodyStmt` case). It does this {{{ ; let gi_stmt | (L loc (BindStmt ty pat expr op1 op2)) <- rn_stmt = L loc $ BindStmt ty pat (nlHsApp ghciStep expr) op1 op2 | otherwise = rn_stmt }}} which transforms the Stmt to {{{ a <- (ghciStepIO :: forall a. M a -> IO a) e }}} where `M` is the currently-in-force GHCi monad. Apparently, via `TcRnMonad.getGHCiMonad` and `setGHCiMonad`, it is possible to change the monad in which GHCi bindings are understood, using the library class {{{ module GHC.Ghci where class (Monad m) => GHCiSandboxIO m where ghciStepIO :: m a -> IO a }}} to mediate. I can't see this documented in the user manual, or indeed anywhere else. Sigh. Anyway it's this `ghcStepIO` call that the typechecker is complaining about. I can see various ways to avoid this leakage * Typecheck `e` all by iself, checking that it has type `M `, before attempting to typecheck `a <- ghcStepIO e`. This is a bit similar to what happens in "Plan C" of the `BodyStmt` case of `tcUserStmt` (see `This two-step story is very clunky, alas`). * Some how avoid adding the error contexts in `tcExpr` for generated code. Neither of these seems particularly easy. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 11:11:48 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 11:11:48 -0000 Subject: [GHC] #15587: traceEvent tests failing in slow validate In-Reply-To: <043.5a7481e85ed8eb1897c26ebcfa11c5fb@haskell.org> References: <043.5a7481e85ed8eb1897c26ebcfa11c5fb@haskell.org> Message-ID: <058.246853fba3e79b50da698f46cb15f956@haskell.org> #15587: traceEvent tests failing in slow validate -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Test Suite | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5119 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Krzysztof Gogolewski ): In [changeset:"c0e5087d01e2912f00feede6c259a2ee87685c90/ghc" c0e5087d/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c0e5087d01e2912f00feede6c259a2ee87685c90" Skip eventlog tests in GHCi way Summary: (GHCi doesn't generate event logs) Test Plan: These tests were failing in GHCi way, they're now skipped in GHCi way as GHCi doesn't generate eventlogs Reviewers: bgamari, simonmar, maoe, alpmestan Reviewed By: alpmestan Subscribers: rwbarton, carter GHC Trac Issues: #15587 Differential Revision: https://phabricator.haskell.org/D5119 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 11:19:26 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 11:19:26 -0000 Subject: [GHC] #15368: Type families, holes and -fdefer-type-errors may cause 'opt_univ fell into a hole' panic In-Reply-To: <050.73f861b4bff033457b6f954137086e2e@haskell.org> References: <050.73f861b4bff033457b6f954137086e2e@haskell.org> Message-ID: <065.e7ffbb707f010d7949ca7247f340f5a7@haskell.org> #15368: Type families, holes and -fdefer-type-errors may cause 'opt_univ fell into a hole' panic -------------------------------------+------------------------------------- Reporter: dramforever | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: crash or panic | typecheck/should_compile/T15368 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): I believe this is fixed in 8.6 beta already so we should merge Phab:D4958 and close this: {{{ haskell $ ghc MorePanic.hs -fdefer-type-errors [1 of 1] Compiling MorePanic ( MorePanic.hs, MorePanic.o ) MorePanic.hs:9:15: warning: [-Wtyped-holes] • Found hole: _ :: (F a b, F a0 b0) Where: ‘a0’ is an ambiguous type variable ‘b0’ is an ambiguous type variable ‘a’, ‘b’ are rigid type variables bound by the type signature for: trigger :: forall a b. a -> b -> (F a b, F b a) at MorePanic.hs:8:1-35 • In the first argument of ‘transitive’, namely ‘_’ In the expression: _ `transitive` trigger _ _ In an equation for ‘trigger’: trigger _ _ = _ `transitive` trigger _ _ • Relevant bindings include trigger :: a -> b -> (F a b, F b a) (bound at MorePanic.hs:9:1) | 9 | trigger _ _ = _ `transitive` trigger _ _ | ^ MorePanic.hs:9:15: warning: [-Wdeferred-type-errors] • Couldn't match type ‘F b a’ with ‘F b0 a0’ Expected type: (F a b, F b a) Actual type: (F a b, F b0 a0) NB: ‘F’ is a non-injective type family The type variables ‘b0’, ‘a0’ are ambiguous • In the expression: _ `transitive` trigger _ _ In an equation for ‘trigger’: trigger _ _ = _ `transitive` trigger _ _ • Relevant bindings include trigger :: a -> b -> (F a b, F b a) (bound at MorePanic.hs:9:1) | 9 | trigger _ _ = _ `transitive` trigger _ _ | ^^^^^^^^^^^^^^^^^^^^^^^^^^ MorePanic.hs:9:38: warning: [-Wtyped-holes] • Found hole: _ :: a0 Where: ‘a0’ is an ambiguous type variable • In the first argument of ‘trigger’, namely ‘_’ In the second argument of ‘transitive’, namely ‘trigger _ _’ In the expression: _ `transitive` trigger _ _ • Relevant bindings include trigger :: a -> b -> (F a b, F b a) (bound at MorePanic.hs:9:1) | 9 | trigger _ _ = _ `transitive` trigger _ _ | ^ MorePanic.hs:9:40: warning: [-Wtyped-holes] • Found hole: _ :: b0 Where: ‘b0’ is an ambiguous type variable • In the second argument of ‘trigger’, namely ‘_’ In the second argument of ‘transitive’, namely ‘trigger _ _’ In the expression: _ `transitive` trigger _ _ • Relevant bindings include trigger :: a -> b -> (F a b, F b a) (bound at MorePanic.hs:9:1) | 9 | trigger _ _ = _ `transitive` trigger _ _ | ^ haskell $ ghc --version The Glorious Glasgow Haskell Compilation System, version 8.6.0.20180810 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 11:23:48 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 11:23:48 -0000 Subject: [GHC] #15368: Type families, holes and -fdefer-type-errors may cause 'opt_univ fell into a hole' panic In-Reply-To: <050.73f861b4bff033457b6f954137086e2e@haskell.org> References: <050.73f861b4bff033457b6f954137086e2e@haskell.org> Message-ID: <065.86a8cdb01420624396dd5ad5dc697b7f@haskell.org> #15368: Type families, holes and -fdefer-type-errors may cause 'opt_univ fell into a hole' panic -------------------------------------+------------------------------------- Reporter: dramforever | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: crash or panic | typecheck/should_compile/T15368 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Krzysztof Gogolewski ): In [changeset:"49d50b2b7d194dca0b23de6fe4dcc717562e90a7/ghc" 49d50b2b/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="49d50b2b7d194dca0b23de6fe4dcc717562e90a7" testsuite: Add test for #15368 Reviewers: bgamari, osa1 Reviewed By: osa1 Subscribers: osa1, monoidal, rwbarton, thomie, carter GHC Trac Issues: #15368 Differential Revision: https://phabricator.haskell.org/D4958 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 11:24:26 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 11:24:26 -0000 Subject: [GHC] #15368: Type families, holes and -fdefer-type-errors may cause 'opt_univ fell into a hole' panic In-Reply-To: <050.73f861b4bff033457b6f954137086e2e@haskell.org> References: <050.73f861b4bff033457b6f954137086e2e@haskell.org> Message-ID: <065.2817fe855af8d65256f03931c78cd9e4@haskell.org> #15368: Type families, holes and -fdefer-type-errors may cause 'opt_univ fell into a hole' panic -------------------------------------+------------------------------------- Reporter: dramforever | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: crash or panic | typecheck/should_compile/T15368 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: new => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 11:24:48 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 11:24:48 -0000 Subject: [GHC] #15587: traceEvent tests failing in slow validate In-Reply-To: <043.5a7481e85ed8eb1897c26ebcfa11c5fb@haskell.org> References: <043.5a7481e85ed8eb1897c26ebcfa11c5fb@haskell.org> Message-ID: <058.28f0fcc15cb660d99b4def46b40212db@haskell.org> #15587: traceEvent tests failing in slow validate -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Test Suite | Version: 8.5 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5119 Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: patch => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 11:37:15 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 11:37:15 -0000 Subject: [GHC] #15604: Profiling RTS flag `-po` does not work In-Reply-To: <043.a8270f259e9e5fb95951cf6a253478e8@haskell.org> References: <043.a8270f259e9e5fb95951cf6a253478e8@haskell.org> Message-ID: <058.012739aa529428d71faccff437fb98b7@haskell.org> #15604: Profiling RTS flag `-po` does not work -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Profiling | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: T15604 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5130 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * testcase: => T15604 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 11:41:40 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 11:41:40 -0000 Subject: [GHC] #15526: Explain or remove mystery import in Unsafe.Coerce In-Reply-To: <045.8c1bd79d636e4b29cdc257cdfcb27b40@haskell.org> References: <045.8c1bd79d636e4b29cdc257cdfcb27b40@haskell.org> Message-ID: <060.9fd59515ab6132b45a0d1299b3c7b48f@haskell.org> #15526: Explain or remove mystery import in Unsafe.Coerce -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: task | Status: patch Priority: normal | Milestone: 8.8.1 Component: Core Libraries | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5092 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Krzysztof Gogolewski ): In [changeset:"a811d938acb09b23b11173842143a0fa946bf5cc/ghc" a811d93/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="a811d938acb09b23b11173842143a0fa946bf5cc" base: Add references to Notes for certain special imports Summary: Modules like GHC.Integer, GHC.Natural etc. are special and sometimes have to be imported just to resolve build ordering issues. It's useful to refer to the appropriate Notes at such import sites. Test Plan: Read it. Reviewers: RyanGlScott, bgamari, hvr, simonpj Reviewed By: RyanGlScott, simonpj Subscribers: simonpj, rwbarton, carter GHC Trac Issues: #15526 Differential Revision: https://phabricator.haskell.org/D5092 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 11:42:46 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 11:42:46 -0000 Subject: [GHC] #15526: Explain or remove mystery import in Unsafe.Coerce In-Reply-To: <045.8c1bd79d636e4b29cdc257cdfcb27b40@haskell.org> References: <045.8c1bd79d636e4b29cdc257cdfcb27b40@haskell.org> Message-ID: <060.a3d26a82de5bd3ce09fc8634e202fb69@haskell.org> #15526: Explain or remove mystery import in Unsafe.Coerce -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: task | Status: closed Priority: normal | Milestone: 8.8.1 Component: Core Libraries | Version: 8.4.3 Resolution: fixed | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5092 Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: patch => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 11:56:14 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 11:56:14 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.b9c33c680550e57906bb6da6077b88e6@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Replying to [comment:103 simonpj]: > > I'm afraid the easiest way is going to be to take the patch as is, and then manually re-engineer the -accum change from there. > > OK. That should be very easy to accomplish. Let me know if you need help (make a branch if so). I think I've got it, but it probably won't hurt if you take a look. I'll let you know when I'm ready. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 14:05:51 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 14:05:51 -0000 Subject: [GHC] #15470: Record projections with ambiguous types In-Reply-To: <047.3cdd34484629508fb5a4f38ac9554616@haskell.org> References: <047.3cdd34484629508fb5a4f38ac9554616@haskell.org> Message-ID: <062.54a369bd8eeb2b6aededf584c6a1de9a@haskell.org> #15470: Record projections with ambiguous types -------------------------------------+------------------------------------- Reporter: sweirich | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I thought that visible type applications would work too, so I tried it (diff below). Alas it turns out that we give record selectors ''nested'' forall types. For example from {{{ data T m = MkT { fld :: forall a. m a -> m a } }}} we get the selector: {{{ fld :: forall m. T m -> (forall a. m a -> m a) }}} So we can't use scoped type variables from the signature to instantiate in the RHS, ike this {{{ fld :: forall m. T m -> (forall a. m a -> m a) fld (MkT x) = x @ a -- No }}} Bother. Maybe we can change this assumption, and put all the foralls (and constraints) at the top of record selectors? I'm not sure of the consequences of doing so. The choice is made in the definition of `sel_ty` in `TcTyDecls.mkOneRecordSelector`. It affects user code. For example, do we write `fld @IO r @Int` or `fld @IO @Int r`? So it's be a breaking change. I'm not sure I see any other solution, alas. Richard, Mr VTA? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 14:33:01 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 14:33:01 -0000 Subject: [GHC] #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory In-Reply-To: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> References: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> Message-ID: <059.b1b964d1543fb347c0806f5794f0007f@haskell.org> #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory -------------------------------------+------------------------------------- Reporter: int-e | Owner: osa1 Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: GHCi | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): Note to self: I think running the interpreter with profiled compiler should show us what's retaining all the extra objects in newer GHCs, but I currently can't build the compiler in prof way (the build seems to be broken). I'll try to see what's wrong with the build.. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 14:43:44 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 14:43:44 -0000 Subject: [GHC] #15471: Polymorphism, typed splices and type inference don't mix In-Reply-To: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> References: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> Message-ID: <064.767a9c4af2e3fcaeb2ad042528a17742@haskell.org> #15471: Polymorphism, typed splices and type inference don't mix -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by mpickering): I still claim there is some bug here for two reasons. 1. The result is unusable after splicing. 2. A very similar program using static pointers works fine. {{{ foo = static (id :: forall a . a -> a ) foo2 = [|| id :: forall a . a -> a ||] }}} In GHCi {{{ > (deRefStaticPtr foo) 'a' 'a' > ($$(foo2)) 5 :89:12: error: • No instance for (Num Any) arising from the literal ‘5’ • In the first argument of ‘$$(foo2)’, namely ‘5’ In the expression: ($$(foo2)) 5 In an equation for ‘it’: it = ($$(foo2)) 5 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 14:45:02 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 14:45:02 -0000 Subject: [GHC] #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory In-Reply-To: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> References: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> Message-ID: <059.a75b1b974e84abae7276ce63a2e0d908@haskell.org> #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory -------------------------------------+------------------------------------- Reporter: int-e | Owner: osa1 Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: GHCi | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): One thing I tried was to run compiled version of this program with GHC 7.10 and GHC 8.4 and the numbers were identical so maybe this isn't related with the library code. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 14:51:21 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 14:51:21 -0000 Subject: [GHC] #15599: typeclass inference depends on whether a module is exposed. In-Reply-To: <047.dd916b476f2fd0f26c1766607c70f5c2@haskell.org> References: <047.dd916b476f2fd0f26c1766607c70f5c2@haskell.org> Message-ID: <062.611e85e57a453ca8af938f00d915c0a7@haskell.org> #15599: typeclass inference depends on whether a module is exposed. -------------------------------------+------------------------------------- Reporter: gleachkr | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.3 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by gleachkr): Thanks for the quick reply. I've updated the repro repo with test-ghci.sh, which uses only ghci, but which demonstrates similar behavior. I did need to load the pkgdbs that stack generated. I've included those in the repo, in case they might help. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 14:51:32 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 14:51:32 -0000 Subject: [GHC] #15471: Polymorphism, typed splices and type inference don't mix In-Reply-To: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> References: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> Message-ID: <064.bfc8fa5faab647d593992229eebc3d58@haskell.org> #15471: Polymorphism, typed splices and type inference don't mix -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by simonpj): I'm only saying "it's behaving as specified". (So not a bug in that sense.) I think you want to propose an extension to the existing behaviour. What is that extension? Specifically, what type do you expect `test_foo` to have? I don't know what this has to do with static forms, but from your `foo` I get {{{ • No instance for (Typeable a0) arising from a static form • In the expression: static (id :: forall a. a -> a) In an equation for ‘foo’: foo = static (id :: forall a. a -> a) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 14:54:51 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 14:54:51 -0000 Subject: [GHC] #15471: Polymorphism, typed splices and type inference don't mix In-Reply-To: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> References: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> Message-ID: <064.6ec657b598a40ce18a1b267daece30d0@haskell.org> #15471: Polymorphism, typed splices and type inference don't mix -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by mpickering): Metaocaml also does the right thing here for what it's worth. {{{ # let id x = x;; val id : 'a -> 'a = # let t = .< id >.;; val t : ('a -> 'a) code = .<(* CSP id *)>. # let v = (!. t) 5;; val v : int = 5 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 15:09:17 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 15:09:17 -0000 Subject: [GHC] #15576: Hadrian puts its build tree in the wrong place In-Reply-To: <046.775a5c9a9255ff4303e7bb0241f9c28d@haskell.org> References: <046.775a5c9a9255ff4303e7bb0241f9c28d@haskell.org> Message-ID: <061.ff327eb20cb0d5fc19122ea3bbf72735@haskell.org> #15576: Hadrian puts its build tree in the wrong place -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by snowleopard): Here is how to update Hadrian: https://ghc.haskell.org/trac/ghc/wiki/Building/Hadrian/QuickStart#UpdatingHadrian Hopefully, we will soon merge Hadrian into the GHC tree and there will be no need for fiddling with submodules. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 15:15:00 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 15:15:00 -0000 Subject: [GHC] #15606: Don't float out lets in between lambdsa Message-ID: <046.a1d628bd4e8b545a45d332101853164d@haskell.org> #15606: Don't float out lets in between lambdsa -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 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: -------------------------------------+------------------------------------- Consider {{{ f = \x. let y = in \z. let v = h x y in }}} The full laziness pass will float out that v-binding thus {{{ f = \x. let y = v = h x y in \z. }}} And now (if `h` is, say, imported) it'll stay like that. But suppose `` simlifies to `Just x`. Then we allow ourselves to eta-expand thus {{{ f = \x z. let y = v = h x y in }}} Now (an early design choice in the let-floater) we never float the v-binding in between the `\x` and `\z`. This is very non-confluent: a smal change in exactly how rapidly `` simplifies can have a big, irreversible effect on the code for `f`. IDEA: extend the let-floater's design choice to not float out between two lambdas, even if they are separated by lets/cases etc. One way to say this is to ask when a lambda gets a new level number compared to its immediately enclosing lambda. Examples where `y` gets the same level number as `x` * `\x.\y. blah` * `\x. let binds in \y` * `\x. case scrut of pi -> \y.blah` Examples where `y` gets the a level number one bigger than `x` * `\x. let v = \y.rhs in blah` * `\x. f (\y.rhs)` This probably won't make a lot of difference, but it'd be worth trying -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 15:18:11 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 15:18:11 -0000 Subject: [GHC] #15471: Polymorphism, typed splices and type inference don't mix In-Reply-To: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> References: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> Message-ID: <064.805b95a8d856789d03b7871691dba690@haskell.org> #15471: Polymorphism, typed splices and type inference don't mix -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by mpickering): Replying to [comment:6 simonpj]: > I'm only saying "it's behaving as specified". (So not a bug in that sense.) > > I think you want to propose an extension to the existing behaviour. What is that extension? Specifically, what type do you expect `test_foo` to have? > > I don't know what this has to do with static forms, but from your `foo` I get > {{{ > • No instance for (Typeable a0) > arising from a static form > • In the expression: static (id :: forall a. a -> a) > In an equation for ‘foo’: foo = static (id :: forall a. a -> a) > }}} I think that the type of the quote is fine but problem is during the type checking of typed splices. The fact that the metaocaml example works also supports this I think. The relevance of the static form example is that the type of `static id` should surely follow the same logic as the type of `[|| id ||]`. The inferred type of `static id` is `foo :: forall a . (Typeable a, IsStatic t) => t (a -> a)`. It is then very surprising when the dereferencing/splicing behaviour differs between the cases. {{{ {-# LANGUAGE StaticPointers #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE TemplateHaskell #-} module SP where foo = static id foo2 = [|| id ||] }}} So I don't have a concrete suggestion to what exactly goes wrong but I suspect that the typed splice typechecking code is somehow suspect. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 15:19:02 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 15:19:02 -0000 Subject: [GHC] #8763: forM_ [1..N] does not get fused (allocates 50% more) In-Reply-To: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> References: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> Message-ID: <057.85477d23213c8b91e8d0d86a8b5591cc@haskell.org> #8763: forM_ [1..N] does not get fused (allocates 50% more) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #7206 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): Right, actually I was aware of INLINE unfoldings being captured as the unoptimized variant, but have never seen it to actively prevent (or rather postpone) inlining of another part of the code. Quite a neat trick! I've identified some other functions that should probably rewritten the same way (`traverse_`, `foldrM`, etc.). No regressions, no improvements according to NoFib. Phab:D5131 passes `./validate.sh`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 15:19:28 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 15:19:28 -0000 Subject: [GHC] #15471: Polymorphism, typed splices and type inference don't mix In-Reply-To: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> References: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> Message-ID: <064.23f9ed6e507bb2b722d0ce08074195eb@haskell.org> #15471: Polymorphism, typed splices and type inference don't mix -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by simonpj): > I think that the type of the quote is fine What type do you expect `test_foo` to have? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 15:20:10 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 15:20:10 -0000 Subject: [GHC] #8763: forM_ [1..N] does not get fused (allocates 50% more) In-Reply-To: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> References: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> Message-ID: <057.ee9e360622fda0a5dd80aa2c11a3ec93@haskell.org> #8763: forM_ [1..N] does not get fused (allocates 50% more) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #7206 | Differential Rev(s): Phab:D5131 Wiki Page: | -------------------------------------+------------------------------------- Changes (by sgraf): * differential: => Phab:D5131 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 15:24:00 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 15:24:00 -0000 Subject: [GHC] #15471: Polymorphism, typed splices and type inference don't mix In-Reply-To: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> References: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> Message-ID: <064.1f619a0f11f43da414d4da13a1a67a3d@haskell.org> #15471: Polymorphism, typed splices and type inference don't mix -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by mpickering): `test_foo` should have type `forall a . Q (TExp (a -> a))`. Which is the same as in metaocaml. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 16:01:04 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 16:01:04 -0000 Subject: [GHC] #14974: 2-fold memory usage regression GHC 8.2.2 -> GHC 8.4.1 compiling `mmark` package In-Reply-To: <042.6f9317183740e6c428dbe334554fec22@haskell.org> References: <042.6f9317183740e6c428dbe334554fec22@haskell.org> Message-ID: <057.9600ab8a67d205ed888265cfa70e0496@haskell.org> #14974: 2-fold memory usage regression GHC 8.2.2 -> GHC 8.4.1 compiling `mmark` package -------------------------------------+------------------------------------- Reporter: hvr | Owner: davide Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: Compiler | Version: 8.4.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by davide): With -ddump-core-stats the final **core size** of the Text.MMark.Parser module has not changed significantly, though the number of **coercions has decreased**: * GHC Version: terms,types,coercions * 8.2.2: 325846 296315 33104 * 8.4.1: 344903 300944 26870 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 16:26:33 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 16:26:33 -0000 Subject: [GHC] #15445: SPECIALIZE one of two identical functions does not fire well In-Reply-To: <047.c1676aaf78d977670954b9a4dbdf798e@haskell.org> References: <047.c1676aaf78d977670954b9a4dbdf798e@haskell.org> Message-ID: <062.151994d1e4d59748f71f5fea2785acc8@haskell.org> #15445: SPECIALIZE one of two identical functions does not fire well -------------------------------------+------------------------------------- Reporter: nobrakal | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: None/Unknown | Test Case: | simplCore/should_compile/T15445 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"3addf72a6f40747cff213653382eb4476bdb53da/ghc" 3addf72/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="3addf72a6f40747cff213653382eb4476bdb53da" Preserve specialisations despite CSE Trac #15445 showed that, as a result of CSE, a function with an automatically generated specialisation RULE could be inlined before the RULE had a chance to fire. This patch attaches a NOINLINE[2] activation to the Id, during CSE, to stop this happening. See Note [Delay inlining after CSE] ---- Historical note --- This patch is simpler and more direct than an earlier version: commit 2110738b280543698407924a16ac92b6d804dc36 Author: Simon Peyton Jones Date: Mon Jul 30 13:43:56 2018 +0100 Don't inline functions with RULES too early We had to revert this patch because it made GHC itself slower. Why? It delayed inlining of /all/ functions with RULES, and that was very bad in TcFlatten.flatten_ty_con_app * It delayed inlining of liftM * That delayed the unravelling of the recursion in some dictionary bindings. * That delayed some eta expansion, leaving flatten_ty_con_app = \x y. let in \z. blah * That allowed the float-out pass to put sguff between the \y and \z. * And that permanently stopped eta expasion of the function, even once was simplified. -- End of historical note --- }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 16:39:37 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 16:39:37 -0000 Subject: [GHC] #15445: SPECIALIZE one of two identical functions does not fire well In-Reply-To: <047.c1676aaf78d977670954b9a4dbdf798e@haskell.org> References: <047.c1676aaf78d977670954b9a4dbdf798e@haskell.org> Message-ID: <062.9c4288ad16ef8c202f9aaa40b143d6ba@haskell.org> #15445: SPECIALIZE one of two identical functions does not fire well -------------------------------------+------------------------------------- Reporter: nobrakal | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: fixed | Keywords: Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: None/Unknown | Test Case: | simplCore/should_compile/T15445 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * resolution: => fixed Comment: I managed to re-instate this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 17:04:18 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 17:04:18 -0000 Subject: [GHC] #15607: RebindableSyntax warns `return` is not in scope when trying to call `pure`, but does not desugar between the two Message-ID: <048.40d13c0995253ff45c6a616fadd5793a@haskell.org> #15607: RebindableSyntax warns `return` is not in scope when trying to call `pure`, but does not desugar between the two -------------------------------------+------------------------------------- Reporter: isovector | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Keywords: | Operating System: Unknown/Multiple RebindableSyntax | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- The following (incorrect) program fails to compile: {{{#!hs {-# LANGUAGE RebindableSyntax #-} import Prelude hiding (pure, return) t = do pure 5 }}} {{{ Not in scope: ‘return’ Perhaps you want to remove ‘return’ from the explicit hiding list in the import of ‘Prelude’ (/home/sandy/Bug.hs:3:1-40). | 6 | pure 5 | }}} Changing the import of Prelude to no longer hide `return` now gives the correct error: {{{#!hs import Prelude hiding (pure) }}} {{{ • Variable not in scope: pure :: Integer -> t • Perhaps you want to remove ‘pure’ from the explicit hiding list in the import of ‘Prelude’ (/home/sandy/Bug.hs:3:1-28). | 6 | pure 5 | ^^^^ }}} This is particularly confusing when `pure` is in scope and would typecheck but `return` is not. The error suggests that there is desugaring going on behind the scenes to turn `pure` into `return` via rebindable syntax. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 17:05:58 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 17:05:58 -0000 Subject: [GHC] #15607: RebindableSyntax warns `return` is not in scope when trying to call `pure`, but does not desugar between the two In-Reply-To: <048.40d13c0995253ff45c6a616fadd5793a@haskell.org> References: <048.40d13c0995253ff45c6a616fadd5793a@haskell.org> Message-ID: <063.df12f560b6628a3ab3823232f3bc2a09@haskell.org> #15607: RebindableSyntax warns `return` is not in scope when trying to call `pure`, but does not desugar between the two -------------------------------------+------------------------------------- Reporter: isovector | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: | RebindableSyntax Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by isovector: Old description: > The following (incorrect) program fails to compile: > > {{{#!hs > {-# LANGUAGE RebindableSyntax #-} > > import Prelude hiding (pure, return) > > t = do > pure 5 > }}} > > {{{ > Not in scope: ‘return’ > Perhaps you want to remove ‘return’ from the explicit hiding list > in the import of ‘Prelude’ (/home/sandy/Bug.hs:3:1-40). > | > 6 | pure 5 > | > }}} > > Changing the import of Prelude to no longer hide `return` now gives the > correct error: > > {{{#!hs > import Prelude hiding (pure) > }}} > > {{{ > • Variable not in scope: pure :: Integer -> t > • Perhaps you want to remove ‘pure’ from the explicit hiding list > in the import of ‘Prelude’ (/home/sandy/Bug.hs:3:1-28). > | > 6 | pure 5 > | ^^^^ > }}} > > This is particularly confusing when `pure` is in scope and would > typecheck but `return` is not. The error suggests that there is > desugaring going on behind the scenes to turn `pure` into `return` via > rebindable syntax. New description: The following (incorrect) program fails to compile: {{{#!hs {-# LANGUAGE RebindableSyntax #-} import Prelude hiding (pure, return) t = do pure 5 }}} {{{ Not in scope: ‘return’ Perhaps you want to remove ‘return’ from the explicit hiding list in the import of ‘Prelude’ (/home/sandy/Bug.hs:3:1-40). | 6 | pure 5 | }}} Notice that this error mentions `return` not being in scope, despite trying to call `pure`. This suggests to the user that there is some desugaring going on to transform pure into return (but there isn't!). Changing the import of Prelude to no longer hide `return` now gives the correct error: {{{#!hs import Prelude hiding (pure) }}} {{{ • Variable not in scope: pure :: Integer -> t • Perhaps you want to remove ‘pure’ from the explicit hiding list in the import of ‘Prelude’ (/home/sandy/Bug.hs:3:1-28). | 6 | pure 5 | ^^^^ }}} This is particularly confusing when `pure` is in scope and would typecheck but `return` is not. The error suggests that there is desugaring going on behind the scenes to turn `pure` into `return` via rebindable syntax. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 20:21:09 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 20:21:09 -0000 Subject: [GHC] #14391: Make the simplifier independent of the typechecker In-Reply-To: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> References: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> Message-ID: <061.dcd611d0572fb71f06a6fac61bbb05e3@haskell.org> #14391: Make the simplifier independent of the typechecker -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4503 Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * owner: ulysses4ever => (none) * status: patch => new Comment: Moving out of 'patch'. ulysses4ever, do you plan to do phase 2? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 21:12:37 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 21:12:37 -0000 Subject: [GHC] #15449: Nondeterministic Failure on aarch64 with -jn, n > 1 In-Reply-To: <046.a39037510433715ab5f0873fb73e977c@haskell.org> References: <046.a39037510433715ab5f0873fb73e977c@haskell.org> Message-ID: <061.367f752554800832c5409b8e4a718425@haskell.org> #15449: Nondeterministic Failure on aarch64 with -jn, n > 1 -------------------------------------+------------------------------------- Reporter: tmobile | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Linux | Architecture: aarch64 Type of failure: Compile-time | Test Case: crash or panic | Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Thra11): I have noticed something which might be relevant. I have two aarch64 machines: 1. Quad-core laptop: 4 x A53, 2GB RAM 2. Hex-core SBC: 2 x A72 + 4 x A53, 4GB RAM Testing with trommler's test-package, GHC on the Hex-core with the A72 cores fails often (segmentation fault/illegal hardware instruction/bus error), while the Quad core ''without'' the A72 cores consistently succeeds. > As far as the difference between 32-bit and 64-bit ARM, the only thing I can guess is that perhaps the smaller ARM chips have much simpler instruction pipelines and don't necessarily perform the allowed reorderings in practice? Following this line of thinking, I'm wondering if the A53's fall into the 'simpler instruction pipeline' bucket, while the A72's and Denver2's are more complex. The other possibility that springs to mind is that having faster cores simply changes timings so as to make certain race conditions more likely. However, if this was the case, I think I would expect to see at least ''some'' failures on the slower CPU. trommler mentions that he was seeing the failures on a NVIDIA Jetson TX2, which appears to be 2 x Denver2 + 4 x A57. I'm not familiar with these cores, but I assume that at least the Denver2 is fairly complex. I have found that the laptop's (Quad core A53) success isn't limited to this little test case. Before I got the SBC (2xA72 + 4xA53, which I use as a nix build server), I successfully built GHC and a range of haskell packages on the laptop (slowly: 2G RAM ends up swapping quite a bit building GHC). However, using the SBC, I haven't been able to build GHC itself, and package building is inconsistent (some packages sometimes succeed, others always fail). Apologies if this is all rather speculative and anecdotal, but I'm hoping it might give someone more familiar with ghc, llvm and CPUs ideas. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 21:14:12 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 21:14:12 -0000 Subject: [GHC] #14391: Make the simplifier independent of the typechecker In-Reply-To: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> References: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> Message-ID: <061.45ba9b0ed33fa5c697782c7cac496d7a@haskell.org> #14391: Make the simplifier independent of the typechecker -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4503 Wiki Page: | -------------------------------------+------------------------------------- Comment (by ulysses4ever): I'd love to. Simon told that it is better to be controlled by someone with more experience though. If nothing, I can shuffle a bunch of definitions myself to achieve the goal formally (no Tc-related imports inside CoreSimpl) and then submit the Diff. Does that sound good? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 21:18:37 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 21:18:37 -0000 Subject: [GHC] #14391: Make the simplifier independent of the typechecker In-Reply-To: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> References: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> Message-ID: <061.11e57ad80f145501e7376666ef60482b@haskell.org> #14391: Make the simplifier independent of the typechecker -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4503 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > Simon told that it is better to be controlled by someone with more experience though. I hope I didn't say that. Perhaps "advised by" or "supported by" someone with more experience, but "controlled by" is so dis-empowering! You are doing us a favour -- thank you -- keep going! I and others will try to support you. Before investing a lot of effort in coding, it's best to lay out a plan (on a wiki page perhaps) with your goals, and the steps you propose to take to achieve those goals. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 5 21:32:48 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 05 Sep 2018 21:32:48 -0000 Subject: [GHC] #15449: Nondeterministic Failure on aarch64 with -jn, n > 1 In-Reply-To: <046.a39037510433715ab5f0873fb73e977c@haskell.org> References: <046.a39037510433715ab5f0873fb73e977c@haskell.org> Message-ID: <061.e356e837fde36f5c9144e5f75d5ff13d@haskell.org> #15449: Nondeterministic Failure on aarch64 with -jn, n > 1 -------------------------------------+------------------------------------- Reporter: tmobile | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Linux | Architecture: aarch64 Type of failure: Compile-time | Test Case: crash or panic | Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Thra11): According to [https://en.wikipedia.org/wiki/List_of_ARM_microarchitectures]: * Cortex-A53: In-order * Cortex-A57: Out-of-order * Cortex-A72: Out-of-order * Denver2: In-order In our rather small sample, when failures happen, the CPU has at least one out-of-order core. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 00:16:40 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 00:16:40 -0000 Subject: [GHC] #14391: Make the simplifier independent of the typechecker In-Reply-To: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> References: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> Message-ID: <061.bb10957da7593c19872482281077693e@haskell.org> #14391: Make the simplifier independent of the typechecker -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4503 Wiki Page: | -------------------------------------+------------------------------------- Comment (by monoidal): Regarding update (April 2018) from the ticket description: Point 1: I agree that we can move `thNameToGhcName` to GhcPlugins; it's not used anywhere. Optionally, we could also move there `ioLookupDataCon` and `ioLookupDataCon_maybe` (they are also unused). Either way, it's cheap. Point 2: I understand the goal is to move `lookupGlobal` away from typecheck/ directory. Currently `lookupGlobal` calls `lookupGlobal_maybe`, which calls `lookupImported_maybe`, which calls `importDecl_maybe`, which calls `initIfaceLoad`, which is in TcRnMonad. So I see that we can weaken the dependency of CoreMonad from TcEnv to TcRnMonad, but I don't see yet how to get rid of it completely. Is my understanding correct? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 03:41:11 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 03:41:11 -0000 Subject: [GHC] #14391: Make the simplifier independent of the typechecker In-Reply-To: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> References: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> Message-ID: <061.9b1fca39c8103c8e4c050cb29e191ed3@haskell.org> #14391: Make the simplifier independent of the typechecker -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4503 Wiki Page: | -------------------------------------+------------------------------------- Comment (by ulysses4ever): Simon, my bad, the wording isn't accurate and isn't yours, indeed. I think, we all understand what was meant though. Monoidal, from the top of my head, you are quite right in both points. The second point is a bit dissapointing, and I have no idea (again, ftoh) how to improve it. Actually, if you are eager to do what is clear, please, go ahead: I will be stuck with mortal things at least till the end of the week. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 03:42:03 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 03:42:03 -0000 Subject: [GHC] #14391: Make the simplifier independent of the typechecker In-Reply-To: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> References: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> Message-ID: <061.48afc19795ad9af8380b7698c688258a@haskell.org> #14391: Make the simplifier independent of the typechecker -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4503 Wiki Page: | -------------------------------------+------------------------------------- Changes (by ulysses4ever): * cc: ulysses4ever (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 07:11:53 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 07:11:53 -0000 Subject: [GHC] #14391: Make the simplifier independent of the typechecker In-Reply-To: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> References: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> Message-ID: <061.d166325bf74cdf244a8a76eb8f9a7d39@haskell.org> #14391: Make the simplifier independent of the typechecker -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4503 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Re lookupGlobal, there is a reason for this! If you look up `Complex`, say, then GHC might need to read in `Complex.hi`, and deserialise and typecheck it (`TcIface` does this). The "typechecking" will never fail, unless it's a stale `.hi` file or something, but it's the process of turning a bare syntax tree into `TyCons`, `Ids` etc. Now that does not need the full glory of the `Tc` monad; but it does need quite a bit. Teasing out exactly what it uses, and perhaps making a stripped-down `Tc` monad just for that, might be worthwhile. But it would be work, perhaps more than is justified until we have a stronger cause. I'm sure there are lots of other ways in which things could be better structured too. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 07:17:09 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 07:17:09 -0000 Subject: [GHC] #15471: Polymorphism, typed splices and type inference don't mix In-Reply-To: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> References: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> Message-ID: <064.6779806aca2e4185666ac7ce678d8e00@haskell.org> #15471: Polymorphism, typed splices and type inference don't mix -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by simonpj): But that doesn't scale well {{{ foo2 :: Num a => a -> a foo2 x = x+1 test_foo2 :: ??? test_foo2 = [|| foo2 |]] }}} If you give it the type `test_foo2 :: forall a. Num a => Q (TExp (a->a))` then you'll need to decide what dictionary to pass to it when you invoke it in `$$(test_foo2)`. Only erasure is allowing MetaOCaml to squeeze by, and we don't have that luxury. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 07:19:03 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 07:19:03 -0000 Subject: [GHC] #15571: Eager AP_STACK blackholing causes incorrect size info for sanity checks In-Reply-To: <043.9213207e6a514a137db4ef0469470bf7@haskell.org> References: <043.9213207e6a514a137db4ef0469470bf7@haskell.org> Message-ID: <058.80dded9c36d10b044d86d243cca2671a@haskell.org> #15571: Eager AP_STACK blackholing causes incorrect size info for sanity checks -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15508 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonmar): Isn't this a problem in general for eager blackholing? I can't think of a good fix off the top of my head. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 07:23:50 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 07:23:50 -0000 Subject: [GHC] #8763: forM_ [1..N] does not get fused (allocates 50% more) In-Reply-To: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> References: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> Message-ID: <057.660eb617e9ce73a8552113d7ad1a0aaa@haskell.org> #8763: forM_ [1..N] does not get fused (allocates 50% more) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #7206 | Differential Rev(s): Phab:D5131 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Here's a longer, and to me more comprehensible, Note {{{ Note [List fusion and continuations in 'c'] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Suppose we define mapM_ f = foldr ((>>) . f) (return ()) (this is the way it used to be). Now suppose we want to optimise the call mapM_ (build g) where g c n = ...(c x1 y1)...(c x2 y2)....n... GHC used to proceed like this: mapM_ (build g) = { Defintion of mapM_ } foldr ((>>) . ) (return ()) (build g) = { foldr/build rule } g ((>>) . ) (return ()) = { Inline g ] let c = (>>) . n = return () in ...(c x1 y1)...(c x2 y2)....n... The trouble is that `c`, being big, will not be inlined. And that can be absolutely terrible for performance, as we saw in Trac #8763. It's much better to define mapM_ f = foldr c (return ()) where c x k = f x >> k {-# INLINE c #-} Now we get mapM_ (build g) = { inline mapM_ } foldr c (return ()) (build g) where c x k = f x >> k {-# INLINE c #-} f = Notice that `f` does not inine into the RHS of `c`, because the ININE pragma stops it; see Note [How INLINE pragmas /prevent/ inlining]. Continuing: = { foldr/build rule } g c (return ()) where ... c x k = f x >> k {-# INLINE c #-} f = = { inline g } ...(c x1 y1)...(c x2 y2)....n... where c x k = f x >> k {-# INLINE c #-} f = n = return () Now, crucially, `c` does inline = { inline c } ...(f x1 >> y1)...(f x2 >> y2)....n... where f = n = return () And all is well! The key thing is that the fragment `(f x1 >> y1)` is inlined into the body of the builder `g`. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 07:26:12 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 07:26:12 -0000 Subject: [GHC] #14915: T2783 fails with the threaded1 way In-Reply-To: <048.6a264df023f86951375f2289b1ed8d61@haskell.org> References: <048.6a264df023f86951375f2289b1ed8d61@haskell.org> Message-ID: <063.49d48628f62c0ad442d14a48d51cbfa5@haskell.org> #14915: T2783 fails with the threaded1 way -------------------------------------+------------------------------------- Reporter: alpmestan | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 | (amd64) Type of failure: Runtime crash | Test Case: T2783 Blocked By: | Blocking: Related Tickets: #15241 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonmar): I think you're right that the assertion is incorrect. Indeed, if it were correct, then the conditional above it, namely {{{ if (((bh_info == &stg_BLACKHOLE_info) && ((StgInd*)bh)->indirectee != (StgClosure*)tso) || (bh_info == &stg_WHITEHOLE_info)) }}} would not need to check `((StgInd*)bh)->indirectee != (StgClosure*)tso)` because that would always be true. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 07:31:03 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 07:31:03 -0000 Subject: [GHC] #15595: Stack overflow in withArgs leads to infinite memory-consuming loop In-Reply-To: <051.e7b5dc4635707a081473bd8c3f2b0afd@haskell.org> References: <051.e7b5dc4635707a081473bd8c3f2b0afd@haskell.org> Message-ID: <066.66f6c65ac6b46007333e0a879e425cae@haskell.org> #15595: Stack overflow in withArgs leads to infinite memory-consuming loop ----------------------------------+-------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 (amd64) Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------+-------------------------------------- Comment (by simonmar): Isn't this the correct behaviour? StackOverflow is an asynchronous exception, so we can't throw it inside `mask`. I don't understand why the program loops, though. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 07:31:14 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 07:31:14 -0000 Subject: [GHC] #15608: Segfault in retainer profiling Message-ID: <043.5de2d12576332caf387b4ed18691b19e@haskell.org> #15608: Segfault in retainer profiling -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Profiling | Version: 8.5 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: -------------------------------------+------------------------------------- To reproduce, build ghc using "prof" flavor, then {{{ $ ghc-stage2 --interactive +RTS -hr GHCi, version 8.7.20180905: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/omer/rcbackup/.ghci λ:1> sequence_ (replicate 100000000 (return ())) zsh: segmentation fault (core dumped) ghc-stage2 --interactive +RTS -hr }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 07:32:14 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 07:32:14 -0000 Subject: [GHC] #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory In-Reply-To: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> References: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> Message-ID: <059.12e7d1b9714c0a0ffd1b7e5b80087788@haskell.org> #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory -------------------------------------+------------------------------------- Reporter: int-e | Owner: osa1 Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: GHCi | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): My attempts to profile ghci revealed another bug: #15608 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 07:35:41 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 07:35:41 -0000 Subject: [GHC] #15587: traceEvent tests failing in slow validate In-Reply-To: <043.5a7481e85ed8eb1897c26ebcfa11c5fb@haskell.org> References: <043.5a7481e85ed8eb1897c26ebcfa11c5fb@haskell.org> Message-ID: <058.5be64d9c59af10a33fff02b3daa95850@haskell.org> #15587: traceEvent tests failing in slow validate -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Test Suite | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5119 Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonmar): * status: closed => new * resolution: fixed => Comment: Why would GHCi not create eventlogs? I can't think of a reason, perhaps this is a real bug? If it's not, can we document what the conflict is somewhere, and emit a more helpful error message if the user tries to do this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 07:38:23 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 07:38:23 -0000 Subject: [GHC] #14915: T2783 fails with the threaded1 way In-Reply-To: <048.6a264df023f86951375f2289b1ed8d61@haskell.org> References: <048.6a264df023f86951375f2289b1ed8d61@haskell.org> Message-ID: <063.c341a0f5d3747d357c7a3f686e7c3075@haskell.org> #14915: T2783 fails with the threaded1 way -------------------------------------+------------------------------------- Reporter: alpmestan | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Runtime System | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 | (amd64) Type of failure: Runtime crash | Test Case: T2783 Blocked By: | Blocking: Related Tickets: #15241 | Differential Rev(s): Phab:D5133 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: new => patch * differential: => Phab:D5133 Comment: Thanks Simon! Submitted a patch. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 07:44:14 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 07:44:14 -0000 Subject: [GHC] #8763: forM_ [1..N] does not get fused (allocates 50% more) In-Reply-To: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> References: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> Message-ID: <057.892a2904f0d0b3de37387619321e8fef@haskell.org> #8763: forM_ [1..N] does not get fused (allocates 50% more) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #7206 | Differential Rev(s): Phab:D5131 Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): OK, I revised the patch. I agree, your examples are worth a thousand words. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 07:47:43 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 07:47:43 -0000 Subject: [GHC] #15604: Profiling RTS flag `-po` does not work In-Reply-To: <043.a8270f259e9e5fb95951cf6a253478e8@haskell.org> References: <043.a8270f259e9e5fb95951cf6a253478e8@haskell.org> Message-ID: <058.41933b5a8a78a38d02a12c037f855ea7@haskell.org> #15604: Profiling RTS flag `-po` does not work -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Profiling | Version: 8.5 Resolution: invalid | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: T15604 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5130 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: patch => closed * resolution: => invalid Comment: It turns out `-po` does not imply `-p` (which is clear in the user manual). Closing. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 07:48:26 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 07:48:26 -0000 Subject: [GHC] #8763: forM_ [1..N] does not get fused (allocates 50% more) In-Reply-To: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> References: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> Message-ID: <057.d69fc9d4f6f44d059b8941a608731a95@haskell.org> #8763: forM_ [1..N] does not get fused (allocates 50% more) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #7206 | Differential Rev(s): Phab:D5131 Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): Well, I revised the patch but I am now at work, where they block some outgoing ports needed for pushing to staging. Long story short, this will have to wait until tonight or at least until I figured out a way to configure a proxy. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 08:40:11 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 08:40:11 -0000 Subject: [GHC] #14915: T2783 fails with the threaded1 way In-Reply-To: <048.6a264df023f86951375f2289b1ed8d61@haskell.org> References: <048.6a264df023f86951375f2289b1ed8d61@haskell.org> Message-ID: <063.af48da2c8a8ecad07d35887505a9e46c@haskell.org> #14915: T2783 fails with the threaded1 way -------------------------------------+------------------------------------- Reporter: alpmestan | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Runtime System | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 | (amd64) Type of failure: Runtime crash | Test Case: T2783 Blocked By: | Blocking: Related Tickets: #15241 | Differential Rev(s): Phab:D5133 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ömer Sinan Ağacan ): In [changeset:"16bc7ae8b191153071b5fd1dde2b02e51171860e/ghc" 16bc7ae8/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="16bc7ae8b191153071b5fd1dde2b02e51171860e" Remove an incorrect assertion in threadPaused: The assertion is triggered when we have a loop in the program (in which case we see the same update frame multiple times in the stack). See #14915 for more details. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #14915 Differential Revision: https://phabricator.haskell.org/D5133 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 08:41:00 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 08:41:00 -0000 Subject: [GHC] #14915: T2783 fails with the threaded1 way In-Reply-To: <048.6a264df023f86951375f2289b1ed8d61@haskell.org> References: <048.6a264df023f86951375f2289b1ed8d61@haskell.org> Message-ID: <063.f622086ece38c68861ba8835a0f7c5f1@haskell.org> #14915: T2783 fails with the threaded1 way -------------------------------------+------------------------------------- Reporter: alpmestan | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Runtime System | Version: 8.5 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 | (amd64) Type of failure: Runtime crash | Test Case: T2783 Blocked By: | Blocking: Related Tickets: #15241 | Differential Rev(s): Phab:D5133 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: patch => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 08:41:36 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 08:41:36 -0000 Subject: [GHC] #15241: Validate failures in sanity way In-Reply-To: <043.d11008dde218db35b7a51fc1896a3cac@haskell.org> References: <043.d11008dde218db35b7a51fc1896a3cac@haskell.org> Message-ID: <058.a38df53aaa53c6da5a6e266162553300@haskell.org> #15241: Validate failures in sanity way -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Runtime System | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14915 | Differential Rev(s): Phab:D4839 Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): Some of these should be fixed with #14915. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 09:05:07 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 09:05:07 -0000 Subject: [GHC] #15471: Polymorphism, typed splices and type inference don't mix In-Reply-To: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> References: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> Message-ID: <064.bd08768531fd56dc30888b2751591ca5@haskell.org> #15471: Polymorphism, typed splices and type inference don't mix -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by mpickering): The inferred type of `test_foo2` is exactly what you suggest it shouldn't be unless I am misunderstaning. {{{ *SP> :t test_foo2 test_foo2 :: forall {a}. Num a => Language.Haskell.TH.Syntax.Q (Language.Haskell.TH.Syntax.TExp (a -> a)) }}} The difference is now that you can't splice back in `test_foo2` without instantiating `a` as otherwise the ambiguous type variable stops `Num a` being solved. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 09:16:45 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 09:16:45 -0000 Subject: [GHC] #15599: typeclass inference depends on whether a module is exposed. In-Reply-To: <047.dd916b476f2fd0f26c1766607c70f5c2@haskell.org> References: <047.dd916b476f2fd0f26c1766607c70f5c2@haskell.org> Message-ID: <062.125b559251c9d99fbc8a11092003eea3@haskell.org> #15599: typeclass inference depends on whether a module is exposed. -------------------------------------+------------------------------------- Reporter: gleachkr | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.3 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): What's the `-package-db` stuff? I tried this {{{ #!/bin/bash GHCI822="/home/simonpj/5builds/ghc-8.2-branch/inplace/bin/ghc-stage2 --interactive" GHCI843="/home/simonpj/5builds/ghc-8.4-branch/inplace/bin/ghc-stage2 --interactive" echo "Behavior in 8.2.2 with pkgdb" echo "test" | $GHCI822 Good.hs 2> /dev/null | grep checkFlag echo "Behavior in 8.2.2 without pkgdb" echo "test" | $GHCI822 Good.hs Link.hs 2> /dev/null | grep checkFlag echo "Behavior in 8.4.3 with pkgdb" echo "test" | $GHCI843 Good.hs 2> /dev/null | grep checkFlag echo "Behavior in 8.4.3 without pkgdb" echo "test" | $GHCI843 Good.hs Link.hs 2> /dev/null | grep checkFlag }}} and got {{{ simonpj at cam-05-unx:~/tmp/T15599$ ./test-ghci.sh Behavior in 8.2.2 with pkgdb *Good> Flag {checkFlag = True} Behavior in 8.2.2 without pkgdb *Good> Flag {checkFlag = True} Behavior in 8.4.3 with pkgdb *Good> Flag {checkFlag = True} Behavior in 8.4.3 without pkgdb *Good> Flag {checkFlag = True} }}} This is with all the files in the same directory. With your file structure (source files nested inside `src/Tests`), the first command fails with {{{ Behavior in 8.2.2 with pkgdb GHCi, version 8.2.2.20180313: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Tests.Good ( src/Tests/Good.hs, interpreted ) src/Tests/Good.hs:3:1: error: Could not find module ‘Tests.Link’ Use -v to see a list of the files searched for. | 3 | import Tests.Link | ^^^^^^^^^^^^^^^^^ Failed, no modules loaded. }}} Clearly I don't understand your use of package databases here -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 09:20:42 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 09:20:42 -0000 Subject: [GHC] #15471: Polymorphism, typed splices and type inference don't mix In-Reply-To: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> References: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> Message-ID: <064.515a3669caab4d8ea968bfb455ecca4c@haskell.org> #15471: Polymorphism, typed splices and type inference don't mix -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by simonpj): Yes, GHC infers `test_foo2 :: forall a. Num a => Q (TExp (a->a))`. You like that -- good. But now what would you ''expect'' to happen here? {{{ qux = $$(test_foo2) }}} We must pass a dictionary, so we probably default to `Integer`. And that's precisely what is happening in the Description, except that there we default to `Any` because we don't have to satisfy `Num`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 09:25:43 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 09:25:43 -0000 Subject: [GHC] #14899: Significant compilation time regression between 8.4 and HEAD due to coverage checking In-Reply-To: <050.9e589019d6eb1fc4987004e5aa20a3e4@haskell.org> References: <050.9e589019d6eb1fc4987004e5aa20a3e4@haskell.org> Message-ID: <065.a9409b195b8ac18f85919e2d95d4dd72@haskell.org> #14899: Significant compilation time regression between 8.4 and HEAD due to coverage checking -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.8.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: | PatternMatchWarnings Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by guibou): @bgamari I'm sorry, but your second point in comment:7 seems truncated. That's minor, but I'm interested by your conclusion on that point. Thank you. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 09:25:48 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 09:25:48 -0000 Subject: [GHC] #15384: Every implication should bump the TcLevel exactly once In-Reply-To: <047.d56843a5a9456b5500d56ec561e931f3@haskell.org> References: <047.d56843a5a9456b5500d56ec561e931f3@haskell.org> Message-ID: <062.9655dc0556ad916a3e09d2d6785ecd6a@haskell.org> #15384: Every implication should bump the TcLevel exactly once -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15007, #15401 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * related: => #15007, #15401 Comment: Also, I think #15007 and #15401 are other examples. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 09:37:28 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 09:37:28 -0000 Subject: [GHC] #15608: Segfault in retainer profiling In-Reply-To: <043.5de2d12576332caf387b4ed18691b19e@haskell.org> References: <043.5de2d12576332caf387b4ed18691b19e@haskell.org> Message-ID: <058.21d45847307b37ab16d50fc9a3a6f493@haskell.org> #15608: Segfault in retainer profiling -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Profiling | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by osa1: Old description: > To reproduce, build ghc using "prof" flavor, then > > {{{ > $ ghc-stage2 --interactive +RTS -hr > GHCi, version 8.7.20180905: http://www.haskell.org/ghc/ :? for help > Loaded GHCi configuration from /home/omer/rcbackup/.ghci > λ:1> sequence_ (replicate 100000000 (return ())) > zsh: segmentation fault (core dumped) ghc-stage2 --interactive +RTS -hr > }}} New description: To reproduce, build ghc using "prof" flavor, then {{{ $ ghc-stage2 --interactive +RTS -hr GHCi, version 8.7.20180905: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/omer/rcbackup/.ghci λ:1> sequence_ (replicate 100000000 (return ())) zsh: segmentation fault (core dumped) ghc-stage2 --interactive +RTS -hr }}} If I use debug runtime in stage2 compiler I can't even run the repl: {{{ haskell $ ghc-stage2 --interactive +RTS -hr rr: Saving execution to trace directory `/home/omer/.local/share/rr/ghc- stage2-13'. GHCi, version 8.7.20180906: http://www.haskell.org/ghc/ :? for help zsh: segmentation fault ghc-stage2 --interactive +RTS -hr }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 09:55:11 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 09:55:11 -0000 Subject: [GHC] #15176: Superclass `Monad m =>` makes program run 100 times slower In-Reply-To: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> References: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> Message-ID: <061.8013387493522e6157132953d0351787@haskell.org> #15176: Superclass `Monad m =>` makes program run 100 times slower -------------------------------------+------------------------------------- Reporter: danilo2 | Owner: osa1 Type: bug | Status: new Priority: highest | Milestone: 8.8.1 Component: Compiler | Version: 8.4.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by MikolajKonarski): * cc: MikolajKonarski (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 09:57:18 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 09:57:18 -0000 Subject: [GHC] #15345: Duplication between `CoreSubst` and `SimplEnv` is very unfortunate In-Reply-To: <049.83412aee209f6050ef82852307b4fd66@haskell.org> References: <049.83412aee209f6050ef82852307b4fd66@haskell.org> Message-ID: <064.2100127f1ad845297ae9e93a2d12ec45@haskell.org> #15345: Duplication between `CoreSubst` and `SimplEnv` is very unfortunate -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > Help me Simon! I agree this is vary far from ideal * `CoreSubst.substIdBndr` takes a `Subst` * It substitutes in the `IdInfo` * `CoreOpt.subst_opt_id_bndr` is similar to `CoreSubst.substIdBndr`, but * It zaps the `IdInfo`. * `SimplEnv.substIdBndr` takes a `SimplEnv`. * For `CoVars` it makes a `TCvSubst`, and calls `TyCoRep.substCoVarBndr` * For `Ids` it calls `SimplEnv.substNonCoVarBndr`, which * zaps the `IdInfo` (because the simplifier will simplify and re- add it) * and for `Ids` it can cope with join points; I'll add a Note to explain this. * Why are `CoVars` treated differently to other `Ids`? Because they can occur in types, so their bindings must be in the `TCvSubst`. Things we could improve relatively easily: * `SimplEnv.substIdBndr` does the Id/CoVar split, calling `substCoVarBndr` and `substNonCoVarIdBndr` resp. But `CoreSubst.substIdBndr` assumes a non-CoVar Id; the split is done by `CoreSubst.substBndr`. This is inconsistent. * `CoreSubst.substIdBndr` should call `CoreSubst.substIdType` rather than copying its code. * `SimplEnv.substIdType` could probably just call `CoreSubst.substIdType` * I suppose that `CoreOpt.subst_opt_id_bndr` could zap the `IdInfo` and then call `CoreSubst.substIdBndr`. Slightly less efficient but more modular; and this is not heavily used code. Does any of that help? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 10:16:46 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 10:16:46 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.d1f8b348a2ab8c54e1934449e39003ac@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): So I manually retrofit the -accum change onto the wip/T14880 branch (pushed to `wip/T14880-reengineered`); however, I'm still getting stat failures. I'm currently running a full `./validate` on a clean build tree to confirm, but maybe you could take a look in the meantime to see if I've missed anything. I have taken the liberty to change a few things around a bit; I believe they shouldn't make a fundamental difference, but maybe I'm wrong. I also noticed that there is an error in the -accum patch; lines 1664-1667 say: {{{#!haskell {- 1664 -} ty_co_vars_of_co_var v is acc {- 1665 -} | v `elemVarSet` is = acc {- 1666 -} | v `elemVarSet` is = acc {- 1667 -} | otherwise = ty_co_vars_of_type (varType v) is (extendVarSet acc v) }}} ...but line 1666 is redundant and should probably rather be: {{{#!haskell {- 1666 -} | v `elemVarSet` acc = acc }}} So I changed that. The above hasn't been rebased onto master yet btw.; I also have a branch around that is the result of actually merging the `wip/T1448-accum` branch onto a rebased `wip/T14880` branch - that one also has stat failures, but it still contains the error described above. I'll also run a validate on this one after fixing that. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 11:59:15 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 11:59:15 -0000 Subject: [GHC] #15609: No skolem info panic: Static pointers and holes Message-ID: <049.9c3839d6ab653baeae68cc98ef04bf26@haskell.org> #15609: No skolem info panic: Static pointers and holes -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 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: -------------------------------------+------------------------------------- The following program panics: {{{ {-# LANGUAGE StaticPointers #-} {-# LANGUAGE GADTs #-} module Panic where data Closure a where foo :: (Closure a -> Closure b) -> Closure (a -> b) foo f = static _ }}} {{{ src/Panic.hs:8:16: error:ghc: panic! (the 'impossible' happened) (GHC version 8.6.0.20180810 for x86_64-unknown-linux): No skolem info: [a_a5rt[sk:1], b_a5ru[sk:1]] Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1164:37 in ghc:Outputable pprPanic, called at compiler/typecheck/TcErrors.hs:2851:5 in ghc:TcErrors Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:03:22 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:03:22 -0000 Subject: [GHC] #15609: No skolem info panic: Static pointers and holes In-Reply-To: <049.9c3839d6ab653baeae68cc98ef04bf26@haskell.org> References: <049.9c3839d6ab653baeae68cc98ef04bf26@haskell.org> Message-ID: <064.de894c3bfe6dd1b28484fa26eea09395@haskell.org> #15609: No skolem info panic: Static pointers and holes -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by mpickering): * version: 8.4.3 => 8.6.1-beta1 Comment: Happens with 8.6.1 as well. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:12:42 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:12:42 -0000 Subject: [GHC] #15603: ref6 example from StaticPointers documentation doesn't type check In-Reply-To: <049.2f1c9babf7c08f8cf0bfccd75c2c4869@haskell.org> References: <049.2f1c9babf7c08f8cf0bfccd75c2c4869@haskell.org> Message-ID: <064.e0a22cc56775f39ea7f6ce84df88b677@haskell.org> #15603: ref6 example from StaticPointers documentation doesn't type check -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): The `static show` example also doesn't produce an error exactly like the implied one. {{{ sp.hs:25:7: error: • No instance for (Typeable a0) arising from a static form • In the expression: static show In an equation for ‘foo’: foo = static show | 25 | foo = static show | ^^^^^^^^^^^ sp.hs:25:14: error: • Ambiguous type variable ‘a0’ arising from a use of ‘show’ prevents the constraint ‘(Show a0)’ from being solved. Relevant bindings include foo :: t0 (a0 -> String) (bound at sp.hs:25:1) Probable fix: use a type annotation to specify what ‘a0’ should be. These potential instances exist: instance Show (ST s a) -- Defined in ‘GHC.ST’ instance Show StaticPtrInfo -- Defined in ‘GHC.StaticPtr’ instance Show Ordering -- Defined in ‘GHC.Show’ ...plus 25 others ...plus 12 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the body of a static form: show In the expression: static show In an equation for ‘foo’: foo = static show | 25 | foo = static show | ^^^^ }}} Then adding a type signature leads to the confusing error: {{{ foo :: (Typeable a, Show a) => StaticPtr (a -> String) foo = static show }}} {{{ sp.hs:26:14: error: • No instance for (Show a) arising from a use of ‘show’ • In the body of a static form: show In the expression: static show In an equation for ‘foo’: foo = static show | 26 | foo = static show | }}} The user guide should discuss why these errors happen to help understanding. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:17:15 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:17:15 -0000 Subject: [GHC] #15603: ref6 example from StaticPointers documentation doesn't type check In-Reply-To: <049.2f1c9babf7c08f8cf0bfccd75c2c4869@haskell.org> References: <049.2f1c9babf7c08f8cf0bfccd75c2c4869@haskell.org> Message-ID: <064.8c5f2d443d6061ace78fe3f7b7654ceb@haskell.org> #15603: ref6 example from StaticPointers documentation doesn't type check -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | StaticPointers Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * keywords: => StaticPointers -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:38:12 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:38:12 -0000 Subject: [GHC] #14770: Allow static pointer expressions to have static pointer free variables In-Reply-To: <048.bed690b6ed6632ceb9361aef80b57ffb@haskell.org> References: <048.bed690b6ed6632ceb9361aef80b57ffb@haskell.org> Message-ID: <063.1a0fd635d73cd9bfd916979cf1877b3c@haskell.org> #14770: Allow static pointer expressions to have static pointer free variables -------------------------------------+------------------------------------- Reporter: TheKing01 | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | StaticPointers Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): This ticket seems to really want a splice like operator for static forms. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:40:50 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:40:50 -0000 Subject: [GHC] #15609: No skolem info panic: Static pointers and holes In-Reply-To: <049.9c3839d6ab653baeae68cc98ef04bf26@haskell.org> References: <049.9c3839d6ab653baeae68cc98ef04bf26@haskell.org> Message-ID: <064.c63c9bf6a76e9360ee4e929ff7346ad0@haskell.org> #15609: No skolem info panic: Static pointers and holes -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by mpickering): * status: new => closed * resolution: => duplicate Comment: Same as #13499 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:43:01 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:43:01 -0000 Subject: [GHC] #15608: Segfault in retainer profiling In-Reply-To: <043.5de2d12576332caf387b4ed18691b19e@haskell.org> References: <043.5de2d12576332caf387b4ed18691b19e@haskell.org> Message-ID: <058.e4ed3c31e73baa3780b36592d3642ae5@haskell.org> #15608: Segfault in retainer profiling -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Profiling | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5134 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * differential: => Phab:D5134 Comment: I fixed a few bugs in Phab:D5134. There are still more bugs to fix until this works. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:53:30 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:53:30 -0000 Subject: [GHC] #1: Implicit parameters cause strange behavi In-Reply-To: <045.dd635ef62f3ce1d5e8bfe2b4cd36b0de@haskell.org> References: <045.dd635ef62f3ce1d5e8bfe2b4cd36b0de@haskell.org> Message-ID: <060.e9ba282e340b58bfe879c643cf10b9f8@haskell.org> #1: Implicit parameters cause strange behavi --------------------------------+-------------------- Reporter: nobody | Owner: nobody Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 5.0 Resolution: Fixed | Keywords: Type of failure: None/Unknown | --------------------------------+-------------------- Comment (by Ömer Sinan Ağacan ): In [changeset:"c6fbac6a6a69a2f4be89701b2c386ae53214f9a3/ghc" c6fbac6/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c6fbac6a6a69a2f4be89701b2c386ae53214f9a3" Fix a race between GC threads in concurrent scavenging While debugging #15285 I realized that free block lists (free_list in BlockAlloc.c) get corrupted when multiple scavenge threads allocate and release blocks concurrently. Here's a picture of one such race: Thread 2 (Thread 32573.32601): #0 check_tail (bd=0x940d40 ) at rts/sm/BlockAlloc.c:860 #1 0x0000000000928ef7 in checkFreeListSanity () at rts/sm/BlockAlloc.c:896 #2 0x0000000000928979 in freeGroup (p=0x7e998ce02880) at rts/sm/BlockAlloc.c:721 #3 0x0000000000928a17 in freeChain (bd=0x7e998ce02880) at rts/sm/BlockAlloc.c:738 #4 0x0000000000926911 in freeChain_sync (bd=0x7e998ce02880) at rts/sm/GCUtils.c:80 #5 0x0000000000934720 in scavenge_capability_mut_lists (cap=0x1acae80) at rts/sm/Scav.c:1665 #6 0x000000000092b411 in gcWorkerThread (cap=0x1acae80) at rts/sm/GC.c:1157 #7 0x000000000090be9a in yieldCapability (pCap=0x7f9994e69e20, task=0x7e9984000b70, gcAllowed=true) at rts/Capability.c:861 #8 0x0000000000906120 in scheduleYield (pcap=0x7f9994e69e50, task=0x7e9984000b70) at rts/Schedule.c:673 #9 0x0000000000905500 in schedule (initialCapability=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:293 #10 0x0000000000908d4f in scheduleWorker (cap=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:2554 #11 0x000000000091a30a in workerStart (task=0x7e9984000b70) at rts/Task.c:444 #12 0x00007f99937fa6db in start_thread (arg=0x7f9994e6a700) at pthread_create.c:463 #13 0x000061654d59f88f in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:95 Thread 1 (Thread 32573.32573): #0 checkFreeListSanity () at rts/sm/BlockAlloc.c:887 #1 0x0000000000928979 in freeGroup (p=0x7e998d303540) at rts/sm/BlockAlloc.c:721 #2 0x0000000000926f23 in todo_block_full (size=513, ws=0x1aa8ce0) at rts/sm/GCUtils.c:264 #3 0x00000000009583b9 in alloc_for_copy (size=513, gen_no=0) at rts/sm/Evac.c:80 #4 0x000000000095850d in copy_tag_nolock (p=0x7e998c675f28, info=0x421d98 , src=0x7e998d075d80, size=513, gen_no=0, tag=1) at rts/sm/Evac.c:153 #5 0x0000000000959177 in evacuate (p=0x7e998c675f28) at rts/sm/Evac.c:715 #6 0x0000000000932388 in scavenge_small_bitmap (p=0x7e998c675f28, size=1, bitmap=0) at rts/sm/Scav.c:271 #7 0x0000000000934aaf in scavenge_stack (p=0x7e998c675f28, stack_end=0x7e998c676000) at rts/sm/Scav.c:1908 #8 0x0000000000934295 in scavenge_one (p=0x7e998c66e000) at rts/sm/Scav.c:1466 #9 0x0000000000934662 in scavenge_mutable_list (bd=0x7e998d300440, gen=0x1b1d880) at rts/sm/Scav.c:1643 #10 0x0000000000934700 in scavenge_capability_mut_lists (cap=0x1aaa340) at rts/sm/Scav.c:1664 #11 0x00000000009299b6 in GarbageCollect (collect_gen=0, do_heap_census=false, gc_type=2, cap=0x1aaa340, idle_cap=0x1b38aa0) at rts/sm/GC.c:378 #12 0x0000000000907a4a in scheduleDoGC (pcap=0x7ffdec5b5310, task=0x1b36650, force_major=false) at rts/Schedule.c:1798 #13 0x0000000000905de7 in schedule (initialCapability=0x1aaa340, task=0x1b36650) at rts/Schedule.c:546 #14 0x0000000000908bc4 in scheduleWaitThread (tso=0x7e998c0067c8, ret=0x0, pcap=0x7ffdec5b5430) at rts/Schedule.c:2537 #15 0x000000000091b5a0 in rts_evalLazyIO (cap=0x7ffdec5b5430, p=0x9c11f0, ret=0x0) at rts/RtsAPI.c:530 #16 0x000000000091ca56 in hs_main (argc=1, argv=0x7ffdec5b5628, main_closure=0x9c11f0, rts_config=...) at rts/RtsMain.c:72 #17 0x0000000000421ea0 in main () In particular, dbl_link_onto() which is used to add a freed block to a doubly-linked free list is not thread safe and corrupts the list when called concurrently. Note that thread 1 is to blame here as thread 2 is properly taking the spinlock. With this patch we now take the spinlock when freeing a todo block in GC, avoiding this race. Test Plan: - Tried slow validate locally: this patch does not introduce new failures. - circleci: https://circleci.com/gh/ghc/ghc-diffs/283 The test got killed because it took 5 hours but T7919 (which was previously failing on circleci) passed. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15285 Differential Revision: https://phabricator.haskell.org/D5115 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:53:30 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:53:30 -0000 Subject: [GHC] #3: DiffArray should be instance of Show In-Reply-To: <047.3d7bfcea6c6c5eaaf4a369a972367c38@haskell.org> References: <047.3d7bfcea6c6c5eaaf4a369a972367c38@haskell.org> Message-ID: <062.385005578a20cee1850c3396e34f9846@haskell.org> #3: DiffArray should be instance of Show --------------------------------+-------------------- Reporter: magunter | Owner: nobody Type: bug | Status: closed Priority: normal | Milestone: Component: hslibs/lang | Version: 5.0 Resolution: Fixed | Keywords: Type of failure: None/Unknown | --------------------------------+-------------------- Comment (by Ömer Sinan Ağacan ): In [changeset:"c6fbac6a6a69a2f4be89701b2c386ae53214f9a3/ghc" c6fbac6/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c6fbac6a6a69a2f4be89701b2c386ae53214f9a3" Fix a race between GC threads in concurrent scavenging While debugging #15285 I realized that free block lists (free_list in BlockAlloc.c) get corrupted when multiple scavenge threads allocate and release blocks concurrently. Here's a picture of one such race: Thread 2 (Thread 32573.32601): #0 check_tail (bd=0x940d40 ) at rts/sm/BlockAlloc.c:860 #1 0x0000000000928ef7 in checkFreeListSanity () at rts/sm/BlockAlloc.c:896 #2 0x0000000000928979 in freeGroup (p=0x7e998ce02880) at rts/sm/BlockAlloc.c:721 #3 0x0000000000928a17 in freeChain (bd=0x7e998ce02880) at rts/sm/BlockAlloc.c:738 #4 0x0000000000926911 in freeChain_sync (bd=0x7e998ce02880) at rts/sm/GCUtils.c:80 #5 0x0000000000934720 in scavenge_capability_mut_lists (cap=0x1acae80) at rts/sm/Scav.c:1665 #6 0x000000000092b411 in gcWorkerThread (cap=0x1acae80) at rts/sm/GC.c:1157 #7 0x000000000090be9a in yieldCapability (pCap=0x7f9994e69e20, task=0x7e9984000b70, gcAllowed=true) at rts/Capability.c:861 #8 0x0000000000906120 in scheduleYield (pcap=0x7f9994e69e50, task=0x7e9984000b70) at rts/Schedule.c:673 #9 0x0000000000905500 in schedule (initialCapability=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:293 #10 0x0000000000908d4f in scheduleWorker (cap=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:2554 #11 0x000000000091a30a in workerStart (task=0x7e9984000b70) at rts/Task.c:444 #12 0x00007f99937fa6db in start_thread (arg=0x7f9994e6a700) at pthread_create.c:463 #13 0x000061654d59f88f in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:95 Thread 1 (Thread 32573.32573): #0 checkFreeListSanity () at rts/sm/BlockAlloc.c:887 #1 0x0000000000928979 in freeGroup (p=0x7e998d303540) at rts/sm/BlockAlloc.c:721 #2 0x0000000000926f23 in todo_block_full (size=513, ws=0x1aa8ce0) at rts/sm/GCUtils.c:264 #3 0x00000000009583b9 in alloc_for_copy (size=513, gen_no=0) at rts/sm/Evac.c:80 #4 0x000000000095850d in copy_tag_nolock (p=0x7e998c675f28, info=0x421d98 , src=0x7e998d075d80, size=513, gen_no=0, tag=1) at rts/sm/Evac.c:153 #5 0x0000000000959177 in evacuate (p=0x7e998c675f28) at rts/sm/Evac.c:715 #6 0x0000000000932388 in scavenge_small_bitmap (p=0x7e998c675f28, size=1, bitmap=0) at rts/sm/Scav.c:271 #7 0x0000000000934aaf in scavenge_stack (p=0x7e998c675f28, stack_end=0x7e998c676000) at rts/sm/Scav.c:1908 #8 0x0000000000934295 in scavenge_one (p=0x7e998c66e000) at rts/sm/Scav.c:1466 #9 0x0000000000934662 in scavenge_mutable_list (bd=0x7e998d300440, gen=0x1b1d880) at rts/sm/Scav.c:1643 #10 0x0000000000934700 in scavenge_capability_mut_lists (cap=0x1aaa340) at rts/sm/Scav.c:1664 #11 0x00000000009299b6 in GarbageCollect (collect_gen=0, do_heap_census=false, gc_type=2, cap=0x1aaa340, idle_cap=0x1b38aa0) at rts/sm/GC.c:378 #12 0x0000000000907a4a in scheduleDoGC (pcap=0x7ffdec5b5310, task=0x1b36650, force_major=false) at rts/Schedule.c:1798 #13 0x0000000000905de7 in schedule (initialCapability=0x1aaa340, task=0x1b36650) at rts/Schedule.c:546 #14 0x0000000000908bc4 in scheduleWaitThread (tso=0x7e998c0067c8, ret=0x0, pcap=0x7ffdec5b5430) at rts/Schedule.c:2537 #15 0x000000000091b5a0 in rts_evalLazyIO (cap=0x7ffdec5b5430, p=0x9c11f0, ret=0x0) at rts/RtsAPI.c:530 #16 0x000000000091ca56 in hs_main (argc=1, argv=0x7ffdec5b5628, main_closure=0x9c11f0, rts_config=...) at rts/RtsMain.c:72 #17 0x0000000000421ea0 in main () In particular, dbl_link_onto() which is used to add a freed block to a doubly-linked free list is not thread safe and corrupts the list when called concurrently. Note that thread 1 is to blame here as thread 2 is properly taking the spinlock. With this patch we now take the spinlock when freeing a todo block in GC, avoiding this race. Test Plan: - Tried slow validate locally: this patch does not introduce new failures. - circleci: https://circleci.com/gh/ghc/ghc-diffs/283 The test got killed because it took 5 hours but T7919 (which was previously failing on circleci) passed. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15285 Differential Revision: https://phabricator.haskell.org/D5115 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:53:30 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:53:30 -0000 Subject: [GHC] #2: rewrite rules, forall, no -fglasgow-exts In-Reply-To: <045.06ea7a403df37fa1d474136f4bf6bb53@haskell.org> References: <045.06ea7a403df37fa1d474136f4bf6bb53@haskell.org> Message-ID: <060.2f6fd3f732e77c166202a59eee2ed36e@haskell.org> #2: rewrite rules, forall, no -fglasgow-exts -------------------------------------+---------------------- Reporter: nobody | Owner: simonmar Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler (Parser) | Version: None Resolution: Fixed | Keywords: Type of failure: None/Unknown | -------------------------------------+---------------------- Comment (by Ömer Sinan Ağacan ): In [changeset:"c6fbac6a6a69a2f4be89701b2c386ae53214f9a3/ghc" c6fbac6/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c6fbac6a6a69a2f4be89701b2c386ae53214f9a3" Fix a race between GC threads in concurrent scavenging While debugging #15285 I realized that free block lists (free_list in BlockAlloc.c) get corrupted when multiple scavenge threads allocate and release blocks concurrently. Here's a picture of one such race: Thread 2 (Thread 32573.32601): #0 check_tail (bd=0x940d40 ) at rts/sm/BlockAlloc.c:860 #1 0x0000000000928ef7 in checkFreeListSanity () at rts/sm/BlockAlloc.c:896 #2 0x0000000000928979 in freeGroup (p=0x7e998ce02880) at rts/sm/BlockAlloc.c:721 #3 0x0000000000928a17 in freeChain (bd=0x7e998ce02880) at rts/sm/BlockAlloc.c:738 #4 0x0000000000926911 in freeChain_sync (bd=0x7e998ce02880) at rts/sm/GCUtils.c:80 #5 0x0000000000934720 in scavenge_capability_mut_lists (cap=0x1acae80) at rts/sm/Scav.c:1665 #6 0x000000000092b411 in gcWorkerThread (cap=0x1acae80) at rts/sm/GC.c:1157 #7 0x000000000090be9a in yieldCapability (pCap=0x7f9994e69e20, task=0x7e9984000b70, gcAllowed=true) at rts/Capability.c:861 #8 0x0000000000906120 in scheduleYield (pcap=0x7f9994e69e50, task=0x7e9984000b70) at rts/Schedule.c:673 #9 0x0000000000905500 in schedule (initialCapability=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:293 #10 0x0000000000908d4f in scheduleWorker (cap=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:2554 #11 0x000000000091a30a in workerStart (task=0x7e9984000b70) at rts/Task.c:444 #12 0x00007f99937fa6db in start_thread (arg=0x7f9994e6a700) at pthread_create.c:463 #13 0x000061654d59f88f in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:95 Thread 1 (Thread 32573.32573): #0 checkFreeListSanity () at rts/sm/BlockAlloc.c:887 #1 0x0000000000928979 in freeGroup (p=0x7e998d303540) at rts/sm/BlockAlloc.c:721 #2 0x0000000000926f23 in todo_block_full (size=513, ws=0x1aa8ce0) at rts/sm/GCUtils.c:264 #3 0x00000000009583b9 in alloc_for_copy (size=513, gen_no=0) at rts/sm/Evac.c:80 #4 0x000000000095850d in copy_tag_nolock (p=0x7e998c675f28, info=0x421d98 , src=0x7e998d075d80, size=513, gen_no=0, tag=1) at rts/sm/Evac.c:153 #5 0x0000000000959177 in evacuate (p=0x7e998c675f28) at rts/sm/Evac.c:715 #6 0x0000000000932388 in scavenge_small_bitmap (p=0x7e998c675f28, size=1, bitmap=0) at rts/sm/Scav.c:271 #7 0x0000000000934aaf in scavenge_stack (p=0x7e998c675f28, stack_end=0x7e998c676000) at rts/sm/Scav.c:1908 #8 0x0000000000934295 in scavenge_one (p=0x7e998c66e000) at rts/sm/Scav.c:1466 #9 0x0000000000934662 in scavenge_mutable_list (bd=0x7e998d300440, gen=0x1b1d880) at rts/sm/Scav.c:1643 #10 0x0000000000934700 in scavenge_capability_mut_lists (cap=0x1aaa340) at rts/sm/Scav.c:1664 #11 0x00000000009299b6 in GarbageCollect (collect_gen=0, do_heap_census=false, gc_type=2, cap=0x1aaa340, idle_cap=0x1b38aa0) at rts/sm/GC.c:378 #12 0x0000000000907a4a in scheduleDoGC (pcap=0x7ffdec5b5310, task=0x1b36650, force_major=false) at rts/Schedule.c:1798 #13 0x0000000000905de7 in schedule (initialCapability=0x1aaa340, task=0x1b36650) at rts/Schedule.c:546 #14 0x0000000000908bc4 in scheduleWaitThread (tso=0x7e998c0067c8, ret=0x0, pcap=0x7ffdec5b5430) at rts/Schedule.c:2537 #15 0x000000000091b5a0 in rts_evalLazyIO (cap=0x7ffdec5b5430, p=0x9c11f0, ret=0x0) at rts/RtsAPI.c:530 #16 0x000000000091ca56 in hs_main (argc=1, argv=0x7ffdec5b5628, main_closure=0x9c11f0, rts_config=...) at rts/RtsMain.c:72 #17 0x0000000000421ea0 in main () In particular, dbl_link_onto() which is used to add a freed block to a doubly-linked free list is not thread safe and corrupts the list when called concurrently. Note that thread 1 is to blame here as thread 2 is properly taking the spinlock. With this patch we now take the spinlock when freeing a todo block in GC, avoiding this race. Test Plan: - Tried slow validate locally: this patch does not introduce new failures. - circleci: https://circleci.com/gh/ghc/ghc-diffs/283 The test got killed because it took 5 hours but T7919 (which was previously failing on circleci) passed. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15285 Differential Revision: https://phabricator.haskell.org/D5115 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:53:30 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:53:30 -0000 Subject: [GHC] #4: -fext-core -fno-core behaves funny In-Reply-To: <045.ae3f8b0e845fade77535d5ec02817b6a@haskell.org> References: <045.ae3f8b0e845fade77535d5ec02817b6a@haskell.org> Message-ID: <060.22be6eb8f39d7d1492c577a6a4fc2403@haskell.org> #4: -fext-core -fno-core behaves funny --------------------------------+-------------------- Reporter: josefs | Owner: nobody Type: bug | Status: closed Priority: normal | Milestone: Component: Driver | Version: None Resolution: Fixed | Keywords: Type of failure: None/Unknown | --------------------------------+-------------------- Comment (by Ömer Sinan Ağacan ): In [changeset:"c6fbac6a6a69a2f4be89701b2c386ae53214f9a3/ghc" c6fbac6/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c6fbac6a6a69a2f4be89701b2c386ae53214f9a3" Fix a race between GC threads in concurrent scavenging While debugging #15285 I realized that free block lists (free_list in BlockAlloc.c) get corrupted when multiple scavenge threads allocate and release blocks concurrently. Here's a picture of one such race: Thread 2 (Thread 32573.32601): #0 check_tail (bd=0x940d40 ) at rts/sm/BlockAlloc.c:860 #1 0x0000000000928ef7 in checkFreeListSanity () at rts/sm/BlockAlloc.c:896 #2 0x0000000000928979 in freeGroup (p=0x7e998ce02880) at rts/sm/BlockAlloc.c:721 #3 0x0000000000928a17 in freeChain (bd=0x7e998ce02880) at rts/sm/BlockAlloc.c:738 #4 0x0000000000926911 in freeChain_sync (bd=0x7e998ce02880) at rts/sm/GCUtils.c:80 #5 0x0000000000934720 in scavenge_capability_mut_lists (cap=0x1acae80) at rts/sm/Scav.c:1665 #6 0x000000000092b411 in gcWorkerThread (cap=0x1acae80) at rts/sm/GC.c:1157 #7 0x000000000090be9a in yieldCapability (pCap=0x7f9994e69e20, task=0x7e9984000b70, gcAllowed=true) at rts/Capability.c:861 #8 0x0000000000906120 in scheduleYield (pcap=0x7f9994e69e50, task=0x7e9984000b70) at rts/Schedule.c:673 #9 0x0000000000905500 in schedule (initialCapability=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:293 #10 0x0000000000908d4f in scheduleWorker (cap=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:2554 #11 0x000000000091a30a in workerStart (task=0x7e9984000b70) at rts/Task.c:444 #12 0x00007f99937fa6db in start_thread (arg=0x7f9994e6a700) at pthread_create.c:463 #13 0x000061654d59f88f in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:95 Thread 1 (Thread 32573.32573): #0 checkFreeListSanity () at rts/sm/BlockAlloc.c:887 #1 0x0000000000928979 in freeGroup (p=0x7e998d303540) at rts/sm/BlockAlloc.c:721 #2 0x0000000000926f23 in todo_block_full (size=513, ws=0x1aa8ce0) at rts/sm/GCUtils.c:264 #3 0x00000000009583b9 in alloc_for_copy (size=513, gen_no=0) at rts/sm/Evac.c:80 #4 0x000000000095850d in copy_tag_nolock (p=0x7e998c675f28, info=0x421d98 , src=0x7e998d075d80, size=513, gen_no=0, tag=1) at rts/sm/Evac.c:153 #5 0x0000000000959177 in evacuate (p=0x7e998c675f28) at rts/sm/Evac.c:715 #6 0x0000000000932388 in scavenge_small_bitmap (p=0x7e998c675f28, size=1, bitmap=0) at rts/sm/Scav.c:271 #7 0x0000000000934aaf in scavenge_stack (p=0x7e998c675f28, stack_end=0x7e998c676000) at rts/sm/Scav.c:1908 #8 0x0000000000934295 in scavenge_one (p=0x7e998c66e000) at rts/sm/Scav.c:1466 #9 0x0000000000934662 in scavenge_mutable_list (bd=0x7e998d300440, gen=0x1b1d880) at rts/sm/Scav.c:1643 #10 0x0000000000934700 in scavenge_capability_mut_lists (cap=0x1aaa340) at rts/sm/Scav.c:1664 #11 0x00000000009299b6 in GarbageCollect (collect_gen=0, do_heap_census=false, gc_type=2, cap=0x1aaa340, idle_cap=0x1b38aa0) at rts/sm/GC.c:378 #12 0x0000000000907a4a in scheduleDoGC (pcap=0x7ffdec5b5310, task=0x1b36650, force_major=false) at rts/Schedule.c:1798 #13 0x0000000000905de7 in schedule (initialCapability=0x1aaa340, task=0x1b36650) at rts/Schedule.c:546 #14 0x0000000000908bc4 in scheduleWaitThread (tso=0x7e998c0067c8, ret=0x0, pcap=0x7ffdec5b5430) at rts/Schedule.c:2537 #15 0x000000000091b5a0 in rts_evalLazyIO (cap=0x7ffdec5b5430, p=0x9c11f0, ret=0x0) at rts/RtsAPI.c:530 #16 0x000000000091ca56 in hs_main (argc=1, argv=0x7ffdec5b5628, main_closure=0x9c11f0, rts_config=...) at rts/RtsMain.c:72 #17 0x0000000000421ea0 in main () In particular, dbl_link_onto() which is used to add a freed block to a doubly-linked free list is not thread safe and corrupts the list when called concurrently. Note that thread 1 is to blame here as thread 2 is properly taking the spinlock. With this patch we now take the spinlock when freeing a todo block in GC, avoiding this race. Test Plan: - Tried slow validate locally: this patch does not introduce new failures. - circleci: https://circleci.com/gh/ghc/ghc-diffs/283 The test got killed because it took 5 hours but T7919 (which was previously failing on circleci) passed. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15285 Differential Revision: https://phabricator.haskell.org/D5115 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:53:30 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:53:30 -0000 Subject: [GHC] #5: fails if library has main() In-Reply-To: <045.5aafe47c7b47732eda828244576abf66@haskell.org> References: <045.5aafe47c7b47732eda828244576abf66@haskell.org> Message-ID: <060.a2ef164569b949d22647391e70e2fd12@haskell.org> #5: fails if library has main() --------------------------------+---------------------- Reporter: cwitty | Owner: simonmar Type: bug | Status: closed Priority: normal | Milestone: Component: Driver | Version: 5.02 Resolution: Wont Fix | Keywords: Type of failure: None/Unknown | --------------------------------+---------------------- Comment (by Ömer Sinan Ağacan ): In [changeset:"c6fbac6a6a69a2f4be89701b2c386ae53214f9a3/ghc" c6fbac6/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c6fbac6a6a69a2f4be89701b2c386ae53214f9a3" Fix a race between GC threads in concurrent scavenging While debugging #15285 I realized that free block lists (free_list in BlockAlloc.c) get corrupted when multiple scavenge threads allocate and release blocks concurrently. Here's a picture of one such race: Thread 2 (Thread 32573.32601): #0 check_tail (bd=0x940d40 ) at rts/sm/BlockAlloc.c:860 #1 0x0000000000928ef7 in checkFreeListSanity () at rts/sm/BlockAlloc.c:896 #2 0x0000000000928979 in freeGroup (p=0x7e998ce02880) at rts/sm/BlockAlloc.c:721 #3 0x0000000000928a17 in freeChain (bd=0x7e998ce02880) at rts/sm/BlockAlloc.c:738 #4 0x0000000000926911 in freeChain_sync (bd=0x7e998ce02880) at rts/sm/GCUtils.c:80 #5 0x0000000000934720 in scavenge_capability_mut_lists (cap=0x1acae80) at rts/sm/Scav.c:1665 #6 0x000000000092b411 in gcWorkerThread (cap=0x1acae80) at rts/sm/GC.c:1157 #7 0x000000000090be9a in yieldCapability (pCap=0x7f9994e69e20, task=0x7e9984000b70, gcAllowed=true) at rts/Capability.c:861 #8 0x0000000000906120 in scheduleYield (pcap=0x7f9994e69e50, task=0x7e9984000b70) at rts/Schedule.c:673 #9 0x0000000000905500 in schedule (initialCapability=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:293 #10 0x0000000000908d4f in scheduleWorker (cap=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:2554 #11 0x000000000091a30a in workerStart (task=0x7e9984000b70) at rts/Task.c:444 #12 0x00007f99937fa6db in start_thread (arg=0x7f9994e6a700) at pthread_create.c:463 #13 0x000061654d59f88f in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:95 Thread 1 (Thread 32573.32573): #0 checkFreeListSanity () at rts/sm/BlockAlloc.c:887 #1 0x0000000000928979 in freeGroup (p=0x7e998d303540) at rts/sm/BlockAlloc.c:721 #2 0x0000000000926f23 in todo_block_full (size=513, ws=0x1aa8ce0) at rts/sm/GCUtils.c:264 #3 0x00000000009583b9 in alloc_for_copy (size=513, gen_no=0) at rts/sm/Evac.c:80 #4 0x000000000095850d in copy_tag_nolock (p=0x7e998c675f28, info=0x421d98 , src=0x7e998d075d80, size=513, gen_no=0, tag=1) at rts/sm/Evac.c:153 #5 0x0000000000959177 in evacuate (p=0x7e998c675f28) at rts/sm/Evac.c:715 #6 0x0000000000932388 in scavenge_small_bitmap (p=0x7e998c675f28, size=1, bitmap=0) at rts/sm/Scav.c:271 #7 0x0000000000934aaf in scavenge_stack (p=0x7e998c675f28, stack_end=0x7e998c676000) at rts/sm/Scav.c:1908 #8 0x0000000000934295 in scavenge_one (p=0x7e998c66e000) at rts/sm/Scav.c:1466 #9 0x0000000000934662 in scavenge_mutable_list (bd=0x7e998d300440, gen=0x1b1d880) at rts/sm/Scav.c:1643 #10 0x0000000000934700 in scavenge_capability_mut_lists (cap=0x1aaa340) at rts/sm/Scav.c:1664 #11 0x00000000009299b6 in GarbageCollect (collect_gen=0, do_heap_census=false, gc_type=2, cap=0x1aaa340, idle_cap=0x1b38aa0) at rts/sm/GC.c:378 #12 0x0000000000907a4a in scheduleDoGC (pcap=0x7ffdec5b5310, task=0x1b36650, force_major=false) at rts/Schedule.c:1798 #13 0x0000000000905de7 in schedule (initialCapability=0x1aaa340, task=0x1b36650) at rts/Schedule.c:546 #14 0x0000000000908bc4 in scheduleWaitThread (tso=0x7e998c0067c8, ret=0x0, pcap=0x7ffdec5b5430) at rts/Schedule.c:2537 #15 0x000000000091b5a0 in rts_evalLazyIO (cap=0x7ffdec5b5430, p=0x9c11f0, ret=0x0) at rts/RtsAPI.c:530 #16 0x000000000091ca56 in hs_main (argc=1, argv=0x7ffdec5b5628, main_closure=0x9c11f0, rts_config=...) at rts/RtsMain.c:72 #17 0x0000000000421ea0 in main () In particular, dbl_link_onto() which is used to add a freed block to a doubly-linked free list is not thread safe and corrupts the list when called concurrently. Note that thread 1 is to blame here as thread 2 is properly taking the spinlock. With this patch we now take the spinlock when freeing a todo block in GC, avoiding this race. Test Plan: - Tried slow validate locally: this patch does not introduce new failures. - circleci: https://circleci.com/gh/ghc/ghc-diffs/283 The test got killed because it took 5 hours but T7919 (which was previously failing on circleci) passed. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15285 Differential Revision: https://phabricator.haskell.org/D5115 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:53:30 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:53:30 -0000 Subject: [GHC] #6: Debugging info confuses runtime linker In-Reply-To: <047.f0ad9cac1869b4c4c3b4613e6dbb6f53@haskell.org> References: <047.f0ad9cac1869b4c4c3b4613e6dbb6f53@haskell.org> Message-ID: <062.99ef2cfb12fa886c8ba64fff99d8c1b3@haskell.org> #6: Debugging info confuses runtime linker ----------------------------------+--------------------- Reporter: simonmar | Owner: sewardj Type: bug | Status: closed Priority: normal | Milestone: Component: Runtime System | Version: 5.02 Resolution: Fixed | Keywords: Type of failure: None/Unknown | ----------------------------------+--------------------- Changes (by Ömer Sinan Ağacan ): * failure: => None/Unknown Comment: In [changeset:"c6fbac6a6a69a2f4be89701b2c386ae53214f9a3/ghc" c6fbac6/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c6fbac6a6a69a2f4be89701b2c386ae53214f9a3" Fix a race between GC threads in concurrent scavenging While debugging #15285 I realized that free block lists (free_list in BlockAlloc.c) get corrupted when multiple scavenge threads allocate and release blocks concurrently. Here's a picture of one such race: Thread 2 (Thread 32573.32601): #0 check_tail (bd=0x940d40 ) at rts/sm/BlockAlloc.c:860 #1 0x0000000000928ef7 in checkFreeListSanity () at rts/sm/BlockAlloc.c:896 #2 0x0000000000928979 in freeGroup (p=0x7e998ce02880) at rts/sm/BlockAlloc.c:721 #3 0x0000000000928a17 in freeChain (bd=0x7e998ce02880) at rts/sm/BlockAlloc.c:738 #4 0x0000000000926911 in freeChain_sync (bd=0x7e998ce02880) at rts/sm/GCUtils.c:80 #5 0x0000000000934720 in scavenge_capability_mut_lists (cap=0x1acae80) at rts/sm/Scav.c:1665 #6 0x000000000092b411 in gcWorkerThread (cap=0x1acae80) at rts/sm/GC.c:1157 #7 0x000000000090be9a in yieldCapability (pCap=0x7f9994e69e20, task=0x7e9984000b70, gcAllowed=true) at rts/Capability.c:861 #8 0x0000000000906120 in scheduleYield (pcap=0x7f9994e69e50, task=0x7e9984000b70) at rts/Schedule.c:673 #9 0x0000000000905500 in schedule (initialCapability=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:293 #10 0x0000000000908d4f in scheduleWorker (cap=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:2554 #11 0x000000000091a30a in workerStart (task=0x7e9984000b70) at rts/Task.c:444 #12 0x00007f99937fa6db in start_thread (arg=0x7f9994e6a700) at pthread_create.c:463 #13 0x000061654d59f88f in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:95 Thread 1 (Thread 32573.32573): #0 checkFreeListSanity () at rts/sm/BlockAlloc.c:887 #1 0x0000000000928979 in freeGroup (p=0x7e998d303540) at rts/sm/BlockAlloc.c:721 #2 0x0000000000926f23 in todo_block_full (size=513, ws=0x1aa8ce0) at rts/sm/GCUtils.c:264 #3 0x00000000009583b9 in alloc_for_copy (size=513, gen_no=0) at rts/sm/Evac.c:80 #4 0x000000000095850d in copy_tag_nolock (p=0x7e998c675f28, info=0x421d98 , src=0x7e998d075d80, size=513, gen_no=0, tag=1) at rts/sm/Evac.c:153 #5 0x0000000000959177 in evacuate (p=0x7e998c675f28) at rts/sm/Evac.c:715 #6 0x0000000000932388 in scavenge_small_bitmap (p=0x7e998c675f28, size=1, bitmap=0) at rts/sm/Scav.c:271 #7 0x0000000000934aaf in scavenge_stack (p=0x7e998c675f28, stack_end=0x7e998c676000) at rts/sm/Scav.c:1908 #8 0x0000000000934295 in scavenge_one (p=0x7e998c66e000) at rts/sm/Scav.c:1466 #9 0x0000000000934662 in scavenge_mutable_list (bd=0x7e998d300440, gen=0x1b1d880) at rts/sm/Scav.c:1643 #10 0x0000000000934700 in scavenge_capability_mut_lists (cap=0x1aaa340) at rts/sm/Scav.c:1664 #11 0x00000000009299b6 in GarbageCollect (collect_gen=0, do_heap_census=false, gc_type=2, cap=0x1aaa340, idle_cap=0x1b38aa0) at rts/sm/GC.c:378 #12 0x0000000000907a4a in scheduleDoGC (pcap=0x7ffdec5b5310, task=0x1b36650, force_major=false) at rts/Schedule.c:1798 #13 0x0000000000905de7 in schedule (initialCapability=0x1aaa340, task=0x1b36650) at rts/Schedule.c:546 #14 0x0000000000908bc4 in scheduleWaitThread (tso=0x7e998c0067c8, ret=0x0, pcap=0x7ffdec5b5430) at rts/Schedule.c:2537 #15 0x000000000091b5a0 in rts_evalLazyIO (cap=0x7ffdec5b5430, p=0x9c11f0, ret=0x0) at rts/RtsAPI.c:530 #16 0x000000000091ca56 in hs_main (argc=1, argv=0x7ffdec5b5628, main_closure=0x9c11f0, rts_config=...) at rts/RtsMain.c:72 #17 0x0000000000421ea0 in main () In particular, dbl_link_onto() which is used to add a freed block to a doubly-linked free list is not thread safe and corrupts the list when called concurrently. Note that thread 1 is to blame here as thread 2 is properly taking the spinlock. With this patch we now take the spinlock when freeing a todo block in GC, avoiding this race. Test Plan: - Tried slow validate locally: this patch does not introduce new failures. - circleci: https://circleci.com/gh/ghc/ghc-diffs/283 The test got killed because it took 5 hours but T7919 (which was previously failing on circleci) passed. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15285 Differential Revision: https://phabricator.haskell.org/D5115 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:53:31 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:53:31 -0000 Subject: [GHC] #7: dodgy case of unboxed tuple type In-Reply-To: <046.d0162c2c79173b600f159e4160473f60@haskell.org> References: <046.d0162c2c79173b600f159e4160473f60@haskell.org> Message-ID: <061.98ce6147ba6127f6e5fe138e583161ba@haskell.org> #7: dodgy case of unboxed tuple type --------------------------------+-------------------- Reporter: mtehver | Owner: nobody Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 5.02 Resolution: Fixed | Keywords: Type of failure: None/Unknown | --------------------------------+-------------------- Changes (by Ömer Sinan Ağacan ): * failure: => None/Unknown Comment: In [changeset:"c6fbac6a6a69a2f4be89701b2c386ae53214f9a3/ghc" c6fbac6/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c6fbac6a6a69a2f4be89701b2c386ae53214f9a3" Fix a race between GC threads in concurrent scavenging While debugging #15285 I realized that free block lists (free_list in BlockAlloc.c) get corrupted when multiple scavenge threads allocate and release blocks concurrently. Here's a picture of one such race: Thread 2 (Thread 32573.32601): #0 check_tail (bd=0x940d40 ) at rts/sm/BlockAlloc.c:860 #1 0x0000000000928ef7 in checkFreeListSanity () at rts/sm/BlockAlloc.c:896 #2 0x0000000000928979 in freeGroup (p=0x7e998ce02880) at rts/sm/BlockAlloc.c:721 #3 0x0000000000928a17 in freeChain (bd=0x7e998ce02880) at rts/sm/BlockAlloc.c:738 #4 0x0000000000926911 in freeChain_sync (bd=0x7e998ce02880) at rts/sm/GCUtils.c:80 #5 0x0000000000934720 in scavenge_capability_mut_lists (cap=0x1acae80) at rts/sm/Scav.c:1665 #6 0x000000000092b411 in gcWorkerThread (cap=0x1acae80) at rts/sm/GC.c:1157 #7 0x000000000090be9a in yieldCapability (pCap=0x7f9994e69e20, task=0x7e9984000b70, gcAllowed=true) at rts/Capability.c:861 #8 0x0000000000906120 in scheduleYield (pcap=0x7f9994e69e50, task=0x7e9984000b70) at rts/Schedule.c:673 #9 0x0000000000905500 in schedule (initialCapability=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:293 #10 0x0000000000908d4f in scheduleWorker (cap=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:2554 #11 0x000000000091a30a in workerStart (task=0x7e9984000b70) at rts/Task.c:444 #12 0x00007f99937fa6db in start_thread (arg=0x7f9994e6a700) at pthread_create.c:463 #13 0x000061654d59f88f in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:95 Thread 1 (Thread 32573.32573): #0 checkFreeListSanity () at rts/sm/BlockAlloc.c:887 #1 0x0000000000928979 in freeGroup (p=0x7e998d303540) at rts/sm/BlockAlloc.c:721 #2 0x0000000000926f23 in todo_block_full (size=513, ws=0x1aa8ce0) at rts/sm/GCUtils.c:264 #3 0x00000000009583b9 in alloc_for_copy (size=513, gen_no=0) at rts/sm/Evac.c:80 #4 0x000000000095850d in copy_tag_nolock (p=0x7e998c675f28, info=0x421d98 , src=0x7e998d075d80, size=513, gen_no=0, tag=1) at rts/sm/Evac.c:153 #5 0x0000000000959177 in evacuate (p=0x7e998c675f28) at rts/sm/Evac.c:715 #6 0x0000000000932388 in scavenge_small_bitmap (p=0x7e998c675f28, size=1, bitmap=0) at rts/sm/Scav.c:271 #7 0x0000000000934aaf in scavenge_stack (p=0x7e998c675f28, stack_end=0x7e998c676000) at rts/sm/Scav.c:1908 #8 0x0000000000934295 in scavenge_one (p=0x7e998c66e000) at rts/sm/Scav.c:1466 #9 0x0000000000934662 in scavenge_mutable_list (bd=0x7e998d300440, gen=0x1b1d880) at rts/sm/Scav.c:1643 #10 0x0000000000934700 in scavenge_capability_mut_lists (cap=0x1aaa340) at rts/sm/Scav.c:1664 #11 0x00000000009299b6 in GarbageCollect (collect_gen=0, do_heap_census=false, gc_type=2, cap=0x1aaa340, idle_cap=0x1b38aa0) at rts/sm/GC.c:378 #12 0x0000000000907a4a in scheduleDoGC (pcap=0x7ffdec5b5310, task=0x1b36650, force_major=false) at rts/Schedule.c:1798 #13 0x0000000000905de7 in schedule (initialCapability=0x1aaa340, task=0x1b36650) at rts/Schedule.c:546 #14 0x0000000000908bc4 in scheduleWaitThread (tso=0x7e998c0067c8, ret=0x0, pcap=0x7ffdec5b5430) at rts/Schedule.c:2537 #15 0x000000000091b5a0 in rts_evalLazyIO (cap=0x7ffdec5b5430, p=0x9c11f0, ret=0x0) at rts/RtsAPI.c:530 #16 0x000000000091ca56 in hs_main (argc=1, argv=0x7ffdec5b5628, main_closure=0x9c11f0, rts_config=...) at rts/RtsMain.c:72 #17 0x0000000000421ea0 in main () In particular, dbl_link_onto() which is used to add a freed block to a doubly-linked free list is not thread safe and corrupts the list when called concurrently. Note that thread 1 is to blame here as thread 2 is properly taking the spinlock. With this patch we now take the spinlock when freeing a todo block in GC, avoiding this race. Test Plan: - Tried slow validate locally: this patch does not introduce new failures. - circleci: https://circleci.com/gh/ghc/ghc-diffs/283 The test got killed because it took 5 hours but T7919 (which was previously failing on circleci) passed. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15285 Differential Revision: https://phabricator.haskell.org/D5115 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:53:31 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:53:31 -0000 Subject: [GHC] #9: GHCI for Win32 crashes with many options In-Reply-To: <046.dc944f46afdf1d8f330553aef7d98981@haskell.org> References: <046.dc944f46afdf1d8f330553aef7d98981@haskell.org> Message-ID: <061.8a7f2b97fc926237027b21a870677448@haskell.org> #9: GHCI for Win32 crashes with many options --------------------------------+-------------------- Reporter: fizzgig | Owner: nobody Type: bug | Status: closed Priority: normal | Milestone: Component: None | Version: 5.02 Resolution: Fixed | Keywords: Type of failure: None/Unknown | --------------------------------+-------------------- Changes (by Ömer Sinan Ağacan ): * failure: => None/Unknown Comment: In [changeset:"c6fbac6a6a69a2f4be89701b2c386ae53214f9a3/ghc" c6fbac6/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c6fbac6a6a69a2f4be89701b2c386ae53214f9a3" Fix a race between GC threads in concurrent scavenging While debugging #15285 I realized that free block lists (free_list in BlockAlloc.c) get corrupted when multiple scavenge threads allocate and release blocks concurrently. Here's a picture of one such race: Thread 2 (Thread 32573.32601): #0 check_tail (bd=0x940d40 ) at rts/sm/BlockAlloc.c:860 #1 0x0000000000928ef7 in checkFreeListSanity () at rts/sm/BlockAlloc.c:896 #2 0x0000000000928979 in freeGroup (p=0x7e998ce02880) at rts/sm/BlockAlloc.c:721 #3 0x0000000000928a17 in freeChain (bd=0x7e998ce02880) at rts/sm/BlockAlloc.c:738 #4 0x0000000000926911 in freeChain_sync (bd=0x7e998ce02880) at rts/sm/GCUtils.c:80 #5 0x0000000000934720 in scavenge_capability_mut_lists (cap=0x1acae80) at rts/sm/Scav.c:1665 #6 0x000000000092b411 in gcWorkerThread (cap=0x1acae80) at rts/sm/GC.c:1157 #7 0x000000000090be9a in yieldCapability (pCap=0x7f9994e69e20, task=0x7e9984000b70, gcAllowed=true) at rts/Capability.c:861 #8 0x0000000000906120 in scheduleYield (pcap=0x7f9994e69e50, task=0x7e9984000b70) at rts/Schedule.c:673 #9 0x0000000000905500 in schedule (initialCapability=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:293 #10 0x0000000000908d4f in scheduleWorker (cap=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:2554 #11 0x000000000091a30a in workerStart (task=0x7e9984000b70) at rts/Task.c:444 #12 0x00007f99937fa6db in start_thread (arg=0x7f9994e6a700) at pthread_create.c:463 #13 0x000061654d59f88f in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:95 Thread 1 (Thread 32573.32573): #0 checkFreeListSanity () at rts/sm/BlockAlloc.c:887 #1 0x0000000000928979 in freeGroup (p=0x7e998d303540) at rts/sm/BlockAlloc.c:721 #2 0x0000000000926f23 in todo_block_full (size=513, ws=0x1aa8ce0) at rts/sm/GCUtils.c:264 #3 0x00000000009583b9 in alloc_for_copy (size=513, gen_no=0) at rts/sm/Evac.c:80 #4 0x000000000095850d in copy_tag_nolock (p=0x7e998c675f28, info=0x421d98 , src=0x7e998d075d80, size=513, gen_no=0, tag=1) at rts/sm/Evac.c:153 #5 0x0000000000959177 in evacuate (p=0x7e998c675f28) at rts/sm/Evac.c:715 #6 0x0000000000932388 in scavenge_small_bitmap (p=0x7e998c675f28, size=1, bitmap=0) at rts/sm/Scav.c:271 #7 0x0000000000934aaf in scavenge_stack (p=0x7e998c675f28, stack_end=0x7e998c676000) at rts/sm/Scav.c:1908 #8 0x0000000000934295 in scavenge_one (p=0x7e998c66e000) at rts/sm/Scav.c:1466 #9 0x0000000000934662 in scavenge_mutable_list (bd=0x7e998d300440, gen=0x1b1d880) at rts/sm/Scav.c:1643 #10 0x0000000000934700 in scavenge_capability_mut_lists (cap=0x1aaa340) at rts/sm/Scav.c:1664 #11 0x00000000009299b6 in GarbageCollect (collect_gen=0, do_heap_census=false, gc_type=2, cap=0x1aaa340, idle_cap=0x1b38aa0) at rts/sm/GC.c:378 #12 0x0000000000907a4a in scheduleDoGC (pcap=0x7ffdec5b5310, task=0x1b36650, force_major=false) at rts/Schedule.c:1798 #13 0x0000000000905de7 in schedule (initialCapability=0x1aaa340, task=0x1b36650) at rts/Schedule.c:546 #14 0x0000000000908bc4 in scheduleWaitThread (tso=0x7e998c0067c8, ret=0x0, pcap=0x7ffdec5b5430) at rts/Schedule.c:2537 #15 0x000000000091b5a0 in rts_evalLazyIO (cap=0x7ffdec5b5430, p=0x9c11f0, ret=0x0) at rts/RtsAPI.c:530 #16 0x000000000091ca56 in hs_main (argc=1, argv=0x7ffdec5b5628, main_closure=0x9c11f0, rts_config=...) at rts/RtsMain.c:72 #17 0x0000000000421ea0 in main () In particular, dbl_link_onto() which is used to add a freed block to a doubly-linked free list is not thread safe and corrupts the list when called concurrently. Note that thread 1 is to blame here as thread 2 is properly taking the spinlock. With this patch we now take the spinlock when freeing a todo block in GC, avoiding this race. Test Plan: - Tried slow validate locally: this patch does not introduce new failures. - circleci: https://circleci.com/gh/ghc/ghc-diffs/283 The test got killed because it took 5 hours but T7919 (which was previously failing on circleci) passed. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15285 Differential Revision: https://phabricator.haskell.org/D5115 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:53:31 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:53:31 -0000 Subject: [GHC] #8: Regex failure In-Reply-To: <045.f8ed3d6828e64883829f70bbb0708aa0@haskell.org> References: <045.f8ed3d6828e64883829f70bbb0708aa0@haskell.org> Message-ID: <060.f26f8ca8fa5963b75ef7ef918d592b4e@haskell.org> #8: Regex failure --------------------------------+---------------------- Reporter: xoltar | Owner: simonmar Type: bug | Status: closed Priority: normal | Milestone: Component: hslibs/text | Version: 5.02 Resolution: Fixed | Keywords: Type of failure: None/Unknown | --------------------------------+---------------------- Changes (by Ömer Sinan Ağacan ): * failure: => None/Unknown Comment: In [changeset:"c6fbac6a6a69a2f4be89701b2c386ae53214f9a3/ghc" c6fbac6/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c6fbac6a6a69a2f4be89701b2c386ae53214f9a3" Fix a race between GC threads in concurrent scavenging While debugging #15285 I realized that free block lists (free_list in BlockAlloc.c) get corrupted when multiple scavenge threads allocate and release blocks concurrently. Here's a picture of one such race: Thread 2 (Thread 32573.32601): #0 check_tail (bd=0x940d40 ) at rts/sm/BlockAlloc.c:860 #1 0x0000000000928ef7 in checkFreeListSanity () at rts/sm/BlockAlloc.c:896 #2 0x0000000000928979 in freeGroup (p=0x7e998ce02880) at rts/sm/BlockAlloc.c:721 #3 0x0000000000928a17 in freeChain (bd=0x7e998ce02880) at rts/sm/BlockAlloc.c:738 #4 0x0000000000926911 in freeChain_sync (bd=0x7e998ce02880) at rts/sm/GCUtils.c:80 #5 0x0000000000934720 in scavenge_capability_mut_lists (cap=0x1acae80) at rts/sm/Scav.c:1665 #6 0x000000000092b411 in gcWorkerThread (cap=0x1acae80) at rts/sm/GC.c:1157 #7 0x000000000090be9a in yieldCapability (pCap=0x7f9994e69e20, task=0x7e9984000b70, gcAllowed=true) at rts/Capability.c:861 #8 0x0000000000906120 in scheduleYield (pcap=0x7f9994e69e50, task=0x7e9984000b70) at rts/Schedule.c:673 #9 0x0000000000905500 in schedule (initialCapability=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:293 #10 0x0000000000908d4f in scheduleWorker (cap=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:2554 #11 0x000000000091a30a in workerStart (task=0x7e9984000b70) at rts/Task.c:444 #12 0x00007f99937fa6db in start_thread (arg=0x7f9994e6a700) at pthread_create.c:463 #13 0x000061654d59f88f in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:95 Thread 1 (Thread 32573.32573): #0 checkFreeListSanity () at rts/sm/BlockAlloc.c:887 #1 0x0000000000928979 in freeGroup (p=0x7e998d303540) at rts/sm/BlockAlloc.c:721 #2 0x0000000000926f23 in todo_block_full (size=513, ws=0x1aa8ce0) at rts/sm/GCUtils.c:264 #3 0x00000000009583b9 in alloc_for_copy (size=513, gen_no=0) at rts/sm/Evac.c:80 #4 0x000000000095850d in copy_tag_nolock (p=0x7e998c675f28, info=0x421d98 , src=0x7e998d075d80, size=513, gen_no=0, tag=1) at rts/sm/Evac.c:153 #5 0x0000000000959177 in evacuate (p=0x7e998c675f28) at rts/sm/Evac.c:715 #6 0x0000000000932388 in scavenge_small_bitmap (p=0x7e998c675f28, size=1, bitmap=0) at rts/sm/Scav.c:271 #7 0x0000000000934aaf in scavenge_stack (p=0x7e998c675f28, stack_end=0x7e998c676000) at rts/sm/Scav.c:1908 #8 0x0000000000934295 in scavenge_one (p=0x7e998c66e000) at rts/sm/Scav.c:1466 #9 0x0000000000934662 in scavenge_mutable_list (bd=0x7e998d300440, gen=0x1b1d880) at rts/sm/Scav.c:1643 #10 0x0000000000934700 in scavenge_capability_mut_lists (cap=0x1aaa340) at rts/sm/Scav.c:1664 #11 0x00000000009299b6 in GarbageCollect (collect_gen=0, do_heap_census=false, gc_type=2, cap=0x1aaa340, idle_cap=0x1b38aa0) at rts/sm/GC.c:378 #12 0x0000000000907a4a in scheduleDoGC (pcap=0x7ffdec5b5310, task=0x1b36650, force_major=false) at rts/Schedule.c:1798 #13 0x0000000000905de7 in schedule (initialCapability=0x1aaa340, task=0x1b36650) at rts/Schedule.c:546 #14 0x0000000000908bc4 in scheduleWaitThread (tso=0x7e998c0067c8, ret=0x0, pcap=0x7ffdec5b5430) at rts/Schedule.c:2537 #15 0x000000000091b5a0 in rts_evalLazyIO (cap=0x7ffdec5b5430, p=0x9c11f0, ret=0x0) at rts/RtsAPI.c:530 #16 0x000000000091ca56 in hs_main (argc=1, argv=0x7ffdec5b5628, main_closure=0x9c11f0, rts_config=...) at rts/RtsMain.c:72 #17 0x0000000000421ea0 in main () In particular, dbl_link_onto() which is used to add a freed block to a doubly-linked free list is not thread safe and corrupts the list when called concurrently. Note that thread 1 is to blame here as thread 2 is properly taking the spinlock. With this patch we now take the spinlock when freeing a todo block in GC, avoiding this race. Test Plan: - Tried slow validate locally: this patch does not introduce new failures. - circleci: https://circleci.com/gh/ghc/ghc-diffs/283 The test got killed because it took 5 hours but T7919 (which was previously failing on circleci) passed. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15285 Differential Revision: https://phabricator.haskell.org/D5115 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:53:31 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:53:31 -0000 Subject: [GHC] #10: undefined reference to `Main_main_closur In-Reply-To: <045.59d858883487eb68b7c9d05072b43b58@haskell.org> References: <045.59d858883487eb68b7c9d05072b43b58@haskell.org> Message-ID: <060.7f81101c8827b12d008bf39111887662@haskell.org> #10: undefined reference to `Main_main_closur --------------------------------+-------------------- Reporter: nobody | Owner: nobody Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 5.02 Resolution: Invalid | Keywords: Type of failure: None/Unknown | --------------------------------+-------------------- Changes (by Ömer Sinan Ağacan ): * failure: => None/Unknown Comment: In [changeset:"c6fbac6a6a69a2f4be89701b2c386ae53214f9a3/ghc" c6fbac6/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c6fbac6a6a69a2f4be89701b2c386ae53214f9a3" Fix a race between GC threads in concurrent scavenging While debugging #15285 I realized that free block lists (free_list in BlockAlloc.c) get corrupted when multiple scavenge threads allocate and release blocks concurrently. Here's a picture of one such race: Thread 2 (Thread 32573.32601): #0 check_tail (bd=0x940d40 ) at rts/sm/BlockAlloc.c:860 #1 0x0000000000928ef7 in checkFreeListSanity () at rts/sm/BlockAlloc.c:896 #2 0x0000000000928979 in freeGroup (p=0x7e998ce02880) at rts/sm/BlockAlloc.c:721 #3 0x0000000000928a17 in freeChain (bd=0x7e998ce02880) at rts/sm/BlockAlloc.c:738 #4 0x0000000000926911 in freeChain_sync (bd=0x7e998ce02880) at rts/sm/GCUtils.c:80 #5 0x0000000000934720 in scavenge_capability_mut_lists (cap=0x1acae80) at rts/sm/Scav.c:1665 #6 0x000000000092b411 in gcWorkerThread (cap=0x1acae80) at rts/sm/GC.c:1157 #7 0x000000000090be9a in yieldCapability (pCap=0x7f9994e69e20, task=0x7e9984000b70, gcAllowed=true) at rts/Capability.c:861 #8 0x0000000000906120 in scheduleYield (pcap=0x7f9994e69e50, task=0x7e9984000b70) at rts/Schedule.c:673 #9 0x0000000000905500 in schedule (initialCapability=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:293 #10 0x0000000000908d4f in scheduleWorker (cap=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:2554 #11 0x000000000091a30a in workerStart (task=0x7e9984000b70) at rts/Task.c:444 #12 0x00007f99937fa6db in start_thread (arg=0x7f9994e6a700) at pthread_create.c:463 #13 0x000061654d59f88f in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:95 Thread 1 (Thread 32573.32573): #0 checkFreeListSanity () at rts/sm/BlockAlloc.c:887 #1 0x0000000000928979 in freeGroup (p=0x7e998d303540) at rts/sm/BlockAlloc.c:721 #2 0x0000000000926f23 in todo_block_full (size=513, ws=0x1aa8ce0) at rts/sm/GCUtils.c:264 #3 0x00000000009583b9 in alloc_for_copy (size=513, gen_no=0) at rts/sm/Evac.c:80 #4 0x000000000095850d in copy_tag_nolock (p=0x7e998c675f28, info=0x421d98 , src=0x7e998d075d80, size=513, gen_no=0, tag=1) at rts/sm/Evac.c:153 #5 0x0000000000959177 in evacuate (p=0x7e998c675f28) at rts/sm/Evac.c:715 #6 0x0000000000932388 in scavenge_small_bitmap (p=0x7e998c675f28, size=1, bitmap=0) at rts/sm/Scav.c:271 #7 0x0000000000934aaf in scavenge_stack (p=0x7e998c675f28, stack_end=0x7e998c676000) at rts/sm/Scav.c:1908 #8 0x0000000000934295 in scavenge_one (p=0x7e998c66e000) at rts/sm/Scav.c:1466 #9 0x0000000000934662 in scavenge_mutable_list (bd=0x7e998d300440, gen=0x1b1d880) at rts/sm/Scav.c:1643 #10 0x0000000000934700 in scavenge_capability_mut_lists (cap=0x1aaa340) at rts/sm/Scav.c:1664 #11 0x00000000009299b6 in GarbageCollect (collect_gen=0, do_heap_census=false, gc_type=2, cap=0x1aaa340, idle_cap=0x1b38aa0) at rts/sm/GC.c:378 #12 0x0000000000907a4a in scheduleDoGC (pcap=0x7ffdec5b5310, task=0x1b36650, force_major=false) at rts/Schedule.c:1798 #13 0x0000000000905de7 in schedule (initialCapability=0x1aaa340, task=0x1b36650) at rts/Schedule.c:546 #14 0x0000000000908bc4 in scheduleWaitThread (tso=0x7e998c0067c8, ret=0x0, pcap=0x7ffdec5b5430) at rts/Schedule.c:2537 #15 0x000000000091b5a0 in rts_evalLazyIO (cap=0x7ffdec5b5430, p=0x9c11f0, ret=0x0) at rts/RtsAPI.c:530 #16 0x000000000091ca56 in hs_main (argc=1, argv=0x7ffdec5b5628, main_closure=0x9c11f0, rts_config=...) at rts/RtsMain.c:72 #17 0x0000000000421ea0 in main () In particular, dbl_link_onto() which is used to add a freed block to a doubly-linked free list is not thread safe and corrupts the list when called concurrently. Note that thread 1 is to blame here as thread 2 is properly taking the spinlock. With this patch we now take the spinlock when freeing a todo block in GC, avoiding this race. Test Plan: - Tried slow validate locally: this patch does not introduce new failures. - circleci: https://circleci.com/gh/ghc/ghc-diffs/283 The test got killed because it took 5 hours but T7919 (which was previously failing on circleci) passed. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15285 Differential Revision: https://phabricator.haskell.org/D5115 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:53:31 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:53:31 -0000 Subject: [GHC] #11: No error from --make -o out when no main In-Reply-To: <042.0dc32cc82542de83e63c07b7c50ba1dd@haskell.org> References: <042.0dc32cc82542de83e63c07b7c50ba1dd@haskell.org> Message-ID: <057.2a6c73212189419f564f136e63dda489@haskell.org> #11: No error from --make -o out when no main --------------------------------+---------------------- Reporter: rrt | Owner: simonmar Type: bug | Status: closed Priority: normal | Milestone: Component: None | Version: None Resolution: Fixed | Keywords: Type of failure: None/Unknown | --------------------------------+---------------------- Changes (by Ömer Sinan Ağacan ): * failure: => None/Unknown Comment: In [changeset:"c6fbac6a6a69a2f4be89701b2c386ae53214f9a3/ghc" c6fbac6/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c6fbac6a6a69a2f4be89701b2c386ae53214f9a3" Fix a race between GC threads in concurrent scavenging While debugging #15285 I realized that free block lists (free_list in BlockAlloc.c) get corrupted when multiple scavenge threads allocate and release blocks concurrently. Here's a picture of one such race: Thread 2 (Thread 32573.32601): #0 check_tail (bd=0x940d40 ) at rts/sm/BlockAlloc.c:860 #1 0x0000000000928ef7 in checkFreeListSanity () at rts/sm/BlockAlloc.c:896 #2 0x0000000000928979 in freeGroup (p=0x7e998ce02880) at rts/sm/BlockAlloc.c:721 #3 0x0000000000928a17 in freeChain (bd=0x7e998ce02880) at rts/sm/BlockAlloc.c:738 #4 0x0000000000926911 in freeChain_sync (bd=0x7e998ce02880) at rts/sm/GCUtils.c:80 #5 0x0000000000934720 in scavenge_capability_mut_lists (cap=0x1acae80) at rts/sm/Scav.c:1665 #6 0x000000000092b411 in gcWorkerThread (cap=0x1acae80) at rts/sm/GC.c:1157 #7 0x000000000090be9a in yieldCapability (pCap=0x7f9994e69e20, task=0x7e9984000b70, gcAllowed=true) at rts/Capability.c:861 #8 0x0000000000906120 in scheduleYield (pcap=0x7f9994e69e50, task=0x7e9984000b70) at rts/Schedule.c:673 #9 0x0000000000905500 in schedule (initialCapability=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:293 #10 0x0000000000908d4f in scheduleWorker (cap=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:2554 #11 0x000000000091a30a in workerStart (task=0x7e9984000b70) at rts/Task.c:444 #12 0x00007f99937fa6db in start_thread (arg=0x7f9994e6a700) at pthread_create.c:463 #13 0x000061654d59f88f in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:95 Thread 1 (Thread 32573.32573): #0 checkFreeListSanity () at rts/sm/BlockAlloc.c:887 #1 0x0000000000928979 in freeGroup (p=0x7e998d303540) at rts/sm/BlockAlloc.c:721 #2 0x0000000000926f23 in todo_block_full (size=513, ws=0x1aa8ce0) at rts/sm/GCUtils.c:264 #3 0x00000000009583b9 in alloc_for_copy (size=513, gen_no=0) at rts/sm/Evac.c:80 #4 0x000000000095850d in copy_tag_nolock (p=0x7e998c675f28, info=0x421d98 , src=0x7e998d075d80, size=513, gen_no=0, tag=1) at rts/sm/Evac.c:153 #5 0x0000000000959177 in evacuate (p=0x7e998c675f28) at rts/sm/Evac.c:715 #6 0x0000000000932388 in scavenge_small_bitmap (p=0x7e998c675f28, size=1, bitmap=0) at rts/sm/Scav.c:271 #7 0x0000000000934aaf in scavenge_stack (p=0x7e998c675f28, stack_end=0x7e998c676000) at rts/sm/Scav.c:1908 #8 0x0000000000934295 in scavenge_one (p=0x7e998c66e000) at rts/sm/Scav.c:1466 #9 0x0000000000934662 in scavenge_mutable_list (bd=0x7e998d300440, gen=0x1b1d880) at rts/sm/Scav.c:1643 #10 0x0000000000934700 in scavenge_capability_mut_lists (cap=0x1aaa340) at rts/sm/Scav.c:1664 #11 0x00000000009299b6 in GarbageCollect (collect_gen=0, do_heap_census=false, gc_type=2, cap=0x1aaa340, idle_cap=0x1b38aa0) at rts/sm/GC.c:378 #12 0x0000000000907a4a in scheduleDoGC (pcap=0x7ffdec5b5310, task=0x1b36650, force_major=false) at rts/Schedule.c:1798 #13 0x0000000000905de7 in schedule (initialCapability=0x1aaa340, task=0x1b36650) at rts/Schedule.c:546 #14 0x0000000000908bc4 in scheduleWaitThread (tso=0x7e998c0067c8, ret=0x0, pcap=0x7ffdec5b5430) at rts/Schedule.c:2537 #15 0x000000000091b5a0 in rts_evalLazyIO (cap=0x7ffdec5b5430, p=0x9c11f0, ret=0x0) at rts/RtsAPI.c:530 #16 0x000000000091ca56 in hs_main (argc=1, argv=0x7ffdec5b5628, main_closure=0x9c11f0, rts_config=...) at rts/RtsMain.c:72 #17 0x0000000000421ea0 in main () In particular, dbl_link_onto() which is used to add a freed block to a doubly-linked free list is not thread safe and corrupts the list when called concurrently. Note that thread 1 is to blame here as thread 2 is properly taking the spinlock. With this patch we now take the spinlock when freeing a todo block in GC, avoiding this race. Test Plan: - Tried slow validate locally: this patch does not introduce new failures. - circleci: https://circleci.com/gh/ghc/ghc-diffs/283 The test got killed because it took 5 hours but T7919 (which was previously failing on circleci) passed. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15285 Differential Revision: https://phabricator.haskell.org/D5115 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:53:31 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:53:31 -0000 Subject: [GHC] #12: Function missing ? In-Reply-To: <045.4cc02afd3bd6ef826554d7c49c991bda@haskell.org> References: <045.4cc02afd3bd6ef826554d7c49c991bda@haskell.org> Message-ID: <060.ebe1163e40af6e7bfe151fb09b52127e@haskell.org> #12: Function missing ? --------------------------------+-------------------- Reporter: nobody | Owner: nobody Type: bug | Status: closed Priority: normal | Milestone: Component: hslibs/net | Version: 5.02 Resolution: Fixed | Keywords: Type of failure: None/Unknown | --------------------------------+-------------------- Changes (by Ömer Sinan Ağacan ): * failure: => None/Unknown Comment: In [changeset:"c6fbac6a6a69a2f4be89701b2c386ae53214f9a3/ghc" c6fbac6/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c6fbac6a6a69a2f4be89701b2c386ae53214f9a3" Fix a race between GC threads in concurrent scavenging While debugging #15285 I realized that free block lists (free_list in BlockAlloc.c) get corrupted when multiple scavenge threads allocate and release blocks concurrently. Here's a picture of one such race: Thread 2 (Thread 32573.32601): #0 check_tail (bd=0x940d40 ) at rts/sm/BlockAlloc.c:860 #1 0x0000000000928ef7 in checkFreeListSanity () at rts/sm/BlockAlloc.c:896 #2 0x0000000000928979 in freeGroup (p=0x7e998ce02880) at rts/sm/BlockAlloc.c:721 #3 0x0000000000928a17 in freeChain (bd=0x7e998ce02880) at rts/sm/BlockAlloc.c:738 #4 0x0000000000926911 in freeChain_sync (bd=0x7e998ce02880) at rts/sm/GCUtils.c:80 #5 0x0000000000934720 in scavenge_capability_mut_lists (cap=0x1acae80) at rts/sm/Scav.c:1665 #6 0x000000000092b411 in gcWorkerThread (cap=0x1acae80) at rts/sm/GC.c:1157 #7 0x000000000090be9a in yieldCapability (pCap=0x7f9994e69e20, task=0x7e9984000b70, gcAllowed=true) at rts/Capability.c:861 #8 0x0000000000906120 in scheduleYield (pcap=0x7f9994e69e50, task=0x7e9984000b70) at rts/Schedule.c:673 #9 0x0000000000905500 in schedule (initialCapability=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:293 #10 0x0000000000908d4f in scheduleWorker (cap=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:2554 #11 0x000000000091a30a in workerStart (task=0x7e9984000b70) at rts/Task.c:444 #12 0x00007f99937fa6db in start_thread (arg=0x7f9994e6a700) at pthread_create.c:463 #13 0x000061654d59f88f in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:95 Thread 1 (Thread 32573.32573): #0 checkFreeListSanity () at rts/sm/BlockAlloc.c:887 #1 0x0000000000928979 in freeGroup (p=0x7e998d303540) at rts/sm/BlockAlloc.c:721 #2 0x0000000000926f23 in todo_block_full (size=513, ws=0x1aa8ce0) at rts/sm/GCUtils.c:264 #3 0x00000000009583b9 in alloc_for_copy (size=513, gen_no=0) at rts/sm/Evac.c:80 #4 0x000000000095850d in copy_tag_nolock (p=0x7e998c675f28, info=0x421d98 , src=0x7e998d075d80, size=513, gen_no=0, tag=1) at rts/sm/Evac.c:153 #5 0x0000000000959177 in evacuate (p=0x7e998c675f28) at rts/sm/Evac.c:715 #6 0x0000000000932388 in scavenge_small_bitmap (p=0x7e998c675f28, size=1, bitmap=0) at rts/sm/Scav.c:271 #7 0x0000000000934aaf in scavenge_stack (p=0x7e998c675f28, stack_end=0x7e998c676000) at rts/sm/Scav.c:1908 #8 0x0000000000934295 in scavenge_one (p=0x7e998c66e000) at rts/sm/Scav.c:1466 #9 0x0000000000934662 in scavenge_mutable_list (bd=0x7e998d300440, gen=0x1b1d880) at rts/sm/Scav.c:1643 #10 0x0000000000934700 in scavenge_capability_mut_lists (cap=0x1aaa340) at rts/sm/Scav.c:1664 #11 0x00000000009299b6 in GarbageCollect (collect_gen=0, do_heap_census=false, gc_type=2, cap=0x1aaa340, idle_cap=0x1b38aa0) at rts/sm/GC.c:378 #12 0x0000000000907a4a in scheduleDoGC (pcap=0x7ffdec5b5310, task=0x1b36650, force_major=false) at rts/Schedule.c:1798 #13 0x0000000000905de7 in schedule (initialCapability=0x1aaa340, task=0x1b36650) at rts/Schedule.c:546 #14 0x0000000000908bc4 in scheduleWaitThread (tso=0x7e998c0067c8, ret=0x0, pcap=0x7ffdec5b5430) at rts/Schedule.c:2537 #15 0x000000000091b5a0 in rts_evalLazyIO (cap=0x7ffdec5b5430, p=0x9c11f0, ret=0x0) at rts/RtsAPI.c:530 #16 0x000000000091ca56 in hs_main (argc=1, argv=0x7ffdec5b5628, main_closure=0x9c11f0, rts_config=...) at rts/RtsMain.c:72 #17 0x0000000000421ea0 in main () In particular, dbl_link_onto() which is used to add a freed block to a doubly-linked free list is not thread safe and corrupts the list when called concurrently. Note that thread 1 is to blame here as thread 2 is properly taking the spinlock. With this patch we now take the spinlock when freeing a todo block in GC, avoiding this race. Test Plan: - Tried slow validate locally: this patch does not introduce new failures. - circleci: https://circleci.com/gh/ghc/ghc-diffs/283 The test got killed because it took 5 hours but T7919 (which was previously failing on circleci) passed. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15285 Differential Revision: https://phabricator.haskell.org/D5115 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:53:31 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:53:31 -0000 Subject: [GHC] #13: ghc 5.02 trats import hiding wrong In-Reply-To: <045.043dfb7e53f7600f085e664dbb9e5f7b@haskell.org> References: <045.043dfb7e53f7600f085e664dbb9e5f7b@haskell.org> Message-ID: <060.382d1ce3f042f6a621ba0a4959339fdb@haskell.org> #13: ghc 5.02 trats import hiding wrong --------------------------------+-------------------- Reporter: norpan | Owner: nobody Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 5.02 Resolution: None | Keywords: Type of failure: None/Unknown | --------------------------------+-------------------- Changes (by Ömer Sinan Ağacan ): * failure: => None/Unknown Comment: In [changeset:"c6fbac6a6a69a2f4be89701b2c386ae53214f9a3/ghc" c6fbac6/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c6fbac6a6a69a2f4be89701b2c386ae53214f9a3" Fix a race between GC threads in concurrent scavenging While debugging #15285 I realized that free block lists (free_list in BlockAlloc.c) get corrupted when multiple scavenge threads allocate and release blocks concurrently. Here's a picture of one such race: Thread 2 (Thread 32573.32601): #0 check_tail (bd=0x940d40 ) at rts/sm/BlockAlloc.c:860 #1 0x0000000000928ef7 in checkFreeListSanity () at rts/sm/BlockAlloc.c:896 #2 0x0000000000928979 in freeGroup (p=0x7e998ce02880) at rts/sm/BlockAlloc.c:721 #3 0x0000000000928a17 in freeChain (bd=0x7e998ce02880) at rts/sm/BlockAlloc.c:738 #4 0x0000000000926911 in freeChain_sync (bd=0x7e998ce02880) at rts/sm/GCUtils.c:80 #5 0x0000000000934720 in scavenge_capability_mut_lists (cap=0x1acae80) at rts/sm/Scav.c:1665 #6 0x000000000092b411 in gcWorkerThread (cap=0x1acae80) at rts/sm/GC.c:1157 #7 0x000000000090be9a in yieldCapability (pCap=0x7f9994e69e20, task=0x7e9984000b70, gcAllowed=true) at rts/Capability.c:861 #8 0x0000000000906120 in scheduleYield (pcap=0x7f9994e69e50, task=0x7e9984000b70) at rts/Schedule.c:673 #9 0x0000000000905500 in schedule (initialCapability=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:293 #10 0x0000000000908d4f in scheduleWorker (cap=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:2554 #11 0x000000000091a30a in workerStart (task=0x7e9984000b70) at rts/Task.c:444 #12 0x00007f99937fa6db in start_thread (arg=0x7f9994e6a700) at pthread_create.c:463 #13 0x000061654d59f88f in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:95 Thread 1 (Thread 32573.32573): #0 checkFreeListSanity () at rts/sm/BlockAlloc.c:887 #1 0x0000000000928979 in freeGroup (p=0x7e998d303540) at rts/sm/BlockAlloc.c:721 #2 0x0000000000926f23 in todo_block_full (size=513, ws=0x1aa8ce0) at rts/sm/GCUtils.c:264 #3 0x00000000009583b9 in alloc_for_copy (size=513, gen_no=0) at rts/sm/Evac.c:80 #4 0x000000000095850d in copy_tag_nolock (p=0x7e998c675f28, info=0x421d98 , src=0x7e998d075d80, size=513, gen_no=0, tag=1) at rts/sm/Evac.c:153 #5 0x0000000000959177 in evacuate (p=0x7e998c675f28) at rts/sm/Evac.c:715 #6 0x0000000000932388 in scavenge_small_bitmap (p=0x7e998c675f28, size=1, bitmap=0) at rts/sm/Scav.c:271 #7 0x0000000000934aaf in scavenge_stack (p=0x7e998c675f28, stack_end=0x7e998c676000) at rts/sm/Scav.c:1908 #8 0x0000000000934295 in scavenge_one (p=0x7e998c66e000) at rts/sm/Scav.c:1466 #9 0x0000000000934662 in scavenge_mutable_list (bd=0x7e998d300440, gen=0x1b1d880) at rts/sm/Scav.c:1643 #10 0x0000000000934700 in scavenge_capability_mut_lists (cap=0x1aaa340) at rts/sm/Scav.c:1664 #11 0x00000000009299b6 in GarbageCollect (collect_gen=0, do_heap_census=false, gc_type=2, cap=0x1aaa340, idle_cap=0x1b38aa0) at rts/sm/GC.c:378 #12 0x0000000000907a4a in scheduleDoGC (pcap=0x7ffdec5b5310, task=0x1b36650, force_major=false) at rts/Schedule.c:1798 #13 0x0000000000905de7 in schedule (initialCapability=0x1aaa340, task=0x1b36650) at rts/Schedule.c:546 #14 0x0000000000908bc4 in scheduleWaitThread (tso=0x7e998c0067c8, ret=0x0, pcap=0x7ffdec5b5430) at rts/Schedule.c:2537 #15 0x000000000091b5a0 in rts_evalLazyIO (cap=0x7ffdec5b5430, p=0x9c11f0, ret=0x0) at rts/RtsAPI.c:530 #16 0x000000000091ca56 in hs_main (argc=1, argv=0x7ffdec5b5628, main_closure=0x9c11f0, rts_config=...) at rts/RtsMain.c:72 #17 0x0000000000421ea0 in main () In particular, dbl_link_onto() which is used to add a freed block to a doubly-linked free list is not thread safe and corrupts the list when called concurrently. Note that thread 1 is to blame here as thread 2 is properly taking the spinlock. With this patch we now take the spinlock when freeing a todo block in GC, avoiding this race. Test Plan: - Tried slow validate locally: this patch does not introduce new failures. - circleci: https://circleci.com/gh/ghc/ghc-diffs/283 The test got killed because it took 5 hours but T7919 (which was previously failing on circleci) passed. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15285 Differential Revision: https://phabricator.haskell.org/D5115 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:53:31 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:53:31 -0000 Subject: [GHC] #14: Case missing in garbage collector In-Reply-To: <045.191f7c95693a4e1b378b945872bb8d4e@haskell.org> References: <045.191f7c95693a4e1b378b945872bb8d4e@haskell.org> Message-ID: <060.a7aa3906e1b01288944d5afd1d7c6924@haskell.org> #14: Case missing in garbage collector ----------------------------------+---------------------- Reporter: josefs | Owner: simonmar Type: bug | Status: closed Priority: normal | Milestone: Component: Runtime System | Version: None Resolution: Fixed | Keywords: Type of failure: None/Unknown | ----------------------------------+---------------------- Changes (by Ömer Sinan Ağacan ): * failure: => None/Unknown Comment: In [changeset:"c6fbac6a6a69a2f4be89701b2c386ae53214f9a3/ghc" c6fbac6/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c6fbac6a6a69a2f4be89701b2c386ae53214f9a3" Fix a race between GC threads in concurrent scavenging While debugging #15285 I realized that free block lists (free_list in BlockAlloc.c) get corrupted when multiple scavenge threads allocate and release blocks concurrently. Here's a picture of one such race: Thread 2 (Thread 32573.32601): #0 check_tail (bd=0x940d40 ) at rts/sm/BlockAlloc.c:860 #1 0x0000000000928ef7 in checkFreeListSanity () at rts/sm/BlockAlloc.c:896 #2 0x0000000000928979 in freeGroup (p=0x7e998ce02880) at rts/sm/BlockAlloc.c:721 #3 0x0000000000928a17 in freeChain (bd=0x7e998ce02880) at rts/sm/BlockAlloc.c:738 #4 0x0000000000926911 in freeChain_sync (bd=0x7e998ce02880) at rts/sm/GCUtils.c:80 #5 0x0000000000934720 in scavenge_capability_mut_lists (cap=0x1acae80) at rts/sm/Scav.c:1665 #6 0x000000000092b411 in gcWorkerThread (cap=0x1acae80) at rts/sm/GC.c:1157 #7 0x000000000090be9a in yieldCapability (pCap=0x7f9994e69e20, task=0x7e9984000b70, gcAllowed=true) at rts/Capability.c:861 #8 0x0000000000906120 in scheduleYield (pcap=0x7f9994e69e50, task=0x7e9984000b70) at rts/Schedule.c:673 #9 0x0000000000905500 in schedule (initialCapability=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:293 #10 0x0000000000908d4f in scheduleWorker (cap=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:2554 #11 0x000000000091a30a in workerStart (task=0x7e9984000b70) at rts/Task.c:444 #12 0x00007f99937fa6db in start_thread (arg=0x7f9994e6a700) at pthread_create.c:463 #13 0x000061654d59f88f in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:95 Thread 1 (Thread 32573.32573): #0 checkFreeListSanity () at rts/sm/BlockAlloc.c:887 #1 0x0000000000928979 in freeGroup (p=0x7e998d303540) at rts/sm/BlockAlloc.c:721 #2 0x0000000000926f23 in todo_block_full (size=513, ws=0x1aa8ce0) at rts/sm/GCUtils.c:264 #3 0x00000000009583b9 in alloc_for_copy (size=513, gen_no=0) at rts/sm/Evac.c:80 #4 0x000000000095850d in copy_tag_nolock (p=0x7e998c675f28, info=0x421d98 , src=0x7e998d075d80, size=513, gen_no=0, tag=1) at rts/sm/Evac.c:153 #5 0x0000000000959177 in evacuate (p=0x7e998c675f28) at rts/sm/Evac.c:715 #6 0x0000000000932388 in scavenge_small_bitmap (p=0x7e998c675f28, size=1, bitmap=0) at rts/sm/Scav.c:271 #7 0x0000000000934aaf in scavenge_stack (p=0x7e998c675f28, stack_end=0x7e998c676000) at rts/sm/Scav.c:1908 #8 0x0000000000934295 in scavenge_one (p=0x7e998c66e000) at rts/sm/Scav.c:1466 #9 0x0000000000934662 in scavenge_mutable_list (bd=0x7e998d300440, gen=0x1b1d880) at rts/sm/Scav.c:1643 #10 0x0000000000934700 in scavenge_capability_mut_lists (cap=0x1aaa340) at rts/sm/Scav.c:1664 #11 0x00000000009299b6 in GarbageCollect (collect_gen=0, do_heap_census=false, gc_type=2, cap=0x1aaa340, idle_cap=0x1b38aa0) at rts/sm/GC.c:378 #12 0x0000000000907a4a in scheduleDoGC (pcap=0x7ffdec5b5310, task=0x1b36650, force_major=false) at rts/Schedule.c:1798 #13 0x0000000000905de7 in schedule (initialCapability=0x1aaa340, task=0x1b36650) at rts/Schedule.c:546 #14 0x0000000000908bc4 in scheduleWaitThread (tso=0x7e998c0067c8, ret=0x0, pcap=0x7ffdec5b5430) at rts/Schedule.c:2537 #15 0x000000000091b5a0 in rts_evalLazyIO (cap=0x7ffdec5b5430, p=0x9c11f0, ret=0x0) at rts/RtsAPI.c:530 #16 0x000000000091ca56 in hs_main (argc=1, argv=0x7ffdec5b5628, main_closure=0x9c11f0, rts_config=...) at rts/RtsMain.c:72 #17 0x0000000000421ea0 in main () In particular, dbl_link_onto() which is used to add a freed block to a doubly-linked free list is not thread safe and corrupts the list when called concurrently. Note that thread 1 is to blame here as thread 2 is properly taking the spinlock. With this patch we now take the spinlock when freeing a todo block in GC, avoiding this race. Test Plan: - Tried slow validate locally: this patch does not introduce new failures. - circleci: https://circleci.com/gh/ghc/ghc-diffs/283 The test got killed because it took 5 hours but T7919 (which was previously failing on circleci) passed. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15285 Differential Revision: https://phabricator.haskell.org/D5115 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:53:31 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:53:31 -0000 Subject: [GHC] #15: Minor Posix.getEffectiveUserID doc-bug In-Reply-To: <047.80c31a3e36ec625145b19607d2edd66a@haskell.org> References: <047.80c31a3e36ec625145b19607d2edd66a@haskell.org> Message-ID: <062.14aade10ffb27f679c87371fe2e01f19@haskell.org> #15: Minor Posix.getEffectiveUserID doc-bug ---------------------------------+-------------------- Reporter: volkersf | Owner: nobody Type: bug | Status: closed Priority: normal | Milestone: Component: Documentation | Version: 5.02 Resolution: Fixed | Keywords: Type of failure: None/Unknown | ---------------------------------+-------------------- Changes (by Ömer Sinan Ağacan ): * failure: => None/Unknown Comment: In [changeset:"c6fbac6a6a69a2f4be89701b2c386ae53214f9a3/ghc" c6fbac6/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c6fbac6a6a69a2f4be89701b2c386ae53214f9a3" Fix a race between GC threads in concurrent scavenging While debugging #15285 I realized that free block lists (free_list in BlockAlloc.c) get corrupted when multiple scavenge threads allocate and release blocks concurrently. Here's a picture of one such race: Thread 2 (Thread 32573.32601): #0 check_tail (bd=0x940d40 ) at rts/sm/BlockAlloc.c:860 #1 0x0000000000928ef7 in checkFreeListSanity () at rts/sm/BlockAlloc.c:896 #2 0x0000000000928979 in freeGroup (p=0x7e998ce02880) at rts/sm/BlockAlloc.c:721 #3 0x0000000000928a17 in freeChain (bd=0x7e998ce02880) at rts/sm/BlockAlloc.c:738 #4 0x0000000000926911 in freeChain_sync (bd=0x7e998ce02880) at rts/sm/GCUtils.c:80 #5 0x0000000000934720 in scavenge_capability_mut_lists (cap=0x1acae80) at rts/sm/Scav.c:1665 #6 0x000000000092b411 in gcWorkerThread (cap=0x1acae80) at rts/sm/GC.c:1157 #7 0x000000000090be9a in yieldCapability (pCap=0x7f9994e69e20, task=0x7e9984000b70, gcAllowed=true) at rts/Capability.c:861 #8 0x0000000000906120 in scheduleYield (pcap=0x7f9994e69e50, task=0x7e9984000b70) at rts/Schedule.c:673 #9 0x0000000000905500 in schedule (initialCapability=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:293 #10 0x0000000000908d4f in scheduleWorker (cap=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:2554 #11 0x000000000091a30a in workerStart (task=0x7e9984000b70) at rts/Task.c:444 #12 0x00007f99937fa6db in start_thread (arg=0x7f9994e6a700) at pthread_create.c:463 #13 0x000061654d59f88f in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:95 Thread 1 (Thread 32573.32573): #0 checkFreeListSanity () at rts/sm/BlockAlloc.c:887 #1 0x0000000000928979 in freeGroup (p=0x7e998d303540) at rts/sm/BlockAlloc.c:721 #2 0x0000000000926f23 in todo_block_full (size=513, ws=0x1aa8ce0) at rts/sm/GCUtils.c:264 #3 0x00000000009583b9 in alloc_for_copy (size=513, gen_no=0) at rts/sm/Evac.c:80 #4 0x000000000095850d in copy_tag_nolock (p=0x7e998c675f28, info=0x421d98 , src=0x7e998d075d80, size=513, gen_no=0, tag=1) at rts/sm/Evac.c:153 #5 0x0000000000959177 in evacuate (p=0x7e998c675f28) at rts/sm/Evac.c:715 #6 0x0000000000932388 in scavenge_small_bitmap (p=0x7e998c675f28, size=1, bitmap=0) at rts/sm/Scav.c:271 #7 0x0000000000934aaf in scavenge_stack (p=0x7e998c675f28, stack_end=0x7e998c676000) at rts/sm/Scav.c:1908 #8 0x0000000000934295 in scavenge_one (p=0x7e998c66e000) at rts/sm/Scav.c:1466 #9 0x0000000000934662 in scavenge_mutable_list (bd=0x7e998d300440, gen=0x1b1d880) at rts/sm/Scav.c:1643 #10 0x0000000000934700 in scavenge_capability_mut_lists (cap=0x1aaa340) at rts/sm/Scav.c:1664 #11 0x00000000009299b6 in GarbageCollect (collect_gen=0, do_heap_census=false, gc_type=2, cap=0x1aaa340, idle_cap=0x1b38aa0) at rts/sm/GC.c:378 #12 0x0000000000907a4a in scheduleDoGC (pcap=0x7ffdec5b5310, task=0x1b36650, force_major=false) at rts/Schedule.c:1798 #13 0x0000000000905de7 in schedule (initialCapability=0x1aaa340, task=0x1b36650) at rts/Schedule.c:546 #14 0x0000000000908bc4 in scheduleWaitThread (tso=0x7e998c0067c8, ret=0x0, pcap=0x7ffdec5b5430) at rts/Schedule.c:2537 #15 0x000000000091b5a0 in rts_evalLazyIO (cap=0x7ffdec5b5430, p=0x9c11f0, ret=0x0) at rts/RtsAPI.c:530 #16 0x000000000091ca56 in hs_main (argc=1, argv=0x7ffdec5b5628, main_closure=0x9c11f0, rts_config=...) at rts/RtsMain.c:72 #17 0x0000000000421ea0 in main () In particular, dbl_link_onto() which is used to add a freed block to a doubly-linked free list is not thread safe and corrupts the list when called concurrently. Note that thread 1 is to blame here as thread 2 is properly taking the spinlock. With this patch we now take the spinlock when freeing a todo block in GC, avoiding this race. Test Plan: - Tried slow validate locally: this patch does not introduce new failures. - circleci: https://circleci.com/gh/ghc/ghc-diffs/283 The test got killed because it took 5 hours but T7919 (which was previously failing on circleci) passed. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15285 Differential Revision: https://phabricator.haskell.org/D5115 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:53:31 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:53:31 -0000 Subject: [GHC] #16: Extensionsflags In-Reply-To: <045.f57ba223861cb8a04990b31a48c514f4@haskell.org> References: <045.f57ba223861cb8a04990b31a48c514f4@haskell.org> Message-ID: <060.4c8e909cff232a2f5057ef99a4489ce4@haskell.org> #16: Extensionsflags -------------------------------------+--------------------------------- Reporter: axelkr | Owner: igloo Type: feature request | Status: closed Priority: normal | Milestone: 6.8.1 Component: Compiler | Version: None Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Unknown/Multiple Type of failure: None/Unknown | Test Case: -------------------------------------+--------------------------------- Changes (by Ömer Sinan Ağacan ): * failure: => None/Unknown Comment: In [changeset:"c6fbac6a6a69a2f4be89701b2c386ae53214f9a3/ghc" c6fbac6/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c6fbac6a6a69a2f4be89701b2c386ae53214f9a3" Fix a race between GC threads in concurrent scavenging While debugging #15285 I realized that free block lists (free_list in BlockAlloc.c) get corrupted when multiple scavenge threads allocate and release blocks concurrently. Here's a picture of one such race: Thread 2 (Thread 32573.32601): #0 check_tail (bd=0x940d40 ) at rts/sm/BlockAlloc.c:860 #1 0x0000000000928ef7 in checkFreeListSanity () at rts/sm/BlockAlloc.c:896 #2 0x0000000000928979 in freeGroup (p=0x7e998ce02880) at rts/sm/BlockAlloc.c:721 #3 0x0000000000928a17 in freeChain (bd=0x7e998ce02880) at rts/sm/BlockAlloc.c:738 #4 0x0000000000926911 in freeChain_sync (bd=0x7e998ce02880) at rts/sm/GCUtils.c:80 #5 0x0000000000934720 in scavenge_capability_mut_lists (cap=0x1acae80) at rts/sm/Scav.c:1665 #6 0x000000000092b411 in gcWorkerThread (cap=0x1acae80) at rts/sm/GC.c:1157 #7 0x000000000090be9a in yieldCapability (pCap=0x7f9994e69e20, task=0x7e9984000b70, gcAllowed=true) at rts/Capability.c:861 #8 0x0000000000906120 in scheduleYield (pcap=0x7f9994e69e50, task=0x7e9984000b70) at rts/Schedule.c:673 #9 0x0000000000905500 in schedule (initialCapability=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:293 #10 0x0000000000908d4f in scheduleWorker (cap=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:2554 #11 0x000000000091a30a in workerStart (task=0x7e9984000b70) at rts/Task.c:444 #12 0x00007f99937fa6db in start_thread (arg=0x7f9994e6a700) at pthread_create.c:463 #13 0x000061654d59f88f in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:95 Thread 1 (Thread 32573.32573): #0 checkFreeListSanity () at rts/sm/BlockAlloc.c:887 #1 0x0000000000928979 in freeGroup (p=0x7e998d303540) at rts/sm/BlockAlloc.c:721 #2 0x0000000000926f23 in todo_block_full (size=513, ws=0x1aa8ce0) at rts/sm/GCUtils.c:264 #3 0x00000000009583b9 in alloc_for_copy (size=513, gen_no=0) at rts/sm/Evac.c:80 #4 0x000000000095850d in copy_tag_nolock (p=0x7e998c675f28, info=0x421d98 , src=0x7e998d075d80, size=513, gen_no=0, tag=1) at rts/sm/Evac.c:153 #5 0x0000000000959177 in evacuate (p=0x7e998c675f28) at rts/sm/Evac.c:715 #6 0x0000000000932388 in scavenge_small_bitmap (p=0x7e998c675f28, size=1, bitmap=0) at rts/sm/Scav.c:271 #7 0x0000000000934aaf in scavenge_stack (p=0x7e998c675f28, stack_end=0x7e998c676000) at rts/sm/Scav.c:1908 #8 0x0000000000934295 in scavenge_one (p=0x7e998c66e000) at rts/sm/Scav.c:1466 #9 0x0000000000934662 in scavenge_mutable_list (bd=0x7e998d300440, gen=0x1b1d880) at rts/sm/Scav.c:1643 #10 0x0000000000934700 in scavenge_capability_mut_lists (cap=0x1aaa340) at rts/sm/Scav.c:1664 #11 0x00000000009299b6 in GarbageCollect (collect_gen=0, do_heap_census=false, gc_type=2, cap=0x1aaa340, idle_cap=0x1b38aa0) at rts/sm/GC.c:378 #12 0x0000000000907a4a in scheduleDoGC (pcap=0x7ffdec5b5310, task=0x1b36650, force_major=false) at rts/Schedule.c:1798 #13 0x0000000000905de7 in schedule (initialCapability=0x1aaa340, task=0x1b36650) at rts/Schedule.c:546 #14 0x0000000000908bc4 in scheduleWaitThread (tso=0x7e998c0067c8, ret=0x0, pcap=0x7ffdec5b5430) at rts/Schedule.c:2537 #15 0x000000000091b5a0 in rts_evalLazyIO (cap=0x7ffdec5b5430, p=0x9c11f0, ret=0x0) at rts/RtsAPI.c:530 #16 0x000000000091ca56 in hs_main (argc=1, argv=0x7ffdec5b5628, main_closure=0x9c11f0, rts_config=...) at rts/RtsMain.c:72 #17 0x0000000000421ea0 in main () In particular, dbl_link_onto() which is used to add a freed block to a doubly-linked free list is not thread safe and corrupts the list when called concurrently. Note that thread 1 is to blame here as thread 2 is properly taking the spinlock. With this patch we now take the spinlock when freeing a todo block in GC, avoiding this race. Test Plan: - Tried slow validate locally: this patch does not introduce new failures. - circleci: https://circleci.com/gh/ghc/ghc-diffs/283 The test got killed because it took 5 hours but T7919 (which was previously failing on circleci) passed. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15285 Differential Revision: https://phabricator.haskell.org/D5115 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:53:31 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:53:31 -0000 Subject: [GHC] #15285: "strange closure type" in T7919 with the threaded2 way In-Reply-To: <048.67a85438785d72c47b85ee0ad004eab2@haskell.org> References: <048.67a85438785d72c47b85ee0ad004eab2@haskell.org> Message-ID: <063.d73fda67dbf31080061ce50ed714d615@haskell.org> #15285: "strange closure type" in T7919 with the threaded2 way -------------------------------------+------------------------------------- Reporter: alpmestan | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Runtime System | Version: 8.5 Resolution: | Keywords: Operating System: Linux | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: T7919 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5115 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ömer Sinan Ağacan ): In [changeset:"c6fbac6a6a69a2f4be89701b2c386ae53214f9a3/ghc" c6fbac6/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c6fbac6a6a69a2f4be89701b2c386ae53214f9a3" Fix a race between GC threads in concurrent scavenging While debugging #15285 I realized that free block lists (free_list in BlockAlloc.c) get corrupted when multiple scavenge threads allocate and release blocks concurrently. Here's a picture of one such race: Thread 2 (Thread 32573.32601): #0 check_tail (bd=0x940d40 ) at rts/sm/BlockAlloc.c:860 #1 0x0000000000928ef7 in checkFreeListSanity () at rts/sm/BlockAlloc.c:896 #2 0x0000000000928979 in freeGroup (p=0x7e998ce02880) at rts/sm/BlockAlloc.c:721 #3 0x0000000000928a17 in freeChain (bd=0x7e998ce02880) at rts/sm/BlockAlloc.c:738 #4 0x0000000000926911 in freeChain_sync (bd=0x7e998ce02880) at rts/sm/GCUtils.c:80 #5 0x0000000000934720 in scavenge_capability_mut_lists (cap=0x1acae80) at rts/sm/Scav.c:1665 #6 0x000000000092b411 in gcWorkerThread (cap=0x1acae80) at rts/sm/GC.c:1157 #7 0x000000000090be9a in yieldCapability (pCap=0x7f9994e69e20, task=0x7e9984000b70, gcAllowed=true) at rts/Capability.c:861 #8 0x0000000000906120 in scheduleYield (pcap=0x7f9994e69e50, task=0x7e9984000b70) at rts/Schedule.c:673 #9 0x0000000000905500 in schedule (initialCapability=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:293 #10 0x0000000000908d4f in scheduleWorker (cap=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:2554 #11 0x000000000091a30a in workerStart (task=0x7e9984000b70) at rts/Task.c:444 #12 0x00007f99937fa6db in start_thread (arg=0x7f9994e6a700) at pthread_create.c:463 #13 0x000061654d59f88f in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:95 Thread 1 (Thread 32573.32573): #0 checkFreeListSanity () at rts/sm/BlockAlloc.c:887 #1 0x0000000000928979 in freeGroup (p=0x7e998d303540) at rts/sm/BlockAlloc.c:721 #2 0x0000000000926f23 in todo_block_full (size=513, ws=0x1aa8ce0) at rts/sm/GCUtils.c:264 #3 0x00000000009583b9 in alloc_for_copy (size=513, gen_no=0) at rts/sm/Evac.c:80 #4 0x000000000095850d in copy_tag_nolock (p=0x7e998c675f28, info=0x421d98 , src=0x7e998d075d80, size=513, gen_no=0, tag=1) at rts/sm/Evac.c:153 #5 0x0000000000959177 in evacuate (p=0x7e998c675f28) at rts/sm/Evac.c:715 #6 0x0000000000932388 in scavenge_small_bitmap (p=0x7e998c675f28, size=1, bitmap=0) at rts/sm/Scav.c:271 #7 0x0000000000934aaf in scavenge_stack (p=0x7e998c675f28, stack_end=0x7e998c676000) at rts/sm/Scav.c:1908 #8 0x0000000000934295 in scavenge_one (p=0x7e998c66e000) at rts/sm/Scav.c:1466 #9 0x0000000000934662 in scavenge_mutable_list (bd=0x7e998d300440, gen=0x1b1d880) at rts/sm/Scav.c:1643 #10 0x0000000000934700 in scavenge_capability_mut_lists (cap=0x1aaa340) at rts/sm/Scav.c:1664 #11 0x00000000009299b6 in GarbageCollect (collect_gen=0, do_heap_census=false, gc_type=2, cap=0x1aaa340, idle_cap=0x1b38aa0) at rts/sm/GC.c:378 #12 0x0000000000907a4a in scheduleDoGC (pcap=0x7ffdec5b5310, task=0x1b36650, force_major=false) at rts/Schedule.c:1798 #13 0x0000000000905de7 in schedule (initialCapability=0x1aaa340, task=0x1b36650) at rts/Schedule.c:546 #14 0x0000000000908bc4 in scheduleWaitThread (tso=0x7e998c0067c8, ret=0x0, pcap=0x7ffdec5b5430) at rts/Schedule.c:2537 #15 0x000000000091b5a0 in rts_evalLazyIO (cap=0x7ffdec5b5430, p=0x9c11f0, ret=0x0) at rts/RtsAPI.c:530 #16 0x000000000091ca56 in hs_main (argc=1, argv=0x7ffdec5b5628, main_closure=0x9c11f0, rts_config=...) at rts/RtsMain.c:72 #17 0x0000000000421ea0 in main () In particular, dbl_link_onto() which is used to add a freed block to a doubly-linked free list is not thread safe and corrupts the list when called concurrently. Note that thread 1 is to blame here as thread 2 is properly taking the spinlock. With this patch we now take the spinlock when freeing a todo block in GC, avoiding this race. Test Plan: - Tried slow validate locally: this patch does not introduce new failures. - circleci: https://circleci.com/gh/ghc/ghc-diffs/283 The test got killed because it took 5 hours but T7919 (which was previously failing on circleci) passed. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15285 Differential Revision: https://phabricator.haskell.org/D5115 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:53:31 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:53:31 -0000 Subject: [GHC] #17: Separate warnings for unused local and top-level bindings In-Reply-To: <047.fe4cdb312b5d86f34d27df1115f2c91a@haskell.org> References: <047.fe4cdb312b5d86f34d27df1115f2c91a@haskell.org> Message-ID: <062.6ef61b8d413fdb9abd86d91170553db0@haskell.org> #17: Separate warnings for unused local and top-level bindings -------------------------------------+------------------------------------- Reporter: magunter | Owner: (none) Type: feature request | Status: closed Priority: lowest | Milestone: 8.0.1 Component: Compiler | Version: None Resolution: fixed | Keywords: -fwarn- | unused-binds newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #3283 | Differential Rev(s): Phab:D591 -------------------------------------+------------------------------------- Comment (by Ömer Sinan Ağacan ): In [changeset:"c6fbac6a6a69a2f4be89701b2c386ae53214f9a3/ghc" c6fbac6/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c6fbac6a6a69a2f4be89701b2c386ae53214f9a3" Fix a race between GC threads in concurrent scavenging While debugging #15285 I realized that free block lists (free_list in BlockAlloc.c) get corrupted when multiple scavenge threads allocate and release blocks concurrently. Here's a picture of one such race: Thread 2 (Thread 32573.32601): #0 check_tail (bd=0x940d40 ) at rts/sm/BlockAlloc.c:860 #1 0x0000000000928ef7 in checkFreeListSanity () at rts/sm/BlockAlloc.c:896 #2 0x0000000000928979 in freeGroup (p=0x7e998ce02880) at rts/sm/BlockAlloc.c:721 #3 0x0000000000928a17 in freeChain (bd=0x7e998ce02880) at rts/sm/BlockAlloc.c:738 #4 0x0000000000926911 in freeChain_sync (bd=0x7e998ce02880) at rts/sm/GCUtils.c:80 #5 0x0000000000934720 in scavenge_capability_mut_lists (cap=0x1acae80) at rts/sm/Scav.c:1665 #6 0x000000000092b411 in gcWorkerThread (cap=0x1acae80) at rts/sm/GC.c:1157 #7 0x000000000090be9a in yieldCapability (pCap=0x7f9994e69e20, task=0x7e9984000b70, gcAllowed=true) at rts/Capability.c:861 #8 0x0000000000906120 in scheduleYield (pcap=0x7f9994e69e50, task=0x7e9984000b70) at rts/Schedule.c:673 #9 0x0000000000905500 in schedule (initialCapability=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:293 #10 0x0000000000908d4f in scheduleWorker (cap=0x1acae80, task=0x7e9984000b70) at rts/Schedule.c:2554 #11 0x000000000091a30a in workerStart (task=0x7e9984000b70) at rts/Task.c:444 #12 0x00007f99937fa6db in start_thread (arg=0x7f9994e6a700) at pthread_create.c:463 #13 0x000061654d59f88f in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:95 Thread 1 (Thread 32573.32573): #0 checkFreeListSanity () at rts/sm/BlockAlloc.c:887 #1 0x0000000000928979 in freeGroup (p=0x7e998d303540) at rts/sm/BlockAlloc.c:721 #2 0x0000000000926f23 in todo_block_full (size=513, ws=0x1aa8ce0) at rts/sm/GCUtils.c:264 #3 0x00000000009583b9 in alloc_for_copy (size=513, gen_no=0) at rts/sm/Evac.c:80 #4 0x000000000095850d in copy_tag_nolock (p=0x7e998c675f28, info=0x421d98 , src=0x7e998d075d80, size=513, gen_no=0, tag=1) at rts/sm/Evac.c:153 #5 0x0000000000959177 in evacuate (p=0x7e998c675f28) at rts/sm/Evac.c:715 #6 0x0000000000932388 in scavenge_small_bitmap (p=0x7e998c675f28, size=1, bitmap=0) at rts/sm/Scav.c:271 #7 0x0000000000934aaf in scavenge_stack (p=0x7e998c675f28, stack_end=0x7e998c676000) at rts/sm/Scav.c:1908 #8 0x0000000000934295 in scavenge_one (p=0x7e998c66e000) at rts/sm/Scav.c:1466 #9 0x0000000000934662 in scavenge_mutable_list (bd=0x7e998d300440, gen=0x1b1d880) at rts/sm/Scav.c:1643 #10 0x0000000000934700 in scavenge_capability_mut_lists (cap=0x1aaa340) at rts/sm/Scav.c:1664 #11 0x00000000009299b6 in GarbageCollect (collect_gen=0, do_heap_census=false, gc_type=2, cap=0x1aaa340, idle_cap=0x1b38aa0) at rts/sm/GC.c:378 #12 0x0000000000907a4a in scheduleDoGC (pcap=0x7ffdec5b5310, task=0x1b36650, force_major=false) at rts/Schedule.c:1798 #13 0x0000000000905de7 in schedule (initialCapability=0x1aaa340, task=0x1b36650) at rts/Schedule.c:546 #14 0x0000000000908bc4 in scheduleWaitThread (tso=0x7e998c0067c8, ret=0x0, pcap=0x7ffdec5b5430) at rts/Schedule.c:2537 #15 0x000000000091b5a0 in rts_evalLazyIO (cap=0x7ffdec5b5430, p=0x9c11f0, ret=0x0) at rts/RtsAPI.c:530 #16 0x000000000091ca56 in hs_main (argc=1, argv=0x7ffdec5b5628, main_closure=0x9c11f0, rts_config=...) at rts/RtsMain.c:72 #17 0x0000000000421ea0 in main () In particular, dbl_link_onto() which is used to add a freed block to a doubly-linked free list is not thread safe and corrupts the list when called concurrently. Note that thread 1 is to blame here as thread 2 is properly taking the spinlock. With this patch we now take the spinlock when freeing a todo block in GC, avoiding this race. Test Plan: - Tried slow validate locally: this patch does not introduce new failures. - circleci: https://circleci.com/gh/ghc/ghc-diffs/283 The test got killed because it took 5 hours but T7919 (which was previously failing on circleci) passed. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15285 Differential Revision: https://phabricator.haskell.org/D5115 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:56:36 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:56:36 -0000 Subject: [GHC] #15285: "strange closure type" in T7919 with the threaded2 way In-Reply-To: <048.67a85438785d72c47b85ee0ad004eab2@haskell.org> References: <048.67a85438785d72c47b85ee0ad004eab2@haskell.org> Message-ID: <063.9ef579bc6e42c6a8eee89748529fd620@haskell.org> #15285: "strange closure type" in T7919 with the threaded2 way -------------------------------------+------------------------------------- Reporter: alpmestan | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.5 Resolution: | Keywords: Operating System: Linux | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: T7919 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5115 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: patch => merge * milestone: => 8.6.1 Comment: Ben, can we merge this to 8.6 branch? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:58:25 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:58:25 -0000 Subject: [GHC] #15587: traceEvent tests failing in slow validate In-Reply-To: <043.5a7481e85ed8eb1897c26ebcfa11c5fb@haskell.org> References: <043.5a7481e85ed8eb1897c26ebcfa11c5fb@haskell.org> Message-ID: <058.4c44c1829eedfbb9c28c4a5afb24cec6@haskell.org> #15587: traceEvent tests failing in slow validate -------------------------------------+------------------------------------- Reporter: osa1 | Owner: osa1 Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Test Suite | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5119 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * owner: (none) => osa1 Comment: I'll investigate further. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 12:59:12 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 12:59:12 -0000 Subject: [GHC] #14391: Make the simplifier independent of the typechecker In-Reply-To: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> References: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> Message-ID: <061.ffbd716031408da8d571d145859c9da4@haskell.org> #14391: Make the simplifier independent of the typechecker -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4503 Wiki Page: | -------------------------------------+------------------------------------- Comment (by monoidal): I created a graph with all module dependencies in `compiler/`. If we don't count SOURCE imports, this graph is acyclic. If we do, there are cyclic dependencies, and we can analyze strongly connected components. Currently, there are 440 modules, but 357 of them are in the same component. In other words, we have 357 modules that import directly or indirectly each other. The full structure is 1*76 + 7 + 357. This means there's a bunch of one-element components, one 7-element component (FastString, Pretty, Panic, Outputable etc.) and everything else is in a big chunk. In total, there are 78 components. What if we could magically remove only one edge from this graph and try to obtain the largest amount of components? Here are the winners, the larger the better: {{{ # of components / import from / import to / new structure 282 typecheck/TcRnMonad.hs -> typecheck/TcSplice.hs 1*273 + 2*2 + 4 + 6 + 7*2 + 11 + 15 + 113 259 typecheck/TcSplice.hs -> main/HscMain.hs 1*252 + 2*4 + 4 + 7 + 169 242 simplCore/CoreMonad.hs -> typecheck/TcEnv.hs 1*236 + 2*2 + 4 + 7 + 88 + 101 235 main/DynFlags.hs -> main/Plugins.hs 1*229 + 2*2 + 4 + 7 + 96 + 100 234 main/Plugins.hs -> simplCore/CoreMonad.hs 1*228 + 2*2 + 4 + 7 + 98 + 99 137 main/HscMain.hs -> main/CodeOutput.hs 1*134 + 4 + 7 + 295 128 main/CodeOutput.hs -> nativeGen/AsmCodeGen.hs 1*125 + 4 + 7 + 304 97 main/HscMain.hs -> simplCore/SimplCore.hs 1*95 + 7 + 338 78 [current situation] 1*76 + 7 + 357 }}} This ticket shows up at the third place (CoreMonad -> TcEnv). If we could remove CoreMonad -> TcEnv import, the structure would improve to 1*236 + 2*2 + 4 + 7 + 88 + 101. Instead of a 357-sized cyclic chunk, we would have half of the modules not participating in any cycle, and the big chunk reduced to two smaller ones. Of course, my script didn't consider whether any item on this list is realistic. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 13:21:10 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 13:21:10 -0000 Subject: [GHC] #3372: Allow for multiple linker instances In-Reply-To: <049.b54da97038a1da97405ea7b63a99f067@haskell.org> References: <049.b54da97038a1da97405ea7b63a99f067@haskell.org> Message-ID: <064.176f66c104a996b92c6a618e7cac99f1@haskell.org> #3372: Allow for multiple linker instances -------------------------------------+------------------------------------- Reporter: jcpetruzza | Owner: (none) Type: feature request | Status: new Priority: low | Milestone: Component: Runtime System | Version: (Linker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: 3658 | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by gelisam): I believe this has been fixed in ghc 7.10.1, can we close this? At least, the release notes for ghc 7.10.1 claim that the linker API is now thread-safe: https://downloads.haskell.org/~ghc/7.10.1/docs/html/users_guide/release-7-10-1.html#idp5860656 See https://github.com/mvdan/hint/issues/68#issuecomment-419088813 for the rest of my archeological search on the history of this ticket and why I believe this is now fixed. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 13:43:46 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 13:43:46 -0000 Subject: [GHC] #14391: Make the simplifier independent of the typechecker In-Reply-To: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> References: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> Message-ID: <061.e8a03a5eadad6812c0bd428748b1b66b@haskell.org> #14391: Make the simplifier independent of the typechecker -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4503 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Interesting! One way to avoid the need for `.hs-boot` files would be to rename-and- typecheck each SCC as a whole. (Implementing this idea would make an excellent project, BTW.) If we did that, then yes, reducing SCC sizes would become highly relevant. (Until we implement it, I'm not sure that reducing SCC sizes is that important.) I had a look at the top candidate: the import of `TcSplice` in `TcRnMonad`. I think it'd be very simple to untangle. It's only needed to allow the call to `runRemoteModFinalizers`. But I think you could easily have {{{ th_modfinalizers_var :: IORef [(TcLclEnv, ThModFinalizers)] }}} and then `TcRnMonad` would not need to mention `runRemoteModFinalizers`. I think that'd be a straight improvement, and we should do it regardless. Would you like to try that? It's a rather simple change. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 13:47:25 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 13:47:25 -0000 Subject: [GHC] #13499: "Panic: no skolem info" with StaticPointers and typed hole In-Reply-To: <044.5000664cb44543b0892ceec125b4ed7e@haskell.org> References: <044.5000664cb44543b0892ceec125b4ed7e@haskell.org> Message-ID: <059.b02ee4485991fef8c1473ae54c2dcf20@haskell.org> #13499: "Panic: no skolem info" with StaticPointers and typed hole -------------------------------------+------------------------------------- Reporter: Otini | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: | StaticPointers, TypedHoles Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15035, #15609 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * related: #15035 => #15035, #15609 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 13:56:27 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 13:56:27 -0000 Subject: [GHC] #14391: Make the simplifier independent of the typechecker In-Reply-To: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> References: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> Message-ID: <061.c32bc98c889748c8d350f5c5dec16bff@haskell.org> #14391: Make the simplifier independent of the typechecker -------------------------------------+------------------------------------- Reporter: nomeata | Owner: monoidal Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4503 Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * owner: (none) => monoidal Comment: Yes, I'll check. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 14:03:09 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 14:03:09 -0000 Subject: [GHC] #9476: Implement late lambda-lifting In-Reply-To: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> References: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> Message-ID: <061.7017ec83b82ae5dabaa6d218966f8d4f@haskell.org> #9476: Implement late lambda-lifting -------------------------------------+------------------------------------- Reporter: simonpj | Owner: sgraf Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #8763 #13286 | Differential Rev(s): Wiki Page: LateLamLift | -------------------------------------+------------------------------------- Changes (by sgraf): * Attachment "unknown.txt" added. allow turning known into unknown calls -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 14:14:58 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 14:14:58 -0000 Subject: [GHC] #15427: Calling hs_try_putmvar from an unsafe foreign call can cause the RTS to hang In-Reply-To: <049.decdf9f369f07feac7a1415f9c9ba9fe@haskell.org> References: <049.decdf9f369f07feac7a1415f9c9ba9fe@haskell.org> Message-ID: <064.a2a0c845245e6377ea8781c338c545ff@haskell.org> #15427: Calling hs_try_putmvar from an unsafe foreign call can cause the RTS to hang -------------------------------------+------------------------------------- Reporter: syntheorem | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Runtime System | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonmar): `hs_try_putmvar` is designed to be called without a Capability, I hadn't anticipated that someone might want to call it from an unsafe FFI call. What's your use case? We could definitely make this clearer in the docs, and perhaps make it fail in a better way. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 14:29:46 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 14:29:46 -0000 Subject: [GHC] #14912: UnsafeReenter test fails with threaded1 and threaded2 In-Reply-To: <048.0d06801876b264a33d0020ade629babb@haskell.org> References: <048.0d06801876b264a33d0020ade629babb@haskell.org> Message-ID: <063.9235efee53ede47dcc8740f6c37b7198@haskell.org> #14912: UnsafeReenter test fails with threaded1 and threaded2 -----------------------------------+-------------------------------------- Reporter: alpmestan | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 8.5 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14743 | Differential Rev(s): Wiki Page: | -----------------------------------+-------------------------------------- Comment (by simonmar): This will only fail for the non-threaded runtime, because the threaded RTS will hang trying to acquire the same capability that the thread already holds. Let's just omit the threaded ways for this test. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 14:30:30 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 14:30:30 -0000 Subject: [GHC] #9476: Implement late lambda-lifting In-Reply-To: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> References: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> Message-ID: <061.1f4dc8a3f4b40cd14443a1a222548998@haskell.org> #9476: Implement late lambda-lifting -------------------------------------+------------------------------------- Reporter: simonpj | Owner: sgraf Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #8763 #13286 | Differential Rev(s): Wiki Page: LateLamLift | -------------------------------------+------------------------------------- Changes (by sgraf): * Attachment "rec-5-6-8-10.txt" added. Varying max number of recursive parameters -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 14:55:58 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 14:55:58 -0000 Subject: [GHC] #15610: GHCi command to list instances a (possibly compound) type belongs to Message-ID: <051.14e1cd8a0da52d24d90bbe3d664e811c@haskell.org> #15610: GHCi command to list instances a (possibly compound) type belongs to -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature | Status: new request | Priority: lowest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 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: -------------------------------------+------------------------------------- This command (`:instances`) would be very useful to me (for deriving in particular). People on Twitter were digging it, I believe some are interested in implementing it {{{ >> import Data.Functor.Sum (Sum) >> >> :instances Sum [] [] Eq a => Eq (Sum [] [] a) Ord a => Ord (Sum [] [] a) Show a => Show (Sum [] [] a) Read a => Read (Sum [] [] a) Functor (Sum [] []) Foldable (Sum [] []) Eq1 (Sum [] []) Ord1 (Sum [] []) Show1 (Sum [] []) Read1 (Sum [] []) FunctorWithIndex (Either Int Int) (Sum [] []) FoldableWithIndex (Either Int Int) (Sum [] []) TraversableWithIndex (Either Int Int) (Sum [] []) }}} Not a precise algorithm, but the command `:instances ` lists what classes `` is an instance of. This is something I usually do by hand and is useful for finding what instances I can expect to derive with `-XDerivingVia`: {{{#!hs data ... deriving (???) via (F A B) -- >> :instances F A B -- Cls1 (F A B) -- Cls2 (F A B) .. data ... deriving (Cls1, Cls2, ..) via (F A B) }}} I expect something like `:instances Sum Endo` to return no instances, but I currently rely on my own mind to derive a contradiction for each type. I would cross-reference `:info Sum`, `:info Endo` which blows up when the types are complex and deeply nested. partial type signature (`_`):: the command `:instances Either _ Int` should match `Eq a => Eq (Either a Int)` trace info:: I find it noisy but we can {{{ >> :instances Sum [] [] .. Functor (Sum [] []) -- (Functor f, Functor g) => Functor (Sum f g) -- Defined in ‘Data.Functor.Sum’ .. }}} This would be more natural in a interactive environment where we can toggle/expand and collapse it. negative results:: There is a `.. => Comonad (Sum f g)` instance but we don't have `Comonad (Sum [] [])` because there is no `Comonad []`. It may be valuable to query negative results {{{ >> :noinstance Sum [] [] NO (instance Comonad (Sum [] [])) because NO (instance Comonad []) }}} multi-parameter type class:: I cheekily listed `FunctorWithIndex` example of, I am fine dropping MPTCs but listing `Coercible` instances might be useful {{{ >> newtype List_or_List a = L_or_L (Sum [] [] a) >> >> :instance Sum [] [] .. Coercible (Sum [] [] a) (List_or_List a) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 15:01:06 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 15:01:06 -0000 Subject: [GHC] #15610: GHCi command to list instances a (possibly compound) type belongs to In-Reply-To: <051.14e1cd8a0da52d24d90bbe3d664e811c@haskell.org> References: <051.14e1cd8a0da52d24d90bbe3d664e811c@haskell.org> Message-ID: <066.a981c410e22270a43fbd62f96035ccb6@haskell.org> #15610: GHCi command to list instances a (possibly compound) type belongs to -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: lowest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by Iceland_jack: Old description: > This command (`:instances`) would be very useful to me (for deriving in > particular). People on Twitter were digging it, I believe some are > interested in implementing it > > {{{ > >> import Data.Functor.Sum (Sum) > >> > >> :instances Sum [] [] > Eq a => Eq (Sum [] [] a) > Ord a => Ord (Sum [] [] a) > Show a => Show (Sum [] [] a) > Read a => Read (Sum [] [] a) > Functor (Sum [] []) > Foldable (Sum [] []) > Eq1 (Sum [] []) > Ord1 (Sum [] []) > Show1 (Sum [] []) > Read1 (Sum [] []) > FunctorWithIndex (Either Int Int) (Sum [] []) > FoldableWithIndex (Either Int Int) (Sum [] []) > TraversableWithIndex (Either Int Int) (Sum [] []) > }}} > > Not a precise algorithm, but the command `:instances ` lists what > classes `` is an instance of. This is something I usually do by hand > and is useful for finding what instances I can expect to derive with > `-XDerivingVia`: > > {{{#!hs > data ... > deriving (???) > via (F A B) > > -- >> :instances F A B > -- Cls1 (F A B) > -- Cls2 (F A B) .. > > data ... > deriving (Cls1, Cls2, ..) > via (F A B) > }}} > > I expect something like `:instances Sum Endo` to return no instances, but > I currently rely on my own mind to derive a contradiction for each type. > I would cross-reference `:info Sum`, `:info Endo` which blows up when the > types are complex and deeply nested. > > partial type signature (`_`):: the command `:instances Either _ Int` > should match `Eq a => Eq (Either a Int)` > > trace info:: I find it noisy but we can > > {{{ > >> :instances Sum [] [] > .. > Functor (Sum [] []) -- (Functor f, Functor g) => Functor (Sum f g) > -- Defined in ‘Data.Functor.Sum’ > .. > }}} > > This would be more natural in a interactive environment where we can > toggle/expand and collapse it. > > negative results:: There is a `.. => Comonad (Sum f g)` instance but we > don't have `Comonad (Sum [] [])` because there is no `Comonad []`. It may > be valuable to query negative results > > {{{ > >> :noinstance Sum [] [] > NO (instance Comonad (Sum [] [])) because > NO (instance Comonad []) > }}} > > multi-parameter type class:: I cheekily listed `FunctorWithIndex` > example of, I am fine dropping MPTCs but listing `Coercible` instances > might be useful > > {{{ > >> newtype List_or_List a = L_or_L (Sum [] [] a) > >> > >> :instance Sum [] [] > .. > Coercible (Sum [] [] a) (List_or_List a) > }}} New description: This command (`:instances`) would be very useful to me (for deriving in particular). People on Twitter were digging it, I believe some are interested in implementing it {{{ >> import Data.Functor.Sum (Sum) >> >> :instances Sum [] [] Eq a => Eq (Sum [] [] a) Ord a => Ord (Sum [] [] a) Show a => Show (Sum [] [] a) Read a => Read (Sum [] [] a) Functor (Sum [] []) Foldable (Sum [] []) Eq1 (Sum [] []) Ord1 (Sum [] []) Show1 (Sum [] []) Read1 (Sum [] []) FunctorWithIndex (Either Int Int) (Sum [] []) FoldableWithIndex (Either Int Int) (Sum [] []) TraversableWithIndex (Either Int Int) (Sum [] []) }}} Not a precise algorithm, but the command `:instances ` lists what classes `` is an instance of. This is something I usually do by hand and is useful for finding what instances I can expect to derive with `-XDerivingVia`: {{{#!hs data ... deriving (???) via (F A B) -- >> :instances F A B -- Cls1 (F A B) -- Cls2 (F A B) .. data ... deriving (Cls1, Cls2, ..) via (F A B) }}} I expect something like `:instances Sum Endo` to return no instances, but I currently rely on my own mind to derive a contradiction for each type. I would cross-reference `:info Sum`, `:info Endo` which blows up when the types are complex and deeply nested. partial type signature (`_`):: the command `:instances Either _ Int` should match `Eq a => Eq (Either a Int)` trace info:: I find it noisy but we can {{{ >> :instances Sum [] [] .. Functor (Sum [] []) -- (Functor f, Functor g) => Functor (Sum f g) -- Defined in ‘Data.Functor.Sum’ .. }}} This would be more natural in a interactive environment where we can toggle/expand and collapse it. negative results:: There is a `.. => Comonad (Sum f g)` instance but we don't have `Comonad (Sum [] [])` because there is no `Comonad []`. It may be valuable to query negative results {{{ >> :noinstance Sum [] [] NO (instance Comonad (Sum [] [])) because NO (instance Comonad []) }}} multi-parameter type class:: I cheekily listed `FunctorWithIndex` example of, I am fine dropping MPTCs, we can also consider special constraints like `Coercible` {{{ >> newtype List_or_List a = L_or_L (Sum [] [] a) >> >> :instance Sum [] [] .. Coercible (Sum [] [] a) (List_or_List a) }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 15:08:30 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 15:08:30 -0000 Subject: [GHC] #15610: GHCi command to list instances a (possibly compound) type belongs to In-Reply-To: <051.14e1cd8a0da52d24d90bbe3d664e811c@haskell.org> References: <051.14e1cd8a0da52d24d90bbe3d664e811c@haskell.org> Message-ID: <066.13a0eeda2ae97f34eb4b4ff8da66e31d@haskell.org> #15610: GHCi command to list instances a (possibly compound) type belongs to -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: lowest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by xldenis): Hi! I'd like to volunteer as tribute to implement this. I am superficially familiar with the GHC codebase and I'm sure I can inspire myself from the work done on the `:doc` command this summer. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 15:11:28 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 15:11:28 -0000 Subject: [GHC] #9476: Implement late lambda-lifting In-Reply-To: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> References: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> Message-ID: <061.a567613318dec957df0889bde06082f7@haskell.org> #9476: Implement late lambda-lifting -------------------------------------+------------------------------------- Reporter: simonpj | Owner: sgraf Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #8763 #13286 | Differential Rev(s): Wiki Page: LateLamLift | -------------------------------------+------------------------------------- Changes (by sgraf): * Attachment "nonrec-5-6-8-10.txt" added. Va -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 15:34:13 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 15:34:13 -0000 Subject: [GHC] #9476: Implement late lambda-lifting In-Reply-To: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> References: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> Message-ID: <061.9c8838a60655d64f0dc811178bcae4e4@haskell.org> #9476: Implement late lambda-lifting -------------------------------------+------------------------------------- Reporter: simonpj | Owner: sgraf Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #8763 #13286 | Differential Rev(s): Wiki Page: LateLamLift | -------------------------------------+------------------------------------- Changes (by sgraf): * Attachment "8-8.txt" added. Allowing max 8 (non-)recursive parameters -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 15:46:03 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 15:46:03 -0000 Subject: [GHC] #15599: typeclass inference depends on whether a module is exposed. In-Reply-To: <047.dd916b476f2fd0f26c1766607c70f5c2@haskell.org> References: <047.dd916b476f2fd0f26c1766607c70f5c2@haskell.org> Message-ID: <062.3b8520b57f4bd22e1ad2cb2f237fbc6e@haskell.org> #15599: typeclass inference depends on whether a module is exposed. -------------------------------------+------------------------------------- Reporter: gleachkr | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.3 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by gleachkr): Sorry, my mistake. it looks like the `-package-db` flag won't suffice to make this more portable and to disentangle it from stack. The included pkgdb directories refer back to the `.stack-work` directory, which isn't around unless you build the package with stack. Here's what I get when I run the two included scripts, though: {{{ GHC-Repro master ❯ ./test.sh Building project... These two results should be the same, since the only difference between the files is that one is an exported module λ ❯ Flag {checkFlag = True} λ ❯ Flag {checkFlag = False} Here it is again with 8.4.3: Building project... λ ❯ Flag {checkFlag = True} λ ❯ Flag {checkFlag = True} GHC-Repro master ❯ ./test-ghci.sh Behavior in 8.2.2 with pkgdb λ ❯ Flag {checkFlag = False} Behavior in 8.2.2 without pkgdb λ ❯ Flag {checkFlag = True} Behavior in 8.4.3 with pkgdb λ ❯ Flag {checkFlag = True} Behavior in 8.4.3 without pkgdb λ ❯ Flag {checkFlag = True} }}} When I run ghci as you did, with everything in the same directory (or with `-isrc`), I get the same results as you, `True` throughout. The difference that made me try the package-db route was that it seems (from a fair amount of experimentation) that you get `checkFlag=False` when the modules from GHC-Repro are not compiled by ghci, but just included, so when you get this loading message: {{{ [1 of 1] Compiling Tests.Good ( src/Tests/Good.hs, interpreted ) [Tests.Link changed] Ok, one module loaded. }}} rather than {{{ [1 of 2] Compiling Tests.Link ( src/Tests/Link.hs, interpreted ) [2 of 2] Compiling Tests.Good ( src/Tests/Good.hs, interpreted ) Ok, two modules loaded. }}} This suggested to me that `Tests.Link` needed to be available as part of a package rather than being loaded into ghci, which I think the second script confirms. In case it might be helpful, I've added the `.stack-work` directory to the github repo, and changed the paths on the `test-ghci.sh` script to point to the pkgdbs inside of that directory. I don't know how portable this is, though, (I hope it would run on other x86 linux machines, but I'm not sure) and it is pretty far from a clean reproduction. Do you know of a better approach? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 15:47:00 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 15:47:00 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.b70e38f3e1e94a0bd32cf257a7adc21b@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I might have time to take a look at this, but I'll need a bit more direction. You say that you might have missed something -- what two branches can I compare to assess that? As for the one-line change: it's seems conceivable that the change could have a measurable performance impact. Have you tested the change, independent of anything else? If the fix makes performance worse, that would be an insight, because the `acc` check looks like it's only an optimization, not an essential check for correctness. Thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 16:09:55 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 16:09:55 -0000 Subject: [GHC] #9476: Implement late lambda-lifting In-Reply-To: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> References: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> Message-ID: <061.173d9e55a040d123dcae8d0b2ffcc146@haskell.org> #9476: Implement late lambda-lifting -------------------------------------+------------------------------------- Reporter: simonpj | Owner: sgraf Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #8763 #13286 | Differential Rev(s): Wiki Page: LateLamLift | -------------------------------------+------------------------------------- Comment (by sgraf): I investigated various variations of the configuration that intuitively should give the best results. Specifically, I played with 3 parameters: 1. `-fstg-lift-lams-known`: Allow turning known into unknown calls. Default: Don't allow. Imagine we lift `f` in the following program: {{{ let g x = ... f y = ... g y ... in f 2 ==> f g y = ... g y ...; let g x = ... in f g 2 }}} This turns the known call to `g` within `f`s body into an unknown one (let's call it ''anonymisation'' for the sake of this post), which needs to go through one of the generic apply functions. My gut tells me this probably isn't worth taking the risk: There's the (very small) chance, that when there's no matching slow call pattern, this will turn into a very slow call, which, from my understanding, would allocate. 2. `-fstg-lift-lams-rec-args `: Allow lifting as long as the resulting recursive function has at most n arguments. Default: 5, the number of available registers. Excess arguments are passed on the stack, which would mean the same slow memory accesses we try to avoid. Still, allocating on the stack vs. on the heap might be favorable, but I'm not sure how passing arguments on the stack plays with (non-tail) recursion, e.g. would passing arguments on the stack mean we had to pass the same, static args all over again for a nested recursive activation? Anyway, I measured. 3. `-fstg-lift-lams-nonrec-args `: Allow lifting as long as the resulting non-recursive function has at most n arguments. Default: 5. Lifting non-recursive functions could have different effects than lifting recursive ones, because a) there's no recursive calls, we pay call overhead only once b) they are probably huge enough that call overhead is neglible. I'll abbreviate each configuration I tested by a triple `{t,f}--`, so the (current) default parameter would be `f-5-5`. - `t-5-5` -- or: allow turning known call into unknown calls. Total mean changes: -0.0% allocs, -0.0% counted instructions Numbers in attachment:unknown.txt. No regressions in allocations (that's what we have the cost model for, after all), with two benchmarks standing out: * `rewrite`: -1.5% allocs, -0.1% counted instructions. Changes were somewhere in `base`, so didn't bother to investigate further * `mate`: -0.9% allocs, -0.1% counted instructions. This one lifted recursive functions of the form {{{ let { $warg_scDq [InlPrag=NOUSERINLINE[2], Occ=OnceL*!, Dmd=] :: Board.Kind -> Board.Square -> [(Move.MoveInFull, Board.Board)] -> [(Move.MoveInFull, Board.Board)] [LclId, Arity=3, Str=, Unf=OtherCon []] = ... } in ... let { go_scKg [Occ=LoopBreaker] :: [(Board.Kind, Board.Square)] -> [(Move.MoveInFull, Board.Board)] [LclId, Arity=1, Str=, Unf=OtherCon []] = sat-only [go_scKg $warg_scDq] \r [ds_scKh] case ds_scKh of { [] -> [] []; : y_scKj [Occ=Once!] ys_scKk [Occ=Once] -> case y_scKj of { (,) ww3_scKm [Occ=Once] ww4_scKn [Occ=Once] -> let { sat_scKo [Occ=Once] :: [(Move.MoveInFull, Board.Board)] [LclId] = [ys_scKk go_scKg] \u [] go_scKg ys_scKk; } in $warg_scDq ww3_scKm ww4_scKn sat_scKo; }; }; } in go_scKg ww_scCR; }}} Which is exactly the kind of lift that I tought we don't want to make: lifting `go` to top-level will result in abstracting over `$warg`, which will turn the known call into an unknown one. Perhaps this is only beneficial because the unknown call isn't on the hot path. - `f--5`: This varied max number of recursive args between 5 and 10 (attachment:rec-5-6-8-10.txt). Allowing 6 parameters lifted some more functions, 8 parameters didn't do anything more than 6 and 10 parameters did another influential lift (-7.7% allocs in `mandel2`, but +0.3% in ci). The only real beneficial lift here was in `fibheaps`, happening with n >= 6 (-0.5% on both allocs and ci). The rest seems to be just noise. So, what happened in `fibheaps`? It seems two recursive functions were lifted, both taking 6 arguments. Ah, but one of them (the last, in particular) is a 'void' parameter (so, slow call pattern pppppv), which is completely erased from the resulting Cmm! ... the tip of my branch should allow the lift here now. - `f-5-`: This varied max number of non-recursive args between 5 and 10 (attachment:nonrec-5-6-8-10. Allowing up to 8 parameters had great effect on allocations in `cichelli` (-10.4%), while also improving counted instructions negligibly (-0.0%). Allowing 10 parameters also had a tiny effect on `simple` (-0.9% allocs, -0.1%). Codegen for both benchmarks reveals that the changes hide somewhere in `base`, so I'm not investigating further at the moment, seems like it's not worth the time. - `f-8-8`: To test the interaction of both tuning parameters. No surprising results: attachment:8-8.txt (the baseline doesn't use the `fibheaps` opportunity which is now optimised in `f-5-5`) I didn't bother evaluating the combination of allowing anonymisation of calls with the max bound on parameters, because I think they are largely independent of another. Should I evaluate more variants, like allowing to lift undersaturated applications (are there even any in STG? Thought not, but then there's `satCallsOnly`)? I don't think these would be worthwhile, except when the resulting PAP is on a cold path... ----- So, here's a **TLDR** some questions: 1. Should we allow anonymisation (see 1) above)? I don't see big wins (configuration `t-5-5`), and don't really understand why there are any at all, which probably is the bigger problem here. 2. I think the `f-5-5` configuration is a good default. Can you think of any other parameters I could vary? Looking at the Wiki page, I think these are the other ones Nicolas evaluated (which was on Core, which is a lot less explicit about these things): i. Abstracting over/lifting LNEs: That's a nono, as the last few years showed ii. Abstract Undersaturated applciations: As I wrote above, I don't think these are worthwhile, because they only shift allocation to call sites via PAPs (and also they aren't trivially to implement because of STGs ANF guarantees) iii. Abstract (over-)saturated applications: That's a no brainer in my eyes. Oversats are just regular calls returning something unknown we then call. If the known call is worthwhile to lift, just do it; the unknown call won't change a bit. iv. Create PAPs: That's a special case of ii. I think, or at least this is the case that would entail a special case in the transformation because of STG only allows atoms as arguments. v. Use strictness: Seems to be related to anticipating CorePrep, which fortunately we don't have to any longer. vi. Use one-shot info: I'm not entirely sure what this means either. Lifting would spoil one-shot info, but I don't think this has any operational consequences, because one-shot info was already used to identify single-entry thunks. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 16:22:32 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 16:22:32 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.cea3ece10eafe8e909ea024d5ca608dc@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Replying to [comment:106 goldfire]: > I might have time to take a look at this, but I'll need a bit more direction. You say that you might have missed something -- what two branches can I compare to assess that? I think you may be missing some context here, so here's the executive summary: - Your original patch is on `wip/T14880` - The baseline HEAD from right before your patch is on `wip/T14880-baseline` - Simon's patch (as mentioned above) is on `wip/T1448-accum` - `wip/T14880-reengineered` contains your patch (as on `wip/T14880`), with the approach from Simon's patch applied practically verbatim. Now here's the conundrum: - The baseline version performs within limits - Your patch applied as-is fails two performance tests: 5321Fun and 5631 - Simon's patch improves performance on 5631 - But Simon's approach applied to your patch doesn't > As for the one-line change: it's seems conceivable that the change could have a measurable performance impact. Have you tested the change, independent of anything else? If the fix makes performance worse, that would be an insight, because the `acc` check looks like it's only an optimization, not an essential check for correctness. It is only an optimization, but that's the whole point of digging further here - the patch allocates more even though we would it expect it to allocate less. AFAIK there are no correctness issues anymore. The patch without the `acc` check fails the two performance tests, but so does the version with the check. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 16:38:24 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 16:38:24 -0000 Subject: [GHC] #14974: 2-fold memory usage regression GHC 8.2.2 -> GHC 8.4.1 compiling `mmark` package In-Reply-To: <042.6f9317183740e6c428dbe334554fec22@haskell.org> References: <042.6f9317183740e6c428dbe334554fec22@haskell.org> Message-ID: <057.e7675943f977b1e6f4ce4b6992258817@haskell.org> #14974: 2-fold memory usage regression GHC 8.2.2 -> GHC 8.4.1 compiling `mmark` package -------------------------------------+------------------------------------- Reporter: hvr | Owner: davide Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: Compiler | Version: 8.4.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by davide): * Attachment "terms_per_pass.png" added. Line plot of core size (in number of terms) for each pass when compiling Text.MMark.Parser. GHC 8.2.2 vs GHC 8.4.1. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 16:58:07 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 16:58:07 -0000 Subject: [GHC] #14974: 2-fold memory usage regression GHC 8.2.2 -> GHC 8.4.1 compiling `mmark` package In-Reply-To: <042.6f9317183740e6c428dbe334554fec22@haskell.org> References: <042.6f9317183740e6c428dbe334554fec22@haskell.org> Message-ID: <057.cd961f4ab33e758281c617f7905c2447@haskell.org> #14974: 2-fold memory usage regression GHC 8.2.2 -> GHC 8.4.1 compiling `mmark` package -------------------------------------+------------------------------------- Reporter: hvr | Owner: davide Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: Compiler | Version: 8.4.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by davide): The 2 peaks of the terms_per_pass.png​ plot are the core size after 3 consecutive 3 passes (for both the GHC 8.2.2 and GHC 8.4.1 peak): SpecConstr, SpecConstr, Simplifier. Note there are no other SpecConstr passes. The core size between GHC 8.2.2 and GHC 8.4.1 track very closely until immediately before the SpecConstr pass. Perhaps a small change in core (before SpecConstr) is allowing for more specialization to happen, or SpecConstr is needlessly creating more core. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 17:25:09 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 17:25:09 -0000 Subject: [GHC] #15611: scope errors lie about what modules are imported Message-ID: <044.35c05a6ccad9dc15d82e16ecd787e95b@haskell.org> #15611: scope errors lie about what modules are imported -------------------------------------+------------------------------------- Reporter: dmwit | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.2 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: -------------------------------------+------------------------------------- Here's Test.hs: {{{ module Test where }}} And here's a ghci session: {{{ % ghci Test.hs GHCi, version 8.4.2: http://www.haskell.org/ghc/ :? for help *Test> Test.foo :1:1: error: Not in scope: ‘Test.foo’ No module named ‘Test’ is imported. }}} That "No module named ‘Test’ is imported." part seems blatantly wrong (and persists even if I explicitly `import Test` rather than using the implicit loading of the module). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 18:59:53 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 18:59:53 -0000 Subject: [GHC] #15612: Got Unable to commit 16777216 bytes of memory error on Ubuntu Message-ID: <048.489179ef71e71298a8416bc0920786be@haskell.org> #15612: Got Unable to commit 16777216 bytes of memory error on Ubuntu -------------------------------------+------------------------------------- Reporter: figelwump | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Unknown/Multiple Architecture: x86_64 | Type of failure: None/Unknown (amd64) | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- When running stack build on Ubuntu 18.04 on an AWS t2-micro instance (1 GB RAM), I got the following error: {{{ Preparing to install GHC to an isolated location. This will not interfere with any system-level installation. Downloaded ghc-8.0.2. Installed GHC. Populated index cache. stack: internal error: Unable to commit 16777216 bytes of memory (GHC version 8.2.2 for x86_64_unknown_linux) Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} ... After which there's no more output and stack build seems to hang. Any guidance here would be appreciated, thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 19:41:22 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 19:41:22 -0000 Subject: [GHC] #14391: Make the simplifier independent of the typechecker In-Reply-To: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> References: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> Message-ID: <061.7f0dbec6a70d9ca7238e6284d57ffe56@haskell.org> #14391: Make the simplifier independent of the typechecker -------------------------------------+------------------------------------- Reporter: nomeata | Owner: monoidal Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4503, Wiki Page: | Phab:D5135 -------------------------------------+------------------------------------- Changes (by monoidal): * differential: Phab:D4503 => Phab:D4503, Phab:D5135 Comment: Thank you, this worked. I submitted [Phab:D5135]. Going back to point 2 the original ticket, can we just remove this instance? {{{ #!hs instance MonadThings CoreM where lookupThing name = do { hsc_env <- getHscEnv ; liftIO $ lookupGlobal hsc_env name } }}} Nothing seems to use it, the testsuite passes, and this way we won't need `lookupGlobal` in CoreMonad. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 19:51:44 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 19:51:44 -0000 Subject: [GHC] #15613: GHCi command, tracing steps of instance resolution for Constraint or expression Message-ID: <051.315b513efc5cd955ece666611620c1e9@haskell.org> #15613: GHCi command, tracing steps of instance resolution for Constraint or expression -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature | Status: new request | Priority: lowest | Milestone: Component: GHCi | Version: Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: #15610 Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Another GHCi command (#15610) to trace the process of instance resolution for a constraint. This is already something people do by hand (ticket:10318#comment:6) and would be a great tool for explorers of Haskell This constraint ultimately boils down to lists being monoids and `Int` being a number {{{ >> :elab Monoid (a -> b -> ([c], Sum Int)) Monoid (a -> b -> ([c], Sum Int)) ==> Monoid (b -> ([c], Sum Int)) ==> Monoid ([c], Sum Int) ==> Monoid [c] ==> Monoid (Sum Int) ==> Num Int }}} If resolving the type class fails, it can pinpoint what caused it to fail {{{ >> data A >> :elab Show (A, Int -> Int) Show (A, Int -> Int) <~bRZsz NO instance~> ==> Show A ==> Show (Int -> Int) }}} A verbose version can explain each step {{{ >> :elab +v Monoid (a -> b -> ([c], Sum Int) Monoid (a -> b -> ([c], Sum Int)) -- Monoid b => Monoid (a -> b) (‘GHC.Base’) ==> Monoid (b -> ([c], Sum Int)) -- Monoid b => Monoid (a -> b) (‘GHC.Base’) ==> Monoid ([c], Sum Int) -- Monoid b => Monoid (a -> b) (‘GHC.Base’) ==> Monoid [c] -- Monoid [a] (‘GHC.Base’) ==> Monoid (Sum Int) -- Num a => Monoid (Sum a) (‘Data.Monoid’) ==> Num Int -- Num Int (‘GHC.Num’) }}} {{{ >> :elab +v Num (Int, Float, Rational) Num (Int, Float, Rational) -- (Num a, Num b, Num c) => Num (a, b, c) (‘Data.NumInstances.Tuple’) ==> Num Int -- Num Int (‘GHC.Num’) ==> Num Float -- Num Float (‘GHC.Float’) ==> Num Rational -- type Rational = Ratio Integer (‘GHC.Real’) = Num (Ration Integer) -- Integral a => Num (Ratio a) (‘GHC.Real’) ==> Integral Integer -- Integral Integer (‘GHC.Real’) }}} ---- Not the same idea but similar. Listing instance resolution that takes place in an expression {{{ >> :elab (+) @Int from: (+) @Int Num Int }}} {{{ >> :elab2 comparing (length @[]) <> compare from: length @[] Foldable [] from: comparing (length @[]) Ord Int from: comparing (length @[]) <> compare Monoid ([a] -> [a] -> Ordering) ==> Monoid ([a] -> Ordering) ==> Monoid Ordering }}} {{{ >> :elab2 ask 'a' from: ask 'a' MonadReader Char ((->) m) ==> MonadReader Char ((->) Char) }}} not sure about that last one, or how to visualize them but I think it gives the right idea. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 19:53:22 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 19:53:22 -0000 Subject: [GHC] #15610: GHCi command to list instances a (possibly compound) type belongs to In-Reply-To: <051.14e1cd8a0da52d24d90bbe3d664e811c@haskell.org> References: <051.14e1cd8a0da52d24d90bbe3d664e811c@haskell.org> Message-ID: <066.4073ab2ccd8691c88da1ae237724fbe2@haskell.org> #15610: GHCi command to list instances a (possibly compound) type belongs to -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: lowest | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15613 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Iceland_jack): * version: 8.4.3 => * related: => #15613 * milestone: 8.6.1 => Old description: > This command (`:instances`) would be very useful to me (for deriving in > particular). People on Twitter were digging it, I believe some are > interested in implementing it > > {{{ > >> import Data.Functor.Sum (Sum) > >> > >> :instances Sum [] [] > Eq a => Eq (Sum [] [] a) > Ord a => Ord (Sum [] [] a) > Show a => Show (Sum [] [] a) > Read a => Read (Sum [] [] a) > Functor (Sum [] []) > Foldable (Sum [] []) > Eq1 (Sum [] []) > Ord1 (Sum [] []) > Show1 (Sum [] []) > Read1 (Sum [] []) > FunctorWithIndex (Either Int Int) (Sum [] []) > FoldableWithIndex (Either Int Int) (Sum [] []) > TraversableWithIndex (Either Int Int) (Sum [] []) > }}} > > Not a precise algorithm, but the command `:instances ` lists what > classes `` is an instance of. This is something I usually do by hand > and is useful for finding what instances I can expect to derive with > `-XDerivingVia`: > > {{{#!hs > data ... > deriving (???) > via (F A B) > > -- >> :instances F A B > -- Cls1 (F A B) > -- Cls2 (F A B) .. > > data ... > deriving (Cls1, Cls2, ..) > via (F A B) > }}} > > I expect something like `:instances Sum Endo` to return no instances, but > I currently rely on my own mind to derive a contradiction for each type. > I would cross-reference `:info Sum`, `:info Endo` which blows up when the > types are complex and deeply nested. > > partial type signature (`_`):: the command `:instances Either _ Int` > should match `Eq a => Eq (Either a Int)` > > trace info:: I find it noisy but we can > > {{{ > >> :instances Sum [] [] > .. > Functor (Sum [] []) -- (Functor f, Functor g) => Functor (Sum f g) > -- Defined in ‘Data.Functor.Sum’ > .. > }}} > > This would be more natural in a interactive environment where we can > toggle/expand and collapse it. > > negative results:: There is a `.. => Comonad (Sum f g)` instance but we > don't have `Comonad (Sum [] [])` because there is no `Comonad []`. It may > be valuable to query negative results > > {{{ > >> :noinstance Sum [] [] > NO (instance Comonad (Sum [] [])) because > NO (instance Comonad []) > }}} > > multi-parameter type class:: I cheekily listed `FunctorWithIndex` > example of, I am fine dropping MPTCs, we can also consider special > constraints like `Coercible` > > {{{ > >> newtype List_or_List a = L_or_L (Sum [] [] a) > >> > >> :instance Sum [] [] > .. > Coercible (Sum [] [] a) (List_or_List a) > }}} New description: This command (`:instances`) would be very useful to me (for deriving in particular). People on Twitter were digging it, I believe some are interested in implementing it {{{ >> import Data.Functor.Sum (Sum) >> >> :instances Sum [] [] Eq a => Eq (Sum [] [] a) Ord a => Ord (Sum [] [] a) Show a => Show (Sum [] [] a) Read a => Read (Sum [] [] a) Functor (Sum [] []) Foldable (Sum [] []) Eq1 (Sum [] []) Ord1 (Sum [] []) Show1 (Sum [] []) Read1 (Sum [] []) FunctorWithIndex (Either Int Int) (Sum [] []) FoldableWithIndex (Either Int Int) (Sum [] []) TraversableWithIndex (Either Int Int) (Sum [] []) }}} Not a precise algorithm, but the command `:instances ` lists what classes `` is an instance of. This is something I usually do by hand and is useful for finding what instances I can expect to derive with `-XDerivingVia`: {{{#!hs data ... deriving (???) via (F A B) -- >> :instances F A B -- Cls1 (F A B) -- Cls2 (F A B) .. data ... deriving (Cls1, Cls2, ..) via (F A B) }}} I expect something like `:instances Sum Endo` to return no instances, but I currently rely on my own mind to derive a contradiction for each type. I would cross-reference `:info Sum`, `:info Endo` which blows up when the types are complex and deeply nested. partial type signature (`_`):: the command `:instances Either _ Int` should match `Eq a => Eq (Either a Int)` trace info:: I find it noisy but we can {{{ >> :instances Sum [] [] .. Functor (Sum [] []) -- (Functor f, Functor g) => Functor (Sum f g) -- Defined in ‘Data.Functor.Sum’ .. }}} This would be more natural in a interactive environment where we can toggle/expand and collapse it (see #15613 for what might appear as we expand instances). negative results:: There is a `.. => Comonad (Sum f g)` instance but we don't have `Comonad (Sum [] [])` because there is no `Comonad []`. It may be valuable to query negative results {{{ >> :noinstance Sum [] [] NO (instance Comonad (Sum [] [])) because NO (instance Comonad []) }}} multi-parameter type class:: I cheekily listed `FunctorWithIndex` example of, I am fine dropping MPTCs, we can also consider special constraints like `Coercible` {{{ >> newtype List_or_List a = L_or_L (Sum [] [] a) >> >> :instance Sum [] [] .. Coercible (Sum [] [] a) (List_or_List a) }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 19:53:43 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 19:53:43 -0000 Subject: [GHC] #14391: Make the simplifier independent of the typechecker In-Reply-To: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> References: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> Message-ID: <061.5cf0d30f0b652bbadadac6c0818ea55a@haskell.org> #14391: Make the simplifier independent of the typechecker -------------------------------------+------------------------------------- Reporter: nomeata | Owner: monoidal Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4503, Wiki Page: | Phab:D5135 -------------------------------------+------------------------------------- Comment (by nomeata): `CoreM` is used by plugins, so to find out if anyone uses it, you’d have to go through various plugins. (But because it is a type class instance, you cannot reliably tell if an occurence of `lookupThing` in a plugin is actually using this instance … so I guess you just have to try building them) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 19:58:55 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 19:58:55 -0000 Subject: [GHC] #15613: GHCi command, tracing steps of instance resolution for Constraint or expression In-Reply-To: <051.315b513efc5cd955ece666611620c1e9@haskell.org> References: <051.315b513efc5cd955ece666611620c1e9@haskell.org> Message-ID: <066.a31d2ec09a9ee72040aed40c4aeafc62@haskell.org> #15613: GHCi command, tracing steps of instance resolution for Constraint or expression -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: lowest | Milestone: Component: GHCi | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15610 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by Iceland_jack: Old description: > Another GHCi command (#15610) to trace the process of instance resolution > for a constraint. This is already something people do by hand > (ticket:10318#comment:6) and would be a great tool for explorers of > Haskell > > This constraint ultimately boils down to lists being monoids and `Int` > being a number > > {{{ > >> :elab Monoid (a -> b -> ([c], Sum Int)) > Monoid (a -> b -> ([c], Sum Int)) > ==> Monoid (b -> ([c], Sum Int)) > ==> Monoid ([c], Sum Int) > ==> Monoid [c] > ==> Monoid (Sum Int) > ==> Num Int > }}} > > If resolving the type class fails, it can pinpoint what caused it to fail > > {{{ > >> data A > >> :elab Show (A, Int -> Int) > Show (A, Int -> Int) > <~bRZsz NO instance~> > > ==> Show A > > ==> Show (Int -> Int) > > }}} > > A verbose version can explain each step > > {{{ > >> :elab +v Monoid (a -> b -> ([c], Sum Int) > Monoid (a -> b -> ([c], Sum Int)) -- Monoid b => Monoid (a -> b) > (‘GHC.Base’) > ==> Monoid (b -> ([c], Sum Int)) -- Monoid b => Monoid (a -> b) > (‘GHC.Base’) > ==> Monoid ([c], Sum Int) -- Monoid b => Monoid (a -> b) > (‘GHC.Base’) > ==> Monoid [c] -- Monoid [a] > (‘GHC.Base’) > ==> Monoid (Sum Int) -- Num a => Monoid (Sum a) > (‘Data.Monoid’) > ==> Num Int -- Num Int > (‘GHC.Num’) > }}} > > {{{ > >> :elab +v Num (Int, Float, Rational) > Num (Int, Float, Rational) -- (Num a, Num b, Num c) => Num (a, b, c) > (‘Data.NumInstances.Tuple’) > ==> Num Int -- Num Int > (‘GHC.Num’) > ==> Num Float -- Num Float > (‘GHC.Float’) > ==> Num Rational -- type Rational = Ratio Integer > (‘GHC.Real’) > = Num (Ration Integer) -- Integral a => Num (Ratio a) > (‘GHC.Real’) > ==> Integral Integer -- Integral Integer > (‘GHC.Real’) > }}} > > ---- > > Not the same idea but similar. Listing instance resolution that takes > place in an expression > > {{{ > >> :elab (+) @Int > from: (+) @Int > Num Int > }}} > {{{ > >> :elab2 comparing (length @[]) <> compare > from: length @[] > Foldable [] > > from: comparing (length @[]) > Ord Int > > from: comparing (length @[]) <> compare > Monoid ([a] -> [a] -> Ordering) > ==> Monoid ([a] -> Ordering) > ==> Monoid Ordering > }}} > {{{ > >> :elab2 ask 'a' > from: ask 'a' > MonadReader Char ((->) m) > ==> MonadReader Char ((->) Char) > }}} > > not sure about that last one, or how to visualize them but I think it > gives the right idea. New description: Another GHCi command (#15610) to trace the process of instance resolution for a constraint. This is already something people do by hand (ticket:10318#comment:6) and would be a great tool for explorers of Haskell This constraint ultimately boils down to lists being monoids and `Int` being a number {{{ >> :elab Monoid (a -> b -> ([c], Sum Int)) Monoid (a -> b -> ([c], Sum Int)) ==> Monoid (b -> ([c], Sum Int)) ==> Monoid ([c], Sum Int) ==> Monoid [c] ==> Monoid (Sum Int) ==> Num Int }}} If resolving the type class fails, it can pinpoint what caused it to fail {{{ >> data A >> :elab Show (A, Int -> Int) Show (A, Int -> Int) <~bRZsz NO instance~> ==> Show A ==> Show (Int -> Int) }}} A verbose version can explain each step {{{ >> :elab +v Monoid (a -> b -> ([c], Sum Int) Monoid (a -> b -> ([c], Sum Int)) -- Monoid b => Monoid (a -> b) (‘GHC.Base’) ==> Monoid (b -> ([c], Sum Int)) -- Monoid b => Monoid (a -> b) (‘GHC.Base’) ==> Monoid ([c], Sum Int) -- Monoid b => Monoid (a -> b) (‘GHC.Base’) ==> Monoid [c] -- Monoid [a] (‘GHC.Base’) ==> Monoid (Sum Int) -- Num a => Monoid (Sum a) (‘Data.Monoid’) ==> Num Int -- Num Int (‘GHC.Num’) }}} {{{ >> :elab +v Num (Int, Float, Rational) Num (Int, Float, Rational) -- (Num a, Num b, Num c) => Num (a, b, c) (‘Data.NumInstances.Tuple’) ==> Num Int -- Num Int (‘GHC.Num’) ==> Num Float -- Num Float (‘GHC.Float’) ==> Num Rational -- type Rational = Ratio Integer (‘GHC.Real’) = Num (Ration Integer) -- Integral a => Num (Ratio a) (‘GHC.Real’) ==> Integral Integer -- Integral Integer (‘GHC.Real’) }}} ---- Not the same idea but similar. Listing instance resolution that takes place in an expression {{{ >> :elab (+) @Int from: (+) @Int Num Int }}} {{{ >> :elab2 comparing (length @[]) <> compare from: length @[] Foldable [] from: comparing (length @[]) Ord Int from: comparing (length @[]) <> compare Monoid ([a] -> [a] -> Ordering) ==> Monoid ([a] -> Ordering) ==> Monoid Ordering }}} {{{ >> :elab2 ask 'a' from: ask 'a' MonadReader Char ((->) m) ==> MonadReader Char ((->) Char) }}} not sure about that last one, or how to visualize them but I think it gives the right idea. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 20:05:47 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 20:05:47 -0000 Subject: [GHC] #15613: GHCi command, tracing steps of instance resolution for Constraint or expression In-Reply-To: <051.315b513efc5cd955ece666611620c1e9@haskell.org> References: <051.315b513efc5cd955ece666611620c1e9@haskell.org> Message-ID: <066.adeb49fc9bf4ce216e7d3b95f734a66f@haskell.org> #15613: GHCi command, tracing steps of instance resolution for Constraint or expression -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: lowest | Milestone: Component: GHCi | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15610 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by monoidal): See also #9622. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 20:08:12 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 20:08:12 -0000 Subject: [GHC] #14391: Make the simplifier independent of the typechecker In-Reply-To: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> References: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> Message-ID: <061.02c519de014cabce06b00ade91ca4ddd@haskell.org> #14391: Make the simplifier independent of the typechecker -------------------------------------+------------------------------------- Reporter: nomeata | Owner: monoidal Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4503, Wiki Page: | Phab:D5135 -------------------------------------+------------------------------------- Comment (by monoidal): What if we moved the instance to `GhcPlugins`? I know it would be an orphan instance, but it would at least accomplish the goal. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 6 20:40:04 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 06 Sep 2018 20:40:04 -0000 Subject: [GHC] #15613: GHCi command, tracing steps of instance resolution for Constraint or expression In-Reply-To: <051.315b513efc5cd955ece666611620c1e9@haskell.org> References: <051.315b513efc5cd955ece666611620c1e9@haskell.org> Message-ID: <066.214ddb6f84bc3d53e984879e29726418@haskell.org> #15613: GHCi command, tracing steps of instance resolution for Constraint or expression -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: lowest | Milestone: Component: GHCi | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15610 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by Iceland_jack: Old description: > Another GHCi command (#15610) to trace the process of instance resolution > for a constraint. This is already something people do by hand > (ticket:10318#comment:6) and would be a great tool for explorers of > Haskell > > This constraint ultimately boils down to lists being monoids and `Int` > being a number > > {{{ > >> :elab Monoid (a -> b -> ([c], Sum Int)) > Monoid (a -> b -> ([c], Sum Int)) > ==> Monoid (b -> ([c], Sum Int)) > ==> Monoid ([c], Sum Int) > ==> Monoid [c] > ==> Monoid (Sum Int) > ==> Num Int > }}} > > If resolving the type class fails, it can pinpoint what caused it to fail > > {{{ > >> data A > >> :elab Show (A, Int -> Int) > Show (A, Int -> Int) > <~bRZsz NO instance~> > > ==> Show A > > ==> Show (Int -> Int) > > }}} > > A verbose version can explain each step > > {{{ > >> :elab +v Monoid (a -> b -> ([c], Sum Int) > Monoid (a -> b -> ([c], Sum Int)) -- Monoid b => Monoid (a -> b) > (‘GHC.Base’) > ==> Monoid (b -> ([c], Sum Int)) -- Monoid b => Monoid (a -> b) > (‘GHC.Base’) > ==> Monoid ([c], Sum Int) -- Monoid b => Monoid (a -> b) > (‘GHC.Base’) > ==> Monoid [c] -- Monoid [a] > (‘GHC.Base’) > ==> Monoid (Sum Int) -- Num a => Monoid (Sum a) > (‘Data.Monoid’) > ==> Num Int -- Num Int > (‘GHC.Num’) > }}} > > {{{ > >> :elab +v Num (Int, Float, Rational) > Num (Int, Float, Rational) -- (Num a, Num b, Num c) => Num (a, b, c) > (‘Data.NumInstances.Tuple’) > ==> Num Int -- Num Int > (‘GHC.Num’) > ==> Num Float -- Num Float > (‘GHC.Float’) > ==> Num Rational -- type Rational = Ratio Integer > (‘GHC.Real’) > = Num (Ration Integer) -- Integral a => Num (Ratio a) > (‘GHC.Real’) > ==> Integral Integer -- Integral Integer > (‘GHC.Real’) > }}} > > ---- > > Not the same idea but similar. Listing instance resolution that takes > place in an expression > > {{{ > >> :elab (+) @Int > from: (+) @Int > Num Int > }}} > {{{ > >> :elab2 comparing (length @[]) <> compare > from: length @[] > Foldable [] > > from: comparing (length @[]) > Ord Int > > from: comparing (length @[]) <> compare > Monoid ([a] -> [a] -> Ordering) > ==> Monoid ([a] -> Ordering) > ==> Monoid Ordering > }}} > {{{ > >> :elab2 ask 'a' > from: ask 'a' > MonadReader Char ((->) m) > ==> MonadReader Char ((->) Char) > }}} > > not sure about that last one, or how to visualize them but I think it > gives the right idea. New description: Another GHCi command (#15610), `:elab ` traces instance resolution for ``. This is already something people do by hand (ticket:10318#comment:6) and would be a great tool for explorers of Haskell This constraint ultimately boils down to lists being monoids and `Int` being a number {{{ >> :elab Monoid (a -> b -> ([c], Sum Int)) Monoid (a -> b -> ([c], Sum Int)) ==> Monoid (b -> ([c], Sum Int)) ==> Monoid ([c], Sum Int) ==> Monoid [c] ==> Monoid (Sum Int) ==> Num Int }}} If resolving the type class fails, it can pinpoint what caused it to fail {{{ >> data A >> :elab Show (A, Int -> Int) Show (A, Int -> Int) <~bRZsz NO instance~> ==> Show A ==> Show (Int -> Int) }}} A verbose version can explain each step {{{ >> :elab +v Monoid (a -> b -> ([c], Sum Int) Monoid (a -> b -> ([c], Sum Int)) -- Monoid b => Monoid (a -> b) (‘GHC.Base’) ==> Monoid (b -> ([c], Sum Int)) -- Monoid b => Monoid (a -> b) (‘GHC.Base’) ==> Monoid ([c], Sum Int) -- Monoid b => Monoid (a -> b) (‘GHC.Base’) ==> Monoid [c] -- Monoid [a] (‘GHC.Base’) ==> Monoid (Sum Int) -- Num a => Monoid (Sum a) (‘Data.Monoid’) ==> Num Int -- Num Int (‘GHC.Num’) }}} {{{ >> :elab +v Num (Int, Float, Rational) Num (Int, Float, Rational) -- (Num a, Num b, Num c) => Num (a, b, c) (‘Data.NumInstances.Tuple’) ==> Num Int -- Num Int (‘GHC.Num’) ==> Num Float -- Num Float (‘GHC.Float’) ==> Num Rational -- type Rational = Ratio Integer (‘GHC.Real’) = Num (Ration Integer) -- Integral a => Num (Ratio a) (‘GHC.Real’) ==> Integral Integer -- Integral Integer (‘GHC.Real’) }}} ---- Not the same idea but similar. Listing instance resolution that takes place in an expression {{{ >> :elab (+) @Int from: (+) @Int Num Int }}} {{{ >> :elab2 comparing (length @[]) <> compare from: length @[] Foldable [] from: comparing (length @[]) Ord Int from: comparing (length @[]) <> compare Monoid ([a] -> [a] -> Ordering) ==> Monoid ([a] -> Ordering) ==> Monoid Ordering }}} {{{ >> :elab2 ask 'a' from: ask 'a' MonadReader Char ((->) m) ==> MonadReader Char ((->) Char) }}} not sure about that last one, or how to visualize them but I think it gives the right idea. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 00:00:05 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 00:00:05 -0000 Subject: [GHC] #9622: GHCi command to solve a constraint In-Reply-To: <047.c9e54978cf24ee7d150efc16fa56ce28@haskell.org> References: <047.c9e54978cf24ee7d150efc16fa56ce28@haskell.org> Message-ID: <062.59594ba218a41b1222674e8e1611a822@haskell.org> #9622: GHCi command to solve a constraint -------------------------------------+------------------------------------- Reporter: monoidal | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.8.3 checker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15613 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Iceland_jack): * cc: Iceland_jack (added) * related: => #15613 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 00:10:23 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 00:10:23 -0000 Subject: [GHC] #15613: GHCi command, tracing steps of instance resolution for Constraint or expression In-Reply-To: <051.315b513efc5cd955ece666611620c1e9@haskell.org> References: <051.315b513efc5cd955ece666611620c1e9@haskell.org> Message-ID: <066.bcb35560109aaabaa3815c8ac0115692@haskell.org> #15613: GHCi command, tracing steps of instance resolution for Constraint or expression -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: lowest | Milestone: Component: GHCi | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15610 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): Replying to [comment:2 monoidal]: Yeah this is almost identical to monoidal's #9622. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 06:21:30 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 06:21:30 -0000 Subject: [GHC] #3427: control what sort of entity a deprecated pragma applies to In-Reply-To: <044.6e5c26a8435c2fcde3f9de3ab4769428@haskell.org> References: <044.6e5c26a8435c2fcde3f9de3ab4769428@haskell.org> Message-ID: <059.b4453046773597369c47e28f26474279@haskell.org> #3427: control what sort of entity a deprecated pragma applies to -------------------------------------+------------------------------------- Reporter: igloo | Owner: nineonine Type: feature request | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 6.10.4 Resolution: | Keywords: deprecate | warning, newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5126 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * differential: => Phab:D5126 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 07:40:27 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 07:40:27 -0000 Subject: [GHC] #3427: control what sort of entity a deprecated pragma applies to In-Reply-To: <044.6e5c26a8435c2fcde3f9de3ab4769428@haskell.org> References: <044.6e5c26a8435c2fcde3f9de3ab4769428@haskell.org> Message-ID: <059.f7247b2fdd2cdfd55608a7938e88c07c@haskell.org> #3427: control what sort of entity a deprecated pragma applies to -------------------------------------+------------------------------------- Reporter: igloo | Owner: nineonine Type: feature request | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 6.10.4 Resolution: | Keywords: deprecate | warning, newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5126 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Thanks for doing this! But before I can review this I need a specification of what the change is, exactly. It's hard to review code without knowing exactly what it is trying to achieve. In fact, it should really be a GHC proposal -- it's clearly a user-facing change. It'd be an easy proposal to write, and could be reviewed quickly. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 08:08:41 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 08:08:41 -0000 Subject: [GHC] #15599: typeclass inference depends on whether a module is exposed. In-Reply-To: <047.dd916b476f2fd0f26c1766607c70f5c2@haskell.org> References: <047.dd916b476f2fd0f26c1766607c70f5c2@haskell.org> Message-ID: <062.1cc64c19a9f953a04b2167151d7e046e@haskell.org> #15599: typeclass inference depends on whether a module is exposed. -------------------------------------+------------------------------------- Reporter: gleachkr | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.3 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > The difference that made me try the package-db route was that it seems (from a fair amount of experimentation) that you get checkFlag=False when the modules from GHC-Repro are not compiled by ghci, but just included, What does "just included" mean? Can you give a sequence of ghc commands that demonstrates the problem? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 08:10:49 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 08:10:49 -0000 Subject: [GHC] #9476: Implement late lambda-lifting In-Reply-To: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> References: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> Message-ID: <061.9fac05f882fba512cd4942f4babb7f04@haskell.org> #9476: Implement late lambda-lifting -------------------------------------+------------------------------------- Reporter: simonpj | Owner: sgraf Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #8763 #13286 | Differential Rev(s): Wiki Page: LateLamLift | -------------------------------------+------------------------------------- Comment (by simonpj): > -fstg-lift-lams-known: Allow turning known into unknown calls. In your example, you say that we might float f but not g. But why don't we float g? Anyway, I agree; it is Very Bad to turn known into unknown calls. Let's not do that. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 08:11:15 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 08:11:15 -0000 Subject: [GHC] #11284: Lambda-lifting fails in simple Text example In-Reply-To: <046.c8fcc117f2d6aac596767173f5e9481b@haskell.org> References: <046.c8fcc117f2d6aac596767173f5e9481b@haskell.org> Message-ID: <061.84a1074548b239717ccf0ebaea3f6e1c@haskell.org> #11284: Lambda-lifting fails in simple Text example -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: duplicate | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #5945, #11318 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by sgraf: Old description: > Consider the example (which uses `Text`; I'm working on finding a more > minimal example), > {{{#!hs > import Data.Char (isSpace) > import Data.List (foldl') > import GHC.Exts (build) > import qualified Data.Text as T > > longestWord :: T.Text -> Int > longestWord t = foldl' max 0 $ map T.length $ fusedWords t > > fusedWords :: T.Text -> [T.Text] > fusedWords t0 = build $ \cons nil -> > let go !t > | T.null t = nil > | otherwise = let (w, rest) = T.span (not . isSpace) t > in cons w (go $ T.dropWhile isSpace rest) > in go t0 > > -- For reference > data Text = Text > {-# UNPACK #-} !A.Array -- payload (Word16 elements) > {-# UNPACK #-} !Int -- offset (units of Word16, not > Char) > {-# UNPACK #-} !Int -- length (units of Word16, not > Char) > }}} > > `longestWord` here produces the simplified Core, > > {{{#!hs > Ticket.$wgo :: GHC.Prim.ByteArray# -> GHC.Prim.Int# -> GHC.Prim.Int# -> > [T.Text] > Ticket.$wgo = ... > > -- > $wgo1 xs n = foldl' (\a b -> max a $ T.length b) n xs > Ticket.$wgo1 :: [T.Text] -> GHC.Prim.Int# -> GHC.Prim.Int# > Ticket.$wgo1 = > \ (w_s4GJ :: [T.Text]) (ww_s4GN :: GHC.Prim.Int#) -> > case w_s4GJ of _ { > [] -> ww_s4GN; > : y_a4vC ys_a4vD -> > case y_a4vC > of _ { Data.Text.Internal.Text dt_a4jP dt1_a4jQ dt2_a4jR -> > let { > a_a4jO :: GHC.Prim.Int# > a_a4jO = GHC.Prim.+# dt1_a4jQ dt2_a4jR } in > letrec { > -- For the love of all that is good, why must you allocate? > -- > -- This loop is essentially `T.length`, the first argument > being > -- the length accumulator and the second being an index into > the > -- ByteArray# > $wloop_length_s4GI :: GHC.Prim.Int# -> GHC.Prim.Int# -> > GHC.Prim.Int# > $wloop_length_s4GI = > \ (ww1_s4Gz :: GHC.Prim.Int#) (ww2_s4GD :: GHC.Prim.Int#) -> > -- Have we reached the end of the Text? > case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.>=# ww2_s4GD > a_a4jO) > of _ { > False -> { > ... > -- in this body there are few cases analyses which > -- classify the code-points we encounter. The branches > -- are recursive calls of the form > $wloop_length_s4GI (GHC.Prim.+# ww1_s4Gz 1) > (GHC.Prim.+# ww2_s4GD 1) > ... > True -> ww1_s4Gz > }; } in > case $wloop_length_s4GI 0 dt1_a4jQ of ww1_s4GH { __DEFAULT -> > case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<=# ww_s4GN ww1_s4GH) > of _ { > False -> Ticket.$wgo1 ys_a4vD ww_s4GN; > True -> Ticket.$wgo1 ys_a4vD ww1_s4GH > } > } > } > } > > longestWord :: T.Text -> Int > longestWord = > \ (w_s4GT :: T.Text) -> > case w_s4GT > of _ { Data.Text.Internal.Text ww1_s4GW ww2_s4GX ww3_s4GY -> > case Ticket.$wgo1 (Ticket.$wgo ww1_s4GW ww2_s4GX ww3_s4GY) 0 > of ww4_s4H2 { __DEFAULT -> > GHC.Types.I# ww4_s4H2 > } > } > }}} > > Notice `$wloop_length_s4GI`: It should be a nice tight loop counting > Unicode characters in the array `dt_a4jP` until it arrives at its end. > However, GHC fails to lambda-lift this closure, thereby turning it into > an allocating operation! Oh no! New description: Consider the example (which uses `Text`; I'm working on finding a more minimal example), {{{#!hs {-# LANGUAGE BangPatterns #-} module T11284 where import Data.Char (isSpace) import Data.List (foldl') import GHC.Exts (build) import qualified Data.Text as T import qualified Data.Text.Array as A longestWord :: T.Text -> Int longestWord t = foldl' max 0 $ map T.length $ fusedWords t fusedWords :: T.Text -> [T.Text] fusedWords t0 = build $ \cons nil -> let go !t | T.null t = nil | otherwise = let (w, rest) = T.span (not . isSpace) t in cons w (go $ T.dropWhile isSpace rest) in go t0 -- For reference data Text = Text {-# UNPACK #-} !A.Array -- payload (Word16 elements) {-# UNPACK #-} !Int -- offset (units of Word16, not Char) {-# UNPACK #-} !Int -- length (units of Word16, not Char) }}} `longestWord` here produces the simplified Core, {{{#!hs Ticket.$wgo :: GHC.Prim.ByteArray# -> GHC.Prim.Int# -> GHC.Prim.Int# -> [T.Text] Ticket.$wgo = ... -- > $wgo1 xs n = foldl' (\a b -> max a $ T.length b) n xs Ticket.$wgo1 :: [T.Text] -> GHC.Prim.Int# -> GHC.Prim.Int# Ticket.$wgo1 = \ (w_s4GJ :: [T.Text]) (ww_s4GN :: GHC.Prim.Int#) -> case w_s4GJ of _ { [] -> ww_s4GN; : y_a4vC ys_a4vD -> case y_a4vC of _ { Data.Text.Internal.Text dt_a4jP dt1_a4jQ dt2_a4jR -> let { a_a4jO :: GHC.Prim.Int# a_a4jO = GHC.Prim.+# dt1_a4jQ dt2_a4jR } in letrec { -- For the love of all that is good, why must you allocate? -- -- This loop is essentially `T.length`, the first argument being -- the length accumulator and the second being an index into the -- ByteArray# $wloop_length_s4GI :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# $wloop_length_s4GI = \ (ww1_s4Gz :: GHC.Prim.Int#) (ww2_s4GD :: GHC.Prim.Int#) -> -- Have we reached the end of the Text? case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.>=# ww2_s4GD a_a4jO) of _ { False -> { ... -- in this body there are few cases analyses which -- classify the code-points we encounter. The branches -- are recursive calls of the form $wloop_length_s4GI (GHC.Prim.+# ww1_s4Gz 1) (GHC.Prim.+# ww2_s4GD 1) ... True -> ww1_s4Gz }; } in case $wloop_length_s4GI 0 dt1_a4jQ of ww1_s4GH { __DEFAULT -> case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.<=# ww_s4GN ww1_s4GH) of _ { False -> Ticket.$wgo1 ys_a4vD ww_s4GN; True -> Ticket.$wgo1 ys_a4vD ww1_s4GH } } } } longestWord :: T.Text -> Int longestWord = \ (w_s4GT :: T.Text) -> case w_s4GT of _ { Data.Text.Internal.Text ww1_s4GW ww2_s4GX ww3_s4GY -> case Ticket.$wgo1 (Ticket.$wgo ww1_s4GW ww2_s4GX ww3_s4GY) 0 of ww4_s4H2 { __DEFAULT -> GHC.Types.I# ww4_s4H2 } } }}} Notice `$wloop_length_s4GI`: It should be a nice tight loop counting Unicode characters in the array `dt_a4jP` until it arrives at its end. However, GHC fails to lambda-lift this closure, thereby turning it into an allocating operation! Oh no! -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 08:13:37 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 08:13:37 -0000 Subject: [GHC] #9476: Implement late lambda-lifting In-Reply-To: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> References: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> Message-ID: <061.6568656a3271efb4adb04591bf7bc4b6@haskell.org> #9476: Implement late lambda-lifting -------------------------------------+------------------------------------- Reporter: simonpj | Owner: sgraf Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #8763 #13286 | Differential Rev(s): Wiki Page: LateLamLift | -------------------------------------+------------------------------------- Comment (by simonpj): > Ah, but one of them (the last, in particular) is a 'void' parameter (so, slow call pattern pppppv), which is completely erased from the resulting Cmm! OK, so the conclusion is: don't count void args in the count? I agree! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 08:14:53 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 08:14:53 -0000 Subject: [GHC] #14391: Make the simplifier independent of the typechecker In-Reply-To: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> References: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> Message-ID: <061.61dfd76ac7b1f698f9d409f3401bf356@haskell.org> #14391: Make the simplifier independent of the typechecker -------------------------------------+------------------------------------- Reporter: nomeata | Owner: monoidal Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4503, Wiki Page: | Phab:D5135 -------------------------------------+------------------------------------- Comment (by nomeata): I think the plugin authors would be fine with that. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 08:16:53 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 08:16:53 -0000 Subject: [GHC] #13600: surprising error message with bang pattern In-Reply-To: <051.cb1136f932f929f97ddeb5e4dd8a6304@haskell.org> References: <051.cb1136f932f929f97ddeb5e4dd8a6304@haskell.org> Message-ID: <066.662657b009689cd468436d29313cad1d@haskell.org> #13600: surprising error message with bang pattern -------------------------------------+------------------------------------- Reporter: andrewufrank | Owner: v0d1ch Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: BangPatterns, | newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: #15166, #15458 | Differential Rev(s): Phab:D5040 Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): Just hit this with the following program missing `-XBangPatterns` from #11284: {{{ module T11284 where import Data.Char (isSpace) import Data.List (foldl') import GHC.Exts (build) import qualified Data.Text as T import qualified Data.Text.Array as A longestWord :: T.Text -> Int longestWord t = foldl' max 0 $ map T.length $ fusedWords t fusedWords :: T.Text -> [T.Text] fusedWords t0 = build $ \cons nil -> let go !t | T.null t = nil | otherwise = let (w, rest) = T.span (not . isSpace) t in cons w (go $ T.dropWhile isSpace rest) in go t0 -- For reference data Text = Text {-# UNPACK #-} !A.Array -- payload (Word16 elements) {-# UNPACK #-} !Int -- offset (units of Word16, not Char) {-# UNPACK #-} !Int -- length (units of Word16, not Char) }}} Complains with {{{ T11284.hs:18:6: error: Variable not in scope: go :: T.Text -> b | 18 | in go t0 }}} I'd say a warning when there's no space in a binary operator definition for `(!)` before its second parameter is the way to go. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 08:24:17 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 08:24:17 -0000 Subject: [GHC] #15578: Honour INLINE pragmas on 0-arity bindings In-Reply-To: <046.e84edd9f62d6ef84f8f7c7aedfa45ace@haskell.org> References: <046.e84edd9f62d6ef84f8f7c7aedfa45ace@haskell.org> Message-ID: <061.632655b69efaa22b83c74758d7e4b2b2@haskell.org> #15578: Honour INLINE pragmas on 0-arity bindings -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15519 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): I have `test3 src = runTokenParser testGrammar src`, is that equivalent? In any case, I'm getting good performance now with the patch applied as written. Given 3 binaries in the cwd, compiled with, unpatched and patched HEAD respectively (`test-HEAD` vs. `test-patched`), I get: {{{#!sh for TAG in HEAD patched; do for TEST in 0 1 3; do echo "$TAG / test$TEST"; ./test-$TAG $TEST; done; done HEAD / test0 387.417648 HEAD / test1 7769.65168 HEAD / test3 7769.16221 patched / test0 385.068842 patched / test1 370.170719 patched / test3 396.022899 }}} So the patched version outperforms the unpatched one by a factor of about 20 on the `test1` and `test3` test cases. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 08:28:53 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 08:28:53 -0000 Subject: [GHC] #13600: surprising error message with bang pattern In-Reply-To: <051.cb1136f932f929f97ddeb5e4dd8a6304@haskell.org> References: <051.cb1136f932f929f97ddeb5e4dd8a6304@haskell.org> Message-ID: <066.b675231458e163dea6bc7014b1f7baa3@haskell.org> #13600: surprising error message with bang pattern -------------------------------------+------------------------------------- Reporter: andrewufrank | Owner: v0d1ch Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: BangPatterns, | newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: #15166, #15458 | Differential Rev(s): Phab:D5040 Wiki Page: | -------------------------------------+------------------------------------- Comment (by v0d1ch): Thank you for the additional information! I am currently digging trough parser trying to find a place where this check should be added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 08:34:39 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 08:34:39 -0000 Subject: [GHC] #11284: Lambda-lifting fails in simple Text example In-Reply-To: <046.c8fcc117f2d6aac596767173f5e9481b@haskell.org> References: <046.c8fcc117f2d6aac596767173f5e9481b@haskell.org> Message-ID: <061.9027f0fc4dc39cd256a3e7c5c91d15e4@haskell.org> #11284: Lambda-lifting fails in simple Text example -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #5945, #11318 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by sgraf): * keywords: LateLamLift => Comment: There's nothing to lift here anymore, all occuring functions turned into join points and the only actual let bindings in STG output are thunks, which can't be lifted. Here's an example run on `/usr/share/dict/words` (with an appropriate `main`): {{{ $ ./Main +RTS -s < /usr/share/dict/words 23 33,832,464 bytes allocated in the heap 24,088 bytes copied during GC 2,011,952 bytes maximum residency (2 sample(s)) 163,024 bytes maximum slop 1 MB total memory in use (0 MB lost due to fragmentation) Tot time (elapsed) Avg pause Max pause Gen 0 28 colls, 0 par 0.000s 0.000s 0.0000s 0.0000s Gen 1 2 colls, 0 par 0.000s 0.000s 0.0001s 0.0002s INIT time 0.000s ( 0.000s elapsed) MUT time 0.012s ( 0.012s elapsed) GC time 0.001s ( 0.000s elapsed) EXIT time 0.000s ( 0.000s elapsed) Total time 0.013s ( 0.013s elapsed) %GC time 0.0% (0.0% elapsed) Alloc rate 2,822,899,212 bytes per MUT second Productivity 95.0% of total user, 95.5% of total elapsed }}} Strange enough, the `Data.Text.Lazy` variant of this is much slower and allocates much more, when I actually thought it would cope better with `getContents`. Whatever, this doesn't seem relevant to LateLamLift anymore. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 08:39:32 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 08:39:32 -0000 Subject: [GHC] #9476: Implement late lambda-lifting In-Reply-To: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> References: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> Message-ID: <061.208b3017e0bb0eae9808db6b0ae647dd@haskell.org> #9476: Implement late lambda-lifting -------------------------------------+------------------------------------- Reporter: simonpj | Owner: sgraf Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #8763 #13286 | Differential Rev(s): Wiki Page: LateLamLift | -------------------------------------+------------------------------------- Comment (by simonpj): The non-recursive case > f-5-: This varied max number of non-recursive args between 5 and 10 (attachment:nonrec-5-6-8-10. Allowing up to 8 parameters had great effect on allocations in cichelli (-10.4%), Hmm. Consider {{{ let f x = e in ...(f e1)...(f e2)... }}} where `e` has a lot of free vars `y1` .. `y20`. If we lift we get a top- level `f` with 21 args, and the calls look like: {{{ ...(f y1 .. y20 e1) ... (f y1 .. y20 e2)... }}} Now * In the original form we store `y1`..`y20` into the function closure for `f`, once. * In the lifted form we store (most of) `y1`..`y20` on the stack, once for each call. So if we had a lot of calls, there's be more memory traffic. Plus of course, any case-expression evals would need to save `y1`..`y20` on the stack, and the reload them to make the call... I was thinking that maybe for non-rec functions we could claim that lifting was a win regardless of the number of parameters, but I don't think that's true. So it's a bit surprising to me that even with a threshold of 10 we have such a small hit on instruction count. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 08:49:02 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 08:49:02 -0000 Subject: [GHC] #9476: Implement late lambda-lifting In-Reply-To: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> References: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> Message-ID: <061.7577a1c4d95bab7321aa25c924eab373@haskell.org> #9476: Implement late lambda-lifting -------------------------------------+------------------------------------- Reporter: simonpj | Owner: sgraf Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #8763 #13286 | Differential Rev(s): Wiki Page: LateLamLift | -------------------------------------+------------------------------------- Comment (by simonpj): > iii) Abstract (over-)saturated applications: I agree. Let's do it. > vi> Use one-shot info: I took a quick look at Nick's code. It seemed to be to do with NOT floating a binding that looked like {{{ f = \x[oneshot]. blah }}} I'm not sure why - and I think it'd irrelevant by the time we get to STG. So yes, ignore this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 08:52:27 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 08:52:27 -0000 Subject: [GHC] #9476: Implement late lambda-lifting In-Reply-To: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> References: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> Message-ID: <061.f967e440cb5cc7cb00c03d1b3ab1d18c@haskell.org> #9476: Implement late lambda-lifting -------------------------------------+------------------------------------- Reporter: simonpj | Owner: sgraf Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #8763 #13286 | Differential Rev(s): Wiki Page: LateLamLift | -------------------------------------+------------------------------------- Comment (by simonpj): * Would you like to publish figures for your best option (`-f-5-5`, don't count void args, float over-sat apps)? * What happens to binary sizes? * I think you should write a paper! It's very easy to forget all the things that are paged into your head at the moment. Get them written down before you forget them! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 09:08:55 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 09:08:55 -0000 Subject: [GHC] #9476: Implement late lambda-lifting In-Reply-To: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> References: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> Message-ID: <061.711a5fe9036c619746786e349018097c@haskell.org> #9476: Implement late lambda-lifting -------------------------------------+------------------------------------- Reporter: simonpj | Owner: sgraf Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #8763 #13286 | Differential Rev(s): Wiki Page: LateLamLift | -------------------------------------+------------------------------------- Comment (by sgraf): Replying to [comment:28 simonpj]: > > -fstg-lift-lams-known: Allow turning known into unknown calls. > > In your example, you say that we might float `f` but not `g`. But why don't we float `g`? Because at the time we handled `g`, it (hypothetically) was deemed non- beneficial to lift. It might lead to more allocation or hurt some other heuristic. Of course one could argue that lifting ''both'' bindings could be a win. Our decision strategy is greedy in that regard; There's no backtracking involved. We transform expressions going from outer to inner, at each step taking into account the lifting decisions we already made (and which we don't question or undo). So, for that example in particular, the assumption was that we examined `g`, decided not to lift it and then look at `f` knowing that `g` won't be lifted. > > lifting go to top-level will result in abstracting over `$warg`, > > Why didn't we float `$warg`? Same reasoning. Because we decided earlier that the lift might not be worthwhile. I could look at some debug output to see what was the reason(s) for `$warg` if you are really interested. Replying to [comment:29 simonpj]: > > Ah, but one of them (the last, in particular) is a 'void' parameter (so, slow call pattern pppppv), which is completely erased from the resulting Cmm! > > OK, so the conclusion is: don't count void args when counting args and comparing with the threshold? I agree! Yes, exactly. See https://github.com/sgraf812/ghc/blob/9b9260c1d45d127edf9ebdfe04a3daaff24a9dea/compiler/simplStg/StgLiftLams/Analysis.hs#L310 Replying to [comment:30 simonpj]: > The non-recursive case > > So it's a bit surprising to me that even with a threshold of 10 we have > such a small hit on instruction count. I was wondering the same thing. I ''think'' the other heuristics (https://github.com/sgraf812/ghc/blob/9b9260c1d45d127edf9ebdfe04a3daaff24a9dea/compiler/simplStg/StgLiftLams/Analysis.hs#L228-L235, for completeness) fire way too often to allow non-recursive calls with 20 arguments. Consider the impact on allocations: When we lift such a function, all 20ish free variables would have to be made available at all call sites, leading to a massive increase in closure allocation for closures around the actual call sites. Example {{{ let f = [x1...x20] \[a b c] -> ... g = [f y] \z -> f y y z in map g [1,2,3] }}} Assuming for the sake of the example that `g` wouldn't be lifted to top- level itself (it's just a PAP of `f`), lifting `f` would just shift the whole closure into `g`'s closure. In general, there could be arbitrary more closures between `f`s binding site and its call sites, each of which would have to carry `f`s former free variables, should we decide to lift it. I could try and measure with the allocation heuristic and the max args heuristic turned off, to see if we get more chaotic results. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 09:13:17 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 09:13:17 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.3f142e94d14a2aaef48ac15d08469beb@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > But Simon's approach applied to your patch doesn't Gah! This zombie keeps rising from the dead. I suggest '''Step 1''': improve `tyCoVarsOfType`. * Apply my patch to HEAD, with the fix in `ty_co_vars_of_co_var`. * Check that it's a win -- generally perf should improve slightly * Commit Now move on to this ticket '''Step 2:''' deal with `Note [Closing over free variable kinds]` (this note is in Richard's original patch). This is a change that fixes an outright bug, albeit one that has not been reported. I think it is nothing to do with the original `updateRole` problem. * Invite Richard to implement `Note [Closing over free variable kinds]` in `TyCoRep`, based on his patch. This will take him (or me) 20 mins. I think the only changes are in `TyCoRep`. * Do perf tests. '''Step 3'''. Back to this ticket and `updateRole`: * Apply the rest of Richard's patch, ''except'' the stuff in `TyCoRep` * Test -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 09:14:15 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 09:14:15 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.4db9f7f3ffdfc4275afa3db24c956969@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Richard, in the original patch you say > Also while working on this, I noticed that GHC wasn't doing its best job at keeping left-to-right ordering of type variables in cases where it doesn't really matter, but still would be nice. I've made some improvements in this area. Where exactly is this change?? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 09:15:32 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 09:15:32 -0000 Subject: [GHC] #9476: Implement late lambda-lifting In-Reply-To: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> References: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> Message-ID: <061.52c8cd91305895ea3789fc167ecfa57b@haskell.org> #9476: Implement late lambda-lifting -------------------------------------+------------------------------------- Reporter: simonpj | Owner: sgraf Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #8763 #13286 | Differential Rev(s): Wiki Page: LateLamLift | -------------------------------------+------------------------------------- Changes (by sgraf): * Attachment "f-5-5.txt" added. Don't turn known into unknown calls, allow max 5 (non-)recursive non-void parameters after lifting, don't lift things with undersaturated applications or partial applications -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 09:28:26 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 09:28:26 -0000 Subject: [GHC] #9476: Implement late lambda-lifting In-Reply-To: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> References: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> Message-ID: <061.68b540742d969b7249fa55b10e4e0155@haskell.org> #9476: Implement late lambda-lifting -------------------------------------+------------------------------------- Reporter: simonpj | Owner: sgraf Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #8763 #13286 | Differential Rev(s): Wiki Page: LateLamLift | -------------------------------------+------------------------------------- Comment (by sgraf): Replying to [comment:32 simonpj]: > * Would you like to publish figures for your best option (`-f-5-5`, don't count void args, float over-sat apps)? I'm currently re-running benchmarks with the new void args thing, but I suspect that the results from comment:23 are pretty much the same, except for `fibheaps`. All results with at least 1% change: {{{ -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- anna -1.1% -0.4% atom -0.8% -1.1% circsim -1.0% -0.7% clausify -1.9% -0.4% cryptarithm1 -2.8% -7.9% cryptarithm2 -4.0% -2.4% exact-reals -2.1% -0.0% expert -1.0% -0.0% fft2 -1.0% -0.3% fibheaps -1.4% -0.7% fluid -1.5% -0.6% hidden -1.0% -0.6% infer -0.6% -1.1% k-nucleotide -0.0% +2.4% kahan -0.4% -2.0% lcss -0.1% -5.8% mate -8.4% -3.5% mkhprog -1.3% -0.1% n-body -20.2% -0.0% nucleic2 -1.0% -0.1% queens -17.7% -0.8% typecheck -2.7% -1.8% -------------------------------------------------------------------------------- Min -20.2% -7.9% Max +0.0% +2.4% Geometric Mean -0.8% -0.3% }}} > * What happens to binary sizes? Good question, given that we push work from binding sites to call sites. It seems they consistently went down by 0.1%. I wonder why? Maybe some heap checks somewhere in `base`? Or is it just a wibble? Maybe I should re-evaluate my baseline... > > * I think you should write a paper! It's very easy to forget all the things that are paged into your head at the moment. Get them written down before you forget them! Yes, I'd love to! In fact, I started something at https://github.com/sgraf812/late-lam-lift. It's a bit rough and only has a section about the decision heuristics at the moment, but I'll post when there's something you could have a look at. In fact, I'd very much like it if Nicolas and/or you would co-author that with me, as I haven't really written a paper before. I think this would be an excellent exercise. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 10:39:09 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 10:39:09 -0000 Subject: [GHC] #9476: Implement late lambda-lifting In-Reply-To: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> References: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> Message-ID: <061.dc443264b20d120bc1465755403e39a0@haskell.org> #9476: Implement late lambda-lifting -------------------------------------+------------------------------------- Reporter: simonpj | Owner: sgraf Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #8763 #13286 | Differential Rev(s): Wiki Page: LateLamLift | -------------------------------------+------------------------------------- Comment (by simonpj): > I could try and measure with the allocation heuristic ... turned off, to see if we get more chaotic results. What is the "allocation heuristic"? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 10:44:12 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 10:44:12 -0000 Subject: [GHC] #11284: Lambda-lifting fails in simple Text example In-Reply-To: <046.c8fcc117f2d6aac596767173f5e9481b@haskell.org> References: <046.c8fcc117f2d6aac596767173f5e9481b@haskell.org> Message-ID: <061.8b692056817c833f08c5fc1012e49e3b@haskell.org> #11284: Lambda-lifting fails in simple Text example -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #5945, #11318 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I suppose we didn't have join points 3 yrs ago. Suppose `$wloop` wasn't a join point; would LLF lift it? I expect so, and I suppose we could find out by switching off join points. (We don't have a way to do that right now, alas.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 10:47:49 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 10:47:49 -0000 Subject: [GHC] #15578: Honour INLINE pragmas on 0-arity bindings In-Reply-To: <046.e84edd9f62d6ef84f8f7c7aedfa45ace@haskell.org> References: <046.e84edd9f62d6ef84f8f7c7aedfa45ace@haskell.org> Message-ID: <061.7fe016618d5000444e64548ccc9ce026@haskell.org> #15578: Honour INLINE pragmas on 0-arity bindings -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15519 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > I have test3 src = runTokenParser testGrammar src, is that equivalent? The `oneShot` makes it more robust. Anyway this seems enough to commit the patch (having checked that nofib doesn't budge). I doubt you'll see any changes there at all. Thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 10:56:19 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 10:56:19 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.86c8c3d8f830637a2216e5b80939ad02@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Replying to [comment:108 simonpj]: > > But Simon's approach applied to your patch doesn't > > Gah! This zombie keeps rising from the dead. > > I suggest > > '''Step 1''': improve `tyCoVarsOfType`. > > * Apply my patch to HEAD, with the fix in `ty_co_vars_of_co_var`. > * Check that it's a win -- generally perf should improve slightly > * Commit Yes. This should be fairly straightforward - that part of the whole thing I completely understand, so I should be able to do that rather easily. It gets a bit tricky combining this part with other changes that also factor out a `tcvs_of_type` style worker, but I believe none of these changes are currently in HEAD. > Now move on to this ticket > > '''Step 2:''' deal with `Note [Closing over free variable kinds]` (this note is in Richard's original patch). > > This is a change that fixes an outright bug, albeit one that has not been reported. I think it is nothing to do with the original `updateRole` problem. > > * Invite Richard to implement `Note [Closing over free variable kinds]` in `TyCoRep`, based on his patch. This will take him (or me) 20 mins. I think the only changes are in `TyCoRep`. > * Do perf tests. > > '''Step 3'''. Back to this ticket and `updateRole`: > > * Apply the rest of Richard's patch, ''except'' the stuff in `TyCoRep` > * Test Is Step 2 the part where you close over kinds at the end rather than in between? Because that also seems fairly straightforward, it's just a simple `closeOverKinds` implementation, and then factoring out workers for the various `tyCoVarsOf...` functions and wrapping them with `closeOverKinds` appropriately. The rest of Richard's patch is what goes over my head. Other than that, yes, this sounds like a solid plan. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 11:01:33 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 11:01:33 -0000 Subject: [GHC] #15614: Test suite should show reason for skipping a test Message-ID: <043.72eff6af976f2c4f90c009736f7513f9@haskell.org> #15614: Test suite should show reason for skipping a test -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Test Suite | Version: 8.5 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 want to add a GHCi test, but it's a bit tricky to run the test so I use a make rule and use `run_command`, like this: {{{ test('UnsafeReenterGhci', [only_ways(['ghci']), exit_code(1), extra_files(['UnsafeReenter.hs', 'UnsafeReenterC.c'])], run_command, ['$MAKE -s --no-print-directory UnsafeReenterGhci']) }}} The important part is `run_command` and `only_ways(['ghci'])`. The problem is that it's impossible to run this test, because by default a `run_command` test can only be run in normal way (see test_common_work() in testlib.py), but there's no way to know this without reading the source code. Having better documentation might help, but I think the test driver should print why a test is skipped (maybe only in verbose mode -- if such a mode exists). In our case it should print something like "Test is only run in 'normal' way" (because `run_command` tests only run in 'normal' way). Correct version of this test is: {{{ test('UnsafeReenterGhci', [extra_ways(['ghci']), only_ways(['ghci']), exit_code(1), extra_files(['UnsafeReenter.hs', 'UnsafeReenterC.c'])], run_command, ['$MAKE -s --no-print-directory UnsafeReenterGhci']) }}} The `extra_ways` makes the test driver consider running the test in `ghci` way, `only_ways` is to avoid running it in `normal` way (the default and only way for `run_command`). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 11:05:56 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 11:05:56 -0000 Subject: [GHC] #15578: Honour INLINE pragmas on 0-arity bindings In-Reply-To: <046.e84edd9f62d6ef84f8f7c7aedfa45ace@haskell.org> References: <046.e84edd9f62d6ef84f8f7c7aedfa45ace@haskell.org> Message-ID: <061.4f0bcb3c3434c32f40484bf750895e3b@haskell.org> #15578: Honour INLINE pragmas on 0-arity bindings -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15519 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Alright, had to change `boring_ok=False` to `True` in one test. Patch incoming, maybe you could take a few seconds to verify that this is OK? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 11:11:43 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 11:11:43 -0000 Subject: [GHC] #14743: `UnsafeReenter` test hangs In-Reply-To: <043.cf7e44020eaed9a14557dc6193e09fc7@haskell.org> References: <043.cf7e44020eaed9a14557dc6193e09fc7@haskell.org> Message-ID: <058.8d56796d88bae57a7010c091799e3286@haskell.org> #14743: `UnsafeReenter` test hangs -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.5 Resolution: invalid | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: new => closed * resolution: => invalid Comment: This is expected, see #14912 comment:3. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 11:11:59 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 11:11:59 -0000 Subject: [GHC] #14912: UnsafeReenter test fails with threaded1 and threaded2 In-Reply-To: <048.0d06801876b264a33d0020ade629babb@haskell.org> References: <048.0d06801876b264a33d0020ade629babb@haskell.org> Message-ID: <063.c2ee92a001706bddc6c3653cd3d041ea@haskell.org> #14912: UnsafeReenter test fails with threaded1 and threaded2 -----------------------------------+-------------------------------------- Reporter: alpmestan | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Runtime System | Version: 8.5 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14743 | Differential Rev(s): Phab:D5136 Wiki Page: | -----------------------------------+-------------------------------------- Changes (by osa1): * status: new => patch * differential: => Phab:D5136 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 11:27:23 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 11:27:23 -0000 Subject: [GHC] #15578: Honour INLINE pragmas on 0-arity bindings In-Reply-To: <046.e84edd9f62d6ef84f8f7c7aedfa45ace@haskell.org> References: <046.e84edd9f62d6ef84f8f7c7aedfa45ace@haskell.org> Message-ID: <061.a1339b60ed8fc7746cce4d06baadb067@haskell.org> #15578: Honour INLINE pragmas on 0-arity bindings -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15519 | Differential Rev(s): D5137 Wiki Page: | -------------------------------------+------------------------------------- Changes (by tdammers): * status: new => patch * differential: => D5137 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 11:34:04 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 11:34:04 -0000 Subject: [GHC] #9476: Implement late lambda-lifting In-Reply-To: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> References: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> Message-ID: <061.c417e1b8497eb206b2e678349242eb1c@haskell.org> #9476: Implement late lambda-lifting -------------------------------------+------------------------------------- Reporter: simonpj | Owner: sgraf Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #8763 #13286 | Differential Rev(s): Wiki Page: LateLamLift | -------------------------------------+------------------------------------- Comment (by sgraf): The allocation heuristic (https://github.com/sgraf812/ghc/blob/9b9260c1d45d127edf9ebdfe04a3daaff24a9dea/compiler/simplStg/StgLiftLams/Analysis.hs#L235) tries to estimate closure growth and only allows the lift if it can guarantee that there are no regressions. I think this is quite essential to identify beneficial lifts, as well as non-trivial to implement. The whole `Analysis` module linked above mostly revolves around computing this `costToLift` https://github.com/sgraf812/ghc/blob/9b9260c1d45d127edf9ebdfe04a3daaff24a9dea/compiler/simplStg/StgLiftLams/Analysis.hs#L375. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 11:40:00 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 11:40:00 -0000 Subject: [GHC] #15578: Honour INLINE pragmas on 0-arity bindings In-Reply-To: <046.e84edd9f62d6ef84f8f7c7aedfa45ace@haskell.org> References: <046.e84edd9f62d6ef84f8f7c7aedfa45ace@haskell.org> Message-ID: <061.fe403d593f25a9bcedd929d8992f8d0e@haskell.org> #15578: Honour INLINE pragmas on 0-arity bindings -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15519 | Differential Rev(s): Phab:D5137 Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * differential: D5137 => Phab:D5137 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 11:43:39 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 11:43:39 -0000 Subject: [GHC] #15614: Test suite should show reason for skipping a test In-Reply-To: <043.72eff6af976f2c4f90c009736f7513f9@haskell.org> References: <043.72eff6af976f2c4f90c009736f7513f9@haskell.org> Message-ID: <058.9ebc13ee8b1547bc73569ecbfb3ced74@haskell.org> #15614: Test suite should show reason for skipping a test -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Test Suite | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Agreed. In the past I have spent a fair amount of time scratching my head wondering why my tests aren't getting run. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 11:47:02 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 11:47:02 -0000 Subject: [GHC] #9476: Implement late lambda-lifting In-Reply-To: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> References: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> Message-ID: <061.0169a52d49e09e426f85ac5ff1d6d62b@haskell.org> #9476: Implement late lambda-lifting -------------------------------------+------------------------------------- Reporter: simonpj | Owner: sgraf Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #8763 #13286 | Differential Rev(s): Wiki Page: LateLamLift | -------------------------------------+------------------------------------- Comment (by simonpj): > I think this is quite essential to identify beneficial lifts, Oh, OK. If I was reading the paper I'd ask "which bits of this analysis really make a difference"? Eg. * If I switched it off altogether, what happens? * If I switch off pieces of it, what happens? We've discussed some of these pieces above, but not all, I think. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 11:50:50 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 11:50:50 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.ffa0b7e1a929e5418daf0102191a4880@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > Is Step 2 the part where you close over kinds at the end rather than in between? That is step 2, yes. It sounds as if you can make a stab at that and get us to review. Then we can help with step 3. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 11:55:32 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 11:55:32 -0000 Subject: [GHC] #15615: Rename some mutable closure types for consistency Message-ID: <047.761a1bb622e3cb60ec6ca4ffd52e119e@haskell.org> #15615: Rename some mutable closure types for consistency -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.6.1 Component: Runtime | Version: 8.4.3 System | Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): Phab:D4784 | Wiki Page: -------------------------------------+------------------------------------- Description taken from the diff: {{{ SMALL_MUT_ARR_PTRS_FROZEN0 -> SMALL_MUT_ARR_PTRS_FROZEN_DIRTY SMALL_MUT_ARR_PTRS_FROZEN -> SMALL_MUT_ARR_PTRS_FROZEN_CLEAN MUT_ARR_PTRS_FROZEN0 -> MUT_ARR_PTRS_FROZEN_DIRTY MUT_ARR_PTRS_FROZEN -> MUT_ARR_PTRS_FROZEN_CLEAN }}} Naming is now consistent with other CLEAR/DIRTY objects (MVAR, MUT_VAR, MUT_ARR_PTRS). (alternatively we could rename MVAR_DIRTY/MVAR_CLEAN etc. to MVAR0/MVAR) Removed a few comments in Scav.c about FROZEN0 being on the mut_list because it's now clear from the closure type. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 11:58:05 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 11:58:05 -0000 Subject: [GHC] #15615: Rename some mutable closure types for consistency In-Reply-To: <047.761a1bb622e3cb60ec6ca4ffd52e119e@haskell.org> References: <047.761a1bb622e3cb60ec6ca4ffd52e119e@haskell.org> Message-ID: <062.3caee0c642b963c0d72791a6e94df397@haskell.org> #15615: Rename some mutable closure types for consistency -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: closed Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.4.3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4784 Wiki Page: | -------------------------------------+------------------------------------- Changes (by AndreasK): * status: new => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 12:01:02 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 12:01:02 -0000 Subject: [GHC] #9476: Implement late lambda-lifting In-Reply-To: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> References: <046.35548079b7f5bfa7d29f786dd2f07078@haskell.org> Message-ID: <061.1b9303df9876f6f6ca4b90aa213d3dae@haskell.org> #9476: Implement late lambda-lifting -------------------------------------+------------------------------------- Reporter: simonpj | Owner: sgraf Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #8763 #13286 | Differential Rev(s): Wiki Page: LateLamLift | -------------------------------------+------------------------------------- Comment (by simonpj): > Yes, I'd love to! In fact, I started something at ​https://github.com/sgraf812/late-lam-lift. Re paper: yes I'd be happy to co-author. Please yell when you think it's ready for a serious look. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 12:54:15 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 12:54:15 -0000 Subject: [GHC] #9279: Local wrapper function remains in final program; result = extra closure allocation In-Reply-To: <047.2731319b9773852326eb9e6a852376dc@haskell.org> References: <047.2731319b9773852326eb9e6a852376dc@haskell.org> Message-ID: <062.d32858a4686e3c22998b6c9e38676dc6@haskell.org> #9279: Local wrapper function remains in final program; result = extra closure allocation -------------------------------------+------------------------------------- Reporter: simonmar | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by sgraf): * Attachment "repro2.tgz" added. Repro without reference to unordered-containers/hashable -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 13:08:53 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 13:08:53 -0000 Subject: [GHC] #9279: Local wrapper function remains in final program; result = extra closure allocation In-Reply-To: <047.2731319b9773852326eb9e6a852376dc@haskell.org> References: <047.2731319b9773852326eb9e6a852376dc@haskell.org> Message-ID: <062.7723a4f14913165198ec25a2cbf8a3ba@haskell.org> #9279: Local wrapper function remains in final program; result = extra closure allocation -------------------------------------+------------------------------------- Reporter: simonmar | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): The current tip of my lambda lifting branch will not lift `$wa4`, because that would result in a top-level function with 7 parameters, which is two more than available hardware registers. Since the above link with the reproduction is offline, I had to delete/rename stuff from the original reproduction until it compiled again myself, but I think I have identified the binding which corresponds to the old `$wa4`: {{{ let { $wlvl_smyy = sat-only \r [w_smyz ww_smyA ww1_smyB ww2_smyC ww3_smyD void_X1V] case readMutVar# [ipv7_smyu void#] of { Unit# ipv11_smyH -> case ipv11_smyH of { IVarFull _ -> lvl12_rmt8; IVarEmpty dt2_smyL -> let { sat_smyM = CCCS IVarFull! [w_smyz]; } in case writeMutVar# [ipv7_smyu sat_smyM void#] of s2#_smyN { (##) -> case readMutVar# [dt2_smyL void#] of { Unit# ipv13_smyQ -> }; }; }; }; } in let { lvl20_smz3 = \r [w_smz4 w1_smz5 w2_smz6 void_X1U] case w2_smz6 of { SchedState ww1_smz9 ww2_smza ww3_smzb ww4_smzc -> $wlvl_smyy w_smz4 ww1_smz9 ww2_smza ww3_smzb ww4_smzc void#; }; } in }}} There's also this debug output: {{{ stgLiftLams:goodToLift [$wlvl_smyy] args spill on stack }}} Which tells me that it won't lift entirely due to `$wlvl` taking to many parameters. Which is a shame, because it's pretty clear that 3 parameters are absent. I suspect some Demand Analyser / WW thing at fault here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 13:26:22 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 13:26:22 -0000 Subject: [GHC] #13896: Use response file to invoke hsc2hs In-Reply-To: <046.8d005e1593e32147d596c190fbabb716@haskell.org> References: <046.8d005e1593e32147d596c190fbabb716@haskell.org> Message-ID: <061.453eeb2dd16d5bf00ad4c9c7c0db4503@haskell.org> #13896: Use response file to invoke hsc2hs ---------------------------------+---------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: hsc2hs | Version: 8.0.1 Resolution: | Keywords: newcomer Operating System: Windows | Architecture: Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4612 Wiki Page: | ---------------------------------+---------------------------------------- Comment (by ckoparkar): bgamari: ping :) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 13:34:12 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 13:34:12 -0000 Subject: [GHC] #15610: GHCi command to list instances a (possibly compound) type belongs to In-Reply-To: <051.14e1cd8a0da52d24d90bbe3d664e811c@haskell.org> References: <051.14e1cd8a0da52d24d90bbe3d664e811c@haskell.org> Message-ID: <066.34f7d2e7bd19d613059985f647a08f42@haskell.org> #15610: GHCi command to list instances a (possibly compound) type belongs to -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: lowest | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15613 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): There are a lot of ideas and moving parts here, so I think this would benefit from going through the [https://github.com/ghc-proposals/ghc- proposals GHC proposals process] for feedback. Once that is done and we have settled on a design, we can talk about what it would take to implement this (which is a different matter entirely). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 13:34:45 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 13:34:45 -0000 Subject: [GHC] #12356: StaticPointers support in GHCi In-Reply-To: <046.4add1b1a872a2608a03a4c2efa3faa77@haskell.org> References: <046.4add1b1a872a2608a03a4c2efa3faa77@haskell.org> Message-ID: <061.4822bf857365ad03f30792dcfa9d0de4@haskell.org> #12356: StaticPointers support in GHCi -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: 8.2.1 Component: Compiler | Version: 8.0.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #12000, #9878 | Differential Rev(s): Phab:D2504, Wiki Page: | Phab:D3663 -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"9400a5c6b308fbb5b3a73690610736ca3b5eb0b3/ghc" 9400a5c6/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="9400a5c6b308fbb5b3a73690610736ca3b5eb0b3" ghc: Remove warning of StaticPointers not being supported by GHCi Support for StaticPointers was added in #12356 but I apparently neglected to remove the warning. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 13:36:35 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 13:36:35 -0000 Subject: [GHC] #9279: Local wrapper function remains in final program; result = extra closure allocation In-Reply-To: <047.2731319b9773852326eb9e6a852376dc@haskell.org> References: <047.2731319b9773852326eb9e6a852376dc@haskell.org> Message-ID: <062.7c5c63ca6fea424e3f4f1d564a30ee8e@haskell.org> #9279: Local wrapper function remains in final program; result = extra closure allocation -------------------------------------+------------------------------------- Reporter: simonmar | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): You could try `-flate-dmd-anal`, which comes with -O2. It runs the demand analyser late in the pipeline, precisely to eliminate useless absent args. Does it help? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 13:37:38 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 13:37:38 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.4fb962799188e09593550196a16cdb9e@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): > Where exactly is this change?? See changes to FV.hs and UniqDFM.hs here (which is the changeset for the original patch): https://github.com/ghc/ghc/compare/bfc1fc2566944a455572303cbb2cbbf0c539c871...wip/T14880 Otherwise, go ahead with comment::110. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 13:38:07 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 13:38:07 -0000 Subject: [GHC] #12356: StaticPointers support in GHCi In-Reply-To: <046.4add1b1a872a2608a03a4c2efa3faa77@haskell.org> References: <046.4add1b1a872a2608a03a4c2efa3faa77@haskell.org> Message-ID: <061.2bba2ba5e7469ff5baf414ca2fdb7508@haskell.org> #12356: StaticPointers support in GHCi -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: 8.2.1 Component: Compiler | Version: 8.0.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #12000, #9878 | Differential Rev(s): Phab:D2504, Wiki Page: | Phab:D3663 -------------------------------------+------------------------------------- Comment (by bgamari): It looks like I simply neglected to remove the warning. Fixed and merged to `ghc-8.6`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 13:41:36 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 13:41:36 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.493a2625e7fd61bda585f4e13c0d7214@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > See changes to FV.hs and UniqDFM.hs OK: these two look like another unrelated change, so let's do them in Step 1a (after the rest of step 1), so that if they cause perf wibbles we know what the culprit is. Then we can move on to the semantically important changes: steps 2, and 3. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 13:44:07 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 13:44:07 -0000 Subject: [GHC] #13112: Windows 64-bit GHC HEAD segfaults on the code with a lot of TH stuff. In-Reply-To: <044.8846313dfa837f257582237983583132@haskell.org> References: <044.8846313dfa837f257582237983583132@haskell.org> Message-ID: <059.cc027b6c04dcfcbb5a1d2de13a0b8446@haskell.org> #13112: Windows 64-bit GHC HEAD segfaults on the code with a lot of TH stuff. ---------------------------------+-------------------------------------- Reporter: awson | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Compiler | Version: 8.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+-------------------------------------- Comment (by jbransen): With GHC 8.4.3 I am also experiencing segfaults on my 64-bit Windows 10 machine, and I'd like to add some observations that can hopefully help pinpoint the exact problem: - I am working on a relatively big package with many dependencies, amongst which is `persistent`, and the segfault happens when compiling the first module containing TH code calling persistent generation. - With GHC 8.2 on the same codebase, the segfaults seemed to appear only when compiling a module with TH for the first time. Building again then worked. With GHC 8.4 the segfault is consistent. - Using `-fexternal-interpreter` solves the problem, but since that is not compatible with intero, it breaks my editor integration and does not help me so much. I've also tried haskell-ide-backend which segfaults in the same way... - I am using Stack, and `stack build` fails with a segfault, but `stack repl` (so using ghci) does work! - I tried to create a minimal example, but I can't. I started to strip down as much as possible, and I now have a strange project which does consistently generate a segfault. However, when I remove some unused (!) import, or some unused (!) dependency from the .cabal file, it does compile. It does not seem to matter so much what I remove, so it really seems like it is related to the amount of dependencies that are in scope. My guess is that somehow it is related to how much is loaded into memory, and that after some threshold we end up in large address space. Hence, I have the feeling there is no "minimal example" triggering this bug... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 13:46:57 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 13:46:57 -0000 Subject: [GHC] #13112: Windows 64-bit GHC HEAD segfaults on the code with a lot of TH stuff. In-Reply-To: <044.8846313dfa837f257582237983583132@haskell.org> References: <044.8846313dfa837f257582237983583132@haskell.org> Message-ID: <059.ebf562121dbfc8e566a99cb2ca2ba2fc@haskell.org> #13112: Windows 64-bit GHC HEAD segfaults on the code with a lot of TH stuff. ---------------------------------+-------------------------------------- Reporter: awson | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Compiler | Version: 8.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+-------------------------------------- Comment (by RyanGlScott): jbransen, can you share the code that exhibits this segfault? I can't really figure out what's going on without a concrete place to start. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 13:49:41 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 13:49:41 -0000 Subject: [GHC] #13600: surprising error message with bang pattern In-Reply-To: <051.cb1136f932f929f97ddeb5e4dd8a6304@haskell.org> References: <051.cb1136f932f929f97ddeb5e4dd8a6304@haskell.org> Message-ID: <066.706aa0f02958018d86f6aabddc582d5d@haskell.org> #13600: surprising error message with bang pattern -------------------------------------+------------------------------------- Reporter: andrewufrank | Owner: v0d1ch Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: BangPatterns, | newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: #15166, #15458 | Differential Rev(s): Phab:D5040 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): It's not just a parsing thing. That definition of `go` really might be defining `(!)`, as if you'd written {{{ let (!) go t | T.null t = ... | otherwise = ... }}} We could simply discourage infix definitions of `(!)` (which is used for array indexing anyway), by issuing a warning and asking the user to write their definition prefix (as I have done above) to avoid the potential ambiguity with bang-patterns. Or, maybe only warn if there is no space between the `!` and the argument (comment:2). I dunno. This is user-facing, so a GHC proposal (a very small one!) might be indicated. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 14:21:56 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 14:21:56 -0000 Subject: [GHC] #13112: Windows 64-bit GHC HEAD segfaults on the code with a lot of TH stuff. In-Reply-To: <044.8846313dfa837f257582237983583132@haskell.org> References: <044.8846313dfa837f257582237983583132@haskell.org> Message-ID: <059.e45a318d3a0cad52a1d01742b0430fe3@haskell.org> #13112: Windows 64-bit GHC HEAD segfaults on the code with a lot of TH stuff. ---------------------------------+-------------------------------------- Reporter: awson | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Compiler | Version: 8.1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+-------------------------------------- Comment (by Phyx-): @jbransen, yeah we pretty much know that this happens because TH is exceeding the memory model. That's a sort of design issue with TH. But the issue is made worse on Windows because of the extreme waste the runtime linker has when allocating memory. I have a patch that addresses this but I haven't gotten reviews yet. Hopefully it'll be in 8.6 which should make this a bit harder to trigger. I also have further linker changes planned to make this more rare too. But we'll see if I get the time to finish them for 8.6 (and get them reviewed which will likely be the sticking point) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 14:31:43 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 14:31:43 -0000 Subject: [GHC] #9374: Investigate Static Argument Transformation In-Reply-To: <048.23fff567ef50b1dc01dc4be619333c72@haskell.org> References: <048.23fff567ef50b1dc01dc4be619333c72@haskell.org> Message-ID: <063.6d04cb8dc8a65f0ac3d07e45559f7f29@haskell.org> #9374: Investigate Static Argument Transformation -------------------------------------+------------------------------------- Reporter: jstolarek | Owner: (none) Type: task | Status: new Priority: lowest | Milestone: Component: Compiler | Version: 7.9 Resolution: | Keywords: | StaticArgumentTransformation, | LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: 14816 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by sgraf): * related: => 14816 Comment: For anyone working on this who has problems debugging performance regressions, #14816 might be worth taking a look at. TLDR; The Demand Analyser tries hard to be precise about parameters, but gives up early on demands on free variables for analysis performance reasons. So, when SAT turns parameters into free variables, there is the slight chance that e.g. SATed single-entry thunks are no longer identified. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 14:35:05 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 14:35:05 -0000 Subject: [GHC] #3372: Allow for multiple linker instances In-Reply-To: <049.b54da97038a1da97405ea7b63a99f067@haskell.org> References: <049.b54da97038a1da97405ea7b63a99f067@haskell.org> Message-ID: <064.33a28eccdf744bf0cc31524674f54c0a@haskell.org> #3372: Allow for multiple linker instances -------------------------------------+------------------------------------- Reporter: jcpetruzza | Owner: (none) Type: feature request | Status: new Priority: low | Milestone: Component: Runtime System | Version: (Linker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: 3658 | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonmar): This is not fixed. The C API for the linker in the runtime was made thread-safe, so that multiple C clients could call it simultaneously, but GHC still has a single global instance of its own linker state. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 14:41:54 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 14:41:54 -0000 Subject: [GHC] #15599: typeclass inference depends on whether a module is exposed. In-Reply-To: <047.dd916b476f2fd0f26c1766607c70f5c2@haskell.org> References: <047.dd916b476f2fd0f26c1766607c70f5c2@haskell.org> Message-ID: <062.fabf323b327ec7054048b1ff552475dd@haskell.org> #15599: typeclass inference depends on whether a module is exposed. -------------------------------------+------------------------------------- Reporter: gleachkr | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.3 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by gleachkr): By "just included", I meant "available in ghci as a package module". I hope that's clear enough---I've read the documentation, but I'm not a GHC developer, so my usage might be off here. The commands in `test-ghci.sh` demonstrate what I take to be the problem. Specifically, the command that gives `checkFlag=false` as the value of `test` from `Good.hs` is: `echo "test" | $GHC822 --interactive -package-db $PKGDB src/Tests/Good.hs`. It seems to generate something like this: {{{ GHC-Repro master ❯ echo "test" | ~/.stack/programs/x86_64-linux/ghc- nopie-8.2.2/bin/ghc --interactive -package-db ./.stack-work/install/x86_64 -linux-nopie/lts-11.15/8.2.2/pkgdb src/Tests/Good.hs GHCi, version 8.2.2: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/graham/dotfiles/home/.ghci [1 of 1] Compiling Tests.Good ( src/Tests/Good.hs, interpreted ) Ok, one module loaded. λ ❯ Flag {checkFlag = False} λ ❯ Leaving GHCi. }}} The sticking point is that, as far as I can tell, the reproduction requires `Tests.Link` to be available as a package module. I'm not sure of the best way to make that happen on your end. I've tried including `.stack-work` in the repo, so that you could, after pulling the latest, hopefully run something like {{{ echo "test" | /home/simonpj/5builds/ghc-8.2-branch/inplace/bin/ghc-stage2 --interactive -package-db ./.stack-work/install/x86_64-linux- nopie/lts-11.15/8.2.2/pkgdb src/Tests/Good.hs }}} and get the same result as me. However, I'm not sure this will work, so if you have another way of including the contents of GHC-Repro as package modules on your end, that might be preferable. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 14:48:33 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 14:48:33 -0000 Subject: [GHC] #12356: StaticPointers support in GHCi In-Reply-To: <046.4add1b1a872a2608a03a4c2efa3faa77@haskell.org> References: <046.4add1b1a872a2608a03a4c2efa3faa77@haskell.org> Message-ID: <061.238dca685126fa323a7b52935b13b3cd@haskell.org> #12356: StaticPointers support in GHCi -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: 8.2.1 Component: Compiler | Version: 8.0.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #12000, #9878 | Differential Rev(s): Phab:D2504, Wiki Page: | Phab:D3663 -------------------------------------+------------------------------------- Comment (by bgamari): Ahh, never mind; the patch in comment:17 is wrong. As noted in comment:9 we *still* don't support StaticPointers in the REPL. I'll revert and make sure there is a comment mentioning this next to the warning. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 15:36:11 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 15:36:11 -0000 Subject: [GHC] #15599: typeclass inference depends on whether a module is exposed. In-Reply-To: <047.dd916b476f2fd0f26c1766607c70f5c2@haskell.org> References: <047.dd916b476f2fd0f26c1766607c70f5c2@haskell.org> Message-ID: <062.f18f98d2067d6e30b03cd47905cd48f5@haskell.org> #15599: typeclass inference depends on whether a module is exposed. -------------------------------------+------------------------------------- Reporter: gleachkr | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.3 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): For another data point: On windows: {{{ $ bash test.sh Building project... These two results should be the same, since the only difference between the files is that one is an exported module *Tests.Good> Flag {checkFlag = True} *Tests.Bad> Flag {checkFlag = False} Here it is again with 8.4.3: Building project... *Tests.Bad> Flag {checkFlag = True} *Tests.Good> Flag {checkFlag = True} }}} The ghci script is hardcoded to linux paths so didn't work on windows. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 15:38:15 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 15:38:15 -0000 Subject: [GHC] #15599: typeclass inference depends on whether a module is exposed. In-Reply-To: <047.dd916b476f2fd0f26c1766607c70f5c2@haskell.org> References: <047.dd916b476f2fd0f26c1766607c70f5c2@haskell.org> Message-ID: <062.dd3f6d337325b4bf9747cecacc84afe9@haskell.org> #15599: typeclass inference depends on whether a module is exposed. -------------------------------------+------------------------------------- Reporter: gleachkr | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.2.3 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Linux | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): Here's how to reproduce it without any of these package db gubbins. 1. Clone `https://github.com/gleachkr/GHC-Repro.git` 2. `echo "test" | cabal repl` - observe that `Flag {checkFlag = True}` 3. `cabal install .` 4. `echo "test" | ghci src/Test/Good.hs` - observe that `Flag {checkFlag = False}` So the same module used in two different ways uses two different instances. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 16:07:24 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 16:07:24 -0000 Subject: [GHC] #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite In-Reply-To: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> References: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> Message-ID: <061.07db2ad150d1d0f10392238dd6c3505a@haskell.org> #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): I'm trying to debug this -- I think this may be related with 7fc418df856d9b58034eeec48915646e67a7a562. Can someone who can reproduce the segfault try this with this commit reverted? I can't reproduce the segfault on my two x86_64 systems (even with `--timeout 1s`). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 16:27:31 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 16:27:31 -0000 Subject: [GHC] #14770: Allow static pointer expressions to have static pointer free variables In-Reply-To: <048.bed690b6ed6632ceb9361aef80b57ffb@haskell.org> References: <048.bed690b6ed6632ceb9361aef80b57ffb@haskell.org> Message-ID: <063.34a4fec54de08726e271b687259e555d@haskell.org> #14770: Allow static pointer expressions to have static pointer free variables -------------------------------------+------------------------------------- Reporter: TheKing01 | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | StaticPointers Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): I think the comment in comment:2 is suggesting that the result of a `static` expression is *not* a `StaticPtr`. Terminology: * A `StaticPtr` is something which resides in the static pointer table. * A `Closure` is an expression which can be serialised. We now distinguish the two situations with two keywords. * `static ` creates a value of `StaticPtr T` where `e` is placed in the SPT. The current restrictions about static forms apply to `e`. * `closure ` creates a value of `Closure T` as per the proposal, free variables in `e` are allowed to refer to values of type `Closure`. We first give the concrete definition of `Closure` which is a simplified version of `Closure` from the [https://hackage.haskell.org/package/static-closure static-closure] package. {{{ data Closure a where CPure :: Closure (ByteString -> a) -> ByteString -> a -> Closure a CStaticPtr :: StaticPtr a -> Closure a CAp :: Closure (a -> b) -> Closure a -> Closure b }}} Then the RHS of `addPointers` from the original post desugars to: {{{ addPointers :: Closure Int -> Closure Int -> Closure Int addPointers c1 c2 = closure ( $$c1 + $$c2 ) ===> addPointers c1 c2 = static (+) `CAp` c1 `CAp` c2 }}} Static parts of the expression are still added to the SPT by using `static`. Dynamic parts of the expression are then applied using `CAp`. This definition also allows us to directly embed serialisable values into the static form. {{{ addOneToPointer :: Closure Int -> Closure Int addOneToPointer p = closure (1 + $$p) ===> addOneToPointer c1 = static (+) `CAp` (CPure (static decode) (encode 1) 1) `CAp` c1 }}} The mechanical transformation that we're performing here is we take a static form, abstract over the spliced variables and then reapply the result of the splice. Let floating the splices in essence. This definition of `Closure` still allows us to serialise a `Closure` to a bytestring and deserialise it. It also allows us to "dereference" the closure just like you can dereference a `StaticPtr`. I think the whole `static-closure` library is lovely and looks like a nice way to make writing `StaticPointers` code more easily. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 16:44:24 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 16:44:24 -0000 Subject: [GHC] #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite In-Reply-To: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> References: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> Message-ID: <061.4abf31432a02079cbe5534a09dc035a4@haskell.org> #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonmar): @osa1 what makes you suspect the STM fix? @bgamari's earlier debugging seemed to suggest that it was SRT-related, in particular if we're crashing in `stg_IND_STATIC` that usually indicates a CAF has been GC'd too early. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 17:00:04 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 17:00:04 -0000 Subject: [GHC] #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite In-Reply-To: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> References: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> Message-ID: <061.1394e3d703fb62c70af1903fcc6da41f@haskell.org> #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): > @osa1 what makes you suspect the STM fix? I'm debugging the assertion failure in comment:12 which looked serious enough to me (a TSO list is getting corrupted). I realized that the list that's being corrupted is a run queue, and the reason it's being corrupted is because in `stmCommitTransaction` we unpark a thread that is already in a run queue. So at some point the thread is in two lists (in both a run queue and a TRec's wait queue). This is the point where we corrupt the list: {{{ We're unpark_tso()'ing a thread that is already in a run queue. 352 if (tso->block_info.closure != &stg_STM_AWOKEN_closure) { 353 // safe to do a non-atomic test-and-set here, because it's 354 // fine if we do multiple tryWakeupThread()s. 355 tso->block_info.closure = &stg_STM_AWOKEN_closure; 356 tryWakeupThread(cap,tso); 357 } Old value = (StgTSO *) 0x104df58 New value = (StgTSO *) 0x42001d9000 0x0000000000dcb2b3 in unpark_tso (cap=0x104f6c0 , tso=0x42001d9078) at rts/STM.c:355 355 tso->block_info.closure = &stg_STM_AWOKEN_closure; >>> bt #0 0x0000000000dcb2b3 in unpark_tso (cap=0x104f6c0 , tso=0x42001d9078) at rts/STM.c:355 #1 0x0000000000dcb35c in unpark_waiters_on (cap=0x104f6c0 , s=0x42001c2070) at rts/STM.c:374 #2 0x0000000000dcd2d2 in stmCommitTransaction (cap=0x104f6c0 , trec=0x4200037c50) at rts/STM.c:1092 #3 0x0000000000dee080 in stg_atomically_frame_info () #4 0x0000000000000000 in ?? () }}} (note that this is reverse execution so "Old value" is actually the new value) The thread is already in a run queue: {{{ >>> print tso $23 = (StgTSO *) 0x42001d9078 >>> print MainCapability->run_queue_hd->_link->_link $25 = (struct StgTSO_ *) 0x42001d9078 }}} At this point the TSO link is fine: {{{ >>> print MainCapability->run_queue_hd->_link->_link->block_info.prev == MainCapability->run_queue_hd->_link $29 = 1 }}} Because the STM fix changed `unpark_tso()` I thought it may be related. I don't yet know how this thread ends up in two lists, I'll investigate further. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 17:15:24 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 17:15:24 -0000 Subject: [GHC] #15610: GHCi command to list instances a (possibly compound) type belongs to In-Reply-To: <051.14e1cd8a0da52d24d90bbe3d664e811c@haskell.org> References: <051.14e1cd8a0da52d24d90bbe3d664e811c@haskell.org> Message-ID: <066.1d044aec8569b65d97173096d3b2cd82@haskell.org> #15610: GHCi command to list instances a (possibly compound) type belongs to -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: lowest | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15613 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): xldenis created a GHC proposal https://github.com/ghc-proposals/ghc- proposals/pull/166 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 18:13:04 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 18:13:04 -0000 Subject: [GHC] #15613: GHCi command, tracing steps of instance resolution for Constraint or expression In-Reply-To: <051.315b513efc5cd955ece666611620c1e9@haskell.org> References: <051.315b513efc5cd955ece666611620c1e9@haskell.org> Message-ID: <066.7434ac14c453aea0fd291724d051afc5@haskell.org> #15613: GHCi command, tracing steps of instance resolution for Constraint or expression -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: lowest | Milestone: Component: GHCi | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15610 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by Iceland_jack: Old description: > Another GHCi command (#15610), `:elab ` traces instance > resolution for ``. This is already something people do by > hand (ticket:10318#comment:6) and would be a great tool for explorers of > Haskell > > This constraint ultimately boils down to lists being monoids and `Int` > being a number > > {{{ > >> :elab Monoid (a -> b -> ([c], Sum Int)) > Monoid (a -> b -> ([c], Sum Int)) > ==> Monoid (b -> ([c], Sum Int)) > ==> Monoid ([c], Sum Int) > ==> Monoid [c] > ==> Monoid (Sum Int) > ==> Num Int > }}} > > If resolving the type class fails, it can pinpoint what caused it to fail > > {{{ > >> data A > >> :elab Show (A, Int -> Int) > Show (A, Int -> Int) > <~bRZsz NO instance~> > > ==> Show A > > ==> Show (Int -> Int) > > }}} > > A verbose version can explain each step > > {{{ > >> :elab +v Monoid (a -> b -> ([c], Sum Int) > Monoid (a -> b -> ([c], Sum Int)) -- Monoid b => Monoid (a -> b) > (‘GHC.Base’) > ==> Monoid (b -> ([c], Sum Int)) -- Monoid b => Monoid (a -> b) > (‘GHC.Base’) > ==> Monoid ([c], Sum Int) -- Monoid b => Monoid (a -> b) > (‘GHC.Base’) > ==> Monoid [c] -- Monoid [a] > (‘GHC.Base’) > ==> Monoid (Sum Int) -- Num a => Monoid (Sum a) > (‘Data.Monoid’) > ==> Num Int -- Num Int > (‘GHC.Num’) > }}} > > {{{ > >> :elab +v Num (Int, Float, Rational) > Num (Int, Float, Rational) -- (Num a, Num b, Num c) => Num (a, b, c) > (‘Data.NumInstances.Tuple’) > ==> Num Int -- Num Int > (‘GHC.Num’) > ==> Num Float -- Num Float > (‘GHC.Float’) > ==> Num Rational -- type Rational = Ratio Integer > (‘GHC.Real’) > = Num (Ration Integer) -- Integral a => Num (Ratio a) > (‘GHC.Real’) > ==> Integral Integer -- Integral Integer > (‘GHC.Real’) > }}} > > ---- > > Not the same idea but similar. Listing instance resolution that takes > place in an expression > > {{{ > >> :elab (+) @Int > from: (+) @Int > Num Int > }}} > {{{ > >> :elab2 comparing (length @[]) <> compare > from: length @[] > Foldable [] > > from: comparing (length @[]) > Ord Int > > from: comparing (length @[]) <> compare > Monoid ([a] -> [a] -> Ordering) > ==> Monoid ([a] -> Ordering) > ==> Monoid Ordering > }}} > {{{ > >> :elab2 ask 'a' > from: ask 'a' > MonadReader Char ((->) m) > ==> MonadReader Char ((->) Char) > }}} > > not sure about that last one, or how to visualize them but I think it > gives the right idea. New description: Another GHCi command (#15610), `:elab ` traces instance resolution for ``. This is already something people do by hand (ticket:10318#comment:6) and would be a great tool for explorers of Haskell {{{ >> :elab Monoid (a -> b -> ([c], Sum Int)) Monoid (a -> b -> ([c], Sum Int)) ==> Monoid (b -> ([c], Sum Int)) ==> Monoid ([c], Sum Int) ==> Monoid [c] ==> Monoid (Sum Int) ==> Num Int }}} If resolving the type class fails, it can pinpoint what caused it to fail {{{ >> data A >> :elab Show (A, Int -> Int) Show (A, Int -> Int) <~bRZsz NO instance~> ==> Show A ==> Show (Int -> Int) }}} A verbose version can explain each step {{{ >> :elab +v Monoid (a -> b -> ([c], Sum Int) Monoid (a -> b -> ([c], Sum Int)) -- Monoid b => Monoid (a -> b) (‘GHC.Base’) ==> Monoid (b -> ([c], Sum Int)) -- Monoid b => Monoid (a -> b) (‘GHC.Base’) ==> Monoid ([c], Sum Int) -- Monoid b => Monoid (a -> b) (‘GHC.Base’) ==> Monoid [c] -- Monoid [a] (‘GHC.Base’) ==> Monoid (Sum Int) -- Num a => Monoid (Sum a) (‘Data.Monoid’) ==> Num Int -- Num Int (‘GHC.Num’) }}} {{{ >> :elab +v Num (Int, Float, Rational) Num (Int, Float, Rational) -- (Num a, Num b, Num c) => Num (a, b, c) (‘Data.NumInstances.Tuple’) ==> Num Int -- Num Int (‘GHC.Num’) ==> Num Float -- Num Float (‘GHC.Float’) ==> Num Rational -- type Rational = Ratio Integer (‘GHC.Real’) = Num (Ration Integer) -- Integral a => Num (Ratio a) (‘GHC.Real’) ==> Integral Integer -- Integral Integer (‘GHC.Real’) }}} ---- Not the same idea but similar. Listing instance resolution that takes place in an expression {{{ >> :elab (+) @Int from: (+) @Int Num Int }}} {{{ >> :elab2 comparing (length @[]) <> compare from: length @[] Foldable [] from: comparing (length @[]) Ord Int from: comparing (length @[]) <> compare Monoid ([a] -> [a] -> Ordering) ==> Monoid ([a] -> Ordering) ==> Monoid Ordering }}} {{{ >> :elab2 ask 'a' from: ask 'a' MonadReader Char ((->) m) ==> MonadReader Char ((->) Char) }}} not sure about that last one, or how to visualize them but I think it gives the right idea. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 21:03:43 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 21:03:43 -0000 Subject: [GHC] #15616: Bug when using TimerManager/GHC.Event ? Message-ID: <050.b9e32097b4d80e539b2bd4442f6808d1@haskell.org> #15616: Bug when using TimerManager/GHC.Event ? -------------------------------------+------------------------------------- Reporter: ddellacosta | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 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: -------------------------------------+------------------------------------- It was suggested on #haskell that this is a bug and that I should report it here. Hopefully this is the simplest possible example that shows the issue. The code sample I got from a StackOverflow answer (https://stackoverflow.com/a/25488677) which I found just trying to learn how to use GHC.Event properly so presumably, and it seemed to work there, so I assume it is still valid code (but let me know if not!). Minimal example repo is here: https://github.com/ddellacosta/timermanager- bug, please see Main.hs I'm on on OS X 10.13.6, and hopefully the shell dump below combined with the repo above gives you everything else you need: {{{#!bash $ cabal new-configure Resolving dependencies... Build profile: -w ghc-8.4.3 -O1 In order, the following would be built (use -v for more details): - timermanager-bug-0.1.0.0 (exe:timermanager-bug) (first run) $ cabal new-build Build profile: -w ghc-8.4.3 -O1 In order, the following will be built (use -v for more details): - timermanager-bug-0.1.0.0 (exe:timermanager-bug) (first run) Configuring executable 'timermanager-bug' for timermanager-bug-0.1.0.0.. clang: warning: argument unused during compilation: '-nopie' [-Wunused- command-line-argument] Preprocessing executable 'timermanager-bug' for timermanager-bug-0.1.0.0.. Building executable 'timermanager-bug' for timermanager-bug-0.1.0.0.. [1 of 1] Compiling Main ( Main.hs, /Users/ddellacosta/code /timermanager-bug/dist-newstyle/build/x86_64-osx/ghc-8.4.3/timermanager- bug-0.1.0.0/x/timermanager-bug/build/timermanager-bug/timermanager-bug- tmp/Main.o ) Linking /Users/ddellacosta/code/timermanager-bug/dist- newstyle/build/x86_64-osx/ghc-8.4.3/timermanager-bug-0.1.0.0/x /timermanager-bug/build/timermanager-bug/timermanager-bug ... clang: warning: argument unused during compilation: '-nopie' [-Wunused- command-line-argument] clang: warning: argument unused during compilation: '-nopie' [-Wunused- command-line-argument] $ cabal new-exec timermanager-bug timermanager-bug: user error (Pattern match failure in do expression at libraries/base/GHC/Event/Thread.hs:216:3-10) $ }}} Let me know if there's any more information I can supply! Apologies if this is not actually a bug but something I'm doing wrong! Thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 21:07:33 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 21:07:33 -0000 Subject: [GHC] #15616: Bug when using TimerManager/GHC.Event ? In-Reply-To: <050.b9e32097b4d80e539b2bd4442f6808d1@haskell.org> References: <050.b9e32097b4d80e539b2bd4442f6808d1@haskell.org> Message-ID: <065.50f45ec7fc5eb62cf46d5986f44ded0c@haskell.org> #15616: Bug when using TimerManager/GHC.Event ? ----------------------------------+---------------------------------------- Reporter: ddellacosta | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: MacOS X | Architecture: Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------+---------------------------------------- Changes (by ddellacosta): * failure: None/Unknown => Runtime crash * os: Unknown/Multiple => MacOS X -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 7 22:50:22 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 07 Sep 2018 22:50:22 -0000 Subject: [GHC] #10827: GHCi should support interpeting multiple packages/units with separate DynFlags In-Reply-To: <045.56917c0b2dd940e5429ceefba9639e36@haskell.org> References: <045.56917c0b2dd940e5429ceefba9639e36@haskell.org> Message-ID: <060.f0f63599a1e0d726a42b95613cef6628@haskell.org> #10827: GHCi should support interpeting multiple packages/units with separate DynFlags -------------------------------------+------------------------------------- Reporter: ezyang | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: GHC API | Version: 7.11 Resolution: | Keywords: backpack Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Ericson2314): * cc: Ericson2314 (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 8 02:32:06 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 08 Sep 2018 02:32:06 -0000 Subject: [GHC] #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes Message-ID: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes -------------------------------------+------------------------------------- Reporter: ChaiTRex | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Poor/confusing Unknown/Multiple | error message Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- With GHC 8.4.3 (`ghc` below on both Ubuntu 16.04.5 and Ubuntu 18.04.1) and recent GHC (`~/dev/ghc/inplace/bin/ghc-stage2` below on Ubuntu 16.04.5; not `HEAD` but close at `ff29fc84c03c800cfa04c2a00eb8edf6fa5f4183`), I get errors for `a = show 5`. I run the following commands, showing that `show 5` is usually fine: {{{ $ ghc -fobject-code -O2 -e 'show 5' "5" $ ghc -fobject-code -O2 -e 'let a = show 5 in a' "5" }}} But not with `a = show 5`: {{{ $ ghc -fobject-code -O2 -e 'a = show 5' : Error: bytecode compiler can't handle unboxed tuples and sums. Possibly due to foreign import/export decls in source. Workaround: use -fobject-code, or compile this module to .o separately. }}} Running with `ghci` gives the same error: {{{ $ ghci -fobject-code -O2 GHCi, version 8.4.3: http://www.haskell.org/ghc/ :? for help Prelude> a = show 5 Error: bytecode compiler can't handle unboxed tuples and sums. Possibly due to foreign import/export decls in source. Workaround: use -fobject-code, or compile this module to .o separately. Prelude> Leaving GHCi. }}} Both errors stop when optimization is turned off: {{{ $ ghc -fobject-code -O0 -e 'a = show 5' $ ghci -fobject-code -O0 GHCi, version 8.4.3: http://www.haskell.org/ghc/ :? for help Prelude> a = show 5 Prelude> Leaving GHCi. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 8 02:34:02 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 08 Sep 2018 02:34:02 -0000 Subject: [GHC] #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes In-Reply-To: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> References: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> Message-ID: <062.f416893af741c9f03b8edbbd05d87ee2@haskell.org> #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes -------------------------------------+------------------------------------- Reporter: ChaiTRex | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by ChaiTRex: Old description: > With GHC 8.4.3 (`ghc` below on both Ubuntu 16.04.5 and Ubuntu 18.04.1) > and recent GHC (`~/dev/ghc/inplace/bin/ghc-stage2` below on Ubuntu > 16.04.5; not `HEAD` but close at > `ff29fc84c03c800cfa04c2a00eb8edf6fa5f4183`), I get errors for `a = show > 5`. > > I run the following commands, showing that `show 5` is usually fine: > > {{{ > $ ghc -fobject-code -O2 -e 'show 5' > "5" > > $ ghc -fobject-code -O2 -e 'let a = show 5 in a' > "5" > }}} > > But not with `a = show 5`: > > {{{ > $ ghc -fobject-code -O2 -e 'a = show 5' > : Error: bytecode compiler can't handle unboxed tuples and > sums. > Possibly due to foreign import/export decls in source. > Workaround: use -fobject-code, or compile this module to .o separately. > }}} > > Running with `ghci` gives the same error: > > {{{ > $ ghci -fobject-code -O2 > GHCi, version 8.4.3: http://www.haskell.org/ghc/ :? for help > Prelude> a = show 5 > Error: bytecode compiler can't handle unboxed tuples and sums. > Possibly due to foreign import/export decls in source. > Workaround: use -fobject-code, or compile this module to .o separately. > Prelude> > Leaving GHCi. > }}} > > Both errors stop when optimization is turned off: > > {{{ > $ ghc -fobject-code -O0 -e 'a = show 5' > > $ ghci -fobject-code -O0 > GHCi, version 8.4.3: http://www.haskell.org/ghc/ :? for help > Prelude> a = show 5 > Prelude> > Leaving GHCi. > }}} New description: With GHC 8.4.3 (on both Ubuntu 16.04.5 and Ubuntu 18.04.1) and recent GHC (not `HEAD` but close at `ff29fc84c03c800cfa04c2a00eb8edf6fa5f4183` on Ubuntu 16.04.5), I get errors for `a = show 5`. I run the following commands, showing that `show 5` is usually fine: {{{ $ ghc -fobject-code -O2 -e 'show 5' "5" $ ghc -fobject-code -O2 -e 'let a = show 5 in a' "5" }}} But not with `a = show 5`: {{{ $ ghc -fobject-code -O2 -e 'a = show 5' : Error: bytecode compiler can't handle unboxed tuples and sums. Possibly due to foreign import/export decls in source. Workaround: use -fobject-code, or compile this module to .o separately. }}} Running with `ghci` gives the same error: {{{ $ ghci -fobject-code -O2 GHCi, version 8.4.3: http://www.haskell.org/ghc/ :? for help Prelude> a = show 5 Error: bytecode compiler can't handle unboxed tuples and sums. Possibly due to foreign import/export decls in source. Workaround: use -fobject-code, or compile this module to .o separately. Prelude> Leaving GHCi. }}} Both errors stop when optimization is turned off: {{{ $ ghc -fobject-code -O0 -e 'a = show 5' $ ghci -fobject-code -O0 GHCi, version 8.4.3: http://www.haskell.org/ghc/ :? for help Prelude> a = show 5 Prelude> Leaving GHCi. }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 8 04:18:26 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 08 Sep 2018 04:18:26 -0000 Subject: [GHC] #15618: Unused binding warning should not apply to newtype constructors Message-ID: <045.59a973c7345ae8db5993c69e98635354@haskell.org> #15618: Unused binding warning should not apply to newtype constructors -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Incorrect Unknown/Multiple | error/warning at compile-time Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- {{{#!hs module Foo (A, foo) where import Data.Type.Coercion newtype A = A Int foo :: Coercion A Int foo = Coercion }}} produces a warning: {{{ NTCon.hs:4:13: warning: [-Wunused-top-binds] Defined but not used: data constructor ‘A’ | 4 | newtype A = A Int | ^^^^^ }}} This is rather silly! 1. It's ''impossible'' to define a newtype without giving it a data constructor. 2. It's ''possible'' to use a newtype without using its data constructor. Therefore, I believe the only reasonable thing to do is suppress the unused binding warning for newtype data constructors. If the newtype itself isn't used, that will be caught anyway. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 8 08:27:13 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 08 Sep 2018 08:27:13 -0000 Subject: [GHC] #14330: Sparks are not started promptly In-Reply-To: <049.15689449c051500fed95f985fcea2e55@haskell.org> References: <049.15689449c051500fed95f985fcea2e55@haskell.org> Message-ID: <064.93f4e84d6498e1fe85b66ab1f0259591@haskell.org> #14330: Sparks are not started promptly -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: sparks Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by lelf): * cc: lelf (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 8 13:14:21 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 08 Sep 2018 13:14:21 -0000 Subject: [GHC] #15619: List comprehension seems to prevent some rewrite rules to fire Message-ID: <047.17a5c5547409e3ba1e026777e7cad14e@haskell.org> #15619: List comprehension seems to prevent some rewrite rules to fire -------------------------------------+------------------------------------- Reporter: nobrakal | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Other Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Hi, Consider {{{#!hs module Test (problem, noProblem) where data Relation = Relation Int vertex :: Int -> Relation vertex = Relation {-# NOINLINE vertex #-} star :: Int -> [Int] -> Relation star x [] = vertex x star x xs = vertex x {-# INLINE star #-} transpose :: Relation -> Relation transpose (Relation e) = Relation (-e) {-# NOINLINE transpose #-} {-# RULES "transpose/vertex" forall x. transpose (vertex x) = vertex x #-} -- The "transpose/vertex" rule does not fire here problem :: Relation problem = transpose $ star 0 [1..2] -- The "transpose/vertex" rule does fire here noProblem :: Relation noProblem = transpose $ star 0 [1,2] }}} `problem` and `noProblem` seems equivalents, but in the first the rewrite rule does not fire. * Commenting `noProblem` and compiling with "-ddump-rule-firings" gives: {{{ [1 of 1] Compiling Test ( Test.hs, Test.o ) Rule fired: Class op negate (BUILTIN) Rule fired: Class op enumFromTo (BUILTIN) Rule fired: eftIntList (GHC.Enum) }}} * Commenting `problem` and compiling with "-ddump-rule-firings" gives: {{{ [1 of 1] Compiling Test ( Test.hs, Test.o ) Rule fired: Class op negate (BUILTIN) Rule fired: transpose/vertex (Test) }}} It is a very "borderline" example (refined from a more complex one): * changing the `data` to a `newtype` solves the problem * removing the dumb pattern-match on the list in `star` also solves the problem I suspect the list comprehension to be the problem, but I am not sure at all (I am not sure if the whole thing is a real bug indeed). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 8 14:07:29 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 08 Sep 2018 14:07:29 -0000 Subject: [GHC] #15444: 8.4.3 has an undocumented dependency on libnuma. In-Reply-To: <047.a9be0b30ca9742d4a5738899e0757af8@haskell.org> References: <047.a9be0b30ca9742d4a5738899e0757af8@haskell.org> Message-ID: <062.450c2b5873b7e0386fbc29f116e5073b@haskell.org> #15444: 8.4.3 has an undocumented dependency on libnuma. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by George): Is this a Linux only issue? In particular, is it present on MacOS/Darwin or Windows? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 8 14:21:05 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 08 Sep 2018 14:21:05 -0000 Subject: [GHC] #15569: Constant folding optimises 1 into 3 In-Reply-To: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> References: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> Message-ID: <065.fe70a97a1e38010efd999ea55028a20d@haskell.org> #15569: Constant folding optimises 1 into 3 -------------------------------------+------------------------------------- Reporter: snowleopard | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9136 | Differential Rev(s): Phab:D5109 Wiki Page: | -------------------------------------+------------------------------------- Changes (by ChaiTRex): * Attachment "ConstantFolding.hs" added. Constant folding tester program -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 8 14:22:07 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 08 Sep 2018 14:22:07 -0000 Subject: [GHC] #15569: Constant folding optimises 1 into 3 In-Reply-To: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> References: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> Message-ID: <065.7c6c36f89fa2fd7b37984f68b14056f9@haskell.org> #15569: Constant folding optimises 1 into 3 -------------------------------------+------------------------------------- Reporter: snowleopard | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9136 | Differential Rev(s): Phab:D5109 Wiki Page: | -------------------------------------+------------------------------------- Changes (by ChaiTRex): * Attachment "ThisGHC.hs" added. Constant folding tester program TH helper -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 8 14:29:20 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 08 Sep 2018 14:29:20 -0000 Subject: [GHC] #15569: Constant folding optimises 1 into 3 In-Reply-To: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> References: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> Message-ID: <065.1ed1397b5875de01899e78318ec79726@haskell.org> #15569: Constant folding optimises 1 into 3 -------------------------------------+------------------------------------- Reporter: snowleopard | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9136 | Differential Rev(s): Phab:D5109 Wiki Page: | -------------------------------------+------------------------------------- Comment (by ChaiTRex): = Semi-exhaustive testing is being performed using GHC before the fix = Using the attached program, I'm doing semi-exhaustive testing of constant folding up to an expression nesting depth of two (up to something like `(a + b)*(c + d)`) with literal and variable values in `[0, 1, 3, 7] :: [Int]`. Note that the attached program takes the better part of a day, so it might not be prudent to add it to the test suite unless that can be significantly reduced or a "very, very slow" testing option can be added. == Testing is being done before fix == To ensure the tester actually detects problems, the tester program was performed until it detected this bug report's bug with GHC before the fix (at GHC commit `ff29fc84c03c800cfa04c2a00eb8edf6fa5f4183`). The tester program is still running and full output will be attached when the program finishes. The first few lines of output are: {{{ ERROR! ((0 - x0) - (0 - x1)) is optimized incorrectly! ERROR! ((0 - x0) - (1 - x0)) is optimized incorrectly! ERROR! ((0 - x0) - (1 - x1)) is optimized incorrectly! ERROR! ((0 - x0) - (3 - x0)) is optimized incorrectly! ⋮ ⋮ ⋮ ⋮ ⋮ ⋮ ⋮ ⋮ ⋮ ⋮ ⋮ ⋮ ⋮ ⋮ ⋮ ⋮ }}} == Testing will be done after fix == Testing will next be performed using GHC at `HEAD` (after the above fix). Results will be posted in my next comment in about a day. == The program == There are two modules attached: * `ThisGHC.hs`: a Template Haskell helper module for running the specific GHC installation a program was compiled with. * `ConstantFolding.hs`: a program that repeatedly compiles a certain number of expressions at a time (to avoid heap overflows from compiling all expressions at once) with `-O2` and tests their output against those expressions compiled with `-O0`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 8 15:52:51 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 08 Sep 2018 15:52:51 -0000 Subject: [GHC] #13965: COMPLETE sets nerf redundant pattern-match warnings In-Reply-To: <050.35980eb4e29ad6aa872b8ca1767abfde@haskell.org> References: <050.35980eb4e29ad6aa872b8ca1767abfde@haskell.org> Message-ID: <065.5a0f31ac243db73549dff4065f79eb5d@haskell.org> #13965: COMPLETE sets nerf redundant pattern-match warnings -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1-rc2 Resolution: | Keywords: | PatternSynonyms, | PatternMatchWarnings Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by ckoparkar): * cc: mpickering (added) Comment: It looks like this was by design when the `COMPLETE` pragma was added in Phab:D2669. {{{ #!diff compiler/deSugar/Check.hs @@ -1360,8 +1455,8 @@ wrapUpTmState (residual, (_, subst)) = (residual, flattenPmVarEnv subst) dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result = when (flag_i || flag_u) $ do - let exists_r = flag_i && notNull redundant - exists_i = flag_i && notNull inaccessible + let exists_r = flag_i && notNull redundant && onlyBuiltin + exists_i = flag_i && notNull inaccessible && onlyBuiltin exists_u = flag_u && notNull uncovered when exists_r $ forM_ redundant $ \(L l q) -> do putSrcSpanDs l (warnDs (Reason Opt_WarnOverlappingPatterns) @@ -1373,7 +1468,8 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result }}} Relevant comment: {{{compiler/deSugar/Check.hs}}} {{{ #!haskell data PartialResult = PartialResult { presultProvenance :: Provenance -- keep track of provenance because we don't want -- to warn about redundant matches if the result -- is contaminated with a COMPLETE pragma ...} }}} Do we want to change this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 8 16:22:55 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 08 Sep 2018 16:22:55 -0000 Subject: [GHC] #14251: LLVM Code Gen messes up registers In-Reply-To: <047.9ece2514d7c7f668525c93ec15fb841a@haskell.org> References: <047.9ece2514d7c7f668525c93ec15fb841a@haskell.org> Message-ID: <062.6926cff911b7393ad1a59d83c58b14a6@haskell.org> #14251: LLVM Code Gen messes up registers -------------------------------------+------------------------------------- Reporter: angerman | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler (LLVM) | Version: 8.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by George): Is this a regression? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 8 19:12:17 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 08 Sep 2018 19:12:17 -0000 Subject: [GHC] #15620: Speed up Data.Unique Message-ID: <045.8f8c32a23f03c289229a8416ac3b0c01@haskell.org> #15620: Speed up Data.Unique -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Core | Version: 8.4.3 Libraries | Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Runtime Unknown/Multiple | performance bug Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- The current `Data.Unique` code seems heavier than necessary: 1. It uses `Integer` when it can surely get away with less than two words on 64-bit systems. 2. It effectively guarantees that uniques will be consecutive, which isn't very useful. I don't know how to fix this, but I'm confident there's a better way out there. One silly idea: use one 100 or so-bit counter per capability. Use the rest of the bits to distinguish among the capabilities. To reduce hash collisions, make each capability increment its counter by a different prime number (or something like that). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 8 19:45:51 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 08 Sep 2018 19:45:51 -0000 Subject: [GHC] #15618: Unused binding warning should not apply to newtype constructors In-Reply-To: <045.59a973c7345ae8db5993c69e98635354@haskell.org> References: <045.59a973c7345ae8db5993c69e98635354@haskell.org> Message-ID: <060.8846183ab4ee7b2691e7a1c1e3286eb0@haskell.org> #15618: Unused binding warning should not apply to newtype constructors -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #10347 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => duplicate * related: => #10347 Comment: This is a duplicate of #10347, so I'll close this ticket in favor of that one. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 8 20:01:42 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 08 Sep 2018 20:01:42 -0000 Subject: [GHC] #10347: Spurious "unused constructor" warning with Coercible In-Reply-To: <047.95d70bb35e967b5051d311b602ee2dc7@haskell.org> References: <047.95d70bb35e967b5051d311b602ee2dc7@haskell.org> Message-ID: <062.da111339077572a514bee73d80ffd5c8@haskell.org> #10347: Spurious "unused constructor" warning with Coercible -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Incorrect | Test Case: warning at compile-time | typecheck/should_compile/T10347 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by dfeuer): * cc: dfeuer (added) Comment: One partial solution would be a pragma disabling the usage warning for a particular binding. {{{#!hs newtype N = N Int test :: N -> N test = ... {-# Ignore-Usage type N, N, test #-} }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 8 20:11:49 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 08 Sep 2018 20:11:49 -0000 Subject: [GHC] #10347: Spurious "unused constructor" warning with Coercible In-Reply-To: <047.95d70bb35e967b5051d311b602ee2dc7@haskell.org> References: <047.95d70bb35e967b5051d311b602ee2dc7@haskell.org> Message-ID: <062.fcd16b7c8cf54c053aab799abc21d443@haskell.org> #10347: Spurious "unused constructor" warning with Coercible -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Incorrect | Test Case: warning at compile-time | typecheck/should_compile/T10347 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): I ran into this issue in real code yesterday. We can now write {{{#!hs class (forall a b. Coercible a b => Coercible (f a) (f b)) => Representational f instance (forall a b. Coercible a b => Coercible (f a) (f b)) => Representational f }}} But to sort of simulate that in older versions, I used {{{#!hs data Skolem newtype Skolem' = Skolem' Skolem class Representational f instance (Coercible (f Skolem) (f Skolem')) => Representational f }}} GHC complained because the `Skolem'` data constructor isn't used directly. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 8 20:25:50 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 08 Sep 2018 20:25:50 -0000 Subject: [GHC] #15621: Error message involving type families points to wrong location Message-ID: <050.f6fd8f38eae3af90b1d1147a0e35ac2c@haskell.org> #15621: Error message involving type families points to wrong location -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 (Type checker) | Keywords: TypeFamilies | Operating System: Unknown/Multiple Architecture: | Type of failure: Poor/confusing Unknown/Multiple | error message Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Consider the following program: {{{#!hs {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} module Bug where import Data.Type.Equality type family F a f :: () f = let a :: F Int :~: F Int a = Refl b :: F Int :~: F Bool b = Refl in () }}} This doesn't typecheck, which isn't surprising, since `F Int` doesn't equal `F Bool` in the definition of `b`. What //is// surprising is where the error message points to: {{{ $ /opt/ghc/8.4.3/bin/ghc Bug.hs [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) Bug.hs:12:11: error: • Couldn't match type ‘F Int’ with ‘F Bool’ Expected type: F Int :~: F Int Actual type: F Bool :~: F Bool NB: ‘F’ is a non-injective type family • In the expression: Refl In an equation for ‘a’: a = Refl In the expression: let a :: F Int :~: F Int a = Refl b :: F Int :~: F Bool .... in () | 12 | a = Refl | ^^^^ }}} This claims that the error message arises from the definition of `a`, which is completely wrong! As evidence, if you comment out `b`, then the program typechecks again. Another interesting facet of this bug is that if you comment out `a`: {{{#!hs {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} module Bug where import Data.Type.Equality type family F a f :: () f = let {- a :: F Int :~: F Int a = Refl -} b :: F Int :~: F Bool b = Refl in () }}} Then the error message will actually point to `b` this time: {{{ $ /opt/ghc/8.4.3/bin/ghc Bug.hs [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) Bug.hs:15:11: error: • Couldn't match type ‘F Int’ with ‘F Bool’ Expected type: F Int :~: F Bool Actual type: F Bool :~: F Bool NB: ‘F’ is a non-injective type family • In the expression: Refl In an equation for ‘b’: b = Refl In the expression: let b :: F Int :~: F Bool b = Refl in () | 15 | b = Refl | ^^^^ }}} The use of type families appears to be important to triggering this bug, since I can't observe this behavior without the use of `F`. This is a regression that was introduced at some point between GHC 8.0.2 and 8.2.2, since 8.2.2 gives the incorrect error message shown above, while 8.0.2 points to the right location: {{{ $ /opt/ghc/8.0.2/bin/ghc Bug.hs [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) Bug.hs:15:11: error: • Couldn't match type ‘F Int’ with ‘F Bool’ Expected type: F Int :~: F Bool Actual type: F Int :~: F Int NB: ‘F’ is a type function, and may not be injective • In the expression: Refl In an equation for ‘b’: b = Refl In the expression: let a :: F Int :~: F Int a = Refl b :: F Int :~: F Bool .... in () }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 8 20:55:28 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 08 Sep 2018 20:55:28 -0000 Subject: [GHC] #15444: 8.4.3 has an undocumented dependency on libnuma. In-Reply-To: <047.a9be0b30ca9742d4a5738899e0757af8@haskell.org> References: <047.a9be0b30ca9742d4a5738899e0757af8@haskell.org> Message-ID: <062.946209e748725556a0991bc80c1c2497@haskell.org> #15444: 8.4.3 has an undocumented dependency on libnuma. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): I didn't hit the issue on windows. I don't own a Mac to check there. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 8 21:47:17 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 08 Sep 2018 21:47:17 -0000 Subject: [GHC] #15613: GHCi command, tracing steps of instance resolution for Constraint or expression In-Reply-To: <051.315b513efc5cd955ece666611620c1e9@haskell.org> References: <051.315b513efc5cd955ece666611620c1e9@haskell.org> Message-ID: <066.5a7ff1252d94e49d3301c6cca3207128@haskell.org> #15613: GHCi command, tracing steps of instance resolution for Constraint or expression -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: lowest | Milestone: Component: GHCi | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15610 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): Reminder to self: display some kind of name, show how the final dictionary is constructed {{{ $fSemigroup-> :: forall b a. Semigroup b => Semigroup (a -> b) $fSemigroupBool :: Semigroup Any }}} and information about Given/Wanted (stuff listed by `-ddump-tc-trace`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 8 21:54:16 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 08 Sep 2018 21:54:16 -0000 Subject: [GHC] #15621: Error message involving type families points to wrong location In-Reply-To: <050.f6fd8f38eae3af90b1d1147a0e35ac2c@haskell.org> References: <050.f6fd8f38eae3af90b1d1147a0e35ac2c@haskell.org> Message-ID: <065.71c55c114ffd83fdbe022ced3d0d944e@haskell.org> #15621: Error message involving type families points to wrong location -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.4.3 checker) | Resolution: | Keywords: TypeFamilies Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): This started happening after commit a920404fb12fb52a59e4f728cce4d662a418c5f8 (`Fix TcSimplify.decideQuantification for kind variables`). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 9 00:01:44 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 09 Sep 2018 00:01:44 -0000 Subject: [GHC] #15621: Error message involving type families points to wrong location In-Reply-To: <050.f6fd8f38eae3af90b1d1147a0e35ac2c@haskell.org> References: <050.f6fd8f38eae3af90b1d1147a0e35ac2c@haskell.org> Message-ID: <065.28ad2ec446fa56815340546cb5d2bab9@haskell.org> #15621: Error message involving type families points to wrong location -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.4.3 checker) | Resolution: | Keywords: TypeFamilies Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): In particular, applying this change on top of the previous commit (d4fa088350913233520ffa7163ef188a63666262) is enough to make the bug surface: {{{#!diff diff --git a/compiler/utils/UniqDFM.hs b/compiler/utils/UniqDFM.hs index 10e8aa9..3d4b1d6 100644 --- a/compiler/utils/UniqDFM.hs +++ b/compiler/utils/UniqDFM.hs @@ -147,8 +147,13 @@ addToUDFM (UDFM m i) k v = UDFM (M.insert (getKey $ getUnique k) (TaggedVal v i) m) (i + 1) addToUDFM_Directly :: UniqDFM elt -> Unique -> elt -> UniqDFM elt -addToUDFM_Directly (UDFM m i) u v = - UDFM (M.insert (getKey u) (TaggedVal v i) m) (i + 1) +addToUDFM_Directly (UDFM m i) u v + = UDFM (M.insertWith tf (getKey u) (TaggedVal v i) m) (i + 1) + where + tf (TaggedVal new_v _) (TaggedVal _ old_i) = TaggedVal new_v old_i + -- Keep the old tag, but insert the new value + -- This means that udfmToList typically returns elements + -- in the order of insertion, rather than the reverse addToUDFM_Directly_C :: (elt -> elt -> elt) -> UniqDFM elt -> Unique -> elt -> UniqDFM elt }}} Since that comment mentions that `udfmToList` now returns elements in a different order than it did previously, I wonder if there is some code which was sensitive to `udfmToList`'s order that wasn't updated properly... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 9 01:49:54 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 09 Sep 2018 01:49:54 -0000 Subject: [GHC] #3372: Allow for multiple linker instances In-Reply-To: <049.b54da97038a1da97405ea7b63a99f067@haskell.org> References: <049.b54da97038a1da97405ea7b63a99f067@haskell.org> Message-ID: <064.a7067f8114131680f6cc2a68b5b9f90f@haskell.org> #3372: Allow for multiple linker instances -------------------------------------+------------------------------------- Reporter: jcpetruzza | Owner: (none) Type: feature request | Status: new Priority: low | Milestone: Component: Runtime System | Version: (Linker) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: 3658 | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by JulianLeviston): I created the afore-linked issue in hint. I wanted to record my use-case here, too, which is that I'm building a meta-editing system (ie it can edit portions of its own code) and my codebase needs 3 to 4 levels of interpreting to have typechecked interpreted hotswappable zero downtime code modification. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 9 09:16:16 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 09 Sep 2018 09:16:16 -0000 Subject: =?utf-8?q?Re=3A_=5BGHC=5D_=2312578=3A_Update_links_to_SPJ?= =?utf-8?b?4oCZcyBwYXBlcnM=?= In-Reply-To: <046.484aa36286e88f4ca7fdf494dce8681e@haskell.org> References: <046.484aa36286e88f4ca7fdf494dce8681e@haskell.org> Message-ID: <061.e30329260aa8578c28603dcb1b3e6c37@haskell.org> #12578: Update links to SPJ’s papers -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: task | Status: closed Priority: normal | Milestone: 8.2.1 Component: Documentation | Version: 8.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3745 Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: new => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 9 12:31:24 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 09 Sep 2018 12:31:24 -0000 Subject: [GHC] #13965: COMPLETE sets nerf redundant pattern-match warnings In-Reply-To: <050.35980eb4e29ad6aa872b8ca1767abfde@haskell.org> References: <050.35980eb4e29ad6aa872b8ca1767abfde@haskell.org> Message-ID: <065.6bf24a733a5cb278dd5e33f04de9cd41@haskell.org> #13965: COMPLETE sets nerf redundant pattern-match warnings -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1-rc2 Resolution: | Keywords: | PatternSynonyms, | PatternMatchWarnings Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by ckoparkar): * cc: ckoparkar (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 9 14:19:28 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 09 Sep 2018 14:19:28 -0000 Subject: [GHC] #14251: LLVM Code Gen messes up registers In-Reply-To: <047.9ece2514d7c7f668525c93ec15fb841a@haskell.org> References: <047.9ece2514d7c7f668525c93ec15fb841a@haskell.org> Message-ID: <062.eb035984628c46fc8d720ddf5c669866@haskell.org> #14251: LLVM Code Gen messes up registers -------------------------------------+------------------------------------- Reporter: angerman | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler (LLVM) | Version: 8.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by monoidal): It's present at least in 8.2, 8.4 and HEAD. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 9 15:14:59 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 09 Sep 2018 15:14:59 -0000 Subject: [GHC] #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` Message-ID: <046.74175c624c857c997e111eade5eabf30@haskell.org> #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` -------------------------------------+------------------------------------- Reporter: rockbmb | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: 8.6.1 Component: Core | Version: 8.4.3 Libraries | Keywords: base, | Operating System: Unknown/Multiple Data.Fixed | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Hello; I'm creating this email to propose a change to `Data.Fixed`. Full credit for this idea goes to Bhavik Mehta (@b-mehta on GitHub), who implemented it in this [https://github.com/dmcclean/exact-pi/pull/8 PR] for `exact- pi`. In `Data.Fixed` there are several `E`-prefixed datatypes used to represent a certain number of digits of precision in fixed-precision arithmetic. For example, `E1` has 1 decimal place, `E12` has 12. Each of them, `E{0,1,2,3,6,9,12}` is hardcoded. If more precision types are to be provided, they have to be hardcoded as well, and all of these types resemble each other. I think there is room for improvement here. Instead of having {{{#!hs data E0 instance HasResolution E0 where resolution _ = 1 }}} and repeating it as many times as there are `E` datatypes, I propose to add the following type: {{{#!hs {-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures #-} import GHC.TypeLits (Nat, KnownNat, natVal) data E (n :: Nat) }}} and then do {{{#!hs instance KnownNat n => HasResolution (E n) where resolution _ = 10^natVal (undefined :: E n) }}} just once, replacing `data E0` with `type E0 = E 0` (and the same for the rest of them) to continue reexporting these types. `E` should also be exported. I've sent an email to the Core Libraries Committee regarding this issue. This is my first contribution to GHC, if I'm doing something incorrectly please tell me. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 9 15:20:07 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 09 Sep 2018 15:20:07 -0000 Subject: [GHC] #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` In-Reply-To: <046.74175c624c857c997e111eade5eabf30@haskell.org> References: <046.74175c624c857c997e111eade5eabf30@haskell.org> Message-ID: <061.9c5c94b5a3bb0ef28e4ceb17b21e93f2@haskell.org> #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` -------------------------------------+------------------------------------- Reporter: rockbmb | Owner: rockbmb Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Core Libraries | Version: 8.4.3 Resolution: | Keywords: base, | Data.Fixed Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by rockbmb): * owner: (none) => rockbmb * cc: AshleyYakeley (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 9 15:24:05 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 09 Sep 2018 15:24:05 -0000 Subject: [GHC] #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` In-Reply-To: <046.74175c624c857c997e111eade5eabf30@haskell.org> References: <046.74175c624c857c997e111eade5eabf30@haskell.org> Message-ID: <061.b6a1d2310a1a270e0d79b36f7509561a@haskell.org> #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` -------------------------------------+------------------------------------- Reporter: rockbmb | Owner: rockbmb Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Core Libraries | Version: 8.4.3 Resolution: | Keywords: base, | Data.Fixed Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by rockbmb): * cc: AshleyYakeley (removed) * cc: Ashley, Yakeley (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 9 15:29:02 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 09 Sep 2018 15:29:02 -0000 Subject: [GHC] #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` In-Reply-To: <046.74175c624c857c997e111eade5eabf30@haskell.org> References: <046.74175c624c857c997e111eade5eabf30@haskell.org> Message-ID: <061.48e2fc1bdebb4726ba1ca66aa207af81@haskell.org> #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` -------------------------------------+------------------------------------- Reporter: rockbmb | Owner: rockbmb Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Core Libraries | Version: 8.4.3 Resolution: | Keywords: base, | Data.Fixed Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by rockbmb): * cc: Ashley, Yakeley (removed) * cc: "Ashley, Yakeley" (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 9 15:30:57 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 09 Sep 2018 15:30:57 -0000 Subject: [GHC] #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` In-Reply-To: <046.74175c624c857c997e111eade5eabf30@haskell.org> References: <046.74175c624c857c997e111eade5eabf30@haskell.org> Message-ID: <061.1b6efcead3fcab8f7876dee426ca3b8e@haskell.org> #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` -------------------------------------+------------------------------------- Reporter: rockbmb | Owner: rockbmb Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Core Libraries | Version: 8.4.3 Resolution: | Keywords: base, | Data.Fixed Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by rockbmb): I am trying to add "Ashley Yakeley" to the "Cc: " field, but the whitespace is preventing me from doing so. Can someone help me with this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 9 15:35:04 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 09 Sep 2018 15:35:04 -0000 Subject: [GHC] #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` In-Reply-To: <046.74175c624c857c997e111eade5eabf30@haskell.org> References: <046.74175c624c857c997e111eade5eabf30@haskell.org> Message-ID: <061.17b79abd816b1d1eb59c7e72999d57d8@haskell.org> #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` -------------------------------------+------------------------------------- Reporter: rockbmb | Owner: rockbmb Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Core Libraries | Version: 8.4.3 Resolution: | Keywords: base, | Data.Fixed Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by rockbmb): * cc: RyanGlScott (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 9 19:34:51 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 09 Sep 2018 19:34:51 -0000 Subject: [GHC] #13965: COMPLETE sets nerf redundant pattern-match warnings In-Reply-To: <050.35980eb4e29ad6aa872b8ca1767abfde@haskell.org> References: <050.35980eb4e29ad6aa872b8ca1767abfde@haskell.org> Message-ID: <065.ffa0b4be1848175768aed48885f8ec73@haskell.org> #13965: COMPLETE sets nerf redundant pattern-match warnings -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1-rc2 Resolution: | Keywords: | PatternSynonyms, | PatternMatchWarnings Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): It's this way because removing a "redudant" match arising from a `COMPLETE` pragma can change what a function does. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 9 19:39:04 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 09 Sep 2018 19:39:04 -0000 Subject: [GHC] #14391: Make the simplifier independent of the typechecker In-Reply-To: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> References: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> Message-ID: <061.9308cf493674f48baf091c7300d44ab4@haskell.org> #14391: Make the simplifier independent of the typechecker -------------------------------------+------------------------------------- Reporter: nomeata | Owner: monoidal Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4503, Wiki Page: | Phab:D5135, Phab:D5139 -------------------------------------+------------------------------------- Changes (by monoidal): * differential: Phab:D4503, Phab:D5135 => Phab:D4503, Phab:D5135, Phab:D5139 Comment: I've done part 1 and 2 in [Phab:D5139]. This removes the last direct import from simplCore/ to typechecker/. There are some several indirect imports remaining and I'll investigate what can be done about them after D5139. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 07:27:03 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 07:27:03 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.14aff4baa316aae26c3dfe6052998379@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Replying to [comment:112 goldfire]: > > Where exactly is this change?? > > See changes to FV.hs and UniqDFM.hs here (which is the changeset for the original patch): > https://github.com/ghc/ghc/compare/bfc1fc2566944a455572303cbb2cbbf0c539c871...wip/T14880 > > Otherwise, go ahead with comment::110. That's the entire changeset for T14880 though, isn't it? But we're really talking about fixing the insertion order for `FV` and `UniqDFM` for this step IIUC. So: Step 0: Fix FV / UniqDFM insertion order Step 1: Refactor `tyCoVars...` to use accumulator-style VarSet (Simon's patch) Step 2: Close over kinds at the end Step 3: "Everything else" -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 07:40:40 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 07:40:40 -0000 Subject: [GHC] #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite In-Reply-To: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> References: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> Message-ID: <061.ee3f7006870c65b844f074e388ee37c1@haskell.org> #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonmar): Aha, yes I think you've found a problem. The run queue is doubly-linked, and the `block_info` field of the TSO is used as the back link, but we're overwriting that pointer in `unpark_tso`. I'd forgotten about the double use of `block_info` when I wrote that patch. I don't know if this causes the original problem, there might still be a SRT problem, but this queue corruption is definitely a bug. I guess we shouldn't touch the `block_info` field here. Would you like to make a patch? Unfortunately that reintroduces the problem of how to avoid repeated wakeup messages. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 08:15:22 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 08:15:22 -0000 Subject: [GHC] #14912: UnsafeReenter test fails with threaded1 and threaded2 In-Reply-To: <048.0d06801876b264a33d0020ade629babb@haskell.org> References: <048.0d06801876b264a33d0020ade629babb@haskell.org> Message-ID: <063.e71349c15c43507ede6e8c9cedb50eee@haskell.org> #14912: UnsafeReenter test fails with threaded1 and threaded2 -----------------------------------+-------------------------------------- Reporter: alpmestan | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Runtime System | Version: 8.5 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14743 | Differential Rev(s): Phab:D5136 Wiki Page: | -----------------------------------+-------------------------------------- Comment (by Ömer Sinan Ağacan ): In [changeset:"3cc3edf30f37b11940d1f9c4afca8c5e9ccaa8f6/ghc" 3cc3edf3/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="3cc3edf30f37b11940d1f9c4afca8c5e9ccaa8f6" Update UnsafeReenter test Only run the test in non-threaded, compiled mode. It hangs with threaded runtime (which stage 2 compiler uses, so disable it for ghci too). Reviewers: simonmar, alpmestan, bgamari Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #14912 Differential Revision: https://phabricator.haskell.org/D5136 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 08:30:45 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 08:30:45 -0000 Subject: [GHC] #14912: UnsafeReenter test fails with threaded1 and threaded2 In-Reply-To: <048.0d06801876b264a33d0020ade629babb@haskell.org> References: <048.0d06801876b264a33d0020ade629babb@haskell.org> Message-ID: <063.3dc4c15e0db4c6b45ea0cf0cef58dd72@haskell.org> #14912: UnsafeReenter test fails with threaded1 and threaded2 -----------------------------------+-------------------------------------- Reporter: alpmestan | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Runtime System | Version: 8.5 Resolution: fixed | Keywords: Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14743 | Differential Rev(s): Phab:D5136 Wiki Page: | -----------------------------------+-------------------------------------- Changes (by osa1): * status: patch => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 09:30:12 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 09:30:12 -0000 Subject: [GHC] #9279: Local wrapper function remains in final program; result = extra closure allocation In-Reply-To: <047.2731319b9773852326eb9e6a852376dc@haskell.org> References: <047.2731319b9773852326eb9e6a852376dc@haskell.org> Message-ID: <062.5e377929cffa1276f1bf157fd9053473@haskell.org> #9279: Local wrapper function remains in final program; result = extra closure allocation -------------------------------------+------------------------------------- Reporter: simonmar | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): `-flate-dmd-anal` doesn't seem to have any effect. Weird, considering that `DmdAnal` definitely sees the opportunity, but WW doesn't seem to exploit it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 09:39:28 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 09:39:28 -0000 Subject: [GHC] #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite In-Reply-To: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> References: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> Message-ID: <061.00366377a224004f4d39b1f5bc810467@haskell.org> #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): Dumb question: can we not remove unparked TSOs from the wait list in unpark_waiters_on()? > Would you like to make a patch? What do you want the patch to do? Do you want to unconditionally try to wake up a thread? (by sending multiple wakup messages sometimes) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 10:34:05 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 10:34:05 -0000 Subject: [GHC] #15569: Constant folding optimises 1 into 3 In-Reply-To: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> References: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> Message-ID: <065.5a3583f98dd29b25315fcc26b9c75ff6@haskell.org> #15569: Constant folding optimises 1 into 3 -------------------------------------+------------------------------------- Reporter: snowleopard | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9136 | Differential Rev(s): Phab:D5109 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Sounds great -- looking forward to the results! Thanks for doing this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 11:01:16 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 11:01:16 -0000 Subject: [GHC] #9279: Local wrapper function remains in final program; result = extra closure allocation In-Reply-To: <047.2731319b9773852326eb9e6a852376dc@haskell.org> References: <047.2731319b9773852326eb9e6a852376dc@haskell.org> Message-ID: <062.dcc4ac7a79b816180c2d2adc232ece59@haskell.org> #9279: Local wrapper function remains in final program; result = extra closure allocation -------------------------------------+------------------------------------- Reporter: simonmar | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): The absent case in WWLib.hs requires that we can `mk_absent_let` for that particular type. For the 3 absent parameters here are of type `MutVar# s a`, `MutVar# s a` and `TVar# s a`. We ''could'' extend `Literal.absentLiteralOf` for these unlifted, boxed cases simply by returning (the equivalent of) NULL. Alternatively, we could make sure that we don't unpack these things in the first place: If we had taken lifted `MutVar`s/`TVar`s, `mk_absent_let` would successfully conjure a lifted let binding with an absent error (so I'd say). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 11:14:13 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 11:14:13 -0000 Subject: [GHC] #9279: Local wrapper function remains in final program; result = extra closure allocation In-Reply-To: <047.2731319b9773852326eb9e6a852376dc@haskell.org> References: <047.2731319b9773852326eb9e6a852376dc@haskell.org> Message-ID: <062.128aeb445b9194863a8c5951d990eba4@haskell.org> #9279: Local wrapper function remains in final program; result = extra closure allocation -------------------------------------+------------------------------------- Reporter: simonmar | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): If I apply this diff {{{ diff --git a/compiler/basicTypes/Literal.hs b/compiler/basicTypes/Literal.hs index 21f4a92290..4444f69c7b 100644 --- a/compiler/basicTypes/Literal.hs +++ b/compiler/basicTypes/Literal.hs @@ -618,6 +618,8 @@ absentLiteralOf tc = lookupUFM absent_lits (tyConName tc) absent_lits :: UniqFM Literal absent_lits = listToUFM [ (addrPrimTyConKey, MachNullAddr) + , (mutVarPrimTyConKey, MachNullAddr) + , (tVarPrimTyConKey, MachNullAddr) , (charPrimTyConKey, MachChar 'x') , (intPrimTyConKey, mkMachIntUnchecked 0) , (int64PrimTyConKey, mkMachInt64Unchecked 0) }}} Everything WWs properly and the troubling binding `$wlvl` gets lifted to top-level. Given that this might bite somewhere else, should we maybe generalise `absentLiteralOf` by returning `MachNullAddr` whenever it gets a boxed type? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 11:54:18 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 11:54:18 -0000 Subject: [GHC] #9279: Local wrapper function remains in final program; result = extra closure allocation In-Reply-To: <047.2731319b9773852326eb9e6a852376dc@haskell.org> References: <047.2731319b9773852326eb9e6a852376dc@haskell.org> Message-ID: <062.8682b029c2037da7d9863bf949313c2e@haskell.org> #9279: Local wrapper function remains in final program; result = extra closure allocation -------------------------------------+------------------------------------- Reporter: simonmar | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): Here's a diff that handles all `UnliftedRep`s uniformly: {{{ diff --git a/compiler/basicTypes/Literal.hs b/compiler/basicTypes/Literal.hs index 21f4a92290..0e9f25f51e 100644 --- a/compiler/basicTypes/Literal.hs +++ b/compiler/basicTypes/Literal.hs @@ -62,6 +62,7 @@ import Binary import Constants import DynFlags import Platform +import RepType import UniqFM import Util @@ -614,11 +615,14 @@ literalType (LitNumber _ _ t) = t absentLiteralOf :: TyCon -> Maybe Literal -- Return a literal of the appropriate primitive -- TyCon, to use as a placeholder when it doesn't matter -absentLiteralOf tc = lookupUFM absent_lits (tyConName tc) +absentLiteralOf tc + | tyConPrimRep tc == [UnliftedRep] + = ASSERT (isUnliftedTyCon tc) Just MachNullAddr + | otherwise + = lookupUFM absent_lits (tyConName tc) absent_lits :: UniqFM Literal -absent_lits = listToUFM [ (addrPrimTyConKey, MachNullAddr) - , (charPrimTyConKey, MachChar 'x') +absent_lits = listToUFM [ (charPrimTyConKey, MachChar 'x') , (intPrimTyConKey, mkMachIntUnchecked 0) , (int64PrimTyConKey, mkMachInt64Unchecked 0) , (wordPrimTyConKey, mkMachWordUnchecked 0) }}} But now `MachNullAddr` isn't always a literal of type `Addr#`. In particular, the definition {{{ -- | Find the Haskell 'Type' the literal occupies literalType :: Literal -> Type literalType MachNullAddr = addrPrimTy literalType (MachChar _) = charPrimTy literalType (MachStr _) = addrPrimTy }}} is probably a lie. But then it also lies for `MachStr` and `MachLabel`s, so maybe this isn't such a bad thing? The binding should be immediately eliminated by the simplifier, after all. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 12:12:03 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 12:12:03 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.65a34ee5ca1e344c063d4fcf9d1402bc@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Looks like step 0 already introduces a performance regression: {{{ Unexpected results from: TEST="T9630" SUMMARY for test run started at Mon Sep 10 12:56:45 2018 CEST 0:06:01 spent to go through 110 total tests, which gave rise to 526 test cases, of which 416 were skipped 4 had missing libraries 105 expected passes 0 expected failures 0 caused framework failures 0 caused framework warnings 0 unexpected passes 0 unexpected failures 1 unexpected stat failures Unexpected stat failures: compiler/T9630.run T9630 [stat not good enough] (normal) }}} That one test deviates by +15% allocations. (The relevant patch: http://git.haskell.org/ghc.git/commitdiff/c8a1f9c42a37eb0c3514aef1a716fdbcb912da31?hp=510c5f4f22aca29a9c36fd993ac79e9077b28173) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 12:19:47 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 12:19:47 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.e4bc015776f11f7272833f4e3e24677d@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Wow! It never occurred to me that the incidental change around ordering (which was entirely unforced -- done just so that users would more often see variables reported in an order similar to what was written) could have such an impact on performance. I suppose it's because `mapUnionFV` can get inlined but `f` can't? Happily, the solution is dead simple: just don't make that change! (We still can, I imagine, make the changes in UniqDFM. I'd be even more flabbergasted if those changes affected performance.) Thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 12:48:17 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 12:48:17 -0000 Subject: [GHC] #13965: COMPLETE sets nerf redundant pattern-match warnings In-Reply-To: <050.35980eb4e29ad6aa872b8ca1767abfde@haskell.org> References: <050.35980eb4e29ad6aa872b8ca1767abfde@haskell.org> Message-ID: <065.b1c2c4a94022ef99e755ba0b90cddb32@haskell.org> #13965: COMPLETE sets nerf redundant pattern-match warnings -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1-rc2 Resolution: | Keywords: | PatternSynonyms, | PatternMatchWarnings Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Replying to [comment:3 mpickering]: > It's this way because removing a "redudant" match arising from a `COMPLETE` pragma can change what a function does. Really? What is an example of this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 13:02:48 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 13:02:48 -0000 Subject: [GHC] #13965: COMPLETE sets nerf redundant pattern-match warnings In-Reply-To: <050.35980eb4e29ad6aa872b8ca1767abfde@haskell.org> References: <050.35980eb4e29ad6aa872b8ca1767abfde@haskell.org> Message-ID: <065.9b2f9c8cbb7550abade2a4b480ffb6ed@haskell.org> #13965: COMPLETE sets nerf redundant pattern-match warnings -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1-rc2 Resolution: | Keywords: | PatternSynonyms, | PatternMatchWarnings Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): {{{ data T = A | B {-# COMPLETE A #-} foo A = 5 foo B = 6 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 13:09:15 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 13:09:15 -0000 Subject: [GHC] #13965: COMPLETE sets nerf redundant pattern-match warnings In-Reply-To: <050.35980eb4e29ad6aa872b8ca1767abfde@haskell.org> References: <050.35980eb4e29ad6aa872b8ca1767abfde@haskell.org> Message-ID: <065.2b1be1dda50f18f40307266fab0701ca@haskell.org> #13965: COMPLETE sets nerf redundant pattern-match warnings -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1-rc2 Resolution: | Keywords: | PatternSynonyms, | PatternMatchWarnings Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): I think this comparison is somewhat unfair. For one thing, this isn't even a situation where the `COMPLETE` set would kick in, since GHC would pick the original set of constructors over the `COMPLETE` set. Removing the "redundant" match on `B` wouldn't introduce any warnings either, but that is correct behavior, since now GHC uses the `COMPLETE` set. The original program is of a different nature, since the only option it has is a `COMPLETE` set (as evidenced by `module Foo`). Moreover, removing the redundant match on `F` doesn't change the fact that GHC is using the same `COMPLETE` set. This is why I argue that GHC's warning behavior on the original program is mistaken, since the second match on `F` is truly redundant, even after factoring in the semantics of `COMPLETE` sets. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 14:05:39 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 14:05:39 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.47e6237bf1ce3caf26354cb25b60359f@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Alright, if the FV/UniqDFM change doesn't affect correctness, I'll first get the rest of the patches implemented on top of master, and then we can take a closer look at step 0 if desired. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 14:47:02 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 14:47:02 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.ae5807623edc5e14a01e6b1bf88e9971@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > We still can, I imagine, make the changes in UniqDFM. I'd be even more flabbergasted if those changes affected performance.) Richard is suggesting trying just the `UniqDFM` part of Step 0. But I'm totally ok with making a separate ticket for that bit of the patch -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 15:05:58 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 15:05:58 -0000 Subject: [GHC] #15569: Constant folding optimises 1 into 3 In-Reply-To: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> References: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> Message-ID: <065.75c1cdf0371348579d30cf5a5f0353d1@haskell.org> #15569: Constant folding optimises 1 into 3 -------------------------------------+------------------------------------- Reporter: snowleopard | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9136 | Differential Rev(s): Phab:D5109 Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): I think we'll be releasing 8.6.1 with the constant folding patch so we should run ChaiTRex's test program at least once before releasing. ChaiTRex, you said you'll be posting results, do you have the results yet? I'll also try to run it on my system. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 15:15:48 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 15:15:48 -0000 Subject: [GHC] #14974: 2-fold memory usage regression GHC 8.2.2 -> GHC 8.4.1 compiling `mmark` package In-Reply-To: <042.6f9317183740e6c428dbe334554fec22@haskell.org> References: <042.6f9317183740e6c428dbe334554fec22@haskell.org> Message-ID: <057.3f33de6cec9052840f1c7ff34db6382b@haskell.org> #14974: 2-fold memory usage regression GHC 8.2.2 -> GHC 8.4.1 compiling `mmark` package -------------------------------------+------------------------------------- Reporter: hvr | Owner: davide Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: Compiler | Version: 8.4.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Interesting questions * Do we get more or better specialisations from `SpecConstr`? * Do any of the library benchmarks run faster? Maybe invite the author to give insight, once you have characterised better what is happening. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 15:36:05 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 15:36:05 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.397c547e262f539a744ef57f60e55bc1@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769 Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Well, the reason I want to skip the FV/UniqDFM part for now is because people are blocked on this ticket, and we don't strictly need this part to get them unblocked. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 15:42:37 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 15:42:37 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.76c168534c2c1a9a136f827c6f598247@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141 -------------------------------------+------------------------------------- Changes (by tdammers): * differential: Phab:D4769 => Phab:D4769, Phab:D5141 Comment: Phab:5141 addresses Step 1. I found no performance regressions, and nofib indicates deviations on the order of 0.1%, most of them improvements. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 15:59:15 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 15:59:15 -0000 Subject: [GHC] #9279: Local wrapper function remains in final program; result = extra closure allocation In-Reply-To: <047.2731319b9773852326eb9e6a852376dc@haskell.org> References: <047.2731319b9773852326eb9e6a852376dc@haskell.org> Message-ID: <062.040bde03f18013b9936d033e105230b6@haskell.org> #9279: Local wrapper function remains in final program; result = extra closure allocation -------------------------------------+------------------------------------- Reporter: simonmar | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): OK, this diff in isolation provokes Core Lint errors everywhere: {{{ *** Core Lint errors : in result of Worker Wrapper binds *** : warning: [RHS of ww_scA1 :: Array# b_sczT] The type of this binder doesn't match the type of its RHS: ww_scA1 Binder's type: Array# b_sczT }}} So, it's pretty clear we would have to add an additional field to `MachNullAddr` (`MachNull` would probably be more appropriate) for the type it represents, similar to `LitNumber`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 16:19:31 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 16:19:31 -0000 Subject: [GHC] #9279: Local wrapper function remains in final program; result = extra closure allocation In-Reply-To: <047.2731319b9773852326eb9e6a852376dc@haskell.org> References: <047.2731319b9773852326eb9e6a852376dc@haskell.org> Message-ID: <062.ee35ced399526436d48f7240f65b6ff6@haskell.org> #9279: Local wrapper function remains in final program; result = extra closure allocation -------------------------------------+------------------------------------- Reporter: simonmar | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): `Note [Absent errors]` reads {{{ Note: I did try the experiment of using an error thunk for unlifted things too, relying on the simplifier to drop it as dead code. But this is fragile - It fails when profiling is on, which disables various optimisations - It fails when reboxing happens. E.g. data T = MkT Int Int# f p@(MkT a _) = ...g p.... where g is /lazy/ in 'p', but only uses the first component. Then 'f' is /strict/ in 'p', and only uses the first component. So we only pass that component to the worker for 'f', which reconstructs 'p' to pass it to 'g'. Alas we can't say ...f (MkT a (absentError Int# "blah"))... bacause `MkT` is strict in its Int# argument, so we get an absentError exception when we shouldn't. Very annoying! So absentError is only used for lifted types. }}} But I suppose having just use `NULL` for the other unlifted+boxed cases is OK. We've been doing it for `Addr#` for a long time. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 16:43:22 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 16:43:22 -0000 Subject: [GHC] #9279: Local wrapper function remains in final program; result = extra closure allocation In-Reply-To: <047.2731319b9773852326eb9e6a852376dc@haskell.org> References: <047.2731319b9773852326eb9e6a852376dc@haskell.org> Message-ID: <062.f7da1ae754f1e3d644ff7ed896416e03@haskell.org> #9279: Local wrapper function remains in final program; result = extra closure allocation -------------------------------------+------------------------------------- Reporter: simonmar | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): Ah, just saw that `AddrRep /= UnliftedRep`... Also, defining `| MachNull Type` makes it hard to define `Ord` and `Binary` instances. Urgh. Not sure how to proceed. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 16:52:43 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 16:52:43 -0000 Subject: [GHC] #15623: Wrong Endian, ghc-pwd and ghc-cabal on ghc 8.0.1 for powerpc64le (IBM Power) Message-ID: <058.92eeca5309f093ba094bb7b979a5550b@haskell.org> #15623: Wrong Endian, ghc-pwd and ghc-cabal on ghc 8.0.1 for powerpc64le (IBM Power) -------------------------------------+------------------------------------- Reporter: | Owner: (none) francescantoncastro | Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.0.1 Keywords: | Operating System: Linux Architecture: powerpc64 | Type of failure: Building GHC | failed Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I tried to compile ghc-8.0.1 from source using the powerpc64/unknown linux .tar.xz file (since the other file was for AIX). The ghc-pwd and ghc-cabal files won't execute even after stripping them with strip. The libraries included are Big Endian instead of Little Endian. I replaced the libffi library by the local one on my system (IBM Power8 with redhatenterpriseserver). ghc complains there is no cabal file after naming a symlink to cabal (on /bin) ghc-cabal (instead of the faulty ghc-cabal file). See attached file. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 16:55:04 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 16:55:04 -0000 Subject: [GHC] #15623: Wrong Endian, ghc-pwd and ghc-cabal on ghc 8.0.1 for powerpc64le (IBM Power) In-Reply-To: <058.92eeca5309f093ba094bb7b979a5550b@haskell.org> References: <058.92eeca5309f093ba094bb7b979a5550b@haskell.org> Message-ID: <073.025a22bbbdb3cae70f697383ef49d377@haskell.org> #15623: Wrong Endian, ghc-pwd and ghc-cabal on ghc 8.0.1 for powerpc64le (IBM Power) ----------------------------------------+--------------------------------- Reporter: francescantoncastro | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Linux | Architecture: powerpc64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------------+--------------------------------- Changes (by francescantoncastro): * Attachment "compilingghc8.0.1onpowerpc64le" added. shell commands -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 18:56:39 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 18:56:39 -0000 Subject: [GHC] #15624: defer-type-errors and equality constraints Message-ID: <047.1d0c6bea7f4dcd5b45e59581cf2ae33d@haskell.org> #15624: defer-type-errors and equality constraints -------------------------------------+------------------------------------- Reporter: monoidal | Owner: (none) Type: bug | Status: new Priority: low | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 (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: -------------------------------------+------------------------------------- Consider {{{ {-# OPTIONS_GHC -fdefer-type-errors #-} x = const True ('a' + 'a') y = const True (not 'a') }}} Currently `x` is True, but `y` is undefined. I think it would make sense for both to be True. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 19:28:04 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 19:28:04 -0000 Subject: [GHC] #12833: GHCi In-Reply-To: <051.4ded213ac1a58670bab81411457b3c2f@haskell.org> References: <051.4ded213ac1a58670bab81411457b3c2f@haskell.org> Message-ID: <066.11bf2e528613ce66a9bde74199ba5f55@haskell.org> #12833: GHCi -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: invalid | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: new => closed * resolution: => invalid Comment: I agree with [comment:1 comment:1]. In ghci, standalone "let" refers to "let" in do-notation, so current behavior is consistent. We could allow local type and pattern synonyms in let and where clauses, but this is ticketed as #4020. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 10 20:57:39 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 10 Sep 2018 20:57:39 -0000 Subject: [GHC] #15625: GHC panic, with QuantifiedConstraints Message-ID: <051.5bb3c3d1540b5617c1e145b1cbeec548@haskell.org> #15625: GHC panic, with QuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.6.1-beta1 Keywords: | Operating System: Unknown/Multiple QuantifiedConstraints | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I got a GHC Panic (I made some minor changes to GHC so it may have been added by me) but I think it's caused by the quality constraint {{{ $ ~/code/latestghc/inplace/bin/ghc-stage2 --interactive -ignore-dot-ghci ~/hs/390.hs GHCi, version 8.7.20180828: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( /home/baldur/hs/390.hs, interpreted ) ghc-stage2: panic! (the 'impossible' happened) (GHC version 8.7.20180828 for x86_64-unknown-linux): ASSERT failed! co_a2DG df_a2DS @ Any Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1160:37 in ghc:Outputable pprPanic, called at compiler/utils/Outputable.hs:1219:5 in ghc:Outputable assertPprPanic, called at compiler/coreSyn/CoreSubst.hs:189:49 in ghc:CoreSubst Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug > }}} given this code {{{#!hs {-# Language RankNTypes, TypeInType, DataKinds, PolyKinds, TypeOperators, GADTs, FlexibleInstances, MultiParamTypeClasses, ConstraintKinds, CPP, UndecidableSuperClasses, QuantifiedConstraints, FlexibleContexts #-} import Data.Kind type Cat ob = ob -> ob -> Type data KLEISLI (m :: Type -> Type) :: Cat (KL_kind m) where MkKLEISLI :: (a -> m b) -> KLEISLI(m) (KL a) (KL b) data KL_kind (m :: Type -> Type) = KL Type class (a ~ KL xx) => AsKL a xx instance (a ~ KL xx) => AsKL a xx ekki__ :: Monad m => (forall xx. AsKL a xx) => KLEISLI m a a ekki__ = MkKLEISLI undefined }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 00:26:19 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 00:26:19 -0000 Subject: [GHC] #3427: control what sort of entity a deprecated pragma applies to In-Reply-To: <044.6e5c26a8435c2fcde3f9de3ab4769428@haskell.org> References: <044.6e5c26a8435c2fcde3f9de3ab4769428@haskell.org> Message-ID: <059.96f5792e64a5e6b2a8f48e28c4cbadc4@haskell.org> #3427: control what sort of entity a deprecated pragma applies to -------------------------------------+------------------------------------- Reporter: igloo | Owner: nineonine Type: feature request | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 6.10.4 Resolution: | Keywords: deprecate | warning, newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5126 Wiki Page: | -------------------------------------+------------------------------------- Comment (by nineonine): Submitted a proposal: https://github.com/ghc-proposals/ghc- proposals/pull/167 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 01:45:23 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 01:45:23 -0000 Subject: [GHC] #15569: Constant folding optimises 1 into 3 In-Reply-To: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> References: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> Message-ID: <065.5c1c0573d4e6f1ca1da659f380477ca1@haskell.org> #15569: Constant folding optimises 1 into 3 -------------------------------------+------------------------------------- Reporter: snowleopard | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9136 | Differential Rev(s): Phab:D5109 Wiki Page: | -------------------------------------+------------------------------------- Changes (by ChaiTRex): * Attachment "BadResultsBeforePatch.txt" added. Bad results before patch -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 01:49:26 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 01:49:26 -0000 Subject: [GHC] #15569: Constant folding optimises 1 into 3 In-Reply-To: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> References: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> Message-ID: <065.1d804a18525bf320dc7cf9f12545097c@haskell.org> #15569: Constant folding optimises 1 into 3 -------------------------------------+------------------------------------- Reporter: snowleopard | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9136 | Differential Rev(s): Phab:D5109 Wiki Page: | -------------------------------------+------------------------------------- Comment (by ChaiTRex): Apologies for the delay: I had no power for a while and had to restart. The results before the patch are attached and point out only this bug. The results after the patch point out no bugs: {{{ }}} So, `Int`s look good on my end, at least up to an expression nesting depth of two (''i.e.'', up to something like `(a + b)*(c + d)`). For any future needs, I've put a newly-multithreaded version of the tester on GitHub at [https://github.com/ChaiTRex/ConstantFoldingTest ChaiTRex/ConstantFoldingTest]. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 02:12:38 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 02:12:38 -0000 Subject: [GHC] #15624: defer-type-errors and equality constraints In-Reply-To: <047.1d0c6bea7f4dcd5b45e59581cf2ae33d@haskell.org> References: <047.1d0c6bea7f4dcd5b45e59581cf2ae33d@haskell.org> Message-ID: <062.88cf6a5729bce61964115e9e70815cee@haskell.org> #15624: defer-type-errors and equality constraints -------------------------------------+------------------------------------- Reporter: monoidal | Owner: (none) Type: bug | Status: closed Priority: low | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.4.3 checker) | Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by goldfire): * status: new => closed * resolution: => duplicate Comment: I believe this is just #11197. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 02:14:07 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 02:14:07 -0000 Subject: [GHC] #11197: Overeager deferred type errors In-Reply-To: <047.311058030fc6bc2d09ef05760e42135c@haskell.org> References: <047.311058030fc6bc2d09ef05760e42135c@haskell.org> Message-ID: <062.6c5acdc5cb5555f294dd2f8aa490b078@haskell.org> #11197: Overeager deferred type errors -------------------------------------+------------------------------------- Reporter: goldfire | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 7.11 checker) | Keywords: TypeInType, Resolution: | DeferredErrors Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): #15624 is another example: {{{#!hs {-# OPTIONS_GHC -fdefer-type-errors #-} x = const True ('a' + 'a') y = const True (not 'a') }}} `x` is `True`, but `y` is `<>`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 07:07:15 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 07:07:15 -0000 Subject: [GHC] #9279: Local wrapper function remains in final program; result = extra closure allocation In-Reply-To: <047.2731319b9773852326eb9e6a852376dc@haskell.org> References: <047.2731319b9773852326eb9e6a852376dc@haskell.org> Message-ID: <062.a8c30fa47d00fa6ca8805bcabc8956b1@haskell.org> #9279: Local wrapper function remains in final program; result = extra closure allocation -------------------------------------+------------------------------------- Reporter: simonmar | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): Extending the existing approach by adding e.g. `| MachNullMutVar` doesn't work, because we still don't know which type to return in `literalType`. The type arguments `s` and `a` to the `MutVar#` constructor are lost. So there is no way around this issue unless we store `Type`s in `Literal` that are relevant in `Ord` and `Binary` instances. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 07:26:53 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 07:26:53 -0000 Subject: [GHC] #15569: Constant folding optimises 1 into 3 In-Reply-To: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> References: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> Message-ID: <065.2f3c244803107174b80d90d61acb0364@haskell.org> #15569: Constant folding optimises 1 into 3 -------------------------------------+------------------------------------- Reporter: snowleopard | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9136 | Differential Rev(s): Phab:D5109 Wiki Page: | -------------------------------------+------------------------------------- Comment (by snowleopard): Great job, ChaiTRex! This gives us some confidence. Could you, perhaps, generate a representative subset of all your tests that will be small enough to be added to the testsuite? For example, without iterating over different constants, yet still hitting each constant folding rule? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 07:38:36 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 07:38:36 -0000 Subject: [GHC] #11197: Overeager deferred type errors In-Reply-To: <047.311058030fc6bc2d09ef05760e42135c@haskell.org> References: <047.311058030fc6bc2d09ef05760e42135c@haskell.org> Message-ID: <062.1fb2f9211f6d2832b448b126af352abe@haskell.org> #11197: Overeager deferred type errors -------------------------------------+------------------------------------- Reporter: goldfire | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 7.11 checker) | Keywords: TypeInType, Resolution: | DeferredErrors Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > comment:14 All I can think of is to make a special case for coercions, and be willing to float them in, on the grounds that evidence bindings are added by the compiler and should have as narrow scope as possible. This would be very easy to try, if anyone feels inclined. I could advise. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 08:16:36 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 08:16:36 -0000 Subject: [GHC] #9279: Local wrapper function remains in final program; result = extra closure allocation In-Reply-To: <047.2731319b9773852326eb9e6a852376dc@haskell.org> References: <047.2731319b9773852326eb9e6a852376dc@haskell.org> Message-ID: <062.3a41c4100e0585ea445b9d29aab1699b@haskell.org> #9279: Local wrapper function remains in final program; result = extra closure allocation -------------------------------------+------------------------------------- Reporter: simonmar | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): There are two things going on in this ticket 1. Should we inline wrappers late in the pipeline? See comment:4 2. Can we do a better job for "absent" arguments of unlifted types. I'll concentrate on (2) in this comment; but we should not lose sight of (1). In fact it might be better to make (2) a new ticket and leave this one for (1) -- or vice versa. For a long time, the worker/wrapper splitter has given up on absent arguments of certain unlifted types: see `Literal.absentLiteralOf` and `Note [Absent errors]` in `WwLib`. This is very annoying because it means that we get left with functions that take a bunch of arguments they do not use, as in this ticket. For lifted types T we build an absent value as a thunk of form {{{ aBSENT_ERROR_ID @T "Used absent value" }}} This does two things A. It gives us something, of the right type, to use in place of the value we aren't passing any more. B. It gives an extra sanity check: if that value is ever used (a compiler bug) we'll get a runtime error message. For unlifted types we don't have thunks, so we can't do this. As you can see in `absentLiteralOf`, for some types we just make up a silly value: e.g. for `Char#` we use `'x#'`; for `Int#` we use `0#`. Note, however that * Substituting a particular value serves purpose (A) but not purpose (B). A compiler bug would go undetected. This is sad: e.g. #11126 is a real bug that was detected by (B). But I see no way out. * It doesn't work for `Array#`, `MutVar#`, `TVar#` etc because we have no available literal values of those types. So Sebastian is suggesting that we add a new literal value -- call it a '''rubbish value''' -- which can work for any (unlifted type), extending `Literal` something like this {{{ data Literal = ... | RubbishLit Type }}} We need to store the type so we can still do `literalType`. Now * Maybe we could get rid of `MachNullAddr` in favour of this new literal. * I think -- but I am not sure -- that this literal should never occur in code generation. For example, we should never pass a rubbish value to a function. Before then dead-code elimination should have got rid of it I'm not 100% certain, but if this was true, it'd be a great sanity check. * Yes, `Literal` has `Eq` and `Ord` -- but I'm not sure why. Try removing them and seeing what happens! (Generally I think it'd be better to define `eqLit` and `cmpLit` and cal them, rather than use `==` and `>`; so much easier to grep for! And in fact, we do have `eqType` and `cmpType`. * Do we need to spit out a `RubbishLit` in the `Binary` instance. This seems more likely, because perhaps these rubbish values can occur in unfoldings, which are serialised as their parse tree. But the we can just serialise the `Type`. It won't happen much. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 09:06:01 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 09:06:01 -0000 Subject: [GHC] #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite In-Reply-To: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> References: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> Message-ID: <061.d6e74fabb375af998834f50cba459407@haskell.org> #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): I managed to reproduce it and did some debugging. Here's the problem. We have this object: {{{ >>> print *((StgClosure *) 0xe4c558) $21 = { header = { info = 0x409968 }, payload = 0xe4c560 } }}} It's defined like this: {{{ $wxs_reFi :: GHC.Prim.Int# -> (# Data.ByteString.Internal.ByteString, [Data.ByteString.Internal.ByteString] #) [GblId, Arity=1, Str=, Unf=OtherCon []] = sat-only [] \r [ww_seSe] case ww_seSe of ds1_seSf [Occ=Once] { __DEFAULT -> let { sat_seSk [Occ=Once] :: [Data.ByteString.Internal.ByteString] [LclId] = [ds1_seSf] \u [] case -# [ds1_seSf 1#] of sat_seSg [Occ=Once] { __DEFAULT -> case $wxs_reFi sat_seSg of { (#,#) ww2_seSi [Occ=Once] ww3_seSj [Occ=Once] -> : [ww2_seSi ww3_seSj]; }; }; } in (#,#) [x_reFh sat_seSk]; 1# -> (#,#) [x_reFh GHC.Types.[]]; }; }}} Notice that (1) it's a FUN_STATIC (2) it has references to another static object x_reFh: {{{ x_reFh :: Data.ByteString.Internal.ByteString [GblId] = [] \u [] case newMutVar# [GHC.ForeignPtr.NoFinalizers GHC.Prim.realWorld#] of { (#,#) ipv_seS6 [Occ=Once] ipv1_seS7 [Occ=Once] -> case __pkg_ccall bytestring-0.10.8.2 [addr#1_reFg ipv_seS6] of { (#,#) _ [Occ=Dead] ds2_seSb [Occ=Once] -> case word2Int# [ds2_seSb] of sat_seSd [Occ=Once] { __DEFAULT -> let { sat_seSc [Occ=Once] :: GHC.ForeignPtr.ForeignPtrContents [LclId] = CCCS GHC.ForeignPtr.PlainForeignPtr! [ipv1_seS7]; } in Data.ByteString.Internal.PS [addr#1_reFg sat_seSc 0# sat_seSd]; }; }; }; }}} The FUN_STATIC SRT optimization should apply to this object. So instead of a SRT table we should have the SRT entries in its payload. However n_ptrs of this object is 0: {{{ >>> set $itbl = itbl_to_fun_itbl(get_itbl((StgClosure *) 0xe4c558)) >>> print *$itbl $21 = { f = { slow_apply_offset = 59278791, __pad_slow_apply_offset = 1572864, b = { bitmap = 10376465356425854976, bitmap_offset = -907476992, __pad_bitmap_offset = 3387490304 }, fun_type = 4, arity = 1 }, i = { layout = { payload = { ptrs = 0, nptrs = 0 }, bitmap = 0, large_bitmap_offset = 0, __pad_large_bitmap_offset = 0, selector_offset = 0 }, type = 14, srt = 10759120, code = 0x409968 "I\203\304\030M;\245X\003" } } }}} So it seems like for some reason we don't actually do FUN_STATIC SRT optimization for this objects. Indeed I can get the reference to refH in the srt field: {{{ >>> print *((StgClosure*) (((StgWord) (($itbl)+1)) + ($itbl)->i.srt)) <--- GET_FUN_SRT $10 = { header = { info = 0x4097e8 }, payload = 0xe4c540 } >>> print ((StgClosure*) (((StgWord) (($itbl)+1)) + ($itbl)->i.srt)) $11 = (StgClosure *) 0xe4c538 }}} x_reFh is originally a THUNK and becomes IND_STATIC after evaluation: {{{ >>> call printClosure((StgClosure *) 0xe4c538) THUNK(0x4097e8) >>> c Hardware watchpoint 5: ((StgClosure *) 0xe4c538)->header.info Old value = (const StgInfoTable *) 0x4097e8 New value = (const StgInfoTable *) 0xdce688 SET_INFO (c=0xe4c538, info=0xdce688 ) at includes/rts/storage/ClosureMacros.h:50 50 } >>> bt #0 SET_INFO (c=0xe4c538, info=0xdce688 ) at includes/rts/storage/ClosureMacros.h:50 #1 0x0000000000dbac9b in lockCAF (reg=0x1020818 , caf=0xe4c538) at rts/sm/Storage.c:415 #2 0x0000000000dbacc5 in newCAF (reg=0x1020818 , caf=0xe4c538) at rts/sm/Storage.c:425 #3 0x0000000000409809 in reFh_info () #4 0x0000000000000000 in ?? () >>> call printClosure((StgClosure *) 0xe4c538) IND_STATIC(0x42004d5878) }}} Now as long as reFi is reachable this 0xe4c538 should be reachable because it's in SRT of reFi. Let's continue: {{{ >>> c ... assertion failure ... >>> bt #0 0x0000000000db8800 in LOOKS_LIKE_INFO_PTR_NOT_NULL (p=12297829382473034410) at includes/rts/storage/ClosureMacros.h:260 #1 0x0000000000db884f in LOOKS_LIKE_INFO_PTR (p=12297829382473034410) at includes/rts/storage/ClosureMacros.h:265 #2 0x0000000000db8887 in LOOKS_LIKE_CLOSURE_PTR (p=0x4200122a10) at includes/rts/storage/ClosureMacros.h:270 #3 0x0000000000db9240 in evacuate (p=0xe4c540) at rts/sm/Evac.c:516 #4 0x0000000000ddf87e in scavenge_static () at rts/sm/Scav.c:1690 #5 0x0000000000ddff0a in scavenge_loop () at rts/sm/Scav.c:2085 #6 0x0000000000db4c49 in scavenge_until_all_done () at rts/sm/GC.c:1088 #7 0x0000000000db38ba in GarbageCollect (collect_gen=1, do_heap_census=false, gc_type=0, cap=0x1020800 , idle_cap=0x0) at rts/sm/GC.c:416 #8 0x0000000000d995a7 in scheduleDoGC (pcap=0x7fff635d6780, task=0x2802f60, force_major=false) at rts/Schedule.c:1799 #9 0x0000000000d98a7f in schedule (initialCapability=0x1020800 , task=0x2802f60) at rts/Schedule.c:545 #10 0x0000000000d99f79 in scheduleWaitThread (tso=0x4200105388, ret=0x0, pcap=0x7fff635d6880) at rts/Schedule.c:2533 #11 0x0000000000da8b4c in rts_evalLazyIO (cap=0x7fff635d6880, p=0xe4d928, ret=0x0) at rts/RtsAPI.c:530 #12 0x0000000000da9297 in hs_main (argc=7, argv=0x7fff635d6a78, main_closure=0xe4d928, rts_config=...) at rts/RtsMain.c:72 #13 0x000000000041210c in main () }}} 0xe4c540 is indirectee of 0xe4c538: {{{ >>> print &((StgInd*)0xe4c538)->indirectee $27 = (StgClosure **) 0xe4c540 }}} But the object was cleared (because this is in sanity mode) {{{ >>> print *UNTAG_CLOSURE(((StgInd*)0xe4c538)->indirectee) $29 = { header = { info = 0xaaaaaaaaaaaaaaaa }, payload = 0x4200122a18 } }}} so it became unreachable. For this object to be unreachable reFi should be unreachable too. Let's see if it was reachable in this GC: {{{ >>> break GarbageCollect Breakpoint 6 at 0xdb3492: file rts/sm/GC.c, line 226. >>> break evacuate_static_object if q == 0xe4c558 Breakpoint 7 at 0xdb8f85: file rts/sm/Evac.c, line 333. >>> reverse-continue }}} Breakpoint 7 is hit first, so it seems like reFi is actually reachable. We should be scavenging it too: {{{ >>> break Scav.c:1675 if p == 0xe4c558 Breakpoint 8 at 0xddf7cc: file rts/sm/Scav.c, line 1675. >>> c >>> bt #0 scavenge_static () at rts/sm/Scav.c:1675 #1 0x0000000000ddff0a in scavenge_loop () at rts/sm/Scav.c:2085 #2 0x0000000000db4c49 in scavenge_until_all_done () at rts/sm/GC.c:1088 #3 0x0000000000db38ba in GarbageCollect (collect_gen=1, do_heap_census=false, gc_type=0, cap=0x1020800 , idle_cap=0x0) at rts/sm/GC.c:416 #4 0x0000000000d995a7 in scheduleDoGC (pcap=0x7fff635d6780, task=0x2802f60, force_major=false) at rts/Schedule.c:1799 #5 0x0000000000d98a7f in schedule (initialCapability=0x1020800 , task=0x2802f60) at rts/Schedule.c:545 #6 0x0000000000d99f79 in scheduleWaitThread (tso=0x4200105388, ret=0x0, pcap=0x7fff635d6880) at rts/Schedule.c:2533 #7 0x0000000000da8b4c in rts_evalLazyIO (cap=0x7fff635d6880, p=0xe4d928, ret=0x0) at rts/RtsAPI.c:530 #8 0x0000000000da9297 in hs_main (argc=7, argv=0x7fff635d6a78, main_closure=0xe4d928, rts_config=...) at rts/RtsMain.c:72 #9 0x000000000041210c in main () }}} At this point if I step a few more lines I get the original assertion error. So in summary: a FUN_STATIC is reachable, but somehow a static object in its SRT is collected. Alternatively, it could be that the FUN_STATIC becomes unreachable, and somehow become reachable again later. Simon, I'm looking at the implementation of SRT optimization for FUN_STATIC. I don't understand why we look for both the SRT field and nptrs of FUN_STATICs in this code: (evacuate()) {{{ case FUN_STATIC: if (info->srt != 0 || info->layout.payload.ptrs != 0) { evacuate_static_object(STATIC_LINK(info,(StgClosure *)q), q); } return; }}} As far as I understand for FUN_STATICs we should only look at the payload, no? I think that what the note in CmmBuildInfoTables.hs says. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 09:22:35 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 09:22:35 -0000 Subject: [GHC] #15569: Constant folding optimises 1 into 3 In-Reply-To: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> References: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> Message-ID: <065.c02ddba9ea33b47d7863150302c4452f@haskell.org> #15569: Constant folding optimises 1 into 3 -------------------------------------+------------------------------------- Reporter: snowleopard | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9136 | Differential Rev(s): Phab:D5109 Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): For the record, here's ~~a paper~~ [https://arxiv.org/pdf/1809.02161.pdf a report] about how these kind of optimisations should be specified in a declarative language (like snowleopard's attempt above). Ultimately, these declarations could be synthesised by an SMT solver out of a language semantics (a.k.a. algebraic structure, in our case). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 09:39:27 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 09:39:27 -0000 Subject: [GHC] #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite In-Reply-To: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> References: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> Message-ID: <061.818e4c47f5d9a889d5e8fc2acb32545a@haskell.org> #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): Sigh that's because the debug RTS is broken. bgamari could we cherry-pick e431d75f8350f25159f9aaa49fe9a504e94bc0a4 to 8.6 branch? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 10:12:04 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 10:12:04 -0000 Subject: [GHC] #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite In-Reply-To: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> References: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> Message-ID: <061.22afda96aaa4f3bf8ed910f1724b65b7@haskell.org> #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): I just realized that the debug RTS issue mentioned in comment:21 does not actually make comment:20 invalid, so I'm still trying to understand the problem described in comment:20. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 11:15:29 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 11:15:29 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.f5ecbd92962dbd9672a16e7539aca97e@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141 -------------------------------------+------------------------------------- Comment (by tdammers): Step 2 implemented here, on top of step 1: http://git.haskell.org/ghc.git/commit/2728d63f0a42251d24d5fc4f044633f981891131 Unfortunately, this causes regressions: {{{ Unexpected results from: TEST="T12150 T12227 T12545 T5321Fun T5631" SUMMARY for test run started at Tue Sep 11 12:37:11 2018 CEST 0:05:56 spent to go through 110 total tests, which gave rise to 526 test cases, of which 416 were skipped 4 had missing libraries 101 expected passes 0 expected failures 0 caused framework failures 0 caused framework warnings 0 unexpected passes 0 unexpected failures 5 unexpected stat failures Unexpected stat failures: compiler/T5631.run T5631 [stat not good enough] (normal) compiler/T5321Fun.run T5321Fun [stat not good enough] (normal) compiler/T12227.run T12227 [stat not good enough] (normal) compiler/T12545.run T12545 [stat not good enough] (normal) compiler/T12150.run T12150 [stat not good enough] (optasm) }}} It's possible that I made mistakes in manually porting the patch onto master, so by all means please review. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 11:21:38 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 11:21:38 -0000 Subject: [GHC] #9279: Local wrapper function remains in final program; result = extra closure allocation In-Reply-To: <047.2731319b9773852326eb9e6a852376dc@haskell.org> References: <047.2731319b9773852326eb9e6a852376dc@haskell.org> Message-ID: <062.1ede671a6c542480c1d01d8c677c3c48@haskell.org> #9279: Local wrapper function remains in final program; result = extra closure allocation -------------------------------------+------------------------------------- Reporter: simonmar | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Concerning comment at 4 I have not looked in detail at the example in the Description, but I'm guessing that we have a situation like this {{{ f x xs = let g :: Int -> Int g y = y+x in map g xs }}} We see that `g` is strict, so we w/w it thus: {{{ f x xs = let $wg :: Int# -> Int# $wg y# = case x of I# x# -> y# + x# g :: Int -> Int {-# Stable unfolding = \y -> #-} g y = case y of I# y# -> case $wg y# of r# -> I# r# in map g xs }}} But alas, `g` never gets to inline, so it is all in vain. Worse, we have lost out, because `map` calls `g` which calls `$wg` and that's slower than what we started with. What we want is this: * If the only call to `$wg` is from `g`, then inline it back in. Currently there are two calls to `gw`, one in the RHS of `g` and one in the stable unfolding of `g`. If we simply nuked the stable unfolding to `g` (which was added by w/w), then there'd only be one call to `gw` and we'd inine it happily. On the other hand, if the body of f was `(map g xs, g 7)`, then the `g 7` would by now have turned into a call of `$wg`, so whether we inlined `$wg` would depend on how big `$wg` is, which is absolutely fine. Arguably should not do this nuking stuff until after `TidyCore`, which generates bindings to put in the interface file. We want to leave `f`'s RHS undisturbed until then, in case `f` itself is inlined in other modules. (An alternative view: it'd be ok to dump the w/w split in before `TidyCore` because we'll rediscover the strictness (and perhaps better strictness) in any module that inlines `f`.) My conclusion: * for local functions (i.e. bound by a `let`, or at top level but not exported) * that have been w/w'd * at a fairly late stage in the pipeline * kill off the stable-unfolding introduced by w/w * and simplify I think it'd be interesting to try this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 12:03:27 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 12:03:27 -0000 Subject: [GHC] #15626: Optimise wakeups for STM Message-ID: <043.1621b105f16e1002f9a247c9e25f825a@haskell.org> #15626: Optimise wakeups for STM -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): Phab:D4961 | Wiki Page: -------------------------------------+------------------------------------- As discovered while debugging #15544, the previous attempt at optimising STM wakeups (Phab:D4961, merged as 502640c90c3d0fbb6c46257be14fdc7e3c694c6c) broke other things (see comment 17) and we're going to revert it. This is the tracking ticket for this issue. To summarize the problem: when a thread from capability 2 is in wait list of a TVar and we update the TVar in capability 1 we send a wakeup message to capability 2. If before capability 2 actually wake ups the thread capability 1 updates the TVar again we send a message again, causing redundant wakeup message sending. Ideally we should somehow mark the TSO as "awoken" and not send wakeup messages more than once. Phab:D4961 did exactly this, but in a wrong way (updated a field of TSO that shouldn't have been updated). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 12:08:19 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 12:08:19 -0000 Subject: [GHC] #15626: Optimise wakeups for STM In-Reply-To: <043.1621b105f16e1002f9a247c9e25f825a@haskell.org> References: <043.1621b105f16e1002f9a247c9e25f825a@haskell.org> Message-ID: <058.53e968296c13380526b61b7df52e2168@haskell.org> #15626: Optimise wakeups for STM -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4961 Wiki Page: | -------------------------------------+------------------------------------- Description changed by osa1: Old description: > As discovered while debugging #15544, the previous attempt at optimising > STM wakeups (Phab:D4961, merged as > 502640c90c3d0fbb6c46257be14fdc7e3c694c6c) broke other things (see comment > 17) and we're going to revert it. This is the tracking ticket for this > issue. > > To summarize the problem: when a thread from capability 2 is in wait list > of a TVar and we update the TVar in capability 1 we send a wakeup message > to capability 2. If before capability 2 actually wake ups the thread > capability 1 updates the TVar again we send a message again, causing > redundant wakeup message sending. Ideally we should somehow mark the TSO > as "awoken" and not send wakeup messages more than once. Phab:D4961 did > exactly this, but in a wrong way (updated a field of TSO that shouldn't > have been updated). New description: As discovered while debugging #15544, the previous attempt at optimising STM wakeups (Phab:D4961, merged as 502640c90c3d0fbb6c46257be14fdc7e3c694c6c) broke other things (see comment 17) and reverted in Phab:D5144. This is the tracking ticket for this issue. To summarize the problem: when a thread from capability 2 is in wait list of a TVar and we update the TVar in capability 1 we send a wakeup message to capability 2. If before capability 2 actually wake ups the thread capability 1 updates the TVar again we send a message again, causing redundant wakeup message sending. Ideally we should somehow mark the TSO as "awoken" and not send wakeup messages more than once. Phab:D4961 did exactly this, but in a wrong way (updated a field of TSO that shouldn't have been updated). -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 12:24:39 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 12:24:39 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.211119fb851f82a359f8f2e85361f6a3@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141 -------------------------------------+------------------------------------- Comment (by simonpj): Sigh. For a start, `closeOverKinds` stupidly goes via `FV`, which is silly in our new setup. Perhaps {{{ closeOverKinds tv_set = tv_set `unionVarSet` mapUnionVarSet kind_fvs tv_set where kind_fvs tcv = ty_co_vars_of_type (varType tv) emptyVarSet emptyVarSet }}} You might want to define {{{ tyCoVarsOfType_unclosed :: Type -> TyCoVarSet tyCoVarsOfTYpe_unclosed ty = ty_co_var_of_type emptyVarSet emptyVarSet }}} Next, I'd worry about that `mapUnionVarSet`. It seems that checking for dups, and avoiding unions, is a help. So perhaps {{{ closeOverKinds tv_set = close emptyVarSet tv_set where close :: TyCoVarSet -> TyCoVarSet -> TyCoVarSet -- (close acc tvs2) extends acc with tcvs closed over kinds -- Invariant: acc is already closed-over-kinds close acc tcvs = nonDetFoldUFM close1 acc tvs close1 :: TyCoVar -> TyCoVarSet -> TyCoVarSet close1 tcv acc = add1 (close kind_vars acc) where kind_vars = ty_co_vars_of_type (varType tcv) acc emptyVarSet add1 tvs2 | tcv `elemVarSet` tvs2 = tvs2 | otherwise = extendVarSet tvs2 tcv }}} By using the the "in-scope set" (first argument) of `ty_co_var_of_type`, I'm saying "don't bother with variables whose kind we have already closed over". And I'm trying to use `extendVarSet`, not `unionVarSet`. I'm not certain I have this right, but I think it's close. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 13:00:50 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 13:00:50 -0000 Subject: [GHC] #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite In-Reply-To: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> References: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> Message-ID: <061.caedcd65fce38595585a093cc7e615fa@haskell.org> #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): - This problem is reproducible even without threaded runtime (should make it easier to debug) - Fixing the STM issue mentioned in comment:17 does not fix this issue (I submitted Phab:D5144 for that) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 13:15:35 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 13:15:35 -0000 Subject: [GHC] #15625: GHC panic, with QuantifiedConstraints In-Reply-To: <051.5bb3c3d1540b5617c1e145b1cbeec548@haskell.org> References: <051.5bb3c3d1540b5617c1e145b1cbeec548@haskell.org> Message-ID: <066.586c30d772170a01a9fb14afae02f2ba@haskell.org> #15625: GHC panic, with QuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): If you don't have a GHC build with `ASSERT`ions enabled, then it's worth noting that this program also triggers a Core Lint error: {{{ $ /opt/ghc/8.6.1/bin/ghci Bug.hs -dcore-lint GHCi, version 8.6.0.20180907: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/ryanglscott/.ghci [1 of 1] Compiling Main ( Bug.hs, interpreted ) *** Core Lint errors : in result of Desugar (after optimization) *** : warning: [in body of letrec with binders $dIP_a2KT :: HasCallStack] co_a2Lc :: a_a1Iw[sk:1] ~# 'KL Any [LclId[CoVarId]] is out of scope *** Offending Program *** ekki__ :: forall (m :: * -> *) (a :: KL_kind m). (Monad m, forall xx. AsKL a xx) => KLEISLI m a a [LclIdX] ekki__ = \ (@ (m_a1Iv :: * -> *)) (@ (a_a1Iw :: KL_kind m_a1Iv)) _ [Occ=Dead] (df_a1Iz :: forall xx. AsKL a_a1Iw xx) -> case \ (@ xx_a1Fp) -> heq_sel @ (KL_kind m_a1Iv) @ (KL_kind m_a1Iv) @ a_a1Iw @ ('KL xx_a1Fp) ($p1~ @ (KL_kind m_a1Iv) @ a_a1Iw @ ('KL xx_a1Fp) ($p1AsKL @ m_a1Iv @ a_a1Iw @ xx_a1Fp (df_a1Iz @ xx_a1Fp))) of df_a2Lp { __DEFAULT -> let { $dIP_a2KT :: HasCallStack [LclId] $dIP_a2KT = (pushCallStack (unpackCString# "undefined"#, SrcLoc (unpackCString# "main"#) (unpackCString# "Main"#) (unpackCString# "Bug.hs"#) (I# 16#) (I# 20#) (I# 16#) (I# 29#)) ((emptyCallStack `cast` (Sym (N:IP[0] <"callStack">_N _N) :: CallStack ~R# (?callStack::CallStack))) `cast` (N:IP[0] <"callStack">_N _N :: (?callStack::CallStack) ~R# CallStack))) `cast` (Sym (N:IP[0] <"callStack">_N _N) :: CallStack ~R# (?callStack::CallStack)) } in (break<0>() $WMkKLEISLI @ Any @ m_a1Iv @ Any (undefined @ 'LiftedRep @ (Any -> m_a1Iv Any) $dIP_a2KT)) `cast` ((KLEISLI _N (Sym co_a2Lc) (Sym co_a2Lc))_R :: KLEISLI m_a1Iv ('KL Any) ('KL Any) ~R# KLEISLI m_a1Iv a_a1Iw[sk:1] a_a1Iw[sk:1]) } }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 13:28:39 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 13:28:39 -0000 Subject: [GHC] #15625: GHC panic, with QuantifiedConstraints In-Reply-To: <051.5bb3c3d1540b5617c1e145b1cbeec548@haskell.org> References: <051.5bb3c3d1540b5617c1e145b1cbeec548@haskell.org> Message-ID: <066.ea4efc52c4cc2d56b60eac3697c52a11@haskell.org> #15625: GHC panic, with QuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by Iceland_jack: Old description: > I got a GHC Panic (I made some minor changes to GHC so it may have been > added by me) but I think it's caused by the quality constraint > > {{{ > $ ~/code/latestghc/inplace/bin/ghc-stage2 --interactive -ignore-dot-ghci > ~/hs/390.hs > GHCi, version 8.7.20180828: http://www.haskell.org/ghc/ :? for help > [1 of 1] Compiling Main ( /home/baldur/hs/390.hs, interpreted > ) > ghc-stage2: panic! (the 'impossible' happened) > (GHC version 8.7.20180828 for x86_64-unknown-linux): > ASSERT failed! > co_a2DG > df_a2DS @ Any > Call stack: > CallStack (from HasCallStack): > callStackDoc, called at compiler/utils/Outputable.hs:1160:37 in > ghc:Outputable > pprPanic, called at compiler/utils/Outputable.hs:1219:5 in > ghc:Outputable > assertPprPanic, called at compiler/coreSyn/CoreSubst.hs:189:49 in > ghc:CoreSubst > > Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug > > > > }}} > > given this code > > {{{#!hs > {-# Language RankNTypes, TypeInType, DataKinds, PolyKinds, TypeOperators, > GADTs, FlexibleInstances, MultiParamTypeClasses, ConstraintKinds, CPP, > UndecidableSuperClasses, QuantifiedConstraints, FlexibleContexts #-} > > import Data.Kind > > type Cat ob = ob -> ob -> Type > > data KLEISLI (m :: Type -> Type) :: Cat (KL_kind m) where > MkKLEISLI :: (a -> m b) -> KLEISLI(m) (KL a) (KL b) > > data KL_kind (m :: Type -> Type) = KL Type > > class (a ~ KL xx) => AsKL a xx > instance (a ~ KL xx) => AsKL a xx > > ekki__ :: Monad m => (forall xx. AsKL a xx) => KLEISLI m a a > ekki__ = MkKLEISLI undefined > }}} New description: I got a GHC Panic (I made some minor changes to GHC so it may have been added by me) but I think it's caused by the equality constraint {{{ $ ~/code/latestghc/inplace/bin/ghc-stage2 --interactive -ignore-dot-ghci ~/hs/390.hs GHCi, version 8.7.20180828: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( /home/baldur/hs/390.hs, interpreted ) ghc-stage2: panic! (the 'impossible' happened) (GHC version 8.7.20180828 for x86_64-unknown-linux): ASSERT failed! co_a2DG df_a2DS @ Any Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1160:37 in ghc:Outputable pprPanic, called at compiler/utils/Outputable.hs:1219:5 in ghc:Outputable assertPprPanic, called at compiler/coreSyn/CoreSubst.hs:189:49 in ghc:CoreSubst Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug > }}} given this code {{{#!hs {-# Language RankNTypes, TypeInType, DataKinds, PolyKinds, TypeOperators, GADTs, FlexibleInstances, MultiParamTypeClasses, ConstraintKinds, CPP, UndecidableSuperClasses, QuantifiedConstraints, FlexibleContexts #-} import Data.Kind type Cat ob = ob -> ob -> Type data KLEISLI (m :: Type -> Type) :: Cat (KL_kind m) where MkKLEISLI :: (a -> m b) -> KLEISLI(m) (KL a) (KL b) data KL_kind (m :: Type -> Type) = KL Type class (a ~ KL xx) => AsKL a xx instance (a ~ KL xx) => AsKL a xx ekki__ :: Monad m => (forall xx. AsKL a xx) => KLEISLI m a a ekki__ = MkKLEISLI undefined }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 13:53:40 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 13:53:40 -0000 Subject: [GHC] #13064: Incorrect redudant imports warning In-Reply-To: <045.fe3c1c6b618d0b4877de88fc27add363@haskell.org> References: <045.fe3c1c6b618d0b4877de88fc27add363@haskell.org> Message-ID: <060.dab275d277afe05245f194574847212a@haskell.org> #13064: Incorrect redudant imports warning -------------------------------------+------------------------------------- Reporter: phadej | Owner: (none) Type: bug | Status: new Priority: low | Milestone: 8.8.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #15393 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): I'll chime in one opinion as a member of the CLC. If I'm reading comment:24 correctly, then there still exists a solution (two solutions, even, depending on how verbose you want to be) to avoiding redundant imports warnings that is compliant with the three-release policy. Moreover, the less verbose of these solutions: {{{#!hs {-# OPTIONS_GHC -Wall #-} import Data.Semigroup import Prelude squash :: Semigroup a => a -> a -> a squash = (<>) foo :: Int foo = 42 }}} Isn't terribly different from the usual advice that we give for avoiding redundant imports on old GHCs, so it wouldn't be //too// far of a break from convention to espouse this advice instead. The only thing we'd have to be conscious of is that code like this, where explicit imports are used: {{{#!hs {-# OPTIONS_GHC -Wall #-} import Data.Semigroup (Semigroup, (<>)) import Prelude squash :: Semigroup a => a -> a -> a squash = (<>) foo :: Int foo = 42 }}} Will now start emitting warnings, so there will likely need to be some migration to mitigate these warnings once they start popping up in the wild. The question is: exactly how much migration can we expect? I'm unsure of what the answer to this question is, so to help get an approximate answer, I'm going to build the `wip/T13064` branch and try building a slew of Hackage libraries with it in order to see which new warnings appear. Regardless of what this experiment produces, I still lean towards the side of applying this change, since it fixes an outright bug. It helps that one can migrate any code to adapt to this new warning scheme without too much trouble as well. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 15:07:27 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 15:07:27 -0000 Subject: [GHC] #15627: Absent unlifted bindings Message-ID: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> #15627: Absent unlifted bindings -------------------------------------+------------------------------------- Reporter: sgraf | Owner: (none) Type: task | Status: new Priority: normal | Milestone: ⊥ Component: Compiler | Version: 8.4.3 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: #9279 #4328 Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- As simonpj put it in ticket:9279#comment:20: > For a long time, the worker/wrapper splitter has given up on absent > arguments of certain unlifted types: see `Literal.absentLiteralOf` and > `Note [Absent errors]` in `WwLib`. This is very annoying because it means > that we get left with functions that take a bunch of arguments they do not > use, as in this ticket (#9279). > > For lifted types T we build an absent value as a thunk of form > {{{ > aBSENT_ERROR_ID @T "Used absent value" > }}} > This does two things > A. It gives us something, of the right type, to use in place of the value > we aren't passing any more. > B. It gives an extra sanity check: if that value is ever used (a compiler > bug) we'll get a runtime error message. > > For unlifted types we don't have thunks, so we can't do this. As you can > see in `absentLiteralOf`, for some types we just make up a silly value: > e.g. for `Char#` we use `'x#'`; for `Int#` we use `0#`. > > Note, however that > > * Substituting a particular value serves purpose (A) but not purpose > (B). A compiler bug would go undetected. This is sad: e.g. #11126 > is a real bug that was detected by (B). But I see no way out. > > * It doesn't work for `Array#`, `MutVar#`, `TVar#` etc because we have > no available literal values of those types. > > So Sebastian is suggesting that we add a new literal value -- call it > a '''rubbish value''' -- which can work for any (unlifted type), > extending `Literal` something like this > {{{ > data Literal = ... > | RubbishLit Type > }}} > We need to store the type so we can still do `literalType`. > > Now > * Maybe we could get rid of `MachNullAddr` in favour of this new literal. > > * I think -- but I am not sure -- that this literal should never occur > in code generation. For example, we should never pass a rubbish value > to a function. Before then dead-code elimination should have got rid > of it I'm not 100% certain, but if this was true, it'd be a great > sanity check. > > * Yes, `Literal` has `Eq` and `Ord` -- but I'm not sure why. Try removing > them and seeing what happens! (Generally I think it'd be better to > define `eqLit` and `cmpLit` and cal them, rather than use `==` and `>`; > so much easier to grep for! > > And in fact, we do have `eqType` and `cmpType`. > > * Do we need to spit out a `RubbishLit` in the `Binary` instance. > This seems more likely, because perhaps these rubbish values can occur > in unfoldings, which are serialised as their parse tree. But > the we can just serialise the `Type`. It won't happen much. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 15:08:30 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 15:08:30 -0000 Subject: [GHC] #9279: Local wrapper function remains in final program; result = extra closure allocation In-Reply-To: <047.2731319b9773852326eb9e6a852376dc@haskell.org> References: <047.2731319b9773852326eb9e6a852376dc@haskell.org> Message-ID: <062.f5618f0576f1139391bd7377bac1c39b@haskell.org> #9279: Local wrapper function remains in final program; result = extra closure allocation -------------------------------------+------------------------------------- Reporter: simonmar | Owner: simonpj Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: LateLamLift Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): Thanks for your input! I created #15627 to track progress on the `mk_absent_let` thing. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 15:10:40 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 15:10:40 -0000 Subject: [GHC] #15625: GHC panic, with QuantifiedConstraints In-Reply-To: <051.5bb3c3d1540b5617c1e145b1cbeec548@haskell.org> References: <051.5bb3c3d1540b5617c1e145b1cbeec548@haskell.org> Message-ID: <066.94b6a3d0aae37bc12a60c37cbabbe371@haskell.org> #15625: GHC panic, with QuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by monoidal): Simpler version that also gives Core Lint warning: {{{ {-# Language GADTs, MultiParamTypeClasses, QuantifiedConstraints #-} class a ~ b => Equal a b ekki__ :: (forall b. Equal a b) => a ekki__ = False }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 15:13:34 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 15:13:34 -0000 Subject: [GHC] #15627: Absent unlifted bindings In-Reply-To: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> References: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> Message-ID: <059.5400b27b17e6bec43377877ab61dbd40@haskell.org> #15627: Absent unlifted bindings -------------------------------------+------------------------------------- Reporter: sgraf | Owner: (none) Type: task | Status: new Priority: normal | Milestone: ⊥ Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9279 #4328 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by simonpj: Old description: > As simonpj put it in ticket:9279#comment:20: > > > For a long time, the worker/wrapper splitter has given up on absent > > arguments of certain unlifted types: see `Literal.absentLiteralOf` and > > `Note [Absent errors]` in `WwLib`. This is very annoying because it > means > > that we get left with functions that take a bunch of arguments they do > not > > use, as in this ticket (#9279). > > > > For lifted types T we build an absent value as a thunk of form > > {{{ > > aBSENT_ERROR_ID @T "Used absent value" > > }}} > > This does two things > > A. It gives us something, of the right type, to use in place of the > value > > we aren't passing any more. > > B. It gives an extra sanity check: if that value is ever used (a > compiler > > bug) we'll get a runtime error message. > > > > For unlifted types we don't have thunks, so we can't do this. As you > can > > see in `absentLiteralOf`, for some types we just make up a silly value: > > e.g. for `Char#` we use `'x#'`; for `Int#` we use `0#`. > > > > Note, however that > > > > * Substituting a particular value serves purpose (A) but not purpose > > (B). A compiler bug would go undetected. This is sad: e.g. #11126 > > is a real bug that was detected by (B). But I see no way out. > > > > * It doesn't work for `Array#`, `MutVar#`, `TVar#` etc because we have > > no available literal values of those types. > > > > So Sebastian is suggesting that we add a new literal value -- call it > > a '''rubbish value''' -- which can work for any (unlifted type), > > extending `Literal` something like this > > {{{ > > data Literal = ... > > | RubbishLit Type > > }}} > > We need to store the type so we can still do `literalType`. > > > > Now > > * Maybe we could get rid of `MachNullAddr` in favour of this new > literal. > > > > * I think -- but I am not sure -- that this literal should never occur > > in code generation. For example, we should never pass a rubbish value > > to a function. Before then dead-code elimination should have got rid > > of it I'm not 100% certain, but if this was true, it'd be a great > > sanity check. > > > > * Yes, `Literal` has `Eq` and `Ord` -- but I'm not sure why. Try > removing > > them and seeing what happens! (Generally I think it'd be better to > > define `eqLit` and `cmpLit` and cal them, rather than use `==` and > `>`; > > so much easier to grep for! > > > > And in fact, we do have `eqType` and `cmpType`. > > > > * Do we need to spit out a `RubbishLit` in the `Binary` instance. > > This seems more likely, because perhaps these rubbish values can > occur > > in unfoldings, which are serialised as their parse tree. But > > the we can just serialise the `Type`. It won't happen much. New description: Transferred from ticket:9279#comment:20: For a long time, the worker/wrapper splitter has given up on absent arguments of certain unlifted types: see `Literal.absentLiteralOf` and `Note [Absent errors]` in `WwLib`. This is very annoying because it means that we get left with functions that take a bunch of arguments they do not use, as in this ticket (#9279). For lifted types T we build an absent value as a thunk of form {{{ aBSENT_ERROR_ID @T "Used absent value" }}} This does two things A. It gives us something, of the right type, to use in place of the value we aren't passing any more. B. It gives an extra sanity check: if that value is ever used (a compiler bug) we'll get a runtime error message. For unlifted types we don't have thunks, so we can't do this. As you can see in `absentLiteralOf`, for some types we just make up a silly value: e.g. for `Char#` we use `'x#'`; for `Int#` we use `0#`. Note, however that * Substituting a particular value serves purpose (A) but not purpose (B). A compiler bug would go undetected. This is sad: e.g. #11126 is a real bug that was detected by (B). But I see no way out. * It doesn't work for `Array#`, `MutVar#`, `TVar#` etc because we have no available literal values of those types. So Sebastian is suggesting that we add a new literal value -- call it a '''rubbish value''' -- which can work for any (unlifted type), extending `Literal` something like this {{{ data Literal = ... | RubbishLit Type }}} We need to store the type so we can still do `literalType`. Now * Maybe we could get rid of `MachNullAddr` in favour of this new literal. * I think -- but I am not sure -- that this literal should never occur in code generation. For example, we should never pass a rubbish value to a function. Before then dead-code elimination should have got rid of it I'm not 100% certain, but if this was true, it'd be a great sanity check. * Yes, `Literal` has `Eq` and `Ord` -- but I'm not sure why. Try removing them and seeing what happens! (Generally I think it'd be better to define `eqLit` and `cmpLit` and cal them, rather than use `==` and `>`; so much easier to grep for! And in fact, we do have `eqType` and `cmpType`. * Do we need to spit out a `RubbishLit` in the `Binary` instance. This seems more likely, because perhaps these rubbish values can occur in unfoldings, which are serialised as their parse tree. But the we can just serialise the `Type`. It won't happen much. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 15:16:39 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 15:16:39 -0000 Subject: [GHC] #15628: Higher-rank kinds Message-ID: <051.5986f225355cd5a8606486fc67a0f4d5@haskell.org> #15628: Higher-rank kinds -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 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: -------------------------------------+------------------------------------- Taken from [https://github.com/ekmett/eq/blob/master/src/Data/Eq/Type/Hetero.hs#L73 Data.Eq.Type.Hetero]. `(:==)` (called `HEq` to avoid unnecessary extensions) fails if you add a `Proxy x ->` argument. {{{#!hs {-# Language RankNTypes, KindSignatures, PolyKinds, GADTs, DataKinds #-} import Data.Kind import Data.Proxy newtype HEq :: forall j. j -> forall k. k -> Type where HEq :: (forall (x::forall xx. xx -> Type). Proxy x -> x a -> x b) -> HEq a b }}} {{{ $ ~/code/latestghc/inplace/bin/ghc-stage2 --interactive -ignore-dot-ghci 398.hs GHCi, version 8.7.20180828: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( 398.hs, interpreted ) 398.hs:7:2: error: • A newtype constructor cannot have existential type variables HEq :: forall j k xx (a :: j) (b :: k). (forall (x :: forall xx1. xx1 -> *). Proxy x -> x a -> x b) -> HEq a b • In the definition of data constructor ‘HEq’ In the newtype declaration for ‘HEq’ | 7 | HEq | ^^^... Failed, no modules loaded. Prelude> }}} It compiles fine without `Proxy x ->`. Now my question is what existential type variable does `HEq` have, `-fprint-explicit-kinds` shows that `Proxy` is actually being instantiated at `(xx -> Type)` and not `(forall xx. xx -> Type)` {{{ 398.hs:10:2: error: • A newtype constructor cannot have existential type variables HEq :: forall j k xx (a :: j) (b :: k). (forall (x :: forall xx1. xx1 -> *). Proxy (xx -> *) (x xx) -> x j a -> x k b) -> HEq j a k b • In the definition of data constructor ‘HEq’ In the newtype declaration for ‘HEq’ | 10 | HEq | ^^^... }}} so I suppose my question is, can we instantiate `Proxy` at a higher-rank kind? (#12045: `Proxy @FOO`) {{{ >> type FOO = (forall xx. xx -> Type) >> :kind (Proxy :: FOO -> Type) :1:2: error: • Expected kind ‘FOO -> *’, but ‘Proxy’ has kind ‘k0 -> *’ • In the type ‘(Proxy :: FOO -> Type)’ }}} It is possible to create a bespoke `Proxy` {{{#!hs type FOO = (forall x. x -> Type) data BespokeProxy :: FOO -> Type where BespokeProxy :: forall (c :: FOO). BespokeProxy c newtype HEq :: forall j. j -> forall k. k -> Type where HEq :: (forall (x::forall xx. xx -> Type). BespokeProxy x -> x a -> x b) -> HEq a b }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 15:24:02 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 15:24:02 -0000 Subject: [GHC] #15628: Higher-rank kinds In-Reply-To: <051.5986f225355cd5a8606486fc67a0f4d5@haskell.org> References: <051.5986f225355cd5a8606486fc67a0f4d5@haskell.org> Message-ID: <066.2a83633f42021529d74d3bd2b3379754@haskell.org> #15628: Higher-rank kinds -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Instantiating a polymorphic type variable with a polytype (or polykind) is called "imprediative polymorphism" and is a swamp. GHC just does not have a decent story at the moment. But I think that is what you are asking for. But see https://www.microsoft.com/en-us/research/publication/guarded- impredicative-polymorphism/ (PLDI'18). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 15:47:21 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 15:47:21 -0000 Subject: [GHC] #15627: Absent unlifted bindings In-Reply-To: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> References: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> Message-ID: <059.3dd8b1fe77b288d91c38db4207006e32@haskell.org> #15627: Absent unlifted bindings -------------------------------------+------------------------------------- Reporter: sgraf | Owner: (none) Type: task | Status: new Priority: normal | Milestone: ⊥ Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9279 #4328 | Differential Rev(s): #11126 | Wiki Page: | -------------------------------------+------------------------------------- Changes (by sgraf): * related: #9279 #4328 => #9279 #4328 #11126 Comment: I just remember posting on ticket:11126#comment:17. While having the `absentError` mechanism around clearly is a sanity check, why only crash when it's entered? That's far too late to be a useful mechanism to debug the reason it crashed! So B) is just saying "If we messed up, at least crash with a marginally more descriptive error". Which isn't bad, but not nearly enough to debug this kind of crash across module boundaries. > I think -- but I am not sure -- that this literal should never occur in code generation. For example, we should never pass a rubbish value to a function. Before then dead-code elimination should have got rid of it I'm not 100% certain, but if this was true, it'd be a great sanity check. I'm thinking the same thing. If DCE didn't get rid of it, the demand analyser probably didn't agree with the occurrence analyser (who I presume is the final authority here), which is a bug that should be caught early to detect cross module symptoms like #11126 early. > Yes, `Literal` has `Eq` and `Ord` -- but I'm not sure why Actually, the very problems I had occurred in `cmpLit`, to which both seem to delegate. Regardless, I removed them. Let's try to see how far I get. > Do we need to spit out a RubbishLit in the Binary instance. This seems more likely, because perhaps these rubbish values can occur in unfoldings, which are serialised as their parse tree. But the we can just serialise the Type. It won't happen much. I'd like this, but there is no `Binary` instance for `Type`. I'm pretty much stuck here. I can see a hacky alternative here, namely to give `RubbishLit` the levity polymorphic `forall (r :: RuntimeRep) (a :: TYPE r)` type. Which is an unsafe lie again, because we only actually allow `AddrRep` and `UnliftedRep`. But this would allow to move the type application out of the literal. Or, looking at https://hackage.haskell.org/package/ghc-8.4.3/docs/IfaceType.html#t:IfaceType, maybe serialise that instead? Or add a new type `IfaceLiteral` to https://hackage.haskell.org/package/ghc-8.4.3/docs/IfaceSyn.html? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 15:53:32 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 15:53:32 -0000 Subject: [GHC] #15628: Higher-rank kinds In-Reply-To: <051.5986f225355cd5a8606486fc67a0f4d5@haskell.org> References: <051.5986f225355cd5a8606486fc67a0f4d5@haskell.org> Message-ID: <066.5bfa59b9cecaa8a8f096825579920d23@haskell.org> #15628: Higher-rank kinds -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): I should have known. I can close it or label it with imprediativity, I still find it mysterious that {{{#!hs -- works newtype Bar = Bar (forall (f :: FOO). ()) }}} adding a `Proxy` induces an existential variable `x` seemingly without introducing quantification, but this is maybe a problem with my intuition? Or at least something rings odd about this (then again higher-rank kinds are odd and interesting) {{{#!hs -- oops, you are actually writing -- Proxy @(x -> Type) (f @x) newtype Bar = Bar (forall (f :: FOO). Proxy f -> ()) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 16:03:57 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 16:03:57 -0000 Subject: [GHC] #15625: GHC panic, with QuantifiedConstraints In-Reply-To: <051.5bb3c3d1540b5617c1e145b1cbeec548@haskell.org> References: <051.5bb3c3d1540b5617c1e145b1cbeec548@haskell.org> Message-ID: <066.a1d61538acd6bf353366c3a404fe7aa5@haskell.org> #15625: GHC panic, with QuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): > ''[narrator] it was the equality constraint'' thanks monoidal :] the purpose for this is to be able to write `Control.Category.id` of the form {{{#!hs id :: KLEISLI m (KL a) (KL a) id = MkKLEISLI pure }}} but when we define {{{#!hs instance Category (KLEISLI m) where id :: KLEISLI m kl_a kl_a id = .. }}} GHC doesn't know that `kl_a` is of the form `KL a` (same as #7259) so I want to constraint the type signature of `id` by saying `(forall a. kl_a ~ KL a)`. But that is uncouth since it's "quantifying over constraints headed by `(~)`" (ticket:15593#comment:1) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 16:16:34 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 16:16:34 -0000 Subject: [GHC] #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite In-Reply-To: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> References: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> Message-ID: <061.71aa9c5553278e0ff8fa9a23df624cba@haskell.org> #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5145 Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonmar): * differential: => Phab:D5145 Comment: See Phab:D5145 for a fix (I hope) and commentary on what the problem was. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 16:17:32 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 16:17:32 -0000 Subject: [GHC] #15627: Absent unlifted bindings In-Reply-To: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> References: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> Message-ID: <059.cf917ad0844f7ec967db10418ba4ab36@haskell.org> #15627: Absent unlifted bindings -------------------------------------+------------------------------------- Reporter: sgraf | Owner: (none) Type: task | Status: new Priority: normal | Milestone: ⊥ Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9279 #4328 | Differential Rev(s): #11126 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Ah I see. The problem is that we are using `Literal` in `IfaceSyn`, and that is biting us here; it would be more consistent to have `IfaceLiteral`. If we did we could have {{{ data IfaceLiteral = ... | RubbishLit IfaceType | LitNumber LitNumType Integer -- No Type here; we reconstruct it in tcIfaceLit -- Avoids the smelly error-thunk in the Binary get ... }}} It's annoying that `Literal` and `IfaceLiteral` would be almost the same; some boilerplate converting to and fro. But it's ''simple'' boilerplate, and uniform with everything else. And it avoids that nasty error thunk in the binary instance of Literal. I suppose that a polymorphic literal as you suggest would be OK. You could avoid the levity polymorphism by retaining `MachNullAddr`. I'm not sure which I prefer. The `IfaceLiteral` story is less clever, and thus perhaps preferable. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 16:44:18 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 16:44:18 -0000 Subject: [GHC] #15613: GHCi command, tracing steps of instance resolution for Constraint or expression In-Reply-To: <051.315b513efc5cd955ece666611620c1e9@haskell.org> References: <051.315b513efc5cd955ece666611620c1e9@haskell.org> Message-ID: <066.12b83c2d285097844ed8921199ca4887@haskell.org> #15613: GHCi command, tracing steps of instance resolution for Constraint or expression -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: lowest | Milestone: Component: GHCi | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15610 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): All this would be cool, but it'd take some work to implement. Plus, remember it's a tree: a goal may lead to multiple sub-goals... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 16:50:46 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 16:50:46 -0000 Subject: [GHC] #15619: List comprehension seems to prevent some rewrite rules to fire In-Reply-To: <047.17a5c5547409e3ba1e026777e7cad14e@haskell.org> References: <047.17a5c5547409e3ba1e026777e7cad14e@haskell.org> Message-ID: <062.c3707ab0dfffeb23dfd9685550841650@haskell.org> #15619: List comprehension seems to prevent some rewrite rules to fire -------------------------------------+------------------------------------- Reporter: nobrakal | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I have not looked in detail, but this looks delicate. {{{ transpose (star 0 ) ==> { inline star } transpose (case of [] -> vertex 0 _ -> vertex 0) }}} At this point the `transpose/vertex` rule can't fire. If we discover that `` is non-empty (which is the case here), the it will fire. But is `[1..2]` non empty? It expands to `enumFromTo 1 2` or something like that. It's hard for GHC to tell that's non-empty. You may say that it should expand to `[1,2]`, but if it was `[1..10000]` would you want it to expand? And what about `[n..m]`? I'm not saying we couldn't do better here, but at the moment I don't see a simple, robust way to do so. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 16:58:01 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 16:58:01 -0000 Subject: [GHC] #13064: Incorrect redudant imports warning In-Reply-To: <045.fe3c1c6b618d0b4877de88fc27add363@haskell.org> References: <045.fe3c1c6b618d0b4877de88fc27add363@haskell.org> Message-ID: <060.57f381bf979d3659727ed166df897076@haskell.org> #13064: Incorrect redudant imports warning -------------------------------------+------------------------------------- Reporter: phadej | Owner: (none) Type: bug | Status: new Priority: low | Milestone: 8.8.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #15393 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by ekmett): I'm leaning on the side of applying this change and my reasoning pretty closely follows Ryan's. Between the ability to explicitly qualify use in the presence of a conflict and the fact that the common "open" import of all things in a module still work out of the box, I'm pretty happy to say we should fix the bug and change programming styles slightly. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 17:49:33 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 17:49:33 -0000 Subject: [GHC] #15613: GHCi command, tracing steps of instance resolution for Constraint or expression In-Reply-To: <051.315b513efc5cd955ece666611620c1e9@haskell.org> References: <051.315b513efc5cd955ece666611620c1e9@haskell.org> Message-ID: <066.23ffab93bb179a033e6a83fc0ddf7362@haskell.org> #15613: GHCi command, tracing steps of instance resolution for Constraint or expression -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: lowest | Milestone: Component: GHCi | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15610 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): > Plus, remember it's a tree: a goal may lead to multiple sub-goals... Yes. Should I make a GHC proposal or is it minimal enough to decide here? I started implementing it: Where do I tap into the current machinery and how best to pass the tree back? It took me a while to be able to find the class being solved, by using `mkClassPred clas tys` in definitions like [https://hackage.haskell.org/package/ghc-8.4.3/docs/src/TcInteract.html#runSolverPipeline runSolverPipeline], [https://hackage.haskell.org/package/ghc-8.4.3/docs/src/InstEnv.html#memberInstEnv matchInstEnv] .. {{{#!hs run_pipeline ((stg_name,stg):stgs) (ContinueWith ct) = do { traceTcS ("runStage " ++ stg_name ++ " {") (text "workitem = " <+> ppr ct) ; res <- stg ct ; let current :: PredType current = mkClassPred clas tys ; traceTcS ("end stage " ++ stg_name ++ " }") empty ; run_pipeline stgs res } }}} and then calling `hscTcExpr` from ''UI''. I'm sure there is a better way but that's how I got started -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 18:04:18 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 18:04:18 -0000 Subject: [GHC] #15628: Higher-rank kinds In-Reply-To: <051.5986f225355cd5a8606486fc67a0f4d5@haskell.org> References: <051.5986f225355cd5a8606486fc67a0f4d5@haskell.org> Message-ID: <066.316376587361bfb1bc3331228a027ba1@haskell.org> #15628: Higher-rank kinds -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: duplicate | Keywords: | ImpredicativeTypes Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * keywords: => ImpredicativeTypes * status: new => closed * resolution: => duplicate Comment: Replying to [comment:2 Iceland_jack]: > adding a `Proxy` induces an existential variable `x` seemingly without introducing quantification It //does// introduce quantification, and it's precisely because GHC can't support impredicative polymorphism at the moment. When you write: {{{#!hs newtype Bar = Bar (forall (f :: forall xx. xx -> Type). Proxy f -> ()) }}} Then if we display all arguments visibly, this is what you are trying to write: {{{#!hs newtype Bar = Bar (forall (f :: forall xx. xx -> Type). Proxy @(forall xx. xx -> Type) f -> ()) }}} You can't instantiate `Proxy`'s first argument with `forall xx. xx -> Type` since it is a polytype, and that would be impredicative. Therefore, GHC has to pick //something// to instantiate `xx` with in order to avoid impredicativity. Since we're in a data type, GHC bails out by creating an existentially quantified variable `x` and using that to instantiate the higher-rank kind: {{{#!hs newtype Bar = forall x. Bar (forall (f :: x -> Type). Proxy @(x -> Type) (f @x) -> ()) }}} But `Bar` is a newtype, and therefore can't have existentials, leading to your error. As simonpj notes in comment:1, this ticket is really asking for impredicative polymorphism. There is already a raft of tickets about this topic, so I'll opt to close this one. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 18:12:23 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 18:12:23 -0000 Subject: [GHC] #13064: Incorrect redudant imports warning In-Reply-To: <045.fe3c1c6b618d0b4877de88fc27add363@haskell.org> References: <045.fe3c1c6b618d0b4877de88fc27add363@haskell.org> Message-ID: <060.e544e4509ef2478062b633e7dc398f5b@haskell.org> #13064: Incorrect redudant imports warning -------------------------------------+------------------------------------- Reporter: phadej | Owner: (none) Type: bug | Status: new Priority: low | Milestone: 8.8.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #15393 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by andrewthad): As a member of the CLC, I'm in favor of fixing GHC so that it conforms to the spec. I agree with Ryan and Edward's reasoning on this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 18:35:54 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 18:35:54 -0000 Subject: [GHC] #15629: "No skolem info" panic (GHC 8.6 only) Message-ID: <050.dd398323ba018b74f7bb68214187ebb6@haskell.org> #15629: "No skolem info" panic (GHC 8.6 only) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 (Type checker) | Keywords: TypeInType | Operating System: Unknown/Multiple Architecture: | Type of failure: Compile-time Unknown/Multiple | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- The following program: {{{#!hs {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} module Bug where import Data.Kind import Data.Proxy import GHC.Generics data TyFun :: Type -> Type -> Type type a ~> b = TyFun a b -> Type infixr 0 ~> type family Apply (f :: k1 ~> k2) (x :: k1) :: k2 data family Sing :: forall k. k -> Type newtype instance Sing (f :: k1 ~> k2) = SLambda { applySing :: forall t. Sing t -> Sing (Apply f t) } singFun1 :: forall f. (forall t. Sing t -> Sing (Apply f t)) -> Sing f singFun1 f = SLambda f data From1Sym0 :: forall k (f :: k -> Type) (a :: k). f a ~> Rep1 f a data To1Sym0 :: forall k (f :: k -> Type) (a :: k). Rep1 f a ~> f a type family ((f :: b ~> c) :. (g :: a ~> b)) (x :: a) :: c where (f :. g) x = Apply f (Apply g x) data (.@#@$$$) :: forall b c a. (b ~> c) -> (a ~> b) -> (a ~> c) type instance Apply (f .@#@$$$ g) x = (f :. g) x (%.) :: forall a b c (f :: b ~> c) (g :: a ~> b) (x :: a). Sing f -> Sing g -> Sing x -> Sing ((f :. g) x) (sf %. sg) sx = applySing sf (applySing sg sx) (%.$$$) :: forall a b c (f :: b ~> c) (g :: a ~> b) (x :: a). Sing f -> Sing g -> Sing (f .@#@$$$ g) sf %.$$$ sg = singFun1 (sf %. sg) f :: forall (m :: Type -> Type) x. Proxy (m x) -> () f _ = () where sFrom1Fun :: forall ab. Sing (From1Sym0 :: m ab ~> Rep1 m ab) sFrom1Fun = undefined sTo1Fun :: forall ab. Sing (To1Sym0 :: Rep1 m ab ~> m ab) sTo1Fun = undefined sFrom1To1Fun :: forall ab. Sing (((From1Sym0 :: m z ~> Rep1 m z) .@#@$$$ To1Sym0) :: Rep1 m ab ~> Rep1 m ab) sFrom1To1Fun = sFrom1Fun %.$$$ sTo1Fun }}} Panics on GHC 8.6: {{{ $ /opt/ghc/8.6.1/bin/ghc Bug.hs [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) Bug.hs:50:39: error: • Expected kind ‘m z ~> Rep1 m ab1’, but ‘(From1Sym0 :: m z ~> Rep1 m z)’ has kind ‘m z ~> Rep1 m z’ • In the first argument of ‘(.@#@$$$)’, namely ‘(From1Sym0 :: m z ~> Rep1 m z)’ In the first argument of ‘Sing’, namely ‘(((From1Sym0 :: m z ~> Rep1 m z) .@#@$$$ To1Sym0) :: Rep1 m ab ~> Rep1 m ab)’ In the type signature: sFrom1To1Fun :: forall ab. Sing (((From1Sym0 :: m z ~> Rep1 m z) .@#@$$$ To1Sym0) :: Rep1 m ab ~> Rep1 m ab) | 50 | sFrom1To1Fun :: forall ab. Sing (((From1Sym0 :: m z ~> Rep1 m z) .@#@$$$ To1Sym0) :: Rep1 m ab ~> Rep1 m ab) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Bug.hs:51:20: error:ghc: panic! (the 'impossible' happened) (GHC version 8.6.0.20180823 for x86_64-unknown-linux): No skolem info: [ab_a1UW[sk:1]] Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1160:37 in ghc:Outputable pprPanic, called at compiler/typecheck/TcErrors.hs:2891:5 in ghc:TcErrors }}} But merely errors on GHC 8.4.3: {{{ $ /opt/ghc/8.4.3/bin/ghc Bug.hs [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) Bug.hs:50:39: error: • Expected kind ‘m z ~> Rep1 m ab2’, but ‘(From1Sym0 :: m z ~> Rep1 m z)’ has kind ‘m z ~> Rep1 m z’ • In the first argument of ‘(.@#@$$$)’, namely ‘(From1Sym0 :: m z ~> Rep1 m z)’ In the first argument of ‘Sing’, namely ‘(((From1Sym0 :: m z ~> Rep1 m z) .@#@$$$ To1Sym0) :: Rep1 m ab ~> Rep1 m ab)’ In the type signature: sFrom1To1Fun :: forall ab. Sing (((From1Sym0 :: m z ~> Rep1 m z) .@#@$$$ To1Sym0) :: Rep1 m ab ~> Rep1 m ab) | 50 | sFrom1To1Fun :: forall ab. Sing (((From1Sym0 :: m z ~> Rep1 m z) .@#@$$$ To1Sym0) :: Rep1 m ab ~> Rep1 m ab) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Bug.hs:51:20: error: • Couldn't match type ‘ab1’ with ‘z1’ because type variable ‘z1’ would escape its scope This (rigid, skolem) type variable is bound by the type signature for: sFrom1To1Fun :: forall z1 ab3. Sing (From1Sym0 .@#@$$$ To1Sym0) at Bug.hs:50:5-112 Expected type: Sing From1Sym0 Actual type: Sing From1Sym0 • In the first argument of ‘(%.$$$)’, namely ‘sFrom1Fun’ In the expression: sFrom1Fun %.$$$ sTo1Fun In an equation for ‘sFrom1To1Fun’: sFrom1To1Fun = sFrom1Fun %.$$$ sTo1Fun • Relevant bindings include sFrom1To1Fun :: Sing (From1Sym0 .@#@$$$ To1Sym0) (bound at Bug.hs:51:5) | 51 | sFrom1To1Fun = sFrom1Fun %.$$$ sTo1Fun | ^^^^^^^^^ Bug.hs:51:36: error: • Couldn't match type ‘ab’ with ‘z1’ because type variable ‘z1’ would escape its scope This (rigid, skolem) type variable is bound by the type signature for: sFrom1To1Fun :: forall z1 ab3. Sing (From1Sym0 .@#@$$$ To1Sym0) at Bug.hs:50:5-112 Expected type: Sing To1Sym0 Actual type: Sing To1Sym0 • In the second argument of ‘(%.$$$)’, namely ‘sTo1Fun’ In the expression: sFrom1Fun %.$$$ sTo1Fun In an equation for ‘sFrom1To1Fun’: sFrom1To1Fun = sFrom1Fun %.$$$ sTo1Fun • Relevant bindings include sFrom1To1Fun :: Sing (From1Sym0 .@#@$$$ To1Sym0) (bound at Bug.hs:51:5) | 51 | sFrom1To1Fun = sFrom1Fun %.$$$ sTo1Fun | ^^^^^^^ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 18:36:43 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 18:36:43 -0000 Subject: [GHC] #15629: "No skolem info" panic (GHC 8.6 only) In-Reply-To: <050.dd398323ba018b74f7bb68214187ebb6@haskell.org> References: <050.dd398323ba018b74f7bb68214187ebb6@haskell.org> Message-ID: <065.14a6dfd63f92f17c1d44a1375fd60ad3@haskell.org> #15629: "No skolem info" panic (GHC 8.6 only) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.6.1-beta1 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Blimey, it looks like this has been fixed on GHC HEAD: {{{ $ /opt/ghc/head/bin/ghci Bug.hs GHCi, version 8.7.20180827: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Bug.hs:50:39: error: • Expected kind ‘m z ~> Rep1 m ab’, but ‘(From1Sym0 :: m z ~> Rep1 m z)’ has kind ‘m z ~> Rep1 m z’ • In the first argument of ‘(.@#@$$$)’, namely ‘(From1Sym0 :: m z ~> Rep1 m z)’ In the first argument of ‘Sing’, namely ‘(((From1Sym0 :: m z ~> Rep1 m z) .@#@$$$ To1Sym0) :: Rep1 m ab ~> Rep1 m ab)’ In the type signature: sFrom1To1Fun :: forall ab. Sing (((From1Sym0 :: m z ~> Rep1 m z) .@#@$$$ To1Sym0) :: Rep1 m ab ~> Rep1 m ab) | 50 | sFrom1To1Fun :: forall ab. Sing (((From1Sym0 :: m z ~> Rep1 m z) .@#@$$$ To1Sym0) :: Rep1 m ab ~> Rep1 m ab) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Bug.hs:51:20: error: • Couldn't match type ‘z’ with ‘ab’ ‘z’ is a rigid type variable bound by the type signature for: sFrom1To1Fun :: forall z1 ab1. Sing (From1Sym0 .@#@$$$ To1Sym0) at Bug.hs:50:5-112 ‘ab’ is a rigid type variable bound by the type signature for: sFrom1To1Fun :: forall z1 ab1. Sing (From1Sym0 .@#@$$$ To1Sym0) at Bug.hs:50:5-112 Expected type: Sing (From1Sym0 .@#@$$$ To1Sym0) Actual type: Sing (From1Sym0 .@#@$$$ To1Sym0) • In the expression: sFrom1Fun %.$$$ sTo1Fun In an equation for ‘sFrom1To1Fun’: sFrom1To1Fun = sFrom1Fun %.$$$ sTo1Fun In an equation for ‘f’: f _ = () where sFrom1Fun :: forall ab. Sing (From1Sym0 :: m ab ~> Rep1 m ab) sFrom1Fun = undefined sTo1Fun :: forall ab. Sing (To1Sym0 :: Rep1 m ab ~> m ab) sTo1Fun = undefined .... • Relevant bindings include sFrom1To1Fun :: Sing (From1Sym0 .@#@$$$ To1Sym0) (bound at Bug.hs:51:5) | 51 | sFrom1To1Fun = sFrom1Fun %.$$$ sTo1Fun | ^^^^^^^^^^^^^^^^^^^^^^^ }}} I'm dying to know what fixed this... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 19:59:26 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 19:59:26 -0000 Subject: [GHC] #14391: Make the simplifier independent of the typechecker In-Reply-To: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> References: <046.0a550c305c7e5731d1526aa1438cdf9f@haskell.org> Message-ID: <061.cc44a4410962ab1a61d2a9d5de177e03@haskell.org> #14391: Make the simplifier independent of the typechecker -------------------------------------+------------------------------------- Reporter: nomeata | Owner: monoidal Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4503, Wiki Page: | Phab:D5135, Phab:D5139 -------------------------------------+------------------------------------- Comment (by Krzysztof Gogolewski ): In [changeset:"03b779f2444c438204789c7ced0ed23556f7b105/ghc" 03b779f/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="03b779f2444c438204789c7ced0ed23556f7b105" Make CoreMonad independent of TcEnv (#14391) Summary: This removes the last direct import from simplCore/ to typechecker/. Test Plan: validate Reviewers: nomeata, simonpj, bgamari Reviewed By: simonpj Subscribers: rwbarton, carter GHC Trac Issues: #14391 Differential Revision: https://phabricator.haskell.org/D5139 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 20:11:44 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 20:11:44 -0000 Subject: [GHC] #15629: "No skolem info" panic (GHC 8.6 only) In-Reply-To: <050.dd398323ba018b74f7bb68214187ebb6@haskell.org> References: <050.dd398323ba018b74f7bb68214187ebb6@haskell.org> Message-ID: <065.52a280b93b7a52500a86478aa5c71917@haskell.org> #15629: "No skolem info" panic (GHC 8.6 only) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.6.1-beta1 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Interesting! I'm sure you are bisecting as we speak. It'd be good to add a regression test regardless. Thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 20:14:23 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 20:14:23 -0000 Subject: [GHC] #13064: Incorrect redudant imports warning In-Reply-To: <045.fe3c1c6b618d0b4877de88fc27add363@haskell.org> References: <045.fe3c1c6b618d0b4877de88fc27add363@haskell.org> Message-ID: <060.d79651efdf87ec6f1b362a6f391982f0@haskell.org> #13064: Incorrect redudant imports warning -------------------------------------+------------------------------------- Reporter: phadej | Owner: (none) Type: bug | Status: new Priority: low | Milestone: 8.8.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #15393 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Thanks both. Edward, if you could, over the next week or two, lead the CLC to make a decision -- or take an executive decision yourself -- then we can act. Thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 20:20:16 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 20:20:16 -0000 Subject: [GHC] #15629: "No skolem info" panic (GHC 8.6 only) In-Reply-To: <050.dd398323ba018b74f7bb68214187ebb6@haskell.org> References: <050.dd398323ba018b74f7bb68214187ebb6@haskell.org> Message-ID: <065.6d6f6e83fda91cfcb0a6587f60e072c6@haskell.org> #15629: "No skolem info" panic (GHC 8.6 only) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.6.1-beta1 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Found it. It's commit 042df603cbb5a77ec13ccfec2ce7bad2bb940aae: {{{ From 042df603cbb5a77ec13ccfec2ce7bad2bb940aae Mon Sep 17 00:00:00 2001 From: Richard Eisenberg Date: Thu, 5 Jul 2018 14:21:43 -0400 Subject: [PATCH] Unwrap casts before checking vars in eager unifier Previously, checking whether (tv |> co) ~ (tv |> co) got deferred, because we looked for vars before stripping casts. (The left type would get stripped, and then tv ~ (tv |> co) would scare the occurs- checker.) This opportunity for improvement presented itself in other work. This is just an optimization. Some programs can now report more errors simultaneously. }}} Pretty impressive for "just an optimization" :) And yes, we should absolutely add a regression test for this, since I couldn't find another program of this caliber in the test suite currently. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 20:33:32 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 20:33:32 -0000 Subject: [GHC] #15629: "No skolem info" panic (GHC 8.6 only) In-Reply-To: <050.dd398323ba018b74f7bb68214187ebb6@haskell.org> References: <050.dd398323ba018b74f7bb68214187ebb6@haskell.org> Message-ID: <065.0d101cbe1edbef9bd7cf0bf33140d4d4@haskell.org> #15629: "No skolem info" panic (GHC 8.6 only) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.6.1-beta1 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Oh my, hand on. Everything should work if the eager unifier does NOTHING. Indeed, I'd love to have a flag `-fno-eager-unifier` which switches off the eager unifier in order to stress the constraint solver. It'd b easy: in `TcUnify.uType`, test the flag and call `uType_defer` immediately if `-fno-eager-unifier` is set. I bet this shows up lots of bugs, so I partly fear to suggest it :-). For this one, does the `No skolem` come back? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 20:46:05 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 20:46:05 -0000 Subject: [GHC] #14251: LLVM Code Gen messes up registers In-Reply-To: <047.9ece2514d7c7f668525c93ec15fb841a@haskell.org> References: <047.9ece2514d7c7f668525c93ec15fb841a@haskell.org> Message-ID: <062.fb46ee09b0c99f501fb5974ecd5d0b57@haskell.org> #14251: LLVM Code Gen messes up registers -------------------------------------+------------------------------------- Reporter: angerman | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler (LLVM) | Version: 8.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by George): fwiw, imho, documenting this in the release notes makes sense, holding up the release for what may have been a latent bug for a long time does not. Adding a test would be good. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 20:56:06 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 20:56:06 -0000 Subject: [GHC] #15613: GHCi command, tracing steps of instance resolution for Constraint or expression In-Reply-To: <051.315b513efc5cd955ece666611620c1e9@haskell.org> References: <051.315b513efc5cd955ece666611620c1e9@haskell.org> Message-ID: <066.53b4b74b34bd802a0993bde867ffb80b@haskell.org> #15613: GHCi command, tracing steps of instance resolution for Constraint or expression -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: lowest | Milestone: Component: GHCi | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15610 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I think you might want something more like `simplifyDefault` or `solveWanteds`, both exported by `TcSimplify`. Mostly these functions are used ''within'' the typechecker, but the pattern match overlap checker uses the constraint solver in `Check.tyOracle`. A significant factor is whether you want any "givens"; that is, do you want to explain why a constraint fails to be solved under a GADT match, or in a function with a given context. Once you get deeper into the constraint solver, solving one step of each individual constraint, you need the `TcS` monad, which holds the inert set... I'm not sure you want to get into that. Better to tell the constraint solver to try to solve, and see what is left over: it'll return (a) any unsolved constraints and (b) evidence bindings that amount to a specification of the exact proof that it came up with; i.e. the tree you want to display. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 21:07:02 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 21:07:02 -0000 Subject: [GHC] #15625: GHC panic, with QuantifiedConstraints In-Reply-To: <051.5bb3c3d1540b5617c1e145b1cbeec548@haskell.org> References: <051.5bb3c3d1540b5617c1e145b1cbeec548@haskell.org> Message-ID: <066.a11ee94d77bf101dd9dd5f436c0b9dc6@haskell.org> #15625: GHC panic, with QuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Another, even simpler example, this time with `Coercible` {{{ ekki__ :: (forall b. Coercible a b) => a ekki__ = coerce False }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 22:53:37 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 22:53:37 -0000 Subject: [GHC] #15630: panic! Simplifier ticks exhausted Message-ID: <049.c44dcaac100e8732d769d68c9db99cf2@haskell.org> #15630: panic! Simplifier ticks exhausted --------------------------------------+--------------------------------- Reporter: micahshahn | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Windows Architecture: x86_64 (amd64) | Type of failure: None/Unknown Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: --------------------------------------+--------------------------------- Compiling the following with -O2 causes a panic. {{{#!hs module GHCPanic where data IValue = IDefault | IInt Int | IBlob String (?) :: Applicative m => (IValue -> m a) -> IValue -> m (Maybe a) (?) _ IDefault = pure Nothing (?) p x = Just <$> p x getInt :: IValue -> Either () Int getInt (IInt i) = Right i getInt v = Left () getString :: IValue -> Either () String getString (IBlob b) = Right $ b getString v = Left () (<+>) :: Applicative m => (m (a -> b), [IValue]) -> (IValue -> m a) -> (m b, [IValue]) (<+>) (f, (v:vs)) p = (f <*> (p v), vs) data TestStructure = TestStructure { _param1 :: Int , _param2 :: Maybe String , _param3 :: Maybe Int , _param4 :: Maybe String , _param5 :: Maybe Int , _param6 :: Maybe Int , _param7 :: Maybe String , _param8 :: Maybe String , _param9 :: Maybe Int , _param10 :: Maybe Int , _param11 :: Maybe String , _param12 :: Maybe String , _param13 :: Maybe Int , _param14 :: Maybe Int , _param15 :: Maybe String } getMenuItem :: [IValue] -> Either () TestStructure getMenuItem vs = fst $ (pure TestStructure, vs) <+> getInt <+> (getString ?) <+> (getInt ?) <+> (getString ?) <+> (getInt ?) <+> (getInt ?) <+> (getString ?) <+> (getString ?) <+> (getInt ?) <+> (getInt ?) <+> (getString ?) <+> (getString ?) <+> (getInt ?) <+> (getInt ?) <+> (getString ?) }}} {{{ ghc.exe: panic! (the 'impossible' happened) (GHC version 8.2.2 for x86_64-unknown-mingw32): Simplifier ticks exhausted When trying UnfoldingDone $j_s1y9 To increase the limit, use -fsimpl-tick-factor=N (default 100) If you need to do this, let GHC HQ know, and what factor you needed To see detailed counts use -ddump-simpl-stats Total ticks: 71323 Call stack: CallStack (from HasCallStack): prettyCurrentCallStack, called at compiler\utils\Outputable.hs:1133:58 in ghc:Outputable callStackDoc, called at compiler\utils\Outputable.hs:1137:37 in ghc:Outputable pprPanic, called at compiler\simplCore\SimplMonad.hs:199:31 in ghc:SimplMonad }}} This seems similar to #8319 which was marked as being fixed. It compiles (albeit very very slowly!) if I remove the last parameter and the last application of (<+>). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 23:26:29 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 23:26:29 -0000 Subject: [GHC] #15629: "No skolem info" panic (GHC 8.6 only) In-Reply-To: <050.dd398323ba018b74f7bb68214187ebb6@haskell.org> References: <050.dd398323ba018b74f7bb68214187ebb6@haskell.org> Message-ID: <065.a214760cf1cd89e11b787bdc6283327b@haskell.org> #15629: "No skolem info" panic (GHC 8.6 only) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.6.1-beta1 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): In a quick hack, I added a `-fno-eager-unifier` flag: {{{#!diff diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 9f0ba57..a2f269d 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -557,6 +557,7 @@ data GeneralFlag | Opt_OptimalApplicativeDo | Opt_VersionMacros | Opt_WholeArchiveHsLibs + | Opt_NoEagerUnifier -- copy all libs into a single folder prior to linking binaries -- this should elivate the excessive command line limit restrictions -- on windows, by only requiring a single -L argument instead of @@ -3017,6 +3018,7 @@ dynamic_flags_deps = [ , make_ord_flag defGhcFlag "dhex-word-literals" (NoArg (setGeneralFlag Opt_HexWordLiterals)) + , make_ord_flag defGhcFlag "ghcversion-file" (hasArg addGhcVersionFile) , make_ord_flag defGhcFlag "main-is" (SepArg setMainIs) , make_ord_flag defGhcFlag "haddock" (NoArg (setGeneralFlag Opt_Haddock)) @@ -4003,7 +4005,8 @@ fFlagsDeps = [ flagSpec "show-warning-groups" Opt_ShowWarnGroups, flagSpec "hide-source-paths" Opt_HideSourcePaths, flagSpec "show-loaded-modules" Opt_ShowLoadedModules, - flagSpec "whole-archive-hs-libs" Opt_WholeArchiveHsLibs + flagSpec "whole-archive-hs-libs" Opt_WholeArchiveHsLibs, + flagSpec "no-eager-unifier" Opt_NoEagerUnifier ] ++ fHoleFlags diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs index 045132e..fb937b7 100644 --- a/compiler/typecheck/TcUnify.hs +++ b/compiler/typecheck/TcUnify.hs @@ -1348,7 +1348,11 @@ uType_defer t_or_k origin ty1 ty2 -------------- uType t_or_k origin orig_ty1 orig_ty2 - = do { tclvl <- getTcLevel + = do { no_eager <- goptM Opt_NoEagerUnifier + ; if no_eager + then uType_defer t_or_k origin orig_ty1 orig_ty2 + else do + { tclvl <- getTcLevel ; traceTc "u_tys" $ vcat [ text "tclvl" <+> ppr tclvl , sep [ ppr orig_ty1, text "~", ppr orig_ty2] @@ -1357,7 +1361,7 @@ uType t_or_k origin orig_ty1 orig_ty2 ; if isReflCo co then traceTc "u_tys yields no coercion" Outputable.empty else traceTc "u_tys yields coercion:" (ppr co) - ; return co } + ; return co } } where go :: TcType -> TcType -> TcM CoercionN -- The arguments to 'go' are always semantically identical }}} However, the panic does //not// reappear if you compile the original program with `-fno-eager-unifier`. The only differences I could observe were minor variations in error quality. With `-fno-eager-unifier` enabled, you don't see any of the "`‘z’ is a rigid type variable bound by`..." stuff, for instance. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 11 23:46:51 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 11 Sep 2018 23:46:51 -0000 Subject: [GHC] #15629: "No skolem info" panic (GHC 8.6 only) In-Reply-To: <050.dd398323ba018b74f7bb68214187ebb6@haskell.org> References: <050.dd398323ba018b74f7bb68214187ebb6@haskell.org> Message-ID: <065.d0ec2190e45d0b440b934cbf08a56053@haskell.org> #15629: "No skolem info" panic (GHC 8.6 only) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.6.1-beta1 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): OK -- that's good! If the flag stays, it should probably be `-feager- unifier` (on by default) because we have generic `-fnoxxx` machinery. I'm still very suspicious that the Real Bug is not fixed, just somehow hidden by the patch. So I'm a bit reluctant to declare victory and close. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 00:22:06 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 00:22:06 -0000 Subject: [GHC] #15628: Higher-rank kinds In-Reply-To: <051.5986f225355cd5a8606486fc67a0f4d5@haskell.org> References: <051.5986f225355cd5a8606486fc67a0f4d5@haskell.org> Message-ID: <066.89040c5a634a395b713ad4a0b268bce2@haskell.org> #15628: Higher-rank kinds -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: duplicate | Keywords: | ImpredicativeTypes Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Just chiming in that I agree with the other analysis. I think GHC is doing the right thing here, given that it can't do impredicative instantiation. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 06:14:27 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 06:14:27 -0000 Subject: [GHC] #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite In-Reply-To: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> References: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> Message-ID: <061.f0fc6d0dba1b1ad843dc084d6394ed39@haskell.org> #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: patch Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5145 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: new => patch -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 06:51:12 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 06:51:12 -0000 Subject: [GHC] #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite In-Reply-To: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> References: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> Message-ID: <061.51886760e5a69ebf058e51a7f7719343@haskell.org> #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: patch Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5145 Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): The patch (when applied to 8.6 branch with STM fix, after a distclean) seems to fix the segfault, but I'm still getting {{{ test-sha256: too many pending signals }}} I see that this error was not reported before but it's something I was getting while trying to reproduce the segfault. Maybe there are multiple bugs? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 06:55:02 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 06:55:02 -0000 Subject: [GHC] #15630: panic! Simplifier ticks exhausted In-Reply-To: <049.c44dcaac100e8732d769d68c9db99cf2@haskell.org> References: <049.c44dcaac100e8732d769d68c9db99cf2@haskell.org> Message-ID: <064.efed881336e63698fc135b9b97d807d7@haskell.org> #15630: panic! Simplifier ticks exhausted ---------------------------------+-------------------------------------- Reporter: micahshahn | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+-------------------------------------- Changes (by osa1): * version: 8.2.2 => 8.5 * milestone: 8.6.1 => Comment: Confirmed on GHC HEAD and 8.6 beta. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 07:15:22 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 07:15:22 -0000 Subject: [GHC] #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite In-Reply-To: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> References: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> Message-ID: <061.3e0e8d76daeeef6e17be221aa7bf0425@haskell.org> #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: patch Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5145 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonmar): I think the error you're seeing is the non-threaded equivalent of `test- sha256: lost signal due to full pipe: 11`. Try turning `-threaded` back on to see what the signal number is. Something in this test installs signal handlers for a lot of different signals (maybe all of them?). This is why we were getting `test-sha256: lost signal due to full pipe: 11` - the program was throwing `SIGSEGV` (signal 11), the handler runs and writes it to a pipe, and the pipe fills up because `SIGSEGV` is thrown repeatedly. When working on the test I disabled the catching of these signals in the RTS, but I don't know where in the test it does this, maybe Tasty? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 07:33:37 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 07:33:37 -0000 Subject: [GHC] #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite In-Reply-To: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> References: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> Message-ID: <061.d1d8d0b9645e2a248148ac2b56f8ae0a@haskell.org> #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: patch Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5145 Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): Interesting, maybe the segfault is still happening then, because I'm getting `test-sha256: lost signal due to full pipe: 11` with threaded runtime. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 08:20:26 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 08:20:26 -0000 Subject: [GHC] #15630: panic! Simplifier ticks exhausted In-Reply-To: <049.c44dcaac100e8732d769d68c9db99cf2@haskell.org> References: <049.c44dcaac100e8732d769d68c9db99cf2@haskell.org> Message-ID: <064.6f88c9bbec681e1faebd2f948d4473f3@haskell.org> #15630: panic! Simplifier ticks exhausted ---------------------------------+-------------------------------------- Reporter: micahshahn | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+-------------------------------------- Comment (by simonpj): I strongly suspect that this is another example of #13253. Look at the example in `bad.hs` on that ticket. We know exactly what is going wrong -- see the comment stream. I've had a fix pending in my tree for months, but I keep getting pre- empted. Your new ticket will help incentivise me. Is it mission critical for you? Putting NOINLINE on `<+>` might well fix it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 08:21:03 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 08:21:03 -0000 Subject: [GHC] #13253: Exponential compilation time with RWST & ReaderT stack with `-02` In-Reply-To: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> References: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> Message-ID: <060.8f8c4a2938a8ba19948553ccae713b38@haskell.org> #13253: Exponential compilation time with RWST & ReaderT stack with `-02` -------------------------------------+------------------------------------- Reporter: phadej | Owner: bgamari, osa1 Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #15630 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * related: => #15630 Comment: I think #15630 is another example. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 08:38:34 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 08:38:34 -0000 Subject: [GHC] #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite In-Reply-To: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> References: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> Message-ID: <061.edb332b3420d37923ff12e315473f2d8@haskell.org> #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: patch Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5145 Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): I also managed to get a panic in the GC (non-debug runtime): {{{ Thread 5 (Thread 0x7fffeffff700 (LWP 26724)): #0 __GI_raise (sig=sig at entry=6) at ../sysdeps/unix/sysv/linux/raise.c:51 #1 0x00007ffff69cc801 in __GI_abort () at abort.c:79 #2 0x0000000000d9a175 in rtsFatalInternalErrorFn (s=0xe02de8 "evacuate: strange closure type %d", ap=0x7fffefffeaf8) at rts/RtsMessages.c:186 #3 0x0000000000d9a2bd in barf (s=s at entry=0xe02de8 "evacuate: strange closure type %d") at rts/RtsMessages.c:48 #4 0x000000000040a259 in evacuate1 (p=p at entry=0xe2c500) at rts/sm/Evac.c:862 #5 0x0000000000dc84f8 in scavenge_static () at rts/sm/Scav.c:1690 #6 scavenge_loop1 () at rts/sm/Scav.c:2085 #7 0x0000000000dad542 in scavenge_until_all_done () at rts/sm/GC.c:1085 #8 0x0000000000dade65 in GarbageCollect (collect_gen=collect_gen at entry=1, do_heap_census=do_heap_census at entry=false, gc_type=gc_type at entry=2, cap=0x1000240 , cap at entry=0x1019f10, idle_cap=idle_cap at entry=0x7fffe4000d80) at rts/sm/GC.c:416 #9 0x0000000000d9c012 in scheduleDoGC (pcap=pcap at entry=0x7fffefffee70, task=task at entry=0x7fffe8000b70, force_major=force_major at entry=false) at rts/Schedule.c:1797 #10 0x0000000000d9c9ea in schedule (initialCapability=initialCapability at entry=0x1000240 , task=task at entry=0x7fffe8000b70) at rts/Schedule.c:545 #11 0x0000000000d9df4c in scheduleWorker (cap=cap at entry=0x1000240 , task=task at entry=0x7fffe8000b70) at rts/Schedule.c:2550 #12 0x0000000000da4e07 in workerStart (task=0x7fffe8000b70) at rts/Task.c:444 #13 0x00007ffff72106db in start_thread (arg=0x7fffeffff700) at pthread_create.c:463 #14 0x00007ffff6aad88f in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:95 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 08:41:39 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 08:41:39 -0000 Subject: [GHC] #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite In-Reply-To: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> References: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> Message-ID: <061.84d30323b1c5c6d8e6e1fb74e2f3116f@haskell.org> #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: patch Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5145 Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): When I disable signal handling in tasty I can see the segfault in gdb: {{{ Thread 2 (Thread 27849.27861): #0 0x000000420032dab1 in ?? () #1 0x0000000000000000 in ?? () }}} GHC stack: {{{ >>> python import ghc_gdb >>> ghc backtrace Sp = 0x42001ca2a0 0: RET_SMALL return=0x90bec0 field 0: Ptr 0x42000350a0 : THUNK_0_1 1: UPDATE_FRAME(0x4200035000: THUNK_1_0) 2: RET_SMALL return=0x8f9190 3: UPDATE_FRAME(0x4200035048: THUNK_1_0) 4: RET_SMALL return=0x689d30 field 0: Word 283469849024 5: RET_SMALL return=0xaa5f50 field 0: Ptr 0x42001ea1b0 : ARR_WORDS 6: RET_SMALL return=0x689ee0 7: RET_SMALL return=0x409a20 8: UPDATE_FRAME(0x42001ca430: BLACKHOLE) 9: RET_SMALL return=0x40b270 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 08:46:53 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 08:46:53 -0000 Subject: [GHC] #15631: Lost opportunity to eliminate seq Message-ID: <046.d8c88fcbd3653a11d724ae33c4e5382e@haskell.org> #15631: Lost opportunity to eliminate seq -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 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: -------------------------------------+------------------------------------- Consider this: {{{ f xs = let ys = reverse xs in ys `seq` length xs + length (reverse (case ys of { a:as -> as; [] -> [] })) }}} We end up with this {{{ Foo.$wf = \ (@ a_s4a0) (w_s4a1 :: [a_s4a0]) -> (1) case GHC.List.reverse1 @ a_s4a0 w_s4a1 (GHC.Types.[] @ a_s4a0) of ys_ap9 { __DEFAULT -> case GHC.List.$wlenAcc @ a_s4a0 w_s4a1 0# of ww2_a49t { __DEFAULT -> (2) case ys_ap9 of { [] -> case Foo.f1 @ a_s4a0 of { GHC.Types.I# v1_B2 -> GHC.Prim.+# ww2_a49t v1_B2 }; : a1_aK8 as_aK9 -> case GHC.List.$wlenAcc @ a_s4a0 (GHC.List.reverse1 @ a_s4a0 as_aK9 (GHC.Types.[] @ a_s4a0)) 0# of ww1_X49V { __DEFAULT -> GHC.Prim.+# ww2_a49t ww1_X49V } } } } }}} The case expression (1) is the `seq` on ys. The case marked (2) is the case analysis in the argument of the second `reverse`. But that first `seq` is redundant! We could equally well say {{{ Foo.$wf = \ (@ a_s4a0) (w_s4a1 :: [a_s4a0]) -> case GHC.List.$wlenAcc @ a_s4a0 w_s4a1 0# of ww2_a49t { __DEFAULT -> (2) case GHC.List.reverse1 @ a_s4a0 w_s4a1 (GHC.Types.[] @ a_s4a0) of { [] -> case Foo.f1 @ a_s4a0 of { GHC.Types.I# v1_B2 -> GHC.Prim.+# ww2_a49t v1_B2 }; : a1_aK8 as_aK9 -> case GHC.List.$wlenAcc @ a_s4a0 (GHC.List.reverse1 @ a_s4a0 as_aK9 (GHC.Types.[] @ a_s4a0)) 0# of ww1_X49V { __DEFAULT -> GHC.Prim.+# ww2_a49t ww1_X49V } } } } }}} That's better because we generate code for only two evals rather than three. The general pattern is {{{ case of b { DEFAULT -> } ==> let b = in }}} where the case binder `b` is used strictly in ``. In this case it's safe to switch to a `let` (marked as strict) which can now be inlined or floated in a way that `case` expressions cannot. We already do this transformation, here in `Simplify.rebuildCase`: {{{ rebuildCase env scrut case_bndr alts@[(_, bndrs, rhs)] cont ... | all_dead_bndrs , if isUnliftedType (idType case_bndr) then exprOkForSpeculation scrut else exprIsHNF scrut || scrut_is_demanded_var scrut = ...turn case into let... }}} The key bit (for this situation) is `scrut_is_demanded_var`. '''But it only fires if `` is a variable'''. I see no reason for this restriction. I think it's sound regardless. Yes, if we decide to inline the binding `b = ` we might change which exception appears; but that is within the semantics of exceptions; and it's still true if `` is a variable. So I think we can safely replace `scrut_is_demand_var` with just `case_bndr_is_demanded`, independent of what `scrut` looks like. I dug back into ghc history to see how the current code came about, bu it had a long evolution and I didn't find any reason for sticking to a variable here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 09:16:03 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 09:16:03 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.44d6ecb95dc85d4593e6bf85516b583a@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141 -------------------------------------+------------------------------------- Comment (by simonpj): Good grief. More revelations/insight concerning `closeOverKinds`. * The actual bug is fixed by the small patch in comment:13, concerning `candidateQTyVarsOfType` in `TcType`. Nothing to do with `TyCoRep`. * But this patch did not quite work for reasons that are lost in the mists of time. Later, Ricahrd produced Phab:D4769 (see comment:19). * But Pahb:D4769 was significantly more ambitious, which in turn led to the detective work on this ticket. Concering `closeOverKinds`, it added this in `TyCoRep`: {{{ Note [Closing over free variable kinds] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Note that it's necessary to close over kinds at the /end/ of collecting the variables. This is for two reasons: 1. Efficiency. If we have Proxy (a::k) -> Proxy (a::k) -> Proxy (a::k), then we don't want to have to traverse k more than once. 2. Correctness. Imagine we have forall k. b -> k, where b has kind k, for some k bound in an outer scope. If we look at b's kind inside the forall, we'll collect that k is free and then remove k from the set of free variables. This is plain wrong. We must instead compute that b is free and then conclude that b's kind is free. }}} * It seems that moving `closeOverKinds` from the ''occurrences'' of a type variable to ''after finding the free vars'' (i.e. Step 2) is responsible for the perf regressions reported in comment:121. But note that, contrary to my claim in comment:108, this change in `closeOverKinds` does not fix the original bug -- that was in `TcType`! My new insight is this: '''Step 2 is absolutely unnecessary'''. Consider the two points in the Note above. 1. Efficiency: we now have an accumulator, so the seond time we encounter 'a', we'll ignore it, certainly not looking at its kind. 2. Correctness: we have an "in-scope set" (I think we should call it it a "bound-var set"), specifying variables that are bound by a forall in the type we are traversing; we simply ignore these variables, certainly not looking at their kind. So consider `forall k. b -> k`, where `b :: k->Type` is free; but of course, it's a different `k`! When looking at `b -> k` we'll have `k` in the bound-var set. So we'll ignore the `k`. But suppose this is our first encounter with `b`; we want the free vars of its kind. '''But we want to behave as if we took the free vars of its kind at the end; that is, with no bound vars in scope'''. So it's easy. Our current code is this {{{ ty_co_vars_of_type (TyVarTy v) is acc | v `elemVarSet` is = acc | v `elemVarSet` acc = acc | otherwise = ty_co_vars_of_type (tyVarKind v) is (extendVarSet acc v) }}} All we need do is to take the free vars of `tyVarKind v` ''with an empty bound-var set'', thus: {{{ ty_co_vars_of_type (TyVarTy v) is acc | v `elemVarSet` is = acc | v `elemVarSet` acc = acc | otherwise = ty_co_vars_of_type (tyVarKind v) emptyVarSet (extendVarSet acc v) ^^^^^^^^^^^ }}} This change is subtle, but it's both more efficient and less code than my suggestion in comment:122. The same change should be made in the `FV` version lower down in `TyCoRep`. Would you like to try that. '''Richard: do you agree?''' -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 09:37:00 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 09:37:00 -0000 Subject: [GHC] #13064: Incorrect redudant imports warning In-Reply-To: <045.fe3c1c6b618d0b4877de88fc27add363@haskell.org> References: <045.fe3c1c6b618d0b4877de88fc27add363@haskell.org> Message-ID: <060.a50b9dc9163786728bdc1a0ad49c664b@haskell.org> #13064: Incorrect redudant imports warning -------------------------------------+------------------------------------- Reporter: phadej | Owner: (none) Type: bug | Status: new Priority: low | Milestone: 8.8.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #15393 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): I don't think this patch should be merged if there is any risk of destabilising the branch. This has already happened once this release cycle with the `MonadFail` desugaring patch being merged very late in the day. If this causes any additional warnings then proactive package maintainers are going to have to cut a third new release of their package. The release is over a month overdue and still have a number of high priority bugs to fix #15544 and #15541 in particular. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 09:43:21 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 09:43:21 -0000 Subject: [GHC] #13064: Incorrect redudant imports warning In-Reply-To: <045.fe3c1c6b618d0b4877de88fc27add363@haskell.org> References: <045.fe3c1c6b618d0b4877de88fc27add363@haskell.org> Message-ID: <060.6ef31fdde5126fefb370ad0c47300c37@haskell.org> #13064: Incorrect redudant imports warning -------------------------------------+------------------------------------- Reporter: phadej | Owner: (none) Type: bug | Status: new Priority: low | Milestone: 8.8.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #15393 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): To be clear, I'm proposing that this fix be introduced in 8.8 and shouldn't be merged into 8.6. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 10:08:07 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 10:08:07 -0000 Subject: [GHC] #13064: Incorrect redudant imports warning In-Reply-To: <045.fe3c1c6b618d0b4877de88fc27add363@haskell.org> References: <045.fe3c1c6b618d0b4877de88fc27add363@haskell.org> Message-ID: <060.647a81142a78a53dd39332018b324739@haskell.org> #13064: Incorrect redudant imports warning -------------------------------------+------------------------------------- Reporter: phadej | Owner: (none) Type: bug | Status: new Priority: low | Milestone: 8.8.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #15393 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Indeed: there is no suggestion of putting this in 8.6! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 10:21:16 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 10:21:16 -0000 Subject: [GHC] #15629: "No skolem info" panic (GHC 8.6 only) In-Reply-To: <050.dd398323ba018b74f7bb68214187ebb6@haskell.org> References: <050.dd398323ba018b74f7bb68214187ebb6@haskell.org> Message-ID: <065.be65521e232d7d5c2a6955d772e2ce84@haskell.org> #15629: "No skolem info" panic (GHC 8.6 only) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.6.1-beta1 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): For what it's worth, here is a slightly more minimal version of the original program: {{{#!hs {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} module Bug (f) where import Data.Kind import Data.Proxy data TyFun :: Type -> Type -> Type type a ~> b = TyFun a b -> Type infixr 0 ~> type family F x :: Type -> Type data F1Sym :: forall x a. x ~> F x a data F2Sym :: forall x a. F x a ~> x data Comp :: forall b c a. (b ~> c) -> (a ~> b) -> (a ~> c) sg :: forall a b c (f :: b ~> c) (g :: a ~> b) (x :: a). Proxy f -> Proxy g -> Proxy (Comp f g) sg _ _ = Proxy f :: forall (x :: Type). Proxy x -> () f _ = () where g :: forall ab. Proxy ((Comp (F1Sym :: x ~> F x z) F2Sym) :: F x ab ~> F x ab) g = sg Proxy Proxy }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 12:07:17 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 12:07:17 -0000 Subject: [GHC] #15632: Undependable Dependencies Message-ID: <043.01997ce1746c591111a0a2273155036b@haskell.org> #15632: Undependable Dependencies -------------------------------------+------------------------------------- Reporter: AntC | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Keywords: | Operating System: Unknown/Multiple FunctionalDependencies, | OverlappingInstances | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: 10675 Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Consider {{{#!hs {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, GADTs, FlexibleInstances, FlexibleContexts, UndecidableInstances #-} data Hither = Hither deriving (Eq, Show, Read) -- just three data Thither = Thither deriving (Eq, Show, Read) -- distinct data Yon = Yon deriving (Eq, Show, Read) -- types class Whither a b | a -> b where whither :: a -> b -> b -- instance Whither Int Hither where -- rejected: FunDep conflict -- whither _ y = y -- with Thither instance, so instance {-# OVERLAPPING #-} (b ~ Hither) => Whither Int b where whither _ y = y instance {-# OVERLAPS #-} Whither a Thither where whither _ y = y instance {-# OVERLAPPABLE #-} (b ~ Yon) => Whither a b where whither _ y = y f :: Whither Int b => Int -> b -> b f = whither g :: Whither Bool b => Bool -> b -> b g = whither }}} Should those three instances be accepted together? In particular, the published work on FDs (including the FDs through CHRs paper) says the `Thither` instance should behave as if: {{{#!hs instance (beta ~ Thither) => Whither a beta where ... }}} (in which `beta` is a unification variable and the `~` constraint is type improvement under the FD.) But now the instance head is the same as the `Yon` instance, modulo alpha renaming; with the constraints being contrary. That's demonstrated by the inferred/improved type for `g`: {{{#!hs *Whither> :t g ===> g :: Bool -> Thither -> Thither -- and yet *Whither> g True Yon ===> Yon }}} What do I expect here? * At least the `Thither` and `Yon` instances to be rejected as inconsistent under the FunDep. * (The `Hither` instance is also inconsistent, going by the strict interpretation in published work. But GHC's rule here is bogus, as documented in Trac #10675.) Exploiting Overlapping instances is essential to making this go wrong. The published work shies away from considering `FunDeps + Overlap`; and yet specifying the semantics as if the instances used bare unification variables is almost inevitably going give overlaps -- especially if there are multiple FDs. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 12:30:17 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 12:30:17 -0000 Subject: [GHC] #15359: Quantified constraints do not work with equality constraints In-Reply-To: <047.6c20373526398fd5725ca3ce9d7c3b21@haskell.org> References: <047.6c20373526398fd5725ca3ce9d7c3b21@haskell.org> Message-ID: <062.8809a3bae47e07e3c6c1e546279332a5@haskell.org> #15359: Quantified constraints do not work with equality constraints -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I am repenting of my earlier claim that we should not allow `(~)` in the head of quantified constraints. Why * You can the same effect via a superclass {{{ class (a ~ b) => Equal a b f1 :: (forall a. blah => a ~ b) => stuff f2 :: (forall a. blah => Equal a b) => stuff }}} If `f1` is illegal, then `f2` should be too. * It does seem odd to treat `Coercible` one way and `(~)` another * The rejection of `(~)` is, I think, pretty much accidental. The message comes from `checkValidInstHead`, in this equation {{{ -- For the most part we don't allow instances for Coercible; -- but we DO want to allow them in quantified constraints: -- f :: (forall a b. Coercible a b => Coercible (m a) (m b)) => ...m... | clas_nm == coercibleTyConName , not quantified_constraint = failWithTc rejected_class_msg -- Handwritten instances of other nonminal-equality classes -- is forbidden, except in the defining module to allow -- instance a ~~ b => a ~ b -- which occurs in Data.Type.Equality | clas_nm `elem` [ heqTyConName, eqTyConName] = failWithTc rejected_class_msg }}} I'm not sure that I thought very deeply about `Coercible` vs `(~)` here. * It keeps coming up: #15625 and #15593 However it's not just a question of lifting the restriction. As things stand, dictionary functions (from instance decls, or in quantified constraints) are always boxed, lifted things. But if we have {{{ f :: (forall a. t1 ~ t2) => blah }}} the way superclasses work for quantifed constraints, we'll behave as if we also had `(forall a. t1 ~# t2)` and that is unboxed. Coercions, of type `(t1 ~# t2)` and `(t1 ~R# t2)` are handled rather separately by the constraint solver, not least because they can occur in types. Still, I think it's not as hard as I thought. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 12:52:28 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 12:52:28 -0000 Subject: [GHC] #15632: Undependable Dependencies In-Reply-To: <043.01997ce1746c591111a0a2273155036b@haskell.org> References: <043.01997ce1746c591111a0a2273155036b@haskell.org> Message-ID: <058.0db55bb4a898d1ab9c9a8cc0755b093c@haskell.org> #15632: Undependable Dependencies -------------------------------------+------------------------------------- Reporter: AntC | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: | FunctionalDependencies, | OverlappingInstances Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: 10675 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Interesting. I have no idea what to do about (overlap + FDs). I would really welcome someone paying careful attention to FDs in GHC, reviewing tickets (including this one) and proposing what changes to make. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 14:08:37 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 14:08:37 -0000 Subject: [GHC] #15631: Lost opportunity to eliminate seq In-Reply-To: <046.d8c88fcbd3653a11d724ae33c4e5382e@haskell.org> References: <046.d8c88fcbd3653a11d724ae33c4e5382e@haskell.org> Message-ID: <061.ddf7acf18a555a7b6694bfb65eeecab3@haskell.org> #15631: Lost opportunity to eliminate seq -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"0e6d42fe76958648243f99c49e648769c1ea658c/ghc" 0e6d42fe/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="0e6d42fe76958648243f99c49e648769c1ea658c" Be a bit more aggressive about let-to-case This patch takes up the missed opportunity described in Trac #15631, by convering a case into a let slightly more agressively. See Simplify.hs Note [Case-to-let for strictly-used binders] There is no measurable perf impact for good or ill. But the code is simpler and easier to explain. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 14:23:42 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 14:23:42 -0000 Subject: [GHC] #15633: Type-checker plugins aren't loaded in 8.6.1 Message-ID: <045.8bcaa0505fc8b553b9837a1fc9146bf4@haskell.org> #15633: Type-checker plugins aren't loaded in 8.6.1 -------------------------------------+------------------------------------- Reporter: phadej | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 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: -------------------------------------+------------------------------------- Type-Checker plugins seem to work in GHCi-8.4.3 https://gist.github.com/phadej/f2040eba327a88d3652cda021403f97f However with GHC-8.6.1 The Glorious Glasgow Haskell Compilation System, version 8.6.0.20180907 76a233143f1ec940f342ce3ce3afaf306923b392 (which seems to be the last commit in 8.6 branch atm) the plugins aren't loaded. {{{ % ghci-8.6.1 -fplugin=ThereIsNoPlugin GHCi, version 8.6.0.20180907: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/ogre/.ghci λ> }}} starts a session without a warning. 8.4.3 however fails: {{{ % ghci-8.4.3 -fplugin=ThereIsNoPlugin GHCi, version 8.4.3: http://www.haskell.org/ghc/ :? for help : Could not find module ‘ThereIsNoPlugin’ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 14:25:02 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 14:25:02 -0000 Subject: [GHC] #15633: Type-checker plugins aren't loaded in GHCi 8.6.1 (was: Type-checker plugins aren't loaded in 8.6.1) In-Reply-To: <045.8bcaa0505fc8b553b9837a1fc9146bf4@haskell.org> References: <045.8bcaa0505fc8b553b9837a1fc9146bf4@haskell.org> Message-ID: <060.e43fe282d1ef38b76db826955e0c1174@haskell.org> #15633: Type-checker plugins aren't loaded in GHCi 8.6.1 -------------------------------------+------------------------------------- Reporter: phadej | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 14:27:29 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 14:27:29 -0000 Subject: [GHC] #15627: Absent unlifted bindings In-Reply-To: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> References: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> Message-ID: <059.ae1295b5f1f416266a9e8f4bb2a2a6af@haskell.org> #15627: Absent unlifted bindings -------------------------------------+------------------------------------- Reporter: sgraf | Owner: (none) Type: task | Status: new Priority: normal | Milestone: ⊥ Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9279 #4328 | Differential Rev(s): #11126 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): We need the `Eq` instance of `Literal` when deriving `Eq AltCon`. That's OK, we have `eqType` for that. However, there's also an instance `Ord AltCon` that is a little shady (sic): {{{ -- This instance is a bit shady. It can only be used to compare AltCons for -- a single type constructor. Fortunately, it seems quite unlikely that we'll -- ever need to compare AltCons for different type constructors. -- The instance adheres to the order described in [CoreSyn case invariants] instance Ord AltCon where compare (DataAlt con1) (DataAlt con2) = ASSERT( dataConTyCon con1 == dataConTyCon con2 ) compare (dataConTag con1) (dataConTag con2) compare (DataAlt _) _ = GT compare _ (DataAlt _) = LT compare (LitAlt l1) (LitAlt l2) = compare l1 l2 compare (LitAlt _) DEFAULT = GT compare DEFAULT DEFAULT = EQ compare DEFAULT _ = LT }}} I will not try and remove that instance, I think it's probably needed somewhere. Questions: 1. How would I implement `cmpType`, which I'd need for a faithful `cmpLit` function? 2. In the likely case the answer to 1) is "don't", then does sound ignoring the `MachNull` type in comparisons OK? E.g. `cmpType (MachNull _) (MachNull_) = EQ`. Makes `Ord AltCon` a little more shady than it already is, but still seems in line with the invariant "only use on AltCons of same type constructor". Also, `cmpType` and `eqType` might then disagree. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 14:36:13 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 14:36:13 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.85e695a5adc8de735e5a7888d8b29fd2@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141 -------------------------------------+------------------------------------- Comment (by goldfire): * First off, no mists of time here: the more ambitious patch was because comment:13 fixed the problem in TcType -- which caused the original bug -- but that same problem existed in TyCoRep. We just didn't have (and still don't, to my knowledge) a concrete program that exhibits misbehavior. I don't remember the exact cause of the bug I mentioned in comment:13, but I don't think that's about the changes in TyCoRep. * Your new approach relies on this invariant: If a variable in a tyvar kind is in the bound-var set, then the variable is in the bound-var set, too. Perhaps easier is to think about the contrapositive: If a variable is not in the bound-var set (in other words, if we look at it at all), then no variable in its kind is in the bound-var set (so we can zap the bound- var set). This invariant is certainly true of well-typed programs. (It's just barely conceivable that it might not be true in the case of a mis- ordered telescope, but let's not worry about that now.) So: yes, I think that works nicely. Nice idea. It's very much worth a Note. @tdammers: Do you think you can push this new idea through? I can write the Note if need be. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 14:38:15 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 14:38:15 -0000 Subject: [GHC] #15627: Absent unlifted bindings In-Reply-To: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> References: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> Message-ID: <059.3a8510b54dd0a8b152531b2c1fdbd289@haskell.org> #15627: Absent unlifted bindings -------------------------------------+------------------------------------- Reporter: sgraf | Owner: (none) Type: task | Status: new Priority: normal | Milestone: ⊥ Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9279 #4328 | Differential Rev(s): #11126 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): Going with 2., we again get stuck in `CoreMap`, which requires an `Ord Literal` instance and seems exactly like the reason that we have it in the first place. Question is: Would `CoreMap` still be OK with 2.)? E.g., can we guarantee that we never put things of different types in the same `CoreMap`? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 14:42:09 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 14:42:09 -0000 Subject: [GHC] #15594: --abi-hash with Backpack incorrectly loads modules from dependent packages In-Reply-To: <045.e21f2218ffe754afd2fc42b07fceb19f@haskell.org> References: <045.e21f2218ffe754afd2fc42b07fceb19f@haskell.org> Message-ID: <060.43c37bd7c0fb50510abca5b9c69cd21e@haskell.org> #15594: --abi-hash with Backpack incorrectly loads modules from dependent packages -------------------------------------+------------------------------------- Reporter: ezyang | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: backpack Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5123 Wiki Page: | -------------------------------------+------------------------------------- Description changed by ezyang: Old description: > Repro at: https://github.com/alexbiehl/cabal-backpack-register- > repro/blob/master/src/Lib.hs New description: Repro at: https://github.com/alexbiehl/cabal-backpack-register-repro -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 14:45:12 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 14:45:12 -0000 Subject: [GHC] #15630: panic! Simplifier ticks exhausted In-Reply-To: <049.c44dcaac100e8732d769d68c9db99cf2@haskell.org> References: <049.c44dcaac100e8732d769d68c9db99cf2@haskell.org> Message-ID: <064.8b56fc2783834654e59b2d1c46b0ae31@haskell.org> #15630: panic! Simplifier ticks exhausted ---------------------------------+-------------------------------------- Reporter: micahshahn | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+-------------------------------------- Comment (by micahshahn): It's not mission critical for me at all - I have a lot of these kind of DAL structures to write so I think I'll end up writing a custom generic typeclass derivation for them with a more straightforward implementation. I figured it was worth a write up in case we weren't aware of this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 14:45:42 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 14:45:42 -0000 Subject: [GHC] #15594: --abi-hash with Backpack incorrectly loads modules from dependent packages In-Reply-To: <045.e21f2218ffe754afd2fc42b07fceb19f@haskell.org> References: <045.e21f2218ffe754afd2fc42b07fceb19f@haskell.org> Message-ID: <060.f031c3907d84a7dbedab4efa2a3e1cdb@haskell.org> #15594: --abi-hash with Backpack incorrectly loads modules from dependent packages -------------------------------------+------------------------------------- Reporter: ezyang | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: backpack Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5123 Wiki Page: | -------------------------------------+------------------------------------- Description changed by ezyang: Old description: > Repro at: https://github.com/alexbiehl/cabal-backpack-register-repro New description: Repro at: https://github.com/alexbiehl/cabal-backpack-register-repro If you use Backpack with data families, you might fail during `--abi-hash` with: {{{ cabal: '/nix/store/m338klajhqlw7v4jd61fiqd82wx305fj-ghc-8.4.3-with- packages/bin/ghc' exited with an error: Failed to load interface for ‘Stuff’ no unit id matching ‘backpack-trans-0.1.0.0-L6CFTQZAAWWFpCQD2NXR4W-indef’ was found }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 15:22:40 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 15:22:40 -0000 Subject: [GHC] #15470: Record projections with ambiguous types In-Reply-To: <047.3cdd34484629508fb5a4f38ac9554616@haskell.org> References: <047.3cdd34484629508fb5a4f38ac9554616@haskell.org> Message-ID: <062.11297b52566db4679aa1a07cdcbd90b0@haskell.org> #15470: Record projections with ambiguous types -------------------------------------+------------------------------------- Reporter: sweirich | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I forgot to put in the diff {{{ modified compiler/typecheck/TcTyDecls.hs @@ -893,7 +893,7 @@ mkOneRecordSelector all_cons idDetails fl | otherwise = map mk_match cons_w_field ++ deflt mk_match con = mkSimpleMatch (mkPrefixFunRhs sel_lname) [L loc (mk_sel_pat con)] - (L loc (HsVar noExt (L loc field_var))) + match_body mk_sel_pat con = ConPatIn (L loc (getName con)) (RecCon rec_fields) rec_fields = HsRecFields { rec_flds = [rec_field], rec_dotdot = Nothing } rec_field = noLoc (HsRecField @@ -905,6 +905,19 @@ mkOneRecordSelector all_cons idDetails fl sel_lname = L loc sel_name field_var = mkInternalName (mkBuiltinUnique 1) (getOccName sel_name) loc + match_body = L loc (HsVar noExt (L loc field_var)) +{- + match_body = foldl app_tv (L loc (HsVar noExt (L loc field_var))) field_tvs + + app_tv :: LHsExpr GhcRn -> TyVar -> LHsExpr GhcRn + app_tv hs_fun tv = L loc (HsAppType (mk_tv_ty tv) hs_fun) + + mk_tv_ty :: TyVar -> LHsWcType GhcRn + mk_tv_ty tv = mkEmptyWildCardBndrs $ L loc $ + HsTyVar noExt NotPromoted $ + L loc (getName tv) +-} }}} If you try commenting out the definition of `match_body` and replacing it with the one that is commented out in this diff, you get my attempt. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 15:24:15 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 15:24:15 -0000 Subject: [GHC] #15631: Lost opportunity to eliminate seq In-Reply-To: <046.d8c88fcbd3653a11d724ae33c4e5382e@haskell.org> References: <046.d8c88fcbd3653a11d724ae33c4e5382e@haskell.org> Message-ID: <061.9d4970d3a1451642518ef62f4fbadeb5@haskell.org> #15631: Lost opportunity to eliminate seq -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 15:24:51 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 15:24:51 -0000 Subject: [GHC] #15631: Lost opportunity to eliminate seq In-Reply-To: <046.d8c88fcbd3653a11d724ae33c4e5382e@haskell.org> References: <046.d8c88fcbd3653a11d724ae33c4e5382e@haskell.org> Message-ID: <061.ceaa0cd9f9a5c488054dee85277173d3@haskell.org> #15631: Lost opportunity to eliminate seq -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | simplCore/should_compile/T15631 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * testcase: => simplCore/should_compile/T15631 Comment: `simplCore/should_compile/T15631` does directly show the improvement. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 15:34:47 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 15:34:47 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.49ca41c39621337d3ceef3f1e21ee1c8@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141 -------------------------------------+------------------------------------- Comment (by simonpj): > If a variable is not in the bound-var set (in other words, if we look at it at all), then no variable in its kind is in the bound-var set (so we can zap the bound-var set). No, not at all! Suppose (b::k) is free in some type `(forall k. b -> T k)`. Then, when we encounter `b` * `b` is not in the bound-var set * But `k` certainly is, and should be * But it's a ''different k'', despite having the same name So it's not just that we ''can'' zap the bound-var set; we ''must'' zap it!! Consider: if we instead waited until the end we'd have `b::k` in our free var set. Then we call `closeOverKinds` (that was our plan, before comment:123). Well, at that point the bound-var set is certainly empty (we are at the top), and we find the free vars of `k` (namely `k` itself) using that empty bound-var set. Regardless, this still looks solid to me, if Tobias can just test it. (It could conceivably be worth doing `TcType.candidateQTyVarsOfType` the same way, for consistency; but that is an un-forced change.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 15:35:44 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 15:35:44 -0000 Subject: [GHC] #15630: panic! Simplifier ticks exhausted In-Reply-To: <049.c44dcaac100e8732d769d68c9db99cf2@haskell.org> References: <049.c44dcaac100e8732d769d68c9db99cf2@haskell.org> Message-ID: <064.71f2d719924ce366fc8b71f53c433070@haskell.org> #15630: panic! Simplifier ticks exhausted ---------------------------------+-------------------------------------- Reporter: micahshahn | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+-------------------------------------- Comment (by simonpj): Indeed v helpful to have a concrete, small, example. Thanks -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 15:58:11 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 15:58:11 -0000 Subject: [GHC] #15621: Error message involving type families points to wrong location In-Reply-To: <050.f6fd8f38eae3af90b1d1147a0e35ac2c@haskell.org> References: <050.f6fd8f38eae3af90b1d1147a0e35ac2c@haskell.org> Message-ID: <065.3e5fc580d760cf60b6ffd9fae8853e5e@haskell.org> #15621: Error message involving type families points to wrong location -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.4.3 checker) | Resolution: | Keywords: TypeFamilies Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): We have `Refl :: forall a. Refl a a` So from the defn of `a` we instantiate `Refl` with `a := alpha`, and get {{{ [W] c1 :: alpha ~ F Int -- Line 12 [W] c2 :: alpha ~ F Int -- Line 12 }}} Each constraint carries its birth location, which I show here. Same for `b`, instantiating `Refl` with `a := beta`: {{{ [W] c3 :: beta ~ F Int -- Line 15 [W] c4 :: beta ~ F Bool -- Line 15 }}} Then depending on the order in which we try to solve, we might do {{{ alpha := beta beta := F Bool -- solves c4 }}} Now, substituting for these unified varaiables, we get {{{ [W] c1 :: F Bool ~ F Int -- Line 12 [W] c2 :: F Bool ~ F Int -- Line 12 [W] C3 :: F Bool ~ F Int -- Line 15 }}} Since these are identical, we pick one; and alas, it is `c1`. So that's why we get a bogus message. Richard, I'd be interested in your views. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 16:14:03 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 16:14:03 -0000 Subject: [GHC] #9173: Better type error messages In-Reply-To: <046.f8f24aa2ddaa3d579bc40f0b6f04f6b7@haskell.org> References: <046.f8f24aa2ddaa3d579bc40f0b6f04f6b7@haskell.org> Message-ID: <061.0decaaaa0c9dfacbf62f315a5e1f74cd@haskell.org> #9173: Better type error messages -------------------------------------+------------------------------------- Reporter: simonpj | Owner: goldfire Type: bug | Status: new Priority: high | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: | TypeErrorMessages Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nineonine): I was able to make some progress on this ticket (screenshot with new error messages: [https://prnt.sc/ktm8u2]). I will keep working on 3-5. Shouldn't take long to finish this part! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 17:52:01 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 17:52:01 -0000 Subject: [GHC] #15621: Error message involving type families points to wrong location In-Reply-To: <050.f6fd8f38eae3af90b1d1147a0e35ac2c@haskell.org> References: <050.f6fd8f38eae3af90b1d1147a0e35ac2c@haskell.org> Message-ID: <065.4eb6877e2297771dc2f2c821d2e15671@haskell.org> #15621: Error message involving type families points to wrong location -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.4.3 checker) | Resolution: | Keywords: TypeFamilies Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): This sniffs awfully like wanteds rewriting wanteds. I don't agree with the details in comment:3. You have constraints like `alpha ~ F Int`. But `CTyEqCan` documents "rhs ... has no top-level function". So these constraints look malformed. I would expect an intervening flatten metavar, which may change what's going on here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 17:57:49 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 17:57:49 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.5be6ab29ca212ba7dc5786591a05fa26@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141 -------------------------------------+------------------------------------- Comment (by goldfire): We're in complete agreement. I was phrasing things strangely, in that I was considering variables to have proper identities, not just uniques. That is, the variables in the kind of a free var might, incidentally, have a doppelganger in the bound-var set, but that's just a doppelgangers, not an appearance of the variable we're processing. In any case, I agree with comment:125. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 18:32:02 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 18:32:02 -0000 Subject: [GHC] #15634: GHCi: Segmentation fault Data.List.sum large number Message-ID: <048.5052d331a4fc48d28dc3b9b9d3968d7b@haskell.org> #15634: GHCi: Segmentation fault Data.List.sum large number -------------------------------------+------------------------------------- Reporter: ksallberg | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Research needed Component: GHCi | Version: 8.0.1 Keywords: segfault | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Hello, first bug report here, so please let me know what I should provide. I tried to search for this but didn't find it. {{{ kristian at snabbadatorn:~$ ghci GHCi, version 8.0.1: http://www.haskell.org/ghc/ :? for help Prelude> [1..100] [1,2,3,4,5,6,7,8,9,10,11,12... and so on Prelude> sum [1..10000000] 50000005000000 Prelude> sum [1..100000000] Segmentation fault }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 18:34:07 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 18:34:07 -0000 Subject: [GHC] #15634: GHCi: Segmentation fault Data.List.sum large number In-Reply-To: <048.5052d331a4fc48d28dc3b9b9d3968d7b@haskell.org> References: <048.5052d331a4fc48d28dc3b9b9d3968d7b@haskell.org> Message-ID: <063.600a9b94b2cf9ae92f7289fbfa09e54b@haskell.org> #15634: GHCi: Segmentation fault Data.List.sum large number -------------------------------------+------------------------------------- Reporter: ksallberg | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Research | needed Component: GHCi | Version: 8.0.1 Resolution: | Keywords: segfault Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by ksallberg: Old description: > Hello, first bug report here, so please let me know what I should > provide. I tried to search for this but didn't find it. > > {{{ > kristian at snabbadatorn:~$ ghci > GHCi, version 8.0.1: http://www.haskell.org/ghc/ :? for help > Prelude> [1..100] > [1,2,3,4,5,6,7,8,9,10,11,12... and so on > Prelude> sum [1..10000000] > 50000005000000 > Prelude> sum [1..100000000] > Segmentation fault > }}} New description: Hello, first bug report here, so please let me know what I should provide. I tried to search for this but didn't find it. {{{ kristian at snabbadatorn:~$ ghci GHCi, version 8.0.1: http://www.haskell.org/ghc/ :? for help Prelude> [1..100] [1,2,3,4,5,6,7,8,9,10,11,12... and so on Prelude> sum [1..10000000] 50000005000000 Prelude> sum [1..100000000] Segmentation fault }}} Machine: Google compute engine, n1-highcpu-8 (8 vCPUs, 7.2 GB memory), uname -r: 4.9.0-8-amd64 {{{ kristian at snabbadatorn:~$ lsb_release -a No LSB modules are available. Distributor ID: Debian Description: Debian GNU/Linux 9.5 (stretch) Release: 9.5 Codename: stretch }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 18:35:25 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 18:35:25 -0000 Subject: [GHC] #15634: GHCi: Segmentation fault Data.List.sum large number In-Reply-To: <048.5052d331a4fc48d28dc3b9b9d3968d7b@haskell.org> References: <048.5052d331a4fc48d28dc3b9b9d3968d7b@haskell.org> Message-ID: <063.cff8953a0c580615e9b3c488856b7e45@haskell.org> #15634: GHCi: Segmentation fault Data.List.sum large number -------------------------------------+------------------------------------- Reporter: ksallberg | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Research | needed Component: GHCi | Version: 8.0.1 Resolution: | Keywords: segfault Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by ksallberg: Old description: > Hello, first bug report here, so please let me know what I should > provide. I tried to search for this but didn't find it. > > {{{ > kristian at snabbadatorn:~$ ghci > GHCi, version 8.0.1: http://www.haskell.org/ghc/ :? for help > Prelude> [1..100] > [1,2,3,4,5,6,7,8,9,10,11,12... and so on > Prelude> sum [1..10000000] > 50000005000000 > Prelude> sum [1..100000000] > Segmentation fault > }}} > > Machine: Google compute engine, n1-highcpu-8 (8 vCPUs, 7.2 GB memory), > > uname -r: 4.9.0-8-amd64 > > {{{ > kristian at snabbadatorn:~$ lsb_release -a > No LSB modules are available. > Distributor ID: Debian > Description: Debian GNU/Linux 9.5 (stretch) > Release: 9.5 > Codename: stretch > }}} New description: Hello, first bug report here, so please let me know what I should provide. I tried to search for this but didn't find it. {{{ kristian at snabbadatorn:~$ ghci GHCi, version 8.0.1: http://www.haskell.org/ghc/ :? for help Prelude> [1..100] [1,2,3,4,5,6,7,8,9,10,11,12... and so on Prelude> sum [1..10000000] 50000005000000 Prelude> sum [1..100000000] Segmentation fault }}} Machine: Google compute engine, n1-highcpu-8 (8 vCPUs, 7.2 GB memory), uname -r: 4.9.0-8-amd64 {{{ kristian at snabbadatorn:~$ lsb_release -a No LSB modules are available. Distributor ID: Debian Description: Debian GNU/Linux 9.5 (stretch) Release: 9.5 Codename: stretch }}} {{{ kristian at snabbadatorn:~$ ghci --version The Glorious Glasgow Haskell Compilation System, version 8.0.1 }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 20:46:05 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 20:46:05 -0000 Subject: [GHC] #15621: Error message involving type families points to wrong location In-Reply-To: <050.f6fd8f38eae3af90b1d1147a0e35ac2c@haskell.org> References: <050.f6fd8f38eae3af90b1d1147a0e35ac2c@haskell.org> Message-ID: <065.35374677086c965c30ee7e2261582d34@haskell.org> #15621: Error message involving type families points to wrong location -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.4.3 checker) | Resolution: | Keywords: TypeFamilies Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > I don't agree with the details in comment:3. Yes, I was abbreviating! What we get is {{{ -- From 'a' [W] fsk1 ~ alpha (CTyEqCan) [W] F Int ~ fsk1 (CFunEqCan) [W] fsk1 ~ alpha (CTyEqCan) -- From 'b' [W] fsk1 ~ beta (CTyEqCan) [W] fsk2 ~ beta (CTyEqCan) [W] F Bool ~ fsk2 (CFunEqCan) }}} Then from `[W] fsk1 ~ alpha` and `[W] fsk1 ~ beta` we get `[D] alpha ~ beta`. And that leads to `alpha := beta`. The `beta := F Bool` comes during unflattening. The purpose of the Derived constraints is precisely to lead to unifications, exactly as we do here. So we probalbly don't want to stop that happening. Why do we get `fsk1 ~ alpha` rather than `alpha ~ fsk1` followed by unification? See `Note [Canonical orientation for tyvar/tyvar equality constraints]` in `TcCanonical`, and `Note [Eliminate flat-skols]` in `TcType`. I think this ticket is closely related to Trac #14185. If we put the constraints from the two definitions into separate implication constraints (with no skolems and no givens), I think the Right Thing would happen. You'll see some half written code, commented out, around `alwaysBuildImplication` in `TcUnify`. I think that'd fix this. But I didn't have time to review all the error message wibbles -- probably many are improvements. Does anyone else want to have a go? The code is there! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 20:54:08 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 20:54:08 -0000 Subject: [GHC] #15627: Absent unlifted bindings In-Reply-To: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> References: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> Message-ID: <059.6e1398ce1fe5932185cbe7073af52102@haskell.org> #15627: Absent unlifted bindings -------------------------------------+------------------------------------- Reporter: sgraf | Owner: (none) Type: task | Status: new Priority: normal | Milestone: ⊥ Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9279 #4328 | Differential Rev(s): #11126 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > I will not try and remove that instance, I think it's probably needed somewhere But I'd like to know where! I'd remove it and replace with calls to `cmpAltCon`. We can't begin to answer the question about whether an imprecise comparison is ok without knowing where it is used. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 21:02:18 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 21:02:18 -0000 Subject: [GHC] #15627: Absent unlifted bindings In-Reply-To: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> References: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> Message-ID: <059.af0c7157faaf052b187ea8a622430c69@haskell.org> #15627: Absent unlifted bindings -------------------------------------+------------------------------------- Reporter: sgraf | Owner: (none) Type: task | Status: new Priority: normal | Milestone: ⊥ Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9279 #4328 | Differential Rev(s): #11126 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > Going with 2., we again get stuck in CoreMap, which requires an Ord Literal instance Not at all! It just requires you to build a `LiteralMap` just like `CoreMap`, `CoercionMap`, etc in `CoreMap`. Using an `Ord` instance is very much a short-cut. But that's a pain -- more boilerplate. So that pushes me a bit more towards the polymorphic literal solution that you propose (retaining `MachNullAddr` as I suggested above. Would you like to try that? (Incidentally that will mean that you couldn't put a `RubbishLit` in a `LitCon` (because there is no facility for type application in a `LitCon`. But that's ok: we don't want to check for equality with rubbish values!) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 22:07:23 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 22:07:23 -0000 Subject: [GHC] #614: Rewrite the I/O library. In-Reply-To: <047.db5969ee97eb115b804d316bedd1e5a1@haskell.org> References: <047.db5969ee97eb115b804d316bedd1e5a1@haskell.org> Message-ID: <062.3be53f4f837aca173add6f203d47dd0e@haskell.org> #614: Rewrite the I/O library. ----------------------------------+-------------------- Reporter: simonmar | Owner: (none) Type: task | Status: closed Priority: normal | Milestone: Component: libraries/base | Version: None Resolution: None | Keywords: Type of failure: None/Unknown | ----------------------------------+-------------------- Changes (by Ben Gamari ): * failure: => None/Unknown Comment: In [changeset:"900c47f88784b91517c00be3e1087322e62f698e/ghc" 900c47f8/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="900c47f88784b91517c00be3e1087322e62f698e" rts/Printer.c: always define the findPtr symbol It was previously only defined (and therefore shipped) when DEBUG is defined. This patch defines it regardless of DEBUG. This will help fix hadrian on OS X [1]. [1]: https://github.com/snowleopard/hadrian/issues/614 Test Plan: The error from hadrian#614 is gone Reviewers: bgamari, erikd, simonmar Reviewed By: simonmar Subscribers: rwbarton, carter Differential Revision: https://phabricator.haskell.org/D5138 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 22:12:14 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 22:12:14 -0000 Subject: [GHC] #15635: Implication introduction for quantified constraints Message-ID: <045.9730a55ea2e47eeaadddd9e4a6dedf50@haskell.org> #15635: Implication introduction for quantified constraints -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Keywords: | Operating System: Unknown/Multiple QuantifiedConstraints | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Now that we have `QuantifiedConstraints`, it seems we need some implication introduction form. The `constraints` package has these types: {{{#!hs data Dict a where Dict :: a => Dict a newtype a :- b = Sub (a => Dict b) }}} `QuantifiedConstraints` suggests another version of `:-`: {{{#!hs newtype Imp a b = Imp { unImp :: forall r. ((a => b) => r) -> r} }}} We can write {{{#!hs fromImp :: Imp a b -> a :- b fromImp (Imp f) = Sub (f Dict) }}} But ... there's no way to go the other way! Let's try it: {{{#!hs toImp :: a :- Dict b -> a :- b toImp (Sub ab) = Imp $ \r -> _ }}} We get {{{ * Found hole: _ :: r * Relevant bindings include r :: (a => b) => r ab :: a => Dict b }}} There's no way to put these things together. But there's no terribly obvious reason they ''can't'' be combined. `a => b` is a function from an `a` dictionary to a `b` dictionary. `a => Dict b` is a function from an `a` dictionary to a value that ''contains'' a `b` dictionary. We just need some way to plumb these things together: some sort of implication introduction. The simplest thing might be a bit of magic: {{{#!hs implIntro :: ((a => b) => q) -> (forall r. (b => r) -> (a => r)) -> q }}} In Core (modulo type abstraction and application), we could simply write {{{#!hs implIntro f g = f (g id) }}} Unfortunately, I doubt that `implIntro` is really general enough to do everything people will want in this space. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 12 23:50:52 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 12 Sep 2018 23:50:52 -0000 Subject: [GHC] #15621: Error message involving type families points to wrong location In-Reply-To: <050.f6fd8f38eae3af90b1d1147a0e35ac2c@haskell.org> References: <050.f6fd8f38eae3af90b1d1147a0e35ac2c@haskell.org> Message-ID: <065.ba9a514ccf041dc1ac8f724e0d1e6185@haskell.org> #15621: Error message involving type families points to wrong location -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.4.3 checker) | Resolution: | Keywords: TypeFamilies Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I agree that the fix for #14185 will fix this precise example, but will it fix all such examples? What if there is a `Refl :: F Int :~: F Int` and a `Refl :: F Int :~: F Bool` in the same function? Then we'd be right back here. So I think #14185 is a bit of a red herring here. (I also think that fix might not fix all cases of #14185 itself.) With the way deriveds currently work, the "wanteds don't rewrite wanteds" story applies really only to skolems (which can't be "improved" through deriveds). Here, we want it also to apply to unification variables. Yet we also want to keep the work that deriveds do in other cases. I'm out of time now, but I don't think this will be so easy, somehow... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 07:03:47 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 07:03:47 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.fdb5dc0b1d5c74e5cdd0ee2180585ffc@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141 -------------------------------------+------------------------------------- Comment (by tdammers): So, let's see if I understand things correctly: - The original plan was to move the "closing over kinds" part out of `ty_co_vars_of_type`, and doing it in one go at the very end. - The new plan is to change `ty_co_vars_of_type` such that the "interesting" case (`TyVar` with a variable that hasn't been seen before) is handled in place, because the real problem is not about when we do the closing over kinds, but rather that we do not want to handle the same variable more than once. - Hence, we should not move the closing-over-kinds part at all, and instead just modify the `TyVar` branch of `ty_co_vars_of_type` so that it handles each variable it encounters exactly once (comment:123) I will certainly give that a try and see how that plays out in terms of performance. I had been implementing Simon's suggestion from comment:122, and at least while still using `mapUnionVarSet`, I'm still getting regressions on 4 tests, so the hypothesis in comment:123 seems plausible to me - after all, if we can handle this correctly while already traversing the code, that's going to be more efficient than first building up the whole varset and then traversing it again to remove the variables we don't want. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 07:18:20 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 07:18:20 -0000 Subject: [GHC] #15608: Segfault in retainer profiling In-Reply-To: <043.5de2d12576332caf387b4ed18691b19e@haskell.org> References: <043.5de2d12576332caf387b4ed18691b19e@haskell.org> Message-ID: <058.1b598e5b41c5c68f6afdf4677efcff0c@haskell.org> #15608: Segfault in retainer profiling -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Profiling | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5134 Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): One of the problems is that because of recursive `retainClosure()` calls retainer profiler sometimes fills the C stack. I currently see 14000+ stack frames because of this loop: {{{ #174645 retainClosure (c0=, cp0=cp0 at entry=0x4201ecaa20, r0=r0 at entry=0x6810bc0 ) at rts/RetainerProfile.c:1598 #174646 0x00000000059b48c7 in retain_small_bitmap (c_child_r=, c=0x4201ecaa20, bitmap=0, size=, p=0x4201ecaa50) at rts/RetainerProfile.c:1140 #174647 retain_PAP_payload (n_args=, payload=0x4201ecaa50, fun=, c_child_r=, pap=0x4201ecaa20) at rts/RetainerProfile.c:1334 #174648 retainClosure (c0=, cp0=cp0 at entry=0x4203affe88, r0=r0 at entry=0x6810bc0 ) at rts/RetainerProfile.c:1598 }}} I don't understand how retainer profiler works yet. It has a stack, and a maxStack variable, but I don't understand why we sometimes push work to the stack and sometimes recurse, and maxStack seems to be unused. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 07:41:03 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 07:41:03 -0000 Subject: [GHC] #15621: Error message involving type families points to wrong location In-Reply-To: <050.f6fd8f38eae3af90b1d1147a0e35ac2c@haskell.org> References: <050.f6fd8f38eae3af90b1d1147a0e35ac2c@haskell.org> Message-ID: <065.5e230e7e2bdb9cbde1e0f3992a7d9f44@haskell.org> #15621: Error message involving type families points to wrong location -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.4.3 checker) | Resolution: | Keywords: TypeFamilies Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > What if there is a Refl :: F Int :~: F Int and a Refl :: F Int :~: F Bool in the same function? It's fine. Each type signature will give rise to its own implication constraint (indeed already does, except that it is optimised away for signatures that are monotypes). So I think that #14185 is not a red herring at all! I agree that there is a tension here. The ''whole point'' of Deriveds, the only reason they exist, is so that we can more vigorously rewrite wanteds with wanteds, and thus find equalities that must hold in any ultimate solution. The trouble is that there may still be a choice of which unifications to do in which order, and that affects error messages. I'm proposing our implication constraints as a way to keep the two sub- problems separate. (They won't ''stay'' separate, because we'll float out any unsolved equality constraints - and indeed deliberately so, so that they can meet friends from other equality constraints and we can learn more equalities thereby. But they will at least ''begin'' separate. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 07:43:28 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 07:43:28 -0000 Subject: [GHC] #15627: Absent unlifted bindings In-Reply-To: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> References: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> Message-ID: <059.45620e9ab26b397f2b39affc775a9e2e@haskell.org> #15627: Absent unlifted bindings -------------------------------------+------------------------------------- Reporter: sgraf | Owner: (none) Type: task | Status: new Priority: normal | Milestone: ⊥ Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9279 #4328 | Differential Rev(s): #11126 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): There's something weird about this polymorphic literal thing. Assuming we are talking about something like `| RubbishLit TyCon`, take the constructor `RubbishLit mutVarPrimTyCon` as an example: It's a value living in the higher kind `Type -> Type -> TYPE UnliftedRep`. I'm not sure this works for `literalType`?! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 07:44:28 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 07:44:28 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.c02ee12c72045d6d62e34f57e8350312@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141 -------------------------------------+------------------------------------- Comment (by simonpj): > Hence, we should not move the closing-over-kinds part at all, and instead just modify the TyVar branch of ty_co_vars_of_type so that it handles each variable it encounters exactly once (comment:123) Correct, that's what I'm suggesting. > I had been implementing Simon's suggestion from comment:122, and at least while still using mapUnionVarSet, I'm still getting regressions on 4 tests, I'd be surprised if you still got regressions if you adopted the more efficient `closeOverKinds` from comment:122. But (a) I've been surprised many times by this zombie and (b) I think comment:123 is better anyway. TL;DR: do comment:123. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 07:53:34 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 07:53:34 -0000 Subject: [GHC] #15632: Undependable Dependencies In-Reply-To: <043.01997ce1746c591111a0a2273155036b@haskell.org> References: <043.01997ce1746c591111a0a2273155036b@haskell.org> Message-ID: <058.0e9e0c93bede3e29081306cc42ddde4c@haskell.org> #15632: Undependable Dependencies -------------------------------------+------------------------------------- Reporter: AntC | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: | FunctionalDependencies, | OverlappingInstances Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: 10675 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AntC): Here's my starter for 10, analysis and rationale below. A) Apply the FunDep consistency check as per the published work. That is, per Definition 6 of the FDs through CHRs paper. If the FunDep's argument positions of the instance head unify, their results must be strictly ''equal''. Except: B) Relax to follow GHC's [ticket:10675#comment:15 'bogus consistency check'] providing all of i) The FunDep is full; ii) One of the instances is strictly more specific; and iii) That instance's argument positions taken together are strictly more specific. (i.e. the result positions are not less specific.) (The bogus consistency check is that the result positions be unifiable rather than equal under the substitution induced by unifying the arguments.) So the example on this ticket gets rejected: although the `Thither` instance is strictly more specific than the `Yon`, its argument position is not. Furthermore the `Thither` instance is in no substitution ordering wrt to the `Hither` instance. The `Hither` and `Yon` instances are happy together, and in a substitution ordering. Note these rules allow nearly all of the dubious instances discussed in the various tickets (including 'dysfunctional dependencies'), ''but'' insist you write them in a convoluted way that would be a big hint you're probably doing something silly. > reviewing tickets (including this one) I've added some more ticket links to this one; #10675 is the authority. > someone paying careful attention to FDs in GHC. That's what [https://github.com/ghc-proposals/ghc-proposals/pull/56 this proposal] was about. Search for the ticket numbers in the discussion. I'll also add a comment to #10675 explaining how to apply the rules for it; and giving the inferred types (much more sensible). '''Rationale''' > proposing what changes to make What we ''don't'' want is to go delving into constraints or some global search amongst instances in scope. IOW we do want rules that can be applied pairwise between instances and per-FunDep. That also makes it easier to explain to puzzled users why their instances are being rejected. In general there might be multiple FunDeps; a parameter position might be an argument for one FunDep but a result for another. For non-full FunDeps (which is #10675) I don't think there's anything we could do other than apply the strict rule. But you can evade that rule (deliberately so) with a strictly more general/overlappable instance. And I think that relaxation is justified because putting unification variables in result positions is a) what the published work gives as the semantics; and b) gives you overlapping instances in effect anyway. Specifically, the above rules authorise what we've been doing for over a dozen years to get a type-level type equality predicate {{{#!hs class TypeEq a b (r :: Bool) | a b -> r instance TypeEq a a True instance {-# OVERLAPPABLE #-} (f ~ False) => TypeEq a b f }}} The equal instance is equivalent to, and could happily be written as {{{#!hs instance {-# OVERLAPPING #-} (t ~ True) => TypeEq a a t }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 07:55:55 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 07:55:55 -0000 Subject: [GHC] #15627: Absent unlifted bindings In-Reply-To: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> References: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> Message-ID: <059.7571610ae113a7af25f727d2dc71bbc9@haskell.org> #15627: Absent unlifted bindings -------------------------------------+------------------------------------- Reporter: sgraf | Owner: (none) Type: task | Status: new Priority: normal | Milestone: ⊥ Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9279 #4328 | Differential Rev(s): #11126 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): No -- don't put a `TyCon` in `RubbishLit`. Instead: {{{ data Literal = RubbishAddr -- Replaces MachNullAddr | RubbishLit | ...as before... literalType RubbishAddr = Addr# literalType RubbishLit = forall (a :: TYPE UnliftedRep). a }}} So now, the core term {{{ (Literal RubbishLit) `App` (Type (TyConApp MutVar# [Int])) }}} We can't use `(RubbishLit @Addr#)` for `RubbishAddr` because `Addr# :: TYPE AddrRep`, which is ill-kinded. Actually, I suppose that some C APIs might want the null addr (zero, I think?) specifically, rather than "any old rubbish value", so maybe we want to retain `MachNullAddr` rather than replace it with `RubbishAddr`. Yet another variant would be to give `RubbishLit` the type `forall r (a::TYPE r). a`. Operationally, we simply don't initialise `RubbishLit` values; whereas using `0` for `Int#` and `'x'` for `Char#` still forces us to initialise. I'd be inclined to stick with the non-levity-polymorphic version initially. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 07:59:13 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 07:59:13 -0000 Subject: [GHC] #15632: Undependable Dependencies In-Reply-To: <043.01997ce1746c591111a0a2273155036b@haskell.org> References: <043.01997ce1746c591111a0a2273155036b@haskell.org> Message-ID: <058.eae1f1261c6e26d2c03cd80ce96f1485@haskell.org> #15632: Undependable Dependencies -------------------------------------+------------------------------------- Reporter: AntC | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: | FunctionalDependencies, | OverlappingInstances Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: 10675, 9210, | Differential Rev(s): 8634 | Wiki Page: | -------------------------------------+------------------------------------- Changes (by AntC): * related: 10675 => 10675, 9210, 8634 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 07:59:43 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 07:59:43 -0000 Subject: [GHC] #15627: Absent unlifted bindings In-Reply-To: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> References: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> Message-ID: <059.7c8af2e65b506828ea8ecf02f619d611@haskell.org> #15627: Absent unlifted bindings -------------------------------------+------------------------------------- Reporter: sgraf | Owner: (none) Type: task | Status: new Priority: normal | Milestone: ⊥ Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9279 #4328 | Differential Rev(s): #11126 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): Ah, of course! Much simpler. I think we have to stick with `MachNullAddr`, because that's how `nullAddr#` https://hackage.haskell.org/package/base-4.11.1.0/docs/GHC- Exts.html#v:nullAddr-35- is defined. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 08:00:56 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 08:00:56 -0000 Subject: [GHC] #13862: Optional "-v" not allowed with :load in GHCi In-Reply-To: <044.9738400eba372a90ccdc97dcca61b7c9@haskell.org> References: <044.9738400eba372a90ccdc97dcca61b7c9@haskell.org> Message-ID: <059.5c397e0ea54697e74dd998b762a1096a@haskell.org> #13862: Optional "-v" not allowed with :load in GHCi -------------------------------------+------------------------------------- Reporter: vanto | Owner: RolandSenn Type: bug | Status: patch Priority: normal | Milestone: 8.8.1 Component: GHCi | Version: 8.0.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #4017 | Differential Rev(s): Phab:D5122 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RolandSenn): * testcase: make test TESTS="T13862a T13862b T13862c" => -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 08:07:34 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 08:07:34 -0000 Subject: [GHC] #14025: Object file is put in wrong directory when any source has absolute path In-Reply-To: <046.48759c75ff80de33ebc22ad9a6eaaf3e@haskell.org> References: <046.48759c75ff80de33ebc22ad9a6eaaf3e@haskell.org> Message-ID: <061.407d138c75dc987d97eea5bc90b54eae@haskell.org> #14025: Object file is put in wrong directory when any source has absolute path -------------------------------------+------------------------------------- Reporter: literon | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RolandSenn): * owner: RolandSenn => (none) Comment: I stopped working on this ticket. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 08:15:26 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 08:15:26 -0000 Subject: [GHC] #12758: Bring sanity to our performance testsuite In-Reply-To: <046.023630bbf855f7a4ed786cb14a3639ea@haskell.org> References: <046.023630bbf855f7a4ed786cb14a3639ea@haskell.org> Message-ID: <061.17bac1a1d0a649e6e826540d26772352@haskell.org> #12758: Bring sanity to our performance testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: high | Milestone: 8.8.1 Component: Test Suite | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3758, Wiki Page: | Phab:D5059 -------------------------------------+------------------------------------- Comment (by davide): I've added a wiki page for the proposed change: https://ghc.haskell.org/trac/ghc/wiki/Performance/Tests. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 09:17:49 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 09:17:49 -0000 Subject: [GHC] #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite In-Reply-To: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> References: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> Message-ID: <061.8fd4df71eb88de94f50361022aae4472@haskell.org> #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: patch Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5145 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonmar): For future archaeology, here are the details of what caused the crash. The fix has comments to explain the underlying problem and the fix, but here I want to put the full details of how it manifested in this particular instance, just in case we need to revisit. The program evaluates a CAF after it has been GC'd. The best way to diagnose it is to add `-debug` to the `ghc-options` in the `.cabal` file, and make sure that you have Phab:D4963 merged (this wasn't merged in 8.6 at the time, which meant the assertion for GC'd CAFs didn't fire as it should have). You can also comment out a bunch of the code in the test case to make it fail faster and with less code, see Phab:P183 Now, the CAF in question is this: {{{ x_rbHt :: Data.ByteString.Internal.ByteString [GblId] = [] \u [] case newMutVar# [GHC.ForeignPtr.NoFinalizers GHC.Prim.realWorld#] of { (#,#) ipv_sbMX [Occ=Once] ipv1_sbMY [Occ=Once] -> case __pkg_ccall bytestring-0.10.8.2 [addr#1_rbHs ipv_sbMX] of { (#,#) _ [Occ=Dead] ds2_sbN2 [Occ=Once] -> case word2Int# [ds2_sbN2] of sat_sbN4 [Occ=Once] { __DEFAULT -> let { sat_sbN3 [Occ=Once] :: GHC.ForeignPtr.ForeignPtrContents [LclId] = CCCS GHC.ForeignPtr.PlainForeignPtr! [ipv1_sbMY]; } in Data.ByteString.Internal.PS [addr#1_rbHs sat_sbN3 0# sat_sbN4]; }; }; }; }}} which is referred to by this function: {{{ $wxs_rbHu :: GHC.Prim.Int# -> (# Data.ByteString.Internal.ByteString, [Data.ByteString.Internal.ByteString] #) [GblId, Arity=1, Str=, Unf=OtherCon []] = sat-only [] \r [ww_sbN5] case ww_sbN5 of ds1_sbN6 [Occ=Once] { __DEFAULT -> let { sat_sbNb [Occ=Once] :: [Data.ByteString.Internal.ByteString] [LclId] = [ds1_sbN6] \u [] case -# [ds1_sbN6 1#] of sat_sbN7 [Occ=Once] { __DEFAULT -> case $wxs_rbHu sat_sbN7 of { (#,#) ww2_sbN9 [Occ=Once] ww3_sbNa [Occ=Once] -> : [ww2_sbN9 ww3_sbNa]; }; }; } in (#,#) [x_rbHt sat_sbNb]; 1# -> (#,#) [x_rbHt GHC.Types.[]]; }; }}} Note that * the function refers to the CAF * it is recursive, and * the recursive call is inside a thunk (`sat_sbNb`) We generated the following SRTs (use `-ddump-cmm` to see this): {{{ [sat_sbNb_entry() // [R1] { info_tbls: [(cc8F, label: sat_sbNb_info rep: HeapRep 1 nonptrs { Thunk } srt: Just x_rbHt_closure), (cc8H, label: block_cc8H_info rep: StackRep [] srt: Nothing)] $wxs_rbHu_entry() // [R2] { info_tbls: [(cc8S, label: $wxs_rbHu_info rep: HeapRep static { Fun {arity: 1 fun_type: ArgSpec 4} } srt: Just x_rbHt_closure)] }}} ie. both the function and the thunk have singleton SRTs, pointing directly to the CAF. This happens because these two declarations are in cycle, and the SRT pass assigns all declarations in a cycle the same SRT. The SRT contains all the references from the RHSs of the declarations, which would be `{$wxs_rbHu_closure, x_rbHt_closure}` except that we remove the recursive reference to `$wxs_rbHu_closure` from the set (it's not necessary to have recursive references in the SRT, the SRT only needs to point to all the things that can be reached from this group). The crash occurred as follows. Let's call the thunk `sat_sbNb_entry` "A", and the function `$wxs_rbHu_entry` "B". * suppose we GC when A is alive, and B is not otherwise reachable. * B is "collected", meaning that it doesn't make it onto the static objects list during this GC, but nothing bad happens yet. * Next, suppose we enter A, and then call B. (remember that A refers to B) At the entry point to B, we GC. This puts B on the stack, as part of the RET_FUN stack frame that gets pushed when we GC at a function entry point. * This GC will now reach B * But because B was previous "collected", it breaks the assumption that static objects are never resurrected. See `Note [STATIC_LINK fields]` in rts/sm/Storage.h for why this is bad. * In practice, the GC thinks that B has already been visited, and so doesn't visit X, and catastrophe ensues. The breakage is caused by a combination of two things: 1. the SRT for the thunk A doesn't point to the function B, even though it calls the function. 2. the function's entry code causes a pointer to the function's closure to appear on the stack, when it wasn't previously visible to the GC. We opted to fix (1), because it's not clear whether (2) could happen in other ways. It turned out that (1) could happen in two ways: * a "shortcutting" optimisation in SRT generation * omitting recursive references from the SRT of a recursive group For completeness, here is what we want to generate instead: {{{ [sat_sbNb_entry() // [R1] { info_tbls: [(cc8F, label: sat_sbNb_info rep: HeapRep 1 nonptrs { Thunk } srt: Just $wxs_rbHu_closure), <--- SRT points to the function, not the CAF (cc8H, label: block_cc8H_info rep: StackRep [] srt: Nothing)] stack_info: arg_space: 8 updfr_space: Just 8 } }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 09:27:04 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 09:27:04 -0000 Subject: [GHC] #14974: 2-fold memory usage regression GHC 8.2.2 -> GHC 8.4.1 compiling `mmark` package In-Reply-To: <042.6f9317183740e6c428dbe334554fec22@haskell.org> References: <042.6f9317183740e6c428dbe334554fec22@haskell.org> Message-ID: <057.dc79c3c9a7245accc174460ffacbb9bf@haskell.org> #14974: 2-fold memory usage regression GHC 8.2.2 -> GHC 8.4.1 compiling `mmark` package -------------------------------------+------------------------------------- Reporter: hvr | Owner: davide Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: Compiler | Version: 8.4.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by davide): * Attachment "bench_8.2.2.txt" added. Benchmark results for GHC 8.2.2 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 09:28:38 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 09:28:38 -0000 Subject: [GHC] #14974: 2-fold memory usage regression GHC 8.2.2 -> GHC 8.4.1 compiling `mmark` package In-Reply-To: <042.6f9317183740e6c428dbe334554fec22@haskell.org> References: <042.6f9317183740e6c428dbe334554fec22@haskell.org> Message-ID: <057.477ce6b4e07eed3406dcdb0a5f2d77c9@haskell.org> #14974: 2-fold memory usage regression GHC 8.2.2 -> GHC 8.4.1 compiling `mmark` package -------------------------------------+------------------------------------- Reporter: hvr | Owner: davide Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: Compiler | Version: 8.4.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by davide): * Attachment "bench_8.4.1.txt" added. Benchmark results for GHC 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 09:33:23 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 09:33:23 -0000 Subject: [GHC] #14974: 2-fold memory usage regression GHC 8.2.2 -> GHC 8.4.1 compiling `mmark` package In-Reply-To: <042.6f9317183740e6c428dbe334554fec22@haskell.org> References: <042.6f9317183740e6c428dbe334554fec22@haskell.org> Message-ID: <057.f6ca5bd60d8c76a8be4366e7159df821@haskell.org> #14974: 2-fold memory usage regression GHC 8.2.2 -> GHC 8.4.1 compiling `mmark` package -------------------------------------+------------------------------------- Reporter: hvr | Owner: davide Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: Compiler | Version: 8.4.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by davide): Benchmarks (with the exception of the benchmark using "data/bench- indented-code-block.md") have improved. It's possible that this is (at least in part) due to more specialization. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 09:37:15 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 09:37:15 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.8c97286dd86b8e79d3e689534c380109@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141 -------------------------------------+------------------------------------- Comment (by tdammers): Indeed. comment:122 implemented in Phab:5147, no more stat regressions, will do a nofib run as well. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 09:38:09 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 09:38:09 -0000 Subject: [GHC] #15578: Honour INLINE pragmas on 0-arity bindings In-Reply-To: <046.e84edd9f62d6ef84f8f7c7aedfa45ace@haskell.org> References: <046.e84edd9f62d6ef84f8f7c7aedfa45ace@haskell.org> Message-ID: <061.0052b341dac99749096d6f7b23afbd75@haskell.org> #15578: Honour INLINE pragmas on 0-arity bindings -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15519 | Differential Rev(s): Phab:D5137 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Krzysztof Gogolewski ): In [changeset:"b9b1f99954e69f23e9647d00e048938d5509ec14/ghc" b9b1f999/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="b9b1f99954e69f23e9647d00e048938d5509ec14" Honor INLINE on 0-arity bindings (#15578) Summary: Fix test for #15578 By allowing 0-arity values to be inlined, we end up changing boringness annotations, and this gets reflected in the Core output for this particular test. Add Notes for #15578 Test Plan: ./validate Reviewers: simonpj, bgamari Reviewed By: simonpj Subscribers: rwbarton, carter GHC Trac Issues: #15578 Differential Revision: https://phabricator.haskell.org/D5137 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 09:42:49 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 09:42:49 -0000 Subject: [GHC] #15578: Honour INLINE pragmas on 0-arity bindings In-Reply-To: <046.e84edd9f62d6ef84f8f7c7aedfa45ace@haskell.org> References: <046.e84edd9f62d6ef84f8f7c7aedfa45ace@haskell.org> Message-ID: <061.2e5deb5eb8111a316a4d8afb73063eac@haskell.org> #15578: Honour INLINE pragmas on 0-arity bindings -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15519 | Differential Rev(s): Phab:D5137 Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: patch => merge -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 10:03:12 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 10:03:12 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.cdc89d104f8e62570783c7ad5017546b@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141, Phab:5147 -------------------------------------+------------------------------------- Changes (by tdammers): * differential: Phab:D4769, Phab:D5141 => Phab:D4769, Phab:D5141, Phab:5147 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 10:30:47 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 10:30:47 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.052752502a3524a25af6744c291ca9fb@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141, Phab:D5147 -------------------------------------+------------------------------------- Changes (by simonpj): * differential: Phab:D4769, Phab:D5141, Phab:5147 => Phab:D4769, Phab:D5141, Phab:D5147 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 10:30:53 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 10:30:53 -0000 Subject: [GHC] #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes In-Reply-To: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> References: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> Message-ID: <062.1c2e3dc263ef954c1518d110f7ff757c@haskell.org> #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes -------------------------------------+------------------------------------- Reporter: ChaiTRex | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * cc: simonpj (added) Comment: This is because the simplifier introduces a call to a worker function that returns an unboxed tuple. This is the original expression: {{{ -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} a :: String [LclIdX] a = show @ Integer GHC.Show.$fShowInteger 5 }}} The simplifier transforms this to {{{ -- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0} a :: String [LclIdX, Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 140 0}] a = GHC.Show.$fShowInteger_$cshowsPrec GHC.Show.$fShow(,)1 5 (GHC.Types.[] @ Char) }}} and then {{{ -- RHS size: {terms: 9, types: 11, coercions: 0, joins: 0/0} a :: String [LclIdX, Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 160 30}] a = case GHC.Show.$w$cshowsPrec4 0# 5 (GHC.Types.[] @ Char) of { (# ww3_a1Xd, ww4_a1Xe #) -> GHC.Types.: @ Char ww3_a1Xd ww4_a1Xe } }}} Here the scrutinee returns an unboxed tuple, and we can't compile this expression to bytecode. Some ideas: - Ignore optimization settings in GHCi and always compile things with all optimizations disabled, to avoid introducing unboxed tuples and sums as a result of inlining worker functions etc. - Somehow teach simplifier to not introduce unboxed tuples/sums (seems like too much work, we may be able to implement unboxed tuple/sum support with same effort). - Implement unboxed tuple and sum support for GHCi. - Improve error message and mention that this may happen as a result of optimizations (maybe only show this if optimizations are enabled). Any other ideas? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 10:42:24 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 10:42:24 -0000 Subject: [GHC] #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes In-Reply-To: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> References: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> Message-ID: <062.ec53a64f134806faf7141080be6070a5@haskell.org> #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes -------------------------------------+------------------------------------- Reporter: ChaiTRex | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Why doesn't this happen ''all the time'' in GHCi? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 10:43:57 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 10:43:57 -0000 Subject: [GHC] #10675: GHC does not check the functional dependency consistency condition correctly In-Reply-To: <046.c63a3d5abf02d779fbe6a1e8e4a5d19e@haskell.org> References: <046.c63a3d5abf02d779fbe6a1e8e4a5d19e@haskell.org> Message-ID: <061.fcce10b1597e65227c6e04b4273af436@haskell.org> #10675: GHC does not check the functional dependency consistency condition correctly -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.1 Resolution: | Keywords: FunDeps Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AntC): Applying the [ticket:15632#comment:2 suggested rules here] * The instances on the O.P. get rejected as inconsistent under the FunDep, because A) Upon unifying the `a` parameter positions (argument to the FunDep), applying the substitution to the `b` position does not give ''equal'' type for the result. B) i) The FunDep is not full. ii) The instance heads overall are in no substitution ordering (they're apart). If you insist on those instances go either {{{#!hs instance C Bool [x] [x] -- per O.P. instance {-# OVERLAPPABLE #-} C' x a b => C x a b where -- catch-all op = op' class C' x a b | a -> b where op' :: x -> a -> b instance C Char x y => C' Char [x] [Maybe y] -- per O.P. but indirect f x = op True [x] -- per O.P. -- inferred ===> f :: C Bool [a] [a] => a -> [a] }}} or {{{#!hs instance C Char x y => C Char [x] [Maybe y] -- per O.P. instance {-# OVERLAPPABLE #-} C'' x a b => C x a b where -- catch-all op = op'' class C'' x a b | a -> b where op'' :: x -> a -> b instance C'' Bool [x] [x] -- per O.P. but indirect f x = op True [x] -- per O.P. -- inferred ===> f :: a -> [a] }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 10:45:04 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 10:45:04 -0000 Subject: [GHC] #9173: Better type error messages In-Reply-To: <046.f8f24aa2ddaa3d579bc40f0b6f04f6b7@haskell.org> References: <046.f8f24aa2ddaa3d579bc40f0b6f04f6b7@haskell.org> Message-ID: <061.dedee5a974a9bf14f634a850468b5b6c@haskell.org> #9173: Better type error messages -------------------------------------+------------------------------------- Reporter: simonpj | Owner: goldfire Type: bug | Status: new Priority: high | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: | TypeErrorMessages Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Great stuff! I think it would be Really Helpful to write down a Note explaining how all the moving parts work. Then we can review that against your code. It always does my head in! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 10:46:39 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 10:46:39 -0000 Subject: [GHC] #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes In-Reply-To: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> References: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> Message-ID: <062.a6532e726f37ebb5ced9a2891ebcd119@haskell.org> #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes -------------------------------------+------------------------------------- Reporter: ChaiTRex | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): So monoidal pointed out to me about this flag {{{ GHCi and -O --------------- When using optimization, the compiler can introduce several things (such as unboxed tuples) into the intermediate code, which GHCi later chokes on since the bytecode interpreter can't handle this (and while this is arguably a bug these aren't handled, there are no plans to fix it.) While the driver pipeline always checks for this particular erroneous combination when parsing flags, we also need to check when we update the flags; this is because API clients may parse flags but update the DynFlags afterwords, before finally running code inside a session (see T10052 and #10052). }}} I think this says that optimisation flags should be ignored by ghci. Indeed normally are: {{{ ~ $ ghci -O2 when making flags consistent: warning: -O conflicts with --interactive; -O ignored. GHCi, version 8.4.3: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/omer/rcbackup/.ghci }}} The problem is when we also add `-fbyte-code` then I guess the consistency check does not work as expected and accepts `-O2`: {{{ ~ $ ghci -fobject-code -O2 GHCi, version 8.4.3: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/omer/rcbackup/.ghci λ:1> a = show 5 Error: bytecode compiler can't handle unboxed tuples and sums. Possibly due to foreign import/export decls in source. Workaround: use -fobject-code, or compile this module to .o separately. }}} So this is probably just a matter of fixing the flag consistency check (whatever that is). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 10:58:50 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 10:58:50 -0000 Subject: [GHC] #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes In-Reply-To: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> References: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> Message-ID: <062.e27ce30fb9faeec94e4905c967432c10@haskell.org> #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes -------------------------------------+------------------------------------- Reporter: ChaiTRex | Owner: monoidal Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * owner: (none) => monoidal Comment: The bug should be in `DynFlags.makeDynFlagsConsistent`. monoidal will submit a patch for this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 10:59:27 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 10:59:27 -0000 Subject: [GHC] #15634: GHCi: Segmentation fault Data.List.sum large number In-Reply-To: <048.5052d331a4fc48d28dc3b9b9d3968d7b@haskell.org> References: <048.5052d331a4fc48d28dc3b9b9d3968d7b@haskell.org> Message-ID: <063.ec5fe65959ed984ba9147d121e5717ee@haskell.org> #15634: GHCi: Segmentation fault Data.List.sum large number -------------------------------------+------------------------------------- Reporter: ksallberg | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Research | needed Component: GHCi | Version: 8.0.1 Resolution: | Keywords: segfault Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by ksallberg: Old description: > Hello, first bug report here, so please let me know what I should > provide. I tried to search for this but didn't find it. > > {{{ > kristian at snabbadatorn:~$ ghci > GHCi, version 8.0.1: http://www.haskell.org/ghc/ :? for help > Prelude> [1..100] > [1,2,3,4,5,6,7,8,9,10,11,12... and so on > Prelude> sum [1..10000000] > 50000005000000 > Prelude> sum [1..100000000] > Segmentation fault > }}} > > Machine: Google compute engine, n1-highcpu-8 (8 vCPUs, 7.2 GB memory), > > uname -r: 4.9.0-8-amd64 > > {{{ > kristian at snabbadatorn:~$ lsb_release -a > No LSB modules are available. > Distributor ID: Debian > Description: Debian GNU/Linux 9.5 (stretch) > Release: 9.5 > Codename: stretch > }}} > > {{{ > kristian at snabbadatorn:~$ ghci --version > The Glorious Glasgow Haskell Compilation System, version 8.0.1 > }}} New description: Hello, first bug report here, so please let me know what I should provide. I tried to search for this but didn't find it. {{{ kristian at snabbadatorn:~$ ghci GHCi, version 8.0.1: http://www.haskell.org/ghc/ :? for help Prelude> [1..100] [1,2,3,4,5,6,7,8,9,10,11,12... and so on Prelude> sum [1..10000000] 50000005000000 Prelude> sum [1..100000000] Segmentation fault }}} Machine: Google compute engine, n1-highcpu-8 (8 vCPUs, 7.2 GB memory), uname -r: 4.9.0-8-amd64 {{{ kristian at snabbadatorn:~$ lsb_release -a No LSB modules are available. Distributor ID: Debian Description: Debian GNU/Linux 9.5 (stretch) Release: 9.5 Codename: stretch }}} {{{ kristian at snabbadatorn:~$ ghci --version The Glorious Glasgow Haskell Compilation System, version 8.0.1 }}} ----------------------- Similar problem in older GHC version, although GHCi at least does not exit: Amazon ec2, r4.8xlarge, 32 cores: {{{ GHCi, version 7.10.3: http://www.haskell.org/ghc/ :? for help Prelude> sum [1..100000000] *** Exception: stack overflow Prelude> }}} {{{ ubuntu at ip-172-31-21-176:~$ lsb_release -a No LSB modules are available. Distributor ID: Ubuntu Description: Ubuntu 16.04.5 LTS Release: 16.04 Codename: xenial }}} {{{ ubuntu at ip-172-31-21-176:~$ uname -r 4.4.0-1065-aws }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 11:00:20 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 11:00:20 -0000 Subject: [GHC] #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes In-Reply-To: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> References: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> Message-ID: <062.d5f2c06ff452aa04b968337fbad4b9fd@haskell.org> #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes -------------------------------------+------------------------------------- Reporter: ChaiTRex | Owner: monoidal Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): > Why doesn't this happen all the time in GHCi? This happens all the time when you combine `-fobject-code` and `-O2`, so I guess people don't combine these too much. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 11:06:31 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 11:06:31 -0000 Subject: [GHC] #15634: GHCi: Segmentation fault Data.List.sum large number In-Reply-To: <048.5052d331a4fc48d28dc3b9b9d3968d7b@haskell.org> References: <048.5052d331a4fc48d28dc3b9b9d3968d7b@haskell.org> Message-ID: <063.c604b440406363d8993e4edc028d44d6@haskell.org> #15634: GHCi: Segmentation fault Data.List.sum large number -------------------------------------+------------------------------------- Reporter: ksallberg | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Research | needed Component: GHCi | Version: 8.0.1 Resolution: | Keywords: segfault Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): Stack overflow is expected. `Prelude.sum` is implemented using `foldl` which is leaky and will overflow the stack at some point. Try this: {{{ ~ $ ghci GHCi, version 8.4.3: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/omer/rcbackup/.ghci λ:1> foldl (+) 0 [1..100000000] *** Exception: stack overflow λ:2> import Data.List λ:3> foldl' (+) 0 [1..100000000] 5000000050000000 }}} The segfault is an actual bug. Would it be possible for you to try this with GHC HEAD or at least 8.4.3? I tried with both and also with 8.0.1, but couldn't reproduce the segfault. If you can build GHC HEAD, it'd also be helpful to get a backtrace by doing this: - vim `which ghc` - Replace the last line with this: `exec gdb --args "$executablename" -B"$topdir" ${1+"$@"}` - Run ghci using `ghc --interactive` - On segfault type `bt`, and paste the backtrace. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 11:06:59 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 11:06:59 -0000 Subject: [GHC] #15569: Constant folding optimises 1 into 3 In-Reply-To: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> References: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> Message-ID: <065.9b6c0efa7ecbc78d7c94ffeab654050c@haskell.org> #15569: Constant folding optimises 1 into 3 -------------------------------------+------------------------------------- Reporter: snowleopard | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9136 | Differential Rev(s): Phab:D5109 Wiki Page: | -------------------------------------+------------------------------------- Comment (by snowleopard): Thanks @sgraf! I think we can proceed with the testing-based solution for now, but I hope we will revisit constant folding rules in future and reimplement them in a more type-safe way. I can volunteer to do that once most of the urgent work on Hadrian is complete. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 11:10:14 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 11:10:14 -0000 Subject: [GHC] #15634: GHCi: Segmentation fault Data.List.sum large number In-Reply-To: <048.5052d331a4fc48d28dc3b9b9d3968d7b@haskell.org> References: <048.5052d331a4fc48d28dc3b9b9d3968d7b@haskell.org> Message-ID: <063.cfacc8025fb8c77bc4fd2442cf5bac42@haskell.org> #15634: GHCi: Segmentation fault Data.List.sum large number -------------------------------------+------------------------------------- Reporter: ksallberg | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Research | needed Component: GHCi | Version: 8.0.1 Resolution: | Keywords: segfault Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by ksallberg): Thank you for the directions. I will try building GHC HEAD as soon as I can, and get back here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 11:13:18 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 11:13:18 -0000 Subject: [GHC] #15629: "No skolem info" panic (GHC 8.6 only) In-Reply-To: <050.dd398323ba018b74f7bb68214187ebb6@haskell.org> References: <050.dd398323ba018b74f7bb68214187ebb6@haskell.org> Message-ID: <065.ffc4058a62ab888d9df873e8857c5bc8@haskell.org> #15629: "No skolem info" panic (GHC 8.6 only) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.6.1-beta1 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Well, I devoted a few mins to trying to see what caused the crash in ghc 8.6, but it doesn't look related to the patch you identify in comment:3. Still, since it is working, I'm disinclined to invest more effort in debugging 8.6! I'll add a regression test and close this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 12:38:57 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 12:38:57 -0000 Subject: [GHC] #15636: Implication constraint priority breaks default class implementations Message-ID: <047.cde874671f0c755782e5f0597d6dda93@haskell.org> #15636: Implication constraint priority breaks default class implementations -------------------------------------+------------------------------------- Reporter: i-am-tom | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Keywords: | Operating System: Unknown/Multiple QuantifiedConstraints | Architecture: | Type of failure: GHC rejects Unknown/Multiple | valid program Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Hello, Not 100% sure that this is a bug, but I've done some investigating (with a ''lot'' of help from Csongor Kiss) and thought it was, at the very least, behaviour worth clarifying. The following code... {{{#!hs {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE UndecidableInstances #-} module Test where class D a where f :: a -> String g :: a -> String g = f class C a instance (forall a. C a => D a) => D x where f _ = "uh oh" }}} ... produces the error: {{{ • Could not deduce (C x) arising from a use of ‘Test.$dmg’ from the context: forall a. C a => D a bound by the instance declaration at Test.hs:19:10-38 Possible fix: add (C x) to the context of the instance declaration • In the expression: Test.$dmg @(x) In an equation for ‘g’: g = Test.$dmg @(x) In the instance declaration for ‘D x’ | 19 | instance (forall a. C a => D a) => D x where | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ }}} It appears that the problem here is with the default implementation for `g`. Namely, when `f` is called, two matching instances are found: - `forall a. C a => D a` - `(forall a. C a => D a) => D x` The issue, as far as we can tell, is that the first instance is chosen (and then the constraint check fails). I'm currently working around this by introducing a newtype into the head of the quantified constraint†, but I thought it best to check whether this is a bug or, indeed, the expected behaviour in this situation. Let me know if I've missed anything from this ticket - it's my first one! Thanks, Tom † An example of this can be found at https://github.com/i-am-tom/learn- me-a-haskell/blob/dbf2a22c5abb78ab91124dcf1e0e7ecd3d88831d/src/Bag/QuantifiedInstances.hs#L92-L94 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 13:01:06 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 13:01:06 -0000 Subject: [GHC] #15625: GHC panic, with QuantifiedConstraints In-Reply-To: <051.5bb3c3d1540b5617c1e145b1cbeec548@haskell.org> References: <051.5bb3c3d1540b5617c1e145b1cbeec548@haskell.org> Message-ID: <066.7c2e9e15a29a5bc04470aef0f4eed698@haskell.org> #15625: GHC panic, with QuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"bd76875ae6ad0cdd734564dddfb9ab88a6de9579/ghc" bd76875a/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="bd76875ae6ad0cdd734564dddfb9ab88a6de9579" Allow (~) in the head of a quantified constraints Since the introduction of quantified constraints, GHC has rejected a quantified constraint with (~) in the head, thus f :: (forall a. blah => a ~ ty) => stuff I am frankly dubious that this is ever useful. But /is/ necessary for Coercible (representation equality version of (~)) and it does no harm to allow it for (~) as well. Plus, our users are asking for it (Trac #15359, #15625). It was really only excluded by accident, so this patch lifts the restriction. See TcCanonical Note [Equality superclasses in quantified constraints] There are a number of wrinkles: * If the context of the quantified constraint is empty, we can get trouble when we get down to unboxed equality (a ~# b) or (a ~R# b), as Trac #15625 showed. This is even more of a corner case, but it produced an outright crash, so I elaborated the superclass machinery in TcCanonical.makeStrictSuperClasses to add a void argument in this case. See Note [Equality superclasses in quantified constraints] * The restriction on (~) was in TcValidity.checkValidInstHead. In lifting the restriction I discovered an old special case for (~), namely | clas_nm `elem` [ heqTyConName, eqTyConName] , nameModule clas_nm /= this_mod This was (solely) to support the strange instance instance a ~~ b => a ~ b in Data.Type.Equality. But happily that is no longer with us, since commit f265008fb6f70830e7e92ce563f6d83833cef071 Refactor (~) to reduce the suerpclass stack So I removed the special case. * I found that the Core invariants on when we could have co = were entirely not written down. (Getting this wrong ws the proximate source of the crash in Trac #15625. So - Documented them better in CoreSyn Note [CoreSyn type and coercion invariant], - Modified CoreOpt and CoreLint to match - Modified CoreUtils.bindNonRec to match - Made MkCore.mkCoreLet use bindNonRec, rather than duplicate its logic - Made Simplify.rebuildCase case-to-let respect Note [CoreSyn type and coercion invariant], }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 13:01:06 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 13:01:06 -0000 Subject: [GHC] #15359: Quantified constraints do not work with equality constraints In-Reply-To: <047.6c20373526398fd5725ca3ce9d7c3b21@haskell.org> References: <047.6c20373526398fd5725ca3ce9d7c3b21@haskell.org> Message-ID: <062.ebfebc429ed2b61845efe27f68487337@haskell.org> #15359: Quantified constraints do not work with equality constraints -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"bd76875ae6ad0cdd734564dddfb9ab88a6de9579/ghc" bd76875a/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="bd76875ae6ad0cdd734564dddfb9ab88a6de9579" Allow (~) in the head of a quantified constraints Since the introduction of quantified constraints, GHC has rejected a quantified constraint with (~) in the head, thus f :: (forall a. blah => a ~ ty) => stuff I am frankly dubious that this is ever useful. But /is/ necessary for Coercible (representation equality version of (~)) and it does no harm to allow it for (~) as well. Plus, our users are asking for it (Trac #15359, #15625). It was really only excluded by accident, so this patch lifts the restriction. See TcCanonical Note [Equality superclasses in quantified constraints] There are a number of wrinkles: * If the context of the quantified constraint is empty, we can get trouble when we get down to unboxed equality (a ~# b) or (a ~R# b), as Trac #15625 showed. This is even more of a corner case, but it produced an outright crash, so I elaborated the superclass machinery in TcCanonical.makeStrictSuperClasses to add a void argument in this case. See Note [Equality superclasses in quantified constraints] * The restriction on (~) was in TcValidity.checkValidInstHead. In lifting the restriction I discovered an old special case for (~), namely | clas_nm `elem` [ heqTyConName, eqTyConName] , nameModule clas_nm /= this_mod This was (solely) to support the strange instance instance a ~~ b => a ~ b in Data.Type.Equality. But happily that is no longer with us, since commit f265008fb6f70830e7e92ce563f6d83833cef071 Refactor (~) to reduce the suerpclass stack So I removed the special case. * I found that the Core invariants on when we could have co = were entirely not written down. (Getting this wrong ws the proximate source of the crash in Trac #15625. So - Documented them better in CoreSyn Note [CoreSyn type and coercion invariant], - Modified CoreOpt and CoreLint to match - Modified CoreUtils.bindNonRec to match - Made MkCore.mkCoreLet use bindNonRec, rather than duplicate its logic - Made Simplify.rebuildCase case-to-let respect Note [CoreSyn type and coercion invariant], }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 13:01:06 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 13:01:06 -0000 Subject: [GHC] #15629: "No skolem info" panic (GHC 8.6 only) In-Reply-To: <050.dd398323ba018b74f7bb68214187ebb6@haskell.org> References: <050.dd398323ba018b74f7bb68214187ebb6@haskell.org> Message-ID: <065.b5a7439387dc585b832263e4210c2230@haskell.org> #15629: "No skolem info" panic (GHC 8.6 only) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.6.1-beta1 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"0d4f394810e13b4643f9361b6d2b3b29cb2d5003/ghc" 0d4f394/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="0d4f394810e13b4643f9361b6d2b3b29cb2d5003" Add regression test for Trac #15629 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 13:27:53 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 13:27:53 -0000 Subject: [GHC] #15359: Quantified constraints do not work with equality constraints In-Reply-To: <047.6c20373526398fd5725ca3ce9d7c3b21@haskell.org> References: <047.6c20373526398fd5725ca3ce9d7c3b21@haskell.org> Message-ID: <062.fa67890b58c2220ab61f2fd53a8b9f05@haskell.org> #15359: Quantified constraints do not work with equality constraints -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.5 Resolution: fixed | Keywords: | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: quantified- | constraints/T15359,T15359a Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * testcase: => quantified-constraints/T15359,T15359a * resolution: => fixed Comment: OK the examples in the Description both now work -- or at least typecheck and pass Lint. I have not tried the more exotic stuff in the comments, but please to have a go! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 13:28:46 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 13:28:46 -0000 Subject: [GHC] #15625: GHC panic, with QuantifiedConstraints In-Reply-To: <051.5bb3c3d1540b5617c1e145b1cbeec548@haskell.org> References: <051.5bb3c3d1540b5617c1e145b1cbeec548@haskell.org> Message-ID: <066.10659f30501f8677b75e158e9c07678c@haskell.org> #15625: GHC panic, with QuantifiedConstraints -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.6.1-beta1 Resolution: fixed | Keywords: | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: quantified- | constraints/T15625, T15625a Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * testcase: => quantified-constraints/T15625, T15625a * resolution: => fixed Comment: Done! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 13:36:47 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 13:36:47 -0000 Subject: [GHC] #15637: Ambiguous type variables in GeneralisedNewtypeDeriving Message-ID: <047.85b8022e5c3b5dfb006bf88861742a5a@haskell.org> #15637: Ambiguous type variables in GeneralisedNewtypeDeriving -------------------------------------+------------------------------------- Reporter: i-am-tom | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Keywords: | Operating System: Unknown/Multiple GeneralisedNewtypeDeriving, | GeneralizedNewtypeDeriving | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- When deriving the `C` instance in the following code: {{{#!hs {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-} module Test where class C a where f :: String instance C () where f = "foo" newtype T = T () deriving C }}} The following error occurs: {{{ Test.hs:10:27: error: • Ambiguous type variable ‘a0’ arising from a use of ‘f’ prevents the constraint ‘(C a0)’ from being solved. Probable fix: use a type annotation to specify what ‘a0’ should be. These potential instances exist: instance C T -- Defined at Test.hs:10:27 instance C () -- Defined at Test.hs:8:10 • In the third argument of ‘GHC.Prim.coerce’, namely ‘f’ In the expression: GHC.Prim.coerce @String @String f :: String In an equation for ‘f’: f = GHC.Prim.coerce @String @String f :: String When typechecking the code for ‘f’ in a derived instance for ‘C T’: To see the code I am typechecking, use -ddump-deriv | 10 | newtype T = T () deriving C | ^ }}} ... and the following core is produced: {{{ ==================== Derived instances ==================== Derived class instances: instance Test.C Test.T where Test.f = GHC.Prim.coerce @GHC.Base.String @GHC.Base.String Test.f :: GHC.Base.String Derived type family instances: }}} The problem seems to be that the `a` should have been set to `()` within the coerced instance. I've been working round this with a `newtype X a = X String` as the result value so that the `a` is present in the signature, but I think this is a bug; should a more specialised instance be generated? I hope this is enough of an explanation! Thanks, Tom -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 13:53:44 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 13:53:44 -0000 Subject: [GHC] #15637: Ambiguous type variables in GeneralisedNewtypeDeriving In-Reply-To: <047.85b8022e5c3b5dfb006bf88861742a5a@haskell.org> References: <047.85b8022e5c3b5dfb006bf88861742a5a@haskell.org> Message-ID: <062.f8cd8e57933be9c56705023b2a6238f2@haskell.org> #15637: Ambiguous type variables in GeneralisedNewtypeDeriving -------------------------------------+------------------------------------- Reporter: i-am-tom | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | GeneralisedNewtypeDeriving, | GeneralizedNewtypeDeriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I suppose we could generate {{{ Test.f = coerce @String @String (Test.f @()) }}} that is, explicitly instantiating `f`. (Then maybe we could omit the second type arg to `coerce`; I'm not sure.) Ryan? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 13:58:30 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 13:58:30 -0000 Subject: [GHC] #15569: Constant folding optimises 1 into 3 In-Reply-To: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> References: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> Message-ID: <065.6d07433cb713762d463f985d04d32309@haskell.org> #15569: Constant folding optimises 1 into 3 -------------------------------------+------------------------------------- Reporter: snowleopard | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9136 | Differential Rev(s): Phab:D5109 Wiki Page: | -------------------------------------+------------------------------------- Comment (by ChaiTRex): I've started reworking my code to generate a small subset of test cases that use one specific fixed constant (100^th^ prime, 200^th^ prime, ''etc''. to avoid coincidentally passing tests) for each spot where a literal or variable is expected, which should cut down significantly on the number of tests. I'd like to further cut down on the number of tests while still getting full coverage, but I've only skimmed some of the constant folding rules. Am I right in assuming that the following are true? * `Int`s are the only type we need to test (if this isn't true, my reworking will make the code take a type parameter, so generating tests for additional types will be simple). * The following expression shapes are the only ones required, where `∘` is multiplication, addition, or subtraction and where multiple occurrences in one expression can represent different operations. '''Note:''' negation stops after single-`∘` expressions: * `a` * `-a` * `a ∘ b` * `a ∘ -b` * `-a ∘ b` * `a ∘ (b ∘ c)` * `(a ∘ b) ∘ c` * `(a ∘ b) ∘ (c ∘ d)` -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 14:02:04 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 14:02:04 -0000 Subject: [GHC] #15629: "No skolem info" panic (GHC 8.6 only) In-Reply-To: <050.dd398323ba018b74f7bb68214187ebb6@haskell.org> References: <050.dd398323ba018b74f7bb68214187ebb6@haskell.org> Message-ID: <065.ee8136a04e8ff489a19918d412175f12@haskell.org> #15629: "No skolem info" panic (GHC 8.6 only) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.6.1-beta1 checker) | Resolution: fixed | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: crash or panic | typecheck/should_fail/T15629 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * testcase: => typecheck/should_fail/T15629 * resolution: => fixed * milestone: 8.6.1 => 8.8.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 14:34:21 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 14:34:21 -0000 Subject: [GHC] #15637: Ambiguous type variables in GeneralisedNewtypeDeriving In-Reply-To: <047.85b8022e5c3b5dfb006bf88861742a5a@haskell.org> References: <047.85b8022e5c3b5dfb006bf88861742a5a@haskell.org> Message-ID: <062.02fcf99ebd9d43af243383d912ac8e42@haskell.org> #15637: Ambiguous type variables in GeneralisedNewtypeDeriving -------------------------------------+------------------------------------- Reporter: i-am-tom | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | GeneralisedNewtypeDeriving, | GeneralizedNewtypeDeriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Replying to [comment:1 simonpj]: > I suppose we could generate > {{{ > Test.f = coerce @String @String (Test.f @()) > }}} > that is, explicitly instantiating `f`. That would make this particular example work, yes. Note that this strategy would not support GND'ing //every// class under the sun that uses `AllowAmbiguousTypes`, such as the example from #14266, which uses an ambiguous type variable in a class context. But your idea would still be an improvement over the status quo, so I'm inclined to adopt it. > (Then maybe we could omit the second type arg to `coerce`; I'm not sure.) No, I don't think adding these extra type applications would change the fact that you need the second type argument to `coerce`. The reason for that is explained in `Note [GND and QuantifiedConstraints]` [http://git.haskell.org/ghc.git/blob/02edb8f2f973a8df26cfb6dfab0ef99a832f711f:/compiler/typecheck/TcGenDeriv.hs#l1823 here]; the short of it is the we need the second type argument to `coerce` to support GND'ing classes like: {{{#!hs class C a where c :: Int -> forall b. b -> a }}} That fact doesn't change even in the presence of this ticket. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 15:16:52 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 15:16:52 -0000 Subject: [GHC] #15638: Make Ptr argument to hGetBuf and hGetBufSome strict Message-ID: <049.608270165e285391187968b39cb4c836@haskell.org> #15638: Make Ptr argument to hGetBuf and hGetBufSome strict -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 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: -------------------------------------+------------------------------------- Currently, we have: {{{ hGetBufSome :: Handle -> Ptr a -> Int -> IO Int hGetBufSome h ptr count = ... hGetBuf :: Handle -> Ptr a -> Int -> IO Int hGetBuf h ptr count }}} I propose putting a bang pattern on the `ptr` argument to both of these functions. Currently, the non-strictness of this argument causes it to be boxed by functions that call it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 15:23:30 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 15:23:30 -0000 Subject: [GHC] #15636: Implication constraint priority breaks default class implementations In-Reply-To: <047.cde874671f0c755782e5f0597d6dda93@haskell.org> References: <047.cde874671f0c755782e5f0597d6dda93@haskell.org> Message-ID: <062.0539c2cba646c5b9afcb5bc2fc72c052@haskell.org> #15636: Implication constraint priority breaks default class implementations -------------------------------------+------------------------------------- Reporter: i-am-tom | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: | QuantifiedConstraints 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: | -------------------------------------+------------------------------------- Comment (by simonpj): This happens just the same if you say {{{ instance (forall a. C a => D a) => D x where f _ = "uh oh" g = f }}} Why? Well `f :: D a => a -> String`, so the occurrence of `f` on the RHS of `g`'s defn here means that we need `D x`. How can we solve `D x`? * We can solve it from the quantified constraint, giving rise to a need for `C x` * We can solve it from the top level instance `instance ... => D x`. GHC picks the first, treating "local" constraints as shadowing "global" ones. The user manual specifies this. There was some discussion in the GHC proposal thread. So currently it's by-design. If you want to propose a different design, by all means do so! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 15:31:05 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 15:31:05 -0000 Subject: [GHC] #15636: Implication constraint priority breaks default class implementations In-Reply-To: <047.cde874671f0c755782e5f0597d6dda93@haskell.org> References: <047.cde874671f0c755782e5f0597d6dda93@haskell.org> Message-ID: <062.648218b93da08793d7f9977c7cf90662@haskell.org> #15636: Implication constraint priority breaks default class implementations -------------------------------------+------------------------------------- Reporter: i-am-tom | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: | QuantifiedConstraints 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: | -------------------------------------+------------------------------------- Comment (by i-am-tom): Not at all - if this is intended behaviour, I'm happy to close the ticket. Thanks for the explanation! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 15:32:36 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 15:32:36 -0000 Subject: [GHC] #15636: Implication constraint priority breaks default class implementations In-Reply-To: <047.cde874671f0c755782e5f0597d6dda93@haskell.org> References: <047.cde874671f0c755782e5f0597d6dda93@haskell.org> Message-ID: <062.8ebcf5e4650446b8bf67a0f100d6c99c@haskell.org> #15636: Implication constraint priority breaks default class implementations -------------------------------------+------------------------------------- Reporter: i-am-tom | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: fixed | Keywords: | QuantifiedConstraints 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: | -------------------------------------+------------------------------------- Changes (by i-am-tom): * status: new => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 15:35:48 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 15:35:48 -0000 Subject: [GHC] #15637: Ambiguous type variables in GeneralisedNewtypeDeriving In-Reply-To: <047.85b8022e5c3b5dfb006bf88861742a5a@haskell.org> References: <047.85b8022e5c3b5dfb006bf88861742a5a@haskell.org> Message-ID: <062.71f0def842a666556d90cfeaff99d835@haskell.org> #15637: Ambiguous type variables in GeneralisedNewtypeDeriving -------------------------------------+------------------------------------- Reporter: i-am-tom | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | GeneralisedNewtypeDeriving, | GeneralizedNewtypeDeriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5148 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch * differential: => Phab:D5148 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 15:36:11 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 15:36:11 -0000 Subject: [GHC] #15637: Ambiguous type variables in GeneralisedNewtypeDeriving In-Reply-To: <047.85b8022e5c3b5dfb006bf88861742a5a@haskell.org> References: <047.85b8022e5c3b5dfb006bf88861742a5a@haskell.org> Message-ID: <062.10da725fedba3baf2d8c68a75e162822@haskell.org> #15637: Ambiguous type variables in GeneralisedNewtypeDeriving -------------------------------------+------------------------------------- Reporter: i-am-tom | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5148 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * keywords: GeneralisedNewtypeDeriving, GeneralizedNewtypeDeriving => deriving -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 17:06:41 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 17:06:41 -0000 Subject: [GHC] #15634: GHCi: Segmentation fault Data.List.sum large number In-Reply-To: <048.5052d331a4fc48d28dc3b9b9d3968d7b@haskell.org> References: <048.5052d331a4fc48d28dc3b9b9d3968d7b@haskell.org> Message-ID: <063.ce5b4c8d33455d719f4e26d3e94f5d16@haskell.org> #15634: GHCi: Segmentation fault Data.List.sum large number -------------------------------------+------------------------------------- Reporter: ksallberg | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Research | needed Component: GHCi | Version: 8.0.1 Resolution: | Keywords: segfault Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): I suspect that this is a duplicate of #15060 which will be fixed in 8.6.1. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 17:14:52 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 17:14:52 -0000 Subject: [GHC] #15608: Segfault in retainer profiling In-Reply-To: <043.5de2d12576332caf387b4ed18691b19e@haskell.org> References: <043.5de2d12576332caf387b4ed18691b19e@haskell.org> Message-ID: <058.fb9abc77597596691ae0f91ef95020dc@haskell.org> #15608: Segfault in retainer profiling -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Profiling | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5134 Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): > One of the problems is that because of recursive retainClosure() calls retainer profiler sometimes fills the C stack. Note that this misfeature of the retainer profiler is being tracked as #14758. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 17:24:19 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 17:24:19 -0000 Subject: [GHC] #15639: Surprising failure combining QuantifiedConstraints with Coercible Message-ID: <045.f2a49699aa20c0c2dd0e1c77d1b17a24@haskell.org> #15639: Surprising failure combining QuantifiedConstraints with Coercible -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 (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: -------------------------------------+------------------------------------- I don't understand what's going wrong here. {{{#!hs -- Fishy.hs {-# language RankNTypes, QuantifiedConstraints, RoleAnnotations #-} module Fishy (Yeah, yeahCoercible) where import Data.Coerce data Yeah_ a = Yeah_ Int newtype Yeah a = Yeah (Yeah_ a) type role Yeah representational yeahCoercible :: ((forall a b. Coercible (Yeah a) (Yeah b)) => r) -> r yeahCoercible r = r -- Fishy2.hs module Fishy2 where import Fishy import Data.Type.Coercion import Data.Coerce yeah :: Coercion [Yeah a] [Yeah b] yeah = yeahCoercible Coercion }}} I get {{{ Fishy2.hs:8:22: error: • Couldn't match representation of type ‘a’ with that of ‘b’ arising from a use of ‘Coercion’ ‘a’ is a rigid type variable bound by the type signature for: yeah :: forall a b. Coercion [Yeah a] [Yeah b] at Fishy2.hs:7:1-34 ‘b’ is a rigid type variable bound by the type signature for: yeah :: forall a b. Coercion [Yeah a] [Yeah b] at Fishy2.hs:7:1-34 • In the first argument of ‘yeahCoercible’, namely ‘Coercion’ In the expression: yeahCoercible Coercion In an equation for ‘yeah’: yeah = yeahCoercible Coercion • Relevant bindings include yeah :: Coercion [Yeah a] [Yeah b] (bound at Fishy2.hs:8:1) | 8 | yeah = yeahCoercible Coercion | }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 17:27:50 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 17:27:50 -0000 Subject: [GHC] #15639: Surprising failure combining QuantifiedConstraints with Coercible In-Reply-To: <045.f2a49699aa20c0c2dd0e1c77d1b17a24@haskell.org> References: <045.f2a49699aa20c0c2dd0e1c77d1b17a24@haskell.org> Message-ID: <060.7698e2d0e8963469328b9a22d6667222@haskell.org> #15639: Surprising failure combining QuantifiedConstraints with Coercible -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.5 checker) | Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by dfeuer): `-ddump-cs-trace` gives {{{ Step 1[l:1,d:1] Kept as inert: [WD] hole{co_a11c} {1}:: t_ax2[tau:0] GHC.Prim.~# 'GHC.Types.LiftedRep simpl_loop iteration=0 (no new given superclasses = True, 1 simples to solve) Step 2[l:0,d:1] Solved by unification: [WD] hole{co_a11c} {1}:: t_ax2[tau:0] GHC.Prim.~# 'GHC.Types.LiftedRep Constraint solver steps = 2 Step 1[l:2,d:0] Given forall-constraint: [G] df_a11t {0}:: forall a b. Coercible (Yeah a) (Yeah b) Step 2[l:2,d:0] Decomposed TyConApp: [WD] hole{co_a11z} {0}:: Coercion a_a11w[tau:2] b_a11x[tau:2] GHC.Prim.~# r_a11r[tau:1] Step 3[l:2,d:0] Kept as inert: [WD] hole{co_a11F} {0}:: b_a11x[tau:2] GHC.Prim.~# [Yeah b_a11l[sk:1]] Kick out, tv = k_a11v[tau:2] n-kicked = 1 kicked_out = WL {Eqs = [WD] hole{co_a11F} {0}:: b_a11x[tau:2] GHC.Prim.~# [Yeah b_a11l[sk:1]] (CIrredCan(sol))} Residual inerts = {Given instances = [G] df_a11t {0}:: forall a b. Coercible (Yeah a) (Yeah b) Unsolved goals = 0} Step 4[l:2,d:0] Solved by unification (1 kicked out): [D] _ {0}:: k_a11v[tau:2] GHC.Prim.~# * Step 5[l:2,d:0] Solved by unification: [WD] hole{co_a11F} {0}:: b_a11x[tau:2] GHC.Prim.~# [Yeah b_a11l[sk:1]] Step 6[l:2,d:0] Solved by unification: [WD] hole{co_a11E} {0}:: a_a11w[tau:2] GHC.Prim.~# [Yeah a_a11k[sk:1]] Step 7[l:2,d:0] Solved by reflexivity: [WD] hole{co_a11D} {0}:: k_a11v[tau:2] GHC.Prim.~# * Step 8[l:2,d:0] Dict/Top (solved wanted): [WD] $dCoercible_a11y {0}:: Coercible [Yeah a_a11k[sk:1]] [Yeah b_a11l[sk:1]] Step 9[l:2,d:1] Decomposed TyConApp: [WD] hole{co_a11G} {1}:: [Yeah a_a11k[sk:1]] ~R# [Yeah b_a11l[sk:1]] Step 10[l:2,d:1] Decomposed TyConApp: [WD] hole{co_a11H} {1}:: Yeah a_a11k[sk:1] ~R# Yeah b_a11l[sk:1] Step 11[l:2,d:1] Kept as inert: [WD] hole{co_a11I} {1}:: a_a11k[sk:1] ~R# b_a11l[sk:1] Step 12[l:2,d:0] Given forall-constraint: [G] df_a11J {0}:: forall a b. Yeah a ~R# Yeah b simpl_loop iteration=0 (no new given superclasses = False, 1 simples to solve) Step 13[l:2,d:1] Kept as inert: [WD] hole{co_a11I} {1}:: a_a11k[sk:1] ~R# b_a11l[sk:1] Constraint solver steps = 13 }}} I don't know quite how to read this, but I'd have expected {{{ Step 10[l:2,d:1] Decomposed TyConApp: [WD] hole{co_a11H} {1}:: Yeah a_a11k[sk:1] ~R# Yeah b_a11l[sk:1] }}} to interact with {{{ Step 12[l:2,d:0] Given forall-constraint: [G] df_a11J {0}:: forall a b. Yeah a ~R# Yeah b }}} and resolve. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 17:37:48 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 17:37:48 -0000 Subject: [GHC] #15639: Surprising failure combining QuantifiedConstraints with Coercible In-Reply-To: <045.f2a49699aa20c0c2dd0e1c77d1b17a24@haskell.org> References: <045.f2a49699aa20c0c2dd0e1c77d1b17a24@haskell.org> Message-ID: <060.cfbaae3da7584e2ebbe0995ac1aeb18e@haskell.org> #15639: Surprising failure combining QuantifiedConstraints with Coercible -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.5 checker) | Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by dfeuer): Best guess: the solver doesn't check for relevant quantified constraints before reducing `Yeah a_a11k[sk:1] ~R# Yeah b_a11l[sk:1]` to `a_a11k[sk:1] ~R# b_a11l[sk:1]`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 20:56:07 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 20:56:07 -0000 Subject: [GHC] #15621: Error message involving type families points to wrong location In-Reply-To: <050.f6fd8f38eae3af90b1d1147a0e35ac2c@haskell.org> References: <050.f6fd8f38eae3af90b1d1147a0e35ac2c@haskell.org> Message-ID: <065.13f9f294b2c5266a9ef45e48d9075ee4@haskell.org> #15621: Error message involving type families points to wrong location -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.4.3 checker) | Resolution: | Keywords: TypeFamilies Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): But what about a function that mentions {{{#!hs let x = (Refl :: F Int :~: F Int) `seq` (Refl :: F Int :~: F Bool) `seq` () }}} We'll get the error on the wrong line, won't we? The solution to #14185 improves the status quo, but only by a lucky coincidence (that the problems in both tickets stem from two different functions). What's nice about #14185 is that it prevents the error from jumping arbitrarily far in a file, but I still don't think it's the real solution to the problem. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 21:02:35 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 21:02:35 -0000 Subject: [GHC] #15285: "strange closure type" in T7919 with the threaded2 way In-Reply-To: <048.67a85438785d72c47b85ee0ad004eab2@haskell.org> References: <048.67a85438785d72c47b85ee0ad004eab2@haskell.org> Message-ID: <063.6cd2815f4bf7ab25cf087a56b7967808@haskell.org> #15285: "strange closure type" in T7919 with the threaded2 way -------------------------------------+------------------------------------- Reporter: alpmestan | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.5 Resolution: fixed | Keywords: Operating System: Linux | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: T7919 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5115 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: Merged with d46dd4528753f5b1e13540691f936cf45c127621. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 21:03:52 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 21:03:52 -0000 Subject: [GHC] #15529: runtime bug when profiling retainers In-Reply-To: <046.4c9b79c30f29fd493993be5df7c9cc48@haskell.org> References: <046.4c9b79c30f29fd493993be5df7c9cc48@haskell.org> Message-ID: <061.aee6a864296b2cd726be7d901a3e62cf@haskell.org> #15529: runtime bug when profiling retainers -------------------------------------+------------------------------------- Reporter: flip101 | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5075 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: Merged with 76a233143f1ec940f342ce3ce3afaf306923b392. I'm going to close assuming this is fixed. flip101, do let us know if you can still reproduce it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 21:05:22 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 21:05:22 -0000 Subject: [GHC] #15563: Typo in the documentation for Numeric.Natural. In-Reply-To: <042.7abd2e76bb8c52c1b059eca61d92e958@haskell.org> References: <042.7abd2e76bb8c52c1b059eca61d92e958@haskell.org> Message-ID: <057.a1ccb71014462f448a88cddb85d37056@haskell.org> #15563: Typo in the documentation for Numeric.Natural. -------------------------------------+------------------------------------- Reporter: asr | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Documentation | Version: 8.4.3 Resolution: fixed | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: Merged with 95b7b0a05368359746360bf4f33de52b43a97b37. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 21:17:25 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 21:17:25 -0000 Subject: [GHC] #15639: Surprising failure combining QuantifiedConstraints with Coercible In-Reply-To: <045.f2a49699aa20c0c2dd0e1c77d1b17a24@haskell.org> References: <045.f2a49699aa20c0c2dd0e1c77d1b17a24@haskell.org> Message-ID: <060.efa3e6cd4648ee23d35dc4dcf9b9f95a@haskell.org> #15639: Surprising failure combining QuantifiedConstraints with Coercible -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.5 checker) | Keywords: Resolution: | QuantifiedConstraints 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: | -------------------------------------+------------------------------------- Changes (by dfeuer): * keywords: => QuantifiedConstraints -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 21:23:18 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 21:23:18 -0000 Subject: [GHC] #15638: Make Ptr argument to hGetBuf and hGetBufSome strict In-Reply-To: <049.608270165e285391187968b39cb4c836@haskell.org> References: <049.608270165e285391187968b39cb4c836@haskell.org> Message-ID: <064.4b512562d025209b2387b69e0a7959bb@haskell.org> #15638: Make Ptr argument to hGetBuf and hGetBufSome strict -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: task | Status: patch Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: new => patch Comment: Fixed in Phab:D5149. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 21:25:28 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 21:25:28 -0000 Subject: [GHC] #14896: QuantifiedConstraints: GHC does doesn't discharge constraints if they are quantified In-Reply-To: <051.1cc6b03dde1d531c03c6cbc0cd468d33@haskell.org> References: <051.1cc6b03dde1d531c03c6cbc0cd468d33@haskell.org> Message-ID: <066.e569fea24f438a076ef872a774b15339@haskell.org> #14896: QuantifiedConstraints: GHC does doesn't discharge constraints if they are quantified -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.5 Resolution: | Keywords: | QuantifiedConstraints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by dfeuer): * priority: normal => low Comment: Reducing the priority for now. I'll bump it back up if someone comes up with a situation where this actually prevents valid code from compiling. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 22:11:22 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 22:11:22 -0000 Subject: [GHC] #15569: Constant folding optimises 1 into 3 In-Reply-To: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> References: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> Message-ID: <065.044fe1c73e336758644225f42f1cd5b5@haskell.org> #15569: Constant folding optimises 1 into 3 -------------------------------------+------------------------------------- Reporter: snowleopard | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9136 | Differential Rev(s): Phab:D5109 Wiki Page: | -------------------------------------+------------------------------------- Comment (by flip101): Since the phrases "SMT solver" and "compiler-checked way" came up. Wouldn't it be good for GHC to move into the direction that CakeML has chosen and then (at least for some parts) verify the compiler with proof? It could be a good addition to CI and also for local builds to run after the test suite. Excuse me if the question is too broad of scope, but the ticket seems a good example for it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 22:14:13 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 22:14:13 -0000 Subject: [GHC] #15579: topNormaliseType is wrong In-Reply-To: <046.5b7180305b5f494ab9ca559038fad023@haskell.org> References: <046.5b7180305b5f494ab9ca559038fad023@haskell.org> Message-ID: <061.a263d0d0ebdabbb32c7b66ccd021cf8c@haskell.org> #15579: topNormaliseType is wrong -------------------------------------+------------------------------------- Reporter: simonpj | Owner: goldfire Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by flip101: Old description: > I’m very puzzled about topNormaliseTYpe_maybe. Here it is: > {{{ > topNormaliseType_maybe env ty > = topNormaliseTypeX stepper mkTransCo ty > where > stepper = unwrapNewTypeStepper `composeSteppers` tyFamStepper > > tyFamStepper rec_nts tc tys -- Try to step a type/data family > = let (args_co, ntys) = normaliseTcArgs env Representational tc tys > in > -- NB: It's OK to use normaliseTcArgs here instead of > -- normalise_tc_args (which takes the LiftingContext described > -- in Note [Normalising types]) because the reduceTyFamApp > below > -- works only at top level. We'll never recur in this function > -- after reducing the kind of a bound tyvar. > > case reduceTyFamApp_maybe env Representational tc ntys of > Just (co, rhs) -> NS_Step rec_nts rhs (args_co `mkTransCo` co) > _ -> NS_Done > }}} > I have two puzzlements > > 1. First, it seems utterly wrong to normalise the arguments using > Representational. Consider > {{{ > F (N Int) > where newtype N x = [x] > }}} > We don’t want to reduce `(N Int)` to `[Int]`, and then try reducing > `(F [Int])`!! That is totally bogus. Surely we should use (the role- > aware) `normalise_tc_args` here? > > 2. I have literally no clue what `Note [Normalising types]` is all about. > Moreover there is no Lifting Context passed to `normalise_tc_args`, so I > don’t know what this stuff about `LiftingContext` is about. Is this > historical baggage? > > Richard and I discussed this. (1) is a bug; for (2) the comment is > misleading and should be deleted. > > Richard will do these things -- and will add examples to the mysterious > `Note [Normalising types]` New description: I’m very puzzled about topNormaliseTYpe_maybe. Here it is: {{{#!haskell topNormaliseType_maybe env ty = topNormaliseTypeX stepper mkTransCo ty where stepper = unwrapNewTypeStepper `composeSteppers` tyFamStepper tyFamStepper rec_nts tc tys -- Try to step a type/data family = let (args_co, ntys) = normaliseTcArgs env Representational tc tys in -- NB: It's OK to use normaliseTcArgs here instead of -- normalise_tc_args (which takes the LiftingContext described -- in Note [Normalising types]) because the reduceTyFamApp below -- works only at top level. We'll never recur in this function -- after reducing the kind of a bound tyvar. case reduceTyFamApp_maybe env Representational tc ntys of Just (co, rhs) -> NS_Step rec_nts rhs (args_co `mkTransCo` co) _ -> NS_Done }}} I have two puzzlements 1. First, it seems utterly wrong to normalise the arguments using Representational. Consider {{{#!haskell F (N Int) where newtype N x = [x] }}} We don’t want to reduce `(N Int)` to `[Int]`, and then try reducing `(F [Int])`!! That is totally bogus. Surely we should use (the role-aware) `normalise_tc_args` here? 2. I have literally no clue what `Note [Normalising types]` is all about. Moreover there is no Lifting Context passed to `normalise_tc_args`, so I don’t know what this stuff about `LiftingContext` is about. Is this historical baggage? Richard and I discussed this. (1) is a bug; for (2) the comment is misleading and should be deleted. Richard will do these things -- and will add examples to the mysterious `Note [Normalising types]` -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 22:14:51 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 22:14:51 -0000 Subject: [GHC] #15569: Constant folding optimises 1 into 3 In-Reply-To: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> References: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> Message-ID: <065.d2ba20d4c385e1c596edffa642c882e5@haskell.org> #15569: Constant folding optimises 1 into 3 -------------------------------------+------------------------------------- Reporter: snowleopard | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9136 | Differential Rev(s): Phab:D5109 Wiki Page: | -------------------------------------+------------------------------------- Comment (by monoidal): I picked all rules from D2858, including the wrong and the correct version of `(L y :-: v) :-: (L x :-: w)` and used sympy to compute the difference between LHS and RHS symbolically. Result: all differences simplify to 0, except that one rule that was found to be wrong. Code: https://gist.github.com/monoidal/3d5565b986a013639389fc57081d2781 All of the rules use addition, subtraction and multiplication only (matters would be different if there was division). This makes me confident that the rules are algebraically correct. It doesn't mean the code is completely correct, but any remaining errors will be of different nature. If someone is willing to do further review, I would suggest things like: double-checking the code surrounding the rules, checking if integer overflow can occur, does this apply only to Int/Integer or other types etc. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 22:27:26 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 22:27:26 -0000 Subject: [GHC] #15623: Wrong Endian, ghc-pwd and ghc-cabal on ghc 8.0.1 for powerpc64le (IBM Power) In-Reply-To: <058.92eeca5309f093ba094bb7b979a5550b@haskell.org> References: <058.92eeca5309f093ba094bb7b979a5550b@haskell.org> Message-ID: <073.b437eb57e5403caeaf52e1703147cd3f@haskell.org> #15623: Wrong Endian, ghc-pwd and ghc-cabal on ghc 8.0.1 for powerpc64le (IBM Power) ----------------------------------------+--------------------------------- Reporter: francescantoncastro | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Linux | Architecture: powerpc64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------------+--------------------------------- Comment (by flip101): Hi francescantoncastro, is this problem important for you now? What about using an older GHC version for your project as a temporary solution? The powerpc64 is a tier2 platform which is low priority according to platforms page https://ghc.haskell.org/trac/ghc/wiki/Platforms#Tier2platforms It wouldn't be good to let this bug block the 8.6.1 release which was suppose to come out last august according to the project page https://ghc.haskell.org/trac/ghc/wiki/Status/GHC-8.6.1 Maybe the milestone can be moved to a later GHC version or bug priority set to low/lowest. What do you think? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 22:28:12 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 22:28:12 -0000 Subject: [GHC] #15639: Surprising failure combining QuantifiedConstraints with Coercible In-Reply-To: <045.f2a49699aa20c0c2dd0e1c77d1b17a24@haskell.org> References: <045.f2a49699aa20c0c2dd0e1c77d1b17a24@haskell.org> Message-ID: <060.cdf9210b0a5ce0ff645b700051e37534@haskell.org> #15639: Surprising failure combining QuantifiedConstraints with Coercible -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.5 checker) | Keywords: Resolution: | QuantifiedConstraints 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: | -------------------------------------+------------------------------------- Comment (by dfeuer): If I had to guess, I would guess that there is no entirely satisfactory general solution to this problem. Given `type role F representational` (or `type role F nominal`) and forall a b. `C a b => Coercible (F a) (F b)`, and seeking `Coercible (F a) (F b)` I very much doubt that there's a single optimal way to determine whether to reduce the wanted to `C` or to `Coercible a b` (or `a ~ b`). To be consistent with how this is handled for other classes, we "should" just reject the constraint altogether, as overlapping. But that would be sad, and I do suspect we can do better, at least for some special cases. For example, if we're given `forall a b. Coercible (F a) (F b)`, we want to think of that as improving the type role of `F`'s parameter from whatever it may be to phantom. Similarly, if we're given `forall a b. Coercible a b => Coercible (F a) (F b)`, we want to think of that as improving the type role of `F`s parameter to representational, if it would otherwise be nominal. Adding such special cases to the constraint solver would certainly be a horribly ugly hack, but I don't really know what else we can do. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 22:39:09 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 22:39:09 -0000 Subject: [GHC] #15579: topNormaliseType is wrong In-Reply-To: <046.5b7180305b5f494ab9ca559038fad023@haskell.org> References: <046.5b7180305b5f494ab9ca559038fad023@haskell.org> Message-ID: <061.19eda858aa6ebf2a217ada381caac45c@haskell.org> #15579: topNormaliseType is wrong -------------------------------------+------------------------------------- Reporter: simonpj | Owner: goldfire Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * cc: RyanGlScott (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 23:07:37 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 23:07:37 -0000 Subject: [GHC] #15509: `showEFloat` inconsistency introduced in base-4.12 In-Reply-To: <042.b4d95dcfedcc55594395a53ebe2f16f7@haskell.org> References: <042.b4d95dcfedcc55594395a53ebe2f16f7@haskell.org> Message-ID: <057.9cd11913de65ea76ff2bd8bff57f61b8@haskell.org> #15509: `showEFloat` inconsistency introduced in base-4.12 -------------------------------------+------------------------------------- Reporter: hvr | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5083 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"e71e341f87c055ecc01f85ddd8d7a2094dfa8e9a/ghc" e71e341f/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="e71e341f87c055ecc01f85ddd8d7a2094dfa8e9a" base: showEFloat: Handle negative precisions the same of zero precision Test Plan: Validate Reviewers: hvr, alpmestan Reviewed By: alpmestan Subscribers: rwbarton, carter GHC Trac Issues: #15509 Differential Revision: https://phabricator.haskell.org/D5083 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 23:09:34 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 23:09:34 -0000 Subject: [GHC] #15509: `showEFloat` inconsistency introduced in base-4.12 In-Reply-To: <042.b4d95dcfedcc55594395a53ebe2f16f7@haskell.org> References: <042.b4d95dcfedcc55594395a53ebe2f16f7@haskell.org> Message-ID: <057.ac09b0c7b97f30a749f9a1039f20874c@haskell.org> #15509: `showEFloat` inconsistency introduced in base-4.12 -------------------------------------+------------------------------------- Reporter: hvr | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5083 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: patch => merge -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 23:20:58 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 23:20:58 -0000 Subject: [GHC] #15640: Add "difficulty" field to tickets Message-ID: <046.4bd78d6f7ffaa04b2adf78d5009291f9@haskell.org> #15640: Add "difficulty" field to tickets -------------------------------------+------------------------------------- Reporter: flip101 | Owner: hvr Type: feature | Status: new request | Priority: normal | Milestone: Component: Trac & Git | Version: Keywords: | Operating System: Unknown/Multiple Architecture: Other | Type of failure: None/Unknown Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I propose to add a new field to tickets to indicate the difficulty of fixing a bug. This for three purposes: * The priority of the bug can be affected by the difficulty, thus making the difficulty visible as a field can be handy to set/affect the priority accordingly, example: https://ghc.haskell.org/trac/ghc/ticket/15579#comment:1 * Can be welcoming to newcomers who want to contribute to GHC to start with tickets with low priority. The new field should be searchable so they can get a list of all tickets with low difficulty * Can make work on GHC more efficient by doing more high-priority / low- difficulty bugs. This plays into pareto principle - 80/20 rule As for the actual levels, "easy" or "hard" is subjective. So i think it's a good idea to have levels according to some experience level somebody should have. I can imagine some bugs can only be squashed by a few or even one person, while others can be jumped on by people who have decent haskell experience (given they want to read the background of setting up GHC dev and such). One could then argue that this field should then be named "skill level needed", but i like difficulty more :) And this also allows for situations where the bug can be fixed only by a few people who are really knowledgeable about the matter but still find a need for different gradients of difficulty level. Maybe something like: * Very easy - new to haskell * Easy - need haskell experience * Medium - need a lot of haskell experience * Hard - need experience with GHC dev * Very Hard - as before + profiling/debugging tools + system knowledge * Very Hard - as before + specific compiling techniques * Very Hard - as before + need C skills (for RTS) * .. I'm not sure how and who can change the Trac settings, but the procedure for this is described on this page: https://trac.edgewall.org/wiki/TracTicketsCustomFields -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 13 23:44:06 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 13 Sep 2018 23:44:06 -0000 Subject: [GHC] #12420: Users guide link for hsc2hs has bitrotten In-Reply-To: <045.2ba362e1b9578cb50ac2c29c5bb4b687@haskell.org> References: <045.2ba362e1b9578cb50ac2c29c5bb4b687@haskell.org> Message-ID: <060.0912695a37d4914743862f35cbeab675@haskell.org> #12420: Users guide link for hsc2hs has bitrotten -------------------------------------+------------------------------------- Reporter: ezyang | Owner: (none) Type: task | Status: closed Priority: normal | Milestone: Component: hsc2hs | Version: 8.0.1 Resolution: fixed | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: new => closed * resolution: => fixed Comment: This was fixed in hsc2hs-0.68.1. https://github.com/haskell/hsc2hs/commit/8fed36addd3439e01752a0ce48140ad0a56a6c61 #diff-e1beed3fccb466b3859f68d819408fe4 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 00:15:44 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 00:15:44 -0000 Subject: [GHC] #15640: Add "difficulty" field to tickets In-Reply-To: <046.4bd78d6f7ffaa04b2adf78d5009291f9@haskell.org> References: <046.4bd78d6f7ffaa04b2adf78d5009291f9@haskell.org> Message-ID: <061.13a88f4d9a394e239b3d7c8aacc92357@haskell.org> #15640: Add "difficulty" field to tickets -------------------------------------+----------------------------- Reporter: flip101 | Owner: hvr Type: feature request | Status: new Priority: normal | Milestone: Component: Trac & Git | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Other Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+----------------------------- Comment (by RyanGlScott): I could have sworn that there used to be a difficulty field. In fact, you can still see evidence that it once existed in this comment: https://ghc.haskell.org/trac/ghc/ticket/8560#comment:7 . Perhaps it just needs to be reenabled? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 01:24:29 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 01:24:29 -0000 Subject: [GHC] #15641: Git repositories have several problems Message-ID: <046.cc1f52463775afa374d2adbd9385be70@haskell.org> #15641: Git repositories have several problems -------------------------------------+------------------------------------- Reporter: flip101 | Owner: hvr Type: bug | Status: new Priority: high | Milestone: Component: Trac & Git | Version: 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 some problems with the repositories. When i try to clone from the official repo: {{{ » git clone --single-branch --branch master --depth=1 --recursive git://git.haskell.org/ghc.git ghc-head Cloning into 'ghc-head'... fatal: The remote end hung up unexpectedly fatal: early EOF fatal: index-pack failed }}} Maybe it's because the git server version is old (1.9.1). Without `--depth=1` it works, but anyway it's an issue. With the github mirror i have another problem: {{{ Cloning into 'libraries/Cabal'... fatal: remote error: ghc/packages/Cabal is not a valid repository name Email support at github.com for help fatal: clone of 'git://github.com/ghc/packages/Cabal.git' into submodule path 'libraries/Cabal' failed }}} With the phabricator repo the following issue: command: {{{ git clone --depth=1 --single-branch --branch ghc-8.6 --recursive https://phabricator.haskell.org/diffusion/GHC/glasgow-haskell-compiler.git ghc-8.6-head }}} error: {{{ Cloning into '.arc-linters/arcanist-external-json-linter'... error: RPC failed; HTTP 503 curl 22 The requested URL returned error: 503 first byte timeout fatal: The remote end hung up unexpectedly fatal: clone of 'https://phabricator.haskell.org/diffusion/GHC/arcanist- external-json-linter.git' into submodule path '.arc-linters/arcanist- external-json-linter' failed }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 02:22:06 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 02:22:06 -0000 Subject: [GHC] #14902: GHC HEAD cannot be booted with GHC 8.4.1 In-Reply-To: <043.016a3788cb924dba7d82567fd39dedeb@haskell.org> References: <043.016a3788cb924dba7d82567fd39dedeb@haskell.org> Message-ID: <058.d7722b470b7751b4311d9634ead4b562@haskell.org> #14902: GHC HEAD cannot be booted with GHC 8.4.1 -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.4.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Magiclouds): @hvr I reproduced this in two ways. 1. github source got me this. Also some submodules cannot be initialized, the cloning just stuck. 2. git.haskell.org source works, until somehow it broke ghc in my system. I did not install new ghc, no idea how it did it. I got messages like following when '''ghc-pkg check'''. cannot find any of ["libHSghc-prim-0.5.2.0.a","libHSghc- prim-0.5.2.0.p_a","libHSghc-prim-0.5.2.0-ghc8.4.3.so","libHSghc- prim-0.5.2.0-ghc8.4.3.dylib","HSghc-prim-0.5.2.0-ghc8.4.3.dll"] on library path There are problems in package rts-1.0: Warning: library-dirs: $HOME/src/Git/ghc/rts/dist/build doesn't exist or isn't a directory -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 02:46:58 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 02:46:58 -0000 Subject: [GHC] #15642: Improve the worst case performance of weak pointers Message-ID: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> #15642: Improve the worst case performance of weak pointers -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: 8.8.1 Component: Runtime | Version: 8.6.1-beta1 System | Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Runtime Unknown/Multiple | performance bug Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Garbage collecting weak pointers involves repeatedly traversing the weak pointer list, checking which keys are still alive, and in response marking the relevant values and finalizers live. This works well in most cases, but if there are long chains of weak pointers, it's terrible. I wonder if we can do something about that without significantly hurting performance elsewhere. Here's the (probably naive) idea: 1. Maintain a hash table mapping weak pointer keys to lists of weak pointers. This replaces the current weak pointer list. 2. Use a bit in the info table pointer of every heap object to indicate whether that object is referenced from any `Weak#`. This is the weakest link: if we don't have a spare bit there, or don't want to use one, then I think this whole idea is sunk. When creating a weak pointer, set the appropriate bit in the key and insert the key and pointer into the hash table. When performing early finalization, clear the bit in the key if no other `Weak#` points to it. When performing garbage collection: check the bit in each object as it is marked. If the bit is set, move the key and its attached `Weak#`s from the hash table into a new hash table (or an association list that gets turned into a hash table after evacuation or whatever), and mark all the linked weak pointer targets and finalizers live. In the end, the old hash table contains only unreachable objects. Now mark those objects live (for finalization and in case of resurrection), and queue up the finalizers. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 02:56:04 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 02:56:04 -0000 Subject: [GHC] #15643: Test Suite Fails for GHCI Message-ID: <053.26dfce1f7866bd4d0d5d9f9f2a3a61f7@haskell.org> #15643: Test Suite Fails for GHCI --------------------------------------+---------------------------- Reporter: JulianLeviston | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Test Suite | Version: Keywords: | Operating System: MacOS X Architecture: x86 | Type of failure: Other Test Case: T1914(ghci) | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: --------------------------------------+---------------------------- Git sha is ce23451c2c771bfbbac27ce63c5fdccc7ed02b3b (version 8.7, I believe - the latest as at day before yesterday) First run through of tests ever for me. Did `cd ghc/testsuite/tests/ghci && make THREADS=8` and the following error ensued: {{{#!shell =====> T1914(ghci) 102 of 271 [0, 0, 0] cd "scripts/T1914.run" && HC="/Users/julian/code/haskell/ghc/inplace/test spaces/ghc-stage2" HC_OPTS="-dcore-lint -dcmm-lint -no-user-package-db -rtsopts -fno-warn-missed-specialisations -fshow-warning-groups -fdiagnostics-color=never -fno-diagnostics-show-caret -dno-debug-output " "/Users/julian/code/haskell/ghc/inplace/test spaces/ghc-stage2" --interactive -v0 -ignore-dot-ghci -fno-ghci-history +RTS -I0.1 -RTS -fghci-leak-check -dcore-lint -dcmm-lint -no-user-package-db -rtsopts -fno-warn-missed-specialisations -fshow-warning-groups -fdiagnostics- color=never -fno-diagnostics-show-caret -dno-debug-output < T1914.script Actual stderr output differs from expected: diff -uw "/dev/null" "scripts/ghci063.run/ghci063.run.stderr.normalised" --- /dev/null 2018-09-12 23:42:18.000000000 +1000 +++ scripts/ghci063.run/ghci063.run.stderr.normalised 2018-09-12 23:42:20.000000000 +1000 @@ -0,0 +1,2 @@ + +B.hs:1:1: parse error on input ‘***’ *** unexpected failure for ghci063(ghci) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 02:58:48 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 02:58:48 -0000 Subject: [GHC] #15643: Test Suite Fails for GHCI In-Reply-To: <053.26dfce1f7866bd4d0d5d9f9f2a3a61f7@haskell.org> References: <053.26dfce1f7866bd4d0d5d9f9f2a3a61f7@haskell.org> Message-ID: <068.858841029f4ebd7d31a5de2ab868145c@haskell.org> #15643: Test Suite Fails for GHCI -----------------------------------+----------------------------------- Reporter: JulianLeviston | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Test Suite | Version: Resolution: | Keywords: Operating System: MacOS X | Architecture: x86 Type of failure: Other | Test Case: T1914(ghci) Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+----------------------------------- Description changed by JulianLeviston: Old description: > Git sha is ce23451c2c771bfbbac27ce63c5fdccc7ed02b3b (version 8.7, I > believe - the latest as at day before yesterday) > > First run through of tests ever for me. Did `cd ghc/testsuite/tests/ghci > && make THREADS=8` and the following error ensued: > > {{{#!shell > =====> T1914(ghci) 102 of 271 [0, 0, 0] > cd "scripts/T1914.run" && HC="/Users/julian/code/haskell/ghc/inplace/test > spaces/ghc-stage2" HC_OPTS="-dcore-lint -dcmm-lint -no-user-package-db > -rtsopts -fno-warn-missed-specialisations -fshow-warning-groups > -fdiagnostics-color=never -fno-diagnostics-show-caret -dno-debug-output " > "/Users/julian/code/haskell/ghc/inplace/test spaces/ghc-stage2" > --interactive -v0 -ignore-dot-ghci -fno-ghci-history +RTS -I0.1 -RTS > -fghci-leak-check -dcore-lint -dcmm-lint -no-user-package-db -rtsopts > -fno-warn-missed-specialisations -fshow-warning-groups -fdiagnostics- > color=never -fno-diagnostics-show-caret -dno-debug-output < > T1914.script > Actual stderr output differs from expected: > diff -uw "/dev/null" "scripts/ghci063.run/ghci063.run.stderr.normalised" > --- /dev/null 2018-09-12 23:42:18.000000000 +1000 > +++ scripts/ghci063.run/ghci063.run.stderr.normalised 2018-09-12 > 23:42:20.000000000 +1000 > @@ -0,0 +1,2 @@ > + > +B.hs:1:1: parse error on input ‘***’ > *** unexpected failure for ghci063(ghci) > }}} New description: Git sha is ce23451c2c771bfbbac27ce63c5fdccc7ed02b3b (version 8.7, I believe - the latest as at day before yesterday) ran tests on MacBook Pro (15-inch, 2017 - MacBookPro14,3) with 3.1Ghz Intel Core i7 16GB RAM, 4 Cores. OS X 10.13.6. First run through of tests ever for me. Did `cd ghc/testsuite/tests/ghci && make THREADS=8` and the following error ensued: {{{#!shell =====> T1914(ghci) 102 of 271 [0, 0, 0] cd "scripts/T1914.run" && HC="/Users/julian/code/haskell/ghc/inplace/test spaces/ghc-stage2" HC_OPTS="-dcore-lint -dcmm-lint -no-user-package-db -rtsopts -fno-warn-missed-specialisations -fshow-warning-groups -fdiagnostics-color=never -fno-diagnostics-show-caret -dno-debug-output " "/Users/julian/code/haskell/ghc/inplace/test spaces/ghc-stage2" --interactive -v0 -ignore-dot-ghci -fno-ghci-history +RTS -I0.1 -RTS -fghci-leak-check -dcore-lint -dcmm-lint -no-user-package-db -rtsopts -fno-warn-missed-specialisations -fshow-warning-groups -fdiagnostics- color=never -fno-diagnostics-show-caret -dno-debug-output < T1914.script Actual stderr output differs from expected: diff -uw "/dev/null" "scripts/ghci063.run/ghci063.run.stderr.normalised" --- /dev/null 2018-09-12 23:42:18.000000000 +1000 +++ scripts/ghci063.run/ghci063.run.stderr.normalised 2018-09-12 23:42:20.000000000 +1000 @@ -0,0 +1,2 @@ + +B.hs:1:1: parse error on input ‘***’ *** unexpected failure for ghci063(ghci) }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 03:02:47 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 03:02:47 -0000 Subject: [GHC] #15643: Test Suite Unexpected failure for ghci063(ghci) (was: Test Suite Fails for GHCI) In-Reply-To: <053.26dfce1f7866bd4d0d5d9f9f2a3a61f7@haskell.org> References: <053.26dfce1f7866bd4d0d5d9f9f2a3a61f7@haskell.org> Message-ID: <068.bab4878f7e373b335b2ed20ced061bdd@haskell.org> #15643: Test Suite Unexpected failure for ghci063(ghci) -----------------------------------+----------------------------------- Reporter: JulianLeviston | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Test Suite | Version: Resolution: | Keywords: Operating System: MacOS X | Architecture: x86 Type of failure: Other | Test Case: T1914(ghci) Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -----------------------------------+----------------------------------- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 03:11:24 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 03:11:24 -0000 Subject: [GHC] #15644: Test Suite Unexpected failure for ghci062(ghci-ext) Message-ID: <053.c6556507f602e7872026b4975902cf7e@haskell.org> #15644: Test Suite Unexpected failure for ghci062(ghci-ext) -----------------------------------------+---------------------------- Reporter: JulianLeviston | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Test Suite | Version: Keywords: | Operating System: MacOS X Architecture: x86 | Type of failure: Other Test Case: ghci062(ghci-ext) | Blocked By: Blocking: | Related Tickets: 15643 Differential Rev(s): | Wiki Page: -----------------------------------------+---------------------------- Testing on MacOS X 10.13.6 MacBook (Retina, 12-inch, 2017) 1.4GHz i7 1 processor, 2 cores git sha is d36b1ffac9960db70043aaab43c931ce217912ba Ran `cd ghc/testsuite/tests/ghci` then `make test THREADS=2` The erroring output is as follows (snipped): {{{#!shell =====> ghci063(ghci) 99 of 271 [0, 1, 2] cd "scripts/ghci063.run" && HC="/Users/julianleviston/code/haskell/ghc/inplace/test spaces/ghc- stage2" HC_OPTS="-dcore-lint -dcmm-lint -no-user-package-db -rtsopts -fno- warn-missed-specialisations -fshow-warning-groups -fdiagnostics- color=never -fno-diagnostics-show-caret -dno-debug-output " "/Users/julianleviston/code/haskell/ghc/inplace/test spaces/ghc-stage2" --interactive -v0 -ignore-dot-ghci -fno-ghci-history +RTS -I0.1 -RTS -fghci-leak-check -dcore-lint -dcmm-lint -no-user-package-db -rtsopts -fno-warn-missed-specialisations -fshow-warning-groups -fdiagnostics- color=never -fno-diagnostics-show-caret -dno-debug-output < ghci063.script =====> ghci062(ghci-ext) 99 of 271 [0, 1, 2] cd "scripts/ghci062.run" && HC="/Users/julianleviston/code/haskell/ghc/inplace/test spaces/ghc- stage2" HC_OPTS="-dcore-lint -dcmm-lint -no-user-package-db -rtsopts -fno- warn-missed-specialisations -fshow-warning-groups -fdiagnostics- color=never -fno-diagnostics-show-caret -dno-debug-output " "/Users/julianleviston/code/haskell/ghc/inplace/test spaces/ghc-stage2" --interactive -v0 -ignore-dot-ghci -fno-ghci-history -fexternal- interpreter +RTS -I0.1 -RTS -dcore-lint -dcmm-lint -no-user-package-db -rtsopts -fno-warn-missed-specialisations -fshow-warning-groups -fdiagnostics-color=never -fno-diagnostics-show-caret -dno-debug-output < ghci062.script Actual stderr output differs from expected: diff -uw "/dev/null" "scripts/ghci063.run/ghci063.run.stderr.normalised" --- /dev/null 2018-09-12 23:13:35.000000000 +1000 +++ scripts/ghci063.run/ghci063.run.stderr.normalised 2018-09-12 23:13:39.000000000 +1000 @@ -0,0 +1,2 @@ + +B.hs:1:1: parse error on input ‘***’ *** unexpected failure for ghci063(ghci) =====> T2452(ghci) 100 of 271 [0, 2, 2] cd "scripts/T2452.run" && HC="/Users/julianleviston/code/haskell/ghc/inplace/test spaces/ghc- stage2" HC_OPTS="-dcore-lint -dcmm-lint -no-user-package-db -rtsopts -fno- warn-missed-specialisations -fshow-warning-groups -fdiagnostics- color=never -fno-diagnostics-show-caret -dno-debug-output " "/Users/julianleviston/code/haskell/ghc/inplace/test spaces/ghc-stage2" --interactive -v0 -ignore-dot-ghci -fno-ghci-history +RTS -I0.1 -RTS -fghci-leak-check -dcore-lint -dcmm-lint -no-user-package-db -rtsopts -fno-warn-missed-specialisations -fshow-warning-groups -fdiagnostics- color=never -fno-diagnostics-show-caret -dno-debug-output < T2452.script Wrong exit code for ghci062(ghci-ext)(expected 0 , actual 1 ) Stderr ( ghci062 ): ghc-iserv.bin: lookupSymbol failed in relocateSection (RELOC_GOT) /Users/julianleviston/code/haskell/ghc/libraries/integer-gmp/dist- install/build/HSinteger-gmp-1.0.2.0.o: unknown symbol `___gmp_rands' ghc-stage2: unable to load package `integer-gmp-1.0.2.0' *** unexpected failure for ghci062(ghci-ext) }}} Note, two errors occurred but I've created an error report for ghci063 in another ticket (#15643) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 03:15:34 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 03:15:34 -0000 Subject: [GHC] #15642: Improve the worst case performance of weak pointers In-Reply-To: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> References: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> Message-ID: <060.2b58966f990669aed7ef90e22ad96ffb@haskell.org> #15642: Improve the worst case performance of weak pointers -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.8.1 Component: Runtime System | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): One more challenge: if many `Weak#`s are attached to the same key, we still need to be able to remove them from the hash table quickly in case of early finalization. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 07:05:00 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 07:05:00 -0000 Subject: [GHC] #15642: Improve the worst case performance of weak pointers In-Reply-To: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> References: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> Message-ID: <060.e2ff696967fb7755dcacd8177c249834@haskell.org> #15642: Improve the worst case performance of weak pointers -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.8.1 Component: Runtime System | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): Somehow marking keys and being able map keys to weaks would be nice. As you say the mapping should be able to map a key to multiple weaks because an object may be key to multiple weaks. Out of curiosity, did you measure how long weak collection takes? I'd guess because we scan all weaks in collected gens repeatedly (until we stop evacuating things) the worst case performance (when we have a ton of weaks) would be pretty bad, but I haven't benchmarked this case myself. > This is the weakest link: if we don't have a spare bit there, or don't want > to use one, then I think this whole idea is sunk. I think in theory it is possible to use a bit in info pointer. We already do this to create forwarding pointers in GC, we could use a different bit to indicate that the objects is a weak key. This however requires changes in mutator code as mutators will have to untag info ptr before entering (in addition to untagging the pointer to the object itself in some cases). That's probably not great as we end up generating more code and probably making things slightly slower (one more instruction to enter -- not sure if measurable difference though) to be able to collect weaks faster, and a lot of programs don't have a lot of weaks. I wonder how other languages with weaks (Python, Java, Lua ...) do this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 07:06:46 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 07:06:46 -0000 Subject: [GHC] #15642: Improve the worst case performance of weak pointers In-Reply-To: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> References: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> Message-ID: <060.51db5cd1dc9fddeed709352e08df6e11@haskell.org> #15642: Improve the worst case performance of weak pointers -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.8.1 Component: Runtime System | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * cc: osa1 (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 07:44:27 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 07:44:27 -0000 Subject: [GHC] #15640: Add "difficulty" field to tickets In-Reply-To: <046.4bd78d6f7ffaa04b2adf78d5009291f9@haskell.org> References: <046.4bd78d6f7ffaa04b2adf78d5009291f9@haskell.org> Message-ID: <061.0ada529013827a7f35a53b09471dfc25@haskell.org> #15640: Add "difficulty" field to tickets -------------------------------------+----------------------------- Reporter: flip101 | Owner: hvr Type: feature request | Status: new Priority: normal | Milestone: Component: Trac & Git | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Other Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+----------------------------- Comment (by osa1): I 100% support this. I'm currently trying to contribute to another compiler (just to get a taste of it after about 4 years of GHC work) and one of the things I do is to filter "easy" tickets and pick one from there. Most of them are actually almost objectively easy, so while the "subjectivity" is a problem I think that's not a too serious one. I think most of the time an experienced GHC hacker could guess difficulty of a ticket quite accurately. > Can be welcoming to newcomers who want to contribute to GHC to start with tickets with low priority. The new field should be searchable so they can get a list of all tickets with low difficulty One of the things we should stop doing is fixing easy problems ourselves instead of marking tickets as "easy" (and "newcomers"). I know I sometimes do this and looking at the tickets I see a lot of other cases too. We should let the new contributors do these tickets. Simply enabling the field won't be enough for new contributors if we don't have any such tickets (because they're all fixed by experienced contributors). OTOH some of the simple issues are also quite annoying to the person who discovered it (e.g. a problem in a debug output or an incorrect assertion) so sometimes it's hard to resist the temptation to fix it ourselves. This is especially a problem if it turns out we don't have enough contributors and simple tickets stay unfixed for weeks/months. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 07:54:57 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 07:54:57 -0000 Subject: [GHC] #10833: Use injective type families (decomposition) when dealing with givens In-Reply-To: <048.a87fa063590f3f8feefba56badb8ff21@haskell.org> References: <048.a87fa063590f3f8feefba56badb8ff21@haskell.org> Message-ID: <063.a42d10913aa05ec5bdc058a3114b206b@haskell.org> #10833: Use injective type families (decomposition) when dealing with givens -------------------------------------+------------------------------------- Reporter: jstolarek | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.10.2 checker) | Keywords: TypeFamilies, Resolution: | InjectiveFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #6018, #11511, | Differential Rev(s): #12199 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by infinity0): Just ran into this trying to implement a type-level fmap over a GADT-based HList, mniip on IRC helped to explain that the error was another variant of this bug: {{{#!haskell {-# LANGUAGE DataKinds , GADTs , ScopedTypeVariables , TypeFamilies , TypeFamilyDependencies , TypeOperators #-} data HList xs where HNil :: HList '[] (:::) :: a -> HList as -> HList (a ': as) infixr 6 ::: type family FMapLoad r (m :: * -> *) (xs :: [*]) = (xs' :: [*]) | xs' -> xs where FMapLoad r m '[] = '[] FMapLoad r m (x ': xs) = (r -> m x) ': FMapLoad r m xs sequenceLoad :: forall r m hlist. Monad m => HList (FMapLoad r m hlist) -> [r] -> m (HList hlist) sequenceLoad fs rs = case (fs, rs) of (HNil, []) -> return HNil (HNil, _ ) -> error "xxx" (_, []) -> error "xxx" (f:::fs, r:rs) -> do a <- f r (a :::) <$> sequenceLoad fs rs main :: IO () main = do return () }}} gives for example the error: {{{ • Could not deduce: hlist ~ '[] from the context: FMapLoad r m hlist ~ '[] bound by a pattern with constructor: HNil :: HList '[], }}} even though `FMapLoad` is injective. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 08:00:24 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 08:00:24 -0000 Subject: [GHC] #15621: Error message involving type families points to wrong location In-Reply-To: <050.f6fd8f38eae3af90b1d1147a0e35ac2c@haskell.org> References: <050.f6fd8f38eae3af90b1d1147a0e35ac2c@haskell.org> Message-ID: <065.0ca19212fc9676dd1239e4166ccb6ba4@haskell.org> #15621: Error message involving type families points to wrong location -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.4.3 checker) | Resolution: | Keywords: TypeFamilies Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > The solution to #14185 improves the status quo, but only by a lucky coincidence (that the problems in both tickets stem from two different functions) NO, as I say in comment:7, each type signature makes a new implication constraint, so that'll keep their constraints separate. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 08:05:49 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 08:05:49 -0000 Subject: [GHC] #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings Message-ID: <051.1afac0be4b689267d905f3e66b5a2d7d@haskell.org> #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 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: -------------------------------------+------------------------------------- Using GHC 8.4.3, I'd expect the following to work: {{{#!hs {-# LANGUAGE RebindableSyntax, OverloadedStrings #-} module Fail where import Prelude hiding (fail) foo x = do Just y <- x return y newtype Text = Text String fail :: Text -> a fail (Text x) = error x fromString :: String -> Text fromString = Text }}} But it fails with: {{{ Fail.hs:8:5-15: error: * Couldn't match expected type `[Char]' with actual type `Text' * In a stmt of a 'do' block: Just y <- x In the expression: do Just y <- x return y In an equation for `foo': foo x = do Just y <- x return y | 8 | Just y <- x | ^^^^^^^^^^^ }}} Given the enabled extensions, I'd expect {{{foo}}} to desugar as: {{{#!hs foo x = x >>= \v -> case v of Just y -> return y _ -> fail (fromString "pattern match error") }}} But looking at TcMatches.tcMonadFailOp it checks the fail operation (which is literally {{{fail}}}) takes an argument of type tyString (e.g. {{{[Char]}}}). One way around that would be to make the "fail-op" being passed around be {{{fail . fromString}}} if the appropriate extensions are enabled. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 08:13:58 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 08:13:58 -0000 Subject: [GHC] #15642: Improve the worst case performance of weak pointers In-Reply-To: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> References: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> Message-ID: <060.6df4c97ffa4fe4ef52356fb918b93e63@haskell.org> #15642: Improve the worst case performance of weak pointers -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.8.1 Component: Runtime System | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonmar): Taking a bit in the info pointer for this seems like a very high cost. We only have one spare bit (on 32-bit), and furthermore using that bit has a runtime cost because we'd have to mask it everywhere. Doesn't seem worth it to me. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 08:23:13 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 08:23:13 -0000 Subject: [GHC] #10833: Use injective type families (decomposition) when dealing with givens In-Reply-To: <048.a87fa063590f3f8feefba56badb8ff21@haskell.org> References: <048.a87fa063590f3f8feefba56badb8ff21@haskell.org> Message-ID: <063.13e746cf22bb3b3c91c97fcf39d4a836@haskell.org> #10833: Use injective type families (decomposition) when dealing with givens -------------------------------------+------------------------------------- Reporter: jstolarek | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 7.10.2 checker) | Keywords: TypeFamilies, Resolution: | InjectiveFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #6018, #11511, | Differential Rev(s): #12199 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > Implementing this requires changing Core. A good step would be to write down exactly the changes required. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 08:26:33 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 08:26:33 -0000 Subject: [GHC] #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings In-Reply-To: <051.1afac0be4b689267d905f3e66b5a2d7d@haskell.org> References: <051.1afac0be4b689267d905f3e66b5a2d7d@haskell.org> Message-ID: <066.075c7e3fc9af6db7f15e9f8d7772385c@haskell.org> #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by simonpj): Could be. But would it not be simpler for you to provide a `fail` with type `String -> m a`? It's not hard to do! I'm not seeing a strong motivation for doing this in the compiler. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 08:45:06 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 08:45:06 -0000 Subject: [GHC] #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings In-Reply-To: <051.1afac0be4b689267d905f3e66b5a2d7d@haskell.org> References: <051.1afac0be4b689267d905f3e66b5a2d7d@haskell.org> Message-ID: <066.7ad32ce756e0eaa05710fbe42e57efdc@haskell.org> #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by NeilMitchell): The use case is for `Prelude` replacement modules that seek to switch the type of `[Char]` to something like `Text`. A standard way is to define your own `Monad`/`MonadFail` class which has `fail :: Text -> m a` in it. If that class is forced to have `fail :: [Char] -> m a` instead (as it is now) then all your users have to implement a function working on `[Char]`, even though for everything else in your custom library, they never see `[Char]` and your custom `Prelude` has no other `[Char]` related functions. In the particular example I'm working on, the `Char` type has been eliminated entirely, aside from the `fail` function. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 08:57:48 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 08:57:48 -0000 Subject: [GHC] #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings In-Reply-To: <051.1afac0be4b689267d905f3e66b5a2d7d@haskell.org> References: <051.1afac0be4b689267d905f3e66b5a2d7d@haskell.org> Message-ID: <066.1059d77efdc1f87c0d9beb73bc583dd6@haskell.org> #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by simonpj): But all you have to do is define `fail = myFail . fromString` and you are done. I suppose you are going to say that you don't want two variants of `fail` in scope. That is a bit more convincing. But now you may get new mysterious messages about missing `IsString` instances arising from invisible code. Make a GHC proposal! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 09:15:57 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 09:15:57 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number Message-ID: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Keywords: type | Operating System: Unknown/Multiple Architecture: | Type of failure: Compile-time Unknown/Multiple | performance bug Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- {{{ :t 1e123456789 }}} takes more than 3 seconds to get the type info. {{{ :t 1e1234111111111111111111111 }}} shows a warning/error, {{{ GNU MP: Cannot allocate memory (size=93978265) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 09:32:48 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 09:32:48 -0000 Subject: [GHC] #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings In-Reply-To: <051.1afac0be4b689267d905f3e66b5a2d7d@haskell.org> References: <051.1afac0be4b689267d905f3e66b5a2d7d@haskell.org> Message-ID: <066.a0c8e2ad63cd196efdda5a0425b3e5a2@haskell.org> #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by NeilMitchell): Indeed, you can't use the name fail, which is unfortunate. The mysterious messages about things already happens - I get an error about `[Char]` vs `Text` - so the `IsString` thing is just the same consequence. I'd view this as a bug fix (overloaded strings should imply even generated strings are overloaded, if they are passed to user-controlled functions), but happy to go through GHC proposal process. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 09:32:55 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 09:32:55 -0000 Subject: [GHC] #2207: Load the interface details for GHC.* even without -O In-Reply-To: <046.c160dd85a0a0b0a47d62c75151b28378@haskell.org> References: <046.c160dd85a0a0b0a47d62c75151b28378@haskell.org> Message-ID: <061.661027600ec58d5dc7afec24cf0f86ea@haskell.org> #2207: Load the interface details for GHC.* even without -O -------------------------------------+------------------------------------- Reporter: simonpj | Owner: Azel Type: feature request | Status: new Priority: normal | Milestone: ⊥ Component: Compiler | Version: 6.8.2 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * keywords: newcomers => newcomer -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 09:33:47 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 09:33:47 -0000 Subject: [GHC] #10700: include/stg/Prim.h isn't C++ compatible In-Reply-To: <045.8e82f2e96f7b839c9a73a7c13e4442bc@haskell.org> References: <045.8e82f2e96f7b839c9a73a7c13e4442bc@haskell.org> Message-ID: <060.b5f6ecdc8c026c063ef45d3ce41dc27e@haskell.org> #10700: include/stg/Prim.h isn't C++ compatible -------------------------------------+------------------------------------- Reporter: Fabian | Owner: rasen Type: bug | Status: closed Priority: normal | Milestone: 7.10.3 Component: Compiler (FFI) | Version: 7.10.1 Resolution: fixed | Keywords: FFI, newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D1107 Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * keywords: FFI, newcomers => FFI, newcomer -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 09:34:06 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 09:34:06 -0000 Subject: [GHC] #11143: Feature request: Add index/read/write primops with byte offset for ByteArray# In-Reply-To: <048.a76989facca9d2ef0c59d6b7bfd86029@haskell.org> References: <048.a76989facca9d2ef0c59d6b7bfd86029@haskell.org> Message-ID: <063.0a85c0b079d94ba9f48b234793af6340@haskell.org> #11143: Feature request: Add index/read/write primops with byte offset for ByteArray# -------------------------------------+------------------------------------- Reporter: vagarenko | Owner: sjakobi Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.2 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #4442 | Differential Rev(s): Phab:D4433 Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * keywords: newcomers => newcomer -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 09:34:29 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 09:34:29 -0000 Subject: [GHC] #13362: GHC first generation of GC to be as large as largest cache size by default In-Reply-To: <045.9df30bf1acd19df01317b133116e51f6@haskell.org> References: <045.9df30bf1acd19df01317b133116e51f6@haskell.org> Message-ID: <060.4534891074e559bf28991c2d382d85d5@haskell.org> #13362: GHC first generation of GC to be as large as largest cache size by default -------------------------------------+------------------------------------- Reporter: varosi | Owner: (none) Type: feature request | Status: patch Priority: normal | Milestone: 8.8.1 Component: Runtime System | Version: 8.0.2 Resolution: | Keywords: numa cache gc | newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4679 Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * keywords: numa cache gc newcomers => numa cache gc newcomer -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 09:34:43 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 09:34:43 -0000 Subject: [GHC] #14099: Document fundeps In-Reply-To: <046.b800e01a492248ea0ae803c458700394@haskell.org> References: <046.b800e01a492248ea0ae803c458700394@haskell.org> Message-ID: <061.2cc71598a1e7100079757b25135d4981@haskell.org> #14099: Document fundeps -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Documentation | Version: 8.2.1 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13657 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * keywords: newcomers => newcomer -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 09:34:53 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 09:34:53 -0000 Subject: [GHC] #14711: Machine readable output of coverage In-Reply-To: <050.d858ad27520ca4b1ee3c013a327a8c68@haskell.org> References: <050.d858ad27520ca4b1ee3c013a327a8c68@haskell.org> Message-ID: <065.1328045c68d3fe4875bf9080f10c415f@haskell.org> #14711: Machine readable output of coverage -------------------------------------+------------------------------------- Reporter: Koterpillar | Owner: jproyo Type: feature request | Status: patch Priority: normal | Milestone: Component: Code Coverage | Version: 8.2.2 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4522 Wiki Page: | Phab:D4523 Phab:D4524 -------------------------------------+------------------------------------- Changes (by monoidal): * keywords: newcomers => newcomer -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 09:35:01 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 09:35:01 -0000 Subject: [GHC] #14229: Contraditions in users_guide/using-warnings.html In-Reply-To: <054.d6f9d16cc1b1fa988ffa9396c0d0581c@haskell.org> References: <054.d6f9d16cc1b1fa988ffa9396c0d0581c@haskell.org> Message-ID: <069.6f24fb1ac3915beb3f667c6c9cb5d6f6@haskell.org> #14229: Contraditions in users_guide/using-warnings.html -------------------------------------+------------------------------------- Reporter: MikolajKonarski | Owner: voanhduy1512 Type: bug | Status: new Priority: low | Milestone: Component: Documentation | Version: 8.2.1 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Documentation | Unknown/Multiple bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4528, Wiki Page: | Phab:D4562 -------------------------------------+------------------------------------- Changes (by monoidal): * keywords: newcomers => newcomer -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 09:42:48 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 09:42:48 -0000 Subject: [GHC] #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings In-Reply-To: <051.1afac0be4b689267d905f3e66b5a2d7d@haskell.org> References: <051.1afac0be4b689267d905f3e66b5a2d7d@haskell.org> Message-ID: <066.3f7f3755b71d1be2f80f3857c07ac83b@haskell.org> #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by simonpj): > I'd view this as a bug fix (overloaded strings should imply even generated strings are overloaded, if they are passed to user-controlled functions), but happy to go through GHC proposal process. Ah, now that is a much solider point! Thanks. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 09:50:40 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 09:50:40 -0000 Subject: =?utf-8?b?UmU6IFtHSENdICMxNDMxMzog4oCcUmVzdWx0IHNpZ25hdHVyZXMg?= =?utf-8?q?are_no_longer_supported_in_pattern_matches=E2=80=9D_lo?= =?utf-8?q?st?= In-Reply-To: <046.f81b72f51154afa43f3605001c35a3f2@haskell.org> References: <046.f81b72f51154afa43f3605001c35a3f2@haskell.org> Message-ID: <061.62553250fc77583a8cc20fee37489561@haskell.org> #14313: “Result signatures are no longer supported in pattern matches” lost -------------------------------------+------------------------------------- Reporter: nomeata | Owner: nomeata Type: task | Status: closed Priority: low | Milestone: Component: Compiler | Version: 8.2.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #2310 | Differential Rev(s): Phab:D4066 Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: patch => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 09:58:36 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 09:58:36 -0000 Subject: [GHC] #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings In-Reply-To: <051.1afac0be4b689267d905f3e66b5a2d7d@haskell.org> References: <051.1afac0be4b689267d905f3e66b5a2d7d@haskell.org> Message-ID: <066.44d48d026c38dd25cb154e24f4796d6b@haskell.org> #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by NeilMitchell): BTW, I'm happy to get the work done, if there's acceptance that it really is a bug, and what it should do. Implementation notes follow (only read them if we're agreed it is a bug, if not I'll transfer them to a proposal). There's still an open question of whether the `fromString` is injected only when you have `OverloadedStrings` and `RebindableSyntax` (and thus a user-controlled `fail`), or always for `OverloadedStrings` - my view is likely only when both are enabled. This would then be consistent with not desugaring pattern matches to `fromString`, since `patError` isn't user- controlled. My fix would be that `getFailFunction` and `failFunction` in `RnExpr.hs` should be changed so that if `OverloadedStrings` is enabled then the `fail_op` would be `fail . fromString` rather than just `fail` as it is now. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 10:06:32 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 10:06:32 -0000 Subject: [GHC] #15633: Type-checker plugins aren't loaded in GHCi 8.6.1 In-Reply-To: <045.8bcaa0505fc8b553b9837a1fc9146bf4@haskell.org> References: <045.8bcaa0505fc8b553b9837a1fc9146bf4@haskell.org> Message-ID: <060.c367f2af60c467986cb4974a3b29698f@haskell.org> #15633: Type-checker plugins aren't loaded in GHCi 8.6.1 -------------------------------------+------------------------------------- Reporter: phadej | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by darchon): To elaborate further Loading: {{{ {-# LANGUAGE DataKinds, TypeOperators #-} module Test where import Data.Proxy import GHC.TypeLits p1 :: Proxy a -> Proxy b -> Proxy (a + b) -> Proxy (b + a) p1 _ _ = id }}} without the normalisation plugin gives: {{{ $ ghci Test.hs GHCi, version 8.6.0.20180907: http://www.haskell.org/ghc/ :? for help Loaded package environment from /home/christiaan/devel/clash-compiler /clash-prelude/.ghc.environment.x86_64-linux-8.6.0.20180907 [1 of 1] Compiling Test ( Test.hs, interpreted ) Test.hs:8:10: error: • Couldn't match type ‘a + b’ with ‘b + a’ Expected type: Proxy (a + b) -> Proxy (b + a) Actual type: Proxy (b + a) -> Proxy (b + a) NB: ‘+’ is a non-injective type family • In the expression: id In an equation for ‘p1’: p1 _ _ = id • Relevant bindings include p1 :: Proxy a -> Proxy b -> Proxy (a + b) -> Proxy (b + a) (bound at Test.hs:8:1) | 8 | p1 _ _ = id | ^^ Failed, no modules loaded. }}} and of course with the normalisation plugin gives: {{{ $ ghci -fplugin=GHC.TypeLits.Normalise Test.hs GHCi, version 8.6.0.20180907: http://www.haskell.org/ghc/ :? for help Loaded package environment from /home/christiaan/devel/clash-compiler /clash-prelude/.ghc.environment.x86_64-linux-8.6.0.20180907 [1 of 1] Compiling Test ( Test.hs, interpreted ) Ok, one module loaded. *Test> }}} However, the following session in GHCi doesn't seem to work: {{{ $ ghci -fplugin=GHC.TypeLits.Normalise -XDataKinds -XTypeOperators GHCi, version 8.6.0.20180907: http://www.haskell.org/ghc/ :? for help Loaded package environment from /home/christiaan/devel/clash-compiler /clash-prelude/.ghc.environment.x86_64-linux-8.6.0.20180907 Prelude> import Data.Proxy Prelude Data.Proxy> import GHC.TypeLits Prelude Data.Proxy GHC.TypeLits> :{ Prelude Data.Proxy GHC.TypeLits| p1 :: Proxy a -> Proxy b -> Proxy (a + b) -> Proxy (b + a) Prelude Data.Proxy GHC.TypeLits| p1 _ _ = id Prelude Data.Proxy GHC.TypeLits| :} :5:10: error: • Couldn't match type ‘a + b’ with ‘b + a’ Expected type: Proxy (a + b) -> Proxy (b + a) Actual type: Proxy (b + a) -> Proxy (b + a) NB: ‘+’ is a non-injective type family • In the expression: id In an equation for ‘p1’: p1 _ _ = id • Relevant bindings include p1 :: Proxy a -> Proxy b -> Proxy (a + b) -> Proxy (b + a) (bound at :5:1) Prelude Data.Proxy GHC.TypeLits> }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 10:08:44 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 10:08:44 -0000 Subject: [GHC] #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings In-Reply-To: <051.1afac0be4b689267d905f3e66b5a2d7d@haskell.org> References: <051.1afac0be4b689267d905f3e66b5a2d7d@haskell.org> Message-ID: <066.21c51fa458cdb23b77a763307cb95d2a@haskell.org> #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by simonpj): The notes look ok to me. I do think a (small) proposal is the right way to proceed. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 10:17:14 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 10:17:14 -0000 Subject: [GHC] #15633: Type-checker plugins aren't loaded in GHCi 8.6.1 In-Reply-To: <045.8bcaa0505fc8b553b9837a1fc9146bf4@haskell.org> References: <045.8bcaa0505fc8b553b9837a1fc9146bf4@haskell.org> Message-ID: <060.b6b5c2a7032b8c34f5b54d3b19f4533c@haskell.org> #15633: Type-checker plugins aren't loaded in GHCi 8.6.1 -------------------------------------+------------------------------------- Reporter: phadej | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by darchon): Possibly, the GHCi session is missing a call to `initializePlugins` https://github.com/ghc/ghc/blob/52065e95c6df89d0048c6e3f35d6cc26ce8246f9/compiler/main/DynamicLoading.hs#L78? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 10:27:00 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 10:27:00 -0000 Subject: [GHC] #15639: Surprising failure combining QuantifiedConstraints with Coercible In-Reply-To: <045.f2a49699aa20c0c2dd0e1c77d1b17a24@haskell.org> References: <045.f2a49699aa20c0c2dd0e1c77d1b17a24@haskell.org> Message-ID: <060.4c9ee520556a4339bc3609d734b5ac89@haskell.org> #15639: Surprising failure combining QuantifiedConstraints with Coercible -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.5 checker) | Keywords: Resolution: | QuantifiedConstraints 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: | -------------------------------------+------------------------------------- Comment (by simonpj): Can you explain more about this example? I think that it is important that * You give a role signature for `Yeah`. (What is the inferred signature?) * You export the type constructor for `Yeah` but not the data constructor. But I'm a bit lost about what you expect to happen. Can you amplify? Why do you think it should typecheck? It'd probably help to give the declaration for `Coercion` too, for those of us who do not use it daily. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 10:35:42 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 10:35:42 -0000 Subject: [GHC] #15633: Type-checker plugins aren't loaded in GHCi 8.6.1 In-Reply-To: <045.8bcaa0505fc8b553b9837a1fc9146bf4@haskell.org> References: <045.8bcaa0505fc8b553b9837a1fc9146bf4@haskell.org> Message-ID: <060.d25bdfeff02cd0c92872c02374e9e8e6@haskell.org> #15633: Type-checker plugins aren't loaded in GHCi 8.6.1 -------------------------------------+------------------------------------- Reporter: phadej | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by mpickering): I think that is the problem. I don't know off the top of my head where the call needs to be inserted. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 11:30:02 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 11:30:02 -0000 Subject: [GHC] #1262: RecursiveDo in Template Haskell In-Reply-To: <062.2857e038d8ba06eaa6e83d19ada8ff7e@haskell.org> References: <062.2857e038d8ba06eaa6e83d19ada8ff7e@haskell.org> Message-ID: <077.5bc0d1f79e2e1edc8f4a0785b6a29279@haskell.org> #1262: RecursiveDo in Template Haskell -------------------------------------+------------------------------------- Reporter: philip.weaver@… | Owner: mgsloan Type: feature request | Status: patch Priority: normal | Milestone: ⊥ Component: Template Haskell | Version: 6.6 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | th/TH_recursiveDo Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D1979 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Krzysztof Gogolewski ): In [changeset:"9c6b7493db24977595b17046e15baf76638b5317/ghc" 9c6b7493/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="9c6b7493db24977595b17046e15baf76638b5317" Add support for ImplicitParams and RecursiveDo in TH Summary: This adds TH support for the ImplicitParams and RecursiveDo extensions. I'm submitting this as one review because I cannot cleanly make the two commits independent. Initially, my goal was just to add ImplicitParams support, and I found that reasonably straightforward, so figured I might as well use my newfound knowledge to address some other TH omissions. Test Plan: Validate Reviewers: goldfire, austin, bgamari, RyanGlScott Reviewed By: RyanGlScott Subscribers: carter, RyanGlScott, thomie GHC Trac Issues: #1262 Differential Revision: https://phabricator.haskell.org/D1979 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 11:31:20 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 11:31:20 -0000 Subject: [GHC] #1262: RecursiveDo in Template Haskell In-Reply-To: <062.2857e038d8ba06eaa6e83d19ada8ff7e@haskell.org> References: <062.2857e038d8ba06eaa6e83d19ada8ff7e@haskell.org> Message-ID: <077.23be58377d8bddedc8f4cc9a707e1e02@haskell.org> #1262: RecursiveDo in Template Haskell -------------------------------------+------------------------------------- Reporter: philip.weaver@… | Owner: mgsloan Type: feature request | Status: closed Priority: normal | Milestone: ⊥ Component: Template Haskell | Version: 6.6 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | th/TH_recursiveDo Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D1979 Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: patch => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 11:41:34 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 11:41:34 -0000 Subject: [GHC] #15502: -ddump-splices truncates Integer literals to Int literals In-Reply-To: <047.99c2e69e35ad36d7625dca8406cf953c@haskell.org> References: <047.99c2e69e35ad36d7625dca8406cf953c@haskell.org> Message-ID: <062.9a561a3e9ab5ee92f6d432a68d362439@haskell.org> #15502: -ddump-splices truncates Integer literals to Int literals -------------------------------------+------------------------------------- Reporter: ChaiTRex | Owner: (none) Type: bug | Status: merge Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5089, Wiki Page: | Phab:D5151 -------------------------------------+------------------------------------- Changes (by monoidal): * differential: Phab:D5089 => Phab:D5089, Phab:D5151 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 12:03:32 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 12:03:32 -0000 Subject: [GHC] #15484: MultiLayerModules and T13701 timeout on i386 Linux In-Reply-To: <046.f49e8907dc2fd082faa408fb71333802@haskell.org> References: <046.f49e8907dc2fd082faa408fb71333802@haskell.org> Message-ID: <061.d6d34b0a4ea91c328ea5145dfdbc7fec@haskell.org> #15484: MultiLayerModules and T13701 timeout on i386 Linux -------------------------------------+------------------------------------- Reporter: bgamari | Owner: alpmestan Type: bug | Status: patch Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5103 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Krzysztof Gogolewski ): In [changeset:"3040444d3a00a3088a67e82d7f81af47f8653609/ghc" 3040444/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="3040444d3a00a3088a67e82d7f81af47f8653609" tests: increase (compile) timeout multiplier for T13701 and MultiLayerModules Summary: Those tests are currently making our i386 validation fail on CircleCI: https://circleci.com/gh/ghc/ghc/8827 Test Plan: Using my Phab<->CircleCI bridge to run i386 validation for this diff. Reviewers: bgamari, monoidal Reviewed By: monoidal Subscribers: rwbarton, carter GHC Trac Issues: #15484, #15383 Differential Revision: https://phabricator.haskell.org/D5103 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 12:03:32 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 12:03:32 -0000 Subject: [GHC] #15383: T3171 doesn't terminate with Interrupted message on Darwin In-Reply-To: <046.1d648bf17453b21fb35b42043bd02c26@haskell.org> References: <046.1d648bf17453b21fb35b42043bd02c26@haskell.org> Message-ID: <061.e701b5d99233e4540267f77928a0e1c3@haskell.org> #15383: T3171 doesn't terminate with Interrupted message on Darwin ---------------------------------+-------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: MacOS X | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15463 | Differential Rev(s): Wiki Page: | ---------------------------------+-------------------------------------- Comment (by Krzysztof Gogolewski ): In [changeset:"3040444d3a00a3088a67e82d7f81af47f8653609/ghc" 3040444/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="3040444d3a00a3088a67e82d7f81af47f8653609" tests: increase (compile) timeout multiplier for T13701 and MultiLayerModules Summary: Those tests are currently making our i386 validation fail on CircleCI: https://circleci.com/gh/ghc/ghc/8827 Test Plan: Using my Phab<->CircleCI bridge to run i386 validation for this diff. Reviewers: bgamari, monoidal Reviewed By: monoidal Subscribers: rwbarton, carter GHC Trac Issues: #15484, #15383 Differential Revision: https://phabricator.haskell.org/D5103 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 12:22:04 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 12:22:04 -0000 Subject: [GHC] #15497: Coercion Quantification In-Reply-To: <047.3a4a4e067b87a899efdf8c3f044fd1ac@haskell.org> References: <047.3a4a4e067b87a899efdf8c3f044fd1ac@haskell.org> Message-ID: <062.fe5c74a0dad0bfb01cf5bcd6a227ecc2@haskell.org> #15497: Coercion Quantification -------------------------------------+------------------------------------- Reporter: ningning | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5054 Wiki Page: | https://ghc.haskell.org/trac/ghc/wiki/DependentHaskell/Phase2| -------------------------------------+------------------------------------- Changes (by simonpj): * differential: => Phab:D5054 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 12:39:39 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 12:39:39 -0000 Subject: [GHC] #15502: -ddump-splices truncates Integer literals to Int literals In-Reply-To: <047.99c2e69e35ad36d7625dca8406cf953c@haskell.org> References: <047.99c2e69e35ad36d7625dca8406cf953c@haskell.org> Message-ID: <062.552fc30f6fa3721f219b34283c5e4203@haskell.org> #15502: -ddump-splices truncates Integer literals to Int literals -------------------------------------+------------------------------------- Reporter: ChaiTRex | Owner: (none) Type: bug | Status: merge Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5089, Wiki Page: | Phab:D5151 -------------------------------------+------------------------------------- Comment (by Krzysztof Gogolewski ): In [changeset:"ecbe26b6966a3a64f4e22e862370536b1dd4440f/ghc" ecbe26b/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="ecbe26b6966a3a64f4e22e862370536b1dd4440f" Fix T15502 on 32-bit Summary: The expected output uses a hardcoded value for maxBound :: Int. This should fix one of circleci failures on i386. Test Plan: make test TEST=T15502 Reviewers: RyanGlScott, bgamari Reviewed By: RyanGlScott Subscribers: rwbarton, carter GHC Trac Issues: #15502 Differential Revision: https://phabricator.haskell.org/D5151 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 12:49:20 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 12:49:20 -0000 Subject: [GHC] #15642: Improve the worst case performance of weak pointers In-Reply-To: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> References: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> Message-ID: <060.162133e62986179ff0d57bd03d41d126@haskell.org> #15642: Improve the worst case performance of weak pointers -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.8.1 Component: Runtime System | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): A more conservative approach (less cost for less benefit) would be to only build the hash table during the first/second/third round of fixpointing. I'm a bit surprised we can only spare one bit for 32-bit systems. Isn't the tables+code area likely to be much smaller than the address space? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 12:54:33 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 12:54:33 -0000 Subject: [GHC] #15642: Improve the worst case performance of weak pointers In-Reply-To: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> References: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> Message-ID: <060.80ad1242c1db8aa76e77d400615258b4@haskell.org> #15642: Improve the worst case performance of weak pointers -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.8.1 Component: Runtime System | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonmar): > I'm a bit surprised we can only spare one bit for 32-bit systems. Isn't the tables+code area likely to be much smaller than the address space? Not when you have a 2GB binary... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 13:05:56 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 13:05:56 -0000 Subject: [GHC] #15642: Improve the worst case performance of weak pointers In-Reply-To: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> References: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> Message-ID: <060.126074e24eded53b6df7f6b43e60a108@haskell.org> #15642: Improve the worst case performance of weak pointers -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.8.1 Component: Runtime System | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): Yes, I suppose that's not too unreasonable a size. Bleh. Assume for the sake of discussion that the proposed mechanism is only used for 64-bit code. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 13:23:23 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 13:23:23 -0000 Subject: [GHC] #15569: Constant folding optimises 1 into 3 In-Reply-To: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> References: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> Message-ID: <065.b97973a1c4365245c50745687acd16e5@haskell.org> #15569: Constant folding optimises 1 into 3 -------------------------------------+------------------------------------- Reporter: snowleopard | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9136 | Differential Rev(s): Phab:D5109 Wiki Page: | -------------------------------------+------------------------------------- Comment (by jean): @sgraf, I'm interested in the SMT direction. I'm currently looking for a project for my SMT course, and this sounds interesting. Can you point to more resources? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 14:11:15 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 14:11:15 -0000 Subject: [GHC] #15501: Fix unknown symbols/addresses in perf output In-Reply-To: <045.068b84fc1146deb53c7717bbca530550@haskell.org> References: <045.068b84fc1146deb53c7717bbca530550@haskell.org> Message-ID: <060.7f6c7b83c3a2c5527090c41a85365b39@haskell.org> #15501: Fix unknown symbols/addresses in perf output -------------------------------------+------------------------------------- Reporter: last_g | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Research Component: Compiler | needed (CodeGen) | Version: 8.5 Resolution: | Keywords: perf, | symbols, elf, linux Operating System: Linux | Architecture: Type of failure: Debugging | Unknown/Multiple information is incorrect | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): D4713 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Marlow ): In [changeset:"c23f057f1753634e2bc0612969470efea6443031/ghc" c23f057f/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c23f057f1753634e2bc0612969470efea6443031" Mark code related symbols as @function not @object Summary: This diff is a part of the bigger project which goal is to improve common profiling tools support (perf) for GHC binaries. A similar job was already done and reverted in the past: * https://phabricator.haskell.org/rGHCb1f453e16f0ce11a2ab18cc4c350bdcbd36299a6 * https://phabricator.haskell.org/rGHCf1f3c4f50650110ad0f700d6566a44c515b0548f Reasoning: `Perf` and similar tools build in memory symbol table from the .symtab section of the ELF file to display human-readable function names instead of the addresses in the output. `Perf` uses only two types of symbols: `@function` and `@notype` but GHC is not capable to produce any `@function` symbols so the `perf` output is pretty useless (All the haskell symbols that you can see in `perf` now are `@notype` internal symbols extracted by mistake/hack). The changes: * mark code related symbols as @function * small hack to mark InfoTable symbols as code if TABLES_NEXT_TO_CODE is true Limitations: * The perf symbolization support is not complete after this patch but I'm working on the second patch. * Constructor symbols are not supported. To fix that we can issue extra local symbols which mark code sections as code and will be only used for debug. Test Plan: tests any additional ideas? Perf output on stock ghc 8.4.1: ``` 9.78% FibbSlow FibbSlow [.] ckY_info 9.59% FibbSlow FibbSlow [.] cjqd_info 7.17% FibbSlow FibbSlow [.] c3sg_info 6.62% FibbSlow FibbSlow [.] c1X_info 5.32% FibbSlow FibbSlow [.] cjsX_info 4.18% FibbSlow FibbSlow [.] s3rN_info 3.82% FibbSlow FibbSlow [.] c2m_info 3.68% FibbSlow FibbSlow [.] cjlJ_info 3.26% FibbSlow FibbSlow [.] c3sb_info 3.19% FibbSlow FibbSlow [.] cjPQ_info 3.05% FibbSlow FibbSlow [.] cjQd_info 2.97% FibbSlow FibbSlow [.] cjAB_info 2.78% FibbSlow FibbSlow [.] cjzP_info 2.40% FibbSlow FibbSlow [.] cjOS_info 2.38% FibbSlow FibbSlow [.] s3rK_info 2.27% FibbSlow FibbSlow [.] cjq0_info 2.18% FibbSlow FibbSlow [.] cKQ_info 2.13% FibbSlow FibbSlow [.] cjSl_info 1.99% FibbSlow FibbSlow [.] s3rL_info 1.98% FibbSlow FibbSlow [.] c2cC_info 1.80% FibbSlow FibbSlow [.] s3rO_info 1.37% FibbSlow FibbSlow [.] c2f2_info ... ``` Perf output on patched ghc: ``` 7.97% FibbSlow FibbSlow [.] c3rM_info 6.75% FibbSlow FibbSlow [.] 0x000000000032cfa8 6.63% FibbSlow FibbSlow [.] cifA_info 4.98% FibbSlow FibbSlow [.] integerzmgmp_GHCziIntegerziType_eqIntegerzh_info 4.55% FibbSlow FibbSlow [.] chXn_info 4.52% FibbSlow FibbSlow [.] c3rH_info 4.45% FibbSlow FibbSlow [.] chZB_info 4.04% FibbSlow FibbSlow [.] Main_fibbzuslow_info 4.03% FibbSlow FibbSlow [.] stg_ap_0_fast 3.76% FibbSlow FibbSlow [.] chXA_info 3.67% FibbSlow FibbSlow [.] cifu_info 3.25% FibbSlow FibbSlow [.] ci4r_info 2.64% FibbSlow FibbSlow [.] s3rf_info 2.42% FibbSlow FibbSlow [.] s3rg_info 2.39% FibbSlow FibbSlow [.] integerzmgmp_GHCziIntegerziType_eqInteger_info 2.25% FibbSlow FibbSlow [.] integerzmgmp_GHCziIntegerziType_minusInteger_info 2.17% FibbSlow FibbSlow [.] ghczmprim_GHCziClasses_zeze_info 2.09% FibbSlow FibbSlow [.] cicc_info 2.03% FibbSlow FibbSlow [.] 0x0000000000331e15 2.02% FibbSlow FibbSlow [.] s3ri_info 1.91% FibbSlow FibbSlow [.] 0x0000000000331bb8 1.89% FibbSlow FibbSlow [.] ci4N_info ... ``` Reviewers: simonmar, niteria, bgamari, goldfire Reviewed By: simonmar, bgamari Subscribers: lelf, rwbarton, thomie, carter GHC Trac Issues: #15501 Differential Revision: https://phabricator.haskell.org/D4713 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 14:31:08 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 14:31:08 -0000 Subject: [GHC] #4022: GHC Bindist is Broken on FreeBSD/amd64 In-Reply-To: <042.be61d95849398bdf9c05d1a69af1e7e3@haskell.org> References: <042.be61d95849398bdf9c05d1a69af1e7e3@haskell.org> Message-ID: <057.3acbb75e620f06067b819747532ead0a@haskell.org> #4022: GHC Bindist is Broken on FreeBSD/amd64 -------------------------------------+------------------------------------- Reporter: pgj | Owner: pgj Type: bug | Status: new Priority: lowest | Milestone: Component: Core Libraries | Version: 6.13 Resolution: | Keywords: GMP,integer- | gmp, sharedlibs Operating System: FreeBSD | Architecture: x86_64 Type of failure: Building GHC | (amd64) failed | Test Case: Blocked By: | Blocking: Related Tickets: #8156 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by arrowd): Ping? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 15:05:44 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 15:05:44 -0000 Subject: [GHC] #14941: Switching direct type family application to EqPred (~) prevents inlining in code using vector (10x slowdown) In-Reply-To: <042.0e3de7917bdd684aac8357b129fd4898@haskell.org> References: <042.0e3de7917bdd684aac8357b129fd4898@haskell.org> Message-ID: <057.33ee33ddeaec987660d0c3b7169de7d0@haskell.org> #14941: Switching direct type family application to EqPred (~) prevents inlining in code using vector (10x slowdown) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: davide Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by davide): * owner: (none) => davide -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 15:07:52 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 15:07:52 -0000 Subject: [GHC] #15112: ghc 8.4.2 on OS X: clang: warning: argument unused during compilation: '-nopie' In-Reply-To: <047.e2e05ed138c24fadcd4842fa8e08b91d@haskell.org> References: <047.e2e05ed138c24fadcd4842fa8e08b91d@haskell.org> Message-ID: <062.caa8ae11fbe695d263c1febf7a501f9d@haskell.org> #15112: ghc 8.4.2 on OS X: clang: warning: argument unused during compilation: '-nopie' ---------------------------------+---------------------------------------- Reporter: elaforge | Owner: (none) Type: bug | Status: infoneeded Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.2 Resolution: | Keywords: Operating System: MacOS X | Architecture: Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+---------------------------------------- Changes (by George): * status: new => infoneeded -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 15:24:15 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 15:24:15 -0000 Subject: [GHC] #14770: Allow static pointer expressions to have static pointer free variables In-Reply-To: <048.bed690b6ed6632ceb9361aef80b57ffb@haskell.org> References: <048.bed690b6ed6632ceb9361aef80b57ffb@haskell.org> Message-ID: <063.17731565c75f40a9ded698ff62689161@haskell.org> #14770: Allow static pointer expressions to have static pointer free variables -------------------------------------+------------------------------------- Reporter: TheKing01 | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | StaticPointers Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I still want examples of usage! Who needs these extra facilities? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 15:29:29 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 15:29:29 -0000 Subject: [GHC] #12565: unhelpful error message about enabling TypeApplications In-Reply-To: <044.4134d62159643bc95161b319ea8f1a1e@haskell.org> References: <044.4134d62159643bc95161b319ea8f1a1e@haskell.org> Message-ID: <059.15f2895c20c511e6c325d19324100372@haskell.org> #12565: unhelpful error message about enabling TypeApplications -------------------------------------+------------------------------------- Reporter: mauke | Owner: goldfire Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: duplicate | Keywords: | TypeApplications Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: new => closed * resolution: => duplicate Comment: This was fixed in #12879. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 16:18:22 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 16:18:22 -0000 Subject: [GHC] #14941: Switching direct type family application to EqPred (~) prevents inlining in code using vector (10x slowdown) In-Reply-To: <042.0e3de7917bdd684aac8357b129fd4898@haskell.org> References: <042.0e3de7917bdd684aac8357b129fd4898@haskell.org> Message-ID: <057.69096c923d9e80725d6b1abf2f67c83f@haskell.org> #14941: Switching direct type family application to EqPred (~) prevents inlining in code using vector (10x slowdown) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: davide Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by davide): I've created a simple case where this happens: {{{#!haskell {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} module F (f) where f :: Int -> Int -- FAST -- f :: forall a. (a ~ Int) => a -> a -- SLOW f x = x + x {-# NOINLINE f #-} }}} Compiling with: {{{ $ ghc-8.4.3 -O -ddump-simpl -dsuppress-coercions F.hs }}} I get this core (note worker-wrapper transformation): {{{ -- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0} F.$wf [InlPrag=NOINLINE] :: GHC.Prim.Int# -> GHC.Prim.Int# [GblId, Arity=1, Caf=NoCafRefs, Str=] F.$wf = \ (ww_s1ay :: GHC.Prim.Int#) -> GHC.Prim.+# ww_s1ay ww_s1ay -- RHS size: {terms: 10, types: 4, coercions: 0, joins: 0/0} f [InlPrag=NOUSERINLINE[0]] :: Int -> Int [GblId, Arity=1, Caf=NoCafRefs, Str=m, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) Tmpl= \ (w_s1av [Occ=Once!] :: Int) -> case w_s1av of { GHC.Types.I# ww1_s1ay [Occ=Once] -> case F.$wf ww1_s1ay of ww2_s1aC { __DEFAULT -> GHC.Types.I# ww2_s1aC } }}] f = \ (w_s1av :: Int) -> case w_s1av of { GHC.Types.I# ww1_s1ay -> case F.$wf ww1_s1ay of ww2_s1aC { __DEFAULT -> GHC.Types.I# ww2_s1aC } } }}} Swapping to `f :: forall a. (a ~ Int) => a -> a` gives: {{{ -- RHS size: {terms: 10, types: 21, coercions: 12, joins: 0/0} f [InlPrag=NOINLINE] :: forall a. ((a :: *) ~ (Int :: *)) => a -> a [GblId, Arity=2, Caf=NoCafRefs, Str=m] f = \ (@ a_a13U) ($d~_a13W :: (a_a13U :: *) ~ (Int :: *)) (eta_B1 :: a_a13U) -> case GHC.Types.HEq_sc @ * @ * @ a_a13U @ Int ($d~_a13W `cast` ) of co_a14c { __DEFAULT -> (GHC.Num.$fNumInt_$c+ (eta_B1 `cast` ) (eta_B1 `cast` )) `cast` } }}} I ran a benchmark to confirm the performance difference: {{{ benchmarking Int -> Int time 12.47 ns (12.43 ns .. 12.55 ns) 1.000 R² (1.000 R² .. 1.000 R²) mean 12.53 ns (12.48 ns .. 12.59 ns) std dev 173.4 ps (140.2 ps .. 239.2 ps) variance introduced by outliers: 17% (moderately inflated) benchmarking (a ~ Int) => a -> a time 15.72 ns (15.69 ns .. 15.76 ns) 1.000 R² (1.000 R² .. 1.000 R²) mean 15.80 ns (15.74 ns .. 16.01 ns) std dev 327.8 ps (135.0 ps .. 691.2 ps) variance introduced by outliers: 32% (moderately inflated) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 16:19:31 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 16:19:31 -0000 Subject: [GHC] #14941: Switching direct type family application to EqPred (~) prevents inlining in code using vector (10x slowdown) In-Reply-To: <042.0e3de7917bdd684aac8357b129fd4898@haskell.org> References: <042.0e3de7917bdd684aac8357b129fd4898@haskell.org> Message-ID: <057.7a0e3215340f52ba63d9486d2ececd15@haskell.org> #14941: Switching direct type family application to EqPred (~) prevents inlining in code using vector (10x slowdown) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: davide Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by davide): * Attachment "simple_case.zip" added. Simple case and benchmark. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 17:40:55 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 17:40:55 -0000 Subject: [GHC] #15641: Git repositories have several problems In-Reply-To: <046.cc1f52463775afa374d2adbd9385be70@haskell.org> References: <046.cc1f52463775afa374d2adbd9385be70@haskell.org> Message-ID: <061.5f86295197bc5d3954b1393ca488f412@haskell.org> #15641: Git repositories have several problems -------------------------------------+------------------------------------- Reporter: flip101 | Owner: hvr Type: bug | Status: new Priority: high | Milestone: Component: Trac & Git | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by potato44): I'm only guessing here, but the problem with github might be from not doing some configuration mentioned on the [https://ghc.haskell.org/trac/ghc/wiki/Newcomers newcomers] wiki page {{{ # needed only once, URL rewrite rule is persisted in ${HOME}/.gitconfig git config --global url."git://github.com/ghc/packages-".insteadOf git://github.com/ghc/packages/ # (if you already cloned using ssh, you'll need this rule instead to make submodules work:) # git config --global url."git at github.com:ghc/packages-".insteadOf git at github.com:ghc/packages/ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 18:12:52 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 18:12:52 -0000 Subject: [GHC] #15641: Git repositories have several problems In-Reply-To: <046.cc1f52463775afa374d2adbd9385be70@haskell.org> References: <046.cc1f52463775afa374d2adbd9385be70@haskell.org> Message-ID: <061.42f443e18e55fbb4575051c96fbfafe2@haskell.org> #15641: Git repositories have several problems -------------------------------------+------------------------------------- Reporter: flip101 | Owner: hvr Type: bug | Status: new Priority: high | Milestone: Component: Trac & Git | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by flip101): Ah yes you are right there are special instructions for cloning from github i missed that. So only 2 of 3 issues remain. However it would be better if those special things for github were not needed (but maybe there is no way around it) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 22:53:42 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 22:53:42 -0000 Subject: [GHC] #15529: runtime bug when profiling retainers In-Reply-To: <046.4c9b79c30f29fd493993be5df7c9cc48@haskell.org> References: <046.4c9b79c30f29fd493993be5df7c9cc48@haskell.org> Message-ID: <061.7caf43b35fd38415ee0c610a60aba42b@haskell.org> #15529: runtime bug when profiling retainers -------------------------------------+------------------------------------- Reporter: flip101 | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5075 Wiki Page: | -------------------------------------+------------------------------------- Comment (by flip101): I tried the ghc-8.6 branch but i get build errors. Now it's becomming too difficult to check this for me, i will wait until it lands in stack nightly or if anyone can help. {{{#!bash # # install ghc # sudo apt install git autoconf automake libtool make gcc g++ libgmp-dev ncurses-dev libtinfo-dev python3 xz-utils clang-5.0 clang-6.0 llvm-5.0 llvm-6.0 mkdir ghc-8.6-install git clone --single-branch --branch ghc-8.6 --recursive git://git.haskell.org/ghc.git ghc-8.6 cd ghc-8.6 ./boot PATH=~/.stack/programs/x86_64-linux/ghc-8.4.3/bin:$PATH /usr/bin/time ./configure --prefix=~/haskell/forks/ghc-8.6-install /usr/bin/time make -j3 /usr/bin/time make test THREADS=3 /usr/bin/time make make install # # build project # cd ~/haskell/myproject # version check PATH=~/haskell/forks/ghc-8.6-install/bin:$PATH stack exec ghc --skip-ghc- check --system-ghc --allow-different-user -- --version PATH=~/haskell/forks/ghc-8.6-install/bin:$PATH stack clean --skip-ghc- check --system-ghc --allow-different-user # step with error PATH=~/haskell/forks/ghc-8.6-install/bin:$PATH stack build -j2 --skip-ghc- check --system-ghc --allow-different-user # not-completed steps: PATH=~/haskell/forks/ghc-8.6-install/bin:$PATH stack build -j2 --skip-ghc- check --system-ghc --allow-different-user --ghc-options '-O0 -rtsopts=all -fprof-auto -fprof-auto-calls -fprof-cafs' --executable-profiling PATH=~/haskell/forks/ghc-8.6-install/bin:$PATH stack exec vfix --skip-ghc- check --system-ghc --allow-different-user -- +RTS -hr -sstderr }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 22:55:05 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 22:55:05 -0000 Subject: [GHC] #15529: runtime bug when profiling retainers In-Reply-To: <046.4c9b79c30f29fd493993be5df7c9cc48@haskell.org> References: <046.4c9b79c30f29fd493993be5df7c9cc48@haskell.org> Message-ID: <061.0a0e08bd5ab1e68b8397062994e40009@haskell.org> #15529: runtime bug when profiling retainers -------------------------------------+------------------------------------- Reporter: flip101 | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5075 Wiki Page: | -------------------------------------+------------------------------------- Changes (by flip101): * Attachment "build cabal error.txt" added. Error building my project with 8.6 branch of ghc -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 14 23:55:11 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 14 Sep 2018 23:55:11 -0000 Subject: [GHC] #15647: ghc: panic! (the 'impossible' happened) Message-ID: <046.7d85244b5dbed365072c20ba13282876@haskell.org> #15647: ghc: panic! (the 'impossible' happened) -------------------------------------+------------------------------------- Reporter: monomon | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.0.2 Keywords: | Operating System: Linux Architecture: x86_64 | Type of failure: Compile-time (amd64) | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- {{{ ghc: panic! (the 'impossible' happened) (GHC version 8.0.2 for x86_64-unknown-linux): initTc: unsolved constraints WC {wc_insol = [W] ask_an9K :: t_an9J[tau:1] (CHoleCan: ask) [W] put_an9Q :: t_an9P[tau:1] (CHoleCan: put)} }}} So this code derives an instance of the Decimal type incorrectly, but not sure if this is causing the error. I have some nested records, which contain a few Decimals. I am trying to make them acidic. {{{#!hs instance SafeCopy (DecimalRaw a) where putCopy (Decimal d) = contain $ safePut d getCopy = contain $ Decimal <$> safeGet deriveSafeCopy 0 'base ''Client deriveSafeCopy 0 'base ''Article deriveSafeCopy 0 'base ''ServerData makeLenses ''ServerData writeState :: String -> Update ServerData () writeState newValue = put (ServerData newValue) queryState :: Update ServerData String queryState = do ServerData string <- ask return string makeAcidic ''ServerData ['writeState 'queryState] }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 15 07:51:53 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 15 Sep 2018 07:51:53 -0000 Subject: [GHC] #13600: surprising error message with bang pattern In-Reply-To: <051.cb1136f932f929f97ddeb5e4dd8a6304@haskell.org> References: <051.cb1136f932f929f97ddeb5e4dd8a6304@haskell.org> Message-ID: <066.3d3d6d4c760871569244f74bbbd37843@haskell.org> #13600: surprising error message with bang pattern -------------------------------------+------------------------------------- Reporter: andrewufrank | Owner: v0d1ch Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: BangPatterns, | newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: #15166, #15458 | Differential Rev(s): Phab:D5040 Wiki Page: | -------------------------------------+------------------------------------- Changes (by erikd): * cc: erikd (added) Comment: Seeing this with ghc 8.4.3 as well. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 15 09:23:42 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 15 Sep 2018 09:23:42 -0000 Subject: [GHC] #15634: GHCi: Segmentation fault Data.List.sum large number In-Reply-To: <048.5052d331a4fc48d28dc3b9b9d3968d7b@haskell.org> References: <048.5052d331a4fc48d28dc3b9b9d3968d7b@haskell.org> Message-ID: <063.786e6a4ad5a4da0fab8d9f51e077ca51@haskell.org> #15634: GHCi: Segmentation fault Data.List.sum large number -------------------------------------+------------------------------------- Reporter: ksallberg | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Research | needed Component: GHCi | Version: 8.0.1 Resolution: | Keywords: segfault Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: new => infoneeded Comment: ksallberg, can you try with GHC 8.6 beta instead? If bgamari is right then the segfault should be fixed in 8.6 beta 1. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 15 09:24:51 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 15 Sep 2018 09:24:51 -0000 Subject: [GHC] #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes In-Reply-To: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> References: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> Message-ID: <062.bc9fbda17236a9f961d73dc59a4da787@haskell.org> #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes -------------------------------------+------------------------------------- Reporter: ChaiTRex | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by JulianLeviston): * owner: monoidal => JulianLeviston Comment: Trying this as my first ticket. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 15 10:37:46 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 15 Sep 2018 10:37:46 -0000 Subject: [GHC] #15485: GHC uses 300% CPU when calling into blocking C call In-Reply-To: <047.13adf0146883a7a0c2f9dc50bb228513@haskell.org> References: <047.13adf0146883a7a0c2f9dc50bb228513@haskell.org> Message-ID: <062.4314d819a7a2a1e6f4cca95d8c6c7f9a@haskell.org> #15485: GHC uses 300% CPU when calling into blocking C call -------------------------------------+------------------------------------- Reporter: oconnore | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 | (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * cc: osa1 (added) Comment: I'll try to reproduce this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 15 11:59:58 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 15 Sep 2018 11:59:58 -0000 Subject: [GHC] #15647: ghc: panic! (the 'impossible' happened) In-Reply-To: <046.7d85244b5dbed365072c20ba13282876@haskell.org> References: <046.7d85244b5dbed365072c20ba13282876@haskell.org> Message-ID: <061.8172358cd669344678c39c8c5df99be0@haskell.org> #15647: ghc: panic! (the 'impossible' happened) -------------------------------------+------------------------------------- Reporter: monomon | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.0.2 Resolution: duplicate | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #13106 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => duplicate * related: => #13106 Comment: Thanks for the bug report. This is a duplicate of #13106, and has been fixed in GHC 8.2. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 15 12:07:44 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 15 Sep 2018 12:07:44 -0000 Subject: [GHC] #15647: ghc: panic! (the 'impossible' happened) In-Reply-To: <046.7d85244b5dbed365072c20ba13282876@haskell.org> References: <046.7d85244b5dbed365072c20ba13282876@haskell.org> Message-ID: <061.ed168f5c4cc2434277b3eb0e65bada9d@haskell.org> #15647: ghc: panic! (the 'impossible' happened) -------------------------------------+------------------------------------- Reporter: monomon | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.0.2 Resolution: duplicate | Keywords: Operating System: Linux | Architecture: x86_64 Type of failure: Compile-time | (amd64) crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #13106 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by monomon): Thank you, I am getting set up with 8.2.2 now -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 15 14:20:07 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 15 Sep 2018 14:20:07 -0000 Subject: [GHC] #15634: GHCi: Segmentation fault Data.List.sum large number In-Reply-To: <048.5052d331a4fc48d28dc3b9b9d3968d7b@haskell.org> References: <048.5052d331a4fc48d28dc3b9b9d3968d7b@haskell.org> Message-ID: <063.7ae497c876d3b55a480b2ab7aca4ecef@haskell.org> #15634: GHCi: Segmentation fault Data.List.sum large number -------------------------------------+------------------------------------- Reporter: ksallberg | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Research | needed Component: GHCi | Version: 8.0.1 Resolution: | Keywords: segfault Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by ksallberg): The following happened when I used GHCi from https://downloads.haskell.org/~ghc/8.6.1-beta1/ (specifically ghc-8.6.0.20180810-x86_64-deb8-linux.tar.xz) {{{ kristian at snabbadatorn:/$ ./usr/local/bin/ghci GHCi, version 8.6.0.20180810: http://www.haskell.org/ghc/ :? for help Prelude> sum [1..100000000] : internal error: Unable to commit 1048576 bytes of memory (GHC version 8.6.0.20180810 for x86_64_unknown_linux) Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug Aborted }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 15 14:28:56 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 15 Sep 2018 14:28:56 -0000 Subject: [GHC] #15497: Coercion Quantification In-Reply-To: <047.3a4a4e067b87a899efdf8c3f044fd1ac@haskell.org> References: <047.3a4a4e067b87a899efdf8c3f044fd1ac@haskell.org> Message-ID: <062.4451739379794c4e06cb11a9b445db63@haskell.org> #15497: Coercion Quantification -------------------------------------+------------------------------------- Reporter: ningning | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5054 Wiki Page: | https://ghc.haskell.org/trac/ghc/wiki/DependentHaskell/Phase2| -------------------------------------+------------------------------------- Comment (by Richard Eisenberg ): In [changeset:"ea5ade34788f29f5902c5475e94fbac13110eea5/ghc" ea5ade34/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="ea5ade34788f29f5902c5475e94fbac13110eea5" Coercion Quantification This patch corresponds to #15497. According to https://ghc.haskell.org/trac/ghc/wiki/DependentHaskell/Phase2, we would like to have coercion quantifications back. This will allow us to migrate (~#) to be homogeneous, instead of its current heterogeneous definition. This patch is (lots of) plumbing only. There should be no user-visible effects. An overview of changes: - Both `ForAllTy` and `ForAllCo` can quantify over coercion variables, but only in *Core*. All relevant functions are updated accordingly. - Small changes that should be irrelevant to the main task: 1. removed dead code `mkTransAppCo` in Coercion 2. removed out-dated Note Computing a coercion kind and roles in Coercion 3. Added `Eq4` in Note Respecting definitional equality in TyCoRep, and updated `mkCastTy` accordingly. 4. Various updates and corrections of notes and typos. - Haddock submodule needs to be changed too. Acknowledgments: This work was completed mostly during Ningning Xie's Google Summer of Code, sponsored by Google. It was advised by Richard Eisenberg, supported by NSF grant 1704041. Test Plan: ./validate Reviewers: goldfire, simonpj, bgamari, hvr, erikd, simonmar Subscribers: RyanGlScott, monoidal, rwbarton, carter GHC Trac Issues: #15497 Differential Revision: https://phabricator.haskell.org/D5054 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 15 14:40:41 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 15 Sep 2018 14:40:41 -0000 Subject: [GHC] #11647: GHCi does not honour implicit `module Main (main) where` for re-exported `main`s In-Reply-To: <042.bdc5ad3927502391eb42801db38e8cb4@haskell.org> References: <042.bdc5ad3927502391eb42801db38e8cb4@haskell.org> Message-ID: <057.f4b2167b68c7f2efd091bc9f62d7aba5@haskell.org> #11647: GHCi does not honour implicit `module Main (main) where` for re-exported `main`s -------------------------------------+------------------------------------- Reporter: hvr | Owner: RolandSenn Type: bug | Status: new Priority: normal | Milestone: Component: GHCi | Version: 7.10.3 Resolution: | 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: | -------------------------------------+------------------------------------- Changes (by RolandSenn): * owner: (none) => RolandSenn Comment: I'll work on this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 15 14:50:24 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 15 Sep 2018 14:50:24 -0000 Subject: [GHC] #15648: Core Lint error with source-level unboxed equality Message-ID: <050.b1c8c377aa63cdac74b3d157d20320e2@haskell.org> #15648: Core Lint error with source-level unboxed equality -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Compile-time Unknown/Multiple | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: #15209 Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I thought that we had killed `(~#)` from the source language in #15209. I could not have been more wrong. Source-level `(~#)` is alive and well, and it can cause Core Lint errors. Be afraid. Be very, very afraid. The trick is to grab `(~#)` using Template Haskell: {{{#!hs module Foo where import Language.Haskell.TH.Lib import Language.Haskell.TH.Syntax ueqT :: Q Type ueqT = conT $ mkNameG_tc "ghc-prim" "GHC.Prim" "~#" }}} Once this is done, you can plop unboxed equality wherever you want into the source language. Here is a particularly mischievous example: {{{#!hs {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} module Bug where import Data.Kind (Type) import Data.Type.Equality (type (~~)) import Foo (ueqT) data LegitEquality :: Type -> Type -> Type where Legit :: LegitEquality a a data JankyEquality :: Type -> Type -> Type where Jank :: $ueqT a b -> JankyEquality a b unJank :: JankyEquality a b -> $ueqT a b unJank (Jank x) = x legitToJank :: LegitEquality a b -> JankyEquality a b legitToJank Legit = Jank mkLegit :: a ~~ b => LegitEquality a b mkLegit = Legit ueqSym :: forall (a :: Type) (b :: Type). $ueqT a b -> $ueqT b a ueqSym = unJank $ legitToJank $ mkLegit @b @a }}} If you compile this with optimizations, then GHC's inner demons are unleashed, which brings utter chaos when `-dcore-lint` is enabled: {{{ $ /opt/ghc/8.6.1/bin/ghc -O2 -fforce-recomp Bug.hs -dcore-lint [1 of 2] Compiling Foo ( Foo.hs, Foo.o ) [2 of 2] Compiling Bug ( Bug.hs, Bug.o ) *** Core Lint errors : in result of Simplifier *** : warning: [in body of lambda with binder co_a5RY :: a_a5RV ~# b_a5RW] x_a5OX :: b_a5RW ~# a_a5RV [LclId] is out of scope *** Offending Program *** ueqSym :: forall a b. (a ~# b) => b ~# a [LclIdX, Arity=1, Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}] ueqSym = \ (@ a_a5RV) (@ b_a5RW) (co_a5RY :: a_a5RV ~# b_a5RW) -> x_a5OX }}} ----- Obviously, this ticket is a little tongue-in-cheek, since I'm probably inviting disaster upon myself by deliberately digging around in `ghc-prim` for `(~#)`. But this does raise the question: should we allow users to do this? I used to think that there was no harm in leaving `(~#)` lying at the bottom of the catacombs that is `ghc-prim`, but this example shows that perhaps `(~#)` should be locked away for good. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 15 14:51:10 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 15 Sep 2018 14:51:10 -0000 Subject: [GHC] #15209: ~# is always in scope with TypeOperators In-Reply-To: <045.a34fe11ee89db0cfed0ea681a1b61885@haskell.org> References: <045.a34fe11ee89db0cfed0ea681a1b61885@haskell.org> Message-ID: <060.1822d6583686c224e1d82a089de6bbf0@haskell.org> #15209: ~# is always in scope with TypeOperators -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC accepts | Unknown/Multiple invalid program | Test Case: Blocked By: | Blocking: Related Tickets: #15648 | Differential Rev(s): Phab:D4763, Wiki Page: | Phab:D4801 -------------------------------------+------------------------------------- Changes (by RyanGlScott): * related: => #15648 Comment: Despite my best attempts to kill it, `(~#)` is still finding ways to sneak back into the source language. See #15648. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 15 15:00:56 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 15 Sep 2018 15:00:56 -0000 Subject: [GHC] #15648: Core Lint error with source-level unboxed equality In-Reply-To: <050.b1c8c377aa63cdac74b3d157d20320e2@haskell.org> References: <050.b1c8c377aa63cdac74b3d157d20320e2@haskell.org> Message-ID: <065.8e4e8fa656d6a6b4f6efc71e38965dac@haskell.org> #15648: Core Lint error with source-level unboxed equality -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15209 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Sigh. I see two problems here: 1. Why does GHC type check `Jank` at type `JankyEquality a b`? There must be something in the type checker which treats arguments of type `a ~# b` as invisible. But these shouldn't be -- they are not `Constraint`s. To fix: find this code and kill it. 2. What on earth was the simplifier thinking?!? To fix: find this code and encourage it to get an education. I'd be less alarmed if the core lint error were right in the desugarer. Then, we could plausibly argue that forbidding `~#` from source would fix the problem. But if the simplifier is doing it, there's got to be a legitimate bug (or, at least, a delicate invariant) somewhere. I don't think we should be able to get a lint error just by writing `~#` in the source. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 15 15:03:38 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 15 Sep 2018 15:03:38 -0000 Subject: [GHC] #15648: Core Lint error with source-level unboxed equality In-Reply-To: <050.b1c8c377aa63cdac74b3d157d20320e2@haskell.org> References: <050.b1c8c377aa63cdac74b3d157d20320e2@haskell.org> Message-ID: <065.2be6d3fc8588713c88c8c6bec77337b1@haskell.org> #15648: Core Lint error with source-level unboxed equality -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15209 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): More shenanigans: if you put this at the end of `Bug.hs`: {{{#!hs main :: IO () main = case ueqSym @Bool @Bool of _ -> mkLegit `seq` print () }}} Then you'll get an outright panic when you compile it: {{{ $ /opt/ghc/8.6.1/bin/ghc -O2 -fforce-recomp Bug.hs [1 of 2] Compiling Foo ( Foo.hs, Foo.o ) [2 of 2] Compiling Bug ( Bug.hs, Bug.o ) ghc: panic! (the 'impossible' happened) (GHC version 8.6.0.20180907 for x86_64-unknown-linux): StgCmmEnv: variable not found x_a5Pc local binds for: main $tc'Jank $trModule $tc'Jank2 $tc'Jank1 $tc'Jank3 $tc'Legit $tc'Legit2 $tc'Legit1 $tc'Legit3 $tcJankyEquality $tcJankyEquality1 $tcJankyEquality2 $tcLegitEquality $tcLegitEquality1 $tcLegitEquality2 $trModule3 $trModule1 $trModule2 $trModule4 main1 $WLegit $krep_r6Fh $krep1_r6Fi $krep2_r6Fj $krep3_r6Fk $krep4_r6Fl $krep5_r6Fm $krep6_r6Fn $krep7_r6Fo $krep8_r6Fp $krep9_r6Fq Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1160:37 in ghc:Outputable pprPanic, called at compiler/codeGen/StgCmmEnv.hs:149:9 in ghc:StgCmmEnv }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 15 15:13:14 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 15 Sep 2018 15:13:14 -0000 Subject: [GHC] #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes In-Reply-To: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> References: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> Message-ID: <062.a20793094310b253311fa1e204faa303@haskell.org> #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes -------------------------------------+------------------------------------- Reporter: ChaiTRex | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by JulianLeviston): I *think* the problem is setting the `fobject-code` flag mean HscInterpreted won't ever get set, which means when checkOptLevel gets called, the error doesn't trigger, because it only works for HscInterpreted. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 15 15:30:09 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 15 Sep 2018 15:30:09 -0000 Subject: [GHC] #15648: Core Lint error with source-level unboxed equality In-Reply-To: <050.b1c8c377aa63cdac74b3d157d20320e2@haskell.org> References: <050.b1c8c377aa63cdac74b3d157d20320e2@haskell.org> Message-ID: <065.214781879399938dd1139df8b40b6893@haskell.org> #15648: Core Lint error with source-level unboxed equality -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15209 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Did you have `-dcore-lint` on in comment:2? That looks like the lint error from above. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 15 18:47:17 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 15 Sep 2018 18:47:17 -0000 Subject: [GHC] #15176: Superclass `Monad m =>` makes program run 100 times slower In-Reply-To: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> References: <046.1ae5a16457a25527a576b82200e29a09@haskell.org> Message-ID: <061.a73ab674dc973c9fda51f7cb27d4697b@haskell.org> #15176: Superclass `Monad m =>` makes program run 100 times slower -------------------------------------+------------------------------------- Reporter: danilo2 | Owner: osa1 Type: bug | Status: new Priority: highest | Milestone: 8.8.1 Component: Compiler | Version: 8.4.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by alpmestan): * cc: alpmestan (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 15 20:59:04 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 15 Sep 2018 20:59:04 -0000 Subject: [GHC] #15648: Core Lint error with source-level unboxed equality In-Reply-To: <050.b1c8c377aa63cdac74b3d157d20320e2@haskell.org> References: <050.b1c8c377aa63cdac74b3d157d20320e2@haskell.org> Message-ID: <065.f2fe6029866f11750ae5628c4f42b5a2@haskell.org> #15648: Core Lint error with source-level unboxed equality -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15209 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Replying to [comment:3 goldfire]: > Did you have `-dcore-lint` on in comment:2? I didn't (it'll give the same Core Lint error as before if you do). I just wanted to give an example which shows that the problem is more severe than just an ordinary Core Lint warning (i.e., you can make GHC crash without needing to resort to debugging flags like `-dcore-lint`). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 00:07:38 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 00:07:38 -0000 Subject: [GHC] #15642: Improve the worst case performance of weak pointers In-Reply-To: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> References: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> Message-ID: <060.af4e6f5ef935aa10aa97eb46a131b1a5@haskell.org> #15642: Improve the worst case performance of weak pointers -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.8.1 Component: Runtime System | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): I realized two things today: 1. We don't have to tag the info pointer (or deal with the possibility that it's tagged) in the mutator. We can instead tag all the pointers in the table at the beginning of collection and untag as we go. 2. We should have enough bits, even for a large binary on a 32-bit system. Why? Because even a huge binary won't have billions of info tables except perhaps in a pathological case. So if we eventually need another bit, we can impose 8-byte alignment for the tables. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 01:44:44 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 01:44:44 -0000 Subject: [GHC] #15009: Float equalities past local equalities In-Reply-To: <047.0a49c3ac676b2b3bc6f93c4594762c08@haskell.org> References: <047.0a49c3ac676b2b3bc6f93c4594762c08@haskell.org> Message-ID: <062.1d8d360e95ff868bbe89da25f9e87e88@haskell.org> #15009: Float equalities past local equalities -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: 8.4.3 Component: Compiler | Version: 8.2.2 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: gadt/T15009 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nfrisby): Very happy to see the progress on this ticket! I think it would even be worthwhile for GHC to be a bit more aggressive here. In particular, in the snippet below, I'd like GHC to infer that {{{test :: () -> NT ((:~:) Char) Maybe}}}. I see this comment's example as decomposing the ticket's example {{{T1}}} into {{{:~:}}} and {{{NT}}}: the equality constraint and the {{{forall}}} need not be collocated. If I understand correctly, the key hurdle to that inference is revealed on line 3640 of the tc-trace below and the reason {{{getNoGivenEqs}}} reports {{{False}}} here is because {{{x_a1d8[sk:2]}}} is level 2 whereas the implication is level 3. I haven't found any Notes explaining why {{{getNoGivenEqs}}} checks that the skolem is from the current implication. Would it be safe and worthwhile to relax this check to, for example, as in this this particular case, require that there be no givens between the skolem's level and the current implication's level? (Or more loosely perhaps: no such equality- like givens, or even no equality-like givens involving this skolem?) {{{ $ cat Test.hs {-# LANGUAGE GADTs, LambdaCase, Rank2Types #-} {-# OPTIONS_GHC -ddump-tc-trace #-} module Test where import Data.Type.Equality newtype NT f g = MkNT{appNT :: forall x. f x -> g x} test () = MkNT (\case Refl -> Just 'c') $ ./ghc-8.6.0.20180810/bin/ghc.exe --make Test.hs >catch 2>&1 $ grep --text -B7 -A5 -n -e 'May have given eq' catch [snip] -- 3634- final wc = WC {wc_simple = 3635- [WD] hole{co_a1dv} {1}:: g_a1d6[tau:1] 3636- GHC.Prim.~# Maybe (CNonCanonical) 3637- [WD] hole{co_a1dy} {2}:: a_a1dx[tau:1] 3638- GHC.Prim.~# Char (CNonCanonical)} 3639- current evbinds = {} 3640-getNoGivenEqs 3641: May have given equalities 3642- Skols: [] 3643- Inerts: {Equalities: [G] co_a1dj {0}:: x_a1d8[sk:2] 3644- GHC.Prim.~# a_a1dx[tau:1] (CTyEqCan) 3645- Unsolved goals = 0} 3646- Insols: {} -- [snip] }}} Thank you for your time. -Nick P.S. - My Reddit post from a few months ago gives a bit more discussion of this kind of example; https://www.reddit.com/r/haskell/comments/8h9mz8/a_way_to_improve_inference_under_gadt_patterns/ Thanks again, Richard, for pointed me here from there; timely! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 03:56:23 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 03:56:23 -0000 Subject: [GHC] #15649: Errors about ambiguous untouchable variable when using constraint variable in RankN type Message-ID: <048.433118ed22801f4feee0bb734e000e8f@haskell.org> #15649: Errors about ambiguous untouchable variable when using constraint variable in RankN type -------------------------------------+------------------------------------- Reporter: infinity0 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 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: -------------------------------------+------------------------------------- The following code compiles and works: {{{#!haskell {-# LANGUAGE ConstraintKinds , FlexibleInstances , MultiParamTypeClasses , GADTs , RankNTypes , ScopedTypeVariables , UndecidableSuperClasses #-} import GHC.Types (Constraint) main :: IO () main = do return () class (r a) => DynPS r a where data PSAny r = forall a. DynPS r a => PSAny a class Unconstrained a instance Unconstrained a instance DynPS Unconstrained () newtype DynLoad' r = DynLoad' { unDynLoad' :: forall ref. r ref => ref -> PSAny r } loadAll :: forall a r . (DynPS r a) => DynLoad' r -> a -> Maybe a loadAll loader r = undefined testCallable :: IO (Maybe ()) testCallable = return $ loadAll (undefined :: DynLoad' Unconstrained) () }}} However it's ugly having to expose `DynLoad'` in the API. Ideally we'd like to have: {{{#!haskell loadAll2 :: forall a r . (DynPS r a) => (forall ref. r ref => ref -> PSAny r) -> a -> Maybe a loadAll2 loader r = loadAll (DynLoad' loader :: DynLoad' r) r }}} But this fails with: {{{ Test3.hs:37:6: error: • Couldn't match type ‘r0’ with ‘r’ ‘r0’ is untouchable inside the constraints: r0 ref bound by the type signature for: loadAll2 :: forall ref. r0 ref => ref -> PSAny r0 at Test3.hs:(37,6)-(39,17) ‘r’ is a rigid type variable bound by the type signature for: loadAll2 :: forall a (r :: * -> Constraint). DynPS r a => (forall ref. r ref => ref -> PSAny r) -> a -> Maybe a at Test3.hs:(37,6)-(39,17) Expected type: ref -> PSAny r0 Actual type: ref -> PSAny r • In the ambiguity check for ‘loadAll2’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes In the type signature: loadAll2 :: forall a r. (DynPS r a) => (forall ref. r ref => ref -> PSAny r) -> a -> Maybe a | 37 | :: forall a r . (DynPS r a) | ^^^^^^^^^^^^^^^^^^^^^^^^... }}} It compiles if we enable `AllowAmbiguousTypes`, but are then forced to use `TypeApplications` as well to actually call it. :( {{{#!haskell -- as above, but add: {-# LANGUAGE AllowAmbiguousTypes, TypeApplications #-} -- and then: testCallable2 :: IO (Maybe ()) --testCallable2 = return $ loadAll2 (undefined :: forall ref. Unconstrained ref => ref -> PSAny Unconstrained) () -- ^ doesn't work either testCallable2 = return $ loadAll2 @() @Unconstrained undefined () }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 05:10:00 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 05:10:00 -0000 Subject: [GHC] #15649: Errors about ambiguous untouchable variable when using constraint variable in RankN type In-Reply-To: <048.433118ed22801f4feee0bb734e000e8f@haskell.org> References: <048.433118ed22801f4feee0bb734e000e8f@haskell.org> Message-ID: <063.6a8d9425b2e07a85d04f07de27a952cc@haskell.org> #15649: Errors about ambiguous untouchable variable when using constraint variable in RankN type -------------------------------------+------------------------------------- Reporter: infinity0 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by infinity0): Note that the error also goes away if we specialise `r` to be of kind `*` rather than `* -> Constraint`, for example: {{{#!haskell -- as the first snippet, but add: {-# LANGUAGE FlexibleContexts #-} -- and then: instance DynPS ((~) ()) () loadAll3 :: forall a r . (DynPS ((~) r) a) => (forall ref . r ~ ref => ref -> PSAny ((~) r)) -> a -> Maybe a loadAll3 loader r = loadAll (DynLoad' loader :: DynLoad' ((~) r)) r testCallable3 :: IO (Maybe ()) testCallable3 = return $ loadAll3 undefined () }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 07:06:39 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 07:06:39 -0000 Subject: [GHC] #4017: Unhelpful error message in GHCi In-Reply-To: <046.b126e34ebdc516a2392e1a0dd50d1e4f@haskell.org> References: <046.b126e34ebdc516a2392e1a0dd50d1e4f@haskell.org> Message-ID: <061.3c82517059a58b03c81665ddc0c72e84@haskell.org> #4017: Unhelpful error message in GHCi -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: patch Priority: lowest | Milestone: Component: Compiler | Version: 6.12.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #13862 | Differential Rev(s): Phab:D5122 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: new => patch * differential: => Phab:D5122 Comment: This is a duplicate of #13862 and will be fixed with Phab:D5122. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 07:23:18 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 07:23:18 -0000 Subject: [GHC] #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes In-Reply-To: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> References: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> Message-ID: <062.456e1bccecd513a765de06e20146b918@haskell.org> #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes -------------------------------------+------------------------------------- Reporter: ChaiTRex | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * cc: RolandSenn (added) Comment: I think you're right. This is another example of problems caused by not having the information of whether we're in interpreter or not in the compiler (we only have information derived from the flags but that information can't tell reliably whether we're in interpreter, as in this ticket). @RolandSenn has a good summary of the problem in Phab:D5122 which also links to a few other issues caused by this problem. Perhaps we should do the refactoring to add a field to DynFlags about whether we're in interepreter. If we do this then maybe we should revisit some of the fixed tickets and fix them "properly" by using the new field. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 07:30:30 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 07:30:30 -0000 Subject: [GHC] #15634: GHCi: Segmentation fault Data.List.sum large number In-Reply-To: <048.5052d331a4fc48d28dc3b9b9d3968d7b@haskell.org> References: <048.5052d331a4fc48d28dc3b9b9d3968d7b@haskell.org> Message-ID: <063.fdfd140d0bf416396ea4cffff2ae82f0@haskell.org> #15634: GHCi: Segmentation fault Data.List.sum large number -------------------------------------+------------------------------------- Reporter: ksallberg | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Research | needed Component: GHCi | Version: 8.0.1 Resolution: | Keywords: segfault Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * cc: bgamari (added) Comment: This is basically a `mmap()` failure (`mmap()` returning `MAP_FAILED`). Whether this is expected or not probably depends on your configuration (how much the process allowed to allocate etc.). Perhaps bgamari knows how to see whether this is expected or not. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 08:15:20 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 08:15:20 -0000 Subject: [GHC] #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes In-Reply-To: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> References: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> Message-ID: <062.a6605fac819701db45916060dd413909@haskell.org> #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes -------------------------------------+------------------------------------- Reporter: ChaiTRex | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by JulianLeviston): Right. It sounds like refactoring is a good idea for this. In terms of `HscTarget`, it feels like `HscInterpreted` is possibly not named correctly? The other three seem like actual targets: `HscC`, `HscAsm`, `HscLlvm`. That is, how can "Interpreted" be a target? A target is the resultant output of a process. `Interpreted` is a method of obtaining a target. That is, the others seems like target languages (C, assembly, LLVM bytecode). What is `Interpreted` in that context? is it trying to say Haskell Bytecode? (I'm not even sure what that *is*). This is just according to my current understanding of what's going on, which is pretty shallow. On the other hand, DynFlags already seems quite large. Is it the right place to determine what mode the compiler is in? I'd be guided by others' advice here because I'm so green. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 08:52:00 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 08:52:00 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.bed4a227b7263dbdc1ba1fb8260e5568@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: type Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Johannkokos): The problem seems to be specific to scientific notation literals. On GHCi, Both {{{ 10^1000000 :: Double }}} and {{{ :t 10^1000000 :: Double }}} terminate near-instantly, while there is a noticeable delay with {{{ 1e1000000 :: Double }}} and {{{ :t 1e1000000 :: Double }}} . ''Comment on reddit by /u/duplode'' -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 09:23:04 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 09:23:04 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.b89b3219d2ee3cee109e1df98928e61f@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * keywords: type => newcomer Comment: It seems like adding one more digit in the literal causes 10x increase in desugaring + type checking time: {{{ ~ $ echo ':t 1e10000000' | time ghci ... ghci 0,37s user 0,04s system 97% cpu 0,418 total ~ $ echo ':t 1e100000000' | time ghci ... ghci 3,63s user 0,12s system 99% cpu 3,749 total ~ $ echo ':t 1e1000000000' | time ghci ... ghci 43,77s user 1,68s system 100% cpu 45,429 total }}} I also tried compiling this {{{#!haskell a = 1e1000000000 }}} and it also takes forever. I suspect this is a type checker bug or a desugarer bug. I think this would be a good newcomer ticket. I'd start with finding how the expression `1e1000000000` parsed, and then find relevant desugarer and type checker code. Then add some print statements around those code to which one takes so long. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 10:23:37 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 10:23:37 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.021046d17fe46c78a15437fe5e5c5716@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by JulianLeviston): * owner: (none) => JulianLeviston -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 11:18:09 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 11:18:09 -0000 Subject: [GHC] #10651: Type checking issue with existential quantification, rank-n types and constraint kinds In-Reply-To: <046.13e821c10925b9eff72404016930e9cc@haskell.org> References: <046.13e821c10925b9eff72404016930e9cc@haskell.org> Message-ID: <061.2c591700df453c58454569b3039bb521@haskell.org> #10651: Type checking issue with existential quantification, rank-n types and constraint kinds -------------------------------------+------------------------------------- Reporter: Roboguy | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler (Type | Version: 7.10.1 checker) | Resolution: invalid | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: #14921, #15649 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => invalid * related: => #14921, #15649 Comment: I'm going to close this, since the fact that this program doesn't typecheck is expected behavior (at least, according to the specification in the OutsideIn(X) paper, as explained in comment:2). See also #14921 and #15649, which are similar tickets. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 11:19:11 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 11:19:11 -0000 Subject: [GHC] #14921: Type inference breaks on constraint-kinded parameter used by a Rank-2 callback In-Reply-To: <051.12d35c7805454922cc0bcfb2ee8e00e1@haskell.org> References: <051.12d35c7805454922cc0bcfb2ee8e00e1@haskell.org> Message-ID: <066.53fa547e26665c4ecbaa93a2b7ec4cc6@haskell.org> #14921: Type inference breaks on constraint-kinded parameter used by a Rank-2 callback -------------------------------------+------------------------------------- Reporter: glittershark | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: invalid | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: #10651, #15649 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => invalid * related: #10651 => #10651, #15649 Comment: I'm going to close this, since the fact that this program doesn't typecheck is expected behavior (at least, according to the specification in the OutsideIn(X) paper, as explained in https://ghc.haskell.org/trac/ghc/ticket/10651#comment:2). See also #10651 and #15649, which are similar tickets. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 11:28:23 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 11:28:23 -0000 Subject: [GHC] #15649: Errors about ambiguous untouchable variable when using constraint variable in RankN type In-Reply-To: <048.433118ed22801f4feee0bb734e000e8f@haskell.org> References: <048.433118ed22801f4feee0bb734e000e8f@haskell.org> Message-ID: <063.379d2fc4ada16d4a9672b66bba5a8448@haskell.org> #15649: Errors about ambiguous untouchable variable when using constraint variable in RankN type -------------------------------------+------------------------------------- Reporter: infinity0 | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10651, #14921 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => duplicate * related: => #10651, #14921 Comment: This is expected behavior. As simonpj explains in https://ghc.haskell.org/trac/ghc/ticket/10651#comment:2, GHC does not (in general) unify underneath constraints that might turn into equalities. In your program, you have {{{#!hs (forall ref. r ref => ref -> PSAny r) }}} In order to prove that `(forall ref. r ref => ref -> PSAny r)` equals `(forall ref. r0 ref => ref -> PSAny r0)` (where `r0` is a unification variable), it must conclude that `r ~ r0`. But this is not sound in general, since `r ref` might later unify with, say, `r ~ Int`, which would make `r0 := Int` a valid substitution. Moreover, `r` is not uniquely determined anywhere else in the type signature (unlike in `loadAll`, where it is determined by the `DynLoad r` argument). Therefore, `r0` is marked as untouchable in this type signature. (This is all explained in Section 5 in the [https://www.microsoft.com/en-us/research/wp- content/uploads/2016/02/jfp-outsidein.pdf ​OutsideIn paper].) See also #10651 and #14921. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 13:05:38 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 13:05:38 -0000 Subject: [GHC] #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` In-Reply-To: <046.74175c624c857c997e111eade5eabf30@haskell.org> References: <046.74175c624c857c997e111eade5eabf30@haskell.org> Message-ID: <061.e6bf128f57a2b9927c48f0fb73bd0280@haskell.org> #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` -------------------------------------+------------------------------------- Reporter: rockbmb | Owner: rockbmb Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Core Libraries | Version: 8.4.3 Resolution: | Keywords: base, | Data.Fixed Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Bodigrim): > I've sent an email to the Core Libraries Committee regarding this issue. Are you sure? I cannot find it in https://mail.haskell.org/pipermail/libraries/2018-September/thread.html -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 13:10:01 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 13:10:01 -0000 Subject: [GHC] #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` In-Reply-To: <046.74175c624c857c997e111eade5eabf30@haskell.org> References: <046.74175c624c857c997e111eade5eabf30@haskell.org> Message-ID: <061.ffd3064dc378f3a6ad68ea4cdaf5f706@haskell.org> #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` -------------------------------------+------------------------------------- Reporter: rockbmb | Owner: rockbmb Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Core Libraries | Version: 8.4.3 Resolution: | Keywords: base, | Data.Fixed Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Indeed, since this proposes to change the existing API in `Data.Fixed`, I would first send a mail to the libraries mailing list (which Bodigrim has linked to in comment:6) and solicit community feedback. If there is a consensus that this change should be adopted, we can proceed forward with the actual implementation. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 13:17:30 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 13:17:30 -0000 Subject: [GHC] #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` In-Reply-To: <046.74175c624c857c997e111eade5eabf30@haskell.org> References: <046.74175c624c857c997e111eade5eabf30@haskell.org> Message-ID: <061.e11ca1764aa81960f47e5492f8cf45ff@haskell.org> #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` -------------------------------------+------------------------------------- Reporter: rockbmb | Owner: rockbmb Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Core Libraries | Version: 8.4.3 Resolution: | Keywords: base, | Data.Fixed Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Bodigrim): AFAIU the proposed implementation (https://github.com/ghc/ghc/pull/196) is backward compatible and the only visible change is a new exported entity `Data.Fixed.E`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 13:23:05 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 13:23:05 -0000 Subject: [GHC] #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` In-Reply-To: <046.74175c624c857c997e111eade5eabf30@haskell.org> References: <046.74175c624c857c997e111eade5eabf30@haskell.org> Message-ID: <061.6c1041b6c3acc947b2c7a9ebbe3cc31f@haskell.org> #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` -------------------------------------+------------------------------------- Reporter: rockbmb | Owner: rockbmb Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Core Libraries | Version: 8.4.3 Resolution: | Keywords: base, | Data.Fixed Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): That is still a breaking change, since it changes `E0`, `E1`, etc. from data types to type synonyms. Among other things, this will cause programs that declare instances against these types to stop compiling if they do not enable the `FlexibleInstances` extension. That change notwithstanding, I would also be interested to hear the community's feedback on the use of the `DataKinds` GHC extension in a prominent place in `base` like `Data.Fixed`. (`DataKinds` is already used in other places in `base`, but they're mostly sectioned off within the `GHC.*` namespace, where language extension experimentation is more readily tolerated.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 13:31:39 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 13:31:39 -0000 Subject: [GHC] #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` In-Reply-To: <046.74175c624c857c997e111eade5eabf30@haskell.org> References: <046.74175c624c857c997e111eade5eabf30@haskell.org> Message-ID: <061.08b2d74ab6d09418b18e82a45653961a@haskell.org> #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` -------------------------------------+------------------------------------- Reporter: rockbmb | Owner: rockbmb Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Core Libraries | Version: 8.4.3 Resolution: | Keywords: base, | Data.Fixed Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by rockbmb): I received this email from Microsoft not long after I sent an email to libraries at haskell.org: Delivery has failed to these recipients or groups: Haskell Libraries (libraries at haskell.org) Your message couldn't be delivered. Despite repeated attempts to contact the recipient's email system it didn't respond. Contact the recipient by some other means (by phone, for example) and ask them to tell their email admin that it appears that their email system isn't accepting connection requests from your email system. Give them the error details shown below. It's likely that the recipient's email admin is the only one who can fix this problem. I'll try again. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 13:54:31 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 13:54:31 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.f062612a08ccc1b3ebda529b9e2fb065@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by JulianLeviston): Took me a very long time to realise I could use `ghc -e ':t 1e100000000' -ddump-parsed` to spit out the parsed file. First I dug into the generated source for the parser trying to wrap my head around how it's built. Then I tried to write a program to spit out the parse result, but that was ultimately fruitless: {{{#!hs module Blah () where import Parser import Lexer import GHC import DynFlags import StringBuffer (stringToStringBuffer) import FastString import SrcLoc import Outputable main :: IO () main = do dynFlags <- getProgramDynFlags let x = runParser dynFlags "putStrLn \"Hey\"" parseStatement case x of POk pstate res -> putStrLn $ ppr res _ -> putStrLn "Fail" runParser :: DynFlags -> String -> P a -> ParseResult a runParser flags str parser = unP parser parseState where filename = "" location = mkRealSrcLoc (mkFastString filename) 1 1 buffer = stringToStringBuffer str parseState = mkPState flags buffer location }}} That was pretty silly... anyway, I subsequently realised I could use flags to spit out stage output. I should have read the docs on hacking on GHC more! That yielded this: {{{#!shell ➜ ghc git:(master) ✗ ./inplace/bin/ghc-stage2 blah2.hs -ddump-rn -dppr- debug [1 of 1] Compiling Blah2 ( blah2.hs, blah2.o ) blah2.hs:1:1: ==================== Renamer ==================== nonrec {blah2.hs:3:1-24} main:Blah2.largevalue{v rpX} main:Blah2.largevalue{v rpX} = {blah2.hs:3:14-24} 1e100000000 (base:GHC.Real.fromRational{v 02C}) <> }}} So I'll dig into GHC.Real.fromRational next and see if I can't work out what's going. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 14:15:39 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 14:15:39 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.cdfa5a1408478726318007245e9a2fa6@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141, Phab:D5147, Phab:D5150 -------------------------------------+------------------------------------- Changes (by tdammers): * differential: Phab:D4769, Phab:D5141, Phab:D5147 => Phab:D4769, Phab:D5141, Phab:D5147, Phab:D5150 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 14:24:45 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 14:24:45 -0000 Subject: [GHC] #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 In-Reply-To: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> References: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> Message-ID: <058.ae967972bb60660d1223140e94a5c9ed@haskell.org> #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 -------------------------------------+------------------------------------- Reporter: noah | Owner: tdammers Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | accelerate,memory,compile Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: Compile-time | Test Case: accelerate performance bug | 1.2.0 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Looks like the simplifier blows up core size (compiling `Data.Array.Accelerate.Analysis.Hash`): {{{ Result size of Desugar (after optimization) = {terms: 3,048, ... }}} This is what we get before the simplifier kicks in - perfectly normal. And then the first round of simplification happens: {{{ Result size of Specialise = {terms: 6,666, types: 10,365, coercions: 1,218, joins: 0/5} -- OverSatApps = False}) = {terms: 10,863, types: 14,960, coercions: 1,218, joins: 0/5} -- Result size of Simplifier iteration=1 = {terms: 137,878, -- Result size of Simplifier iteration=2 = {terms: 66,407, types: 72,375, coercions: 25,148, joins: 0/991} Result size of Simplifier = {terms: 66,295, types: 72,319, coercions: 25,148, joins: 0/991} }}} ...increasing core size by a factor of 20 (peaking at 40). And the next round is even worse: {{{ Result size of Simplifier iteration=1 = {terms: 465,354, -- Result size of Simplifier iteration=2 = {terms: 259,229, -- Result size of Simplifier iteration=3 = {terms: 469,826, -- Result size of Simplifier iteration=4 = {terms: 345,027, -- Result size of Simplifier = {terms: 345,027, }}} Our perfectly reasonable 3000-something terms now blow up to over 300k. Now on to figuring out *why* it blows up. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 14:44:50 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 14:44:50 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.4763269f23e0f665c2408218f92d0777@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by JulianLeviston): Seems to be picking `Double` as the type... I noticed that `Double` over `1e309` parses as `Infinity`... {{{#!shell ghc git:(master) ✗ time ./inplace/bin/ghc-stage2 blah2.hs -ddump-tc -dppr- debug [1 of 1] Compiling Blah2 ( blah2.hs, blah2.o ) TYPE SIGNATURES (main:Blah2.$trModule{v r1} [lidx] :: ghc-prim:GHC.Types.Module{tc 622}) :: ghc-prim:GHC.Types.Module{tc 622} (main:Blah2.largeValue{v rpX} [lid] :: ghc-prim:GHC.Types.Double{(w) tc 3k}) :: ghc-prim:GHC.Types.Double{(w) tc 3k} TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] Dependent packages: [base, ghc-prim, integer-gmp] blah2.hs:1:1: ==================== Typechecker ==================== {} ((main:Blah2.$trModule{v r1} [lidx] :: ghc-prim:GHC.Types.Module{tc 622}) :: ghc-prim:GHC.Types.Module{tc 622}) = ghc-prim:GHC.Types.Module{d 625} {} (ghc-prim:GHC.Types.TrNameS{d 62b} {} "main"#) {} (ghc-prim:GHC.Types.TrNameS{d 62b} {} "Blah2"#) {blah2.hs:3:1-22} {blah2.hs:3:1-22} (largeValue{v aLS} [lid] :: ghc-prim:GHC.Types.Double{(w) tc 3k}) :: ghc-prim:GHC.Types.Double{(w) tc 3k} [LclId] main:Blah2.largeValue{v rpX} = {blah2.hs:3:14-22} 1e1000000 (base:GHC.Real.fromRational{v 02C} {} 1e1000000) <> ./inplace/bin/ghc-stage2 blah2.hs -ddump-tc -dppr-debug 0.27s user 0.21s system 96% cpu 0.505 total }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 15:24:35 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 15:24:35 -0000 Subject: [GHC] #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 In-Reply-To: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> References: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> Message-ID: <058.821fa42ad14356b8a54cc7636d7234d3@haskell.org> #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 -------------------------------------+------------------------------------- Reporter: noah | Owner: tdammers Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | accelerate,memory,compile Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: Compile-time | Test Case: accelerate performance bug | 1.2.0 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): So here's an interesting candidate: {{{ -- RHS size: {terms: 27, types: 44, coercions: 4, joins: 0/0} encodeConst encodeConst = \ @ t_areG ds_dtLe ds_dtLf -> case ds_dtLe of { TypeRunit co_areI -> case ds_dtLf `cast` of { () -> mempty $fMonoidBuilder }; TypeRscalar t_aq5y -> encodeScalarConst t_aq5y ds_dtLf; TypeRpair @ a1_areO @ b_areP co_areQ ta_aq5A tb_aq5B -> case ds_dtLf `cast` of { (a_aq5C, b_aq5D) -> <> $fSemigroupBuilder (encodeConst ta_aq5A a_aq5C) (encodeConst tb_aq5B b_aq5D) } } end Rec } }}} Perfectly benign, but after simplification, we get: {{{ -- RHS size: {terms: 81,945, types: 43,626, coercions: 10,191, joins: 0/2,111} encodeConst1_r4XSg encodeConst1_r4XSg ... }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 16:18:07 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 16:18:07 -0000 Subject: [GHC] #15649: Errors about ambiguous untouchable variable when using constraint variable in RankN type In-Reply-To: <048.433118ed22801f4feee0bb734e000e8f@haskell.org> References: <048.433118ed22801f4feee0bb734e000e8f@haskell.org> Message-ID: <063.c15cf6b819317ed30d6231700796f660@haskell.org> #15649: Errors about ambiguous untouchable variable when using constraint variable in RankN type -------------------------------------+------------------------------------- Reporter: infinity0 | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10651, #14921 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by infinity0): OK, thanks for explaining. Looks like adding a `Proxy r` as mentioned on #10651 also works here, and you don't need `AllowAmbiguousTypes` or `TypeApplications`. It might be good to have the error message (r0 is untouchable etc) mention this workaround. (I had known of the trick of giving a ghost parameter in other similar cases with ambiguous types, but here `r` is of kind `* -> Constraint` so that doesn't work and one *has* to use `Proxy` here.) {{{#!haskell loadAll2 :: forall a r . (DynPS r a) => (forall ref. r ref => ref -> PSAny r) -> Proxy r -> a -> Maybe a loadAll2 loader _ r = loadAll (DynLoad' loader :: DynLoad' r) r testCallable2 :: IO (Maybe ()) testCallable2 = return $ loadAll2 undefined (Proxy :: Proxy Unconstrained) () }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 16:22:26 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 16:22:26 -0000 Subject: [GHC] #14921: Type inference breaks on constraint-kinded parameter used by a Rank-2 callback In-Reply-To: <051.12d35c7805454922cc0bcfb2ee8e00e1@haskell.org> References: <051.12d35c7805454922cc0bcfb2ee8e00e1@haskell.org> Message-ID: <066.06ff7c176fd6d613deb9692fcfd51414@haskell.org> #14921: Type inference breaks on constraint-kinded parameter used by a Rank-2 callback -------------------------------------+------------------------------------- Reporter: glittershark | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: invalid | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: #10651, #15649 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by infinity0): As mentioned on the other tickets `Proxy` is an alternative workaround to `TypeApplications` + `AllowAmbiguousTypes`, the latter being quite a strong relaxation that one often doesn't want to enable in library code. {{{#!haskell {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ScopedTypeVariables #-} module Scratch where import Data.Proxy import Prelude data Foo = FooA Int | FooB String useFoo :: forall cls a . (cls Int, cls String) => Proxy cls -> (forall k . cls k => k -> a) -> Foo -> a useFoo _ f (FooA a) = f a useFoo _ f (FooB b) = f b x = useFoo (Proxy :: Proxy Show) show (FooA 1) }}} compiles without errors. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 16:23:33 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 16:23:33 -0000 Subject: [GHC] #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes In-Reply-To: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> References: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> Message-ID: <062.14e2cc4584acfd6f1344a157514b60c3@haskell.org> #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes -------------------------------------+------------------------------------- Reporter: ChaiTRex | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): As you say, `HscInterpreted` means modules are compiled to bytecode and then interpreted. Interpreter can interact with native code and with `-fobject-code` you tell GHCi to compile the loaded modules to native code rather than to bytecode (the default, or `-fbyte-code`). Either way the expressions you type in the GHCi prompt are compiled to bytecode and interpreted, so I think those options are only applied to the loaded modules. We need to avoid optimising those expressions. I think another (simpler) way for this might be to find the top-level function for compiling GHCi expressions to bytecode, and override relevant `DynFlag` fields there so that down the line the desugarer and simplifier do not optimise it. That means no new field to `DynFlags` so think it would be even better. If the top-level function to compile a GHCi expression/statement is also used for other purposes perhaps we can introduce a new top-level function for GHCi only, and override relevant `DynFlags` fields there. How does that sound? Sounds better to me as we don't add more to `DynFlags` (which is already huge). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 16:25:17 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 16:25:17 -0000 Subject: [GHC] #13862: Optional "-v" not allowed with :load in GHCi In-Reply-To: <044.9738400eba372a90ccdc97dcca61b7c9@haskell.org> References: <044.9738400eba372a90ccdc97dcca61b7c9@haskell.org> Message-ID: <059.9593e0e28f3cf088dbab917a1159f1ae@haskell.org> #13862: Optional "-v" not allowed with :load in GHCi -------------------------------------+------------------------------------- Reporter: vanto | Owner: RolandSenn Type: bug | Status: patch Priority: normal | Milestone: 8.8.1 Component: GHCi | Version: 8.0.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #4017 | Differential Rev(s): Phab:D5122 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ömer Sinan Ağacan ): In [changeset:"c6bff526123611d89ea4c92fbc26df221b7ecdd5/ghc" c6bff52/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="c6bff526123611d89ea4c92fbc26df221b7ecdd5" Fix for #13862: Optional "-v" not allowed with :load in GHCi Replace the error message `Use -v to see a list of the files searched for.` with `Use -v (or :set -v` in ghci) to see a list of the files searched for.` Reviewers: bgamari, monoidal, thomie, osa1 Subscribers: rwbarton, carter GHC Trac Issues: #13862 Differential Revision: https://phabricator.haskell.org/D5122 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 16:27:35 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 16:27:35 -0000 Subject: [GHC] #13862: Optional "-v" not allowed with :load in GHCi In-Reply-To: <044.9738400eba372a90ccdc97dcca61b7c9@haskell.org> References: <044.9738400eba372a90ccdc97dcca61b7c9@haskell.org> Message-ID: <059.08c6b66a9fbef0d947ea8aeac95d2cf4@haskell.org> #13862: Optional "-v" not allowed with :load in GHCi -------------------------------------+------------------------------------- Reporter: vanto | Owner: RolandSenn Type: bug | Status: closed Priority: normal | Milestone: 8.8.1 Component: GHCi | Version: 8.0.2 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #4017 | Differential Rev(s): Phab:D5122 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: patch => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 16:28:01 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 16:28:01 -0000 Subject: [GHC] #4017: Unhelpful error message in GHCi In-Reply-To: <046.b126e34ebdc516a2392e1a0dd50d1e4f@haskell.org> References: <046.b126e34ebdc516a2392e1a0dd50d1e4f@haskell.org> Message-ID: <061.53e0e9a70d46cc48c45e075848eaa8e0@haskell.org> #4017: Unhelpful error message in GHCi -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: closed Priority: lowest | Milestone: Component: Compiler | Version: 6.12.2 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #13862 | Differential Rev(s): Phab:D5122 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: patch => closed * resolution: => fixed Comment: I think this is fixed with Phab:D5122. Please re-open if you disagree. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 16 18:02:22 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 16 Sep 2018 18:02:22 -0000 Subject: [GHC] #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` In-Reply-To: <046.74175c624c857c997e111eade5eabf30@haskell.org> References: <046.74175c624c857c997e111eade5eabf30@haskell.org> Message-ID: <061.57924a3b79215434b5764bd6814b7a8d@haskell.org> #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` -------------------------------------+------------------------------------- Reporter: rockbmb | Owner: rockbmb Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Core Libraries | Version: 8.4.3 Resolution: | Keywords: base, | Data.Fixed Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by rockbmb): I just tried sending it again, it does not work. I received no confirmation of having sent the message, and I could not see it in September's threads. I've triple-checked my Mailman settings, I don't know what the issue is. I'll try to solve this so the mail gets sent. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 00:48:31 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 00:48:31 -0000 Subject: [GHC] #13064: Incorrect redudant imports warning In-Reply-To: <045.fe3c1c6b618d0b4877de88fc27add363@haskell.org> References: <045.fe3c1c6b618d0b4877de88fc27add363@haskell.org> Message-ID: <060.445e0c8a1e9f894380df85fe0c69efab@haskell.org> #13064: Incorrect redudant imports warning -------------------------------------+------------------------------------- Reporter: phadej | Owner: (none) Type: bug | Status: new Priority: low | Milestone: 8.8.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #15393 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): To follow up on my proposed experiment (in comment:29), I built about 143 commonly used Hackage libraries using the `wip/T13064` GHC branch. Of those 143, I noticed new warnings being emitted in 31 of them (~22%): {{{ - adjunctions-4.4 - aeson-1.4.0.0 - ansi-wl-pprint-0.6.8.2 - asn1-encoding-0.9.5 - async-2.2.1 - attoparsec-0.13.2.2 - blaze-builder-0.4.1.0 - cassava-0.5.1.0 - conduit-1.3.0.3 - cookie-0.4.4 - foundation-0.0.21 - Glob-0.9.2 - haskell-src-exts-1.20.2 - hspec-core-2.5.6 - lens-4.17 - math-functions-0.3.0.2 - memory-0.14.16 - microstache-1.0.1.1 - mono-traversable-1.0.9.0 - network-2.8.0.0 - primitive-0.6.4.0 - resourcet-1.2.1 - scientific-0.3.6.2 - tasty-1.1.0.3 - th-orphans-0.13.6 - unordered-containers-0.2.9.0 - uuid-types-1.0.3 - x509-1.7.4 - x509-store-1.6.6 - x509-system-1.6.6 - yaml-0.10.1.1 }}} I still advocate adopting this change, but it is worth noting that a non- trivial number of existing libraries will need to be updated in order to accommodate the new warnings. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 03:37:42 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 03:37:42 -0000 Subject: [GHC] #15650: Add (or document if already exist) ability to derive custom typeclasses via source plugins Message-ID: <047.9ed0d12b18c95ae66c807fef4b0f6ff1@haskell.org> #15650: Add (or document if already exist) ability to derive custom typeclasses via source plugins -------------------------------------+------------------------------------- Reporter: chshersh | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Keywords: source | Operating System: Unknown/Multiple plugins,deriving,typeclass | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- == Problem Suppose, I have some custom typeclass `Foo` defined in some library `foo`: {{{#!hs class Foo a where ... some methods ... }}} I would like to be able to derive instances of this typeclass for any possible data type using `deriving` clause just like GHC already does for typeclasses `Eq`, `Ord`, `Show`, `Read`, `Enum`, etc.: {{{#!hs data Bar = Bar | Baz deriving (Eq, Ord, Foo) }}} There're already two possible ways to derive instances of custom typeclasses: 1. `anyclass` deriving strategy (usually involves `Generic`) 2. `-XTemplateHaskell` solution. But I would like to have source-plugin-based solution for this problem so I can just add `-fplugin=Foo.Plugin` and enjoy deriving capabilities. == Advantage over existing approaches Solution with `-XTemplateHaskell` is not that pleasant to write and easy to maintain (you need to use libraries like http://hackage.haskell.org/package/th-abstraction to support multiple GHC versions),involves scoping restriction and is syntactically uglier. Compare: {{{#!hs {-# LANGUAGE TemplateHaskell #-} data Bar = Bar | Baz deriving (Eq, Ord) deriveFoo ''Bar }}} Solution with something like `Generic` introduces performance overhead (required for to/from generic representation conversion). This might not be significant for something like ''parsing CLI arguments'' but it's more important if you want to have efficient binary serialisation. Also, it's known that deriving typeclasses is a relatively slow compilation process (https://github.com/tfausak/tfausak.github.io/issues/127) so there's slight chance that deriving typeclass manually can be slightly faster than deriving `Generic + MyClass`. Especially when maintainers of plugins can experiment with some caching strategies for deriving typeclasses. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 03:39:58 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 03:39:58 -0000 Subject: [GHC] #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes In-Reply-To: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> References: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> Message-ID: <062.0e3de1b1dd36cd1cd4ec1a76905812da@haskell.org> #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes -------------------------------------+------------------------------------- Reporter: ChaiTRex | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by JulianLeviston): That feels like it might be a bit messy. I'll investigate more, though. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 07:17:46 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 07:17:46 -0000 Subject: [GHC] #15508: concprog001 fails with various errors In-Reply-To: <043.7b20754ba25128f911949e43ef11a3db@haskell.org> References: <043.7b20754ba25128f911949e43ef11a3db@haskell.org> Message-ID: <058.f6dbbeb902349a4e2cdfa52d8b07f56f@haskell.org> #15508: concprog001 fails with various errors -------------------------------------+------------------------------------- Reporter: osa1 | Owner: osa1 Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #15571 | Differential Rev(s): Phab:D5051 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonmar): Just came across this ticket. It looks like the problems fall into two categories: * There are segfaults and various barfs when the test is compiled with `-prof` * There is a sanity check failure when the test is compiled without `-prof`, but no segfaults/barfs Is that right? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 07:20:18 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 07:20:18 -0000 Subject: [GHC] #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 In-Reply-To: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> References: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> Message-ID: <058.20c71fb580bb0c644fe7527765766cee@haskell.org> #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 -------------------------------------+------------------------------------- Reporter: noah | Owner: tdammers Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | accelerate,memory,compile Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: Compile-time | Test Case: accelerate performance bug | 1.2.0 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Unfortunately, some dependencies no longer build on GHC HEAD, so I'll try and boil it down to a self-contained reproduction case. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 09:13:27 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 09:13:27 -0000 Subject: [GHC] #15569: Constant folding optimises 1 into 3 In-Reply-To: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> References: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> Message-ID: <065.dce3194952b6215280a84881bcde92a5@haskell.org> #15569: Constant folding optimises 1 into 3 -------------------------------------+------------------------------------- Reporter: snowleopard | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9136 | Differential Rev(s): Phab:D5109 Wiki Page: | -------------------------------------+------------------------------------- Comment (by sgraf): @jean, I'm not particularly invested in the field, but on page 6 in the report I linked there is a table of superoptimizers (I confused these with supercompilation in the past, which is totally different), the respective papers of which might be a good start. In particular, everything doing "synthesis" is probably fueled by an SMT solver. I think the essence boils down to formalising source and target language (which should be same algebraic structure in our example) and let the SMT solver synthesize a RHS to a given LHS expression which has minimal cost wrt. some metric. This seems like the most recent approach: https://arxiv.org/pdf/1711.04422.pdf -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 12:06:39 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 12:06:39 -0000 Subject: [GHC] #15627: Absent unlifted bindings In-Reply-To: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> References: <044.bc86ad63a852b5821c5e83dda4b97374@haskell.org> Message-ID: <059.490837b1fb3d191c9179981a72c5fbe7@haskell.org> #15627: Absent unlifted bindings -------------------------------------+------------------------------------- Reporter: sgraf | Owner: (none) Type: task | Status: patch Priority: normal | Milestone: ⊥ Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9279 #4328 | Differential Rev(s): Phab:D5153 #11126 | Wiki Page: | -------------------------------------+------------------------------------- Changes (by sgraf): * status: new => patch * differential: => Phab:D5153 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 12:31:37 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 12:31:37 -0000 Subject: [GHC] #15650: Add (or document if already exist) ability to derive custom typeclasses via source plugins In-Reply-To: <047.9ed0d12b18c95ae66c807fef4b0f6ff1@haskell.org> References: <047.9ed0d12b18c95ae66c807fef4b0f6ff1@haskell.org> Message-ID: <062.2be6c69bb762c3d87f13d011382c338f@haskell.org> #15650: Add (or document if already exist) ability to derive custom typeclasses via source plugins -------------------------------------+------------------------------------- Reporter: chshersh | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: source | plugins,deriving,typeclass Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): I am far from an expert on source plugins, so I can't say whether this is possible or not. But my initial reaction is: sure, why not? I could imagine an API like this: {{{#!hs type Derived a = a class Foo a where ... data Bar deriving (Derived Foo) }}} Here, the use of `Derived` is a syntactic clue to a source plugin to derive this using some custom functionality (instead of just trying to derive `Foo` normally). To make this robust, you'd likely need to borrow some of GHC's own logic for `deriving` type classes. Luckily, GHC already exposes much of this! See the `TcDeriv`, `TcGenDeriv`, and `TcDerivUtils` modules. I certainly don't have the time to try this out myself, but I'd be happy point any volunteers in the right direction. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 12:33:33 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 12:33:33 -0000 Subject: [GHC] #12457: Deriving should be (more closely) integrated with other metaprogramming methods In-Reply-To: <049.722143f91b930762e66d90cff1b491ea@haskell.org> References: <049.722143f91b930762e66d90cff1b491ea@haskell.org> Message-ID: <064.f0a526fbe933930283ba72891807e5dd@haskell.org> #12457: Deriving should be (more closely) integrated with other metaprogramming methods -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: deriving Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15650 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * related: => #15650 Comment: Source plugins might offer one way forward here. See #15650. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 12:33:54 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 12:33:54 -0000 Subject: [GHC] #15650: Add (or document if already exist) ability to derive custom typeclasses via source plugins In-Reply-To: <047.9ed0d12b18c95ae66c807fef4b0f6ff1@haskell.org> References: <047.9ed0d12b18c95ae66c807fef4b0f6ff1@haskell.org> Message-ID: <062.29c7df8bb8120ae291db2a3234497563@haskell.org> #15650: Add (or document if already exist) ability to derive custom typeclasses via source plugins -------------------------------------+------------------------------------- Reporter: chshersh | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: source | plugins,deriving,typeclass Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #12457 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * related: => #12457 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 12:37:30 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 12:37:30 -0000 Subject: [GHC] #15650: Add (or document if already exist) ability to derive custom typeclasses via source plugins In-Reply-To: <047.9ed0d12b18c95ae66c807fef4b0f6ff1@haskell.org> References: <047.9ed0d12b18c95ae66c807fef4b0f6ff1@haskell.org> Message-ID: <062.e473ced7c8cd35d91fc9dd0d7d3c9eeb@haskell.org> #15650: Add (or document if already exist) ability to derive custom typeclasses via source plugins -------------------------------------+------------------------------------- Reporter: chshersh | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: source | plugins,deriving,typeclass Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by mpickering): * related: #12457 => Comment: I have been playing around with this problem this morning. There are some engineering issues to do with the phase ordering. Plugins run at the end of the specific phase so you need to at least run a renamer plugin to remove the instances like `Derived Foo` from the deriving list. Then you probably need to also to implement a type checker plugin to solve the instances you are yet to create and finally, actually generate the instances with `TcDeriv` and so on. One way around this might be to implement the deriving all in a renamer plugin as then you can just directly generate the `instance Foo a where..` syntax and pass it into the type checker. Now typing this out, this seems a more robust and easy solution to implement. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 14:31:55 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 14:31:55 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.18e021caec5e2492f4cfd8470ee76a32@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by monoidal): The literal `1e100` means `fromRational (100...000 :: Rational)`, as specified in Haskell report. Constructing this number takes time and space proportional to the number of zeroes. It's not surprising it crashes badly when the exponent has 10 digits or more. On the other hand, the type of `10^1000000000` can be found quickly because the expression is not evaluated. The big integer is already created during parsing (as can be seen by compiling `main = print 1e1000` with `-ddump-parsed-ast`). With `-XNumDecimals`, we need to process the literal before we can tell its type: `1.234e3` is a valid `Integer` but `1.234e2` is not. I don't see any easy way to fix this and preserve backwards compatibility. Perhaps we could show a parse error when attempting to create an integer with an unrealistic exponent. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 15:57:16 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 15:57:16 -0000 Subject: [GHC] #8763: forM_ [1..N] does not get fused (allocates 50% more) In-Reply-To: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> References: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> Message-ID: <057.9b800b167275e70b90d256b88fc51eaa@haskell.org> #8763: forM_ [1..N] does not get fused (allocates 50% more) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #7206 | Differential Rev(s): Phab:D5131 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Let's commit this! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 16:23:34 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 16:23:34 -0000 Subject: [GHC] #15638: Make Ptr argument to hGetBuf and hGetBufSome strict In-Reply-To: <049.608270165e285391187968b39cb4c836@haskell.org> References: <049.608270165e285391187968b39cb4c836@haskell.org> Message-ID: <064.baffe4445078bfa6d94a2b44398965ce@haskell.org> #15638: Make Ptr argument to hGetBuf and hGetBufSome strict -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: task | Status: patch Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Krzysztof Gogolewski ): In [changeset:"88130dbe948eaa7f76cf237d8aba17b41fac4904/ghc" 88130dbe/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="88130dbe948eaa7f76cf237d8aba17b41fac4904" base: Add bangs to GHC.IO.Handle.Text hGet* functions Summary: I believe that demand analysis doesn't notice that these are morally strict in the pointer argument due to the `count == 0` special case. Fixes #15638. Test Plan: Validate Reviewers: andrewthad, hvr Reviewed By: andrewthad Subscribers: rwbarton, carter GHC Trac Issues: #15638 Differential Revision: https://phabricator.haskell.org/D5149 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 16:26:09 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 16:26:09 -0000 Subject: [GHC] #15638: Make Ptr argument to hGetBuf and hGetBufSome strict In-Reply-To: <049.608270165e285391187968b39cb4c836@haskell.org> References: <049.608270165e285391187968b39cb4c836@haskell.org> Message-ID: <064.66778d56d98c1f9ff6b8f5384131227a@haskell.org> #15638: Make Ptr argument to hGetBuf and hGetBufSome strict -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: task | Status: closed Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: patch => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 19:21:16 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 19:21:16 -0000 Subject: [GHC] #15584: nonVoid is too conservative w.r.t. strict argument types In-Reply-To: <050.6cca1c180a42ae3c8a5210a8b2be904f@haskell.org> References: <050.6cca1c180a42ae3c8a5210a8b2be904f@haskell.org> Message-ID: <065.9193e0d7a2b3fdedba26826048616359@haskell.org> #15584: nonVoid is too conservative w.r.t. strict argument types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: | PatternMatchWarnings Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #15305 | Differential Rev(s): Phab:D5116 Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): How clever do we want to be here? Users need to be able to predict, reasonably reliably, how far they should go in explaining totality to the compiler. We certainly wouldn't want GHC to complain about a redundant pattern match in {{{#!hs f :: S -> a f (MkS (MkV v)) = absurd v }}} because that's perfectly reasonable code. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 19:35:47 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 19:35:47 -0000 Subject: [GHC] #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings In-Reply-To: <051.1afac0be4b689267d905f3e66b5a2d7d@haskell.org> References: <051.1afac0be4b689267d905f3e66b5a2d7d@haskell.org> Message-ID: <066.99750f673427f0317c86755c86ec8e19@haskell.org> #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by NeilMitchell): Proposal raised at https://github.com/ghc-proposals/ghc-proposals/pull/168 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 20:25:40 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 20:25:40 -0000 Subject: [GHC] #8763: forM_ [1..N] does not get fused (allocates 50% more) In-Reply-To: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> References: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> Message-ID: <057.55c7738a2e9cf3a355019a245af63084@haskell.org> #8763: forM_ [1..N] does not get fused (allocates 50% more) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #7206 | Differential Rev(s): Phab:D5131 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Krzysztof Gogolewski ): In [changeset:"e655aac18c5b240f27fcaf26317ad87be5ce8b96/ghc" e655aac1/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="e655aac18c5b240f27fcaf26317ad87be5ce8b96" Make sure forM_ and related functions fuse cleanly Summary: It was revealed in #8763 that it's hard to come up with a list fusion helper for `efdtIntFB` that doesn't duplicated occurrences of `c`, which is crucial in guaranteeing that it is inlined. Not inlining `c` led to spoiled join points, in turn leading to unnecessary heap allocation. This patch tackles the problem from a different angle: Fixing all consumers instead of the less often used producer `efdtIntFB` by inserting an INLINE pragma in the appropriate places. See https://ghc.haskell.org/trac/ghc/ticket/8763#comment:76 and the new Note [List fusion and continuations in 'c']. A quick run of NoFib revealed no regression or improvements whatsoever. Reviewers: hvr, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, carter GHC Trac Issues: #8763 Differential Revision: https://phabricator.haskell.org/D5131 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 20:27:53 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 20:27:53 -0000 Subject: [GHC] #8763: forM_ [1..N] does not get fused (allocates 50% more) In-Reply-To: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> References: <042.6416bb310965de24a032dfcecd66fba0@haskell.org> Message-ID: <057.80f63586409400c31a518781044fdc93@haskell.org> #8763: forM_ [1..N] does not get fused (allocates 50% more) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 7.6.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #7206 | Differential Rev(s): Phab:D5131 Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: new => merge Comment: Not sure if we'd like to merge this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 20:45:44 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 20:45:44 -0000 Subject: [GHC] #15651: Check if some auto apply code is dead and remove if appropriate. Message-ID: <047.b33d42ff3387d371d86604cad9cfe127@haskell.org> #15651: Check if some auto apply code is dead and remove if appropriate. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.6.1 Component: Runtime | Version: 8.4.3 System | Keywords: Newcomer | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- There is a whole family of stg_ap_stk_* and stg_stk_save_* functions generated in AutoApply.cmm which as far as I can tell is not used anywhere in the compiler and can likely be removed. In particular this would involve: * Stop the code in question from being generated. (utils/genapply) * Make sure that doesn't break things. (Validate/Run the testsuite). * Grep for stk in the compiler to make sure we don't build calls to these in rare circumstances with string concatenation for extra safety. * Document the change in patch notes just in case. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 21:31:00 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 21:31:00 -0000 Subject: [GHC] #13617: GHCi linker does not honor alignment of sections. In-Reply-To: <050.e6156dbdb2fd87e0bc8e4bf60775489f@haskell.org> References: <050.e6156dbdb2fd87e0bc8e4bf60775489f@haskell.org> Message-ID: <065.87d50e806bbf0fe70b3a3a5aa93e4442@haskell.org> #13617: GHCi linker does not honor alignment of sections. --------------------------------+---------------------------------------- Reporter: RyanGlScott | Owner: Phyx- Type: bug | Status: patch Priority: normal | Milestone: 8.8.1 Component: GHCi | Version: 8.0.2 Resolution: | Keywords: Operating System: Windows | Architecture: Unknown/Multiple Type of failure: GHCi crash | Test Case: T13617 Blocked By: | Blocking: Related Tickets: #7134 | Differential Rev(s): Phab:D3915 Wiki Page: | --------------------------------+---------------------------------------- Comment (by Tamar Christina ): In [changeset:"5840734379da5d494a368d0b8a6edf1b1216a7f4/ghc" 5840734/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="5840734379da5d494a368d0b8a6edf1b1216a7f4" Updated PE linker, section alignment and cleanup. Summary: This patch is to address a couple of short comings of the PE linker. The first thing it does is properly honor section alignments, so SSE code will work reliably. While doing this I've also changed how it reads and stores ObjectFile information. Previously the entire object file was read in and treated as one blob, including headers, symbol tables etc. Now the ObjectFile is read in but stored in chunks, tables go into a temporary info struct and code/data into a new private heap. This allows me to free all meta data once we're done relocating. Which means we can reclaim this memory. As I've mentioned above I've also moved from using VirtualAlloc to HeapAlloc. The reason is VirtualAlloc is meant to be used for more low level memory allocation, it's very fast because it can only allocate whole blocks, (64k) by default, and the memory must be paged (4k) aligned. So when you ask for e.g. 30k of memory, you're given a whole block where 34k will be wasted memory. Nothing else can ever access that untill you free the 30k. One downside of HeapAlloc is that you're not in control of how the heap grows, and heap memory is always committed. So it's harder to tell how much we're actually using now. Another big upside of splitting off the ObjectCode tables to info structs is that I can adjust them, so that later addressings can just use array subscripts to index into them. This simplifies the code a lot and a lot of complicated casts and indexing can be removed. Leaving less and more simple code. This patch doesn't fix the memprotection but it doesn't regress it either. It does however make the next changes smaller and fixes the alignments. Test Plan: ./validate , new test T13617 Reviewers: bgamari, erikd, simonmar, hvr, angerman Reviewed By: angerman Subscribers: nickkuk, carter, RyanGlScott, rwbarton, thomie GHC Trac Issues: #13617 Differential Revision: https://phabricator.haskell.org/D3915 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 17 21:38:35 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 17 Sep 2018 21:38:35 -0000 Subject: [GHC] #13617: GHCi linker does not honor alignment of sections. In-Reply-To: <050.e6156dbdb2fd87e0bc8e4bf60775489f@haskell.org> References: <050.e6156dbdb2fd87e0bc8e4bf60775489f@haskell.org> Message-ID: <065.fae978d1a53653401169334e9579cd15@haskell.org> #13617: GHCi linker does not honor alignment of sections. --------------------------------+---------------------------------------- Reporter: RyanGlScott | Owner: Phyx- Type: bug | Status: closed Priority: normal | Milestone: 8.8.1 Component: GHCi | Version: 8.0.2 Resolution: fixed | Keywords: Operating System: Windows | Architecture: Unknown/Multiple Type of failure: GHCi crash | Test Case: T13617 Blocked By: | Blocking: Related Tickets: #7134 | Differential Rev(s): Phab:D3915 Wiki Page: | --------------------------------+---------------------------------------- Changes (by Phyx-): * status: patch => closed * resolution: => fixed Comment: This is *finally* closed. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 01:10:13 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 01:10:13 -0000 Subject: [GHC] #15201: GHC 8.4 fails to build on Debian s390x In-Reply-To: <044.625246c98fa687e3f833d1f81c733f4b@haskell.org> References: <044.625246c98fa687e3f833d1f81c733f4b@haskell.org> Message-ID: <059.95610167f29bc55fe4717b39df9a74a3@haskell.org> #15201: GHC 8.4 fails to build on Debian s390x ---------------------------------+---------------------------------------- Reporter: clint | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Linux | Architecture: Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+---------------------------------------- Changes (by clint): * os: Unknown/Multiple => Linux * architecture: Other => Unknown/Multiple Comment: https://salsa.debian.org/haskell- team/DHG_packages/blob/experimental/p/ghc/debian/patches/fix-build-using- unregisterized-v8.2 appears to work -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 01:15:18 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 01:15:18 -0000 Subject: [GHC] #15208: GHC 8.4 fails to build on Debian armel (softfloat) In-Reply-To: <044.485dae4c163d04b201fd244d05e7bdd0@haskell.org> References: <044.485dae4c163d04b201fd244d05e7bdd0@haskell.org> Message-ID: <059.58ead54636dae390b9f3c9bf59420c10@haskell.org> #15208: GHC 8.4 fails to build on Debian armel (softfloat) ---------------------------------+------------------------------ Reporter: clint | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Linux | Architecture: arm Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+------------------------------ Comment (by clint): https://salsa.debian.org/haskell- team/DHG_packages/blob/experimental/p/ghc/debian/patches/armel-revert- ghci-fixes.patch appears to work -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 04:38:49 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 04:38:49 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.2afed300f8152c2cda9925eae071b99b@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): > The literal 1e100 means fromRational (100...000 :: Rational), as specified in > Haskell report Where is this specified in the report? I can see the syntax in section 2.5 which links to sections 3.4 and 6.4.1 but I can't see this rule in any of those linked sections. Can't find where the semantics for this literal is defined. > It's not surprising it crashes badly when the exponent has 10 digits or more. Wait, are you saying that typing `1e1234111111111111111111111` to take minutes and use up more than 20G of memory (residence, not allocation!) not surprising? Perhaps I'm completely lost then. Could you elaborate on how is this not surprising? FWIW I just typed in that expression in Python REPL and it gave me an answer in an instant. > With -XNumDecimals, we need to process the literal before we can tell its > type: 1.234e3 is a valid Integer but 1.234e2 is not. I'm still not convinced that we can't do better but OK. At the very least we should be able to type those expressions quickly when `-XNumDecimals` is not enabled (which is the default). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 04:46:49 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 04:46:49 -0000 Subject: [GHC] #11671: Allow labels starting with uppercase with OverloadedLabels In-Reply-To: <044.a0bb36a4fb997b6415af764b9c7b0bc1@haskell.org> References: <044.a0bb36a4fb997b6415af764b9c7b0bc1@haskell.org> Message-ID: <059.ad1f5c8cbbff4c43019d053ed9975f27@haskell.org> #11671: Allow labels starting with uppercase with OverloadedLabels -------------------------------------+------------------------------------- Reporter: inaki | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1-rc1 (Parser) | Resolution: | Keywords: ORF Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): There's a patch for this feature but it needs to go through the proposal process: https://github.com/ghc/ghc/pull/192 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 05:02:38 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 05:02:38 -0000 Subject: [GHC] #15642: Improve the worst case performance of weak pointers In-Reply-To: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> References: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> Message-ID: <060.b7277416c3bf6ea7721bc60d0c8df829@haskell.org> #15642: Improve the worst case performance of weak pointers -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.8.1 Component: Runtime System | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): Hmm I think (1) is a good idea. Just one traversal over all weaks before GC to tag keys, then any live key will be untagged during evacuation. (did I get this right?) Out of curiosity, are you observing any slowness/long pauses in a real program because of collecting weaks? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 05:04:24 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 05:04:24 -0000 Subject: [GHC] #15651: Check if some auto apply code is dead and remove if appropriate. In-Reply-To: <047.b33d42ff3387d371d86604cad9cfe127@haskell.org> References: <047.b33d42ff3387d371d86604cad9cfe127@haskell.org> Message-ID: <062.aa6f491f892ad21f723d613086b3d51c@haskell.org> #15651: Check if some auto apply code is dead and remove if appropriate. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.4.3 Resolution: | Keywords: Newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * cc: osa1 (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 05:07:07 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 05:07:07 -0000 Subject: [GHC] #15508: concprog001 fails with various errors In-Reply-To: <043.7b20754ba25128f911949e43ef11a3db@haskell.org> References: <043.7b20754ba25128f911949e43ef11a3db@haskell.org> Message-ID: <058.32e27508168915f220f8989b5d687b7d@haskell.org> #15508: concprog001 fails with various errors -------------------------------------+------------------------------------- Reporter: osa1 | Owner: osa1 Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #15571 | Differential Rev(s): Phab:D5051 Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): That's right. In my testing this program does not fail if I don't use debug or prof runtimes. I think the debug runtime issue is #15571. I don't know if there are other problems though. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 05:12:49 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 05:12:49 -0000 Subject: [GHC] #15642: Improve the worst case performance of weak pointers In-Reply-To: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> References: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> Message-ID: <060.2c72805b4d7fa96966f5d1ced2dc65a1@haskell.org> #15642: Improve the worst case performance of weak pointers -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.8.1 Component: Runtime System | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): Replying to [comment:9 osa1]: > Hmm I think (1) is a good idea. Just one traversal over all weaks before GC to tag keys, then any live key will be untagged during evacuation. (did I get this right?) Sounds right to me. > Out of curiosity, are you observing any slowness/long pauses in a real program because of collecting weaks? I've never written a practical program using weak references. I just think worst-case quadratic time garbage collection sounds pretty bad. Can we fix it without making more common cases worse? Dunno, but I think it's worth trying. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 05:14:30 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 05:14:30 -0000 Subject: [GHC] #15642: Improve the worst case performance of weak pointers In-Reply-To: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> References: <045.b8d71ba53c8e2932bac5a373812a1724@haskell.org> Message-ID: <060.0c783cf2122c07a45a74d2a9128d6038@haskell.org> #15642: Improve the worst case performance of weak pointers -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.8.1 Component: Runtime System | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): Oh, and the hash table can just point to the first weak for each key and we can chain them up. We just need to skip over any manually finalized ones when we traverse. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 08:03:50 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 08:03:50 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.60a4a0d870ddfae0f4be54186633140e@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > Wait, are you saying that typing 1.7e1234111111111111111111111 to take minutes and use up more than 20G of memory (residence, not allocation!) not surprising? I agree: that's absurd! HOwever, unlike Python, we can't just compute a suitable `Float`, because literals are overloaded. The [https://www.haskell.org/onlinereport/haskell2010/haskellch3.html#x8-240003.2 Report] does say that a floating point literal like `1e100` means `fromRational (n % d)` where "the integers n and d are chosen so that n/d = f". I suspect that in computing `17 % 10000000000000000000000` we try to find the GCD of the two before we even start with `fromRational`, and you can see this isn't going to end well. What to do? Probably we need a special case for `fromRational :: Rational -> Float` (and similarly `Double`); and maybe even a special literal representation inside GHC for `Rational`s of form `N / 10000000000000` for some number of zeros. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 09:10:40 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 09:10:40 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.660a3d0ca834dfba9cbd8f2296cbef7a@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): > a floating point literal like 1e100 means fromRational (n % d) where "the > integers n and d are chosen so that n/d = f" But finding the n and d should happen after type checking, no? Why idoes this even effect type checking time? Shouldn't `:t` just do type checking? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 10:27:28 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 10:27:28 -0000 Subject: [GHC] #15510: Qualified Holes In-Reply-To: <049.e79fa23b6a2782343800cacfefeeaef8@haskell.org> References: <049.e79fa23b6a2782343800cacfefeeaef8@haskell.org> Message-ID: <064.e552d658a5837e798b3dad9c8560c626@haskell.org> #15510: Qualified Holes -------------------------------------+------------------------------------- Reporter: andrewthad | Owner: (none) Type: feature request | Status: new Priority: low | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by sgraf): * milestone: 8.6.1 => 8.8.1 Comment: I don't think this will happen in GHC 8.6. Revert if you disagree. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 10:57:09 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 10:57:09 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.0b4ab2e091600a1141cdfee1b28dece7@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by monoidal): > I suspect that in computing 17 % 10000000000000000000000 we try to find the GCD of the two before we even start with fromRational, and you can see this isn't going to end well. It's not even GCD: just computing the nominator of 1e1000000000 in the binary representation requires at least `log2(10**1000000000)` bits of memory, which is over 396GB. If we'd like to fix this, I see the following options: a. Move computation of n,d from typechecking to desugaring. This should allow `:t 1e1000000000`, but `let x _ = 1e1000000000` will still crash. b. Add a method to `Fractional`, say `fromMantissaExp :: Integer -> Integer -> Integer -> a` that will be called instead of `fromRational`, with a default implementation that calls `fromRational`. This will allow `let x _ = 1e1000000000` to work, we could make it return Infinity for `Double`. This will likely have performance implications (I'm not sure if positive or negative). c. Change the representation of `Ratio` to have an extra constructor that represents numbers of the form `N / D * 10**E`. All those solutions need some extra special cases for `-XNumDecimals`. It's doable, I'm not convinced it's worth the maintenance cost but I won't protest if it's done. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 12:57:42 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 12:57:42 -0000 Subject: [GHC] #15584: nonVoid is too conservative w.r.t. strict argument types In-Reply-To: <050.6cca1c180a42ae3c8a5210a8b2be904f@haskell.org> References: <050.6cca1c180a42ae3c8a5210a8b2be904f@haskell.org> Message-ID: <065.ec232023a966047a69afb0a87479445f@haskell.org> #15584: nonVoid is too conservative w.r.t. strict argument types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: | PatternMatchWarnings Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #15305 | Differential Rev(s): Phab:D5116 Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Replying to [comment:2 dfeuer]: > Users need to be able to predict, reasonably reliably, how far they should go in explaining totality to the compiler. I agree! This proposed change would make it easier for users' to predict when a function is total. The rule is this: if it is possible to pass a well typed argument to a function //that doesn't bottom when demanded//, then that function must match that argument in order to be considered total. (The part in italics is what is new in GHC 8.8 after #15305, and further improved upon in this ticket.) > We certainly wouldn't want GHC to complain about a redundant pattern match in > > {{{#!hs > f :: S -> a > f (MkS (MkV v)) = absurd v > }}} > > because that's perfectly reasonable code. I would disagree about this being perfectly reasonable code—there's no reason to ever match on `MkS` (or `MkV`), since that is guaranteed to bottom when demanded. In other words, it's another form of unreachable code, since calling `f (MkS (MkV ⊥))` will bottom out before `MkV` (or `MkS`) are ever reached. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 13:12:59 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 13:12:59 -0000 Subject: [GHC] #10859: Generated Eq instance associates && wrongly In-Reply-To: <046.4f10604a3fa32deb15c9056d38ba731c@haskell.org> References: <046.4f10604a3fa32deb15c9056d38ba731c@haskell.org> Message-ID: <061.33e63abdc436602612e59af4b43df425@haskell.org> #10859: Generated Eq instance associates && wrongly -------------------------------------+------------------------------------- Reporter: nomeata | Owner: simonpj Type: bug | Status: closed Priority: lowest | Milestone: 8.6.1 Component: Compiler | Version: 7.10.2 Resolution: fixed | Keywords: deriving, | newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #10858 | Differential Rev(s): Phab:D5104 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: Merged in bc907262b40d09b479d100875b26f1add352523a. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 13:13:17 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 13:13:17 -0000 Subject: [GHC] #15572: TH improperly converts promoted data cons in ConT In-Reply-To: <050.0e46c20217a7ed360417cc67421971cd@haskell.org> References: <050.0e46c20217a7ed360417cc67421971cd@haskell.org> Message-ID: <065.eec1393a4a57a2a97cc3deaacf38d5b0@haskell.org> #15572: TH improperly converts promoted data cons in ConT -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Template Haskell | Version: 8.4.3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: th/T15572 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5112 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: Merged in ebc8ebf89332ddac3039ff87331c4c053ae516ea. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 13:13:39 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 13:13:39 -0000 Subject: [GHC] #15550: Names of RULES aren't quoted in -ddump-splices In-Reply-To: <050.b5daffb0170f6fb061ff2380766e1195@haskell.org> References: <050.b5daffb0170f6fb061ff2380766e1195@haskell.org> Message-ID: <065.715b7ef8a034dcbcd90c9cd2feb346fb@haskell.org> #15550: Names of RULES aren't quoted in -ddump-splices -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Template Haskell | Version: 8.4.3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5090 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: Merged with 2cdb2de12ce4a96269cfa5fcd69dabfc4eb99786. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 13:13:52 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 13:13:52 -0000 Subject: [GHC] #15509: `showEFloat` inconsistency introduced in base-4.12 In-Reply-To: <042.b4d95dcfedcc55594395a53ebe2f16f7@haskell.org> References: <042.b4d95dcfedcc55594395a53ebe2f16f7@haskell.org> Message-ID: <057.32bd63243fe8aeae8fa4ee0a1bc070bd@haskell.org> #15509: `showEFloat` inconsistency introduced in base-4.12 -------------------------------------+------------------------------------- Reporter: hvr | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5083 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: Merged with 2116932ef55fe2f11e04f9a9e593bc73a2e96680. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 13:14:09 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 13:14:09 -0000 Subject: [GHC] #15577: TypeApplications-related infinite loop (GHC 8.6+ only) In-Reply-To: <050.727e460d0083534afd4869db4aa81c30@haskell.org> References: <050.727e460d0083534afd4869db4aa81c30@haskell.org> Message-ID: <065.6e7a2da81be51b8105987f965a9ba12d@haskell.org> #15577: TypeApplications-related infinite loop (GHC 8.6+ only) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: high | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.5 checker) | Keywords: Resolution: fixed | TypeApplications, TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: Merged with 83ca9bb257ff9e0b9ebfa37ba1449118d15543a2. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 13:36:59 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 13:36:59 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.cb6fe94487fec19b2c88034c31ba95ee@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by alpmestan): * cc: alpmestan (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 14:20:28 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 14:20:28 -0000 Subject: [GHC] #15502: -ddump-splices truncates Integer literals to Int literals In-Reply-To: <047.99c2e69e35ad36d7625dca8406cf953c@haskell.org> References: <047.99c2e69e35ad36d7625dca8406cf953c@haskell.org> Message-ID: <062.cfdde67001167ec666e11f77509468b5@haskell.org> #15502: -ddump-splices truncates Integer literals to Int literals -------------------------------------+------------------------------------- Reporter: ChaiTRex | Owner: (none) Type: bug | Status: closed Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5089, Wiki Page: | Phab:D5151 -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: Merged comment:6 with 6cad8e31dc852594aad8512d01eb9730d3371249 and comment:3 with 8344588e23fc9bb3c1b15e81edd316134c9860ec. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 14:21:56 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 14:21:56 -0000 Subject: [GHC] #15621: Error message involving type families points to wrong location In-Reply-To: <050.f6fd8f38eae3af90b1d1147a0e35ac2c@haskell.org> References: <050.f6fd8f38eae3af90b1d1147a0e35ac2c@haskell.org> Message-ID: <065.3310a9e2087e518883ce96c9c5bb9dd8@haskell.org> #15621: Error message involving type families points to wrong location -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.4.3 checker) | Resolution: | Keywords: TypeFamilies Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * milestone: 8.6.1 => 8.8.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 14:49:46 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 14:49:46 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.709f20288bac85af811b777af2ea7f2c@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141, Phab:D5147, Phab:D5150 -------------------------------------+------------------------------------- Comment (by simonpj): Plan (c.f. comment:114) * Commit Step 0 (unless there is some reason not to) * Commit Step 1 (ditto) * Step 2: Phab:D5147. Ben says there are Lint errors, which sounds mysterious. He will explain how to reproduce this. * Step 3: still to come. Let's get this done! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 15:29:09 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 15:29:09 -0000 Subject: [GHC] #11284: Lambda-lifting fails in simple Text example In-Reply-To: <046.c8fcc117f2d6aac596767173f5e9481b@haskell.org> References: <046.c8fcc117f2d6aac596767173f5e9481b@haskell.org> Message-ID: <061.6178d97cf87c5e9d0edf25516fe52aab@haskell.org> #11284: Lambda-lifting fails in simple Text example -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #5945, #11318 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by sgraf): * cc: sgraf (added) Comment: Sorry, I didn't pick your reply up in the ticket noise. I ''think'' we would pick it up. This is the STG binding for `$wloop_length`: https://gist.github.com/sgraf812/fcfda9e55004d19881314e31fdea4423 As this turned into a join point anyway, no closure mentions `$wloop`, so there will be no positive closure growth (e.g. penalties in allocations). `$wloop` also has only 3 free variables, which adds with the 2 arguments to a fortunate 5, so there would be enough hardware registers for the lift. I don't see any reason we wouldn't have lifted it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 15:38:08 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 15:38:08 -0000 Subject: [GHC] #13600: surprising error message with bang pattern In-Reply-To: <051.cb1136f932f929f97ddeb5e4dd8a6304@haskell.org> References: <051.cb1136f932f929f97ddeb5e4dd8a6304@haskell.org> Message-ID: <066.d9fa0f6c66ec6b9c5ec3f024e23c8747@haskell.org> #13600: surprising error message with bang pattern -------------------------------------+------------------------------------- Reporter: andrewufrank | Owner: v0d1ch Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: BangPatterns, | newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Poor/confusing | Test Case: T13600, error message | T13600b Blocked By: | Blocking: Related Tickets: #15166, #15458 | Differential Rev(s): Phab:D5040 Wiki Page: | -------------------------------------+------------------------------------- Changes (by v0d1ch): * testcase: => T13600, T13600b -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 15:59:52 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 15:59:52 -0000 Subject: [GHC] #15651: Check if some auto apply code is dead and remove if appropriate. In-Reply-To: <047.b33d42ff3387d371d86604cad9cfe127@haskell.org> References: <047.b33d42ff3387d371d86604cad9cfe127@haskell.org> Message-ID: <062.6eb034781db7e79683a5a23d3554d4d1@haskell.org> #15651: Check if some auto apply code is dead and remove if appropriate. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.8.1 Component: Runtime System | Version: 8.4.3 Resolution: | Keywords: Newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by sgraf): * cc: sgraf (added) * milestone: 8.6.1 => 8.8.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 17:06:43 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 17:06:43 -0000 Subject: [GHC] #15196: Invert floating point comparisons such that no extra parity check is required. In-Reply-To: <047.7b7b81a2e120787e43a042c6cb25c543@haskell.org> References: <047.7b7b81a2e120787e43a042c6cb25c543@haskell.org> Message-ID: <062.b64d363a6eecd69913f70590a294c4f1@haskell.org> #15196: Invert floating point comparisons such that no extra parity check is required. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: task | Status: patch Priority: normal | Milestone: 8.8.1 Component: Compiler (NCG) | Version: 8.4.3 Resolution: | Keywords: CodeGen Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4990 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Krzysztof Gogolewski ): In [changeset:"6bb9bc7d3c935dcb77e0700cce28de2c9df646df/ghc" 6bb9bc7/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="6bb9bc7d3c935dcb77e0700cce28de2c9df646df" Invert FP conditions to eliminate the explicit NaN check. Summary: Optimisation: we don't have to test the parity flag if we know the test has already excluded the unordered case: eg > and >= test for a zero carry flag, which can only occur for ordered operands. By reversing comparisons we can avoid testing the parity for < and <= as well. This works since: * If any of the arguments is an NaN CF gets set. Resulting in a false result. * Since this allows us to rule out NaN we can exchange the arguments and invert the direction of the arrows. Test Plan: ci/nofib Reviewers: carter, bgamari, alpmestan Reviewed By: alpmestan Subscribers: alpmestan, simonpj, jmct, rwbarton, thomie GHC Trac Issues: #15196 Differential Revision: https://phabricator.haskell.org/D4990 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 17:08:44 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 17:08:44 -0000 Subject: [GHC] #15196: Invert floating point comparisons such that no extra parity check is required. In-Reply-To: <047.7b7b81a2e120787e43a042c6cb25c543@haskell.org> References: <047.7b7b81a2e120787e43a042c6cb25c543@haskell.org> Message-ID: <062.f49d7925b32d027c476eba6cccdef54b@haskell.org> #15196: Invert floating point comparisons such that no extra parity check is required. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: task | Status: merge Priority: normal | Milestone: 8.8.1 Component: Compiler (NCG) | Version: 8.4.3 Resolution: | Keywords: CodeGen Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4990 Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: patch => merge -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 17:43:34 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 17:43:34 -0000 Subject: [GHC] #11042: Template Haskell / GHCi does not respect extra-lib-dirs In-Reply-To: <044.eb43e7f9b5666e68e3df817728c4c87b@haskell.org> References: <044.eb43e7f9b5666e68e3df817728c4c87b@haskell.org> Message-ID: <059.8df6fd94a700fcd8525010ff6e253cbc@haskell.org> #11042: Template Haskell / GHCi does not respect extra-lib-dirs -------------------------------------+------------------------------------- Reporter: mboes | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash | Test Case: Blocked By: 11238 | Blocking: Related Tickets: #10458 #5289 | Differential Rev(s): #12753 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by awson): I've concocted a fix for this based on a very simple idea. The idea is: don't crash early. `load_dyn` simply not crashes when `loadDLL` fails. Instead `load_dyn` issues a warning, stating that it can't load the dll and that some symbols may remain unresolved. If the latter is the case it crashes later eventually. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 17:44:41 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 17:44:41 -0000 Subject: [GHC] #11042: Template Haskell / GHCi does not respect extra-lib-dirs In-Reply-To: <044.eb43e7f9b5666e68e3df817728c4c87b@haskell.org> References: <044.eb43e7f9b5666e68e3df817728c4c87b@haskell.org> Message-ID: <059.c957f599087fee90389699d6d5ea0cdf@haskell.org> #11042: Template Haskell / GHCi does not respect extra-lib-dirs -------------------------------------+------------------------------------- Reporter: mboes | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash | Test Case: Blocked By: 11238 | Blocking: Related Tickets: #10458 #5289 | Differential Rev(s): #12753 | Wiki Page: | -------------------------------------+------------------------------------- Changes (by awson): * Attachment "11042_fix.patch" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 18:00:23 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 18:00:23 -0000 Subject: [GHC] #11042: Template Haskell / GHCi does not respect extra-lib-dirs In-Reply-To: <044.eb43e7f9b5666e68e3df817728c4c87b@haskell.org> References: <044.eb43e7f9b5666e68e3df817728c4c87b@haskell.org> Message-ID: <059.763a43b283cbaf7642f62c7917d3104f@haskell.org> #11042: Template Haskell / GHCi does not respect extra-lib-dirs -------------------------------------+------------------------------------- Reporter: mboes | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash | Test Case: Blocked By: 11238 | Blocking: Related Tickets: #10458 #5289 | Differential Rev(s): #12753 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by awson): The fix is a bit partial, but it (at least) fixes the most common case, when we have a regular package built in dyn way. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 18:02:47 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 18:02:47 -0000 Subject: [GHC] #14941: Switching direct type family application to EqPred (~) prevents inlining in code using vector (10x slowdown) In-Reply-To: <042.0e3de7917bdd684aac8357b129fd4898@haskell.org> References: <042.0e3de7917bdd684aac8357b129fd4898@haskell.org> Message-ID: <057.6e5fe3f1807bb19e8e4f96ae2116a7e1@haskell.org> #14941: Switching direct type family application to EqPred (~) prevents inlining in code using vector (10x slowdown) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: davide Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by davide): == Regarding simple example `f :: forall a. (a ~ Int) => a -> a`, the difference in performance is somewhat expected. This may be a different issue than the example given in the ticket description. In short, `a ~ Int` is a proof that type `a` is equal to type `Int`. In core, `a ~ Int` is a regular ''boxed'' GADT meaning that it could be bottom i.e. an invalid prove (this is the main mechanism behind [https://downloads.haskell.org/~ghc/8.0.2/docs/html/users_guide/glasgow_exts.html?highlight=defered%20type%20error #deferring-type-errors-to-runtime -fdefer-type-errors]). Unboxing `a ~ b` at corresponds to checking the proof which is required to coerce the input binding from `a` to `Int`. Normally the `(a ~ Int)` would be optimized away (as described [http://dreixel.net/research/pdf/epdtecp.pdf here] in section 7.3), but that requires a worker wrapper transformation that never happens. Removing `NOINLINE` allows `f` to be optimized across modules, which closes the performance gap. == Regarding original example Unlike my simple example, all the code is in one module, so I expect the equality proof `VG.Mutable v ~ vm` to be optimized away (again see [http://dreixel.net/research/pdf/epdtecp.pdf here] section 7.3). With ghc 3.2.2, when compiling the slow version, I see `selectVectorDestructive2` is specialized to `$sselectVectorDestructive2 :: Int -> Vector Int -> MVector (PrimState IO) Int -> Int -> Int -> IO ()` (pass 2). This is good, but for some reason myread and partitionLoop2 are not specialized even though they are used by `$sselectVectorDestructive2`: {{{#!haskell $sselectVectorDestructive2 = ... let $dMVector = Data.Vector.Generic.Base.$p1Vector @Vector @Int Data.Vector.Unboxed.Base.$fVectorVectorInt in ... (Main.myread @IO @MVector @Int Control.Monad.Primitive.$fPrimMonadIO $dMVector GHC.Classes.$fOrdInt GHC.Show.$fShowInt v begin) ... (Main.partitionLoop2 @IO @MVector @Int Control.Monad.Primitive.$fPrimMonadIO $dMVector GHC.Classes.$fOrdInt GHC.Show.$fShowInt v begin pivot (GHC.Types.I# ...) }}} In the fast version, myread and partitionLoop2 are specialized in this pass. I noticed 2 other differences: * fast version floats `$dMVector` to a top level binding. * fast version specializes to `Mutable Vector (PrimState IO) Int` instead of `MVector (PrimState IO) Int`. Note `Mutable` is a type family and `Mutable Vector = MVector` -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 18:17:13 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 18:17:13 -0000 Subject: [GHC] #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite In-Reply-To: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> References: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> Message-ID: <061.2a7b409ae39d89b22724b56bc4b56fab@haskell.org> #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: patch Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5145 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"1971e9995b7c4acf550093f15e17dfdad47caaf9/ghc" 1971e999/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="1971e9995b7c4acf550093f15e17dfdad47caaf9" Don't shortcut SRTs for static functions (#15544) Shortcutting the SRT for a static function can lead to resurrecting a static object at runtime, which violates assumptions in the GC. See comments for details. Test Plan: - manual testing (in progress) - validate Reviewers: osa1, bgamari, erikd Reviewed By: bgamari Subscribers: rwbarton, carter GHC Trac Issues: #15544 Differential Revision: https://phabricator.haskell.org/D5145 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 18:43:45 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 18:43:45 -0000 Subject: [GHC] #15072: Teach the testsuite driver about response files In-Reply-To: <046.77942c6e24b9dfca972cf55cbeb07713@haskell.org> References: <046.77942c6e24b9dfca972cf55cbeb07713@haskell.org> Message-ID: <061.31358f6026df597459b25975cf175788@haskell.org> #15072: Teach the testsuite driver about response files -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.8.1 Component: Test Suite | Version: 8.2.2 Resolution: | Keywords: ci-breakage Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by ckoparkar): * cc: ckoparkar (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 19:46:54 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 19:46:54 -0000 Subject: [GHC] #15652: SerializedCompact has a [(Ptr a, Word)] instead of a custom datatype Message-ID: <046.e254de971f146f2975eb5f0ce06214f5@haskell.org> #15652: SerializedCompact has a [(Ptr a, Word)] instead of a custom datatype -------------------------------------+------------------------------------- Reporter: chessai | Owner: ezyang Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: | Version: 8.4.3 libraries/compact | Keywords: ghc-compact, | Operating System: Unknown/Multiple compact regions | Type of failure: Runtime Architecture: aarch64 | performance bug Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- {{{#!hs data SerializedCompact a = SerializedCompact { serializedCompactBlockList :: [(Ptr a, Word)] , serializedCompactRoot :: Ptr a } }}} I'm not sure why the first member of {{{SerializedCompact}}} isn't something like {{{#!hs data CompactBlock a = CompactBlock {-# UNPACK #-} (Ptr a) {-# UNPACK #-} Word }}} so the {{{Ptr}}} can unpack into the constructor, which isn't possible with {{{(,)}}}. {{{SerializedCompact}}} would then look like {{{#!hs data SerializedCompact a = SerializedCompact { serializedCompactBlockList :: [CompactBlock a] , serializedCompactRoot :: Ptr a } }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 20:03:07 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 20:03:07 -0000 Subject: [GHC] #15591: Inconsistent kind variable binder visibility between associated and non-associated type families In-Reply-To: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> References: <050.8a27896ec689dcb3ecd15da9e935f56e@haskell.org> Message-ID: <065.74c2259874ef4661cd7d3f7fd9e7f34d@haskell.org> #15591: Inconsistent kind variable binder visibility between associated and non- associated type families -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: | TypeApplications, TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15592 | Differential Rev(s): Phab:D5159 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch * differential: => Phab:D5159 Comment: By gum, I think I figured out this one. The trick was to pass the type variables bound by the class directly `kcLHsQTyVars` and to use that to one's advantage. See Phab:D5159. I still haven't figured out how to make the non-CUSK case for `kcLHsQTyVars` work yet (that code confuses the bejeezus out of me), but that's the topic of a separate ticket (#15592) anyway, so I'll leave that for later. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 20:05:05 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 20:05:05 -0000 Subject: [GHC] #15653: Both `Ptr a` in SerializedCompact are inaccurate because of the `a` Message-ID: <046.cd7d529803a4724dd6595ad0ba265e9b@haskell.org> #15653: Both `Ptr a` in SerializedCompact are inaccurate because of the `a` -------------------------------------+------------------------------------- Reporter: chessai | Owner: ezyang Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: | Version: 8.4.3 libraries/compact | Keywords: ghc-compact, | Operating System: Unknown/Multiple compact regions | Architecture: | Type of failure: Incorrect API Unknown/Multiple | annotation Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- {{{SerializedCompactPtr}}} is defined as: {{{#!hs data SerializedCompact a = SerializedCompact { serializedCompactBlockList :: [(Ptr a, Word)] , serializedCompactRoot :: Ptr a } }}} But, these {{{Ptr a}}} values are a lie, because they don't point to something of type 'a', which makes the documentation for {{{ghc-compact}}} sort of confusing to look at. A more accurate type would just be {{{Addr}}}. The consequences of this being changes to {{{Addr}}} are 1: breaking API changes (though not many people use compact regions) 2: A dependency on primitive would be necessary, though I'm again unsure how big of a deal this is, given that ghc-compact already depends on bytestring. ({{{Addr}}} should probably be moved to base, and re-exported from primitive, which would avoid this issue.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 20:38:34 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 20:38:34 -0000 Subject: [GHC] #13279: Check known-key lists In-Reply-To: <045.27ffb78b0e00a0c6dcfe02a64352aaa4@haskell.org> References: <045.27ffb78b0e00a0c6dcfe02a64352aaa4@haskell.org> Message-ID: <060.3d5763e44dca5e108e7ae98a15005ec4@haskell.org> #13279: Check known-key lists -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: dfeuer Type: task | Status: patch Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.1 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5159 Wiki Page: | -------------------------------------+------------------------------------- Changes (by ckoparkar): * status: new => patch * differential: => Phab:D5159 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 20:39:14 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 20:39:14 -0000 Subject: [GHC] #13279: Check known-key lists In-Reply-To: <045.27ffb78b0e00a0c6dcfe02a64352aaa4@haskell.org> References: <045.27ffb78b0e00a0c6dcfe02a64352aaa4@haskell.org> Message-ID: <060.e2f469d1da41460b7dd781fed5c23d8c@haskell.org> #13279: Check known-key lists -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: dfeuer Type: task | Status: patch Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.1 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5160 Wiki Page: | -------------------------------------+------------------------------------- Changes (by ckoparkar): * differential: Phab:D5159 => Phab:D5160 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 21:42:48 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 21:42:48 -0000 Subject: [GHC] #15654: Use deriving Functor in the codebase Message-ID: <047.b99ed8ac066f244e968fce2614f3392c@haskell.org> #15654: Use deriving Functor in the codebase -------------------------------------+------------------------------------- Reporter: monoidal | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 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: -------------------------------------+------------------------------------- In many places in compiler/ we manually define a Functor instance (`git grep "instance Functor"` shows 60). I think we could switch to `deriving` in most (or all?) cases. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 22:04:42 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 22:04:42 -0000 Subject: [GHC] #15655: Simpliify tcTyConScopedTyVars Message-ID: <046.16294c7e25d320791ab3c35dee4099d0@haskell.org> #15655: Simpliify tcTyConScopedTyVars -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 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: -------------------------------------+------------------------------------- Currently we have {{{ tcTyConScopedTyVars :: [(Name,TyVar)], }}} But actually every call of `mkTcTyCon` passes something like `(mkTyVarNamePairs tvs)` to it. So we could noticeably simplify this to {{{ tcTyConScopedTyVars :: [TyVar], }}} Less fiddling around. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 22:13:19 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 22:13:19 -0000 Subject: [GHC] #15656: Extend -Wall with incomplete-uni-patterns and incomplete-record-updates Message-ID: <048.18d484ea3a84b8fb98b962ae915a09c0@haskell.org> #15656: Extend -Wall with incomplete-uni-patterns and incomplete-record-updates -------------------------------------+------------------------------------- Reporter: ckoparkar | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Keywords: GHCProposal | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- The [https://github.com/ghc-proposals/ghc-proposals/pull/71 proposal] has been accepted, and could be implemented. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 22:26:27 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 22:26:27 -0000 Subject: [GHC] #15530: Type applications in patterns In-Reply-To: <046.ac75a1c05d26e58243b1cc5f1128ff00@haskell.org> References: <046.ac75a1c05d26e58243b1cc5f1128ff00@haskell.org> Message-ID: <061.d079e249208b55c0968af92aca57aaa2@haskell.org> #15530: Type applications in patterns -------------------------------------+------------------------------------- Reporter: nomeata | Owner: mnguyen Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 Resolution: | Keywords: GHCProposal Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by ckoparkar): * keywords: => GHCProposal -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 22:29:18 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 22:29:18 -0000 Subject: [GHC] #15364: Replace the atomicModifyMutVar# primop In-Reply-To: <045.aa8fbba8dcbd166d60f806e361779d6c@haskell.org> References: <045.aa8fbba8dcbd166d60f806e361779d6c@haskell.org> Message-ID: <060.e75fc7355caf6e1487a842af0f767439@haskell.org> #15364: Replace the atomicModifyMutVar# primop -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.8.1 Component: Runtime System | Version: 8.5 Resolution: | Keywords: GHCProposal Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4884 Wiki Page: | -------------------------------------+------------------------------------- Changes (by ckoparkar): * keywords: => GHCProposal -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 22:30:47 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 22:30:47 -0000 Subject: [GHC] #14941: Switching direct type family application to EqPred (~) prevents inlining in code using vector (10x slowdown) In-Reply-To: <042.0e3de7917bdd684aac8357b129fd4898@haskell.org> References: <042.0e3de7917bdd684aac8357b129fd4898@haskell.org> Message-ID: <057.1c94d018d1a4c5c169004d99850eeea8@haskell.org> #14941: Switching direct type family application to EqPred (~) prevents inlining in code using vector (10x slowdown) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: davide Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Thanks for the simpler example. I think I now understand what is going on. It's all to do with strictness analysis. Consider this function, and suppose it is strict in x: {{{ f1 :: Int -> blah f1 x = ...(case x of I# y -> ...)... }}} The strictness analysis sees that `f1` is strict in `x` and we get a w/w split {{{ f1 :: Int -> blah f1 x = case x of I# y -> $wf y $wf1 :: Int# -> blah $wf1 y = let x = I# y in ...original body of f... }}} Now suppose that we have {{{ type family F a type instance F Bool = Int f2 :: F Bool -> blah f2 x = ...same as before... }}} In fact the strictness analysis still sees that `f2` is strict in `x`, and worker wrapper works too -- all by using the family instances. We get this {{{ f2 :: F Bool -> blah f2 x = case (x |> g1) of I# y -> $wf2 y $wf2 :: Int# -> blah $wf2 y = let x = (I# y) |> sym g in ..as before... }}} Here `g` is a coercion `g :: F Bool ~ Int`, constructed from the family instances. This coersionn is generated by `topNormaliseType_maybe`, itself called from `deepSplitCprType_maybe` in `WwLib`, during worker/wrapper generation. But it's harder if the coercion is purely local. Let's start with this (yes I know you can't write `(~#)` in source Haskell but imagine this is Core: {{{ f3 :: forall a. (a ~# Int) => a -> blah f3 a (g :: (a ~# Int) (x :: a) = ...as before... }}} What we'd like is this: {{{ f3 :: forall a. (a ~# Int) => a -> blah f3 a (g :: (a ~# Int) (x :: a) = case (x |> g) of I# y -> $wf3 a g y $wf3 :: forall a. (a ~# Int) => Int# -> blah $wf3 a g y = let x = (I# y) |> sym g in ...as before... }}} but alas neither the demand analyser, nor the worker/wrapper generator are clever enough to do this. We need a kind of `normaliseType` that can take some local "givens" as well as the top-level family instance envs. This has the same ring as something Ryan wanted in the coverage checker. It's not obvious exactly what "should work". Eg what about `(Int ~# a)`, or even `([Int] ~# [a])`? Finally, there is the question of `(~)` vs `(~#)`. I think we are very aggressive about unboxing `(~)` constraints, so I'd like this: {{{ f4 :: forall a. (a ~ Int) => a -> blah f4 a (g :: (a ~ Int) (x :: a) = case g of MkTwiddle (g2 :: a ~# Int) -> case (x |> g2) of I# y -> $wf4 a g2 y $wf4 :: forall a. (a ~# Int) => Int# -> blah $wf4 a g2 y = let x = (I# y) |> sym g2 g = MkTwiddle g2 in ...as before... }}} Making all this happen will take some work though. How important is it. I'm tempted to say "don't write types like that"! (Although the type checker goes to some trouble to support them well.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 18 23:24:04 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 18 Sep 2018 23:24:04 -0000 Subject: [GHC] #15648: Core Lint error with source-level unboxed equality In-Reply-To: <050.b1c8c377aa63cdac74b3d157d20320e2@haskell.org> References: <050.b1c8c377aa63cdac74b3d157d20320e2@haskell.org> Message-ID: <065.72286ea5ece35fdf99e9d68ee5abdcb6@haskell.org> #15648: Core Lint error with source-level unboxed equality -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15209 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Replying to [comment:1 goldfire]: > 1. Why does GHC type check `Jank` at type `JankyEquality a b`? There must be something in the type checker which treats arguments of type `a ~# b` as invisible. But these shouldn't be -- they are not `Constraint`s. To fix: find this code and kill it. I think there is a simpler explanation for why this happens: when we kind- check the type `(a ~# b) -> c`, everything works since `(->)` is levity polymorphic and `a ~# b` has kind `TYPE (TupleRep '[])`. This means that resulting `Type` is `FunTy (TyConApp (~#) [TyVarTy a, TyVarTy b]) (TyVarTy c)`—which GHC believes to be `(a ~# b) => c`—so things like `Jank` are seemingly typechecked as if the value of type `a ~# b` were invisible. From a certain perspective, this is a natural consequence of making `a ~# b` have kind `TYPE (TupleRep '[])`. This suggests that one way to work around this issue would be to change its kind. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 00:22:42 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 00:22:42 -0000 Subject: [GHC] #15656: Extend -Wall with incomplete-uni-patterns and incomplete-record-updates In-Reply-To: <048.18d484ea3a84b8fb98b962ae915a09c0@haskell.org> References: <048.18d484ea3a84b8fb98b962ae915a09c0@haskell.org> Message-ID: <063.080bba632cd95ab71e0938f73a786058@haskell.org> #15656: Extend -Wall with incomplete-uni-patterns and incomplete-record-updates -------------------------------------+------------------------------------- Reporter: ckoparkar | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: GHCProposal Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by ckoparkar): * type: feature request => task -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 07:49:46 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 07:49:46 -0000 Subject: [GHC] #15571: Eager AP_STACK blackholing causes incorrect size info for sanity checks In-Reply-To: <043.9213207e6a514a137db4ef0469470bf7@haskell.org> References: <043.9213207e6a514a137db4ef0469470bf7@haskell.org> Message-ID: <058.c58a2aa91b9e97d2e2ab6d44c735a712@haskell.org> #15571: Eager AP_STACK blackholing causes incorrect size info for sanity checks -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15508 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): We discussed this. Simon is right in comment:1 that this is problem with eager blackholing in general. However, eager blackholing is optional, so if you're working on the RTS and you need sanity checks can always not use it (which is the default). The problem with AP_STACK eager blackholing is more serious as it can't be disabled (expect perhaps in non-threaded runtime?) Anyways, we came up with this plan: - Implement a new stack frame AP_STACK_EAGER_BLACKHOLE which is exactly like the EAGER_BLACKHOLE but indicates that the object that became an eager blackhole was an AP_STACK. - (Only in debug runtime) Allocate one more word when allocating an AP_STACK and record its size. Note that this is only possible because we only allocate AP_STACKs in runtime (and not in generated code). - When eagerly blackholing an AP_STACK use AP_STACK_EAGER_BLACKHOLE instead of EAGER_BLACKHOLE and record the AP_STACK's size. - When we actually BLACKHOLE the AP_STACK_EAGER_BLACKHOLE in `threadPaused` we look at the size of the object and we can correctly return the `AP_STACK` size in `closure_sizeW()` because we recorded it in step (2). Simon, did I get this right? One thing I'm not sure (and forgot to ask at the meeting) is (3) in the bug report. I don't know if we're supposed to zero the slop when blackholing an AP_STACK eager blackhole in `threadPaused`. We enter the AP_STACK right after eagerly blackholing it, but I'm not sure if we can call `threadPaused` before being done with the stack. Can you comment on this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 08:23:20 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 08:23:20 -0000 Subject: [GHC] #15657: Support promotion of pattern synonyms to kinds Message-ID: <048.42e536a5545c93631381ff3a3c4fff51@haskell.org> #15657: Support promotion of pattern synonyms to kinds -------------------------------------+------------------------------------- Reporter: infinity0 | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 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: -------------------------------------+------------------------------------- Suppose we define a heterogeneous binary tree: {{{#!hs {-# LANGUAGE DataKinds , GADTs , PatternSynonyms #-} data Tree a = TLeaf | TNode a (Tree a) (Tree a) data HTree xs where HLeaf :: HTree 'TLeaf HNode :: x -> HTree ls -> HTree rs -> HTree ('TNode x ls rs) }}} A tree representation is chosen because it's pretty general, and easy to combine - just `HNode` a bunch of them together. With a `HList` for example, it's harder to do this in nested fashion, and we want to be able to do that for the `$BigRealWorld` things we're writing. However in the majority of cases, the `$BigRealWorld` things defined by actual clients of the API don't need the full power of the HTree, and so pattern synonyms potentially allow them to easily define a tree of one item, or a small unnested list of items. {{{#!hs -- as above, then: pattern TPure :: a -> Tree a pattern TPure a = TNode a TLeaf TLeaf pattern TCons :: a -> Tree a -> Tree a pattern TCons x y = TNode x TLeaf y pattern HTPure :: x -> HTree ('TPure x) -- error, has to be ('TNode x 'TLeaf 'TLeaf) pattern HTPure a = HNode a HLeaf HLeaf clientThing :: HTree ('TPure Int) -- error, has to be ('TNode Int 'TLeaf 'TLeaf) clientThing = HTPure 3 }}} Oh no! GHC fails with: {{{ • Pattern synonym ‘TPure’ cannot be used here (Pattern synonyms cannot be promoted) • In the first argument of ‘HTree’, namely ‘( 'TPure x)’ In the type ‘x -> HTree ( 'TPure x)’ | 20 | pattern HTPure :: x -> HTree ('TPure x) }}} Actually the first one is not a big deal, we only write that once so it doesn't matter if we need to expand it fully. But things like `clientAPI` might be defined several times and then it's annoying to have to write the synonym out in full every time. I appreciate `ViewPatterns` make it hard to do this and would be totally happy with a solution that only works to promote non-ViewPattern pattern synonyms. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 08:24:59 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 08:24:59 -0000 Subject: [GHC] #15657: Support promotion of pattern synonyms to kinds In-Reply-To: <048.42e536a5545c93631381ff3a3c4fff51@haskell.org> References: <048.42e536a5545c93631381ff3a3c4fff51@haskell.org> Message-ID: <063.cee09caa6633327bb7968de580f3da91@haskell.org> #15657: Support promotion of pattern synonyms to kinds -------------------------------------+------------------------------------- Reporter: infinity0 | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by infinity0: Old description: > Suppose we define a heterogeneous binary tree: > > {{{#!hs > {-# LANGUAGE > DataKinds > , GADTs > , PatternSynonyms > #-} > > data Tree a = TLeaf | TNode a (Tree a) (Tree a) > > data HTree xs where > HLeaf :: HTree 'TLeaf > HNode :: x -> HTree ls -> HTree rs -> HTree ('TNode x ls rs) > }}} > > A tree representation is chosen because it's pretty general, and easy to > combine - just `HNode` a bunch of them together. With a `HList` for > example, it's harder to do this in nested fashion, and we want to be able > to do that for the `$BigRealWorld` things we're writing. > > However in the majority of cases, the `$BigRealWorld` things defined by > actual clients of the API don't need the full power of the HTree, and so > pattern synonyms potentially allow them to easily define a tree of one > item, or a small unnested list of items. > > {{{#!hs > -- as above, then: > > pattern TPure :: a -> Tree a > pattern TPure a = TNode a TLeaf TLeaf > > pattern TCons :: a -> Tree a -> Tree a > pattern TCons x y = TNode x TLeaf y > > pattern HTPure :: x -> HTree ('TPure x) -- error, has to be ('TNode x > 'TLeaf 'TLeaf) > pattern HTPure a = HNode a HLeaf HLeaf > > clientThing :: HTree ('TPure Int) -- error, has to be ('TNode Int 'TLeaf > 'TLeaf) > clientThing = HTPure 3 > }}} > > Oh no! GHC fails with: > > {{{ > • Pattern synonym ‘TPure’ cannot be used here > (Pattern synonyms cannot be promoted) > • In the first argument of ‘HTree’, namely ‘( 'TPure x)’ > In the type ‘x -> HTree ( 'TPure x)’ > | > 20 | pattern HTPure :: x -> HTree ('TPure x) > }}} > > Actually the first one is not a big deal, we only write that once so it > doesn't matter if we need to expand it fully. But things like `clientAPI` > might be defined several times and then it's annoying to have to write > the synonym out in full every time. > > I appreciate `ViewPatterns` make it hard to do this and would be totally > happy with a solution that only works to promote non-ViewPattern pattern > synonyms. New description: Suppose we define a heterogeneous binary tree: {{{#!hs {-# LANGUAGE DataKinds , GADTs , PatternSynonyms #-} data Tree a = TLeaf | TNode a (Tree a) (Tree a) data HTree xs where HLeaf :: HTree 'TLeaf HNode :: x -> HTree ls -> HTree rs -> HTree ('TNode x ls rs) }}} A tree representation is chosen because it's pretty general, and easy to combine - just `HNode` a bunch of them together. With a `HList` for example, it's harder to do this in nested fashion, and we want to be able to do that for the `$BigRealWorld` things we're writing. However in the majority of cases, the `$BigRealWorld` things defined by actual clients of the API don't need the full power of the HTree, and so pattern synonyms potentially allow them to easily define a tree of one item, or a small unnested list of items. {{{#!hs -- as above, then: pattern TPure :: a -> Tree a pattern TPure a = TNode a TLeaf TLeaf pattern TCons :: a -> Tree a -> Tree a pattern TCons x y = TNode x TLeaf y pattern HTPure :: x -> HTree ('TPure x) -- error, has to be ('TNode x 'TLeaf 'TLeaf) pattern HTPure a = HNode a HLeaf HLeaf clientThing :: HTree ('TPure Int) -- error, has to be ('TNode Int 'TLeaf 'TLeaf) clientThing = HTPure 3 }}} Oh no! GHC fails with: {{{ • Pattern synonym ‘TPure’ cannot be used here (Pattern synonyms cannot be promoted) • In the first argument of ‘HTree’, namely ‘( 'TPure x)’ In the type ‘x -> HTree ( 'TPure x)’ | 20 | pattern HTPure :: x -> HTree ('TPure x) }}} Actually the first one is not a big deal, we only write that once so it doesn't matter if we need to expand it fully. But things like `clientThing` might be defined several times and then it's annoying to have to write the synonym out in full every time. I appreciate `ViewPatterns` make it hard to do this and would be totally happy with a solution that only works to promote non-ViewPattern pattern synonyms. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 09:55:57 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 09:55:57 -0000 Subject: [GHC] #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory In-Reply-To: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> References: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> Message-ID: <059.4e473cc259f46792c23727df20e36523@haskell.org> #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory -------------------------------------+------------------------------------- Reporter: int-e | Owner: osa1 Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: GHCi | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): Looking at `+RTS -h` output, we allocate and retain GBs of PAPs. Not sure what are those PAPs for and what's retaining them though. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 10:29:44 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 10:29:44 -0000 Subject: [GHC] #13279: Check known-key lists In-Reply-To: <045.27ffb78b0e00a0c6dcfe02a64352aaa4@haskell.org> References: <045.27ffb78b0e00a0c6dcfe02a64352aaa4@haskell.org> Message-ID: <060.c8a4b258f09166d2798f01fc16423feb@haskell.org> #13279: Check known-key lists -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: dfeuer Type: task | Status: patch Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.1 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5160 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Krzysztof Gogolewski ): In [changeset:"45befe27495b1a7bca037b6a3eedf2474a0204c8/ghc" 45befe2/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="45befe27495b1a7bca037b6a3eedf2474a0204c8" Use predefined known-key names when possible Summary: For certain entities in 'PrelNames', we were creating new 'Name's instead of reusing the ones already defined. Easily fixed. Test Plan: ./validate Reviewers: dfeuer, RyanGlScott, bgamari, simonpj Reviewed By: simonpj Subscribers: simonpj, rwbarton, carter GHC Trac Issues: #13279 Differential Revision: https://phabricator.haskell.org/D5160 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 10:35:25 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 10:35:25 -0000 Subject: [GHC] #13279: Check known-key lists In-Reply-To: <045.27ffb78b0e00a0c6dcfe02a64352aaa4@haskell.org> References: <045.27ffb78b0e00a0c6dcfe02a64352aaa4@haskell.org> Message-ID: <060.9617b012b710efe8802202d9cecb1d2f@haskell.org> #13279: Check known-key lists -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: dfeuer Type: task | Status: closed Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.1 Resolution: fixed | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5160 Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: patch => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 10:51:28 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 10:51:28 -0000 Subject: [GHC] #15485: GHC uses 300% CPU when calling into blocking C call In-Reply-To: <047.13adf0146883a7a0c2f9dc50bb228513@haskell.org> References: <047.13adf0146883a7a0c2f9dc50bb228513@haskell.org> Message-ID: <062.1d51502b182481ac45e0c0826fd179da@haskell.org> #15485: GHC uses 300% CPU when calling into blocking C call -------------------------------------+------------------------------------- Reporter: oconnore | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 | (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: new => infoneeded Comment: oconnore, would it be possible for you to provide a reproducer? I looked at the /r/haskell thread but I still have no idea how to reproduce this. A cabal package would work (please avoid stack if possible, it adds extra friction). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 11:59:28 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 11:59:28 -0000 Subject: [GHC] #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory In-Reply-To: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> References: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> Message-ID: <059.8f8f00a8029f2baf6a254aff5a54e787@haskell.org> #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory -------------------------------------+------------------------------------- Reporter: int-e | Owner: osa1 Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: GHCi | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I speculate that the giant PAP is {{{ return () >> (return () >> (return () >> (... >> return ()...))) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 12:08:36 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 12:08:36 -0000 Subject: [GHC] #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory In-Reply-To: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> References: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> Message-ID: <059.4ccd7a80211d603b6be653500235602c@haskell.org> #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory -------------------------------------+------------------------------------- Reporter: int-e | Owner: osa1 Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: GHCi | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): Simon, do you have any guesses on what may be retaining those PAPs? Btw, here's the Core generated for this expression: (output of -ddump- simpl) {{{ GHC.Base.bindIO @ () @ [()] (GHC.GHCi.ghciStepIO @ GHC.Types.IO GHC.GHCi.$fGHCiSandboxIOIO @ () (Data.Foldable.sequence_ @ [] @ GHC.Types.IO @ () Data.Foldable.$fFoldable[] GHC.Base.$fMonadIO (GHC.List.replicate @ (GHC.Types.IO ()) (GHC.Types.I# 100000000#) (GHC.Base.return @ GHC.Types.IO GHC.Base.$fMonadIO @ () GHC.Tuple.())))) (\ (it_a1UK :: ()) -> GHC.Base.returnIO @ [()] (GHC.Types.: @ () it_a1UK (GHC.Types.[] @ ()))) }}} More readable version: {{{ GHC.Base.bindIO (ghciStepIO ) (\i -> GHC.Base.returnIO [i]) }}} The Core identical to the Core generated by GHC 7.10. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 12:16:04 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 12:16:04 -0000 Subject: [GHC] #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory In-Reply-To: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> References: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> Message-ID: <059.3ee6ef9419578e7b28346c9020aebbc6@haskell.org> #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory -------------------------------------+------------------------------------- Reporter: int-e | Owner: osa1 Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: GHCi | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): One other thing I tried is `-fno-it` flag, which disables binding the `it` variable. It did not fix the leak. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 12:31:55 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 12:31:55 -0000 Subject: [GHC] #12100: GHC 8.0.1 build segmentation fault in haddock In-Reply-To: <047.3b49389b21e0a29c007c4ece13b83eaf@haskell.org> References: <047.3b49389b21e0a29c007c4ece13b83eaf@haskell.org> Message-ID: <062.823d2548bfc4435a4f667f82e63c8e44@haskell.org> #12100: GHC 8.0.1 build segmentation fault in haddock -------------------------------------+------------------------------------- Reporter: ilovezfs | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: MacOS X | Architecture: Type of failure: Building GHC | Unknown/Multiple failed | Test Case: Blocked By: | Blocking: Related Tickets: #11744, #11951 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * priority: highest => normal * milestone: 8.2.1 => Comment: I doubt we'll be releasing another 8.0 or 8.2. Is this reproducible with more recent GHCs? Updating milestone and priority. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 12:34:23 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 12:34:23 -0000 Subject: [GHC] #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite In-Reply-To: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> References: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> Message-ID: <061.a91aa2174f8c2154fb40d6008b98664e@haskell.org> #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: merge Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5145 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: patch => merge -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 12:37:01 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 12:37:01 -0000 Subject: [GHC] #15569: Constant folding optimises 1 into 3 In-Reply-To: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> References: <050.faecf73a66ba46b12a33656ce184ee72@haskell.org> Message-ID: <065.1fd126c83ce0a86472a9ea99e43bb8af@haskell.org> #15569: Constant folding optimises 1 into 3 -------------------------------------+------------------------------------- Reporter: snowleopard | Owner: (none) Type: bug | Status: closed Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #9136 | Differential Rev(s): Phab:D5109 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: new => closed * resolution: => fixed Comment: The fix was merged to both master and 8.6, so closing. I think the testing effort should be tracked in its own ticket. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 12:39:51 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 12:39:51 -0000 Subject: [GHC] #14329: GHC 8.2.1 segfaults while bootstrapping master In-Reply-To: <046.2503a1f6f14456a42761d49ce89e96f2@haskell.org> References: <046.2503a1f6f14456a42761d49ce89e96f2@haskell.org> Message-ID: <061.0f640c9cbc2426e3d2bce536be698f03@haskell.org> #14329: GHC 8.2.1 segfaults while bootstrapping master -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #12960, #9065, | Differential Rev(s): Phab:D4075 #7762 | Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: new => infoneeded * priority: highest => normal * milestone: 8.2.2 => Comment: Is this reproducible with newer GHCs? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 12:45:28 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 12:45:28 -0000 Subject: [GHC] #4820: "Invalid object in isRetainer" when doing retainer profiling in GHC 7 branch In-Reply-To: <049.7962690c1cad7c1dc6772c5aaee21bae@haskell.org> References: <049.7962690c1cad7c1dc6772c5aaee21bae@haskell.org> Message-ID: <064.930c7a96063da6d8013fbcd797002523@haskell.org> #4820: "Invalid object in isRetainer" when doing retainer profiling in GHC 7 branch ----------------------------------+-------------------------------------- Reporter: dleuschner | Owner: (none) Type: bug | Status: closed Priority: highest | Milestone: 8.4.1 Component: Profiling | Version: 8.0.1 Resolution: invalid | Keywords: Operating System: MacOS X | Architecture: x86_64 (amd64) Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #11978 | Differential Rev(s): Wiki Page: | ----------------------------------+-------------------------------------- Changes (by osa1): * status: infoneeded => closed * resolution: => invalid Comment: We've fixed a lot of RTS bugs (including retainer profiler bugs) since this was submitted, so I suspect this is fixed. Please reopen if you disagree. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 12:48:11 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 12:48:11 -0000 Subject: [GHC] #11647: GHCi does not honour implicit `module Main (main) where` for re-exported `main`s In-Reply-To: <042.bdc5ad3927502391eb42801db38e8cb4@haskell.org> References: <042.bdc5ad3927502391eb42801db38e8cb4@haskell.org> Message-ID: <057.caaf5611f7f892073a4fee2ff54d48aa@haskell.org> #11647: GHCi does not honour implicit `module Main (main) where` for re-exported `main`s -------------------------------------+------------------------------------- Reporter: hvr | Owner: RolandSenn Type: bug | Status: patch Priority: normal | Milestone: Component: GHCi | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHC rejects | Test Case: make test valid program | TEST=T11647 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5162 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RolandSenn): * status: new => patch * testcase: => make test TEST=T11647 * differential: => Phab:D5162 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 13:06:05 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 13:06:05 -0000 Subject: [GHC] #15658: strange inferred kind with TypeInType Message-ID: <044.5c56e4e9c5ca25f242e17058c46d6daa@haskell.org> #15658: strange inferred kind with TypeInType -------------------------------------+------------------------------------- Reporter: dmwit | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.2 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: -------------------------------------+------------------------------------- This type family has a strange kind to begin with: {{{ {-# Language TypeFamilies , TypeInType #-} type family F f a :: a }}} But it gets even stranger when you ask ghci what it thinks about F: {{{ > :k F F :: * -> forall a -> a }}} There is a forall which doesn't seem to bind any variables and hasn't got the customary delimiting dot. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 13:31:45 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 13:31:45 -0000 Subject: [GHC] #15658: strange inferred kind with TypeInType In-Reply-To: <044.5c56e4e9c5ca25f242e17058c46d6daa@haskell.org> References: <044.5c56e4e9c5ca25f242e17058c46d6daa@haskell.org> Message-ID: <059.a69de30e57de8fe3cf721e4518c85ca6@haskell.org> #15658: strange inferred kind with TypeInType -------------------------------------+------------------------------------- Reporter: dmwit | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.2 Resolution: | Keywords: TypeInType, | GHCProposal Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * keywords: => TypeInType, GHCProposal Comment: This is expected: `TypeInType` gives programmers a limited ability to write dependent quantification in kinds. The [https://downloads.haskell.org/~ghc/8.4.3/docs/html/users_guide/glasgow_exts.html?highlight=typeintype #inferring-dependency-in-datatype-declarations Inferring dependency in datatype declarations] section of the users' guide documents this feature to some degree. The part that is not documented is the `forall k ->` bit, which I'll briefly explain here. Here is the type family you wrote (with explicit kinds for clarity): {{{#!hs type family F (f :: *) (a :: *) :: a }}} This binds the `f` and `a` type variables, and interestingly enough, it //reuses// the bound `a` type variable later in the return kind. In other words, `a` is used in a dependent fashion, so the kind for `F` is (again, with explicit kinds for clarity): {{{#!hs F :: * -> forall (a :: *) -> a }}} This kind says that `F` takes two type arguments of kind `*` and returns a type of kind `a`, where `a` is the second type argument. Importantly, the kind of `F` is //not// `* -> forall (a :: *). a`, since that would imply that `a` is insivible (i.e., that you don't explicitly pass it as an argument to `F`). You can think of the use of `->` versus `.` as indicating visible arguments versus invisible ones. As I briefly mentioned before, this aspect of kinds is not really documented at the moment. This is partly because while you can observe these kinds in GHCi (through `:kind`), you cannot write them yourself (they'll simply fail to parse at the moment). [https://github.com/ghc- proposals/ghc-proposals/pull/81 This GHC proposal] aims to rectify this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 14:03:39 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 14:03:39 -0000 Subject: [GHC] #15652: SerializedCompact has a [(Ptr a, Word)] instead of a custom datatype In-Reply-To: <046.e254de971f146f2975eb5f0ce06214f5@haskell.org> References: <046.e254de971f146f2975eb5f0ce06214f5@haskell.org> Message-ID: <061.1fda38c172ad29d28db1b3b783874a00@haskell.org> #15652: SerializedCompact has a [(Ptr a, Word)] instead of a custom datatype -------------------------------------+------------------------------------- Reporter: chessai | Owner: ezyang Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: | Version: 8.4.3 libraries/compact | Keywords: ghc-compact, Resolution: | compact regions Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Runtime | Test Case: performance bug | Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): I don't think there's any deep reason for this; it was likely just the most convenient choice at the time the code was written. Ultimately it seems unlikely that there will typically be enough blocks that unpacking will have a significant change in performance characteristics. Is there a particular motivation for wanting unpacking here? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 14:06:43 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 14:06:43 -0000 Subject: [GHC] #15072: Teach the testsuite driver about response files In-Reply-To: <046.77942c6e24b9dfca972cf55cbeb07713@haskell.org> References: <046.77942c6e24b9dfca972cf55cbeb07713@haskell.org> Message-ID: <061.9ed9e7893adb21ecc978f45375e1469d@haskell.org> #15072: Teach the testsuite driver about response files -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.8.1 Component: Test Suite | Version: 8.2.2 Resolution: | Keywords: ci-breakage Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Yes; GHC currently uses response files itself when invoking gcc but doesn't understand them itself. This should be fixed. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 14:11:10 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 14:11:10 -0000 Subject: [GHC] #15641: Git repositories have several problems In-Reply-To: <046.cc1f52463775afa374d2adbd9385be70@haskell.org> References: <046.cc1f52463775afa374d2adbd9385be70@haskell.org> Message-ID: <061.1c7d1e783f1b24d5354fdaa397892b79@haskell.org> #15641: Git repositories have several problems -------------------------------------+------------------------------------- Reporter: flip101 | Owner: hvr Type: bug | Status: new Priority: high | Milestone: Component: Trac & Git | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): I am a bit confused as to why your first attempt at cloning from `git.haskell.org` failed. Are you able to ping that host? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 14:12:53 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 14:12:53 -0000 Subject: [GHC] #4022: GHC Bindist is Broken on FreeBSD/amd64 In-Reply-To: <042.be61d95849398bdf9c05d1a69af1e7e3@haskell.org> References: <042.be61d95849398bdf9c05d1a69af1e7e3@haskell.org> Message-ID: <057.66a52684cdfe375692bec28c87db7aec@haskell.org> #4022: GHC Bindist is Broken on FreeBSD/amd64 -------------------------------------+------------------------------------- Reporter: pgj | Owner: pgj Type: bug | Status: new Priority: lowest | Milestone: Component: Core Libraries | Version: 6.13 Resolution: | Keywords: GMP,integer- | gmp, sharedlibs Operating System: FreeBSD | Architecture: x86_64 Type of failure: Building GHC | (amd64) failed | Test Case: Blocked By: | Blocking: Related Tickets: #8156 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): I do intend on producing a FreeBSD bindist for 8.6.1. I can try producing one for 8.4.3 as well. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 14:25:02 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 14:25:02 -0000 Subject: [GHC] #15634: GHCi: Segmentation fault Data.List.sum large number In-Reply-To: <048.5052d331a4fc48d28dc3b9b9d3968d7b@haskell.org> References: <048.5052d331a4fc48d28dc3b9b9d3968d7b@haskell.org> Message-ID: <063.220e8bda3d711b91d1ebed31e20d084f@haskell.org> #15634: GHCi: Segmentation fault Data.List.sum large number -------------------------------------+------------------------------------- Reporter: ksallberg | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Research | needed Component: GHCi | Version: 8.0.1 Resolution: | Keywords: segfault Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Indeed this is not expected; ideally we would throw a proper exception here (which we should presumably do when the test program is compiled). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 14:30:08 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 14:30:08 -0000 Subject: [GHC] #15652: SerializedCompact has a [(Ptr a, Word)] instead of a custom datatype In-Reply-To: <046.e254de971f146f2975eb5f0ce06214f5@haskell.org> References: <046.e254de971f146f2975eb5f0ce06214f5@haskell.org> Message-ID: <061.399848fc05e812e2e0e517e66034cd29@haskell.org> #15652: SerializedCompact has a [(Ptr a, Word)] instead of a custom datatype -------------------------------------+------------------------------------- Reporter: chessai | Owner: ezyang Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: | Version: 8.4.3 libraries/compact | Keywords: ghc-compact, Resolution: | compact regions Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Runtime | Test Case: performance bug | Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by chessai): You're probably right about the significant change in performance, though I aim for unpacking everywhere - it just seems to be a better default mindset overall. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 15:14:40 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 15:14:40 -0000 Subject: [GHC] #15072: Teach the testsuite driver about response files In-Reply-To: <046.77942c6e24b9dfca972cf55cbeb07713@haskell.org> References: <046.77942c6e24b9dfca972cf55cbeb07713@haskell.org> Message-ID: <061.688debe34fd086e229936506fb62c859@haskell.org> #15072: Teach the testsuite driver about response files -------------------------------------+------------------------------------- Reporter: bgamari | Owner: ckoparkar Type: task | Status: new Priority: normal | Milestone: 8.8.1 Component: Test Suite | Version: 8.2.2 Resolution: | Keywords: ci-breakage Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by ckoparkar): * owner: (none) => ckoparkar Comment: Alright, so there are 2 things we'd like to do: (1) Update the GHC executable itself to understand response file arguments. (2) Update the testsuite. Since we're updating the executable, is there some process we have to follow (eg. announce on a specific mailing list) ? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 15:30:57 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 15:30:57 -0000 Subject: [GHC] #11295: Figure out what LLVM passes are fruitful In-Reply-To: <046.97e900ad29a1522a4b7374676cc6de7a@haskell.org> References: <046.97e900ad29a1522a4b7374676cc6de7a@haskell.org> Message-ID: <061.2744cdcd853a453ca1331acb1e1e8814@haskell.org> #11295: Figure out what LLVM passes are fruitful -------------------------------------+------------------------------------- Reporter: bgamari | Owner: kavon Type: task | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (LLVM) | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: 14528 | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): kavon, it would be great to have this done for 8.8. Do let me know if there's any way I can help. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 15:42:02 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 15:42:02 -0000 Subject: [GHC] #15659: Wacky error message when RULE mentions out-of-scope variable Message-ID: <050.8dd7643b53c2eca3e9802af78b7aab52@haskell.org> #15659: Wacky error message when RULE mentions out-of-scope variable -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Keywords: newcomer | Operating System: Unknown/Multiple Architecture: | Type of failure: Poor/confusing Unknown/Multiple | error message Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- If I compile the following program with GHC 8.4 or later: {{{#!hs module Foo where {-# RULES "test" forall x. f x = x #-} }}} The error message I get is somewhat eyebrow-raising: {{{ $ /opt/ghc/8.4.3/bin/ghc Foo.hs [1 of 1] Compiling Foo ( Foo.hs, Foo.o ) Foo.hs:3:11: error: Rule "test": Not in scope: OutOfScope(f) in left-hand side: f x LHS must be of form (f e1 .. en) where f is not forall'd | 3 | {-# RULES "test" forall x. f x = x #-} | ^^^^^^^^^^^^^^^^^^^^^^^^ }}} I'm not sure what this `OutOfScope` business is, but I doubt we want to be referring to it in error messages. The error in GHC 8.2 and earlier was much less confusing: {{{ $ /opt/ghc/8.2.2/bin/ghc Foo.hs [1 of 1] Compiling Foo ( Foo.hs, Foo.o ) Foo.hs:3:11: error: Rule "test": Not in scope: f in left-hand side: f x LHS must be of form (f e1 .. en) where f is not forall'd | 3 | {-# RULES "test" forall x. f x = x #-} | ^^^^^^^^^^^^^^^^^^^^^^^^ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 15:56:15 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 15:56:15 -0000 Subject: [GHC] #4022: GHC Bindist is Broken on FreeBSD/amd64 In-Reply-To: <042.be61d95849398bdf9c05d1a69af1e7e3@haskell.org> References: <042.be61d95849398bdf9c05d1a69af1e7e3@haskell.org> Message-ID: <057.7319a6ea1679a8e861d846c1b7cb1ada@haskell.org> #4022: GHC Bindist is Broken on FreeBSD/amd64 -------------------------------------+------------------------------------- Reporter: pgj | Owner: pgj Type: bug | Status: new Priority: lowest | Milestone: Component: Core Libraries | Version: 6.13 Resolution: | Keywords: GMP,integer- | gmp, sharedlibs Operating System: FreeBSD | Architecture: x86_64 Type of failure: Building GHC | (amd64) failed | Test Case: Blocked By: | Blocking: Related Tickets: #8156 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by arrowd): It would be great if you do 8.4.3. To make the bindist be consumable by stack you'd need to compile it on the least supported FreeBSD version (10.4 at the moment). You can take a look at GHC port [1], if interested. Feel free to bug me with any questions. Thanks in advance. 1. https://svnweb.freebsd.org/ports/head/lang/ghc/Makefile?view=markup -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 17:10:09 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 17:10:09 -0000 Subject: [GHC] #15497: Coercion Quantification In-Reply-To: <047.3a4a4e067b87a899efdf8c3f044fd1ac@haskell.org> References: <047.3a4a4e067b87a899efdf8c3f044fd1ac@haskell.org> Message-ID: <062.dde69f4fe40a8a367f4acc91105afd55@haskell.org> #15497: Coercion Quantification -------------------------------------+------------------------------------- Reporter: ningning | Owner: ningning Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5054 Wiki Page: | https://ghc.haskell.org/trac/ghc/wiki/DependentHaskell/Phase2| -------------------------------------+------------------------------------- Changes (by ningning): * owner: (none) => ningning -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 17:11:48 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 17:11:48 -0000 Subject: [GHC] #15497: Coercion Quantification In-Reply-To: <047.3a4a4e067b87a899efdf8c3f044fd1ac@haskell.org> References: <047.3a4a4e067b87a899efdf8c3f044fd1ac@haskell.org> Message-ID: <062.635f3a5f8481602b932cf3d905464a42@haskell.org> #15497: Coercion Quantification -------------------------------------+------------------------------------- Reporter: ningning | Owner: ningning Type: task | Status: closed Priority: normal | Milestone: Component: Compiler | Version: Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5054 Wiki Page: | https://ghc.haskell.org/trac/ghc/wiki/DependentHaskell/Phase2| -------------------------------------+------------------------------------- Changes (by ningning): * status: new => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 18:54:36 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 18:54:36 -0000 Subject: [GHC] #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite In-Reply-To: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> References: <046.896ae06fe4a7986fa271ab3587c71083@haskell.org> Message-ID: <061.1f8455dc62a7a0fb8a6935c282a06293@haskell.org> #15544: Non-deterministic segmentation fault in cryptohash-sha256 testsuite -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: closed Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5145 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * status: merge => closed * resolution: => fixed Comment: Merged with 28356f217fe4d314bd5a4f0316b5bced755cbb2f. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 19:01:21 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 19:01:21 -0000 Subject: [GHC] #15571: Eager AP_STACK blackholing causes incorrect size info for sanity checks In-Reply-To: <043.9213207e6a514a137db4ef0469470bf7@haskell.org> References: <043.9213207e6a514a137db4ef0469470bf7@haskell.org> Message-ID: <058.48aa7240fc80dc02865c86f5572fd13d@haskell.org> #15571: Eager AP_STACK blackholing causes incorrect size info for sanity checks -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15508 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonmar): Hmm, I wonder if there's a much simpler way. The AP_STACK entry code simply copies the payload of the object onto the stack, after doing a stack check. So why don't we zero the slop immediately after copying the payload? That way we don't overwrite any data, and we don't need any new objects or stack frames. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 19:02:26 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 19:02:26 -0000 Subject: [GHC] #15571: Eager AP_STACK blackholing causes incorrect size info for sanity checks In-Reply-To: <043.9213207e6a514a137db4ef0469470bf7@haskell.org> References: <043.9213207e6a514a137db4ef0469470bf7@haskell.org> Message-ID: <058.f3718a0a38fdd249e37949df60f008a5@haskell.org> #15571: Eager AP_STACK blackholing causes incorrect size info for sanity checks -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15508 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonmar): Zero the slop right here: https://phabricator.haskell.org/diffusion/GHC/browse/master/rts%2FApply.cmm$682 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 19:13:39 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 19:13:39 -0000 Subject: [GHC] #15658: strange inferred kind with TypeInType In-Reply-To: <044.5c56e4e9c5ca25f242e17058c46d6daa@haskell.org> References: <044.5c56e4e9c5ca25f242e17058c46d6daa@haskell.org> Message-ID: <059.63623ce600a14a71b0185048771282a6@haskell.org> #15658: strange inferred kind with TypeInType -------------------------------------+------------------------------------- Reporter: dmwit | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.2 Resolution: | Keywords: TypeInType, | GHCProposal Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dmwit): I agree: it should be documented with some care. Here is another case worth discussing when writing the documentation. If I try to follow your reasoning for a modified type family, say: {{{ type family G a :: a }}} I reason that it should be: {{{ G :: forall (a :: *) -> a }}} So without the explicit kinding, I would expect ghci to give `G` the kind `forall a -> a`. But ghci does not agree: {{{ > :k G G :: a }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 19 19:16:26 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 19 Sep 2018 19:16:26 -0000 Subject: [GHC] #15658: strange inferred kind with TypeInType In-Reply-To: <044.5c56e4e9c5ca25f242e17058c46d6daa@haskell.org> References: <044.5c56e4e9c5ca25f242e17058c46d6daa@haskell.org> Message-ID: <059.5587ed871dd4e984fca5fea4ca127788@haskell.org> #15658: strange inferred kind with TypeInType -------------------------------------+------------------------------------- Reporter: dmwit | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.2 Resolution: | Keywords: TypeInType, | GHCProposal Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Replying to [comment:2 dmwit]: > So without the explicit kinding, I would expect ghci to give `G` the kind `forall a -> a`. But ghci does not agree: > > {{{ > > :k G > G :: a > }}} That's due to a separate GHC bug, #14238, which has been fixed in GHC 8.6.1. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 20 00:40:59 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 20 Sep 2018 00:40:59 -0000 Subject: [GHC] #14941: Switching direct type family application to EqPred (~) prevents inlining in code using vector (10x slowdown) In-Reply-To: <042.0e3de7917bdd684aac8357b129fd4898@haskell.org> References: <042.0e3de7917bdd684aac8357b129fd4898@haskell.org> Message-ID: <057.f829dea1c340d2919e48a1a687e29714@haskell.org> #14941: Switching direct type family application to EqPred (~) prevents inlining in code using vector (10x slowdown) -------------------------------------+------------------------------------- Reporter: nh2 | Owner: davide Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nh2): Replying to [comment:9 simonpj]: > How important is it? I'm tempted to say "don't write types like that"! From the user's perspective, I can put forward two use cases: 1. Type level let bindings `(..., VG.Mutable v ~ vm) => ... -> vm (PrimState m) e -> ...` From the issue description. This is essentially type-signature `let`-binding, allowing me to write the type signature more clearly/legibly, especially if `vm` is used multiple times. 2. Refactorings For the code in comment 4, `(val ~ Int) =>`, this arose from a refactoring where I replaced `Int` by `val` across a large code base, and then in the top-level-ish function set `val ~ Int` to check if the performance was unimpacted. I'd probably be OK without this being fixed, now that I know what's going on, but if it's not fixed, we somehow have to do a much better job at giving warnings or educating people that you can't just apply a substitution principle when "cleaning up" type signaturees with `~`. I incorrectly assumed this would be type-level only, and as a result had to start a multi-day investigation of where my performance went because I expected any mistake on my side but not this. Especially when writing code using `vector` whose type family heavy API, in my opinion, almost begs for `~` to be used to achieve readable signatures. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 20 09:30:39 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 20 Sep 2018 09:30:39 -0000 Subject: [GHC] #14251: LLVM Code Gen messes up registers In-Reply-To: <047.9ece2514d7c7f668525c93ec15fb841a@haskell.org> References: <047.9ece2514d7c7f668525c93ec15fb841a@haskell.org> Message-ID: <062.adc4a5fb8ef528011863264e6609496d@haskell.org> #14251: LLVM Code Gen messes up registers -------------------------------------+------------------------------------- Reporter: angerman | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler (LLVM) | Version: 8.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by awson): AFAIUI, the most recent takes on this problem are: 1. https://phabricator.haskell.org/D4003 by @angerman 2. https://gist.github.com/kavon/566fc6c21ff51803538884b79dc1d841 by @kavon (referred from the former) My understanding is that "1" doesn't quite work (generates wrong code for handwritten `cmm`). Also my understanding is that "2" should work (haven't tested it), but isn't so much aesthetically pleasant, since all padding arguments are of `FloatReg` type regardless of which type they are at the call-site. A year has passed since. Neither these two approaches, no other suggested in the email thread started from https://mail.haskell.org/pipermail/ghc- devs/2017-September/014700.html, were elaborated further. I wonder then what are chances of e.g. "2" to be upstreamed if properly polished? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 20 10:22:07 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 20 Sep 2018 10:22:07 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.adfbac169e3055a6c050270c19c632fe@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141, Phab:D5147, Phab:D5150 -------------------------------------+------------------------------------- Comment (by tdammers): Did an overnight validate run of the 3 changes, one by one. Here's what I got: -- master (a3bce956d7) -- {{{ Unexpected stat failures: /tmp/ghctest-hajvz66w/test spaces/perf/compiler/T9630.run T9630 [stat not good enough] (normal) }}} -- + step 1 (wip/T14880-2-step1) -- {{{ Unexpected stat failures: /tmp/ghctest-shsa0qwp/test spaces/perf/compiler/T9630.run T9630 [stat not good enough] (normal) }}} -- + step 2 (wip/T14880-2-step2-c123) -- {{{ Unexpected failures: /tmp/ghctest-5yp1lu_z/test spaces/dependent/should_fail/BadTelescope4.run BadTelescope4 [exit code 0] (normal) /tmp/ghctest-5yp1lu_z/test spaces/dependent/should_fail/T14066g.run T14066g [exit code 0] (normal) /tmp/ghctest-5yp1lu_z/test spaces/partial- sigs/should_compile/T12844.run T12844 [stderr mismatch] (normal) /tmp/ghctest-5yp1lu_z/test spaces/partial- sigs/should_compile/T15039a.run T15039a [stderr mismatch] (normal) /tmp/ghctest-5yp1lu_z/test spaces/partial- sigs/should_compile/T15039b.run T15039b [stderr mismatch] (normal) /tmp/ghctest-5yp1lu_z/test spaces/partial- sigs/should_compile/T15039c.run T15039c [stderr mismatch] (normal) /tmp/ghctest-5yp1lu_z/test spaces/partial- sigs/should_compile/T15039d.run T15039d [stderr mismatch] (normal) /tmp/ghctest-5yp1lu_z/test spaces/partial-sigs/should_run/T15415.run T15415 [bad stderr] (ghci) /tmp/ghctest-5yp1lu_z/test spaces/polykinds/T14265.run T14265 [stderr mismatch] (normal) }}} -- + step 3 (wip/T14880-2-step3) -- {{{ Unexpected failures: /tmp/ghctest-ht1chu9r/test spaces/dependent/should_compile/T14880-2.run T14880-2 [exit code non-0] (normal) /tmp/ghctest-ht1chu9r/test spaces/dependent/should_fail/BadTelescope4.run BadTelescope4 [exit code 0] (normal) /tmp/ghctest-ht1chu9r/test spaces/dependent/should_compile/dynamic- paper.run dynamic-paper [stderr mismatch] (normal) /tmp/ghctest-ht1chu9r/test spaces/dependent/should_fail/T14066g.run T14066g [exit code 0] (normal) /tmp/ghctest-ht1chu9r/test spaces/partial- sigs/should_compile/T12844.run T12844 [stderr mismatch] (normal) /tmp/ghctest-ht1chu9r/test spaces/partial- sigs/should_compile/T15039a.run T15039a [stderr mismatch] (normal) /tmp/ghctest-ht1chu9r/test spaces/partial- sigs/should_compile/T15039b.run T15039b [stderr mismatch] (normal) /tmp/ghctest-ht1chu9r/test spaces/partial- sigs/should_compile/T15039c.run T15039c [stderr mismatch] (normal) /tmp/ghctest-ht1chu9r/test spaces/partial- sigs/should_compile/T15039d.run T15039d [stderr mismatch] (normal) /tmp/ghctest-ht1chu9r/test spaces/partial-sigs/should_run/T15415.run T15415 [bad stderr] (ghci) /tmp/ghctest-ht1chu9r/test spaces/polykinds/T9222.run T9222 [stderr mismatch] (normal) /tmp/ghctest-ht1chu9r/test spaces/polykinds/T14265.run T14265 [stderr mismatch] (normal) }}} So it seems that step1 doesn't add any regressions beyond what's on master already, but steps 2 and 3 do. Step 3 also fails to pass the additional test `T14880-2` it introduces. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 20 10:40:16 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 20 Sep 2018 10:40:16 -0000 Subject: [GHC] #11042: Template Haskell / GHCi does not respect extra-lib-dirs In-Reply-To: <044.eb43e7f9b5666e68e3df817728c4c87b@haskell.org> References: <044.eb43e7f9b5666e68e3df817728c4c87b@haskell.org> Message-ID: <059.64c5dc1644752b652c502583fd2e20fc@haskell.org> #11042: Template Haskell / GHCi does not respect extra-lib-dirs -------------------------------------+------------------------------------- Reporter: mboes | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash | Test Case: Blocked By: 11238 | Blocking: Related Tickets: #10458 #5289 | Differential Rev(s): #12753 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by int-index): Replying to [comment:25 awson]: > The idea is: don't crash early. Nice! If anyone is willing to test this fix, I've put up a repo with instructions to reproduce this issue: https://github.com/serokell/trac11042 trommler, rwbarton, do you think this is a sensible way forward? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 20 10:40:32 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 20 Sep 2018 10:40:32 -0000 Subject: [GHC] #15571: Eager AP_STACK blackholing causes incorrect size info for sanity checks In-Reply-To: <043.9213207e6a514a137db4ef0469470bf7@haskell.org> References: <043.9213207e6a514a137db4ef0469470bf7@haskell.org> Message-ID: <058.d4036e3295a8424d8ca7e88b3bff1db6@haskell.org> #15571: Eager AP_STACK blackholing causes incorrect size info for sanity checks -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15508 | Differential Rev(s): Phab:D5165 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: new => patch * differential: => Phab:D5165 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 20 10:48:19 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 20 Sep 2018 10:48:19 -0000 Subject: [GHC] #15632: Undependable Dependencies In-Reply-To: <043.01997ce1746c591111a0a2273155036b@haskell.org> References: <043.01997ce1746c591111a0a2273155036b@haskell.org> Message-ID: <058.6ed3f28c766ebb80fcf1d539f2b339ac@haskell.org> #15632: Undependable Dependencies -------------------------------------+------------------------------------- Reporter: AntC | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: | FunctionalDependencies, | OverlappingInstances Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: 10675, 9210, | Differential Rev(s): 8634 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by AntC): Replying to [comment:2 AntC]: I've implemented the suggestion, in a version of Hugs. So throw at me your awkward cases/counter-examples. (Hugs latest release/Sep 2006 only allows `FunDeps + Overlap` if all the overlapping instances are per the strictly unify-to-equal rule. Hugs instance heads must overlap in a strict substitution order; none of GHC's allowing the potential for overlap.) Seems to be working; I have a type-level type equality test; it handles the tricky cases I'm aware of, including this ticket. #10675 is rejected. Even handles overlap of instances for TRex records. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 20 10:58:06 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 20 Sep 2018 10:58:06 -0000 Subject: [GHC] #15571: Eager AP_STACK blackholing causes incorrect size info for sanity checks In-Reply-To: <043.9213207e6a514a137db4ef0469470bf7@haskell.org> References: <043.9213207e6a514a137db4ef0469470bf7@haskell.org> Message-ID: <058.1b3d385679a16cda43023c30af2640f8@haskell.org> #15571: Eager AP_STACK blackholing causes incorrect size info for sanity checks -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15508 | Differential Rev(s): Phab:D5165 Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): I submitted a patch. Simon, looking at this note {{{ Note [zeroing slop] In some scenarios we write zero words into "slop"; memory that is left unoccupied after we overwrite a closure in the heap with a smaller closure. Zeroing slop is required for: - full-heap sanity checks (DEBUG, and +RTS -DS) - LDV profiling (PROFILING, and +RTS -hb) Zeroing slop must be disabled for: - THREADED_RTS with +RTS -N2 and greater, because we cannot overwrite slop when another thread might be reading it. Hence, slop is zeroed when either: - PROFILING && era <= 0 (LDV is on) - !THREADED_RTS && DEBUG And additionally: - LDV profiling and +RTS -N2 are incompatible - full-heap sanity checks are disabled for THREADED_RTS }}} This says that we can't zero slops in threaded runtime and heap sanity checks are disabled in threaded runtime, but that's not true. I can see in gdb that we do full heap sanity check in threaded programs too. Do you know what changed since this comment? I'm surprised that sanity checks work at all in threaded runtime because we don't zero the slops... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 20 11:07:25 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 20 Sep 2018 11:07:25 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.72304a156f9d37f03d0bb39872861fd3@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141, Phab:D5147, Phab:D5150 -------------------------------------+------------------------------------- Comment (by simonpj): But these are error wibbles, probably fine. (Still need looking at, of course. No perf changes? I can see no reported regression, but could you try some of the ones which did regress before, and see what happens to compiler allocations etc? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 20 11:58:30 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 20 Sep 2018 11:58:30 -0000 Subject: [GHC] #15571: Eager AP_STACK blackholing causes incorrect size info for sanity checks In-Reply-To: <043.9213207e6a514a137db4ef0469470bf7@haskell.org> References: <043.9213207e6a514a137db4ef0469470bf7@haskell.org> Message-ID: <058.29568061fa327441144ff2922ebaff16@haskell.org> #15571: Eager AP_STACK blackholing causes incorrect size info for sanity checks -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15508 | Differential Rev(s): Phab:D5165 Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonmar): If I recall correctly we disable the part of the sanity check that requires zeroing the slop when THREADED_RTS is on. See here: https://phabricator.haskell.org/diffusion/GHC/browse/master/rts%2Fsm%2FSanity.c$738-743 So full heap sanity check only happens after a major GC in the threaded runtime, and we don't do slop zeroing. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 20 13:39:30 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 20 Sep 2018 13:39:30 -0000 Subject: [GHC] #13233: typePrimRep panic while compiling GHC with profiling In-Reply-To: <046.6aee0fed3c9ac84b9f07b89c83d69fc3@haskell.org> References: <046.6aee0fed3c9ac84b9f07b89c83d69fc3@haskell.org> Message-ID: <061.9812bec76315e440691545047484a012@haskell.org> #13233: typePrimRep panic while compiling GHC with profiling -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: | LevityPolymorphism Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: crash or panic | codeGen/should_fail/T13233 Blocked By: | Blocking: Related Tickets: #14123, #14573 | Differential Rev(s): Phab:D3490 Wiki Page: | -------------------------------------+------------------------------------- Comment (by davide): Building GHC with the build.mk from comment:43, the bug doesn't surface in newer commits: ||= Commit =||= Build =|| || HEAD (a4ae97ea63) || success || || ghc-8.6 (6cad8e31dc852594a) || success || || 6f8c3ce4b1 || panic (expected) || -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 20 14:09:59 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 20 Sep 2018 14:09:59 -0000 Subject: [GHC] #15481: TH fails to recover from reifyFixity with -fexternal-interpreter In-Reply-To: <050.5475c911201fc232088c3ce363d7a784@haskell.org> References: <050.5475c911201fc232088c3ce363d7a784@haskell.org> Message-ID: <065.7bc5e3d7f3c20fb5c9ea979a7ca3f82a@haskell.org> #15481: TH fails to recover from reifyFixity with -fexternal-interpreter -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: RemoteGHCi Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Interestingly, if you invoke `fail` anywhere in the second argument to `recover`: {{{#!hs main :: IO () main = putStrLn $(recover (stringE "reifyFixity failed") (do foo <- newName "foo" _ <- reifyFixity foo fail "wat" stringE "reifyFixity successful")) }}} Then `-fexternal-interpreter` will successfully recover again. Also, there appears to be something specific to `reifyFixity` that triggers this bug. If I replace `reifyFixity` with `reify` or `reifyConStrictness`, then `-fexternal-interpreter` is able to successfully recover from those. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 20 14:26:01 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 20 Sep 2018 14:26:01 -0000 Subject: [GHC] #14251: LLVM Code Gen messes up registers In-Reply-To: <047.9ece2514d7c7f668525c93ec15fb841a@haskell.org> References: <047.9ece2514d7c7f668525c93ec15fb841a@haskell.org> Message-ID: <062.7bf3069acf06f6a07212fd6b6461edb8@haskell.org> #14251: LLVM Code Gen messes up registers -------------------------------------+------------------------------------- Reporter: angerman | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler (LLVM) | Version: 8.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"ba086ca72ee6c77abba685f3100ad513e38a1a87/ghc" ba086ca/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="ba086ca72ee6c77abba685f3100ad513e38a1a87" Add testcase for #14251 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 20 15:21:36 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 20 Sep 2018 15:21:36 -0000 Subject: [GHC] #15481: TH fails to recover from reifyFixity with -fexternal-interpreter In-Reply-To: <050.5475c911201fc232088c3ce363d7a784@haskell.org> References: <050.5475c911201fc232088c3ce363d7a784@haskell.org> Message-ID: <065.0c5ee7c9c6589d93a2522fd2d7e5b749@haskell.org> #15481: TH fails to recover from reifyFixity with -fexternal-interpreter -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: RemoteGHCi Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): I now understand the underlying problem slightly better than before. One of the culprits appears to be whether `addErrTc` is used to accumulate errors (as opposed to `failWithTc`, which throws errors immediately). `reifyFixity` only calls `addErrTc` when used in the program above, whereas if you swap out `reifyFixity` for something like `reify` or `reifyConStrictness`, you'll end up reaching a code path that uses `failWithTc`. (Similarly, adding an explicit use of `fail` will also cause `failWithTc` to be invoked.) For some peculiar reason, `recover` is able to successfully recover from errors added via `failWithTc` when `-fexternal-interpreter` is enabled, but not errors added via `addErrTc`. I don't know why that is the case, however. There is a `Note [TH recover with -fexternal-interpreter]` [http://git.haskell.org/ghc.git/blob/4eebc8016f68719e1ccdf460754a97d1f4d6ef05:/compiler/typecheck/TcSplice.hs#l1066 here], but I can't glean any nuggets of wisdom from that. Given that `failWithTc` appears to be recovered more reliably than `addErrTc`, one way to fix this bug is to just error more eagerly in `qReifyFixity`, like so: {{{#!diff diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index c26ba0d..000c84c 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -866,7 +866,7 @@ instance TH.Quasi TcM where qLookupName = lookupName qReify = reify - qReifyFixity nm = lookupThName nm >>= reifyFixity + qReifyFixity nm = checkNoErrs (lookupThName nm) >>= reifyFixity qReifyInstances = reifyInstances qReifyRoles = reifyRoles qReifyAnnotations = reifyAnnotations }}} This makes the original program in this ticket recover successfully, even with `-fexternal-interpreter`. That being said, I'm not sure if it's really the "right" way to fix this bug, since there appears to be some underlying issue in the way `-fexternal-interpreter` interacts with `addErrTc`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 20 15:35:53 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 20 Sep 2018 15:35:53 -0000 Subject: [GHC] #13971: Misleading "Kind mis-match on LHS of default declaration" error In-Reply-To: <050.d40bc20f28df73e49993d6ba5839a725@haskell.org> References: <050.d40bc20f28df73e49993d6ba5839a725@haskell.org> Message-ID: <065.c08a2525d8ccab18176cb354388ef598@haskell.org> #13971: Misleading "Kind mis-match on LHS of default declaration" error -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler (Type | Version: 8.0.1 checker) | Resolution: | Keywords: TypeFamilies Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): I suppose we could just remove the phrase "on LHS" as a simple fix. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 20 19:49:09 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 20 Sep 2018 19:49:09 -0000 Subject: [GHC] #15660: source file modify race leads to inconsistent error message Message-ID: <047.0bb5271dc9d70158327714b5707bda53@haskell.org> #15660: source file modify race leads to inconsistent error message -------------------------------------+------------------------------------- Reporter: joeyhess | Owner: (none) Type: bug | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Linux Architecture: | Type of failure: Poor/confusing Unknown/Multiple | error message Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I got this odd error message from ghc: {{{ Command/AddUrl.hs:120:32: error: lexical error in string/character literal at character '-' | 120 | BatchNull -> '\0' | ^ }}} Part of the error message says that '-' is the problem character, but the quoted line of code does not contain that. What happened is I started the build, noticed I had typoed '\-' and quickly corrected it in my editor and saved. It seems ghc must have read the source file twice, so I raced it and so experienced this inconsistency. I wonder if it could display the wrong line entirely if a larger change was made to the file? Thanks for your time with such a minor thing as this bug. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 20 20:52:54 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 20 Sep 2018 20:52:54 -0000 Subject: [GHC] #15661: Nullary constraint in GHCi breaks `:t` command Message-ID: <045.4edb5a5e645d42b94af8bcdcf6c12464@haskell.org> #15661: Nullary constraint in GHCi breaks `:t` command -------------------------------------+------------------------------------- Reporter: taktoa | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 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: -------------------------------------+------------------------------------- If you create a value whose type has a nullary constraint (i.e.: a constraint that does not reference any of the type variables in scope) and then try to run `:t` on it, GHCi attempts to run instance resolution and fails before printing the type. Expected output: {{{ GHCi, version 8.4.3: http://www.haskell.org/ghc/ :? for help Prelude> :set -XFlexibleContexts Prelude> data Foo = Foo Prelude> let x :: (Show Foo) => () ; x = () Prelude> :t x x :: Show Foo => () }}} Actual output: {{{ GHCi, version 8.4.3: http://www.haskell.org/ghc/ :? for help Prelude> :set -XFlexibleContexts Prelude> data Foo = Foo Prelude> let x :: (Show Foo) => () ; x = () Prelude> :t x :1:1: error: No instance for (Show Foo) arising from a use of ‘x’ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 20 21:15:23 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 20 Sep 2018 21:15:23 -0000 Subject: [GHC] #14251: LLVM Code Gen messes up registers In-Reply-To: <047.9ece2514d7c7f668525c93ec15fb841a@haskell.org> References: <047.9ece2514d7c7f668525c93ec15fb841a@haskell.org> Message-ID: <062.5133473f90c290db2183df1e314b9f41@haskell.org> #14251: LLVM Code Gen messes up registers -------------------------------------+------------------------------------- Reporter: angerman | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler (LLVM) | Version: 8.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): In my opinion just about anything is better than the status quo. It would be great if someone could look into finishing up (2). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 21 07:04:27 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 21 Sep 2018 07:04:27 -0000 Subject: [GHC] #15571: Eager AP_STACK blackholing causes incorrect size info for sanity checks In-Reply-To: <043.9213207e6a514a137db4ef0469470bf7@haskell.org> References: <043.9213207e6a514a137db4ef0469470bf7@haskell.org> Message-ID: <058.bfb421d76e0941237a5b299c353a2376@haskell.org> #15571: Eager AP_STACK blackholing causes incorrect size info for sanity checks -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.6.1 Component: Runtime System | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15508 | Differential Rev(s): Phab:D5165 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ömer Sinan Ağacan ): In [changeset:"66c17293648fd03a04aabfd807b3c8336e8f843a/ghc" 66c17293/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="66c17293648fd03a04aabfd807b3c8336e8f843a" Fix slop zeroing for AP_STACK eager blackholes in debug build As #15571 reports, eager blackholing breaks sanity checks as we can't zero the payload when eagerly blackholing (because we'll be using the payload after blackholing), but by the time we blackhole a previously eagerly blackholed object (in `threadPaused()`) we don't have the correct size information for the object (because the object's type becomes BLACKHOLE when we eagerly blackhole it) so can't properly zero the slop. This problem can be solved for AP_STACK eager blackholing (which unlike eager blackholing in general, is not optional) by zeroing the payload after entering the stack. This patch implements this idea. Fixes #15571. Test Plan: Previously concprog001 when compiled and run with sanity checks ghc-stage2 Mult.hs -debug -rtsopts ./Mult +RTS -DS was failing with Mult: internal error: checkClosure: stack frame (GHC version 8.7.20180821 for x86_64_unknown_linux) Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug thic patch fixes this panic. The test still panics, but it runs for a while before panicking (instead of directly panicking as before), and the new problem seems unrelated: Mult: internal error: ASSERTION FAILED: file rts/sm/Sanity.c, line 296 (GHC version 8.7.20180919 for x86_64_unknown_linux) Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug The new problem will be fixed in another diff. I also tried slow validate (which requires D5164): this does not introduce any new failures. Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15571 Differential Revision: https://phabricator.haskell.org/D5165 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 21 07:05:48 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 21 Sep 2018 07:05:48 -0000 Subject: [GHC] #15571: Eager AP_STACK blackholing causes incorrect size info for sanity checks In-Reply-To: <043.9213207e6a514a137db4ef0469470bf7@haskell.org> References: <043.9213207e6a514a137db4ef0469470bf7@haskell.org> Message-ID: <058.efd92c6a8114243b0fafdc26d6a0bae6@haskell.org> #15571: Eager AP_STACK blackholing causes incorrect size info for sanity checks -------------------------------------+------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Runtime System | Version: 8.5 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15508 | Differential Rev(s): Phab:D5165 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: patch => closed * resolution: => fixed * milestone: 8.6.1 => -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 21 07:24:03 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 21 Sep 2018 07:24:03 -0000 Subject: [GHC] #15508: concprog001 fails with various errors In-Reply-To: <043.7b20754ba25128f911949e43ef11a3db@haskell.org> References: <043.7b20754ba25128f911949e43ef11a3db@haskell.org> Message-ID: <058.1df7df7ed028bd8e44e5a982813d5b1d@haskell.org> #15508: concprog001 fails with various errors -------------------------------------+------------------------------------- Reporter: osa1 | Owner: osa1 Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #15571 | Differential Rev(s): Phab:D5051 Wiki Page: | (reverted), Phab:D5165 -------------------------------------+------------------------------------- Changes (by osa1): * differential: Phab:D5051 => Phab:D5051 (reverted), Phab:D5165 Comment: Fixing one bug reveals others. I'm currently getting this {{{ Mult: internal error: ASSERTION FAILED: file rts/sm/Sanity.c, line 296 (GHC version 8.7.20180919 for x86_64_unknown_linux) Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} The stack trace: {{{ >>> bt #0 __GI_raise (sig=sig at entry=6) at ../sysdeps/unix/sysv/linux/raise.c:51 #1 0x00007f7bf5709801 in __GI_abort () at abort.c:79 #2 0x00000000007313b5 in rtsFatalInternalErrorFn (s=0x79fd90 "ASSERTION FAILED: file %s, line %u\n", ap=0x7ffe92feb8b8) at rts/RtsMessages.c:186 #3 0x0000000000730fd9 in barf (s=0x79fd90 "ASSERTION FAILED: file %s, line %u\n") at rts/RtsMessages.c:48 #4 0x000000000073103e in _assertFail (filename=0x7a55f0 "rts/sm/Sanity.c", linenum=296) at rts/RtsMessages.c:63 #5 0x0000000000751be3 in checkClosure (p=0x42008e45e0) at rts/sm/Sanity.c:295 #6 0x00000000007521b0 in checkHeapChain (bd=0x4200803900) at rts/sm/Sanity.c:450 #7 0x0000000000752bf1 in checkGeneration (gen=0x10ec408, after_major_gc=false) at rts/sm/Sanity.c:745 #8 0x0000000000752cc1 in checkFullHeap (after_major_gc=false) at rts/sm/Sanity.c:764 #9 0x0000000000752d3b in checkSanity (after_gc=false, major_gc=false) at rts/sm/Sanity.c:773 #10 0x000000000074e99b in GarbageCollect (collect_gen=0, do_heap_census=false, gc_type=0, cap=0x90e1c0 , idle_cap=0x0) at rts/sm/GC.c:320 #11 0x0000000000734141 in scheduleDoGC (pcap=0x7ffe92febcb0, task=0x10fdd50, force_major=false) at rts/Schedule.c:1800 #12 0x0000000000733619 in schedule (initialCapability=0x90e1c0 , task=0x10fdd50) at rts/Schedule.c:546 #13 0x0000000000734b13 in scheduleWaitThread (tso=0x4200105388, ret=0x0, pcap=0x7ffe92febdb0) at rts/Schedule.c:2537 #14 0x0000000000743205 in rts_evalLazyIO (cap=0x7ffe92febdb0, p=0x7d5710, ret=0x0) at rts/RtsAPI.c:530 #15 0x000000000074394c in hs_main (argc=1, argv=0x7ffe92febfa8, main_closure=0x7d5710, rts_config=...) at rts/RtsMain.c:72 #16 0x000000000042fd6e in main () }}} The assertion that fails: {{{ ASSERT(bq->queue == (MessageBlackHole*)END_TSO_QUEUE || bq->queue->header.info == &stg_MSG_BLACKHOLE_info); }}} bq->queue is actually an IND: {{{ >>> print bq->queue $1 = (struct MessageBlackHole_ *) 0x42001df098 >>> call printClosure(bq->queue) IND(0x42001de350) }}} There's a note about this in Evac.c: {{{ // Note [BLACKHOLE pointing to IND] // // BLOCKING_QUEUE can be overwritten by IND (see // wakeBlockingQueue()). However, when this happens we must // be updating the BLACKHOLE, so the BLACKHOLE's indirectee // should now point to the value. // // The mutator might observe an inconsistent state, because // the writes are happening in another thread, so it's // possible for the mutator to follow an indirectee and find // an IND. But this should never happen in the GC, because // the mutators are all stopped and the writes have // completed. }}} It seems like this currently does not hold. We're in GC and observe that a BLOCKING_QUEUE is actually an IND. Adding watchpoint to see when it became an IND: {{{ >>> watch ((StgBlockingQueue *) 0x42008e45e0)->queue->header.info Hardware watchpoint 1: ((StgBlockingQueue *) 0x42008e45e0)->queue->header.info >>> reverse-continue >>> bt #0 0x00000000007406a0 in SET_INFO (c=0x42001df098, info=0x763e08 ) at includes/rts/storage/ClosureMacros.h:49 #1 0x0000000000740dfe in throwToMsg (cap=0x90e1c0 , msg=0x42000cc180) at rts/RaiseAsync.c:412 #2 0x0000000000740905 in throwTo (cap=0x90e1c0 , source=0x420040e438, target=0x42008bcc40, exception=0x7df158) at rts/RaiseAsync.c:213 #3 0x00000000007613c2 in stg_killThreadzh () #4 0x0000000000000000 in ?? () }}} I'm not sure when this object is supposed to become a BLACKHOLE (or END_TSO_QUEUE) again. Simon, any ideas? I'm also confused why a note about blackholes talk about BLOCKING_QUEUE... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 21 12:58:49 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 21 Sep 2018 12:58:49 -0000 Subject: [GHC] #11671: Allow labels starting with uppercase with OverloadedLabels In-Reply-To: <044.a0bb36a4fb997b6415af764b9c7b0bc1@haskell.org> References: <044.a0bb36a4fb997b6415af764b9c7b0bc1@haskell.org> Message-ID: <059.7b67926916689adf7cf7163ab4c11567@haskell.org> #11671: Allow labels starting with uppercase with OverloadedLabels -------------------------------------+------------------------------------- Reporter: inaki | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1-rc1 (Parser) | Keywords: ORF, Resolution: | GHCProposal Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * keywords: ORF => ORF, GHCProposal -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 21 13:01:30 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 21 Sep 2018 13:01:30 -0000 Subject: [GHC] #13700: GHCi command listing possible type class instances In-Reply-To: <051.87a39f033f8a52ca51433d465661fe5a@haskell.org> References: <051.87a39f033f8a52ca51433d465661fe5a@haskell.org> Message-ID: <066.6ec7b0072a45dd2e5b6a8cc2dde058ac@haskell.org> #13700: GHCi command listing possible type class instances -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: Iceland_jack Type: feature request | Status: closed Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Resolution: duplicate | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15610 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * resolution: => duplicate * related: => #15610 Comment: I'm going to close this in favor of #15610, which seems to be a more up- to-date version of this same request. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 21 13:02:18 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 21 Sep 2018 13:02:18 -0000 Subject: [GHC] #15610: GHCi command to list instances a (possibly compound) type belongs to In-Reply-To: <051.14e1cd8a0da52d24d90bbe3d664e811c@haskell.org> References: <051.14e1cd8a0da52d24d90bbe3d664e811c@haskell.org> Message-ID: <066.569c37a6d864a6cc7bafb6e393bf80f9@haskell.org> #15610: GHCi command to list instances a (possibly compound) type belongs to -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: feature request | Status: new Priority: lowest | Milestone: Component: Compiler | Version: Resolution: | Keywords: GHCProposal Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #13700, #15613 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * keywords: => GHCProposal * related: #15613 => #13700, #15613 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 21 13:02:35 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 21 Sep 2018 13:02:35 -0000 Subject: [GHC] #8281: The impossible happened: primRepToFFIType In-Reply-To: <044.47e20917996e473150de04c1ce1afc0b@haskell.org> References: <044.47e20917996e473150de04c1ce1afc0b@haskell.org> Message-ID: <059.0bfa9180ac472ac114576d19cacde658@haskell.org> #8281: The impossible happened: primRepToFFIType -------------------------------------+------------------------------------- Reporter: tibbe | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.6.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D3619 Wiki Page: | -------------------------------------+------------------------------------- Comment (by hvr): Fwiw, re documenting `UnliftedFFITypes` for unpinned `ByteArray#s` I (re)stumbled over this old authoritative sounding email (https://mail.haskell.org/pipermail/haskell-cafe/2014-June/114761.html) from Johan Tibell which stated > There is a way to pass an unpinned `ByteArray#` (or `MutableByteArray#`, but the former seems right in your case) to a foreign call, using the `UnliftedFFITypes` language extension. The `ByteArray#` is **guaranteed to not to be moved for the duration of the call**. The code should treat the `ByteArray#` argument as if it was a pointer to bytes. You will need to do any address offset computations on the C side (i.e. pass any offsets you need as extra argument to your C function). ...which might explain why there's a lot of code out there (including my own) which relies on that guarantee to be upheld (including for `safe` FFI calls). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 21 13:02:50 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 21 Sep 2018 13:02:50 -0000 Subject: [GHC] #3427: control what sort of entity a deprecated pragma applies to In-Reply-To: <044.6e5c26a8435c2fcde3f9de3ab4769428@haskell.org> References: <044.6e5c26a8435c2fcde3f9de3ab4769428@haskell.org> Message-ID: <059.4fde667ee610bd57e6b17ebeca6fdaab@haskell.org> #3427: control what sort of entity a deprecated pragma applies to -------------------------------------+------------------------------------- Reporter: igloo | Owner: nineonine Type: feature request | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 6.10.4 Resolution: | Keywords: deprecate | warning, newcomer, GHCProposal Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5126 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * keywords: deprecate warning, newcomer => deprecate warning, newcomer, GHCProposal -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 21 13:03:18 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 21 Sep 2018 13:03:18 -0000 Subject: [GHC] #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings In-Reply-To: <051.1afac0be4b689267d905f3e66b5a2d7d@haskell.org> References: <051.1afac0be4b689267d905f3e66b5a2d7d@haskell.org> Message-ID: <066.cbbe5c1c56c2be84a9aaf3230b338c19@haskell.org> #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: GHCProposal 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: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * keywords: => GHCProposal -- Ticket URL: GHC The Glasgow Haskell Compiler From patelvirashree at gmail.com Fri Sep 21 15:10:38 2018 From: patelvirashree at gmail.com (Virashree Patel) Date: Fri, 21 Sep 2018 10:10:38 -0500 Subject: Looking for student ticket to GHC Message-ID: Hi, I am looking to buy a student ticket to GHC 2018. If you are selling still please contact me. Thank you! Best, Vira Patel, Graduate Research Assistant at *Kansas State University * LinkedIn: *linkedin.com/in/virashreepatel * -------------- next part -------------- An HTML attachment was scrubbed... URL: From ghc-devs at haskell.org Fri Sep 21 16:16:05 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 21 Sep 2018 16:16:05 -0000 Subject: [GHC] #15662: Line pragmas appear to be slightly broken with Clang's CPP Message-ID: <046.2a012973b0e74ae240426b655456015f@haskell.org> #15662: Line pragmas appear to be slightly broken with Clang's CPP -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 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: -------------------------------------+------------------------------------- Two tests fail on OS X due to CPP irregularities, {{{ 7 --- /var/folders/3y/qjvrbynj45j_z4jt_l1k1qg00000gv/T/ghctest- jb4vg3rr/test spaces/parser/should_fail/readFail032.run/readFail032.stderr.normalised 2018-09-18 09:07:49.000000000 +0300 8 +++ /var/folders/3y/qjvrbynj45j_z4jt_l1k1qg00000gv/T/ghctest- jb4vg3rr/test spaces/parser/should_fail/readFail032.run/readFail032.comp.stderr.normalised 2018-09-18 09:07:49.000000000 +0300 9 @@ -1,5 +1,5 @@ 10 11 -readFail032.hs:25:38: 12 +readFail032.hs:26:38: 13 Couldn't match type ‘Char’ with ‘[Char]’ 14 Expected type: [[Char]] 15 Actual type: [Char] 16 --- /var/folders/3y/qjvrbynj45j_z4jt_l1k1qg00000gv/T/ghctest- jb4vg3rr/test spaces/parser/should_fail/readFail048.run/readFail048.stderr.normalised 2018-09-18 09:07:50.000000000 +0300 17 +++ /var/folders/3y/qjvrbynj45j_z4jt_l1k1qg00000gv/T/ghctest- jb4vg3rr/test spaces/parser/should_fail/readFail048.run/readFail048.comp.stderr.normalised 2018-09-18 09:07:50.000000000 +0300 18 @@ -1,5 +1,5 @@ 19 20 -readFail048.hs:25:38: 21 +readFail048.hs:26:38: 22 Couldn't match type ‘Char’ with ‘[Char]’ 23 Expected type: [[Char]] 24 Actual type: [Char] }}} This appears to be a CPP bug. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 21 18:31:35 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 21 Sep 2018 18:31:35 -0000 Subject: [GHC] #4022: GHC Bindist is Broken on FreeBSD/amd64 In-Reply-To: <042.be61d95849398bdf9c05d1a69af1e7e3@haskell.org> References: <042.be61d95849398bdf9c05d1a69af1e7e3@haskell.org> Message-ID: <057.56aeda8e8f8a4ac69cdfb9cf70c29086@haskell.org> #4022: GHC Bindist is Broken on FreeBSD/amd64 -------------------------------------+------------------------------------- Reporter: pgj | Owner: pgj Type: bug | Status: new Priority: lowest | Milestone: Component: Core Libraries | Version: 6.13 Resolution: | Keywords: GMP,integer- | gmp, sharedlibs Operating System: FreeBSD | Architecture: x86_64 Type of failure: Building GHC | (amd64) failed | Test Case: Blocked By: | Blocking: Related Tickets: #8156 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Unfortunately I'm finding that the FreeBSD bindist for 8.6.1 fails to pass `bindisttest`: {{{ [1 of 1] Compiling Main ( bindisttest/HelloWorld.lhs, bindisttest/HelloWorld.o ) Linking bindisttest/HelloWorld ... /usr/local/bin/ld.gold: error: /usr/home/ben/bin- dist-8.6.1-FreeBSD/ghc/bindisttest/install dir/lib/ghc-8.6.1/rts/libHSrts.a(RTS.o): unexpected reloc 8 in object file ... (many more messages of the same form) }}} I suspect this is due to our insistence on using `ld.gold`. I'm going to try doing another build with `--disable-ld-override`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 21 18:48:40 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 21 Sep 2018 18:48:40 -0000 Subject: [GHC] #4022: GHC Bindist is Broken on FreeBSD/amd64 In-Reply-To: <042.be61d95849398bdf9c05d1a69af1e7e3@haskell.org> References: <042.be61d95849398bdf9c05d1a69af1e7e3@haskell.org> Message-ID: <057.c385b4d15ca7d7b969342589898042d9@haskell.org> #4022: GHC Bindist is Broken on FreeBSD/amd64 -------------------------------------+------------------------------------- Reporter: pgj | Owner: pgj Type: bug | Status: new Priority: lowest | Milestone: Component: Core Libraries | Version: 6.13 Resolution: | Keywords: GMP,integer- | gmp, sharedlibs Operating System: FreeBSD | Architecture: x86_64 Type of failure: Building GHC | (amd64) failed | Test Case: Blocked By: | Blocking: Related Tickets: #8156 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Sadly using `ld.bfd` (on FreeBSD 11, just as in comment:41) fails even earlier in the build with undefined DTrace symbols: {{{ /usr/home/ben/bin- dist-8.6.1-FreeBSD/ghc/rts/dist/build/libHSrts_thr_p.a(RTS.thr_p_o): In function `traceTaskMigrate': /usr/home/ben/bin-dist-8.6.1-FreeBSD/ghc/rts/Trace.h:868:0: error: undefined reference to `__dtrace_HaskellEvent___task__migrate' | 868 | dtraceTaskMigrate(serialisableTaskId(task), (EventCapNo)cap->no, | ^ }}} I suppose I will also need to disable DTrace. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 21 20:24:11 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 21 Sep 2018 20:24:11 -0000 Subject: [GHC] #15663: T9675 inexplicably regressed in allocations due to text submodule bump Message-ID: <046.4bbf528148a8a5d4e7c394f0e92d23d3@haskell.org> #15663: T9675 inexplicably regressed in allocations due to text submodule bump -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 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: -------------------------------------+------------------------------------- Harbormaster somehow started showing a significant (~20%) regression in `T9675`'s allocations starting in 989dca6cbd93. Strangely, this is a bump of the `text` submodule. Something is extremely fishy here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 21 20:27:24 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 21 Sep 2018 20:27:24 -0000 Subject: [GHC] #15663: T9675 inexplicably regressed in allocations due to text submodule bump In-Reply-To: <046.4bbf528148a8a5d4e7c394f0e92d23d3@haskell.org> References: <046.4bbf528148a8a5d4e7c394f0e92d23d3@haskell.org> Message-ID: <061.86ec178b84f8c853166fec819f8279d2@haskell.org> #15663: T9675 inexplicably regressed in allocations due to text submodule bump -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by bgamari: Old description: > Harbormaster somehow started showing a significant (~20%) regression in > `T9675`'s allocations starting in 989dca6cbd93. Strangely, this is a bump > of the `text` submodule. Something is extremely fishy here. New description: Harbormaster somehow started showing a significant (~20%) regression in `T9675`'s allocations starting in 989dca6cbd93205a72f12a0921ba1216559a9e1e. Strangely, this is a bump of the `text` submodule. This can't be right; something is extremely fishy here. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 21 21:11:53 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 21 Sep 2018 21:11:53 -0000 Subject: [GHC] #15664: Core Lint error Message-ID: <051.098b7dc938620399617aa57fbf6ce28a@haskell.org> #15664: Core Lint error -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Keywords: TypeInType | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- From [https://github.com/VictorCMiraldo/victorcmiraldo.github.io/blob/845e74b59aee5a322b6cdd1e45355db16a30d8af/data/hask2018_draft.pdf Generic Programming of All Kinds], {{{#!hs {-# Language RankNTypes, TypeOperators, DataKinds, PolyKinds, GADTs, TypeInType, TypeFamilies #-} {-# Options_GHC -dcore-lint #-} -- https://github.com/VictorCMiraldo/victorcmiraldo.github.io/blob/845e74b59aee5a322b6cdd1e45355db16a30d8af/data/hask2018_draft.pdf import Data.Kind import GHC.Exts import Data.Function data Ctx :: Type -> Type where E :: Ctx(Type) (:&:) :: a -> Ctx(as) -> Ctx(a -> as) type family Apply(kind) (f :: kind) (ctx :: Ctx kind) :: Type where Apply(Type) a E = a Apply(k -> ks) f (a:&:as) = Apply(ks) (f a) as data ApplyT kind :: kind -> Ctx(kind) -> Type where A0 :: a -> ApplyT(Type) a E AS :: ApplyT(ks) (f a) as -> ApplyT(k -> ks) f (a:&:as) type f ~> g = (forall xx. f xx -> g xx) unravel :: ApplyT(k) f ~> Apply(k) f unravel (A0 a) = a unravel (AS fa) = unravel fa }}} gives a core lint error {{{ $ ghci -ignore-dot-ghci hs/443.hs > /tmp/bug.log }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 21 21:12:44 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 21 Sep 2018 21:12:44 -0000 Subject: [GHC] #15664: Core Lint error In-Reply-To: <051.098b7dc938620399617aa57fbf6ce28a@haskell.org> References: <051.098b7dc938620399617aa57fbf6ce28a@haskell.org> Message-ID: <066.0c1e030205d0c940500f38bfac6bad57@haskell.org> #15664: Core Lint error -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Iceland_jack): * Attachment "bug.log" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 21 21:19:04 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 21 Sep 2018 21:19:04 -0000 Subject: [GHC] #15664: Core Lint error In-Reply-To: <051.098b7dc938620399617aa57fbf6ce28a@haskell.org> References: <051.098b7dc938620399617aa57fbf6ce28a@haskell.org> Message-ID: <066.d4e59c391b37113c944f71746a93818f@haskell.org> #15664: Core Lint error -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): Short version {{{#!hs {-# Language RankNTypes, TypeOperators, DataKinds, PolyKinds, GADTs, TypeInType, TypeFamilies #-} {-# Options_GHC -dcore-lint #-} import Data.Kind type family Apply (kind) (f :: kind) :: Type data ApplyT(kind) :: kind -> Type type f ~> g = (forall xx. f xx -> g xx) unravel :: ApplyT(k) ~> Apply(k) unravel = unravel }}} {{{ $ ghci -ignore-dot-ghci hs/443.hs GHCi, version 8.7.20180828: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( hs/443.hs, interpreted ) *** Core Lint errors : in result of Desugar (before optimization) *** : warning: In the type ‘forall k. ApplyT k ~> Apply k’ Un-saturated type application Apply k_a1y2 *** Offending Program *** Rec { $tcApplyT :: TyCon [LclIdX] $tcApplyT = TyCon 14646326419187070856## 770477529860249545## $trModule (TrNameS "ApplyT"#) 1# $krep_a1Ad $krep_a1Ae [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId] $krep_a1Ae = $WKindRepVar (I# 0#) $krep_a1Ad [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId] $krep_a1Ad = KindRepFun $krep_a1Ae krep$* $trModule :: Module [LclIdX] $trModule = Module (TrNameS "main"#) (TrNameS "Main"#) unravel :: forall k. ApplyT k ~> Apply k [LclIdX] unravel = \ (@ k_a1zb) (@ (xx_a1zc :: k_a1zb)) -> break<0>() unravel @ k_a1zb @ xx_a1zc end Rec } *** End of Offense *** : error: Compilation had errors *** Exception: ExitFailure 1 > }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 21 22:17:23 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 21 Sep 2018 22:17:23 -0000 Subject: [GHC] #15664: Core Lint error In-Reply-To: <051.098b7dc938620399617aa57fbf6ce28a@haskell.org> References: <051.098b7dc938620399617aa57fbf6ce28a@haskell.org> Message-ID: <066.dc65ea99278afb32c4237a7d6150d3ab@haskell.org> #15664: Core Lint error -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by monoidal): A bit shorter version: {{{ {-# Language RankNTypes, TypeOperators, DataKinds, PolyKinds, GADTs, TypeInType, TypeFamilies #-} {-# Options_GHC -dcore-lint #-} import Data.Kind type family Apply (f :: Type) :: Type type F f = forall x. x unravel :: F Apply unravel = unravel }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 22 00:50:20 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 22 Sep 2018 00:50:20 -0000 Subject: [GHC] #15663: T9675 inexplicably regressed in allocations due to text submodule bump In-Reply-To: <046.4bbf528148a8a5d4e7c394f0e92d23d3@haskell.org> References: <046.4bbf528148a8a5d4e7c394f0e92d23d3@haskell.org> Message-ID: <061.d3cb84a6cc76f50890c2fa851792c32a@haskell.org> #15663: T9675 inexplicably regressed in allocations due to text submodule bump -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ben Gamari ): In [changeset:"fd89bb44c1ebe36498c84f5e1ab4e4308a5a594a/ghc" fd89bb44/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="fd89bb44c1ebe36498c84f5e1ab4e4308a5a594a" testsuite: Bump expected allocations of T9675 This inexplicably started with 989dca6cbd93, which appears to be a bump of the `text` submodule. This is very fishy so I've opened #15663 to ensure we investigate. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 22 01:18:14 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 22 Sep 2018 01:18:14 -0000 Subject: [GHC] #15663: T9675 inexplicably regressed in allocations due to text submodule bump In-Reply-To: <046.4bbf528148a8a5d4e7c394f0e92d23d3@haskell.org> References: <046.4bbf528148a8a5d4e7c394f0e92d23d3@haskell.org> Message-ID: <061.c42979fc624bf0effb5d51c7e403f58c@haskell.org> #15663: T9675 inexplicably regressed in allocations due to text submodule bump -------------------------------------+------------------------------------- Reporter: bgamari | Owner: alpmestan Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * owner: (none) => alpmestan Comment: Do you think you could look into this, Alp? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 22 04:14:15 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 22 Sep 2018 04:14:15 -0000 Subject: [GHC] #11042: Template Haskell / GHCi does not respect extra-lib-dirs In-Reply-To: <044.eb43e7f9b5666e68e3df817728c4c87b@haskell.org> References: <044.eb43e7f9b5666e68e3df817728c4c87b@haskell.org> Message-ID: <059.68f7b6e1e2d2977f4d874a3b8acfef1b@haskell.org> #11042: Template Haskell / GHCi does not respect extra-lib-dirs -------------------------------------+------------------------------------- Reporter: mboes | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash | Test Case: Blocked By: 11238 | Blocking: Related Tickets: #10458 #5289 | Differential Rev(s): #12753 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by awson): I've amended the patch. Now we don't crash early only if we have a chance to have package's dll loaded, otherwise the linker behaviour is the same as before. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 22 04:15:14 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 22 Sep 2018 04:15:14 -0000 Subject: [GHC] #11042: Template Haskell / GHCi does not respect extra-lib-dirs In-Reply-To: <044.eb43e7f9b5666e68e3df817728c4c87b@haskell.org> References: <044.eb43e7f9b5666e68e3df817728c4c87b@haskell.org> Message-ID: <059.532784d5c6bccac9debdb62e17ad5f70@haskell.org> #11042: Template Haskell / GHCi does not respect extra-lib-dirs -------------------------------------+------------------------------------- Reporter: mboes | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash | Test Case: Blocked By: 11238 | Blocking: Related Tickets: #10458 #5289 | Differential Rev(s): #12753 | Wiki Page: | -------------------------------------+------------------------------------- Changes (by awson): * Attachment "11042_fix.patch" added. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 22 04:15:14 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 22 Sep 2018 04:15:14 -0000 Subject: [GHC] #11042: Template Haskell / GHCi does not respect extra-lib-dirs In-Reply-To: <044.eb43e7f9b5666e68e3df817728c4c87b@haskell.org> References: <044.eb43e7f9b5666e68e3df817728c4c87b@haskell.org> Message-ID: <044.eb43e7f9b5666e68e3df817728c4c87b@haskell.org> #11042: Template Haskell / GHCi does not respect extra-lib-dirs -------------------------------------+------------------------------------- Reporter: mboes | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash | Test Case: Blocked By: 11238 | Blocking: Related Tickets: #10458 #5289 | Differential Rev(s): #12753 | Wiki Page: | -------------------------------------+------------------------------------- Changes (by awson): * Attachment "11042_fix.patch" removed. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 22 04:58:21 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 22 Sep 2018 04:58:21 -0000 Subject: [GHC] #15665: Break up the stable pointer table Message-ID: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> #15665: Break up the stable pointer table -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 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 see no obvious reason for the stable pointer table to be a single array. Indeed, that leads to all sorts of complications. It smells to me like the simplest thing would be to make it a chain of blocks, and make a `StablePtr#` a real pointer to the relevant entry. No relocation ever! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 22 06:39:10 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 22 Sep 2018 06:39:10 -0000 Subject: [GHC] #11042: Template Haskell / GHCi does not respect extra-lib-dirs In-Reply-To: <044.eb43e7f9b5666e68e3df817728c4c87b@haskell.org> References: <044.eb43e7f9b5666e68e3df817728c4c87b@haskell.org> Message-ID: <059.a960d0d2a359683966adb257d0b66ce9@haskell.org> #11042: Template Haskell / GHCi does not respect extra-lib-dirs -------------------------------------+------------------------------------- Reporter: mboes | Owner: (none) Type: bug | Status: infoneeded Priority: normal | Milestone: Component: Compiler | Version: 7.10.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash | Test Case: Blocked By: 11238 | Blocking: Related Tickets: #10458 #5289 | Differential Rev(s): #12753 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by awson): https://phabricator.haskell.org/D5170 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 22 08:19:21 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 22 Sep 2018 08:19:21 -0000 Subject: [GHC] #15663: T9675 inexplicably regressed in allocations due to text submodule bump In-Reply-To: <046.4bbf528148a8a5d4e7c394f0e92d23d3@haskell.org> References: <046.4bbf528148a8a5d4e7c394f0e92d23d3@haskell.org> Message-ID: <061.aaf04c55f54d4bf6d181f85279433dbf@haskell.org> #15663: T9675 inexplicably regressed in allocations due to text submodule bump -------------------------------------+------------------------------------- Reporter: bgamari | Owner: alpmestan Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alpmestan): Sure thing, I'll look into this next week. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 22 08:33:17 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 22 Sep 2018 08:33:17 -0000 Subject: [GHC] #15508: concprog001 fails with various errors In-Reply-To: <043.7b20754ba25128f911949e43ef11a3db@haskell.org> References: <043.7b20754ba25128f911949e43ef11a3db@haskell.org> Message-ID: <058.ce1e53e4b70afbf7fc42de0713e016d8@haskell.org> #15508: concprog001 fails with various errors -------------------------------------+------------------------------------- Reporter: osa1 | Owner: osa1 Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #15571 | Differential Rev(s): Phab:D5051 Wiki Page: | (reverted), Phab:D5165 -------------------------------------+------------------------------------- Comment (by simonmar): Yes, the ASSERT is wrong here. Note [BLACKHOLE pointing to IND] is talking about when a BLOCKING_QUEUE gets overwritten by IND, but this case is different: the ASSERT is looking at bq->queue which is normally a MSG_BLACKHOLE. A MSG_BLACKHOLE can be revoked by overwriting with IND, as per the code in `throwToMsg` that you found. This is all fine, so the ASSERT needs to account for bq->queue being an IND instead. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 22 11:00:35 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 22 Sep 2018 11:00:35 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.31d7fb63c61ec7054ca7ec7e0f283860@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by JulianLeviston): > C. Change the representation of Ratio to have an extra constructor that represents numbers of the form N / D * 10**E. It feels to me that this (C) is the best of the 3 options, probably because it's the '''laziest'''. Ideally we don't want to compute anything until the last possible moment, I'd reckon. As far as I can tell from section 2.5 of the report, the type of '''any''' literal where there's an `e` marking the exponent is going to be `Fractional a => a`. Can we not short circuit on this, and then keep the value as Ratio (ie "c" above) until its actual value is needed? I'm a bit curious that computing `time ./inplace/bin/ghc-stage2 -e '1e10000000 :: Float'` takes a long time to render `Infinity` but I guess this issue would go away when we fix the typechecking bug. I don't think choosing '''B''' is really an option because that'd involve changing the Haskell report. As I'm pretty new, some direction would be good. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 22 11:17:54 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 22 Sep 2018 11:17:54 -0000 Subject: [GHC] #4022: GHC Bindist is Broken on FreeBSD/amd64 In-Reply-To: <042.be61d95849398bdf9c05d1a69af1e7e3@haskell.org> References: <042.be61d95849398bdf9c05d1a69af1e7e3@haskell.org> Message-ID: <057.e990a47438837ebfee63055c16e44e83@haskell.org> #4022: GHC Bindist is Broken on FreeBSD/amd64 -------------------------------------+------------------------------------- Reporter: pgj | Owner: pgj Type: bug | Status: new Priority: lowest | Milestone: Component: Core Libraries | Version: 6.13 Resolution: | Keywords: GMP,integer- | gmp, sharedlibs Operating System: FreeBSD | Architecture: x86_64 Type of failure: Building GHC | (amd64) failed | Test Case: Blocked By: | Blocking: Related Tickets: #8156 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by arrowd): > I suppose I will also need to disable DTrace. I remember there were problems with DTrace in 8.4.3 too, so yes. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 22 14:15:46 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 22 Sep 2018 14:15:46 -0000 Subject: [GHC] #6089: Allow declaration splices inside declaration brackets In-Reply-To: <044.85bbefd435d2792cc792b502a5ebe47e@haskell.org> References: <044.85bbefd435d2792cc792b502a5ebe47e@haskell.org> Message-ID: <059.20d3fc44fd897a75ef4fd535091e7b68@haskell.org> #6089: Allow declaration splices inside declaration brackets -------------------------------------+------------------------------------- Reporter: igloo | Owner: simonpj Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.4.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: #11129 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by Wizek): * cc: Wizek (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 22 16:30:01 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 22 Sep 2018 16:30:01 -0000 Subject: [GHC] #4022: GHC Bindist is Broken on FreeBSD/amd64 In-Reply-To: <042.be61d95849398bdf9c05d1a69af1e7e3@haskell.org> References: <042.be61d95849398bdf9c05d1a69af1e7e3@haskell.org> Message-ID: <057.e1238ae2670348f9e317a6c75aad82da@haskell.org> #4022: GHC Bindist is Broken on FreeBSD/amd64 -------------------------------------+------------------------------------- Reporter: pgj | Owner: pgj Type: bug | Status: new Priority: lowest | Milestone: Component: Core Libraries | Version: 6.13 Resolution: | Keywords: GMP,integer- | gmp, sharedlibs Operating System: FreeBSD | Architecture: x86_64 Type of failure: Building GHC | (amd64) failed | Test Case: Blocked By: | Blocking: Related Tickets: #8156 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * cc: raichoo (added) Comment: Ccing raichoo who last fixed DTrace support in FreeBSD. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 22 19:32:49 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 22 Sep 2018 19:32:49 -0000 Subject: [GHC] #15666: Dependent type synonym in recursive type family causes GHC to panic Message-ID: <044.a6a6176d1f1adf6fd7f4bfff14914ffc@haskell.org> #15666: Dependent type synonym in recursive type family causes GHC to panic -------------------------------------+------------------------------------- Reporter: tydeu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Compile-time Unknown/Multiple | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- = Background I had written the following code in Haskell (GHC): {{{#!hs {-# LANGUAGE NoImplicitPrelude, TypeInType, PolyKinds, DataKinds, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-} import Data.Kind(Type) data PolyType k (t :: k) type Wrap (t :: k) = PolyType k t type Unwrap pt = (GetType pt :: GetKind pt) type family GetKind (pt :: Type) :: Type where GetKind (PolyType k t) = k type family GetType (pt :: Type) :: k where GetType (PolyType k t) = t }}} The intention of this code is to allow me to wrap a type of an arbitrary kind into a type (namely `PolyType`) of a single kind (namely `Type`) and then reverse the process (i.e. unwrap it) later. = Problem I wanted to define a function that would recursively operate on a composite type like so: {{{#!hs data Composite :: a -> b -> Type type family RecursiveWrap (expr :: exprK) where RecursiveWrap (Composite a b) = Wrap (Composite (Unwrap (RecursiveWrap a)) (Unwrap (RecursiveWrap b))) RecursiveWrap x = Wrap x }}} However, the above definition causes GHC to panic: {{{ ghc.exe: panic! (the 'impossible' happened) (GHC version 8.4.3 for x86_64-unknown-mingw32): cyclic evaluation in fixIO }}} = Ideas If we inline the the `Unwrap` synoynm into the defintion of the type family above like so: {{{#!hs type family RecursiveWrap expr where RecursiveWrap (Composite a b) = Wrap (Composite (GetType (RecursiveWrap a) :: GetKind (RecursiveWrap a)) (GetType (RecursiveWrap a) :: GetKind (RecursiveWrap a)) ) RecursiveWrap x = Wrap x }}} GHC instead simply produces an error: {{{ * Type constructor `RecursiveWrap' cannot be used here (it is defined and used in the same recursive group) * In the first argument of `GetKind', namely `(RecursiveWrap a)' In the kind `GetKind (RecursiveWrap a)' In the first argument of `Composite', namely `(GetType (RecursiveWrap a) :: GetKind (RecursiveWrap a))' }}} As such, I suspect this has to do with the recursive type family appearing in the kind signature when the `Unwrap` type synonym is expanded. However, it strikes me as odd that even the above code errors. Since with the `UndecidableInstances` extension turned on, I think that I should be able to write recursive type families like the above. Especially given that the above family would not loop indefinitely and thus be reducible. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 22 19:34:25 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 22 Sep 2018 19:34:25 -0000 Subject: [GHC] #15666: Dependent type synonym in recursive type family causes GHC to panic In-Reply-To: <044.a6a6176d1f1adf6fd7f4bfff14914ffc@haskell.org> References: <044.a6a6176d1f1adf6fd7f4bfff14914ffc@haskell.org> Message-ID: <059.51e4772d9dea92d52e8b6c7e276c3273@haskell.org> #15666: Dependent type synonym in recursive type family causes GHC to panic -------------------------------------+------------------------------------- Reporter: tydeu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by tydeu): * keywords: => newcomer -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 22 19:40:44 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 22 Sep 2018 19:40:44 -0000 Subject: [GHC] #15666: Dependent type synonym in recursive type family causes GHC to panic In-Reply-To: <044.a6a6176d1f1adf6fd7f4bfff14914ffc@haskell.org> References: <044.a6a6176d1f1adf6fd7f4bfff14914ffc@haskell.org> Message-ID: <059.d277846f6bf9878662a33c19daae9427@haskell.org> #15666: Dependent type synonym in recursive type family causes GHC to panic -------------------------------------+------------------------------------- Reporter: tydeu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Old description: > = Background > > I had written the following code in Haskell (GHC): > > {{{#!hs > {-# LANGUAGE > NoImplicitPrelude, > TypeInType, PolyKinds, DataKinds, > ScopedTypeVariables, > TypeFamilies, > UndecidableInstances > #-} > > import Data.Kind(Type) > > data PolyType k (t :: k) > > type Wrap (t :: k) = PolyType k t > type Unwrap pt = (GetType pt :: GetKind pt) > > type family GetKind (pt :: Type) :: Type where > GetKind (PolyType k t) = k > > type family GetType (pt :: Type) :: k where > GetType (PolyType k t) = t > }}} > > The intention of this code is to allow me to wrap a type of an arbitrary > kind > into a type (namely `PolyType`) of a single kind (namely `Type`) and then > reverse the process (i.e. unwrap it) later. > > = Problem > > I wanted to define a function that would recursively operate on a > composite type like so: > > {{{#!hs > data Composite :: a -> b -> Type > > type family RecursiveWrap (expr :: exprK) where > RecursiveWrap (Composite a b) = > Wrap (Composite (Unwrap (RecursiveWrap a)) (Unwrap (RecursiveWrap > b))) > RecursiveWrap x = Wrap x > }}} > > However, the above definition causes GHC to panic: > > {{{ > ghc.exe: panic! (the 'impossible' happened) > (GHC version 8.4.3 for x86_64-unknown-mingw32): > cyclic evaluation in fixIO > }}} > > = Ideas > > If we inline the the `Unwrap` synoynm into the defintion of the type > family > above like so: > > {{{#!hs > type family RecursiveWrap expr where > RecursiveWrap (Composite a b) = > Wrap (Composite > (GetType (RecursiveWrap a) :: GetKind (RecursiveWrap a)) > (GetType (RecursiveWrap a) :: GetKind (RecursiveWrap a)) > ) > RecursiveWrap x = Wrap x > }}} > > GHC instead simply produces an error: > > {{{ > * Type constructor `RecursiveWrap' cannot be used here > (it is defined and used in the same recursive group) > * In the first argument of `GetKind', namely `(RecursiveWrap a)' > In the kind `GetKind (RecursiveWrap a)' > In the first argument of `Composite', namely > `(GetType (RecursiveWrap a) :: GetKind (RecursiveWrap a))' > }}} > > As such, I suspect this has to do with the recursive type family > appearing in > the kind signature when the `Unwrap` type synonym is expanded. > > However, it strikes me as odd that even the above code errors. Since with > the > `UndecidableInstances` extension turned on, I think that I should be able > to > write recursive type families like the above. Especially given that the > above > family would not loop indefinitely and thus be reducible. New description: = Background I had written the following code in Haskell (GHC): {{{#!hs {-# LANGUAGE NoImplicitPrelude, TypeInType, PolyKinds, DataKinds, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-} import Data.Kind(Type) data PolyType k (t :: k) type Wrap (t :: k) = PolyType k t type Unwrap pt = (GetType pt :: GetKind pt) type family GetKind (pt :: Type) :: Type where GetKind (PolyType k t) = k type family GetType (pt :: Type) :: k where GetType (PolyType k t) = t }}} The intention of this code is to allow me to wrap a type of an arbitrary kind into a type (namely `PolyType`) of a single kind (namely `Type`) and then reverse the process (i.e. unwrap it) later. = Problem I wanted to define a function that would recursively operate on a composite type like so: {{{#!hs data Composite :: a -> b -> Type type family RecursiveWrap expr where RecursiveWrap (Composite a b) = Wrap (Composite (Unwrap (RecursiveWrap a)) (Unwrap (RecursiveWrap b))) RecursiveWrap x = Wrap x }}} However, the above definition causes GHC to panic: {{{ ghc.exe: panic! (the 'impossible' happened) (GHC version 8.4.3 for x86_64-unknown-mingw32): cyclic evaluation in fixIO }}} = Ideas If we inline the the `Unwrap` synoynm into the defintion of the type family above like so: {{{#!hs type family RecursiveWrap expr where RecursiveWrap (Composite a b) = Wrap (Composite (GetType (RecursiveWrap a) :: GetKind (RecursiveWrap a)) (GetType (RecursiveWrap a) :: GetKind (RecursiveWrap a)) ) RecursiveWrap x = Wrap x }}} GHC instead simply produces an error: {{{ * Type constructor `RecursiveWrap' cannot be used here (it is defined and used in the same recursive group) * In the first argument of `GetKind', namely `(RecursiveWrap a)' In the kind `GetKind (RecursiveWrap a)' In the first argument of `Composite', namely `(GetType (RecursiveWrap a) :: GetKind (RecursiveWrap a))' }}} As such, I suspect this has to do with the recursive type family appearing in the kind signature when the `Unwrap` type synonym is expanded. However, it strikes me as odd that even the above code errors. Since with the `UndecidableInstances` extension turned on, I think that I should be able to write recursive type families like the above. Especially given that the above family would not loop indefinitely and thus be reducible. -- Comment (by tydeu): Realized I accidentally broke my example while trying to clean it up for this ticket. Fixed it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 22 20:32:41 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 22 Sep 2018 20:32:41 -0000 Subject: [GHC] #15665: Break up the stable pointer table In-Reply-To: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> References: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> Message-ID: <060.11c18e5bc707134815747cb868c5288b@haskell.org> #15665: Break up the stable pointer table -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): Well, I guess that's used to compress the free list, but is it really worth it? We could either uncompress the free list or untag stored pointers, I imagine. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 22 20:49:53 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 22 Sep 2018 20:49:53 -0000 Subject: [GHC] #15666: Dependent type synonym in recursive type family causes GHC to panic In-Reply-To: <044.a6a6176d1f1adf6fd7f4bfff14914ffc@haskell.org> References: <044.a6a6176d1f1adf6fd7f4bfff14914ffc@haskell.org> Message-ID: <059.7410243c6f0c7d1b8c7b6db2868c538e@haskell.org> #15666: Dependent type synonym in recursive type family causes GHC to panic -------------------------------------+------------------------------------- Reporter: tydeu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): This appears to be fixed as of GHC 8.6.1 (it's not immediately clear which commit fixed this issue). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 22 21:38:20 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 22 Sep 2018 21:38:20 -0000 Subject: [GHC] #15666: Dependent type synonym in recursive type family causes GHC to panic In-Reply-To: <044.a6a6176d1f1adf6fd7f4bfff14914ffc@haskell.org> References: <044.a6a6176d1f1adf6fd7f4bfff14914ffc@haskell.org> Message-ID: <059.3190bf94a9fa8dc721088e5a8e5e0ff7@haskell.org> #15666: Dependent type synonym in recursive type family causes GHC to panic -------------------------------------+------------------------------------- Reporter: tydeu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tydeu): Replying to [comment:3 RyanGlScott]: > This appears to be fixed as of GHC 8.6.1 (it's not immediately clear which commit fixed this issue). I just tested this and yes, the issue has been resolved. :) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 03:56:17 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 03:56:17 -0000 Subject: [GHC] #15666: Dependent type synonym in recursive type family causes GHC to panic In-Reply-To: <044.a6a6176d1f1adf6fd7f4bfff14914ffc@haskell.org> References: <044.a6a6176d1f1adf6fd7f4bfff14914ffc@haskell.org> Message-ID: <059.1ccf73efa2314c5afe06c277b41fe8d3@haskell.org> #15666: Dependent type synonym in recursive type family causes GHC to panic -------------------------------------+------------------------------------- Reporter: tydeu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by potato44): * keywords: newcomer => Comment: The newcomer label is for when a newcomer (to GHC's codebase) should be able to fix the bug, not for the reporter being a newcomer. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 07:27:14 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 07:27:14 -0000 Subject: [GHC] #15665: Break up the stable pointer table In-Reply-To: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> References: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> Message-ID: <060.f1ddcbbdf0da4f9b6a18e593005a4086@haskell.org> #15665: Break up the stable pointer table -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): I don't understand comment:1. What do you mean by "compress the free list"? What do you mean by "untag stored pointers"? I think the only problem would be that currently free slots in stable ptr table hold offset of the next free slot. So allocating a new stable pointer (assuming we have space in the table) is as simple as `stable_ptr_free = (spEntry*)(stable_ptr_free->addr);`. If we switch to an array-list representation this operation will be more expensive, we'll have to traverse the chain of arrays until we find the array with the next empty slot. If the array-list representation will fix the table copying on GC I think this may worth it though. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 09:44:38 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 09:44:38 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.04c00d6c93e05b638556781e3ce2fd3e@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): So, to summarize the problem here: - Semantics of a floating point literal (which is in our case in `XeY` form) is defined as `fromRational (n % d)`. - So we need to find and `n` and `d` such that `fromRational (n % d)` gives us our float. - As per Haskell 2010 chapter 6.4.1 (note that section 2.5 only gives the syntax, not the type) `fromRational` has type `Fractional a => Rational -> a` so `fromRational (n % d)` has type `Fractional a => a` - So `XeY` form always has type `Fractional a => a` ! - Currently we tokenize an `XeY` we call `readRational__` on the string `"XeY"`, which returns this: `(n%1)*(10^^(k-d))`. `n`, `k` and `d` are parsed from the input so this is very cheap (in our example `n` is `X`, `k` is `Y`, `d` is `0`). - However, evaluating `(10^^_) :: Rational` part of the expression takes long time and uses a lot of memory. Indeed, as comment:10 says, if you have 1000000000 as the exponent then representation of this number takes GBs of memory so this is expected. - comment:12 asks why rendering `Infinity` takes this long: that's because we generate the `Infinity` value during desugaring (after parsing), and for this we have to first generate the `Rational` value for the literal first (which is what is taking all the time and using all the memory). You can observe this if you run ghci with `-fdump-parsed -fdump-ds` and evaluate `1e100000 :: Float`. Perhaps it makes sense to distinguish these two problems: - Type checking is too slow - Generating `Infinity :: Float` is too slow (a) in comment:10 fixes (1) but not (2). (c) in comment:10 fixes (1), and it may also fix (2) if we could somehow use this new constructor fields to return `Infinity` without calculating `10^^e :: Integer` first (as far as I understand the new consturctor will look like: `ExpRational n e -- stands for (n%1)*(10^^e)`). However, (c) means a change in a public type, and we'd need to evaluate performance changes etc. caused by turning a product type to a sum type (more optimizations apply to product types than sum types! at least until we improve demand analysis for sum types and use unboxed sums in WW). Also, I'm not sure if adding one more constructor to a library type just for this is a good idea. We'd need to think about how/whether to expose this to users (perhaps we do want to expose it in `Data.Ratio` somehow). This means long discussions and bikeshedding etc. What to do? I think delaying evaluation `readRational` until it's needed by making some code lazier would work. Looking at the lexer, we generate a `ITrational` for this literal like this: {{{ tok_float str = ITrational $! readFractionalLit str readFractionalLit :: String -> FractionalLit readFractionalLit str = ((FL $! (SourceText str)) $! is_neg) $! readRational str where is_neg = case str of ('-':_) -> True }}} Notice how we're very deliberately strict here. My guess is that simply removing strictness around `readRational` (e.g. the `$!` in `readFractionalLit`) may fix this. If it doesn't then some other code down the line needs to be made lazier too. However I'm not sure if this causes other problems (the fact that the thunk for `readRational str` will keep the `str` alive is not a problem because the `str` only holds the string for the literal). We'll have to evaluate this change in strictness somehow. If we follow this route then we'd also need to add a test to make sure typing this expression remains fast (strictness properties are hard to maintain ...). Here's another idea that is like (c) but does not need changes in a public type: duplicate the `Ratio` type so that only the version used by GHC has the special constructor. The code gen and `Data.Ratio` will still use the current type. Now we can use the special constructor in lexing to avoid evaluating a huge `Integer`, and only when desugaring we do some kind of evaluation (this is where we can perhaps be smart and generate `Infinity` efficiently, or in the worst case we end up with the current situation, but with fast type checking). None of these solutions strike me as particularly satisfying though... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 10:30:40 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 10:30:40 -0000 Subject: [GHC] #15667: Readonly permissions bits are wrong Message-ID: <044.f1da98646cee33a60ff58118ea841bfc@haskell.org> #15667: Readonly permissions bits are wrong -------------------------------------+------------------------------------- Reporter: Phyx- | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Keywords: | Operating System: Windows Architecture: | Type of failure: GHC doesn't work Unknown/Multiple | at all Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Unfortunately it seems the mapping for the permission bits for GHC 8.6.1 seem to have gotten screwed up. When installed to a read-only location GHC is no longer working due to it attempting to get write access as well. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 11:16:21 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 11:16:21 -0000 Subject: [GHC] #15659: Wacky error message when RULE mentions out-of-scope variable In-Reply-To: <050.8dd7643b53c2eca3e9802af78b7aab52@haskell.org> References: <050.8dd7643b53c2eca3e9802af78b7aab52@haskell.org> Message-ID: <065.3f9221c87b5f7c5b49b87f63ef4a9e69@haskell.org> #15659: Wacky error message when RULE mentions out-of-scope variable -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"cad5d0b69bc039b635a6eb0e5c9ed47d7c5a38ed/ghc" cad5d0b/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="cad5d0b69bc039b635a6eb0e5c9ed47d7c5a38ed" Buglet in reporting out of scope errors in rules Most out of scope errors get reported by the type checker these days, but not all. Example, the function on the LHS of a RULE. Trace #15659 pointed out that this less-heavily-used code path produce a "wacky" error message. Indeed so. Easily fixed. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 11:16:21 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 11:16:21 -0000 Subject: [GHC] #15607: RebindableSyntax warns `return` is not in scope when trying to call `pure`, but does not desugar between the two In-Reply-To: <048.40d13c0995253ff45c6a616fadd5793a@haskell.org> References: <048.40d13c0995253ff45c6a616fadd5793a@haskell.org> Message-ID: <063.6a3b34594372a72d95ebbcfd40f602c0@haskell.org> #15607: RebindableSyntax warns `return` is not in scope when trying to call `pure`, but does not desugar between the two -------------------------------------+------------------------------------- Reporter: isovector | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: | RebindableSyntax Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"4bde71df9a32bf6f5ee7d44fbbf79523da4b0a9e/ghc" 4bde71df/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="4bde71df9a32bf6f5ee7d44fbbf79523da4b0a9e" Don't look up unnecessary return in LastStmt This fixes Trac #15607. The general pattern is well established (e.g. see the guard_op binding in rnStmt of BodyStme), but we weren't using it for LastStmt. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 11:16:21 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 11:16:21 -0000 Subject: [GHC] #11155: Trivial thunk gives "undefined reference to stg_ap_0_upd_info" In-Reply-To: <046.d8196c999608fededc5ef9d4e2e29843@haskell.org> References: <046.d8196c999608fededc5ef9d4e2e29843@haskell.org> Message-ID: <061.bf67692f42c7bbdd3a0aa2652464a122@haskell.org> #11155: Trivial thunk gives "undefined reference to stg_ap_0_upd_info" -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: closed Priority: highest | Milestone: 8.0.1 Component: Compiler | Version: 7.10.2 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | simplCore/should_compile/T11155 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"2dbf88b3558c3b53a1207fb504232c3da67b266e/ghc" 2dbf88b3/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="2dbf88b3558c3b53a1207fb504232c3da67b266e" Fix get getIdFromTrivialExpr This bug, discovered by Trac #15325, has been lurking since commit 1c9fd3f1c5522372fcaf250c805b959e8090a62c Author: Simon Peyton Jones Date: Thu Dec 3 12:57:54 2015 +0000 Case-of-empty-alts is trivial (Trac #11155) I'd forgotttnen to modify getIdFromTrivialExpr when I modified exprIsTrivial. Easy to fix, though. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 11:16:21 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 11:16:21 -0000 Subject: [GHC] #15325: GHCi panic in getIdFromTrivialExpr with -fdefer-type-errors In-Reply-To: <050.bf11294bfa46fbb2d7747b428a80c7a3@haskell.org> References: <050.bf11294bfa46fbb2d7747b428a80c7a3@haskell.org> Message-ID: <065.f120c9d81a3aae113677eb4dac595acd@haskell.org> #15325: GHCi panic in getIdFromTrivialExpr with -fdefer-type-errors -------------------------------------+------------------------------------- Reporter: dramforever | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"2dbf88b3558c3b53a1207fb504232c3da67b266e/ghc" 2dbf88b3/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="2dbf88b3558c3b53a1207fb504232c3da67b266e" Fix get getIdFromTrivialExpr This bug, discovered by Trac #15325, has been lurking since commit 1c9fd3f1c5522372fcaf250c805b959e8090a62c Author: Simon Peyton Jones Date: Thu Dec 3 12:57:54 2015 +0000 Case-of-empty-alts is trivial (Trac #11155) I'd forgotttnen to modify getIdFromTrivialExpr when I modified exprIsTrivial. Easy to fix, though. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 11:18:05 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 11:18:05 -0000 Subject: [GHC] #15659: Wacky error message when RULE mentions out-of-scope variable In-Reply-To: <050.8dd7643b53c2eca3e9802af78b7aab52@haskell.org> References: <050.8dd7643b53c2eca3e9802af78b7aab52@haskell.org> Message-ID: <065.0fb5c578cea5a0c20a589f1e77044643@haskell.org> #15659: Wacky error message when RULE mentions out-of-scope variable -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: fixed | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Poor/confusing | Test Case: error message | rename/should_fail/T15659 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * testcase: => rename/should_fail/T15659 * resolution: => fixed Comment: a plane journey gave me a chance to fix this. Thanks for reporting it! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 11:19:11 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 11:19:11 -0000 Subject: [GHC] #15607: RebindableSyntax warns `return` is not in scope when trying to call `pure`, but does not desugar between the two In-Reply-To: <048.40d13c0995253ff45c6a616fadd5793a@haskell.org> References: <048.40d13c0995253ff45c6a616fadd5793a@haskell.org> Message-ID: <063.be20b561f3f934b6549073c2ee82fc17@haskell.org> #15607: RebindableSyntax warns `return` is not in scope when trying to call `pure`, but does not desugar between the two -------------------------------------+------------------------------------- Reporter: isovector | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: fixed | Keywords: | RebindableSyntax Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: | rename/should_fail/T15607 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * testcase: => rename/should_fail/T15607 * resolution: => fixed Comment: A plane journey gave me an opportunity to fix this. Thanks for reporting it! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 11:26:04 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 11:26:04 -0000 Subject: [GHC] #15325: GHCi panic in getIdFromTrivialExpr with -fdefer-type-errors In-Reply-To: <050.bf11294bfa46fbb2d7747b428a80c7a3@haskell.org> References: <050.bf11294bfa46fbb2d7747b428a80c7a3@haskell.org> Message-ID: <065.e286c754f775d8e0501eddb916aaec99@haskell.org> #15325: GHCi panic in getIdFromTrivialExpr with -fdefer-type-errors -------------------------------------+------------------------------------- Reporter: dramforever | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: crash or panic | ghci/scripts/T15325 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * testcase: => ghci/scripts/T15325 * resolution: => fixed Comment: Fixed over the Atlantic. Thanks for reporting this! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 11:33:26 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 11:33:26 -0000 Subject: [GHC] #13600: surprising error message with bang pattern In-Reply-To: <051.cb1136f932f929f97ddeb5e4dd8a6304@haskell.org> References: <051.cb1136f932f929f97ddeb5e4dd8a6304@haskell.org> Message-ID: <066.f85418f8f45196528ee233aab9ddca06@haskell.org> #13600: surprising error message with bang pattern -------------------------------------+------------------------------------- Reporter: andrewufrank | Owner: v0d1ch Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.0.2 Resolution: | Keywords: BangPatterns, | newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Poor/confusing | Test Case: T13600a, error message | T13600b Blocked By: | Blocking: Related Tickets: #15166, #15458 | Differential Rev(s): Phab:D5040 Wiki Page: | -------------------------------------+------------------------------------- Changes (by v0d1ch): * testcase: T13600, T13600b => T13600a, T13600b -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 12:04:24 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 12:04:24 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.014d7b27dd02327acef6635ffb161361@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Some thoughts * I don't think we should rely on laziness in the compiler. It'll come back to bite us. * It's not unreasonable that programs with silly literals will blow up at runtime, if it is evaluated, because of the `fromRational r` semantics. But it should not blow up at compile time. * The underlying problem is that, in the compiler, we represent the literal as a `Rational`. In `BasicTypes` we have: {{{ data FractionalLit = FL { fl_text :: SourceText -- How the value was written in the source , fl_neg :: Bool -- See Note [Negative zero] , fl_value :: Rational -- Numeric value of the literal } }}} This `FractionalLit` is used in `HsLit` and `HsOverLit`. And it is finally desugar in `Match.dsLit`: {{{ dsLit :: HsLit GhcRn -> DsM CoreExpr dsLit l = ... HsRat _ (FL _ _ val) ty -> do num <- mkIntegerExpr (numerator val) denom <- mkIntegerExpr (denominator val) return (mkCoreConApps ratio_data_con [Type integer_ty, num, denom]) }}} That is we finally generate Core for `(n % d)`. * But ''why'' do we produce a compile-time `Rational` for the literal?? For integral values it makes sense to do so, so that we can do constant folding (turning `1 + 2` into `3` at compile time). But by the time we get to Core, we've turned it into `n % d` and I don't think we then do any useful compile time work. So my solution is this: 1. Drop the `fl_value` field in `FractionalLit` 2. Change `dsLit` on `FractionalLit` to desugar to `readRational `, where`` is the string the user wrote, recorded in the `fl_text` field. That is, defer the construction of the `Rational` to runtime. I think that'd be simple to do. If we were going to parse a string at runtime, we'd want to be sure that parsing would succeed, but I think the lexer has ensured that it's parseble. I suppose another alternative would be to have {{{ data FractionalLit = FL { fl_text :: SourceText -- How the value was written in the source , fl_neg :: Bool -- See Note [Negative zero] , fl_before, fl_after, fl_exp :: Integer -- Denotes .E } }}} THat is, parse the pieces of the string, and record them in the literal. Then desugar to `makeRational before after exp` which again defers to runtime the building of the `Rational` itself. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 12:25:40 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 12:25:40 -0000 Subject: [GHC] #15233: You can always set fixity of (:), with no effect In-Reply-To: <051.8c3b112281bc7b731cc4cf74f7b2040c@haskell.org> References: <051.8c3b112281bc7b731cc4cf74f7b2040c@haskell.org> Message-ID: <066.4d32b7f21b41f33b5baf21251e353bed@haskell.org> #15233: You can always set fixity of (:), with no effect -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5167 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch * differential: => Phab:D5167 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 12:26:31 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 12:26:31 -0000 Subject: [GHC] #4861: Documentation for base does not include special items In-Reply-To: <051.5ee4c1527610ef4964c665e655014652@haskell.org> References: <051.5ee4c1527610ef4964c665e655014652@haskell.org> Message-ID: <066.a270d54cb90242c8901c3c5ed1857290@haskell.org> #4861: Documentation for base does not include special items -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: (none) Type: bug | Status: patch Priority: low | Milestone: ⊥ Component: Core Libraries | Version: 7.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Documentation | Unknown/Multiple bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5167 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: upstream => patch * differential: => Phab:D5167 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 12:29:21 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 12:29:21 -0000 Subject: [GHC] #8708: Kind annotation in tuple not parsed In-Reply-To: <047.7299eca00fb25a2e788e2c82e2894717@haskell.org> References: <047.7299eca00fb25a2e788e2c82e2894717@haskell.org> Message-ID: <062.43400bb5dfca49ea11e053d06c84e70a@haskell.org> #8708: Kind annotation in tuple not parsed -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 7.7 (Parser) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #11267, #11622 | Differential Rev(s): Phab:D5173 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch * differential: => Phab:D5173 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 12:29:41 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 12:29:41 -0000 Subject: [GHC] #11622: Annotating types in type familiy equations without parentheses In-Reply-To: <051.fa9ccc48e4902c5c4db8bb7f638000aa@haskell.org> References: <051.fa9ccc48e4902c5c4db8bb7f638000aa@haskell.org> Message-ID: <066.44586d6ce9578b8c3fdbe795ef72b2ad@haskell.org> #11622: Annotating types in type familiy equations without parentheses -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5173 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch * differential: => Phab:D5173 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 12:33:01 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 12:33:01 -0000 Subject: [GHC] #14907: Error message: (%, %) shows up when with accidental paren In-Reply-To: <051.2e9709c3004b74af6c52b8b012de4b6f@haskell.org> References: <051.2e9709c3004b74af6c52b8b012de4b6f@haskell.org> Message-ID: <066.e1c564c7bf9e46a4ed82ec74e625ec10@haskell.org> #14907: Error message: (%,%) shows up when with accidental paren -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5172 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => patch * differential: => Phab:D5172 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 13:35:18 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 13:35:18 -0000 Subject: [GHC] #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory In-Reply-To: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> References: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> Message-ID: <059.8e16b267dbe9d7f1a1245a102f268241@haskell.org> #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory -------------------------------------+------------------------------------- Reporter: int-e | Owner: osa1 Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: GHCi | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Hmm. Thanks for showing the full code that GHCi compiles to bytecode. It looks like this: {{{ let main_action = ... in bindIO main_action (\it -> return [it]) }}} So GHCi will build a thunk for `main_action` and will pass it to the compiled code for `GHC.Base.bindIO`. But alas `main_action` is essentially this {{{ main_action :: IO () main_action = sequence_ (replicate ...) }}} (I have omitted the `ghcStepIO` stuff; it is essentially the identity function, and I don't think it affects things.) Now that `main_action` thunk will be updated, so if it remains live for any reason, we'll retain a huge PAP of the form described in an earlier comment `return () >> (return () ...))`. Why is it being kept alive? I'm really not sure. The interpreter should be ''tail-calling'' `bindIO`... I wonder if `main_action` could be floated to top level as a CAF before it gets to the bytecode generator? Anyway, I hope that may help a bit. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 13:36:31 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 13:36:31 -0000 Subject: [GHC] #15009: Float equalities past local equalities In-Reply-To: <047.0a49c3ac676b2b3bc6f93c4594762c08@haskell.org> References: <047.0a49c3ac676b2b3bc6f93c4594762c08@haskell.org> Message-ID: <062.2f71d0d4817e26d47e4c801b77286313@haskell.org> #15009: Float equalities past local equalities -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: 8.4.3 Component: Compiler | Version: 8.2.2 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: gadt/T15009 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I think you are referring to `Note [Let-bound skolems]` in `TcSMonad`? Suppose we have {{{ data T where MkT :: (a ~ Int) => a -> T }}} Here `a` is existentially bound, but it's really just a let-binding; we may as well have written {{{ data T where MkT :: Int -> T }}} Now consider type inference on this, where we try `f :: alpha -> T -> beta`. {{{ f x y = case y of MkT -> x }}} We'll get an implication constraint {{{ forall[2] a. (a~Int) => alpha[1] ~ beta[1] }}} Can we float that equality out, and unify `alpha := beta`? We say yes, because of `Note [Let-bound skolems]`. You ask whether the `a` needs to be bound at the same level (i.e. in the same implication) as the `(a ~ Int)`. I think it does. Consider {{{ data S a where MkS :: (a ~ Int) => S a g :: forall a. S a -> a -> blah g x y = let h = \z. ( z :: Int , case x of MkS -> [y,z]) in ... }}} When doing inference on `h` we'll assign `y :: alpha[1]`, say. Then from the body of the lambda we'll get {{{ alpha[1] ~ Int -- From z::Int forall[2]. (a ~ Int) => alpha[1] ~ a -- From [y,z] }}} Now, suppose we decide to float `alpha ~ a` out of the implication and then unify `alpha := a`. Now we are stuck! But if treat `alpha ~ Int` first, and unify `alpha := Int`, all is fine. But we absolutely cannot float that equality or we will get stuck. Does that help explain? I could add this to the Note. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 13:58:47 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 13:58:47 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.5b69d10967942ef04980ba0737170847@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): That sounds good to me. Just to make sure, the proposed solution will still blow up when desugaring, so currently we aim to fix the type checking, right? Or am I missing something about the proposed solution? One problem with removing `fl_value` may be that any users of this type (maybe source plugins?) will have to provide a string instead of an actual float (we currently allow users to only give a value and omit `fl_text` by passing a `NoSourceText`). I don't know if there are any users (can it be used by source plugins?) of this type but maybe it's worth checking. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 14:13:30 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 14:13:30 -0000 Subject: [GHC] #15584: nonVoid is too conservative w.r.t. strict argument types In-Reply-To: <050.6cca1c180a42ae3c8a5210a8b2be904f@haskell.org> References: <050.6cca1c180a42ae3c8a5210a8b2be904f@haskell.org> Message-ID: <065.804f1df3f1b82fe3a13d3830d63ae920@haskell.org> #15584: nonVoid is too conservative w.r.t. strict argument types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: | PatternMatchWarnings Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: #15305 | Differential Rev(s): Phab:D5116 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ryan Scott ): In [changeset:"e68b439fe5de61b9a2ca51af472185c62ccb8b46/ghc" e68b439/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="e68b439fe5de61b9a2ca51af472185c62ccb8b46" Add a recursivity check in nonVoid Summary: Previously `nonVoid` outright refused to call itself recursively to avoid the risk of hitting infinite loops when checking recurisve types. But this is too conservative—we //can// call `nonVoid` recursively as long as we incorporate a way to detect the presence of recursive types, and bail out if we do detect one. Happily, such a mechanism already exists in the form of `checkRecTc`, so let's use it. Test Plan: make test TEST=T15584 Reviewers: simonpj, bgamari Reviewed By: simonpj Subscribers: rwbarton, carter GHC Trac Issues: #15584 Differential Revision: https://phabricator.haskell.org/D5116 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 14:14:17 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 14:14:17 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.d4b7a88188cebe30c911ac72c5c76039@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > the proposed solution will still blow up when desugaring No, it won'r blow up when desugaring. Just desugar the constant to `fromRational (readRational "1E1000")`. Nothing blows up there! > One problem with removing fl_value may be that any users of this type (maybe source plugins?) will have to provide a string instead of an actual float Well `(show f)` is a good string. And I quite like the `fl_before/after/exp` version too. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 14:15:01 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 14:15:01 -0000 Subject: [GHC] #15584: nonVoid is too conservative w.r.t. strict argument types In-Reply-To: <050.6cca1c180a42ae3c8a5210a8b2be904f@haskell.org> References: <050.6cca1c180a42ae3c8a5210a8b2be904f@haskell.org> Message-ID: <065.81eccfbfe33635e921a07b2fc2e01604@haskell.org> #15584: nonVoid is too conservative w.r.t. strict argument types -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.5 Resolution: fixed | Keywords: | PatternMatchWarnings Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Incorrect | Test Case: error/warning at compile-time | pmcheck/should_compile/T15584 Blocked By: | Blocking: Related Tickets: #15305 | Differential Rev(s): Phab:D5116 Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * testcase: => pmcheck/should_compile/T15584 * status: patch => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 14:25:18 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 14:25:18 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.586d04699229eae78fe4b8ee5f70c0bf@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141, Phab:D5147, Phab:D5150 -------------------------------------+------------------------------------- Changes (by tdammers): * Attachment "perf-step3.log" added. Performance test results after step 3 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 14:32:35 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 14:32:35 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.f9ac194bad1471d3c074341770e924bd@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141, Phab:D5147, Phab:D5150 -------------------------------------+------------------------------------- Comment (by tdammers): The perf regressions we saw in previous attempts were these: {{{ Unexpected stat failures: compiler/T5631.run T5631 [stat not good enough] (normal) compiler/T5321Fun.run T5321Fun [stat not good enough] (normal) compiler/T12227.run T12227 [stat not good enough] (normal) compiler/T12545.run T12545 [stat not good enough] (normal) compiler/T12150.run T12150 [stat not good enough] (optasm) }}} Results for these: {{{ =====> T5631(normal) 7 of 43 [0, 0, 0] cd "T5631.run" && "/home/tobias/well-typed/devel/ghc-phab/inplace/test spaces/ghc-stage2" -c T5631.hs -no-user-package-db -rtsopts -fno-warn- missed-specialisations -fshow-warning-groups -fdiagnostics-color=never -fno-diagnostics-show-caret -dno-debug-output +RTS -V0 -tT5631.comp.stats --machine-readable -RTS Expected T5631(normal) bytes allocated: 1161885448 +/-5% Lower bound T5631(normal) bytes allocated: 1103791175 Upper bound T5631(normal) bytes allocated: 1219979721 Actual T5631(normal) bytes allocated: 1165383416 Deviation T5631(normal) bytes allocated: 0.3 % =====> T5321Fun(normal) 10 of 43 [0, 0, 0] cd "T5321Fun.run" && "/home/tobias/well-typed/devel/ghc-phab/inplace/test spaces/ghc-stage2" -c T5321Fun.hs -no-user-package-db -rtsopts -fno-warn- missed-specialisations -fshow-warning-groups -fdiagnostics-color=never -fno-diagnostics-show-caret -dno-debug-output +RTS -V0 -tT5321Fun.comp.stats --machine-readable -RTS Expected T5321Fun(normal) bytes allocated: 423774560 +/-5% Lower bound T5321Fun(normal) bytes allocated: 402585832 Upper bound T5321Fun(normal) bytes allocated: 444963288 Actual T5321Fun(normal) bytes allocated: 438838640 Deviation T5321Fun(normal) bytes allocated: 3.6 % =====> T12227(normal) 25 of 43 [0, 0, 0] cd "T12227.run" && "/home/tobias/well-typed/devel/ghc-phab/inplace/test spaces/ghc-stage2" -c T12227.hs -no-user-package-db -rtsopts -fno-warn- missed-specialisations -fshow-warning-groups -fdiagnostics-color=never -fno-diagnostics-show-caret -dno-debug-output -O2 -ddump-hi -ddump-to- file +RTS -M1G +RTS -V0 -tT12227.comp.stats --machine-readable -RTS Expected T12227(normal) bytes allocated: 752214784 +/-5% Lower bound T12227(normal) bytes allocated: 714604044 Upper bound T12227(normal) bytes allocated: 789825524 Actual T12227(normal) bytes allocated: 744873984 Deviation T12227(normal) bytes allocated: -1.0 % =====> T12545(normal) 28 of 43 [0, 0, 0] cd "T12545.run" && "/home/tobias/well-typed/devel/ghc-phab/inplace/test spaces/ghc-stage2" --make T12545 -no-user-package-db -rtsopts -fno-warn- missed-specialisations -fshow-warning-groups -fdiagnostics-color=never -fno-diagnostics-show-caret -dno-debug-output -v0 +RTS -V0 -tT12545.comp.stats --machine-readable -RTS Expected T12545(normal) bytes allocated: 3249613688 +/-5% Lower bound T12545(normal) bytes allocated: 3087133003 Upper bound T12545(normal) bytes allocated: 3412094373 Actual T12545(normal) bytes allocated: 3212031504 Deviation T12545(normal) bytes allocated: -1.2 % =====> T12150(optasm) 32 of 43 [0, 0, 0] cd "T12150.run" && "/home/tobias/well-typed/devel/ghc-phab/inplace/test spaces/ghc-stage2" -c T12150.hs -no-user-package-db -rtsopts -fno-warn- missed-specialisations -fshow-warning-groups -fdiagnostics-color=never -fno-diagnostics-show-caret -dno-debug-output -O -fasm +RTS -V0 -tT12150.comp.stats --machine-readable -RTS Expected T12150(optasm) bytes allocated: 77557800 +/-5% Lower bound T12150(optasm) bytes allocated: 73679910 Upper bound T12150(optasm) bytes allocated: 81435690 Actual T12150(optasm) bytes allocated: 76394064 Deviation T12150(optasm) bytes allocated: -1.5 % }}} Executive summary: All of these tests perform roughly the same or better, except for the notorious `T5631Fun` test, which deviates by 3.6% - still significant, but not enough to exceed the 5% threshold. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 14:40:18 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 14:40:18 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.25ae3c3723ec9e40f207c0752b69831c@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141, Phab:D5147, Phab:D5150 -------------------------------------+------------------------------------- Comment (by simonpj): But these figure are * deviations from the "expected" stored in `all.T` That's quite different from * difference in allocation between just before the patch and just after the patch Maybe this 3.6% was there before the patch! Also, it'd be good to know what "the patch" is when showing the differences. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 15:40:18 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 15:40:18 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.cc57171d8a1a1221b9fcc6d6b2452087@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141, Phab:D5147, Phab:D5150 -------------------------------------+------------------------------------- Comment (by tdammers): Replying to [comment:137 simonpj]: > But these figure are > > * deviations from the "expected" stored in `all.T` > > That's quite different from > > * difference in allocation between just before the patch and just after the patch Ah yes, of course. I'll do another run on the base commit. > Also, it'd be good to know what "the patch" is when showing the differences. Right, yes. "The Patch" is the latest implementation of steps 1, 2-c123, and 3, as found in ​Phab:D5141, ​Phab:D5147, and ​Phab:D5150 (all 3 applied in order). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 17:18:58 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 17:18:58 -0000 Subject: [GHC] #15668: Allocations values for some compile tests are way too hight Message-ID: <044.4f8d3361f0b05a864933b4ce9dad3f8c@haskell.org> #15668: Allocations values for some compile tests are way too hight ----------------------------------------+--------------------------------- Reporter: Phyx- | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Keywords: | Operating System: Windows Architecture: Unknown/Multiple | Type of failure: None/Unknown Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: ----------------------------------------+--------------------------------- These tests have way too high allocation counts. {{{ bytes allocated value is too high: Expected T12425(optasm) bytes allocated: 139100464 +/-5% Lower bound T12425(optasm) bytes allocated: 132145440 Upper bound T12425(optasm) bytes allocated: 146055488 Actual T12425(optasm) bytes allocated: 149370944 Deviation T12425(optasm) bytes allocated: 7.4 % *** unexpected stat test failure for T12425(optasm) bytes allocated value is too high: Expected MultiLayerModules(normal) bytes allocated: 5619893176 +/-10% Lower bound MultiLayerModules(normal) bytes allocated: 5057903858 Upper bound MultiLayerModules(normal) bytes allocated: 6181882494 Actual MultiLayerModules(normal) bytes allocated: 6693788656 Deviation MultiLayerModules(normal) bytes allocated: 19.1 % *** unexpected stat test failure for MultiLayerModules(normal) bytes allocated value is too high: Expected T11303b(normal) bytes allocated: 54373936 +/-10% Lower bound T11303b(normal) bytes allocated: 48936542 Upper bound T11303b(normal) bytes allocated: 59811330 Actual T11303b(normal) bytes allocated: 62015072 Deviation T11303b(normal) bytes allocated: 14.1 % *** unexpected stat test failure for T11303b(normal) bytes allocated value is too high: Expected T12234(optasm) bytes allocated: 79889200 +/-5% Lower bound T12234(optasm) bytes allocated: 75894740 Upper bound T12234(optasm) bytes allocated: 83883660 Actual T12234(optasm) bytes allocated: 91583520 Deviation T12234(optasm) bytes allocated: 14.6 % *** unexpected stat test failure for T12234(optasm) }}} These are a bit too high for me to just blindly update them without knowing why. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 17:22:12 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 17:22:12 -0000 Subject: [GHC] #15669: T7040_ghci has a suspicious testcase failure Message-ID: <044.9d1f4438ef24291d12c76127056f4c24@haskell.org> #15669: T7040_ghci has a suspicious testcase failure ----------------------------------------+--------------------------------- Reporter: Phyx- | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Keywords: | Operating System: Windows Architecture: Unknown/Multiple | Type of failure: None/Unknown Test Case: T7040_ghci | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: ----------------------------------------+--------------------------------- T7040_ghci has a weird failure. This looks like BSS initialization issue in the linker maybe? {{{ +++ rts/T7040_ghci.run/T7040_ghci.run.stdout.normalised 2018-09-23 17:26:01.197146900 +0100 @@ -1,2 +1,2 @@ -x: 0 +x: 493156 x: 1 }}} Luckily the value seems to mutate correctly. So it may just be a simple missing `memset`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 17:24:35 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 17:24:35 -0000 Subject: [GHC] #15670: FloatFnInverses seems to show some weird rounding/precision issues. Message-ID: <044.e66d467337a47c853f202406c21ad543@haskell.org> #15670: FloatFnInverses seems to show some weird rounding/precision issues. ----------------------------------------+--------------------------------- Reporter: Phyx- | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Keywords: | Operating System: Windows Architecture: Unknown/Multiple | Type of failure: None/Unknown Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: ----------------------------------------+--------------------------------- There seems to be a rounding issue with math functions on Windows. We likely need a crt update to fix this. Or maybe check the round mode if it's being set correctly. {{{ --- numeric/should_run/FloatFnInverses.run/FloatFnInverses.stdout.normalised 2018-09-23 17:26:01.581150200 +0100 +++ numeric/should_run/FloatFnInverses.run/FloatFnInverses.run.stdout.normalised 2018-09-23 17:26:01.583146400 +0100 @@ -8,8 +8,8 @@ [0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] [0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] [0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] -[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] -[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] +[Infinity,Infinity,Infinity,Infinity,Infinity,Infinity,Infinity,Infinity,Infinity,Infinity,Infinity,Infinity,Infinity,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,-Infinity,-Infinity,-Infinity,-Infinity,-Infinity,-Infinity,-Infinity,-Infinity,-Infinity,-Infinity,-Infinity,-Infinity,-Infinity] +[7.788445287802241e33,7.788445287802241e33,7.788445287802241e33,7.788445287802241e33,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,-7.788445287802241e33,-7.788445287802241e33,-7.788445287802241e33,-7.788445287802241e33,-7.788445287802241e33] [0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] [0.0,0.0,0.0,0.0,0.0,0.0] [0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 17:29:24 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 17:29:24 -0000 Subject: [GHC] #15671: Link errors due to forcibly exporting findPtr Message-ID: <044.6372bc7500582c14ea27cfe705ed9ef3@haskell.org> #15671: Link errors due to forcibly exporting findPtr -------------------------------------+------------------------------------- Reporter: Phyx- | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: T10955dyn | Blocked By: T10955 | Blocking: | Related Tickets: Differential Rev(s): Phab:D5138 | Wiki Page: -------------------------------------+------------------------------------- The change in https://phabricator.haskell.org/rGHC900c47f88784b91517c00be3e1087322e62f698e is causing link errors due to the combination of `-Wl,-u` and `-Wl ,--export-all-symbols` {{{ Wrong exit code for T10955dyn()(expected 0 , actual 2 ) Stderr ( T10955dyn ): E:/ghc- dev/msys64/home/Tamar/ghc/rts/dist/build/libHSrts_thr.a(Printer.thr_o): In function `findPtr': E:\ghc-dev\msys64\home\Tamar\ghc/rts/Printer.c:880: multiple definition of `findPtr' ./bin_dyn/libA.dll.a(d020776.o):(.text+0x0): first defined here }}} I believe the correct solution is to just use a cabal flag to emulate the setup we had with make, instead of forcing this symbol always. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 17:59:05 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 17:59:05 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.b1fc4223831a62aa92384a5299ad65c1@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141, Phab:D5147, Phab:D5150 -------------------------------------+------------------------------------- Comment (by tdammers): Comparing the baseline commit `510c5f4f22` against `wip/T14880-2-step3`, we get (bytes allocated): - T5631 from 1169733648 down to 1165383416, or +0.7% down to +0.3% (vs. `all.T`) - T5321Fun from 435532680 **up** to 438838640, or +2.8% up to +3.6% - T12227 from 754850808 down to 744873984, or +0.4% down to -1.0% - T12545 from 3289709120 down to 3212031504, or +1.2% down to -1.2% - T12150 from 76390472 to 76394064, insignificant -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 18:29:08 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 18:29:08 -0000 Subject: [GHC] #15009: Float equalities past local equalities In-Reply-To: <047.0a49c3ac676b2b3bc6f93c4594762c08@haskell.org> References: <047.0a49c3ac676b2b3bc6f93c4594762c08@haskell.org> Message-ID: <062.1ce5af57fdcc87a4c20d0499d9f9d0b1@haskell.org> #15009: Float equalities past local equalities -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: 8.4.3 Component: Compiler | Version: 8.2.2 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: gadt/T15009 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nfrisby): Replying to [comment:11 simonpj]: > I think you are referring to `Note [Let-bound skolems]` in `TcSMonad`? Yep, that's the most relevant Note. > ... Snipped. (Should it have been "When doing inference on {{{h}}} we'll assign {{{z :: alpha[1]}}}"? Since {{{y}}} is already "declared" {{{:: a}}} from the {{{g}}} signature.) > Does that help explain? I could add this to the Note. Yes, that explanation does help. I'm ruminating now about how it compares to the main jfp-OutsideIn narrative eg so I can better suggest how to update the Note. Beyond the Note, though, my comment above was asking how feasible it is for the following example to work. My intuition (which I'm working to unpack) thinks it should. But 1) am I wrong? and 2) how much work to have GHC accept it? {{{ data S a where MkS :: (a ~ Int) => S a -- from your 2nd example data Query f b = MkQuery (forall q. f q -> q -> b) -- a new ingredient g3 :: Query S Int -- GHC 8.6 cannot infer this type. Should a later GHC? g3 = MkQuery (\MkS x -> x) }}} I'm trying to decode my intuition for what exactly is it about {{{g3}}} (contrasted with your {{{g}}}) that should justify unifying{{{beta := Int}}} in this case. For example, if we define {{{QueryS}}} as a manual specialization of {{{Query}}} with {{{f = S}}}, then your previous commit for this ticket works for {{{g2}}} below. {{{ data QueryS b where MkQueryS :: (a ~ Int) => (a -> b) -> QueryS b to :: Query S b -> QueryS b to (MkQuery f) = MkQueryS (f MkS) from :: QueryS b -> Query S b from (MkQueryS f) = MkQuery (\MkS -> f) g2 = MkQueryS (\x -> x) -- GHC 8.6 infers QueryS Int }}} This isomorphism and inference for {{{g2}}} reassures me that my hope for {{{g3}}} is at least within the realm of possibility. In {{{g3}}} there is nothing between the implicit type lambda binding {{{q}}} and the pattern match on {{{MkS}}}. So I think we end up with nested implications with nothing in between. (I'm very doubtful that I have the level numbers correct here.) {{{ forall[2] a. -- from the type lambda forall[3] . (a ~ Int) => -- from the MkS pattern (a ~ alpha[2],a ~ beta[1]) }}} Perhaps my optimistic intuition for {{{g3}}} is because the outer implication here is so trivial: {{{alpha}}} and {{{beta}}} do not occur in (any other equality-like constraints in) any siblings of our inner implication, so floating {{{alpha ~ beta}}} wouldn't have any consequences. Is that suggestive of some refinement to eg {{{getNoGivenEqs}}} or am I lost in the weeds? Thank you for your patience. -Nick -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 18:41:35 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 18:41:35 -0000 Subject: [GHC] #15666: Dependent type synonym in recursive type family causes GHC to panic In-Reply-To: <044.a6a6176d1f1adf6fd7f4bfff14914ffc@haskell.org> References: <044.a6a6176d1f1adf6fd7f4bfff14914ffc@haskell.org> Message-ID: <059.3c501e81ea4b50da7b04e678498ee1c9@haskell.org> #15666: Dependent type synonym in recursive type family causes GHC to panic -------------------------------------+------------------------------------- Reporter: tydeu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tydeu): Replying to [comment:5 potato44]: > The newcomer label is for when a newcomer (to GHC's codebase) should be able to fix the bug, not for the reporter being a newcomer. Ah, I'll keep that in mind. My apologies. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 18:51:40 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 18:51:40 -0000 Subject: [GHC] #14251: LLVM Code Gen messes up registers In-Reply-To: <047.9ece2514d7c7f668525c93ec15fb841a@haskell.org> References: <047.9ece2514d7c7f668525c93ec15fb841a@haskell.org> Message-ID: <062.f60439428093779907a219e5c6274512@haskell.org> #14251: LLVM Code Gen messes up registers -------------------------------------+------------------------------------- Reporter: angerman | Owner: kavon Type: bug | Status: new Priority: highest | Milestone: 8.6.1 Component: Compiler (LLVM) | Version: 8.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by kavon): * owner: (none) => kavon Comment: I'll polish up solution (2) ASAP. Sorry I missed this! While it seems ugly to add `FloatReg` as padding, it we need ''something'' to "eat up" a floating point register, since they're assigned left-to- right. We know Float and Double are passed in the same register on x86-64 so it should be fine. I need to look into ARM and other calling conventions to make this correct on other systems. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 19:11:44 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 19:11:44 -0000 Subject: [GHC] #15668: Allocations values for some compile tests are way too hight In-Reply-To: <044.4f8d3361f0b05a864933b4ce9dad3f8c@haskell.org> References: <044.4f8d3361f0b05a864933b4ce9dad3f8c@haskell.org> Message-ID: <059.79cc206bcc29bfe13fb2c0886bc6b962@haskell.org> #15668: Allocations values for some compile tests are way too hight ---------------------------------+---------------------------------------- Reporter: Phyx- | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Windows | Architecture: Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+---------------------------------------- Comment (by simonpj): I'm lost. Are these changes since yesterday, or what? What commit was responsible? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 19:18:37 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 19:18:37 -0000 Subject: [GHC] #15668: Allocations values for some compile tests are way too hight In-Reply-To: <044.4f8d3361f0b05a864933b4ce9dad3f8c@haskell.org> References: <044.4f8d3361f0b05a864933b4ce9dad3f8c@haskell.org> Message-ID: <059.620e4f9273bd28cf93512cfcb6e2fab6@haskell.org> #15668: Allocations values for some compile tests are way too hight ---------------------------------+---------------------------------------- Reporter: Phyx- | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Windows | Architecture: Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+---------------------------------------- Comment (by Phyx-): I don't know yet when they're from. I haven't done the bisect yet. I just know they're from sometime the last couple of months, which admittedly is not very helpful. I'm just looking into the failures on Windows atm and cataloging the ones I can't solve immediately. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 19:38:41 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 19:38:41 -0000 Subject: [GHC] #15668: Allocations values for some compile tests are way too hight In-Reply-To: <044.4f8d3361f0b05a864933b4ce9dad3f8c@haskell.org> References: <044.4f8d3361f0b05a864933b4ce9dad3f8c@haskell.org> Message-ID: <059.2849a3eef2ca88ddd7daf1194e2201e3@haskell.org> #15668: Allocations values for some compile tests are way too hight ---------------------------------+---------------------------------------- Reporter: Phyx- | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Windows | Architecture: Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+---------------------------------------- Description changed by simonpj: Old description: > These tests have way too high allocation counts. > > {{{ > bytes allocated value is too high: > Expected T12425(optasm) bytes allocated: 139100464 +/-5% > Lower bound T12425(optasm) bytes allocated: 132145440 > Upper bound T12425(optasm) bytes allocated: 146055488 > Actual T12425(optasm) bytes allocated: 149370944 > Deviation T12425(optasm) bytes allocated: 7.4 % > *** unexpected stat test failure for T12425(optasm) > > bytes allocated value is too high: > Expected MultiLayerModules(normal) bytes allocated: 5619893176 > +/-10% > Lower bound MultiLayerModules(normal) bytes allocated: 5057903858 > Upper bound MultiLayerModules(normal) bytes allocated: 6181882494 > Actual MultiLayerModules(normal) bytes allocated: 6693788656 > Deviation MultiLayerModules(normal) bytes allocated: 19.1 % > *** unexpected stat test failure for MultiLayerModules(normal) > > bytes allocated value is too high: > Expected T11303b(normal) bytes allocated: 54373936 +/-10% > Lower bound T11303b(normal) bytes allocated: 48936542 > Upper bound T11303b(normal) bytes allocated: 59811330 > Actual T11303b(normal) bytes allocated: 62015072 > Deviation T11303b(normal) bytes allocated: 14.1 % > *** unexpected stat test failure for T11303b(normal) > > bytes allocated value is too high: > Expected T12234(optasm) bytes allocated: 79889200 +/-5% > Lower bound T12234(optasm) bytes allocated: 75894740 > Upper bound T12234(optasm) bytes allocated: 83883660 > Actual T12234(optasm) bytes allocated: 91583520 > Deviation T12234(optasm) bytes allocated: 14.6 % > *** unexpected stat test failure for T12234(optasm) > }}} > > These are a bit too high for me to just blindly update them without > knowing why. New description: These tests are failing on Windows (only), with way too high allocation counts. Quite when this started happening is not clear -- perhaps in the last couple of months. {{{ bytes allocated value is too high: Expected T12425(optasm) bytes allocated: 139100464 +/-5% Lower bound T12425(optasm) bytes allocated: 132145440 Upper bound T12425(optasm) bytes allocated: 146055488 Actual T12425(optasm) bytes allocated: 149370944 Deviation T12425(optasm) bytes allocated: 7.4 % *** unexpected stat test failure for T12425(optasm) bytes allocated value is too high: Expected MultiLayerModules(normal) bytes allocated: 5619893176 +/-10% Lower bound MultiLayerModules(normal) bytes allocated: 5057903858 Upper bound MultiLayerModules(normal) bytes allocated: 6181882494 Actual MultiLayerModules(normal) bytes allocated: 6693788656 Deviation MultiLayerModules(normal) bytes allocated: 19.1 % *** unexpected stat test failure for MultiLayerModules(normal) bytes allocated value is too high: Expected T11303b(normal) bytes allocated: 54373936 +/-10% Lower bound T11303b(normal) bytes allocated: 48936542 Upper bound T11303b(normal) bytes allocated: 59811330 Actual T11303b(normal) bytes allocated: 62015072 Deviation T11303b(normal) bytes allocated: 14.1 % *** unexpected stat test failure for T11303b(normal) bytes allocated value is too high: Expected T12234(optasm) bytes allocated: 79889200 +/-5% Lower bound T12234(optasm) bytes allocated: 75894740 Upper bound T12234(optasm) bytes allocated: 83883660 Actual T12234(optasm) bytes allocated: 91583520 Deviation T12234(optasm) bytes allocated: 14.6 % *** unexpected stat test failure for T12234(optasm) }}} These are a bit too high for me to just blindly update them without knowing why. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 21:09:00 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 21:09:00 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.aace18a4f3023f746358d693dec52d85@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by JulianLeviston): * owner: JulianLeviston => (none) Comment: Removing myself as owner because this has gone well beyond the small simple patch I was hoping for one of my first tickets :) Hopefully someone else can pick it up. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 23 23:02:36 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 23 Sep 2018 23:02:36 -0000 Subject: [GHC] #15665: Break up the stable pointer table In-Reply-To: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> References: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> Message-ID: <060.8baca9e27cda99bb7c461bc4d2371deb@haskell.org> #15665: Break up the stable pointer table -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): Currently, a stable pointer table entry consists of a single pointer, either into the heap (if it's used) or to the next free entry (if it's not). Garbage collection traverses the whole table and distinguishes between used and free entries by whether they point into the table or not. This leads to a very compact table, but it tightly restricts the implementation. If we "uncompress" it, we use ''two'' words per entry: one for the payload and one for a next pointer. The uncompressed representation offers a lot more flexibility. We can immediately drop the array doubling mess. But we get a lot more flexibility elsewhere. In particular, we can have ''non-free'' lists, one per generation, along with the free list. Now when we collect a generation, we traverse only its non-free list, marking objects and moving entries to the non-free list for the next generation. I ''think'' we can probably even go to a nearly lock-free mechanism, using something like a Harris-style lock-free linked list. Here's a rough sketch: === Make a stable pointer Pop an entry from the free list. If the free list is empty, take a lock and allocate a new block of entries. Populate the entry appropriately and add it to the Gen0 non-free list. Perform one step of maintenance. === Delete a stable pointer Tag the entry deleted (Harris stage 1 of deletion). Possibly perform one step === Maintenance Traverse all the non-free lists. Physically delete (Harris stage 2) each entry tagged as deleted and push it onto the free list. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 03:29:44 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 03:29:44 -0000 Subject: [GHC] #15444: 8.4.3 has an undocumented dependency on libnuma. In-Reply-To: <047.a9be0b30ca9742d4a5738899e0757af8@haskell.org> References: <047.a9be0b30ca9742d4a5738899e0757af8@haskell.org> Message-ID: <062.4e3da25db1393b141d65ca956454baac@haskell.org> #15444: 8.4.3 has an undocumented dependency on libnuma. -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: (none) Type: bug | Status: closed Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by AndreasK): * status: new => closed * resolution: => fixed Comment: Fixed in 8.6 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 03:40:27 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 03:40:27 -0000 Subject: [GHC] #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes In-Reply-To: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> References: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> Message-ID: <062.68040fa9ae45effd4076b20bb279f5c8@haskell.org> #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes -------------------------------------+------------------------------------- Reporter: ChaiTRex | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by JulianLeviston): I've been still looking at this, just to keep this updated. > As you say, HscInterpreted means modules are compiled to bytecode and then interpreted. Interpreter can interact with native code and with -fobject-code you tell GHCi to compile the loaded modules to native code rather than to bytecode (the default, or -fbyte-code). The above paragraph confused me. The `-e` and `--interactive` flags setup `HscInterpreted` as the language in `main'` in `Main.hs`. DynFlags can be used to override this target (ie with `-fbytecode` or `-fobjectcode`). It seems like a mistake to be able to override it when it's already set to the `HscInterpreted` target, though I don't really understand if that's actually wanted. Like, in the case that you're using `ghci`, would you ever want to turn on `-fobjectcode` from within the interpreter? What would that mean if you could do that? Would it start compiling to object code and ''then'' execute the compiled code? If you're compiling with `ghc --make` and you also use `-fbytecode` is that something that's intended? I guess I'm trying to figure out if, when `-e` and `--interactive` set the `HscInterpreted` target it actually makes more sense to have that be a mode of the compiler that cannot be adjusted via `DynFlags` rather than the target which '''can''' be adjusted. However, I don't know the intent well enough. I'm not sure it's captured anywhere? The `man` doc for `ghc` seems to be extremely brief on what these particular flags mean, or are intended for. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 05:15:06 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 05:15:06 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.858a0cea2172b2215981d217659a8393@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): The discussion may be confusing but the proposed change is actually quite simple. Just refactor one type and follow the type errors. In more details: - Update the `FractionalLit` type as shown in comment:14. There are two variants, pick one. I'd pick the one with `fl_before`/`fl_after`/`fl_exp`. - `readRational` (the slow function that causes this ticket) is used by DynFlags and CmmLex too, so to keep things simpler let's keep the original `readRational` and add a new variant that returns `FractionalLit` (instead of `Rational`). This is the fast variant. - Replace `readFractionalLit` in Lexer.x with the new fast variant of `readRational`. Sounds like a good first ticket to me. Simon, > No, it won'r blow up when desugaring. Just desugar the constant to > fromRational (readRational "1E1000"). Nothing blows up there! But this relies on laziness, no? I thought you said this is not a good idea in comment:14. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 05:45:42 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 05:45:42 -0000 Subject: [GHC] #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes In-Reply-To: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> References: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> Message-ID: <062.643f9464eaa9b43fc9dfb1a88bf969d5@haskell.org> #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes -------------------------------------+------------------------------------- Reporter: ChaiTRex | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): Here's another way to say what I mean. When in GHCi we do two kinds of compilation: - We compile loaded modules (if necessary) - We compile expressions typed in the GHCi prompt The target only makes sense for (1). In (2) we only compile to bytecode. So really `HscInterpreted` and flags like `-O` etc. are only applicable to (1). But currently we also apply some of those flags/settings to (e.g. `-O`) to (2) which is what's causing this bug. One of my suggestions in comment:11 was to separate these two compilations so that when we do (2) we never try to optimise the code. This can be done by implementing a new (or modifying the existing one if one already exists) top-level function for compiling GHCi expressions and updating `DynFlags` there to fix the compilation settings (e.g. by resetting optimisation level) for GHCi. Is this any more clear than my previous comment? > The -e and --interactive flags setup HscInterpreted as the language in main' > in Main.hs. DynFlags can be used to override this target (ie with -fbytecode > or -fobjectcode). It seems like a mistake to be able to override it when it's > already set to the HscInterpreted target, though I don't really understand if > that's actually wanted. So the lang/target doesn't matter when compiling GHCi expressions, as you _have to_ compile those to bytecode regardless of the lang/target. I meant overriding optimisation settings, not the lang/target. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 05:52:12 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 05:52:12 -0000 Subject: [GHC] #15665: Break up the stable pointer table In-Reply-To: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> References: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> Message-ID: <060.54a9a449136b71cc3f97f54f207ea8cf@haskell.org> #15665: Break up the stable pointer table -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #7670 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * related: => #7670 Comment: > If we "uncompress" it, we use two words per entry: one for the payload and one for a next pointer But you'll still allocate an array instead of allocating each (payload, next), right? (Adding #7670 as related ticket as this proposes a fix for it) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 05:52:27 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 05:52:27 -0000 Subject: [GHC] #7670: StablePtrs should be organized by generation for efficient minor collections In-Reply-To: <045.3e79ce9413679adff14ececd359ab7ff@haskell.org> References: <045.3e79ce9413679adff14ececd359ab7ff@haskell.org> Message-ID: <060.cfcfd92d418d5903464383ef33ebd34e@haskell.org> #7670: StablePtrs should be organized by generation for efficient minor collections -------------------------------------+------------------------------------- Reporter: ezyang | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 7.7 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15665 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * related: => #15665 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 05:59:22 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 05:59:22 -0000 Subject: [GHC] #15665: Break up the stable pointer table In-Reply-To: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> References: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> Message-ID: <060.64d81170d3d73ff7dd6965a288725d4c@haskell.org> #15665: Break up the stable pointer table -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #7670 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): Right. Each allocation would be a full block, and would add all the entries in the block to the free list. Trying to go lock-free looks more complicated the more I think about it, but generational collection looks easy. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 06:15:34 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 06:15:34 -0000 Subject: [GHC] #15665: Break up the stable pointer table In-Reply-To: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> References: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> Message-ID: <060.a1e80bdb0dddfce281c3c317908a72ee@haskell.org> #15665: Break up the stable pointer table -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #7670 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): Note: I think any approach using lists of active entries will need incremental deletion or similar to avoid needing a ''doubly'' linked list, but that should be pretty easy with a global lock. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 07:18:29 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 07:18:29 -0000 Subject: [GHC] #15508: concprog001 fails with various errors In-Reply-To: <043.7b20754ba25128f911949e43ef11a3db@haskell.org> References: <043.7b20754ba25128f911949e43ef11a3db@haskell.org> Message-ID: <058.97bfa2596ba42dc98d7e72d0fd19c668@haskell.org> #15508: concprog001 fails with various errors -------------------------------------+------------------------------------- Reporter: osa1 | Owner: osa1 Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #15571 | Differential Rev(s): Phab:D5051 Wiki Page: | (reverted), Phab:D5165 -------------------------------------+------------------------------------- Comment (by osa1): This is easy to fix, but I'm trying to understand the code: {{{ // Revoke the message by replacing it with IND. We're not // locking anything here, so we might still get a TRY_WAKEUP // message from the owner of the blackhole some time in the // future, but that doesn't matter. ASSERT(target->block_info.bh->header.info == &stg_MSG_BLACKHOLE_info); OVERWRITE_INFO(target->block_info.bh, &stg_IND_info); raiseAsync(cap, target, msg->exception, false, NULL); return THROWTO_SUCCESS; }}} (in throwToMsg()) Why we can make a MessageBlackHole an IND without setting the indirectee? Is this used to remove (by skipping) a MessageBlackHole from the queue? (because actually removing would be impossible as we don't have a `prev` field in `MessageBlackHole`?) I'm quite confused about how these two types are used: {{{ typedef struct StgBlockingQueue_ { StgHeader header; struct StgBlockingQueue_ *link; // here so it looks like an IND StgClosure *bh; // the BLACKHOLE StgTSO *owner; struct MessageBlackHole_ *queue; } StgBlockingQueue; typedef struct MessageBlackHole_ { StgHeader header; struct MessageBlackHole_ *link; StgTSO *tso; StgClosure *bh; } MessageBlackHole; }}} As far as I understand, a BLACKHOLE can become a BLOCKING_QUEUE (in `messageBlackHole()`), and `queue` of a BLOCKING_QUEUE is for threads that are blocked on this BLACKHOLE. But then - Why do we have a `bh` field in `messageBlackHole`? We could pass the `bh` as a parameter to `messageBlackHole()` and `bh` would the blackhole that we just looked at to find the `MessageBlackHole`. - Why do we need a list of `BLOCKING_QUEUE`s? Is this only to be able to implement `checkBlockingQueues()`? The comments around `checkBlockingQueues()` say {{{ // If we update a closure that we know we BLACKHOLE'd, and the closure // no longer points to the current TSO as its owner, then there may be // an orphaned BLOCKING_QUEUE closure with blocked threads attached to // it. We therefore traverse the BLOCKING_QUEUEs attached to the // current TSO to see if any can now be woken up. }}} but I don't understand how can owner of a BLACKHOLE not point to our capability if we BLACKHOLEd it. Could you say a few workds about this? I'll submit a patch but I don't know what to say in the commit message as I don't understand this code ... -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 08:25:22 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 08:25:22 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.7edacd3fe1cbd12319d6a22a26d3e543@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141, Phab:D5147, Phab:D5150 -------------------------------------+------------------------------------- Comment (by tdammers): The first test to fail is `T14880-2`, a new test based on the reproduction case in comment:2. GHC 8.4 fails with a panic; the GHC version in `wip/T14880-2-step3` compiles it without errors when compiling core lint disabled, but enabling core lint (as in the test suite) triggers a lint failure: {{{ =====> T14880-2(normal) 1 of 1 [0, 0, 0] cd "dependent/should_compile/T14880-2.run" && "/home/tobias/well- typed/devel/ghc-phab/inplace/test spaces/ghc-stage2" -c T14880-2.hs -dcore-lint -dcmm-lint -no-user-package-db -rtsopts -fno-warn-missed- specialisations -fshow-warning-groups -fdiagnostics-color=never -fno- diagnostics-show-caret -dno-debug-output Compile failed (exit code 1) errors were: *** Core Lint errors : in result of Desugar (before optimization) *** : warning: In the type ‘Proxy (Foo arg_a1eO)’ Kind application error in type ‘Proxy a_a1eN’ Function kind = forall k. k -> * Arg kinds = [(arg_a1eO, *), (a_a1eN, arg_a1eM)] Fun: arg_a1eO (a_a1eN, arg_a1eM) : warning: In the type ‘Proxy (Foo arg_a1eO)’ Kind application error in type ‘Foo arg_a1eO’ Function kind = forall x -> forall (a :: x). Proxy a -> * Arg kinds = [(arg_a1eO, *), (a_a1eN, arg_a1eM)] Forall: a_aZA arg_a1eO (a_a1eN, arg_a1eM) *** Offending Program *** Rec { $tcFoo :: TyCon [LclIdX] $tcFoo = TyCon 1426396007728932770## 937350176756910988## $trModule (TrNameS "Foo"#) 2# $krep_a1qj $krep_a1qm [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId] $krep_a1qm = $WKindRepVar (I# 1#) $krep_a1ql [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId] $krep_a1ql = $WKindRepVar (I# 0#) $krep_a1qj [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId] $krep_a1qj = KindRepFun $krep_a1qk krep$* $krep_a1qk [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId] $krep_a1qk = KindRepTyConApp $tcProxy (: @ KindRep $krep_a1ql (: @ KindRep $krep_a1qm ([] @ KindRep))) $trModule :: Module [LclIdX] $trModule = Module (TrNameS "main"#) (TrNameS "Bug"#) quux :: forall arg (a :: arg) arg. Proxy (Foo arg) -> () [LclIdX] quux = \ (@ arg_a1eM) (@ (a_a1eN :: arg_a1eM)) (@ arg_a1eO) (ds_d1qn :: Proxy (Foo arg_a1eO)) -> () end Rec } *** End of Offense *** }}} I can't tell whether this means that the Core is indeed incorrect, or that the core linter is wrong in rejecting this program. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 08:51:27 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 08:51:27 -0000 Subject: [GHC] #10193: TypeRep Show instance doesn't add parens around type operators In-Reply-To: <050.ff6cff2e03c64787c90e72c6c5c4a299@haskell.org> References: <050.ff6cff2e03c64787c90e72c6c5c4a299@haskell.org> Message-ID: <065.09605f1c566626683481dee65940571a@haskell.org> #10193: TypeRep Show instance doesn't add parens around type operators -------------------------------------+------------------------------------- Reporter: pawel.nowak | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: libraries/base | Version: 7.10.1-rc3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by harpocrates): * status: new => closed * resolution: => fixed Comment: I believe this was (inadvertently) fixed in 3397396a385ef9f493cf1e20894e88d21dfec48d. In any case, it is fixed as of `ghc-8.6.1`, where the output of the code in the ticket description is now `(:*:) Char Char`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 10:44:54 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 10:44:54 -0000 Subject: [GHC] #15508: concprog001 fails with various errors In-Reply-To: <043.7b20754ba25128f911949e43ef11a3db@haskell.org> References: <043.7b20754ba25128f911949e43ef11a3db@haskell.org> Message-ID: <058.d58346ec4edb4fd1c218dd69b8206153@haskell.org> #15508: concprog001 fails with various errors -------------------------------------+------------------------------------- Reporter: osa1 | Owner: osa1 Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #15571 | Differential Rev(s): Phab:D5051 Wiki Page: | (reverted), Phab:D5165 -------------------------------------+------------------------------------- Comment (by simonmar): > Why we can make a MessageBlackHole an IND without setting the indirectee? Is this used to remove (by skipping) a MessageBlackHole from the queue? (because actually removing would be impossible as we don't have a prev field in MessageBlackHole?) Yes, exactly. > As far as I understand, a BLACKHOLE can become a BLOCKING_QUEUE (in messageBlackHole()), and queue of a BLOCKING_QUEUE is for threads that are blocked on this BLACKHOLE. Just to be clear, A BLACKHOLE doesn't "become" a BLOCKING_QUEUE, the BLACKHOLE's indirectee field points to the BLOCKING_QUEUE. > Why do we have a bh field in messageBlackHole? We could pass the bh as a parameter to messageBlackHole() and bh would the blackhole that we just looked at to find the MessageBlackHole. A MessageBlackHole is sent to another capability, which needs to know which BLACKHOL to add it to. > Why do we need a list of BLOCKING_QUEUEs? Is this only to be able to implement checkBlockingQueues()? The comments around checkBlockingQueues() say See this comment in `messageBlackHole()`: {{{ // All BLOCKING_QUEUES are linked in a list on owner->bq, so // that we can search through them in the event that there is // a collision to update a BLACKHOLE and a BLOCKING_QUEUE // becomes orphaned (see updateThunk()). }}} > but I don't understand how can owner of a BLACKHOLE not point to our capability if we BLACKHOLEd it. A BLACKHOLE can be updated by another thread at any time. The fact that it is a BLACKHOLE is not an exclusive ownership. We use compare-and-swap to install the BLACKHOLE in `threadPaused()`, but another thread might already be evaluating the thunk and will update it with the value later, and we don't use a compare-and-swap when updating because that would be too expensive. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 11:33:41 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 11:33:41 -0000 Subject: [GHC] #15611: scope errors lie about what modules are imported In-Reply-To: <044.35c05a6ccad9dc15d82e16ecd787e95b@haskell.org> References: <044.35c05a6ccad9dc15d82e16ecd787e95b@haskell.org> Message-ID: <059.30db79a2aaba7ecb1a03aef9c2f6def5@haskell.org> #15611: scope errors lie about what modules are imported -------------------------------------+------------------------------------- Reporter: dmwit | Owner: RolandSenn Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RolandSenn): * owner: (none) => RolandSenn Comment: I'll work on this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 12:37:52 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 12:37:52 -0000 Subject: [GHC] #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes In-Reply-To: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> References: <047.252f036686da3cb5c2c5a5709f59083c@haskell.org> Message-ID: <062.0343550a24a3ae6549b5bb35139015c4@haskell.org> #15617: Unboxed tuples/sum error message on `a = show 5` in expression evaluation and interactive modes -------------------------------------+------------------------------------- Reporter: ChaiTRex | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by JulianLeviston): Oh that's much clearer, thank you. I'll have to dig in more to find out about the split of compilation of loaded modules versus expressions (at GHCi prompt and/or given to `-e` flag) to think about how to separate those two types of code. As far as I can see so far in my explorations, `HscInterpreted` (ie the target) is the marker used to determine whether to compile to bytecode or not. Loading with `-e` or `--interpreted` sets this, and Setting `-fbytecode` sets it, too, and conversely, setting `-fobjectcode` sets it to the standard compile target for the platform (which is near `HscInterpreted`. Thanks for being so helpful and patient. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 12:57:45 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 12:57:45 -0000 Subject: [GHC] #15508: concprog001 fails with various errors In-Reply-To: <043.7b20754ba25128f911949e43ef11a3db@haskell.org> References: <043.7b20754ba25128f911949e43ef11a3db@haskell.org> Message-ID: <058.c5052d464484b0cf9c20fbfc2b6873b8@haskell.org> #15508: concprog001 fails with various errors -------------------------------------+------------------------------------- Reporter: osa1 | Owner: osa1 Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #15571 | Differential Rev(s): Phab:D5051 Wiki Page: | (reverted), Phab:D5165, Phab:D5178 -------------------------------------+------------------------------------- Changes (by osa1): * differential: Phab:D5051 (reverted), Phab:D5165 => Phab:D5051 (reverted), Phab:D5165, Phab:D5178 Comment: Thanks Simon. Submitted a patch with some comments and an update to the sanity check. Current status: - debug runtime seems to work (the program takes too long to run and I killed it after 30 mins or so) - debug + threaded runtime seems to work (did 10 runs with `+RTS -DS -N2`) - debug + prof fails with {{{ Mult: internal error: ASSERTION FAILED: file rts/sm/Sanity.c, line 210 (GHC version 8.7.20180923 for x86_64_unknown_linux) Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} (the PAP invariant bug) - debug + prof + threaded fails with different errors like {{{ Mult: internal error: invalid closure, info=0x53b130 (GHC version 8.7.20180923 for x86_64_unknown_linux) Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} or {{{ Mult: internal error: ASSERTION FAILED: file rts/sm/Evac.c, line 890 (GHC version 8.7.20180923 for x86_64_unknown_linux) Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 13:14:15 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 13:14:15 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.4ca91ea6543f393d707f2a8246cf7e3d@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > But this relies on laziness, no? No, it doesn't rely on laziness. At no stage will GHC construct that Rational. The desugarer will generate something like {{{ Var 'fromRational' `App` (Var 'readRational' `App` Lit (LitString "1e100")) }}} That is, it'll generate Core that will, when compiled and run, compute the rational (at runtime). But the compiler just manipulates this Core data structure, there is no bad Rational in it. Does that help? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 13:35:26 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 13:35:26 -0000 Subject: [GHC] #15672: Flags missing documentation. Message-ID: <045.958bbebd9adae560ab69fa02f124e3a9@haskell.org> #15672: Flags missing documentation. -------------------------------------+------------------------------------- Reporter: merijn | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 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: -------------------------------------+------------------------------------- The following flags are missing documentation in the flag reference section of the GHC user guide: `-fprint-bind-contents`, `-fprint-evld- with-show`, `-fimplicit-import-qualified`, `-copy-libs-when-linking`, `-Werror=compat`, `-Wwarn=compat`, and `-Wno-error=compat`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 13:48:20 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 13:48:20 -0000 Subject: [GHC] #15508: concprog001 fails with various errors In-Reply-To: <043.7b20754ba25128f911949e43ef11a3db@haskell.org> References: <043.7b20754ba25128f911949e43ef11a3db@haskell.org> Message-ID: <058.1e6a76b881edccbc931ecb49b8880a60@haskell.org> #15508: concprog001 fails with various errors -------------------------------------+------------------------------------- Reporter: osa1 | Owner: osa1 Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Runtime crash | Test Case: Blocked By: | Blocking: Related Tickets: #15571 | Differential Rev(s): Phab:D5051 Wiki Page: | (reverted), Phab:D5165, Phab:D5178 -------------------------------------+------------------------------------- Comment (by Ömer Sinan Ağacan ): In [changeset:"d90946cea1357d3e99805c27dab1e811785a4088/ghc" d90946c/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="d90946cea1357d3e99805c27dab1e811785a4088" Fix a MSG_BLACKHOLE sanity check, add some comments Reviewers: simonmar, bgamari, erikd Reviewed By: simonmar Subscribers: rwbarton, carter GHC Trac Issues: #15508 Differential Revision: https://phabricator.haskell.org/D5178 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 16:05:25 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 16:05:25 -0000 Subject: [GHC] #15673: ghc: panic! (the 'impossible' happened) Message-ID: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> #15673: ghc: panic! (the 'impossible' happened) --------------------------------------+--------------------------------- Reporter: mcmayer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.4 Component: Compiler | Version: 8.4.3 Keywords: | Operating System: MacOS X Architecture: x86_64 (amd64) | Type of failure: None/Unknown Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: --------------------------------------+--------------------------------- The following few lines produce a GHC panic: {{{#!hs module Main where import Data.Bits (shift) badOne :: [Int] -> Integer badOne is = sum $ zipWith (\n _->shift 1 n) (enumFrom 0) is main = return () :: IO () }}} The function is stripped down as much as possible, it doesn't perform anything all to meaningful anymore. The error message is: {{{#!bash ghc: panic! (the 'impossible' happened) (GHC version 8.4.3 for x86_64-apple-darwin): heap overflow }}} All else is off-the-shelf stack lts-12.10 via {{{#!bash stack new bad-one simple }}} Tested on Mac OS X and Debian. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 16:06:50 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 16:06:50 -0000 Subject: [GHC] #15673: ghc: panic! (the 'impossible' happened) In-Reply-To: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> References: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> Message-ID: <061.1a8b90b6143b1ce481101018b023f710@haskell.org> #15673: ghc: panic! (the 'impossible' happened) -------------------------------------+------------------------------------- Reporter: mcmayer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.4 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: MacOS X | Architecture: x86_64 Type of failure: GHC doesn't work | (amd64) at all | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by mcmayer): * failure: None/Unknown => GHC doesn't work at all -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 16:13:32 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 16:13:32 -0000 Subject: [GHC] #15673: ghc: panic! (the 'impossible' happened) In-Reply-To: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> References: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> Message-ID: <061.b23d505fefb5eb1c12de6e28379f57c5@haskell.org> #15673: ghc: panic! (the 'impossible' happened) -------------------------------------+------------------------------------- Reporter: mcmayer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.4 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: MacOS X | Architecture: x86_64 Type of failure: GHC doesn't work | (amd64) at all | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by mcmayer: Old description: > The following few lines produce a GHC panic: > > {{{#!hs > module Main where > > import Data.Bits (shift) > > badOne :: [Int] -> Integer > badOne is = sum $ zipWith (\n _->shift 1 n) (enumFrom 0) is > > main = return () :: IO () > }}} > > The function is stripped down as much as possible, it doesn't perform > anything all to meaningful anymore. > > The error message is: > > {{{#!bash > ghc: panic! (the 'impossible' happened) > (GHC version 8.4.3 for x86_64-apple-darwin): > heap overflow > }}} > > All else is off-the-shelf stack lts-12.10 via > > {{{#!bash > stack new bad-one simple > }}} > > Tested on Mac OS X and Debian. New description: The following few lines produce a GHC panic: {{{#!hs module Main where import Data.Bits (shift) badOne :: [Int] -> Integer badOne is = sum $ zipWith (\n _->shift 1 n) [0..] is main = return () :: IO () }}} The function is stripped down as much as possible, it doesn't perform anything all to meaningful anymore. The error message is: {{{#!bash ghc: panic! (the 'impossible' happened) (GHC version 8.4.3 for x86_64-apple-darwin): heap overflow }}} All else is off-the-shelf stack lts-12.10 via {{{#!bash stack new bad-one simple }}} Tested on Mac OS X and Debian. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 16:17:39 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 16:17:39 -0000 Subject: [GHC] #15673: ghc: panic! (the 'impossible' happened) In-Reply-To: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> References: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> Message-ID: <061.0b0fc4e0f7742d9230098982afb519bc@haskell.org> #15673: ghc: panic! (the 'impossible' happened) -------------------------------------+------------------------------------- Reporter: mcmayer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.4 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: MacOS X | Architecture: x86_64 Type of failure: GHC doesn't work | (amd64) at all | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by mcmayer: Old description: > The following few lines produce a GHC panic: > > {{{#!hs > module Main where > > import Data.Bits (shift) > > badOne :: [Int] -> Integer > badOne is = sum $ zipWith (\n _->shift 1 n) [0..] is > > main = return () :: IO () > }}} > > The function is stripped down as much as possible, it doesn't perform > anything all to meaningful anymore. > > The error message is: > > {{{#!bash > ghc: panic! (the 'impossible' happened) > (GHC version 8.4.3 for x86_64-apple-darwin): > heap overflow > }}} > > All else is off-the-shelf stack lts-12.10 via > > {{{#!bash > stack new bad-one simple > }}} > > Tested on Mac OS X and Debian. New description: The following few lines produce a GHC panic: {{{#!hs module Main where import Data.Bits (shift) badOne :: [Int] -> Integer -- replace Integer by Int and all is good! badOne is = sum $ zipWith (\n _->shift 1 n) [0..] is main = return () :: IO () }}} The function is stripped down as much as possible, it doesn't perform anything all to meaningful anymore. The error message is: {{{#!bash ghc: panic! (the 'impossible' happened) (GHC version 8.4.3 for x86_64-apple-darwin): heap overflow }}} All else is off-the-shelf stack lts-12.10 via {{{#!bash stack new bad-one simple }}} Tested on Mac OS X and Debian. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 16:39:39 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 16:39:39 -0000 Subject: [GHC] #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings In-Reply-To: <051.1afac0be4b689267d905f3e66b5a2d7d@haskell.org> References: <051.1afac0be4b689267d905f3e66b5a2d7d@haskell.org> Message-ID: <066.2e32e300c1c9ae9b466bea514bec8d41@haskell.org> #15645: TypeChecking of Monad patterns incorrect with RebindableSyntax and OverloadedStrings -------------------------------------+------------------------------------- Reporter: NeilMitchell | Owner: shayne- | fletcher-da Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: GHCProposal 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: | -------------------------------------+------------------------------------- Changes (by shayne-fletcher-da): * owner: (none) => shayne-fletcher-da -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 16:49:02 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 16:49:02 -0000 Subject: [GHC] #15673: ghc: panic! (the 'impossible' happened) In-Reply-To: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> References: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> Message-ID: <061.738245b0d2c463d20b14a185793b8743@haskell.org> #15673: ghc: panic! (the 'impossible' happened) -------------------------------------+------------------------------------- Reporter: mcmayer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.4 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: MacOS X | Architecture: x86_64 Type of failure: GHC doesn't work | (amd64) at all | Test Case: Blocked By: | Blocking: Related Tickets: 14959 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by mcmayer): * related: => 14959 Old description: > The following few lines produce a GHC panic: > > {{{#!hs > module Main where > > import Data.Bits (shift) > > badOne :: [Int] -> Integer -- replace Integer by Int and all is good! > badOne is = sum $ zipWith (\n _->shift 1 n) [0..] is > > main = return () :: IO () > }}} > > The function is stripped down as much as possible, it doesn't perform > anything all to meaningful anymore. > > The error message is: > > {{{#!bash > ghc: panic! (the 'impossible' happened) > (GHC version 8.4.3 for x86_64-apple-darwin): > heap overflow > }}} > > All else is off-the-shelf stack lts-12.10 via > > {{{#!bash > stack new bad-one simple > }}} > > Tested on Mac OS X and Debian. New description: The following few lines produce a GHC panic: {{{#!hs module Main where import Data.Bits (shift) badOne :: [Int] -> Integer -- replace Integer by Int and all is good! badOne is = sum $ zipWith (\n _->shift 1 n) [0..] is main = return () :: IO () }}} The function is stripped down as much as possible, it doesn't perform anything all to meaningful anymore. The error message is: {{{#!bash ghc: panic! (the 'impossible' happened) (GHC version 8.4.3 for x86_64-apple-darwin): heap overflow }}} All else is off-the-shelf stack lts-12.10 via {{{#!bash stack new bad-one simple }}} Tested on Mac OS X and Debian. This has some resemblance to[https://ghc.haskell.org/trac/ghc/ticket/14959 #14959]. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 16:49:55 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 16:49:55 -0000 Subject: [GHC] #15673: ghc: panic! (the 'impossible' happened) In-Reply-To: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> References: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> Message-ID: <061.0e5f0f89cfd73ccf61ff28bee6b613d7@haskell.org> #15673: ghc: panic! (the 'impossible' happened) -------------------------------------+------------------------------------- Reporter: mcmayer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.4 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: MacOS X | Architecture: x86_64 Type of failure: GHC doesn't work | (amd64) at all | Test Case: Blocked By: | Blocking: Related Tickets: 14959 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by mcmayer: Old description: > The following few lines produce a GHC panic: > > {{{#!hs > module Main where > > import Data.Bits (shift) > > badOne :: [Int] -> Integer -- replace Integer by Int and all is good! > badOne is = sum $ zipWith (\n _->shift 1 n) [0..] is > > main = return () :: IO () > }}} > > The function is stripped down as much as possible, it doesn't perform > anything all to meaningful anymore. > > The error message is: > > {{{#!bash > ghc: panic! (the 'impossible' happened) > (GHC version 8.4.3 for x86_64-apple-darwin): > heap overflow > }}} > > All else is off-the-shelf stack lts-12.10 via > > {{{#!bash > stack new bad-one simple > }}} > > Tested on Mac OS X and Debian. > > This has some resemblance > to[https://ghc.haskell.org/trac/ghc/ticket/14959 #14959]. New description: The following few lines produce a GHC panic: {{{#!hs module Main where import Data.Bits (shift) badOne :: [Int] -> Integer -- replace Integer by Int and all is good! badOne is = sum $ zipWith (\n _->shift 1 n) [0..] is main = return () :: IO () }}} The function is stripped down as much as possible, it doesn't perform anything all to meaningful anymore. The error message is: {{{#!bash ghc: panic! (the 'impossible' happened) (GHC version 8.4.3 for x86_64-apple-darwin): heap overflow }}} All else is off-the-shelf stack lts-12.10 via {{{#!bash stack new bad-one simple }}} Tested on Mac OS X and Debian. This has some resemblance with [https://ghc.haskell.org/trac/ghc/ticket/14959 #14959]. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 16:53:02 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 16:53:02 -0000 Subject: [GHC] #15673: ghc: panic! (the 'impossible' happened) In-Reply-To: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> References: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> Message-ID: <061.4b78eaa682569cdaad33c3320d666654@haskell.org> #15673: ghc: panic! (the 'impossible' happened) -------------------------------------+------------------------------------- Reporter: mcmayer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.4 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: MacOS X | Architecture: x86_64 Type of failure: GHC doesn't work | (amd64) at all | Test Case: Blocked By: | Blocking: Related Tickets: 14959 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by mcmayer: Old description: > The following few lines produce a GHC panic: > > {{{#!hs > module Main where > > import Data.Bits (shift) > > badOne :: [Int] -> Integer -- replace Integer by Int and all is good! > badOne is = sum $ zipWith (\n _->shift 1 n) [0..] is > > main = return () :: IO () > }}} > > The function is stripped down as much as possible, it doesn't perform > anything all to meaningful anymore. > > The error message is: > > {{{#!bash > ghc: panic! (the 'impossible' happened) > (GHC version 8.4.3 for x86_64-apple-darwin): > heap overflow > }}} > > All else is off-the-shelf stack lts-12.10 via > > {{{#!bash > stack new bad-one simple > }}} > > Tested on Mac OS X and Debian. > > This has some resemblance with > [https://ghc.haskell.org/trac/ghc/ticket/14959 #14959]. New description: The following few lines produce a GHC panic: {{{#!hs module Main where import Data.Bits (shift) badOne :: [Int] -> Integer -- replace Integer by Int and all is good! badOne is = sum $ zipWith (\n _->shift 1 n) [0..] is main = return () :: IO () }}} The function is stripped down as much as possible, it doesn't perform anything all to meaningful anymore. The error message is: {{{#!bash ghc: panic! (the 'impossible' happened) (GHC version 8.4.3 for x86_64-apple-darwin): heap overflow }}} All else is off-the-shelf stack lts-12.10 via {{{#!bash stack new bad-one simple }}} Tested on Mac OS X and Debian. This has some resemblance with [https://ghc.haskell.org/trac/ghc/ticket/14959 #14959], which was fixed in 8.4.2. -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 16:57:32 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 16:57:32 -0000 Subject: [GHC] #15673: heap overflow with Bits.shift and Integer (was: ghc: panic! (the 'impossible' happened)) In-Reply-To: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> References: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> Message-ID: <061.e98eed1d7578b7ff5c39be26b8a61233@haskell.org> #15673: heap overflow with Bits.shift and Integer -------------------------------------+------------------------------------- Reporter: mcmayer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.4.4 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: MacOS X | Architecture: x86_64 Type of failure: GHC doesn't work | (amd64) at all | Test Case: Blocked By: | Blocking: Related Tickets: 14959 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 17:18:05 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 17:18:05 -0000 Subject: [GHC] #15673: heap overflow with Bits.shift and Integer In-Reply-To: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> References: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> Message-ID: <061.629cb790acc6a08d39f5599de71d85ee@haskell.org> #15673: heap overflow with Bits.shift and Integer -------------------------------------+------------------------------------- Reporter: mcmayer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 Type of failure: GHC doesn't work | (amd64) at all | Test Case: Blocked By: | Blocking: Related Tickets: 14959 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * os: MacOS X => Unknown/Multiple * milestone: 8.4.4 => 8.8.1 Comment: Confirmed on GHC HEAD and 8.4 on Linux. Note that you need to pass -O or -O2 to reproduce, with -O0 (the default) this compiles without any errors. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 17:19:15 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 17:19:15 -0000 Subject: [GHC] #15673: heap overflow with Bits.shift and Integer In-Reply-To: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> References: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> Message-ID: <061.fa146fc374314726f8e238478b4777de@haskell.org> #15673: heap overflow with Bits.shift and Integer -------------------------------------+------------------------------------- Reporter: mcmayer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 Type of failure: GHC doesn't work | (amd64) at all | Test Case: Blocked By: | Blocking: Related Tickets: #14959 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * related: 14959 => #14959 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 21:25:35 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 21:25:35 -0000 Subject: [GHC] #13637: Printing type operators adds extraneous parenthesis In-Reply-To: <046.6ebd1e08796fca2595c91164229af3b2@haskell.org> References: <046.6ebd1e08796fca2595c91164229af3b2@haskell.org> Message-ID: <061.d6c5353b39f4a11efd451bff86970d73@haskell.org> #13637: Printing type operators adds extraneous parenthesis -------------------------------------+------------------------------------- Reporter: darchon | Owner: alanz Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1-rc2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by harpocrates): This seems to be by design. Taken from `BasicTypes`: {{{ Note [Type operator precedence] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We don't keep the fixity of type operators in the operator. So the pretty printer follows the following precedence order: TyConPrec Type constructor application TyOpPrec/FunPrec Operator application and function arrow We have FunPrec and TyOpPrec to represent the precedence of function arrow and type operators respectively, but currently we implement FunPred == TyOpPrec, so that we don't distinguish the two. Reason: it's hard to parse a type like a ~ b => c * d -> e - f By treating TyOpPrec = FunPrec we end up with more parens (a ~ b) => (c * d) -> (e - f) But the two are different constructors of TyPrec so we could make (->) bind more or less tightly if we wanted. }}} I propose we close this ticket - I tend to agree with the note that the extra parens increase readability. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 21:48:40 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 21:48:40 -0000 Subject: [GHC] #14880: GHC panic: updateRole In-Reply-To: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> References: <050.cdd24a949fb0169408d9edbb528c50d3@haskell.org> Message-ID: <065.cbebad1c3944b78edb3328fe65cef53f@haskell.org> #14880: GHC panic: updateRole -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: goldfire Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.2.2 checker) | Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15076 | Differential Rev(s): Phab:D4769, Wiki Page: | Phab:D5141, Phab:D5147, Phab:D5150 -------------------------------------+------------------------------------- Comment (by simonpj): Richard and I had a good discussion about this. Happily, we are now back to addressing the original problem, rather than chasing perf ghosts. We've agreed a path forwards and he's going to execute on it. So you can down-tools for now. (Note to self: Richard and I wrote notes on the FC-call channel, dated today.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 22:25:10 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 22:25:10 -0000 Subject: [GHC] #15665: Break up the stable pointer table In-Reply-To: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> References: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> Message-ID: <060.6db18f6e2e7d4e2939a542e4b99188de@haskell.org> #15665: Break up the stable pointer table -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #7670 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): One challenge is that the active entry list for a generation could jump all over the heap, making major GC more expensive than it is now when the table is well populated. Is there a sufficiently cheap way to ameliorate this? I believe there is. The trick is to have one active entry list per generation in each block, and an active block list in each generation. So now GC for a generation will always finish one block before it moves to the next, which I imagine should be much easier on the caches. We just need to reserve room for as many pointers in each block as there are GC generations, which doesn't look like too high a price to me. Can we improve concurrency, which was really what got me started thinking about this machine? I don't really know. The easiest thing would be to divide everything strictly among the capabilities. Each capability would have its own free list and its own active lists. Each block would be owned by just one capability. Only that capability would be permitted to allocate stable pointers in that block, though others could mark pointers for deletion. The trouble with that rigidity is that one capability could have loads of entries on its free list while another is flat broke and forced to allocate fresh blocks (for example, a heavy `StablePtr` allocator could migrate from one capability to another). Is there some sufficiently cheap way to tax the rich to feed the poor without too much bureaucracy? I don't see any, but I'm surely no expert. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 23:08:40 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 23:08:40 -0000 Subject: [GHC] #15665: Break up the stable pointer table In-Reply-To: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> References: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> Message-ID: <060.0e463713250d52d7fc970974717e0c67@haskell.org> #15665: Break up the stable pointer table -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #7670 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): Ah, I think I do see one. Start by using one free list per block, and tracking the number of free list entries both per block and per capability. When adding an entry to the free list for a block, check whether both of the following are true: 1. The block has "sufficient" free entries (to be worth the synchronization overhead) and 2. The capability has "sufficient" other free entries (so it's not going to have to jump straight from the donor line to the recipient line). In that case, the capability relinquishes the block to a shared list. Any capability that runs out of free entries can try to get a (partially used) block from that list and only allocate a fresh one if that fails. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Mon Sep 24 23:57:04 2018 From: ghc-devs at haskell.org (GHC) Date: Mon, 24 Sep 2018 23:57:04 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.8781f92df2771e67a821b8d9104a06f1@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by monoidal): In this part: {{{ , fl_before, fl_after, fl_exp :: Integer -- Denotes .E }}} I would be careful with `fl_after`: we don't want to merely convert the part after the dot to an integer, because 1.2e3 and 1.02e3 are not the same. I think we could always shift the dot and exponent so that we always have a whole number before "e" (e.g. 1.2e4 -> 12e3, 0.1e-4 -> 1e-5) Regarding desugaring to `readRational "1e100"`, do I understand correctly programs would then have to parse `1e100` every time a floating literal is evaluated? My feeling is that this will affect negatively performance (but it's just a feeling - I suggest benchmarking before checking this in.) One more complication is hexadecimal floats, which have the same problem (`:t 0x1.0p100000000` is slow) I know I've said this and I already sound like a grouch, but I still prefer just to forbid big exponents and call it a day. There are less than 1e90 elementary particles in the observable universe, doubles go up to 1e308 and rarely used extended floating point representations only slightly further. If someone wants to write `2e10000000000000` we might just ask them to write the code as `2 * 10^^10000000000000` instead. This at least has a chance to work given an appropriate type and typeclass instance, unlike computing this expression as integer which is hopeless. After all, Haskell is about moving problems at run time to problems at compile time, not the other way around. (I don't want to stir up an argument here. If you disagree, you can just ignore what I said, I won't insist.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 01:44:47 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 01:44:47 -0000 Subject: [GHC] #8578: Improvements to SpinLock implementation In-Reply-To: <044.7d4d696b896537d8c685483f715ea999@haskell.org> References: <044.7d4d696b896537d8c685483f715ea999@haskell.org> Message-ID: <059.854cbea91f64d1cc3957a350a09d9ba6@haskell.org> #8578: Improvements to SpinLock implementation -------------------------------------+------------------------------------- Reporter: parcs | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 7.7 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): Since thoughtpolice mentioned them, I'm wondering if there are specific places we should look at as HLE (or perhaps RTM) candidates. I don't ''think'' we can rely on the system glibc to use them to implement mutexes unless we ask for that specifically in some fashion. I'd expect very small and short transactions (most but not all of what we do) to benefit. Has anyone looked into that yet? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 01:45:06 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 01:45:06 -0000 Subject: [GHC] #8578: Improvements to SpinLock implementation In-Reply-To: <044.7d4d696b896537d8c685483f715ea999@haskell.org> References: <044.7d4d696b896537d8c685483f715ea999@haskell.org> Message-ID: <059.8961b282db2a52a67b997e5f252f32f3@haskell.org> #8578: Improvements to SpinLock implementation -------------------------------------+------------------------------------- Reporter: parcs | Owner: (none) Type: task | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 7.7 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by dfeuer): * cc: dfeuer (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 03:46:08 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 03:46:08 -0000 Subject: [GHC] #14201: Implement ideas from "Compiling Pattern Matching to Good Decision Trees" In-Reply-To: <047.8c12540f1c55383efff9bbd37be2e217@haskell.org> References: <047.8c12540f1c55383efff9bbd37be2e217@haskell.org> Message-ID: <062.6144443b746db2248a17629fee522245@haskell.org> #14201: Implement ideas from "Compiling Pattern Matching to Good Decision Trees" -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: AndreasK Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AndreasK): = There are shortcomings in the current codegen of GHC that eliminate much of the gains to be had here. * Changing the order of pattern matches can lead to more floating of case alternatives to the top level. The associated cost from calling a top level function overshadows potential gains when that happens. This is expensive since: * They have to confirm to the calling convention, so can require register shifting. * They prohibit us from falling through to the alternative. * They split the code in memory usually leading to more cache pressure. There is an ticket about the issue already: #15560 * The algorithm depends on shared pattern matching subtrees being commoned up which doesn't work yet. As a consequence we quite often end up with duplicate code which kills performance. * I had hoped to leave this to CSE but it turns out GHC's CSE is not as good as one would hope in this regard. See https://ghc.haskell.org/trac/ghc/wiki/MoreCSE for some discussion. * We could do an special CSE for just the pattern matching trees. Butduring desugaring we don't work bottom up but top down. We generate functions which take as argument the expression to put into the case alternatives instead of directly generating an AST expression. It wasn't clear how to work with or refactor this to allow commoning up of pattern matching subtrees at the time I last looked at this. * Last and least: The current codelayout is heavily dependent on how we generate `if` statements for Cmm. As consequence performance can vary a lot when changing the order of pattern matches. I did some work on code layout which hopefully will help with this in #15124. Which might change the performance difference between differing pattern match algorithms. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 05:35:05 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 05:35:05 -0000 Subject: [GHC] #9173: Better type error messages In-Reply-To: <046.f8f24aa2ddaa3d579bc40f0b6f04f6b7@haskell.org> References: <046.f8f24aa2ddaa3d579bc40f0b6f04f6b7@haskell.org> Message-ID: <061.8188fd5251ddb76f26a8832d2d43026c@haskell.org> #9173: Better type error messages -------------------------------------+------------------------------------- Reporter: simonpj | Owner: goldfire Type: bug | Status: new Priority: high | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: | TypeErrorMessages Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by nineonine): Update: I was able to locate all the places where we make `TypeEqOrigin`. We do this with a help of a smart constructor `mkCheckExpType`. There are around 80-90 places (across 12 modules) where we use it. There is another function `synKnownType` that uses `mkCheckExpType` which has another 25 occurrences. For now I just used dummy text everywhere to be able to compile it. Here you can see more detailed search results for these functions: * `mkCheckExpType` - https://lpaste.net/7745839270543228928 * `synKnownType` - https://lpaste.net/4510196100136697856 I have already changed some of the messages where I was able to infer the context and come up with meaningful explanations. Here is a screenshot of examples from the ticket with new messages - https://prnt.sc/kycm4c, however, some places are tricky so I will probably need more time to spend on them. Right now my plan is the following - I want to come up with all the test cases(programs) that would call all the code parts where we use the above mentioned functions. By doing that, I will slowly weed out all the dummy messages and replace with meaningful ones. As suggested, I am collecting all the notes of my changes. Perhaps, it is a good time to submit a patch to Phabricator? We could proceed with a discussion there and it would be much easier to discuss all the new messages (with line comments). By the way, If someone could code review and help with new messages - that would be greatly appreciated! Thank you. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 06:31:46 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 06:31:46 -0000 Subject: [GHC] #12178: Allow inline pragmas on pattern synonyms In-Reply-To: <049.c0b5177720c745c7c76b88f1c76a960e@haskell.org> References: <049.c0b5177720c745c7c76b88f1c76a960e@haskell.org> Message-ID: <064.8e594b421f87fcfa595be68cb4305f88@haskell.org> #12178: Allow inline pragmas on pattern synonyms -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: feature request | Status: new Priority: high | Milestone: 8.8.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: | PatternSynonyms, newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * owner: osa1 => (none) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 07:07:32 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 07:07:32 -0000 Subject: [GHC] #12848: Reduce long-term memory usage of GHCi In-Reply-To: <047.67e660d21ca1bf05a200182e30500999@haskell.org> References: <047.67e660d21ca1bf05a200182e30500999@haskell.org> Message-ID: <062.50d80a2dfae77d79cce5d786cdeab09c@haskell.org> #12848: Reduce long-term memory usage of GHCi ------------------------------------+-------------------------------------- Reporter: arybczak | Owner: (none) Type: feature request | Status: new Priority: high | Milestone: Component: GHCi | Version: 8.0.1 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: #15111 | Differential Rev(s): Wiki Page: | ------------------------------------+-------------------------------------- Changes (by osa1): * related: => #15111 Comment: Indeed that is related, however I just tried GHC 8.6 and this problem still occurs. As in the original report for GHC 8.0.1, the leak stops after a few reloads. This seems very similar to #15111, I don't know why this is still not fixed. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 09:11:24 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 09:11:24 -0000 Subject: [GHC] #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 In-Reply-To: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> References: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> Message-ID: <058.c8bd8f4d75259e2e3758ba2129d4527c@haskell.org> #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 -------------------------------------+------------------------------------- Reporter: noah | Owner: tdammers Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | accelerate,memory,compile Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: Compile-time | Test Case: accelerate performance bug | 1.2.0 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Here's a reduced version: {{{#!haskell {-# LANGUAGE GADTs #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_HADDOCK hide #-} -- | -- Module : Repro -- -- based on Data.Array.Accelerate.Analysis.Hash from accelerate -- -- Copyright : [2017] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell -- License : BSD3 module Repro where import Data.ByteString.Builder import Data.ByteString.Builder.Extra import Data.Monoid import Foreign.C.Types import System.IO.Unsafe ( unsafePerformIO ) import System.Mem.StableName ( hashStableName, makeStableName ) import Prelude hiding ( exp ) import Data.Array.Accelerate.Type import Data.Array.Accelerate.Analysis.Hash.TH {-# INLINE encodeSingleConst #-} encodeSingleConst :: SingleType t -> t -> Builder encodeSingleConst (NumSingleType t) = encodeNumConst t encodeSingleConst (NonNumSingleType t) = encodeNonNumConst t {-# INLINE encodeVectorConst #-} encodeVectorConst :: VectorType t -> t -> Builder encodeVectorConst (Vector2Type t) (V2 a b) = intHost $(hashQ "V2") <> encodeSingleConst t a <> encodeSingleConst t b encodeVectorConst (Vector3Type t) (V3 a b c) = intHost $(hashQ "V3") <> encodeSingleConst t a <> encodeSingleConst t b <> encodeSingleConst t c encodeVectorConst (Vector4Type t) (V4 a b c d) = intHost $(hashQ "V4") <> encodeSingleConst t a <> encodeSingleConst t b <> encodeSingleConst t c <> encodeSingleConst t d encodeVectorConst (Vector8Type t) (V8 a b c d e f g h) = intHost $(hashQ "V8") <> encodeSingleConst t a <> encodeSingleConst t b <> encodeSingleConst t c <> encodeSingleConst t d <> encodeSingleConst t e <> encodeSingleConst t f <> encodeSingleConst t g <> encodeSingleConst t h encodeVectorConst (Vector16Type t) (V16 a b c d e f g h i j k l m n o p) = intHost $(hashQ "V16") <> encodeSingleConst t a <> encodeSingleConst t b <> encodeSingleConst t c <> encodeSingleConst t d <> encodeSingleConst t e <> encodeSingleConst t f <> encodeSingleConst t g <> encodeSingleConst t h <> encodeSingleConst t i <> encodeSingleConst t j <> encodeSingleConst t k <> encodeSingleConst t l <> encodeSingleConst t m <> encodeSingleConst t n <> encodeSingleConst t o <> encodeSingleConst t p {-# INLINE encodeNonNumConst #-} encodeNonNumConst :: NonNumType t -> t -> Builder encodeNonNumConst TypeBool{} x = intHost $(hashQ "Bool") <> word8 (fromBool x) encodeNonNumConst TypeChar{} x = intHost $(hashQ "Char") <> charUtf8 x encodeNonNumConst TypeCSChar{} (CSChar x) = intHost $(hashQ "CSChar") <> int8 x encodeNonNumConst TypeCUChar{} (CUChar x) = intHost $(hashQ "CUChar") <> word8 x encodeNonNumConst TypeCChar{} (CChar x) = intHost $(hashQ "CChar") <> $( [e| int8 |] ) x {-# INLINE fromBool #-} fromBool :: Bool -> Word8 fromBool True = 1 fromBool False = 0 {-# INLINE encodeNumConst #-} encodeNumConst :: NumType t -> t -> Builder encodeNumConst (IntegralNumType t) = encodeIntegralConst t encodeNumConst (FloatingNumType t) = encodeFloatingConst t {-# INLINE encodeIntegralConst #-} encodeIntegralConst :: IntegralType t -> t -> Builder encodeIntegralConst TypeInt{} x = intHost $(hashQ "Int") <> intHost x encodeIntegralConst TypeInt8{} x = intHost $(hashQ "Int8") <> int8 x encodeIntegralConst TypeInt16{} x = intHost $(hashQ "Int16") <> int16Host x encodeIntegralConst TypeInt32{} x = intHost $(hashQ "Int32") <> int32Host x encodeIntegralConst TypeInt64{} x = intHost $(hashQ "Int64") <> int64Host x encodeIntegralConst TypeWord{} x = intHost $(hashQ "Word") <> wordHost x encodeIntegralConst TypeWord8{} x = intHost $(hashQ "Word8") <> word8 x encodeIntegralConst TypeWord16{} x = intHost $(hashQ "Word16") <> word16Host x encodeIntegralConst TypeWord32{} x = intHost $(hashQ "Word32") <> word32Host x encodeIntegralConst TypeWord64{} x = intHost $(hashQ "Word64") <> word64Host x encodeIntegralConst TypeCShort{} (CShort x) = intHost $(hashQ "CShort") <> int16Host x encodeIntegralConst TypeCUShort{} (CUShort x) = intHost $(hashQ "CUShort") <> word16Host x encodeIntegralConst TypeCInt{} (CInt x) = intHost $(hashQ "CInt") <> int32Host x encodeIntegralConst TypeCUInt{} (CUInt x) = intHost $(hashQ "CUInt") <> word32Host x encodeIntegralConst TypeCLLong{} (CLLong x) = intHost $(hashQ "CLLong") <> int64Host x encodeIntegralConst TypeCULLong{} (CULLong x) = intHost $(hashQ "CULLong") <> word64Host x encodeIntegralConst TypeCLong{} (CLong x) = intHost $(hashQ "CLong") <> $( [e| int64Host |] ) x encodeIntegralConst TypeCULong{} (CULong x) = intHost $(hashQ "CULong") <> $( [e| word64Host |] ) x {-# INLINE encodeFloatingConst #-} encodeFloatingConst :: FloatingType t -> t -> Builder encodeFloatingConst TypeHalf{} (Half (CUShort x)) = intHost $(hashQ "Half") <> word16Host x encodeFloatingConst TypeFloat{} x = intHost $(hashQ "Float") <> floatHost x encodeFloatingConst TypeDouble{} x = intHost $(hashQ "Double") <> doubleHost x encodeFloatingConst TypeCFloat{} (CFloat x) = intHost $(hashQ "CFloat") <> floatHost x encodeFloatingConst TypeCDouble{} (CDouble x) = intHost $(hashQ "CDouble") <> doubleHost x }}} In order to compile this, only 3 dependencies need to be downloaded: `base-orphans`, `half`, and `hashable`. This makes it easy to build this without Cabal, plug in different compilers, and compile files individually. Now, it turns out that the above sample, after everything it depends on has been compiled, takes about 30 seconds to compile (with full optimizations), and Core size blows up to about 140k terms. Changing the pragmas for `encodeSingleConst` and `encodeVectorConst` to `NOINLINE` however brings this down to only 3 seconds; changing only `encodeVectorConst` still gets us 20 seconds. Tentative hypothesis: simplifier somehow chokes on the TH-generated code in `encodeVectorConst`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 09:57:59 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 09:57:59 -0000 Subject: [GHC] #8316: GHCi debugger segfaults when trying force a certain variable In-Reply-To: <044.9ebacfadd8f49d7b017849858920cbb4@haskell.org> References: <044.9ebacfadd8f49d7b017849858920cbb4@haskell.org> Message-ID: <059.e0ddb745c36f92ccb71cf6c9ae4c9c86@haskell.org> #8316: GHCi debugger segfaults when trying force a certain variable -------------------------------------+------------------------------------- Reporter: guest | Owner: (none) Type: bug | Status: new Priority: high | Milestone: Component: GHCi | Version: 7.6.3 Resolution: | Keywords: debugger Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4535 Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): Ah, looking at this ticket again, I can see what I missed last time (in Phab:D4535). The problem is Phab:D4535 does not have any effect because TSO and BLOCKING_QUEUE are already not handled by `cvObtainTerm.go` and `cvObtainTerm` returns a `Suspension` when it finds one of those objects. So even if we follow a BLACKHOLE that points to a TSO we return a `Suspension`. In Phab:D4535 we returned `Suspension` slightly earlier (before following the indirectee), but the value we returned was identical to the value we returned without the patch. What we should do is if we see a BLACKHOLE pointing to an TSO or BLOCKING_QUEUE we should return a `Suspension` with the BLACKHOLE itself as the `hval` (currently: `hval` is the indirectee). However I suspect entering the BLACKHOLE will result in a deadlock because the thread that's supposed to evaluate the expression (i.e. the owner) is blocked on an MVar (the breakpoint MVar passed to `GHCi.Run.withBreakAction`) and when we enter the BLACKHOLE our thread gets parked, to be unparked by the owner of the BLACKHOLE, which never happens as we don't update the MVar before entering the BLACKHOLE. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 10:26:55 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 10:26:55 -0000 Subject: [GHC] #8316: GHCi debugger segfaults when trying force a certain variable In-Reply-To: <044.9ebacfadd8f49d7b017849858920cbb4@haskell.org> References: <044.9ebacfadd8f49d7b017849858920cbb4@haskell.org> Message-ID: <059.ff611f32d4cc9f0a0e6085073ef500a7@haskell.org> #8316: GHCi debugger segfaults when trying force a certain variable -------------------------------------+------------------------------------- Reporter: guest | Owner: (none) Type: bug | Status: new Priority: high | Milestone: Component: GHCi | Version: 7.6.3 Resolution: | Keywords: debugger Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4535, Wiki Page: | Phab:D5179 -------------------------------------+------------------------------------- Changes (by osa1): * differential: Phab:D4535 => Phab:D4535, Phab:D5179 Comment: I submitted a diff. As expected, it causes a deadlock in the reproducer. Simon, any ideas on how to fix the deadlock? Would it be possible to resume the evaluator thread (by updating `breakMVar`) before entering a BLACKHOLE? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 11:17:46 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 11:17:46 -0000 Subject: [GHC] #15674: GADT's displayed type is misleading Message-ID: <043.9b768266188379838903cb47df1bf014@haskell.org> #15674: GADT's displayed type is misleading -------------------------------------+------------------------------------- Reporter: AntC | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Keywords: | Operating System: Windows Architecture: x86_64 | Type of failure: Poor/confusing (amd64) | error message Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- GHCi's `:t` alleges these three data constructors have the same type `:: Int -> T Int` (modulo name of the type constructor): {{{#!hs data DG a where MkDG :: Int -> DG Int MkDG2 :: (a ~ Int) => a -> DG a data family DF a data instance DF Int where MkDF :: Int -> DF Int }}} I tried switching on verbosity flags, but to no avail: `-fprint-explicit- foralls, -fprint-equality-relations`, and a few others. The `DG` constructors are GADTs, the `DF` constructor is not. So it's not hard to see different type-level behaviour: {{{#!hs f (MkDF x) = x -- accepted without a signature -- f :: DF Int -> Int -- inferred signature, or you can spec it -- f :: DF a -> a -- rejected: signature is too general/ -- a is a rigid type variable g (MkDG x) = x -- } without a signature, rejected g (MkDG2 x) = x -- } "untouchable" type (Note) -- g :: DG Int -> Int -- } g accepted with either sig -- g :: DG a -> a -- } ?but MkDG doesn't return DG a, allegedly }}} '''Note:''' at least the error message re `MkDG2` does show its type as `:: (forall a). (a ~ Int) => DG a -> a`. But doggedly `MkDG :: Int -> DG Int`. "Untouchable" error messages are a fertile source of questions on StackOverflow. The message does say `Possible fix: add a type signature for 'g'`, but gives no clue what the signature might be. If you've imported these data constructors from a library, such that you can't (easily) see they're GADTs, couldn't `:t` give you better help to show what's going on? Or should one of the verbosity flags already do this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 11:30:00 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 11:30:00 -0000 Subject: [GHC] #8316: GHCi debugger segfaults when trying force a certain variable In-Reply-To: <044.9ebacfadd8f49d7b017849858920cbb4@haskell.org> References: <044.9ebacfadd8f49d7b017849858920cbb4@haskell.org> Message-ID: <059.2bda30ba9f474fda93c28007513fb2ca@haskell.org> #8316: GHCi debugger segfaults when trying force a certain variable -------------------------------------+------------------------------------- Reporter: guest | Owner: (none) Type: bug | Status: new Priority: high | Milestone: Component: GHCi | Version: 7.6.3 Resolution: | Keywords: debugger Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4535, Wiki Page: | Phab:D5179 -------------------------------------+------------------------------------- Comment (by simonmar): I don't see a good way to solve this. The thread that is evaluiating `foo` is stopped at a breakpoint - that's what the user asked for, so it's not entirely surprising that if they evaluate something that requires `foo` then it deadlocks. What would we like to happen? I can think of a couple of alternatives: **1. Just make it work** Should it automatically continue evaluation of `foo`? How would you know when to do that? Evaluating a BLACKHOLE doesn't necessarily mean that we're about to deadlock, we might be evaluating something that another thread is evaluating. As soon as we release the `breakMVar` the thread will continue evaluating `foo`, but I don't know of a way to tell whether/when we should do that. Perhaps instead of the MVar, a breakpoint should be an asynchronous exception so that we end up with a thunk that we could poke to continue evaluation? That would make this work, but it would mean a big change to the way breakpoints work and I'm not sure whether it would run into other problems. One potential problem is that it's a lot more expensive than the current breakpoint mechanism, so `:trace` wouldn't work so well. **2. Make it an error of some kind** e.g. {{{ [main.hs:2:7-11] *Main> _t1 *** Exception: blocked on breakpoint 1 }}} The question is how to achieve that. Perhaps we periodically monitor the thread we just created to do the evaluation and check whether it's blocked on a blackhole, and then compare the owner of the blackhole it is blocked on against all the threads we know are currently at breakpoints? That could possibly work, but it's tricky to implement. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 11:41:57 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 11:41:57 -0000 Subject: [GHC] #9173: Better type error messages In-Reply-To: <046.f8f24aa2ddaa3d579bc40f0b6f04f6b7@haskell.org> References: <046.f8f24aa2ddaa3d579bc40f0b6f04f6b7@haskell.org> Message-ID: <061.e080b6302aeab1db45599b421e1ea1fc@haskell.org> #9173: Better type error messages -------------------------------------+------------------------------------- Reporter: simonpj | Owner: goldfire Type: bug | Status: new Priority: high | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: | TypeErrorMessages Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): This sounds great. I think it would be very helpful if you wrote a wiki page (on the Trac wiki) explaining (a) the problem you are trying to solve (being more specific than "better error messages"), and (b) how you are solving it. Concerning (b) there are quite a few moving parts, and it really helps to explain how they work together. It may well be that we iterate the design a bit, and it's best to do that before you have invested a great deal of effort in it. Thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 11:54:35 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 11:54:35 -0000 Subject: [GHC] #15674: GADT's displayed type is misleading In-Reply-To: <043.9b768266188379838903cb47df1bf014@haskell.org> References: <043.9b768266188379838903cb47df1bf014@haskell.org> Message-ID: <058.e14b44fa8ee91b3ec558da175762410a@haskell.org> #15674: GADT's displayed type is misleading -------------------------------------+------------------------------------- Reporter: AntC | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Poor/confusing | (amd64) error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): `:type ` tells you the type of the expression ``, where `` can be any old expression, not just a single identifier. On the other hand `:info ` gives you information about the declaration of the entity ``. And indeed `:info MkDF`, `:info MkDG` and `:info MkDG2` give you the info that I think you want. This works if the constructors are imported from a library that you can't (easily) see. Does that help? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 12:02:05 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 12:02:05 -0000 Subject: [GHC] #14907: Error message: (%, %) shows up when with accidental paren In-Reply-To: <051.2e9709c3004b74af6c52b8b012de4b6f@haskell.org> References: <051.2e9709c3004b74af6c52b8b012de4b6f@haskell.org> Message-ID: <066.a2e17425f7dcc0315fd700ddedbcec22@haskell.org> #14907: Error message: (%,%) shows up when with accidental paren -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5172 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Krzysztof Gogolewski ): In [changeset:"9bfbc4e16d511678cffa9f7f76b369c8cfca7a66/ghc" 9bfbc4e1/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="9bfbc4e16d511678cffa9f7f76b369c8cfca7a66" Don't show constraint tuples in errors (#14907) Summary: This means that 'GHC.Classes.(%,%)' is no longer mentioned in error messages for things like class (a,b,c) -- outside of 'GHC.Classes' class (a,Bool) Test Plan: make TEST=T14907a && make TEST=T14907b Reviewers: RyanGlScott, bgamari Reviewed By: RyanGlScott Subscribers: rwbarton, carter GHC Trac Issues: #14907 Differential Revision: https://phabricator.haskell.org/D5172 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 12:03:37 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 12:03:37 -0000 Subject: [GHC] #14907: Error message: (%, %) shows up when with accidental paren In-Reply-To: <051.2e9709c3004b74af6c52b8b012de4b6f@haskell.org> References: <051.2e9709c3004b74af6c52b8b012de4b6f@haskell.org> Message-ID: <066.b3d2214e7b3c33e108cac58c5f00f519@haskell.org> #14907: Error message: (%,%) shows up when with accidental paren -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: merge Priority: normal | Milestone: Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5172 Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: patch => merge -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 12:09:47 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 12:09:47 -0000 Subject: [GHC] #15666: Dependent type synonym in recursive type family causes GHC to panic In-Reply-To: <044.a6a6176d1f1adf6fd7f4bfff14914ffc@haskell.org> References: <044.a6a6176d1f1adf6fd7f4bfff14914ffc@haskell.org> Message-ID: <059.d341984e720e748c13eef08759e39b8c@haskell.org> #15666: Dependent type synonym in recursive type family causes GHC to panic -------------------------------------+------------------------------------- Reporter: tydeu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15380 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * related: => #15380 Comment: Ah, the commit that fixed this is 59f38587d44efd00b10a6d98f6a7a1b22e87f13a (`Remove the type-checking knot.`) That being said, the program in this ticket is rather different from the one in #15380 (which that commit fixed), since this ticket's program actually does compile. I'll add a separate regression test for this one. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 12:40:34 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 12:40:34 -0000 Subject: [GHC] #15666: Dependent type synonym in recursive type family causes GHC to panic In-Reply-To: <044.a6a6176d1f1adf6fd7f4bfff14914ffc@haskell.org> References: <044.a6a6176d1f1adf6fd7f4bfff14914ffc@haskell.org> Message-ID: <059.3fff8cb82a8313f86984099179164a22@haskell.org> #15666: Dependent type synonym in recursive type family causes GHC to panic -------------------------------------+------------------------------------- Reporter: tydeu | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15380 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Ryan Scott ): In [changeset:"2a9ceadfa07e2298ce934c6d304a3ba1f529ad93/ghc" 2a9cead/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="2a9ceadfa07e2298ce934c6d304a3ba1f529ad93" Add regression test for #15666 Commit 59f38587d44efd00b10a6d98f6a7a1b22e87f13a ended up fixing #15666. Let's add a regression test to ensure that it stays fixed. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 12:41:53 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 12:41:53 -0000 Subject: [GHC] #15666: Dependent type synonym in recursive type family causes GHC to panic In-Reply-To: <044.a6a6176d1f1adf6fd7f4bfff14914ffc@haskell.org> References: <044.a6a6176d1f1adf6fd7f4bfff14914ffc@haskell.org> Message-ID: <059.45ad77b58d04aee9091a785247776add@haskell.org> #15666: Dependent type synonym in recursive type family causes GHC to panic -------------------------------------+------------------------------------- Reporter: tydeu | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Compile-time | Test Case: crash or panic | dependent/should_compile/T15666 Blocked By: | Blocking: Related Tickets: #15380 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * status: new => closed * testcase: => dependent/should_compile/T15666 * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 12:48:17 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 12:48:17 -0000 Subject: [GHC] #15663: T9675 inexplicably regressed in allocations due to text submodule bump In-Reply-To: <046.4bbf528148a8a5d4e7c394f0e92d23d3@haskell.org> References: <046.4bbf528148a8a5d4e7c394f0e92d23d3@haskell.org> Message-ID: <061.1834e4748f2970f56046161c9224116d@haskell.org> #15663: T9675 inexplicably regressed in allocations due to text submodule bump -------------------------------------+------------------------------------- Reporter: bgamari | Owner: alpmestan Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alpmestan): On my machine, the test passes both at commit e40b3888d7b70bb5c95c377cac66b2839332673d (the one before the text submodule bump) and at commit 989dca6cbd93205a72f12a0921ba1216559a9e1e (the text submodule bump). Moreover, the important stats look really, really similar: || ||= before text bump =||= after text bump =|| || bytes allocated || 67745356 || 678640112 || || max bytes used || 20177520 || 18842304 || || average bytes used || 8714779 || 8859872 || || max mem in use || 77594624 || 73400320 || and it just goes on, most of those stats align. Is that submodule bump the exact moment when the problem appeared? I'm going to try with an older commit and see if the stats look similar there too. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 13:39:48 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 13:39:48 -0000 Subject: [GHC] #15663: T9675 inexplicably regressed in allocations due to text submodule bump In-Reply-To: <046.4bbf528148a8a5d4e7c394f0e92d23d3@haskell.org> References: <046.4bbf528148a8a5d4e7c394f0e92d23d3@haskell.org> Message-ID: <061.c42cf5a33f42901e97b878cf1ac6e089@haskell.org> #15663: T9675 inexplicably regressed in allocations due to text submodule bump -------------------------------------+------------------------------------- Reporter: bgamari | Owner: alpmestan Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alpmestan): With a (master) commit from early september (ed789516e201e4fad771e5588da47a62e53b42b8): ||= bytes allocated =|| 677459608 || ||= max bytes used =|| 18826416 || ||= average bytes used =|| 8745272 || ||= max mem in use =|| 73400320 || The figures are again very, very close what I got with the previous two commits. I'm now going to try with the tip of the master branch right now. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 13:48:13 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 13:48:13 -0000 Subject: [GHC] #8316: GHCi debugger segfaults when trying force a certain variable In-Reply-To: <044.9ebacfadd8f49d7b017849858920cbb4@haskell.org> References: <044.9ebacfadd8f49d7b017849858920cbb4@haskell.org> Message-ID: <059.3ac8eb26e8da7420a18153cf5007c090@haskell.org> #8316: GHCi debugger segfaults when trying force a certain variable -------------------------------------+------------------------------------- Reporter: guest | Owner: (none) Type: bug | Status: new Priority: high | Milestone: Component: GHCi | Version: 7.6.3 Resolution: | Keywords: debugger Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4535, Wiki Page: | Phab:D5179 -------------------------------------+------------------------------------- Comment (by osa1): Here's another example that deadlocks even with GHC 8.6: {{{ foo = 0 : bar bar = 1 : foo }}} in GHCi: {{{ GHCi, version 8.6.1: http://www.haskell.org/ghc/ :? for help :Loaded GHCi configuration from /home/omer/rcbackup/.ghci [1 of 1] Compiling Main ( test.hs, interpreted ) Ok, one module loaded. λ:1> :break foo Breakpoint 0 activated at test.hs:1:7-13 λ:2> foo Stopped in Main.foo, test.hs:1:7-13 _result :: [Integer] = _ [test.hs:1:7-13] λ:3> :print bar bar = (_t1::[Integer]) [test.hs:1:7-13] λ:4> _t1 [1 }}} The reason why we don't get "TSO entered" here is because _t1 stands for `bar`, and `bar` itself is not locked by the evaluator thread. Instead an object in `bar`'s payload is owned. I think this shows that even if we could somehow release the MVar in the original reproducer there will be deadlocks. I think we should: - Merge the patch. We should never enter a TSO or BLOCKING_QUEUE. - Document this behavior in the user manual - Disallow evaluating BLACKHOLEs in GHCi The last step would fix the original reproducer, but my example above will still deadlock and that's what you get for having lazy evaluation. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 13:49:30 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 13:49:30 -0000 Subject: [GHC] #8316: GHCi debugger panics when trying force a certain variable (was: GHCi debugger segfaults when trying force a certain variable) In-Reply-To: <044.9ebacfadd8f49d7b017849858920cbb4@haskell.org> References: <044.9ebacfadd8f49d7b017849858920cbb4@haskell.org> Message-ID: <059.19ccaf1fc9f738d89012dd6b02695bd7@haskell.org> #8316: GHCi debugger panics when trying force a certain variable -------------------------------------+------------------------------------- Reporter: guest | Owner: (none) Type: bug | Status: new Priority: high | Milestone: Component: GHCi | Version: 7.6.3 Resolution: | Keywords: debugger Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: GHCi crash | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4535, Wiki Page: | Phab:D5179 -------------------------------------+------------------------------------- Description changed by osa1: Old description: > The file Test.hs has following definition: > {{{ > foo :: [Int] > foo = [1..] > }}} > > Calling ghci as: > {{{ > ghci Test.hs -ignore-dot-ghci > }}} > > and bebugging foo like this: > {{{ > *Main> :break foo > Breakpoint 0 activated at main.hs:2:7-11 > *Main> foo > Stopped in Main.foo, main.hs:2:7-11 > _result :: [Int] = _ > [main.hs:2:7-11] *Main> :print foo > foo = (_t1::[Int]) > [main.hs:2:7-11] *Main> _t1 > }}} > > results in this segault: > {{{ > : internal error: TSO object entered! > (GHC version 8.5.20180302 for x86_64_unknown_linux) > Please report this as a GHC bug: > http://www.haskell.org/ghc/reportabug > [1] 5445 abort (core dumped) ghci Test.hs -ignore-dot-ghci > }}} New description: The file Test.hs has following definition: {{{ foo :: [Int] foo = [1..] }}} Calling ghci as: {{{ ghci Test.hs -ignore-dot-ghci }}} and bebugging foo like this: {{{ *Main> :break foo Breakpoint 0 activated at main.hs:2:7-11 *Main> foo Stopped in Main.foo, main.hs:2:7-11 _result :: [Int] = _ [main.hs:2:7-11] *Main> :print foo foo = (_t1::[Int]) [main.hs:2:7-11] *Main> _t1 }}} results in this panic: {{{ : internal error: TSO object entered! (GHC version 8.5.20180302 for x86_64_unknown_linux) Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug [1] 5445 abort (core dumped) ghci Test.hs -ignore-dot-ghci }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 13:55:21 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 13:55:21 -0000 Subject: [GHC] #15674: GADT's displayed type is misleading In-Reply-To: <043.9b768266188379838903cb47df1bf014@haskell.org> References: <043.9b768266188379838903cb47df1bf014@haskell.org> Message-ID: <058.95fc6d089943f1a66646e416928a9abb@haskell.org> #15674: GADT's displayed type is misleading -------------------------------------+------------------------------------- Reporter: AntC | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Poor/confusing | (amd64) error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AntC): Replying to [comment:1 simonpj]: Thank you Simon. > `:type ` tells you the type of the expression ``, where `` can be any old expression, not just a single identifier. > Yes. So you're saying those three data constructors are at the same type, considered as expressions(?) What is it about their typedness that explains the observable difference in behaviour wrt the functions? (It's to do with pattern matching/deconstructing, rather than applying them as functions/constructing.) > On the other hand `:info ` gives you information about the declaration of the entity ``. Yes, `:info` more or less shows the code that declares ``. > And indeed `:info MkDF`, `:info MkDG` and `:info MkDG2` give you the info that I think you want. Hmm. `:info` still shows `MkDF :: Int -> DF Int`, `MkDG :: Int -> DG Int`. It does show `MkDG2 :: (a ~ Int) => a -> DG a` or even `MkDG2 :: forall a. (a ~ Int) => a -> DG a`. So ''prima facie'' `MkDF, MkDG`'s types are the same; `MkDG2`'s is different. But actually `MkDG` is the same as `MkDG2`. (And setting `-fprint-explicit-foralls` doesn't explicitly show the `forall` in `MkDG`, although it does in `MkDG2`. But `MkDG2`'s decl doesn't have an explicit `forall`, neither do I need `-XExplicitForAll` to compile it -- that's not implied by `-XGADTs`, surprisingly.) > This works if the constructors are imported from a library that you can't (easily) see. > Ok. > Does that help? > > Perhaps `:t` should behave precisely like `:i` if it is given a single identifier as its argument. That would be non-uniform and ad-hoc, but perhaps useful in practice. Usually if I'm having trouble from error messages to do with "untouchable" or "rigid", it's `:t` I go to. I just have to kick myself to go to `:i`. But even the type signature showing in `:i` is misleading. Perhaps: if `` is a data constructor, and not a H98 constructor, and `-fprint- explicit-foralls` is set, show the foralls explicitly? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 14:22:46 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 14:22:46 -0000 Subject: [GHC] #15674: GADT's displayed type is misleading In-Reply-To: <043.9b768266188379838903cb47df1bf014@haskell.org> References: <043.9b768266188379838903cb47df1bf014@haskell.org> Message-ID: <058.86f30187d9b7f9571c1e570d3a6e439e@haskell.org> #15674: GADT's displayed type is misleading -------------------------------------+------------------------------------- Reporter: AntC | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Poor/confusing | (amd64) error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Replying to [comment:2 AntC]: > (It's to do with pattern matching/deconstructing, rather than applying them as functions/constructing.) Precisely. > So ''prima facie'' `MkDF, MkDG`'s types are the same; `MkDG2`'s is different. This is true. > But actually `MkDG` is the same as `MkDG2`. In most contexts, yes. But you can say `MkDG2 @Int` while you can't do that with `MkDG`. Their types are subtly different. > (And setting `-fprint-explicit-foralls` doesn't explicitly show the `forall` in `MkDG`, although it does in `MkDG2`. There is no `forall` in `MkDG`, which doesn't quantify over any variables. > But `MkDG2`'s decl doesn't have an explicit `forall`, neither do I need `-XExplicitForAll` to compile it -- that's not implied by `-XGADTs`, surprisingly.) Your code does not contain an explicit `forall` in `MkDG2`. It contains an implicit one, implied by the presence of the type variable `a`. > > Does that help? > > > > Perhaps `:t` should behave precisely like `:i` if it is given a single identifier as its argument. That would be non-uniform and ad-hoc, but perhaps useful in practice. But that would be non-uniform and ad-hoc. :) `:type ` gives you the type that is assigned to `it` if you had `let it = `. It's a uniform rule that always works. > > Usually if I'm having trouble from error messages to do with "untouchable" or "rigid", it's `:t` I go to. I just have to kick myself to go to `:i`. But even the type signature showing in `:i` is misleading. Perhaps: if `` is a data constructor, and not a H98 constructor, and `-fprint-explicit-foralls` is set, show the foralls explicitly? I'm not sure what `forall`s you're looking for. There isn't one in `MkDG`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 14:53:23 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 14:53:23 -0000 Subject: [GHC] #15674: GADT's displayed type is misleading In-Reply-To: <043.9b768266188379838903cb47df1bf014@haskell.org> References: <043.9b768266188379838903cb47df1bf014@haskell.org> Message-ID: <058.004dae5172fe2f4f0f275efbfedf0330@haskell.org> #15674: GADT's displayed type is misleading -------------------------------------+------------------------------------- Reporter: AntC | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Poor/confusing | (amd64) error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by monoidal): One way to see the difference is to define {{{ pattern PDG a = MkDG a pattern PDG2 a = MkDG2 a pattern PDF a = MkDF a }}} then `:i PDG PDG2 PDF` will show {{{ pattern PDG :: () => (a ~ Int) => Int -> DG a -- Defined at GA.hs:8:1 pattern PDG2 :: () => (a ~ Int) => a -> DG a -- Defined at GA.hs:9:1 pattern PDF :: Int -> DF Int -- Defined at GA.hs:10:1 }}} Should we show this and how? I don't know. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 15:07:58 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 15:07:58 -0000 Subject: [GHC] #15663: T9675 inexplicably regressed in allocations due to text submodule bump In-Reply-To: <046.4bbf528148a8a5d4e7c394f0e92d23d3@haskell.org> References: <046.4bbf528148a8a5d4e7c394f0e92d23d3@haskell.org> Message-ID: <061.221b9ec67e18f06b561488332cd6386c@haskell.org> #15663: T9675 inexplicably regressed in allocations due to text submodule bump -------------------------------------+------------------------------------- Reporter: bgamari | Owner: alpmestan Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alpmestan): With the tip of master from an hour or two ago (d90946cea1357d3e99805c27dab1e811785a4088): || bytes allocated || 678812960 || || max bytes used || 18871352 || || average bytes used || 8865483 || || max mem in use || 73400320 || Those numbers do almost all look a bit superior to the ones I got with the commit from early september, but certainly not by 20%. What am I missing? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 16:45:08 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 16:45:08 -0000 Subject: [GHC] #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 In-Reply-To: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> References: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> Message-ID: <058.fc8e3d3030cf33c932e0710a18105481@haskell.org> #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 -------------------------------------+------------------------------------- Reporter: noah | Owner: tdammers Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | accelerate,memory,compile Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: Compile-time | Test Case: accelerate performance bug | 1.2.0 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Interesting -- thanks for the smaller code. This is beginning to smell like #15253. See esp comment:22. `encodeVectorConst` has stuff like {{{ intHost $(hashQ "V16") <> encodeSingleConst t a <> encodeSingleConst t b <> etc }}} where `encodeSingleConst` is a giant `case`. So I think we may be over- doing case-of-case as in #15253. I've been trying to work on #15253 but keep getting distracted. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 16:45:51 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 16:45:51 -0000 Subject: [GHC] #13253: Exponential compilation time with RWST & ReaderT stack with `-02` In-Reply-To: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> References: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> Message-ID: <060.9c1d6b0bcadc9da710dc4b23281e82af@haskell.org> #13253: Exponential compilation time with RWST & ReaderT stack with `-02` -------------------------------------+------------------------------------- Reporter: phadej | Owner: bgamari, osa1 Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #15630 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): #15488 may be another case. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 17:00:38 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 17:00:38 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.a3a333c57148beb1e202a0e01c56e6e9@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > I would be careful with fl_after: we don't want to merely convert the part after the dot to an integer, because 1.2e3 and 1.02e3 are not the same. Excellent point. > Regarding desugaring to readRational "1e100", do I understand correctly programs would then have to parse 1e100 every time a floating literal is evaluated? No; it'll be floated to top level, and done once in the run of the program. > I would still prefer to forbid big exponents and call it a day. The difficulty is then you have to pick what is "big"; and one day it'll bite us. So we'll add a compiler flag, etc. It doesn't smell, to me, like something that should cause the program to be rejected. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 18:35:48 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 18:35:48 -0000 Subject: [GHC] #15675: Type operators in existential context cannot be parsed Message-ID: <048.82b49a5797d809055f4cfc780ae00441@haskell.org> #15675: Type operators in existential context cannot be parsed -------------------------------------+------------------------------------- Reporter: int-index | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 (Parser) | 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: -------------------------------------+------------------------------------- {{{#!haskell {-# LANGUAGE TypeOperators, MultiParamTypeClasses, ExistentialQuantification #-} class a + b data D1 = forall a b. (a + b) => D1 a b data D2 = forall a b. a + b => D2 a b }}} The declaration `D1` is accepted, while `D2` is rejected. There is no reason to reject `D2` except for shortcomings of the current grammar. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 19:33:32 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 19:33:32 -0000 Subject: [GHC] #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 In-Reply-To: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> References: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> Message-ID: <058.deb38b33ff0dab12f6c8b6870104b03d@haskell.org> #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 -------------------------------------+------------------------------------- Reporter: noah | Owner: tdammers Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | accelerate,memory,compile Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: Compile-time | Test Case: accelerate performance bug | 1.2.0 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Unfortunately, the `dump-simpl` output is too large to attach (~3 MiB), but almost all of it is indeed one huge `case` for `encodeVectorConst`, and it does fit the case-of-case pattern. So let me see if I understand this correctly: case-of-case is supposed to unwrap constructs of the shape `case (case a of b -> c) of d -> e` into `case a of b -> (case c of d -> e)`, and normally, the result would then reduce to something simpler than the original case-of-case construct - but in this case, it doesn't. Does that mean what we need is a way to tell when this is going to happen, and in those cases, skip the transform? And something I don't understand yet is how this relates to #15253 (adding support for type-level integers). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 19:35:24 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 19:35:24 -0000 Subject: [GHC] #15457: (~) and (!) are parsed inconsistently in types (plus documentation warts) In-Reply-To: <050.bc8c0ec5a857afbbf6fcb9729be2d57e@haskell.org> References: <050.bc8c0ec5a857afbbf6fcb9729be2d57e@haskell.org> Message-ID: <065.b6449482973824fba673ea29e26a0df5@haskell.org> #15457: (~) and (!) are parsed inconsistently in types (plus documentation warts) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: int-index Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 (Parser) | Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5180 Wiki Page: | -------------------------------------+------------------------------------- Changes (by int-index): * differential: => Phab:D5180 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 19:36:08 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 19:36:08 -0000 Subject: [GHC] #15675: Type operators in existential context cannot be parsed In-Reply-To: <048.82b49a5797d809055f4cfc780ae00441@haskell.org> References: <048.82b49a5797d809055f4cfc780ae00441@haskell.org> Message-ID: <063.043af7977fce52f7a4c884cacfb1e8b1@haskell.org> #15675: Type operators in existential context cannot be parsed -------------------------------------+------------------------------------- Reporter: int-index | Owner: int-index Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 (Parser) | Resolution: | 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): Phab:D5180 Wiki Page: | -------------------------------------+------------------------------------- Changes (by int-index): * owner: (none) => int-index * differential: => Phab:D5180 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 19:49:06 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 19:49:06 -0000 Subject: [GHC] #15672: Flags missing documentation. In-Reply-To: <045.958bbebd9adae560ab69fa02f124e3a9@haskell.org> References: <045.958bbebd9adae560ab69fa02f124e3a9@haskell.org> Message-ID: <060.190276ed95c4634aea267e3f1b4f9620@haskell.org> #15672: Flags missing documentation. -------------------------------------+------------------------------------- Reporter: merijn | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Sigh, we really need some way to check for these sorts of issues via CI. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 20:05:02 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 20:05:02 -0000 Subject: [GHC] #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 In-Reply-To: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> References: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> Message-ID: <058.db3b463a211cd11085e79c47c8cd3b8a@haskell.org> #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 -------------------------------------+------------------------------------- Reporter: noah | Owner: tdammers Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | accelerate,memory,compile Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: Compile-time | Test Case: accelerate performance bug | 1.2.0 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by alpmestan): * cc: alpmestan (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 20:45:27 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 20:45:27 -0000 Subject: [GHC] #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 In-Reply-To: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> References: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> Message-ID: <058.12e6920782a72887a23e50d07d47df15@haskell.org> #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 -------------------------------------+------------------------------------- Reporter: noah | Owner: tdammers Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | accelerate,memory,compile Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: Compile-time | Test Case: accelerate performance bug | 1.2.0 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Darn. I meant #13253, esp comment:22. Sorry about that. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 21:01:53 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 21:01:53 -0000 Subject: [GHC] #15665: Break up the stable pointer table In-Reply-To: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> References: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> Message-ID: <060.c0dc09370abb82f8f2c61e675d051b6c@haskell.org> #15665: Break up the stable pointer table -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #7670 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): How can we use entries as efficiently as possible? When allocating, we are always better off allocating into a block with a non-empty free list if we have one. But which one should we pick? If we pick one with a long free list, then we'll be able to stick with it for a while before we have to pick another, which should make allocation efficient. On the flip side, we may want to slowly concentrate live entries to be able to offer blocks to other threads. I don't feel like I have a clue how to manage that balance as yet. How should we focus our maintenance work? I'm not really sure. The simplest thing seems to be to just go through all the blocks in the order they were added and then go back to the beginning. We should probably keep "deletion pending" counts (updated with FAA) per block to avoid traversing blocks with very little maintenance work available--I believe setting the right threshold there should improve the worst-case block allocation behavior. Speaking of worst-case block allocation behavior.... Doing maintenance work (deleting marked-deleted blocks) only on stable pointer allocation and GC) seems to be pretty important for controlling complexity if we want to avoid licking. But it can cause trouble for certain patterns of allocation and deallocation. A thread could use up all its capacity, so all its free lists are empty, then delete almost all its stable pointers, leaving its free lists still empty. Allocating a new stable pointer could naively allocate a fresh block, which would be most unfortunate. We might want to find a block with lots of pending deletions, perform them all, and then continue. But maintaining a lock-free priority queue of blocks with lots of pending deletions sounds too hard. Hrm... Perhaps we can detect this situation with a global counter and use the garbage collector to clean it up? Not so pretty, but maybe. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 21:24:22 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 21:24:22 -0000 Subject: [GHC] #15665: Break up the stable pointer table In-Reply-To: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> References: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> Message-ID: <060.0e15c510a6650236ea20695ccb048867@haskell.org> #15665: Break up the stable pointer table -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #7670 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): Ah.... Another option: We could make the generation lists ''doubly linked''. This is much less expensive than I initially thought, because the links are intra-block, so two can fit in one word. We then add a many- pushers-one-popper maintenance list running through the target pointers of entries marked deleted. We'd keep a similar list of blocks that need more than a little maintenance. Now maintenance is much more effective! So effective that we don't need to do it on stable pointer allocation at all, unless the free list is empty. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 21:54:17 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 21:54:17 -0000 Subject: [GHC] #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` In-Reply-To: <046.74175c624c857c997e111eade5eabf30@haskell.org> References: <046.74175c624c857c997e111eade5eabf30@haskell.org> Message-ID: <061.3ad10874c57776ac20ab1e0b7500eeab@haskell.org> #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` -------------------------------------+------------------------------------- Reporter: rockbmb | Owner: rockbmb Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Core Libraries | Version: 8.4.3 Resolution: | Keywords: base, | Data.Fixed Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Bodigrim): > Among other things, this will cause programs that declare instances against these types to stop compiling if they do not enable the FlexibleInstances extension. As I noticed in a CLC mail thread(https://mail.haskell.org/pipermail/libraries/2018-September/028975.html), no code from Hackage derives such instances currently. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 22:01:37 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 22:01:37 -0000 Subject: [GHC] #15665: Break up the stable pointer table In-Reply-To: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> References: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> Message-ID: <060.c568fdb102a72bb3341cf404a3ba46b2@haskell.org> #15665: Break up the stable pointer table -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #7670 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): Deletion marking in the doubly linked regime: 1. Set the key pointer to the head of the maintenance list for this block. The garbage collector can realize this as within-block and thus not a heap pointer. 2. Use CAS to set the head of the maintenance list. On failure, go back to 1. If the thread marking deletion pauses between these steps, then a concurrent maintenance pass may fail to delete the entry. That's okay; it'll be cleaned up on the next pass. Even if the thread fails altogether, that just means the entry can never be reused. Note: the maintenance routine doesn't risk ABA problems because it's the only one popping. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Tue Sep 25 23:16:30 2018 From: ghc-devs at haskell.org (GHC) Date: Tue, 25 Sep 2018 23:16:30 -0000 Subject: [GHC] #12005: Constraint instances not shown in `:info` In-Reply-To: <051.e0728f3c0e56a4361f8b5139b7d323c2@haskell.org> References: <051.e0728f3c0e56a4361f8b5139b7d323c2@haskell.org> Message-ID: <066.9cdfff1df378dbbf4d1f24ca21cb886f@haskell.org> #12005: Constraint instances not shown in `:info` -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by harpocrates): You may be interested in `:info!` which returns a more reliably complete listing of instances. {{{ Prelude Data.Kind> :i Defer class Defer (p :: Constraint) where defer :: (p => r) -> r {-# MINIMAL defer #-} -- Defined at :2:1 instance [safe] Defer (() :: Constraint) -- Defined at :3:10 }}} The reason `instance Defer (() :: Constraint)` is filtered out from the output of `:info` is due to `GHC.getInfo`. Unless instructed to not filter its output, this last function will check that //all// names in an instance head are in scope before reporting it. Due to some wrinkles around constraint tuples, `() :: Constraint` doesn't satisfy this check. I consider this a bug. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 02:40:44 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 02:40:44 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.2915a731b1e943472ccb30ff887ec30c@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by JulianLeviston): * owner: (none) => JulianLeviston Comment: > The discussion may be confusing but the proposed change is actually quite simple. Just refactor one type and follow the type errors. Thanks for the direction. I can happily do that, but a) it wasn't clear to me that there *was* a proposed solution. It seemed like there was still quite a bit of a discussion going on. b) It'd be good to also know what on earth I'm doing when I do it, and it seemed to be getting deep into some really complicated territory that I felt was utterly beyond my interest or understanding. However, I'll add myself back as owner and when it's at a point where it seems there's consensus on a proposed solution, try to work out what that exactly means and continue the process of implementing a patch (it seems like it's got to consensus now). Thanks for your collective patience :) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 03:42:09 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 03:42:09 -0000 Subject: [GHC] #15664: Core Lint error In-Reply-To: <051.098b7dc938620399617aa57fbf6ce28a@haskell.org> References: <051.098b7dc938620399617aa57fbf6ce28a@haskell.org> Message-ID: <066.8cbf08bf05aa7e9c749d6864b60150d5@haskell.org> #15664: Core Lint error -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"4bdb10ca7ba14f00dd62270eadab4f93238227bc/ghc" 4bdb10ca/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="4bdb10ca7ba14f00dd62270eadab4f93238227bc" Fix Lint of unsaturated type families GHC allows types to have unsaturated type synonyms and type families, provided they /are/ saturated if you expand all type synonyms. TcValidity carefully checked this; see check_syn_tc_app. But Lint only did half the job, adn that led to Trac #15664. This patch just teaches Core Lint to be as clever as TcValidity. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 03:42:09 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 03:42:09 -0000 Subject: [GHC] #15673: heap overflow with Bits.shift and Integer In-Reply-To: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> References: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> Message-ID: <061.f1a5435400ffab26fff36b476b3987ac@haskell.org> #15673: heap overflow with Bits.shift and Integer -------------------------------------+------------------------------------- Reporter: mcmayer | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 Type of failure: GHC doesn't work | (amd64) at all | Test Case: Blocked By: | Blocking: Related Tickets: #14959 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Peyton Jones ): In [changeset:"d25fa45e377253cfbe26e410075dda9d58bb869c/ghc" d25fa45e/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="d25fa45e377253cfbe26e410075dda9d58bb869c" Fix constant-folding for Integer shifts In this patch commit 869f69fd4a78371c221e6d9abd69a71440a4679a Author: Simon Peyton Jones Date: Wed Dec 11 18:19:34 2013 +0000 Guarding against silly shifts we deal with silly shifts like (Sll 1 9223372036854775807). But I only dealt with primops that Int# and Word#. Alas, the same problem affects shifts of Integer, as Trac #15673 showed. Fortunately, the problem is easy to fix. }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 04:05:45 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 04:05:45 -0000 Subject: [GHC] #15673: heap overflow with Bits.shift and Integer In-Reply-To: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> References: <046.420a2b4d5cead8487c4a42ad1b028a53@haskell.org> Message-ID: <061.30a0023d02708c4b2f29a7391902407d@haskell.org> #15673: heap overflow with Bits.shift and Integer -------------------------------------+------------------------------------- Reporter: mcmayer | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: x86_64 | (amd64) Type of failure: GHC doesn't work | Test Case: at all | simplCore/should_compile/T15673 Blocked By: | Blocking: Related Tickets: #14959 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * testcase: => simplCore/should_compile/T15673 * status: new => closed * resolution: => fixed Comment: Thanks for reporting with nice repro case -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 04:06:31 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 04:06:31 -0000 Subject: [GHC] #15664: Core Lint error In-Reply-To: <051.098b7dc938620399617aa57fbf6ce28a@haskell.org> References: <051.098b7dc938620399617aa57fbf6ce28a@haskell.org> Message-ID: <066.a58bedd6a5b116f7f9e3cb87a0b19b45@haskell.org> #15664: Core Lint error -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: fixed | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: indexed- | types/should_compile/T15664 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * status: new => closed * testcase: => indexed-types/should_compile/T15664 * resolution: => fixed Comment: Excellent point. Fixed now. Thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 04:10:34 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 04:10:34 -0000 Subject: [GHC] #12005: Constraint instances not shown in `:info` In-Reply-To: <051.e0728f3c0e56a4361f8b5139b7d323c2@haskell.org> References: <051.e0728f3c0e56a4361f8b5139b7d323c2@haskell.org> Message-ID: <066.cf9d7fced4cc3f1ad8654005c95e4dc1@haskell.org> #12005: Constraint instances not shown in `:info` -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > I consider this a bug. I think I do too... `()` is really built-in syntax. Would you like to fix it? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 06:16:56 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 06:16:56 -0000 Subject: [GHC] #10990: Checking whether a default declaration is an instance of a defaultable typeclass is broken In-Reply-To: <045.0913ea572fc15f8b06002bba2c6402bf@haskell.org> References: <045.0913ea572fc15f8b06002bba2c6402bf@haskell.org> Message-ID: <060.ccf0d552feb33b5d033c8a43f8eba62d@haskell.org> #10990: Checking whether a default declaration is an instance of a defaultable typeclass is broken -------------------------------------+------------------------------------- Reporter: kanetw | Owner: (none) Type: bug | Status: closed Priority: low | Milestone: Component: Compiler (Type | Version: 7.10.2 checker) | Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by harpocrates): * status: new => closed * resolution: => fixed Comment: Fixed in 9a34bf1985035858ece043bf38b47b6ff4b88efb (I think, although I haven't compiled before and after to check). At the very least, that commit added test cases demonstrating this to be solved. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 07:26:21 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 07:26:21 -0000 Subject: [GHC] #13147: Formatting is broken in Exceptions section of GHC.Prim haddock In-Reply-To: <051.0397004541ccc405db287acf386a2c03@haskell.org> References: <051.0397004541ccc405db287acf386a2c03@haskell.org> Message-ID: <066.bdf846d636fea7da2bc6ede5312fd5c5@haskell.org> #13147: Formatting is broken in Exceptions section of GHC.Prim haddock -------------------------------------+------------------------------------- Reporter: chris-martin | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: Component: Prelude | Version: 8.0.1 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Documentation | Unknown/Multiple bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by harpocrates): * status: new => closed * resolution: => fixed Comment: This was fixed in 3e0712612a1e6c9b404e31b2a0175d8f9c5d443e. I've also added a comment in https://phabricator.haskell.org/D5167 warning against `{- ... -}` style comments in primops.txt.pp. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 08:55:25 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 08:55:25 -0000 Subject: [GHC] #15672: Flags missing documentation. In-Reply-To: <045.958bbebd9adae560ab69fa02f124e3a9@haskell.org> References: <045.958bbebd9adae560ab69fa02f124e3a9@haskell.org> Message-ID: <060.d800730f93cfef7a8406a56b3b9666f5@haskell.org> #15672: Flags missing documentation. -------------------------------------+------------------------------------- Reporter: merijn | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by merijn): Ah, I think I should've just added these to my previous 8.2 ticket: #14985 bgamari: It's actually even worse, because some of the `-fprint-` flags actually *had* documentation in previous version of the user guide, but were removed. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 09:00:02 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 09:00:02 -0000 Subject: [GHC] #12005: Constraint instances not shown in `:info` In-Reply-To: <051.e0728f3c0e56a4361f8b5139b7d323c2@haskell.org> References: <051.e0728f3c0e56a4361f8b5139b7d323c2@haskell.org> Message-ID: <066.4af3aa8cd5a1e09fc2f2abc32e16484e@haskell.org> #12005: Constraint instances not shown in `:info` -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: Component: Compiler | Version: 7.10.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5182 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * status: new => patch * differential: => Phab:D5182 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 09:08:05 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 09:08:05 -0000 Subject: [GHC] #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 In-Reply-To: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> References: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> Message-ID: <058.774ed18022562ea8d0351b43d2a5a74e@haskell.org> #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 -------------------------------------+------------------------------------- Reporter: noah | Owner: tdammers Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | accelerate,memory,compile Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: Compile-time | Test Case: accelerate performance bug | 1.2.0 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Ah, yes, that makes sense. A lot, actually. The situation fits the description like a glove - we have the nested cases, we have small expressions at the leaves, and we have the "-O2 triggers exponential blowup" part. However, the patch proposed in https://ghc.haskell.org/trac/ghc/ticket/13253#comment:24 does not make things any better - core size still blows up the same (114k terms), and compilation time is about the same. In fact, no matter what conditions I put in that particular spot, I always get the same result, suggesting that this particular program never hits the `OneOcc` branch at all. I still think case-of-case is the direction to investigate, but this particular patch does not seem to be the solution. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 09:55:08 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 09:55:08 -0000 Subject: [GHC] #15674: GADT's displayed type is misleading In-Reply-To: <043.9b768266188379838903cb47df1bf014@haskell.org> References: <043.9b768266188379838903cb47df1bf014@haskell.org> Message-ID: <058.b21d5db582b913847707600dd51a347f@haskell.org> #15674: GADT's displayed type is misleading -------------------------------------+------------------------------------- Reporter: AntC | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Poor/confusing | (amd64) error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AntC): Replying to [comment:3 goldfire]: > ... you can say `MkDG2 @Int` while you can't do that with `MkDG`. Their types are subtly different. > Aagh. My brain just blew a fuse. > > (And setting `-fprint-explicit-foralls` doesn't explicitly show the `forall` in `MkDG`, although it does in `MkDG2`. > > There is no `forall` in `MkDG`, which doesn't quantify over any variables. > Then I totally ignore the `a` in the `data DG a where ...`? (I don't mean its specific variable name, I mean the fact that `MkDG`'s return type is more specific that the `data`'s head, which is what makes it a GADT.) > > But `MkDG2`'s decl doesn't have an explicit `forall`, neither do I need `-XExplicitForAll` to compile it -- that's not implied by `-XGADTs`, surprisingly.) > > Your code does not contain an explicit `forall` in `MkDG2`. It contains an implicit one, implied by the presence of the type variable `a`. > For `MkDG2`, with `-fprint-explicit-foralls` `:i` shows `MkDG2 :: forall a. (a ~ Int) => a -> DG a` `:t` shows `MkDG2 :: Int -> DG Int` With `-fno-print-explicit-foralls` `:i` shows `MkDG2 :: (a ~ Int) => a -> DG a` `:t` shows `MkDG2 :: Int -> DG Int` Is that intended behaviour? It doesn't seem either internally consistent, nor consistent with your explanation: why is the `forall` appearing at all? Why is it appearing for `:i` but not `:t`? For `:t`, why is the `(a ~ Int)` not showing, even with verbosity to the max? `MkDG2`'s decl does have that explicitly, and it does make a (subtle) difference to the type. > > I'm not sure what `forall`s you're looking for. There isn't one in `MkDG`. What I'm looking for with these mind-blowingly similar-but- "subtly different" nuances is strong help from the compiler to navigate error messages when I get my types wrong. (Or rather, when I get wrong the types I'm importing from some library whose internals I don't really want to tangle with.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 10:28:15 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 10:28:15 -0000 Subject: [GHC] #15674: GADT's displayed type is misleading In-Reply-To: <043.9b768266188379838903cb47df1bf014@haskell.org> References: <043.9b768266188379838903cb47df1bf014@haskell.org> Message-ID: <058.393c18a774516e1d7f99e05bf6bfe02a@haskell.org> #15674: GADT's displayed type is misleading -------------------------------------+------------------------------------- Reporter: AntC | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Poor/confusing | (amd64) error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AntC): Replying to [comment:4 monoidal]: Thank you for the tip with defining patterns. It's the only way to reveal the differences here: {{{#!hs data family DG3 a data instance DG3 a where MkDG3 :: Int -> DG3 [Int] data family DG4 a data instance DG4 [a] where MkDG4 :: Int -> DG4 [Int] > :i PDG3 PDG4 pattern PDG3 :: () => (a ~ [Int]) => Int -> DG3 a pattern PDG4 :: () => (a ~ Int) => Int -> DG4 [a] }}} > Should we show this and how? I don't know. Now we have variable `a` showing. But according to Richard's message, it shouldn't be because it's not `forall`'d, neither explicitly nor implicitly (sigh). And indeed `:i` for the data constructors doesn't show `(a ~ ...)` even with full verbosity. My understanding of pattern synonyms is that they're built on top of data constructors. Then it seems back-to-front to use pattern synonyms to diagnose constructors. This ticket arose from a quest to understand `data` and `data instance`s from the ground up. I can't find any firm ground to start from, only quicksand. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 10:58:50 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 10:58:50 -0000 Subject: [GHC] #15676: Users guide: broken external links Message-ID: <043.832fbb81b7da989493fae3c23550cfef@haskell.org> #15676: Users guide: broken external links -------------------------------------+------------------------------------- Reporter: AntC | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Documentation | Version: 8.6.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Documentation Unknown/Multiple | bug Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Section 10.9 'Type Families' intro has external links to three papers, labelled [AssocDataTypes2005] [AssocTypeSyn2005] [TypeFamilies2008] The links point to http://www.cse.unsw.edu.au/~chak/papers/....html. I get Access Forbidden Error 403. Instead they could point to the microsoft research publications versions(?) (Each is co-authored by Chak and SPJ and others.) But beware some of those are draft versions. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 11:39:31 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 11:39:31 -0000 Subject: [GHC] #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 In-Reply-To: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> References: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> Message-ID: <058.d5544016c7941aa6789d591f188f4e91@haskell.org> #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 -------------------------------------+------------------------------------- Reporter: noah | Owner: tdammers Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | accelerate,memory,compile Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: Compile-time | Test Case: accelerate performance bug | 1.2.0 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by tdammers): * Attachment "Repro.hs" added. Further simplified reproduction case -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 11:41:39 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 11:41:39 -0000 Subject: [GHC] #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 In-Reply-To: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> References: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> Message-ID: <058.2a7066299668a54fd3fbe0c0377629d0@haskell.org> #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 -------------------------------------+------------------------------------- Reporter: noah | Owner: tdammers Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | accelerate,memory,compile Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: Compile-time | Test Case: accelerate performance bug | 1.2.0 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Further simplified reproduction case produces about 25,000 terms as-is, but only 7,000 when marking `encodeVectorConst` and `encodeSingleConst` as `NOINLINE`. I've removed the dependency on TH, some extensions, and all other modules except the `.Type` one. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 12:22:41 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 12:22:41 -0000 Subject: [GHC] #15677: Valid hole fits and GADT type variable names Message-ID: <050.cc002e198458d754a5b83d9b7f8d65ce@haskell.org> #15677: Valid hole fits and GADT type variable names -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.6.1 Keywords: TypedHoles, | Operating System: Unknown/Multiple GADTs | Architecture: | Type of failure: Poor/confusing Unknown/Multiple | error message Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Consider the following code: {{{#!hs {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} module Foo where import Data.Kind data HList :: [Type] -> Type where HNil :: HList '[] HCons :: x -> HList xs -> HList (x:xs) foo :: HList a -> HList a foo HNil = HNil foo (HCons (b :: bType) bs) = HCons _ bs }}} Here is the suggestion that the typed hole in `foo` provides: {{{ $ /opt/ghc/8.6.1/bin/ghc Bug.hs [1 of 1] Compiling Foo ( Bug.hs, Bug.o ) Bug.hs:16:37: error: • Found hole: _ :: x Where: ‘x’ is a rigid type variable bound by a pattern with constructor: HCons :: forall x (xs :: [*]). x -> HList xs -> HList (x : xs), in an equation for ‘foo’ at Bug.hs:16:6-26 • In the first argument of ‘HCons’, namely ‘_’ In the expression: HCons _ bs In an equation for ‘foo’: foo (HCons (b :: bType) bs) = HCons _ bs • Relevant bindings include bs :: HList xs (bound at Bug.hs:16:25) b :: x (bound at Bug.hs:16:13) foo :: HList a -> HList a (bound at Bug.hs:15:1) Constraints include a ~ (x : xs) (from Bug.hs:16:6-26) Valid hole fits include b :: x (bound at Bug.hs:16:13) | 16 | foo (HCons (b :: bType) bs) = HCons _ bs | ^ }}} One thing immediately stands out here: the hole has type `x`, but `x` appears no where in the definition of `foo`! I had expected this suggestion to mention `bType`, since I went through the effort of declaring `b` to have that type through a pattern signature, but GHC instead uses types from the definition of the `HCons` constructor itself. This seems less than ideal, since one would expect GHC to only ever mention types that are lexically in scope at a particular definition site. One thing which complicates this idea is that there can be multiple in- scope type variables that all refer to the same type. For instance, if I define this function: {{{#!hs bar :: HList a -> HList a -> HList a bar HNil HNil = HNil bar (HCons (b :: bType) bs) (HCons (c :: cType) cs) = HCons _ bs }}} What should the suggested type of the hole be: `bType`, or `cType`? Either choice is equally valid. After talking with Tritlo and simonpj about this, we came to the consensus that we should just pick one of the type variables to report at the top of the error message: {{{ • Found hole: _ :: bType }}} And then later in the message, include any type variable synonyms that have been brought into scope (via pattern signatures or otherwise). I imagine this might look something like: {{{ • Type variable synonyms include `cType` equals `bType` }}} This is quite similar to an existing feature of valid hole fits where we report `Constraints include`. (Indeed, we briefly considered just reporting these type variable synonyms as explicit equality constraints, but doing so would be somewhat misleading, since that's not how pattern signatures actually work in practice.) One implementation challenge is to figure out how to construct a mapping from `x` to `bType`. One place where inspiration can be drawn from is the `ATyVar` constructor of `TcTyThing`: {{{#!hs data TcTyThing = ... | ATyVar Name TcTyVar -- The type variable to which the lexically scoped type -- variable is bound. We only need the Name -- for error-message purposes; it is the corresponding -- Name in the domain of the envt }}} `ATyVar` already stores a "reverse mapping" of sorts to give better a more accurate `Name` in the event that it is pretty-printed, which is quite similar to what we need to do with `x` and `bType`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 12:35:39 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 12:35:39 -0000 Subject: [GHC] #15678: Provide the provenance of unification variables in error messages when possible Message-ID: <050.e92fa89afda7a29fc4016ed9aed303a9@haskell.org> #15678: Provide the provenance of unification variables in error messages when possible -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.6.1 (Type checker) | Keywords: TypeErrors | Operating System: Unknown/Multiple Architecture: | Type of failure: Poor/confusing Unknown/Multiple | error message Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Consider the following code: {{{#!hs module Foo where x :: Int x = const 42 _ }}} When compiles, this gives the following suggestion: {{{ $ /opt/ghc/8.6.1/bin/ghc Bug.hs [1 of 1] Compiling Foo ( Bug.hs, Bug.o ) Bug.hs:4:14: error: • Found hole: _ :: b0 Where: ‘b0’ is an ambiguous type variable • In the second argument of ‘const’, namely ‘_’ In the expression: const 42 _ In an equation for ‘x’: x = const 42 _ • Relevant bindings include x :: Int (bound at Bug.hs:4:1) Valid hole fits include x :: Int (bound at Bug.hs:4:1) otherwise :: Bool (imported from ‘Prelude’ at Bug.hs:1:8-10 (and originally defined in ‘GHC.Base’)) False :: Bool (imported from ‘Prelude’ at Bug.hs:1:8-10 (and originally defined in ‘GHC.Types’)) True :: Bool (imported from ‘Prelude’ at Bug.hs:1:8-10 (and originally defined in ‘GHC.Types’)) lines :: String -> [String] (imported from ‘Prelude’ at Bug.hs:1:8-10 (and originally defined in ‘base-4.12.0.0:Data.OldList’)) unlines :: [String] -> String (imported from ‘Prelude’ at Bug.hs:1:8-10 (and originally defined in ‘base-4.12.0.0:Data.OldList’)) (Some hole fits suppressed; use -fmax-valid-hole-fits=N or -fno- max-valid-hole-fits) | 4 | x = const 42 _ | ^ }}} One thing that's rather ugly about this is the use of the type `b0`. What exactly //is// `b0` anyway? The only hint that the error message gives is that it's an ambiguous type variable. But that's not terribly helpful to figure out where `b0` arises from. Ambiguous type variables like this one arise quite frequently when writing Haskell code, and it can often take some sleuthing to figure out why they pop up. simonpj had one suggestion for making ambiguous type variables less confusing: report their provenance whenever possible. There is one notable example of a situation where it's simple to explain from where exactly in the source code a unification variable originates: function applications. In particular, the program above applies the function `const 42` to `_`, which means that the type of `const 42` is instantiated to be `b0 -> Int`. Let's report this! Something like: {{{ • Found hole: _ :: b0 Where: ‘b0’ is an ambiguous type variable Arising from an application of (const 42 :: b0 -> Int) In the expression: const 42 _ }}} This would go a long way to clearing up what GHC is thinking when it reports these ambiguous type variable errors. While we can't easily report the provenance of //every// ambiguous type variables, those arising from function applications are quite doable. We might be able to reuse the `CtOrigin` machinery (or take heavy inspiration from it) to accomplish this feat. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 12:46:09 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 12:46:09 -0000 Subject: [GHC] #15678: Provide the provenance of unification variables in error messages when possible In-Reply-To: <050.e92fa89afda7a29fc4016ed9aed303a9@haskell.org> References: <050.e92fa89afda7a29fc4016ed9aed303a9@haskell.org> Message-ID: <065.6a3752b0c2b6806cc71e60352aeb38b5@haskell.org> #15678: Provide the provenance of unification variables in error messages when possible -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler (Type | Version: 8.6.1 checker) | Resolution: | Keywords: TypeErrors Operating System: Unknown/Multiple | Architecture: Type of failure: Poor/confusing | Unknown/Multiple error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I think this would be great. One small extra piece. When unifying `alpha ~ beta` we could be careful to eliminate the one with the least-informative provenance, if the unification can be solved either way round. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 12:51:22 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 12:51:22 -0000 Subject: [GHC] #15679: Use String rather than [Char] where possible Message-ID: <046.3bb9ac10a15ae4c2232a034af0945dff@haskell.org> #15679: Use String rather than [Char] where possible -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.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: -------------------------------------+------------------------------------- Try this in GHCi {{{ Prelude> :t "foo" "foo" :: [Char] }}} It would be better to say {{{ "foo" :: String }}} Why don't we? Because of this in `TysWiredIn` {{{ stringTy :: Type stringTy = mkListTy charTy -- convenience only }}} That is, where GHC needs `String` is uses `stringTy` which is just `[Char]`. How to fix? Two ways: 1. Make `String` into a "wired-in type". That's not hard, but it increases the number of wired-in types, which is generally undesirable. 2. Make `String` into a "knonw-key name", and look it up in the type environment on the (few) occasions where we need `stringTy`. That's a little harder -- notably `hsLitType` would become monadic -- but not difficult. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 12:52:22 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 12:52:22 -0000 Subject: [GHC] #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 In-Reply-To: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> References: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> Message-ID: <058.21b0dd2fcb695d802a8e7e556cd5b09e@haskell.org> #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 -------------------------------------+------------------------------------- Reporter: noah | Owner: tdammers Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | accelerate,memory,compile Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: Compile-time | Test Case: accelerate performance bug | 1.2.0 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Here's what the updated example looks like after desugaring: {{{ encodeIntegralConst encodeIntegralConst = \ @ t_aaZ7 ds_dbct x_aaUu -> case ds_dbct of { TypeInt co_aaZJ _ -> <> $fSemigroupBuilder (intHost (I# 200#)) (intHost (x_aaUu `cast` )); TypeInt8 co_aaZR _ -> <> $fSemigroupBuilder (intHost (I# 208#)) (int8 (x_aaUu `cast` )); TypeInt16 co_ab00 _ -> <> $fSemigroupBuilder (intHost (I# 216#)) (int16Host (x_aaUu `cast` )); -- ... } -- RHS size: {terms: 45, types: 57, coercions: 14, joins: 0/0} encodeFloatingConst encodeFloatingConst = \ @ t_aaY8 ds_db5K ds_db5L -> case ds_db5K of { TypeHalf co_aaYn _ -> <> $fSemigroupBuilder (intHost (I# 500#)) (word16Host (((ds_db5L `cast` ) `cast` ) `cast` )); TypeFloat co_aaYC _ -> <> $fSemigroupBuilder (intHost (I# 510#)) (floatHost (ds_db5L `cast` )); -- ... } -- RHS size: {terms: 10, types: 12, coercions: 0, joins: 0/0} encodeNumConst encodeNumConst = \ @ t_ab24 ds_dbjh -> case ds_dbjh of { IntegralNumType t_aaUs -> encodeIntegralConst t_aaUs; FloatingNumType t_aaUt -> encodeFloatingConst t_aaUt } -- RHS size: {terms: 5, types: 0, coercions: 0, joins: 0/0} $trModule $trModule = Module (TrNameS "main"#) (TrNameS "Repro"#) -- RHS size: {terms: 11, types: 4, coercions: 0, joins: 0/0} fromBool fromBool = \ ds_dbjn -> case ds_dbjn of { False -> fromInteger $fNumWord8 0; True -> fromInteger $fNumWord8 1 } -- RHS size: {terms: 46, types: 57, coercions: 13, joins: 0/0} encodeNonNumConst encodeNonNumConst = \ @ t_ab2w ds_dbjr x_aaUn -> case ds_dbjr of { TypeBool co_ab2I _ -> <> $fSemigroupBuilder (intHost (I# 0#)) (word8 (fromBool (x_aaUn `cast` ))); TypeChar co_ab2N _ -> <> $fSemigroupBuilder (intHost (I# 100#)) (charUtf8 (x_aaUn `cast` )); -- ... } -- RHS size: {terms: 10, types: 12, coercions: 0, joins: 0/0} encodeSingleConst encodeSingleConst = \ @ t_ab3l ds_dblJ -> case ds_dblJ of { NumSingleType t_aaUe -> encodeNumConst t_aaUe; NonNumSingleType t_aaUf -> encodeNonNumConst t_aaUf } -- RHS size: {terms: 47, types: 52, coercions: 4, joins: 0/0} encodeVectorConst encodeVectorConst = \ @ t_ab3r ds_dblP ds_dblQ -> case ds_dblP of { __DEFAULT -> patError "Repro.hs:(29,1)-(30,133)|function encodeVectorConst"#; Vector2Type @ a_ab3G co_ab3H t_aaUg -> case ds_dblQ `cast` of { V2 a_aaUh b_aaUi -> <> $fSemigroupBuilder (intHost (I# 2#)) (<> $fSemigroupBuilder (encodeSingleConst t_aaUg a_aaUh) (encodeSingleConst t_aaUg b_aaUi)) }; Vector3Type @ a_ab3X co_ab3Y t_aaUj -> case ds_dblQ `cast` of { V3 a_aaUk b_aaUl c_aaUm -> <> $fSemigroupBuilder (intHost (I# 3#)) (<> $fSemigroupBuilder (encodeSingleConst t_aaUj a_aaUk) (<> $fSemigroupBuilder (encodeSingleConst t_aaUj b_aaUl) (encodeSingleConst t_aaUj c_aaUm))) } } }}} After inlining, the pattern that we get is something like: {{{ case a of A1 b1 -> case b1 of B1 c -> case c of ... A2 b2 -> case b2 of B2 d -> case d of ... }}} But this not the case-of-case pattern at all! It's just a very large nested `case`, resulting from excessive inlining, and the structure of the whole thing is such that every path through the tree of `case`s is unique at every step, so statically analyzing the `case` branches does not lead to any simplification. In fact, we can achieve the same kind of blowup with the following example code (no dependencies whatsoever): {{{#!haskell module SimpleBlowup where data Foo = Foo1 Bar | Foo2 Bar | Foo3 Bar | Foo4 Bar | Foo5 Bar | Foo6 Bar | Foo7 Bar | Foo8 Bar | Foo9 Bar | Foo10 Bar | Foo11 Bar | Foo12 Bar | Foo13 Bar | Foo14 Bar | Foo15 Bar | Foo16 Bar | Foo17 Bar | Foo18 Bar | Foo19 Bar | Foo20 Bar data Bar = Bar1 Baz | Bar2 Baz | Bar3 Baz | Bar4 Baz data Baz = Baz1 Int | Baz2 Int | Baz3 Int | Baz4 Int | Baz5 Int | Baz6 Int | Baz7 Int | Baz8 Int | Baz9 Int | Baz10 Int | Baz11 Int | Baz12 Int | Baz13 Int | Baz14 Int | Baz15 Int | Baz16 Int | Baz17 Int | Baz18 Int | Baz19 Int | Baz20 Int {-#INLINE encodeFoo #-} encodeFoo :: Foo -> Int encodeFoo (Foo1 bar) = encodeBar bar + 1 encodeFoo (Foo2 bar) = encodeBar bar + 2 encodeFoo (Foo3 bar) = encodeBar bar + 3 encodeFoo (Foo4 bar) = encodeBar bar + 4 encodeFoo (Foo5 bar) = encodeBar bar + 5 encodeFoo (Foo6 bar) = encodeBar bar + 6 encodeFoo (Foo7 bar) = encodeBar bar + 7 encodeFoo (Foo8 bar) = encodeBar bar + 8 encodeFoo (Foo9 bar) = encodeBar bar + 9 encodeFoo (Foo10 bar) = encodeBar bar + 10 encodeFoo (Foo11 bar) = encodeBar bar + 11 encodeFoo (Foo12 bar) = encodeBar bar + 12 encodeFoo (Foo13 bar) = encodeBar bar + 13 encodeFoo (Foo14 bar) = encodeBar bar + 14 encodeFoo (Foo15 bar) = encodeBar bar + 15 encodeFoo (Foo16 bar) = encodeBar bar + 16 encodeFoo (Foo17 bar) = encodeBar bar + 17 encodeFoo (Foo18 bar) = encodeBar bar + 18 encodeFoo (Foo19 bar) = encodeBar bar + 19 encodeFoo (Foo20 bar) = encodeBar bar + 20 {-#INLINE encodeBar #-} encodeBar :: Bar -> Int encodeBar (Bar1 baz) = encodeBaz baz + 1 encodeBar (Bar2 baz) = encodeBaz baz + 2 encodeBar (Bar3 baz) = encodeBaz baz + 3 encodeBar (Bar4 baz) = encodeBaz baz + 4 {-#INLINE encodeBaz #-} encodeBaz :: Baz -> Int encodeBaz (Baz1 i) = encodeInt i + 1 encodeBaz (Baz2 i) = encodeInt i + 2 encodeBaz (Baz3 i) = encodeInt i + 3 encodeBaz (Baz4 i) = encodeInt i + 4 encodeBaz (Baz5 i) = encodeInt i + 5 encodeBaz (Baz6 i) = encodeInt i + 6 encodeBaz (Baz7 i) = encodeInt i + 7 encodeBaz (Baz8 i) = encodeInt i + 8 encodeBaz (Baz9 i) = encodeInt i + 9 encodeBaz (Baz10 i) = encodeInt i + 10 encodeBaz (Baz11 i) = encodeInt i + 11 encodeBaz (Baz12 i) = encodeInt i + 12 encodeBaz (Baz13 i) = encodeInt i + 13 encodeBaz (Baz14 i) = encodeInt i + 14 encodeBaz (Baz15 i) = encodeInt i + 15 encodeBaz (Baz16 i) = encodeInt i + 16 encodeBaz (Baz17 i) = encodeInt i + 17 encodeBaz (Baz18 i) = encodeInt i + 18 encodeBaz (Baz19 i) = encodeInt i + 19 encodeBaz (Baz20 i) = encodeInt i + 20 {-#INLINE encodeInt #-} encodeInt :: Int -> Int encodeInt i = (i * 47 + 31) `mod` 17 }}} This blows up Core size to about 45,000 terms. Changing all the `INLINE`s to `NOINLINE` however, we only get 1,200 terms. So AFAICT, this isn't case-of-case being overly eager, it's just GHC obediently honoring those `INLINE` pragmas, which legit produces a lot of Core, and due to the structure of the things being inlined, the usual crossing-off of obvious non-matches isn't possible. This is probably not something you encounter a lot in the wild, because in order to trigger this in a noticable way, the following conditions must be met: - Several layers of function applications forming a nested pattern-match - ...each of them marked `INLINE` - ...and essentially consisting of a pattern-matching construct with many (tens or more) branches I presume that this would typically involve nested data types with many constructors on multiple levels. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 13:09:56 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 13:09:56 -0000 Subject: [GHC] #15481: TH fails to recover from reifyFixity with -fexternal-interpreter In-Reply-To: <050.5475c911201fc232088c3ce363d7a784@haskell.org> References: <050.5475c911201fc232088c3ce363d7a784@haskell.org> Message-ID: <065.7203d1613e318a33b82a3d8bf7012acc@haskell.org> #15481: TH fails to recover from reifyFixity with -fexternal-interpreter -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: RemoteGHCi Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * cc: simonmar (added) Comment: Generally, in GHC's type checker monad we can 1. Add an error into a bag of errors to be reported later 2. Raise an exception in the monad (1) and (2) are independent: * You can add an error without raising an exception, via `addErrTc`, thereby allowing multiple errors to be reported. * You can add an error and raise an exception; that's what `failTc` does. * You can raise an exception without adding an error; but that would be very confusing and GHC never does that. The expected behaviour of `Language.Haskell.TH.recover` is, I believe, that it should invoke the recovery action if either (1) or (2) has happened; that is, even if execution finishes without raising an exception, but with errors in the error bag, we should invoke the recovery action. And indeed that is what happens: * `Language.Haskell.TH.recover` invokes `qRecover` in the `Quasi` monad. * The instance for `Quasi TcM` in `TcSplice` has {{{ qRecover recover main = tryTcDiscardingErrs recover main }}} * And indeed `tryTcDiscardingErrors` invokes the recovery action if there are accumulated error messages, even if no exception is raised. So it must be something to do with the external interpreter. Let's fix that, rather than messing with the entirely-innocent `qReifyFixity`. Simon M, any ideas? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 13:26:00 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 13:26:00 -0000 Subject: [GHC] #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 In-Reply-To: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> References: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> Message-ID: <058.e02f2adc8e3a0aa0e81e4fa9a563e2be@haskell.org> #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 -------------------------------------+------------------------------------- Reporter: noah | Owner: tdammers Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | accelerate,memory,compile Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: Compile-time | Test Case: accelerate performance bug | 1.2.0 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > So AFAICT, this isn't case-of-case being overly eager, it's just GHC obediently honoring those `INLINE` pragmas, which legit produces a lot of Core Yes you are right about that. * But why did it not happen in earlier versions of GHC, which should have been equally obedient? I'm worried that this kind of blow-up can happen even without INLINE pragmas: {{{ f1 x = if x>0 then 0 else 1 f2 x = if x>0 then f1 (x-1) else f1 (x-2) f3 x = if x>0 then f2 (x-1) else f2 (x-2) f4 x = if x>0 then f3 (x-1) else f3 (x-2) h x = f x }}} Now * `f4` looks small, so we could inline it at its call in `h` * Now we have two calls to `f3`; but `f3` is small so we can inline them both. * Now we have four calls to `f2`; but `f2` is small so we can inline them all. ...and so on. This happens if we inline "bottom up". If instead we did "top-down" we might inline `f1` into `f2`, and `f2` into `f3`... but then `f3` would look big so we would not inline it into `f4`. But we are clearly walking close to the precipice. Who writes such function nests? Well, `accelerate` perhaps (but see the above question). But they ''also'' arise naturally from the join points created from deeply-nested case-of-case transforms, and that's the relevance of the case-of-case stuff. So we have two threads to pursue * Why does `accelerate` have INLINE pragmas on these nested functions? Obedience to those pragmas will certainly cause trouble. * How can we avoid blow-up when (absent INLINE pragmas) such definition nests occur naturally? This is the thing I've been thinking about. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 14:14:55 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 14:14:55 -0000 Subject: [GHC] #15481: TH fails to recover from reifyFixity with -fexternal-interpreter In-Reply-To: <050.5475c911201fc232088c3ce363d7a784@haskell.org> References: <050.5475c911201fc232088c3ce363d7a784@haskell.org> Message-ID: <065.fbc0a70ac1311f2a4601c5e028280bd2@haskell.org> #15481: TH fails to recover from reifyFixity with -fexternal-interpreter -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: simonmar Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: RemoteGHCi Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonmar): * owner: (none) => simonmar Comment: It looks like the external-interpreter implementation of `qRecover` only runs the handler in the exception case, not in the case where an error was added with `addErrTcM`. Probably just a misunderstanding on my part of how it was supposed to work. I'll see if I can fix this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 14:19:22 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 14:19:22 -0000 Subject: [GHC] #15665: Break up the stable pointer table In-Reply-To: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> References: <045.ce0b5f54be9c00d5592041df27ec0ecf@haskell.org> Message-ID: <060.21176584735e4ad9311e1e982657b062@haskell.org> #15665: Break up the stable pointer table -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #7670 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by dfeuer): This stream of consciousness has gotten a bit long. So here's a bit of a consolidation of my proposed implementation: Stable pointers are managed in blocks. Each block belongs (at any given time, anyway) to at most one capability. That capability is the only one that allocates stable pointers in the block. Each block contains a table of entries, as many non-free lists (doubly linked stacks) as there are GC generations, a free list (singly linked), and a maintenance list (a read stack and a write stack, each singly linked). An entry consists of a pointer and two half-word fields. An entry cycles through three states: live, marked deleted, and free. In any non-free entry, the half-word fields point to the previous and next non-free entries in the generation. In a live entry, the pointer points into the Haskell heap. In a marked-deleted entry, the pointer points to the next entry in the maintenance list. In a free entry, the pointer points to the next entry in the free list, and the half-word fields are unused. === Allocation into a block If there is an entry on the free list, remove it from the free list, populate its pointer, and add it to the non-free list in its generation. Otherwise, perform a maintenance step to free an entry and use it. === Deletion To delete a block, add it to the maintenance list. This can be done with a CAS loop by any thread. === Maintenance If the read end of the maintenance list is empty, use an exchange operation to remove the write end and then install it as the read end (we don't care too much about order). Pop an entry off the read end, physically delete it from the non-free list, and (unless it is needed immediately) as it to the free list. === Garbage collection Traverse the read end of the maintenance list performing maintenance. Exchange out the write end and do the same. The maintenance list may continue to grow during collection; that will be cleaned up later. The purpose of performing maintenance during GC is to avoid having to traverse the same deleted entries over and over when there isn't much stable pointer allocation. Traverse the non-free list for the current generation. Do whatever's needed to mark and update the pointers in live entries. === Block management Most of the open questions are here. I'll leave them out of this comment. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 15:24:38 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 15:24:38 -0000 Subject: [GHC] #15383: T3171 doesn't terminate with Interrupted message on Darwin In-Reply-To: <046.1d648bf17453b21fb35b42043bd02c26@haskell.org> References: <046.1d648bf17453b21fb35b42043bd02c26@haskell.org> Message-ID: <061.f4f0cffdf6087c3370a1b7066785464e@haskell.org> #15383: T3171 doesn't terminate with Interrupted message on Darwin ---------------------------------+-------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: MacOS X | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15463 | Differential Rev(s): Wiki Page: | ---------------------------------+-------------------------------------- Comment (by bgamari): Indeed this also appears to happen ([[https://circleci.com/gh/ghc/ghc/9913|occasionally]]) on Fedora/amd64. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 16:49:18 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 16:49:18 -0000 Subject: [GHC] #15664: Core Lint error In-Reply-To: <051.098b7dc938620399617aa57fbf6ce28a@haskell.org> References: <051.098b7dc938620399617aa57fbf6ce28a@haskell.org> Message-ID: <066.9e7fd21919a5880131b47a8483cc3a06@haskell.org> #15664: Core Lint error -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: fixed | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: indexed- | types/should_compile/T15664 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by Iceland_jack: Old description: > From > [https://github.com/VictorCMiraldo/victorcmiraldo.github.io/blob/845e74b59aee5a322b6cdd1e45355db16a30d8af/data/hask2018_draft.pdf > Generic Programming of All Kinds], > > {{{#!hs > {-# Language RankNTypes, TypeOperators, DataKinds, PolyKinds, GADTs, > TypeInType, TypeFamilies #-} > > {-# Options_GHC -dcore-lint #-} > > -- > https://github.com/VictorCMiraldo/victorcmiraldo.github.io/blob/845e74b59aee5a322b6cdd1e45355db16a30d8af/data/hask2018_draft.pdf > > import Data.Kind > import GHC.Exts > import Data.Function > > data Ctx :: Type -> Type where > E :: Ctx(Type) > (:&:) :: a -> Ctx(as) -> Ctx(a -> as) > > type family > Apply(kind) (f :: kind) (ctx :: Ctx kind) :: Type where > Apply(Type) a E = a > Apply(k -> ks) f (a:&:as) = Apply(ks) (f a) as > > data ApplyT kind :: kind -> Ctx(kind) -> Type where > A0 :: a > -> ApplyT(Type) a E > > AS :: ApplyT(ks) (f a) as > -> ApplyT(k -> ks) f (a:&:as) > > type f ~> g = (forall xx. f xx -> g xx) > > unravel :: ApplyT(k) f ~> Apply(k) f > unravel (A0 a) = a > unravel (AS fa) = unravel fa > }}} > > gives a core lint error > > {{{ > $ ghci -ignore-dot-ghci hs/443.hs > /tmp/bug.log > }}} New description: From [https://dl.acm.org/citation.cfm?id=3242745 Generic Programming of All Kinds], {{{#!hs {-# Language RankNTypes, TypeOperators, DataKinds, PolyKinds, GADTs, TypeInType, TypeFamilies #-} {-# Options_GHC -dcore-lint #-} import Data.Kind import GHC.Exts import Data.Function data Ctx :: Type -> Type where E :: Ctx(Type) (:&:) :: a -> Ctx(as) -> Ctx(a -> as) type family Apply(kind) (f :: kind) (ctx :: Ctx kind) :: Type where Apply(Type) a E = a Apply(k -> ks) f (a:&:as) = Apply(ks) (f a) as data ApplyT kind :: kind -> Ctx(kind) -> Type where A0 :: a -> ApplyT(Type) a E AS :: ApplyT(ks) (f a) as -> ApplyT(k -> ks) f (a:&:as) type f ~> g = (forall xx. f xx -> g xx) unravel :: ApplyT(k) f ~> Apply(k) f unravel (A0 a) = a unravel (AS fa) = unravel fa }}} gives a core lint error {{{ $ ghci -ignore-dot-ghci hs/443.hs > /tmp/bug.log }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 16:50:49 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 16:50:49 -0000 Subject: [GHC] #15664: Core Lint error In-Reply-To: <051.098b7dc938620399617aa57fbf6ce28a@haskell.org> References: <051.098b7dc938620399617aa57fbf6ce28a@haskell.org> Message-ID: <066.141b6dce18c1676ec9ae4cb7df0f38e8@haskell.org> #15664: Core Lint error -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: fixed | Keywords: TypeInType Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: indexed- | types/should_compile/T15664 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): Thanks -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 18:44:28 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 18:44:28 -0000 Subject: [GHC] #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 In-Reply-To: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> References: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> Message-ID: <058.51963abce5bbbc5287586b7275507a26@haskell.org> #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 -------------------------------------+------------------------------------- Reporter: noah | Owner: tdammers Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | accelerate,memory,compile Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: Compile-time | Test Case: accelerate performance bug | 1.2.0 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): > But why did it not happen in earlier versions of GHC, which should have been equally obedient? Do we have evidence of this? So far, I have only tested `accelerate` against 8.4 and HEAD, and both show the blow-up. AFAICT, the `accelerate` situation is rather specific, I don't see people come up with code like this a lot, not with the explicit inlining anyway. Which leaves those situations where GHC decides to inline on its own; but for those cases, my guess would be that the explanation why this happens now and not before is because we simply optimize more aggressively now. I'll run `accelerate` and the reproduction case against an older GHC just to double check, but I'd expect things to still blow up. > Why does accelerate have INLINE pragmas on these nested functions? Obedience to those pragmas will certainly cause trouble. Well, what do you know, there's already a ticket: https://github.com/AccelerateHS/accelerate/issues/428. I took the liberty to comment on that, so hopefully we'll get some feedback on the matter from there. > How can we avoid blow-up when (absent INLINE pragmas) such definition nests occur naturally? This is the thing I've been thinking about. So essentially this boils down to figuring out whether inlining is going to pay off; and the challenge is that just looking at the size before and after inlining isn't going to be enough, because normally we expect the large post-inlining (or post-case-of-case-transform) core to be large but sufficiently shrinkable (by crossing off obvious non-matches). So what we would need is a way to tell whether our code, once blown up, will indeed be shrinkable, either before we blow it up, or right after (but before any further transformations, because those are now potentially expensive). This is probably something that should be addressed via #13253 though; it's not what causes the problem in this case here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 19:25:02 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 19:25:02 -0000 Subject: [GHC] #13253: Exponential compilation time with RWST & ReaderT stack with `-02` In-Reply-To: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> References: <045.b3c468c50b4e8e33ee0981a3ab0c6b4b@haskell.org> Message-ID: <060.9762a6776302038a1892507dc8a531a9@haskell.org> #13253: Exponential compilation time with RWST & ReaderT stack with `-02` -------------------------------------+------------------------------------- Reporter: phadej | Owner: bgamari, osa1 Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #15630 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): #15488 is not a case of this particular problem, but it does provide some related insights. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 19:41:54 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 19:41:54 -0000 Subject: [GHC] #15669: T7040_ghci has a suspicious testcase failure In-Reply-To: <044.9d1f4438ef24291d12c76127056f4c24@haskell.org> References: <044.9d1f4438ef24291d12c76127056f4c24@haskell.org> Message-ID: <059.9252a770a536287eede5eababc88e506@haskell.org> #15669: T7040_ghci has a suspicious testcase failure ---------------------------------+---------------------------------------- Reporter: Phyx- | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Windows | Architecture: Unknown/Multiple Type of failure: None/Unknown | Test Case: T7040_ghci Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+---------------------------------------- Changes (by Phyx-): * priority: normal => high -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 20:37:41 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 20:37:41 -0000 Subject: [GHC] #15481: TH fails to recover from reifyFixity with -fexternal-interpreter In-Reply-To: <050.5475c911201fc232088c3ce363d7a784@haskell.org> References: <050.5475c911201fc232088c3ce363d7a784@haskell.org> Message-ID: <065.51f15896c2b09c4d266c574a4c60a50f@haskell.org> #15481: TH fails to recover from reifyFixity with -fexternal-interpreter -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: simonmar Type: bug | Status: patch Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: RemoteGHCi Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5185 Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonmar): * status: new => patch * differential: => Phab:D5185 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Wed Sep 26 23:01:31 2018 From: ghc-devs at haskell.org (GHC) Date: Wed, 26 Sep 2018 23:01:31 -0000 Subject: [GHC] #8809: Prettier error messages? In-Reply-To: <047.4dbdad421fcd945584d210433034ccb5@haskell.org> References: <047.4dbdad421fcd945584d210433034ccb5@haskell.org> Message-ID: <062.339d5438c07ac331983151322543f367@haskell.org> #8809: Prettier error messages? -------------------------------------+------------------------------------- Reporter: joelteon | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.9 Resolution: | Keywords: | TypeErrorMessages Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 13122 Related Tickets: | Differential Rev(s): #8809,#10073,#10179,#12906,#13670 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by cdsmith): I'm summarizing a conversation with Richard in the hallway at ICFP. What would be nice is basically a separation of the logic to detect and gather information about an error from the logic to build an error message. I think this can be done with a reasonable migration path. I'm assuming a vanilla heterogeneous typed map, of a type that I'm sure exists many times over in Hackage. Details here could differ, but aren't all that relevant. {{{ #!haskell data TypedMap type TypedKey v = (String, Proxy v) empty :: TypedMap get :: TypedMap -> TypedKey v -> Maybe v put :: TypedKey v -> v -> TypedMap -> TypedMap }}} The key to a quick transition is to store the existing error messages (an `SDoc`, is that right?) alongside the map with more information. Then an error message is just a `(SDoc, TypedMap)`. As a starting point, existing code to report errors can just use an empty map, and the initial error message formatting can ignore the map and just show the message. So initial refactoring would have no effect. As a second step, one could add further stages on the formatting side that match a subset of errors (or even combinations of errors) and emit custom error messages. To make these useful, the map would often be extended with extra information at the reporting site. This would usually include at least some unique name or code indicating the kind of error this is, and optional keys that could point to expressions, types, etc. What this does is create a single place for logic that recognizes error patterns that occur frequently because of common mistakes, and does something smart with them. One could imagine this being another plugin point, where plugins could make improvement passes to the set of errors. These plugins might do very non-trivial things, such as trying to reparse a failed module with a whole new grammar that identifies common errors. This is a little weaker than the naive approach of defining a gigantic algebraic data type of all errors, as that sounds like a maintenance nightmare. It also keeps basic error messages in place so that work is only needed on the formatter side if and when a specific error is targeted for improvement. Just an initial thought. It seems to be mostly independent of the choice of how to pretty-print the message output (e.g., embedding rich types to be communicated to an IDE). This is about deciding what to say to the user in the first place. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 27 03:26:46 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 27 Sep 2018 03:26:46 -0000 Subject: [GHC] #8809: Prettier error messages? In-Reply-To: <047.4dbdad421fcd945584d210433034ccb5@haskell.org> References: <047.4dbdad421fcd945584d210433034ccb5@haskell.org> Message-ID: <062.54e08a2397b247c621b4e77dc3f62e62@haskell.org> #8809: Prettier error messages? -------------------------------------+------------------------------------- Reporter: joelteon | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.9 Resolution: | Keywords: | TypeErrorMessages Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 13122 Related Tickets: | Differential Rev(s): #8809,#10073,#10179,#12906,#13670 | Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Good background reading above, in comment:12, 13, 22. Maybe a bunch of dynamics is what we want, or maybe info in the `SDoc` itself, or both -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 27 06:32:13 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 27 Sep 2018 06:32:13 -0000 Subject: [GHC] #15680: Flag for printing absolute paths in diagnostics Message-ID: <057.3257c78352f5d8777cf39f28c5a70ccf@haskell.org> #15680: Flag for printing absolute paths in diagnostics -------------------------------------+------------------------------------- Reporter: | Owner: (none) quasicomputational | Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.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: -------------------------------------+------------------------------------- Currently, GHC will produce errors and warnings with relative paths pointing to the input that caused it. This is less than ideal for any tooling consuming these diagnostics, because build tools will concurrently build many packages in different working directories and interleave the output from multiple GHC invocations. In particular, this makes using `next-error` in emacs a lot less useful than it could be with cabal-install's output. [https://github.com/commercialhaskell/stack/blob/0740444175f41e6ea5ed236cd2c53681e4730003/src/Stack/Build/Execute.hs#L1896 Stack has some rather hackish code to post-process the diagnostics and to turn the relative paths absolute.] I can personally report that this makes the development process a lot more pleasant! I think it'd be much cleaner to have a GHC flag for this at the source. `-fabsolute-diagnostic-paths` or something similar, subject to bikeshedding. I had a look at implementing this myself, and `mkLocMessageAnn` in `ErrUtils` would be the locus of the change. However, I can't figure out how that function should learn what the current working directory is! Any tips? Is that information lurking somewhere in `DynFlags`? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 27 06:41:24 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 27 Sep 2018 06:41:24 -0000 Subject: [GHC] #15681: Take {-# COMPLETE #-} pragma into consideration when using MonadFailDesugaring Message-ID: <047.47a45e7308c6a8ffbc7451de73cfa648@haskell.org> #15681: Take {-# COMPLETE #-} pragma into consideration when using MonadFailDesugaring -------------------------------------+------------------------------------- Reporter: chshersh | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Keywords: pattern- | Operating System: Unknown/Multiple matching,monadfail,desugaring | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Consider the following code: {{{#!hs import Data.List.NonEmpty (NonEmpty (..)) foo :: Monad m => m (NonEmpty a) -> m a foo m = do (x :| _) <- m pure x }}} It works completely fine on GHC 8.6.1 and doesn't require `MonadFail` constraint because `NonEmpty` has only single constructor so there're no other cases in pattern-matching. Howewer, if I rewrite this code using `-XPatternSynonyms` with `{-# COMPLETE #-}` pragma, it doesn't work anymore. {{{#!hs {-# LANGUAGE PatternSynonyms #-} import Data.List.NonEmpty (NonEmpty (..)) newtype Foo a = Foo (NonEmpty a) pattern (:||) :: a -> [a] -> Foo a pattern x :|| xs <- Foo (x :| xs) {-# COMPLETE (:||) #-} foo :: Monad m => m (Foo a) -> m a foo m = do (x :|| _) <- m pure x }}} And I see the following error: {{{ • Could not deduce (Control.Monad.Fail.MonadFail m) arising from a do statement with the failable pattern ‘(x :|| _)’ from the context: MonadFoo m bound by the type signature for: foo :: forall (m :: * -> *) a. MonadFoo m => m (Foo a) -> m a at /Users/fenx/haskell/sandbox/Fail.hs:13:1-37 Possible fix: add (Control.Monad.Fail.MonadFail m) to the context of the type signature for: foo :: forall (m :: * -> *) a. MonadFoo m => m (Foo a) -> m a • In a stmt of a 'do' block: (x :|| _) <- m In the expression: do (x :|| _) <- m pure x In an equation for ‘foo’: foo m = do (x :|| _) <- m pure x | 15 | (x :|| _) <- m | ^^^^^^^^^^^^^^ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 27 07:36:57 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 27 Sep 2018 07:36:57 -0000 Subject: [GHC] #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory In-Reply-To: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> References: <044.e7b47664b0b4e75e999d3e8ddaf8b64f@haskell.org> Message-ID: <059.f790d111bfdc9388a33ca70258ecfb7a@haskell.org> #15503: interpreter: sequence_ (replicate 100000000 (return ())) gobbles up memory -------------------------------------+------------------------------------- Reporter: int-e | Owner: osa1 Type: bug | Status: new Priority: high | Milestone: 8.8.1 Component: GHCi | Version: 8.5 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): I still have no idea what retains all those PAPs, but I realized that 8.0.1 is when we introduced `-fexternal-interpreter`. Perhaps that has to do with this issue (reminder: the leak was also introduced with 8.0.1). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 27 13:31:05 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 27 Sep 2018 13:31:05 -0000 Subject: [GHC] #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 In-Reply-To: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> References: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> Message-ID: <058.12df74f6401a31975d5a67a8cc974bbb@haskell.org> #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 -------------------------------------+------------------------------------- Reporter: noah | Owner: tdammers Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | accelerate,memory,compile Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: Compile-time | Test Case: accelerate performance bug | 1.2.0 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by tdammers): Update: it appears that `accelerate` is already slow to compile on GHC 8.0.2, so this doesn't seem to be a new issue - more likely, it's one that we run into more often now. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 27 15:53:34 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 27 Sep 2018 15:53:34 -0000 Subject: [GHC] #15418: Performance drop 60 times on non-profiling binary In-Reply-To: <045.a055029aec148ca416c29df30694b018@haskell.org> References: <045.a055029aec148ca416c29df30694b018@haskell.org> Message-ID: <060.774ed82d6c2739a07afc939dd674b8f0@haskell.org> #15418: Performance drop 60 times on non-profiling binary -------------------------------------+------------------------------------- Reporter: hth313 | Owner: (none) Type: bug | Status: infoneeded Priority: high | Milestone: 8.8.1 Component: Runtime System | Version: 8.4.3 Resolution: | Keywords: Operating System: MacOS X | Architecture: x86_64 Type of failure: Runtime | (amd64) performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #14414, #9599 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Simon Marlow ): In [changeset:"d00c308633fe7d216d31a1087e00e63532d87d6d/ghc" d00c3086/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="d00c308633fe7d216d31a1087e00e63532d87d6d" Fix for recover with -fexternal-interpreter (#15418) Summary: When using -fexternal-interpreter, recover was not treating a Q compuation that simply registered an error with addErrTc as failing. Test Plan: New unit tests: * T15418 is the repro from in the ticket * TH_recover_warns is a new test to ensure that we're keeping warnings when the body of recover succeeds. Reviewers: bgamari, RyanGlScott, angerman, goldfire, erikd Subscribers: rwbarton, carter GHC Trac Issues: #15418 Differential Revision: https://phabricator.haskell.org/D5185 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 27 15:55:56 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 27 Sep 2018 15:55:56 -0000 Subject: [GHC] #15418: Performance drop 60 times on non-profiling binary In-Reply-To: <045.a055029aec148ca416c29df30694b018@haskell.org> References: <045.a055029aec148ca416c29df30694b018@haskell.org> Message-ID: <060.be171910e5fe51b1efec09388d941da0@haskell.org> #15418: Performance drop 60 times on non-profiling binary -------------------------------------+------------------------------------- Reporter: hth313 | Owner: (none) Type: bug | Status: infoneeded Priority: high | Milestone: 8.8.1 Component: Runtime System | Version: 8.4.3 Resolution: | Keywords: Operating System: MacOS X | Architecture: x86_64 Type of failure: Runtime | (amd64) performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #14414, #9599 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonmar): oops, I got the ticket number wrong in this commit, it should be #15481 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 27 15:57:12 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 27 Sep 2018 15:57:12 -0000 Subject: [GHC] #15481: TH fails to recover from reifyFixity with -fexternal-interpreter In-Reply-To: <050.5475c911201fc232088c3ce363d7a784@haskell.org> References: <050.5475c911201fc232088c3ce363d7a784@haskell.org> Message-ID: <065.8027e833394512734c6508c73f8813a9@haskell.org> #15481: TH fails to recover from reifyFixity with -fexternal-interpreter -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: simonmar Type: bug | Status: merge Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | Keywords: RemoteGHCi Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5185 Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonmar): * status: patch => merge Comment: Committed in d00c308633fe7d216d31a1087e00e63532d87d6d -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 27 16:37:29 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 27 Sep 2018 16:37:29 -0000 Subject: [GHC] #15519: Minor code refactoring leads to drastic performance degradation In-Reply-To: <046.ad6b341bd87e1814116aa36115f7bc12@haskell.org> References: <046.ad6b341bd87e1814116aa36115f7bc12@haskell.org> Message-ID: <061.7eff65dd7503bfef2e28cd05ff064d7f@haskell.org> #15519: Minor code refactoring leads to drastic performance degradation -------------------------------------+------------------------------------- Reporter: danilo2 | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: SpecConstr Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: 15578 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by George): * related: => 15578 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 27 16:40:57 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 27 Sep 2018 16:40:57 -0000 Subject: [GHC] #15519: Minor code refactoring leads to drastic performance degradation In-Reply-To: <046.ad6b341bd87e1814116aa36115f7bc12@haskell.org> References: <046.ad6b341bd87e1814116aa36115f7bc12@haskell.org> Message-ID: <061.1cff5c3aef27626a30c938db748717bb@haskell.org> #15519: Minor code refactoring leads to drastic performance degradation -------------------------------------+------------------------------------- Reporter: danilo2 | Owner: (none) Type: bug | Status: new Priority: highest | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: SpecConstr Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15578 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by George): * related: 15578 => #15578 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 27 20:05:05 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 27 Sep 2018 20:05:05 -0000 Subject: [GHC] #15681: Take {-# COMPLETE #-} pragma into consideration when using MonadFailDesugaring In-Reply-To: <047.47a45e7308c6a8ffbc7451de73cfa648@haskell.org> References: <047.47a45e7308c6a8ffbc7451de73cfa648@haskell.org> Message-ID: <062.1f141808af3d7164e3e296faad48d41e@haskell.org> #15681: Take {-# COMPLETE #-} pragma into consideration when using MonadFailDesugaring -------------------------------------+------------------------------------- Reporter: chshersh | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Resolution: | Keywords: pattern- | matching,monadfail,desugaring Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): Ah. This is because `isIrrefutableHsPat`, which determines is a pattern warrants a `MonadFail` constraint when matched upon in `do`-notation, [http://git.haskell.org/ghc.git/blob/1d7b61f97f9ec3780a1b7b5bf95a880d56224f4f:/compiler/hsSyn/HsPat.hs#l694 treats pattern synonyms quite conservatively]: {{{#!hs isIrrefutableHsPat pat = go pat where go (L _ pat) = go1 pat ... go1 (ConPatOut{ pat_con = L _ (PatSynCon _pat) }) = False -- Conservative ... }}} Compare the [http://git.haskell.org/ghc.git/blob/1d7b61f97f9ec3780a1b7b5bf95a880d56224f4f:/compiler/hsSyn/HsPat.hs#l689 treatment] for plain old data constructors: {{{#!hs go1 (ConPatOut{ pat_con = L _ (RealDataCon con), pat_args = details }) = isJust (tyConSingleDataCon_maybe (dataConTyCon con)) && all go (hsConPatArgs details) }}} This essentially says that a plain old data-constructor pattern match is irrefutable if its corresponding data type is inhabited by only one constructor. Could we do the same for pattern synonyms? We certainly could adapt the code for the `RealDataCon` case and reuse it for `PatSynCon`: {{{#!diff diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs index 6f65487..c23c479 100644 --- a/compiler/hsSyn/HsPat.hs +++ b/compiler/hsSyn/HsPat.hs @@ -57,6 +57,7 @@ import Var import RdrName ( RdrName ) import ConLike import DataCon +import PatSyn import TyCon import Outputable import Type @@ -691,8 +692,13 @@ isIrrefutableHsPat pat -- NB: tyConSingleDataCon_maybe, *not* isProductTyCon, because -- the latter is false of existentials. See Trac #4439 && all go (hsConPatArgs details) - go1 (ConPatOut{ pat_con = L _ (PatSynCon _pat) }) - = False -- Conservative + go1 (ConPatOut{ pat_con = L _ (PatSynCon pat), pat_args = details }) + | (_, _, _, _, _, res_ty) <- patSynSig pat + , Just tc <- tyConAppTyCon_maybe res_ty + = isJust (tyConSingleDataCon_maybe tc) + && all go (hsConPatArgs details) + | otherwise + = False -- Conservative go1 (LitPat {}) = False go1 (NPat {}) = False }}} While this fixes the particular example in this ticket, it's a bit dodgy. That's because it's determining if a pattern synonym is irrefutable by consulting the plain old data constructors that correspond to the type constructor that heads its return type. This is a bit of an impedance mismatch since exhaustiveness checking for pattern synonyms can only ever really be done in the context of one or more user-defined `COMPLETE` sets. It's not clear to me if `isIrrefutableHsPat` could be changed to take `COMPLETE` sets into account. The code to look up `COMPLETE` sets, [http://git.haskell.org/ghc.git/blob/d00c308633fe7d216d31a1087e00e63532d87d6d:/compiler/deSugar/DsMonad.hs#l530 dsGetCompleteMatches], lives in the `DsM` monad, while `isIrrefutableHsPat` is pure. Moreover, `isIrrefutableHsPat` has call sites that are outside of `DsM`, so it's unclear to me if we could factor out the monadic parts of `dsGetCompleteMatches`. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 27 21:12:37 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 27 Sep 2018 21:12:37 -0000 Subject: [GHC] #15682: evolve / improve Native Gen Format in Format.hs (especially in context of post simd cleanup) Message-ID: <045.afd34daae706eefa9da0f17df562b03e@haskell.org> #15682: evolve / improve Native Gen Format in Format.hs (especially in context of post simd cleanup) -------------------------------------+------------------------------------- Reporter: carter | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.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: -------------------------------------+------------------------------------- Currently `GlobalReg` represents the STG machine registers. However, some STG registers get aliased to the same machine registers (e.g. `FloatReg 1` and `DoubleReg 1`; see `Note [Overlapping global registers]`). To make matters worse, we assume that we can always determine the `CmmType` of a `GlobalReg`. However, in the case of SIMD registers this isn't necessarily the case (e.g. a XMM register may contain 1 or 2 double-precision floats, or 1, 2, 4, 8, or 16 integers). for ghc/compiler/nativeGen/Format.hs {{{ data Format = II8 | II16 | II32 | II64 | FF32 | FF64 | FF80 deriving (Show, Eq) }}} currently this is meant to "encode" both physical bit size AND which register class the value is. we also have the issue that this register class distinction stops being true once simd integer operations. this gets worse with simd once we want to track (perhaps?) the size / number of elements used in the xmm/ymm/zmm / arm simd vectors. perhaps also: signedness? this actually also relates to how GlobalRegisters and Format are related! is GlobalRegisters meant for STG machine vs native Machine? this intersects with ABI questions. Plus we currently have eg Float and Double which are different logically/semantically, BUT the same registers in most native machine architectures -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 27 22:09:06 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 27 Sep 2018 22:09:06 -0000 Subject: [GHC] #15683: coerce fails for Coercible type families Message-ID: <051.04aeb617fffe9d1d9bbaf4cf6990ba5c@haskell.org> #15683: coerce fails for Coercible type families -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Keywords: TypeFamilies | 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 want to bring attention to this [https://www.reddit.com/r/haskell/comments/9io4xw/coercing_type_families_when_type_instances_are/ reddit post] that boils down to {{{#!hs type family X a type instance X Int = String type instance X Bool = String data T a = T (X a) }}} but not being able to coerce {{{#!hs coerce :: T Int -> T Bool }}} This gives the error “Couldn't match type ‘`Int`’ with ‘`Bool`’ arising from a use of ‘`coerce`’”. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 27 22:10:49 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 27 Sep 2018 22:10:49 -0000 Subject: [GHC] #15683: coerce fails for Coercible type families In-Reply-To: <051.04aeb617fffe9d1d9bbaf4cf6990ba5c@haskell.org> References: <051.04aeb617fffe9d1d9bbaf4cf6990ba5c@haskell.org> Message-ID: <066.46ba05f371747acefe5aa4b904e4b797@haskell.org> #15683: coerce fails for Coercible type families -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Resolution: | Keywords: TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): I think Richard was collecting examples of the `Coercible` solver wrt completeness -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 27 22:38:47 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 27 Sep 2018 22:38:47 -0000 Subject: [GHC] #15684: Add tests for SIMD loads and stores Message-ID: <046.b0ae3413a85928c297d182289293bf36@haskell.org> #15684: Add tests for SIMD loads and stores -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.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: -------------------------------------+------------------------------------- The NCG SIMD patch tests most of the arithmetic operations but not loads and stores. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Thu Sep 27 23:42:35 2018 From: ghc-devs at haskell.org (GHC) Date: Thu, 27 Sep 2018 23:42:35 -0000 Subject: [GHC] #15683: coerce fails for Coercible type families In-Reply-To: <051.04aeb617fffe9d1d9bbaf4cf6990ba5c@haskell.org> References: <051.04aeb617fffe9d1d9bbaf4cf6990ba5c@haskell.org> Message-ID: <066.0f9f81a0fc74d9f784ea96e6e655e03f@haskell.org> #15683: coerce fails for Coercible type families -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Resolution: | Keywords: TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by sam-barr): For reference, I (the OP of the reddit post) encountered this issue when trying to use idioms introduced in Trees That Grow. It would be useful to be able to coerce subtrees without explicit recursion when no further manipulation is required. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 00:53:30 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 00:53:30 -0000 Subject: [GHC] #12178: Allow inline pragmas on pattern synonyms In-Reply-To: <049.c0b5177720c745c7c76b88f1c76a960e@haskell.org> References: <049.c0b5177720c745c7c76b88f1c76a960e@haskell.org> Message-ID: <064.ae64c61670dd5065467bdda275c20b30@haskell.org> #12178: Allow inline pragmas on pattern synonyms -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: feature request | Status: new Priority: high | Milestone: 8.8.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: | PatternSynonyms, newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by chessai): Why would a pattern synonym not get inlined by default, always? Pattern Synonyms AFAIK don't perform any computation; only computation that may occur within a Pattern Synonym would be within ViewPatterns, but inlining any function inside of the ViewPattern shouldn't matter to just the issue of inlining the Pattern Synonym. Please correct me if I am wrong or missing something. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 01:17:30 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 01:17:30 -0000 Subject: [GHC] #15559: fromJust has no HasCallStack In-Reply-To: <046.0c0fc309394993486a792a626e8db1e1@haskell.org> References: <046.0c0fc309394993486a792a626e8db1e1@haskell.org> Message-ID: <061.27c919d9a7c4c739bff5bbad72cff532@haskell.org> #15559: fromJust has no HasCallStack -------------------------------------+------------------------------------- Reporter: nomeata | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Core Libraries | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by chessai): > I really like GHC's internal HasDebugCallStack, which disappears (that is, becomes ()) when DEBUG is not defined via CPP and becomes HasCallStack when DEBUG is defined. As far as I know, there's no standard way to mark a build meant for debugging, but perhaps there should be. Then, we could do the same for all applications instead of just GHC. In addition to making this available to users of GHC, there should probably be an additional side-effect to the DEBUG flag, or a separate flag, that turns HasDebugCallStack on for all functions -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 01:22:21 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 01:22:21 -0000 Subject: [GHC] #15685: Pattern signature not inferred Message-ID: <051.c5171c2fbdeaddb4c2ac22c9d434e0a0@haskell.org> #15685: Pattern signature not inferred -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Keywords: | Operating System: Unknown/Multiple PatternSynonyms | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Should this pattern synonym declaration fail, {{{#!hs {-# Language DataKinds, TypeOperators, PolyKinds, GADTs, PatternSynonyms #-} import Data.Kind data NS f as where Here :: f a -> NS f (a:as) data NP :: (k -> Type) -> ([k] -> Type) where Nil :: NP f '[] pattern HereNil = Here Nil }}} {{{ $ ghci -ignore-dot-ghci hs/457.hs GHCi, version 8.7.20180828: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( hs/457.hs, interpreted ) [flags changed] hs/457.hs:11:19: error: • Could not deduce: f ~~ NP f0 from the context: (as ~ (a1 : as1), GHC.Types.Any ~ '[]) bound by the signature for pattern synonym ‘HereNil’ at hs/457.hs:11:1-26 ‘f’ is a rigid type variable bound by the signature for pattern synonym ‘HereNil’ at hs/457.hs:11:1-26 Expected type: NS f as Actual type: NS (NP f0) ('[] : as0) • In the expression: Here Nil In an equation for ‘HereNil’: HereNil = Here Nil • Relevant bindings include $bHereNil :: NS f as (bound at hs/457.hs:11:9) | 11 | pattern HereNil = Here Nil | ^^^^^^^^ hs/457.hs:11:24: error: • Kind mismatch: cannot unify (f :: a -> *) with: NP a0 :: [GHC.Types.Any] -> * Their kinds differ. Expected type: f a1 Actual type: NP a0 GHC.Types.Any • In the pattern: Nil In the pattern: Here Nil In the declaration for pattern synonym ‘HereNil’ | 11 | pattern HereNil = Here Nil | ^^^ Failed, no modules loaded. Prelude> }}} It can be given a pattern signature, my question is can this not be inferred {{{#!hs -- pattern HereNil :: NS (NP f) ('[]:as) pattern HereNil :: () => (nil_as ~ ('[]:as)) => NS (NP f) nil_as pattern HereNil = Here Nil }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 01:29:45 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 01:29:45 -0000 Subject: [GHC] #15685: Pattern signature not inferred In-Reply-To: <051.c5171c2fbdeaddb4c2ac22c9d434e0a0@haskell.org> References: <051.c5171c2fbdeaddb4c2ac22c9d434e0a0@haskell.org> Message-ID: <066.acaf07eb99786a365693a344eaa6fefc@haskell.org> #15685: Pattern signature not inferred -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Resolution: | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): It can be more general with a heterogeneous equality `(~~)`, can `NP f` be "delayed" as well? This is the limit of my knowledge {{{#!hs pattern HereNil :: () => (nil_as ~~ ('[]:as)) => NS (NP f) nil_as }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 02:15:28 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 02:15:28 -0000 Subject: [GHC] #13492: -p option report much less time than actual on high intensity of FFI calls application In-Reply-To: <045.f50d3dd52e457f79de74acb0151c7b37@haskell.org> References: <045.f50d3dd52e457f79de74acb0151c7b37@haskell.org> Message-ID: <060.7132e729065323236a20e3fdb2853d1e@haskell.org> #13492: -p option report much less time than actual on high intensity of FFI calls application -------------------------------------+------------------------------------- Reporter: varosi | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Profiling | Version: 8.5 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Debugging | (amd64) information is incorrect | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by maoe): * cc: maoe (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 02:17:43 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 02:17:43 -0000 Subject: [GHC] #6113: Profiling with -p not written if killed with SIGTERM In-Reply-To: <045.764bc656e63c4390b5e307b27a89b060@haskell.org> References: <045.764bc656e63c4390b5e307b27a89b060@haskell.org> Message-ID: <060.33d1e1061091259de9d56b795499ea12@haskell.org> #6113: Profiling with -p not written if killed with SIGTERM -------------------------------------+------------------------------------- Reporter: Veinor | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Profiling | Version: 7.4.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by maoe): * cc: maoe (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 02:19:32 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 02:19:32 -0000 Subject: [GHC] #12178: Allow inline pragmas on pattern synonyms In-Reply-To: <049.c0b5177720c745c7c76b88f1c76a960e@haskell.org> References: <049.c0b5177720c745c7c76b88f1c76a960e@haskell.org> Message-ID: <064.3be153cc9ec8e52f8743d26b3f59663d@haskell.org> #12178: Allow inline pragmas on pattern synonyms -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: feature request | Status: new Priority: high | Milestone: 8.8.1 Component: Compiler | Version: 8.0.1 Resolution: | Keywords: | PatternSynonyms, newcomer Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > Why would a pattern synonym not get inlined by default, always? The only disadvantage to inlining is code size; and that applies equally to all inlining decisions, whether for pattern synonyms or any other function. Consider {{{ pattern P a = [[[[a]]]] f x = P (x+1) g y = P (y-1) }}} Here's what it compiles to, without inlining {{{ $bP x = (:) ((:) ((:) ((:) x []) []) []) [] f x = $bP (x+1) g y = $bP (y-1) }}} Yes, we could inline `$bP`: {{{ f x = (:) ((:) ((:) ((:) (x+1) []) []) []) [] g y = (:) ((:) ((:) ((:) (y-1) []) []) []) [] }}} But really nothing much was gained by inlining the builder `$bp`. It's the same for matching. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 03:00:31 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 03:00:31 -0000 Subject: [GHC] #15371: Eventlog framework outputs environment variables which may cause a security issue In-Reply-To: <043.e0598f3eff95a3e71b8c6103a2d86a17@haskell.org> References: <043.e0598f3eff95a3e71b8c6103a2d86a17@haskell.org> Message-ID: <058.7971a55407bdab8251e06c1c7dceb7ca@haskell.org> #15371: Eventlog framework outputs environment variables which may cause a security issue -------------------------------------+------------------------------------- Reporter: maoe | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by maoe): Uploaded the patch to https://phabricator.haskell.org/D5187. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 03:02:35 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 03:02:35 -0000 Subject: [GHC] #15371: Eventlog framework outputs environment variables which may cause a security issue In-Reply-To: <043.e0598f3eff95a3e71b8c6103a2d86a17@haskell.org> References: <043.e0598f3eff95a3e71b8c6103a2d86a17@haskell.org> Message-ID: <058.f882c845c557c52246c9c4f14ec192fd@haskell.org> #15371: Eventlog framework outputs environment variables which may cause a security issue -------------------------------------+------------------------------------- Reporter: maoe | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | https://phabricator.haskell.org/D5187 -------------------------------------+------------------------------------- Changes (by maoe): * differential: => https://phabricator.haskell.org/D5187 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 03:49:34 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 03:49:34 -0000 Subject: [GHC] #15681: Take {-# COMPLETE #-} pragma into consideration when using MonadFailDesugaring In-Reply-To: <047.47a45e7308c6a8ffbc7451de73cfa648@haskell.org> References: <047.47a45e7308c6a8ffbc7451de73cfa648@haskell.org> Message-ID: <062.7fa775b05daa906874f96a5cd3ce589d@haskell.org> #15681: Take {-# COMPLETE #-} pragma into consideration when using MonadFailDesugaring -------------------------------------+------------------------------------- Reporter: chshersh | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Resolution: | Keywords: pattern- | matching,monadfail,desugaring Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > That's because it's determining if a pattern synonym is irrefutable by consulting the plain old data constructors that correspond to the type constructor that heads its return type Yes, that is pretty dodgy! Eg I think it would give the wrong answer for {{{ pattern P a = (Just a, True) }}} The outer constructor is `(,)`, but that doesn't mean that `P x` is irrefutable. Naively, one might think that the simple thing do to is to behave as if the type synonym was expanded at the use site. But that breaks the abstraction that is part of the purpose of having a pattern synonym. And in fact, in separate compilation, GHC does not record the original definition directly; it just exports teh builder and matcher functions for the pattern synonym. The right thing must surely be to use the `COMPLETE` sets, somehow. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 03:54:37 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 03:54:37 -0000 Subject: [GHC] #15682: evolve / improve Native Gen Format in Format.hs (especially in context of post simd cleanup) In-Reply-To: <045.afd34daae706eefa9da0f17df562b03e@haskell.org> References: <045.afd34daae706eefa9da0f17df562b03e@haskell.org> Message-ID: <060.49e89ded8ee6f542ec060c2ef43a02e0@haskell.org> #15682: evolve / improve Native Gen Format in Format.hs (especially in context of post simd cleanup) -------------------------------------+------------------------------------- Reporter: carter | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Yes, this is a bit of a mess. It would help to a clear problem statement, with goals and constraints; and perhaps possible solutions. Then we can have a well-informed design debate. I for one am quite at sea about what the difficulties are, and how hard/easy they are to fix. Thanks! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 05:35:43 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 05:35:43 -0000 Subject: [GHC] #15371: Eventlog framework outputs environment variables which may cause a security issue In-Reply-To: <043.e0598f3eff95a3e71b8c6103a2d86a17@haskell.org> References: <043.e0598f3eff95a3e71b8c6103a2d86a17@haskell.org> Message-ID: <058.b5f204a50281d77c37f90f1640f44fcc@haskell.org> #15371: Eventlog framework outputs environment variables which may cause a security issue -------------------------------------+------------------------------------- Reporter: maoe | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Runtime System | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: Other | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5187 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * differential: https://phabricator.haskell.org/D5187 => Phab:D5187 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 06:08:46 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 06:08:46 -0000 Subject: [GHC] #15117: Add linting checks for DWARF unwind information In-Reply-To: <046.99e1d9bddf61dd7d8326fcca5a52c63d@haskell.org> References: <046.99e1d9bddf61dd7d8326fcca5a52c63d@haskell.org> Message-ID: <061.b5fc61abb2e23b576f859798dfdbefc1@haskell.org> #15117: Add linting checks for DWARF unwind information -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: task | Status: patch Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4559 Wiki Page: | -------------------------------------+------------------------------------- Changes (by osa1): * cc: osa1 (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 06:16:37 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 06:16:37 -0000 Subject: [GHC] #14510: GHC.ExecutionStack.showStackTrace broken In-Reply-To: <043.9685830b69e2246f2b96ccff19455218@haskell.org> References: <043.9685830b69e2246f2b96ccff19455218@haskell.org> Message-ID: <058.3fbbff893d21f907124ec8498ba46065@haskell.org> #14510: GHC.ExecutionStack.showStackTrace broken ---------------------------------+-------------------------------------- Reporter: duog | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Linux | Architecture: x86_64 (amd64) Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+-------------------------------------- Changes (by osa1): * cc: osa1 (added) Comment: What is the expected output here? I just tried this with 8.2.2, 8.4.3 and 8.6.1 on Ubuntu 18.04. I don't get any errors with 8.4.3 and 8.6.1 but `showStackTrace` returns `Nothing`. With 8.2.2 I get this compile error: {{{ [1 of 1] Compiling Main ( testdwarf.hs, testdwarf.o ) /tmp/ghc28125_0/ghc_2.s: Assembler messages: /tmp/ghc28125_0/ghc_2.s:1059:0: error: Error: invalid operands (.debug_frame and .note.GNU-stack sections) for `-' | 1059 | .uleb128 1f-.-1 | ^ /tmp/ghc28125_0/ghc_2.s:1133:0: error: Error: invalid operands (.debug_frame and .note.GNU-stack sections) for `-' | 1133 | .uleb128 1f-.-1 | ^ /tmp/ghc28125_0/ghc_2.s:1162:0: error: Error: invalid operands (.debug_frame and .note.GNU-stack sections) for `-' | 1162 | .uleb128 1f-.-1 | ^ /tmp/ghc28125_0/ghc_2.s:1191:0: error: Error: invalid operands (.debug_frame and .note.GNU-stack sections) for `-' | 1191 | .uleb128 1f-.-1 | ^ `gcc' failed in phase `Assembler'. (Exit code: 1) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 06:38:00 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 06:38:00 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.8599a645c7e4ad7bda443d017ca43d96@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): Hmm, I'm not sure if doing parsing in runtime is a good idea. Why not do the parsing in compile time generate Core for this instead: {{{ (X GHC.Real.% 1) GHC.Num.* (10 :: Integer) GHC.Real.^^ Y }}} for `XeY`? Now the huge `Integer` will be computed in runtime but we won't be doing parsing. I just realized that this is basically desugaring `XeY` to `(X%1) * 10^^Y`, similar to the idea in comment:20 except we don't ask users to write this, instead we convert the `XeY` notation to the other. Simon, any opinions on this? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 09:33:43 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 09:33:43 -0000 Subject: [GHC] #15611: scope errors lie about what modules are imported In-Reply-To: <044.35c05a6ccad9dc15d82e16ecd787e95b@haskell.org> References: <044.35c05a6ccad9dc15d82e16ecd787e95b@haskell.org> Message-ID: <059.2e4e397020712311b9c741a92c7f63a1@haskell.org> #15611: scope errors lie about what modules are imported -------------------------------------+------------------------------------- Reporter: dmwit | Owner: RolandSenn Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14225 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RolandSenn): * related: => #14225 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 09:34:00 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 09:34:00 -0000 Subject: [GHC] #14225: "No module named ... is imported" message is a bit misleading with qualified imports In-Reply-To: <046.66ec7009ab5b4f5d3b72af6d147f4e53@haskell.org> References: <046.66ec7009ab5b4f5d3b72af6d147f4e53@haskell.org> Message-ID: <061.d61a997d34df85fcfffc7b0ad03b9397@haskell.org> #14225: "No module named ... is imported" message is a bit misleading with qualified imports -------------------------------------+------------------------------------- Reporter: bgamari | Owner: RolandSenn Type: bug | Status: new Priority: low | Milestone: Component: Compiler | Version: 8.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #15611 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RolandSenn): * owner: (none) => RolandSenn * related: => #15611 Comment: I'll work on this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 12:04:21 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 12:04:21 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.61c14f0d52eddbbd187890741bcebf82@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > Why not do the parsing in compile time generate Core for this instead: Yes, I agree. That's what I meant in comment:14 with `fl_before` etc, but I expressed it badly. Let me try to do better. Accounting for monoidal's excellent point we could have {{{ data FractionalLit = FL { fl_text :: SourceText -- How the value was written in the source , fl_neg :: Bool -- See Note [Negative zero] , fl_mantissa, fl_exp :: Integer -- Denotes E } }}} So `1.077E400` would be represented with `fl_mantissa = 1077` and `fl_exp = 397`. Then we desugar to {{{ Var 'makeRational' `App` (Lit 1077) `App` (Lit 397) }}} where `makeRational` is a new library function defined thus {{{ makeRational :: Integer -> Integer -> Integer makeRational i e = (i % 1) * (10 ^^ e) }}} Probably we want it to inline, but that's a separate matter. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 12:16:38 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 12:16:38 -0000 Subject: [GHC] #15681: Take {-# COMPLETE #-} pragma into consideration when using MonadFailDesugaring In-Reply-To: <047.47a45e7308c6a8ffbc7451de73cfa648@haskell.org> References: <047.47a45e7308c6a8ffbc7451de73cfa648@haskell.org> Message-ID: <062.b1ba00ee69eb400cb28685d8d5071ed9@haskell.org> #15681: Take {-# COMPLETE #-} pragma into consideration when using MonadFailDesugaring -------------------------------------+------------------------------------- Reporter: chshersh | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.6.1 Resolution: | Keywords: pattern- | matching,monadfail,desugaring,PatternSynonyms,PatternMatchWarnings Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * keywords: pattern-matching,monadfail,desugaring => pattern- matching,monadfail,desugaring,PatternSynonyms,PatternMatchWarnings * milestone: 8.6.1 => 8.8.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 12:29:46 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 12:29:46 -0000 Subject: [GHC] #15683: coerce fails for Coercible type families In-Reply-To: <051.04aeb617fffe9d1d9bbaf4cf6990ba5c@haskell.org> References: <051.04aeb617fffe9d1d9bbaf4cf6990ba5c@haskell.org> Message-ID: <066.09c0f95f8a1e68a00d047c252292e5ce@haskell.org> #15683: coerce fails for Coercible type families -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Resolution: | Keywords: TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): This is by design. You are expecting `T Int` and `T Bool` to be representationally equal because if you look at every field of every constructor of `T`, and reduce every type-family application therein, on the particular argument types `Int` and `Bool`, then the answers are reprsentationally equal. Quite true! But this could be laborious if `T` had many constructors {{{ data T a = T1 (X a ) | T2 [Y a] (Z [a]) ..etc... }}} If you add `type instance X Char = Char`, then certainly `T Int` is not coercible to `T Char`, so that check would have to be done for every individual instantation -- and recursively so. Instead, the type system analyses the data type declaration for `T` computes a single summary -- the "role signature" of `T` --that decides, one and for all, when `(T t1)` is representationally equal to `T t2`. In this case, because of the possibility of `type instance T Char = Char`, the decision is that `T t1` is coercible to `T t2` only if `t1` is (nominally) equal to `t2`. [https://www.microsoft.com/en-us/research/publication/safe-coercions/ The paper] explains all this in some details. I don't see a decently feasibly way to fix this, I'm afraid. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 13:56:44 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 13:56:44 -0000 Subject: [GHC] #15646: ghci takes super long time to find the type of large fractional number In-Reply-To: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> References: <050.bf3dc390139c3159296f75808c90ac8d@haskell.org> Message-ID: <065.23af1da753e777b1bd86bc8f1f3ce6d4@haskell.org> #15646: ghci takes super long time to find the type of large fractional number -------------------------------------+------------------------------------- Reporter: Johannkokos | Owner: | JulianLeviston Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: GHCi | Version: 8.4.3 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): OK, that makes sense. JulianLeviston, feel free to ping me on IRC if you have any questions -- or let us know here. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 14:28:07 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 14:28:07 -0000 Subject: [GHC] #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` In-Reply-To: <046.74175c624c857c997e111eade5eabf30@haskell.org> References: <046.74175c624c857c997e111eade5eabf30@haskell.org> Message-ID: <061.3e7637d5178cb0711d17a32fa11ec3f6@haskell.org> #15622: Generalize `E{0,1,2,3,6,9,12}` from `Data.Fixed` -------------------------------------+------------------------------------- Reporter: rockbmb | Owner: rockbmb Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Core Libraries | Version: 8.4.3 Resolution: | Keywords: base, | Data.Fixed Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by rockbmb): Since no code from Hackage derives instances against these types currently, does anyone disagree it is safe to assume no code (published on Hackage) will break from this change? Projects not uploaded to Hackage or that are closed-source and rely on GHC may have issues if they have instances defined for `E0/E1...`, but I do not think they will be too great. In these cases, would the addition of `FlexibleInstances` be problematic? I do not think so, but that is my opinion. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 14:59:59 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 14:59:59 -0000 Subject: [GHC] #15686: Different results depending on if the code was compiled with or without optimizations Message-ID: <048.6589a93b821cb7515e2a60f838ea248d@haskell.org> #15686: Different results depending on if the code was compiled with or without optimizations -------------------------------------+------------------------------------- Reporter: Darwin226 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Keywords: | Operating System: Windows Architecture: x86_64 | Type of failure: Incorrect result (amd64) | at runtime Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- The test case consists of three files: Main.hs {{{#!hs {-# LANGUAGE OverloadedLists, BangPatterns #-} {-# OPTIONS_GHC -ddump-simpl -dsuppress-all -ddump-to-file #-} module Main where import Mesh import Vec import Control.Exception main :: IO () main = do !_ <- evaluate $ toBondForce (Particle {_position = Vec {_vecX = 0.0, _vecY = -20.0}, _mass = 10.0, _velocity = Vec {_vecX = 0.0, _vecY = 3.0}}) (Particle {_position = Vec {_vecX = 20.0, _vecY = -20.0}, _mass = 10.0, _velocity = Vec {_vecX = 0.0, _vecY = 0.0}}) (FixedDistanceBond {_distance = 20.0, _strength = 0.5}) return () }}} Vec.hs {{{#!hs {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, FunctionalDependencies #-} module Vec where data Vec = Vec { _vecX :: {-# UNPACK #-}!Double, _vecY :: {-# UNPACK #-}!Double } deriving (Eq, Ord, Read, Show) liftVec :: (Double -> Double -> Double) -> Vec -> Vec -> Vec liftVec f (Vec x y) (Vec z w) = Vec (f x z) (f y w) {-# INLINE liftVec #-} instance Num Vec where fromInteger i = Vec (fromInteger i) (fromInteger i) (+) a b = liftVec (+) a b {-# INLINE (+) #-} (*) a b = liftVec (*) a b {-# INLINE (*) #-} (-) a b = liftVec (-) a b {-# INLINE (-) #-} signum (Vec x y) = Vec (signum x) (signum y) abs (Vec x y) = Vec (abs x) (abs y) instance Fractional Vec where fromRational r = Vec (fromRational r) (fromRational r) (/) = liftVec (/) {-# INLINE (/) #-} fromDouble :: Double -> Vec fromDouble x = Vec x x {-# INLINE fromDouble #-} class Vector2D v where norm :: v -> Double normalize :: v -> v distance :: v -> v -> Double dot :: v -> v -> Double project :: v -> v -> v instance Vector2D Vec where norm (Vec x y) = sqrt (x ** 2 + y ** 2) {-# INLINE norm #-} normalize v@(Vec x y) = Vec (x / n) (y / n) where n = norm v {-# INLINE normalize #-} distance v1 v2 = norm (v2 - v1) {-# INLINE distance #-} dot (Vec x y) (Vec z w) = x * z + y * w {-# INLINE dot #-} project tgt v = normTgt * realToFrac (dot normTgt v) where normTgt = normalize tgt {-# INLINE project #-} }}} Mesh.hs {{{#!hs {-# LANGUAGE Strict, RecordWildCards, TemplateHaskell, BangPatterns #-} {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, FunctionalDependencies #-} {-# OPTIONS_GHC -ddump-simpl -dsuppress-all -ddump-to-file #-} module Mesh where import Vec import Debug.Trace data Particle = Particle { _position :: {-# UNPACK #-}!Vec , _mass :: {-# UNPACK #-}!Double , _velocity :: {-# UNPACK #-}!Vec } deriving (Eq, Ord, Read, Show) data Bond = FixedDistanceBond { _distance :: {-# UNPACK #-}!Double , _strength :: {-# UNPACK #-}!Double } deriving (Eq, Ord, Read, Show) toBondForce :: Particle -> Particle -> Bond -> Vec toBondForce Particle{..} !p2 FixedDistanceBond{..} = traceShow (show (Mesh._position p2, dir)) $ dir * fromDouble (actualDist - _distance) * fromDouble _strength - project dir velDiff * 0.1 where posDiff = Mesh._position p2 - _position dir = normalize posDiff actualDist = norm posDiff velDiff = _velocity - Mesh._velocity p2 }}} Compiling Main.hs with optimizations (-O2) and running the program produces the output "(Vec {_vecX = 20.0, _vecY = 0.0},Vec {_vecX = 1.0, _vecY = 0.0})" while compiling without optimizations produces "(Vec {_vecX = 20.0, _vecY = -20.0},Vec {_vecX = 1.0, _vecY = 0.0})" which is correct. Further observations: Changing `traceShow (show (Mesh._position p2, dir))` to `traceShow (show (Mesh._position p2))` makes the code perform correctly even with optimizations. The core output looks correct to me even with optimizations. I can't test with other GHC versions on Windows, but I know I can't reproduce this with GHC 8.4 on Linux and I think it also doesn't reproduce with 8.2 on Linux. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 15:15:18 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 15:15:18 -0000 Subject: [GHC] #5467: Template Haskell: support for Haddock comments In-Reply-To: <046.e4a8d15ae2317226a67b074817a4dd39@haskell.org> References: <046.e4a8d15ae2317226a67b074817a4dd39@haskell.org> Message-ID: <061.12dcd90de5cbf96feaf760ab55554443@haskell.org> #5467: Template Haskell: support for Haddock comments -------------------------------------+------------------------------------- Reporter: reinerp | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.2.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by harpocrates): * cc: harpocrates (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 15:18:56 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 15:18:56 -0000 Subject: [GHC] #14813: EmptyCase thinks pattern match involving type family is not exhaustive, when it actually is In-Reply-To: <050.3962023f385f083f5f659edfe4ce01db@haskell.org> References: <050.3962023f385f083f5f659edfe4ce01db@haskell.org> Message-ID: <065.208eda69ee843167572b5c391e531558@haskell.org> #14813: EmptyCase thinks pattern match involving type family is not exhaustive, when it actually is -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: | PatternMatchWarnings Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5094 Wiki Page: | -------------------------------------+------------------------------------- Comment (by Krzysztof Gogolewski ): In [changeset:"e72d7880b940881d38b8c3db9a00d5d007b1458f/ghc" e72d788/ghc]: {{{ #!CommitTicketReference repository="ghc" revision="e72d7880b940881d38b8c3db9a00d5d007b1458f" Normalise EmptyCase types using the constraint solver Summary: Certain `EmptyCase` expressions were mistakently producing warnings since their types did not have as many type families reduced as they could have. The most direct way to fix this is to normalise these types initially using the constraint solver to solve for any local equalities that may be in scope. Test Plan: make test TEST=T14813 Reviewers: simonpj, bgamari, goldfire Reviewed By: simonpj Subscribers: rwbarton, carter GHC Trac Issues: #14813 Differential Revision: https://phabricator.haskell.org/D5094 }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 15:20:54 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 15:20:54 -0000 Subject: [GHC] #14813: EmptyCase thinks pattern match involving type family is not exhaustive, when it actually is In-Reply-To: <050.3962023f385f083f5f659edfe4ce01db@haskell.org> References: <050.3962023f385f083f5f659edfe4ce01db@haskell.org> Message-ID: <065.f335b758dac7736cd8dc27ff7f3588bf@haskell.org> #14813: EmptyCase thinks pattern match involving type family is not exhaustive, when it actually is -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.2.2 Resolution: fixed | Keywords: | PatternMatchWarnings Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect | Unknown/Multiple error/warning at compile-time | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5094 Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: patch => closed * resolution: => fixed -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 15:34:33 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 15:34:33 -0000 Subject: [GHC] #9251: ghc does not expose branchless max/min operations as primops In-Reply-To: <045.e29eb1e7c055c049cd093a2df9caa8db@haskell.org> References: <045.e29eb1e7c055c049cd093a2df9caa8db@haskell.org> Message-ID: <060.0e2bb0564fb6f2dbe43ad4ba154d59b8@haskell.org> #9251: ghc does not expose branchless max/min operations as primops -------------------------------------+------------------------------------- Reporter: carter | Owner: osa1 Type: task | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: #9246 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by rockbmb): Hello; What is the status on this issue? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 18:03:08 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 18:03:08 -0000 Subject: [GHC] #15683: coerce fails for Coercible type families In-Reply-To: <051.04aeb617fffe9d1d9bbaf4cf6990ba5c@haskell.org> References: <051.04aeb617fffe9d1d9bbaf4cf6990ba5c@haskell.org> Message-ID: <066.e76b3ca9d9576b5569b53edbb1626e4e@haskell.org> #15683: coerce fails for Coercible type families -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Resolution: | Keywords: TypeFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #8177 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * related: => #8177 Comment: I think what you likely want is the ability to declare type families that aren't nominal in their arguments. Something like: {{{#!hs type role X representational type family X a }}} To be clear, GHC doesn't currently grant the ability to do this, but if it hypothetically did, then this would solve your problem. This is the scope of #8177. I'd go as far to say that this ticket is a duplicate of that one—do you agree? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Fri Sep 28 19:13:23 2018 From: ghc-devs at haskell.org (GHC) Date: Fri, 28 Sep 2018 19:13:23 -0000 Subject: [GHC] #15683: coerce fails for Coercible type families In-Reply-To: <051.04aeb617fffe9d1d9bbaf4cf6990ba5c@haskell.org> References: <051.04aeb617fffe9d1d9bbaf4cf6990ba5c@haskell.org> Message-ID: <066.4ae753021a35ace4dc108fa67f82cd8d@haskell.org> #15683: coerce fails for Coercible type families -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Resolution: | Keywords: TypeFamilies, | Coercible Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by goldfire): * keywords: TypeFamilies => TypeFamilies, Coercible * related: #8177 => Comment: I'm afraid I disagree with comment:4. That's a related concern, but different. I think the solution to this problem is to have a ''lattice'' of roles. When we say, e.g., `type role T nominal representational phantom`, what we mean is: * `T a b c` is representationally equal to `T d e f` if `a` is nominally equal to `d`, `b` is representationally equal to `e`, and `c` is phantomly equal to `f`. What you want to say here is * `X a` is representationally equal to `X b` if `F a` is representationally equal to `F b`. We can imagine something like `type role X representational(F)` that means the phrase above. This could be checked easily. But it would need to come with a theory of GHC core for which we can prove type safety -- not a low bar. So, it's conceivable that some research could produce what you want, but it's out of reach for now. Note that this is ''not'' an infelicity of the solver, but an infelicity of the theory. (By contrast, #8177 is "just engineering" -- I don't think we'd need a new formal proof of safety to do it.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 03:01:49 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 03:01:49 -0000 Subject: [GHC] #15686: Different results depending on if the code was compiled with or without optimizations In-Reply-To: <048.6589a93b821cb7515e2a60f838ea248d@haskell.org> References: <048.6589a93b821cb7515e2a60f838ea248d@haskell.org> Message-ID: <063.580f4f820153d40d7b9632e7f98fc11d@haskell.org> #15686: Different results depending on if the code was compiled with or without optimizations -------------------------------------+------------------------------------- Reporter: Darwin226 | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 Resolution: fixed | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Incorrect result | (amd64) at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by AndreasK): * status: new => closed * resolution: => fixed Comment: Was fixed in #14619. Thanks for the report! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 03:02:36 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 03:02:36 -0000 Subject: [GHC] #15686: Different results depending on if the code was compiled with or without optimizations In-Reply-To: <048.6589a93b821cb7515e2a60f838ea248d@haskell.org> References: <048.6589a93b821cb7515e2a60f838ea248d@haskell.org> Message-ID: <063.d54da019adb3f64a78dc03dff59e9202@haskell.org> #15686: Different results depending on if the code was compiled with or without optimizations -------------------------------------+------------------------------------- Reporter: Darwin226 | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.4.1 Component: Compiler | Version: 8.2.2 Resolution: fixed | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Incorrect result | (amd64) at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bgamari): * milestone: 8.6.1 => 8.4.1 -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 03:11:23 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 03:11:23 -0000 Subject: [GHC] #15671: Link errors due to forcibly exporting findPtr In-Reply-To: <044.6372bc7500582c14ea27cfe705ed9ef3@haskell.org> References: <044.6372bc7500582c14ea27cfe705ed9ef3@haskell.org> Message-ID: <059.f8e1a2f12b34409d87394c76c82c80e7@haskell.org> #15671: Link errors due to forcibly exporting findPtr -------------------------------------+------------------------------------- Reporter: Phyx- | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: T10955dyn | T10955 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D5138 Wiki Page: | -------------------------------------+------------------------------------- Comment (by bgamari): Strange how this doesn't appear to fail on Linux. Nevertheless, the proposed solution sounds reasonable to me. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 06:15:00 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 06:15:00 -0000 Subject: [GHC] #8400: Migrate the RTS to use libuv (or libev, or libevent) In-Reply-To: <046.b38bad0bbb5fef315e7819ac07954a6b@haskell.org> References: <046.b38bad0bbb5fef315e7819ac07954a6b@haskell.org> Message-ID: <061.ab18828779da0cc43a86699fb9e4e822@haskell.org> #8400: Migrate the RTS to use libuv (or libev, or libevent) -------------------------------------+------------------------------------- Reporter: schyler | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: Component: Runtime System | Version: Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: 635, 7353 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by lelf): * cc: lelf (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 09:55:21 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 09:55:21 -0000 Subject: [GHC] #15687: Type synonym unused binds no warning? Message-ID: <043.df7d8d1951a81ca970949512dabe7d62@haskell.org> #15687: Type synonym unused binds no warning? -------------------------------------+------------------------------------- Reporter: AntC | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 (Parser) | Keywords: | Operating System: Windows Architecture: | Type of failure: GHC accepts Unknown/Multiple | invalid program Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- I was taken aback this was accepted {{{#!hs type Silly a b = Maybe b x :: Silly Int Bool x = Just True y :: Silly Char Bool y = Just False z = x == y -- returns False }}} What's with the `a` in `Silly`'s decl? That's not a phantom type. It's ignored and thrown away. So `x` and `y` are the same type, and can be compare for equality. I expected a rule: all tyvars in the `type`'s head must appear on rhs. Or at least a warning there was something silly. I tried `-Wall, -fwarn- unused-binds`, `-Wunused-type-patterns`. I was just checking up on [https://github.com/ghc-proposals/ghc- proposals/pull/173#issuecomment-424980779 a remark] that type synonyms are at the type level like implicit bidirectional pattern synonyms. For those, all vars must appear on both sides. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 09:59:05 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 09:59:05 -0000 Subject: [GHC] #15688: HAVE_LIBNUMA is defined as non-zero even when libnuma does not exist Message-ID: <043.a3b071a3cac6b25fe5e1d4c70b0395cf@haskell.org> #15688: HAVE_LIBNUMA is defined as non-zero even when libnuma does not exist ----------------------------------------+--------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Build System | Version: 8.6.1 Keywords: | Operating System: Linux Architecture: Unknown/Multiple | Type of failure: None/Unknown Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: ----------------------------------------+--------------------------------- I think this is a regression introduced in the last few weeks. The libnuma dependency is checked correctly by the configure script, but somehow when I don't have libnuma installed I still have `HAVE_LIBNUMA` defined as non-zero so I end up with this error: {{{ /usr/bin/x86_64-linux-gnu-ld.gold: error: cannot find -lnuma rts/posix/OSMem.c:368:0: error: error: undefined reference to 'mbind' | 368 | if (RtsFlags.GcFlags.numa) { | ^ rts/posix/OSMem.c:670:0: error: error: undefined reference to 'numa_num_configured_nodes' | 670 | } | ^ rts/posix/OSMem.c:680:0: error: error: undefined reference to 'numa_get_mems_allowed' | 680 | | ^ rts/posix/OSMem.c:670:0: error: error: undefined reference to 'numa_num_configured_nodes' | 670 | } | ^ rts/posix/OSMem.c:685:0: error: error: undefined reference to 'numa_bitmask_free' | 685 | mask = numa_get_mems_allowed(); | ^ rts/posix/OSMem.c:670:0: error: error: undefined reference to 'numa_num_configured_nodes' | 670 | } | ^ collect2: error: ld returned 1 exit status `gcc' failed in phase `Linker'. (Exit code: 1) utils/ghc-cabal/ghc.mk:56: recipe for target 'utils/ghc- cabal/dist/build/tmp/ghc-cabal' failed }}} Installing libnuma-dev fixes this. Relevant lines in config.log: {{{ CabalHaveLibNuma='False' #define HAVE_LIBNUMA 0 }}} I have no idea why `HAVE_LIBNUMA` is not 0 when compiling the file. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 11:29:25 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 11:29:25 -0000 Subject: [GHC] #15689: s390x builds flood with -Wunused-label warnings Message-ID: <050.f398befb4e7f9999da6779f44973fdec@haskell.org> #15689: s390x builds flood with -Wunused-label warnings -------------------------------------+------------------------------------- Reporter: juhpetersen | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 (CodeGen) | Keywords: | Operating System: Linux Architecture: Other | Type of failure: None/Unknown Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This has been happening for major releases for some time already, but I am finally getting around to reporting this. On s390x when building ghc, huge numbers of -Wunused-label warnings flood gcc output. For example this build: https://koji.fedoraproject.org/koji/taskinfo?taskID=29940997 (note the logs are only kept for 2 weeks) The build.log is 11MB and this is just for compiling less than half of ghc-cabal (270 modules), which generated around 50k unused-label warnings!! So you can imagine the size of a full build. (Well ghc-8.2.2.69.fc29 full build.log was "only" 33MB for s390x vs 8.8MB for x86_64.) For now I patched warnings.mk on s390x to workaround this, but it would be better to fix the root cause I suppose. Here is a small part of the buildlog: {{{ "/usr/bin/ghc" -H32m -O -Wall \ -optc-Wall -optc-fno-stack-protector \ \ -hide-all-packages \ -package ghc-prim -package base -package array -package transformers -package time -package containers -package bytestring -package deepseq -package process -package pretty -package directory -package unix \ --make utils/ghc-cabal/Main.hs -o utils/ghc-cabal/dist/build/tmp /ghc-cabal \ -no-user-package-db \ -Wall -fno-warn-unused-imports -fno-warn-warnings-deprecations \ -DCABAL_VERSION=2,2,0,1 \ -DCABAL_PARSEC \ -DBOOTSTRAPPING \ -odir bootstrapping \ -hidir bootstrapping \ libraries/Cabal/Cabal/Distribution/Parsec/Lexer.hs \ -ilibraries/Cabal/Cabal \ -ilibraries/binary/src \ -ilibraries/filepath \ -ilibraries/hpc \ -ilibraries/mtl \ -ilibraries/text \ libraries/text/cbits/cbits.c \ -Ilibraries/text/include \ -ilibraries/parsec/src \ \ "rm" -f compiler/stage1/build/Config.hs Creating compiler/stage1/build/Config.hs ... done. "rm" -f utils/ghc-pkg/dist/build/Version.hs echo "module Version where" >> utils/ghc- pkg/dist/build/Version.hs echo "version, targetOS, targetARCH :: String" >> utils/ghc- pkg/dist/build/Version.hs echo "version = \"8.4.3\"" >> utils/ghc-pkg/dist/build/Version.hs echo "targetOS = \"linux\"" >> utils/ghc- pkg/dist/build/Version.hs echo "targetARCH = \"s390x\"" >> utils/ghc-pkg/dist/build/Version.hs [ 1 of 270] Compiling Control.Monad.Cont.Class ( libraries/mtl/Control/Monad/Cont/Class.hs, bootstrapping/Control/Monad/Cont/Class.o ) /tmp/ghc705e_0/ghc_130.hc: In function ‘ControlziMonadziContziClass_zdp1MonadCont_entry’: /tmp/ghc705e_0/ghc_130.hc:16:1: error: warning: label ‘_c3bA’ defined but not used [-Wunused-label] _c3bA: ^~~~~ | 16 | _c3bA: | ^ /tmp/ghc705e_0/ghc_130.hc: In function ‘c3bx_entry’: /tmp/ghc705e_0/ghc_130.hc:34:1: error: warning: label ‘_c3bx’ defined but not used [-Wunused-label] _c3bx: ^~~~~ | 34 | _c3bx: | ^ /tmp/ghc705e_0/ghc_130.hc: In function ‘ControlziMonadziContziClass_callCC_entry’: /tmp/ghc705e_0/ghc_130.hc:54:1: error: warning: label ‘_c3bO’ defined but not used [-Wunused-label] _c3bO: ^~~~~ | 54 | _c3bO: | ^ /tmp/ghc705e_0/ghc_130.hc: In function ‘c3bL_entry’: /tmp/ghc705e_0/ghc_130.hc:72:1: error: warning: label ‘_c3bL’ defined but not used [-Wunused-label] _c3bL: ^~~~~ | 72 | _c3bL: | ^ /tmp/ghc705e_0/ghc_130.hc: In function ‘s38I_entry’: /tmp/ghc705e_0/ghc_130.hc:98:1: error: warning: label ‘_c3ca’ defined but not used [-Wunused-label] _c3ca: ^~~~~ | 98 | _c3ca: | ^ /tmp/ghc705e_0/ghc_130.hc: In function ‘s38J_entry’: /tmp/ghc705e_0/ghc_130.hc:125:1: error: warning: label ‘_c3cf’ defined but not used [-Wunused-label] _c3cf: ^~~~~ | 125 | _c3cf: | ^ /tmp/ghc705e_0/ghc_130.hc: In function ‘ControlziMonadziContziClass_zdfMonadContErrorT1_entry’: /tmp/ghc705e_0/ghc_130.hc:152:1: error: warning: label ‘_c3ck’ defined but not used [-Wunused-label] _c3ck: ^~~~~ | 152 | _c3ck: | ^ /tmp/ghc705e_0/ghc_130.hc: In function ‘s38M_entry’: /tmp/ghc705e_0/ghc_130.hc:181:1: error: warning: label ‘_c3cx’ defined but not used [-Wunused-label] _c3cx: ^~~~~ | 181 | _c3cx: | ^ /tmp/ghc705e_0/ghc_130.hc: In function ‘ControlziMonadziContziClass_zdfMonadContErrorTzuzdcp1MonadCont_entry’: /tmp/ghc705e_0/ghc_130.hc:206:1: error: warning: label ‘_c3cA’ defined but not used [-Wunused-label] _c3cA: ^~~~~ | 206 | _c3cA: | ^ /tmp/ghc705e_0/ghc_130.hc: In function ‘s38Q_entry’: /tmp/ghc705e_0/ghc_130.hc:235:1: error: warning: label ‘_c3cO’ defined but not used [-Wunused-label] _c3cO: ^~~~~ | 235 | _c3cO: | ^ /tmp/ghc705e_0/ghc_130.hc: In function ‘s38P_entry’: /tmp/ghc705e_0/ghc_130.hc:257:1: error: warning: label ‘_c3cV’ defined but not used [-Wunused-label] _c3cV: ^~~~~ | 257 | _c3cV: | ^ /tmp/ghc705e_0/ghc_130.hc: In function ‘ControlziMonadziContziClass_zdfMonadContErrorT_entry’: /tmp/ghc705e_0/ghc_130.hc:285:1: error: warning: label ‘_c3cZ’ defined but not used [-Wunused-label] _c3cZ: ^~~~~ | 285 | _c3cZ: | ^ /tmp/ghc705e_0/ghc_130.hc: In function ‘s38W_entry’: /tmp/ghc705e_0/ghc_130.hc:323:1: error: warning: label ‘_c3dj’ defined but not used [-Wunused-label] _c3dj: ^~~~~ | 323 | _c3dj: | ^ /tmp/ghc705e_0/ghc_130.hc: In function ‘s38X_entry’: /tmp/ghc705e_0/ghc_130.hc:350:1: error: warning: label ‘_c3do’ defined but not used [-Wunused-label] _c3do: ^~~~~ | 350 | _c3do: | ^ /tmp/ghc705e_0/ghc_130.hc: In function ‘ControlziMonadziContziClass_zdfMonadContExceptT1_entry’: /tmp/ghc705e_0/ghc_130.hc:377:1: error: warning: label ‘_c3dt’ defined but not used [-Wunused-label] _c3dt: ^~~~~ | 377 | _c3dt: | ^ /tmp/ghc705e_0/ghc_130.hc: In function ‘s38Z_entry’: /tmp/ghc705e_0/ghc_130.hc:411:1: error: warning: label ‘_c3dG’ defined but not used [-Wunused-label] _c3dG: ^~~~~ | 411 | _c3dG: | ^ /tmp/ghc705e_0/ghc_130.hc: In function ‘ControlziMonadziContziClass_zdfMonadContExceptTzuzdcp1MonadCont_entry’: /tmp/ghc705e_0/ghc_130.hc:435:1: error: warning: label ‘_c3dJ’ defined but not used [-Wunused-label] _c3dJ: ^~~~~ | 435 | _c3dJ: | ^ /tmp/ghc705e_0/ghc_130.hc: In function ‘s392_entry’: /tmp/ghc705e_0/ghc_130.hc:462:1: error: warning: label ‘_c3dX’ defined but not used [-Wunused-label] _c3dX: ^~~~~ | }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 11:33:44 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 11:33:44 -0000 Subject: [GHC] #15689: s390x builds flood with -Wunused-label warnings In-Reply-To: <050.f398befb4e7f9999da6779f44973fdec@haskell.org> References: <050.f398befb4e7f9999da6779f44973fdec@haskell.org> Message-ID: <065.41d039118e55cf5314f76691599fa9d6@haskell.org> #15689: s390x builds flood with -Wunused-label warnings ---------------------------------------+------------------------------ Reporter: juhpetersen | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler (CodeGen) | Version: 8.4.3 Resolution: | Keywords: Operating System: Linux | Architecture: Other Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------------+------------------------------ Changes (by juhpetersen): * version: 8.6.1 => 8.4.3 Comment: (I haven't tested yet on 8.6.1 - that will be my next step (after hopefully having finally gotten 8.4.3 to build on s390x now with Debian's Stg.h patch). But I think this probably happens for all 8.x releases - I can check more carefully later, so I would be surprised if 8.6 is not affected too.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 12:47:52 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 12:47:52 -0000 Subject: [GHC] #15687: Type synonym unused binds no warning? In-Reply-To: <043.df7d8d1951a81ca970949512dabe7d62@haskell.org> References: <043.df7d8d1951a81ca970949512dabe7d62@haskell.org> Message-ID: <058.fafd678d39a19fe53b416561205e161d@haskell.org> #15687: Type synonym unused binds no warning? -------------------------------------+------------------------------------- Reporter: AntC | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 (Parser) | Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: GHC accepts | Unknown/Multiple invalid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): I'm not sure why you think that `type` should introduce a ''pattern'' synonym (which, indeed, must mention all its variables on the right-hand side). It just introduces a (not necessarily injective) synonym. It's true that `-XTypeSynonymInstances` allows you to use a type synonym in an instance head. This might suggest the pattern-like behavior you seek. But this works via the expansion of the synonym, meaning that a program with both `instance C (Silly Int Bool)` and `instance C (Silly Char Bool)` will be rightly rejected. Note that this behavior is not new. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 13:04:41 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 13:04:41 -0000 Subject: [GHC] #15685: Pattern signature not inferred In-Reply-To: <051.c5171c2fbdeaddb4c2ac22c9d434e0a0@haskell.org> References: <051.c5171c2fbdeaddb4c2ac22c9d434e0a0@haskell.org> Message-ID: <066.3cc02ec01c78d345dd924839d00eb011@haskell.org> #15685: Pattern signature not inferred -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Resolution: | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): While I can't say that the synonym should be accepted, the fact that `Any` appears in the error message is almost certainly wrong. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 15:27:48 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 15:27:48 -0000 Subject: [GHC] #15688: HAVE_LIBNUMA is defined as non-zero even when libnuma does not exist In-Reply-To: <043.a3b071a3cac6b25fe5e1d4c70b0395cf@haskell.org> References: <043.a3b071a3cac6b25fe5e1d4c70b0395cf@haskell.org> Message-ID: <058.7308d347031a4847f06c432a0a3ab112@haskell.org> #15688: HAVE_LIBNUMA is defined as non-zero even when libnuma does not exist ---------------------------------+---------------------------------------- Reporter: osa1 | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Build System | Version: 8.6.1 Resolution: | Keywords: Operating System: Linux | Architecture: Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ---------------------------------+---------------------------------------- Comment (by bgamari): Can you confirm that `includes/ghcautoconf.h` also sets `HAVE_LIBNUMA` to 0? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 15:40:08 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 15:40:08 -0000 Subject: [GHC] #15687: Type synonym unused binds no warning? In-Reply-To: <043.df7d8d1951a81ca970949512dabe7d62@haskell.org> References: <043.df7d8d1951a81ca970949512dabe7d62@haskell.org> Message-ID: <058.5916803e05b9bade06ac93e9c79e5175@haskell.org> #15687: Type synonym unused binds no warning? -------------------------------------+------------------------------------- Reporter: AntC | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 (Parser) | Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: GHC accepts | Unknown/Multiple invalid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): You could argue that you should get a warning about "unused `a`" in `Silly`'s definition. But we don't warn about {{{ const x y = x }}} so you might consider it inconsistent to warn about the same thing at the type level. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 16:05:17 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 16:05:17 -0000 Subject: [GHC] #15560: Full laziness destroys opportunities for join points In-Reply-To: <047.749103193d66a2bfa9b7c261530a5e01@haskell.org> References: <047.749103193d66a2bfa9b7c261530a5e01@haskell.org> Message-ID: <062.fc8cda4052194d771a88e7f117348f7e@haskell.org> #15560: Full laziness destroys opportunities for join points -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: chessai Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 (CodeGen) | Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14287 #13286 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by chessai): * owner: (none) => chessai * milestone: 8.6.1 => 8.8.1 Comment: I am looking into this. Not sure if it's going to be better, but it would at least be good to have benchmarks for the differences over various mock setups and popular libraries. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 16:17:18 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 16:17:18 -0000 Subject: [GHC] #15560: Full laziness destroys opportunities for join points In-Reply-To: <047.749103193d66a2bfa9b7c261530a5e01@haskell.org> References: <047.749103193d66a2bfa9b7c261530a5e01@haskell.org> Message-ID: <062.918362dea3e9b8c10d34802774b61341@haskell.org> #15560: Full laziness destroys opportunities for join points -------------------------------------+------------------------------------- Reporter: AndreasK | Owner: chessai Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 (CodeGen) | Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: #14287 #13286 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): > I am looking into this. Great -- thank you! -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 16:40:23 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 16:40:23 -0000 Subject: [GHC] #13104: runRW# ruins join points In-Reply-To: <049.de62ded7b05ef8af28dbfe5dd7c43ff2@haskell.org> References: <049.de62ded7b05ef8af28dbfe5dd7c43ff2@haskell.org> Message-ID: <064.3500302fcf854258d54ebef8fa673eb5@haskell.org> #13104: runRW# ruins join points -------------------------------------+------------------------------------- Reporter: lukemaurer | Owner: chessai Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.1 Resolution: | Keywords: JoinPoints Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by chessai): * owner: (none) => chessai * milestone: => 8.8.1 Comment: I would like to work on this as a warm-up to my work on #15560. Reviewing the issue, I agree with Simon's last comment about `runRW#` being treated specially. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 17:13:55 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 17:13:55 -0000 Subject: [GHC] #11955: Haddock documentation for pattern synonyms printed with explicit forall quantifiers In-Reply-To: <046.a6a2b187c86fbb5c93bbd55a34566418@haskell.org> References: <046.a6a2b187c86fbb5c93bbd55a34566418@haskell.org> Message-ID: <061.c2fd71ca9fd5b12e89cfae9c3135a04a@haskell.org> #11955: Haddock documentation for pattern synonyms printed with explicit forall quantifiers -------------------------------------+------------------------------------- Reporter: darchon | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.0.1-rc3 Resolution: | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by harpocrates): * cc: harpocrates (added) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 18:47:50 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 18:47:50 -0000 Subject: [GHC] #15690: Add Eq1/Ord1/Read1/Show1 instances to newtypes in Data.Semigroup Message-ID: <047.495036e9df763c935f3327024510abda@haskell.org> #15690: Add Eq1/Ord1/Read1/Show1 instances to newtypes in Data.Semigroup -------------------------------------+------------------------------------- Reporter: Bodigrim | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: 8.8.1 Component: | Version: 8.6.1 libraries/base | 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'd like to have `Eq1`/`Ord1`/`Read1`/`Show1` instances for newtypes in `Data.Semigroup`, at least for `Min`, `Max` and `Option`. Is there a specific reason for their absence? If no, I'll be happy to prepare a PR. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 20:45:56 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 20:45:56 -0000 Subject: [GHC] #15009: Float equalities past local equalities In-Reply-To: <047.0a49c3ac676b2b3bc6f93c4594762c08@haskell.org> References: <047.0a49c3ac676b2b3bc6f93c4594762c08@haskell.org> Message-ID: <062.8bcd54351255da612006b8db0912b5c7@haskell.org> #15009: Float equalities past local equalities -------------------------------------+------------------------------------- Reporter: goldfire | Owner: (none) Type: feature request | Status: closed Priority: normal | Milestone: 8.4.3 Component: Compiler | Version: 8.2.2 Resolution: fixed | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: gadt/T15009 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): Hmm. I think you may be suggesting this transformation on constraints: {{{ forall tvs1. blah1 => forall tvs2. blah2 => unsolved-stuff --> forall (tvs1, tvs2). (blah1, blah2) => unsolved-stuff }}} The hope would be that an equality in the inner `blah2` might look like `(a~ty)`, where `a` is bound by the outer `tvs1`. If so, then in the transformed implication, the equality would fall under `Note [Let-bound skolems]`, and we could float things from `unsolved-stuff` out. I think that is plausible, and it's an interesting idea that I had not onsidered.. The side condition is that there are no "wanteds" as a peer to the inner implication, like this {{{ forall tvs1. blah1 => ( forall tvs2. blah2 => unsolved-stuff , alpha ~ Int ) }}} If there was, the argument of comment:11 would apply. But what if there were ''two'' such implications? Floating constraints out of either would disable floating constraints out of the other! This looks complicated and unprincipled to me. I suggest just using a type signature. Extremely complicated type inference is not necessarily a boon to the programmer! Perhaps there is a simple, principled algorithm hiding in there; but I don't yet see it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 20:47:39 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 20:47:39 -0000 Subject: [GHC] #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 In-Reply-To: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> References: <043.32eb5b85b23ae8693c74c6f6abd5a883@haskell.org> Message-ID: <058.3379d95536442a375d6c9da190cf3ecc@haskell.org> #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0 -------------------------------------+------------------------------------- Reporter: noah | Owner: tdammers Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: | accelerate,memory,compile Operating System: Linux | Architecture: x86_64 | (amd64) Type of failure: Compile-time | Test Case: accelerate performance bug | 1.2.0 Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by simonpj): * cc: benl@… (added) Comment: I talked to Ben Lippmeier at ICFP, who said he'd look into the accelerate end of this ticket, and discuss it with Trevor. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 21:05:16 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 21:05:16 -0000 Subject: [GHC] #15674: GADT's displayed type is misleading In-Reply-To: <043.9b768266188379838903cb47df1bf014@haskell.org> References: <043.9b768266188379838903cb47df1bf014@haskell.org> Message-ID: <058.61b9925803a48b3395f6ec04579fe865@haskell.org> #15674: GADT's displayed type is misleading -------------------------------------+------------------------------------- Reporter: AntC | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1-beta1 Resolution: | Keywords: Operating System: Windows | Architecture: x86_64 Type of failure: Poor/confusing | (amd64) error message | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by goldfire): Replying to [comment:5 AntC]: > > There is no `forall` in `MkDG`, which doesn't quantify over any variables. > > > > Then I totally ignore the `a` in the `data DG a where ...`? In GADT syntax, the bit between the `data` and the `where` is the declaration for the type only -- not any constructors. The `a` there serves to say that `DG` takes one argument. It does not affect or cause any variable quantification in constructors. > > For `MkDG2`, with `-fprint-explicit-foralls` > `:i` shows `MkDG2 :: forall a. (a ~ Int) => a -> DG a` > > `:t` shows `MkDG2 :: Int -> DG Int` > > With `-fno-print-explicit-foralls` > `:i` shows `MkDG2 :: (a ~ Int) => a -> DG a` > > `:t` shows `MkDG2 :: Int -> DG Int` > > Is that intended behaviour? It doesn't seem either internally consistent, nor consistent with your explanation: why is the `forall` appearing at all? Why is it appearing for `:i` but not `:t`? Yes, this is all expected behavior. Haskell allows you omit `forall`s if you have a type variable in a type. But when you write `-fprint-explicit- foralls`, it will print one even if you left it out. So: the `forall` appears because you asked for it. I'll quote myself: > `:type ` gives you the type that is assigned to it if you had `let it = `. It's a uniform rule that always works. When we say `let it = MkDG2`, GHC instantiates the type of `MkDG2` at its occurrence and then generalizes (because `let`-bound variables are generalized). Thus, `it` might not have exactly the same type as `MkDG2`, which is what's happening here. Here's a simpler example: {{{#!hs silly :: (Ord a, Eq a) => a -> Bool silly = ... }}} Asking for `:t silly` gives you `Ord a => a -> Bool`. This is because we instantiate and regeneralize the type of `silly`. In this process, GHC realizes that `Eq a` is redundant and drops it. The same is happening with `MkDG2`. > What I'm looking for with these mind-blowingly similar-but- "subtly different" nuances is strong help from the compiler to navigate error messages when I get my types wrong. Short of a use of a type application (which doesn't seem to be what you're doing), `MkDG` and `MkDG2` behave identically. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 21:13:21 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 21:13:21 -0000 Subject: [GHC] #15471: Polymorphism, typed splices and type inference don't mix In-Reply-To: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> References: <049.084aa260e703fc9ae584d3d54f195e8c@haskell.org> Message-ID: <064.bddd0e80da4a9188ffa6717d7b935d92@haskell.org> #15471: Polymorphism, typed splices and type inference don't mix -------------------------------------+------------------------------------- Reporter: mpickering | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Template Haskell | Version: 8.4.3 Resolution: | 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: | -------------------------------------+------------------------------------- Comment (by simonpj): After chatting with Matthew at ICFP, we identified that the really troubling thing about this ticket is the inconsistency between the typing of `qux` with (works) and without (fails) a type signature. This is mentioned in the Description, but I had not focused on it before. On investigation, I find it is worse than I thought. Consider {{{ {-# LANGUAGE TemplateHaskell #-} module Def where import Language.Haskell.TH foo :: Q (TExp a) -> Q (TExp [a]) foo x = [|| [ $$x, $$x ] ||] }}} This defines a perfectly decent typed-TH function `foo`. Now try {{{ {-# LANGUAGE TemplateHaskell #-} module Foo where import Language.Haskell.TH import TH bar y = $$(foo [|| y ||] ) }}} Note, no type signature. What type gets inferred for `bar`? Answer {{{ TYPE SIGNATURES bar :: GHC.Types.Any -> [GHC.Types.Any] }}} Yikes! Of course it should be {{{ bar :: a -> [a] }}} and indeed that type signature works. Why does this happen? Becuase `TcSplice.tcTopSplice` calls `tcTopSpliceExpr`, and the latter concludes with {{{ -- Zonk it and tie the knot of dictionary bindings ; zonkTopLExpr (mkHsDictLet (EvBinds const_binds) expr') } }}} At this moment the type checker is inside `bar`'s `\y -> ...`, so we have `y :: alpha` for some as-yet-unknown unification variable `alpha`. Alas, the `zonkTopLExpr` turns that unification variable into `Any`, and after that there is no way back. One way out might be to make the zonker less aggressive; make it leave unification variables alone. But that means that the entire optimisation pipeline would, for the first time, have to accommodate unification variables in Core terms. Currently it's an invariant that no such unification variables exist. I don't think anything would actually break, but it Just Seems Wrong. Richard suggested an interesting alternative: defer actually ''running'' typed-TH splices until the zonker, or the desugarer. When we encounter `$$( e )` we have to: 1. Typecheck `e`, ensuring it has type `Q (TExp ty)`; then `$$( e )` has type `ty`. 2. Compile and run the code `e`, to generate some (renamed) `HsSyn` code. 3. Typecheck the `HsSyn GhcRn` code it generates, to add the elaboration: type abstractions type applications and so on. Because it's ''typed'' TH, we know that (3) can't fail. So at typecheck time we could do (1) and stop, leaving steps (2) and (3) to be done after typechecking is complete. Interesting. There's a real bug here. I like the idea of deferring running the splice. I'm not sure whether the desugarer or the zonker is best. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sat Sep 29 22:05:58 2018 From: ghc-devs at haskell.org (GHC) Date: Sat, 29 Sep 2018 22:05:58 -0000 Subject: [GHC] #15687: Type synonym unused binds no warning? In-Reply-To: <043.df7d8d1951a81ca970949512dabe7d62@haskell.org> References: <043.df7d8d1951a81ca970949512dabe7d62@haskell.org> Message-ID: <058.88e8a4325982f9c6144855db0c709bc3@haskell.org> #15687: Type synonym unused binds no warning? -------------------------------------+------------------------------------- Reporter: AntC | Owner: (none) Type: feature request | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 (Parser) | Resolution: | Keywords: Operating System: Windows | Architecture: Type of failure: GHC accepts | Unknown/Multiple invalid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by AntC): > Note that this behavior is not new. Indeed. Probably been there forever: there's nothing in the Report requiring all type vars to appear on rhs. I can't see there would ever be any sense in it, though; unlike unused vars in other places, for which there's `-fwarn-unused-binds`. > we don't warn about ... There's sense to not using all the arguments at term level. Never the less it's sufficiently unusual for GHC to recognise a special form. You can (I usually do) write {{{#!hs const x _ = x const x _y = x }}} (Yes I could use `_a` for `Silly`, but I can still see no sense to it.) In some contexs, using `_` avoids getting a warning. (I'm thinking this for `type` could be a small tweak/enhancement for somebody starting GHC development: steal the logic from checking bidirectional patterns.) -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 30 06:46:59 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 30 Sep 2018 06:46:59 -0000 Subject: [GHC] #15648: Core Lint error with source-level unboxed equality In-Reply-To: <050.b1c8c377aa63cdac74b3d157d20320e2@haskell.org> References: <050.b1c8c377aa63cdac74b3d157d20320e2@haskell.org> Message-ID: <065.62252a55a3d86f82d582d59b0e7465b5@haskell.org> #15648: Core Lint error with source-level unboxed equality -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: #15209 | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by simonpj): I can see several things here. 1. `(~#)` has a funny kind (see `prelude/TysPrim`: {{{ (~#) :: forall k1 k2. k1 -> k2 -> TYPE (TupleRep []) }}} The kind `TYPE TupleRep []` says that values of this type are represented by a zero-tuple of values; which takes zero bits. 2. Note that it does ''not'' have return kind `Constraint`. Indeed, it can't, because that would mean it had a boxed, lifted representation, since (after the type checker) `Constraint` and `Type` are the same. So it won't behave like an invisible argument, because it doesn't have kind `Constraint`. Making `(~#)` behave like `(~)` in source code would be problematic for this reason. 3. In Core, term-level variables (`Id`) are split into coercion variables (`CoVar`s) and all others; distinguished by their `IdDetails` field, and `isCoVarId`. Coercion variables can be ''bound'' in terms (say by a lambda) but, unlike other Ids, can ''occur'' only in types and coercions. The simplifier keeps them in a different environment for that reason. In short: * A variable should reply True to `isCoVarId` '''iff''' it has type `t1 ~# t2` or `t1 ~R# t2`. * A `CoVar` should occur only in types or coercions, never in a term (i.e. `Var` in Core). Lint checks for the latter, but not the former; I'll fix that. 4. This program has a non-`CoVar` bound by a lambda, and that's why the simplifier is breaking. TL;DR: there a shortcoming in Lint, which I'll fix. Beyond that, GHC should really give a better error than a Lint failure in this case, but it's a bit exotic, and I'm not really sure where the best place to do it is. Maybe `chekcValidType`? -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 30 09:44:49 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 30 Sep 2018 09:44:49 -0000 Subject: [GHC] #15623: Wrong Endian, ghc-pwd and ghc-cabal on ghc 8.0.1 for powerpc64le (IBM Power) In-Reply-To: <058.92eeca5309f093ba094bb7b979a5550b@haskell.org> References: <058.92eeca5309f093ba094bb7b979a5550b@haskell.org> Message-ID: <073.a06822a9985c3eb14cd19ba8f75aad53@haskell.org> #15623: Wrong Endian, ghc-pwd and ghc-cabal on ghc 8.0.1 for powerpc64le (IBM Power) ----------------------------------------+--------------------------------- Reporter: francescantoncastro | Owner: (none) Type: bug | Status: closed Priority: highest | Milestone: 8.6.1 Component: Compiler | Version: 8.0.1 Resolution: invalid | Keywords: Operating System: Linux | Architecture: powerpc64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------------+--------------------------------- Changes (by trommler): * status: new => closed * resolution: => invalid Comment: Are you sure your machine is running in little endian mode? In the configure script `compilingghc8.0.1onpowerpc64le` it is detected as powerpc64 which is big endian. The bindist you downloaded is for big endian systems there is no bindist for powerpc64le available on the GHC site. I prepared a powerpc64le bindist for GHC 8.2.1 for openSUSE. You can find it here: https://build.opensuse.org/package/show/devel:languages:haskell/ghc- bootstrap If you are looking for a newer GHC (8.2.1 cannot be used to bootstrap 8.6.1) you can find a GHC 8.4.3 bindist for powerpc64le temporarily here: https://build.opensuse.org/package/show/home:ptrommler:branches:devel:languages:haskell /ghc-bootstrap Hope that helps. I'll close the ticket as invalid for now. Please reopen if it still doesn't work. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 30 12:44:21 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 30 Sep 2018 12:44:21 -0000 Subject: [GHC] #10986: GHC should delete all temporary files it creates in /tmp In-Reply-To: <044.1681438585b48fcd6c17fa0b77a432bd@haskell.org> References: <044.1681438585b48fcd6c17fa0b77a432bd@haskell.org> Message-ID: <059.f593958f542296056f79a4c74b397ef8@haskell.org> #10986: GHC should delete all temporary files it creates in /tmp -------------------------------------+------------------------------------- Reporter: erikd | Owner: (none) Type: feature request | Status: new Priority: high | Milestone: Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D2324 Wiki Page: | -------------------------------------+------------------------------------- Comment (by monoidal): I found out this still happens with Template Haskell + -fno-code. Given `M.hs` {{{ {-# LANGUAGE TemplateHaskell #-} module M where $(return []) }}} compiling `ghc -fno-code -v2 M.hs` fails to remove the directory: {{{ *** Deleting temp dirs: Warning: exception raised when deleting /tmp/ghc17992_0: /tmp/ghc17992_0: removeDirectory: unsatisfied constraints (Directory not empty) }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 30 13:30:47 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 30 Sep 2018 13:30:47 -0000 Subject: [GHC] #15691: Marking Pred(S n) = n as injective Message-ID: <051.d7e7ce03c23f4752318f13248c7822e5@haskell.org> #15691: Marking Pred(S n) = n as injective -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 (Type checker) | Keywords: TypeFamilies, | Operating System: Unknown/Multiple InjectiveFamilies | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Should `Pred` be injective? Please close the ticket if this is a known limitation {{{#!hs {-# Language DataKinds, TypeFamilyDependencies #-} data N = O | S N type family Pred n = res | res -> n where Pred(S n) = n }}} fails with {{{ • Type family equation violates injectivity annotation. RHS of injective type family equation is a bare type variable but these LHS type and kind patterns are not bare variables: ‘'S n’ Pred ('S n) = n -- Defined at 462.hs:7:2 • In the equations for closed type family ‘Pred’ In the type family declaration for ‘Pred’ | 7 | Pred(S n) = n | ^^^^^^^^^^^^^ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 30 13:48:27 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 30 Sep 2018 13:48:27 -0000 Subject: [GHC] #15113: Do not make CAFs from literal strings In-Reply-To: <046.d042ad82da8658ea11bcd44bf2d86387@haskell.org> References: <046.d042ad82da8658ea11bcd44bf2d86387@haskell.org> Message-ID: <061.44fd990bec4578b63190fbeb11ca84fd@haskell.org> #15113: Do not make CAFs from literal strings -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: patch Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.2.2 Resolution: | Keywords: CAFs Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D4717 Wiki Page: | -------------------------------------+------------------------------------- Comment (by osa1): I started looking into this, but I realized that nofib can't be run with GHC 8.6 (and probably with HEAD) so I'll need to fix nofib first. What I've done so far is I implemented two counters: - A runtime counter for SRT traversals done by the GC - A compiler counter to count how many SRTs are generated (I'm also recording sum of sizes of the SRTs although this is probably not too useful) The runtime counter is printed with `+RTS -t`: {{{ <> }}} The "226752 SRT scavs" part is new, and it means that we scavenged 226752 SRTs. The compiler counter prints once per binding group and it looks like this: {{{ SRTs: 4 SRT(s), total size: 17 }}} This means that 4 SRTs are generated, and total size of all those SRTs are 17 words. The patch is here: https://github.com/osa1/ghc/commit/c46fe24a02591edd3ce7b6aa70246493826d218d I'll fix nofib first and then try to collect these numbers from nofib output. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 30 14:20:29 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 30 Sep 2018 14:20:29 -0000 Subject: [GHC] #15691: Marking Pred(S n) = n as injective In-Reply-To: <051.d7e7ce03c23f4752318f13248c7822e5@haskell.org> References: <051.d7e7ce03c23f4752318f13248c7822e5@haskell.org> Message-ID: <066.2131cdd664aadb68d15eb5743db6156e@haskell.org> #15691: Marking Pred(S n) = n as injective -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: closed Priority: normal | Milestone: 8.6.1 Component: Compiler (Type | Version: 8.6.1 checker) | Keywords: TypeFamilies, Resolution: invalid | InjectiveFamilies Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by monoidal): * status: new => closed * cc: goldfire (added) * resolution: => invalid Comment: Yes, it's a known limitation. See [http://ics.p.lodz.pl/~stolarek/_media/pl:research:stolarek_peyton- jones_eisenberg_injectivity.pdf "Injective Type Families for Haskell"], section 4.1, "Awkward Case 2". By definition of `Pred` we have `Pred (S (Pred Zero)) ~ Pred Zero`. If `Pred` is recognized as injective, then `Zero ~ S (Pred Zero)`, which is a contradiction. The problem is that `Pred Zero` is a valid type, even though it's outside of the domain of `Pred`. See also #9636. The [https://repository.brynmawr.edu/cgi/viewcontent.cgi?article=1075&context=compsci_pubs Constrained Type Families] paper resolves this by representing the domain of the type function as a constraint. I don't know if there are plans to implement it. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 30 14:33:22 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 30 Sep 2018 14:33:22 -0000 Subject: [GHC] #15692: GHC panic from pattern synonyms + deferred type errors Message-ID: <051.39157d43d1b8d263a8e2728339a9f8aa@haskell.org> #15692: GHC panic from pattern synonyms + deferred type errors -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Keywords: | Operating System: Unknown/Multiple PatternSynonyms, TypeInType | Architecture: | Type of failure: Compile-time Unknown/Multiple | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- {{{#!hs {-# Language DataKinds, TypeOperators, PolyKinds, PatternSynonyms, GADTs #-} {-# Options_GHC -dcore-lint -fdefer-type-errors #-} import Data.Kind data Ctx :: Type -> Type where E :: Ctx(Type) (:&:) :: a -> Ctx(as) -> Ctx(a -> as) data ApplyT (k::Type) :: k -> Ctx(k) -> Type where AO :: a -> ApplyT(Type) a E AS :: ApplyT(ks) (f a) ctx -> ApplyT(k -> ks) f (a:&:ctx) pattern ASSO = AS (AS (AO False)) }}} {{{ $ ghci -ignore-dot-ghci 463.hs hs/463.hs:16:27: warning: [-Wdeferred-type-errors] • Couldn't match type ‘a a1 a2’ with ‘Bool’ Expected type: a3 Actual type: Bool • In the pattern: False In the pattern: AO False In the pattern: AS (AO False) | 16 | pattern ASSO = AS (AS (AO False)) | ^^^^^ ghc-stage2: panic! (the 'impossible' happened) (GHC version 8.7.20180828 for x86_64-unknown-linux): urk! lookup local fingerprint $mASSO [iESflb :-> ($trModule, 1ca40dc83a9c879effdb760462cc9a2d), iESgKD :-> ($tc'E, 79f67a27a14dc1bb6eecb39e4b061e2c), iESgKF :-> ($tc':&:, 24793c0c1652ffcf92e04f47d38fa075), iESgKH :-> ($tcCtx, a3f9358cbfe161bf59e75500d70ce0ae), iESgKI :-> ($tc'AO, 72111d1891cb082e989c20a2191a8b4b), iESgKK :-> ($tc'AS, ff019c04c400d5fbdd46ff8a816d4913), iESgKM :-> ($tcApplyT, cbfe28374b4115925c7213e6330ab115)] Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1160:37 in ghc:Outputable pprPanic, called at compiler/iface/MkIface.hs:524:37 in ghc:MkIface Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug > }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 30 14:52:19 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 30 Sep 2018 14:52:19 -0000 Subject: [GHC] #15692: GHC panic from pattern synonyms + deferred type errors In-Reply-To: <051.39157d43d1b8d263a8e2728339a9f8aa@haskell.org> References: <051.39157d43d1b8d263a8e2728339a9f8aa@haskell.org> Message-ID: <066.8f19162e9d798406e2f0ebfc9bf73a46@haskell.org> #15692: GHC panic from pattern synonyms + deferred type errors -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Resolution: | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * keywords: PatternSynonyms, TypeInType => PatternSynonyms Comment: Here's a version which doesn't require any `TypeInType` voodoo: {{{#!hs {-# LANGUAGE GADTs #-} {-# LANGUAGE PatternSynonyms #-} {-# OPTIONS_GHC -fdefer-type-errors #-} module Bug where data F x where FS :: F (f a) -> F a pattern FS' = FS False }}} {{{ $ /opt/ghc/8.6.1/bin/ghc Bug.hs [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) Bug.hs:9:18: warning: [-Wdeferred-type-errors] • Couldn't match expected type ‘F (f x)’ with actual type ‘Bool’ • In the pattern: False In the pattern: FS False In the declaration for pattern synonym ‘FS'’ | 9 | pattern FS' = FS False | ^^^^^ ghc: panic! (the 'impossible' happened) (GHC version 8.6.1 for x86_64-unknown-linux): urk! lookup local fingerprint $mFS' [iESfI6 :-> ($trModule, 550028d00664444fecdab255e6368e70), iESgIq :-> ($tc'FS, a6b7c6b435bb17f938e26b19c786b9e3), iESgIs :-> ($tcF, 59ff366e0583120727f8be6ecf210589)] Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1160:37 in ghc:Outputable pprPanic, called at compiler/iface/MkIface.hs:524:37 in ghc:MkIface }}} This is a regression from GHC 8.4.3: {{{ $ /opt/ghc/8.4.3/bin/ghci Bug.hs GHCi, version 8.4.3: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Bug.hs:9:18: warning: [-Wdeferred-type-errors] • Couldn't match expected type ‘F (f x)’ with actual type ‘Bool’ • In the pattern: False In the pattern: FS False In the declaration for pattern synonym ‘FS'’ | 9 | pattern FS' = FS False | ^^^^^ Bug.hs:9:18: warning: [-Wdeferred-type-errors] • Couldn't match expected type ‘F (f0 x)’ with actual type ‘Bool’ • In the first argument of ‘FS’, namely ‘False’ In the expression: FS False In an equation for ‘FS'’: FS' = FS False • Relevant bindings include $bFS' :: F x (bound at Bug.hs:9:9) | 9 | pattern FS' = FS False | ^^^^^ }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 30 14:55:55 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 30 Sep 2018 14:55:55 -0000 Subject: [GHC] #15693: Abstracting out pattern into a pattern synonym fails with scary error Message-ID: <051.5637636d2d1e053a5f3f7fb9b58522eb@haskell.org> #15693: Abstracting out pattern into a pattern synonym fails with scary error -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Keywords: | Operating System: Unknown/Multiple PatternSynonyms | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This '''works''' {{{#!hs {-# Language DataKinds, TypeOperators, PolyKinds, PatternSynonyms, GADTs #-} import Data.Kind data Ctx :: Type -> Type where E :: Ctx(Type) (:&:) :: a -> Ctx(as) -> Ctx(a -> as) data ApplyT(kind::Type) :: kind -> Ctx(kind) -> Type where AO :: a -> ApplyT(Type) a E AS :: ApplyT(ks) (f a) ctx -> ApplyT(k -> ks) f (a:&:ctx) foo :: ApplyT(Type -> Type -> Type) Either a -> () foo (ASSO (Left a)) = () pattern ASSO a = AS (AS (AO a)) }}} but then you might think, let's give a name (pattern synonym) to `ASSO (Left a)` This '''fails''' {{{#!hs {-# Language DataKinds, TypeOperators, PolyKinds, PatternSynonyms, GADTs #-} import Data.Kind data Ctx :: Type -> Type where E :: Ctx(Type) (:&:) :: a -> Ctx(as) -> Ctx(a -> as) data ApplyT(kind::Type) :: kind -> Ctx(kind) -> Type where AO :: a -> ApplyT(Type) a E AS :: ApplyT(ks) (f a) ctx -> ApplyT(k -> ks) f (a:&:ctx) pattern ASSO a = AS (AS (AO a)) pattern ASSOLeft a = ASSO (Left a) }}} {{{ $ ghci -ignore-dot-ghci 464.hs GHCi, version 8.7.20180828: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( hs/464.hs, interpreted ) hs/464.hs:16:22: error: • Couldn't match type ‘k1’ with ‘*’ ‘k1’ is a rigid type variable bound by the signature for pattern synonym ‘ASSOLeft’ at hs/464.hs:16:1-34 Expected type: ApplyT kind a b Actual type: ApplyT (* -> * -> *) Either (a1 ':&: (a20 ':&: 'E)) • In the expression: ASSO (Left a) In an equation for ‘ASSOLeft’: ASSOLeft a = ASSO (Left a) | 16 | pattern ASSOLeft a = ASSO (Left a) | ^^^^^^^^^^^^^ hs/464.hs:16:28: error: • Could not deduce: k1 ~ * from the context: (kind ~ (k -> ks), a ~~ f, b ~~ (a2 ':&: ctx), ks ~ (k1 -> ks1), f a2 ~~ f1, ctx ~~ (a3 ':&: ctx1), ks1 ~ *, f1 a3 ~~ a4, ctx1 ~~ 'E) bound by a pattern with pattern synonym: ASSO :: forall kind (a :: kind) (b :: Ctx kind). () => forall ks k (f :: k -> ks) (a1 :: k) (ctx :: Ctx ks) ks1 k1 (f1 :: k1 -> ks1) (a2 :: k1) (ctx1 :: Ctx ks1) a3. (kind ~ (k -> ks), a ~~ f, b ~~ (a1 ':&: ctx), ks ~ (k1 -> ks1), f a1 ~~ f1, ctx ~~ (a2 ':&: ctx1), ks1 ~ *, f1 a2 ~~ a3, ctx1 ~~ 'E) => a3 -> ApplyT kind a b, in a pattern synonym declaration at hs/464.hs:16:22-34 ‘k1’ is a rigid type variable bound by a pattern with pattern synonym: ASSO :: forall kind (a :: kind) (b :: Ctx kind). () => forall ks k (f :: k -> ks) (a1 :: k) (ctx :: Ctx ks) ks1 k1 (f1 :: k1 -> ks1) (a2 :: k1) (ctx1 :: Ctx ks1) a3. (kind ~ (k -> ks), a ~~ f, b ~~ (a1 ':&: ctx), ks ~ (k1 -> ks1), f a1 ~~ f1, ctx ~~ (a2 ':&: ctx1), ks1 ~ *, f1 a2 ~~ a3, ctx1 ~~ 'E) => a3 -> ApplyT kind a b, in a pattern synonym declaration at hs/464.hs:16:22-34 When matching types a3 :: k1 b0 :: * Expected type: a4 Actual type: Either a1 b0 • In the pattern: Left a In the pattern: ASSO (Left a) In the declaration for pattern synonym ‘ASSOLeft’ | 16 | pattern ASSOLeft a = ASSO (Left a) | ^^^^^^ Failed, no modules loaded. Prelude> }}} ---- Can I, as a user, assume that any valid pattern `foo (ASSO (Left a)) = ...` can be abstracted into a pattern synonym? There error message is too scary for me to sensibly know what to expect -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 30 14:57:07 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 30 Sep 2018 14:57:07 -0000 Subject: [GHC] #15693: Abstracting out pattern into a pattern synonym fails with scary error In-Reply-To: <051.5637636d2d1e053a5f3f7fb9b58522eb@haskell.org> References: <051.5637636d2d1e053a5f3f7fb9b58522eb@haskell.org> Message-ID: <066.42787115c5a335e6a96fa56356559712@haskell.org> #15693: Abstracting out pattern into a pattern synonym fails with scary error -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Resolution: | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by Iceland_jack): If users can not always abstract patterns into synonyms, are there any rules of thumbs for when that is possible -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 30 15:11:07 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 30 Sep 2018 15:11:07 -0000 Subject: [GHC] #15460: Literals overflow In-Reply-To: <045.4d90b83e8c6931283f442559046619d4@haskell.org> References: <045.4d90b83e8c6931283f442559046619d4@haskell.org> Message-ID: <060.e128f01e69499b1beb9a8fd9b5d5c818@haskell.org> #15460: Literals overflow -------------------------------------+------------------------------------- Reporter: hsyl20 | Owner: harpocrates Type: bug | Status: new Priority: normal | Milestone: 8.8.1 Component: Compiler | Version: 8.4.3 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Incorrect result | Unknown/Multiple at runtime | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by harpocrates): * owner: (none) => harpocrates Comment: Literal overflow warnings are being added in https://phabricator.haskell.org/D5181. After that gets merged, I'll add a testcase for this (then we'll close?). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 30 15:52:17 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 30 Sep 2018 15:52:17 -0000 Subject: [GHC] #15692: GHC panic from pattern synonyms + deferred type errors In-Reply-To: <051.39157d43d1b8d263a8e2728339a9f8aa@haskell.org> References: <051.39157d43d1b8d263a8e2728339a9f8aa@haskell.org> Message-ID: <066.1ba14c1dfb1d9dcc3c2e5fe61b74ae6a@haskell.org> #15692: GHC panic from pattern synonyms + deferred type errors -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Resolution: | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by RyanGlScott): * cc: simonpj (added) Comment: Somewhat ironically, commit 149d7912eb84a24861b021c13d2ee61b44de5856 (`Fix error recovery for pattern synonyms`) introduced this. -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 30 17:54:56 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 30 Sep 2018 17:54:56 -0000 Subject: [GHC] #15694: GHC panic from pattern synonym, "Type-correct unfilled coercion hole" Message-ID: <051.eef99d48758aa3732858d34fad575ab5@haskell.org> #15694: GHC panic from pattern synonym, "Type-correct unfilled coercion hole" -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Keywords: | Operating System: Unknown/Multiple PatternSynonyms | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- {{{#!hs {-# Language RankNTypes, PatternSynonyms, TypeOperators, DataKinds, PolyKinds, KindSignatures, GADTs #-} import Data.Kind import Data.Type.Equality data Ctx :: Type -> Type where E :: Ctx(Type) (:&:) :: a -> Ctx(as) -> Ctx(a -> as) data ApplyT(kind::Type) :: kind -> Ctx(kind) -> Type where AO :: a -> ApplyT(Type) a E AS :: ApplyT(ks) (f a) ctx -> ApplyT(k -> ks) f (a:&:ctx) pattern ASSO :: () => forall ks k (f :: k -> ks) (a1 :: k) (ctx :: Ctx ks) (ks1 :: Type) k1 (a2 :: k1) (ctx1 :: Ctx ks1) a3. (kind ~ (k -> ks), a ~~ f, b ~~ (a1 :&: ctx), ks ~ (k1 -> ks1), ctx ~~ (a2 :&: E), ks1 ~ Type, f a1 a2 ~~ a3) => a3 -> ApplyT kind a b pattern ASSO a = AS (AS (AO a)) }}} {{{ baldur at KindStar:~/hs$ ghci -ignore-dot-ghci 465.hs GHCi, version 8.7.20180828: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( 465.hs, interpreted ) WARNING: file compiler/types/TyCoRep.hs, line 2378 in_scope InScope {kind_a1Cw a_a1Cx b_a1Cy ks_a1Cz k_a1CA f_a1CB a1_a1CC ctx_a1CD ks1_a1CE k1_a1CF a2_a1CG ctx1_a1CH a3_a1CI k0_a1F8} tenv [a1Cw :-> kind_a1Cw[sk:0], a1Cx :-> a_a1Cx[sk:0], a1Cy :-> b_a1Cy[sk:0], a1Cz :-> ks_a1Cz[sk:0], a1CA :-> k_a1CA[sk:0], a1CB :-> f_a1CB[sk:0], a1CC :-> a1_a1CC[sk:0], a1CD :-> ctx_a1CD[sk:0], a1CE :-> ks1_a1CE[sk:0], a1CF :-> k1_a1CF[sk:0], a1CG :-> a2_a1CG[sk:0], a1CH :-> ctx1_a1CH[sk:0], a1CI :-> a3_a1CI[sk:0]] cenv [] tys [kind_a1Cw[sk:1] ~ (k_a1CA[sk:2] -> ks_a1Cz[sk:2]), a_a1Cx[sk:1] ~~ f_a1CB[sk:2], b_a1Cy[sk:1] ~~ (a1_a1CC[sk:2] ':&: ctx_a1CD[sk:2]), ks_a1Cz[sk:2] ~ (k1_a1CF[sk:2] -> ks1_a1CE[sk:2]), ctx_a1CD[sk:2] ~~ (a2_a1CG[sk:2] ':&: 'E), ks1_a1CE[sk:2] ~ *, (f_a1CB[sk:2] a1_a1CC[sk:2] |> {co_a1Fc}) a2_a1CG[sk:2] ~~ a3_a1CI[sk:2]] cos [] needInScope [a1F8 :-> k0_a1F8[sk:2], a1Fc :-> co_a1Fc] WARNING: file compiler/types/TyCoRep.hs, line 2378 in_scope InScope {kind_a1Cw a_a1Cx b_a1Cy k0_a1HA ks_a1HB k_a1HC f_a1HD a1_a1HE ctx_a1HF ks1_a1HG k1_a1HH a2_a1HI ctx1_a1HJ a3_a1HK} tenv [a1Cz :-> ks_a1HB[tau:4], a1CA :-> k_a1HC[tau:4], a1CB :-> f_a1HD[tau:4], a1CC :-> a1_a1HE[tau:4], a1CD :-> ctx_a1HF[tau:4], a1CE :-> ks1_a1HG[tau:4], a1CF :-> k1_a1HH[tau:4], a1CG :-> a2_a1HI[tau:4], a1CH :-> ctx1_a1HJ[tau:4], a1CI :-> a3_a1HK[tau:4], a1F8 :-> k0_a1HA[tau:4]] cenv [] tys [kind_a1Cw[sk:0] ~ (k_a1CA[sk:0] -> ks_a1Cz[sk:0]), a_a1Cx[sk:0] ~~ f_a1CB[sk:0], b_a1Cy[sk:0] ~~ (a1_a1CC[sk:0] ':&: ctx_a1CD[sk:0]), ks_a1Cz[sk:0] ~ (k1_a1CF[sk:0] -> ks1_a1CE[sk:0]), ctx_a1CD[sk:0] ~~ (a2_a1CG[sk:0] ':&: 'E), ks1_a1CE[sk:0] ~ *, (f_a1CB[sk:0] a1_a1CC[sk:0] |> {co_a1Fc}) a2_a1CG[sk:0] ~~ a3_a1CI[sk:0]] cos [] needInScope [a1Cw :-> kind_a1Cw[sk:0], a1Cx :-> a_a1Cx[sk:0], a1Cy :-> b_a1Cy[sk:0], a1Fc :-> co_a1Fc] ghc-stage2: panic! (the 'impossible' happened) (GHC version 8.7.20180828 for x86_64-unknown-linux): ASSERT failed! Type-correct unfilled coercion hole {co_a1Fc} Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1160:37 in ghc:Outputable pprPanic, called at compiler/utils/Outputable.hs:1219:5 in ghc:Outputable assertPprPanic, called at compiler/typecheck/TcHsSyn.hs:1716:99 in ghc:TcHsSyn Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug > }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 30 17:56:00 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 30 Sep 2018 17:56:00 -0000 Subject: [GHC] #15694: GHC panic from pattern synonym, "Type-correct unfilled coercion hole" In-Reply-To: <051.eef99d48758aa3732858d34fad575ab5@haskell.org> References: <051.eef99d48758aa3732858d34fad575ab5@haskell.org> Message-ID: <066.f5f040ff83612c0bb364994b4d54e654@haskell.org> #15694: GHC panic from pattern synonym, "Type-correct unfilled coercion hole" -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Resolution: | Keywords: | PatternSynonyms Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by Iceland_jack: Old description: > {{{#!hs > {-# Language RankNTypes, PatternSynonyms, TypeOperators, DataKinds, > PolyKinds, KindSignatures, GADTs #-} > > import Data.Kind > import Data.Type.Equality > > data Ctx :: Type -> Type where > E :: Ctx(Type) > (:&:) :: a -> Ctx(as) -> Ctx(a -> as) > > data ApplyT(kind::Type) :: kind -> Ctx(kind) -> Type where > AO :: a -> ApplyT(Type) a E > AS :: ApplyT(ks) (f a) ctx > -> ApplyT(k -> ks) f (a:&:ctx) > > pattern ASSO :: () => forall ks k (f :: k -> ks) (a1 :: k) (ctx :: Ctx > ks) (ks1 :: Type) k1 (a2 :: k1) (ctx1 :: Ctx ks1) a3. (kind ~ (k -> ks), > a ~~ f, b ~~ (a1 :&: ctx), ks ~ (k1 -> ks1), ctx ~~ (a2 :&: E), ks1 ~ > Type, f a1 a2 ~~ a3) => a3 -> ApplyT kind a b > pattern ASSO a = AS (AS (AO a)) > }}} > > {{{ > baldur at KindStar:~/hs$ ghci -ignore-dot-ghci 465.hs > GHCi, version 8.7.20180828: http://www.haskell.org/ghc/ :? for help > [1 of 1] Compiling Main ( 465.hs, interpreted ) > WARNING: file compiler/types/TyCoRep.hs, line 2378 > in_scope InScope {kind_a1Cw a_a1Cx b_a1Cy ks_a1Cz k_a1CA f_a1CB > a1_a1CC ctx_a1CD ks1_a1CE k1_a1CF a2_a1CG ctx1_a1CH > a3_a1CI > k0_a1F8} > tenv [a1Cw :-> kind_a1Cw[sk:0], a1Cx :-> a_a1Cx[sk:0], > a1Cy :-> b_a1Cy[sk:0], a1Cz :-> ks_a1Cz[sk:0], > a1CA :-> k_a1CA[sk:0], a1CB :-> f_a1CB[sk:0], > a1CC :-> a1_a1CC[sk:0], a1CD :-> ctx_a1CD[sk:0], > a1CE :-> ks1_a1CE[sk:0], a1CF :-> k1_a1CF[sk:0], > a1CG :-> a2_a1CG[sk:0], a1CH :-> ctx1_a1CH[sk:0], > a1CI :-> a3_a1CI[sk:0]] > cenv [] > tys [kind_a1Cw[sk:1] ~ (k_a1CA[sk:2] -> ks_a1Cz[sk:2]), > a_a1Cx[sk:1] ~~ f_a1CB[sk:2], > b_a1Cy[sk:1] ~~ (a1_a1CC[sk:2] ':&: ctx_a1CD[sk:2]), > ks_a1Cz[sk:2] ~ (k1_a1CF[sk:2] -> ks1_a1CE[sk:2]), > ctx_a1CD[sk:2] ~~ (a2_a1CG[sk:2] ':&: 'E), ks1_a1CE[sk:2] ~ *, > (f_a1CB[sk:2] a1_a1CC[sk:2] |> {co_a1Fc}) a2_a1CG[sk:2] > ~~ a3_a1CI[sk:2]] > cos [] > needInScope [a1F8 :-> k0_a1F8[sk:2], a1Fc :-> co_a1Fc] > WARNING: file compiler/types/TyCoRep.hs, line 2378 > in_scope InScope {kind_a1Cw a_a1Cx b_a1Cy k0_a1HA ks_a1HB k_a1HC > f_a1HD a1_a1HE ctx_a1HF ks1_a1HG k1_a1HH a2_a1HI > ctx1_a1HJ a3_a1HK} > tenv [a1Cz :-> ks_a1HB[tau:4], a1CA :-> k_a1HC[tau:4], > a1CB :-> f_a1HD[tau:4], a1CC :-> a1_a1HE[tau:4], > a1CD :-> ctx_a1HF[tau:4], a1CE :-> ks1_a1HG[tau:4], > a1CF :-> k1_a1HH[tau:4], a1CG :-> a2_a1HI[tau:4], > a1CH :-> ctx1_a1HJ[tau:4], a1CI :-> a3_a1HK[tau:4], > a1F8 :-> k0_a1HA[tau:4]] > cenv [] > tys [kind_a1Cw[sk:0] ~ (k_a1CA[sk:0] -> ks_a1Cz[sk:0]), > a_a1Cx[sk:0] ~~ f_a1CB[sk:0], > b_a1Cy[sk:0] ~~ (a1_a1CC[sk:0] ':&: ctx_a1CD[sk:0]), > ks_a1Cz[sk:0] ~ (k1_a1CF[sk:0] -> ks1_a1CE[sk:0]), > ctx_a1CD[sk:0] ~~ (a2_a1CG[sk:0] ':&: 'E), ks1_a1CE[sk:0] ~ *, > (f_a1CB[sk:0] a1_a1CC[sk:0] |> {co_a1Fc}) a2_a1CG[sk:0] > ~~ a3_a1CI[sk:0]] > cos [] > needInScope [a1Cw :-> kind_a1Cw[sk:0], a1Cx :-> a_a1Cx[sk:0], > a1Cy :-> b_a1Cy[sk:0], a1Fc :-> co_a1Fc] > ghc-stage2: panic! (the 'impossible' happened) > (GHC version 8.7.20180828 for x86_64-unknown-linux): > ASSERT failed! > Type-correct unfilled coercion hole {co_a1Fc} > Call stack: > CallStack (from HasCallStack): > callStackDoc, called at compiler/utils/Outputable.hs:1160:37 in > ghc:Outputable > pprPanic, called at compiler/utils/Outputable.hs:1219:5 in > ghc:Outputable > assertPprPanic, called at compiler/typecheck/TcHsSyn.hs:1716:99 > in ghc:TcHsSyn > > Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug > > > > }}} New description: {{{#!hs {-# Language RankNTypes, PatternSynonyms, TypeOperators, DataKinds, PolyKinds, KindSignatures, GADTs #-} import Data.Kind import Data.Type.Equality data Ctx :: Type -> Type where E :: Ctx(Type) (:&:) :: a -> Ctx(as) -> Ctx(a -> as) data ApplyT(kind::Type) :: kind -> Ctx(kind) -> Type where AO :: a -> ApplyT(Type) a E AS :: ApplyT(ks) (f a) ctx -> ApplyT(k -> ks) f (a:&:ctx) pattern ASSO :: () => forall ks k (f :: k -> ks) (a1 :: k) (ctx :: Ctx ks) (ks1 :: Type) k1 (a2 :: k1) (ctx1 :: Ctx ks1) a3. (kind ~ (k -> ks), a ~~ f, b ~~ (a1 :&: ctx), ks ~ (k1 -> ks1), ctx ~~ (a2 :&: E), ks1 ~ Type, f a1 a2 ~~ a3) => a3 -> ApplyT kind a b pattern ASSO a = AS (AS (AO a)) }}} {{{ $ ghci -ignore-dot-ghci 465.hs GHCi, version 8.7.20180828: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( 465.hs, interpreted ) WARNING: file compiler/types/TyCoRep.hs, line 2378 in_scope InScope {kind_a1Cw a_a1Cx b_a1Cy ks_a1Cz k_a1CA f_a1CB a1_a1CC ctx_a1CD ks1_a1CE k1_a1CF a2_a1CG ctx1_a1CH a3_a1CI k0_a1F8} tenv [a1Cw :-> kind_a1Cw[sk:0], a1Cx :-> a_a1Cx[sk:0], a1Cy :-> b_a1Cy[sk:0], a1Cz :-> ks_a1Cz[sk:0], a1CA :-> k_a1CA[sk:0], a1CB :-> f_a1CB[sk:0], a1CC :-> a1_a1CC[sk:0], a1CD :-> ctx_a1CD[sk:0], a1CE :-> ks1_a1CE[sk:0], a1CF :-> k1_a1CF[sk:0], a1CG :-> a2_a1CG[sk:0], a1CH :-> ctx1_a1CH[sk:0], a1CI :-> a3_a1CI[sk:0]] cenv [] tys [kind_a1Cw[sk:1] ~ (k_a1CA[sk:2] -> ks_a1Cz[sk:2]), a_a1Cx[sk:1] ~~ f_a1CB[sk:2], b_a1Cy[sk:1] ~~ (a1_a1CC[sk:2] ':&: ctx_a1CD[sk:2]), ks_a1Cz[sk:2] ~ (k1_a1CF[sk:2] -> ks1_a1CE[sk:2]), ctx_a1CD[sk:2] ~~ (a2_a1CG[sk:2] ':&: 'E), ks1_a1CE[sk:2] ~ *, (f_a1CB[sk:2] a1_a1CC[sk:2] |> {co_a1Fc}) a2_a1CG[sk:2] ~~ a3_a1CI[sk:2]] cos [] needInScope [a1F8 :-> k0_a1F8[sk:2], a1Fc :-> co_a1Fc] WARNING: file compiler/types/TyCoRep.hs, line 2378 in_scope InScope {kind_a1Cw a_a1Cx b_a1Cy k0_a1HA ks_a1HB k_a1HC f_a1HD a1_a1HE ctx_a1HF ks1_a1HG k1_a1HH a2_a1HI ctx1_a1HJ a3_a1HK} tenv [a1Cz :-> ks_a1HB[tau:4], a1CA :-> k_a1HC[tau:4], a1CB :-> f_a1HD[tau:4], a1CC :-> a1_a1HE[tau:4], a1CD :-> ctx_a1HF[tau:4], a1CE :-> ks1_a1HG[tau:4], a1CF :-> k1_a1HH[tau:4], a1CG :-> a2_a1HI[tau:4], a1CH :-> ctx1_a1HJ[tau:4], a1CI :-> a3_a1HK[tau:4], a1F8 :-> k0_a1HA[tau:4]] cenv [] tys [kind_a1Cw[sk:0] ~ (k_a1CA[sk:0] -> ks_a1Cz[sk:0]), a_a1Cx[sk:0] ~~ f_a1CB[sk:0], b_a1Cy[sk:0] ~~ (a1_a1CC[sk:0] ':&: ctx_a1CD[sk:0]), ks_a1Cz[sk:0] ~ (k1_a1CF[sk:0] -> ks1_a1CE[sk:0]), ctx_a1CD[sk:0] ~~ (a2_a1CG[sk:0] ':&: 'E), ks1_a1CE[sk:0] ~ *, (f_a1CB[sk:0] a1_a1CC[sk:0] |> {co_a1Fc}) a2_a1CG[sk:0] ~~ a3_a1CI[sk:0]] cos [] needInScope [a1Cw :-> kind_a1Cw[sk:0], a1Cx :-> a_a1Cx[sk:0], a1Cy :-> b_a1Cy[sk:0], a1Fc :-> co_a1Fc] ghc-stage2: panic! (the 'impossible' happened) (GHC version 8.7.20180828 for x86_64-unknown-linux): ASSERT failed! Type-correct unfilled coercion hole {co_a1Fc} Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1160:37 in ghc:Outputable pprPanic, called at compiler/utils/Outputable.hs:1219:5 in ghc:Outputable assertPprPanic, called at compiler/typecheck/TcHsSyn.hs:1716:99 in ghc:TcHsSyn Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug > }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 30 19:06:14 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 30 Sep 2018 19:06:14 -0000 Subject: [GHC] #15695: Core Lint error, from -fobject-code + defer type errors + pattern synonyms + other stuff Message-ID: <051.924cbdebca03c5aa89a4c1b89bc4850d@haskell.org> #15695: Core Lint error, from -fobject-code + defer type errors + pattern synonyms + other stuff -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: Compile-time Unknown/Multiple | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Try running this (`-fobject-code` is required) with '''and''' without `-dcore-lint`. I tried to minimize it but it is still hefty. This is showing it without `-dcore-lint`: {{{#!hs {-# Language RankNTypes, PatternSynonyms, DataKinds, PolyKinds, GADTs, TypeOperators, MultiParamTypeClasses, TypeFamilies, TypeSynonymInstances, FlexibleInstances, InstanceSigs, FlexibleContexts #-} {-# Options_GHC -fdefer-type-errors #-} import Data.Kind import Data.Type.Equality data TyVar :: Type -> Type -> Type where VO :: TyVar (a -> as) a VS :: TyVar as a -> TyVar (b -> as) a data NP :: (k -> Type) -> ([k] -> Type) where Nil :: NP f '[] (:*) :: f a -> NP f as -> NP f (a:as) data NS :: (k -> Type) -> ([k] -> Type) where Here :: f a -> NS f (a:as) There :: NS f as -> NS f (a:as) infixr 6 :&: data Ctx :: Type -> Type where E :: Ctx(Type) (:&:) :: a -> Ctx(as) -> Ctx(a -> as) data NA a type SOP(kind::Type) code = NS (NP NA) code data ApplyT(kind::Type) :: kind -> Ctx(kind) -> Type where AO :: a -> ApplyT(Type) a E AS :: ApplyT(ks) (f a) ctx -> ApplyT(k -> ks) f (a:&:ctx) from' :: ApplyT(Type -> Type -> Type) Either ctx -> NS (NP NA) '[ '[VO] ] from' (ASSO (Left a)) = Here (a :* Nil) from' (ASSO (Right b)) = There (Here undefined) pattern ASSO :: () => forall (ks :: Type) k (f :: k -> ks) (a1 :: k) (ks1 :: Type) k1 (f1 :: k1 -> ks1) (a2 :: k1) a3. (kind ~ (k -> k1 -> Type), a ~~ f, b ~~ (a1 :&: a2 :&: E), f a1 ~~ f1, f1 a2 ~~ a3) => a3 -> ApplyT kind a b pattern ASSO a = AS (AS (AO a)) }}} {{{ $ latestbug -fobject-code 466.hs GHCi, version 8.7.20180828: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( 466.hs, 466.o ) 466.hs:35:14: warning: [-Wdeferred-type-errors] • Could not deduce: a2 ~ NA 'VO from the context: ((* -> * -> *) ~ (k1 -> k2 -> *), Either ~~ f, ctx ~~ (a2 ':&: (a3 ':&: 'E)), f a2 ~~ f1, f1 a3 ~~ a4) bound by a pattern with pattern synonym: ASSO :: forall kind (a :: kind) (b :: Ctx kind). () => forall ks k (f :: k -> ks) (a1 :: k) ks1 k1 (f1 :: k1 -> ks1) (a2 :: k1) a3. (kind ~ (k -> k1 -> *), a ~~ f, b ~~ (a1 ':&: (a2 ':&: 'E)), f a1 ~~ f1, f1 a2 ~~ a3) => a3 -> ApplyT kind a b, in an equation for ‘from'’ at 466.hs:35:8-21 ‘a2’ is a rigid type variable bound by a pattern with pattern synonym: ASSO :: forall kind (a :: kind) (b :: Ctx kind). () => forall ks k (f :: k -> ks) (a1 :: k) ks1 k1 (f1 :: k1 -> ks1) (a2 :: k1) a3. (kind ~ (k -> k1 -> *), a ~~ f, b ~~ (a1 ':&: (a2 ':&: 'E)), f a1 ~~ f1, f1 a2 ~~ a3) => a3 -> ApplyT kind a b, in an equation for ‘from'’ at 466.hs:35:8-21 Expected type: a4 Actual type: Either (NA 'VO) a3 • In the pattern: Left a In the pattern: ASSO (Left a) In an equation for ‘from'’: from' (ASSO (Left a)) = Here (a :* Nil) • Relevant bindings include from' :: ApplyT (* -> * -> *) Either ctx -> NS (NP NA) '[ '[ 'VO]] (bound at 466.hs:35:1) | 35 | from' (ASSO (Left a)) = Here (a :* Nil) | ^^^^^^^ 466.hs:36:26: warning: [-Wdeferred-type-errors] • Couldn't match type ‘a0 : as0’ with ‘'[]’ Expected type: NS (NP NA) '[ '[ 'VO]] Actual type: NS (NP NA) ('[ 'VO] : a0 : as0) • In the expression: There (Here undefined) In an equation for ‘from'’: from' (ASSO (Right b)) = There (Here undefined) • Relevant bindings include from' :: ApplyT (* -> * -> *) Either ctx -> NS (NP NA) '[ '[ 'VO]] (bound at 466.hs:35:1) | 36 | from' (ASSO (Right b)) = There (Here undefined) | ^^^^^^^^^^^^^^^^^^^^^^ WARNING: file compiler/types/TyCoRep.hs, line 2378 in_scope InScope {wild_00 wild_Xl wild_Xv wild_X1m a_a1Gv ks_a1Ou k_a1Ov f_a1Ow a_a1Ox ctx_a1Oy co_a1Oz co_a1OA co_a1OB ks_a1OC k_a1OD f_a1OE a_a1OF ctx_a1OG co_a1OH co_a1OI co_a1OJ a_a1OK co_a1OL co_a1OM co_a1ON as_a1Q3 a_a1Q4 ctx_a1Q5 $krep_a2XW $krep_a2XX $krep_a2XY $krep_a2XZ $krep_a2Y0 $krep_a2Y1 $krep_a2Y2 $krep_a2Y3 $krep_a2Y4 $krep_a2Y5 $krep_a2Y6 $krep_a2Y7 $krep_a2Y8 $krep_a2Y9 $krep_a2Ya $krep_a2Yb $krep_a2Yc $krep_a2Yd $krep_a2Ye $krep_a2Yf $krep_a2Yg $krep_a2Yh $krep_a2Yi $krep_a2Yj $krep_a2Yk $krep_a2Yl $krep_a2Ym $krep_a2Yn $krep_a2Yo $krep_a2Yp $krep_a2Yq $krep_a2Yr $krep_a2Ys $krep_a2Yt $krep_a2Yu $krep_a2Yv $krep_a2Yw $krep_a2Yx $krep_a2Yy $krep_a2Yz $krep_a2YA $krep_a2YB $krep_a2YC $krep_a2YD $krep_a2YE $krep_a2YF $krep_a2YG $krep_a2YH $krep_a2YI $krep_a2YJ $krep_a2YK $krep_a2YL ds_d2YO ds_d2YP ds_d2YV fail_d2Z2 from' $bASSO $mASSO $tc':&: $tc':* $tc'AO $tc'AS $tc'E $tc'Here $tc'Nil $tc'There $tc'VO $tc'VS $tcApplyT $tcCtx $tcNA $tcNP $tcNS $tcTyVar $trModule $trModule_s2ZM $trModule_s2ZN $trModule_s2ZO $trModule_s2ZP $krep_s2ZQ $krep_s2ZR $krep_s2ZS $krep_s2ZT $krep_s2ZU $krep_s2ZV $krep_s2ZW $krep_s2ZX $tcTyVar_s2ZY $tcTyVar_s2ZZ $krep_s300 $krep_s301 $krep_s302 $krep_s303 $tc'VO_s304 $tc'VO_s305 $krep_s306 $krep_s307 $tc'VS_s308 $tc'VS_s309 $tcNP_s30a $tcNP_s30b $krep_s30c $krep_s30d $krep_s30e $krep_s30f $krep_s30g $krep_s30h $tc':*_s30i $tc':*_s30j $krep_s30k $krep_s30l $krep_s30m $tc'Nil_s30n $tc'Nil_s30o $tcNS_s30p $tcNS_s30q $krep_s30r $krep_s30s $krep_s30t $krep_s30u $krep_s30v $krep_s30w $tc'Here_s30x $tc'Here_s30y $krep_s30z $krep_s30A $krep_s30B $tc'There_s30C $tc'There_s30D $tcCtx_s30E $tcCtx_s30F $krep_s30G $krep_s30H $krep_s30I $tc':&:_s30J $tc':&:_s30K $krep_s30L $krep_s30M $krep_s30N $krep_s30O $krep_s30P $tc'E_s30Q $tc'E_s30R $tcNA_s30S $tcNA_s30T $tcApplyT_s30U $tcApplyT_s30V $krep_s30W $krep_s30X $krep_s30Y $krep_s30Z $krep_s310 $krep_s311 $tc'AS_s312 $tc'AS_s313 $krep_s314 $krep_s315 $krep_s316 $tc'AO_s317 $tc'AO_s318} tenv [a1Ow :-> f_a1Ow, a1Ox :-> a_a1Ox, a1Oy :-> ctx_a1Oy, a1OE :-> f_a1OE, a1OF :-> a_a1OF, a1OG :-> ctx_a1OG] cenv [a1Oz :-> co_a1Oz, a1OA :-> co_a1OA, a1OB :-> co_a1OB, a1OH :-> co_a1OH, a1OI :-> co_a1OI, a1OJ :-> co_a1OJ, a1OL :-> co_a1OL, a1OM :-> co_a1OM, a1ON :-> co_a1ON] tys [a_a1Ox ~# (NA 'VO |> Sym (Nth:2 (Sym co_a2U0)))] cos [] needInScope [a1Ov :-> k_a1Ov, a1OD :-> k_a1OD, a1Q3 :-> as_a1Q3, a1Q4 :-> a_a1Q4, a2U0 :-> co_a2U0] WARNING: file compiler/types/TyCoRep.hs, line 2378 in_scope InScope {wild_00 wild_Xl wild_Xv wild_X1m a_a1Gv ks_a1Ou k_a1Ov f_a1Ow a_a1Ox ctx_a1Oy co_a1Oz co_a1OA co_a1OB ks_a1OC k_a1OD f_a1OE a_a1OF ctx_a1OG co_a1OH co_a1OI co_a1OJ a_a1OK co_a1OL co_a1OM co_a1ON as_a1Q3 a_a1Q4 ctx_a1Q5 $krep_a2XW $krep_a2XX $krep_a2XY $krep_a2XZ $krep_a2Y0 $krep_a2Y1 $krep_a2Y2 $krep_a2Y3 $krep_a2Y4 $krep_a2Y5 $krep_a2Y6 $krep_a2Y7 $krep_a2Y8 $krep_a2Y9 $krep_a2Ya $krep_a2Yb $krep_a2Yc $krep_a2Yd $krep_a2Ye $krep_a2Yf $krep_a2Yg $krep_a2Yh $krep_a2Yi $krep_a2Yj $krep_a2Yk $krep_a2Yl $krep_a2Ym $krep_a2Yn $krep_a2Yo $krep_a2Yp $krep_a2Yq $krep_a2Yr $krep_a2Ys $krep_a2Yt $krep_a2Yu $krep_a2Yv $krep_a2Yw $krep_a2Yx $krep_a2Yy $krep_a2Yz $krep_a2YA $krep_a2YB $krep_a2YC $krep_a2YD $krep_a2YE $krep_a2YF $krep_a2YG $krep_a2YH $krep_a2YI $krep_a2YJ $krep_a2YK $krep_a2YL ds_d2YO ds_d2YP ds_d2YV fail_d2Z2 from' $bASSO $mASSO $tc':&: $tc':* $tc'AO $tc'AS $tc'E $tc'Here $tc'Nil $tc'There $tc'VO $tc'VS $tcApplyT $tcCtx $tcNA $tcNP $tcNS $tcTyVar $trModule $trModule_s2ZM $trModule_s2ZN $trModule_s2ZO $trModule_s2ZP $krep_s2ZQ $krep_s2ZR $krep_s2ZS $krep_s2ZT $krep_s2ZU $krep_s2ZV $krep_s2ZW $krep_s2ZX $tcTyVar_s2ZY $tcTyVar_s2ZZ $krep_s300 $krep_s301 $krep_s302 $krep_s303 $tc'VO_s304 $tc'VO_s305 $krep_s306 $krep_s307 $tc'VS_s308 $tc'VS_s309 $tcNP_s30a $tcNP_s30b $krep_s30c $krep_s30d $krep_s30e $krep_s30f $krep_s30g $krep_s30h $tc':*_s30i $tc':*_s30j $krep_s30k $krep_s30l $krep_s30m $tc'Nil_s30n $tc'Nil_s30o $tcNS_s30p $tcNS_s30q $krep_s30r $krep_s30s $krep_s30t $krep_s30u $krep_s30v $krep_s30w $tc'Here_s30x $tc'Here_s30y $krep_s30z $krep_s30A $krep_s30B $tc'There_s30C $tc'There_s30D $tcCtx_s30E $tcCtx_s30F $krep_s30G $krep_s30H $krep_s30I $tc':&:_s30J $tc':&:_s30K $krep_s30L $krep_s30M $krep_s30N $krep_s30O $krep_s30P $tc'E_s30Q $tc'E_s30R $tcNA_s30S $tcNA_s30T $tcApplyT_s30U $tcApplyT_s30V $krep_s30W $krep_s30X $krep_s30Y $krep_s30Z $krep_s310 $krep_s311 $tc'AS_s312 $tc'AS_s313 $krep_s314 $krep_s315 $krep_s316 $tc'AO_s317 $tc'AO_s318} tenv [a1Ow :-> f_a1Ow, a1Ox :-> a_a1Ox, a1Oy :-> ctx_a1Oy, a1OE :-> f_a1OE, a1OF :-> a_a1OF, a1OG :-> ctx_a1OG] cenv [a1Oz :-> co_a1Oz, a1OA :-> co_a1OA, a1OB :-> co_a1OB, a1OH :-> co_a1OH, a1OI :-> co_a1OI, a1OJ :-> co_a1OJ, a1OL :-> co_a1OL, a1OM :-> co_a1OM, a1ON :-> co_a1ON] tys [a_a1Ox ~# (NA 'VO |> Sym (Nth:2 (Sym co_a2U0)))] cos [] needInScope [a1Ov :-> k_a1Ov, a1OD :-> k_a1OD, a1Q3 :-> as_a1Q3, a1Q4 :-> a_a1Q4, a2U0 :-> co_a2U0] Ok, one module loaded. Prelude Main> }}} -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 30 19:11:58 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 30 Sep 2018 19:11:58 -0000 Subject: [GHC] #15695: Core Lint error, from -fobject-code + defer type errors + pattern synonyms + other stuff In-Reply-To: <051.924cbdebca03c5aa89a4c1b89bc4850d@haskell.org> References: <051.924cbdebca03c5aa89a4c1b89bc4850d@haskell.org> Message-ID: <066.c9c5f3b267455020d9bcf2af1e631a28@haskell.org> #15695: Core Lint error, from -fobject-code + defer type errors + pattern synonyms + other stuff -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Description changed by Iceland_jack: Old description: > Try running this (`-fobject-code` is required) with '''and''' without > `-dcore-lint`. I tried to minimize it but it is still hefty. This is > showing it without `-dcore-lint`: > > {{{#!hs > {-# Language RankNTypes, PatternSynonyms, DataKinds, PolyKinds, GADTs, > TypeOperators, MultiParamTypeClasses, TypeFamilies, TypeSynonymInstances, > FlexibleInstances, InstanceSigs, FlexibleContexts #-} > > {-# Options_GHC -fdefer-type-errors #-} > > import Data.Kind > import Data.Type.Equality > > data TyVar :: Type -> Type -> Type where > VO :: TyVar (a -> as) a > VS :: TyVar as a -> TyVar (b -> as) a > > data NP :: (k -> Type) -> ([k] -> Type) where > Nil :: NP f '[] > (:*) :: f a -> NP f as -> NP f (a:as) > > data NS :: (k -> Type) -> ([k] -> Type) where > Here :: f a -> NS f (a:as) > There :: NS f as -> NS f (a:as) > > infixr 6 :&: > data Ctx :: Type -> Type where > E :: Ctx(Type) > (:&:) :: a -> Ctx(as) -> Ctx(a -> as) > > data NA a > > type SOP(kind::Type) code = NS (NP NA) code > > data ApplyT(kind::Type) :: kind -> Ctx(kind) -> Type where > AO :: a -> ApplyT(Type) a E > AS :: ApplyT(ks) (f a) ctx > -> ApplyT(k -> ks) f (a:&:ctx) > > from' :: ApplyT(Type -> Type -> Type) Either ctx -> NS (NP NA) '[ '[VO] ] > from' (ASSO (Left a)) = Here (a :* Nil) > from' (ASSO (Right b)) = There (Here undefined) > > pattern ASSO > :: () => > forall (ks :: Type) k (f :: k -> ks) (a1 :: k) (ks1 :: Type) k1 (f1 > :: k1 -> ks1) (a2 :: k1) a3. > (kind ~ (k -> k1 -> Type), a ~~ f, b ~~ (a1 :&: a2 :&: E), > f a1 ~~ f1, f1 a2 ~~ a3) => > a3 -> ApplyT kind a b > pattern ASSO a = AS (AS (AO a)) > }}} > > {{{ > $ latestbug -fobject-code 466.hs > GHCi, version 8.7.20180828: http://www.haskell.org/ghc/ :? for help > [1 of 1] Compiling Main ( 466.hs, 466.o ) > 466.hs:35:14: warning: [-Wdeferred-type-errors] > • Could not deduce: a2 ~ NA 'VO > from the context: ((* -> * -> *) ~ (k1 -> k2 -> *), Either ~~ f, > ctx ~~ (a2 ':&: (a3 ':&: 'E)), f a2 ~~ f1, f1 a3 > ~~ a4) > bound by a pattern with pattern synonym: > ASSO :: forall kind (a :: kind) (b :: Ctx kind). > () => > forall ks k (f :: k -> ks) (a1 :: k) ks1 k1 > (f1 :: k1 > -> ks1) (a2 :: k1) a3. > (kind ~ (k -> k1 -> *), a ~~ f, b ~~ (a1 ':&: > (a2 ':&: 'E)), > f a1 ~~ f1, f1 a2 ~~ a3) => > a3 -> ApplyT kind a b, > in an equation for ‘from'’ > at 466.hs:35:8-21 > ‘a2’ is a rigid type variable bound by > a pattern with pattern synonym: > ASSO :: forall kind (a :: kind) (b :: Ctx kind). > () => > forall ks k (f :: k -> ks) (a1 :: k) ks1 k1 (f1 :: k1 > -> > ks1) (a2 :: k1) a3. > (kind ~ (k -> k1 -> *), a ~~ f, b ~~ (a1 ':&: (a2 ':&: > 'E)), > f a1 ~~ f1, f1 a2 ~~ a3) => > a3 -> ApplyT kind a b, > in an equation for ‘from'’ > at 466.hs:35:8-21 > Expected type: a4 > Actual type: Either (NA 'VO) a3 > • In the pattern: Left a > In the pattern: ASSO (Left a) > In an equation for ‘from'’: from' (ASSO (Left a)) = Here (a :* Nil) > • Relevant bindings include > from' :: ApplyT (* -> * -> *) Either ctx -> NS (NP NA) '[ '[ > 'VO]] > (bound at 466.hs:35:1) > | > 35 | from' (ASSO (Left a)) = Here (a :* Nil) > | ^^^^^^^ > > 466.hs:36:26: warning: [-Wdeferred-type-errors] > • Couldn't match type ‘a0 : as0’ with ‘'[]’ > Expected type: NS (NP NA) '[ '[ 'VO]] > Actual type: NS (NP NA) ('[ 'VO] : a0 : as0) > • In the expression: There (Here undefined) > In an equation for ‘from'’: > from' (ASSO (Right b)) = There (Here undefined) > • Relevant bindings include > from' :: ApplyT (* -> * -> *) Either ctx -> NS (NP NA) '[ '[ > 'VO]] > (bound at 466.hs:35:1) > | > 36 | from' (ASSO (Right b)) = There (Here undefined) > | ^^^^^^^^^^^^^^^^^^^^^^ > WARNING: file compiler/types/TyCoRep.hs, line 2378 > in_scope InScope {wild_00 wild_Xl wild_Xv wild_X1m a_a1Gv ks_a1Ou > k_a1Ov f_a1Ow a_a1Ox ctx_a1Oy co_a1Oz co_a1OA co_a1OB > ks_a1OC > k_a1OD f_a1OE a_a1OF ctx_a1OG co_a1OH co_a1OI co_a1OJ > a_a1OK > co_a1OL co_a1OM co_a1ON as_a1Q3 a_a1Q4 ctx_a1Q5 > $krep_a2XW > $krep_a2XX $krep_a2XY $krep_a2XZ $krep_a2Y0 > $krep_a2Y1 $krep_a2Y2 > $krep_a2Y3 $krep_a2Y4 $krep_a2Y5 $krep_a2Y6 > $krep_a2Y7 $krep_a2Y8 > $krep_a2Y9 $krep_a2Ya $krep_a2Yb $krep_a2Yc > $krep_a2Yd $krep_a2Ye > $krep_a2Yf $krep_a2Yg $krep_a2Yh $krep_a2Yi > $krep_a2Yj $krep_a2Yk > $krep_a2Yl $krep_a2Ym $krep_a2Yn $krep_a2Yo > $krep_a2Yp $krep_a2Yq > $krep_a2Yr $krep_a2Ys $krep_a2Yt $krep_a2Yu > $krep_a2Yv $krep_a2Yw > $krep_a2Yx $krep_a2Yy $krep_a2Yz $krep_a2YA > $krep_a2YB $krep_a2YC > $krep_a2YD $krep_a2YE $krep_a2YF $krep_a2YG > $krep_a2YH $krep_a2YI > $krep_a2YJ $krep_a2YK $krep_a2YL ds_d2YO ds_d2YP > ds_d2YV fail_d2Z2 > from' $bASSO $mASSO $tc':&: $tc':* $tc'AO $tc'AS > $tc'E $tc'Here > $tc'Nil $tc'There $tc'VO $tc'VS $tcApplyT $tcCtx > $tcNA $tcNP $tcNS > $tcTyVar $trModule $trModule_s2ZM $trModule_s2ZN > $trModule_s2ZO > $trModule_s2ZP $krep_s2ZQ $krep_s2ZR $krep_s2ZS > $krep_s2ZT > $krep_s2ZU $krep_s2ZV $krep_s2ZW $krep_s2ZX > $tcTyVar_s2ZY > $tcTyVar_s2ZZ $krep_s300 $krep_s301 $krep_s302 > $krep_s303 > $tc'VO_s304 $tc'VO_s305 $krep_s306 $krep_s307 > $tc'VS_s308 > $tc'VS_s309 $tcNP_s30a $tcNP_s30b $krep_s30c > $krep_s30d $krep_s30e > $krep_s30f $krep_s30g $krep_s30h $tc':*_s30i > $tc':*_s30j $krep_s30k > $krep_s30l $krep_s30m $tc'Nil_s30n $tc'Nil_s30o > $tcNS_s30p > $tcNS_s30q $krep_s30r $krep_s30s $krep_s30t > $krep_s30u $krep_s30v > $krep_s30w $tc'Here_s30x $tc'Here_s30y $krep_s30z > $krep_s30A > $krep_s30B $tc'There_s30C $tc'There_s30D $tcCtx_s30E > $tcCtx_s30F > $krep_s30G $krep_s30H $krep_s30I $tc':&:_s30J > $tc':&:_s30K > $krep_s30L $krep_s30M $krep_s30N $krep_s30O > $krep_s30P $tc'E_s30Q > $tc'E_s30R $tcNA_s30S $tcNA_s30T $tcApplyT_s30U > $tcApplyT_s30V > $krep_s30W $krep_s30X $krep_s30Y $krep_s30Z > $krep_s310 $krep_s311 > $tc'AS_s312 $tc'AS_s313 $krep_s314 $krep_s315 > $krep_s316 > $tc'AO_s317 $tc'AO_s318} > tenv [a1Ow :-> f_a1Ow, a1Ox :-> a_a1Ox, a1Oy :-> ctx_a1Oy, > a1OE :-> f_a1OE, a1OF :-> a_a1OF, a1OG :-> ctx_a1OG] > cenv [a1Oz :-> co_a1Oz, a1OA :-> co_a1OA, a1OB :-> co_a1OB, > a1OH :-> co_a1OH, a1OI :-> co_a1OI, a1OJ :-> co_a1OJ, > a1OL :-> co_a1OL, a1OM :-> co_a1OM, a1ON :-> co_a1ON] > tys [a_a1Ox ~# (NA 'VO |> Sym (Nth:2 (Sym co_a2U0)))] > cos [] > needInScope [a1Ov :-> k_a1Ov, a1OD :-> k_a1OD, a1Q3 :-> as_a1Q3, > a1Q4 :-> a_a1Q4, a2U0 :-> co_a2U0] > WARNING: file compiler/types/TyCoRep.hs, line 2378 > in_scope InScope {wild_00 wild_Xl wild_Xv wild_X1m a_a1Gv ks_a1Ou > k_a1Ov f_a1Ow a_a1Ox ctx_a1Oy co_a1Oz co_a1OA co_a1OB > ks_a1OC > k_a1OD f_a1OE a_a1OF ctx_a1OG co_a1OH co_a1OI co_a1OJ > a_a1OK > co_a1OL co_a1OM co_a1ON as_a1Q3 a_a1Q4 ctx_a1Q5 > $krep_a2XW > $krep_a2XX $krep_a2XY $krep_a2XZ $krep_a2Y0 > $krep_a2Y1 $krep_a2Y2 > $krep_a2Y3 $krep_a2Y4 $krep_a2Y5 $krep_a2Y6 > $krep_a2Y7 $krep_a2Y8 > $krep_a2Y9 $krep_a2Ya $krep_a2Yb $krep_a2Yc > $krep_a2Yd $krep_a2Ye > $krep_a2Yf $krep_a2Yg $krep_a2Yh $krep_a2Yi > $krep_a2Yj $krep_a2Yk > $krep_a2Yl $krep_a2Ym $krep_a2Yn $krep_a2Yo > $krep_a2Yp $krep_a2Yq > $krep_a2Yr $krep_a2Ys $krep_a2Yt $krep_a2Yu > $krep_a2Yv $krep_a2Yw > $krep_a2Yx $krep_a2Yy $krep_a2Yz $krep_a2YA > $krep_a2YB $krep_a2YC > $krep_a2YD $krep_a2YE $krep_a2YF $krep_a2YG > $krep_a2YH $krep_a2YI > $krep_a2YJ $krep_a2YK $krep_a2YL ds_d2YO ds_d2YP > ds_d2YV fail_d2Z2 > from' $bASSO $mASSO $tc':&: $tc':* $tc'AO $tc'AS > $tc'E $tc'Here > $tc'Nil $tc'There $tc'VO $tc'VS $tcApplyT $tcCtx > $tcNA $tcNP $tcNS > $tcTyVar $trModule $trModule_s2ZM $trModule_s2ZN > $trModule_s2ZO > $trModule_s2ZP $krep_s2ZQ $krep_s2ZR $krep_s2ZS > $krep_s2ZT > $krep_s2ZU $krep_s2ZV $krep_s2ZW $krep_s2ZX > $tcTyVar_s2ZY > $tcTyVar_s2ZZ $krep_s300 $krep_s301 $krep_s302 > $krep_s303 > $tc'VO_s304 $tc'VO_s305 $krep_s306 $krep_s307 > $tc'VS_s308 > $tc'VS_s309 $tcNP_s30a $tcNP_s30b $krep_s30c > $krep_s30d $krep_s30e > $krep_s30f $krep_s30g $krep_s30h $tc':*_s30i > $tc':*_s30j $krep_s30k > $krep_s30l $krep_s30m $tc'Nil_s30n $tc'Nil_s30o > $tcNS_s30p > $tcNS_s30q $krep_s30r $krep_s30s $krep_s30t > $krep_s30u $krep_s30v > $krep_s30w $tc'Here_s30x $tc'Here_s30y $krep_s30z > $krep_s30A > $krep_s30B $tc'There_s30C $tc'There_s30D $tcCtx_s30E > $tcCtx_s30F > $krep_s30G $krep_s30H $krep_s30I $tc':&:_s30J > $tc':&:_s30K > $krep_s30L $krep_s30M $krep_s30N $krep_s30O > $krep_s30P $tc'E_s30Q > $tc'E_s30R $tcNA_s30S $tcNA_s30T $tcApplyT_s30U > $tcApplyT_s30V > $krep_s30W $krep_s30X $krep_s30Y $krep_s30Z > $krep_s310 $krep_s311 > $tc'AS_s312 $tc'AS_s313 $krep_s314 $krep_s315 > $krep_s316 > $tc'AO_s317 $tc'AO_s318} > tenv [a1Ow :-> f_a1Ow, a1Ox :-> a_a1Ox, a1Oy :-> ctx_a1Oy, > a1OE :-> f_a1OE, a1OF :-> a_a1OF, a1OG :-> ctx_a1OG] > cenv [a1Oz :-> co_a1Oz, a1OA :-> co_a1OA, a1OB :-> co_a1OB, > a1OH :-> co_a1OH, a1OI :-> co_a1OI, a1OJ :-> co_a1OJ, > a1OL :-> co_a1OL, a1OM :-> co_a1OM, a1ON :-> co_a1ON] > tys [a_a1Ox ~# (NA 'VO |> Sym (Nth:2 (Sym co_a2U0)))] > cos [] > needInScope [a1Ov :-> k_a1Ov, a1OD :-> k_a1OD, a1Q3 :-> as_a1Q3, > a1Q4 :-> a_a1Q4, a2U0 :-> co_a2U0] > Ok, one module loaded. > Prelude Main> > }}} New description: Try running this (`-fobject-code` is required) with '''and''' without `-dcore-lint`. I tried to minimize it but it is still hefty. This is showing it without `-dcore-lint`: {{{#!hs {-# Language RankNTypes, PatternSynonyms, DataKinds, PolyKinds, GADTs, TypeOperators, MultiParamTypeClasses, TypeFamilies, TypeSynonymInstances, FlexibleInstances, InstanceSigs, FlexibleContexts #-} {-# Options_GHC -fdefer-type-errors #-} import Data.Kind import Data.Type.Equality data TyVar :: Type -> Type -> Type where VO :: TyVar (a -> as) a VS :: TyVar as a -> TyVar (b -> as) a data NP :: (k -> Type) -> ([k] -> Type) where Nil :: NP f '[] (:*) :: f a -> NP f as -> NP f (a:as) data NS :: (k -> Type) -> ([k] -> Type) where Here :: f a -> NS f (a:as) There :: NS f as -> NS f (a:as) infixr 6 :&: data Ctx :: Type -> Type where E :: Ctx(Type) (:&:) :: a -> Ctx(as) -> Ctx(a -> as) data NA a type SOP(kind::Type) code = NS (NP NA) code data ApplyT(kind::Type) :: kind -> Ctx(kind) -> Type where AO :: a -> ApplyT(Type) a E AS :: ApplyT(ks) (f a) ctx -> ApplyT(k -> ks) f (a:&:ctx) from' :: ApplyT(Type -> Type -> Type) Either ctx -> NS (NP NA) '[ '[VO] ] from' (ASSO (Left a)) = Here (a :* Nil) from' (ASSO (Right b)) = There (Here undefined) pattern ASSO :: () => forall (ks :: Type) k (f :: k -> ks) (a1 :: k) (ks1 :: Type) k1 (f1 :: k1 -> ks1) (a2 :: k1) a3. (kind ~ (k -> k1 -> Type), a ~~ f, b ~~ (a1 :&: a2 :&: E), f a1 ~~ f1, f1 a2 ~~ a3) => a3 -> ApplyT kind a b pattern ASSO a = AS (AS (AO a)) }}} {{{ $ ghci -ignore-dot-ghci -fobject-code 466.hs GHCi, version 8.7.20180828: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( 466.hs, 466.o ) 466.hs:35:14: warning: [-Wdeferred-type-errors] • Could not deduce: a2 ~ NA 'VO from the context: ((* -> * -> *) ~ (k1 -> k2 -> *), Either ~~ f, ctx ~~ (a2 ':&: (a3 ':&: 'E)), f a2 ~~ f1, f1 a3 ~~ a4) bound by a pattern with pattern synonym: ASSO :: forall kind (a :: kind) (b :: Ctx kind). () => forall ks k (f :: k -> ks) (a1 :: k) ks1 k1 (f1 :: k1 -> ks1) (a2 :: k1) a3. (kind ~ (k -> k1 -> *), a ~~ f, b ~~ (a1 ':&: (a2 ':&: 'E)), f a1 ~~ f1, f1 a2 ~~ a3) => a3 -> ApplyT kind a b, in an equation for ‘from'’ at 466.hs:35:8-21 ‘a2’ is a rigid type variable bound by a pattern with pattern synonym: ASSO :: forall kind (a :: kind) (b :: Ctx kind). () => forall ks k (f :: k -> ks) (a1 :: k) ks1 k1 (f1 :: k1 -> ks1) (a2 :: k1) a3. (kind ~ (k -> k1 -> *), a ~~ f, b ~~ (a1 ':&: (a2 ':&: 'E)), f a1 ~~ f1, f1 a2 ~~ a3) => a3 -> ApplyT kind a b, in an equation for ‘from'’ at 466.hs:35:8-21 Expected type: a4 Actual type: Either (NA 'VO) a3 • In the pattern: Left a In the pattern: ASSO (Left a) In an equation for ‘from'’: from' (ASSO (Left a)) = Here (a :* Nil) • Relevant bindings include from' :: ApplyT (* -> * -> *) Either ctx -> NS (NP NA) '[ '[ 'VO]] (bound at 466.hs:35:1) | 35 | from' (ASSO (Left a)) = Here (a :* Nil) | ^^^^^^^ 466.hs:36:26: warning: [-Wdeferred-type-errors] • Couldn't match type ‘a0 : as0’ with ‘'[]’ Expected type: NS (NP NA) '[ '[ 'VO]] Actual type: NS (NP NA) ('[ 'VO] : a0 : as0) • In the expression: There (Here undefined) In an equation for ‘from'’: from' (ASSO (Right b)) = There (Here undefined) • Relevant bindings include from' :: ApplyT (* -> * -> *) Either ctx -> NS (NP NA) '[ '[ 'VO]] (bound at 466.hs:35:1) | 36 | from' (ASSO (Right b)) = There (Here undefined) | ^^^^^^^^^^^^^^^^^^^^^^ WARNING: file compiler/types/TyCoRep.hs, line 2378 in_scope InScope {wild_00 wild_Xl wild_Xv wild_X1m a_a1Gv ks_a1Ou k_a1Ov f_a1Ow a_a1Ox ctx_a1Oy co_a1Oz co_a1OA co_a1OB ks_a1OC k_a1OD f_a1OE a_a1OF ctx_a1OG co_a1OH co_a1OI co_a1OJ a_a1OK co_a1OL co_a1OM co_a1ON as_a1Q3 a_a1Q4 ctx_a1Q5 $krep_a2XW $krep_a2XX $krep_a2XY $krep_a2XZ $krep_a2Y0 $krep_a2Y1 $krep_a2Y2 $krep_a2Y3 $krep_a2Y4 $krep_a2Y5 $krep_a2Y6 $krep_a2Y7 $krep_a2Y8 $krep_a2Y9 $krep_a2Ya $krep_a2Yb $krep_a2Yc $krep_a2Yd $krep_a2Ye $krep_a2Yf $krep_a2Yg $krep_a2Yh $krep_a2Yi $krep_a2Yj $krep_a2Yk $krep_a2Yl $krep_a2Ym $krep_a2Yn $krep_a2Yo $krep_a2Yp $krep_a2Yq $krep_a2Yr $krep_a2Ys $krep_a2Yt $krep_a2Yu $krep_a2Yv $krep_a2Yw $krep_a2Yx $krep_a2Yy $krep_a2Yz $krep_a2YA $krep_a2YB $krep_a2YC $krep_a2YD $krep_a2YE $krep_a2YF $krep_a2YG $krep_a2YH $krep_a2YI $krep_a2YJ $krep_a2YK $krep_a2YL ds_d2YO ds_d2YP ds_d2YV fail_d2Z2 from' $bASSO $mASSO $tc':&: $tc':* $tc'AO $tc'AS $tc'E $tc'Here $tc'Nil $tc'There $tc'VO $tc'VS $tcApplyT $tcCtx $tcNA $tcNP $tcNS $tcTyVar $trModule $trModule_s2ZM $trModule_s2ZN $trModule_s2ZO $trModule_s2ZP $krep_s2ZQ $krep_s2ZR $krep_s2ZS $krep_s2ZT $krep_s2ZU $krep_s2ZV $krep_s2ZW $krep_s2ZX $tcTyVar_s2ZY $tcTyVar_s2ZZ $krep_s300 $krep_s301 $krep_s302 $krep_s303 $tc'VO_s304 $tc'VO_s305 $krep_s306 $krep_s307 $tc'VS_s308 $tc'VS_s309 $tcNP_s30a $tcNP_s30b $krep_s30c $krep_s30d $krep_s30e $krep_s30f $krep_s30g $krep_s30h $tc':*_s30i $tc':*_s30j $krep_s30k $krep_s30l $krep_s30m $tc'Nil_s30n $tc'Nil_s30o $tcNS_s30p $tcNS_s30q $krep_s30r $krep_s30s $krep_s30t $krep_s30u $krep_s30v $krep_s30w $tc'Here_s30x $tc'Here_s30y $krep_s30z $krep_s30A $krep_s30B $tc'There_s30C $tc'There_s30D $tcCtx_s30E $tcCtx_s30F $krep_s30G $krep_s30H $krep_s30I $tc':&:_s30J $tc':&:_s30K $krep_s30L $krep_s30M $krep_s30N $krep_s30O $krep_s30P $tc'E_s30Q $tc'E_s30R $tcNA_s30S $tcNA_s30T $tcApplyT_s30U $tcApplyT_s30V $krep_s30W $krep_s30X $krep_s30Y $krep_s30Z $krep_s310 $krep_s311 $tc'AS_s312 $tc'AS_s313 $krep_s314 $krep_s315 $krep_s316 $tc'AO_s317 $tc'AO_s318} tenv [a1Ow :-> f_a1Ow, a1Ox :-> a_a1Ox, a1Oy :-> ctx_a1Oy, a1OE :-> f_a1OE, a1OF :-> a_a1OF, a1OG :-> ctx_a1OG] cenv [a1Oz :-> co_a1Oz, a1OA :-> co_a1OA, a1OB :-> co_a1OB, a1OH :-> co_a1OH, a1OI :-> co_a1OI, a1OJ :-> co_a1OJ, a1OL :-> co_a1OL, a1OM :-> co_a1OM, a1ON :-> co_a1ON] tys [a_a1Ox ~# (NA 'VO |> Sym (Nth:2 (Sym co_a2U0)))] cos [] needInScope [a1Ov :-> k_a1Ov, a1OD :-> k_a1OD, a1Q3 :-> as_a1Q3, a1Q4 :-> a_a1Q4, a2U0 :-> co_a2U0] WARNING: file compiler/types/TyCoRep.hs, line 2378 in_scope InScope {wild_00 wild_Xl wild_Xv wild_X1m a_a1Gv ks_a1Ou k_a1Ov f_a1Ow a_a1Ox ctx_a1Oy co_a1Oz co_a1OA co_a1OB ks_a1OC k_a1OD f_a1OE a_a1OF ctx_a1OG co_a1OH co_a1OI co_a1OJ a_a1OK co_a1OL co_a1OM co_a1ON as_a1Q3 a_a1Q4 ctx_a1Q5 $krep_a2XW $krep_a2XX $krep_a2XY $krep_a2XZ $krep_a2Y0 $krep_a2Y1 $krep_a2Y2 $krep_a2Y3 $krep_a2Y4 $krep_a2Y5 $krep_a2Y6 $krep_a2Y7 $krep_a2Y8 $krep_a2Y9 $krep_a2Ya $krep_a2Yb $krep_a2Yc $krep_a2Yd $krep_a2Ye $krep_a2Yf $krep_a2Yg $krep_a2Yh $krep_a2Yi $krep_a2Yj $krep_a2Yk $krep_a2Yl $krep_a2Ym $krep_a2Yn $krep_a2Yo $krep_a2Yp $krep_a2Yq $krep_a2Yr $krep_a2Ys $krep_a2Yt $krep_a2Yu $krep_a2Yv $krep_a2Yw $krep_a2Yx $krep_a2Yy $krep_a2Yz $krep_a2YA $krep_a2YB $krep_a2YC $krep_a2YD $krep_a2YE $krep_a2YF $krep_a2YG $krep_a2YH $krep_a2YI $krep_a2YJ $krep_a2YK $krep_a2YL ds_d2YO ds_d2YP ds_d2YV fail_d2Z2 from' $bASSO $mASSO $tc':&: $tc':* $tc'AO $tc'AS $tc'E $tc'Here $tc'Nil $tc'There $tc'VO $tc'VS $tcApplyT $tcCtx $tcNA $tcNP $tcNS $tcTyVar $trModule $trModule_s2ZM $trModule_s2ZN $trModule_s2ZO $trModule_s2ZP $krep_s2ZQ $krep_s2ZR $krep_s2ZS $krep_s2ZT $krep_s2ZU $krep_s2ZV $krep_s2ZW $krep_s2ZX $tcTyVar_s2ZY $tcTyVar_s2ZZ $krep_s300 $krep_s301 $krep_s302 $krep_s303 $tc'VO_s304 $tc'VO_s305 $krep_s306 $krep_s307 $tc'VS_s308 $tc'VS_s309 $tcNP_s30a $tcNP_s30b $krep_s30c $krep_s30d $krep_s30e $krep_s30f $krep_s30g $krep_s30h $tc':*_s30i $tc':*_s30j $krep_s30k $krep_s30l $krep_s30m $tc'Nil_s30n $tc'Nil_s30o $tcNS_s30p $tcNS_s30q $krep_s30r $krep_s30s $krep_s30t $krep_s30u $krep_s30v $krep_s30w $tc'Here_s30x $tc'Here_s30y $krep_s30z $krep_s30A $krep_s30B $tc'There_s30C $tc'There_s30D $tcCtx_s30E $tcCtx_s30F $krep_s30G $krep_s30H $krep_s30I $tc':&:_s30J $tc':&:_s30K $krep_s30L $krep_s30M $krep_s30N $krep_s30O $krep_s30P $tc'E_s30Q $tc'E_s30R $tcNA_s30S $tcNA_s30T $tcApplyT_s30U $tcApplyT_s30V $krep_s30W $krep_s30X $krep_s30Y $krep_s30Z $krep_s310 $krep_s311 $tc'AS_s312 $tc'AS_s313 $krep_s314 $krep_s315 $krep_s316 $tc'AO_s317 $tc'AO_s318} tenv [a1Ow :-> f_a1Ow, a1Ox :-> a_a1Ox, a1Oy :-> ctx_a1Oy, a1OE :-> f_a1OE, a1OF :-> a_a1OF, a1OG :-> ctx_a1OG] cenv [a1Oz :-> co_a1Oz, a1OA :-> co_a1OA, a1OB :-> co_a1OB, a1OH :-> co_a1OH, a1OI :-> co_a1OI, a1OJ :-> co_a1OJ, a1OL :-> co_a1OL, a1OM :-> co_a1OM, a1ON :-> co_a1ON] tys [a_a1Ox ~# (NA 'VO |> Sym (Nth:2 (Sym co_a2U0)))] cos [] needInScope [a1Ov :-> k_a1Ov, a1OD :-> k_a1OD, a1Q3 :-> as_a1Q3, a1Q4 :-> a_a1Q4, a2U0 :-> co_a2U0] Ok, one module loaded. Prelude Main> }}} -- -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 30 20:20:15 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 30 Sep 2018 20:20:15 -0000 Subject: [GHC] #15695: Core Lint error, from -fobject-code + defer type errors + pattern synonyms + other stuff In-Reply-To: <051.924cbdebca03c5aa89a4c1b89bc4850d@haskell.org> References: <051.924cbdebca03c5aa89a4c1b89bc4850d@haskell.org> Message-ID: <066.9b84ed0947819c812df36e3bf08c5e11@haskell.org> #15695: Core Lint error, from -fobject-code + defer type errors + pattern synonyms + other stuff -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.6.1 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: Type of failure: Compile-time | Unknown/Multiple crash or panic | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by RyanGlScott): I'm failing to see where the Core Lint error is in this program. There's some `WARNING`s, but those aren't the same as Core Lint errors (and indeed, it's not terribly uncommon to see `WARNING`s). -- Ticket URL: GHC The Glasgow Haskell Compiler From ghc-devs at haskell.org Sun Sep 30 23:25:02 2018 From: ghc-devs at haskell.org (GHC) Date: Sun, 30 Sep 2018 23:25:02 -0000 Subject: [GHC] #3073: Avoid reconstructing dictionaries in recursive instance methods In-Reply-To: <046.cb32dbba432b9228a1ce1c087df10ff6@haskell.org> References: <046.cb32dbba432b9228a1ce1c087df10ff6@haskell.org> Message-ID: <061.add70b1a89c1563e45281efc14489173@haskell.org> #3073: Avoid reconstructing dictionaries in recursive instance methods -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: lowest | Milestone: Component: Compiler | Version: 6.10.1 Resolution: | Keywords: Inlining Operating System: Unknown/Multiple | Architecture: Type of failure: Runtime | Unknown/Multiple performance bug | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by nh2): * cc: nh2 (added) -- Ticket URL: GHC The Glasgow Haskell Compiler