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 --> 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 -> term • (x + y) + z --> x + (y + z) • (fn Wrap a => • (case a of • Op(d,c,b) => • if "+" %= c • then (case %unWrap d of • Op(g,f,e) => • if "+" %= f • then Wrap (Op(g,"+", • Wrap (Op(e,"+",b)))) • else Wrap a • | _ => Wrap a) • else Wrap a • | _ => Wrap a))

6. Simple but inefficient solution • (* rewrite: pat * pat -> term -> term *) • fun rewrite (lhs,rhs) term = • case match lhs emptySubst term of • NONE => term • | SOME sigma => 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 => NONE | SOME (sigma) => (case pat of Var u => (case find u sigma of NONE => SOME ((u,term) :: sigma) | SOME w => if termeq w term then SOME sigma else NONE) | Term(Int n) => (case t of Int u => if u=n then msigma else NONE | _ => NONE) | Term(Op(t11,s1,t12)) => (case t of Op (t21,s2,t22) => (if s2 = s1 then (match t11 (match t12 msigma t22) t21) else NONE) | _ => NONE)

8. Alternate, efficient Solution • fun rewrite (lhs,rhs) term = • case match lhs emptySubst term of • NONE => term • | SOME sigma => substitute sigma rhs • (* rewrite: pat * pat -> term -> term *) • fun rewrite (lhs,rhs) term = • match2 lhs emptySubst term • (fn NONE => term • | SOME sigma => 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 => k NONE | SOME (sigma) => (case pat of Var u => (case find u sigma of NONE => k (SOME ((u,term) :: sigma)) | SOME w => if termeq w term then k (SOME sigma) else k NONE) | Term(Int n) => (case t of Int u => if u=n then k msigma else k NONE | _ => k NONE) | Term(Op(t11,s1,t12)) => (case t of Op (t21,s2,t22) => (if s2 = s1 then match2 t11 msigma t21 (fn sigma2 => match2 t12 sigma2 t22 k) else k NONE) | _ => k NONE));

10. Finally: stage the result • Work with pieces of code with type term rather than terms themselves. • type substitution = • ((string * <term>) list) option; • match: pat -> substitution -> <term> -> • (substitution -> <term>) • -> <term> • rewrite:(pat * pat ) -> • <term -> term>

11. Staged match function • fun match pat msigma term k = • case (msigma) of • NONE => k NONE • | SOME (sigma) => • (case pat of • Var u => • (case find u sigma of • NONE => k (SOME ((u,term) :: sigma)) • | SOME w => • <if termeq ~w ~term • then ~(k (SOME sigma)) • else ~(k NONE)>) • | ...

12. Staged match (continued) • ... • | Term(Int n) => • <case ~term of • Int u => if u= ~(lift n) then ~(k msigma) • else ~(k NONE) • | _ => ~(k NONE)> • | Term(Op(p11,s1,p12)) => • <case ~term of • Op(t21,s2,t22) => • if ~(lift s1) = s2 • then ~(match p11 msigma <t21> • (fn msig => • match p12 msig <t22> k)) • else ~(k NONE) • | _ => ~(k NONE)> );

13. Staged rewrite • (* rewrite :(pat * pat ) -> <term -> term> *) • fun rewrite (lhs,rhs) = • <fn (Wrap t) => • ~(match3 lhs (SOME []) <Wrap t> • (fn NONE => <Wrap t> • | SOME s => subst s rhs) )>;

14. Applying the staging • “Compiling” a rule is now simply applying the staged rewrite function to a rule. • -| rewrite r3; • val it = • <(fn Wrap a => • (case a of • Op(d,c,b) => • if "+" %= c • then (case %unWrap d of • Op(g,f,e) => • if "+" %= f • then Wrap • (Op(g,"+",Wrap (Op(e,"+",b)))) • else Wrap a • | _ => Wrap a) • else Wrap a • | _ => Wrap a))> • : <term -> term >

15. Using Metaml • MetaML can be downloaded from • http://www.cse.ogi.edu/PacSoft/projects/metaml/index.html

16. MetaML’s extensions to ML • Staging extensions • bracket < ... >, 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 : * -> * ) 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 -> 'a list); • fun copy [] = [] • | copy (x::xs) = 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 -> 'a list -> a • -> ('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 -> 'a list, • plus : ['a]. 'a list -> 'a list -> 'a list, • zero : ['a].'a list • }; • val lm1 = LM{inject = fn x => [x], • plus = fn x => fn y => x@y, • zero = []}

20. Pattern Matching to access • fun f (LM{inject=inj, 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 -> ‘a T • bind: (‘a T) -> (‘a -> ‘b T) -> (‘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 : * -> * ) monad = • Mon of • (['a]. 'a -> 'a 'm) * • (['a,'b]. ('a 'm) -> ('a -> 'b 'm) -> 'b 'm); • type 'x Id = 'x; • val Id = (Mon (fn x => x, fn x => fn f => f x)) • : Id Monad;

24. Do and Return • MetaML’s 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 <- x • ; Return ex (f z) • }; • vs • fun option f x = bind x (fn z => unit (f z));

25. Syntactic Sugar • Do (Mon(unit,bind)) { x <- e; f } • = • bind e (fn x => f) • Return (Mon(unit,bind)) e • = • unit e • Do m { x1 <- e1; x2 <- e2 ; x3 <- e3 ; e4 } • = • Do m { x1 <- e1; • Do m { x2 <- e2 ; • Do m { x3 <- e3 ; e4 }}}

26. State Transformer Monad • datatype 'a intSt = C of (int -> ('a * int)); • val intSt = • let fun unit x = C(fn n => (x,n)) • fun bind (C x) f = • C (fn n => 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 > 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 x>0 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 -> value; • eval : Exp -> env -> value • interp : Com -> env -> (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 -> index -> (stack -> value) • interp : Com -> index -> stack -> (stack * output)

32. Creating a Monad • Note the dynamic meanings of Exp and Com • eval : Exp -> index ->(stack -> value) • interp : Com -> index ->stack -> (stack * output) • Abstract over both these with the following • datatype ‘a M = • StOut of (stack -> (‘a * stack * output)); • eval : Exp -> index -> value M • interp: Com -> index -> 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 -> ('a * int list * string)); • fun unStOut (StOut f) = f; • fun unit x = StOut(fn n => (x,n,"")); • fun bind (e : ‘a M) (f : ‘a -> ‘b M) = • StOut(fn n => • 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 -> int M *) • fun read i = StOut(fn ns => (fetch i ns,ns,"")); • (* write : location -> int -> unit M *) • fun write i v = StOut(fn ns =>( (), put i v ns, "" )); • (* push: int -> unit M *) • fun push x = StOut(fn ns => ( (), x :: ns, "")); • (* pop : unit M *) • val pop = StOut(fn (n::ns) => ((), ns, "")); • (* output: int -> unit M *) • fun output n = StOut(fn ns =>((),ns, (toString n)^" "));

35. Example translation • read : location -> int M • write : location -> int -> unit M • push: int -> unit M • pop : unit M • output: int -> unit M • declare x = 5 in print (x+x) • do M { push 5 • ; x <- read xloc • ; y <- Return M (x + x) • ; output y • ; pop • }

36. Monadic eval • fun eval1 exp index = (* eval1: Exp -> index -> int M *) • case exp of • Constant n => Return mswo n • | Variable x => let val loc = position x index • in read loc end • | Minus(x,y) => Do mswo { a <- eval1 x index ; • b <- eval1 y index; • Return mswo (a - b) } • | Greater(x,y) => Do mswo { a <- eval1 x index ; • b <- eval1 y index; • Return mswo (if a '>' b then 1 else 0) } • | Times(x,y) => Do mswo { a <- eval1 x index ; • b <- eval1 y index; • Return mswo (a * b) };

37. Monadic interp • (* interp1 : Com -> index -> unit M *) • fun interp1 stmt index = • case stmt of • Assign(name,e) => • let val loc = position name index • in Do mswo { v <- eval1 e index ; write loc v } end • | Seq(s1,s2) => • Do mswo { x <- interp1 s1 index; • y <- interp1 s2 index; • Return mswo () } • | Cond(e,s1,s2) => • Do mswo { x <- eval1 e index; • if x=1 • then interp1 s1 index • else interp1 s2 index }

38. Monadic interp (cont.) • | While(e,body) => • let fun loop () = • Do mswo { v <- eval1 e index ; • if v=0 then Return mswo () • else Do mswo • { interp1 body index ; • loop () } } • in loop () end • | Declare(nm,e,stmt) => • Do mswo { v <- eval1 e index ; • push v ; • interp1 stmt (nm::index); • pop } • | Print e => • Do mswo { v <- eval1 e index; output v };

39. 2-stage Monadic eval • fun eval2 exp index = (* eval2: Exp -> index -> <int M> *) • case exp of • Constant n => <Return mswo ~(lift n)> • | Variable x => let val loc = position x index • in <read ~(lift loc)> end • | Minus(x,y) => <Do mswo { a <- ~(eval2 x index) ; • b <- ~(eval2 y index); • Return mswo (a - b) }> • | Greater(x,y) => • <Do mswo { a <- ~(eval2 x index) ; • b <- ~(eval2 y index); • Return mswo (if a '>' b then 1 else 0) }> • | Times(x,y) => <Do mswo { a <- ~(eval2 x index) ; • b <- ~(eval2 y index) ; • Return mswo (a * b) }> ;

40. 2-stage Monadic interp • (* interpret2 : Com -> index -> <unit M> *) • fun interpret2 stmt index = • case stmt of • Assign(name,e) => • let val loc = position name index • in <Do mswo { n <- ~(eval2 e index) ; • write ~(lift loc) n }> end • | Seq(s1,s2) => <Do mswo { x <- ~(interpret2 s1 index); • y <- ~(interpret2 s2 index); • Return mswo () }> • | Cond(e,s1,s2) => • <Do mswo { x <- ~(eval2 e index); • if x=1 then ~(interpret2 s1 index) • else ~(interpret2 s2 index)}>

41. 2-stage interp (cont.) • | While(e,body) => • <let fun loop () = • Do mswo { v <- ~(eval2 e index); • if v=0 then Return mswo () • else Do mswo { q <- ~(interpret2 body index); • loop ()} • } • in loop () end> • | Declare(nm,e,stmt) => • <Do mswo { x <- ~(eval2 e index) ; • push x ; • ~(interpret2 stmt (nm::index)) ; • pop }> • | Print e => <Do mswo { x <- ~(eval2 e index) ; • output x }>;

42. declare x = 10 in { x := x - 1; print x } • <Do %mswo • { %push 10 • ; a <- %read 1 • ; b <- Return %mswo a %- 1 • ; c <- %write 1 b • ; d <- %read 1 • ; e <- %output d • ; Return %mswo () • ; %pop • }>

43. Analyzing code • Matching against code • -| fun is5 <5> = true • | is5 _ = false; • val is5 = fn : <int> -> bool • -| is5 (lift (1+4)); • val it = true : bool • -| is5 <0>; • val it = false : bool

44. Variables in code patterns • -| fun parts < ~x + ~y > = SOME(x,y) | parts _ = NONE; • val parts = fn : <int> -> (<int> * <int>) option • -| parts <6 + 7>; • val it = SOME (<6>,<7>) : (<int> * <int>) option • -| parts <2>; • val it = NONE : (<int> * <int>) option

45. Higher-order code variables • Esc in pattterns under a lambda need to be higher-order variables. • -| fun f <fn x => ~(g <x>) + 0> = <fn y => ~(g <y>)> • | f x = x; • val f = Fn : ['b].<'b -> int> -> <'b -> int> • -| f <fn x => (x-4) + 0>; • val it = <(fn a => a %- 4)> : <int -> int>

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: • <fn x => ~(f <x>)> legal • <fn x => ~(f <2>)>illegal • <fn x => ~f > illegal • <fn x => fn y => ~(f <x>)>illegal • <fn (x,y) => ~(f <x> <y>)>legal