sophia/priv/stdlib/List.aes

include "ListInternal.aes"

namespace List =

  function is_empty(l : list('a)) : bool = switch(l)
    [] => true
    _  => false

  function first(l : list('a)) : option('a) = switch(l)
    []   => None
    h::_ => Some(h)

  function tail(l : list('a)) : option(list('a)) = switch(l)
    []   => None
    _::t => Some(t)

  function last(l : list('a)) : option('a) = switch(l)
    []   => None
    [x]  => Some(x)
    _::t => last(t)

  function drop_last(l : list('a)) : option(list('a)) = switch(l)
    [] => None
    _  => Some(drop_last_unsafe(l))

  function drop_last_unsafe(l : list('a)) : list('a) = switch(l)
    [_]  => []
    h::t => h::drop_last_unsafe(t)
    []   => abort("drop_last_unsafe: list empty")


  function contains(e : 'a, l : list('a)) = switch(l)
    []   => false
    h::t => h == e || contains(e, t)

/** Finds first element of `l` fulfilling predicate `p` as `Some` or `None`
 * if no such element exists.
 */
  function find(p : 'a => bool, l : list('a)) : option('a) = switch(l)
    []   => None
    h::t => if(p(h)) Some(h) else find(p, t)

/** Returns list of all indices of elements from `l` that fulfill the predicate `p`.
 */
  function find_indices(p : 'a => bool, l : list('a)) : list(int) = find_indices_(p, l, 0)
  private function find_indices_( p : 'a => bool
                                , l : list('a)
                                , n : int
                                ) : list(int) = switch(l)
    []   => []
    h::t =>
     let rest = find_indices_(p, t, n+1)
     if(p(h)) n::rest else rest

  function nth(n : int, l : list('a)) : option('a) =
    switch(l)
      []   => None
      h::t => if(n == 0) Some(h) else nth(n-1, t)

  /* Unsafe version of `nth` */
  function get(n : int, l : list('a)) : 'a =
    switch(l)
      [] => abort(if(n < 0) "Negative index get" else "Out of index get")
      h::t => if(n == 0) h else get(n-1, t)


  function length(l : list('a)) : int = length_(l, 0)
  private function length_(l : list('a), acc : int) : int = switch(l)
    []   => acc
    _::t => length_(t, acc + 1)


/** Creates an ascending sequence of all integer numbers
 * between `a` and `b` (including `a` and `b`)
 */
  function from_to(a : int, b : int) : list(int) = [a..b]

/** Creates an ascending sequence of integer numbers betweeen
 * `a` and `b` jumping by given `step`. Includes `a` and takes
 * `b` only if `(b - a) mod step == 0`. `step` should be bigger than 0.
 */
  function from_to_step(a : int, b : int, s : int) : list(int) =
    require(s > 0, "List.from_to_step: non-positive step")
    from_to_step_(a, b - (b-a) mod s, s, [])
  private function from_to_step_(a : int, b : int, s : int, acc : list(int)) : list(int) =
    if(b < a) acc
    else from_to_step_(a, b - s, s, b::acc)


/** Unsafe. Replaces `n`th element of `l` with `e`. Crashes on over/underflow
 */
  function replace_at(n : int, e : 'a, l : list('a)) : list('a) =
    if(n<0) abort("insert_at underflow") else replace_at_(n, e, l)
  private function replace_at_(n : int, e : 'a, l : list('a)) : list('a) =
   switch(l)
     []   => abort("replace_at overflow")
     h::t => if (n == 0) e::t
             else h::replace_at_(n-1, e, t)

/** Unsafe. Adds `e` to `l` to be its `n`th element. Crashes on over/underflow
 */
  function insert_at(n : int, e : 'a, l : list('a)) : list('a) =
    if(n<0) abort("insert_at underflow") else insert_at_(n, e, l)
  private function insert_at_(n : int, e : 'a, l : list('a)) : list('a) =
   if (n == 0) e::l
   else switch(l)
     []   => abort("insert_at overflow")
     h::t => h::insert_at_(n-1, e, t)

/** Assuming that cmp represents `<` comparison, inserts `x` before
 * the first element in the list `l` which is greater than it
 */
  function insert_by(cmp : (('a, 'a) => bool), x : 'a, l : list('a)) : list('a) =
    switch(l)
      []   => [x]
      h::t =>
        if(cmp(x, h)) // x < h
          x::l
        else
          h::insert_by(cmp, x, t)


  function foldr(cons : ('a, 'b) => 'b, nil : 'b, l : list('a)) : 'b = switch(l)
    []   => nil
    h::t => cons(h, foldr(cons, nil, t))

  function foldl(rcons : ('b, 'a) => 'b, acc : 'b, l : list('a)) : 'b = switch(l)
    []   => acc
    h::t => foldl(rcons, rcons(acc, h), t)

  function foreach(l : list('a), f : 'a => unit) : unit =
    switch(l)
     []    => ()
     e::l' =>
       f(e)
       foreach(l', f)

  function reverse(l : list('a)) : list('a) = reverse_(l, [])
  private function reverse_(l : list('a), acc : list('a)) : list('a) = switch(l)
    [] => acc
    h::t => reverse_(t, h::acc)

  function map(f : 'a => 'b, l : list('a)) : list('b) = switch(l)
    [] => []
    h::t => f(h)::map(f, t)

/** Effectively composition of `map` and `flatten`
 */
  function flat_map(f : 'a => list('b), l : list('a)) : list('b) =
    ListInternal.flat_map(f, l)

  function filter(p : 'a => bool, l : list('a)) : list('a) = switch(l)
    []   => []
    h::t =>
      let rest = filter(p, t)
      if(p(h)) h::rest else rest

/** Take up to `n` first elements
 */
  function take(n : int, l : list('a)) : list('a) =
    if(n < 0) abort("Take negative number of elements") else take_(n, l)
  private function take_(n : int, l : list('a)) : list('a) =
    if(n == 0) []
    else switch(l)
      []   => []
      h::t => h::take_(n-1, t)

/** Drop up to `n` first elements
 */
  function drop(n : int, l : list('a)) : list('a) =
   if(n < 0) abort("Drop negative number of elements") else drop_(n, l)
  private function drop_(n : int, l : list('a)) : list('a) =
   if (n == 0) l
   else switch(l)
      []   => []
      _::t => drop_(n-1, t)

/** Get the longest prefix of a list in which every element
 * matches predicate `p`
 */
  function take_while(p : 'a => bool, l : list('a)) : list('a) = switch(l)
    []   => []
    h::t => if(p(h)) h::take_while(p, t) else []

/** Drop elements from `l` until `p` holds
 */
  function drop_while(p : 'a => bool, l : list('a)) : list('a) = switch(l)
    []   => []
    h::t => if(p(h)) drop_while(p, t) else l

/** Splits list into two lists of elements that respectively
 * match and don't match predicate `p`
 */
  function partition(p : 'a => bool, lst : list('a)) : (list('a) * list('a)) = switch(lst)
    []   => ([], [])
    h::t =>
      let (l, r) = partition(p, t)
      if(p(h)) (h::l, r) else (l, h::r)

  function flatten(l : list(list('a))) : list('a) = switch(l)
    []   => []
    h::t => h ++ flatten(t)

  function all(p : 'a => bool, l : list('a)) : bool = switch(l)
    []   => true
    h::t => if(p(h)) all(p, t) else false

  function any(p : 'a => bool, l : list('a)) : bool = switch(l)
    []   => false
    h::t => if(p(h)) true else any(p, t)

  function sum(l : list(int)) : int = switch(l)
    []   => 0
    h::t => h + sum(t)

  function product(l : list(int)) : int = switch(l)
    []   => 1
    h::t => h * sum(t)

/** Zips two list by applying bimapping function on respective elements.
 * Drops the tail of the longer list.
 */
  private function zip_with( f : ('a, 'b) => 'c
                            , l1 : list('a)
                            , l2 : list('b)
                            ) : list('c) = switch ((l1, l2))
    (h1::t1, h2::t2) => f(h1, h2)::zip_with(f, t1, t2)
    _ => []

/** Zips two lists into list of pairs.
 * Drops the tail of the longer list.
 */
  function zip(l1 : list('a), l2 : list('b)) : list('a * 'b) = zip_with((a, b) => (a, b), l1, l2)

  function unzip(l : list('a * 'b)) : (list('a) * list('b)) = switch(l)
    []          => ([], [])
    (h1, h2)::t =>
      let (t1, t2) = unzip(t)
      (h1::t1, h2::t2)


  /** Merges two sorted lists using `lt` comparator
   */
  function
    merge : (('a, 'a) => bool, list('a), list('a)) => list('a)
    merge(lt, x::xs, y::ys) =
      if(lt(x, y)) x::merge(lt, xs, y::ys)
      else y::merge(lt, x::xs, ys)
    merge(_, [], ys) = ys
    merge(_, xs, []) = xs


  /** Mergesort inspired by
   * https://hackage.haskell.org/package/base-4.14.1.0/docs/src/Data.OldList.html#sort
   */
  function
    sort : (('a, 'a) => bool, list('a)) => list('a)
    sort(_, []) = []
    sort(lt, l) =
      merge_all(lt, monotonic_subs(lt, l))

  /** Splits list into compound increasing sublists
   */
  private function
    monotonic_subs : (('a, 'a) => bool, list('a)) => list(list('a))
    monotonic_subs(lt, x::y::rest) =
      if(lt(y, x)) desc(lt, y, [x], rest)
      else asc(lt, y, [x], rest)
    monotonic_subs(_, l) = [l]

  /** Extracts the longest descending prefix and proceeds with monotonic split
   */
  private function
    desc : (('a, 'a) => bool, 'a, list('a), list('a)) => list(list('a))
    desc(lt, x, acc, h::t) =
      if(lt(x, h)) (x::acc) :: monotonic_subs(lt, h::t)
      else desc(lt, h, x::acc, t)
    desc(_, x, acc, []) = [x::acc]

  /** Extracts the longest ascending prefix and proceeds with monotonic split
   */
  private function
    asc : (('a, 'a) => bool, 'a, list('a), list('a)) => list(list('a))
    asc(lt, x, acc, h::t) =
      if(lt(h, x)) reverse(x::acc) :: monotonic_subs(lt, h::t)
      else asc(lt, h, x::acc, t)
    asc(_, x, acc, []) = [reverse(x::acc)]

  /** Merges list of sorted lists
   */
  private function
    merge_all : (('a, 'a) => bool, list(list('a))) => list('a)
    merge_all(_, [part]) = part
    merge_all(lt, parts) = merge_all(lt, merge_pairs(lt, parts))

  /** Single round of `merge_all` – pairs of lists in a list of list
   */
  private function
    merge_pairs : (('a, 'a) => bool, list(list('a))) => list(list('a))
    merge_pairs(lt, x::y::rest) = merge(lt, x, y) :: merge_pairs(lt, rest)
    merge_pairs(_, l) = l


/** Puts `delim` between every two members of the list
 */
  function intersperse(delim : 'a, l : list('a)) : list('a) = switch(l)
    []   => []
    [e]  => [e]
    h::t => h::delim::intersperse(delim, t)

/** Effectively a zip with an infinite sequence of natural numbers
 */
  function enumerate(l : list('a)) : list(int * 'a) = enumerate_(l, 0)
  private function enumerate_(l : list('a), n : int) : list(int * 'a) = switch(l)
    []   => []
    h::t => (n, h)::enumerate_(t, n + 1)