1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
..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 == "" || substr(v,1,1) == ";") 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) == "\"") {
gsub("\\\\n", "\\n",
gsub("\\\\\"", "\"",
substr(token, 2, nchar(token)-1)))
} else if (token == "nil") {
nil
} else if (token == "true") {
TRUE
} else if (token == "false") {
FALSE
} else {
new.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 == "'") {
. <- Reader.next(rdr);
new.list(new.symbol("quote"), read_form(rdr))
} else if (token == "`") {
. <- Reader.next(rdr);
new.list(new.symbol("quasiquote"), read_form(rdr))
} else if (token == "~") {
. <- Reader.next(rdr);
new.list(new.symbol("unquote"), read_form(rdr))
} else if (token == "~@") {
. <- Reader.next(rdr);
new.list(new.symbol("splice-unquote"), read_form(rdr))
} else 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(nil)
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)
|
