Skip to content

Commit 131cd95

Browse files
jnapejnape
committed
Initial attempt at approximation of catamorphism using fixed inductive types
1 parent 1760ec4 commit 131cd95

File tree

7 files changed

+168
-9
lines changed

7 files changed

+168
-9
lines changed

‎src/main/java/com/jnape/palatable/lambda/recursionschemes/Algebra.java

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
package com.jnape.palatable.lambda.recursionschemes;
2+
3+
import com.jnape.palatable.lambda.functions.Fn1;
4+
import com.jnape.palatable.lambda.functor.Functor;
5+
6+
public interface Algebra<F extends Functor<A, ?>, A> extends Fn1<F, A> {
7+
}

‎src/main/java/com/jnape/palatable/lambda/recursionschemes/builtin/Catamorphism.java

Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,33 @@
1+
package com.jnape.palatable.lambda.recursionschemes.builtin;
2+
3+
import com.jnape.palatable.lambda.functions.Fn1;
4+
import com.jnape.palatable.lambda.functions.Fn2;
5+
import com.jnape.palatable.lambda.functor.Functor;
6+
import com.jnape.palatable.lambda.recursionschemes.Algebra;
7+
import com.jnape.palatable.lambda.recursionschemes.Fix;
8+
9+
public class Catamorphism<A, F extends Functor, FA extends Functor<A, F>> implements Fn2<Algebra<FA, A>, Fix<F, ? extends Functor<? extends Fix<F, ?>, F>>, A> {
10+
11+
private static final Catamorphism INSTANCE = new Catamorphism();
12+
13+
@Override
14+
@SuppressWarnings("unchecked")
15+
public A apply(Algebra<FA, A> algebra, Fix<F, ? extends Functor<? extends Fix<F, ?>, F>> fixed) {
16+
return algebra.apply((FA) fixed.unfix().fmap(x -> cata(algebra, (Fix<F, Functor<Fix<F, ?>, F>>) x)));
17+
}
18+
19+
@SuppressWarnings("unchecked")
20+
public static <A, F extends Functor, FA extends Functor<A, F>> Catamorphism<A, F, FA> cata() {
21+
return INSTANCE;
22+
}
23+
24+
public static <A, F extends Functor, FA extends Functor<A, F>> Fn1<Fix<F, ? extends Functor<? extends Fix<F, ?>, F>>, A> cata(
25+
Algebra<FA, A> algebra) {
26+
return Catamorphism.<A, F, FA>cata().apply(algebra);
27+
}
28+
29+
public static <A, F extends Functor, FA extends Functor<A, F>> A cata(
30+
Algebra<FA, A> algebra, Fix<F, ? extends Functor<? extends Fix<F, ?>, F>> fixed) {
31+
return cata(algebra).apply(fixed);
32+
}
33+
}

‎src/test/java/com/jnape/palatable/lambda/recursionschemes/builtin/CatamorphismTest.java

Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,34 @@
1+
package com.jnape.palatable.lambda.recursionschemes.builtin;
2+
3+
import com.jnape.palatable.lambda.recursionschemes.Algebra;
4+
import org.junit.Test;
5+
import testsupport.recursion.ListF;
6+
import testsupport.recursion.NatF;
7+
8+
import static com.jnape.palatable.lambda.recursionschemes.Fix.fix;
9+
import static com.jnape.palatable.lambda.recursionschemes.builtin.Catamorphism.cata;
10+
import static org.junit.Assert.assertEquals;
11+
import static testsupport.recursion.List.cons;
12+
import static testsupport.recursion.List.nil;
13+
import static testsupport.recursion.Nat.s;
14+
import static testsupport.recursion.Nat.z;
15+
16+
public class CatamorphismTest {
17+
18+
@Test
19+
public void foldingThroughLeastFixedPoint() {
20+
Algebra<NatF<Integer>, Integer> sum = nat -> nat.match(z -> 0, s -> s.carrier() + 1);
21+
assertEquals((Integer) 0, cata(sum).apply(fix(NatF.z())));
22+
assertEquals((Integer) 0, cata(sum).apply(z()));
23+
24+
assertEquals((Integer) 3, cata(sum).apply(fix(NatF.s(fix(NatF.s(fix(NatF.s(fix(NatF.z())))))))));
25+
assertEquals((Integer) 3, cata(sum).apply(s(s(s(z())))));
26+
27+
Algebra<ListF<String, Integer>, Integer> length = list -> list.match(nil -> 0, cons -> 1 + cons.tail());
28+
assertEquals((Integer) 0, cata(length).apply(fix(ListF.nil())));
29+
assertEquals((Integer) 0, cata(length).apply(nil()));
30+
31+
assertEquals((Integer) 3, cata(length).apply(fix(ListF.cons("3", fix(ListF.cons("2", fix(ListF.cons("1", fix(ListF.nil())))))))));
32+
assertEquals((Integer) 3, cata(length).apply(cons("3", cons("2", cons("1", nil())))));
33+
}
34+
}

‎src/test/java/testsupport/recursion/List.java

Lines changed: 25 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,25 @@
1+
package testsupport.recursion;
2+
3+
import com.jnape.palatable.lambda.recursionschemes.Fix;
4+
5+
public final class List<A> implements Fix<ListF<A, ?>, ListF<A, List<A>>> {
6+
7+
private final ListF<A, List<A>> unfixed;
8+
9+
private List(ListF<A, List<A>> unfixed) {
10+
this.unfixed = unfixed;
11+
}
12+
13+
@Override
14+
public ListF<A, List<A>> unfix() {
15+
return unfixed;
16+
}
17+
18+
public static <A> List<A> nil() {
19+
return new List<>(ListF.nil());
20+
}
21+
22+
public static <A> List<A> cons(A head, List<A> tail) {
23+
return new List<>(ListF.cons(head, tail));
24+
}
25+
}

‎src/test/java/testsupport/recursion/ListF.java

Lines changed: 33 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,18 @@
11
package testsupport.recursion;
22

3+
import com.jnape.palatable.lambda.adt.coproduct.CoProduct2;
34
import com.jnape.palatable.lambda.functor.Functor;
45

56
import java.util.function.Function;
67

7-
public abstract class ListF<A, B> implements Functor<B, ListF<A, ?>> {
8+
public abstract class ListF<A, B> implements Functor<B, ListF<A, ?>>, CoProduct2<ListF.Nil<A, B>, ListF.Cons<A, B>> {
89

910
public static <A, B> ListF<A, B> nil() {
1011
return new Nil<>();
1112
}
1213

13-
public static <A, B> ListF<A, B> cons(@SuppressWarnings("unused") A a,
14-
@SuppressWarnings("unused") B b) {
15-
return new Cons<>();
14+
public static <A, B> ListF<A, B> cons(A head, B tail) {
15+
return new Cons<>(head, tail);
1616
}
1717

1818
public static final class Nil<A, B> extends ListF<A, B> {
@@ -22,14 +22,42 @@ public static final class Nil<A, B> extends ListF<A, B> {
2222
public <C> ListF<A, C> fmap(Function<? super B, ? extends C> fn) {
2323
return (Nil<A, C>) this;
2424
}
25+
26+
@Override
27+
public <R> R match(Function<? super Nil<A, B>, ? extends R> aFn,
28+
Function<? super Cons<A, B>, ? extends R> bFn) {
29+
return aFn.apply(this);
30+
}
2531
}
2632

2733
public static final class Cons<A, B> extends ListF<A, B> {
2834

35+
private final A head;
36+
private final B tail;
37+
38+
private Cons(A head, B tail) {
39+
this.head = head;
40+
this.tail = tail;
41+
}
42+
43+
public A head() {
44+
return head;
45+
}
46+
47+
public B tail() {
48+
return tail;
49+
}
50+
2951
@Override
3052
@SuppressWarnings("unchecked")
3153
public <C> ListF<A, C> fmap(Function<? super B, ? extends C> fn) {
32-
return (ListF<A, C>) this;
54+
return new Cons<>(head, fn.apply(tail));
55+
}
56+
57+
@Override
58+
public <R> R match(Function<? super Nil<A, B>, ? extends R> aFn,
59+
Function<? super Cons<A, B>, ? extends R> bFn) {
60+
return bFn.apply(this);
3361
}
3462
}
3563
}

‎src/test/java/testsupport/recursion/Nat.java

Lines changed: 25 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,25 @@
1+
package testsupport.recursion;
2+
3+
import com.jnape.palatable.lambda.recursionschemes.Fix;
4+
5+
public final class Nat implements Fix<NatF, NatF<Nat>> {
6+
7+
private final NatF<Nat> carrier;
8+
9+
private Nat(NatF<Nat> carrier) {
10+
this.carrier = carrier;
11+
}
12+
13+
@Override
14+
public NatF<Nat> unfix() {
15+
return carrier;
16+
}
17+
18+
public static Nat z() {
19+
return new Nat(NatF.z());
20+
}
21+
22+
public static Nat s(Nat n) {
23+
return new Nat(NatF.s(n));
24+
}
25+
}

‎src/test/java/testsupport/recursion/NatF.java

Lines changed: 11 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -11,8 +11,8 @@ public static <A> NatF<A> z() {
1111
return new Z<>();
1212
}
1313

14-
public static <A> NatF<A> s(@SuppressWarnings("unused") A a) {
15-
return new S<>();
14+
public static <A> NatF<A> s(A a) {
15+
return new S<>(a);
1616
}
1717

1818
public static final class Z<A> extends NatF<A> {
@@ -33,13 +33,20 @@ public <R> R match(Function<? super Z<A>, ? extends R> aFn, Function<? super S<A
3333
}
3434

3535
public static final class S<A> extends NatF<A> {
36-
private S() {
36+
private final A a;
37+
38+
private S(A a) {
39+
this.a = a;
40+
}
41+
42+
public A carrier() {
43+
return a;
3744
}
3845

3946
@Override
4047
@SuppressWarnings("unchecked")
4148
public <B> NatF<B> fmap(Function<? super A, ? extends B> fn) {
42-
return (NatF<B>) this;
49+
return new S<>(fn.apply(a));
4350
}
4451

4552
@Override

0 commit comments

Comments
 (0)