Skip to content

Instantly share code, notes, and snippets.

@gksato

gksato/Length_test.md

Last active June 3, 2020 22:45
Show Gist options
  • Save gksato/417030a1f19f1f376dcb2fabaf66c10a to your computer and use it in GitHub Desktop.
Save gksato/417030a1f19f1f376dcb2fabaf66c10a to your computer and use it in GitHub Desktop.
Download ZIP
Two optimization results of Data.Vector.Generic.length with different revisions
Raw
Length_test.md

Test of vector: Data.Vector.Generic.length revised

Summary

This gist is here to record the result of a test I conducted in order to compare the optimization of versions of the function Data.Vector.Generic.length in vector. The test was conducted by compiling a simple program (Test.hs) with different revisions and checking the optimization result (-ddump-simpl). The versions compared are:

Test requisites

  • git
  • Haskell Stack

Test content

  1. Clone the repository. The working tree root is considered as the working directory: 
    $ git clone https://github.com/gksato/vector.git
$ cd vector
  2. Copy the content of this gist to a subfolder of vector. Say this folder is named test-length.
  3. Move stack.yaml upward: 
    $ mv test-length/stack.yaml ./stack.yaml
  4. checkout any of the revisions: 
    # For the old version:
$ git checkout eeb42ad42aa345ce192086baed80c805bcfc3e72
# For the new version:
$ git checkout 50c0ff0ac24c7d39c1d7c69c8311316187fb766c
  5. Compile the test: 
    $ stack build vector:lib && stack ghc -- -ddump-simpl -ddump-to-file -O2 Test.hs
  6. You get the optimization result in Test.dump-simpl.

changelog

  • 03-Jun-2020 Gist created
  • 04-Jun-2020 Fixed the file name
Raw
stack.yaml
# This file was automatically generated by 'stack init'
#
# Some commonly used options have been documented as comments in this file.
# For advanced use and comprehensive documentation of the format, please see:
# https://docs.haskellstack.org/en/stable/yaml_configuration/
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
# A snapshot resolver dictates the compiler version and the set of packages
# to be used for project dependencies. For example:
#
# resolver: lts-3.5
# resolver: nightly-2015-09-21
# resolver: ghc-7.10.2
#
# The location of a snapshot can be provided as a file or url. Stack assumes
# a snapshot provided as a file might change, whereas a url resource does not.
#
# resolver: ./custom-snapshot.yaml
# resolver: https://example.com/snapshots/2018-01-01.yaml
resolver: lts-15.15
# User packages to be built.
# Various formats can be used as shown in the example below.
#
# packages:
# - some-directory
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
# subdirs:
# - auto-update
# - wai
packages:
- .
- benchmarks
# Dependency packages to be pulled from upstream that are not in the resolver.
# These entries can reference officially published versions as well as
# forks / in-progress versions pinned to a git hash. For example:
#
# extra-deps:
# - acme-missiles-0.3
# - git: https://github.com/commercialhaskell/stack.git
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
#
# extra-deps: []
# Override default flag values for local packages and extra-deps
# flags: {}
# Extra package databases containing global packages
# extra-package-dbs: []
# Control whether we use the GHC we find on the path
# system-ghc: true
#
# Require a specific version of stack, using version ranges
# require-stack-version: -any # Default
# require-stack-version: ">=2.3"
#
# Override the architecture used by stack, especially useful on Windows
# arch: i386
# arch: x86_64
#
# Extra directories used by stack for building
# extra-include-dirs: [/path/to/dir]
# extra-lib-dirs: [/path/to/dir]
#
# Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor
Raw
Test.hs
import qualified Data.Vector.Unboxed as VU
x :: Int
x = VU.length
$ VU.filter (==1)
$ VU.takeWhile (<40)
$ VU.generate (maxBound `div` 16) id
main :: IO ()
main = print x
Raw
TestAfter.dump-simpl
==================== Tidy Core ====================
2020-06-03 04:55:10.207365 UTC
Result size of Tidy Core
= {terms: 70, types: 41, coercions: 3, joins: 0/0}
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
Main.$trModule4 :: GHC.Prim.Addr#
[GblId,
Caf=NoCafRefs,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
Main.$trModule4 = "main"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
Main.$trModule3 :: GHC.Types.TrName
[GblId,
Caf=NoCafRefs,
Str=m1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
Main.$trModule3 = GHC.Types.TrNameS Main.$trModule4
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
Main.$trModule2 :: GHC.Prim.Addr#
[GblId,
Caf=NoCafRefs,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
Main.$trModule2 = "Main"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
Main.$trModule1 :: GHC.Types.TrName
[GblId,
Caf=NoCafRefs,
Str=m1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
Main.$trModule1 = GHC.Types.TrNameS Main.$trModule2
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
Main.$trModule :: GHC.Types.Module
[GblId,
Caf=NoCafRefs,
Str=m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
Main.$trModule = GHC.Types.Module Main.$trModule3 Main.$trModule1
Rec {
-- RHS size: {terms: 30, types: 5, coercions: 0, joins: 0/0}
Main.main_$s$wfoldlM'_loop [Occ=LoopBreaker]
:: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int#
[GblId, Arity=2, Caf=NoCafRefs, Str=<L,U><L,U>, Unf=OtherCon []]
Main.main_$s$wfoldlM'_loop
= \ (sc_s7ZU :: GHC.Prim.Int#) (sc1_s7ZT :: GHC.Prim.Int#) ->
case GHC.Prim.<# sc_s7ZU 576460752303423487# of {
__DEFAULT -> sc1_s7ZT;
1# ->
case GHC.Prim.<# sc_s7ZU 40# of {
__DEFAULT -> sc1_s7ZT;
1# ->
case sc_s7ZU of wild_X1b {
__DEFAULT ->
Main.main_$s$wfoldlM'_loop (GHC.Prim.+# wild_X1b 1#) sc1_s7ZT;
1# -> Main.main_$s$wfoldlM'_loop 2# (GHC.Prim.+# sc1_s7ZT 1#)
}
}
}
end Rec }
-- RHS size: {terms: 14, types: 12, coercions: 0, joins: 0/0}
Main.main1 :: String
[GblId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 100 30}]
Main.main1
= case Main.main_$s$wfoldlM'_loop 0# 0# of ww_s7Wa { __DEFAULT ->
case GHC.Show.$wshowSignedInt 0# ww_s7Wa (GHC.Types.[] @ Char) of
{ (# ww5_i4PU, ww6_i4PV #) ->
GHC.Types.: @ Char ww5_i4PU ww6_i4PV
}
}
-- RHS size: {terms: 4, types: 0, coercions: 0, joins: 0/0}
main :: IO ()
[GblId,
Arity=1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 60}]
main
= GHC.IO.Handle.Text.hPutStr'
GHC.IO.Handle.FD.stdout Main.main1 GHC.Types.True
-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
Main.main2
:: GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld, () #)
[GblId,
Arity=1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}]
Main.main2 = GHC.TopHandler.runMainIO1 @ () main
-- RHS size: {terms: 1, types: 0, coercions: 3, joins: 0/0}
:Main.main :: IO ()
[GblId,
Arity=1,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)
Tmpl= Main.main2
`cast` (Sym (GHC.Types.N:IO[0] <()>_R)
:: (GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld, () #))
~R# IO ())}]
:Main.main
= Main.main2
`cast` (Sym (GHC.Types.N:IO[0] <()>_R)
:: (GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld, () #))
~R# IO ())
Raw
TestBefore.dump-simpl
==================== Tidy Core ====================
2020-06-03 04:57:26.342845 UTC
Result size of Tidy Core
= {terms: 113, types: 188, coercions: 115, joins: 1/1}
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
Main.$trModule4 :: GHC.Prim.Addr#
[GblId,
Caf=NoCafRefs,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
Main.$trModule4 = "main"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
Main.$trModule3 :: GHC.Types.TrName
[GblId,
Caf=NoCafRefs,
Str=m1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
Main.$trModule3 = GHC.Types.TrNameS Main.$trModule4
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
Main.$trModule2 :: GHC.Prim.Addr#
[GblId,
Caf=NoCafRefs,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
Main.$trModule2 = "Main"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
Main.$trModule1 :: GHC.Types.TrName
[GblId,
Caf=NoCafRefs,
Str=m1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
Main.$trModule1 = GHC.Types.TrNameS Main.$trModule2
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
Main.$trModule :: GHC.Types.Module
[GblId,
Caf=NoCafRefs,
Str=m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
Main.$trModule = GHC.Types.Module Main.$trModule3 Main.$trModule1
-- RHS size: {terms: 71, types: 107, coercions: 109, joins: 1/1}
Main.main2
:: GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld, VU.Vector Int #)
[GblId,
Arity=1,
Caf=NoCafRefs,
Str=<L,U>,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 122 0}]
Main.main2
= \ (s1_i59o [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
case GHC.Prim.newByteArray#
@ (Control.Monad.Primitive.PrimState
(GHC.ST.ST GHC.Prim.RealWorld))
4611686018427387896#
(s1_i59o
`cast` ((GHC.Prim.State#
(Sym (Control.Monad.Primitive.D:R:PrimStateST[0]
(Nth:0
(Nth:2
(<GHC.Prim.State# GHC.Prim.RealWorld>_R
->_R ((#,#)
<'GHC.Types.TupleRep '[]>_R
<'GHC.Types.LiftedRep>_R
<GHC.Prim.State# GHC.Prim.RealWorld>_R
(Data.Vector.Generic.Base.Mutable
<VU.Vector>_N
(Control.Monad.Primitive.D:R:PrimStateST[0]
<GHC.Prim.RealWorld>_N)
<Int>_N)_R)_R))))))_R
:: GHC.Prim.State# GHC.Prim.RealWorld
~R# GHC.Prim.State#
(Control.Monad.Primitive.PrimState
(GHC.ST.ST GHC.Prim.RealWorld))))
of
{ (# ipv_i8aR, ipv1_i8aS #) ->
joinrec {
$s$wfoldlM'_loop_saoo [Occ=LoopBreaker]
:: GHC.Prim.State# GHC.Prim.RealWorld
-> GHC.Prim.Int#
-> GHC.Prim.Int#
-> (# GHC.Prim.State# GHC.Prim.RealWorld, VU.Vector Int #)
[LclId[JoinId(3)], Arity=3, Str=<L,U><L,U><L,U>, Unf=OtherCon []]
$s$wfoldlM'_loop_saoo (sc_saon
:: GHC.Prim.State# GHC.Prim.RealWorld)
(sc1_saol :: GHC.Prim.Int#)
(sc2_saok :: GHC.Prim.Int#)
= case GHC.Prim.<# sc1_saol 576460752303423487# of {
__DEFAULT ->
case GHC.Prim.unsafeFreezeByteArray#
@ (Control.Monad.Primitive.PrimState
(GHC.ST.ST GHC.Prim.RealWorld))
ipv1_i8aS
(sc_saon
`cast` ((GHC.Prim.State#
(Sym (Control.Monad.Primitive.D:R:PrimStateST[0]
(Nth:0
(Nth:2
(Nth:3
(<GHC.Prim.State# GHC.Prim.RealWorld>_R
->_R ((#,#)
<'GHC.Types.TupleRep '[]>_R
<'GHC.Types.LiftedRep>_R
<GHC.Prim.State#
GHC.Prim.RealWorld>_R
(Data.Vector.Generic.Base.Mutable
<VU.Vector>_N
(Sym (Control.Monad.Primitive.D:R:PrimStateST[0]
<GHC.Prim.RealWorld>_N))
<Int>_N)_R)_R)))))))_R
:: GHC.Prim.State# GHC.Prim.RealWorld
~R# GHC.Prim.State#
(Control.Monad.Primitive.PrimState
(GHC.ST.ST GHC.Prim.RealWorld))))
of
{ (# ipv2_i88O, ipv3_i88P #) ->
(# ipv2_i88O
`cast` ((GHC.Prim.State#
(Control.Monad.Primitive.D:R:PrimStateST[0]
<GHC.Prim.RealWorld>_N))_R
:: GHC.Prim.State#
(Control.Monad.Primitive.PrimState (GHC.ST.ST GHC.Prim.RealWorld))
~R# GHC.Prim.State# GHC.Prim.RealWorld),
(Data.Vector.Primitive.Vector @ Int 0# sc2_saok ipv3_i88P)
`cast` (Sym (Data.Vector.Unboxed.Base.N:R:VectorInt[0]) ; Sym (Data.Vector.Unboxed.Base.D:R:VectorInt0[0])
:: Data.Vector.Primitive.Vector Int ~R# VU.Vector Int) #)
};
1# ->
case GHC.Prim.<# sc1_saol 40# of {
__DEFAULT ->
case GHC.Prim.unsafeFreezeByteArray#
@ (Control.Monad.Primitive.PrimState
(GHC.ST.ST GHC.Prim.RealWorld))
ipv1_i8aS
(sc_saon
`cast` ((GHC.Prim.State#
(Sym (Control.Monad.Primitive.D:R:PrimStateST[0]
(Nth:0
(Nth:2
(Nth:3
(<GHC.Prim.State#
GHC.Prim.RealWorld>_R
->_R ((#,#)
<'GHC.Types.TupleRep '[]>_R
<'GHC.Types.LiftedRep>_R
<GHC.Prim.State#
GHC.Prim.RealWorld>_R
(Data.Vector.Generic.Base.Mutable
<VU.Vector>_N
(Sym (Control.Monad.Primitive.D:R:PrimStateST[0]
<GHC.Prim.RealWorld>_N))
<Int>_N)_R)_R)))))))_R
:: GHC.Prim.State# GHC.Prim.RealWorld
~R# GHC.Prim.State#
(Control.Monad.Primitive.PrimState
(GHC.ST.ST GHC.Prim.RealWorld))))
of
{ (# ipv2_i88O, ipv3_i88P #) ->
(# ipv2_i88O
`cast` ((GHC.Prim.State#
(Control.Monad.Primitive.D:R:PrimStateST[0]
<GHC.Prim.RealWorld>_N))_R
:: GHC.Prim.State#
(Control.Monad.Primitive.PrimState
(GHC.ST.ST GHC.Prim.RealWorld))
~R# GHC.Prim.State# GHC.Prim.RealWorld),
(Data.Vector.Primitive.Vector @ Int 0# sc2_saok ipv3_i88P)
`cast` (Sym (Data.Vector.Unboxed.Base.N:R:VectorInt[0]) ; Sym (Data.Vector.Unboxed.Base.D:R:VectorInt0[0])
:: Data.Vector.Primitive.Vector Int ~R# VU.Vector Int) #)
};
1# ->
case sc1_saol of wild_X1x {
__DEFAULT ->
jump $s$wfoldlM'_loop_saoo
sc_saon (GHC.Prim.+# wild_X1x 1#) sc2_saok;
1# ->
case GHC.Prim.writeIntArray#
@ (Control.Monad.Primitive.PrimState
(GHC.ST.ST GHC.Prim.RealWorld))
ipv1_i8aS
sc2_saok
1#
(sc_saon
`cast` ((GHC.Prim.State#
(Sym (Control.Monad.Primitive.D:R:PrimStateST[0]
<GHC.Prim.RealWorld>_N)))_R
:: GHC.Prim.State# GHC.Prim.RealWorld
~R# GHC.Prim.State#
(Control.Monad.Primitive.PrimState
(GHC.ST.ST GHC.Prim.RealWorld))))
of s'#_i8Nc
{ __DEFAULT ->
jump $s$wfoldlM'_loop_saoo
(s'#_i8Nc
`cast` ((GHC.Prim.State#
(Control.Monad.Primitive.D:R:PrimStateST[0]
<GHC.Prim.RealWorld>_N))_R
:: GHC.Prim.State#
(Control.Monad.Primitive.PrimState
(GHC.ST.ST GHC.Prim.RealWorld))
~R# GHC.Prim.State# GHC.Prim.RealWorld))
2#
(GHC.Prim.+# sc2_saok 1#)
}
}
}
}; } in
jump $s$wfoldlM'_loop_saoo
(ipv_i8aR
`cast` ((GHC.Prim.State#
(Control.Monad.Primitive.D:R:PrimStateST[0]
(Nth:0
(Nth:2
(Nth:3
(<GHC.Prim.State# GHC.Prim.RealWorld>_R
->_R ((#,#)
<'GHC.Types.TupleRep '[]>_R
<'GHC.Types.LiftedRep>_R
<GHC.Prim.State# GHC.Prim.RealWorld>_R
(Sub (Sym (Data.Vector.Unboxed.Base.D:R:MutableVector[0])) <Control.Monad.Primitive.PrimState
(GHC.ST.ST
GHC.Prim.RealWorld)>_N <Int>_N))_R))))))_R
:: GHC.Prim.State#
(Control.Monad.Primitive.PrimState (GHC.ST.ST GHC.Prim.RealWorld))
~R# GHC.Prim.State# GHC.Prim.RealWorld))
0#
0#
}
-- RHS size: {terms: 16, types: 49, coercions: 3, joins: 0/0}
Main.main1 :: String
[GblId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 100 30}]
Main.main1
= case GHC.Magic.runRW#
@ ('GHC.Types.TupleRep
'[ 'GHC.Types.TupleRep '[], 'GHC.Types.LiftedRep])
@ (# GHC.Prim.State# GHC.Prim.RealWorld, VU.Vector Int #)
Main.main2
of
{ (# ipv1_i5bJ, ipv2_i5bK #) ->
case ipv2_i5bK
`cast` (Data.Vector.Unboxed.Base.D:R:VectorInt0[0] ; Data.Vector.Unboxed.Base.N:R:VectorInt[0]
:: VU.Vector Int ~R# Data.Vector.Primitive.Vector Int)
of
{ Data.Vector.Primitive.Vector ipv_s8vC ipv4_s8vD ipv5_s8vE ->
case GHC.Show.$wshowSignedInt 0# ipv4_s8vD (GHC.Types.[] @ Char) of
{ (# ww5_i4PU, ww6_i4PV #) ->
GHC.Types.: @ Char ww5_i4PU ww6_i4PV
}
}
}
-- RHS size: {terms: 4, types: 0, coercions: 0, joins: 0/0}
main :: IO ()
[GblId,
Arity=1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 60}]
main
= GHC.IO.Handle.Text.hPutStr'
GHC.IO.Handle.FD.stdout Main.main1 GHC.Types.True
-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0}
Main.main3
:: GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld, () #)
[GblId,
Arity=1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}]
Main.main3 = GHC.TopHandler.runMainIO1 @ () main
-- RHS size: {terms: 1, types: 0, coercions: 3, joins: 0/0}
:Main.main :: IO ()
[GblId,
Arity=1,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)
Tmpl= Main.main3
`cast` (Sym (GHC.Types.N:IO[0] <()>_R)
:: (GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld, () #))
~R# IO ())}]
:Main.main
= Main.main3
`cast` (Sym (GHC.Types.N:IO[0] <()>_R)
:: (GHC.Prim.State# GHC.Prim.RealWorld
-> (# GHC.Prim.State# GHC.Prim.RealWorld, () #))
~R# IO ())
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment