Skip to content

Instantly share code, notes, and snippets.

@ClarkeRemy

ClarkeRemy/recursion_schemes.sml

Created July 26, 2024 14:42
Show Gist options
  • Save ClarkeRemy/06cc4b390b6661cdf980b093004c3f82 to your computer and use it in GitHub Desktop.
Save ClarkeRemy/06cc4b390b6661cdf980b093004c3f82 to your computer and use it in GitHub Desktop.
Download ZIP
Recursion schemes based on Wang Murphy paper
Raw
recursion_schemes.sml
(* https://www.cs.cmu.edu/~tom7/papers/wang-murphy-recursion.pdf *)
signature TYP = sig
type t
type 'a F
val Fmap : ('a -> 'b) -> 'a F -> 'b F
val inj : t F -> t
val prj : t -> t F
end
functor AuxDefs(structure T :TYP) : sig
structure T : TYP
val fold : ('a T.F -> 'a) -> T.t -> 'a
val unfold : ( 'a -> 'a T.F) -> 'a -> T.t
val inj_succ : ( 'a -> T.t) -> 'a T.F -> T.t
val prj_succ : (T.t -> 'a) -> T.t -> 'a T.F
end = struct
structure T = T
open T
fun fold step x = (step o Fmap (fold step) o prj) x
fun unfold gen x = (inj o Fmap (unfold gen ) o gen) x
fun inj_succ inj_pred = inj o Fmap inj_pred
fun prj_succ prj_pred = Fmap prj_pred o prj
end
structure ForTest =struct
datatype 'a F = Zero | Succ of 'a
type t = int
fun Fmap f n = case n of Zero => Zero | Succ n => (Succ o f) n
fun inj Zero = 0 | inj (Succ n) = n + 1
fun prj 0 = Zero | prj n = Succ (n-1)
end
structure ATest = AuxDefs(structure T = ForTest)
fun h a b= (print "h"; a o b)
fun j a b x = (print "j" ; (a o b) x)
fun gee () = ATest.unfold (fn 0 => ForTest.Zero | n => ForTest.Succ (n-1) ) 3
fun wiz () = ATest.fold (fn ForTest.Zero => 1 | ForTest.Succ n => n*2) (gee())
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment