Source

ocaml-logicm / logicM_list.ml

Full commit
      type 'a m = 'a list

      let return x = [x]

(*
      let list_rev_map_append f a b =
        let inner a acc =
          match a with
          | [] -> acc
          | h::t -> inner t ((f h) :: acc)
        in
          inner a b
*)

      let bind f m =
        List.fold_left (fun acc x -> List.rev_append (f x) acc) [] m

      let mzero = []

      let mplus = List.rev_append

      let mplusl a bl = mplus a (Lazy.force bl)

      let interleave = mplus

      let ( <+> ) = mplus

      let reflect r =
        match r with
        | None -> []
        | Some (h, t) -> h::t

      let msplit m =
        match m with
        | [] -> None
        | h::t -> Some (h, t)

      let once m =
        match m with
        | [] -> []
        | h::_t -> [h]

      let destruct_bindu m th el =
        match m with
        | [] -> el ()
        | h::t -> th h t

      let destruct_bind m th el =
        destruct_bindu m th (fun () -> el)

      let ifteu m th el =
        if m = []
        then el ()
        else bind th m

      let ret_unit = [()]

      let guard cond =
        if cond then ret_unit else []

      let ( >>= ) m f = bind f m

      let runL optnum m =
        match optnum with
        | None -> m
        | Some n ->
            if n >= List.length m
            then m
            else
              let rec inner acc n m =
                if n <= 0
                then acc
                else
                  match m with
                  | [] -> assert false
                  | h::t -> inner (h::acc) (n-1) t
              in
                inner [] n m

      let bagof optnum m =
        return (runL optnum m)

      let observe m =
        match m with
        | [] -> None
        | h::_t -> Some h

      let from_stream s =
        let rec inner acc =
          match ExtStream.Stream.get_opt s with
          | None -> acc
          | Some x -> inner (x :: acc)
        in
          inner []

      let filter cond m =
        let rec inner acc m =
          match m with
          | [] -> acc
          | h::t -> if cond h then inner (h::acc) t else inner acc t
        in
          inner [] m

      let ifm m ~th ~el =
        if m = []
        then el ()
        else th m

      let impl_name = "list"