# HG changeset patch # User Mike Pavone # Date 1388978889 28800 # Node ID 6aab8a5a2be9552e92e51b0149dd7cde0bb1e864 # Parent 3bfc00e4f5e5d60dbfc995f0e9a98131d09b5fe4 Don't expose internal helper functions in parser module diff -r 3bfc00e4f5e5 -r 6aab8a5a2be9 modules/parser.tp --- a/modules/parser.tp Sun Jan 05 19:27:41 2014 -0800 +++ b/modules/parser.tp Sun Jan 05 19:28:09 2014 -0800 @@ -1,29 +1,262 @@ -#{ - _applyMatch <- :fun tomatch { +{ +_applyMatch <- :fun tomatch { fun: tomatch } - _matchString <- :str tomatch { - if: (tomatch isString?) { - if: (tomatch length) < (str length) { +_matchString <- :str tomatch { + if: (tomatch isString?) { + if: (tomatch length) < (str length) { + #{ + matched? <- { false } + } + } else: { + if: (tomatch length) > (str length) { + tomatch <- tomatch from: 0 withLength: (str length) + } + if: str = tomatch { + #{ + matched? <- { true } + matchlen <- { str length } + basicYield? <- { true } + yield <- { str } + } + } else: { #{ matched? <- { false } } - } else: { - if: (tomatch length) > (str length) { - tomatch <- tomatch from: 0 withLength: (str length) + } + } + } else: { + #{ + matched? <- { false } + } + } +} +_makeMatchCall <- :matchexpr { + if: (matchexpr nodeType) = "lambda" { + #{ + valid? <- { true } + matchcall <- quote: (_applyMatch: matchexpr tomatch) + } + } else: { + if: (matchexpr nodeType) = "symbol" { + #{ + valid? <- { true } + matchcall <- quote: (matchexpr: tomatch) + } + } else: { + if: (matchexpr nodeType) = "strlit" { + #{ + valid? <- { true } + matchcall <- quote: (_matchString: matchexpr tomatch) } - if: str = tomatch { - #{ - matched? <- { true } - matchlen <- { str length } - basicYield? <- { true } - yield <- { str } + } else: { + if: (matchexpr nodeType) = "op" { + if: (matchexpr opName) = "." { + left <- (_makeMatchCall: (matchexpr left)) matchcall + right <- (_makeMatchCall: (matchexpr right)) matchcall + #{ + valid? <- { true } + matchcall <- quote: (_applyMatch: :tomatch { + lm <- left + if: (lm matched?) { + orig <- tomatch + tomatch <- tomatch from: (lm matchlen) + rm <- right + if: (rm matched?) { + total <- (rm matchlen) + (lm matchlen) + #{ + matched? <- { true } + matchlen <- { total } + basicYield? <- { true } + yield <- { orig from: 0 withLength: total } + } + } else: { + rm + } + } else: { + lm + } + } tomatch) + } + } else: { + #{ + valid? <- { false } + message <- "Unsupported operator " . (matchexpr opName) + } } } else: { #{ - matched? <- { false } + valid? <- { false } + message <- "Unsupported AST node type " . (matchexpr nodeType) + } + } + } + } + } +} +_nPlus <- :matchexpr min { + funexpr <- false + valid <- false + mc <- _makeMatchCall: matchexpr + if: (mc valid?) { + mcall <- mc matchcall + quote: :tomatch { + cur <- 0 + count <- 0 + n <- tomatch byte_length + orig <- tomatch + _match <- true + allBasic? <- true + yieldvals <- [] + while: { _match && cur < n } do: { + res <- mcall + _match <- res matched? + if: _match { + count <- count + 1 + //TODO: Use some kind of lightweight substring wrapper here + tomatch <- tomatch from: (res matchlen) + if: allBasic? { + ifnot: (res basicYield?) { + allBasic? <- false + if: cur > 0 { + yieldvals <- (orig from: 0 withLength: cur) | yieldvals + } + yieldvals <- (res yield) | yieldvals + } + } else: { + yieldvals <- (res yield) | yieldvals + } + allBasic? <- allBasic? && (res basicYield?) + cur <- cur + (res matchlen) + } + } + if: count >= min { + if: allBasic? { + #{ + matched? <- { true } + matchlen <- { cur } + basicYield? <- { true } + yield <- { orig from: 0 withLength: cur } + } + } else: { + yieldvals <- yieldvals reverse + #{ + matched? <- { true } + matchlen <- { cur } + basicYield? <- { false } + yield <- { yieldvals } } } + } else: { + #{ + matched? <- { false } + } + } + } + } else: { + print: "#error Invalid nPlus macro call: " . (mc message) . "\n" + } +} +_expandClass <- :chars { + if: (chars length) > 0 { + pos <- 0 + inverted <- false + if: (chars byte: 0) = ("^" byte: 0) { + pos <- 1 + inverted <- true + } + state_begin <- 0 + state_normal <- 1 + state_rangeend <- 2 + state <- state_begin + out <- "" + while: { pos < (chars byte_length)} do: { + if: state = state_begin { + out <- out . (chars from: pos withLength: 1) + state <- state_normal + } else: { + if: state = state_normal { + if: (chars byte: pos) = ("-" byte: 0) { + state <- state_rangeend + } else: { + out <- out . (chars from: pos withLength: 1) + } + } else: { + rangestart <- out byte: ((out byte_length) - 1) + rangeend <- chars byte: pos + if: rangeend < rangestart { + tmp <- rangeend + rangeend <- rangestart + rangestart <- tmp + } + out <- out from: 0 withLength: ((out length) - 1) + while: { rangestart <= rangeend } do: { + out <- out . (rangestart asStringChar) + rangestart <- rangestart + 1 + } + state <- state_begin + } + } + pos <- pos + 1 + } + if: inverted { + old <- out + out <- "" + //skip control characters for now + cur <- 32 + while: { cur < 256 } do: { + notfound <- true + idx <- 0 + len <- (old length) + while: { notfound && idx < len } do: { + if: cur = (old byte: idx) { + notfound <- false + } else: { + idx <- idx + 1 + } + } + if: notfound { + out <- out . (cur asStringChar) + } + cur <- cur + 1 + } + } + out + } else: { + "" + } +} +_charClass <- :chars { + chars <- _expandClass: chars + charmap <- "" + char <- 0 + while: { char < 256 } do: { + mchar <- 0 + found <- false + while: { mchar < (chars byte_length)} do: { + if: (chars byte: mchar) = char { + found <- true + mchar <- chars byte_length + } + mchar <- mchar + 1 + } + charmap <- charmap . (if: found { "t" } else: { "f" }) + char <- char + 1 + } + t <- "t" byte: 0 + quote: :tomatch { + if: (tomatch isString?) { + if: (charmap byte: (tomatch byte: 0)) = t { + #{ + matched? <- { true } + matchlen <- { 1 } + basicYield? <- { true } + yield <- { tomatch from: 0 withLength: 1 } + } + } else: { + #{ + matched? <- { false } + } } } else: { #{ @@ -31,6 +264,8 @@ } } } +} +#{ ifmatch:else <- :matchres :elseblock { if: (matchres matched?) { matchres @@ -38,247 +273,14 @@ elseblock: } } - _makeMatchCall <- :matchexpr { - if: (matchexpr nodeType) = "lambda" { - #{ - valid? <- { true } - matchcall <- quote: (_applyMatch: matchexpr tomatch) - } - } else: { - if: (matchexpr nodeType) = "symbol" { - #{ - valid? <- { true } - matchcall <- quote: (matchexpr: tomatch) - } - } else: { - if: (matchexpr nodeType) = "strlit" { - #{ - valid? <- { true } - matchcall <- quote: (_matchString: matchexpr tomatch) - } - } else: { - if: (matchexpr nodeType) = "op" { - if: (matchexpr opName) = "." { - left <- (_makeMatchCall: (matchexpr left)) matchcall - right <- (_makeMatchCall: (matchexpr right)) matchcall - #{ - valid? <- { true } - matchcall <- quote: (_applyMatch: :tomatch { - lm <- left - if: (lm matched?) { - orig <- tomatch - tomatch <- tomatch from: (lm matchlen) - rm <- right - if: (rm matched?) { - total <- (rm matchlen) + (lm matchlen) - #{ - matched? <- { true } - matchlen <- { total } - basicYield? <- { true } - yield <- { orig from: 0 withLength: total } - } - } else: { - rm - } - } else: { - lm - } - } tomatch) - } - } else: { - #{ - valid? <- { false } - message <- "Unsupported operator " . (matchexpr opName) - } - } - } else: { - #{ - valid? <- { false } - message <- "Unsupported AST node type " . (matchexpr nodeType) - } - } - } - } - } - } - expandClass <- :chars { - if: (chars length) > 0 { - pos <- 0 - inverted <- false - if: (chars byte: 0) = ("^" byte: 0) { - pos <- 1 - inverted <- true - } - state_begin <- 0 - state_normal <- 1 - state_rangeend <- 2 - state <- state_begin - out <- "" - while: { pos < (chars byte_length)} do: { - if: state = state_begin { - out <- out . (chars from: pos withLength: 1) - state <- state_normal - } else: { - if: state = state_normal { - if: (chars byte: pos) = ("-" byte: 0) { - state <- state_rangeend - } else: { - out <- out . (chars from: pos withLength: 1) - } - } else: { - rangestart <- out byte: ((out byte_length) - 1) - rangeend <- chars byte: pos - if: rangeend < rangestart { - tmp <- rangeend - rangeend <- rangestart - rangestart <- tmp - } - out <- out from: 0 withLength: ((out length) - 1) - while: { rangestart <= rangeend } do: { - out <- out . (rangestart asStringChar) - rangestart <- rangestart + 1 - } - state <- state_begin - } - } - pos <- pos + 1 - } - if: inverted { - old <- out - out <- "" - //skip control characters for now - cur <- 32 - while: { cur < 256 } do: { - notfound <- true - idx <- 0 - len <- (old length) - while: { notfound && idx < len } do: { - if: cur = (old byte: idx) { - notfound <- false - } else: { - idx <- idx + 1 - } - } - if: notfound { - out <- out . (cur asStringChar) - } - cur <- cur + 1 - } - } - out - } else: { - "" - } - } charClass <- macro: :rawchars { eval: rawchars :chars { - orig <- chars - chars <- expandClass: chars - charmap <- "" - char <- 0 - while: { char < 256 } do: { - mchar <- 0 - found <- false - while: { mchar < (chars byte_length)} do: { - if: (chars byte: mchar) = char { - found <- true - mchar <- chars byte_length - } - mchar <- mchar + 1 - } - charmap <- charmap . (if: found { "t" } else: { "f" }) - char <- char + 1 - } - t <- "t" byte: 0 - quote: :tomatch { - if: (tomatch isString?) { - if: (charmap byte: (tomatch byte: 0)) = t { - #{ - matched? <- { true } - matchlen <- { 1 } - basicYield? <- { true } - yield <- { tomatch from: 0 withLength: 1 } - } - } else: { - #{ - matched? <- { false } - } - } - } else: { - #{ - matched? <- { false } - } - } - } + _charClass: chars } else: { print: "#error Argument to charClass macro must be a compile-time constant\n" } } - _nPlus <- :matchexpr min { - funexpr <- false - valid <- false - mc <- _makeMatchCall: matchexpr - if: (mc valid?) { - mcall <- mc matchcall - quote: :tomatch { - cur <- 0 - count <- 0 - n <- tomatch byte_length - orig <- tomatch - _match <- true - allBasic? <- true - yieldvals <- [] - while: { _match && cur < n } do: { - res <- mcall - _match <- res matched? - if: _match { - count <- count + 1 - //TODO: Use some kind of lightweight substring wrapper here - tomatch <- tomatch from: (res matchlen) - if: allBasic? { - ifnot: (res basicYield?) { - allBasic? <- false - if: cur > 0 { - yieldvals <- (orig from: 0 withLength: cur) | yieldvals - } - yieldvals <- (res yield) | yieldvals - } - } else: { - yieldvals <- (res yield) | yieldvals - } - allBasic? <- allBasic? && (res basicYield?) - cur <- cur + (res matchlen) - } - } - if: count >= min { - if: allBasic? { - #{ - matched? <- { true } - matchlen <- { cur } - basicYield? <- { true } - yield <- { orig from: 0 withLength: cur } - } - } else: { - yieldvals <- yieldvals reverse - #{ - matched? <- { true } - matchlen <- { cur } - basicYield? <- { false } - yield <- { yieldvals } - } - } - } else: { - #{ - matched? <- { false } - } - } - } - } else: { - print: "#error Invalid nPlus macro call: " . (mc message) . "\n" - } - } - zeroPlus <- macro: :matchexpr { _nPlus: matchexpr 0 } @@ -993,3 +995,4 @@ } } } +}