; TODO: ; comment ; ->, ->> ; private vars/fns ; if-not, when, when-not, if-let, when-let ; case ; destructuring ; gensym and gensym# syntax for macros ; throw an error when an undefined symbol is used in a fn or macro definition ; make strings enumerable, e.g. ; (apply str “hello”) should return “hello” ; (take 3 “hello”) should return (“h” “e” “l”) ; note: (seq “hello”) already returns (“h” “e” “l” “l” “o”) because of special ; logic in the definition of seq ; make equality semantics work like clojure's: ; (= 2 2.0) should be false ; (== 2 2.0) should be true
(ns rubylisp.core)
;; awkwardly defined basic functions that will make it easier to define other ;; functions and macros
(def seq
(fn seq [x] (if (.nil? x) nil (if (.empty? x) nil (if (.is_a? x Kernel::String) (.to_list (.chars x)) (.to_list x))))))
(def count
(fn count [x] (let [coll (seq x)] (if (.nil? coll) 0 (.count coll)))))
(def empty?
(fn empty? [coll] (if (.nil? coll) true (.empty? coll))))
(def cons
(fn cons [x y] (let [lst (if (.nil? y) () (.to_list y))] (.cons lst x))))
(def concat
(fn concat [& colls] (if (.nil? colls) () (if (.== 1 (.count colls)) (.to_list (.first colls)) (.+ (.to_list (.first colls)) (apply concat (.drop colls 1)))))))
;; defn, defmacro
;; TODO: docstring support (defmacro* defmacro
(fn [name & more] `(defmacro* ~name (fn ~name ~@more))))
;; TODO: docstring support (defmacro defn
[name & more] `(def ~name (fn ~name ~@more)))
;; CONTROL FLOW
(defn boolean
[x] (if x true false))
(defn not
[x] (if x false true))
(defn throw
[e] (Kernel::raise e))
(defmacro cond
[& xs] (if (.> (count xs) 0) (list 'if (.first xs) (if (.> (count xs) 1) (.at xs 1) (throw "`cond` requires an even number of forms.")) (cons 'cond (.drop xs 2)))))
(defmacro or
[& xs] (cond (empty? xs) nil (.== 1 (count xs)) (.first xs) ;; FIXME: implement gensym and use it here so the macro is hygenic :else `(let [or_FIXME ~(.first xs)] (if or_FIXME or_FIXME (or ~@(.drop xs 1))))))
(defmacro and
[& xs] (cond (empty? xs) true (.== 1 (count xs)) (.first xs) ;; FIXME: implement gensym and use it here so the macro is hygenic :else `(let [and_FIXME ~(.first xs)] (if and_FIXME (and ~@(.drop xs 1)) and_FIXME))))
;; LISTS & OTHER COLLECTIONS
(defn nil?
[x] (.== nil x))
(defn string?
[x] (.is_a? x Kernel::String))
(defn list
[& args] (.to_list (if (nil? args) [] args)))
(defn list?
[x] (.is_a? x Hamster::List))
(defn vector
[& args] (Hamster::Vector::new args))
(defn vector?
[x] (.is_a? x Hamster::Vector))
;; TODO: implement `or` and use it here (defn sequential?
[x] (or (list? x) (vector? x) (.is_a? x Kernel::Array)))
(defn vec
[coll] (Hamster::Vector::new coll))
(defn hash-map
[& args] (Hamster::Hash::new (.to_h (.each_slice args 2))))
(defn map?
[x] (.is_a? x Hamster::Hash))
;; TODO: multiple arity fn (defn nth
[coll index & more] (if more (let [not-found (.first more)] (if (.>= index (count coll)) not-found (.at coll index))) (if (.>= index (count coll)) (Kernel::raise Kernel::IndexError) (.at coll index))))
(defn first
[coll] (if (not (nil? coll)) (.first coll)))
(defn ffirst
[coll] (first (first coll)))
(defn second
[coll] (nth coll 1))
(defn last
[coll] (.last coll))
(defn rest
[coll] (let [lst (if (nil? coll) () (.to_list coll))] (.tail lst)))
(defn take
[n coll] (.to_list (.take coll n)))
(defn butlast
[coll] (take (.- (count coll) 1) coll))
;; TODO: support mapping over multiple collections (defn map
[f coll] (if (empty? coll) () (cons (f (first coll)) (call-with-block .map (rest coll) [] f))))
(defn reverse
[coll] (if (empty? coll) coll (cons (last coll) (reverse (butlast coll)))))
;; TODO: multiple arity fn (defn range
[& args] (cond (.== 0 (count args)) ;; requires adjusting call-with-block so that it can use namespaced methods "TODO: zero-arity that produces a lazy list, i.e. Hamster::iterate(0, &:next)" (.== 1 (count args)) (apply range 0 args) :else (let [start (first args) end (.- (second args) 1)] (Hamster::interval start end))))
;; TODO: implement as multiple arity fn (defn repeat
[& args] (if (.== 1 (count args)) (apply Hamster::repeat args) (apply Hamster::replicate args)))
;; TODO: implement as multiple arity fn (defn reduce
[f & args] (if (.== 1 (count args)) (let [xs (first args)] (reduce f (first xs) (rest xs))) (let [init (first args) xs (second args)] (if (.== 0 (count xs)) init (reduce f (f init (first xs)) (rest xs))))))
;; MATH & LOGIC
;; TODO: zero arity that returns 0 ;; TODO: one arity that returns x (defn +
[x y & more] (let [xy (.+ x y)] (if more (apply + xy more) xy)))
;; TODO: one arity that returns x * -1 (defn -
[x y & more] (let [xy (.- x y)] (if more (apply - xy more) xy)))
(defn inc
[x] (+ x 1))
(defn dec
[x] (- x 1))
;; TODO: zero arity that returns 1 ;; TODO: one arity that returns x (i.e. x * 1) (defn *
[x y & more] (let [xy (.* x y)] (if more (apply * xy more) xy)))
;; TODO: one arity that returns 1 / x (defn /
[x y & more] (let [xy (./ x y)] (if more (apply / xy more) xy)))
(defn <
[x & xs] (boolean (reduce (fn [x y] (if (and x (.< x y)) y)) x xs)))
(defn <=
[x & xs] (boolean (reduce (fn [x y] (if (and x (.<= x y)) y)) x xs)))
(defn =
[x & xs] (boolean (reduce (fn [x y] (if (and x (.== x y)) y)) x xs)))
(defn not=
[& xs] (not (apply = xs)))
(defn >
[x & xs] (boolean (reduce (fn [x y] (if (and x (.> x y)) y)) x xs)))
(defn >=
[x & xs] (boolean (reduce (fn [x y] (if (and x (.>= x y)) y)) x xs)))
(defn pos?
[x] (> x 0))
(defn neg?
[x] (< x 0))
(defn zero?
[x] (= 0 x))
;; STRINGS & KEYWORDS
(defn str
[& args] (.join (map .to_s args)))
(defn name
[x] (if (string? x) x (.name x)))
(defn read-string
[s] (first (RubyLisp::Reader::read_str s)))
;; problem: this is defined in rubylisp.core, so code is evaluated there (defn load-string
[s] (eval (RubyLisp::Reader::read_str s)))
;; I/O
(defn pr-str
[& args] (if (zero? (count args)) "" (apply RubyLisp::Printer::pr_str args)))
(defn prn
[& args] (Kernel::puts (apply pr-str args)) nil)
(defn print
[& args] (Kernel::print (.join (map str args) " ")) nil)
(defn println
[& args] (Kernel::puts (.join (map str args) " ")) nil)
(defn slurp
[filename] (File::read filename))
(defn load-file
[filename] (load-string (slurp filename)))
;; RUBY INTEROP
(defn =@
[obj kw value] (.instance_variable_set obj (.to_sym (+ "@" (name kw))) value))
(defn class
[x] (.class x))
;; CONCURRENCY
(defn deref
[x] (.deref x))
(defn atom
[value] (Concurrent::Atom::new value))
(defn atom?
[value] (.is_a? value Concurrent::Atom))
(defn swap!
[a f & args] (call-with-block .swap a (if (nil? args) [] args) f))
(defn reset!
[a new-value] (.reset a new-value))