view modules/array.tp @ 322:fb54a3af9c86

Add sort method to arrays
author Michael Pavone <pavone@retrodev.com>
date Sun, 22 Mar 2015 22:06:50 -0700
parents bb4723fec05e
children eb5f1fca9b78
line wrap: on
line source

#{
	llProperty: size withType: uint32_t
	llProperty: storage withType: uint32_t
	llProperty: data withType: ((object ptr) ptr)
	llMessage: get withVars: {
		index <- obj_int32 ptr
	} andCode: :index {
		if: (index num) >= 0 && (index num) < size {
			(self data) get: (index num)
		} else: {
			false
		}
	}

	llMessage: set withVars: {
		index <- obj_int32 ptr
		value <- object ptr
	} andCode: :index value {
		if: (index num) >= 0 && (index num) < size {
			data set: (index num) value
		}
		self
	}

	llMessage: foreach withVars: {
		clos <- lambda ptr
		i <- uint32_t
		index <- obj_int32 ptr
	} andCode: :clos {
		i <- 0
		while: { i < size } do: {
			index <- make_object: (addr_of: obj_int32_meta) NULL 0
			index num!: i
			ccall: clos 2 index (data get: i)
			i <- i + 1
		}
		self
	}

	llMessage: append withVars: {
		value <- object ptr
		tmp <- (object ptr) ptr
	} andCode: :value {
		if: storage = size {
			storage <- storage * 2
			tmp <- GC_REALLOC: data storage * (sizeof: (object ptr))
			if: (not: tmp) {
				fputs: "Failed to increase array size\n" stderr
				exit: 1
			}
			data <- tmp
		}
		data set: size value
		size <- size + 1
		self
	}

	llMessage: resize withVars: {
		newsize <- obj_uint32 ptr
		tmp <- (object ptr) ptr
	} andCode: :newsize {
		self storage!: (newsize num)
		tmp <- GC_REALLOC: data storage * (sizeof: (object ptr))
		if: (not: tmp) {
			fputs: "Failed to adjust array size\n" stderr
			exit: 1
		}
		data <- tmp
		if: size > storage {
			size <- storage
		}
		self
	}

	llMessage: length withVars: {
		intret <- obj_int32 ptr
	} andCode: {
		intret <- make_object: (addr_of: obj_int32_meta) NULL 0
		intret num!: size
		intret
	}

	fold:with <- :acc :fun {
		foreach: self :idx el {
			acc <- fun: acc el
		}
		acc
	}

	foldr:with <- :acc :fun {
		idx <- length - 1
		while: {idx >= 0} do: {
			acc <- fun: acc (get: idx)
		}
		acc
	}

	map <- :fun {
		new <- #[]
		foreach: self :idx el {
			new append: (fun: el)
		}
		new
	}

	filter <- :fun {
		new <- #[]
		foreach: self :idx el {
			if: (fun: el) {
				new append: el
			}
		}
		new
	}

	find:withDefault <- :pred :default{
		idx <- 0
		l <- length
		ret <- default
		while: {idx < l} do: {
			v <- get: idx
			if: (pred: v) {
				ret <- #{
					key <- idx
					value <- v
				}
				idx <- l
			}
		}
		ret
	}
	
	sort <- {
		n <- length
		tmp <- #[]
		tmp resize: n
		while: { (tmp length) < n} do: {
			tmp append: false
		}
		src <- self
		dst <- tmp
		
		merge <- :lStart rStart rEnd {
			dstIdx <- lStart
			left <- lStart
			right <- rStart
			
			while: { dstIdx < rEnd } do: {
				if: left < rStart && (right >= rEnd || (src get: left) <= (src get: right)) {
					dst set: dstIdx (src get: left)
					left <- left + 1
				} else: {
					dst set: dstIdx (src get: right)
					right <- right + 1
				}
				dstIdx <- dstIdx + 1
			}
		}
		
		needsCopy? <- false
		subSize <- 1
		while: { subSize < n} do: {
			group <- subSize * 2
			i <- 0
			while: { i < n} do: {
				right <- i + subSize
				end <- i + group
				if: right > n {
					right <- n
					end <- n
				} else: {
					if: end > n {
						end <- n
					}
				}
				merge: i right end
				i <- i + group
			}
			tmp <- dst
			dst <- src
			src <- tmp
			needsCopy? <- not: needsCopy?
		
			subSize <- subSize + subSize
		}
		if: needsCopy? {
			foreach: src :index val {
				self set: index val
			}
		}
	}

	join <- :sep {
		if: length > 0 {
			str <- string: (get: 0)
			idx <- 1
			l <- length
			while: { idx < l } do: {
				str <- str . sep . (get: idx)
				idx <- idx + 1
			}
			str
		} else: {
			""
		}
	}

	jsonEncode <- {
		parts <- map: :el { json encode: el }
		"[" . (parts join: ",") . "]"
	}
}