view modules/dict.tp @ 253:697c2c562af2

Fix infinite loop in hash dict
author Michael Pavone <pavone@retrodev.com>
date Sat, 31 May 2014 21:27:03 -0700
parents c58e17f5c0f6
children bb4723fec05e
line wrap: on
line source
{
	linearWithEls <- :els {
		key:val <- :k v {
			#{
				key <- k
				val <- v
			}
		}
		find <- :tofind {
			idx <- 0
			while: {
				if: idx < (els length) {
					((els get: idx) key: ) != tofind
				} else: {false}
			} do: {
				idx <- idx + 1
			}
			if: idx < (els length) {idx} else: {-1}
		}
		#{
			set <- :k v {
				idx <- find: k
				if: idx < 0 {
					els append: (key: k val: v)
				} else: {
					(els get: idx) val!: v
				}
				self
			}

			get <- :k {
				get: k withDefault: false
			}

			get:withDefault <- :k default {
				idx <- find: k
				if: idx < 0 {
					default
				} else: {
					(els get: idx) val
				}
			}

			get:elseSet <- :k :else {
				get: k else: {
					v <- else:
					els append: (key: k val: v)
					v
				}
			}

			get:else <- :k :else {
				idx <- find: k
				if: idx < 0 {
					else:
				} else: {
					(els get: idx) val
				}
			}

			contains? <- :k {
				(find: k) >= 0
			}

			foreach <- :l {
				foreach: els :idx el {
					l: (el key) (el val)
				}
			}

			map <- :fun {
				newels <- #[]
				foreach: els :idx el {
					newels append: (key: (el key) val: (fun: (el val)))
				}
				linearWithEls: newels
			}

			length <- { els length }
		}
	}
	_empty <- #{
		empty? <- { true }
	}
	_makeBucket <- :key val {
		#{
			empty? <- { false }
			k <- key
			v <- val
			= <- :other { k = other }
		}
	}
	#{
		//requires only that keys support equality
		linear <- {
			linearWithEls: #[]
		}

		//requires that keys support equality and hash
		hash <- {

			_buckets <- #[
				_empty
				_empty
				_empty
				_empty]
			_size <- 0
			_hashdiffs <- #[0]
			#{
				size <- { size }
				ifget:else <- :key ifpres :ifnot {
					basehash <- key hash
					notdone <- true
					i <- 0
					ret <- _empty

					while: { if: notdone { i < (_hashdiffs length)}} do: {
						hv <- basehash + (_hashdiffs get: i)
						trunc <- hv % (_buckets length)
						if: trunc < 0 { trunc <- 0 - trunc }
						bucket <- _buckets get: trunc
						if: (bucket empty?) {
							notdone <- false
						} else: {
							if: bucket = key {
								ret <- bucket
								notdone <- false
							}
						}
						i <- i + 1
					}
					if: (ret empty?) ifnot else: {
						ifpres: (ret v)
					}
				}

				get:else <- :key :else {
					ifget: key :val {
						val
					} else: else
				}

				contains? <- :key {
					ifget: key :_ {
						true
					} else: {
						false
					}
				}

				set <- :key val {
					notdone <- true
					basehash <- key hash
					i <- 0
					while: { if: notdone { i < (_hashdiffs length) } } do: {
						hv <- basehash + (_hashdiffs get: i)
						trunc <- hv % (_buckets length)
						if: trunc < 0 { trunc <- 0 - trunc }
						bucket <- (_buckets get: trunc)
						if: (bucket empty?) {
							_size <- _size + 1
							_buckets set: trunc (_makeBucket: key val)
							notdone <- false
						} else: {
							if: bucket = key {
								bucket v!: val
								notdone <- false
							}
						}
						i <- i + 1
					}
					if: notdone {
						newsize <- (_buckets length) * 3 + 1
						lastdiff <- _hashdiffs get: ((_hashdiffs length) - 1)
						if: lastdiff <= 0 {
							_hashdiffs append: 0 - lastdiff + 1
						} else: {
							_hashdiffs append: 0 - lastdiff
						}
						newbucks <- #[]
						newbucks resize: newsize
						while: { (newbucks length) < newsize } do: {
							newbucks append: _empty
						}
						oldbucks <- _buckets
						_buckets <- newbucks
						_size <- 0
						foreach: oldbucks :idx el {
							if: (not: (el empty?)) {
								set: (el k) (el v)
							}
						}
						set: key val
					}
					self
				}

				foreach <- :fun {
					foreach: _buckets :idx el {
						if: (not: (el empty?)) {
							fun: (el k) (el v)
						}
					}
				}
			}
		}

		main <- {
			d <- hash
			d set: "foo" "bar"
			d set: "baz" "qux"
			i <- 0
			while: { i < 32 } do: {
				d set: (string: i) "blah " . (string: i)
				i <- i + 1
			}
			foreach: d :k v {
				print: "k: " . k . ", v: " . v . "\n"
			}
			0
		}
	}
}