view modules/string.tp @ 331:61f5b794d939

Breaking change: method call syntax now always uses the syntactic receiver as the actual receiver. This makes its behavior different from function call syntax, but solves some problems with methods being shadowed by local variables and the like.
author Michael Pavone <pavone@retrodev.com>
date Sat, 28 Mar 2015 14:21:04 -0700
parents 8dbb2d2522a5
children 74cab9b5f2a4
line wrap: on
line source

#{
	llProperty: len withType: uint32_t
	llProperty: bytes withType: uint32_t
	llProperty: data withType: (char ptr)

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

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

	llMessage: "=" withVars: {
		argb <- (string ptr)
	} andCode: :argb {
		if: len = (argb len) && bytes = (argb bytes) && (not: (memcmp: data (argb data) bytes)) {
			true
		}
	}

	llMessage: compareSub withVars: {
		argb <- string ptr
		myoff <- obj_int32 ptr
		boff <- obj_int32 ptr
		clen <- obj_int32 ptr
		intret <- obj_int32 ptr
	} andCode: :argb myoff boff clen {
		intret <- make_object: (addr_of: obj_int32_meta) NULL 0
		intret num!: (memcmp: data + (myoff num) (argb data) + (boff num) (clen num))
		intret
	}

	llMessage: "!=" withVars: {
		argb <- (string ptr)
	} andCode: :argb {
		if: len != (argb len) || bytes != (argb bytes) || (memcmp: data (argb data) bytes) {
			true
		}
	}

	print <- {
		(file stdout) write: self
		self
	}

	llMessage: string withVars: {} andCode: {
		self
	}

	llMessage: "." withVars: {
		argbo <- (object ptr)
		argb <- (string ptr)
		out <- (string ptr)
	} andCode: :argbo {
		argb <- (mcall: string 1 argbo) castTo: (string ptr)
		out <- make_object: (addr_of: string_meta) NULL 0
		out bytes!: bytes + (argb bytes)
		out len!: len + (argb len)
		out data!: (GC_MALLOC_ATOMIC: (out bytes) + 1)
		memcpy: (out data) data bytes
		memcpy: (out data) + bytes (argb data) (argb bytes) + 1
		out
	}

	llMessage: byte withVars: {
		index <- (obj_int32 ptr)
		intret <- (obj_int32 ptr)
	} andCode: :index {
		intret <- make_object: (addr_of: obj_int32_meta) NULL 0
		intret num!: (if: (index num) < bytes { data get: (index num) } else: {0})
		intret
	}

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

	parseHex32 <- {
		num <- 0u32
		cur <- 0
		a <- uint32: ("a" byte: 0)
		A <- uint32: ("A" byte: 0)
		f <- uint32: ("f" byte: 0)
		F <- uint32: ("F" byte: 0)
		zero <- "0" byte: 0
		nine <- "9" byte: 0
		while: { cur < byte_length} do: {
			b <- uint32: (byte: cur)
			cur <- cur + 1
			if: b >= zero && b <= nine {
				num <- num * 16 + (b - zero)
			} else: {
				if: b >= a && b <= f {
					num <- num * 16 + (b - a) + 10u32
				} else: {
					if: b >= A && b <= F {
						num <- num * 16 + (b - A) + 10u32
					} else: {
						cur <- byte_length
					}
				}
			}
		}
		num
	}

	parseHex64 <- {
		num <- 0u64
		cur <- 0
		a <- uint64: ("a" byte: 0)
		A <- uint64: ("A" byte: 0)
		f <- uint64: ("f" byte: 0)
		F <- uint64: ("F" byte: 0)
		zero <- "0" byte: 0
		nine <- "9" byte: 0
		while: { cur < byte_length} do: {
			b <- uint64: (byte: cur)
			cur <- cur + 1
			if: b >= zero && b <= nine {
				num <- num * 16 + (b - zero)
			} else: {
				if: b >= a && b <= f {
					num <- num * 16 + (b - a) + 10u64
				} else: {
					if: b >= A && b <= F {
						num <- num * 16 + (b - A) + 10u64
					} else: {
						cur <- byte_length
					}
				}
			}
		}
		num
	}

	llMessage: hash withVars: {
		intret <- (obj_int32 ptr)
		i <- uint32_t
	} andCode: {
		intret <- make_object: (addr_of: obj_int32_meta) NULL 0
		intret num!: 0
		if: bytes {
			intret num!: (data get: 0) * 128
			i <- 0
			while: { i < bytes } do: {
				intret num!: (1000003 * (intret num)) xor (data get: i)
				i <- i + 1
			}
			intret num!: (intret num) xor bytes
		}
		intret
	}

	llMessage: find:startingAt:else withVars: {
		intret <- obj_int32 ptr
		oneedle <- object ptr
		startpos <- obj_int32 ptr
		ifNotFound <- object ptr
		sneedle <- string ptr
		i <- uint32_t
		notFound <- uint32_t
	} andCode: :oneedle :startpos :ifNotFound {
		sneedle <- (mcall: string 1 oneedle) castTo: (string ptr)
		i <- startpos num
		notFound <- 1
		while: { notFound && i + (sneedle bytes) <= bytes} do: {
			if: (memcmp: data + i (sneedle data) (sneedle bytes)) = 0 {
				notFound <- 0
			} else: {
				i <- i + 1
			}
		}
		if: notFound {
			ccall: ifNotFound 0
		} else: {
			intret <- make_object: (addr_of: obj_int32_meta) NULL 0
			intret num!: i
			intret
		}
	}

	find:else <- :toFind :orElse {
		find: toFind startingAt: 0 else: orElse
	}

	llMessage: from:withLength withVars: {
		from <- obj_int32 ptr
		tocopy <- obj_int32 ptr
		ret <- string ptr
		start <- int32_t
		clampedLen <- int32_t
	} andCode: :from :tocopy {
		start <- from num
		if: start < 0 {
			start <- bytes + start
		}
		if: start > bytes {
			start <- bytes
		}
		clampedLen <- tocopy num
		if: clampedLen < 0 {
			clampedLen <- bytes - clampedLen
			if: clampedLen < 0 {
				clampedLen <- 0
			}
		}
		if: start + clampedLen > bytes {
			clampedLen <- bytes - start
		}
		ret <- make_object: (addr_of: string_meta) NULL 0
		ret data!: (GC_MALLOC_ATOMIC: clampedLen + 1)
		memcpy: (ret data) data + start clampedLen
		ret len!: clampedLen
		ret bytes!: clampedLen
		(ret data) set: clampedLen 0
		ret
	}

	from <- :start {
		from: start withLength: length
	}

	partitionOn <- :delim {
		pos <- find: delim else: { -1 }
		if: pos >= 0 {
			_before <- from: 0 withLength: pos
			_after <- from: (pos + (delim length))
			#{
				before <- _before
				after <- _after
			}
		} else: {
			_before <- self
			#{
				before <- _before
				after <- ""
			}
		}
	}

	splitOn <- :delim {
		pos <- 0
		pieces <- #[]
		while: {
			pos <- find: delim else: { -1 }
			pos >= 0
		} do: {
			pieces append: (from: 0 withLength: pos)
			self <- from: pos + (delim length)
		}
		pieces append: self
	}

	ltrim <- {
		l <- length
		start <- 0
		space <- " " byte: 0
		tab <- "\t" byte: 0
		nl <- "\n" byte: 0
		cr <- "\r" byte: 0

		while: {
			if: start < l {
				b <- byte: start
				b = space || b = tab || b = nl || b = cr
			}
		} do: {
			start <- start + 1
		}
		from: start
	}

	trim <- {
		l <- length
		start <- 0
		space <- " " byte: 0
		tab <- "\t" byte: 0
		nl <- "\n" byte: 0
		cr <- "\r" byte: 0

		while: {
			if: start < l {
				b <- byte: start
				b = space || b = tab || b = nl || b = cr
			}
		} do: {
			start <- start + 1
		}
		end <- l - 1
		while: {
			if: end > start {
				b <- byte: end
				b = space || b = tab || b = nl || b = cr
			}
		} do: {
			end <- end - 1
		}
		from: start withLength: (end + 1 - start)
	}
	
	startsWith? <- :prefix {
		if: (prefix length) <= length {
			0 = (compareSub: prefix 0 0 (prefix length))
		}
	}

	endsWith? <- :suffix {
		if: (suffix length) <= length {
			0 = (compareSub: suffix (length - (suffix length)) 0 (suffix length))
		}
	}

	jsonEncode <- {
		i <- 0
		start <- 0
		parts <- #["\""]
		q <- "\"" byte: 0
		s <- "\\" byte: 0
		while: { i < byte_length } do: {
			b <- byte: i
			if: b = q {
				parts append: (from: start withLength: i - start)
				start <- i + 1
				parts append: "\\\""
			} else: {
				if: b = s {
					parts append: (from: start withLength: i - start)
					start <- i + 1
					parts append: "\\\\"
				}
			}

			i <- i + 1
		}
		if: start < byte_length {
			parts append: (from: start)
		}
		parts append: "\""
		parts join: ""
	}

	isInteger? <- { false }
	isString? <- { true }
	isBasicString? <- { true }
}