R: add hash-map and metadata support.

[jackhill/mal.git] / r / core.r

..core.. <- TRUE

if(!exists("..types..")) source("types.r")
if(!exists("..printer..")) source("printer.r")


# String functions

pr_str <- function(...)
    .pr_list(list(...), print_readably=TRUE, join=" ")

str <- function(...)
    .pr_list(list(...), print_readably=FALSE, join="")

prn <- function(...) {
    cat(.pr_list(list(...), print_readably=TRUE, join=" "))
    cat("\n")
    nil
}

println <- function(...) {
    cat(.pr_list(list(...), print_readably=FALSE, join=" "))
    cat("\n")
    nil
}

# Hash Map functions
do_get <- function(hm,k) {
    if (class(hm) == "nil") return(nil)
    v <- hm[[k]]
    if (is.null(v)) nil else v
}
contains_q <-function(hm,k) {
    if (class(hm) == "nil") return(FALSE)
    if (is.null(hm[[k]])) FALSE else TRUE
}

# Sequence functions
cons <- function(a,b) {
    new_lst <- append(list(a), b)
    new.listl(new_lst)
}

do_concat <- function(...) {
    new_lst <- list()
    for(l in list(...)) {
        new_lst <- append(new_lst, l)
    }
    new.listl(new_lst)
}

do_apply <- function(f, ...) {
    p <- list(...)
    args <- list()
    if (length(p) > 1) {
        for(l in slice(p, 1, length(p)-1)) {
            args[[length(args)+1]] <- l
        }
    }
    args <- append(args, p[[length(p)]])
    fapply(f, args)
}

map <- function(f, seq) {
    new.listl(lapply(seq, function(el) fapply(f, el)))
}

# Metadata functions
with_meta <- function(obj, m) {
    new_obj <- .clone(obj)
    attr(new_obj, "meta") <- m
    new_obj
}

meta <- function(obj) {
    m <- attr(obj, "meta")
    if (is.null(m)) nil else m
}

core_ns <- list(
    "="=function(a,b) .equal_q(a,b),
    "throw"=function(err) throw(err),
    "nil?"=.nil_q,
    "true?"=.true_q,
    "false?"=.false_q,
    "symbol?"=.symbol_q,
    "symbol"=new.symbol,
    "symbol?"=.symbol_q,

    "pr-str"=pr_str,
    "str"=str,
    "prn"=prn,
    "println"=println,
    "readline"=readline,
    "read-string"=function(str) read_str(str),
    "slurp"=function(path) readChar(path, file.info(path)$size),
    "<"=function(a,b) a<b,
    "<="=function(a,b) a<=b,
    ">"=function(a,b) a>b,
    ">="=function(a,b) a>=b,
    "+"=function(a,b) a+b,
    "-"=function(a,b) a-b,
    "*"=function(a,b) a*b,
    "/"=function(a,b) a/b,

    "list"=new.list,
    "list?"=function(a) .list_q(a),
    "vector"=new.vector,
    "vector?"=function(a) .vector_q(a),
    "hash-map"=new.hash_map,
    "map?"=function(a) .hash_map_q(a),
    "assoc"=function(hm,...) .assoc(hm,list(...)),
    "dissoc"=function(hm,...) .dissoc(hm,list(...)),
    "get"=do_get,
    "contains?"=contains_q,
    "keys"=function(hm) new.listl(ls(hm)),
    "vals"=function(hm) new.listl(lapply(ls(hm), function(x) hm[[x]])),

    "sequential?"=.sequential_q,
    "cons"=cons,
    "concat"=do_concat,
    "nth"=function(a,b) if (length(a) < b+1) nil else a[[b+1]],
    "first"=function(a) if (length(a) < 1) nil else a[[1]], 
    "rest"=function(a) new.listl(slice(a,2)),
    "empty?"=function(a) .sequential_q(a) && length(a) == 0,
    "count"=function(a) length(a),
    "apply"=do_apply,
    "map"=map,

    "with-meta"=with_meta,
    "meta"=meta
)