❮❮❮ Shifting electric load ❮❮❮ ❯❯❯ Podvarak ❯❯❯

Recursion schemes in a ML style language

Reading notes, links and models.

Tags: functional-programming proglang

Reading time: 9 min.

Intro

Motivation

Write out recursion schemes for mutually recursive datatypes with full type parameters.

Use only basic ML-style types instead of Haskell style derivation via type classes and generic representations.

References

Terminology

Notes

Written in the ML-part of F#.

Examples

Single linked list

The datatype

type List<'a> = 
  | None
  | Cons of 'a * List<'a>

The usual fold (folding from left, down the spine of Cons cases)

let rec foldl (current : 'r) (combine : 'r -> 'a -> 'r) (l : List<'a>) : 'r =
  match l with
  | None -> initial
  | Cons (a, rest) -> foldl (combine current a) rest
  combine initial

The fold from right (up from the None leaf, the natural one)

let rec foldr (combine : 'a -> 'r -> 'r) (initial : 'r)  (l : List<'a>) : 'r =
  match l with
  | None -> initial
  | Cons (a, rest) -> combine (a, foldr combine initial rest)

A folder datastructure for the right fold:

type ListFolder<'a, 'r> =
  {
  None : 'r
  Cons : 'a * 'r -> 'r
  }

let rec fold (lf : ListFolder<'a, 'r>) (list : List<'a>) : 'r =
  match l with
  | None -> lf.None
  | Cons (a, rest) -> lf.Cons (a, fold lf rest)

Working with a non-commutative monoid (mimicking left-fold):

type Monoid<'m> =
  { Identity : 'm; Combine : 'm -> 'm -> 'm }

let monoidListFolder (m : Monoid<'m>) : ListFolder<'a, 'm -> 'm> =
  {
  None : id
  Cons : m.Combine
  }

let foldApps (m : Monoid<'m>) (l : List<'a>) : 'm =
  let f = monoidListFolder m
  fold f l 
  |> Seq.fold (>>) m.Identity

Exposing the original list:

type ListFolder2<'a, 'r> =
  {
  None : 'r
  Cons : List<'a> * 'a * 'r -> 'r
  }

let rec fold2 (lf : ListFolder2<'a, 'r>) (l : List<'a>) : 'r =
  match l with
  | None -> lf.None
  | Cons (a, rest) -> lf.Cons (l, a, fold lf rest)

Passing data down and up again:

type DownUp<'d, 'u> =
  { Down : 'd; Up : 'u }

type ListFolder3<'a, 'down, 'up> =
  {
  None : 'down -> 'up
  Cons : DownUp<'down * 'a * List<'a> -> 'down, 'down * 'a * List<'up> -> 'up>
  }

let rec fold3 (lf : ListFolder3<'a, 'd, 'u>) (current : 'd) (l : List<'a>) : 'u =
  match l with
  | None -> lf.None current
  | Cons (a, rest) -> 
    let down = lf.Cons.Down (current, a, rest)
    let uprest = fold3 lf down rest
    lf.Cons.Up (current, a, uprest)

Arithmetic expressions

Simple arithmetic expressions (the additive monoid) over some numeric type 'n:

type Exp<'n> =
  | Int of 'n
  | Neg of Exp<'n> // Instead of | Sub Exp<'n> * Exp<'n>
  | Add of Exp<'n> * Exp<'n>

Full recursion scheme with passing data down and up:

type ExpFolder<'n, 'down, 'up> =
  {
  Int : DownUp<'down * 'n -> 'down, 'down * 'n -> 'up>
  Neg : DownUp<'down * Exp<'n> -> 'down, 'down * 'up -> 'up>
  Cons : DownUp<'down * (Exp<'n> * Exp<'n>) -> 'down, 'down * ('up * 'up) -> 'up>
  }

let rec fold (ef : ExpFolder<'n, 'd, 'u>) (d : 'd) (exp : Exp<'n>) : 'u =
  match exp with
  | Int n -> let d' -> 
    // Int.Down (d, n) not needed here
    // No recursive step, as leaf case.
    Int.Up (d, n)
  | Neg e -> let d' -> 
    let d' = Neg.Down (d, e)
    let e' : 'u = fold ef d' e
    Neg.Up (d', e') // Use the updated d' to carry information between .Down and .Up.
  | Add (e1, e2) -> 
    let d' = Add.Down (d, (e1, e2))
    let e1' = fold ef d' e1 // Independent recursion
    let e2' = fold ef d' e2 // Independent recursion
    Add.Up (d, (e1', e2')) // Use the updated d' to carry information between .Down and .Up.
   Int.Up (d, n)

Annotated arithmetic expressions

An annotated expression grammar:

type AnnExp<'a, 'n> =
  { Ann : 'a; Exp : ExpTree<'a, 'n>}
type ExpTree<'a, 'n> =
  | Int of 'n
  | Neg of AnnotatedExp<'a, 'n>
  | Add of AnnExp<'a, 'n> * AnnExp<'a, 'n>

With an useful extracted helper type isomorph to

type Annotated<'a, 'c> =
  { Annotation : 'a; Content : 'c }
  
type AnnExp<'a, 'n> =
  AnnotatedExp<'a, ExpTree<'a, n>>
type ExpTree<'a, 'n> =
  | Int of 'n
  | Neg of AnnExp<'a, 'n'>
  | Add of AnnExp<'a, 'n> * AnnExp<'a, 'n>

The folders:

type AnnExpFolder<'a, 'n, 'd_ae, 'c_ae, 'u_ae, 'd_et, 'c_et, 'u_et> =
  DownUp<
    'd_ae * AnnExp<'a, 'n> -> 'c_ae * Annotated<'a, 'd_et>
  , 'c_ae * Annotated<'a, 'u_et> -> 'u_et
  >
type ExpTreeFolder<'a, 'n, 'd_ae, 'c_ae, 'u_ae, 'd_et, 'c_et, 'u_et> =
  {
  Int : DownUp<'d_et * 'n -> 'c_et, 'c_et * 'n -> 'u_et>
  Neg : DownUp<'d_et * AnnExp<'a, 'n> -> 'c_et * 'd_ae, 'c_et * 'u_ae -> 'u_et>
  Add : DownUp<'d_et * (AnnExp<'a, 'n> * AnnExp<'a, 'n>) -> 'c_et * ('d_ae * 'd_ae), 'c_et * ('u_ae * 'u_ae) -> 'u_et>
  }

The resulting folds:

type Fold<'a, 'n, 'd_ae, 'u_ae, 'd_et, 'u_et> =
  {
  AnnExp : 'd_ae -> AnnExp<'a, 'n> -> 'u_ae
  ExpTree : 'd_et -> AnnExp<'a, 'n> -> 'u_et
  }

// This couples the type parameters to each other.
let fold 
  (aef : AnnExpFolder<'a, 'n, 'd_ae, 'c_ae, 'u_ae, 'd_et, 'c_et, 'u_et>)
  (tef : AnnExpFolder<'a, 'n, 'd_ae, 'c_ae, 'u_ae, 'd_et, 'c_et, 'u_et>)
  : Fold<'a, 'n, 'd_ae, 'u_ae, 'd_et, 'u_et>
  =
  let rec annexp (d : 'd_ae) (ae : AnnExp<'a, 'n>) : 'u_ae =
    let (c, content_d)= aef.Down (d, ae)
    let content_u = exp content_d ae.Content
    aef.Up (c, content_u)
    
  and exp (d : 'd_et) (et : ExpTree<'a, 'n>) : 'u_et =
    match et with
    | Int n ->
      let c = tef.Int.Down (d, n)
      // No recursion as leaf
      tef.Int.Up (c, n)
    | Neg neg ->
      let (c, d') = tef.Add.Neg (d, neg)
      let u = annexp d' neg
      tef.Add.Neg (c, u) 
    | Add (e1, e2) ->
      let (c, (d1, d2)) = tef.Add.Down (d, (e1, e2))
      // Here still parallel fold
      let u1 = annexp d1 e1
      let u2 = annexp d2 e2
      tef.Add.Up (c, (u1, u2)) 
  {
  AnnExp = annexp
  ExpTree = exp
  }

Hierachical mutual recursion

A program consists of declarations. Declarations input/output identifiers of type 'id and calculate other identifiers. Expressions are

type Exp<'num, 'id> =
  | Int of 'num
  | Ref of 'id
  | Neg of Exp<'num, 'id>
  | Sum of list<Exp<'num, 'id>>
type Dec<'num, 'id> =
  | Input of 'id
  | Calc of 'id * Exp<'num, 'id>
  | Output of 'id
type Prog<'num, 'id> = 
  list<Dec<'num, 'id>>

Expanded form, with annotations added

type ExpAnn<'num, 'id, 'ann> =
  Annotated<'ann, Exp<'num, 'id, 'ann>>
and Exp<'num, 'id, 'ann> =
  | Int of 'num
  | Ref of 'id
  | Neg of ExpAnn<'num, 'id, 'ann>
  | Add of AddTuple
  | Sum of SumList<'num, 'id, 'ann>
and AddTuple<'num, 'id> =
  ExpAnn<'num, 'id, 'ann> * ExpAnn<'num, 'id, 'ann>
and SumList<'num, 'id> = 
  list<ExpAnn<'num, 'id, 'ann>> 
type Dec<'num, 'id, 'ann> =
  | Input of 'id
  | Calc of CalcDef<'num, 'id, 'ann>
  | Output of 'id
and CalcDef<'num, 'id, 'ann> =
  { Id : 'id; Def : Exp<'num, 'id, 'ann> }
type AnnDec<'num, 'id, 'ann, 'a_d> =
  Annotated<'a_d, Dec<'num, 'id, 'ann>>
type Prog<'num, 'id, 'ann, 'a_d> = 
  list<AnnDec<'num, 'id, 'ann, 'a_d>>
type AnnProg<'num, 'id, 'ann, 'a_d, 'a_p> =
  Annotated<'a_p, Prog<'num, 'id, 'ann, 'a_d>>

Folder records. By recursion strongly connected components have the same type parameters.

type ExpAnnFolder<'num, 'id, 'ann, 'd_ea, 'c_ea, 'u_ea, 'd_e, 'c_e, 'u_e, 'd_at, 'c_at, 'u_at, 'd_sl, 'c_sl, 'u_sl> =
  DownUp<
    'd_ea * Annotated<'ann, Exp<'num, 'id, 'ann>> -> 'c_ea
  , 'c_ea * Annotated<'ann, 'u_e> -> 'u_ea
  >
type ExpFolder<'num, 'id, 'ann, 'd_ea, 'c_ea, 'u_ea, 'd_e, 'c_e, 'u_e, 'd_at, 'c_at, 'u_at, 'd_sl, 'c_sl, 'u_sl> =
  {
  Int = DownUp<
       'd_e * 'num -> 'c_e
    ,  'c_e * 'num -> 'u_e
    >
  Ref = DownUp<
       'd_e * 'id -> 'c_e
    ,  'c_e * 'id -> 'u_e
    >
  Neg = DownUp<
       'd_e * ExpAnn<'num, 'id, 'ann> -> 'c_e
    ,  'd_e * 'u_ea -> 'u_e
    >
  Add = DownUp<
       'd_e * 'num -> 'c_e
    ,  'd_e * 'u_at -> 'u_e
    >
  SumList = DownUp<
       'd_e * 'num -> 'c_e
    ,  'd_e * 'u_sl -> 'u_e
    >
  }
type AddTupleFolder<'num, 'id, 'ann, 'd_ea, 'c_ea, 'u_ea, 'd_e, 'c_e, 'u_e, 'd_at, 'c_at, 'u_at, 'd_sl, 'c_sl, 'u_sl> =
  DownUp<
    'd_at * (ExpAnn<'num, 'id, 'ann> * ExpAnn<'num, 'id, 'ann>) -> 'c_at
  , 'c_at * ('u_ea * 'u_ea) -> 'u_at
  >
type SumListFolder<'num, 'id, 'ann, 'd_ea, 'c_ea, 'u_ea, 'd_e, 'c_e, 'u_e, 'd_at, 'c_at, 'u_at, 'd_sl, 'c_sl, 'u_sl> =
  DownUp<
    'd_sl * list<ExpAnn<'num, 'id, 'ann>>  -> 'c_sl
  , 'c_sl * 'u_ea -> 'u_sl
  >

type DecFolder<'num, 'id, 'ann, 'd_dec, 'c_dec, 'u_dec, 'd_cd, 'c_cd, 'u_cd, 'd_ea, 'u_ea> =
  // Definition omitted
  // 'd_ea and 'u_ea are the only type variables coupling to the expression level
  // '$x_dec is for Dec
  // '$x_cd is for CalcDef

// Other folders left out.

Fold:

// To be written

General mutual recursion

Expand out $m$ mutually recursive types into canonical form
- only recursion throught cases/fields directly through another recursive type
- this may introduce more intermediate types and enlarge the recursive type into $n$ types
Construct the folders
- a type variable for each type variable of the original recursive types
- a type variable for each of the $n$ expanded types
  - this is for the simple fold
  - if passing information down, there is a second type variable for each of the $n$ types
- For each of the $n$ expanded types
  - DU: A record of functions
    - for each case | Case of 'payload a field named Case of type DownUp
      - Down: 'down-for-type * 'payload -> needed 'down-for-types associated with recursive calls in 'payload
      - Up: 'down-for-type * ('payload with recursive types replaced by corresponding up type vars) -> 'up-for-type
  - Record, tuple, map, set or other pre-defined container datatype
    - A single DownUp
      - Down: 'down-for-type * 'container -> needed 'down-for-types associated with recursive calls in 'container parameters
      - Up: 'down-for-type * ('container with recursive types replaced by corresponding up type vars) -> 'up-for-type
Write the fold
- Write a record to collect all the fold functions
  - for each of the $n$ types a field
    - always the form: 'down-for-type * 'type -> 'up-for-type
- implementation
  - taking all the folder instances
  - returning a fold record
  - implementation mutual recursive function for the $n$ expanded types
    - for DU
      - match on cases
        
        for each case
        
        apply .Down to (d, node-data) => c, d'
        
        u = recurse down with new d'
        
        apply .Up to (c, node-data or u)
    - for container
      - apply .Down to (d, container) => c, d'
      - u = thread d’ through container fold, recursing down
      - apply .Up to (c, container with u u)

Factoring out

Factor in intermediate cases only if
- Different types are needed to be passed up/along/down
- A factored type is used at least twice => allows for factoring of logic