Source file standard.ml

(**************************************************************************)
(*                                                                        *)
(*                                 OCaml                                  *)
(*                                                                        *)
(*                 Simon Cruanes                                          *)
(*                                                                        *)
(*   Copyright 2017 Institut National de Recherche en Informatique et     *)
(*     en Automatique.                                                    *)
(*                                                                        *)
(*   All rights reserved.  This file is distributed under the terms of    *)
(*   the GNU Lesser General Public License version 2.1, with the          *)
(*   special exception on linking described in the file LICENSE.          *)
(*                                                                        *)
(**************************************************************************)


module Make2(Mon: Sigs2.MONAD2)
: Sigs2.SEQMON2TRAVERSORS
    with type ('a, 'e) mon := ('a, 'e) Mon.t
    with type ('a, 'e) callermon := ('a, 'e) Mon.t
    with type ('a, 'e) t := 'a Stdlib.Seq.t
= struct

  let return = Mon.return
  let ( let* ) = Mon.bind

  let rec equal eq xs ys =
    (* TODO: support ( and* ) with Beeg.join *)
    let xs = xs () in
    let ys = ys () in
    match xs, ys with
    | Stdlib.Seq.Nil, Stdlib.Seq.Nil ->
        return true
    | Cons (x, xs), Cons (y, ys) ->
        let* e = eq x y in
        if e then
          equal eq xs ys
        else
          return false
    | Nil, Cons (_, _)
    | Cons (_, _), Nil ->
        return false

  let rec compare cmp xs ys =
    let xs = xs () in
    let ys = ys () in
    match xs, ys with
    | Stdlib.Seq.Nil, Stdlib.Seq.Nil ->
        return 0
    | Cons (x, xs), Cons (y, ys) ->
        let* c = cmp x y in
        if c <> 0 then return c else compare cmp xs ys
    | Nil, Cons (_, _) ->
        return (-1)
    | Cons (_, _), Nil ->
        return (+1)

  let rec fold_left f acc seq =
    let n = seq () in
    match n with
    | Stdlib.Seq.Nil -> return acc
    | Cons (x, next) ->
        let* acc = f acc x in
        fold_left f acc next

  let rec iter f seq =
    let n = seq () in
    match n with
    | Stdlib.Seq.Nil -> return ()
    | Cons (x, next) ->
        let* () = f x in
        iter f next

  let rec iteri_aux f i xs =
    let n = xs () in
    match n with
    | Stdlib.Seq.Nil ->
        return ()
    | Cons (x, xs) ->
        let* () = f i x in
        iteri_aux f (i+1) xs
  let[@inline] iteri f xs = iteri_aux f 0 xs

  let rec fold_lefti_aux f accu i xs =
    let n = xs () in
    match n with
    | Stdlib.Seq.Nil ->
        return accu
    | Cons (x, xs) ->
        let* accu = f accu i x in
        fold_lefti_aux f accu (i+1) xs
  let[@inline] fold_lefti f accu xs = fold_lefti_aux f accu 0 xs

  let rec for_all p xs =
    let n = xs () in
    match n with
    | Stdlib.Seq.Nil ->
        return true
    | Cons (x, xs) ->
        let* b = p x in
        if b then
          for_all p xs
        else
          return false

  let rec exists p xs =
    let n = xs () in
    match n with
    | Stdlib.Seq.Nil ->
        return false
    | Cons (x, xs) ->
        let* b = p x in
        if b then
          return true
        else
          exists p xs

  let rec find p xs =
    let n = xs () in
    match n with
    | Stdlib.Seq.Nil ->
        return None
    | Cons (x, xs) ->
        let* b = p x in
        if b then return (Some x) else find p xs

  let rec find_map f xs =
    let n = xs () in
    match n with
    | Stdlib.Seq.Nil ->
        return None
    | Cons (x, xs) ->
        let* o = f x in
        match o with
        | None ->
            find_map f xs
        | Some _ as result ->
            return result

  let rec iter2 f xs ys =
    let n = xs () in
    match n with
    | Stdlib.Seq.Nil ->
        return ()
    | Cons (x, xs) ->
        let n = ys () in
        match n with
        | Stdlib.Seq.Nil ->
            return ()
        | Cons (y, ys) ->
            let* () = f x y in
            iter2 f xs ys

  let rec fold_left2 f accu xs ys =
    let n = xs () in
    match n with
    | Stdlib.Seq.Nil ->
        return accu
    | Cons (x, xs) ->
        let n = ys () in
        match n with
        | Stdlib.Seq.Nil ->
            return accu
        | Cons (y, ys) ->
            let* accu = f accu x y in
            fold_left2 f accu xs ys

  let rec for_all2 f xs ys =
    let n = xs () in
    match n with
    | Stdlib.Seq.Nil ->
        return true
    | Cons (x, xs) ->
        let n = ys () in
        match n with
        | Stdlib.Seq.Nil ->
            return true
        | Cons (y, ys) ->
            let* b = f x y in
            if b then
              for_all2 f xs ys
            else
              return false

  let rec exists2 f xs ys =
    let n = xs () in
    match n with
    | Stdlib.Seq.Nil ->
        return false
    | Cons (x, xs) ->
        let n = ys () in
        match n with
        | Stdlib.Seq.Nil ->
            return false
        | Cons (y, ys) ->
            let* b = f x y in
            if b then
              return true
            else
              exists2 f xs ys

end

module Make1(Mon: Sigs1.MONAD1)
: Sigs1.SEQMON1TRAVERSORS
    with type 'a mon := 'a Mon.t
    with type 'a callermon := 'a Mon.t
    with type 'a t := 'a Stdlib.Seq.t
= Make2
  (struct
    type ('a, 'e) t = 'a Mon.t
    let return = Mon.return
    let bind = Mon.bind
  end)