<commit_before>
module type MONAD = sig
  type 'a t
  val return : 'a -> 'a t
  val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
end

module NonLogical = struct
  type 'a t = unit -> 'a
  let return x () = x
  let (>>=) x f () = let y = x() in f y ()
end

type ('a, 'b) list_view =
  | Nil of exn
  | Cons of 'a * 'b

(** The monad is parametrised in the types of state, environment and
    writer. *)
module type Param = sig
  (** Read only *)
  type e
(** Write only *)
  type w
(** [w] must be a monoid *)
  val wunit : w
  val wprod : w -> w -> w
(** Read-write *)
  type s
(** Update-only. Essentially a writer on [u->u]. *)
  type u
(** [u] must be pointed. *)
  val uunit : u
end

module Logical (P:Param) = struct
  type state = {
    e: P.e;
    w: P.w;
    s: P.s;
    u: P.u;
  }

  type _ t =
    | Ignore : _ t -> unit t
    | Return : 'a -> 'a t
    | Bind : 'a t * ('a -> 'b t) -> 'b t
    | Map : 'a t * ('a -> 'b) -> 'b t
    | Get : P.s t
    | Set : P.s -> unit t
    | Modify : (P.s -> P.s) -> unit t
    | Put : P.w -> unit t
    | Current : P.e t
    | Local : P.e * 'a t -> 'a t (* local bind *)
    | Update : (P.u -> P.u) -> unit t
    | Zero : exn -> 'a t
    | WithState : state * 'a t -> 'a t (* use other state *)
    | Plus : 'a t * (exn -> 'a t ) -> 'a t
    | Split : 'a t -> ('a, exn -> 'a t) list_view t
    | Once : 'a t -> 'a t  (* keep at most one element *)
    | Break : (exn -> exn option) * 'a t -> 'a t

  let return x = Return x
  let (>>=) x f = Bind (x, f)
  let map f x = Map (x, f)
  let ignore x = Ignore x
  let set x = Set x
  let get = Get
  let modify f = Modify f
  let put x = Put x
  let current = Current
  let local x y = Local (x, y)
  let update f = Update f
  let zero e = Zero e
  let with_state st x = WithState (st, x)
  let plus a f = Plus (a, f)
  let split x = Split x
  let once x = Once x
  let break f x = Break (f, x)

  type 'a reified =
    | RNil of exn
    | RCons of 'a * (exn -> 'a reified)

  let repr r () = match r with
    | RNil e -> Nil e
    | RCons (x, f) -> Cons (x, f)

  let cons x cont = Cons (x, cont)
  let nil e = Nil e
<commit_msg>wip: a few simplifications in backtrack<commit_after>
module type MONAD = sig
  type 'a t
  val return : 'a -> 'a t
  val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
end

module NonLogical = struct
  type 'a t = unit -> 'a
  let return x () = x
  let (>>=) x f () = let y = x() in f y ()
end

type ('a, 'b) list_view =
  | Nil of exn
  | Cons of 'a * 'b

(** The monad is parametrised in the types of state, environment and
    writer. *)
module type Param = sig
  (** Read only *)
  type e
(** Write only *)
  type w
(** [w] must be a monoid *)
  val wunit : w
  val wprod : w -> w -> w
(** Read-write *)
  type s
(** Update-only. Essentially a writer on [u->u]. *)
  type u
(** [u] must be pointed. *)
  val uunit : u
end

module Logical (P:Param) = struct
  type state = {
    e: P.e;
    w: P.w;
    s: P.s;
    u: P.u;
  }

  type _ t =
    | Ignore : _ t -> unit t
    | Return : 'a -> 'a t
    | Bind : 'a t * ('a -> 'b t) -> 'b t
    | Map : 'a t * ('a -> 'b) -> 'b t
    | Get : P.s t
    | Set : P.s -> unit t
    | Modify : (P.s -> P.s) -> unit t
    | Put : P.w -> unit t
    | Current : P.e t
    | Local : P.e * 'a t -> 'a t (* local bind *)
    | Update : (P.u -> P.u) -> unit t
    | Zero : exn -> 'a t
    | WithState : state * 'a t -> 'a t (* use other state *)
    | Plus : 'a t * (exn -> 'a t ) -> 'a t
    | Split : 'a t -> ('a, exn -> 'a t) list_view t
    | Once : 'a t -> 'a t  (* keep at most one element *)
    | Break : (exn -> exn option) * 'a t -> 'a t

  let return x = Return x

  let (>>=) x f = Bind (x, f)

  let map f x = match x with
    | Return x -> return (f x)
    | Map (y, g) -> Map (y, fun x -> f (g x))
    | _ -> Map (x, f)

  let rec ignore : type a. a t -> unit t = function
    | Return _ -> Return ()
    | Map (x, _) -> ignore x
    | x -> Ignore x

  let set x = Set x
  let get = Get
  let modify f = Modify f
  let put x = Put x
  let current = Current
  let local x y = Local (x, y)
  let update f = Update f
  let zero e = Zero e
  let with_state st x = WithState (st, x)

  let rec plus a f = match a with
    | Zero e -> f e
    | Plus (a1, f1) ->
      plus a1 (fun e -> plus (f1 e) f)

  let split x = Split x

  let rec once : type a. a t -> a t = function
    | Zero e -> Zero e
    | Return x -> Return x
    | Map (x, f) -> map f (once x)
    | x -> Once x

  let break f x = Break (f, x)

  type 'a reified =
    | RNil of exn
    | RCons of 'a * (exn -> 'a reified)

  let repr r () = match r with
    | RNil e -> Nil e
    | RCons (x, f) -> Cons (x, f)

  let cons x cont = Cons (x, cont)
  let nil e = Nil e

{'fraction_non_alphanumeric': 0.1672005124919923, 'fraction_numerical': 0.0008541533205210335, 'mean_word_length': 1.7472140762463344, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 97, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5072034', 'n_tokens_mistral': 1926, 'n_tokens_neox': 1883, 'n_words': 800}