ntha-0.1.0: lib/std.ntha

(data Maybe a (Just a) Nothing)

(monad Maybe {:return (λ x → (Just x))
              :>>= (λ x f → (match x
                              ((Just v) → (f v))
                              (Nothing → Nothing)))})

(ƒ len [l]
  (match l
    ([] ⇒ 0)
    (_ :: t ⇒ (+ 1 (len t)))))

(ƒ map [f xs]
  (match xs
    ([] ⇒ [])
    (h :: t ⇒ ((f h) :: (map f t)))))

(ƒ fold [f s xs]
  (match xs
    ([] ⇒ s)
    (h :: t ⇒ (fold f (f s h) t))))

(ƒ filter [f xs]
  (match xs
    ([] ⇒ [])
    (h :: t ⇒ (if (f h)
                 (h :: (filter f t))
                 (filter f t)))))

(ƒ range [x y]
  (let [rec-range (λ x y res ⇒ (if (> x y)
                                  res
                                  (rec-range x (- y 1) (y :: res))))]
    (rec-range x y [])))

(ƒ lookup [name pairs]
  (match pairs
    ([] ⇒ Nothing)
    ((k . v) :: t ⇒ (if (= name k)
                      (Just v)
                      (lookup name t)))))

(ƒ lookup! [default name pairs]
  (match pairs
    ([] ⇒ default)
    ((k . v) :: t ⇒ (if (= name k)
                      v
                      (lookup! default name t)))))

(ƒ exists?
  [e l]
  (match l
    ([] → false)
    (h :: t → (if (= h e)
                true
                (exists? e t)))))

(asserteq (exists? 3 [3 2 1]) true)
(asserteq (exists? 33 [3 2 1]) false)

(ƒ diff-list
  [l1 l2]
  (match l1
    ([] → [])
    (h :: t → (if (exists? h l2)
                (diff-list t l2)
                (h :: (diff-list t l2))))))

(asserteq (diff-list [3 2 1] [2 1]) [3])

(ƒ exists-map?
 [e m]
 (match (lookup e m)
   (Nothing → false)
   (_ → true)))

(ƒ diff-map
  [m l]
  (match m
    ([] → [])
    ((k . v) :: t → (if (exists? k l)
                      (diff-map t l)
                      ((k . v) :: (diff-map t l))))))

(asserteq (diff-map [(1 . 2) (2 . 3)] [1]) [(2 . 3)])
(asserteq (diff-map [(1 . 2) (2 . 3) (3 . 3)] [1 2]) [(3 . 3)])

(ƒ union-map
 [m1 m2]
 (match m2
   ([] → m1)
   ((k . v) :: t → (if (exists-map? k m1)
                     (union-map m1 t)
                     ((k . v) :: (union-map m1 t))))))

(asserteq (union-map [(1 . 1) (3 . 3)] [(1 . 3) (3 . 1) (2 . 2)]) [(2 . 2) (1 . 1) (3 . 3)])

(ƒ map-map
  [f m]
  (match m
    ([] → [])
    ((k . v) :: t → ((k . (f v)) :: (map-map f t)))))

(asserteq (map-map (λ x → (+ x 1)) [(1 . 1) (2 . 2)]) [(1 . 2) (2 . 3)])

(ƒ nub
  [l]
  (match l
    ([] → [])
    (h :: t → (if (exists? h t)
                (nub t)
                (h :: (nub t))))))

(asserteq (nub [1 2 3]) [1 2 3])
(asserteq (nub [1 1 1 2 2 3]) [1 2 3])

(ƒ conj [e l]
  (reverse (e :: (reverse l))))

(ƒ concat [l1 l2]
  (match l2
    ([] → l1)
    (h :: t → (concat (conj h l1) t))))

(asserteq (concat [1 2 3] [4 5 6]) [1 2 3 4 5 6])
(asserteq (concat "123" "456") "123456")

(ƒ flatten [l]
  (match l
    ([] → [])
    (h :: t → (concat h (flatten t)))))

(asserteq (flatten [[1] [2] [3]]) [1 2 3])

(ƒ empty? [l]
  (match l
    ([] → true)
    (_ → false)))

(asserteq (empty? []) true)
(asserteq (empty? [3]) false)

(ƒ head [l]
  (match l
    ([] → (error "empty list"))
    (h :: _ → h)))

(asserteq (head [1 2 3]) 1)

(ƒ tail [l]
  (match l
    ([] → [])
    (_ :: t → t)))

(asserteq (tail [1 2 3]) [2 3])

(ƒ take [n l]
  (if (> n 0)
    ((head l) :: (take (- n 1) (tail l)))
    []))

(asserteq (take 3 [1 2 3 4 5 6]) [1 2 3])
(asserteq (take 2 "_.x") "_.")

(ƒ max [a b] (if (≥ a b) a b))

(ƒ zero? [n] (= n 0))

(ƒ fst
  [tuple]
  (match tuple
    ((v . _) → v)
    (_ → (error "need apply a tuple value"))))

(ƒ snd
  [tuple]
  (match tuple
    ((_ . v) → v)
    (_ → (error "need apply a tuple value"))))