order enforcement with/without a parameterized monad

monad.rs

// a parameterized monad.
// There is a revised version by @KeenS, which is rather sophisticated, at https://gist.github.com/KeenS/9665e098ade28fdcaf42bb77b9940c23#file-idx_monad-rs

pub mod idx {
    use std::marker::PhantomData;

    #[derive(Debug)]
    pub struct Idx<'a, X: 'a, Y: 'a, A:'a>{
        pub x: A,
        pre: PhantomData<&'a X>,
        post: PhantomData<&'a Y>,
    }

    pub fn bind<'a, X:'a, Y:'a, Z:'a, T:'a, U:'a, F: FnOnce(T) -> Idx<'a,Y,Z,U>>(m: Idx<'a,X,Y,T>, f: F) -> Idx<'a,X,Z,U> {
        let pre = m.pre;
        let r = f(m.x);
        Idx{x:r.x, pre:pre, post:r.post}
    }

    pub fn ret<'a, X:'a, T:'a>(x: T) -> Idx<'a,X,X,T> {
        Idx{x:x, pre:PhantomData, post:PhantomData}
    }

    pub fn run<'a,T:'a>(m:Idx<'a,(),(),T>) -> T {
        m.x
    }

    pub struct One;
    pub struct Two;
    
    pub fn op0to1<'a, T>(x : T) -> Idx<'a, (),One,T> {
        Idx{x:x, pre:PhantomData, post:PhantomData}
    }
    
    pub fn op1to2<'a, T>(x : T) -> Idx<'a, One,Two,T> {
        Idx{x:x, pre:PhantomData, post:PhantomData}
    }
    
    pub fn op2to0<'a, T>(x : T) -> Idx<'a, Two,(),T> {
        Idx{x:x, pre:PhantomData, post:PhantomData}
    }
}

// https://github.com/TeXitoi/rust-mdo/blob/9b5f44e4159e4587afe14f5d3d99e475022b0959/src/lib.rs#L48-L90

macro_rules! mdo {
    (
        let $p: pat = $e: expr ; $( $t: tt )*
    ) => (
        { let $p = $e ; mdo! { $( $t )* } }
    );

    (
        let $p: ident : $ty: ty = $e: expr ; $( $t: tt )*
    ) => (
        { let $p: $ty = $e ; mdo! { $( $t )* } }
    );

    (
        $p: pat =<< $e: expr ; $( $t: tt )*
    ) => (
        bind($e, move |$p| mdo! { $( $t )* } )
    );

    (
        $p: ident : $ty: ty =<< $e: expr ; $( $t: tt )*
    ) => (
        bind($e, move |$p : $ty| mdo! { $( $t )* } )
    );

    (
        ign $e: expr ; $( $t: tt )*
    ) => (
        bind($e, move |_| mdo! { $( $t )* })
    );

    (
        when $e: expr ; $( $t: tt )*
    ) => (
        bind(if $e { ret(()) } else { mzero() }, move |_| mdo! { $( $t )* })
    );

    (
        ret $f: expr
    ) => (
        $f
    )
}


fn main() {
    use idx::{bind, ret, run, op0to1, op1to2, op2to0};

    let m = || mdo! {
        z =<< ret(10);
        x =<< ret(20);
        ret ret(z+x)
    };
        
    println!("{:?}", run(m()));

    let m2 = mdo! {
        z =<< op0to1(123);
        x =<< op1to2(345);
        ign (op2to0(()));
        ret ret(z * x)
    };
        
    println!("{:?}", run(m2));

    
/*    
    let m = mdo! {
        z =<< op0to1(123);
        x =<< op2to0(345); // ERROR
        ret ret(z * x)
    };
*/
/*
error[E0308]: mismatched types
   --> main.rs:137:15
    |
135 |     let m = mdo! {
    |             - in this macro invocation
136 |         z =<< op0to1(123);
137 |         x =<< op2to0(345); // ERROR
    |               ^^^^^^^^^^^ expected struct `idx::One`, found struct `idx::Two`
    |
    = note: expected type `idx::Idx<'_, idx::One, _, _>`
    = note:    found type `idx::Idx<'_, idx::Two, (), {integer}>`

error: aborting due to previous error
*/

/*
    let m3 = mdo! {
        z =<< op0to1(123);
        x =<< op1to2(345);
        ign m(); // ERROR: m is monomorphic
        ign (op2to0(()));
        ret ret(z * x)
    };

    println!("{:?}", run(m2));
*/
/*
error[E0308]: mismatched types
   --> main.rs:111:13
    |
108 |     let m3 = mdo! {
    |              - in this macro invocation
...
111 |         ign m(); // ERROR: m is monomorphic
    |             ^^^ expected struct `idx::Two`, found ()
    |
    = note: expected type `idx::Idx<'_, idx::Two, _, _>`
    = note:    found type `idx::Idx<'_, (), (), {integer}>`

error: aborting due to previous error
*/
    

}

MonadTest.cr

# A monad in Crystal
class Id(T)
  getter :value
  
  def initialize(@value : T)
  end

  def bind(&x : T -> Id(U)) forall U
    yield @value
  end
end  

p (Id.new(1).bind {|x| Id.new(x+1) }).value


class CONS(HD,TL)
  getter :hd, :tl

  def initialize(@hd : HD, @tl : TL)
  end
end

class NIL
end

abstract class Lens(A,B,SS,TT)
  abstract def get(ss : SS) : A
  abstract def put(ss : SS, b : B) : TT
end

class L0(A,B,SS) < Lens(A,B,CONS(A,SS),CONS(B,SS))
  def get(ss)
#  def self.get(ss : CONS(A,SS))
    ss.hd
  end
  def put(ss, b)
#  def self.put(ss : CONS(A,SS), b : B)
    CONS.new(b,ss.tl)
  end
end    

c1 = CONS.new(1, NIL.new())
c2 = CONS.new(1, NIL.new())

# p (L0.get(c1) + 2)
# p (L0.get(L0.put(c2, "abc")) + "def")
# p L0.put(c1,"abc")
p (L0.new().get(c1) + 2)
p (L0.new().get(L0.put(c2, "abc")) + "def")
p L0.new().put(c1,"abc")
                 

class Idx(X,Y,T)
  getter :value
  
  def initialize(@value : T)
  end

  def bind(&x : T -> Idx(Y,Z,U)) forall Z,U
    yield @value
  end

  def self.run(m : Idx(Int32,Int32,T)) forall T
    m.value
  end
  
               
end  

p Idx.run(Idx(Int32,Int32,Int32).new(1).bind {|x| Idx(Int32,Int32,Int32).new(x+1) })

# p Idx.run(Idx.new(1).bind {|x| Idx.new(x+1) })
# Error in Test.cr:47: can't infer the type parameter X for the generic class Idx(X, Y, T). Please provide it explicitly
#
# p Idx.run(Idx.new(1).bind {|x| Idx.new(x+1) })
#               ^~~

MonadTest.java

// a parameterized monad in Java 8

import java.util.function.Function;
import java.util.function.Consumer;

public class MonadTest {
    static class Monad<X,Y,T> {
	private T x;
	Monad(T x) { this.x = x; }
	public <U,Z> Monad<X,Z,U> bind(Function<T,Monad<Y,Z,U>> f) {
	    return new Monad<X,Z,U>(f.apply(x).x);
	}
	public static <X,T> Monad<X,X,T> ret(T x) {
	    return new Monad<X,X,T>(x);
	}

	// for local type-inference
	// see for example http://qiita.com/kmizu/items/b603e9e42099f951caa5
	public <U> U let(Function<Monad<X,Y,T>, U> f) {
	    return f.apply(this);
	}
	public void let(Consumer<Monad<X,Y,T>> f) {
	    f.accept(this);
	}
    }

    public static <T> T run(Monad<Zero, Zero, T> m) {
	return m.x;
    }

    static class Zero {}
    static class One {}
    static class Two {}

    static <X> Monad<Zero, One, X> op0to1(X x) {
	return new Monad<>(x);
    }

    static <X> Monad<One, Two, X> op1to2(X x) {
	return new Monad<>(x);
    }

    static <X> Monad<Two, Zero, X> op2to0(X x) {
	return new Monad<>(x);
    }

    public static void main(String[] args)  {
	op0to1(100)
	.bind(x -> op1to2(200)
	.bind(y -> op2to0("")
	.bind(__ -> Monad.ret(x + y))))
	.let(m -> {
		System.out.println(run(m));
	    } );

// 	op0to1(100)
// 	.bind(x -> op1to2(200)
// 	.bind(y -> op1to2(x + y))) // ERROR
// 	.let(m -> { System.out.println(run(m)); } );

// Test.java:52: error: incompatible types: no instance(s) of type variable(s) X#1 exist so that Monad<One,Two,X#1> conforms to Monad<Two,Z,U>
//         .bind(x -> op1to2(200)
//              ^
//   where X#1,Z,U,T,Y,X#2 are type-variables:
//     X#1 extends Object declared in method <X#1>op1to2(X#1)
//     Z extends Object declared in method <U,Z>bind(Function<T,Monad<Y,Z,U>>)
//     U extends Object declared in method <U,Z>bind(Function<T,Monad<Y,Z,U>>)
//     T extends Object declared in class Monad
//     Y extends Object declared in class Monad
//     X#2 extends Object declared in class Monad
// Test.java:53: error: incompatible types: no instance(s) of type variable(s) X#1 exist so that Monad<One,Two,X#1> conforms to Monad<Two,Z,U>
//         .bind(y -> op1to2(x + y))) // ERROR
//              ^
//   where X#1,Z,U,T,Y,X#2 are type-variables:
//     X#1 extends Object declared in method <X#1>op1to2(X#1)
//     Z extends Object declared in method <U,Z>bind(Function<T,Monad<Y,Z,U>>)
//     U extends Object declared in method <U,Z>bind(Function<T,Monad<Y,Z,U>>)
//     T extends Object declared in class Monad
//     Y extends Object declared in class Monad
//     X#2 extends Object declared in class Monad
// 2 errors
    }
    
}

ord_op.rs

// non-monadic version of https://gist.github.com/keigoi/ff1d4352cfc158528db5ce539dfa41fd

pub mod ord_op {
    use std::marker::PhantomData;
    
    pub struct Wit<T> { dummy : PhantomData<T> }
    pub struct One;
    pub struct Two;
    
    pub fn op0to1<T>(_ : Wit<()>, x : T) -> (Wit<One>, T) {
        (Wit::<One> { dummy: PhantomData }, x)
    }
    
    pub fn op1to2<T>(_ : Wit<One>, x : T) -> (Wit<Two>, T) {
        (Wit::<Two> { dummy: PhantomData }, x)
    }
    
    pub fn op2to0<T>(_ : Wit<Two>, x : T) -> (Wit<()>, T) {
        (Wit::<()> { dummy: PhantomData }, x)
    }

    pub fn run<T, F: FnOnce(Wit<()>) -> (Wit<()>, T)>(f: F) -> T {
        let (_, x) = f (Wit::<()>{dummy:PhantomData});
        x
    }
    
}

fn main() {
    use ord_op::{run, op0to1, op1to2, op2to0};

    let res = run(|w| {
        let (w, x) = op0to1(w, 123);
        let (w, y) = op1to2(w, 456);
        let (w, _) = op2to0(w, ());
        (w, x+y)
    } );
    
    println!("{:?}", res);
    

    // let res = run(|w| {
    //     let (w, x) = op0to1(w, 123);
    //     let (w, y) = op1to2(w, 456);
    //     (w, x+y) // ERROR
    // } );

// error[E0308]: mismatched types
//   --> main2.rs:43:10
//    |
// 43 |         (w, x+y)
//    |          ^ expected (), found struct `ord_op::Two`
//    |
//    = note: expected type `ord_op::Wit<()>`
//    = note:    found type `ord_op::Wit<ord_op::Two>`
//
// error: aborting due to previous error


    // let res = run(|w0| {
    //     let (w, x) = op0to1(w0, 123);
    //     let (w, y) = op1to2(w, 456);
    //     let (_, _) = op2to0(w, ());
    //     (w0, x+y) // ERROR
    // } );

// error[E0382]: use of moved value: `w0`
//   --> main2.rs:62:10
//    |
// 59 |         let (w, x) = op0to1(w0, 123);
//    |                             -- value moved here
// ...
// 62 |         (w0, x+y)
//    |          ^^ value used here after move
//    |
//    = note: move occurs because `w0` has type `ord_op::Wit<()>`, which does not implement the `Copy` trait
//
// error: aborting due to previous error
    
}