Mercurial > repos > tabletprog
view modules/string.tp @ 323:eb5f1fca9b78
Fix infinite loop in foldr:with
author | Michael Pavone <pavone@retrodev.com> |
---|---|
date | Mon, 23 Mar 2015 21:18:26 -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 } }