1escape <- paste0("([0-9a-f]{1,6})(\r\n|[ \n\r\t\f])?", "|[^\n\r\f0-9a-f]") 2nonascii <- "[^\1-\177]" 3hash_re <- "([_a-z0-9-]|([0-9a-f]{1,6})(\r\n|[ \n\r\t\f])?|[^\1-\177])" 4 5TokenMacros <- list(unicode_escape = "\\([0-9a-f]{1,6})(?:\r\n|[ \n\r\t\f])?", 6 escape = escape, 7 string_escape = paste0("\\(?:\n|\r\n|\r|\f)|", escape), 8 nonascii = nonascii, 9 nmchar = paste0("([_a-z0-9-]|", escape, "|", nonascii, ")"), 10 nmstart = paste0("[_a-z]|", escape, "|", nonascii)) 11 12Selector <- R6Class("Selector", 13 public = list( 14 parsed_tree = NULL, 15 pseudo_element = NULL, 16 initialize = function(tree, pseudo_element = NULL) { 17 self$parsed_tree <- tree 18 if (!is.null(pseudo_element)) 19 self$pseudo_element <- tolower(pseudo_element) 20 }, 21 repr = function() { 22 pseudo_el <- 23 if (is.null(self$pseudo_element)) "" 24 else paste0("::", self$pseudo_element) 25 paste0(self$parsed_tree$repr(), pseudo_el) 26 }, 27 specificity = function() { 28 specs <- self$parsed_tree$specificity() 29 if (!is.null(self$pseudo_element)) 30 specs[3] <- specs[3] + 1 31 specs 32 }, 33 show = function() { # nocov start 34 cat(self$repr(), "\n") 35 } # nocov end 36 ) 37) 38 39ClassSelector <- R6Class("ClassSelector", 40 public = list( 41 selector = NULL, 42 class_name = NULL, 43 initialize = function(selector, class_name) { 44 self$selector <- selector 45 self$class_name <- class_name 46 }, 47 repr = function() { 48 paste0( 49 first_class_name(self), 50 "[", 51 self$selector$repr(), 52 ".", 53 self$class_name, 54 "]") 55 }, 56 specificity = function() { 57 specs <- self$selector$specificity() 58 specs[2] <- specs[2] + 1 59 specs 60 }, 61 show = function() { # nocov start 62 cat(self$repr(), "\n") 63 } # nocov end 64 ) 65) 66 67Function <- R6Class("Function", 68 public = list( 69 selector = NULL, 70 name = NULL, 71 arguments = NULL, 72 initialize = function(selector, name, arguments) { 73 self$selector <- selector 74 self$name <- tolower(name) 75 self$arguments <- arguments 76 }, 77 repr = function() { 78 token_values <- lapply(self$arguments, 79 function(token) paste0("'", token$value, "'")) 80 token_values <- paste0(unlist(token_values), collapse = ", ") 81 token_values <- paste0("[", token_values, "]") 82 paste0( 83 first_class_name(self), 84 "[", 85 self$selector$repr(), 86 ":", 87 self$name, 88 "(", 89 token_values, 90 ")]") 91 }, 92 argument_types = function() { 93 token_types <- lapply(self$arguments, function(token) token$type) 94 unlist(token_types) 95 }, 96 specificity = function() { 97 specs <- self$selector$specificity() 98 specs[2] <- specs[2] + 1 99 specs 100 }, 101 show = function() { # nocov start 102 cat(self$repr(), "\n") 103 } # nocov end 104 ) 105) 106 107Pseudo <- R6Class("Pseudo", 108 public = list( 109 selector = NULL, 110 ident = NULL, 111 initialize = function(selector, ident) { 112 self$selector <- selector 113 self$ident <- tolower(ident) 114 }, 115 repr = function() { 116 paste0( 117 first_class_name(self), 118 "[", 119 self$selector$repr(), 120 ":", 121 self$ident, 122 "]") 123 }, 124 specificity = function() { 125 specs <- self$selector$specificity() 126 specs[2] <- specs[2] + 1 127 specs 128 }, 129 show = function() { # nocov start 130 cat(self$repr(), "\n") 131 } # nocov end 132 ) 133) 134 135Negation <- R6Class("Negation", 136 public = list( 137 selector = NULL, 138 subselector = NULL, 139 initialize = function(selector, subselector) { 140 self$selector <- selector 141 self$subselector <- subselector 142 }, 143 repr = function() { 144 paste0( 145 first_class_name(self), 146 "[", 147 self$selector$repr(), 148 ":not(", 149 self$subselector$repr(), 150 ")]") 151 }, 152 specificity = function() { 153 specs <- self$selector$specificity() 154 sub_specs <- self$subselector$specificity() 155 specs + sub_specs 156 }, 157 show = function() { # nocov start 158 cat(self$repr(), "\n") 159 } # nocov end 160 ) 161) 162 163Attrib <- R6Class("Attrib", 164 public = list( 165 selector = NULL, 166 namespace = NULL, 167 attrib = NULL, 168 operator = NULL, 169 value = NULL, 170 initialize = function(selector, namespace, attrib, operator, value) { 171 self$selector <- selector 172 self$namespace <- namespace 173 self$attrib <- attrib 174 self$operator <- operator 175 self$value <- value 176 }, 177 repr = function() { 178 attr <- 179 if (!is.null(self$namespace)) 180 paste0(self$namespace, "|", self$attrib) 181 else 182 self$attrib 183 if (self$operator == "exists") 184 paste0( 185 first_class_name(self), 186 "[", 187 self$selector$repr(), 188 "[", 189 attr, 190 "]]") 191 else 192 paste0( 193 first_class_name(self), 194 "[", 195 self$selector$repr(), 196 "[", 197 attr, 198 " ", 199 self$operator, 200 " '", 201 self$value, 202 "']]") 203 }, 204 specificity = function() { 205 specs <- self$selector$specificity() 206 specs[2] <- specs[2] + 1 207 specs 208 }, 209 show = function() { # nocov start 210 cat(self$repr(), "\n") 211 } # nocov end 212 ) 213) 214 215Element <- R6Class("Element", 216 public = list( 217 namespace = NULL, 218 element = NULL, 219 initialize = function(namespace = NULL, element = NULL) { 220 self$namespace <- namespace 221 self$element <- element 222 }, 223 repr = function() { 224 el <- 225 if (!is.null(self$element)) self$element 226 else "*" 227 if (!is.null(self$namespace)) 228 el <- paste0(self$namespace, "|", el) 229 paste0(first_class_name(self), "[", el, "]") 230 }, 231 specificity = function() { 232 if (!is.null(self$element)) c(0, 0, 1) 233 else rep(0, 3) 234 }, 235 show = function() { # nocov start 236 cat(self$repr(), "\n") 237 } # nocov end 238 ) 239) 240 241Hash <- R6Class("Hash", 242 public = list( 243 selector = NULL, 244 id = NULL, 245 initialize = function(selector, id) { 246 self$selector <- selector 247 self$id <- id 248 }, 249 repr = function() { 250 paste0( 251 first_class_name(self), 252 "[", 253 self$selector$repr(), 254 "#", 255 self$id, 256 "]") 257 }, 258 specificity = function() { 259 specs <- self$selector$specificity() 260 specs[1] <- specs[1] + 1 261 specs 262 }, 263 show = function() { # nocov start 264 cat(self$repr(), "\n") 265 } # nocov end 266 ) 267) 268 269CombinedSelector <- R6Class("CombinedSelector", 270 public = list( 271 selector = NULL, 272 combinator = NULL, 273 subselector = NULL, 274 initialize = function(selector, combinator, subselector) { 275 if (is.null(selector)) 276 stop("'selector' cannot be NULL") 277 self$selector <- selector 278 self$combinator <- combinator 279 self$subselector <- subselector 280 }, 281 repr = function() { 282 comb <- 283 if (self$combinator == " ") "<followed>" 284 else self$combinator 285 paste0( 286 first_class_name(self), 287 "[", 288 self$selector$repr(), 289 " ", 290 comb, 291 " ", 292 self$subselector$repr(), 293 "]") 294 }, 295 specificity = function() { 296 specs <- self$selector$specificity() 297 sub_specs <- self$subselector$specificity() 298 specs + sub_specs 299 }, 300 show = function() { # nocov start 301 cat(self$repr(), "\n") 302 } # nocov end 303 ) 304) 305 306#### Parser 307 308# foo 309el_re <- '^[ \t\r\n\f]*([a-zA-Z]+)[ \t\r\n\f]*$' 310 311# foo#bar or #bar 312id_re <- '^[ \t\r\n\f]*([a-zA-Z]*)#([a-zA-Z0-9_-]+)[ \t\r\n\f]*$' 313 314# foo.bar or .bar 315class_re <- '^[ \t\r\n\f]*([a-zA-Z]*)\\.([a-zA-Z][a-zA-Z0-9_-]*)[ \t\r\n\f]*$' 316 317parse <- function(css) { 318 nc <- nchar(css) 319 el_match <- str_match(css, el_re)[1, 2] 320 if (!is.na(el_match)) 321 return(list(Selector$new(Element$new(element = el_match)))) 322 id_match <- str_match(css, id_re)[1, 2:3] 323 if (!is.na(id_match[2])) 324 return(list(Selector$new( 325 Hash$new( 326 Element$new( 327 element = 328 if (nzchar(id_match[1]) == 0) NULL 329 else id_match[1]), 330 id_match[2])))) 331 class_match <- str_match(css, class_re)[1, 2:3] 332 if (!is.na(class_match[3])) 333 return(list(Selector$new( 334 ClassSelector$new( 335 Element$new( 336 element = 337 if (is.na(class_match[2])) NULL 338 else class_match[2]), 339 class_match[3])))) 340 stream <- TokenStream$new(tokenize(css)) 341 stream$source_text <- css 342 parse_selector_group(stream) 343} 344 345parse_selector_group <- function(stream) { 346 stream$skip_whitespace() 347 i <- 1 348 results <- list() 349 while (TRUE) { 350 parsed_selector <- parse_selector(stream) 351 results[[i]] <- Selector$new(parsed_selector$result, 352 parsed_selector$pseudo_element) 353 i <- i + 1 354 if (token_equality(stream$peek(), "DELIM", ",")) { 355 stream$nxt() 356 stream$skip_whitespace() 357 } else { 358 break 359 } 360 } 361 results 362} 363 364token_equality <- function(token, t, val) { 365 if (token$type != t) 366 return(FALSE) 367 # val can be NULL or (maybe) NA 368 if (is.null(val) && is.null(token$value)) 369 return(TRUE) 370 if (is.na(val) && is.na(token$value)) 371 return(TRUE) 372 # Should be OK with regular equality 373 token$value == val 374} 375 376parse_selector <- function(stream) { 377 results <- parse_simple_selector(stream) 378 result <- results$result 379 pseudo_element <- results$pseudo_element 380 381 while (TRUE) { 382 stream$skip_whitespace() 383 peek <- stream$peek() 384 if (token_equality(peek, "EOF", NULL) || 385 token_equality(peek, "DELIM", ",")) { 386 break 387 } 388 if (!is.null(pseudo_element) && nzchar(pseudo_element)) { 389 stop("Got pseudo-element ::", 390 pseudo_element, 391 " not at the end of a selector") 392 } 393 if (peek$is_delim(c("+", ">", "~"))) { 394 # A combinator 395 combinator <- stream$nxt()$value 396 stream$skip_whitespace() 397 } else { 398 # By exclusion, the last parse_simple_selector() ended 399 # at peek == ' ' 400 combinator <- ' ' 401 } 402 stuff <- parse_simple_selector(stream) 403 pseudo_element <- stuff$pseudo_element 404 result <- CombinedSelector$new(result, combinator, stuff$result) 405 } 406 list(result = result, pseudo_element = pseudo_element) 407} 408 409parse_simple_selector <- function(stream, inside_negation = FALSE) { 410 stream$skip_whitespace() 411 selector_start <- length(stream$used) 412 peek <- stream$peek() 413 if (peek$type == "IDENT" || token_equality(peek, "DELIM", "*")) { 414 if (peek$type == "IDENT") { 415 namespace <- stream$nxt()$value 416 } else { 417 stream$nxt() 418 namespace <- NULL 419 } 420 if (token_equality(stream$peek(), "DELIM", "|")) { 421 stream$nxt() 422 element <- stream$next_ident_or_star() 423 } else { 424 element <- namespace 425 namespace <- NULL 426 } 427 } else { 428 element <- namespace <- NULL 429 } 430 result <- Element$new(namespace, element) 431 pseudo_element <- NULL 432 while (TRUE) { 433 peek <- stream$peek() 434 if (any(peek$type == c("S", "EOF")) || 435 peek$is_delim(c(",", "+", ">", "~")) || 436 (inside_negation && token_equality(peek, "DELIM", ")"))) { 437 break 438 } 439 if (!is.null(pseudo_element)) { 440 stop("Got pseudo-element ::", 441 pseudo_element, 442 " not at the end of a selector") 443 } 444 if (peek$type == "HASH") { 445 result <- Hash$new(result, stream$nxt()$value) 446 } else if (token_equality(peek, "DELIM", ".")) { 447 stream$nxt() 448 result <- ClassSelector$new(result, stream$next_ident()) 449 } else if (token_equality(peek, "DELIM", "|")) { 450 stream$nxt() 451 result <- Element$new(element = stream$next_ident()) 452 } else if (token_equality(peek, "DELIM", "[")) { 453 stream$nxt() 454 result <- parse_attrib(result, stream) 455 } else if (token_equality(peek, "DELIM", ":") || 456 token_equality(peek, "DELIM", "::")) { 457 if (token_equality(peek, "DELIM", "::")) { 458 stream$nxt() 459 pseudo_element <- stream$next_ident() 460 next 461 } else { 462 stream$nxt() 463 } 464 ident <- stream$next_ident() 465 if (tolower(ident) %in% c( 466 "first-line", "first-letter", "before", "after")) { 467 # Special case: CSS 2.1 pseudo-elements can have a single ':' 468 # Any new pseudo-element must have two. 469 pseudo_element <- ident 470 next 471 } 472 if (!token_equality(stream$peek(), "DELIM", "(")) { 473 result <- Pseudo$new(result, ident) 474 next 475 } 476 stream$nxt() 477 stream$skip_whitespace() 478 if (tolower(ident) == "not") { 479 if (inside_negation) { 480 stop("Got nested :not()") 481 } 482 res <- parse_simple_selector(stream, inside_negation = TRUE) 483 argument <- res$result 484 argument_pseudo_element <- res$pseudo_element 485 stream$skip_whitespace() 486 nt <- stream$nxt() 487 if (length(argument_pseudo_element) && 488 nzchar(argument_pseudo_element)) { 489 stop("Got pseudo-element ::", 490 argument_pseudo_element, 491 " inside :not() at ", 492 nt$pos) 493 } 494 if (!token_equality(nt, "DELIM", ")")) { 495 stop("Expected ')', got ", nt$value) 496 } 497 result <- Negation$new(result, argument) 498 } else { 499 arguments <- list() 500 i <- 1 501 while (TRUE) { 502 nt <- stream$nxt() 503 if (nt$type %in% c("IDENT", "STRING", "NUMBER") || 504 (token_equality(nt ,"DELIM", "+") || 505 token_equality(nt, "DELIM", "-"))) { 506 arguments[[i]] <- nt 507 i <- i + 1 508 } else if (nt$type == "S") { 509 next 510 } else if (token_equality(nt, "DELIM", ")")) { 511 break 512 } else { 513 stop("Expected an argument, got ", nt$repr()) 514 } 515 } 516 if (length(arguments) == 0) { 517 stop("Expected at least one argument, got ", nt$repr()) 518 } 519 result <- Function$new(result, ident, arguments) 520 } 521 } else { 522 stop("Expected selector, got ", stream$peek()$repr()) 523 } 524 } 525 if (length(stream$used) == selector_start) { 526 stop("Expected selector, got ", stream$peek()$repr()) 527 } 528 list(result = result, pseudo_element = pseudo_element) 529} 530 531parse_attrib <- function(selector, stream) { 532 stream$skip_whitespace() 533 attrib <- stream$next_ident_or_star() 534 if (is.null(attrib) && !token_equality(stream$peek(), "DELIM", "|")) 535 stop("Expected '|', got ", stream$peek()$repr()) 536 if (token_equality(stream$peek(), "DELIM", "|")) { 537 stream$nxt() 538 namespace <- attrib 539 attrib <- stream$next_ident() 540 op <- NULL 541 } else if (token_equality(stream$peek(), "DELIM", "|=")) { 542 namespace <- NULL 543 stream$nxt() 544 op <- "|=" 545 } else { 546 namespace <- op <- NULL 547 } 548 if (is.null(op)) { 549 stream$skip_whitespace() 550 nt <- stream$nxt() 551 if (token_equality(nt, "DELIM", "]")) { 552 return(Attrib$new(selector, namespace, attrib, "exists", NULL)) 553 } else if (token_equality(nt, "DELIM", "=")) { 554 op <- "=" 555 } else if (nt$is_delim(c("^=", "$=", "*=", "~=", "|=", "!="))) { 556 op <- nt$value 557 } else { 558 stop("Operator expected, got ", nt$repr()) 559 } 560 } 561 stream$skip_whitespace() 562 value <- stream$nxt() 563 if (!value$type %in% c("IDENT", "STRING")) { 564 stop("Expected string or ident, got ", value$repr()) 565 } 566 stream$skip_whitespace() 567 nt <- stream$nxt() 568 if (!token_equality(nt, "DELIM", "]")) { 569 stop("Expected ']', got ", nt$repr()) 570 } 571 Attrib$new(selector, namespace, attrib, op, value$value) 572} 573 574str_int <- function(s) { 575 suppressWarnings(as.integer(s)) 576} 577 578parse_series <- function(tokens) { 579 for (token in tokens) { 580 if (token$type == "STRING") 581 stop("String tokens not allowed in series.") 582 } 583 s <- paste0(sapply(tokens, function(x) x$value), collapse = "") 584 if (s == "odd") 585 return(2:1) 586 else if (s == "even") 587 return(c(2, 0)) 588 else if (s == "n") 589 return(1:0) 590 if (is.na(str_locate(s, "n")[1, 1])) { 591 result <- str_int(s) 592 if (is.na(result)) { 593 return(NULL) 594 } else { 595 return(c(0, result)) 596 } 597 } 598 ab <- str_split_fixed(s, "n", 2)[1,] 599 a <- str_trim(ab[1]) 600 b <- str_trim(ab[2]) 601 602 intb <- str_int(b) 603 if (!nzchar(a) && is.na(intb)) 604 return(NULL) 605 606 if (!nzchar(a)) 607 a <- 1 608 else if (a == "-" || a == "+") 609 a <- str_int(paste0(a, "1")) 610 else 611 a <- str_int(a) 612 if (!nzchar(b)) 613 b <- 0 614 else 615 b <- str_int(b) 616 c(a, b) 617} 618 619Token <- R6Class("Token", 620 public = list( 621 type = "", 622 value = NULL, 623 pos = 1, 624 initialize = function(type = "", value = NULL, pos = 1) { 625 self$type <- type 626 self$value <- value 627 self$pos <- pos 628 }, 629 repr = function() { 630 paste0("<", self$type, " '", self$value, "' at ", self$pos, ">") 631 }, 632 is_delim = function(values) { 633 self$type == "DELIM" && self$value %in% values 634 }, 635 show = function() { # nocov start 636 cat(self$repr(), "\n") 637 } # nocov end 638 ) 639) 640 641EOFToken <- R6Class("EOFToken", 642 inherit = Token, 643 public = list( 644 initialize = function(pos = 1, type = "EOF", value = NULL) { 645 super$initialize(type, value, pos) 646 }, 647 repr = function() { 648 paste0("<", self$type, " at ", self$pos, ">") 649 }, 650 show = function() { # nocov start 651 cat(self$repr(), "\n") 652 } # nocov end 653 )) 654 655compile_ <- function(pattern) { 656 function(x) { 657 str_locate(x, pattern)[1, ] 658 } 659} 660 661delims_2ch <- c('~=', '|=', '^=', '$=', '*=', '::', '!=') 662delims_1ch <- c('>', '+', '~', ',', '.', '*', '=', '[', ']', '(', ')', '|', ':', '#') 663delim_escapes <- paste0("\\", delims_1ch, collapse = "|") 664match_whitespace <- compile_('[ \t\r\n\f]+') 665match_number <- compile_('[+-]?(?:[0-9]*\\.[0-9]+|[0-9]+)') 666match_hash <- compile_(paste0("^#([_a-zA-Z0-9-]|", nonascii, "|\\\\(?:", delim_escapes, "))+")) 667match_ident <- compile_(paste0("^([_a-zA-Z0-9-]|", nonascii, "|\\\\(?:", delim_escapes, "))+")) 668match_string_by_quote <- list("'" = compile_(paste0("([^\n\r\f\\']|", TokenMacros$string_escape, ")*")), 669 '"' = compile_(paste0('([^\n\r\f\\"]|', TokenMacros$string_escape, ")*"))) 670 671# Substitution for escaped chars 672sub_simple_escape <- function(x) gsub('\\\\(.)', "\\1", x) 673sub_unicode_escape <- function(x) gsub(TokenMacros$unicode_escape, "\\1", x, ignore.case = TRUE) 674sub_newline_escape <- function(x) gsub('\\\\(?:\n|\r\n|\r|\f)', "", x) 675 676tokenize <- function(s) { 677 pos <- 1 678 i <- 1 679 len_s <- nchar(s) 680 results <- list() 681 while (pos <= len_s) { 682 ss <- substring(s, pos, len_s) 683 match <- match_whitespace(ss) 684 if (!anyNA(match) && match[1] == 1) { 685 results[[i]] <- Token$new("S", " ", pos) 686 match_end <- match[2] 687 pos <- pos + match_end 688 i <- i + 1 689 next 690 } 691 match <- match_number(ss) 692 if (!anyNA(match) && match[1] == 1) { 693 match_start <- match[1] 694 match_end <- max(match[1], match[2]) 695 value <- substring(ss, match_start, match_end) 696 results[[i]] <- Token$new("NUMBER", value, pos) 697 pos <- pos + match_end 698 i <- i + 1 699 next 700 } 701 match <- match_ident(ss) 702 if (!anyNA(match) && match[1] == 1) { 703 match_start <- match[1] 704 match_end <- max(match[1], match[2]) 705 value <- substring(ss, match_start, match_end) 706 value <- sub_simple_escape(sub_unicode_escape(value)) 707 results[[i]] <- Token$new("IDENT", value, pos) 708 pos <- pos + match_end 709 i <- i + 1 710 next 711 } 712 match <- match_hash(ss) 713 if (!anyNA(match) && match[1] == 1) { 714 match_start <- match[1] 715 match_end <- max(match[1], match[2]) 716 value <- substring(ss, match_start, match_end) 717 value <- sub_simple_escape(sub_unicode_escape(value)) 718 hash_id <- substring(value, 2) 719 results[[i]] <- Token$new("HASH", hash_id, pos) 720 pos <- pos + match_end 721 i <- i + 1 722 next 723 } 724 # Testing presence of two char delims 725 nc_inds <- seq_len(nchar(ss)) 726 if (length(nc_inds) %% 2 == 1) 727 nc_inds <- c(nc_inds, length(nc_inds) + 1) 728 split_ss_2ch <- substring(ss, nc_inds[(nc_inds %% 2) == 1], 729 nc_inds[(nc_inds %% 2) == 0]) 730 delim_inds_2ch <- which(split_ss_2ch %in% delims_2ch) 731 if (length(delim_inds_2ch) && delim_inds_2ch[1] == 1) { 732 # We have a 2ch delim 733 results[[i]] <- Token$new("DELIM", split_ss_2ch[1], pos) 734 pos <- pos + 2 735 i <- i + 1 736 next 737 } 738 739 # Testing presence of single char delims 740 split_ss_1ch <- substring(ss, nc_inds, nc_inds) 741 delim_inds_1ch <- which(split_ss_1ch %in% delims_1ch) 742 if (length(delim_inds_1ch) && delim_inds_1ch[1] == 1) { 743 # We have a single char delim 744 results[[i]] <- Token$new("DELIM", split_ss_1ch[1], pos) 745 pos <- pos + 1 746 i <- i + 1 747 next 748 } 749 quote <- substring(s, pos, pos) 750 if (quote %in% c("'", '"')) { 751 ncs <- nchar(s) 752 split_chars <- substring(s, (pos + 1):ncs, (pos + 1):ncs) 753 matching_quotes <- which(split_chars == quote) 754 is_escaped <- logical(length(matching_quotes)) 755 if (length(matching_quotes)) { 756 for (j in seq_along(matching_quotes)) { 757 end_quote <- matching_quotes[j] 758 if (end_quote > 1) { 759 is_escaped[j] <- split_chars[end_quote - 1] == "\\" 760 } 761 } 762 if (all(is_escaped)) { 763 stop("Unclosed string at ", pos) 764 } 765 end_quote <- matching_quotes[min(which(!is_escaped))] 766 value <- substring(s, pos + 1, pos + end_quote - 1) 767 value <- sub_simple_escape( 768 sub_unicode_escape( 769 sub_newline_escape(value))) 770 results[[i]] <- Token$new("STRING", value, pos) 771 pos <- pos + end_quote + 1 # one for each quote char 772 i <- i + 1 773 } else { 774 stop("Unclosed string at ", pos) 775 } 776 } 777 # Remove comments 778 pos1 <- pos + 1 779 if (substring(s, pos, pos1) == "/*") { 780 rel_pos <- str_locate(ss, "\\*/")[1] 781 pos <- 782 if (is.na(rel_pos)) { 783 len_s + 1 784 } else { 785 pos + rel_pos + 1 786 } 787 next 788 } 789 # Because we always call 'next', if we're here there must have 790 # been an error 791 tmp <- substring(ss, 1, 1) 792 if (!tmp %in% c(delims_1ch, '"', "'")) { 793 stop("Unexpected character '", 794 tmp, 795 "' found at position ", 796 pos) 797 } 798 } 799 results[[i]] <- EOFToken$new(pos) 800 results 801} 802 803TokenStream <- R6Class("TokenStream", 804 public = list( 805 pos = 1, 806 tokens = NULL, 807 ntokens = 0, 808 used = list(), 809 source_text = NULL, 810 peeked = list(), 811 peeking = FALSE, 812 initialize = function(tokens, source_text = NULL) { 813 self$tokens <- tokens 814 self$ntokens <- length(tokens) 815 self$source_text <- source_text 816 }, 817 nxt = function() { 818 if (self$peeking) { 819 self$peeking <- FALSE 820 self$used[[self$pos]] <- self$peeked 821 self$peeked 822 } else { 823 nt <- self$next_token() 824 self$used[[self$pos]] <- nt 825 nt 826 } 827 }, 828 next_token = function() { 829 nt <- self$tokens[[self$pos]] 830 self$pos <- self$pos + 1 831 nt 832 }, 833 peek = function() { 834 if (!self$peeking) { 835 self$peeked <- self$next_token() 836 self$peeking <- TRUE 837 } 838 self$peeked 839 }, 840 next_ident = function() { 841 nt <- self$nxt() 842 if (nt$type != "IDENT") 843 stop("Expected ident, got ", nt$repr()) 844 nt$value 845 }, 846 next_ident_or_star = function() { 847 nt <- self$nxt() 848 if (nt$type == "IDENT") 849 nt$value 850 else if (token_equality(nt, "DELIM", "*")) 851 NULL 852 else 853 stop("Expected ident or '*', got ", nt$repr()) 854 }, 855 skip_whitespace = function() { 856 peek <- self$peek() 857 if (peek$type == "S") 858 self$nxt() 859 } 860 ) 861) 862