r/reader.r

   1 ..reader.. <- TRUE
   2
   3 if(!exists("..types..")) source("types.r")
   4
   5 new.Reader <- function(tokens) {
   6     e <- structure(new.env(), class="Reader")
   7     e$tokens <- tokens
   8     e$position <- 1
   9     e
  10 }
  11
  12 Reader.peek <- function(rdr) {
  13     if (rdr$position > length(rdr$tokens)) return(NULL)
  14     rdr$tokens[[rdr$position]]
  15 }
  16
  17 Reader.next <- function(rdr) {
  18     if (rdr$position > length(rdr$tokens)) return(NULL)
  19     rdr$position <- rdr$position + 1
  20     rdr$tokens[[rdr$position-1]]
  21 }
  22
  23 tokenize <- function(str) {
  24     re <- "[\\s,]*(~@|[\\[\\]\\{\\}\\(\\)'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"|;.*|[^\\s\\[\\]\\{\\}\\('\"`,;\\)]*)"
  25     m <- lapply(regmatches(str, gregexpr(re, str, perl=TRUE)),
  26                 function(e) sub("^[\\s,]+", "", e, perl=TRUE))
  27     res <- list()
  28     i <- 1
  29     for(v in m[[1]]) {
  30         if (v == "" || substr(v,1,1) == ";") next
  31         res[[i]] <- v
  32         i <- i+1
  33     }
  34     res
  35 }
  36
  37 re_match <- function(re, str) { length(grep(re, c(str))) > 0 }
  38
  39 read_atom <- function(rdr) {
  40     token <- Reader.next(rdr)
  41     if (re_match("^-?[0-9][0-9.]*$", token)) {
  42         as.numeric(token)
  43     } else if (substr(token,1,1) == "\"") {
  44         gsub("\\\\n", "\\n",
  45              gsub("\\\\\"", "\"",
  46                   substr(token, 2, nchar(token)-1)))
  47     } else if (token == "nil") {
  48         nil
  49     } else if (token == "true") {
  50         TRUE
  51     } else if (token == "false") {
  52         FALSE
  53     } else {
  54         new.symbol(token)
  55     }
  56 }
  57
  58 read_seq <- function(rdr, start="(", end=")") {
  59     lst <- list()
  60     token <- Reader.next(rdr)
  61     if (token != start) {
  62         throw(concat("expected '", start, "'"))
  63     }
  64     repeat {
  65         token <- Reader.peek(rdr)
  66         if (is.null(token)) {
  67             throw(concat("expected '", end, "', got EOF"))
  68         }
  69         if (token == end) break
  70         lst[[length(lst)+1]] <- read_form(rdr)
  71     }
  72     Reader.next(rdr)
  73     new.listl(lst)
  74 }
  75
  76 read_form <- function(rdr) {
  77     token <- Reader.peek(rdr)
  78     if (token == "'") {
  79         . <- Reader.next(rdr);
  80         new.list(new.symbol("quote"), read_form(rdr))
  81     } else if (token == "`") {
  82         . <- Reader.next(rdr);
  83         new.list(new.symbol("quasiquote"), read_form(rdr))
  84     } else if (token == "~") {
  85         . <- Reader.next(rdr);
  86         new.list(new.symbol("unquote"), read_form(rdr))
  87     } else if (token == "~@") {
  88         . <- Reader.next(rdr);
  89         new.list(new.symbol("splice-unquote"), read_form(rdr))
  90     } else if (token == ")") {
  91         throw("unexpected ')'")
  92     } else if (token == "(") {
  93         new.listl(read_seq(rdr))
  94     } else if (token == "]") {
  95         throw("unexpected ']'")
  96     } else if (token == "[") {
  97         new.vectorl(read_seq(rdr, "[", "]"))
  98     } else {
  99         read_atom(rdr)
 100     }
 101 }
 102
 103 read_str <- function(str) {
 104     tokens <- tokenize(str)
 105     if (length(tokens) == 0) return(nil)
 106     return(read_form(new.Reader(tokens)))
 107 }
 108
 109 #cat("---\n")
 110 #print(tokenize("123"))
 111 #cat("---\n")
 112 #print(tokenize("  (  123 456 abc   \"def\"  )  "))
 113
 114 #rdr <- new.reader(tokenize("  (  123 456 abc   \"def\"  )  "))
 115 #Reader.peek(rdr)
 116 #Reader.next(rdr)
 117 #Reader.next(rdr)
 118 #Reader.next(rdr)
 119 #Reader.next(rdr)
 120 #Reader.next(rdr)
 121 #Reader.next(rdr)
 122 #Reader.next(rdr)