20221206 PL&V Reading Group: There And Back Again

20221206-taba.md

After missing a couple of sessions I was able to attend the reading group to go through There and back again, a functional pearl demonstrating techniques for recursing over a list or other data structure and processing it "at return time" to perform convolutions or other operations like palindrome checking.

The examples were all given in ML which gives me a bit of a headache, but the paper leads off with three exercises for the reader that were very helpful for focusing the attention and led to some interesting discussion.

The attached files demonstrate how to use the there-and-back-again approach in Haskell (taba.hs) and Prolog (taba.pl) to implement convolution, palindrome checking, and also general list reverse. It's basically just using the call stack to avoid needing to construct an auxiliary list, and whether that's beneficial or not depends on what you're doing (and how big is your stack) but it's a useful technique to know.

It inspired me to add a decidedly non-functional bonus: a C program (palindrome.c) that checks whether a list is a palindrome using no recursive calls and no allocation by reversing the second half of the list in place, doing the check, then reversing it back again! (It would have been nice to do this in Rust, but sneaking the mutation past the borrow checker appears to require unsafe code or additional overhead).

References

There and back again
https://dl.acm.org/doi/10.1145/581478.581500

palindrome.c

#include <stdlib.h>
#include <stdio.h>
#include <stdbool.h>

typedef struct Node {
    char data;
    struct Node *next;
} Node;

Node *string_to_list(const char *s) {
    if (*s) {
        Node *list = (Node *) malloc(sizeof(Node));
        list->data = *s;
        list->next = string_to_list(s + 1);
        return list;
    } else {
        return NULL;
    }
}

void print_list(const Node *list) {
    for (; list; list = list->next) {
        putchar(list->data);
    }
}

Node *reverse(Node *list) {
    Node *tail = NULL;
    while (list) {
        Node *temp = list->next;
        list->next = tail;
        tail = list;
        list = temp;
    }
    return tail;
}

bool compare_list(const Node *a, const Node *b) {
    for (; a && b; a = a->next, b = b->next) {
        if (a->data != b->data) return false;
    }
    return true;
}

bool palindrome(Node *list) {
    Node *mid = list;
    Node *end = list;
    for (; end; mid = mid->next, end = (end->next ? end->next->next : end->next));
    mid = reverse(mid);
    bool res = compare_list(list, mid);
    reverse(mid);
    return res;
}

void test(const char *s) {
    Node *list = string_to_list(s);
    bool res = palindrome(list);
    putchar('\'');
    print_list(list);
    putchar('\'');
    printf(" %s a palindrome\n", res ? "is" : "is not");
}

int main() {
    test("");
    test("a");
    test("ab");
    test("aa");
    test("aba");
    test("nope");
    test("appa");
    test("hello");
    test("kayak");
    return 0;
}

taba.hs

taba :: (a -> b -> c -> c) -> c -> [a] -> [b] -> c
taba f base xs ys = fst (foldr (taba_acc f) (base, ys) xs)

taba_acc :: (a -> b -> c -> c) -> a -> (c, [b]) -> (c, [b])
taba_acc f x (ret, y : ys) = (f x y ret, ys)

convolve_f :: a -> b -> [(a, b)] -> [(a, b)]
convolve_f x y tail = (x, y) : tail

palindrome_f :: (Eq a) => a -> a -> Bool -> Bool
palindrome_f x y c = c && (x == y)

reverse_f :: a -> a -> [a] -> [a]
reverse_f _x y tail = y : tail

convolve xs ys = taba convolve_f [] xs ys

palindrome xs = taba palindrome_f True xs xs

reverse xs = taba reverse_f [] xs xs

taba.pl

taba(Base, _P, OrigYs, [], [], Base - OrigYs).

taba(Base, P, OrigYs, [X|Xs], [_Y|Ys], Ret - RetYs) :-
    taba(Base, P, OrigYs, Xs, Ys, Ret0 - [RetY|RetYs]),
    call(P, X, RetY, Ret0, Ret).

convolve_p(X, Y, Tail, [X-Y|Tail]).
convolve(Xs, Ys, Zs) :- taba([], convolve_p, Ys, Xs, Ys, Zs - _).

palindrome_p(X, Y, Tail, Tail) :- X = Y.
palindrome(Xs) :- taba([], palindrome_p, Xs, Xs, Xs, _).

reverse_p(_X, Y, Tail, [Y|Tail]).
my_reverse(Xs, Zs) :- taba([], reverse_p, Xs, Xs, Xs, Zs - _).