view modules/string.tp @ 377:93c28eee141e tip

Merge
author Michael Pavone <pavone@retrodev.com>
date Sat, 15 Aug 2015 22:45:33 -0700
parents 6871e72b6db2
children
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
	}
	
	llMessage: int64 withVars: {
		int64ret <- (obj_int64 ptr)
	} andCode: {
		int64ret  <- make_object: (addr_of: obj_int64_meta) NULL 0
		int64ret num!: (atoll: data)
		int64ret
	}

	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: parseFloat64 withVars: {
		fret64 <- obj_float64 ptr
	} andCode: {
		//TODO: This should probably detect non-numeric values and return an option type
		fret64 <- make_object: (addr_of: obj_float64_meta) NULL 0
		fret64 num!: (atof: data)
		fret64
	}
	
	parseFloat32 <- {
		parseFloat64 f32
	}

	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 }
}