view modules/array.tp @ 251:2557ce4e671f

Fix a couple of compiler bugs. topenv was getting initialized in multiple places. This resulted in multiple copies of modules getting created which caused problems for macro expansion. Additionally, arguments were not being marked as declared during code generation so assigning to an argument that was not closed over generated invalid C code.
author Michael Pavone <pavone@retrodev.com>
date Fri, 11 Apr 2014 22:29:32 -0700
parents fd9005253861
children 56409de95f55
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
	}

	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
	}

	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: {
			""
		}
	}
}