impls/hy/core.hy

   1 (import [hy.models [HyKeyword :as Keyword HyString :as Str HySymbol :as Sym]])
   2 (import [copy [copy]])
   3 (import [time [time]])
   4 (import [mal_types [MalException Atom clone]])
   5 (import [reader [read-str]])
   6 (import [printer [pr-str]])
   7
   8 (defn sequential? [a]
   9   (or (instance? tuple a) (instance? list a)))
  10
  11 (defn equal [a b]
  12   (if (and (sequential? a) (sequential? b) (= (len a) (len b)))
  13       (every? (fn [[a b]] (equal a b)) (zip a b))
  14
  15       (and (instance? dict a) (instance? dict b) (= (.keys a) (.keys b)))
  16       (every? (fn [k] (and (equal (get a k) (get b k)))) a)
  17
  18       (= (type a) (type b))
  19       (= a b)
  20
  21       False))
  22
  23 (def ns
  24   {"="        equal
  25    "throw"    (fn [a] (raise (MalException a)))
  26
  27    "nil?"     none?
  28    "true?"    (fn [a] (and (instance? bool a) (= a True)))
  29    "false?"   (fn [a] (and (instance? bool a) (= a False)))
  30    "number?"  (fn [a] (and (not (instance? bool a)) (instance? int a)))
  31    "string?"  (fn [a] (and (string? a) (not (keyword? a))))
  32    "symbol"   (fn [a] (Sym a))
  33    "symbol?"  (fn [a] (instance? Sym a))
  34    "keyword"  (fn [a] (Keyword (if (keyword? a) a (+ ":" a))))
  35    "keyword?" (fn [a] (keyword? a))
  36    "fn?"      (fn [a] (and (callable a) (or (not (hasattr a "macro"))
  37                                             (not a.macro))))
  38    "macro?"   (fn [a] (and (callable a) (and (hasattr a "macro") a.macro)))
  39
  40    "pr-str"  (fn [&rest a] (Str (.join " " (map (fn [e] (pr-str e True)) a))))
  41    "str"     (fn [&rest a] (Str (.join "" (map (fn [e] (pr-str e False)) a))))
  42    "prn"     (fn [&rest a] (print (.join " " (map (fn [e] (pr-str e True)) a))))
  43    "println" (fn [&rest a] (print (.join " " (map (fn [e] (pr-str e False)) a))))
  44    "read-string" read-str
  45    "readline" (fn [a] (Str (raw_input a)))
  46    "slurp"   (fn [a] (Str (-> a open .read)))
  47
  48    "<"  <
  49    "<=" <=
  50    ">"  >
  51    ">=" >=
  52    "+"  +
  53    "-"  -
  54    "*"  *
  55    "/"  (fn [a b] (int (/ a b)))
  56    "time-ms"   (fn [] (int (* 1000 (time))))
  57
  58    "list"      (fn [&rest args] (tuple args))
  59    "list?"     (fn [a] (instance? tuple a))
  60    "vector"    (fn [&rest a] (list a))
  61    "vector?"   (fn [a] (instance? list a))
  62    "hash-map"  (fn [&rest a] (dict (partition a 2)))
  63    "map?"      (fn [a] (instance? dict a))
  64    "assoc"     (fn [m &rest a] (setv m (copy m))
  65                                (for [[k v] (partition a 2)] (assoc m k v)) m)
  66    "dissoc"    (fn [m &rest a] (setv m (copy m))
  67                                (for [k a] (if (.has_key m k) (.pop m k))) m)
  68    "get"       (fn [m a] (if (and m (.has_key m a)) (get m a)))
  69    "contains?" (fn [m a] (if (none? m) None (.has_key m a)))
  70    "keys"      (fn [m] (tuple (.keys m)))
  71    "vals"      (fn [m] (tuple (.values m)))
  72
  73    "sequential?" sequential?
  74    "cons"   (fn [a b] (tuple (chain [a] b)))
  75    "concat" (fn [&rest a] (tuple (apply chain a)))
  76    "vec"    (fn [a] (list a))
  77    "nth"    (fn [a b] (get a b))
  78    "first"  (fn [a] (if (none? a) None (first a)))
  79    "rest"   (fn [a] (if (none? a) (,) (tuple (rest a))))
  80    "empty?" empty?
  81    "count"  (fn [a] (if (none? a) 0 (len a)))
  82    "apply"  (fn [f &rest a] (apply f (+ (list (butlast a)) (list (last a)))))
  83    "map"    (fn [f a] (tuple (map f a)))
  84
  85    "conj"   (fn [a &rest xs] (if (instance? list a) (+ a (list xs))
  86                                  (tuple (+ (tuple (reversed xs)) a))))
  87    "seq"    (fn [a] (if (or (none? a) (empty? a)) None
  88                         (string? a) (tuple (map Str a))
  89                         (tuple a)))
  90
  91    "meta"   (fn [a] (if (hasattr a "meta") a.meta))
  92    "with-meta" (fn [a b] (setv a (clone a)) (setv a.meta b) a)
  93    "atom"   (fn [a] (Atom a))
  94    "atom?"  (fn [a] (instance? Atom a))
  95    "deref"  (fn [a] a.val)
  96    "reset!" (fn [a b] (do (setv a.val b) b))
  97    "swap!"  (fn [a f &rest xs] (do (setv a.val (apply f (+ (, a.val) xs))) a.val))
  98    })