ligo/test/test.ml

module Monad_example = struct

  module X : sig
    type 'a t
    module Let_syntax : sig
      val return : 'a -> 'a t
      module Let_syntax : sig
        val return : 'a -> 'a t
        val bind   : 'a t -> ('a -> 'b t) -> 'b t
        val map    : 'a t -> f:('a -> 'b) -> 'b t
        val both   : 'a t -> 'b t -> ('a * 'b) t
        module Open_on_rhs  : sig val return : 'a -> 'a t end
      end
    end
  end = struct
    type 'a t = 'a
    let return x = x
    let bind x f = f x
    let map x ~f = f x
    let both x y = (x, y)
    module Let_syntax = struct
      let return = return
      module Let_syntax = struct
        let return = return
        let bind   = bind
        let map    = map
        let both   = both
        module Open_on_rhs  = struct let return = return end
      end
    end
  end

  open X.Let_syntax

  let _mf a : _ X.t =
    let%bind_open x = a in
    return (x + 1)

  let _mf' a b c : _ X.t =
    let%bind_open x = a and y = b and (u, v) = c in
    return (x + y + (u * v))

  let _mg a : _ X.t =
    let%map x = a in
    x + 1

  let _mg' a b c : _ X.t =
    let%map x = a and y = b and (u, v) = c in
    x + y + (u * v)

  let _mh a : _ X.t =
    match%bind_open a with
    | 0 -> return true
    | _ -> return false

  let _mi a : _ X.t =
    match%map a with
    | 0 -> true
    | _ -> false
end

module Applicative_example = struct

  module X : sig
    type 'a t
    module Let_syntax : sig
      val return : 'a -> 'a t
      module Let_syntax : sig
        val return : 'a -> 'a t
        val map    : 'a t -> f:('a -> 'b) -> 'b t
        val both   : 'a t -> 'b t -> ('a * 'b) t
        module Open_on_rhs : sig
          val flag : int t
          val anon : int t
        end
      end
    end
  end = struct
    type 'a t = 'a
    let return x = x
    let map x ~f = f x
    let both x y = (x, y)
    module Let_syntax = struct
      let return = return
      module Let_syntax = struct
        let return = return
        let map    = map
        let both   = both
        module Open_on_rhs = struct
          let flag = 66
          let anon = 77
        end
      end
    end
  end

  open X.Let_syntax

  (* {[
       let _af a : _ X.t =
         let%bind x = a in (* "Error: Unbound value Let_syntax.bind" *)
         return (x + 1)
     ]} *)

  (* {[
       let _af' a b c : _ X.t =
         let%bind x = a and y = b and (u, v) = c in (* "Error: Unbound value Let_syntax.bind" *)
         return (x + y + (u * v))
     ]} *)

  let _ag a : _ X.t =
    let%map x = a in
    x + 1

  let _ag' a b c : _ X.t =
    let%map x = a and y = b and (u, v) = c in
    x + y + (u * v)

  (* {[
       let _ah a : _ X.t =
         match%bind a with (* "Error: Unbound value Let_syntax.bind" *)
         | 0 -> return true
         | _ -> return false
     ]} *)

  let _ai a : _ X.t =
    match%map a with
    | 0 -> true
    | _ -> false
end