R.rsp 0.44.0
HenrikBengtsson
| 1 |
###########################################################################/**
|
|
| 2 |
# @RdocClass RspParser
|
|
| 3 |
#
|
|
| 4 |
# @title "The RspParser class"
|
|
| 5 |
#
|
|
| 6 |
# \description{
|
|
| 7 |
# @classhierarchy
|
|
| 8 |
#
|
|
| 9 |
# An RspParser is parser for the RSP language.
|
|
| 10 |
# }
|
|
| 11 |
#
|
|
| 12 |
# @synopsis
|
|
| 13 |
#
|
|
| 14 |
# \arguments{
|
|
| 15 |
# \item{...}{Not used.}
|
|
| 16 |
# }
|
|
| 17 |
#
|
|
| 18 |
# \section{Fields and Methods}{
|
|
| 19 |
# @allmethods
|
|
| 20 |
# }
|
|
| 21 |
#
|
|
| 22 |
# @author
|
|
| 23 |
#
|
|
| 24 |
# @keyword internal
|
|
| 25 |
#*/###########################################################################
|
|
| 26 |
setConstructorS3("RspParser", function(...) { |
|
| 27 | 1 |
extend(NA, "RspParser") |
| 28 |
})
|
|
| 29 |
|
|
| 30 |
|
|
| 31 |
#########################################################################/**
|
|
| 32 |
# @RdocMethod parseRaw
|
|
| 33 |
#
|
|
| 34 |
# @title "Parses the string into blocks of text and RSP"
|
|
| 35 |
#
|
|
| 36 |
# \description{
|
|
| 37 |
# @get "title".
|
|
| 38 |
# }
|
|
| 39 |
#
|
|
| 40 |
# @synopsis
|
|
| 41 |
#
|
|
| 42 |
# \arguments{
|
|
| 43 |
# \item{object}{An @see RspString to be parsed.}
|
|
| 44 |
# \item{what}{A @character string specifying what type of RSP construct
|
|
| 45 |
# to parse for.}
|
|
| 46 |
# \item{commentLength}{Specify the number of hyphens in RSP comments
|
|
| 47 |
# to parse for.}
|
|
| 48 |
# \item{...}{Not used.}
|
|
| 49 |
# \item{verbose}{See @see "R.utils::Verbose".}
|
|
| 50 |
# }
|
|
| 51 |
#
|
|
| 52 |
# \value{
|
|
| 53 |
# Returns a named @list with elements named "text" and "rsp".
|
|
| 54 |
# }
|
|
| 55 |
#
|
|
| 56 |
# @author
|
|
| 57 |
#
|
|
| 58 |
# \seealso{
|
|
| 59 |
# @seeclass
|
|
| 60 |
# }
|
|
| 61 |
#*/#########################################################################
|
|
| 62 |
setMethodS3("parseRaw", "RspParser", function(parser, object, what=c("comment", "directive", "expression"), commentLength=-1L, ..., verbose=FALSE) { |
|
| 63 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 64 |
# Local functions
|
|
| 65 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 66 |
# Escape '<%%' and '%%>'
|
|
| 67 | 1 |
escapeP <- function(s) { |
| 68 | 1 |
s <- gsub(.rspBracketOpenEscape, "---<<<---%%%---%%%---", s, fixed=TRUE) |
| 69 | 1 |
s <- gsub(.rspBracketCloseEscape, "---%%%---%%%--->>>---", s, fixed=TRUE) |
| 70 | 1 |
s |
| 71 | 1 |
} # escapeP() |
| 72 |
|
|
| 73 |
# Unescape '<%%' and '%%>'
|
|
| 74 | 1 |
unescapeP <- function(s) { |
| 75 | 1 |
s <- gsub("---<<<---%%%---%%%---", .rspBracketOpenEscape, s, fixed=TRUE) |
| 76 | 1 |
s <- gsub("---%%%---%%%--->>>---", .rspBracketCloseEscape, s, fixed=TRUE) |
| 77 | 1 |
s |
| 78 | 1 |
} # unescapeP() |
| 79 |
|
|
| 80 |
|
|
| 81 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 82 |
# Validate arguments
|
|
| 83 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 84 |
# Argument 'what':
|
|
| 85 | 1 |
what <- match.arg(what) |
| 86 |
|
|
| 87 |
# Argument 'commentLength':
|
|
| 88 | 1 |
commentLength <- as.integer(commentLength) |
| 89 | 1 |
stop_if_not(is.finite(commentLength)) |
| 90 | 1 |
stop_if_not(commentLength == -1L || commentLength >= 2L) |
| 91 |
|
|
| 92 |
# Argument 'verbose':
|
|
| 93 | 1 |
verbose <- Arguments$getVerbose(verbose) |
| 94 | 1 |
if (verbose) { |
| 95 | 1 |
pushState(verbose) |
| 96 | 1 |
on.exit(popState(verbose)) |
| 97 |
}
|
|
| 98 |
|
|
| 99 |
|
|
| 100 | 1 |
verbose && enter(verbose, "Raw parsing of RSP string") |
| 101 |
|
|
| 102 |
# Work with one large character string
|
|
| 103 | 1 |
bfr <- paste(object, collapse="\n", sep="") |
| 104 | 1 |
verbose && cat(verbose, "Length of RSP string: ", nchar(bfr)) |
| 105 |
|
|
| 106 |
|
|
| 107 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 108 |
# Setup
|
|
| 109 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 110 |
# Pattern for suffix specification
|
|
| 111 |
## patternS <- "(([+]))|([-]+\\[([^]]*)\\])?%>"
|
|
| 112 | 1 |
patternS <- "([+]|[-]+(\\[[^]]*\\])?)%>" |
| 113 |
|
|
| 114 |
# Setup the regular expressions for start and stop RSP constructs
|
|
| 115 | 1 |
hasPatternLTail <- FALSE |
| 116 | 1 |
if (what == "comment") { |
| 117 | 1 |
if (commentLength == -1L) { |
| 118 |
# <%-%>, <%--%>, <%---%>, <%----%>, ...
|
|
| 119 |
# <%-[suffix]%>, <%--[suffix]%>, <%---[suffix]%>, ...
|
|
| 120 | 1 |
patternL <- sprintf("(%s([-]+(\\[[^]]*\\])?%s))", .rspBracketOpen, .rspBracketClose) |
| 121 | 1 |
patternR <- NULL |
| 122 |
} else { |
|
| 123 |
# <%-- --%>, <%--\n--%>, <%-- text --%>, ...
|
|
| 124 |
# <%--- ---%>, <%--- text ---%>, ...
|
|
| 125 | 1 |
patternL <- sprintf("(%s-{%d})([^-])", .rspBracketOpen, commentLength) |
| 126 | 1 |
hasPatternLTail <- TRUE |
| 127 | 1 |
patternR <- sprintf("(|[^-])(-{%d}(\\[[^]]*\\])?)%s", commentLength, .rspBracketClose) |
| 128 |
}
|
|
| 129 | 1 |
bodyClass <- RspComment
|
| 130 | 1 |
} else if (what == "directive") { |
| 131 | 1 |
patternL <- sprintf("(%s@)()", .rspBracketOpen) |
| 132 | 1 |
patternR <- sprintf("()(|[+]|-(\\[[^]]*\\])?)%s", .rspBracketClose) |
| 133 | 1 |
bodyClass <- RspUnparsedDirective
|
| 134 | 1 |
} else if (what == "expression") { |
| 135 | 1 |
patternL <- sprintf("(%s)()", .rspBracketOpen) |
| 136 | 1 |
patternR <- sprintf("()(|[+]|-(\\[[^]]*\\])?)%s", .rspBracketClose) |
| 137 | 1 |
bodyClass <- RspUnparsedExpression
|
| 138 |
}
|
|
| 139 |
|
|
| 140 | 1 |
if (verbose) { |
| 141 | 1 |
cat(verbose, "Regular expression patterns to use:") |
| 142 | 1 |
str(verbose, list(patternL=patternL, patternR=patternR, patternS=patternS)) |
| 143 | 1 |
cat(verbose, "Class to coerce to: ", class(bodyClass())[1L]) |
| 144 |
}
|
|
| 145 |
|
|
| 146 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 147 |
# Parse
|
|
| 148 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 149 | 1 |
verbose && cat(verbose, "What to parse for: ", what) |
| 150 |
|
|
| 151 |
# Hide '<%%' and '%%>' from parser
|
|
| 152 | 1 |
n <- nchar(bfr) |
| 153 | 1 |
bfr <- escapeP(bfr) |
| 154 | 1 |
escapedP <- (nchar(bfr) != n) |
| 155 |
|
|
| 156 |
# Constants
|
|
| 157 | 1 |
START <- 0L |
| 158 | 1 |
STOP <- 1L |
| 159 |
|
|
| 160 | 1 |
parts <- list() |
| 161 | 1 |
state <- START
|
| 162 | 1 |
while(TRUE) { |
| 163 | 1 |
if (state == START) { |
| 164 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 165 |
# (a) Scan for RSP start tag, i.e. <%, <%@, or <%--
|
|
| 166 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 167 |
# The start tag may exists *anywhere* in static code
|
|
| 168 | 1 |
posL <- regexpr(patternL, bfr) |
| 169 | 1 |
if (posL == -1L) |
| 170 | 1 |
break
|
| 171 | 1 |
nL <- attr(posL, "match.length") |
| 172 | 1 |
stop_if_not(is.integer(nL)) |
| 173 |
|
|
| 174 |
# (i) Extract RSP construct, '<%...%>[extra]'
|
|
| 175 | 1 |
tag <- substring(bfr, first=posL, last=posL+nL-1L) |
| 176 |
|
|
| 177 |
# Was it an escaped RSP start tag, i.e. '<%%'?
|
|
| 178 | 1 |
if (what == "expression") { |
| 179 | 1 |
tagX <- substring(bfr, first=posL, last=posL+nL) |
| 180 | 1 |
if (tagX == .rspBracketOpenEscape) |
| 181 |
break
|
|
| 182 |
}
|
|
| 183 |
|
|
| 184 |
# If parsed too far, i.e. into the tailing text
|
|
| 185 |
# (so that '[extra]' is non-empty), then adjust
|
|
| 186 | 1 |
bfrExtra <- gsub(patternL, "\\4", tag) |
| 187 | 1 |
nExtra <- nchar(bfrExtra) |
| 188 | 1 |
nL <- nL - nExtra |
| 189 |
|
|
| 190 |
# (ii) Extract the preceeding text
|
|
| 191 | 1 |
text <- substring(bfr, first=1L, last=posL-1L) |
| 192 |
|
|
| 193 |
# Record as RSP text, unless empty.
|
|
| 194 | 1 |
if (nchar(text) > 0L) { |
| 195 |
# Update flag whether the RSP construct being parsed is
|
|
| 196 |
# on the same output line as RSP text or not. It is not
|
|
| 197 |
# if the text ends with a line break.
|
|
| 198 | 1 |
if (escapedP) text <- unescapeP(text) |
| 199 | 1 |
part <- list(text=RspText(text)) |
| 200 |
} else { |
|
| 201 | 1 |
part <- NULL |
| 202 |
}
|
|
| 203 |
|
|
| 204 |
|
|
| 205 |
# (iii) Special case: Locate RSP end tag immediately.
|
|
| 206 | 1 |
if (is.null(patternR)) { |
| 207 | 1 |
body <- "" |
| 208 |
|
|
| 209 |
# Extract the '<%...%>' part
|
|
| 210 | 1 |
if (nExtra > 0L) { |
| 211 |
tail <- substring(tag, first=1L, last=nL-1L) |
|
| 212 |
} else { |
|
| 213 | 1 |
tail <- tag
|
| 214 |
}
|
|
| 215 |
|
|
| 216 |
# Extract the '...%>' part
|
|
| 217 |
# Currently only used for "empty" comments, e.g. <%---%>
|
|
| 218 | 1 |
tail <- gsub(patternL, "\\2", tail) |
| 219 |
|
|
| 220 |
# Get optional suffix specifications, i.e. '+%>' or '-[{specs}]%>'
|
|
| 221 | 1 |
if (regexpr(patternS, tail) != -1L) { |
| 222 | 1 |
suffixSpecs <- gsub(patternS, "\\1", tail) |
| 223 | 1 |
suffixSpecs <- gsub("--*", "-", suffixSpecs) |
| 224 | 1 |
verbose && printf(verbose, "Identified suffix specification: '%s'\n", suffixSpecs) |
| 225 | 1 |
attr(body, "suffixSpecs") <- suffixSpecs |
| 226 |
} else { |
|
| 227 |
verbose && cat(verbose, "Identified suffix specification: <none>") |
|
| 228 |
}
|
|
| 229 |
|
|
| 230 | 1 |
if (what == "comment") { |
| 231 | 1 |
attr(body, "commentLength") <- commentLength |
| 232 |
}
|
|
| 233 |
|
|
| 234 | 1 |
if (!is.null(bodyClass)) { |
| 235 | 1 |
body <- bodyClass(body) |
| 236 |
}
|
|
| 237 |
|
|
| 238 | 1 |
part2 <- list(rsp=body) |
| 239 | 1 |
if (what != "expression") { |
| 240 | 1 |
names(part2)[1L] <- what |
| 241 |
}
|
|
| 242 | 1 |
part <- c(part, part2) |
| 243 | 1 |
state <- START
|
| 244 |
} else { |
|
| 245 |
# Push-back something to buffer?
|
|
| 246 | 1 |
if (hasPatternLTail && nchar(gsub(patternL, "\\2", tag)) > 0L) { |
| 247 | 1 |
nL <- nL - 1L |
| 248 |
}
|
|
| 249 | 1 |
state <- STOP
|
| 250 | 1 |
} # if (is.null(patternR)) |
| 251 |
|
|
| 252 |
# (iv) Finally, consume the read buffer
|
|
| 253 | 1 |
bfr <- substring(bfr, first=posL+nL) |
| 254 | 1 |
} else if (state == STOP) { |
| 255 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 256 |
# (b) Scan for RSP end tag, i.e. %>, %>, or --%>
|
|
| 257 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 258 |
# Not found?
|
|
| 259 | 1 |
posR <- indexOfNonQuoted(bfr, patternR) |
| 260 | 1 |
if (posR == -1L) |
| 261 |
break
|
|
| 262 |
|
|
| 263 |
# (i) Extract RSP body with RSP end tag, '[extra][pattern]%>'
|
|
| 264 | 1 |
nR <- attr(posR, "match.length") |
| 265 | 1 |
tail <- substring(bfr, first=posR, last=posR+nR-1L) |
| 266 |
|
|
| 267 |
# Was it an escaped RSP end tag, i.e. '%%>'?
|
|
| 268 | 1 |
if (what == "expression") { |
| 269 | 1 |
nT <- nchar(tail) |
| 270 | 1 |
if (nT >= 3L && substring(tail, first=nT-2L, last=nT) == "%%>") |
| 271 |
break
|
|
| 272 |
}
|
|
| 273 |
|
|
| 274 |
# If parsed too far, i.e. into the preceeding body
|
|
| 275 |
# (so that '[extra]' is non-empty), then adjust
|
|
| 276 | 1 |
bodyExtra <- gsub(patternR, "\\1", tail) |
| 277 | 1 |
nExtra <- nchar(bodyExtra) |
| 278 | 1 |
posR <- posR + nExtra |
| 279 | 1 |
nR <- nR - nExtra |
| 280 |
|
|
| 281 |
# Extract body of RSP construct (without RSP end tag)
|
|
| 282 | 1 |
body <- substring(bfr, first=1L, last=posR-1L) |
| 283 | 1 |
if (escapedP) body <- unescapeP(body) |
| 284 |
|
|
| 285 |
# Get optional suffix specifications, i.e. '+%>' or '-[{specs}]%>'
|
|
| 286 | 1 |
if (regexpr(patternS, tail) == 1L) { |
| 287 | 1 |
suffixSpecs <- gsub(patternS, "\\1", tail) |
| 288 | 1 |
verbose && printf(verbose, "Identified suffix specification: '%s'\n", suffixSpecs) |
| 289 | 1 |
attr(body, "suffixSpecs") <- suffixSpecs |
| 290 |
} else { |
|
| 291 | 1 |
verbose && cat(verbose, "Identified suffix specification: <none>") |
| 292 |
}
|
|
| 293 |
|
|
| 294 | 1 |
if (what == "comment") { |
| 295 | 1 |
attr(body, "commentLength") <- commentLength |
| 296 |
}
|
|
| 297 |
|
|
| 298 | 1 |
if (!is.null(bodyClass)) { |
| 299 | 1 |
body <- bodyClass(body) |
| 300 |
}
|
|
| 301 |
|
|
| 302 | 1 |
part <- list(rsp=body) |
| 303 | 1 |
if (what != "expression") { |
| 304 | 1 |
names(part)[1L] <- what |
| 305 |
}
|
|
| 306 |
|
|
| 307 |
# (iv) Finally, consume the read buffer
|
|
| 308 | 1 |
bfr <- substring(bfr, first=posR+nR) |
| 309 |
|
|
| 310 | 1 |
state <- START
|
| 311 | 1 |
} # if (state == ...) |
| 312 |
|
|
| 313 | 1 |
parts <- c(parts, part) |
| 314 |
|
|
| 315 | 1 |
if (verbose) { |
| 316 | 1 |
cat(verbose, "RSP construct(s) parsed:") |
| 317 | 1 |
print(verbose, part) |
| 318 | 1 |
cat(verbose, "Number of RSP constructs parsed this far: ", length(parts)) |
| 319 |
}
|
|
| 320 | 1 |
} # while(TRUE) |
| 321 |
|
|
| 322 |
|
|
| 323 |
# Add the rest of the buffer as text, unless empty.
|
|
| 324 | 1 |
if (nchar(bfr) > 0L) { |
| 325 | 1 |
text <- bfr
|
| 326 | 1 |
if (escapedP) text <- unescapeP(text) |
| 327 | 1 |
text <- RspText(text) |
| 328 | 1 |
parts <- c(parts, list(text=text)) |
| 329 |
}
|
|
| 330 | 1 |
verbose && cat(verbose, "Total number of RSP constructs parsed: ", length(parts)) |
| 331 |
|
|
| 332 |
# Setup results
|
|
| 333 | 1 |
doc <- RspDocument(parts, attrs=getAttributes(object)) |
| 334 | 1 |
attr(doc, "what") <- what |
| 335 |
|
|
| 336 | 1 |
verbose && exit(verbose) |
| 337 |
|
|
| 338 | 1 |
doc |
| 339 |
}, protected=TRUE) # parseRaw() |
|
| 340 |
|
|
| 341 |
|
|
| 342 |
|
|
| 343 |
#########################################################################/**
|
|
| 344 |
# @RdocMethod parseDocument
|
|
| 345 |
#
|
|
| 346 |
# @title "Parse an RSP string into and RSP document"
|
|
| 347 |
#
|
|
| 348 |
# \description{
|
|
| 349 |
# @get "title" with RSP comments dropped.
|
|
| 350 |
# }
|
|
| 351 |
#
|
|
| 352 |
# @synopsis
|
|
| 353 |
#
|
|
| 354 |
# \arguments{
|
|
| 355 |
# \item{object}{An @see RspString to be parsed.}
|
|
| 356 |
# \item{envir}{The @environment where the RSP document is preprocessed.}
|
|
| 357 |
# \item{...}{Passed to the processor in each step.}
|
|
| 358 |
# \item{until}{Specifies how far the parse should proceed, which is useful
|
|
| 359 |
# for troubleshooting and debugging.}
|
|
| 360 |
# \item{as}{Specifies in what format the parsed RSP document
|
|
| 361 |
# should be returned.}
|
|
| 362 |
# \item{verbose}{See @see "R.utils::Verbose".}
|
|
| 363 |
# }
|
|
| 364 |
#
|
|
| 365 |
# \value{
|
|
| 366 |
# Returns a @see "RspDocument" (when \code{as = "RspDocument"}; default)
|
|
| 367 |
# or @see "RspString" (when \code{as = "RspString"}).
|
|
| 368 |
# }
|
|
| 369 |
#
|
|
| 370 |
# @author
|
|
| 371 |
#
|
|
| 372 |
# \seealso{
|
|
| 373 |
# @seeclass
|
|
| 374 |
# }
|
|
| 375 |
#*/#########################################################################
|
|
| 376 |
setMethodS3("parseDocument", "RspParser", function(parser, object, envir=parent.frame(), ..., until=c("*", "end", "expressions", "directives", "comments"), as=c("RspDocument", "RspString"), verbose=FALSE) { |
|
| 377 |
## WORKAROUND: For unknown reasons, the R.oo package needs to be
|
|
| 378 |
## attached in order for 'R CMD build' to build the R.rsp package.
|
|
| 379 |
## If not, the generated RSP-to-R script becomes corrupt and contains
|
|
| 380 |
## invalid symbols, at least for '<%= ... %>' RSP constructs.
|
|
| 381 |
## Below use("R.oo", quietly=TRUE) is used to attach 'R.oo',
|
|
| 382 |
## but we do it as late as possible, in order narrow down the cause.
|
|
| 383 |
## It appears to be related to garbage collection and finalizers of
|
|
| 384 |
## Object, which will try to attach 'R.oo' temporarily before running
|
|
| 385 |
## finalize() on the object. If so, it's a bug in R.oo.
|
|
| 386 |
## /HB 2013-09-17
|
|
| 387 | 1 |
use("R.oo", quietly=TRUE) |
| 388 |
|
|
| 389 |
|
|
| 390 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 391 |
# Local functions
|
|
| 392 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 393 | 1 |
metadata <- getMetadata(object, local=TRUE) |
| 394 |
|
|
| 395 | 1 |
returnAs <- function(doc, as=c("RspDocument", "RspString")) { |
| 396 | 1 |
as <- match.arg(as) |
| 397 |
|
|
| 398 |
# Make sure to always output something
|
|
| 399 | 1 |
if (length(doc) == 0L) { |
| 400 | 1 |
expr <- RspText("") |
| 401 | 1 |
doc[[1]] <- expr |
| 402 |
}
|
|
| 403 |
|
|
| 404 | 1 |
if (length(metadata) > 0L) doc <- setMetadata(doc, metadata) |
| 405 |
|
|
| 406 | 1 |
if (as == "RspDocument") { |
| 407 | 1 |
return(doc) |
| 408 | 1 |
} else if (as == "RspString") { |
| 409 | 1 |
object <- asRspString(doc) |
| 410 | 1 |
return(object) |
| 411 |
}
|
|
| 412 | 1 |
} # returnAs() |
| 413 |
|
|
| 414 |
|
|
| 415 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 416 |
# Validate arguments
|
|
| 417 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 418 |
# Argument 'until':
|
|
| 419 | 1 |
until <- match.arg(until) |
| 420 |
|
|
| 421 |
# Argument 'as':
|
|
| 422 | 1 |
as <- match.arg(as) |
| 423 |
|
|
| 424 |
# Argument 'verbose':
|
|
| 425 | 1 |
verbose <- Arguments$getVerbose(verbose) |
| 426 | 1 |
if (verbose) { |
| 427 | 1 |
pushState(verbose) |
| 428 | 1 |
on.exit(popState(verbose)) |
| 429 |
}
|
|
| 430 |
|
|
| 431 |
|
|
| 432 | 1 |
verbose && enter(verbose, "Parsing RSP string") |
| 433 | 1 |
verbose && cat(verbose, "Compile until: ", sQuote(until)) |
| 434 | 1 |
verbose && cat(verbose, "Return as: ", sQuote(as)) |
| 435 |
|
|
| 436 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 437 |
# (1a) Parse and drop "empty" RSP comments
|
|
| 438 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 439 | 1 |
verbose && enter(verbose, "Dropping 'empty' RSP comments") |
| 440 | 1 |
verbose && cat(verbose, "Length of RSP string before: ", nchar(object)) |
| 441 |
|
|
| 442 |
# This is only for comments such as <%-%>, <%--%>, <%---%>, ...
|
|
| 443 | 1 |
doc <- parseRaw(parser, object, what="comment", commentLength=-1L, verbose=less(verbose, 50)) |
| 444 |
|
|
| 445 |
# Nothing todo?
|
|
| 446 | 1 |
if (length(doc) == 0L) { |
| 447 |
return(returnAs(doc, as=as)) |
|
| 448 |
}
|
|
| 449 |
|
|
| 450 | 1 |
idxs <- which(sapply(doc, FUN=inherits, "RspComment")) |
| 451 | 1 |
count <- length(idxs) |
| 452 |
|
|
| 453 |
# Empty comments found?
|
|
| 454 | 1 |
if (count > 0L) { |
| 455 | 1 |
verbose && print(verbose, doc) |
| 456 |
|
|
| 457 |
# Preprocess, drop RspComments and adjust for empty lines
|
|
| 458 | 1 |
doc <- preprocess(doc, verbose=less(verbose, 10)) |
| 459 | 1 |
verbose && print(verbose, doc) |
| 460 |
|
|
| 461 | 1 |
verbose && cat(verbose, "Number of 'empty' RSP comments dropped: ", count) |
| 462 |
|
|
| 463 |
# Coerce to RspString
|
|
| 464 | 1 |
object <- asRspString(doc) |
| 465 | 1 |
verbose && cat(verbose, "Length of RSP string after: ", nchar(object)) |
| 466 |
} else { |
|
| 467 | 1 |
verbose && cat(verbose, "No 'empty' RSP comments found.") |
| 468 |
}
|
|
| 469 |
|
|
| 470 | 1 |
verbose && exit(verbose) |
| 471 |
|
|
| 472 | 1 |
if (until == "comments") { |
| 473 | 1 |
verbose && exit(verbose) |
| 474 | 1 |
return(returnAs(doc, as=as)) |
| 475 |
}
|
|
| 476 |
|
|
| 477 |
|
|
| 478 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 479 |
# (1b) Parse and drop RSP comments
|
|
| 480 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 481 | 1 |
verbose && enter(verbose, "Dropping 'paired' RSP comments") |
| 482 | 1 |
verbose && cat(verbose, "Length of RSP string before: ", nchar(object)) |
| 483 |
|
|
| 484 |
# Nothing todo?
|
|
| 485 | 1 |
if (length(doc) == 0L) { |
| 486 |
return(returnAs(doc, as=as)) |
|
| 487 |
}
|
|
| 488 |
|
|
| 489 | 1 |
count <- 0L |
| 490 | 1 |
posL <- -1L |
| 491 | 1 |
while ((pos <- regexpr(sprintf("%s[-]+", .rspBracketOpen), object)) != -1L) { |
| 492 |
# Nothing changed? (e.g. if there is an unclosed comment)
|
|
| 493 | 1 |
if (identical(pos, posL)) { |
| 494 |
break
|
|
| 495 |
}
|
|
| 496 |
|
|
| 497 |
# Identify the comment length of the first comment found
|
|
| 498 | 1 |
n <- attr(pos, "match.length") - 2L |
| 499 | 1 |
if (n < 2L) { |
| 500 |
tag <- substring(object, first=pos) |
|
| 501 |
start <- substring(tag, first=1L, n+2L) |
|
| 502 |
throw(RspParseException(sprintf("Detected an RSP comment start tag (%s) but no matching end tag: %s", sQuote(start), sQuote(tag)))) |
|
| 503 |
}
|
|
| 504 |
|
|
| 505 | 1 |
verbose && printf(verbose, "Number of hypens of first comment found: %d\n", n) |
| 506 |
|
|
| 507 |
# Find all comments of this same length
|
|
| 508 | 1 |
doc <- parseRaw(parser, object, what="comment", commentLength=n, verbose=less(verbose, 50)) |
| 509 |
|
|
| 510 | 1 |
idxs <- which(sapply(doc, FUN=inherits, "RspComment")) |
| 511 | 1 |
count <- count + length(idxs) |
| 512 |
|
|
| 513 |
# Trim non-text RSP constructs
|
|
| 514 | 1 |
doc <- trimNonText(doc, verbose=less(verbose, 10)) |
| 515 |
|
|
| 516 |
# Preprocess (=drop RspComments and adjust for empty lines)
|
|
| 517 | 1 |
doc <- preprocess(doc, verbose=less(verbose, 10)) |
| 518 |
|
|
| 519 |
# Coerce to RspString
|
|
| 520 | 1 |
object <- asRspString(doc) |
| 521 |
|
|
| 522 | 1 |
posL <- pos
|
| 523 |
}
|
|
| 524 |
|
|
| 525 | 1 |
if (count > 0L) { |
| 526 | 1 |
verbose && cat(verbose, "Number of 'paired' RSP comments dropped: ", count) |
| 527 | 1 |
verbose && cat(verbose, "Length of RSP string after: ", nchar(object)) |
| 528 |
} else { |
|
| 529 | 1 |
verbose && cat(verbose, "No 'paired' RSP comments found.") |
| 530 |
}
|
|
| 531 |
|
|
| 532 | 1 |
verbose && exit(verbose) |
| 533 |
|
|
| 534 |
|
|
| 535 | 1 |
if (until == "directives") { |
| 536 | 1 |
verbose && exit(verbose) |
| 537 | 1 |
docP <- parseRaw(parser, object, what="directive", verbose=less(verbose, 50)) |
| 538 | 1 |
return(returnAs(docP, as=as)) |
| 539 |
}
|
|
| 540 |
|
|
| 541 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 542 |
# (2a) Parse RSP preprocessing directive
|
|
| 543 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 544 | 1 |
verbose && enter(verbose, "Processing RSP preprocessing directives") |
| 545 | 1 |
verbose && cat(verbose, "Length of RSP string before: ", nchar(object)) |
| 546 |
|
|
| 547 | 1 |
doc <- parseRaw(parser, object, what="directive", verbose=less(verbose, 50)) |
| 548 |
|
|
| 549 |
# Nothing todo?
|
|
| 550 | 1 |
if (length(doc) == 0L) { |
| 551 | 1 |
return(returnAs(doc, as=as)) |
| 552 |
}
|
|
| 553 |
|
|
| 554 | 1 |
idxs <- which(sapply(doc, FUN=inherits, "RspUnparsedDirective")) |
| 555 | 1 |
if (length(idxs) > 0L) { |
| 556 | 1 |
verbose && cat(verbose, "Number of (unparsed) RSP preprocessing directives found: ", length(idxs)) |
| 557 |
|
|
| 558 |
# Parse each of them
|
|
| 559 | 1 |
for (idx in idxs) { |
| 560 | 1 |
doc[[idx]] <- parseDirective(doc[[idx]]) |
| 561 |
}
|
|
| 562 |
|
|
| 563 |
# Trim non-text RSP constructs
|
|
| 564 | 1 |
doc <- trimNonText(doc, verbose=less(verbose, 10)) |
| 565 |
|
|
| 566 |
# Process all RSP preprocessing directives, i.e. <%@...%>
|
|
| 567 | 1 |
doc <- preprocess(doc, envir=envir, ..., verbose=less(verbose, 10)) |
| 568 |
|
|
| 569 |
# Coerce to RspString
|
|
| 570 | 1 |
object <- asRspString(doc) |
| 571 | 1 |
verbose && cat(verbose, "Length of RSP string after: ", nchar(object)) |
| 572 |
} else { |
|
| 573 | 1 |
verbose && cat(verbose, "No RSP preprocessing directives found.") |
| 574 |
}
|
|
| 575 | 1 |
idxs <- NULL; # Not needed anymore |
| 576 |
|
|
| 577 | 1 |
verbose && exit(verbose) |
| 578 |
|
|
| 579 | 1 |
if (until == "expressions") { |
| 580 | 1 |
verbose && exit(verbose) |
| 581 | 1 |
return(returnAs(doc, as=as)) |
| 582 |
}
|
|
| 583 |
|
|
| 584 |
|
|
| 585 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 586 |
# (3) Parse RSP expressions
|
|
| 587 |
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
| 588 | 1 |
verbose && enter(verbose, "Processing RSP expressions") |
| 589 | 1 |
verbose && cat(verbose, "Length of RSP string before: ", nchar(object)) |
| 590 |
|
|
| 591 | 1 |
doc <- parseRaw(parser, object, what="expression", verbose=less(verbose, 50)) |
| 592 |
|
|
| 593 |
# Nothing todo?
|
|
| 594 | 1 |
if (length(doc) == 0L) { |
| 595 |
return(returnAs(doc, as=as)) |
|
| 596 |
}
|
|
| 597 |
|
|
| 598 | 1 |
idxs <- which(sapply(doc, FUN=inherits, "RspUnparsedExpression")) |
| 599 |
|
|
| 600 | 1 |
if (length(idxs) > 0L) { |
| 601 | 1 |
verbose && cat(verbose, "Number of (unparsed) RSP expressions found: ", length(idxs)) |
| 602 |
|
|
| 603 |
# Parse them
|
|
| 604 | 1 |
for (idx in idxs) { |
| 605 | 1 |
doc[[idx]] <- parseExpression(doc[[idx]]) |
| 606 |
}
|
|
| 607 |
|
|
| 608 |
# Trim non-text RSP constructs
|
|
| 609 | 1 |
doc <- trimNonText(doc, verbose=less(verbose, 10)) |
| 610 |
|
|
| 611 |
# Preprocess (=trim all empty lines)
|
|
| 612 | 1 |
doc <- preprocess(doc, envir=envir, ..., verbose=less(verbose, 10)) |
| 613 |
|
|
| 614 | 1 |
if (verbose && isVisible(verbose)) { |
| 615 | 1 |
object <- asRspString(doc) |
| 616 | 1 |
verbose && cat(verbose, "Length of RSP string after: ", nchar(object)) |
| 617 |
}
|
|
| 618 |
} else { |
|
| 619 | 1 |
verbose && cat(verbose, "No RSP expressions found.") |
| 620 |
}
|
|
| 621 |
|
|
| 622 | 1 |
verbose && exit(verbose) |
| 623 |
|
|
| 624 | 1 |
if (until == "end") { |
| 625 | 1 |
verbose && exit(verbose) |
| 626 | 1 |
return(returnAs(doc, as=as)) |
| 627 |
}
|
|
| 628 |
|
|
| 629 | 1 |
verbose && exit(verbose) |
| 630 |
|
|
| 631 | 1 |
returnAs(doc, as=as) |
| 632 |
}, protected=TRUE) |
Read our documentation on viewing source code .