September 2018 - ghc-tickets

[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

[GHC] #9163: Ptr should have a phantom role
by GHC 28 Oct '18

28 Oct '18

#9163: Ptr should have a phantom role ------------------------------------+------------------------------------- Reporter: simonpj | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 Keywords: | Operating System: Unknown/Multiple Architecture: Unknown/Multiple | Type of failure: None/Unknown Difficulty: Unknown | Test Case: Blocked By: | Blocking: Related Tickets: | ------------------------------------+------------------------------------- In `GHC.Ptr` we see {{{ type role Ptr representational data Ptr a = Ptr Addr# deriving (Eq, Ord) }}} with no comments. Why is `Ptr` representational? In the same module we have `castPtr`: {{{ castPtr :: Ptr a -> Ptr b castPtr (Ptr addr) = Ptr addr }}} which unpacks and repacks a `Ptr`. If `Ptr` was phantom, we could use `coerce`. And that in turn would actually make a lot of code more efficient – there are lots of calls to `castPtr`. Specifically, in `nofib`, I tried implementing `castPtr` with `unsafeCoerce`. Then I found: * 12% less allocation in `reverse-complem` * 7.3% less allocation in `fasta`. * Binary sizes fell 0.1%. Both these benchmarks are ones that do a ''lot'' of I/O, and it turns out that `GHC.IO.Handle.Text.$wa1` has a `castPtr` that (all by itself) accounts for 12% of `reverse-complem`'s total allocation! So making `castPtr` free is good. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/9163> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 41

[GHC] #13809: TH-reified data family instances have a paucity of kinds
by GHC 27 Oct '18

27 Oct '18

#13809: TH-reified data family instances have a paucity of kinds -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Template | Version: 8.0.1 Haskell | 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: -------------------------------------+------------------------------------- Consider this data family (and instances): {{{#!hs {-# LANGUAGE TypeFamilies #-} module Foo where data family Foo a data instance Foo ((f :: * -> *) (a :: *)) data instance Foo ((f :: (* -> *) -> *) (a :: (* -> *))) }}} These are two data family instances that GHC distinguishes by the kinds of their type parameters. However, Template Haskell does not give me the same insight that GHC has, because if I call `Language.Haskell.TH.reify ''Foo`, I get this: {{{#!hs FamilyI (DataFamilyD Foo.Foo [ KindedTV a_6989586621679025989 StarT ] (Just StarT)) [ DataInstD [] Foo.Foo [ AppT (VarT f_6989586621679026001) (VarT a_6989586621679026000) ] Nothing [] [] , DataInstD [] Foo.Foo [ AppT (VarT f_6989586621679026007) (VarT a_6989586621679026006) ] Nothing [] [] ] }}} Note that neither `f` nor `a` have a kind signature in either instance! This makes it completely impossible to tell which is which (aside from the order, which is brittle). It would make my life a lot easier if TH were to include kind signatures for each type variable in a data family instance. I can see two ways to accomplish this: 1. Include a `[TyVarBndr]` field in `DataInstD` and `NewtypeInstD` where each `TyVarBndr` is a `KindedTV`. 2. Walk over the `Type`s in a `DataInstD`/`NewtypeInstD` and ensure that every occurrence of a `VarT` is surrounded with `SigT` to indicate its kind. While (1) is arguably the cleaner solution, since it makes the kinds easy to discover, it is a breaking change. Therefore, I'm inclined to implement option (2) instead. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13809> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 9

[GHC] #14268: Implement Explicit Foralls Proposal
by GHC 27 Oct '18

27 Oct '18

#14268: Implement Explicit Foralls Proposal -------------------------------------+------------------------------------- Reporter: johnleo | Owner: (none) Type: task | Status: new Priority: normal | Milestone: 8.4.1 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: -------------------------------------+------------------------------------- Implement Richard Eisenberg's Explicit Foralls proposal. https://github.com/ghc-proposals/ghc-proposals/pull/55 For details see the proposal: https://github.com/goldfirere/ghc-proposals/blob/instance- forall/proposals/0000-instance-foralls.rst -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/14268> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 13

[GHC] #15351: QuantifiedConstraints ignore FunctionalDependencies
by GHC 27 Oct '18

27 Oct '18

#15351: QuantifiedConstraints ignore FunctionalDependencies -------------------------------------+------------------------------------- Reporter: aaronvargo | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.5 (Type checker) | 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: -------------------------------------+------------------------------------- The following code fails to compile: {{{#!hs {-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE FunctionalDependencies #-} class C a b | a -> b where foo :: a -> b bar :: (forall a. C (f a) Int) => f a -> String bar = show . foo }}} {{{ • Could not deduce (Show a0) arising from a use of ‘show’ ... The type variable ‘a0’ is ambiguous }}} Yet it ought to work, since this is perfectly fine with top-level instances: {{{#!hs instance C [a] Int where ... baz :: [a] -> String baz = show . foo }}} -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/15351> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 12

[GHC] #11238: Redesign the dynamic linking on ELF systems
by GHC 26 Oct '18

26 Oct '18

#11238: Redesign the dynamic linking on ELF systems -------------------------------------+------------------------------------- Reporter: trommler | Owner: trommler Type: task | Status: new Priority: normal | Milestone: 8.2.1 Component: Runtime | Version: 7.10.3 System (Linker) | Keywords: | Operating System: Linux Architecture: | Type of failure: Other Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This ticket is to follow up on my comment on #11042. Let's give dynamic linking on ELF systems a second chance. I propose the following steps: 1. Collect required features 1. Write up and discuss and agree on a specification 1. Create regression tests for all features 1. Design and implement a new dynamic linker for GHCi 1. (optional) Make it work on Mac OS X too -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/11238> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 10

[GHC] #10353: Haddock for Data.List should list instances
by GHC 26 Oct '18

26 Oct '18

#10353: Haddock for Data.List should list instances -------------------------------------+------------------------------------- Reporter: goldfire | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: | Version: 7.10.1 Documentation | Operating System: Unknown/Multiple Keywords: | Type of failure: None/Unknown Architecture: | Blocked By: Unknown/Multiple | Related Tickets: Test Case: | Blocking: | Differential Revisions: | -------------------------------------+------------------------------------- I'd like to know the set of classes for which there are instances for `[]`. So, I naturally looked in the documentation for `Data.List`. However, because `Data.List` doesn't export `[]`, this list isn't there. Can this be fixed? (It's an honest question -- because of `[]`'s special syntax, I could see this fix being non-trivial.) -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/10353> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 1

[GHC] #15078: base: Customary type class laws (e.g. for Eq) and non-abiding instances (e.g. Float) should be documented
by GHC 26 Oct '18

26 Oct '18

#15078: base: Customary type class laws (e.g. for Eq) and non-abiding instances (e.g. Float) should be documented -------------------------------------+------------------------------------- Reporter: sjakobi | Owner: (none) Type: feature | Status: new request | Priority: normal | Milestone: 8.6.1 Component: Core | Version: 8.4.2 Libraries | 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: -------------------------------------+------------------------------------- As beginning Haskellers regularly ask about these laws and instances I think it would be good to have them documented where they are defined. Here's a first draft of what I have in mind for `Float`'s `Eq` and `Ord` instances: {{{ -- | Note that in the presence of @NaN@, this instance does not satisfy -- reflexivity: -- -- >>> nan = 0/0 :: Float -- >>> nan == nan -- False -- -- Also note that this instance does not encode structural equality: -- -- >>> 0 == (-0 :: Float) -- True -- >>> recip 0 == recip (-0 :: Float) -- False instance Eq Float where (==) = eqFloat }}} {{{ -- | Due to the peculiarities of @NaN@, this instance does not satisfy totality: -- -- >>> nan = 0/0 :: Float -- >>> nan <= nan -- False -- -- Another special case with @NaN@ is: -- -- @ -- 'compare' x y -- | 'isNaN' x || 'isNaN' y = 'GT' -- @ -- -- However -- -- @ -- nan > _ = False -- _ > nan = False -- @ -- -- In consequence we also have: -- -- @ -- 'max' x y | 'isNaN' x || 'isNaN' y = x -- 'min' x y | 'isNaN' x || 'isNaN' y = y -- @ -- -- Ignoring @NaN@, @Infinity@ and @-Infinity@ are the respective greatest -- and least elements of 'Float'. instance Ord Float where (F# x) `compare` (F# y) = if isTrue# (x `ltFloat#` y) then LT else if isTrue# (x `eqFloat#` y) then EQ else GT (F# x) < (F# y) = isTrue# (x `ltFloat#` y) (F# x) <= (F# y) = isTrue# (x `leFloat#` y) (F# x) >= (F# y) = isTrue# (x `geFloat#` y) (F# x) > (F# y) = isTrue# (x `gtFloat#` y) }}} -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/15078> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 22

[GHC] #13913: Can't apply higher-ranked kind in type family
by GHC 26 Oct '18

26 Oct '18

#13913: Can't apply higher-ranked kind in type family -------------------------------------+------------------------------------- Reporter: RyanGlScott | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 (Type checker) | Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: GHC rejects Unknown/Multiple | valid program Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- This code doesn't typecheck due to `F2`: {{{#!hs {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeInType #-} module Bug where import Data.Kind f :: (forall (a :: Type). a -> a) -> Bool f g = g True type F1 (g :: forall (a :: Type). a -> a) = g True type family F2 (g :: forall (a :: Type). a -> a) :: Bool where F2 g = g True }}} {{{ $ /opt/ghc/8.2.1/bin/ghci Bug.hs GHCi, version 8.2.0.20170623: http://www.haskell.org/ghc/ :? for help Loaded GHCi configuration from /home/rgscott/.ghci [1 of 1] Compiling Bug ( Bug.hs, interpreted ) Bug.hs:14:6: error: • Expected kind ‘forall a. a -> a’, but ‘g’ has kind ‘Bool -> Bool’ • In the first argument of ‘F2’, namely ‘g’ In the type family declaration for ‘F2’ | 14 | F2 g = g True | ^ }}} This is surprising to me, since `F2` seems like the type family counterpart to `f` and `F1`, both of which typecheck. -- Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13913> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler

1 4