Commit | Line | Data |
---|---|---|
01feedfe JM |
1 | ..core.. <- TRUE |
2 | ||
3 | if(!exists("..types..")) source("types.r") | |
4 | if(!exists("..printer..")) source("printer.r") | |
5 | ||
6 | ||
c30efef4 JM |
7 | # String functions |
8 | ||
36737ae5 JM |
9 | pr_str <- function(...) |
10 | .pr_list(list(...), print_readably=TRUE, join=" ") | |
01feedfe | 11 | |
36737ae5 JM |
12 | str <- function(...) |
13 | .pr_list(list(...), print_readably=FALSE, join="") | |
01feedfe JM |
14 | |
15 | prn <- function(...) { | |
36737ae5 JM |
16 | cat(.pr_list(list(...), print_readably=TRUE, join=" ")) |
17 | cat("\n") | |
01feedfe JM |
18 | nil |
19 | } | |
20 | ||
21 | println <- function(...) { | |
36737ae5 JM |
22 | cat(.pr_list(list(...), print_readably=FALSE, join=" ")) |
23 | cat("\n") | |
01feedfe JM |
24 | nil |
25 | } | |
26 | ||
f947d503 JM |
27 | do_readline <- function(prompt) { |
28 | l <- readline(prompt) | |
29 | if (is.null(l)) nil else l | |
30 | } | |
31 | ||
36737ae5 JM |
32 | # Hash Map functions |
33 | do_get <- function(hm,k) { | |
34 | if (class(hm) == "nil") return(nil) | |
35 | v <- hm[[k]] | |
36 | if (is.null(v)) nil else v | |
37 | } | |
38 | contains_q <-function(hm,k) { | |
39 | if (class(hm) == "nil") return(FALSE) | |
40 | if (is.null(hm[[k]])) FALSE else TRUE | |
41 | } | |
42 | ||
c30efef4 JM |
43 | # Sequence functions |
44 | cons <- function(a,b) { | |
45 | new_lst <- append(list(a), b) | |
8128c69a | 46 | new.listl(new_lst) |
c30efef4 JM |
47 | } |
48 | ||
b8ee29b2 JM |
49 | nth <- function(a,b) { |
50 | if (b < length(a)) | |
51 | a[[b+1]] | |
52 | else | |
53 | throw("nth: index out of range") | |
54 | } | |
55 | ||
c30efef4 JM |
56 | do_concat <- function(...) { |
57 | new_lst <- list() | |
58 | for(l in list(...)) { | |
59 | new_lst <- append(new_lst, l) | |
60 | } | |
8128c69a JM |
61 | new.listl(new_lst) |
62 | } | |
63 | ||
64 | do_apply <- function(f, ...) { | |
65 | p <- list(...) | |
66 | args <- list() | |
67 | if (length(p) > 1) { | |
68 | for(l in slice(p, 1, length(p)-1)) { | |
69 | args[[length(args)+1]] <- l | |
70 | } | |
71 | } | |
72 | args <- append(args, p[[length(p)]]) | |
73 | fapply(f, args) | |
74 | } | |
75 | ||
76 | map <- function(f, seq) { | |
f947d503 JM |
77 | new.listl(lapply(seq, function(el) fapply(f, list(el)))) |
78 | } | |
79 | ||
80 | conj <- function(obj, ...) { | |
81 | p <- list(...) | |
82 | new_obj <- .clone(obj) | |
83 | if (.list_q(obj)) { | |
84 | if (length(p) > 0) { | |
85 | for(l in p) new_obj <- append(list(l), new_obj) | |
86 | } | |
87 | new.listl(new_obj) | |
88 | } else if (.vector_q(obj)) { | |
89 | if (length(p) > 0) { | |
90 | for(l in p) new_obj <- append(new_obj, list(l)) | |
91 | } | |
92 | new.vectorl(new_obj) | |
93 | } else { | |
94 | throw("conj called on non-sequence") | |
95 | } | |
c30efef4 JM |
96 | } |
97 | ||
36737ae5 JM |
98 | # Metadata functions |
99 | with_meta <- function(obj, m) { | |
100 | new_obj <- .clone(obj) | |
101 | attr(new_obj, "meta") <- m | |
102 | new_obj | |
103 | } | |
104 | ||
105 | meta <- function(obj) { | |
106 | m <- attr(obj, "meta") | |
107 | if (is.null(m)) nil else m | |
108 | } | |
109 | ||
f947d503 JM |
110 | # Atom functions |
111 | deref <- function(atm) atm$val | |
112 | reset_bang <- function (atm, val) { atm$val <- val; val } | |
113 | swap_bang <- function (atm, f, ...) { | |
114 | p <- list(...) | |
115 | args <- list(atm$val) | |
116 | if (length(p) > 0) { | |
117 | for(l in p) args[[length(args)+1]] <- l | |
118 | } | |
119 | atm$val <- fapply(f, args) | |
120 | } | |
121 | ||
01feedfe JM |
122 | core_ns <- list( |
123 | "="=function(a,b) .equal_q(a,b), | |
8128c69a JM |
124 | "throw"=function(err) throw(err), |
125 | "nil?"=.nil_q, | |
126 | "true?"=.true_q, | |
127 | "false?"=.false_q, | |
8128c69a JM |
128 | "symbol"=new.symbol, |
129 | "symbol?"=.symbol_q, | |
b8ee29b2 JM |
130 | "keyword"=new.keyword, |
131 | "keyword?"=.keyword_q, | |
01feedfe JM |
132 | |
133 | "pr-str"=pr_str, | |
134 | "str"=str, | |
135 | "prn"=prn, | |
136 | "println"=println, | |
f947d503 | 137 | "readline"=do_readline, |
c30efef4 JM |
138 | "read-string"=function(str) read_str(str), |
139 | "slurp"=function(path) readChar(path, file.info(path)$size), | |
01feedfe JM |
140 | "<"=function(a,b) a<b, |
141 | "<="=function(a,b) a<=b, | |
142 | ">"=function(a,b) a>b, | |
143 | ">="=function(a,b) a>=b, | |
144 | "+"=function(a,b) a+b, | |
145 | "-"=function(a,b) a-b, | |
146 | "*"=function(a,b) a*b, | |
147 | "/"=function(a,b) a/b, | |
9b3362e8 | 148 | "time-ms"=function() round(as.numeric(Sys.time())*1000), |
01feedfe | 149 | |
8128c69a | 150 | "list"=new.list, |
01feedfe | 151 | "list?"=function(a) .list_q(a), |
8128c69a JM |
152 | "vector"=new.vector, |
153 | "vector?"=function(a) .vector_q(a), | |
36737ae5 JM |
154 | "hash-map"=new.hash_map, |
155 | "map?"=function(a) .hash_map_q(a), | |
156 | "assoc"=function(hm,...) .assoc(hm,list(...)), | |
157 | "dissoc"=function(hm,...) .dissoc(hm,list(...)), | |
158 | "get"=do_get, | |
159 | "contains?"=contains_q, | |
160 | "keys"=function(hm) new.listl(ls(hm)), | |
161 | "vals"=function(hm) new.listl(lapply(ls(hm), function(x) hm[[x]])), | |
01feedfe | 162 | |
8128c69a | 163 | "sequential?"=.sequential_q, |
c30efef4 | 164 | "cons"=cons, |
8128c69a | 165 | "concat"=do_concat, |
b8ee29b2 | 166 | "nth"=nth, |
8128c69a JM |
167 | "first"=function(a) if (length(a) < 1) nil else a[[1]], |
168 | "rest"=function(a) new.listl(slice(a,2)), | |
36737ae5 | 169 | "empty?"=function(a) .sequential_q(a) && length(a) == 0, |
b8ee29b2 | 170 | "count"=function(a) if (.nil_q(a)) 0 else length(a), |
8128c69a | 171 | "apply"=do_apply, |
36737ae5 | 172 | "map"=map, |
f947d503 | 173 | "conj"=conj, |
36737ae5 JM |
174 | |
175 | "with-meta"=with_meta, | |
f947d503 JM |
176 | "meta"=meta, |
177 | "atom"=new.atom, | |
178 | "atom?"=.atom_q, | |
179 | "deref"=deref, | |
180 | "reset!"=reset_bang, | |
181 | "swap!"=swap_bang | |
01feedfe | 182 | ) |