Advanced Functional Programming

1
Advanced Functional Programming

• Tim Sheard
• Oregon Graduate Institute of Science Technology

• Lecture 18
• MetaML Examples
• Staged Pattern Matching
• Staaged interpreter
• MetaML extensions

2
Synopsis MetaML features

• Pattern based object code templates
• templates look like the object language
• Object-code has a type.
• The type of code is embedded in the meta-lang
  type system
• Object code has structure.
• Possible to analyze it, take it apart, etc.
• Automatic alpha-renaming of bound variables
• No name clashes
• Object-code can be run or executed (runtime
  code-gen.)
• Object-code can be observed (pretty-printed)

3
An example Staged Pattern Matching

• Consider an algebra of terms
• Terms have constants (like 5), and operators
  (like )
• Patterns are like terms, Except they also include
  variables
• datatype 'a Structure
• Op of ('a string 'a) ( e.g. (1 5) )
• Int of int ( e.g. 5 )
• datatype term Wrap of term Structure
• datatype pat
• Var of string
• Term of pat Structure

4
Rewrite Rules

• A rewrite rule is encoded as a pair of patterns
• (x y) z --gt x (y z)
• ( Term(Op(Term (Op(Var "x","",Var "y")),
• "",
• Var "z")),
• Term(Op(Var "x",
• "",
• Term(Op(Var "y","",Var "z"))))
• )

5
A rule Compiles into a program

• with type term -gt term
• (x y) z --gt x (y z)
• (fn Wrap a gt
• (case a of
• Op(d,c,b) gt
• if "" c
• then (case unWrap d of
• Op(g,f,e) gt
• if "" f
• then Wrap (Op(g,"",
• Wrap
  (Op(e,"",b))))
• else Wrap a
• _ gt Wrap a)
• else Wrap a
• _ gt Wrap a))

6
Simple but inefficient solution

• ( rewrite pat pat -gt term -gt term )
• fun rewrite (lhs,rhs) term
• case match lhs emptySubst term of
• NONE gt term
• SOME sigma gt substitute sigma rhs
• Where match does a simultaneous walk over lhs and
  term and builds a substitution.
• A substitution can either fail (NONE) or succeed
  (SOME sigma) with a set of bindings sigma.

7
fun match pat msigma (term as (Wrap t)) case
(msigma) of NONE gt NONE SOME (sigma) gt
(case pat of Var u gt (case find
u sigma of NONE gt SOME ((u,term)
sigma) SOME w gt if termeq w term
then SOME sigma else NONE)
Term(Int n) gt (case t of Int u
gt if un then msigma else NONE _ gt
NONE) Term(Op(t11,s1,t12)) gt
(case t of Op (t21,s2,t22) gt
(if s2 s1 then
(match t11 (match t12 msigma t22) t21)
else NONE) _ gt NONE)
8
Alternate, efficient Solution

• fun rewrite (lhs,rhs) term
• case match lhs emptySubst term of
• NONE gt term
• SOME sigma gt substitute sigma rhs
• ( rewrite pat pat -gt term -gt term )
• fun rewrite (lhs,rhs) term
• match2 lhs emptySubst term
• (fn NONE gt term
• SOME sigma gt substitute sigma rhs)
• Rather than returning a substitution, match is
  passed a continuation which expects a
  subsitution, and match applies the continuation
  to get the answer

9
fun match2 pat msigma (term as (Wrap t)) k case
(msigma) of NONE gt k NONE SOME (sigma)
gt (case pat of Var u gt (case find
u sigma of NONE gt k (SOME ((u,term)
sigma)) SOME w gt if termeq w term then
k (SOME sigma)
else k NONE) Term(Int n) gt (case t
of Int u gt if un then k msigma else k
NONE _ gt k NONE) Term(Op(t11,s1,t12)
) gt (case t of Op
(t21,s2,t22) gt (if s2 s1
then match2 t11 msigma t21
(fn sigma2 gt match2 t12 sigma2 t22 k)
else k NONE) _ gt k NONE))
10
Finally stage the result

• Work with pieces of code with type term rather
  than terms themselves.
• type substitution
• ((string lttermgt) list) option
• match pat -gt substitution -gt lttermgt -gt
• (substitution -gt lttermgt)
• -gt lttermgt
• rewrite(pat pat ) -gt
• ltterm -gt termgt

11
Staged match function

• fun match pat msigma term k
• case (msigma) of
• NONE gt k NONE
• SOME (sigma) gt
• (case pat of
• Var u gt
• (case find u sigma of
• NONE gt k (SOME ((u,term) sigma))
• SOME w gt
• ltif termeq w term
• then (k (SOME sigma))
• else (k NONE)gt)
• ...

12
Staged match (continued)

• ...
• Term(Int n) gt
• ltcase term of
• Int u gt if u (lift n) then (k
  msigma)
• else (k NONE)
• _ gt (k NONE)gt
• Term(Op(p11,s1,p12)) gt
• ltcase term of
• Op(t21,s2,t22) gt
• if (lift s1) s2
• then (match p11 msigma ltt21gt
• (fn msig gt
• match p12 msig ltt22gt
  k))
• else (k NONE)
• _ gt (k NONE)gt )

13
Staged rewrite

• ( rewrite (pat pat ) -gt ltterm -gt termgt )
• fun rewrite (lhs,rhs)
• ltfn (Wrap t) gt
• (match3 lhs (SOME ) ltWrap tgt
• (fn NONE gt ltWrap tgt
• SOME s gt subst s rhs) )gt

14
Applying the staging

• Compiling a rule is now simply applying the
  staged rewrite function to a rule.
• - rewrite r3
• val it
• lt(fn Wrap a gt
• (case a of
• Op(d,c,b) gt
• if "" c
• then (case unWrap d of
• Op(g,f,e) gt
• if "" f
• then Wrap
• (Op(g,"",Wrap
  (Op(e,"",b))))
• else Wrap a
• _ gt Wrap a)
• else Wrap a
• _ gt Wrap a))gt
• ltterm -gt term gt

15
Using Metaml

• MetaML can be downloaded from
• http//www.cse.ogi.edu/PacSoft/projects/metaml/ind
  ex.html

16
MetaMLs extensions to ML

• Staging extensions
• bracket lt ... gt, escape (), lift(), and
  run()
• Extensions to the type system
• Higher order type constructors
• Polymorphic components to Constructors
• (limited rank2 polymorphism)
• Qualified types (extensions to records)
• Syntactic extensions
• Monadic Do and Return
• Extensible records

17
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))))

18
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 )

19
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

20
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 )

21
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

22
The standard morphisms

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

23
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

24
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))

25
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

26
State Transformer Monad

• datatype 'a intSt C of (int -gt ('a int))
• val intSt
• let fun unit x C(fn n gt (x,n))
• fun bind (C x) f
• C (fn n gt let val (a,n1) x n
• val (C g) f a
• in g n1 end)
• in (Mon(unit,bind)) end
• Note how the state is threaded in and out of each
  computation.

27
Using staging to write a compiler

• We will write a compiler using the following
  process.
• 1 - Create a denotational semantics for the
  language
• 2 - Express the semantics in terms of a monad
• 3 - Express the actions of the compiler as
  non-standard morphisms of the monad.
• 4 - Stage the monadic interpretor

28
The While-language

• 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 )
• datatype Com
• Assign of (string Exp) ( x 1
  )
• Seq of (Com Com) ( x 1 y 2
  )
• Cond 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 Exp ( print x
  )

29
Semantics of While-language

• Exp - an environment to value function
• an environment is mapping from variables to
  values
• Var - reads the store
• Com - a function that given an environment
  produces a new environment and also produces
  output
• Declare - increase the size of the environment -
  environment behaves like a stack!
• Assign - change the environment
• Print - add something to the output - output
  behaves like a stream

30
1 stage meaning

• type variable string
• type value int
• type output string
• type env variable -gt value
• eval Exp -gt env -gt value
• interp Com -gt env -gt (env output)

31
2 stage meaning

• Divide the environment into 2 pieces
• static part (known at compile-time)
• type location int
• type index variable list
• ( position in list encodes where variable
  lives in the stack )
• dynamic part (known at run-time)
• type value int
• type stack value list
• Meaning
• eval Exp -gt index -gt (stack -gt value)
• interp Com -gt index -gt stack -gt (stack output)

32
Creating a Monad

• Note the dynamic meanings of Exp and Com
• eval Exp -gt index -gt (stack -gt value)
• interp Com -gt index -gt stack -gt (stack
  output)
• Abstract over both these with the following
• datatype a M
• StOut of (stack -gt (a stack output))
• eval Exp -gt index -gt value M
• interp Com -gt index -gt unit M
• Note that M is the type constructor of a monad.

33
Monad of state with output

• datatype 'a M
• StOut of (int list -gt ('a int list
  string))
• fun unStOut (StOut f) f
• fun unit x StOut(fn n gt (x,n,""))
• fun bind (e a M) (f a -gt b M)
• StOut(fn n gt
• let val (a,n1,s1) (unStOut e) n
• val (b,n2,s2) unStOut(f a) n1
• in (b,n2,s1 s2) end)
• val mswo M Monad Mon(unit,bind)

34
Actions in the Monad

• ( read location -gt int M )
• fun read i StOut(fn ns gt (fetch i ns,ns,""))
• ( write location -gt int -gt unit M )
• fun write i v StOut(fn ns gt( (), put i v ns,
  "" ))
• ( push int -gt unit M )
• fun push x StOut(fn ns gt ( (), x ns, ""))
• ( pop unit M )
• val pop StOut(fn (nns) gt ((), ns, ""))
• ( output int -gt unit M )
• fun output n StOut(fn ns gt((),ns, (toString
  n)" "))

35
Example translation

• read location -gt int M
• write location -gt int -gt unit M
• push int -gt unit M
• pop unit M
• output int -gt unit M
• declare x 5 in print (xx)
• do M push 5
• x lt- read xloc
• y lt- Return M (x x)
• output y
• pop

36
Monadic eval

• fun eval1 exp index ( eval1 Exp -gt index -gt
  int M )
• case exp of
• Constant n gt Return mswo n
• Variable x gt let val loc position x index
• in read loc end
• Minus(x,y) gt Do mswo a lt- eval1 x index
• b lt- eval1 y index
• Return mswo (a - b)
• Greater(x,y) gt Do mswo a lt- eval1 x index
• b lt- eval1 y index
• Return mswo (if a 'gt' b then 1 else 0)
• Times(x,y) gt Do mswo a lt- eval1 x index
• b lt- eval1 y index
• Return mswo (a b)

37
Monadic interp

• ( interp1 Com -gt index -gt unit M )
• fun interp1 stmt index
• case stmt of
• Assign(name,e) gt
• let val loc position name index
• in Do mswo v lt- eval1 e index write loc v
  end
• Seq(s1,s2) gt
• Do mswo x lt- interp1 s1 index
• y lt- interp1 s2 index
• Return mswo ()
• Cond(e,s1,s2) gt
• Do mswo x lt- eval1 e index
• if x1
• then interp1 s1 index
• else interp1 s2 index

38
Monadic interp (cont.)

• While(e,body) gt
• let fun loop ()
• Do mswo v lt- eval1 e index
• if v0 then Return mswo ()
• else Do mswo
• interp1 body index
  
• loop ()
• in loop () end
• Declare(nm,e,stmt) gt
• Do mswo v lt- eval1 e index
• push v
• interp1 stmt (nmindex)
• pop
• Print e gt
• Do mswo v lt- eval1 e index output v

39
2-stage Monadic eval

• fun eval2 exp index ( eval2 Exp -gt index -gt
  ltint Mgt )
• case exp of
• Constant n gt ltReturn mswo (lift n)gt
• Variable x gt let val loc position x index
• in ltread (lift loc)gt end
• Minus(x,y) gt ltDo mswo a lt- (eval2 x index)
  
• b lt- (eval2 y index)
  
• Return mswo (a - b) gt
• Greater(x,y) gt
• ltDo mswo a lt- (eval2 x index)
• b lt- (eval2 y index)
• Return mswo (if a 'gt' b then 1 else
  0) gt
• Times(x,y) gt ltDo mswo a lt- (eval2 x index)
  
• b lt- (eval2 y index)
  
• Return mswo (a b) gt
  

40
2-stage Monadic interp

• ( interpret2 Com -gt index -gt ltunit Mgt )
• fun interpret2 stmt index
• case stmt of
• Assign(name,e) gt
• let val loc position name index
• in ltDo mswo n lt- (eval2 e index)
• write (lift loc) n gt end
• Seq(s1,s2) gt ltDo mswo x lt- (interpret2 s1
  index)
• y lt- (interpret2 s2
  index)
• Return mswo () gt
• Cond(e,s1,s2) gt
• ltDo mswo x lt- (eval2 e index)
• if x1 then (interpret2 s1 index)
• else (interpret2 s2 index)gt

41
2-stage interp (cont.)

• While(e,body) gt
• ltlet fun loop ()
• Do mswo v lt- (eval2 e index)
• if v0 then Return mswo ()
• else Do mswo q lt- (interpret2 body index)
• loop ()
• in loop () endgt
• Declare(nm,e,stmt) gt
• ltDo mswo x lt- (eval2 e index)
• push x
• (interpret2 stmt (nmindex))
• pop gt
• Print e gt ltDo mswo x lt- (eval2 e index)
• output x gt

42
declare x 10 in x x - 1 print x

• ltDo mswo
• push 10
• a lt- read 1
• b lt- Return mswo a - 1
• c lt- write 1 b
• d lt- read 1
• e lt- output d
• Return mswo ()
• pop
• gt

43
Analyzing code

• Matching against code
• - fun is5 lt5gt true
• is5 _ false
• val is5 fn ltintgt -gt bool
• - is5 (lift (14))
• val it true bool
• - is5 lt0gt
• val it false bool

44
Variables in code patterns

• - fun parts lt x y gt SOME(x,y)
  parts _ NONE
• val parts fn ltintgt -gt (ltintgt ltintgt) option
  
• - parts lt6 7gt
• val it SOME (lt6gt,lt7gt) (ltintgt ltintgt) option
  
• - parts lt2gt
• val it NONE (ltintgt ltintgt) option

45
Higher-order code variables

• Esc in pattterns under a lambda need to be
  higher-order variables.
• - fun f ltfn x gt (g ltxgt) 0gt ltfn y gt (g
  ltygt)gt
• f x x
• val f Fn 'b.lt'b -gt intgt -gt lt'b -gt intgt
• - f ltfn x gt (x-4) 0gt
• val it lt(fn a gt a - 4)gt ltint -gt intgt

46
Rules for higher-order variables

• The escaped expression must me an application
• The application must have a variable as the
  function part. This variable is the the
  higher-order variable
• The arguments to the application must be
  bracketed variables which are bound in enclosing
  lambda expresions.
• All lambda bound variables must appear.
• Examples
• ltfn x gt (f ltxgt)gt legal
• ltfn x gt (f lt2gt)gt illegal
• ltfn x gt f gt illegal
• ltfn x gt fn y gt (f ltxgt)gt illegal
• ltfn (x,y) gt (f ltxgt ltygt)gt legal