on master help sign in
Merge branch 'master' into canonicalize

Conflicts: Elm.cabal

commit4a1d46cf90935b0809d1590c75bb66b98846d527 authorEvan Czaplicki <info@elm-lang.org> dateThu 24 Apr 2014, 06:28 (13 years ago) parent247ad62fa1ea89
14 files changed+998−29
Elm.cabal+3−6 compiler/Generate/JavaScript/Ports.hs+1−1 libraries/Array.elm+189 libraries/Dict.elm+76−18 libraries/Graphics/Input.elm+1−1 libraries/List.elm+7−1 libraries/Native/Array.js+592 libraries/Native/Show.js+4 libraries/Native/Utils.js+5 libraries/Set.elm+11−1 tests/elm/Test.elm+3−1 tests/elm/Test/Array.elm+54 tests/elm/Test/Dict.elm+26 tests/elm/Test/Set.elm+26
Elm.cabal+3−6
@@ -248,16 +248,11 @@ Test-Suite compiler-tests
248248 AST.Helpers
249249 AST.Literal
250250 AST.PrettyPrint
251− build-depends: base,
252− directory,
253− Elm,
254− test-framework,
251+ build-depends: test-framework,
255252 test-framework-hunit,
256253 test-framework-quickcheck2 >= 0.3,
257254 HUnit,
258− pretty,
259255 QuickCheck >= 2 && < 3,
260− filemanip,
261256 aeson,
262257 base >=4.2 && <5,
263258 binary >= 0.7.0.0,
@@ -267,6 +262,8 @@ Test-Suite compiler-tests
267262 cmdargs,
268263 containers >= 0.3,
269264 directory,
265+ Elm,
266+ filemanip,
270267 filepath,
271268 indents,
272269 language-ecmascript >=0.15 && < 1.0,
compiler/Generate/JavaScript/Ports.hs+1−1
@@ -21,7 +21,7 @@ check x jsType continue =
2121 JSNumber -> [typeof "number"]
2222 JSBoolean -> [typeof "boolean"]
2323 JSString -> [typeof "string", instanceof "String"]
24− JSArray -> [instanceof "Array"]
24+ JSArray -> [(obj "_U.isJSArray" <|)]
2525 JSObject fields -> [jsFold OpLAnd (typeof "object" : map member fields)]
2626
2727incoming :: CanonicalType -> Expression ()
libraries/Array.elmnew file+189
@@ -0,0 +1,189 @@
1+module Array where
2+
3+{-| A library for fast immutable arrays. The elements in an array must have the
4+same type. The arrays are implemented in Relaxed Radix Balanced-Trees for fast
5+reads, updates, and appends.
6+
7+# Creating Arrays
8+@docs empty, repeat, initialize, fromList
9+
10+# Basics
11+@docs length, push, append
12+
13+# Get and Set
14+@docs get, getSafe, getUnsafe, set
15+
16+# Taking Arrays Apart
17+@docs toList, toIndexedList, slice
18+
19+# Mapping and Folding
20+@docs map, indexedMap, foldl, foldr
21+-}
22+
23+import Native.Array
24+import Basics (..)
25+import Maybe (..)
26+import List
27+
28+data Array a = Array
29+
30+{-| Initialize an array. `initialize n f` creates an array of length `n` with
31+the element at index `i` initialized to the result of `(f i)`.
32+
33+ initialize 4 id == fromList [0,1,2,3]
34+ initialize 4 (\n -> n*n) == fromList [0,1,4,9]
35+ initialize 4 (always 0) == fromList [0,0,0,0]
36+-}
37+initialize : Int -> (Int -> a) -> Array a
38+initialize = Native.Array.initialize
39+
40+{-| Creates an array with a given length, filled with a default element.
41+
42+ repeat 5 0 == fromList [0,0,0,0,0]
43+ repeat 3 "cat" == fromList ["cat","cat","cat"]
44+
45+Notice that `repeat 3 x` is the same as `initialize 3 (always x)`.
46+-}
47+repeat : Int -> a -> Array a
48+repeat n e = initialize n (always e)
49+
50+{-| Create an array from a list. -}
51+fromList : [a] -> Array a
52+fromList = Native.Array.fromList
53+
54+{-| Create a list of elements from an array.
55+
56+ toList (fromList [3,5,8]) == [3,5,8]
57+-}
58+toList : Array a -> [a]
59+toList = Native.Array.toList
60+
61+-- TODO: make this a native function.
62+{-| Create an indexed list from an array. Each element of the array will be
63+paired with its index.
64+
65+ toIndexedList (fromList ["cat","dog"]) == [(0,"cat"), (1,"dog")]
66+-}
67+toIndexedList : Array a -> [(Int, a)]
68+toIndexedList array =
69+ List.zip [ 0 .. Native.Array.length array - 1 ] (Native.Array.toList array)
70+
71+{-| Apply a function on every element in an array.
72+
73+ map sqrt (fromList [1,4,9]) == fromList [1,2,3]
74+-}
75+map : (a -> b) -> Array a -> Array b
76+map = Native.Array.map
77+
78+{-| Apply a function on every element with its index as first argument.
79+
80+ indexedMap (*) (fromList [5,5,5]) == fromList [0,5,10]
81+-}
82+indexedMap : (Int -> a -> b) -> Array a -> Array b
83+indexedMap = Native.Array.indexedMap
84+
85+{-| Reduce an array from the left. Read `foldl` as &ldquo;fold from the left&rdquo;.
86+
87+ foldl (::) [] (fromList [1,2,3]) == [3,2,1]
88+-}
89+foldl : (a -> b -> b) -> b -> Array a -> b
90+foldl = Native.Array.foldl
91+
92+{-| Reduce an array from the right. Read `foldr` as &ldquo;fold from the right&rdquo;.
93+
94+ foldr (+) 0 (repeat 3 5) == 15
95+-}
96+foldr : (a -> b -> b) -> b -> Array a -> b
97+foldr = Native.Array.foldr
98+
99+{-| Keep only elements that satisfy the predicate:
100+
101+ filter isEven (fromList [1..6]) == (fromList [2,4,6])
102+-}
103+filter : (a -> Bool) -> Array a -> Array a
104+filter isOkay arr =
105+ let update x xs = if isOkay x then Native.Array.push x xs else xs
106+ in
107+ Native.Array.foldl update Native.Array.empty arr
108+
109+{-| Return an empty array.
110+
111+ length empty == 0
112+-}
113+empty : Array a
114+empty = Native.Array.empty
115+
116+{-| Push an element to the end of an array.
117+
118+ push 3 (fromList [1,2]) == fromList [1,2,3]
119+-}
120+push : a -> Array a -> Array a
121+push = Native.Array.push
122+
123+{-| Get the element at a particular index.
124+
125+ getUnsafe 2 (A.fromList [3,2,1]) == 1
126+
127+Warning: this function will result in a runtime error if the index is not found,
128+so it is best to use `get` or `getSafe` unless you are very confident the index
129+will be found.
130+-}
131+getUnsafe : Int -> Array a -> a
132+getUnsafe = Native.Array.get
133+
134+{-| Return Just the element at the index or Nothing if the index is out of range.
135+
136+ get 2 (fromList [3,2,1]) == Just 2
137+ get 5 (fromList [3,2,1]) == Nothing
138+ get -1 (fromList [3,2,1]) == Nothing
139+-}
140+get : Int -> Array a -> Maybe a
141+get i array =
142+ if 0 <= i && i < Native.Array.length array
143+ then Just (Native.Array.get i array)
144+ else Nothing
145+
146+{-| Get the element at the index. If the index is out of range, the given default
147+element is returned.
148+
149+ getSafe 0 2 (fromList [3,2,1]) == 1
150+ getSafe 0 5 (fromList [3,2,1]) == 0
151+-}
152+getSafe : a -> Int -> Array a -> a
153+getSafe default i array =
154+ if 0 <= i && i < Native.Array.length array
155+ then Native.Array.get i array
156+ else default
157+
158+{-| Set the element at a particular index. Returns an updated array.
159+If the index is out of range, the array is unaltered.
160+
161+ set 1 7 (fromList [1,2,3]) == fromList [1,7,3]
162+-}
163+set : Int -> a -> Array a -> Array a
164+set = Native.Array.set
165+
166+{-| Slice an array given a range. The selection is inclusive, so the last
167+element in the selection will also be in the new array. This may change in the
168+future. You can select from the end by giving a negative Int.
169+
170+ slice 1 2 (fromList [0,1,2,3,4]) == fromList [1,2]
171+ slice 1 -2 (fromList [0,1,2,3,4]) == fromList [1,2,3]
172+ slice -3 -2 (fromList [0,1,2,3,4]) == fromList [2,3]
173+-}
174+slice : Int -> Int -> Array a -> Array a
175+slice = Native.Array.slice
176+
177+{-| Return the length of an array.
178+
179+ length (fromList [1,2,3]) == 3
180+-}
181+length : Array a -> Int
182+length = Native.Array.length
183+
184+{-| Append two arrays to a new one.
185+
186+ append (array 2 42) (array 3 81) == fromList [42,42,81,81,81]
187+-}
188+append : Array a -> Array a -> Array a
189+append = Native.Array.append
libraries/Dict.elm+76−18
@@ -1,6 +1,8 @@
11module Dict (empty,singleton,insert,update
2− ,lookup,findWithDefault
2+ ,get,getSafe,getUnsafe
33 ,remove,member
4+ ,filter
5+ ,partition
46 ,foldl,foldr,map
57 ,union,intersect,diff
68 ,keys,values
@@ -17,7 +19,7 @@ Insert, remove, and query operations all take *O(log n)* time.
1719@docs empty, singleton, insert, update, remove
1820
1921# Query
20−@docs member, lookup, findWithDefault
22+@docs member, get, getMaybe, getWithDefault
2123
2224# Combine
2325@docs union, intersect, diff
@@ -26,7 +28,7 @@ Insert, remove, and query operations all take *O(log n)* time.
2628@docs keys, values, toList, fromList
2729
2830# Transform
29−@docs map, foldl, foldr
31+@docs map, foldl, foldr, filter, partition
3032
3133-}
3234
@@ -84,33 +86,74 @@ max t =
8486 RBNode _ _ _ _ r -> max r
8587 RBEmpty _ -> Native.Error.raise "(max Empty) is not defined"
8688
87−{-| Lookup the value associated with a key. -}
88−lookup : comparable -> Dict comparable v -> Maybe v
89−lookup k t =
89+{-| Get the value associated with a key. If the key is not found, return
90+`Nothing`. This is useful when you are not sure if a key will be in the
91+dictionary.
92+
93+ animals = fromList [ ("Tom", Cat), ("Jerry", Mouse) ]
94+
95+ get "Tom" animals == Just Cat
96+ get "Mouse" animals == Just Mouse
97+ get "Spike" animals == Nothing
98+
99+The `getSafe` and `getUnsafe` are built-in ways to handle common ways of
100+using the resulting `Maybe`.
101+-}
102+get : comparable -> Dict comparable v -> Maybe v
103+get k t =
90104 case t of
91105 RBEmpty LBlack -> Nothing
92106 RBNode _ k' v l r ->
93107 case Native.Utils.compare k k' of
94− LT -> lookup k l
108+ LT -> get k l
95109 EQ -> Just v
96− GT -> lookup k r
110+ GT -> get k r
111+
112+{-| Get the value associated with a key. If the key is not found,
113+return a default value.
97114
98−{-| Find the value associated with a key. If the key is not found,
99−return the default value. -}
100−findWithDefault : v -> comparable -> Dict comparable v -> v
101−findWithDefault base k t =
115+ animals = fromList [ ("Tom", Cat), ("Jerry", Mouse) ]
116+
117+ getSafe Dog "Tom" animals == Cat
118+ getSafe Dog "Mouse" animals == Mouse
119+ getSafe Dog "Spike" animals == Dog
120+-}
121+getSafe : v -> comparable -> Dict comparable v -> v
122+getSafe base k t =
102123 case t of
103124 RBEmpty LBlack -> base
104125 RBNode _ k' v l r ->
105126 case Native.Utils.compare k k' of
106− LT -> findWithDefault base k l
127+ LT -> getSafe base k l
107128 EQ -> v
108− GT -> findWithDefault base k r
129+ GT -> getSafe base k r
130+
131+{-| Get the value associated with a key.
132+
133+ animals = fromList [ ("Tom", Cat), ("Jerry", Mouse) ]
134+
135+ get "Tom" animals == Cat
136+ get "Mouse" animals == Mouse
137+ get "Spike" animals == -- Runtime Error!
138+
139+Warning: this function will result in a runtime error if the key is not found,
140+so it is best to use `get` or `getSafe` unless you are very confident the key
141+will be found.
142+-}
143+getUnsafe : comparable -> Dict comparable v -> v
144+getUnsafe k t =
145+ case t of
146+ RBEmpty LBlack -> Native.Error.raise "key not found when using 'getUnsafe'"
147+ RBNode _ k' v l r ->
148+ case Native.Utils.compare k k' of
149+ LT -> getUnsafe k l
150+ EQ -> v
151+ GT -> getUnsafe k r
109152
110153{-| Determine if a key is in a dictionary. -}
111154member : comparable -> Dict comparable v -> Bool
112155-- Does t contain k?
113−member k t = isJust <| lookup k t
156+member k t = isJust <| get k t
114157
115158ensureBlackRoot : Dict k v -> Dict k v
116159ensureBlackRoot t =
@@ -327,9 +370,7 @@ union t1 t2 = foldl insert t2 t1
327370{-| Keep a key-value pair when its key appears in the second dictionary.
328371Preference is given to values in the first dictionary. -}
329372intersect : Dict comparable v -> Dict comparable v -> Dict comparable v
330−intersect t1 t2 =
331− let combine k v t = if k `member` t2 then insert k v t else t
332− in foldl combine empty t1
373+intersect t1 t2 = filter (\k _ -> k `member` t2) t1
333374
334375{-| Keep a key-value pair when its key does not appear in the second dictionary.
335376Preference is given to the first dictionary. -}
@@ -351,3 +392,20 @@ toList t = foldr (\k v acc -> (k,v) :: acc) [] t
351392{-| Convert an association list into a dictionary. -}
352393fromList : [(comparable,v)] -> Dict comparable v
353394fromList assocs = List.foldl (\(k,v) d -> insert k v d) empty assocs
395+
396+{-| Keep a key-value pair when it satisfies a predicate. -}
397+filter : (comparable -> v -> Bool) -> Dict comparable v -> Dict comparable v
398+filter p dict =
399+ let add k v t = if p k v then insert k v t else t
400+ in foldl add empty dict
401+
402+{-| Partition a dictionary according to a predicate. The first dictionary
403+contains all key-value pairs which satisfy the predicate, and the second
404+contains the rest.
405+-}
406+partition : (comparable -> v -> Bool) -> Dict comparable v -> (Dict comparable v, Dict comparable v)
407+partition p dict =
408+ let add k v (t1, t2) = if p k v
409+ then (insert k v t1, t2)
410+ else (t1, insert k v t2)
411+ in foldl add (empty, empty) dict
libraries/Graphics/Input.elm+1−1
@@ -89,7 +89,7 @@ button = Native.Graphics.Input.button
8989
9090 prettyButton : Element
9191 prettyButton =
92− customButton click.handle
92+ customButton click.handle ()
9393 (image 100 40 "/button_up.jpg")
9494 (image 100 40 "/button_hover.jpg")
9595 (image 100 40 "/button_down.jpg")
libraries/List.elm+7−1
@@ -163,7 +163,13 @@ maximum = foldl1 max
163163minimum : [comparable] -> comparable
164164minimum = foldl1 min
165165
166−{-| Split a list based on the predicate. -}
166+{-| Partition a list based on a predicate. The first list contains all values
167+that satisfy the predicate, and the second list contains all the value that do
168+not.
169+
170+ partition (\x -> x < 3) [0..5] == ([0,1,2], [3,4,5])
171+ partition isEven [0..5] == ([0,2,4], [1,3,5])
172+-}
167173partition : (a -> Bool) -> [a] -> ([a],[a])
168174partition pred lst =
169175 case lst of
libraries/Native/Array.jsnew file+592
@@ -0,0 +1,592 @@
1+Elm.Native.Array = {};
2+Elm.Native.Array.make = function(elm) {
3+ elm.Native = elm.Native || {};
4+ elm.Native.Array = elm.Native.Array || {};
5+ if (elm.Native.Array.values) return elm.Native.Array.values;
6+ if ('values' in Elm.Native.Array)
7+ return elm.Native.Array.values = Elm.Native.Array.values;
8+
9+ var List = Elm.Native.List.make(elm);
10+
11+ // A RRB-Tree has two distinct data types.
12+ // Leaf -> "height" is always 0
13+ // "table" is an array of elements
14+ // Node -> "height" is always greater than 0
15+ // "table" is an array of child nodes
16+ // "lengths" is an array of accumulated lengths of the child nodes
17+
18+ // M is the maximal table size. 32 seems fast. E is the allowed increase
19+ // of search steps when concatting to find an index. Lower values will
20+ // decrease balancing, but will increase search steps.
21+ var M = 32;
22+ var E = 2;
23+
24+ // An empty array.
25+ var empty = { ctor:"_Array", height:0, table:new Array() };
26+
27+ // Gets the value at index i recursively.
28+ function get(i, array) {
29+ if (i < 0 || i >= length(array)) {
30+ throw new Error("Index " + i + " is out of range. Check the length of " +
31+ "your array first or use getMaybe or getWithDefault.");
32+ }
33+ return unsafeGet(i, array);
34+ }
35+
36+ function unsafeGet(i, array) {
37+ if (array.height == 0) {
38+ return array.table[i];
39+ }
40+ var slot = getSlot(i, array);
41+ var offset = slot > 0 ? array.lengths[slot-1] : 0;
42+ return unsafeGet(i - offset, array.table[slot]);
43+ }
44+
45+ // Sets the value at the index i. Only the nodes leading to i will get
46+ // copied and updated.
47+ function set(i, item, a) {
48+ if (length(a) <= i) {
49+ return a;
50+ }
51+ var newA = nodeCopy(a);
52+ newA.table = a.table.slice();
53+
54+ if (a.height == 0) {
55+ newA.table[i] = item;
56+ } else {
57+ var slot = getSlot(i, a);
58+ var sub = slot > 0 ? a.lengths[slot-1] : 0;
59+ newA.table[slot] = set(i - sub, item, a.table[slot]);
60+ }
61+ return newA;
62+ }
63+
64+ function initialize(len, f) {
65+ if (len == 0) { return empty; }
66+ var h = Math.floor(Math.log(len)/Math.log(M));
67+ return initialize_(f, h, 0, len);
68+ }
69+
70+ function initialize_(f, h, from, to) {
71+ if (h == 0) {
72+ var table = new Array((to - from) % (M + 1));
73+ for (var i = 0; i < table.length; i++) {
74+ table[i] = f(from + i);
75+ }
76+ return { ctor:"_Array", height:0, table:table };
77+ }
78+
79+ var step = Math.pow(M, h);
80+ var table = new Array(Math.ceil((to - from) / step));
81+ var lengths = new Array(table.length);
82+ for (var i = 0; i < table.length; i++) {
83+ table[i] = initialize_( f, h - 1, from + (i * step)
84+ , Math.min(from + ((i + 1) * step), to));
85+ lengths[i] = length(table[i]) + (i > 0 ? lengths[i-1] : 0);
86+ }
87+ return { ctor:"_Array", height:h, table:table, lengths:lengths };
88+ }
89+
90+ function fromList(list) {
91+ if (list == List.Nil) { return empty; }
92+
93+ // Allocate M sized blocks (table) and write list elements to it.
94+ var table = new Array(M);
95+ var nodes = new Array();
96+ var i = 0;
97+
98+ while (list.ctor !== '[]') {
99+ table[i] = list._0;
100+ list = list._1;
101+ i++;
102+
103+ // table is full, so we can push a leaf containing it into the
104+ // next node.
105+ if (i == M) {
106+ fromListPush({ ctor:"_Array", height:0, table:table }
107+ , nodes);
108+ table = new Array(M);
109+ i = 0;
110+ }
111+ }
112+
113+ // Maybe there is something left on the table.
114+ if (i > 0) {
115+ fromListPush({ ctor:"_Array", height:0, table:table.splice(0,i) }
116+ , nodes);
117+ }
118+
119+ // Go through all of the nodes and eventually push them into higher nodes.
120+ for (var h = 0; h < nodes.length - 1; h++) {
121+ if (nodes[h].table.length > 0) {
122+ fromListPush(nodes[h], nodes);
123+ }
124+ }
125+
126+ var head = nodes[nodes.length - 1];
127+ if (head.height > 0 && head.table.length == 1) {
128+ return head.table[0];
129+ } else {
130+ return head;
131+ }
132+ }
133+
134+ // Push a node into a higher node as a child.
135+ function fromListPush(toPush, nodes) {
136+ var h = toPush.height;
137+
138+ // Maybe the node on this height does not exist.
139+ if (nodes.length == h) {
140+ nodes.push({ ctor:"_Array", height:h + 1
141+ , table:new Array()
142+ , lengths:new Array() });
143+ }
144+
145+ nodes[h].table.push(toPush);
146+ var len = length(toPush);
147+ if (nodes[h].lengths.length > 0) {
148+ len += nodes[h].lengths[nodes[h].lengths.length - 1];
149+ }
150+ nodes[h].lengths.push(len);
151+
152+ if (nodes[h].table.length == M) {
153+ fromListPush(nodes[h], nodes);
154+ nodes[h] = { ctor:"_Array", height:h + 1
155+ , table:new Array()
156+ , lengths:new Array() };
157+ }
158+ }
159+
160+ // Pushes an item via push_ to the bottom right of a tree.
161+ function push(item, a) {
162+ var pushed = push_(item, a);
163+ if (pushed !== null) {
164+ return pushed;
165+ }
166+
167+ var newTree = create(item, a.height);
168+ return siblise(a, newTree);
169+ }
170+
171+ // Recursively tries to push an item to the bottom-right most
172+ // tree possible. If there is no space left for the item,
173+ // null will be returned.
174+ function push_(item, a) {
175+ // Handle resursion stop at leaf level.
176+ if (a.height == 0) {
177+ if (a.table.length < M) {
178+ var newA = { ctor:"_Array", height:0, table:a.table.slice() };
179+ newA.table.push(item);
180+ return newA;
181+ } else {
182+ return null;
183+ }
184+ }
185+
186+ // Recursively push
187+ var pushed = push_(item, botRight(a));
188+
189+ // There was space in the bottom right tree, so the slot will
190+ // be updated.
191+ if (pushed != null) {
192+ var newA = nodeCopy(a);
193+ newA.table[newA.table.length - 1] = pushed;
194+ newA.lengths[newA.lengths.length - 1]++;
195+ return newA
196+ }
197+
198+ // When there was no space left, check if there is space left
199+ // for a new slot with a tree which contains only the item
200+ // at the bottom.
201+ if (a.table.length < M) {
202+ var newSlot = create(item, a.height - 1);
203+ var newA = nodeCopy(a);
204+ newA.table.push(newSlot);
205+ newA.lengths.push(newA.lengths[newA.lengths.length - 1] + length(newSlot));
206+ return newA
207+ } else {
208+ return null;
209+ }
210+ }
211+
212+ // Converts an array into a list of elements.
213+ function toList(a) {
214+ return toList_(List.Nil, a);
215+ }
216+
217+ function toList_(list, a) {
218+ for (var i = a.table.length - 1; i >= 0; i--) {
219+ list = a.height == 0 ? List.Cons(a.table[i], list) : toList_(list, a.table[i]);
220+ }
221+ return list;
222+ }
223+
224+ // Maps a function over the elements of an array.
225+ function map(f, a) {
226+ var newA = { ctor:"_Array", height:a.height, table:new Array(a.table) };
227+ if (a.height > 0) { newA.lengths = a.lengths; }
228+ for (var i = 0; i < a.table.length; i++) {
229+ newA.table[i] = a.height == 0 ? f(a.table[i]) : map(f, a.table[i]);
230+ }
231+ return newA;
232+ }
233+
234+ // Maps a function over the elements with their index as first argument.
235+ function indexedMap(f, a) {
236+ var newA = { ctor:"_Array", height:a.height, table:new Array(a.table) };
237+ if (a.height > 0) { newA.lengths = a.lengths; }
238+ for (var i = 0; i < a.table.length; i++) {
239+ newA.table[i] = a.height == 0 ? A2(f, i, a.table[i]) : indexedMap(f, a.table[i]);
240+ }
241+ return newA;
242+ }
243+
244+ function foldl(f, b, a) {
245+ for (var i = 0; i < a.table.length; i++) {
246+ b = A2(f, a.height == 0 ? a.table[i] : foldl(f, b, a.table[i]), b);
247+ }
248+ return b;
249+ }
250+
251+ function foldr(f, b, a) {
252+ for (var i = a.table.length; i--; ) {
253+ b = A2(f, a.height == 0 ? a.table[i] : foldr(f, b, a.table[i]), b);
254+ }
255+ return b;
256+ }
257+
258+ // Returns a sliced tree. "to" is inclusive, but this may change,
259+ // when I understand, why e.g. JS does not handle it this way. :-)
260+ // If "from" or "to" is negative, they will select from the end on.
261+ // TODO: currently, it slices the right, then the left. This can be
262+ // optimized.
263+ function slice(from, to, a) {
264+ if (from < 0) { from += length(a); }
265+ if (to < 0) { to += length(a); }
266+ return sliceLeft(from, sliceRight(to, a));
267+ }
268+
269+ function sliceRight(to, a) {
270+ if (to == length(a)) {
271+ return a;
272+ }
273+
274+ // Handle leaf level.
275+ if (a.height == 0) {
276+ var newA = { ctor:"_Array", height:0 };
277+ newA.table = a.table.slice(0, to + 1);
278+ return newA;
279+ }
280+
281+ // Slice the right recursively.
282+ var right = getSlot(to, a);
283+ var sliced = sliceRight(to - (right > 0 ? a.lengths[right - 1] : 0), a.table[right]);
284+
285+ // Maybe the a node is not even needed, as sliced contains the whole slice.
286+ if (right == 0) {
287+ return sliced;
288+ }
289+
290+ // Create new node.
291+ var newA = { ctor:"_Array", height:a.height
292+ , table:a.table.slice(0, right + 1)
293+ , lengths:a.lengths.slice(0, right + 1) };
294+ newA.table[right] = sliced;
295+ newA.lengths[right] = length(sliced) + (right > 0 ? newA.lengths[right - 1] : 0);
296+ return newA;
297+ }
298+
299+ function sliceLeft(from, a) {
300+ if (from == 0) {
301+ return a;
302+ }
303+
304+ // Handle leaf level.
305+ if (a.height == 0) {
306+ var newA = { ctor:"_Array", height:0 };
307+ newA.table = a.table.slice(from, a.table.length + 1);
308+ return newA;
309+ }
310+
311+ // Slice the left recursively.
312+ var left = getSlot(from, a);
313+ var sliced = sliceLeft(from - (left > 0 ? a.lengths[left - 1] : 0), a.table[left]);
314+
315+ // Maybe the a node is not even needed, as sliced contains the whole slice.
316+ if (left == a.table.length - 1) {
317+ return sliced;
318+ }
319+
320+ // Create new node.
321+ var newA = { ctor:"_Array", height:a.height
322+ , table:a.table.slice(left, a.table.length + 1)
323+ , lengths:new Array(a.table.length - left) };
324+ newA.table[left] = sliced;
325+ var len = 0;
326+ for (var i = 0; i < newA.table.length; i++) {
327+ len += length(newA.table[i]);
328+ newA.lengths[i] = len;
329+ }
330+
331+ return newA;
332+ }
333+
334+ // Appends two trees.
335+ // TODO: Add support for appending trees of different sizes. Current
336+ // behavior will just rise the lower tree and then append them.
337+ function append(a,b) {
338+ if (b.height > a.height) { return append(parentise(a, b.height), b); }
339+ if (a.height > b.height) { return append(a, parentise(b, a.height)); }
340+ if (a.height == 0) { return append(parentise(a, 1), parentise(b, 1)); }
341+
342+ var c = append_(a, b);
343+ if (c[1].table.length > 0) {
344+ return siblise(c[0], c[1]);
345+ } else {
346+ return c[0];
347+ }
348+ }
349+
350+ // Returns an array of two nodes. The second node _may_ be empty. This case
351+ // needs to be handled by the function, that called append_. May be only
352+ // called for trees with an minimal height of 1.
353+ function append_(a, b) {
354+ if (a.height == 1) {
355+ // Check if balancing is needed and return based on that.
356+ var toRemove = calcToRemove(a, b);
357+ if (toRemove <= E) {
358+ return [a,b];
359+ }
360+
361+ return shuffle(a, b, toRemove);
362+ }
363+
364+ var appended = append_(botRight(a), botLeft(b));
365+ a = nodeCopy(a), b = nodeCopy(b);
366+
367+ // Adjust the bottom right side of the new tree.
368+ a.table[a.table.length - 1] = appended[0];
369+ a.lengths[a.lengths.length - 1] = length(appended[0])
370+ a.lengths[a.lengths.length - 1] += a.lengths.length > 1 ? a.lengths[a.lengths.length - 2] : 0;
371+
372+ // Adjust the bottom left side of the new tree.
373+ if (appended[1].table.length > 0) {
374+ b.table[0] = appended[1];
375+ b.lengths[0] = length(appended[1]);
376+ for (var i = 1, len = length(b.table[0]); i < b.lengths.length; i++) {
377+ len += length(b.table[i]);
378+ b.lengths[i] = len;
379+ }
380+ } else {
381+ b.table.shift();
382+ for (var i = 1; i < b.lengths.length; i++) {
383+ b.lengths[i] = b.lengths[i] - b.lengths[0];
384+ }
385+ b.lengths.shift();
386+ }
387+
388+ // Check if balancing is needed and return based on that.
389+ var toRemove = calcToRemove(a, b);
390+ if (toRemove <= E || b.table.length == 0) {
391+ return [a,b];
392+ }
393+
394+ return shuffle(a, b, toRemove);
395+ }
396+
397+ // Returns the extra search steps for E. Refer to the paper.
398+ function calcToRemove(a, b) {
399+ var subLengths = 0;
400+ for (var i = 0; i < a.table.length; i++) {
401+ subLengths += a.table[i].table.length;
402+ }
403+ for (var i = 0; i < b.table.length; i++) {
404+ subLengths += b.table[i].table.length;
405+ }
406+
407+ var toRemove = a.table.length + b.table.length
408+ return toRemove - (Math.floor((subLengths - 1) / M) + 1);
409+ }
410+
411+ // get2, set2 and saveSlot are helpers for accessing elements over two arrays.
412+ function get2(a, b, index) {
413+ return index < a.length ? a[index] : b[index - a.length];
414+ }
415+
416+ function set2(a, b, index, value) {
417+ if (index < a.length) {
418+ a[index] = value;
419+ } else {
420+ b[index - a.length] = value;
421+ }
422+ }
423+
424+ function saveSlot(a, b, index, slot) {
425+ set2(a.table, b.table, index, slot);
426+
427+ var l = (index == 0 || index == a.lengths.length) ?
428+ 0 : get2(a.lengths, a.lengths, index - 1);
429+ set2(a.lengths, b.lengths, index, l + length(slot));
430+ }
431+
432+ // Creates a node or leaf with a given length at their arrays for perfomance.
433+ // Is only used by shuffle.
434+ function createNode(h, length) {
435+ if (length < 0) { length = 0; }
436+ var a = { ctor:"_Array", height:h, table:new Array(length) };
437+ if (h > 0) {
438+ a.lengths = new Array(length);
439+ }
440+ return a;
441+ }
442+
443+ // Returns an array of two balanced nodes.
444+ function shuffle(a, b, toRemove) {
445+ var newA = createNode(a.height, Math.min(M, a.table.length + b.table.length - toRemove));
446+ var newB = createNode(a.height, newA.table.length - (a.table.length + b.table.length - toRemove));
447+
448+ // Skip the slots with size M. More precise: copy the slot references
449+ // to the new node
450+ var read = 0;
451+ while (get2(a.table, b.table, read).table.length % M == 0) {
452+ set2(newA.table, newB.table, read, get2(a.table, b.table, read));
453+ set2(newA.lengths, newB.lengths, read, get2(a.lengths, b.lengths, read));
454+ read++;
455+ }
456+
457+ // Pulling items from left to right, caching in a slot before writing
458+ // it into the new nodes.
459+ var write = read;
460+ var slot = new createNode(a.height - 1, 0);
461+ var from = 0;
462+
463+ // If the current slot is still containing data, then there will be at
464+ // least one more write, so we do not break this loop yet.
465+ while (read - write - (slot.table.length > 0 ? 1 : 0) < toRemove) {
466+ // Find out the max possible items for copying.
467+ var source = get2(a.table, b.table, read);
468+ var to = Math.min(M - slot.table.length, source.table.length)
469+
470+ // Copy and adjust size table.
471+ slot.table = slot.table.concat(source.table.slice(from, to));
472+ if (slot.height > 0) {
473+ var len = slot.lengths.length;
474+ for (var i = len; i < len + to - from; i++) {
475+ slot.lengths[i] = length(slot.table[i]);
476+ slot.lengths[i] += (i > 0 ? slot.lengths[i - 1] : 0);
477+ }
478+ }
479+
480+ from += to;
481+
482+ // Only proceed to next slots[i] if the current one was
483+ // fully copied.
484+ if (source.table.length <= to) {
485+ read++; from = 0;
486+ }
487+
488+ // Only create a new slot if the current one is filled up.
489+ if (slot.table.length == M) {
490+ saveSlot(newA, newB, write, slot);
491+ slot = createNode(a.height - 1,0);
492+ write++;
493+ }
494+ }
495+
496+ // Cleanup after the loop. Copy the last slot into the new nodes.
497+ if (slot.table.length > 0) {
498+ saveSlot(newA, newB, write, slot);
499+ write++;
500+ }
501+
502+ // Shift the untouched slots to the left
503+ while (read < a.table.length + b.table.length ) {
504+ saveSlot(newA, newB, write, get2(a.table, b.table, read));
505+ read++; write++;
506+ }
507+
508+ return [newA, newB];
509+ }
510+
511+ // Navigation functions
512+ function botRight(a) { return a.table[a.table.length - 1]; }
513+ function botLeft(a) { return a.table[0]; }
514+
515+ // Copies a node for updating. Note that you should not use this if
516+ // only updating only one of "table" or "lengths" for performance reasons.
517+ function nodeCopy(a) {
518+ var newA = { ctor:"_Array", height:a.height
519+ , table:a.table.slice() };
520+ if (a.height > 0) { newA.lengths = a.lengths.slice(); }
521+ return newA;
522+ }
523+
524+ // Returns how many items are in the tree.
525+ function length(array) {
526+ if (array.height == 0) {
527+ return array.table.length;
528+ } else {
529+ return array.lengths[array.lengths.length - 1];
530+ }
531+ }
532+
533+ // Calculates in which slot of "table" the item probably is, then
534+ // find the exact slot via forward searching in "lengths". Returns the index.
535+ function getSlot(i, a) {
536+ var slot = Math.floor(i / (Math.pow(M, a.height)));
537+ while (a.lengths[slot] <= i) {
538+ slot++
539+ }
540+ return slot;
541+ }
542+
543+ // Recursively creates a tree with a given height containing
544+ // only the given item.
545+ function create(item, h) {
546+ if (h == 0) {
547+ return { ctor:"_Array", height:0
548+ , table:[item] };
549+ } else {
550+ return { ctor:"_Array", height:h
551+ , table:[create(item, h - 1)]
552+ , lengths:[1] };
553+ }
554+ }
555+
556+ // Recursively creates a tree that contains the given tree.
557+ function parentise(tree, h) {
558+ if (h == tree.height) {
559+ return tree;
560+ } else {
561+ return { ctor:"_Array", height:h
562+ , table:[parentise(tree, h - 1)]
563+ , lengths:[length(tree)] };
564+ }
565+ }
566+
567+ // Emphasizes blood brotherhood beneath two trees.
568+ function siblise(a, b) {
569+ return { ctor:"_Array", height:a.height + 1
570+ , table:[a, b]
571+ , lengths:[length(a), length(a) + length(b)] };
572+ }
573+
574+ Elm.Native.Array.values = {
575+ empty:empty,
576+ fromList:fromList,
577+ toList:toList,
578+ initialize:F2(initialize),
579+ append:F2(append),
580+ push:F2(push),
581+ slice:F3(slice),
582+ get:F2(get),
583+ set:F3(set),
584+ map:F2(map),
585+ indexedMap:F2(indexedMap),
586+ foldl:F3(foldl),
587+ foldr:F3(foldr),
588+ length:length
589+ };
590+
591+ return elm.Native.Array.values = Elm.Native.Array.values;
592+}
libraries/Native/Show.js+4
@@ -5,6 +5,7 @@ Elm.Native.Show.make = function(elm) {
55 if (elm.Native.Show.values) return elm.Native.Show.values;
66
77 var NList = Elm.Native.List.make(elm);
8+ var Array = Elm.Array.make(elm);
89 var List = Elm.List.make(elm);
910 var Dict = Elm.Dict.make(elm);
1011 var Tuple2 = Elm.Native.Utils.make(elm).Tuple2;
@@ -43,6 +44,9 @@ Elm.Native.Show.make = function(elm) {
4344 output.push(toString(v[k]));
4445 }
4546 return "(" + output.join(",") + ")";
47+ } else if (v.ctor === "_Array") {
48+ var list = Array.toList(v);
49+ return "Array.fromList " + toString(list);
4650 } else if (v.ctor === "::") {
4751 var output = '[' + toString(v._0);
4852 v = v._1;
libraries/Native/Utils.js+5
@@ -210,6 +210,10 @@ Elm.Native.Utils.make = function(elm) {
210210 return Tuple2(posx, posy);
211211 }
212212
213+ function isJSArray(a) {
214+ return a instanceof Array;
215+ }
216+
213217 return elm.Native.Utils.values = {
214218 eq:eq,
215219 cmp:cmp,
@@ -229,6 +233,7 @@ Elm.Native.Utils.make = function(elm) {
229233 mod : F2(mod),
230234 htmlHeight: F2(htmlHeight),
231235 getXY: getXY,
236+ isJSArray: isJSArray,
232237 toFloat: function(x) { return +x; }
233238 };
234239};
libraries/Set.elm+11−1
@@ -2,6 +2,7 @@
22module Set (empty,singleton,insert,remove
33 ,member
44 ,foldl,foldr,map
5+ ,filter,partition
56 ,union,intersect,diff
67 ,toList,fromList
78 ) where
@@ -25,7 +26,7 @@ Insert, remove, and query operations all take *O(log n)* time.
2526@docs toList, fromList
2627
2728# Transform
28−@docs map, foldl, foldr
29+@docs map, foldl, foldr, filter, partition
2930
3031-}
3132
@@ -88,3 +89,12 @@ foldr f b s = Dict.foldr (\k _ b -> f k b) b s
8889{-| Map a function onto a set, creating a new set with no duplicates. -}
8990map : (comparable -> comparable') -> Set comparable -> Set comparable'
9091map f s = fromList (List.map f (toList s))
92+
93+{-| Create a new set consisting only of elements which satisfy a predicate. -}
94+filter : (comparable -> Bool) -> Set comparable -> Set comparable
95+filter p set = Dict.filter (\k _ -> p k) set
96+
97+{-| Create two new sets; the first consisting of elements which satisfy a
98+predicate, the second consisting of elements which do not. -}
99+partition : (comparable -> Bool) -> Set comparable -> (Set comparable, Set comparable)
100+partition p set = Dict.partition (\k _ -> p k) set
tests/elm/Test.elm+3−1
@@ -11,9 +11,11 @@ import IO.Runner as Run
1111
1212import Test.String as String
1313import Test.Trampoline as Trampoline
14+import Test.Array as Array
15+import Test.Dict as Dict
1416
1517tests : [Test]
16−tests = String.tests ++ Trampoline.tests
18+tests = String.tests ++ Trampoline.tests ++ Array.tests ++ Dict.tests
1719
1820console : IO ()
1921console = runDisplay tests
tests/elm/Test/Array.elmnew file+54
@@ -0,0 +1,54 @@
1+module Test.Array (tests) where
2+
3+import List
4+import Array
5+
6+import ElmTest.Assertion (..)
7+import ElmTest.Test (..)
8+
9+tests : [Test]
10+tests =
11+ let creationTests =
12+ [ test "empty" <| assertEqual Array.empty (Array.fromList [])
13+ , test "initialize" <| assertEqual (Array.initialize 4 id) (Array.fromList [0,1,2,3])
14+ , test "initialize 2" <| assertEqual (Array.initialize 4 (\n -> n*n)) (Array.fromList [0,1,4,9])
15+ , test "initialize 3" <| assertEqual (Array.initialize 4 (always 0)) (Array.fromList [0,0,0,0])
16+ , test "initialize Empty" <| assertEqual (Array.initialize 0 id) Array.empty
17+ , test "initialize 4" <| assertEqual (Array.initialize 2 (always 0)) (Array.fromList [0,0])
18+ , test "repeat" <| assertEqual (Array.repeat 5 40) (Array.fromList [40,40,40,40,40])
19+ , test "repeat 2" <| assertEqual (Array.repeat 5 0) (Array.fromList [0,0,0,0,0])
20+ , test "repeat 3" <| assertEqual (Array.repeat 3 "cat") (Array.fromList ["cat","cat","cat"])
21+ , test "fromList" <| assertEqual (Array.fromList []) Array.empty
22+ ]
23+ basicsTests =
24+ [ test "length" <| assertEqual (Array.length (Array.fromList [1,2,3])) 3
25+ , test "length - Long" <| assertEqual (Array.length (Array.repeat 10000 0)) 10000
26+ , test "push" <| assertEqual (Array.push 3 (Array.fromList [1,2])) (Array.fromList [1,2,3])
27+ , test "append" <| assertEqual (Array.toList <| Array.append (Array.repeat 2 42) (Array.repeat 3 81)) ([42,42,81,81,81])
28+ ]
29+ getAndSetTests =
30+ [ test "get" <| assertEqual (Array.get 1 (Array.fromList [3,2,1])) (Just 2)
31+ , test "get 2" <| assertEqual (Array.get 5 (Array.fromList [3,2,1])) Nothing
32+ , test "get 3" <| assertEqual (Array.get -1 (Array.fromList [3,2,1])) Nothing
33+ , test "getSafe 1" <| assertEqual (Array.getSafe 0 2 (Array.fromList [3,2,1])) 1
34+ , test "getSafe 2" <| assertEqual (Array.getSafe 0 5 (Array.fromList [3,2,1])) 0
35+ , test "getUnsafe" <| assertEqual (Array.getUnsafe 2 (Array.fromList [3,2,1])) 1
36+ , test "set" <| assertEqual (Array.set 1 7 (Array.fromList [1,2,3])) (Array.fromList [1,7,3])
37+ ]
38+ takingArraysApartTests =
39+ [ test "toList" <| assertEqual (Array.toList (Array.fromList [3,5,8])) [3,5,8]
40+ , test "toIndexedList" <| assertEqual (Array.toIndexedList (Array.fromList ["cat","dog"])) [(0,"cat"), (1,"dog")]
41+ , test "slice" <| assertEqual (Array.slice 1 2 (Array.fromList [0,1,2,3,4])) (Array.fromList [1,2])
42+ , test "slice 2" <| assertEqual (Array.slice 1 -2 (Array.fromList [0,1,2,3,4])) (Array.fromList [1,2,3])
43+ , test "slice 3" <| assertEqual (Array.slice -3 -2 (Array.fromList [0,1,2,3,4])) (Array.fromList [2,3])
44+ ]
45+ mappingAndFoldingTests =
46+ [ test "map" <| assertEqual (Array.map sqrt (Array.fromList [1,4,9])) (Array.fromList [1,2,3])
47+ , test "indexedMap" <| assertEqual (Array.indexedMap (*) (Array.fromList [5,5,5])) (Array.fromList [0,5,10])
48+ , test "foldl" <| assertEqual (Array.foldl (::) [] (Array.fromList [1,2,3])) [3,2,1]
49+ , test "foldr" <| assertEqual (Array.foldr (+) 0 (Array.repeat 3 5)) 15
50+ , test "foldr 2" <| assertEqual (Array.foldr (::) [] (Array.fromList [1,2,3])) [1,2,3]
51+ , test "filter" <| assertEqual (Array.filter (\x -> x `mod` 2 == 0) (Array.fromList [1..6])) (Array.fromList [2,4,6])
52+ ]
53+ in
54+ List.concat [creationTests, basicsTests, getAndSetTests, takingArraysApartTests, mappingAndFoldingTests]
tests/elm/Test/Dict.elmnew file+26
@@ -0,0 +1,26 @@
1+module Test.Dict (tests) where
2+
3+import Dict
4+import List
5+
6+import ElmTest.Assertion (..)
7+import ElmTest.Test (..)
8+
9+animals : Dict.Dict String String
10+animals = Dict.fromList [ ("Tom", "cat"), ("Jerry", "mouse") ]
11+
12+tests : [Test]
13+tests =
14+ let getTests =
15+ [ test "get 1" <| assertEqual (Just "cat") (Dict.get "Tom" animals)
16+ , test "get 2" <| assertEqual Nothing (Dict.get "Spike" animals)
17+ , test "getSafe 1" <| assertEqual "mouse" (Dict.getSafe "dog" "Jerry" animals)
18+ , test "getSafe 2" <| assertEqual "dog" (Dict.getSafe "dog" "Spike" animals)
19+ , test "getUnsafe" <| assertEqual "cat" (Dict.getUnsafe "Tom" animals)
20+ ]
21+ filterTests =
22+ [ test "filter" <| assertEqual (Dict.singleton "Tom" "cat") (Dict.filter (\k v -> k == "Tom") animals)
23+ , test "partition" <| assertEqual (Dict.singleton "Tom" "cat", Dict.singleton "Jerry" "mouse") (Dict.partition (\k v -> k == "Tom") animals)
24+ ]
25+ in
26+ List.concat [ getTests, filterTests ]
tests/elm/Test/Set.elmnew file+26
@@ -0,0 +1,26 @@
1+module Test.Set (tests) where
2+
3+import Set
4+import List
5+
6+import ElmTest.Assertion (..)
7+import ElmTest.Test (..)
8+
9+set : Set
10+set = Set.fromList [1..100]
11+
12+setPart1 : Set
13+setPart1 = Set.fromList [1..50]
14+
15+setPart2 : Set
16+setPart2 = Set.fromList [51..100]
17+
18+pred : Int -> Bool
19+pred x = x <= 50
20+
21+tests : [Test]
22+tests =
23+ let
24+ filterTests = [assertEqual setPart1 <| filter pred set]
25+ partitionTests = [assertEqual (setPart1, setPart2) <| partition pred set]
26+ in List.concat [partitionTests, filterTests]