[NEM] '''18Mar2005''' Been playing around with Haskell a bit recently, and in particular, looking at monads. (See [http://www.nomaware.com/monads/html/index.html] for an introduction). This is a first stab at writing monads using [TOOT]. It's a bit ad-hoc at the moment, but I think it demonstrates the basic approach. Also, the sharp-eyed among you may notice an implementation of algebraic pattern-matching in this code... # Install TOOT unknown handler if {[llength [info commands ::__toot_unknown]] == 0} { rename ::unknown ::__toot_unknown proc ::unknown {cmd args} { if {[llength $cmd] > 1} { uplevel 1 $cmd $args } else { uplevel 1 [linsert $args 0 ::__toot_unknown $cmd] } } } # Create a type command namespace eval type { namespace export constructor method match proc create {name body} { set body " namespace import ::type::* $body namespace ensemble create " uplevel 1 [list namespace eval $name $body] uplevel 1 [list proc ${name}: {self method args} \ [string map [list %N [list $name]] { uplevel 1 [linsert $args 0 \ %N::$method $self] }]] } proc constructor {name args} { set tname [uplevel 1 [list namespace current]] uplevel 1 [list \ interp alias {} $name {} ::type::Construct $tname $name $args ] } proc Construct {type con params args} { if {[llength $args] != [llength $params]} { return -code error \ "wrong # args: should be \"$type $con $params\"" } return [list ${type}: [linsert $args 0 $con]] } proc method {name arglist body} { uplevel 1 [list proc $name [linsert $arglist 0 self] $body] } proc match {value options} { upvar 1 __dict dict set dict [dict create] foreach {pattern -> script} $options { if {[Match $pattern $value dict]} { return [uplevel 1 [list dict with __dict $script]] } } return -code error "'$value' doesn't match type" } proc Match {pattern value var} { upvar 1 $var dict if {[llength $pattern] != [llength $value]} { return 0 } foreach pat $pattern word $value { if {[string match {[A-Z]*} $pat]} { if {![string equal $pat $word]} { return 0 } } else { dict set dict $pat $word } } return 1 } } # The Maybe monad type::create Maybe { constructor Nothing constructor Just a # Inject a value into the monad # Return :: a -> Maybe a proc Return {a} { Just $a } # >>= :: Maybe a -> (a -> Maybe b) -> Maybe b proc >>= {ma atomb} { type::match $ma { Nothing -> Nothing {Just a} -> { uplevel 1 $atomb [list $a] } } } proc >> {_ fmb} { uplevel 1 $fmb } } And some tests... # Take the head of a list -- returns Nothing if the list is empty # head :: [a] -> Maybe a proc head {list} { if {[llength $list]} { Just [lindex $list 0] } else { Nothing } } # double an integer, if it is less than 1000 # double :: Int -> Maybe Int proc double {a} { if {$a < 1000} { Just [expr {$a * 2}] } else { Nothing } } # double the first item in a list, and print the result proc printdouble {list} { [[head $list] >>= double] >>= puts } printdouble {1 2 3} printdouble {} ;# empty list, should produce no output printdouble {2000 3000 4000} # iterate: # repeatedly apply a function to successive numbers until it produces # Nothing # iterate :: (a -> Maybe a) -> [a] proc iterate {func init} { set res [uplevel 1 $func [list $init]] $res match { Nothing -> { return } {Just a} -> { concat $a [iterate $func $a] } } } # mmap: # Like "map", but doesn't append if function returns Nothing # mmap (a -> Maybe b) -> [a] -> [b] proc mmap {func list} { set ret [list] foreach item $list { set r [uplevel 1 $func [list $item]] $r match { Nothing -> { } {Just a} -> { lappend ret $a } } } return $ret } puts [iterate double 2] puts [mmap double {2 4 5 1000 2000 70 80}] [NEM] Here's a more complicated example, using an Error monad, which perhaps illustrates things a bit better. Imagine a world where Tcl didn't have built-in exception handling. In this world you might have operations which could either return a result, or might not in some error condition. One way to get around this is to return a return code and a potential result as a tuple (list). This is essentially what Tcl does at the C-level: the int return code signals TCL_OK, TCL_ERROR, etc, and the actual result (or error message) is stored in the interpreter. Now, what this means at the C-level is that you have a lot of code which does: if (Tcl_SomeFunc(interp, ...) != TCL_OK) { return TCL_ERROR; } which gets a bit tedious to keep typing, but generally works ok. What a monad allows you to do is to package up this boiler-plate code into an Error monad which does the right thing. Now, all you need to do is sequence your actions using the Error monad operations, and use throw/catch and everything should work ok. To demonstrate: # error monad # source monad.tcl type::create Error { constructor Error msg constructor Ok result proc Return {a} { Ok $result } proc >>= {ea atoeb} { type::match $ea { {Error msg} -> { Error $msg } {Ok res} -> { uplevel 1 $atoeb [list $res] } } } proc >> {ea feb} { # still check result and propagate type::match $ea { {Error msg} -> { Error $msg } {Ok _} -> { uplevel 1 $feb } } } proc throw {message} { Error $message } proc catch {res handler} { $res match { {Error msg} -> { return [uplevel 1 $handler [list $msg]] } {Ok res} -> { return $res } } } proc Return {val} { Ok $val } } # lrange $list 1 end, if list has at least one element, else error proc tail {list} { if {[llength $list]} { Error::Return [lrange $list 1 end] } else { Error::throw "empty list" } } # A monadic puts function proc eputs {item} { puts $item Error::Return $item } # Print each successive sub-list of a list, then error :) proc printevery {list} { [[tail $list] >>= eputs] >>= printevery } proc Handle {errormsg} { puts "ERROR: $errormsg" } Error::catch [printevery {1 2 3 4 5 6}] Handle Error::catch [tail {1 2 3}] Handle ;# should be fine Error::catch [tail {}] Handle ;# error OK - so, it still looks pretty involved, all this >>= business. Well, in Haskell, they define a new "do" keyword syntax form, which converts code automatically to this form. TODO... ---- [Category Concept]