R: step0-3, readline FFI.

1 files changed, 108 insertions, 0 deletions

diff --git a/r/reader.r b/r/reader.r
new file mode 100644
index 0000000..d2ab486
--- /dev/null
+++ b/r/reader.r
@@ -0,0 +1,108 @@
+..reader.. <- TRUE
+
+if(!exists("..types..")) source("types.r")
+
+new.Reader <- function(tokens) {
+    e <- structure(new.env(), class="Reader")
+    e$tokens <- tokens
+    e$position <- 1
+    e
+}
+
+Reader.peek <- function(rdr) {
+    if (rdr$position > length(rdr$tokens)) return(NULL)
+    rdr$tokens[[rdr$position]]
+}
+
+Reader.next <- function(rdr) {
+    if (rdr$position > length(rdr$tokens)) return(NULL)
+    rdr$position <- rdr$position + 1
+    rdr$tokens[[rdr$position-1]]
+}
+
+tokenize <- function(str) {
+    re <- "[\\s,]*(~@|[\\[\\]\\{\\}\\(\\)'`~^@]|\"(?:\\\\.|[^\\\\\"])*\"|;.*|[^\\s\\[\\]\\{\\}\\('\"`,;\\)]*)"
+    m <- lapply(regmatches(str, gregexpr(re, str, perl=TRUE)), 
+                function(e) sub("^[\\s,]+", "", e, perl=TRUE))
+    res <- list()
+    i <- 1
+    for(v in m[[1]]) {
+        if (v == "") next
+        res[[i]] <- v
+        i <- i+1
+    }
+    res
+}
+
+re_match <- function(re, str) { length(grep(re, c(str))) > 0 }
+
+read_atom <- function(rdr) {
+    token <- Reader.next(rdr)
+    if (re_match("^-?[0-9][0-9.]*$", token)) {
+        as.numeric(token)
+    } else if (substr(token,1,1) == "\"") {
+        substr(token, 2, nchar(token)-1)
+    } else if (token == "nil") {
+        NULL
+    } else if (token == "true") {
+        TRUE
+    } else if (token == "false") {
+        FALSE
+    } else {
+        as.symbol(token)
+    }
+}
+
+read_seq <- function(rdr, start="(", end=")") {
+    lst <- list()
+    token <- Reader.next(rdr)
+    if (token != start) {
+        throw(concat("expected '", start, "'"))
+    }
+    repeat {
+        token <- Reader.peek(rdr)
+        if (is.null(token)) {
+            throw(concat("expected '", end, "', got EOF"))
+        }
+        if (token == end) break
+        lst[[length(lst)+1]] <- read_form(rdr)
+    }
+    Reader.next(rdr)
+    new.listl(lst)
+}
+
+read_form <- function(rdr) {
+    token <- Reader.peek(rdr)
+    if (token == ")") {
+        throw("unexpected ')'")
+    } else if (token == "(") {
+        new.listl(read_seq(rdr))
+    } else if (token == "]") {
+        throw("unexpected ']'")
+    } else if (token == "[") {
+        new.vectorl(read_seq(rdr, "[", "]"))
+    } else {
+        read_atom(rdr)
+    }
+}
+
+read_str <- function(str) {
+    tokens <- tokenize(str)
+    if (length(tokens) == 0) return(NULL)
+    return(read_form(new.Reader(tokens)))
+}
+
+#cat("---\n")
+#print(tokenize("123"))
+#cat("---\n")
+#print(tokenize("  (  123 456 abc   \"def\"  )  "))
+
+#rdr <- new.reader(tokenize("  (  123 456 abc   \"def\"  )  "))
+#Reader.peek(rdr)
+#Reader.next(rdr)
+#Reader.next(rdr)
+#Reader.next(rdr)
+#Reader.next(rdr)
+#Reader.next(rdr)
+#Reader.next(rdr)
+#Reader.next(rdr)