6b2b19d · elk · git.iko.soy

git.iko.soy/elk

Add type annotations to the Dict library to test functionality and speed of type annotations. Shows dramatic speed improvement!

6b2b19devancz14 years ago

core-elm/Dict.elm+42−6

compare with master

unifiedsplit

@@ -14,6 +14,7 @@ data NColor = Red | Black

15data RBTree k v = RBNode NColor k v (RBTree k v) (RBTree k v) | RBEmpty

17+empty : RBTree k v

17empty = RBEmpty

18empty = RBEmpty

19raise err = throw (JavaScript.castStringToJSString err)

20raise err = throw (JavaScript.castStringToJSString err)

@@ -97,6 +98,7 @@ invariants_hold t =

97--}

98--}

100

101+min : RBTree k v -> (k,v)

100min t =

102min t =

101 case t of

103 case t of

102 RBNode _ k v RBEmpty _ -> (k,v)

104 RBNode _ k v RBEmpty _ -> (k,v)

@@ -112,6 +114,7 @@ max t =

112 }

114 }

113--}

115--}

114

116

117+lookup : k -> RBTree k v -> Maybe v

115lookup k t =

118lookup k t =

116 case t of

119 case t of

117 RBEmpty -> Nothing

120 RBEmpty -> Nothing

@@ -121,6 +124,7 @@ lookup k t =

121 EQ -> Just v

124 EQ -> Just v

122 GT -> lookup k r

125 GT -> lookup k r

123

126

127+findWithDefault : v -> k -> RBTree k v -> v

124findWithDefault base k t =

128findWithDefault base k t =

125 case t of

129 case t of

126 RBEmpty -> base

130 RBEmpty -> base

@@ -143,8 +147,10 @@ find k t =

143--}

147--}

144

148

145-- Does t contain k?

149-- Does t contain k?

150+member : k -> RBTree k v -> Bool

146member k t = isJust $ lookup k t

151member k t = isJust $ lookup k t

147

152

153+rotateLeft : RBTree k v -> RBTree k v

148rotateLeft t =

154rotateLeft t =

149 case t of

155 case t of

150 RBNode cy ky vy a (RBNode cz kz vz b c) -> RBNode cy kz vz (RBNode Red ky vy a b) c

156 RBNode cy ky vy a (RBNode cz kz vz b c) -> RBNode cy kz vz (RBNode Red ky vy a b) c

@@ -152,16 +158,19 @@ rotateLeft t =

152

158

153-- rotateRight -- the reverse, and

159-- rotateRight -- the reverse, and

154-- makes Y have Z's color, and makes Z Red.

160-- makes Y have Z's color, and makes Z Red.

161+rotateRight : RBTree k v -> RBTree k v

155rotateRight t =

162rotateRight t =

156 case t of

163 case t of

157 RBNode cz kz vz (RBNode cy ky vy a b) c -> RBNode cz ky vy a (RBNode Red kz vz b c)

164 RBNode cz kz vz (RBNode cy ky vy a b) c -> RBNode cz ky vy a (RBNode Red kz vz b c)

158 _ -> raise "rotateRight of a node without enough children"

165 _ -> raise "rotateRight of a node without enough children"

159

166

167+rotateLeftIfNeeded : RBTree k v -> RBTree k v

160rotateLeftIfNeeded t =

168rotateLeftIfNeeded t =

161 case t of

169 case t of

162 RBNode _ _ _ _ (RBNode Red _ _ _ _) -> rotateLeft t

170 RBNode _ _ _ _ (RBNode Red _ _ _ _) -> rotateLeft t

163 _ -> t

171 _ -> t

164

172

173+rotateRightIfNeeded : RBTree k v -> RBTree k v

165rotateRightIfNeeded t =

174rotateRightIfNeeded t =

166 case t of

175 case t of

167 RBNode _ _ _ (RBNode Red _ _ (RBNode Red _ _ _ _) _) _ -> rotateRight t

176 RBNode _ _ _ (RBNode Red _ _ (RBNode Red _ _ _ _) _) _ -> rotateRight t

@@ -169,6 +178,7 @@ rotateRightIfNeeded t =

169

178

170otherColor c = case c of { Red -> Black ; Black -> Red }

179otherColor c = case c of { Red -> Black ; Black -> Red }

171

180

181+color_flip : RBTree k v -> RBTree k v

172color_flip t =

182color_flip t =

173 case t of

183 case t of

174 RBNode c1 bk bv (RBNode c2 ak av la ra) (RBNode c3 ck cv lc rc) ->

184 RBNode c1 bk bv (RBNode c2 ak av la ra) (RBNode c3 ck cv lc rc) ->

@@ -177,6 +187,7 @@ color_flip t =

177 (RBNode (otherColor c3) ck cv lc rc)

187 (RBNode (otherColor c3) ck cv lc rc)

178 _ -> raise "color_flip called on a RBEmpty or RBNode with a RBEmpty child"

188 _ -> raise "color_flip called on a RBEmpty or RBNode with a RBEmpty child"

179

189

190+color_flipIfNeeded : RBTree k v -> RBTree k v

180color_flipIfNeeded t =

191color_flipIfNeeded t =

181 case t of

192 case t of

182 RBNode _ _ _ (RBNode Red _ _ _ _) (RBNode Red _ _ _ _) -> color_flip t

193 RBNode _ _ _ (RBNode Red _ _ _ _) (RBNode Red _ _ _ _) -> color_flip t

@@ -184,13 +195,14 @@ color_flipIfNeeded t =

184

195

185fixUp t = color_flipIfNeeded (rotateRightIfNeeded (rotateLeftIfNeeded t))

196fixUp t = color_flipIfNeeded (rotateRightIfNeeded (rotateLeftIfNeeded t))

186

197

187−

198+ensureBlackRoot : RBTree k v -> RBTree k v

188ensureBlackRoot t =

199ensureBlackRoot t =

189 case t of

200 case t of

190 RBNode Red k v l r -> RBNode Black k v l r

201 RBNode Red k v l r -> RBNode Black k v l r

191 _ -> t

202 _ -> t

192

203

193-- Invariant: t is a valid left-leaning rb tree *)

204-- Invariant: t is a valid left-leaning rb tree *)

205+insert : k -> v -> RBTree k v -> RBTree k v

194insert k v t =

206insert k v t =

195 let ins t =

207 let ins t =

196 case t of

208 case t of

@@ -211,35 +223,40 @@ insert k v t =

211 else new_t)

223 else new_t)

212--}

224--}

213

225

226+singleton : k -> v -> RBTree k v

214singleton k v = insert k v RBEmpty

227singleton k v = insert k v RBEmpty

215

228

216−

229+isRed : RBTree k v -> Bool

217isRed t =

230isRed t =

218 case t of

231 case t of

219 RBNode Red _ _ _ _ -> True

232 RBNode Red _ _ _ _ -> True

220 _ -> False

233 _ -> False

221

234

235+isRedLeft : RBTree k v -> Bool

222isRedLeft t =

236isRedLeft t =

223 case t of

237 case t of

224 RBNode _ _ _ (RBNode Red _ _ _ _) _ -> True

238 RBNode _ _ _ (RBNode Red _ _ _ _) _ -> True

225 _ -> False

239 _ -> False

226

240

241+isRedLeftLeft : RBTree k v -> Bool

227isRedLeftLeft t =

242isRedLeftLeft t =

228 case t of

243 case t of

229 RBNode _ _ _ (RBNode _ _ _ (RBNode Red _ _ _ _) _) _ -> True

244 RBNode _ _ _ (RBNode _ _ _ (RBNode Red _ _ _ _) _) _ -> True

230 _ -> False

245 _ -> False

231

246

247+isRedRight : RBTree k v -> Bool

232isRedRight t =

248isRedRight t =

233 case t of

249 case t of

234 RBNode _ _ _ _ (RBNode Red _ _ _ _) -> True

250 RBNode _ _ _ _ (RBNode Red _ _ _ _) -> True

235 _ -> False

251 _ -> False

236

252

253+isRedRightLeft : RBTree k v -> Bool

237isRedRightLeft t =

254isRedRightLeft t =

238 case t of

255 case t of

239 RBNode _ _ _ _ (RBNode _ _ _ (RBNode Red _ _ _ _) _) -> True

256 RBNode _ _ _ _ (RBNode _ _ _ (RBNode Red _ _ _ _) _) -> True

240 _ -> False

257 _ -> False

241

258

242−

259+moveRedLeft : RBTree k v -> RBTree k v

243moveRedLeft t =

260moveRedLeft t =

244 let t' = color_flip t in

261 let t' = color_flip t in

245 case t' of

262 case t' of

@@ -250,16 +267,20 @@ moveRedLeft t =

250 _ -> t'

267 _ -> t'

251 _ -> t'

268 _ -> t'

252

269

270+moveRedRight : RBTree k v -> RBTree k v

253moveRedRight t =

271moveRedRight t =

254 let t' = color_flip t in

272 let t' = color_flip t in

255 if isRedLeftLeft t' then color_flip (rotateRight t') else t'

273 if isRedLeftLeft t' then color_flip (rotateRight t') else t'

256

274

275+moveRedLeft : RBTree k v -> RBTree k v

257moveRedLeftIfNeeded t =

276moveRedLeftIfNeeded t =

258 if not (isRedLeft t) && not (isRedLeftLeft t) then moveRedLeft t else t

277 if not (isRedLeft t) && not (isRedLeftLeft t) then moveRedLeft t else t

259

278

279+moveRedRightIfNeeded : RBTree k v -> RBTree k v

260moveRedRightIfNeeded t =

280moveRedRightIfNeeded t =

261 if not (isRedRight t) && not (isRedRightLeft t) then moveRedRight t else t

281 if not (isRedRight t) && not (isRedRightLeft t) then moveRedRight t else t

262

282

283+deleteMin : RBTree k v -> RBTree k v

263deleteMin t =

284deleteMin t =

264 let del t =

285 let del t =

265 case t of

286 case t of

@@ -282,6 +303,7 @@ deleteMax t =

282 in ensureBlackRoot (del t)

303 in ensureBlackRoot (del t)

283--}

304--}

284

305

306+remove : k -> RBTree k v -> RBTree k v

285remove k t =

307remove k t =

286 let eq_and_noRightNode t =

308 let eq_and_noRightNode t =

287 case t of { RBNode _ k' _ _ RBEmpty -> k == k' ; _ -> False }

309 case t of { RBNode _ k' _ _ RBEmpty -> k == k' ; _ -> False }

@@ -313,27 +335,41 @@ remove k t =

313 raise "invariants broken after remove")

335 raise "invariants broken after remove")

314--}

336--}

315

337

338+map : (a -> b) -> RBTree k a -> RBTree k b

316map f t =

339map f t =

317 case t of

340 case t of

318 RBEmpty -> RBEmpty

341 RBEmpty -> RBEmpty

319 RBNode c k v l r -> RBNode c k (f v) (map f l) (map f r)

342 RBNode c k v l r -> RBNode c k (f v) (map f l) (map f r)

320

343

344+foldl : (k -> v -> b -> b) -> b -> RBTree k v -> b

321foldl f acc t =

345foldl f acc t =

322 case t of

346 case t of

323 RBEmpty -> acc

347 RBEmpty -> acc

324 RBNode _ k v l r -> foldl f (f k v (foldl f acc l)) r

348 RBNode _ k v l r -> foldl f (f k v (foldl f acc l)) r

325

349

350+foldr : (k -> v -> b -> b) -> b -> RBTree k v -> b

326foldr f acc t =

351foldr f acc t =

327 case t of

352 case t of

328 RBEmpty -> acc

353 RBEmpty -> acc

329 RBNode _ k v l r -> foldr f (f k v (foldr f acc r)) l

354 RBNode _ k v l r -> foldr f (f k v (foldr f acc r)) l

330

355

356+union : RBTree k v -> RBTree k v -> RBTree k v

331union t1 t2 = foldl insert t2 t1

357union t1 t2 = foldl insert t2 t1

358+

359+intersect : RBTree k v -> RBTree k v -> RBTree k v

332intersect t1 t2 = foldl (\k v t -> if k `member` t2 then insert k v t else t) empty t1

360intersect t1 t2 = foldl (\k v t -> if k `member` t2 then insert k v t else t) empty t1

361+

362+diff : RBTree k v -> RBTree k v -> RBTree k v

333diff t1 t2 = foldl (\k v t -> remove k t) t1 t2

363diff t1 t2 = foldl (\k v t -> remove k t) t1 t2

334

364

365+keys : RBTree k v -> [k]

335−keys t = foldr (\k v acc -> k : acc) [] t

366+keys t = foldr (\k v acc -> k :: acc) [] t

367+

368+values : RBTree k v -> [v]

336−values t = foldr (\k v acc -> v : acc) [] t

369+values t = foldr (\k v acc -> v :: acc) [] t

370+

371+toList : RBTree k v -> [(k,v)]

372+toList t = foldr (\k v acc -> (k,v) :: acc) [] t

337

373

338−toList t = foldr (\k v acc -> (k,v) : acc) [] t

374+fromList : [(k,v)] -> RBTree k v

339fromList assocs = Elm.List.foldl (uncurry insert) empty assocs

375fromList assocs = Elm.List.foldl (uncurry insert) empty assocs