(This is a crude translation of Scheme:ExplicitMonad)

Occasionally I see articles on writing Monads in Scheme:

A practical merit of Monads is that once you define a set of basic operations that satisfies the monad rules on a specific data structure, you can apply various generic operations over it. (It is a bit like that if you define call-with-iterators, you can apply various generic functions provided in gauche.collection).

There's a problem, though, when you want to use Monads in dynamically typed languages like Scheme. Basic monad operations require generic method to be dispatched with the type of return values. Runtime time dispatch requires some value at hand to determine which specialized method to be called; since the method hasn't been called, we don't have a return value, thus we can't know which method to be called.

Oleg's article above suggests defining basic monad operations in different names for different kind of monads, and locally rebound them depending on which kind of monad you're using. Although it works for macros like letM (Haskell's do), it is still difficult to define useful generic operations such as mapM agnostic to the kind of monads to be used.

Is it an inherent limitation of dynamic typing?

I don't think so. The fact is that Scheme's implementation uses less information than Haskell's---In Haskell's Monads, you are using more information as types. So, isn't it possible that Scheme can do the same thing if a programmer provides remaining information?

Specifically, a programmer can explicitly specify the kind of monads he expects as the return value.

I implemented this idea. Before going into the implementation of the infrastructure, let's look at some examples to see how the monadic programming looks like in this system.

Maybe monad

With this system, Maybe monad is defined as follows:

(define-monad Maybe
  (unitM (x)   (cons 'Just x))
  (bindM (m f) (match m
                 ('Nothing 'Nothing)
                 (('Just . x) (f x))))
  (failM (x)   'Nothing)
  (zeroM ()    'Nothing)
  (plusM (p q) (if (eq? p 'Nothing) q p))

unitM, bindM, failM, zeroM and plusM corresponds to return, >>=, fail, mzero and mplus in Haskell, respectively.

You can't use these monad operations directly.

gosh> (unitM 'x)
*** ERROR: unitM: monad is not expected

But if you express the kind of Monad you're expecting, it works:

gosh> (Maybe (unitM 'x))
(Just . x)

Let's implement the crone sheep example in All about monads. I used classes only to make nicer output (via write-object method), and it has nothing to do with Monads.

(define-class <sheep> ()
  ((name   :init-keyword :name)
   (father :init-keyword :father)
   (mother :init-keyword :mother)))

(define-method write-object ((s <sheep>) out)
  (format out "#<sheep ~a>" (ref s 'name)))

(define (sheep name . opts)
  (let-optionals* opts ((father #f) (mother #f))
    (make <sheep> :name name :father father :mother mother)))

(define (father s)
  (cond ((ref s 'father) => unitM)
        (else 'Nothing)))

(define (mother s)
  (cond ((ref s 'mother) => unitM)
        (else 'Nothing)))

(define (mothers-paternal-grandfather s)
  (letM* ((m  <- (mother s))
          (gf <- (father m)))
         (father gf)))

;; Create some sheep
(define mary (sheep 'mary))
(define adam (sheep 'adam))
(define john (sheep 'john adam #f))
(define mike (sheep 'mike #f   mary))
(define beth (sheep 'beth #f   mary))
(define suze (sheep 'suze john beth))
(define don  (sheep 'don  mike beth))
(define duke (sheep 'duke don  suze))

Look at the definitions of father, mother and mothers-paternal-grandfather; they are agnostic to which kind of Monads they're dealing with.

Once the caller specifies it expects Maybe monad, this example works:

gosh> (Maybe (mothers-paternal-grandfather duke))
(Just . #<sheep adam>)
gosh> (Maybe (mothers-paternal-grandfather don))

Generic monad operations

You can implement generic monad operations:

;; Haskell's sequence
;; seqM :: [m a] -> m [a]
(define (seqM ms)
  (define (mcons p q)
    (bindM p (lambda (x) (bindM q (lambda (y) (unitM (cons x y)))))))
  (fold-right mcons (unitM '()) ms))

;; mapM :: (a -> m b), [a] -> m [b]
(define (mapM proc args)
  (seqM (map proc args)))

;; foldM :: (a, b -> m a), a, [b] -> m a
(define (foldM proc seed lis)
  (if (null? lis)
    (unitM seed)
    (bindM (proc (car lis) seed)
           (lambda (seed2) (foldM proc seed2 (cdr lis))))))

Examples in here:

(define (baz xs)
  (define (bar x)
    (if (>= x 0)
      (unitM (sqrt x))
      (failM "I like positive")))
  (Maybe (mapM bar xs)))

gosh> (baz '(1 4 9))
(Just 1.0 2.0 3.0)
gosh> (baz '(1 -4 9))

State monad

The definition of State monad:

(define-monad State 
  (unitM (x)   (lambda (s) (values x s)))
  (bindM (m f) (lambda (s)
                 (receive (val s*) (m s)
                   ((f val) s*))))
  (getM  ()    (lambda (s) (values s s)))
  (putM  (s)   (lambda (_) (values #f s)))
  (runM  (m init) (m init)))

Here's a program that traverses a tree, and returns a new tree which has the same structure as the input, but each leaf is substituted by the number increasing in the order in which the leaf is visited.

(define (number-tree tree)
  (if (pair? tree)
    (letM* ((left  <- (number-tree (car tree)))
            (right <- (number-tree (cdr tree))))
           (unitM (cons left right)))
    (letM* ((n     <- (getM))
            (_     <- (putM (+ n 1))))
           (unitM n))))

You can call runM operation with specifying that you're expecting State monad.

gosh> (State (runM (number-tree '(((a . b) . c) (d . e) . f)) 0))
(((0 . 1) . 2) (3 . 4) . 5)

The above definition of number-tree works any monad that implements getM and putM as well as basic monad operations. However, you can specialize number-tree procedure to State monad by specifying it inside the procedure. If you define number-tree this way, the caller of number-tree doesn't need to know Monads at all.

(define (number-tree tree)
   (if (pair? tree)
     (letM* ((left  <- (number-tree (car tree)))
             (right <- (number-tree (cdr tree))))
            (unitM (cons left right)))
     (letM* ((n     <- (getM))
             (_     <- (putM (+ n 1))))
           (unitM n)))))

List monad

A definition of List monad:

(define-monad List
  (unitM (x)   (list x))
  (bindM (m f) (append-map f m))
  (failM (_)   '())
  (zeroM ()    '())
  (plusM (p q) (append p q))

The following is taken from an example in All About Monads. It parses input string either as hexadecimal or decimal number, or a word that consists only of alphabetic characters, and returns a list of all possible results. (The order of arguments of parse is reversed from Haskell version, only because foldM calls the given procedure with arguments in the order different from Haskell version).

(use util.match)

(define (parse-hex-digit parsed ch)
  (match parsed
    (('Hex n) (if (char-set-contains? #[0-9a-fA-F] ch)
                (unitM `(Hex ,(+ (* n 16) (digit->integer ch 16))))
    (_ (zeroM))))

(define (parse-digit parsed ch)
  (match parsed
    (('Digit n) (if (char-numeric? ch)
                  (unitM `(Digit ,(+ (* n 10) (digit->integer ch))))
    (_ (zeroM))))

(define (parse-word parsed ch)
  (match parsed
    (('Word s)  (if (char-alphabetic? ch)
                  (unitM `(Word ,(string-append s (string ch))))
    (_ (zeroM))))

(define (parse ch parsed)
  (plusM (parse-hex-digit parsed ch)

         (plusM (parse-digit parsed ch)
                (parse-word parsed ch))))

(define (parse-arg str)
  (letM* ((List init <- (plusM (unitM '(Hex 0))
                               (plusM (unitM '(Digit 0))
                                      (unitM '(Word ""))))))
         (foldM parse init (string->list str))))

In this example we explicitly specified List monad in the parse-arg procedure; so the caller of parse-arg doesn't need to specify the kind of the Monad.


gosh> (parse-arg "123")
((Hex 291) (Digit 123))
gosh> (parse-arg "123ab")
((Hex 74667))
gosh> (parse-arg "cafebabe")
((Hex 3405691582) (Word "cafebabe"))
gosh> (parse-arg "cafeba99")
((Hex 3405691545))
gosh> (parse-arg "cafebaz9")

Custom Monad

This 'Numbered monad' example, as well as the code that adds numbers to the visited node within a tree, are taken from Monadic Programming in Scheme. (Effectively, the monad is a kind of State monad).

(use util.match)

(define-monad Numbered
  (unitM (x) (lambda (count) (cons count x)))
  (bindM (m f)
         (lambda (count)
           (match-let1 (newcount . val) (m count)
             ((f val) newcount))))
  (runM  (m init-count) (m init-count))

(define (incr n) (cons (+ n 1) n))

(define (make-node val kids)
  (letM* ((count <- incr))
         (unitM (list 'Node count val kids))))

(define (build-btree depth)
  (if (zero? depth)
    (make-node depth '())
    (letM* ((left  <- (build-btree (- depth 1)))
            (right <- (build-btree (- depth 1))))
           (make-node depth (list left right)))))

Here's a result of calling build-btree. The result is indented for the convenience. Each node is in the form (Node number depth (child ...)). The 115 at the beginning of the result is the next node number to be used

gosh> (Numbered (runM (build-btree 3) 100))
 Node 114 3
      ((Node 106 2
             ((Node 102 1
                    ((Node 100 0 ())
                     (Node 101 0 ())))
              (Node 105 1
                    ((Node 103 0 ())
                     (Node 104 0 ())))))
       (Node 113 2
             ((Node 109 1
                    ((Node 107 0 ())
                     (Node 108 0 ())))
              (Node 112 1
                    ((Node 110 0 ())
                     (Node 111 0 ())))))))

Multiple monads

The example to mix IO monad and List monad, appeared in the last part of Monadic Programming in Scheme.

(define-monad IO
  (unitM (x)       x)
  (bindM (m f)     (f m))
  (get-charM ()    (read-char))
  (readM     ()    (read))
  (put-charM (ch)  (write-char ch))
  (put-lineM (str) (print str))

(define (f)
   (letM* (( (put-lineM "Enter a number:") )
           (n     <- (readM))
           (all-n <- (unitM (iota n 1)))
           (evens <- (List
                      (letM* ((i <- all-n))
                             (if (even? i) (unitM i) (failM "odd")))))
          (unitM evens))))


There are multiple possible implementation strategy, but here I use the following scheme:

(define-module util.monad
  (use util.match)
  (use util.list)
  (use srfi-1)
  (use gauche.parameter)
  (export define-monad letM*
          Identity Maybe List State IO
          unitM bindM failM zeroM plusM runM getM putM
          seqM mapM foldM)
(select-module util.monad)

(define %monad-alist (make-parameter '()))
(define (%monad-alist-lookup name)
  (assq-ref (%monad-alist) name))
(define (%monad-alist-register name monad)
  (%monad-alist (acons name monad (%monad-alist))))

(define %current-monad
  (make-parameter (lambda (key . args)
                    (errorf "~a: monad is not expected" key))))

(define-syntax define-monad
  (syntax-rules ()
    ((_ name : super (key args . exprs) ...)
       (define-method key args
         ((%current-monad) 'key . args)) ...
       (let ((cmd-alist `((key . ,(lambda args . exprs)) ...)))
          (lambda (selector . rest)
            (cond ((assq selector cmd-alist)
                   => (lambda (p) (apply (cdr p) rest)))
                  ((%monad-alist-lookup 'super)
                   => (cut apply <> selector rest))
                   (errorf "Monad ~a doesn't support the operation ~s"
                           'name selector))))))
       (define-syntax name
         (syntax-rules ()
           ((_ . body)
            (parameterize ((%current-monad (%monad-alist-lookup 'name)))
              . body))))))
    ((_ name (key args . exprs) ...)
     (define-monad name : Monad (key args . exprs) ...))

(define-syntax letM*
  (syntax-rules ()
    ((letM* () expr)
    ((letM* ((var <- init) . more) expr)
     (bindM init (lambda (var) (letM* more expr))))
    ((letM* ((m var <- init) . more) expr)
     (m (bindM init (lambda (var) (letM* more expr)))))
    ((letM* ((action) . more) expr)
     (bindM action (lambda (_) (letM* more expr))))
    ((letM* ((m action) . more) expr)
     (m (bindM action (lambda (_) (letM* more expr)))))

;; base class
(define-monad Monad : #f
  (failM (x) (error x)))

;; Monad definitions and operation definitions comes after this ...

(provide "util/monad")

We use define-method inside the expansion of define-monad; which is to ensure the named operator (e.g. getM) are globally bound. It is not inherent in this system, although implementing it with pure R5RS scheme might be a bit complicated. (If we assume Gauche's object system, however, we can create a class for a monad, and make %current-monad keeps the singleton instance of the class).

Tags: Monad, Haskell

Last modified : 2013/04/29 01:54:30 UTC