Tim Sheard

1
Fundamentals of
Staged Computation
Lecture 6 Monads and Interpreters

• Tim Sheard
• Oregon Graduate Institute

CSE 510 Section FSC Winter 2004
2
Interpreters are hard to modify

• Consider the interpreters for Exp and Com
• Consider 3 extensions
• Adding a print command
• Adding a divide expression and catching divide by
  0 errors
• Adding a notion of multiple results
• Drastic changes need to be made to the structure
  of the interpreter.

3
Extended Abstract Syntax

• datatype Exp
• Constant of int ( 5 )
• Variable of string ( x )
• Minus of (Exp Exp) ( x - 5 )
• Greater of (Exp Exp) ( x gt 1 )
• Times of (Exp Exp) ( x 4 )
• Divide of (Exp Exp) ( x / 3 )
• datatype Com
• Assign of (string Exp) ( x 1
  )
• Seq of (Com Com) ( x 1 y
  2 )
• If of (Exp Com Com) ( if x then x
  1 else y 1 )
• While of (Exp Com) ( while xgt0 do x
  x - 1 )
• Declare of (string Exp Com) ( Declare x
  1 in x x - 1 )
• Print of string Exp ( Print "answer"
  (x2) )

4
Adding a Print command

• New types
• type env (string int) list
• eval0 Exp -gt env -gt int
• interp1 Com -gt env -gt (env string)
• The type of Eval doesnt change since evaluation
  of Exp cant cause any printing.
• A Com is an env transformer and an output
  producer.

String produced by printing
5
New interp function

• fun interp1 stmt env
• case stmt of
• Assign(name,e) gt
• let val v eval0 e env
• in (set name v env,"") end
• Seq(x1,x2) gt
• let val (env1,s1) interp1 x1 env
• val (env2,s2) interp1 x2 env1
• in (env2,s1 s2) end
• If(e,s1,s2) gt
• let val x eval0 e env
• in if x1
• then interp1 s1 env
• else interp1 s2 env
• end

Assignment cause no output
Collect output from both sub-commands
6
Interp continued

• While(e,body) gt
• let fun loop env s
• let val v eval0 e env
• in if v0
• then (env,s)
• else let val (env1,s1) interp1
  body env
• in loop env1 (ss1) end
• end
• in loop env "" end
• Declare(nm,e,stmt) gt
• let val v eval0 e env
• val env1 ext nm v env
• val (env2,s) interp1 stmt env1
• in (remove env2,s) end

Output collected from many traversals of loop
Env is shrunk but output is propagated
7
Add Divide and error catching

• New types
• eval2 Exp -gt env -gt int option
• interp2 Com -gt env -gt env option
• Where
• Datatype a option NONE SOME of a

8
Eval2

• fun eval2 exp env
• case exp of
• Constant n gt SOME n
• Variable s gt SOME (lookup s env)
• Minus(x,y) gt
• (case eval2 x env of
• SOME a gt (case eval2 y env of
• SOME b gt SOME(a - b)
• _ gt NONE)
• _ gt NONE)
• . . . ( similar for Greter and Times )
• Divide(x,y) gt
• (case eval2 x env of
• SOME a gt (case eval2 y env of
• SOME 0 gt NONE
• SOME b gt SOME(a div b)
• _ gt NONE)
• _ gt NONE)

Error production
Error propagation
9
interp2

• fun interp2 stmt env
• case stmt of
• Assign(name,e) gt
• (case eval2 e env of
• SOME v gt SOME(set name v env)
• _ gt NONE)
• Seq(s1,s2) gt
• (case interp2 s1 env of
• SOME env1 gt interp2 s2 env1
• NONE gt NONE)
• If(e,s1,s2) gt
• (case eval2 e env of
• SOME x gt if x1
• then interp2 s1 env
• else interp2 s2 env
• NONE gt NONE)
• . . . ( similar for While etc. )

10
Additions for multiple values

• E.g. Suppose x ? 9,5 y ? 2,4
• Then (x y) ? 7,5,3,1
• 9-2, 9-4, 5-2, 5-4
• New types
• type env (string int list) list
• eval3 Exp -gt env -gt int list
• Interp3 Com -gt env -gt env
• Useful function combines map and append
• fun mapp f
• mapp f (xxs) (f x) _at_ (mapp f xs)

Appends results rather than consing them
11
Eval3

• fun eval3 exp env
• case exp of
• Constant n gt n
• Variable s gt lookup s env
• Minus(x,y) gt
• let val xs eval3 x env
• fun f x let val ys eval3 y env
• fun g y x - y
• in mapp g ys end
• in mapp f xs end
• Greater(x,y) gt
• let val xs eval3 x env
• fun f x let val ys eval3 y env
• fun g y if x 'gt' y then
  1 else 0
• in mapp g ys end
• in mapp f xs end
• . . .

Constants have singleton values
Recursive calls give multiple results which are
then combined
12
Example run

• val env3 ("x",9,5),("y",2,4)
• val test2 eval3
• (Minus (Variable "x",Variable "y")) env3
• - test2
• val it 7,5,3,1 int list

13
Notes

• Each new addition made drastic changes to the
  structure of the code.
• Print extra results returned in pair
• Divide case analysis to determine if SOME or
  NONE
• Mulitiple Answers results are lists, need
  complicated use of mapp to combine results
• Consider making an interpreter with all three
  changes

14
Patterns
a M (a string) a M a option a
M a list
(x,) SOME x x
Let val (a,s) e1 val (b,t) e2 In fst Case e of SOME z gt m NONE gt NONE Let val xs e fun f x In mapp f xs end
These patterns can be captured by two
functions Return a -gt a M Bind a M -gt (a
-gt b M) -gt b M Where M is some type
constructor. This pattern is called a Monad
15
Output monad

• fun return x (x,"")
• fun bind (x,s1) g
• let val (y,s2) g x in (y,s1s2) end

16
Error Monad

• datatype a option NONE SOME of
• fun return x SOME x
• fun bind (SOME x) g g x
• bind NONE g NONE

17
Monad of Multiple results

• datatype a list a a list
• fun return x x
• fun bind xs g mapp g xs

18
Monads in Meta ML

• Monads are built into MetaML
• Users can define their own Monads
• Monads support their own special syntax
• Do m x lt- e y bind e (fn xgt y)
• Return m x return x
• Monads require extensions to ML
• Higher order type constructors
• Type constructors (I.e. things like list) which
  take type constructors as arguments
• Polymorphic components to records

19
Higher Order Type Constructors

• datatype ('a,'T -gt ) tree
• Tip of 'a
• Node of (('a,'T)tree) 'T
• datatype 'a binary bin of 'a 'a
• val z (int,list) tree
• Node Tip 4, Tip 2
• val w (int,binary ) tree
• Node(bin (Tip 1,Node(bin (Tip 3, Tip 0))))

20
Polymorphic Components

• datatype a A of ('a.'a list -gt 'a list)
• fun copy
• copy (xxs) x (copy xs)
• val a1 A(rev)
• val a2 A copy
• - fun f x y (A g) (g x, g y)
• val f Fn 'a,'b.'b list -gt 'a list -gt a
  
• -gt ('b list 'a list )
• - val q f 1,2,3 "x","y","d" a1
• val q (3,2,1,"d","y","x")
• (int list string list )

21
List Monoid example

• datatype list_monoid LM of
• inject 'a.'a -gt 'a list,
• plus 'a. 'a list -gt 'a list -gt 'a list,
• zero 'a.'a list
• val lm1 LMinject fn x gt x,
• plus fn x gt fn y gt x_at_y,
• zero

22
Pattern Matching to access

• fun f (LMinjectinj, plus sum, zero z)
• (sum z (inj 2), sum (inj true) (inj false))
• - f lm1
• val it (2,true ,false )
• (int list bool list )

23
Monads

• A Monad is
• A type constructor T
• a type to type function
• and 2 polymorphic functions
• unit a -gt a T
• bind (a T) -gt (a -gt b T) -gt (b T)
• an expression with type a T is a computation
• returns a value of type a
• might perform a T action
• Print, propogate errors, return multiple results

24
Instances of Monad Actions

• Performing input/output
• Changing the value of a mutable variable
• Raising an exception
• Monads can be emulated with pure functional
  programs
• by threading stores, or I/O streams, or exception
  continuations in and out of all computations

25
The standard morphisms

• Return creates a simple (nullary) action
  which does nothing
• Bind sequences two actions
• Non-standard morphisms describe the actions of
  the monad

26
Monads in MetaML

• Uses both HHTC and local polymorphism
• datatype ('m -gt ) monad
• Mon of
• ('a. 'a -gt 'a 'm)
• ('a,'b. ('a 'm) -gt ('a -gt 'b 'm) -gt 'b 'm)
• type 'x Id 'x
• val Id (Mon (fn x gt x, fn x gt fn f gt f x))
• Id Monad

27
Do and Return

• MetaMLs interface to the standard morphisms unit
  and bind
• val ex
• let fun bind (SOME x) f f x
• bind NONE f NONE
• in (Mon(SOME,bind)) option Monad end
• fun option f x
• Do ex
• z lt- x
• Return ex (f z)
• vs
• fun option f x bind x (fn z gt unit (f z))

28
Syntactic Sugar

• Do (Mon(unit,bind)) x lt- e f
• bind e (fn x gt f)
• Return (Mon(unit,bind)) e
• unit e
• Do m x1 lt- e1 x2 lt- e2 x3 lt- e3 e4
• Do m x1 lt- e1
• Do m x2 lt- e2
• Do m x3 lt- e3 e4

29
Output Monad again

• datatype 'a OP OP of 'a string
• fun return x OP(x,"")
• fun bind (OP(x,s1)) g
• let val OP(y,s2) g x
• in OP(y,s1s2) end
• val om Mon(return,bind)

30
Error (option) Monad again

• val em let fun return x SOME x
• fun bind (SOME x) g g x
• bind NONE g NONE
• in Mon(return,bind) end

31
Multiple values (list) Monad again

• val mvm
• let fun return x x
• fun mapp f
• mapp f (xxs) (f x) _at_ (mapp f xs)
• fun bind xs g mapp g xs
• in Mon(return,bind) end

32
The interpreter one more time

• ( eval4 m Monad -gt Exp -gt (string int m )
  list -gt int m )
• fun eval4 m exp env
• case exp of
• Constant n gt Return m n
• Variable s gt lookup s env
• Minus(x,y) gt
• Do m a lt- eval4 m x env
• b lt- eval4 m y env
• Return m (a - b)
• Greater(x,y) gt
• Do m a lt- eval4 m x env
• b lt- eval4 m y env
• Return m (if a 'gt' b then 1 else 0)
• Times(x,y) gt
• Do m a lt- eval4 m x env
• b lt- eval4 m y env
• Return m (a b)

33
Examples

• val term
• (Minus (Variable "x",Variable "y"))
• val envMVM ("x",9,5),("y",2,4)
• val ans1 eval4 mvm term envMVM
• val it 7,5,3,1 int list
• val envEM ("x",SOME 4),("y",SOME 2)
• val ans2 eval4 em term envEM
• val it SOME 2 int option

34
Interp, one more time

• fun interp4 m stmt env
• case stmt of
• Assign(name,e) gt Do m v lt- eval4 m e env
• Return m(set name
  (Return m v) env)
• Seq(s1,s2) gt Do m env1 lt- interp4 m s1 env
• interp4 m s2 env1
• If(e,s1,s2) gt
• Do m x lt- eval4 m e env
• if x1 then interp4 m s1 env else
  interp4 m s2 env
• While(e,body) gt
• let fun loop env
• Do m v lt- eval4 m e env
• if v0
• then Return m env
• else Do m env1 lt- interp4
  m body env loop env1
• in loop env end
• Declare(nm,e,stmt) gt
• Do m v lt- eval4 m e env
• env2 lt- interp4 m stmt (ext nm (Return
  m v) env)

35
All features at once

• Now making an interpreter with all the features
  is easy
• Define a new monad with all the features
• Add a few new cases for Print and Divide
• Write a few non-standard morphisms
• Inject some new output for print
• Raise an error for divide by zero

36
New Monad

• datatype 'a M M of (('a list) option) string
• fun return x M(SOMEx,"")
• fun mapp f M(SOME,"")
• mapp f (xxs)
• (case f x of
• M(NONE,s) gt M(NONE,s)
• M(SOME ys,s1) gt
• (case mapp f xs of
• M(SOME zs,s2) gt M(SOME(ys _at_
  zs),s1s2)
• M(NONE,s2) gt M(NONE,s1s2)))
• fun bind (M(NONE,s)) g M(NONE,s)
• bind (M(SOME xs,s1)) g
• let val M(zs,s2) mapp g xs in M(zs,s1s2)
  end
• val m Mon(return,bind)

37
Non-Standard morphisms

• fun output s M(SOMEs,s)
• fun fail s M(NONE,s)

38
Ultimate interpreter

• ( eval5 Exp -gt (string int M) list -gt int M
  )
• fun eval5 exp env
• case exp of
• Constant n gt Return m n
• Variable s gt lookup s env
• Minus(x,y) gt Do m a lt- eval5 x env
• b lt- eval5 y env
• Return m (a - b)
• Greater(x,y) gt Do m a lt- eval5 x env
• b lt- eval5 y env
• Return m (if a 'gt' b
  then 1 else 0)
• Times(x,y) gt Do m a lt- eval5 x env
• b lt- eval5 y env
• Return m (a b)
• Divide(x,y) gt Do m a lt- eval5 x env
• b lt- eval5 y env
• if b 0
• then fail "Divide by
  0"
• else Return m (a div
  b)

39
interp5

• ( interp5 Com -gt (string int M) list -gt
  (string int M) list M )
• fun interp5 stmt env
• case stmt of
• Assign(name,e) gt
• Do m v lt- eval5 e env Return m(set name
  (Return m v) env)
• Seq(s1,s2) gt
• Do m env1 lt- interp5 s1 env interp5 s2 env1
  
• If(e,s1,s2) gt
• Do m x lt- eval5 e env
• if x1 then interp5 s1 env else
  interp5 s2 env
• While(e,body) gt
• let fun loop env
• Do m v lt- eval5 e env
• if v0
• then Return m env
• else Do m env1 lt- interp5
  body env
• loop env1
• in loop env end

40
Interp5 continued

• ( interp5 Com -gt (string int M) list -gt
  (string int M) list M )
• fun interp5 stmt env
• case stmt of
• . . .
• Declare(nm,e,stmt) gt
• Do m v lt- eval5 e env
• env2 lt- interp5 stmt (ext nm (Return m
  v) env)
• Return m (remove env2)
• Print(s,e) gt
• Do m v lt- eval5 e env
• output (s" "(show v))
• Return m env