# Prelude
(def seq (a b) (let { x = a } b)) # execute a then b
(def compose (f g x) (f (g x)))
(def apply (f x) (f x))
(def id (a) a)
(def flip (f a b) (f b a))
(def const (a b) a)
(def foldl (f z l)
(if (isEmpty l)
z
(let { x = (head l), xs = (tail l) }
(foldl f (f z x) xs))))
(def scanl (f q ls)
(let { ls' = (if (isEmpty ls)
[]
(let {x = (head ls), xs = (tail ls)}
(scanl f (f q x) xs))) }
(cons q ls')))
(def foldr (f z l)
(if (isEmpty l)
z
(let {x = (head l), xs = (foldr f z (tail l))}
(f x xs))))
(def foldr1 (f l) # l can't be empty
(let {x = (head l), xs = (tail l)}
(if (isEmpty xs)
x
(f x (foldr1 f xs)))))
(def scanr (f q0 l)
(if (isEmpty l)
[q0]
(let { x = (head l), xs = (tail l)
, qs = (scanr f q0 xs)
, q = (head qs) }
(cons (f x q) qs))))
(def take (n l)
(if (<= n 0)
[]
(if (isEmpty l)
[]
(let { x = (head l), xs = (tail l) }
(cons x (take (- n 1) xs))))))
(def drop (n l)
(if (<= n 0)
l
(if (isEmpty l)
[]
(drop (- n 1) (tail l)))))
(def splitAt (n l) ((take n l), (drop n l)))
(def map (f l) (if (isEmpty l)
[]
(let {x = (head l), xs = (tail l)}
(cons (f x) (map f xs)))))
(def concat (l1 l2) (if (isEmpty l1)
l2
(let {x = (head l1), xs = (tail l1)}
(cons x (concat xs l2)))))
(def concatMap (f)
(foldr (compose concat f) []))
(def insertAt (n x xs)
(let { sp = (splitAt n xs), before = (fst sp), after = (snd sp) }
(concat before (cons x after))))
(def range (n)
(if (< n 0)
[]
(concat (range (- n 1)) [n])))
(def iterateN (f x n)
(if (<= n 0)
[]
(cons x (iterateN f (f x) (- n 1)))))
(def filter (f l)
(if (isEmpty l)
[]
(let {
x = (head l)
, xs = (filter f (tail l))
}
(if (f x)
(cons x xs)
xs))))
(def dropWhile (f l)
(if (isEmpty l)
[]
(let {x = (head l), xs = (tail l)}
(if (f x)
(dropWhile f xs)
l))))
(def isSpace (c)
(|| (== ' ' c)
(|| (== '\t' c)
(|| (== '\n' c)
(|| (== '\r' c)
(|| (== '\f' c)
(== '\v' c)))))))
(def isNum (c)
(|| (== '0' c)
(|| (== '1' c)
(|| (== '2' c)
(|| (== '3' c)
(|| (== '4' c)
(|| (== '5' c)
(|| (== '6' c)
(|| (== '7' c)
(|| (== '7' c)
(== '9' c)))))))))))
(def zip (ks vs)
(if (isEmpty ks)
[]
(if (isEmpty vs)
[]
(let {k = (head ks), v = (head vs)
, kss = (tail ks), vss = (tail vs)}
(cons (k, v) (zip kss vss))))))
(def zipWith (f ks vs)
(if (isEmpty ks)
[]
(if (isEmpty vs)
[]
(let {k = (head ks), v = (head vs)
, kss = (tail ks), vss = (tail vs)}
(cons (f k v) (zipWith f kss vss))))))
(def unzip ()
(foldr
(lambda (kv ksvs)
(let {k = (fst kv), v = (snd kv)
, ks = (fst ksvs), vs = (snd ksvs)}
((cons k ks), (cons v vs))))
([],[])))
(def reverse ()
(foldl (flip cons) []))
(def last (l) # l should not be empty
(let { x = (head l), xs = (tail l) }
(if (isEmpty xs)
x
(last xs))))
(def and () (foldr && True))
(def or () (foldr || False))
(def all (p) (compose and (map p)))
(def any (p l)
(if (isEmpty l)
False
(let {x = (head l), xs = (tail l)}
(|| (p x) (any p xs)))))
(def elem (v l)
(if (isEmpty l)
False
(let { x = (head l), xs = (tail l) }
(if (== v x)
True
(elem v xs)))))
(def member (k l)
(if (isEmpty l)
False
(let {x = (head l), xs = (tail l)
, key = (fst x)}
(if (== k key)
True
(member k xs)))))
(def lookup (k l) # when k is not found in l, _|_
(let {x = (head l)
, key = (fst x)
, val = (snd x)
, xs = (tail l)}
(if (== key k)
val
(lookup k xs))))
(def break (p l)
(if (isEmpty l)
([], [])
(let {x = (head l), xs = (tail l)}
(if (p x)
([], l)
(let { broken = (break p xs)
, ys = (fst broken)
, zs = (snd broken) }
((cons x ys), zs))))))
(def words (s)
(if (isEmpty s)
[]
(let { x = (head s), xs = (tail s) }
(let { s' = (dropWhile isSpace s) }
(if (isEmpty s')
[]
(let { broken = (break isSpace s')
, w = (fst broken)
, ss = (snd broken) }
(cons w (words ss))))))))
(def unwords (s)
(if (isEmpty s)
""
(foldr1 (lambda (w s) (concat w (cons ' ' s))) s)))
(def lines (s)
(if (isEmpty s)
[]
(let { x = (break (== '\n') s)
, l = (fst x), s1 = (snd x)
, s2 = (if (isEmpty s1) [] (tail s1)) }
(cons l (lines s2)))))
(def unlines ()
(concatMap (lambda (x) (concat x "\n"))))
# simple quick sort
(def quick-sort (l) (if (isEmpty l) # is the list empty?
[]
(let { x = (head l)
, xs = (tail l)
, lesser = (filter (lambda (a) (< a x)) xs)
, greater = (filter (lambda (a) (>= a x)) xs)
}
(concat (concat (quick-sort lesser)
(cons x []))
(quick-sort greater)))))
(def trace (msg x) (seq (println msg) x))
(def fac (n) (if (<= n 1) 1 (* n (fac (- n 1)))))
(def fib (n)
(if (< n 2)
n
(let { i = (fib (- n 1)), i-1 = (fib (- n 2)) }
(+ i i-1))))
(def twice (f x) (f (f x)))
(def succ (x) (+ x 1))
(def pred (x) (- x 1))
(def sum (l)
(foldl + 0 l))
(def product ()
(foldl * 1))
(def subs (l)
(if (isEmpty l)
[[]]
(let { x = (head l), xs = (tail l), subsXs = (subs xs) }
(concat subsXs (map (cons x) subsXs)))))
{-
((twice twice succ) 0)
==> (twice (twice succ) 0)
==> ((twice succ) ((twice succ) 0))
==> (succ (succ ((twice succ) 0)))
==> (+ (succ ((twice succ) 0)) 1)
==> (+ (+ ((twice succ) 0) 1) 1)
==> (+ (+ (succ (succ 0)) 1) 1)
==> (+ (+ (succ 1) 1) 1)
==> (+ (+ 2 1) 1)
==> (+ 3 1)
==> 4
(let { fac = (+ fac 1)
((twice (twice (twice succ))) 0)
==> ((twice (twice (succ (succ)))) 0)
==> (twice ((succ (succ)) ((succ (succ)))) 0)
==> ((succ succ) ((succ succ) 0))
==> ((succ succ) (succ (succ 0)))
==> ((succ succ) 2)
==> (succ (succ 2))
==> 4
-}
{-
ev "((lambda (x) ((let { x = (lambda (x) (+ x 1)) } x) x)) 3)"
(def f (x) (((lambda (x) (let { x = (lambda (x) (+ x 1)) } x)) x) x))
(def f (x) (((lambda (x) ((lambda (x) x) (lambda (x) (+ x 1)))) x) x))
(lambda (x) ((let { x = (lambda (x) ((let {x = (lambda (x y) (+ x y)) } x) x 1)) } x) x))
# f x = ((\x -> let x = (\x -> x + 1) in x) x) x
# let f x = ((\x -> (let x = \x -> x + 1 in x)) x) x in f
-}