April 2018 - ghc-tickets

[GHC] #14512: System-wide installed profile build cannot load libHSghc-prim.0.5.2.0.so
by GHC 31 Oct '18

31 Oct '18

#14512: System-wide installed profile build cannot load libHSghc-prim.0.5.2.0.so -------------------------------------+------------------------------------- Reporter: tdammers | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Build System | Version: 8.3 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: -------------------------------------+------------------------------------- Steps to reproduce: 1. Make a pristine git checkout 2. Follow the steps outlined in https://ghc.haskell.org/trac/ghc/wiki/Building/QuickStart, uncommenting the `BuildFlavour = prof` line in `build.mk`, to build and install ghc. 3. Check ghc version to verify that this ghc build is the one in `/usr/local/bin` 4. Try to compile the following `hello.hs`: {{{#!hs {-# LANGUAGE TemplateHaskell #-} import Language.Haskell.TH main = putStrLn $(litE (stringL "Hello")) }}} It should fail with an error message similar to: {{{ <no location info>: error: ghc: panic! (the 'impossible' happened) (GHC version 8.3.20171120 for x86_64-unknown-linux): Dynamic linker not initialised CallStack (from -prof): Linker.CAF (<entire-module>) Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} and: {{{ <no location info>: error: <command line>: can't load .so/.DLL for: libHSghc-prim-0.5.2.0.so (libHSghc-prim-0.5.2.0.so: cannot open shared object file: No such file or directory) }}} By contrast, the following do *not* trigger the error: - Building GHC without uncommenting the `BuildFlavour` line in `build.mk` - Compiling with the `inplace/bin/ghc-stage2` in the GHC source tree - Compiling a `hello.hs` that does not use TemplateHaskell Further system info: - Debian 9 - Cabal version 1.24 - GHC 8.0.1 -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/14512> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 3

[GHC] #9545: Evaluate Takano Akio's foldrW/buildW fusion framework as a possible replacement for foldr/build
by GHC 29 Oct '18

29 Oct '18

#9545: Evaluate Takano Akio's foldrW/buildW fusion framework as a possible replacement for foldr/build -------------------------------------+------------------------------------- Reporter: dfeuer | Owner: Type: task | Status: new Priority: normal | Milestone: Component: libraries/base | Version: 7.9 Keywords: | Operating System: Architecture: Unknown/Multiple | Unknown/Multiple Difficulty: Project (more | Type of failure: than a week) | None/Unknown Blocked By: | Test Case: Related Tickets: | Blocking: | Differential Revisions: -------------------------------------+------------------------------------- Takano Akio's [https://github.com/takano-akio/ww-fusion worker-wrapper fusion] modifies `foldr/build` fairly conservatively to allow safe fusion of `foldl` and friends without relying on arity analysis. This advantage is important for two reasons that I know of: 1. As discussed in Joachim Breitner's original paper, the current arity analysis is unable to infer arity correctly when facing certain forms of recursion. 2. The current arity analysis, and probably ''any'' practical arity analysis, depends on inlining to a degree that can sometimes be unhealthy. I would love to make functions like `hPutStr` fuse, but I suspect doing so safely at present would likely cause a code explosion—the function being folded is too large to want to inline to make it available for arity analysis following fusion. I don't understand it completely yet, but it looks like `foldrW/buildW` can eliminate a lot of this uncertainty. Furthermore, it appears that functions currently written using `foldr` in a "right-handed" way can remain unchanged, using an implementation of `foldr` in terms of `foldrW`. Only "left-handed" folds will need to be rewritten to take advantage of this framework, along with all the `build`s. That said, `foldrW/buildW` probably has its weaknesses too. The basic fusion rule looks like this. {{{#!hs {-# RULES "foldrW/buildW" forall f z (i :: Wrap f b) (g :: forall c g . (Wrap g c) -> (a -> c -> c) -> c -> c) . foldrW i f z (buildW g) = g i f z #-} }}} If `g` and `i` are not inlined sufficiently to merge with each other, I imagine this could produce worse results than `foldr/build` when the latter works properly. The only way to really get a feel for performance would be to carefully modify everything to work as well as it can with this framework and see how the results compare. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/9545> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 9

[GHC] #9374: Investigate Static Argument Transformation
by GHC 29 Oct '18

29 Oct '18

#9374: Investigate Static Argument Transformation -------------------------------------+------------------------------------- Reporter: jstolarek | Owner: Type: task | Status: new Priority: lowest | Milestone: Component: Compiler | Version: 7.9 Keywords: | Operating System: Architecture: Unknown/Multiple | Unknown/Multiple Difficulty: Unknown | Type of failure: Blocked By: | None/Unknown Related Tickets: | Test Case: | Blocking: | Differential Revisions: -------------------------------------+------------------------------------- At the moment the Static Argument Transformation (SAT) optimisation is not run unless explicitly enabled with `-fstatic-argument-transformation`. The comment in DynFlags says: {{{ Max writes: I think it's probably best not to enable SAT with -O2 for the 6.10 release. The version of SAT in HEAD at the moment doesn't incorporate several improvements to the heuristics, and I'm concerned that without those changes SAT will interfere with some attempts to write "high performance Haskell", as we saw in some posts on Haskell-Cafe earlier this year. In particular, the version in HEAD lacks the tail call criterion, so many things that look like reasonable loops will be turned into functions with extra (unneccesary) thunk creation. }}} 6.10 was a long time ago. Has anything changed since then? Does it make sense to enable that optimisation now? What are the mentioned heuristics and were they finally implemented? Does anyone know what Haskell-cafe posts does Max refer to? -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/9374> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 30

[GHC] #11719: Cannot use higher-rank kinds with type families
by GHC 29 Oct '18

29 Oct '18

#11719: Cannot use higher-rank kinds with type families -------------------------------------+------------------------------------- Reporter: ocharles | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1-rc2 (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: -------------------------------------+------------------------------------- This ticket came out of a discussion with Richard in this mailing list post: https://mail.haskell.org/pipermail/haskell- cafe/2016-March/123462.html Here's the code that should work, but doesn't: {{{ import Data.Kind data TyFun :: * -> * -> * type a ~> b = TyFun a b -> * type family (f :: a ~> b) @@ (x :: a) :: b data Null a = Nullable a | NotNullable a type family ((f :: b ~> c) ∘ (g :: a ~> b)) (x :: a) :: c where (f ∘ g) x = f @@ (g @@ x) type family BaseType (k :: forall a. a ~> Type) (x :: b) :: Type where -- this fails :( -- BaseType k x = (@@) k x }}} -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/11719> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 22

[GHC] #15071: :set usage in ghci tests breaks platform independence of output
by GHC 29 Oct '18

29 Oct '18

#15071: :set usage in ghci tests breaks platform independence of output -------------------------------------+------------------------------------- Reporter: bgamari | Owner: (none) Type: bug | Status: new Priority: high | Milestone: 8.6.1 Component: Test Suite | Version: 8.2.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: -------------------------------------+------------------------------------- Numerous GHCi tests are currently failing on Windows due to the use of `:set`, which prints the default flag set, which is platform dependent. For instance: {{{ --- "/tmp/ghctest-eo_ri0ye/test spaces/./ghci/scripts/ghci024.run/ghci024.stdout.normalised" 2018-04-19 18:35:50.927278200 +0000 +++ "/tmp/ghctest-eo_ri0ye/test spaces/./ghci/scripts/ghci024.run/ghci024.run.stdout.normalised" 2018-04-19 18:35:50.927278200 +0000 @@ -7,7 +7,6 @@ GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-diagnostics-show-caret - -fexternal-dynamic-refs -fignore-optim-changes -fignore-hpc-changes -fno-ghci-history }}} -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/15071> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 7

[GHC] #15076: Typed hole causes GHC to panic (No skolem info)
by GHC 29 Oct '18

29 Oct '18

#15076: Typed hole causes GHC to panic (No skolem info) -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: 8.6.1 Component: Compiler | Version: 8.2.2 (Type checker) | Keywords: TypedHoles, | Operating System: Unknown/Multiple TypeInType | Architecture: | Type of failure: Compile-time Unknown/Multiple | crash or panic Test Case: | Blocked By: Blocking: | Related Tickets: #14040 Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Spun out from https://ghc.haskell.org/trac/ghc/ticket/14040#comment:2, which was different enough from the original program in #14040 to warrant its own ticket. The following program panics on every version of GHC from 8.0.2 onward: {{{#!hs {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeInType #-} module Bug where import Data.Kind import Data.Proxy newtype S (f :: k1 -> k2) = MkS (forall t. Proxy t -> Proxy (f t)) foo :: forall (a :: Type) (f :: forall (x :: a). Proxy x -> Type). S f -> () foo (MkS (sF :: _)) = () }}} {{{ $ ~/Software/ghc/inplace/bin/ghc-stage2 --interactive Bug.hs GHCi, version 8.5.20180420: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Bug.hs:15:17: error:ghc-stage2: panic! (the 'impossible' happened) (GHC version 8.5.20180420 for x86_64-unknown-linux): No skolem info: [a1_a1Cb[sk:1]] Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1162:37 in ghc:Outputable pprPanic, called at compiler/typecheck/TcErrors.hs:3224:5 in ghc:TcErrors }}} -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/15076> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 10

[GHC] #14552: GHC panic on pattern synonym
by GHC 29 Oct '18

29 Oct '18

#14552: GHC panic on pattern synonym -------------------------------------+------------------------------------- Reporter: Iceland_jack | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.3 Keywords: | Operating System: Unknown/Multiple PatternSynonyms, TypeInType, | ViewPatterns | Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- {{{#!hs {-# Language RankNTypes, ViewPatterns, PatternSynonyms, TypeOperators, KindSignatures, PolyKinds, DataKinds, TypeFamilies, TypeInType, GADTs #-} import Data.Kind data family Sing a type a --> b = (a, b) -> Type type family (@@) (f::a --> b) (x::a) :: b data Proxy a = Proxy newtype Limit' :: (k --> Type) -> Type where Limit' :: (forall xx. Proxy xx -> f@@xx) -> Limit' f data Exp :: [Type] -> Type -> Type where TLam' :: Proxy f -> (forall aa. Proxy aa -> Exp xs (f @@ aa)) -> Exp xs (Limit' f) pattern FOO f <- TLam' Proxy (($ Proxy) -> f) }}} ---> {{{ $ ghci -ignore-dot-ghci 119-bug.hs GHCi, version 8.3.20171122: http://www.haskell.org/ghc/ :? for help [1 of 1] Compiling Main ( 119-bug.hs, interpreted ) ghc-stage2: panic! (the 'impossible' happened) (GHC version 8.3.20171122 for x86_64-unknown-linux): ASSERT failed! in_scope InScope {a_a1Mh b_a1Mi rep_a1MB r_a1MC} tenv [a1MC :-> r_a1MC] cenv [] tys [k_a1Mj[ssk:3]] cos [] needInScope [a1Mj :-> k_a1Mj[ssk:3]] Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1205:22 in ghc:Outputable assertPprPanic, called at compiler/types/TyCoRep.hs:2136:51 in ghc:TyCoRep checkValidSubst, called at compiler/types/TyCoRep.hs:2159:29 in ghc:TyCoRep substTy, called at compiler/types/TyCoRep.hs:2364:41 in ghc:TyCoRep substTyVarBndr, called at compiler/coreSyn/CoreSubst.hs:571:10 in ghc:CoreSubst Call stack: CallStack (from HasCallStack): callStackDoc, called at compiler/utils/Outputable.hs:1147:37 in ghc:Outputable pprPanic, called at compiler/utils/Outputable.hs:1203:5 in ghc:Outputable assertPprPanic, called at compiler/types/TyCoRep.hs:2136:51 in ghc:TyCoRep checkValidSubst, called at compiler/types/TyCoRep.hs:2159:29 in ghc:TyCoRep substTy, called at compiler/types/TyCoRep.hs:2364:41 in ghc:TyCoRep substTyVarBndr, called at compiler/coreSyn/CoreSubst.hs:571:10 in ghc:CoreSubst Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug > }}} -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/14552> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 12

[GHC] #14854: The size of FastString table is suboptimal for large codebases
by GHC 28 Oct '18

28 Oct '18

#14854: The size of FastString table is suboptimal for large codebases -------------------------------------+------------------------------------- Reporter: niteria | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 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: -------------------------------------+------------------------------------- Context: I was profiling a no-op rebuild (build once, do incremental build with nothing changed) of a large code base. It takes `35.829s`, and according to the profile about `20%` of the time is spent in `mkFastStringByteString`. I run it with `-dfaststring-stats +RTS -s` and got: {{{ FastString stats: size: 4091 entries: 829959 longest chain: 268 has z-encoding: 0% 50,011,906,640 bytes allocated in the heap 7,936,277,664 bytes copied during GC 3,106,526,336 bytes maximum residency (8 sample(s)) 123,108,224 bytes maximum slop 10169 MB total memory in use (0 MB lost due to fragmentation) Tot time (elapsed) Avg pause Max pause Gen 0 117 colls, 37 par 32.390s 2.293s 0.0196s 0.0911s Gen 1 8 colls, 3 par 19.722s 2.266s 0.2832s 0.6936s Parallel GC work balance: 60.62% (serial 0%, perfect 100%) TASKS: 93 (1 bound, 92 peak workers (92 total), using -N30) SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) INIT time 0.009s ( 0.009s elapsed) MUT time 277.370s ( 31.261s elapsed) GC time 52.113s ( 4.558s elapsed) EXIT time 0.005s ( 0.001s elapsed) Total time 329.497s ( 35.829s elapsed) Alloc rate 180,307,295 bytes per MUT second Productivity 84.2% of total user, 87.3% of total elapsed }}} That's pretty bad, fitting `800k` elements in `4k` buckets is hard. To confirm this indeed could be improved I changed the size to `2^20` (`1048576`) and also removed division in `hashStr` function (it come up on `perf` profile), like this: {{{ hashStr :: Ptr Word8 -> Int -> Int -- use the Addr to produce a hash value between 0 & m (inclusive) hashStr (Ptr a#) (I# len#) = loop 0# 0# where loop h n | isTrue# (n ==# len#) = I# h | otherwise = loop h2 (n +# 1#) where !c = ord# (indexCharOffAddr# a# n) -- !h2 = (c +# (h *# 128#)) `remInt#` -- hASH_TBL_SIZE# -- NOTE: below is multiplication by 127 (a prime) and division by 2^20, it's by no means the best hashing function !h2 = (c +# ((h `uncheckedIShiftL#` 7#) -# h)) `andI#` hASH_TBL_SIZE_MASK# }}} Here's what I ended up with: {{{ FastString stats: size: 1048576 entries: 829959 longest chain: 8 has z-encoding: 0% 51,012,218,048 bytes allocated in the heap 8,948,377,768 bytes copied during GC 3,543,797,248 bytes maximum residency (8 sample(s)) 139,428,352 bytes maximum slop 10502 MB total memory in use (0 MB lost due to fragmentation) Tot time (elapsed) Avg pause Max pause Gen 0 115 colls, 39 par 32.261s 2.677s 0.0233s 0.2225s Gen 1 8 colls, 3 par 21.786s 2.329s 0.2911s 0.5737s Parallel GC work balance: 48.75% (serial 0%, perfect 100%) TASKS: 93 (1 bound, 92 peak workers (92 total), using -N30) SPARKS: 0 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled) INIT time 0.008s ( 0.008s elapsed) MUT time 65.508s ( 23.791s elapsed) GC time 54.047s ( 5.006s elapsed) EXIT time 0.007s ( 0.001s elapsed) Total time 119.570s ( 28.806s elapsed) Alloc rate 778,712,134 bytes per MUT second Productivity 54.8% of total user, 82.6% of total elapsed }}} The realtime improvement is nice (`-20%`), but even nicer is the "serial" time improvement, from `329.497s`to `119.570s` (`2.75x` speedup). This is on modified 8.0.2, but the related code looks about the same on HEAD. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/14854> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 11

[GHC] #15066: EtaExpandLevPoly triggers a core lint error in profasm/profthreaded ways
by GHC 28 Oct '18

28 Oct '18

#15066: EtaExpandLevPoly triggers a core lint error in profasm/profthreaded ways ----------------------------------------+--------------------------------- Reporter: alpmestan | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 Keywords: | Operating System: Linux Architecture: Unknown/Multiple | Type of failure: None/Unknown Test Case: EtaExpandLevPoly | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: ----------------------------------------+--------------------------------- Against 8b823f270e53627ddca1a993c05f1ab556742d96: {{{#!hs $ make fulltest TEST=EtaExpandLevPoly [...] =====> EtaExpandLevPoly(normal) 1 of 1 [0, 0, 0] cd "./typecheck/should_run/EtaExpandLevPoly.run" && "/home/alp/ghc-slow- validate/inplace/test spaces/ghc-stage2" -o EtaExpandLevPoly EtaExpandLevPoly.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 cd "./typecheck/should_run/EtaExpandLevPoly.run" && ./EtaExpandLevPoly =====> EtaExpandLevPoly(hpc) 1 of 1 [0, 0, 0] cd "./typecheck/should_run/EtaExpandLevPoly.run" && "/home/alp/ghc-slow- validate/inplace/test spaces/ghc-stage2" -o EtaExpandLevPoly EtaExpandLevPoly.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 -O -fhpc cd "./typecheck/should_run/EtaExpandLevPoly.run" && ./EtaExpandLevPoly =====> EtaExpandLevPoly(optasm) 1 of 1 [0, 0, 0] cd "./typecheck/should_run/EtaExpandLevPoly.run" && "/home/alp/ghc-slow- validate/inplace/test spaces/ghc-stage2" -o EtaExpandLevPoly EtaExpandLevPoly.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 -O -fasm cd "./typecheck/should_run/EtaExpandLevPoly.run" && ./EtaExpandLevPoly =====> EtaExpandLevPoly(profasm) 1 of 1 [0, 0, 0] cd "./typecheck/should_run/EtaExpandLevPoly.run" && "/home/alp/ghc-slow- validate/inplace/test spaces/ghc-stage2" -o EtaExpandLevPoly EtaExpandLevPoly.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 -O -prof -static -fprof-auto Compile failed (exit code 1) errors were: [1 of 1] Compiling Main ( EtaExpandLevPoly.hs, EtaExpandLevPoly.o ) *** Core Lint errors : in result of Simplifier *** <no location info>: warning: In the type ‘((# Bool, Int# #) |> Sym (TYPE (Sym co_a1ww))_N)’ co_a1ww :: (a_a1wt :: RuntimeRep) ~# ('TupleRep '['LiftedRep, 'IntRep] :: RuntimeRep) [LclId[CoVarId]] is out of scope *** Offending Program *** foo :: forall b. G 'LiftedRep -> b -> b [LclIdX, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}] foo = \ (@ (a_a1wt :: RuntimeRep)) (@ (b_a1wu :: TYPE a_a1wt)) (ds_d1Pr :: G a_a1wt) -> scctick<foo> case ds_d1Pr of { MkG co_a1ww -> \ (x_a10m :: (b_a1wu |> Sym (TYPE (Sym co_a1ww))_N)) -> tick<foo.\> x_a10m } bar :: forall a. H 'LiftedRep -> (a -> a -> (# a, a #)) -> a -> (# a, a #) [LclIdX, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 60 60}] bar = \ (@ (r_a1vB :: RuntimeRep)) (@ (a_a1vC :: TYPE r_a1vB)) (ds_d1Pk :: H r_a1vB) -> scctick<bar> case ds_d1Pk of { MkH co_a1vE -> (\ (f_a10o :: (a_a1vC |> Sym (TYPE (Sym co_a1vE))_N) -> (a_a1vC |> Sym (TYPE (Sym co_a1vE))_N) -> (# (a_a1vC |> Sym (TYPE (Sym co_a1vE))_N), (a_a1vC |> Sym (TYPE (Sym co_a1vE))_N) #)) (x_a10p :: (a_a1vC |> Sym (TYPE (Sym co_a1vE))_N)) -> scctick<bar.\> f_a10o x_a10p x_a10p) `cast` ((Coh <a_a1vC>_R (TYPE co_a1vE)_N ->_R Coh <a_a1vC>_R (TYPE co_a1vE)_N ->_R ((#,#) (Sub (Sym co_a1vE)) (Sub (Sym co_a1vE)) (Coh <a_a1vC>_R (TYPE co_a1vE)_N) (Coh <a_a1vC>_R (TYPE co_a1vE)_N))_R) ->_R Coh <a_a1vC>_R (TYPE co_a1vE)_N ->_R ((#,#) (Sub (Sym co_a1vE)) (Sub (Sym co_a1vE)) (Coh <a_a1vC>_R (TYPE co_a1vE)_N) (Coh <a_a1vC>_R (TYPE co_a1vE)_N))_R :: (((a_a1vC |> (TYPE co_a1vE)_N) -> (a_a1vC |> (TYPE co_a1vE)_N) -> (# (a_a1vC |> (TYPE co_a1vE)_N), (a_a1vC |> (TYPE co_a1vE)_N) #)) -> (a_a1vC |> (TYPE co_a1vE)_N) -> (# (a_a1vC |> (TYPE co_a1vE)_N), (a_a1vC |> (TYPE co_a1vE)_N) #) :: *) ~R# ((a_a1vC -> a_a1vC -> (# a_a1vC, a_a1vC #)) -> a_a1vC -> (# a_a1vC, a_a1vC #) :: *)) } $trModule_s245 :: Addr# [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] $trModule_s245 = "main"# $trModule_s246 :: TrName [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] $trModule_s246 = TrNameS $trModule_s245 $trModule_s247 :: Addr# [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] $trModule_s247 = "Main"# $trModule_s248 :: TrName [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] $trModule_s248 = TrNameS $trModule_s247 $trModule :: Module [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $trModule = Module $trModule_s246 $trModule_s248 $krep_a1P3 [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_a1P3 = KindRepTyConApp $tc'LiftedRep ([] @ KindRep) $krep_a1OZ [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_a1OZ = KindRepTyConApp $tc'IntRep ([] @ KindRep) $krep_a1OX [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_a1OX = KindRepTyConApp $tcRuntimeRep ([] @ KindRep) $krep_a1OW [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_a1OW = KindRepFun $krep_a1OX krep$* $krep_s249 :: [KindRep] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_s249 = : @ KindRep $krep_a1OX ([] @ KindRep) $krep_a1P5 [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_a1P5 = KindRepTyConApp $tc'[] $krep_s249 $krep_s24a :: [KindRep] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_s24a = : @ KindRep $krep_a1P5 ([] @ KindRep) $krep_s24b :: [KindRep] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_s24b = : @ KindRep $krep_a1OZ $krep_s24a $krep_s24c :: [KindRep] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_s24c = : @ KindRep $krep_a1OX $krep_s24b $krep_a1P4 [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_a1P4 = KindRepTyConApp $tc': $krep_s24c $krep_s24d :: [KindRep] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_s24d = : @ KindRep $krep_a1P4 ([] @ KindRep) $krep_s24e :: [KindRep] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_s24e = : @ KindRep $krep_a1P3 $krep_s24d $krep_s24f :: [KindRep] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_s24f = : @ KindRep $krep_a1OX $krep_s24e $krep_a1P2 [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_a1P2 = KindRepTyConApp $tc': $krep_s24f $krep_s24g :: [KindRep] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_s24g = : @ KindRep $krep_a1P2 ([] @ KindRep) $krep_a1P1 [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_a1P1 = KindRepTyConApp $tc'TupleRep $krep_s24g $tcG_s24h :: Addr# [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] $tcG_s24h = "G"# $tcG_s24i :: TrName [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] $tcG_s24i = TrNameS $tcG_s24h $tcG :: TyCon [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] $tcG = TyCon 14221008574166376522## 17210926818700297107## $trModule $tcG_s24i 0# $krep_a1OW $krep_s24j :: [KindRep] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_s24j = : @ KindRep $krep_a1P1 ([] @ KindRep) $krep_a1P0 [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_a1P0 = KindRepTyConApp $tcG $krep_s24j $tc'MkG_s24k :: Addr# [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] $tc'MkG_s24k = "'MkG"# $tc'MkG_s24l :: TrName [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] $tc'MkG_s24l = TrNameS $tc'MkG_s24k $tc'MkG :: TyCon [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] $tc'MkG = TyCon 11219666876303220503## 4566534404187760096## $trModule $tc'MkG_s24l 0# $krep_a1P0 $tcH_s24m :: Addr# [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] $tcH_s24m = "H"# $tcH_s24n :: TrName [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] $tcH_s24n = TrNameS $tcH_s24m $tcH :: TyCon [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] $tcH = TyCon 5827673930009354874## 4277163490596771739## $trModule $tcH_s24n 0# $krep_a1OW $krep_s24o :: [KindRep] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_s24o = : @ KindRep $krep_a1OZ ([] @ KindRep) $krep_a1OY [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_a1OY = KindRepTyConApp $tcH $krep_s24o $tc'MkH_s24p :: Addr# [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] $tc'MkH_s24p = "'MkH"# $tc'MkH_s24q :: TrName [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] $tc'MkH_s24q = TrNameS $tc'MkH_s24p $tc'MkH :: TyCon [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] $tc'MkH = TyCon 273175143458456096## 17487285292499736820## $trModule $tc'MkH_s24q 0# $krep_a1OY main :: IO () [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 510 0}] main = scctick<main> case (tick<foo> \ (x_a10m :: ((# Bool, Int# #) |> Sym (TYPE (Sym co_a1ww))_N)) -> scc<foo> tick<foo.\> x_a10m) (# True, 3# #) of ds_d23V { (# ipv_s24s, ipv_s24t #) -> (\ (s_a24P :: State# RealWorld) -> case ((hPutStr' stdout ($fShowBool_$cshow ipv_s24s) True) `cast` (N:IO[0] <()>_R :: (IO () :: *) ~R# (State# RealWorld -> (# State# RealWorld, () #) :: *))) s_a24P of { (# ipv_a24S, ipv1_a24T #) -> case ((hPutStr' stdout (showSignedInt $fShow(,)1 (I# ipv_s24t) ([] @ Char)) True) `cast` (N:IO[0] <()>_R :: (IO () :: *) ~R# (State# RealWorld -> (# State# RealWorld, () #) :: *))) ipv_a24S of { (# ipv_X265, ipv1_X267 #) -> ((case (scctick<bar> case $WMkH of { MkH co_a1vE -> \ (f_a10o :: Int# -> Int# -> (# Int#, Int# #)) (x_a10p :: Int#) -> scctick<bar.\> f_a10o x_a10p x_a10p }) ((#,#) @ 'IntRep @ 'IntRep @ Int# @ Int#) 8# of ds_d23T { (# ipv_s25y, ipv_s25z #) -> (\ (s_X26d :: State# RealWorld) -> case ((hPutStr' stdout (showSignedInt $fShow(,)1 (I# ipv_s25y) ([] @ Char)) True) `cast` (N:IO[0] <()>_R :: (IO () :: *) ~R# (State# RealWorld -> (# State# RealWorld, () #) :: *))) s_X26d of { (# ipv_X26j, ipv1_X26l #) -> ((hPutStr' stdout (showSignedInt $fShow(,)1 (I# ipv_s25z) ([] @ Char)) True) `cast` (N:IO[0] <()>_R :: (IO () :: *) ~R# (State# RealWorld -> (# State# RealWorld, () #) :: *))) ipv_X26j }) `cast` (Sym (N:IO[0] <()>_R) :: (State# RealWorld -> (# State# RealWorld, () #) :: *) ~R# (IO () :: *)) }) `cast` (N:IO[0] <()>_R :: (IO () :: *) ~R# (State# RealWorld -> (# State# RealWorld, () #) :: *))) ipv_X265 } }) `cast` (Sym (N:IO[0] <()>_R) :: (State# RealWorld -> (# State# RealWorld, () #) :: *) ~R# (IO () :: *)) } main_s3to :: State# RealWorld -> (# State# RealWorld, () #) [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}] main_s3to = runMainIO1 @ () main main :: IO () [LclIdX, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] main = main_s3to `cast` (Sym (N:IO[0] <()>_R) :: (State# RealWorld -> (# State# RealWorld, () #) :: *) ~R# (IO () :: *)) *** End of Offense *** <no location info>: error: Compilation had errors *** unexpected failure for EtaExpandLevPoly(profasm) =====> EtaExpandLevPoly(threaded1) 1 of 1 [0, 1, 0] cd "./typecheck/should_run/EtaExpandLevPoly.run" && "/home/alp/ghc-slow- validate/inplace/test spaces/ghc-stage2" -o EtaExpandLevPoly EtaExpandLevPoly.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 -threaded -debug cd "./typecheck/should_run/EtaExpandLevPoly.run" && ./EtaExpandLevPoly =====> EtaExpandLevPoly(threaded2) 1 of 1 [0, 1, 0] cd "./typecheck/should_run/EtaExpandLevPoly.run" && "/home/alp/ghc-slow- validate/inplace/test spaces/ghc-stage2" -o EtaExpandLevPoly EtaExpandLevPoly.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 -O -threaded -eventlog cd "./typecheck/should_run/EtaExpandLevPoly.run" && ./EtaExpandLevPoly +RTS -N2 -ls -RTS =====> EtaExpandLevPoly(dyn) 1 of 1 [0, 1, 0] cd "./typecheck/should_run/EtaExpandLevPoly.run" && "/home/alp/ghc-slow- validate/inplace/test spaces/ghc-stage2" -o EtaExpandLevPoly EtaExpandLevPoly.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 -O -dynamic cd "./typecheck/should_run/EtaExpandLevPoly.run" && ./EtaExpandLevPoly =====> EtaExpandLevPoly(profthreaded) 1 of 1 [0, 1, 0] cd "./typecheck/should_run/EtaExpandLevPoly.run" && "/home/alp/ghc-slow- validate/inplace/test spaces/ghc-stage2" -o EtaExpandLevPoly EtaExpandLevPoly.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 -O -prof -static -fprof-auto -threaded Compile failed (exit code 1) errors were: [1 of 1] Compiling Main ( EtaExpandLevPoly.hs, EtaExpandLevPoly.o ) *** Core Lint errors : in result of Simplifier *** <no location info>: warning: In the type ‘((# Bool, Int# #) |> Sym (TYPE (Sym co_a1ww))_N)’ co_a1ww :: (a_a1wt :: RuntimeRep) ~# ('TupleRep '['LiftedRep, 'IntRep] :: RuntimeRep) [LclId[CoVarId]] is out of scope *** Offending Program *** foo :: forall b. G 'LiftedRep -> b -> b [LclIdX, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}] foo = \ (@ (a_a1wt :: RuntimeRep)) (@ (b_a1wu :: TYPE a_a1wt)) (ds_d1Pr :: G a_a1wt) -> scctick<foo> case ds_d1Pr of { MkG co_a1ww -> \ (x_a10m :: (b_a1wu |> Sym (TYPE (Sym co_a1ww))_N)) -> tick<foo.\> x_a10m } bar :: forall a. H 'LiftedRep -> (a -> a -> (# a, a #)) -> a -> (# a, a #) [LclIdX, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 60 60}] bar = \ (@ (r_a1vB :: RuntimeRep)) (@ (a_a1vC :: TYPE r_a1vB)) (ds_d1Pk :: H r_a1vB) -> scctick<bar> case ds_d1Pk of { MkH co_a1vE -> (\ (f_a10o :: (a_a1vC |> Sym (TYPE (Sym co_a1vE))_N) -> (a_a1vC |> Sym (TYPE (Sym co_a1vE))_N) -> (# (a_a1vC |> Sym (TYPE (Sym co_a1vE))_N), (a_a1vC |> Sym (TYPE (Sym co_a1vE))_N) #)) (x_a10p :: (a_a1vC |> Sym (TYPE (Sym co_a1vE))_N)) -> scctick<bar.\> f_a10o x_a10p x_a10p) `cast` ((Coh <a_a1vC>_R (TYPE co_a1vE)_N ->_R Coh <a_a1vC>_R (TYPE co_a1vE)_N ->_R ((#,#) (Sub (Sym co_a1vE)) (Sub (Sym co_a1vE)) (Coh <a_a1vC>_R (TYPE co_a1vE)_N) (Coh <a_a1vC>_R (TYPE co_a1vE)_N))_R) ->_R Coh <a_a1vC>_R (TYPE co_a1vE)_N ->_R ((#,#) (Sub (Sym co_a1vE)) (Sub (Sym co_a1vE)) (Coh <a_a1vC>_R (TYPE co_a1vE)_N) (Coh <a_a1vC>_R (TYPE co_a1vE)_N))_R :: (((a_a1vC |> (TYPE co_a1vE)_N) -> (a_a1vC |> (TYPE co_a1vE)_N) -> (# (a_a1vC |> (TYPE co_a1vE)_N), (a_a1vC |> (TYPE co_a1vE)_N) #)) -> (a_a1vC |> (TYPE co_a1vE)_N) -> (# (a_a1vC |> (TYPE co_a1vE)_N), (a_a1vC |> (TYPE co_a1vE)_N) #) :: *) ~R# ((a_a1vC -> a_a1vC -> (# a_a1vC, a_a1vC #)) -> a_a1vC -> (# a_a1vC, a_a1vC #) :: *)) } $trModule_s245 :: Addr# [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] $trModule_s245 = "main"# $trModule_s246 :: TrName [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] $trModule_s246 = TrNameS $trModule_s245 $trModule_s247 :: Addr# [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] $trModule_s247 = "Main"# $trModule_s248 :: TrName [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] $trModule_s248 = TrNameS $trModule_s247 $trModule :: Module [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $trModule = Module $trModule_s246 $trModule_s248 $krep_a1P3 [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_a1P3 = KindRepTyConApp $tc'LiftedRep ([] @ KindRep) $krep_a1OZ [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_a1OZ = KindRepTyConApp $tc'IntRep ([] @ KindRep) $krep_a1OX [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_a1OX = KindRepTyConApp $tcRuntimeRep ([] @ KindRep) $krep_a1OW [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_a1OW = KindRepFun $krep_a1OX krep$* $krep_s249 :: [KindRep] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_s249 = : @ KindRep $krep_a1OX ([] @ KindRep) $krep_a1P5 [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_a1P5 = KindRepTyConApp $tc'[] $krep_s249 $krep_s24a :: [KindRep] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_s24a = : @ KindRep $krep_a1P5 ([] @ KindRep) $krep_s24b :: [KindRep] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_s24b = : @ KindRep $krep_a1OZ $krep_s24a $krep_s24c :: [KindRep] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_s24c = : @ KindRep $krep_a1OX $krep_s24b $krep_a1P4 [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_a1P4 = KindRepTyConApp $tc': $krep_s24c $krep_s24d :: [KindRep] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_s24d = : @ KindRep $krep_a1P4 ([] @ KindRep) $krep_s24e :: [KindRep] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_s24e = : @ KindRep $krep_a1P3 $krep_s24d $krep_s24f :: [KindRep] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_s24f = : @ KindRep $krep_a1OX $krep_s24e $krep_a1P2 [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_a1P2 = KindRepTyConApp $tc': $krep_s24f $krep_s24g :: [KindRep] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_s24g = : @ KindRep $krep_a1P2 ([] @ KindRep) $krep_a1P1 [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_a1P1 = KindRepTyConApp $tc'TupleRep $krep_s24g $tcG_s24h :: Addr# [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] $tcG_s24h = "G"# $tcG_s24i :: TrName [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] $tcG_s24i = TrNameS $tcG_s24h $tcG :: TyCon [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] $tcG = TyCon 14221008574166376522## 17210926818700297107## $trModule $tcG_s24i 0# $krep_a1OW $krep_s24j :: [KindRep] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_s24j = : @ KindRep $krep_a1P1 ([] @ KindRep) $krep_a1P0 [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_a1P0 = KindRepTyConApp $tcG $krep_s24j $tc'MkG_s24k :: Addr# [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] $tc'MkG_s24k = "'MkG"# $tc'MkG_s24l :: TrName [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] $tc'MkG_s24l = TrNameS $tc'MkG_s24k $tc'MkG :: TyCon [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] $tc'MkG = TyCon 11219666876303220503## 4566534404187760096## $trModule $tc'MkG_s24l 0# $krep_a1P0 $tcH_s24m :: Addr# [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] $tcH_s24m = "H"# $tcH_s24n :: TrName [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] $tcH_s24n = TrNameS $tcH_s24m $tcH :: TyCon [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] $tcH = TyCon 5827673930009354874## 4277163490596771739## $trModule $tcH_s24n 0# $krep_a1OW $krep_s24o :: [KindRep] [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_s24o = : @ KindRep $krep_a1OZ ([] @ KindRep) $krep_a1OY [InlPrag=NOUSERINLINE[~]] :: KindRep [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] $krep_a1OY = KindRepTyConApp $tcH $krep_s24o $tc'MkH_s24p :: Addr# [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] $tc'MkH_s24p = "'MkH"# $tc'MkH_s24q :: TrName [LclId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] $tc'MkH_s24q = TrNameS $tc'MkH_s24p $tc'MkH :: TyCon [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] $tc'MkH = TyCon 273175143458456096## 17487285292499736820## $trModule $tc'MkH_s24q 0# $krep_a1OY main :: IO () [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 510 0}] main = scctick<main> case (tick<foo> \ (x_a10m :: ((# Bool, Int# #) |> Sym (TYPE (Sym co_a1ww))_N)) -> scc<foo> tick<foo.\> x_a10m) (# True, 3# #) of ds_d23V { (# ipv_s24s, ipv_s24t #) -> (\ (s_a24P :: State# RealWorld) -> case ((hPutStr' stdout ($fShowBool_$cshow ipv_s24s) True) `cast` (N:IO[0] <()>_R :: (IO () :: *) ~R# (State# RealWorld -> (# State# RealWorld, () #) :: *))) s_a24P of { (# ipv_a24S, ipv1_a24T #) -> case ((hPutStr' stdout (showSignedInt $fShow(,)1 (I# ipv_s24t) ([] @ Char)) True) `cast` (N:IO[0] <()>_R :: (IO () :: *) ~R# (State# RealWorld -> (# State# RealWorld, () #) :: *))) ipv_a24S of { (# ipv_X265, ipv1_X267 #) -> ((case (scctick<bar> case $WMkH of { MkH co_a1vE -> \ (f_a10o :: Int# -> Int# -> (# Int#, Int# #)) (x_a10p :: Int#) -> scctick<bar.\> f_a10o x_a10p x_a10p }) ((#,#) @ 'IntRep @ 'IntRep @ Int# @ Int#) 8# of ds_d23T { (# ipv_s25y, ipv_s25z #) -> (\ (s_X26d :: State# RealWorld) -> case ((hPutStr' stdout (showSignedInt $fShow(,)1 (I# ipv_s25y) ([] @ Char)) True) `cast` (N:IO[0] <()>_R :: (IO () :: *) ~R# (State# RealWorld -> (# State# RealWorld, () #) :: *))) s_X26d of { (# ipv_X26j, ipv1_X26l #) -> ((hPutStr' stdout (showSignedInt $fShow(,)1 (I# ipv_s25z) ([] @ Char)) True) `cast` (N:IO[0] <()>_R :: (IO () :: *) ~R# (State# RealWorld -> (# State# RealWorld, () #) :: *))) ipv_X26j }) `cast` (Sym (N:IO[0] <()>_R) :: (State# RealWorld -> (# State# RealWorld, () #) :: *) ~R# (IO () :: *)) }) `cast` (N:IO[0] <()>_R :: (IO () :: *) ~R# (State# RealWorld -> (# State# RealWorld, () #) :: *))) ipv_X265 } }) `cast` (Sym (N:IO[0] <()>_R) :: (State# RealWorld -> (# State# RealWorld, () #) :: *) ~R# (IO () :: *)) } main_s3to :: State# RealWorld -> (# State# RealWorld, () #) [LclId, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}] main_s3to = runMainIO1 @ () main main :: IO () [LclIdX, Arity=1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] main = main_s3to `cast` (Sym (N:IO[0] <()>_R) :: (State# RealWorld -> (# State# RealWorld, () #) :: *) ~R# (IO () :: *)) *** End of Offense *** <no location info>: error: Compilation had errors *** unexpected failure for EtaExpandLevPoly(profthreaded) Unexpected results from: TEST="EtaExpandLevPoly" SUMMARY for test run started at Fri Apr 20 00:34:52 2018 CEST 0:00:05 spent to go through 1 total tests, which gave rise to 9 test cases, of which 1 were skipped 0 had missing libraries 6 expected passes 0 expected failures 0 caused framework failures 0 caused framework warnings 0 unexpected passes 2 unexpected failures 0 unexpected stat failures Unexpected failures: typecheck/should_run/EtaExpandLevPoly.run EtaExpandLevPoly [exit code non-0] (profasm) typecheck/should_run/EtaExpandLevPoly.run EtaExpandLevPoly [exit code non-0] (profthreaded) }}} I'll mark the test as expected broken in those ways for now, linking to this ticket. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/15066> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 3

[GHC] #14465: Performance of Natural
by GHC 28 Oct '18

28 Oct '18

#14465: Performance of Natural -------------------------------------+------------------------------------- Reporter: Bodigrim | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: Component: Compiler | Version: 8.2.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: -------------------------------------+------------------------------------- Recently I tried to use `Natural` instead of `Integer` in one of my projects. I expected no difference or even a minor performance boost (since `Natural` does not have to worry about a sign). But in fact it caused a slowdown. A constant of type `Integer` will be evaluated to a low-level representation (`S#` / `Jp#` / `Jn#`) during `CorePrep` stage. Nothing of this kind happens to constant values of type `Natural`: {{{#!hs import Numeric.Natural one :: Natural one = fromInteger 1 }}} is translated to {{{#!hs one1 :: Integer one1 = 1 -- will be converted by CorePrep to S# 1# one :: Natural one = case one1 of { S# i#_a2c6 -> case tagToEnum# (>=# i#_a2c6 0#) of { False -> underflowError; True -> NatS# (int2Word# i#_a2c6) }; Jp# dt_a2cg -> case uncheckedIShiftRL# (sizeofByteArray# dt_a2cg) 3# of { __DEFAULT -> case sizeofByteArray# dt_a2cg of { __DEFAULT -> NatJ# dt_a2cg; 0# -> underflowError }; 1# -> case indexWordArray# dt_a2cg 0# of wild2_a2ck { __DEFAULT -> NatS# wild2_a2ck } }; Jn# ipv_a2cn -> underflowError } }}} This is not bad itself, if `one` is a top-level definition. At the end of the day a thunk will be replaced by its value, computed exactly once. But suppose we have written {{{#!hs import Numeric.Natural plusOne :: Natural -> Natural plusOne n = n + 1 }}} The corresponding Core looks this way: {{{#!hs plusOne :: Natural -> Natural plusOne = \ (n_auS :: Natural) -> case 1 of { S# i#_a2dA -> case tagToEnum# (>=# i#_a2dA 0#) of { False -> case underflowError of wild2_00 { }; True -> plusNatural n_auS (NatS# (int2Word# i#_a2dA)) }; Jp# dt_a2dI -> case uncheckedIShiftRL# (sizeofByteArray# dt_a2dI) 3# of { __DEFAULT -> case sizeofByteArray# dt_a2dI of { __DEFAULT -> plusNatural n_auS (NatJ# dt_a2dI); 0# -> case underflowError of wild4_00 { } }; 1# -> case indexWordArray# dt_a2dI 0# of wild2_a2dM { __DEFAULT -> plusNatural n_auS (NatS# wild2_a2dM) } }; Jn# ipv_a2dP -> case underflowError of wild1_00 { } } }}} It looks expensive to pattern match `1` repeatedly, at every call to `plusOne`. Another deficiency of `Natural` is that no constant folding is done. Even `2 * 2` results in 50 lines of Core: {{{#!hs twoTimesTwo2 :: Integer twoTimesTwo2 = 2 twoTimesTwo1 :: Natural twoTimesTwo1 = case twoTimesTwo2 of { S# i#_a2u3 -> case tagToEnum# (>=# i#_a2u3 0#) of { False -> underflowError; True -> NatS# (int2Word# i#_a2u3) }; Jp# dt_a2ub -> case uncheckedIShiftRL# (sizeofByteArray# dt_a2ub) 3# of { __DEFAULT -> case sizeofByteArray# dt_a2ub of { __DEFAULT -> NatJ# dt_a2ub; 0# -> underflowError }; 1# -> case indexWordArray# dt_a2ub 0# of wild2_a2uf { __DEFAULT -> NatS# wild2_a2uf } }; Jn# ipv_a2ui -> underflowError } twoTimesTwo :: Natural twoTimesTwo = case twoTimesTwo2 of { S# i#_a2u3 -> case tagToEnum# (>=# i#_a2u3 0#) of { False -> case underflowError of wild2_00 { }; True -> $fNumNatural_$c* twoTimesTwo1 (NatS# (int2Word# i#_a2u3)) }; Jp# dt_a2ub -> case uncheckedIShiftRL# (sizeofByteArray# dt_a2ub) 3# of { __DEFAULT -> case sizeofByteArray# dt_a2ub of { __DEFAULT -> $fNumNatural_$c* twoTimesTwo1 (NatJ# dt_a2ub); 0# -> case underflowError of wild4_00 { } }; 1# -> case indexWordArray# dt_a2ub 0# of wild2_a2uf { __DEFAULT -> $fNumNatural_$c* twoTimesTwo1 (NatS# wild2_a2uf) } }; Jn# ipv_a2ui -> case underflowError of wild1_00 { } } }}} This is not surprising, since constant folding of `Integer` works only due to a special Core literal `LitInteger` and a set of hardcoded `PrelRules.builtinIntegerRules` (and `NOINLINE` pragmas in `GHC.Integer.Type`). ---- Is it reasonable to make `Natural` a first-class Core citizen? I suppose a new `LitNatural` node and decent amount of copy-paste will do. Or, possibly, we may reuse `LitInteger Integer Type` with appropriate `Type` to avoid some duplication of code. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/14465> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 4