exception Deadlock
fun yield(l,m) x=SMLofNJ.Cont.callcc(fn k =>
      (l:=SMLofNJ.Cont.throw k; (!m)(x); raise Deadlock))
fun bp(f)=let val r=ref(fn _=>raise Deadlock) in r:=(fn _=>f(r)); r end
fun fork f r=bp(fn r'=>(f(fn x=>yield(r',r)(SOME(x))); yield(r',r)(NONE)))

fun compareLexStreams cmp (f,g)=let
  val r=ref(fn _=>())
  val l=fork f r and m=fork g r
  fun run()=case (yield(r,l)(),yield(r,m)())
              of (NONE,NONE)=>EQUAL
               | (SOME(_),NONE)=>GREATER
               | (NONE,SOME(_))=>LESS
               | (SOME(x),SOME(y)) =>
            case cmp(x,y)
              of EQUAL=>run()
               | c=>c
in
  run()
end
  
datatype 'a t = L | N of 'a * 'a t * 'a t
fun appt f L=() | appt f (N(x,t,u))=(appt f t; f(x); appt f u)

fun compareLexInorder cmp (t,u)=
      compareLexStreams cmp (fn y=>appt y t,fn y=>appt y u)