prelude.zero

// naming conventions
// x, y, z unspecified type
// f, g, h function type
// n, m, k integer type
// b, c    boolean type
// p, q    boolean-valued function
// m*      maybe of *
// *s      list of *
// **      pair of * and *

// universal
x.f := f(x)                      // uniform function call syntax
f || x := f(x)                   // low precedence application
f <> g := x -> f(g(x))           // function composition
`f(x, y) := f(y, x)              // flip order of first two arguments of function
id(x) := x                       // identity function
constant(x) := _ -> x            // return value does not depend on parameter
on(f, g) := x -> y -> f(g(x), g(y)) // apply binary f with unary g applied first
mirror(f)(x) := f(x, x)          // convert binary function to unary function
undefined := error("undefined")

// boolean logic
true(t, f) := t
false(t, f) := f
if(c, x, y) := c(x, y)
(?) := if

!b := b ? false || true
b /\ c := b ? c || false
b \/ c := b ? true || c
b => c := b ? c || true
b <=> c := b ? c || !c

// pairs
(,)(x, y)(f) := f(x, y)     // this definition is for (,) and sections
first(xy) := xy(true)
second(xy) := xy(false)
swap((x, y)) := (y, x)

// function methods
f^^(n)(z) := n < 0 ? error("(^^): negative") || n = 0 ? z || f^^(n - 1)(f(z))
until(f, p, z) := p(z) ? z || f.until(p, f(z))
while(f, p, z) := f.until((!) <> p, z)
curry(f) := x -> y -> f((x, y))
uncurry(f) := xx -> f(first(xx), second(xx))

// more pairs
mapPair(xx, f) := (,).on(f).uncurry(xx)

// maybe
nothing := z -> f -> z
just(x) := z -> f -> f(x)
isNothing(mx) := mx(true, constant(false))
isJust(mx) := mx(false, constant(true))
fromJust(mx) := mx(error("fromJust: not a just"), id)
maybe(x, f, mx) := mx(x, f)
mx >>= f := mx(nothing, f)                   // maybe chaining (bind)
mx ?|| x := mx(x, id)                        // just value or default

// math
abs(n) := n >= 0 ? n || -n
sign(n) := n = 0 ? 0 || n > 0 ? 1 || -1
min(n, m) := n <= m ? n || m
max(n, m) := n >= m ? n || m
mod(n, m) := n % m
even(n) := n.mod(2) = 0
odd(n) := n.mod(2) != 0
divides(n, m) := m.mod(n) = 0
factorial(n) := (n = 0) ? 1 || n * factorial(n - 1)
gcd(n, m) := (m = 0) ? n || gcd(m, n.mod(m))
n ^ m := (
    m = 0 ? 1
    m < 0 ? 1 / n ^ -m
    even(m) ? (*).mirror(n ^ (m / 2))
    n * n ^ (m - 1)
)

// list basics
x :: xs := (x, xs)                     // prepend element to list (cons)
prepend := `(::)
isEmpty(xs) := xs(_ -> _ -> false)
head(xs) := isEmpty(xs) ? error("head: empty list") || first(xs)
--xs := isEmpty(xs) ? error("dropHead: empty list") || second(xs)
drop(xs, n) := (--)^^(n)(xs)            // drop n elements from front of list
take(xs, n) := n = 0 ? [] || xs.head :: (--xs).take(n - 1)
xs[n] := head(xs.drop(n))          // get element of list at index
slice(xs, start, end) := xs.drop(start).take(end - start)
xs =:= ys := xs.isEmpty \/ ys.isEmpty ? xs.isEmpty <=> ys.isEmpty ||
    xs[0] = ys[0] /\ --xs =:= --ys       // integer list equality
last(xs) := (--).until(isEmpty <> (--), xs)[0] // get last element of list
dropLast(xs) := xs =:= [] \/ --xs =:= [] ? [] || xs[0] :: dropLast(--xs)
dropWhile(ns, p) := (--).while(p <> head, ns)
takeWhile(ns, p) := ns.isEmpty \/ !p(ns[0]) ? [] || ns[0] :: takeWhile(--ns, p)

takeSafe(xs, n) := (
    n = 0 ? just([])
    xs.isEmpty ? nothing
    takeSafe(--xs, n - 1) >>= just <> (xs[0] ::)
)

apply(f, arguments) := (
    arguments.isEmpty ? f
    apply(f(arguments[0]), --arguments)
)

// syntactic helpers
xs ::? f := isEmpty(xs) ? [] || f(head(xs), --xs)

// list folds
foldr(xs, f, z) := if(isEmpty(xs), z, f(head(xs), foldr(--xs, f, z)))
foldl(xs, f, z) := if(isEmpty(xs), z, foldl(--xs, f, f(z, head(xs))))
reducer(xs, f) := (--xs).foldr(f, xs[0])
reducel(xs, f) := (--xs).foldl(f, xs[0])

// list fold operations
xs ++ ys := xs.foldr((::), ys)                   // concatenate two lists
length(xs) := xs.foldr(constant((+ 1)), 0)         // get length of list
(#) := length

// generic list constructors
iterate(f, x) := x :: iterate(f, f(x))       // iteratively apply f
repeat(x) := x :: repeat(x)                  // infinitely repeat one element
replicate(x, n) := (x ::)^^(n)([])         // replicate one element n times
cycle(xs) := xs ++ cycle(xs)                 // infinitely cycle list

// generic list transformations
filter(xs, p) := foldr(xs, x -> xs' -> if(p(x), x :: xs', xs'), [])
(|) := filter
map(xs, f) := foldr(xs, (::) <> f, [])          // map function over list
zipWith(xs, f, ys) := xs =:= [] \/ ys =:= [] ? [] ||
    f(xs[0], ys[0]) :: zipWith(--xs, f, --ys)
zip(xs, ys) := zipWith(xs, (,), ys)
unzip(xs) := (xs.map(first), xs.map(second))
join(xss) := xss.foldr((++), [])            // concatenate list of lists
reverse(xs) := xs.foldl(`(::), [])
interleave(xs, y) := xs ::? x -> xs' ->
    xs' =:= [] ? xs || x :: y :: interleave(xs', y)
joinWith(xss, ys) := join(interleave(xss, ys))
bisect(xs, p) := (xs | p, xs | (!) <> p)

// generic list reducers
any(xs, p) := xs.map(p).foldr((\/), false)     // test if any element satisfies p
all(xs, p) := xs.map(p).foldr((/\), true)      // test if all elements satisfy p
// find first element satisfying p, or return nothing
find(xs, p) := xs =:= [] ? nothing || p(xs[0]) ? just(xs[0]) || (--xs).find(p)

lookup(table, key) := table.isEmpty ? nothing ||
    table[0].first =:= key ? just(table[0].second) || (--table).lookup(key)
containsKey(table, key) := isJust(table.lookup(key))
remove(table, key) := table | (key', _) -> !(key' =:= key)
insert(table, key, value) := (key, value) :: table.remove(key)
getKeys(table) := table.map(first)
getValues(table) := table.map(second)
mapKeys(table, f) := table.map((key, value) -> (f(key), value))
mapValues(table, f) := table.map((key, value) -> (key, f(value)))
union(tableA, tableB) := (
    tableB.isEmpty ? tableA
    tableA.containsKey(tableB[0].first) ? union(tableA, --tableB)
    union(tableB[0] :: tableA, --tableB)
)

indexOf(nss, key) := (
    indexOf'(list, depth) := (
        list =:= [] ? nothing
        list[0] =:= key ? just(depth)
        indexOf'(--list, depth + 1)
    )
    indexOf'(nss, 0)
)
contains(nss, key) := isJust(nss.indexOf(key))

// integer list basics
n : ns := ns.any((= n))
n !: ns := !(n : ns)

// integer list constructors
n .. m := n > m ? [] || n :: (n + 1 .. m)

// integer list transformations
sort(ns) := ns ::? k -> ks -> sort(ks | (<= k)) ++ [k] ++ sort(ks | (> k))
deduplicate(ns) := ns ::? k -> ks -> k :: deduplicate(ks | (!= k))
ns <: ms := ns.all((: ms))
ns ** ms := join(ns.map(n -> ms.map(m -> (n, m))))

startsWith(ns, ks) := ks.isEmpty ? true ||
    ns.isEmpty \/ ns[0] != ks[0] ? false || startsWith(--ns, --ks)

split(ns, p) := (
    ns.isEmpty ? ([], [])
    p(ns) ? ([], ns)
    (before, after) := (--ns).split(p)
    (ns[0] :: before, after)
)

splitAt(xs, n) := (xs.take(n), xs.drop(n))
splitWhen(ns, p) := ns.split(p <> head)
splitOn(ns, delimiter) := ns.split(`startsWith(delimiter))

splitWith(ns, splitter) := (
    (before, after) := splitter(ns)
    before.isEmpty ? ([], ns)
    (before', after') := after.splitWith(splitter)
    (before ++ before', after')
)

partition(ns, splitter) := (
    ns.isEmpty ? []
    (before, after) := splitter(ns)
    before :: partition(after, splitter)
)

dropIf(ns, p) := ns =:= [] ? [] || p(ns[0]) ? --ns || ns
dropPrefix(ns, prefix) := ns.startsWith(prefix) ? ns.drop(#prefix) || ns

partitionBy(ns, p) := ns.partition(`splitWhen(p) <> `dropIf(p))
partitionOn(ns, delimiter) := ns.partition(
    `splitOn(delimiter) <> `dropPrefix(delimiter))

words(ns) := ns.partitionOn(" ") | (!) <> isEmpty
lines(ns) := ns.partitionOn("\n")

repl(in, prompt, f) := prompt ++ in.lines.map(f).joinWith("\n" ++ prompt)

// integer list reducers
sum(ns) := ns.foldl((+), 0)
product(ns) := ns.foldl((*), 1)
minimum(ns) := ns.reducel(min)
maximum(ns) := ns.reducel(max)

// infinite lists
countFrom := iterate((+ 1))
naturals := countFrom(0)
primes := (
    filterPrime(ns) := ns ::? n -> ns' ->
        n :: filterPrime(ns' | n' -> n' % n != 0)
    filterPrime(countFrom(2))
)

// ASCII character classes
isUppercase(n) := n >= 'A' /\ n <= 'Z'
isLowercase(n) := n >= 'a' /\ n <= 'z'
isDigit(n) := n >= '0' /\ n <= '9'
isQuote(n) := n = '"' \/ n = '\''
isWhitespace(n) := n = ' ' \/ n >= '\t' /\ n <= '\r'
isBlank(n) := n = ' ' \/ n = '\t'
isControl(n) := n >= 0 /\ n < 32 \/ n = 127
isAlphabetic(n) := isUppercase(n) \/ isLowercase(n)
isAlphanumeric(n) := isAlphabetic(n) \/ isDigit(n)
isPrintable(n) := n < 127 /\ !isControl(n)
isGraphical(n) := isPrintable(n) /\ !isBlank(n)
isPunctuation(n) := isGraphical(n) /\ !isAlphanumeric(n)

// serialization
showBoolean(b) := b ? "true" || "false"
showNatural(n) := (
    showReversedNatural(m) := m = 0 ? [] ||
        ('0' + m.mod(10)) :: showReversedNatural(m / 10)
    n = 0 ? "0" || reverse(showReversedNatural(n))
)

showString(ns) := "\"" ++ ns ++ "\""     // todo: escape
showPair(xsxs) := "(" ++ xsxs.first ++ ", " ++ xsxs.second ++ ")"
showList(xs) := "[" ++ xs.joinWith(", ") ++ "]"
showInteger(n) := (n < 0 ? "-" || "") ++ showNatural(abs(n))

showStringPair(nsns) := showPair(nsns.mapPair(showString))
showIntegerPair(nn) := showPair(nn.mapPair(showInteger))
showStringIntegerPair(nsn) := showPair(
    (showString(nsn.first), showInteger(nsn.second)))

showStringList(nss) := showList(nss.map(showString))
showIntegerList(ns) := showList(ns.map(showInteger))
showIntegerPairList(nns) := showList(nns.map(showIntegerPair))
showIntegerListPair(nsns) := showPair(nsns.mapPair(showIntegerList))
showIntegerListList(nss) := showList(nss.map(showIntegerList))
showStringIntegerPairList(nsns) := showList(nsns.map(showStringIntegerPair))

// parsing
parseDigit(digit, base) :=
    isDigit(digit) /\ digit - '0' < base ? digit - '0' ||
    error("Invalid digit in base " ++ showInteger(base) ++ ": " ++ [digit])
parseNatural(string, base) :=
    string.foldl(x -> d -> base * x + parseDigit(d, base), 0)
parseInteger(string, base) := string.head = '-' ?
    -parseNatural(--string, base) || parseNatural(string, base)