1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Data.Void (Void)
import Test.Tasty.Bench
import qualified Data.Sequence as Seq
import qualified Dhall.Core as Core
import qualified Dhall.Import as Import
import qualified Dhall.TypeCheck as TypeCheck
dhallPreludeImport :: Core.Import
dhallPreludeImport = Core.Import
{ Core.importMode = Core.Code
, Core.importHashed = Core.ImportHashed
{ Core.hash = Nothing
, Core.importType = Core.Local Core.Here $ Core.File
{ Core.directory = Core.Directory ["deep-nested-large-record", "benchmark"]
, Core.file = "prelude.dhall"
}
}
}
issue412 :: Core.Expr s Void -> Benchmarkable
issue412 prelude = whnf TypeCheck.typeOf expr
where
expr
= Core.Let (Core.Binding Nothing "prelude" Nothing Nothing Nothing prelude)
$ Core.ListLit Nothing
$ Seq.replicate 5
$ Core.Var (Core.V "prelude" 0) `Core.Field` types `Core.Field` little `Core.Field` foo
types = Core.makeFieldSelection "types"
little = Core.makeFieldSelection "little"
foo = Core.makeFieldSelection "Foo"
unionPerformance :: Core.Expr s Void -> Benchmarkable
unionPerformance prelude = whnf TypeCheck.typeOf expr
where
expr =
Core.Let
(Core.Binding
Nothing
"x"
Nothing
Nothing
Nothing
(Core.Let
(Core.Binding
Nothing
"big"
Nothing
Nothing
Nothing
(prelude `Core.Field` types `Core.Field` big)
)
(Core.Prefer mempty Core.PreferFromSource "big" "big")
)
)
"x"
types = Core.makeFieldSelection "types"
big = Core.makeFieldSelection "Big"
main :: IO ()
main =
defaultMain
[ env prelude $ \p ->
bgroup "Prelude"
[ bench "issue 412" (issue412 p)
, bench "union performance" (unionPerformance p)
]
]
where prelude = Import.load (Core.Embed dhallPreludeImport)
|
