git.iko.soy/elk
on master help sign in
Merge pull request #1089 from elm-lang/dev

update benchmarks, fix a bug

commit59087d94b798db6ae8a44ae47cb798eb37fba9ab authorEvan Czaplicki <info@elm-lang.org> dateThu 8 Oct 2015, 14:31 (11 years ago) parent8a2e85d2667e18
26 files changed+680−1493
compare with master
unifiedsplit
.gitignore+1 bench/CompilerBenchmarks.elm−165 bench/elm-package.json+4−3 bench/src/AnimateBench.elm−58 bench/src/ArrayBench.elm−94 bench/src/Benchmark.elm+106−197 bench/src/CtorBench.elm−135 bench/src/DictBench.elm−63 bench/src/IfBench.elm−104 bench/src/LargeDictionary.elm−34 bench/src/ListBench.elm−85 bench/src/Main.elm+46 bench/src/Native/Benchmark.js+62−86 bench/src/PatternMatchBench.elm−70 bench/src/Realistic/Check.elm+65 bench/src/Realistic/Todo.elm+169 bench/src/RecordBench.elm−76 bench/src/SmallCtorBench.elm−76 bench/src/SmallRecordBench.elm−42 bench/src/SmallTupleBench.elm−30 bench/src/Syntax/Case.elm+80 bench/src/Syntax/Let.elm+37 bench/src/Syntax/Records.elm+109 bench/src/TodoBench.elm−132 bench/src/TupleBench.elm−42 src/Canonicalize/Setup.hs+1−1
.gitignore+1
@@ -1,3 +1,4 @@
1+elm-stuff
12dist
23cabal-dev
34.cabal-sandbox/
bench/CompilerBenchmarks.elmdeleted−165
@@ -1,165 +0,0 @@
1−import Graphics.Element exposing (show)
2−import Signal
3−import Benchmark
4−import Task exposing (Task, andThen)
5−import Text
6−import Array
7−import Random
8−import Dict
9−import Time
10−
11−import LargeDictionary
12−import ArrayBench
13−import ListBench
14−
15−import RecordBench
16−import SmallRecordBench
17−import TupleBench
18−import SmallTupleBench
19−import CtorBench
20−import SmallCtorBench
21−import PatternMatchBench
22−import IfBench
23−import DictBench
24−
25−import AnimateBench
26−import TodoBench
27−
28−{-| Compile this with --output=Benchmarks.html to generate
29− a webpage, which runs the benchmarks and shows the results.
30−-}
31−
32−
33−mySuite =
34− Benchmark.Suite "My Suite"
35− [ Benchmark.bench1 "Access 20-field record 200 times: " RecordBench.sumRandomElems indices200
36− , Benchmark.bench1 "Access 9-field record 200 times: " SmallRecordBench.sumRandomElems indices200
37−
38− , Benchmark.bench1 "Access 9-field tuple 200 times: " TupleBench.sumRandomElems indices200
39− , Benchmark.bench1 "Access 3-field tuple 200 times: " SmallTupleBench.sumRandomElems indices200
40−
41− , Benchmark.bench1 "Access 20-constructor Type 200 times: " CtorBench.sumFieldsList ctorData200
42− , Benchmark.bench1 "Access 10-constructor Type 200 times: " SmallCtorBench.sumFieldsList smallCtorData200
43−
44− , Benchmark.bench1 "Tail-recursive if function, called 200 times: " IfBench.tailRecSum indices200
45− , Benchmark.bench1 "If expression with 20 branches, called 200 times: " IfBench.manyConditionalSum indices200
46− , Benchmark.bench1 "If expression with 4 branches, called 200 times: " IfBench.fewConditionalSum indices200
47−
48− , Benchmark.bench1 "Pattern match 18-levels deep, use all values, 200 times " PatternMatchBench.deepMatchSum nestedData200
49− , Benchmark.bench1 "Pattern match 18-levels deep, 16 wildcards, 200 times " PatternMatchBench.wildcardMatchSum nestedData200
50− , Benchmark.bench1 "Pattern match 4-levels deep, use all values, 200 times " PatternMatchBench.shallowMatchSum nestedData200
51−
52− , Benchmark.bench1 "Make and sum dict, 10000 elems: " LargeDictionary.addNToDictAndSum 10000
53− , Benchmark.bench1 "Make and sum dict, 50 elems: " LargeDictionary.addNToDictAndSum 50
54−
55− , Benchmark.bench1 "Array native foldr, 500 elems: " ArrayBench.foldrMeanStddev array500
56− , Benchmark.bench1 "Array native foldl, 500 elems: " ArrayBench.foldlMeanStddev array500
57− , Benchmark.bench1 "Array custom foldr, 500 elems: " ArrayBench.customFoldrMeanStddev array500
58− , Benchmark.bench1 "Array custom foldl, 500 elems: " ArrayBench.customFoldrMeanStddev array500
59− , Benchmark.bench3 "Array square nth elem, 500 elems: " ArrayBench.updateNRandomIndices (\x -> x*x) indices200 array500
60−
61− , Benchmark.bench1 "Dict native foldr, 500 elems: " DictBench.foldrMeanStddev dict500
62− , Benchmark.bench1 "Dict native foldl, 500 elems: " DictBench.foldlMeanStddev dict500
63− , Benchmark.bench3 "Dict square nth elem, 500 elems: " DictBench.updateNRandomIndices (\x -> x*x) indices200 dict500
64−
65− , Benchmark.bench1 "List native foldr, 500 elems: " ListBench.foldrMeanStddev list500
66− , Benchmark.bench1 "List native foldl, 500 elems: " ListBench.foldlMeanStddev list500
67− , Benchmark.bench1 "List custom foldr, 500 elems: " ListBench.customFoldrMeanStddev list500
68− , Benchmark.bench1 "List custom foldl, 500 elems: " ListBench.customFoldrMeanStddev list500
69− , Benchmark.bench3 "List square nth elem, 500 elems: " ListBench.updateNRandomIndices (\x -> x*x) indices200 list500
70−
71− , Benchmark.bench2 "200 lookups in array of 500 elems: " ArrayBench.randomLookups indices200 (Array.fromList [1 .. 500] )
72− , Benchmark.bench2 "200 lookups in list of 500 elems: " ListBench.randomLookups indices200 ([1 .. 500] )
73− , Benchmark.bench2 "200 lookups in dict of 500 elems: " DictBench.randomLookups indices200 (Dict.fromList (List.map2 (,) [1 .. 500] [1 .. 500]) )
74−
75− , Benchmark.bench1 "30s simulated animation @ 30fps: " AnimateBench.runAnimation timeSteps30s
76− , Benchmark.bench1 "TodoMVC: approx. 330 simulated actions " TodoBench.evalActions TodoBench.testActions
77− ]
78−
79−
80−--Display of results:
81−
82−--Mailbox updated with benchmark run progress
83−results : Signal.Mailbox String
84−results =
85− Signal.mailbox "Benchmark loading"
86−
87−
88−--The actual task which runs the benchmarks
89−port benchResults : (Task Benchmark.Never ())
90−port benchResults =
91− Benchmark.runWithProgress (Just results) mySuite
92− `andThen` \_ -> Task.sleep 0
93−
94−
95−--Our main page:
96−main =
97− Signal.map (Graphics.Element.leftAligned << Text.fromString) results.signal
98−
99−
100−
101−-- Random generation and structures
102−
103−--Maximum size for random numbers
104−maxSize = 1000000
105−
106−
107−--Random generator for floating point numbers
108−floatGen =
109− Random.float (-1 * maxSize) (maxSize)
110−
111−
112−--Generate random indices for lists out of 500 elements
113−indexGen =
114− Random.int (0) (499)
115−
116−
117−--Random seeds: they're fixed, so it's not truly random
118−--But we get seemingly random data, that we can compare fairly
119−--across multiple runs of the benchmark
120−
121−--seed for our index generation
122−indexSeed =
123− Random.initialSeed 56
124−
125−
126−--Seed for our float generation
127−seed =
128− Random.initialSeed 23
129−
130−
131−--Pseudo-random array of 500 floating point numbers
132−array500 =
133− (ArrayBench.randomArray floatGen 500 seed)
134−
135−
136−--Pseudo-random dictionary, indexed 0 .. 500, of 500 floating point numbers
137−dict500 =
138− (DictBench.randomDict floatGen 500 seed)
139−
140−
141−
142−--Same contents as array500, but in list form
143−list500 =
144− (ListBench.randomList floatGen 500 seed)
145−
146−
147−--Pseudo random list of 200 indices between 0 and 499
148−indices200 =
149− (ListBench.randomList indexGen 200 indexSeed)
150−
151−
152−--List of timesteps simulating 30 seconds of animation at 30fps
153−timeSteps30s =
154− List.map (\x -> (1.0 / 30.0) * (toFloat x * Time.second) ) [1 .. 900]
155−
156−ctorData200 =
157− List.map CtorBench.makeRandomData indices200
158−
159−
160−smallCtorData200 =
161− List.map SmallCtorBench.makeRandomData indices200
162−
163−
164−nestedData200 =
165− List.map PatternMatchBench.intToNest indices200
bench/elm-package.json+4−3
@@ -9,7 +9,8 @@
99 "exposed-modules": [],
1010 "native-modules": true,
1111 "dependencies": {
12− "elm-lang/core": "2.1.0 <= v < 3.0.0"
12+ "elm-lang/core": "2.1.0 <= v < 4.0.0",
13+ "evancz/elm-html": "4.0.0 <= v < 5.0.0"
1314 },
14− "elm-version": "0.15.1 <= v < 0.16.0"
15−}
15+ "elm-version": "0.15.0 <= v < 0.17.0"
16+}
bench/src/AnimateBench.elmdeleted−58
@@ -1,58 +0,0 @@
1−module AnimateBench where
2−
3−import Time exposing (Time)
4−
5−
6−{-| Main Spring Type.
7−A spring's behavior is defined by its stiffness and damping parameters.
8−-}
9−type alias Spring a =
10− { stiffness : Float
11− , damping : Float
12− , position : a
13− , velocity : a
14− , destination : a
15− }
16−
17−
18−defaultSpring =
19− Spring 1.0 0.5 0.0 1.0 100.0
20−
21−
22−epsilon = 0.0001
23−
24−
25−{-| Animate a spring given a framerate.
26−
27− animate framerate spring
28−-}
29−animate : Time -> Spring Float -> Spring Float
30−animate fpms spring =
31− let
32− frameRate = fpms / 1000
33−
34− fspring = -spring.stiffness * (spring.position - spring.destination)
35−
36− fdamper = -spring.damping * spring.velocity
37−
38− a = fspring + fdamper
39−
40− newV = spring.velocity + a * frameRate
41− newX = spring.position + newV * frameRate
42− in
43− if
44− abs (newV - spring.velocity) < epsilon && abs (newX - spring.position) < epsilon
45− then
46− { spring | position <- spring.destination
47− , velocity <- 0
48− }
49− else
50− { spring | position <- newX
51− , velocity <- newV
52− }
53−
54−
55−
56−runAnimation : List Float -> Spring Float
57−runAnimation timeSteps =
58− List.foldr animate defaultSpring timeSteps
bench/src/ArrayBench.elmdeleted−94
@@ -1,94 +0,0 @@
1−module ArrayBench where
2−
3−import Array
4−import Random
5−import Debug exposing (crash)
6−
7−
8−
9−randomArray
10− : Random.Generator a
11− -> Int
12− -> Random.Seed
13− -> Array.Array a
14−randomArray gen n initSeed =
15− let
16− f n (seed, accum) =
17− let
18− (nextToAdd, newSeed) = Random.generate gen seed
19− newAccum = Array.push nextToAdd accum
20− in (newSeed, newAccum)
21− in
22− snd <| List.foldl f (initSeed, Array.empty) [1 .. n]
23−
24−meanAndStddev
25− : ((Float -> (Float, Float) -> (Float, Float)) -> (Float, Float) -> Array.Array Float -> (Float, Float))
26− -> Array.Array Float
27− -> (Float, Float)
28−meanAndStddev foldFn ourArray =
29− let
30− --ourArray = randomArray n (Random.initialSeed 23)
31− (theSum, sumSq) = foldFn (\x (sum, sumSq) -> (x + sum, (x^2) + sumSq) ) (0,0) ourArray
32− in
33− (theSum, sqrt(theSum*theSum - sumSq))
34−
35−
36−foldrMeanStddev = meanAndStddev Array.foldr
37−
38−
39−foldlMeanStddev = meanAndStddev Array.foldl
40−
41−
42−customFoldrMeanStddev = meanAndStddev myFoldr
43−
44−
45−customFoldlMeanStddev = meanAndStddev myFoldl
46−
47−
48−updateNRandomIndices
49− : (Float -> Float)
50− -> List Int
51− -> Array.Array Float
52− -> Array.Array Float
53−updateNRandomIndices f indexList startList =
54− List.foldr
55− (\ i oldList -> updateN i f oldList)
56− startList indexList
57−
58−
59−randomLookups : List Int -> Array.Array Float -> List (Maybe Float)
60−randomLookups indices arr =
61− List.map (\i -> Array.get i arr) indices
62−
63−
64−myFoldl : (a -> b -> b) -> b -> Array.Array a -> b
65−myFoldl f init arr =
66− let
67− len = Array.length arr
68− fromJust (Just x) = x
69− helper init i =
70− if (i >= len)
71− then init
72− else
73− helper (f (fromJust <| Array.get i arr) init) (i+1)
74− in helper init 0
75−
76−
77−myFoldr : (a -> b -> b) -> b -> Array.Array a -> b
78−myFoldr f init arr =
79− let
80− len = Array.length arr
81− fromJust (Just x) = x
82− helper init i =
83− if (i <= 0)
84− then init
85− else
86− helper (f (fromJust <| Array.get i arr) init) (i-1)
87− in helper init (len-1)
88−
89−
90−updateN : Int -> (a -> a) -> Array.Array a -> Array.Array a
91−updateN n f arr =
92− case Array.get n arr of
93− Just x -> Array.set n (f x) arr
94− _ -> crash "Array out of bounds"
bench/src/Benchmark.elm+106−197
@@ -1,212 +1,121 @@
11module Benchmark
2− ( Never
3− , Benchmark
4− , Suite (..)
5− , BenchStats
2+ ( Benchmark
3+ , test
4+ , suite
65 , run
7− , runWithProgress
8− , bench
9− , bench1
10− , bench2
11− , bench3
12− , bench4
13− , bench5
14− , bench6
15− , bench7
16− , bench8
17− , bench9
6+ , Statistics
7+ , view
188 )where
19−{-| A wrapper around benchmark.js that allows benchmarking
20−of pure functions to be evaluated.
9+{-| A wrapper around benchmark.js that allows benchmarking of pure functions.
2110
22−# Error and Benchmark types
23−@docs Never, Benchmark, Suite, BenchStats
11+# Creating Benchmarks
12+@docs Benchmark, test, suite
2413
25−# Running benchmarks
26−@docs run, runWithProgress
27−
28−# Creating benchmarks
29−@docs bench, bench1, bench2, bench3, bench4, bench5, bench6, bench7, bench8, bench9
14+# Run benchmarks
15+@docs run, Statistics
3016-}
3117
3218
33−import Task
34−import String
3519import Native.Benchmark
3620import Native.BenchmarkJS
37−import Signal
38−import Time
39−
40−
41−{-|
42−Our error return type: can never be instantiated
43−because running benchmarks should not fail
44−|-}
45−type Never =
46− Never Never
47−
48−
49−{-|
50−Opaque type representing a function to be timed
51−|-}
52−type Benchmark =
53− Benchmark
54−
55−
56−{-|
57−The results of running a benchmark
58−|-}
59−type BenchStats =
60− BenchStats
61− { name : String
62− , hz : Float
63− , marginOfError : Float
64− , moePercent : Float
65−-- , numRunsSampled : Int
66− }
67−
68−
69−{-|
70−A single or collection of benchmarks
71−that can be run, generating output
72−|-}
73−type Suite =
74− SingleBenchmark Benchmark
21+import String
22+import Task
23+import Html exposing (Html, div, ul, li, p, text)
24+import Html.Attributes exposing (style)
25+
26+
27+
28+-- SET UP BENCHMARK SUITE
29+
30+
31+{-| A set of benchmarks. -}
32+type Benchmark
33+ = Test String Thunk
7534 | Suite String (List Benchmark)
7635
7736
78−{-|
79−Run a benchmark, generating a list of results for each benchmark.
80−Results contain a pretty-printed string summary, and a list
81−of detailed data for each benchmark.
82−|-}
83−run
84− : Suite
85− -> Task.Task Never (String, List BenchStats)
86−run = runWithProgress Nothing
87−
88−
89−{-|
90−Run a benchmark, generating a list of results for each benchmark
91−and updating a String signal with progress as the benchmarks run
92−|-}
93−runWithProgress
94− : Maybe (Signal.Mailbox String)
95− -> Suite
96− -> Task.Task Never (String, List BenchStats)
97−runWithProgress maybeMailbox suite =
37+type Thunk = Thunk
38+
39+
40+{-| An individual benchmark with a name. It measures how long it takes to
41+evaluate the given function when it is passed a `()` value.
42+-}
43+test : String -> (() -> result) -> Benchmark
44+test name thunk =
45+ Test name (Native.Benchmark.makeThunk thunk)
46+
47+
48+{-| A collection of benchmarks to run together.
49+-}
50+suite : String -> List Benchmark -> Benchmark
51+suite =
52+ Suite
53+
54+
55+
56+-- RUN THE BENCHMARKS
57+
58+
59+{-| Statistics -}
60+type Statistics
61+ = StatSuite String (List Statistics)
62+ | Result String
63+ { mean : Float
64+ , hz : Float
65+ }
66+
67+
68+{-| Run a benchmark.
69+-}
70+run : Benchmark -> Task.Task x Statistics
71+run =
72+ Native.Benchmark.run
73+
74+
75+
76+-- TO HTML
77+
78+
79+view : Statistics -> Html
80+view statistics =
81+ div [ style [] ]
82+ [ viewHelp statistics
83+ ]
84+
85+
86+viewHelp : Statistics -> Html
87+viewHelp statistics =
88+ case statistics of
89+ Result name {hz} ->
90+ text (name ++ " - " ++ prettyFloat hz ++ " ops/sec")
91+
92+ StatSuite name subStats ->
93+ let
94+ subResults =
95+ List.map viewHelp subStats
96+ in
97+ p []
98+ [ text name
99+ , ul [] (List.map (\html -> li [] [html]) subResults)
100+ ]
101+
102+
103+prettyFloat : Float -> String
104+prettyFloat float =
105+ String.join "," (numberChunker (round float) [])
106+
107+
108+numberChunker : Int -> List String -> List String
109+numberChunker n chunks =
98110 let
99− ourTask =
100− case maybeMailbox of
101− Nothing -> \_ -> Task.sleep 0
102− Just mailbox ->
103− \s ->
104− (Signal.send mailbox.address s
105− `Task.andThen` \_ -> Task.sleep (5*Time.second))
106− -- `Task.andThen` \_ -> Task.keepGoing
111+ next =
112+ n // 1000
113+
114+ chunk =
115+ n % 1000
107116 in
108− Native.Benchmark.runWithProgress ourTask suite
109−
110−{-|
111−Create a benchmark with the given name
112−running an arbitrary thunk
113−|-}
114−bench : String -> (() -> result) -> Benchmark
115−bench = Native.Benchmark.makeBenchmark
116−
117−
118−{-|
119−Functions for creating named benchmarks with 1 to 9 arguments
120−|-}
121−bench1 : String -> (a -> result) -> a -> Benchmark
122−bench1 name f a =
123− Native.Benchmark.makeBenchmark name (\_ -> f a)
124−
125−
126−{-||-}
127−bench2 : String -> (a -> b -> result) -> a -> b -> Benchmark
128−bench2 name f a b =
129− Native.Benchmark.makeBenchmark name (\_ -> f a b)
130−
131−
132−{-||-}
133−bench3 : String -> (a -> b -> c -> result) -> a -> b -> c -> Benchmark
134−bench3 name f a b c =
135− Native.Benchmark.makeBenchmark name (\_ -> f a b c)
136−
137−
138−{-||-}
139−bench4 : String -> (a -> b -> c -> d -> result) -> a -> b -> c -> d -> Benchmark
140−bench4 name f a b c d =
141− Native.Benchmark.makeBenchmark name (\_ -> f a b c d)
142−
143−
144−{-||-}
145−bench5 : String -> (a -> b -> c -> d -> e -> result) -> a -> b -> c -> d -> e -> Benchmark
146−bench5 name f a b c d e =
147− Native.Benchmark.makeBenchmark name (\_ -> f a b c d e)
148−
149−
150−{-||-}
151−bench6 :
152− String
153− -> (a -> b -> c -> d -> e -> f -> result)
154− -> a
155− -> b
156− -> c
157− -> d
158− -> e
159− -> f
160− -> Benchmark
161−bench6 name fn a b c d e f =
162− Native.Benchmark.makeBenchmark name (\_ -> fn a b c d e f)
163−
164−
165−{-||-}
166−bench7 :
167− String
168− -> (a -> b -> c -> d -> e -> f -> g -> result)
169− -> a
170− -> b
171− -> c
172− -> d
173− -> e
174− -> f
175− -> g
176− -> Benchmark
177−bench7 name fn a b c d e f g =
178− Native.Benchmark.makeBenchmark name (\_ -> fn a b c d e f g)
179−
180−
181−{-||-}
182−bench8 :
183− String
184− -> (a -> b -> c -> d -> e -> f -> g -> h -> result)
185− -> a
186− -> b
187− -> c
188− -> d
189− -> e
190− -> f
191− -> g
192− -> h
193− -> Benchmark
194−bench8 name fn a b c d e f g h =
195− Native.Benchmark.makeBenchmark name (\_ -> fn a b c d e f g h)
196−
197−{-||-}
198−bench9 :
199− String
200− -> (a -> b -> c -> d -> e -> f -> g -> h -> i -> result)
201− -> a
202− -> b
203− -> c
204− -> d
205− -> e
206− -> f
207− -> g
208− -> h
209− -> i
210− -> Benchmark
211−bench9 name fn a b c d e f g h i =
212− Native.Benchmark.makeBenchmark name (\_ -> fn a b c d e f g h i)
117+ if next == 0 then
118+ toString chunk :: chunks
119+
120+ else
121+ numberChunker next (String.padLeft 3 '0' (toString chunk) :: chunks)
bench/src/CtorBench.elmdeleted−135
@@ -1,135 +0,0 @@
1−module CtorBench where
2−
3−type ManyCtors =
4− MyLongNamedCtor1 Float Float Float
5− | MyLongNamedCtor2 Float Float
6− | MyLongNamedCtor3 Float Float Float
7− | MyLongNamedCtor4 Float Float
8− | MyLongNamedCtor5 Float Float Float
9− | MyLongNamedCtor6 Float Float
10− | MyLongNamedCtor7 Float Float Float
11− | MyLongNamedCtor8 Float Float
12− | MyLongNamedCtor9 Float Float Float
13− | MyLongNamedCtor10 Float Float
14− | MyLongNamedCtor11 Float Float Float
15− | MyLongNamedCtor12 Float Float
16− | MyLongNamedCtor13 Float Float Float
17− | MyLongNamedCtor14 Float Float
18− | MyLongNamedCtor15 Float Float Float
19− | MyLongNamedCtor16 Float Float
20− | MyLongNamedCtor17 Float Float Float
21− | MyLongNamedCtor18 Float Float
22− | MyLongNamedCtor19 Float Float Float
23− | MyLongNamedCtor20 Float Float
24−
25−
26−getFieldSum someData =
27− case someData of
28− MyLongNamedCtor1 x y z ->
29− x + y + z
30−
31− MyLongNamedCtor3 x y z ->
32− x + y + z
33−
34− MyLongNamedCtor5 x y z ->
35− x + y + z
36−
37− MyLongNamedCtor7 x y z ->
38− x + y + z
39−
40− MyLongNamedCtor9 x y z ->
41− x + y + z
42−
43− MyLongNamedCtor11 x y z ->
44− x + y + z
45−
46− MyLongNamedCtor13 x y z ->
47− x + y + z
48−
49− MyLongNamedCtor15 x y z ->
50− x + y + z
51−
52− MyLongNamedCtor17 x y z ->
53− x + y + z
54−
55− MyLongNamedCtor19 x y z ->
56− x + y + z
57−
58− MyLongNamedCtor20 x y ->
59− x + y
60−
61− MyLongNamedCtor18 x y ->
62− x + y
63−
64− MyLongNamedCtor16 x y ->
65− x + y
66−
67− MyLongNamedCtor14 x y ->
68− x + y
69−
70− MyLongNamedCtor12 x y ->
71− x + y
72−
73− MyLongNamedCtor10 x y ->
74− x + y
75−
76− MyLongNamedCtor8 x y ->
77− x + y
78−
79− MyLongNamedCtor6 x y ->
80− x + y
81−
82− MyLongNamedCtor4 x y ->
83− x + y
84−
85− MyLongNamedCtor2 x y ->
86− x + y
87−
88−
89−makeRandomData i =
90− case (i % 20) of
91− 0 ->
92− MyLongNamedCtor20 (toFloat i) (toFloat <| i*i)
93− 1 ->
94− MyLongNamedCtor1 (toFloat i) (toFloat <| i*i) (toFloat <| i*i*i)
95− 2 ->
96− MyLongNamedCtor2 (toFloat i) (toFloat <| i*i)
97− 3 ->
98− MyLongNamedCtor3 (toFloat i) (toFloat <| i*i) (toFloat <| i*i*i)
99− 4 ->
100− MyLongNamedCtor4 (toFloat i) (toFloat <| i*i)
101− 5 ->
102− MyLongNamedCtor5 (toFloat i) (toFloat <| i*i) (toFloat <| i*i*i)
103− 6 ->
104− MyLongNamedCtor6 (toFloat i) (toFloat <| i*i)
105− 7 ->
106− MyLongNamedCtor7 (toFloat i) (toFloat <| i*i) (toFloat <| i*i*i)
107− 8 ->
108− MyLongNamedCtor8 (toFloat i) (toFloat <| i*i)
109− 9 ->
110− MyLongNamedCtor9 (toFloat i) (toFloat <| i*i) (toFloat <| i*i*i)
111− 10 ->
112− MyLongNamedCtor10 (toFloat i) (toFloat <| i*i)
113− 11 ->
114− MyLongNamedCtor11 (toFloat i) (toFloat <| i*i) (toFloat <| i*i*i)
115− 12 ->
116− MyLongNamedCtor12 (toFloat i) (toFloat <| i*i)
117− 13 ->
118− MyLongNamedCtor13 (toFloat i) (toFloat <| i*i) (toFloat <| i*i*i)
119− 14 ->
120− MyLongNamedCtor14 (toFloat i) (toFloat <| i*i)
121− 15 ->
122− MyLongNamedCtor15 (toFloat i) (toFloat <| i*i) (toFloat <| i*i*i)
123− 16 ->
124− MyLongNamedCtor16 (toFloat i) (toFloat <| i*i)
125− 17 ->
126− MyLongNamedCtor17 (toFloat i) (toFloat <| i*i) (toFloat <| i*i*i)
127− 18 ->
128− MyLongNamedCtor18 (toFloat i) (toFloat <| i*i)
129− 19 ->
130− MyLongNamedCtor19 (toFloat i) (toFloat <| i*i) (toFloat <| i*i*i)
131−
132−
133−sumFieldsList : List ManyCtors -> Float
134−sumFieldsList dataList =
135− List.foldr (\val sumSoFar -> (getFieldSum val) + sumSoFar ) 0.0 dataList
bench/src/DictBench.elmdeleted−63
@@ -1,63 +0,0 @@
1−module DictBench where
2−
3−import Dict
4−import Random
5−import Debug exposing (crash)
6−
7−
8−
9−randomDict
10− : Random.Generator a
11− -> Int
12− -> Random.Seed
13− -> Dict.Dict Int a
14−randomDict gen n initSeed =
15− let
16− f n (seed, accum) =
17− let
18− (nextToAdd, newSeed) = Random.generate gen seed
19− newAccum = Dict.insert n nextToAdd accum
20− in (newSeed, newAccum)
21− in
22− snd <| List.foldl f (initSeed, Dict.empty) [1 .. n]
23−
24−meanAndStddev
25− : ((Int -> Float -> (Float, Float) -> (Float, Float)) -> (Float, Float) -> Dict.Dict Int Float -> (Float, Float))
26− -> Dict.Dict Int Float
27− -> (Float, Float)
28−meanAndStddev foldFn ourDict =
29− let
30− --ourDict = randomDict n (Random.initialSeed 23)
31− (theSum, sumSq) = foldFn (\_ x (sum, sumSq) -> (x + sum, (x^2) + sumSq) ) (0,0) ourDict
32− in
33− (theSum, sqrt(theSum*theSum - sumSq))
34−
35−
36−foldrMeanStddev = meanAndStddev Dict.foldr
37−
38−
39−foldlMeanStddev = meanAndStddev Dict.foldl
40−
41−
42−updateNRandomIndices
43− : (Float -> Float)
44− -> List Int
45− -> Dict.Dict Int Float
46− -> Dict.Dict Int Float
47−updateNRandomIndices f indexList startList =
48− List.foldr
49− (\ i oldList -> updateN i f oldList)
50− startList indexList
51−
52−
53−randomLookups : List Int -> Dict.Dict Int Float -> List (Maybe Float)
54−randomLookups indices arr =
55− List.map (\i -> Dict.get i arr) indices
56−
57−
58−
59−updateN : Int -> (a -> a) -> Dict.Dict Int a -> Dict.Dict Int a
60−updateN n f arr =
61− case Dict.get n arr of
62− Just x -> Dict.insert n (f x) arr
63− _ -> crash "Dict out of bounds"
bench/src/IfBench.elmdeleted−104
@@ -1,104 +0,0 @@
1−module IfBench where
2−
3−
4−tailRecursiveIfFn : Int -> Float
5−tailRecursiveIfFn i =
6− if i < 0 then
7− 10.0
8−
9− else if i == 0 then
10− 20.0
11−
12− else if i > 0 && i < 10 then
13− 30.0
14−
15− else
16− tailRecursiveIfFn (i - (1 + (i % 5)))
17−
18−
19−manyConditionFunction i =
20− if i <= 0 then
21− 30.0 + (toFloat i)
22−
23− else if i > 100 && (i * i) % 20 == 7 then
24− 24.3 + (toFloat i)
25−
26− else if i > 100 && (i % 3 == 1) then
27− 3.33 + (toFloat i)
28−
29− else if i == 152 then
30− 29.0 + (toFloat i)
31−
32− else if i + (i*i) > 200 && (i + (i*i) < 300) then
33− 32.9 + (toFloat i)
34−
35− else if i == 99 then
36− 93.0 + (toFloat i)
37−
38− else if i*i % 17 == 13 then
39− 9.0 + (toFloat i)
40−
41− else if i == 101 then
42− 39.0 + (toFloat i)
43−
44− else if i == 102 then
45− 38.0 + (toFloat i)
46−
47− else if i == 103 then
48− 49.0 + (toFloat i)
49−
50− else if i == 104 then
51− 59.0 + (toFloat i)
52−
53− else if i == 105 then
54− 69.0 + (toFloat i)
55−
56− else if i == 106 then
57− 39.0 + (toFloat i)
58−
59− else if i == 107 then
60− 38.0 + (toFloat i)
61−
62− else if i == 108 then
63− 49.0 + (toFloat i)
64−
65− else if i == 109 then
66− 59.0 + (toFloat i)
67−
68− else if i == 110 then
69− 69.0 + (toFloat i)
70−
71− else if i == 111 then
72− 39.0 + (toFloat i)
73−
74− else if i == 115 then
75− 69.0 + (toFloat i)
76−
77− else if otherwise then
78− toFloat i
79−
80−
81−fewConditionFunction i =
82− if i <= 0 then
83− 30.0 + (toFloat i)
84−
85− else if i == 104 then
86− 59.0 + (toFloat i)
87−
88− else if i == 105 then
89− 69.0 + (toFloat i)
90−
91− else
92− toFloat i
93−
94−
95−tailRecSum intList =
96− List.foldr (\i sumSoFar -> sumSoFar + tailRecursiveIfFn i ) 0.0 intList
97−
98−
99−manyConditionalSum intList =
100− List.foldr (\i sumSoFar -> sumSoFar + manyConditionFunction i ) 0.0 intList
101−
102−
103−fewConditionalSum intList =
104− List.foldr (\i sumSoFar -> sumSoFar + fewConditionFunction i ) 0.0 intList
bench/src/LargeDictionary.elmdeleted−34
@@ -1,34 +0,0 @@
1−module LargeDictionary where
2−
3−
4−import Dict
5−import Random
6−import Signal
7−import Time
8−import Graphics.Element
9−
10−
11−maxSize = 10000000
12−
13−
14−randomGen =
15− Random.int (-1 * maxSize) (maxSize)
16−
17−
18−addNToDictWithSeed
19− : Int
20− -> Random.Seed
21− -> Dict.Dict Int Int
22− -> Dict.Dict Int Int
23−addNToDictWithSeed n seed accum =
24− case n of
25− 0 -> accum
26− _ ->
27− let
28− (nextToAdd, newSeed) = Random.generate randomGen seed
29− newAccum = Dict.insert nextToAdd nextToAdd accum
30− in addNToDictWithSeed (n-1) newSeed newAccum
31−
32−
33−addNToDictAndSum numToInsert =
34− addNToDictWithSeed numToInsert (Random.initialSeed 23) Dict.empty
bench/src/ListBench.elmdeleted−85
@@ -1,85 +0,0 @@
1−module ListBench where
2−
3−import Random
4−
5−
6−
7−randomList
8− : Random.Generator a
9− -> Int
10− -> Random.Seed
11− -> List a
12−randomList gen n initSeed =
13− let
14− f n (seed, accum) =
15− let
16− (nextToAdd, newSeed) = Random.generate gen seed
17− newAccum = nextToAdd :: accum
18− in (newSeed, newAccum)
19− in
20− snd <| List.foldl f (initSeed, []) [1 .. n]
21−
22−meanAndStddev
23− : ((Float -> (Float, Float) -> (Float, Float)) -> (Float, Float) -> List Float -> (Float, Float))
24− -> List Float
25− -> (Float, Float)
26−meanAndStddev foldFn ourList =
27− let
28− --ourList = addNToListWithSeed n (Random.initialSeed 23)
29− (theSum, sumSq) = foldFn (\x (sum, sumSq) -> (x + sum, (x^2) + sumSq) ) (0,0) ourList
30− in
31− (theSum, sqrt(theSum*theSum - sumSq))
32−
33−
34−foldrMeanStddev = meanAndStddev List.foldr
35−
36−
37−foldlMeanStddev = meanAndStddev List.foldl
38−
39−
40−customFoldrMeanStddev = meanAndStddev myFoldr
41−
42−
43−customFoldlMeanStddev = meanAndStddev myFoldl
44−
45−
46−updateNRandomIndices
47− : (Float -> Float)
48− -> List Int
49− -> List Float
50− -> List Float
51−updateNRandomIndices f indexList startList =
52− List.foldr
53− (\ i oldList -> updateN i f oldList)
54− startList indexList
55−
56−
57−
58−randomLookups : List Int -> List Float -> List (Maybe Float)
59−randomLookups indices ourList =
60− let
61− getNth i l =
62− case (i, l) of
63− (_, []) -> Nothing
64− (0, x :: _) -> Just x
65− (i, _ :: xs ) -> getNth i xs
66− in List.map (\i -> getNth i ourList) indices
67−
68−
69−myFoldl : (a -> b -> b) -> b -> List a -> b
70−myFoldl f init l =
71− case l of
72− [] -> init
73− (x :: xs) -> myFoldl f (f x init) xs
74−
75−
76−myFoldr : (a -> b -> b) -> b -> List a -> b
77−myFoldr f init l =
78− case l of
79− [] -> init
80− (x :: xs) -> f x (myFoldr f init xs)
81−
82−
83−updateN : Int -> (a -> a) -> List a -> List a
84−updateN n f list =
85− List.indexedMap (\index value -> if index == n then f value else value) list
bench/src/Main.elmnew file+46
@@ -0,0 +1,46 @@
1+module Main where
2+
3+import Html exposing (Html, text)
4+import Signal
5+import Task
6+
7+import Benchmark
8+import Syntax.Case as Case
9+import Syntax.Let as Let
10+import Syntax.Records as Records
11+import Realistic.Check as Check
12+import Realistic.Todo as Todo
13+
14+
15+-- COMPILER BENCHMARK
16+
17+compilerBenchmark : Benchmark.Benchmark
18+compilerBenchmark =
19+ Benchmark.suite "generated code"
20+ [ Benchmark.suite "business logic from the wild"
21+ [ Check.benchmark
22+ , Todo.benchmark
23+ ]
24+ , Benchmark.suite "syntax"
25+ [ Case.benchmark
26+ , Let.benchmark
27+ , Records.benchmark
28+ ]
29+ ]
30+
31+
32+-- DISPLAY THINGS
33+
34+main =
35+ results.signal
36+
37+
38+results : Signal.Mailbox Html
39+results =
40+ Signal.mailbox (text "Working...")
41+
42+
43+port benchResults : Task.Task x ()
44+port benchResults =
45+ Benchmark.run compilerBenchmark
46+ `Task.andThen` (Benchmark.view >> Signal.send results.address)
bench/src/Native/Benchmark.js+62−86
@@ -8,95 +8,71 @@ Elm.Native.Benchmark.make = function(localRuntime) {
88 return localRuntime.Native.Benchmark.values;
99 }
1010
11− var List = Elm.Native.List.make(localRuntime);
11+ var List = Elm.List.make(localRuntime);
1212 var Task = Elm.Native.Task.make(localRuntime);
13− var Signal = Elm.Signal.make(localRuntime);
14− var Utils = Elm.Native.Utils.make(localRuntime);
15−
16− //Nothing special happens here, but we need to use it as a Native function
17− //So that we can accept thunks of any type
18− function makeBenchmark(name, thunk)
19− {
20− return {name : name, thunk : thunk};
21− }
22−
23− //Generate the task for running a benchmark suite
24− //Possibly updating a given mailbox with a string describing
25− //Our progress of running the benchmarks so far
26− function runWithProgress(maybeTaskFn, inSuite)
13+
14+
15+ // RUN SOME BENCHMARKS
16+
17+ function run(benchmark)
18+ {
19+ return Task.asyncFunction(function(callback)
20+ {
21+ var overallSuite = new Benchmark.Suite;
22+ var statistics = addTests(overallSuite, benchmark);
23+ overallSuite.on('complete', function(event) {
24+ callback(Task.succeed(statistics));
25+ });
26+ overallSuite.run({ async: true });
27+ });
28+ }
29+
30+
31+ // ADD TESTS TO THE JS BENCHMARK SUITE
32+
33+ function addTests(overallSuite, benchmark)
2734 {
28−
29− return Task.asyncFunction(function(callback) {
30− var bjsSuite = new Benchmark.Suite;
31− var benchArray;
32− var retData = [];
33− var finalString = "";
34− var numCompleted = 0;
35− var numToRun;
36−
37− switch (inSuite.ctor)
38− {
39− case "Suite":
40− benchArray = List.toArray(inSuite._1);
41− break;
42− case "SingleBenchmark":
43− benchArray = [inSuite._0 ];
44− break;
45− }
46−
47− numToRun = benchArray.length;
48− Task.perform(maybeTaskFn("Running benchmark 1 of " + numToRun));
49−
50− //Initialize each benchmark in the suite
51− for (i = 0; i < benchArray.length; i++)
52− {
53− var ourThunk = function (){
54− //Run the thing we're timing, then mark the asynch benchmark as done
55− benchArray[i].thunk();
56− deferred.resolve();
57− }
58− bjsSuite.add(benchArray[i].name, benchArray[i].thunk );
59− }
60−
61− //Every time a benchmark finishes, we store its results
62− //and update our progress string
63− bjsSuite.on('cycle', function(event) {
64− numCompleted += 1;
65− retData.push(
66− { name : event.target.options.name
67− , hz : event.target.hz
68− , marginOfError : event.target.stats.moe
69− , moePercent : event.target.stats.rme
70− }
71− );
72− finalString += String(event.target) + "\n";
73− var intermedString =
74− "Running benchmark "
75− + (numCompleted + 1)
76− + " of " + numToRun
77− + "\nLast result: " + String(event.target);
78− Task.perform(maybeTaskFn(intermedString));
79− //retString += String(event.target) + "\n";
80− });
81−
82− //When the last benchmark finishes, we show all results collected
83− bjsSuite.on('complete', function(event) {
84− Task.perform(maybeTaskFn("Final results:\n\n" + finalString) );
85− return callback(Task.succeed(Utils.Tuple2(finalString, List.fromArray(retData))));
86− });
87−
88− //Finally: actually run the suite
89− Task.perform(
90− Task.asyncFunction(function(otherCallback){
91− bjsSuite.run({ 'async': true });
92− }));
93− });
94− }
35+ if (benchmark.ctor === 'Suite')
36+ {
37+ return {
38+ ctor: 'StatSuite',
39+ _0: benchmark._0,
40+ _1: A2(List.map, curriedAddTests(overallSuite), benchmark._1)
41+ };
42+ }
43+
44+ // WE MUST BE LOOKING AT A TEST
45+ var name = benchmark._0;
46+ var thunk = benchmark._1;
47+
48+ var statistics = {
49+ ctor: 'Result',
50+ _0: name,
51+ _1: null
52+ };
53+
54+ overallSuite.add(name, thunk, {
55+ onStart: function() {
56+ console.log('running: ' + name);
57+ },
58+ onComplete: function(event) {
59+ var jsBenchmark = event.target;
60+ statistics._1 = {
61+ mean: jsBenchmark.stats.mean,
62+ hz: jsBenchmark.hz
63+ };
64+ }
65+ });
66+
67+ return statistics;
68+ }
69+
70+ var curriedAddTests = F2(addTests);
71+
72+
9573
9674 return localRuntime.Native.Benchmark.values = {
97− makeBenchmark: F2(makeBenchmark),
98− runWithProgress: F2(runWithProgress)
75+ makeThunk: function(x) { return x; },
76+ run: run
9977 };
100−
101−
10278};
bench/src/PatternMatchBench.elmdeleted−70
@@ -1,70 +0,0 @@
1−module PatternMatchBench where
2−
3−type NestedStructure =
4− Nest Float (NestedStructure)
5− | End Float
6−
7−
8−intToNest : Int -> NestedStructure
9−intToNest i =
10− let
11− helper i accum =
12− case (i % 20) of
13− 0 ->
14− accum
15−
16− _ ->
17− helper (i-1) <| Nest (toFloat <| i * i) accum
18− in
19− helper i (End <| toFloat i)
20−
21−deepMatchingFunction : NestedStructure -> Float
22−deepMatchingFunction struct =
23− case struct of
24− (Nest x1 (Nest x2 (Nest x3 (Nest x4 (Nest x5 (Nest x6 (Nest x7 (Nest x8 (Nest x9 (Nest x10 (Nest x11 (Nest x12 (Nest x13 (Nest x14 (Nest x15 (Nest x16 (Nest x17 (End x18 ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ->
25− x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 + x10 + x11 + x12 + x13 + x14 + x15 + x16 + x17 + x18
26−
27− Nest x _ ->
28− x
29−
30− End x ->
31− x
32−
33−
34−wildcardMatchingFunction : NestedStructure -> Float
35−wildcardMatchingFunction struct =
36− case struct of
37− (Nest x (Nest _ (Nest _ (Nest _ (Nest _ (Nest _ (Nest _ (Nest _ (Nest _ (Nest _ (Nest _ (Nest _ (Nest _ (Nest _ (Nest _ (Nest _ (Nest _ (End y ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ->
38− x + y + x + y + x + y + x + y + x + y + x + y + x + y + x + y + x + y
39−
40− Nest x _ ->
41− x
42−
43− End x ->
44− x
45−
46−
47−shallowMatchingFunction : NestedStructure -> Float
48−shallowMatchingFunction struct =
49− case struct of
50− (Nest x1 (Nest x2 (Nest x3 (End x4) ) ) ) ->
51− x1 + x2 + x3 + x4 + x1 + x2 + x3 + x4 + x1 + x2 + x3 + x4 + x1 + x2 + x3 + x4 + x1 + x2
52−
53− Nest x _ ->
54− x
55−
56− End x ->
57− x
58−
59−sumStructures : (NestedStructure -> Float) -> List NestedStructure -> Float
60−sumStructures f inList =
61− List.foldr (\x sumSoFar -> sumSoFar + f x) 0.0 inList
62−
63−
64−deepMatchSum = sumStructures deepMatchingFunction
65−
66−
67−shallowMatchSum = sumStructures shallowMatchingFunction
68−
69−
70−wildcardMatchSum = sumStructures wildcardMatchingFunction
bench/src/Realistic/Check.elmnew file+65
@@ -0,0 +1,65 @@
1+module Realistic.Check (benchmark) where
2+{-| Source: http://elm-lang.org/examples/checkboxes
3+-}
4+
5+import Benchmark
6+import String
7+
8+
9+benchmark : Benchmark.Benchmark
10+benchmark =
11+ Benchmark.suite "check box business logic"
12+ [ run "toggle boxes" toggleActions
13+ ]
14+
15+
16+run : String -> List Action -> Benchmark.Benchmark
17+run description actions =
18+ Benchmark.test
19+ (description ++ " - " ++ toString (List.length actions) ++ " actions")
20+ (\_ -> List.foldl update initialModel actions)
21+
22+
23+toggleActions =
24+ [ Red True
25+ , Underline True
26+ , Bold True
27+ , Bold False
28+ , Red False
29+ , Bold True
30+ , Bold False
31+ ]
32+
33+
34+-- MODEL
35+
36+type alias Model =
37+ { red : Bool
38+ , underline : Bool
39+ , bold : Bool
40+ }
41+
42+
43+initialModel =
44+ Model False False True
45+
46+
47+-- UPDATE
48+
49+type Action
50+ = Red Bool
51+ | Underline Bool
52+ | Bold Bool
53+
54+
55+update action model =
56+ case action of
57+ Red bool ->
58+ { model | red = bool }
59+
60+ Underline bool ->
61+ { model | underline = bool }
62+
63+ Bold bool ->
64+ { model | bold = bool }
65+
bench/src/Realistic/Todo.elmnew file+169
@@ -0,0 +1,169 @@
1+module Realistic.Todo (benchmark) where
2+{-| Source: https://github.com/evancz/elm-todomvc
3+-}
4+
5+import Benchmark
6+import String
7+
8+
9+benchmark : Benchmark.Benchmark
10+benchmark =
11+ Benchmark.suite "todomvc business logic"
12+ [ run "type in 5 todos, each 15 characters long" typingActions
13+ , run "do everything" batchActions
14+ ]
15+
16+
17+run : String -> List Action -> Benchmark.Benchmark
18+run description actions =
19+ Benchmark.test
20+ (description ++ " - " ++ toString (List.length actions) ++ " actions")
21+ (\_ -> List.foldl update emptyModel actions)
22+
23+
24+typingActions =
25+ let
26+ enter i =
27+ List.map (\n -> UpdateField (String.repeat n "X")) [1..15]
28+ ++ [ Add ]
29+ in
30+ List.concatMap enter [1..5]
31+
32+
33+batchActions =
34+ let
35+ addTask i =
36+ [ UpdateField ("My task " ++ toString i)
37+ , Add
38+ ]
39+
40+ editTask i =
41+ [ EditingTask i True
42+ , UpdateTask i "New Task text"
43+ , EditingTask i False
44+ ]
45+
46+ check i =
47+ Check i True
48+
49+ uncheck i =
50+ Check i False
51+
52+ isEven i =
53+ i % 2 == 0
54+ in
55+ List.concat
56+ [ List.concatMap addTask [1..50]
57+ , [CheckAll True, CheckAll False]
58+ , List.concatMap editTask (List.filter isEven [1 .. 50])
59+ , List.map check [5, 7, 9, 13, 17, 23, 37]
60+ , List.map uncheck [7, 13, 23, 37]
61+ , [DeleteComplete, Delete 7, Delete 23]
62+ , List.concatMap addTask [51..80]
63+ , List.map check (List.filter isEven [51..80])
64+ , [DeleteComplete, CheckAll True, DeleteComplete]
65+ ]
66+
67+
68+
69+-- MODEL
70+
71+
72+type alias Model =
73+ { tasks : List Task
74+ , field : String
75+ , uid : Int
76+ , visibility : String
77+ }
78+
79+
80+type alias Task =
81+ { description : String
82+ , completed : Bool
83+ , editing : Bool
84+ , id : Int
85+ }
86+
87+
88+newTask : String -> Int -> Task
89+newTask desc id =
90+ { description = desc
91+ , completed = False
92+ , editing = False
93+ , id = id
94+ }
95+
96+
97+emptyModel : Model
98+emptyModel =
99+ { tasks = []
100+ , visibility = "All"
101+ , field = ""
102+ , uid = 0
103+ }
104+
105+
106+
107+-- UPDATE
108+
109+
110+type Action
111+ = NoOp
112+ | UpdateField String
113+ | EditingTask Int Bool
114+ | UpdateTask Int String
115+ | Add
116+ | Delete Int
117+ | DeleteComplete
118+ | Check Int Bool
119+ | CheckAll Bool
120+ | ChangeVisibility String
121+
122+
123+update : Action -> Model -> Model
124+update action model =
125+ case action of
126+ NoOp -> model
127+
128+ Add ->
129+ { model |
130+ uid = model.uid + 1,
131+ field = "",
132+ tasks =
133+ if String.isEmpty model.field
134+ then model.tasks
135+ else model.tasks ++ [newTask model.field model.uid]
136+ }
137+
138+ UpdateField str ->
139+ { model | field = str }
140+
141+ EditingTask id isEditing ->
142+ let updateTask t = if t.id == id then { t | editing = isEditing } else t
143+ in
144+ { model | tasks = List.map updateTask model.tasks }
145+
146+ UpdateTask id task ->
147+ let updateTask t = if t.id == id then { t | description = task } else t
148+ in
149+ { model | tasks = List.map updateTask model.tasks }
150+
151+ Delete id ->
152+ { model | tasks = List.filter (\t -> t.id /= id) model.tasks }
153+
154+ DeleteComplete ->
155+ { model | tasks = List.filter (not << .completed) model.tasks }
156+
157+ Check id isCompleted ->
158+ let updateTask t = if t.id == id then { t | completed = isCompleted } else t
159+ in
160+ { model | tasks = List.map updateTask model.tasks }
161+
162+ CheckAll isCompleted ->
163+ let updateTask t = { t | completed = isCompleted }
164+ in
165+ { model | tasks = List.map updateTask model.tasks }
166+
167+ ChangeVisibility visibility ->
168+ { model | visibility = visibility }
169+
bench/src/RecordBench.elmdeleted−76
@@ -1,76 +0,0 @@
1−module RecordBench where
2−
3−type alias BigRecord =
4− { myLargeNamedField1 : Float
5− , myLargeNamedField2 : Float
6− , myLargeNamedField3 : Float
7− , myLargeNamedField4 : Float
8− , myLargeNamedField5 : Float
9− , myLargeNamedField6 : Float
10− , myLargeNamedField7 : Float
11− , myLargeNamedField8 : Float
12− , myLargeNamedField9 : Float
13− , myLargeNamedField10 : Float
14− , myLargeNamedField11 : Float
15− , myLargeNamedField12 : Float
16− , myLargeNamedField13 : Float
17− , myLargeNamedField14 : Float
18− , myLargeNamedField15 : Float
19− , myLargeNamedField16 : Float
20− , myLargeNamedField17 : Float
21− , myLargeNamedField18 : Float
22− , myLargeNamedField19 : Float
23− , myLargeNamedField20 : Float
24− }
25−
26−defaultRec =
27− BigRecord 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 10.0
28− 11.0 12.0 13.0 14.0 15.0 16.0 17.0 18.0 19.0 20.0
29−
30−getField i =
31− case (i % 20) of
32− 0 ->
33− defaultRec.myLargeNamedField20
34− 1 ->
35− defaultRec.myLargeNamedField1
36− 2 ->
37− defaultRec.myLargeNamedField2
38− 3 ->
39− defaultRec.myLargeNamedField3
40− 4 ->
41− defaultRec.myLargeNamedField4
42− 5 ->
43− defaultRec.myLargeNamedField5
44− 6 ->
45− defaultRec.myLargeNamedField6
46− 7 ->
47− defaultRec.myLargeNamedField7
48− 8 ->
49− defaultRec.myLargeNamedField8
50− 9 ->
51− defaultRec.myLargeNamedField9
52− 10 ->
53− defaultRec.myLargeNamedField10
54− 11 ->
55− defaultRec.myLargeNamedField11
56− 12 ->
57− defaultRec.myLargeNamedField12
58− 13 ->
59− defaultRec.myLargeNamedField13
60− 14 ->
61− defaultRec.myLargeNamedField14
62− 15 ->
63− defaultRec.myLargeNamedField15
64− 16 ->
65− defaultRec.myLargeNamedField16
66− 17 ->
67− defaultRec.myLargeNamedField17
68− 18 ->
69− defaultRec.myLargeNamedField18
70− 19 ->
71− defaultRec.myLargeNamedField19
72−
73−
74−sumRandomElems : List Int -> Float
75−sumRandomElems randomInts =
76− List.foldr (\i sumSoFar -> (getField i) + sumSoFar ) 0.0 randomInts
bench/src/SmallCtorBench.elmdeleted−76
@@ -1,76 +0,0 @@
1−module SmallCtorBench where
2−
3−type ManyCtors =
4− MyLongNamedCtor1 Float Float Float
5− | MyLongNamedCtor2 Float Float
6− | MyLongNamedCtor3 Float Float Float
7− | MyLongNamedCtor4 Float Float
8− | MyLongNamedCtor5 Float Float Float
9− | MyLongNamedCtor6 Float Float
10− | MyLongNamedCtor7 Float Float Float
11− | MyLongNamedCtor8 Float Float
12− | MyLongNamedCtor9 Float Float Float
13− | MyLongNamedCtor10 Float Float
14−
15−
16−getFieldSum someData =
17− case someData of
18− MyLongNamedCtor1 x y z ->
19− x + y + z
20−
21− MyLongNamedCtor3 x y z ->
22− x + y + z
23−
24− MyLongNamedCtor5 x y z ->
25− x + y + z
26−
27− MyLongNamedCtor7 x y z ->
28− x + y + z
29−
30− MyLongNamedCtor9 x y z ->
31− x + y + z
32−
33− MyLongNamedCtor10 x y ->
34− x + y
35−
36− MyLongNamedCtor8 x y ->
37− x + y
38−
39− MyLongNamedCtor6 x y ->
40− x + y
41−
42− MyLongNamedCtor4 x y ->
43− x + y
44−
45− MyLongNamedCtor2 x y ->
46− x + y
47−
48−
49−makeRandomData i =
50− case (i % 10) of
51− 0 ->
52− MyLongNamedCtor10 (toFloat i) (toFloat <| i*i)
53− 1 ->
54− MyLongNamedCtor1 (toFloat i) (toFloat <| i*i) (toFloat <| i*i*i)
55− 2 ->
56− MyLongNamedCtor2 (toFloat i) (toFloat <| i*i)
57− 3 ->
58− MyLongNamedCtor3 (toFloat i) (toFloat <| i*i) (toFloat <| i*i*i)
59− 4 ->
60− MyLongNamedCtor4 (toFloat i) (toFloat <| i*i)
61− 5 ->
62− MyLongNamedCtor5 (toFloat i) (toFloat <| i*i) (toFloat <| i*i*i)
63− 6 ->
64− MyLongNamedCtor6 (toFloat i) (toFloat <| i*i)
65− 7 ->
66− MyLongNamedCtor7 (toFloat i) (toFloat <| i*i) (toFloat <| i*i*i)
67− 8 ->
68− MyLongNamedCtor8 (toFloat i) (toFloat <| i*i)
69− 9 ->
70− MyLongNamedCtor9 (toFloat i) (toFloat <| i*i) (toFloat <| i*i*i)
71−
72−
73−
74−sumFieldsList : List ManyCtors -> Float
75−sumFieldsList dataList =
76− List.foldr (\val sumSoFar -> (getFieldSum val) + sumSoFar ) 0.0 dataList
bench/src/SmallRecordBench.elmdeleted−42
@@ -1,42 +0,0 @@
1−module SmallRecordBench where
2−
3−type alias SmallRecord =
4− { myLargeNamedField1 : Float
5− , myLargeNamedField2 : Float
6− , myLargeNamedField3 : Float
7− , myLargeNamedField4 : Float
8− , myLargeNamedField5 : Float
9− , myLargeNamedField6 : Float
10− , myLargeNamedField7 : Float
11− , myLargeNamedField8 : Float
12− , myLargeNamedField9 : Float
13− }
14−
15−defaultRec =
16− SmallRecord 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0
17−
18−getField i =
19− case (i % 9) of
20− 1 ->
21− defaultRec.myLargeNamedField1
22− 2 ->
23− defaultRec.myLargeNamedField2
24− 3 ->
25− defaultRec.myLargeNamedField3
26− 4 ->
27− defaultRec.myLargeNamedField4
28− 5 ->
29− defaultRec.myLargeNamedField5
30− 6 ->
31− defaultRec.myLargeNamedField6
32− 7 ->
33− defaultRec.myLargeNamedField7
34− 8 ->
35− defaultRec.myLargeNamedField8
36− 0 ->
37− defaultRec.myLargeNamedField9
38−
39−
40−sumRandomElems : List Int -> Float
41−sumRandomElems randomInts =
42− List.foldr (\i sumSoFar -> (getField i) + sumSoFar ) 0.0 randomInts
bench/src/SmallTupleBench.elmdeleted−30
@@ -1,30 +0,0 @@
1−module SmallTupleBench where
2−
3−type alias SmallTuple =
4− ( Float
5− , Float
6− , Float
7− , Float
8− , Float
9− , Float
10− , Float
11− , Float
12− , Float
13− )
14−
15−defaultTuple =
16− (1.0, 2.0, 3.0)
17−
18−getField (x1, x2, x3) i =
19− case (i % 3) of
20− 1 ->
21− x1
22− 2 ->
23− x2
24− 0 ->
25− x3
26−
27−
28−sumRandomElems : List Int -> Float
29−sumRandomElems randomInts =
30− List.foldr (\i sumSoFar -> (getField defaultTuple i) + sumSoFar ) 0.0 randomInts
bench/src/Syntax/Case.elmnew file+80
@@ -0,0 +1,80 @@
1+module Syntax.Case (benchmark) where
2+
3+import Benchmark exposing (Benchmark, test, suite)
4+import String
5+
6+
7+benchmark : Benchmark.Benchmark
8+benchmark =
9+ suite "case expressions"
10+ [ suite "simple explicit patterns"
11+ [ test "Maybe.withDefault 0 (Just 42)" (withDefault 0 (Just 42))
12+ , test "Maybe.withDefault 0 Nothing" (withDefault 0 Nothing)
13+ , test "isBlack Diamond" (isBlack Diamond)
14+ , test "evaluate basicBoolean" (\_ -> evaluate basicBoolean)
15+ , test "evaluate fancyBoolean" (\_ -> evaluate fancyBoolean)
16+ ]
17+ ]
18+
19+
20+-- 1 Level Deep Patterns
21+
22+withDefault default maybe _ =
23+ case maybe of
24+ Just x ->
25+ x
26+
27+ Nothing ->
28+ default
29+
30+
31+type Suit = Diamond | Heart | Spade | Club
32+
33+
34+isBlack suit _ =
35+ case suit of
36+ Diamond ->
37+ False
38+
39+ Heart ->
40+ False
41+
42+ Spade ->
43+ True
44+
45+ Club ->
46+ True
47+
48+
49+type Boolean
50+ = Tru
51+ | Fls
52+ | And Boolean Boolean
53+ | Or Boolean Boolean
54+ | Not Boolean
55+
56+
57+basicBoolean =
58+ And (Not Fls) Tru
59+
60+
61+fancyBoolean =
62+ Or (Not Tru) (Or Fls (And Tru Tru))
63+
64+
65+evaluate boolean =
66+ case boolean of
67+ Tru ->
68+ True
69+
70+ Fls ->
71+ False
72+
73+ And a b ->
74+ evaluate a && evaluate b
75+
76+ Or a b ->
77+ evaluate a || evaluate b
78+
79+ Not bool ->
80+ not (evaluate bool)
bench/src/Syntax/Let.elmnew file+37
@@ -0,0 +1,37 @@
1+module Syntax.Let (benchmark) where
2+
3+import Benchmark exposing (Benchmark, test, suite)
4+import String
5+
6+
7+benchmark : Benchmark.Benchmark
8+benchmark =
9+ suite "let expressions"
10+ [ test "bind numbers, add them" simpleBindings
11+ , test "tuple destructuring" tupleDestructuring
12+ , test "record destructuring" recordDestructuring
13+ ]
14+
15+
16+simpleBindings _ =
17+ let
18+ x = 3
19+ y = 4
20+ in
21+ x + y
22+
23+
24+tupleDestructuring _ =
25+ let
26+ (x,y) = (3,4)
27+ (a,b) = (1,1)
28+ in
29+ x + y + a + b
30+
31+
32+recordDestructuring _ =
33+ let
34+ {x,y} = { x = 3, y = 4 }
35+ {a,b} = { a = 1, b = 1 }
36+ in
37+ x + y + a + b
bench/src/Syntax/Records.elmnew file+109
@@ -0,0 +1,109 @@
1+module Syntax.Records (benchmark) where
2+
3+import Benchmark exposing (Benchmark, test, suite)
4+import String
5+
6+
7+benchmark : Benchmark.Benchmark
8+benchmark =
9+ suite "records"
10+ [ suite "update"
11+ [ test "1 of 2 fields" (update1of2 record2)
12+ , test "2 of 2 fields" (update2of2 record2)
13+ , test "2 of 2 new" (new2of2 record2)
14+ , test "3 of 5 fields" (update3of5 record5)
15+ , test "5 of 5 fields" (update5of5 record5)
16+ , test "5 of 5 new" (new5of5 record5)
17+ ]
18+ , suite "access"
19+ [ test "2 of 2" (access2of2 record2)
20+ , test "4 of 10" (access4of10 record10)
21+ ]
22+ ]
23+
24+
25+-- RECORDS WITH 2 FIELDS
26+
27+record2 =
28+ { x = 3
29+ , y = 4
30+ }
31+
32+
33+update1of2 r _ =
34+ { r | x = r.x + 42 }
35+
36+
37+update2of2 r _ =
38+ { r
39+ | x = r.x + 1
40+ , y = r.y + 1
41+ }
42+
43+
44+new2of2 r _ =
45+ { x = r.x + 1
46+ , y = r.y + 1
47+ }
48+
49+
50+access2of2 r _ =
51+ r.x + r.y
52+
53+
54+-- RECORDS WITH 5 FIELDS
55+
56+record5 =
57+ { product = "iPhone 6s"
58+ , storage = 16
59+ , weight = 143
60+ , ppi = 326
61+ , chip = "A9"
62+ }
63+
64+
65+update3of5 r _ =
66+ { r
67+ | product = "iPhone 6s Plus"
68+ , weight = 192
69+ , ppi = 401
70+ }
71+
72+
73+update5of5 r _ =
74+ { r
75+ | product = "iPhone 6"
76+ , storage = r.storage
77+ , weight = 129
78+ , ppi = r.ppi
79+ , chip = "A8"
80+ }
81+
82+
83+new5of5 r _ =
84+ { product = "iPhone 6"
85+ , storage = r.storage
86+ , weight = 129
87+ , ppi = r.ppi
88+ , chip = "A8"
89+ }
90+
91+
92+-- RECORDS WITH 10 FIELDS
93+
94+record10 =
95+ { a = 1
96+ , b = 2
97+ , c = 3
98+ , d = 4
99+ , e = True
100+ , f = 'a'
101+ , g = "abc"
102+ , h = record2
103+ , i = record5
104+ , j = [1,2,3]
105+ }
106+
107+
108+access4of10 r _ =
109+ r.a + r.b + r.c + r.d
bench/src/TodoBench.elmdeleted−132
@@ -1,132 +0,0 @@
1−module TodoBench where
2−
3−import String
4−
5−---- MODEL ----
6−
7−-- The full application state of our todo app.
8−type alias Model =
9− { tasks : List Task
10− , field : String
11− , uid : Int
12− , visibility : String
13− }
14−
15−
16−type alias Task =
17− { description : String
18− , completed : Bool
19− , editing : Bool
20− , id : Int
21− }
22−
23−
24−newTask : String -> Int -> Task
25−newTask desc id =
26− { description = desc
27− , completed = False
28− , editing = False
29− , id = id
30− }
31−
32−
33−emptyModel : Model
34−emptyModel =
35− { tasks = []
36− , visibility = "All"
37− , field = ""
38− , uid = 0
39− }
40−
41−
42−---- UPDATE ----
43−
44−-- A description of the kinds of actions that can be performed on the model of
45−-- our application. See the following post for more info on this pattern and
46−-- some alternatives: http://elm-lang.org/learn/Architecture.elm
47−type Action
48− = NoOp
49− | UpdateField String
50− | EditingTask Int Bool
51− | UpdateTask Int String
52− | Add
53− | Delete Int
54− | DeleteComplete
55− | Check Int Bool
56− | CheckAll Bool
57− | ChangeVisibility String
58−
59−
60−-- How we update our Model on a given Action?
61−update : Action -> Model -> Model
62−update action model =
63− case action of
64− NoOp -> model
65−
66− Add ->
67− { model |
68− uid <- model.uid + 1,
69− field <- "",
70− tasks <-
71− if String.isEmpty model.field
72− then model.tasks
73− else model.tasks ++ [newTask model.field model.uid]
74− }
75−
76− UpdateField str ->
77− { model | field <- str }
78−
79− EditingTask id isEditing ->
80− let updateTask t = if t.id == id then { t | editing <- isEditing } else t
81− in
82− { model | tasks <- List.map updateTask model.tasks }
83−
84− UpdateTask id task ->
85− let updateTask t = if t.id == id then { t | description <- task } else t
86− in
87− { model | tasks <- List.map updateTask model.tasks }
88−
89− Delete id ->
90− { model | tasks <- List.filter (\t -> t.id /= id) model.tasks }
91−
92− DeleteComplete ->
93− { model | tasks <- List.filter (not << .completed) model.tasks }
94−
95− Check id isCompleted ->
96− let updateTask t = if t.id == id then { t | completed <- isCompleted } else t
97− in
98− { model | tasks <- List.map updateTask model.tasks }
99−
100− CheckAll isCompleted ->
101− let updateTask t = { t | completed <- isCompleted }
102− in
103− { model | tasks <- List.map updateTask model.tasks }
104−
105− ChangeVisibility visibility ->
106− { model | visibility <- visibility }
107−
108−testActions =
109− List.concat
110− [ List.concatMap --Add 50 tasks
111− (\i -> [UpdateField <| "My task " ++ toString i, Add]) [1 .. 50]
112− , [CheckAll True] --Check them all
113− , [CheckAll False] --Uncheck them all
114− , List.concatMap --Alter the text of even numbered tasks
115− (\i -> [EditingTask i True, UpdateTask i "New Task text", Add] ) <| List.filter (\x -> x % 2 == 0 ) [1 .. 50]
116− --Check and uncheck some more tasks
117− , [Check 5 True, Check 7 True, Check 9 True, Check 13 True, Check 17 True, Check 23 True, Check 37 True]
118− , [Check 7 False, Check 13 False, Check 23 False, Check 37 False]
119− , [DeleteComplete] --Delete our checked tasks
120− , [Delete 7, Delete 23] --Delete a few more tasks
121− , List.concatMap --Add a few more tasks
122− (\i -> [UpdateField <| "Second batch task " ++ toString i, Add]) [51 .. 80]
123− , List.map --Check off and delete every other task
124− (\i -> Check i True ) <| List.filter (\x -> x % 2 == 0 ) [1 .. 80]
125− , [DeleteComplete]
126− , [CheckAll True, DeleteComplete] --Check and delete the remaining tasks
127− ]
128−
129−
130−evalActions : List Action -> Model
131−evalActions actions =
132− List.foldr update emptyModel actions
bench/src/TupleBench.elmdeleted−42
@@ -1,42 +0,0 @@
1−module TupleBench where
2−
3−type alias BigTuple =
4− ( Float
5− , Float
6− , Float
7− , Float
8− , Float
9− , Float
10− , Float
11− , Float
12− , Float
13− )
14−
15−defaultTuple =
16− (1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0)
17−
18−getField (x1, x2, x3, x4, x5, x6, x7, x8, x9) i =
19− case (i % 9) of
20− 1 ->
21− x1
22− 2 ->
23− x2
24− 3 ->
25− x3
26− 4 ->
27− x4
28− 5 ->
29− x5
30− 6 ->
31− x6
32− 7 ->
33− x7
34− 8 ->
35− x8
36− 0 ->
37− x9
38−
39−
40−sumRandomElems : List Int -> Float
41−sumRandomElems randomInts =
42− List.foldr (\i sumSoFar -> (getField defaultTuple i) + sumSoFar ) 0.0 randomInts
src/Canonicalize/Setup.hs+1−1
@@ -326,7 +326,7 @@ declToPatches moduleName (A.A (region,_) decl) =
326326 D.TypeAlias name tvars alias ->
327327 ( Just (node region name tvars alias)
328328 , case alias of
329− A.A _ (Type.RRecord _ _) ->
329+ A.A _ (Type.RRecord _ Nothing) ->
330330 [topLevel Env.Value name]
331331 _ ->
332332 []