Direct-Style Monads

fpm2012.ml

(* Direct-Style Monads in OchaCaml *)
type 'a option = Some of 'a | None
;;

let return x = Some x
;;

let bind x f =
  match x with
  | Some x -> f x
  | None -> None
;;

let rec find pred = function
  | [] -> None
  | y::ys ->
      if pred y then
        Some y
      else
        find pred ys
;;

let reify thunk =
  reset (fun () ->
    let v = thunk () in
    return v)
;;

let reflect m =
  shift (fun k ->
    bind m k)
;;


let () =
  let res = reify (fun () ->
    let x = reflect (find (fun x -> x = "x") ["x"; "y"; "z"]) in
    let y = reflect (find (fun x -> x = 4) [3; 4; 5]) in
    (x, y)
  )
  in
  match res with
    Some (x, y) ->
      print_string ("Some (" ^ x ^ ", " ^ string_of_int y ^ ")");
      print_newline ()
  | None ->
      print_endline "None"
;;

Fpm2012.scala

// Direct-Style Monads in Scala
object Fpm2012 {
  trait Monad[M[_]] {
    def unit[A](x : A) : M[A]

    def bind[A, B](m : M[A], f : A => M[B]) : M[B]
  }

  implicit object OptionMonad extends Monad[Option] {
    def unit[A](x : A) = Some(x)

    def bind[A, B](m : Option[A], f : A => Option[B]) = m.flatMap(f)
  }

  implicit object ListMonad extends Monad[List] {
    def unit[A](x : A) = List(x)

    def bind[A, B](m : List[A], f : A => List[B]) = m.flatMap(f)
  }

  import scala.util.continuations._

  def reify[A, M[+_]](x : => A @cpsParam[M[A], M[A]])(implicit monad : Monad[M]) : M[A] =
    reset { monad.unit(x) }

  class Reflective[+A, M[_]](m : M[A], monad : Monad[M]) {
    def reflect[B]() : A @cpsParam[M[B], M[B]] = {
      shift { (k : A => M[B]) =>
        monad.bind(m, k)
      }
    }
  }

  implicit def Option2Reflective[A](xs : Option[A])(implicit monad : Monad[Option]) =
    new Reflective[A, Option](xs, monad)

  implicit def List2Reflective[A](xs : List[A])(implicit monad : Monad[List]) =
    new Reflective[A, List](xs, monad)

  def main(args: Array[String]) = {
    val res = reify {
      val left = List("x", "y", "z").find(_ == "x").reflect[(String, Int)]
      val right = List(4, 5, 6).find(_ == 5).reflect[(String, Int)]

      (left, right)
    }
    println(res)

    val res2 = reify {
      val (a, b) = List(("a", 1), ("x", 3), ("y", 6), ("z", 0)).reflect[Option[(String, Int)]]
      reify {
        val left = List("x", "y", "z").find(_ == a).reflect[(String, Int)]
        val right = List(4, 5, 6).find(_ == b).reflect[(String, Int)]
        (left, right)
      }
    }
    println(res2)
  }
}

fpm2012.scm

;;; Direct-Style Monads in Gauche
(use gauche.record)

(define-record-type Option #f option?)

(define-record-type (Some Option)
    (some x)
    some?
  (x option-get-value))

(define-record-type (None Option) (%none) none?)

(define none
  (let ((v (%none)))
    (lambda ()
      v)))

(define-method write-object ((obj Some) port)
  (format port "#<Some ~S>" (option-get-value obj)))

(define-method write-object ((obj None) port)
  (format port "#<None>"))

(use gauche.partcont)
(use util.match)

(define-syntax reify
  (syntax-rules ()
    ((_ exprs ...)
     (reset (let ((v (begin exprs ...)))
              (some v))))))

(define (reflect m)
  (shift k
    (match m
      (($ Some x) (k x))
      (($ None) m))))

(define (boolean->option v)
  (cond (v => some)
        (else (none))))

(define (find-opt pred xs)
  (boolean->option (find pred xs)))

(define (main args)
  (print
   (reify
    (let* ((a (reflect (find-opt (cut eq? <> 'x) '(x y z))))
           (b (reflect (find-opt (cut = <> 5) '(4 5 6)))))
      (list a b)))))