Skip to content

Instantly share code, notes, and snippets.

@madidier
Last active July 6, 2023 12:05
Show Gist options
  • Star 6 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save madidier/4b4e52db9007e74cb77423006769437a to your computer and use it in GitHub Desktop.
Save madidier/4b4e52db9007e74cb77423006769437a to your computer and use it in GitHub Desktop.
Sum type encoding and catamorphism of "Either" in various languages and approaches

The Sum Type Ménagerie

Welcome in the Sum Type Ménagerie ! Feel free to skip the explanations and tour the specimens, or alternatively, you know... study the explanation.

Specification

Each program, or "specimen" as we'll call them here solves the exact same little problem. I'll explain the problem in terms of set theory, although, the concept can be understood from a type theory viewpoint as being a basic implementation of tagged unions, sum type, or even coproduct (yes, the concept has a few names).

Now, let's pick two sets. We'll call them A and B. I want to construct a set that contains both these sets, in such a way that I can "remember" where the elements of this bigger set came from. That is, if some element is a member of both A and B, and I see that element in my combined set, I want to be able to tell either "It came from the A set", or, "It came from the B set". This implies my combined set will contain two distinct values for the values that are contained in both sets.

I'll call this set Either(A, B) for some arbitrary A and B. For every element a of A, I'll write down the corresponding element in Either(A, B) as Left(a). Likewise, every element b of B in Either(A, B) will be denoted as Right(b).

The first basic thing our specimen will have to do is to provide a universal programming representation for any Either set; that is, it should let us pick arbitrary As and Bs and construct values from the Either(A, B) set.

Next, in order to be able to do something useful with our Either(A, B) values, we should get some means of extracting values from it. We'll want to be able to pick any arbitrary set C, any arbitrary function f from A to C and an arbitrary function g from B to C, and somehow, combine f and g into a h function from Either(A, B) to C. We'll write h = Cata(f, g). Cata is a shorthand for catamorphism, from the greek words meaning downward and shape. "To shape downward", since we are going from members of the Either(A, B) set to members of the C set. *

In our specimens, this Cata(f, g) function will generally be called match (because it allows us to conditionally pick either function depending on which shape a value matches with, and matches is somehow a word many programmers prefer to read). Or, if the programming languages already reserves the match word to mean something else, it will be called cata.

By convention, in each specimen, we'll create the value Right("lol") from the Either(Text, Text) set. Then, we'll apply a catamorphism to it, where the left function is a function that evaluates to the empty text for any input text, and the right function will be the function that evaluates to the text that was passed down to it, for any input text. The result of this operation should be displayed on the screen. That is, the program should display "lol".

*: I'm slightly abusing the language here, since catamorphisms in general are related to recursive data types and Either(A, B) is not a recursive type. What I'm describing is still technically a catamorphism though, since a non-recursive data type can be considered a special case of recursive data types. There are great articles detailing the concept online. Have a peek with Google if you're interested.

Examples / Use cases in languages that support sum types

In a haskell-like language:

data Settlement
  = Paypal (Amount USD)
  | Check (Amount USD)
  | LoyaltyPoints Int
  | ...

messages :: Settlement -> List Message
messages (Check amount) | amount < Amount 20 USD = [warn "Check payments of less than $20 incur a $0.50 processing fee"]
messages (LoyaltyPoints _) = [info "Thanks for your loyalty to ACME services !"]
messages _ = []

In a ML-like language (ie, OCaml or F#):

type Settlement =
  | Paypal of UsdAmount
  | Check of UsdAmount
  | LoyaltyPoints of Int
  | ...
;;

let messages : Settlement -> Message list = function
  | Check(usdAmount) when usdAmount < 20 -> [warn "Check payments of less than $20 incur a $0.50 processing fee"]
  | LoyaltyPoints(_) -> [info "Thanks for your loyalty to ACME services !"]
  | _ -> []
;;

Specimen Naming

The specimens fall roughly in two cases (there may be more than one specimen for a given programming language):

  • The base case, with a file named Either.lang. These are the somewhat "boring" implementations that use the language's idiomatic mechanism for defining and using data types.
  • The Higher Order Function-based ones, with a file named Either-hof.lang. These are the implementation, that, for better or worse, do not use the host language's data definition idioms. They rely on the language's context capture mechanism instead (or in the very specific case of the C language, manually mimics context capture). Most of the time, this leads to shorter code.

Represented Languages

  • Adga
  • C
  • C++
  • C#
  • Ceylon
  • Clojure
  • CoffeeScript
  • D
  • Erlang
  • F#
  • Go
  • Haskell
  • Idris
  • Java
  • JavaScript (ES6)
  • Kotlin
  • LiveScript
  • Lua
  • Mercury
  • OCaml
  • PHP
  • Perl
  • PowerShell
  • Prolog
  • PureScript
  • Python 2 and 3 (specimens use a compatible subset)
  • Ruby
  • Rust
  • Racket
  • Scala
  • Swift
  • Tulip
  • TypeScript
  • Untyped lambda calculus (encoded through prolog terms and tested with an interpreter I wrote)

(Probable) Future Languages

  • VB.NET: I'm not really looking forward to that one, but if I find myself in lack of a more interesting language to learn about, I'll certainly do this.
  • Vala, Genie: Last time I looked, these two compiled down to C with reference counted GObjects. I wonder what their type systems look like and what would be available for me to implement specimens.
  • Delphi: I've noticed commercial accounting software sold in France, which uses that language. May be interesting to dig in a bit.
  • Groovy: The reasons for its recent apparent rise in popularity on the JVM are somewhat unclear to me. Is it much more than an optionally typed Java with syntactic sugar and meta-programmable closures ? Writing a specimen won't be enough to answer that question, though.
  • Nix: A specimen should be trivial to write. But testing it would be an occasion to learn more about Nix tooling instead of just having a dormant NixOS setup on my laptop.
  • ATS: I've read very interesting things about this language. But currently, it simply is a language I can't decypher.
  • Eiffel: A verified language. The PL design seems dated and somewhat impractical (i.e., it seems to rely heavily on subtyping). It would be interesting to see what is possible within that language's limits, though.
  • Emacs Lisp: Because despite having been an emacs user for years, I still don't know how to hello world in emacs lisp.

Excluded Languages

  • Bash: It lacks anything that would remotely look like a closure.

Why ?

Because that's bloody fun.

-- I haven't been able to actually run the program (broken archlinux packages), but it typechecks
open import Data.String
open import Function
open import IO.Primitive
Either : Set → Set → Set₁
Either l r = {a : Set} → (l → a) → (r → a) → a
Left : { l r : Set } → l → Either l r
Left val l _ = l val
Right : { l r : Set } → r → Either l r
Right val _ r = r val
main = putStrLn (toCostring (Right {String} "lol" (const "") id))
#include "stdio.h"
/* Why am I inflicting this upon myself ? */
/* Closure emulation */
/* This actually lacks a memory management solution... */
/* The least painful to implement half-solution would be an arena */
typedef struct closure {
void* ctx;
union value (*call)(void*, union value);
} closure_t;
/* value_t is just a hack to reduce the need for heap allocations... */
typedef union value {
void* ptr;
struct closure closure;
} value_t;
value_t apply(closure_t fn, value_t arg) {
return fn.call(fn.ctx, arg);
}
/* Utility closures */
/* forall a. a -> (forall b. b -> a) */
value_t constant_impl(void* x, value_t arg) {
return (value_t){.ptr = x};
}
closure_t constant(void* x) {
return (closure_t){ x, constant_impl };
}
/* forall a. a -> a */
value_t identity_impl(void* ctx, value_t arg) {
return arg;
}
static const closure_t identity = { NULL, identity_impl };
/* Finally, the church encoding of Left */
/* forall l r. l -> (forall t. (l -> t) -> (r -> t) -> t) */
value_t Left_impl(void* val, value_t leftFn) {
return (value_t){.closure = constant(
apply(leftFn.closure, (value_t){.ptr = val}).ptr
)};
}
closure_t Left(void* val) {
return (closure_t){ val, Left_impl };
}
/* And, of Right */
/* forall l r. r -> (forall t. (l -> t) -> (r -> t) -> t) */
value_t Right_impl1(void* val, value_t rightFn) {
return apply(rightFn.closure, (value_t){.ptr = val});
}
value_t Right_impl0(void* val, value_t leftFn) {
return (value_t){.closure = { val, Right_impl1 }};
}
closure_t Right(void* val) {
return (closure_t){ val, Right_impl0 };
}
int main(void) {
printf("%s\n",
apply(apply(
Right("lol"),
(value_t){.closure = constant("")}).closure,
(value_t){.closure = identity }).ptr
);
return 0;
}
alias Either<L, R> => <T> => T(T(L), T(R));
Either<L, Nothing> left <L>(L val) => <T>(T(L) l, T(Nothing) r) => l(val);
Either<Nothing, R> right<R>(R val) => <T>(T(Nothing) l, T(R) r) => r(val);
print(right("lol")((_) => "", (x) => x));
(defn Left [val] (fn [l r] (l val)))
(defn Right [val] (fn [l r] (r val)))
(print ((Right "lol") (constantly "") identity))
Left = (val) => (l) => (r) => l val
Right = (val) => (l) => (r) => r val
console.log Right("lol")((x) => "")((x) => x)
-module(main).
-export([main/0]).
left(Value) ->
fun(L, _) -> L(Value) end.
right(Value) ->
fun(_, R) -> R(Value) end.
main() ->
io:format("~s~n", [(right("lol"))(
fun(_) -> "" end,
fun(X) -> X end)]).
type Either<'l, 'r> = abstract cata : ('l -> 'a) -> ('r -> 'a) -> 'a
let left x = { new Either<_, _> with member this.cata l r = l x }
let right x = { new Either<_, _> with member this.cata l r = r x }
System.Console.WriteLine((right "lol").cata (fun _ -> "") id)
package main
import "fmt"
type Either[A any, B any] func(func(A) any, func(B) any) any
func Left[A any, B any](value A) Either[A, B] {
return func(l func(A) any, r func(B) any) any {
return l(value)
}
}
func Right[A any, B any](value B) Either[A, B] {
return func(l func(A) any, r func(B) any) any {
return r(value)
}
}
func main() {
fmt.Println(Right[string, string]("lol")(
func(x string) any { return "" },
func(x string) any { return x }))
}
{-# LANGUAGE RankNTypes #-}
type Either' l r = forall a. (l -> a) -> (r -> a) -> a
left :: l -> Either' l r
left val l _ = l val
right :: r -> Either' l r
right val _ r = r val
main :: IO ()
main = putStrLn (right "lol" (const "") id)
Either' : Type -> Type -> Type
Either' l r = {a: Type} -> (l -> a) -> (r -> a) -> a
left : l -> Either' l r
left val l _ = l val
right : r -> Either' l r
right val _ r = r val
main : IO ()
main = putStrLn (right {l=String} "lol" (const "") id)
const Left = val => (l, _) => l(val);
const Right = val => (_, r) => r(val);
console.log(Right("lol")(_ => "", x => x));
To be evaluated using my prolog lambda calculus evaluator:
https://gist.github.com/madidier/bfb9a936550c92d7d63fea49da90253d
Left = x -> l -> r -> l(x),
Right = x -> l -> r -> r(x),
Id = x -> x,
Const = a -> b -> a,
Main = [Right, "lol", [Const, ""], Id],
parse(Main, AST), deepEval(AST, :Res), writeln(Res).
Left = (val) -> (l, r) -> l val
Right = (val) -> (l, r) -> r val
console.log Right("lol")((x) -> "", (x) -> x)
function Left(val)
return function(l, r) return l(val) end
end
function Right(val)
return function(l, r) return r(val) end
end
print(Right("lol")(
function (x) return "" end,
function (x) return x end
))
type ('l, 'r) either = { cata: 'a . ('l -> 'a) -> ('r -> 'a) -> 'a }
let left x = { cata = fun l _ -> l x }
let right x = { cata = fun _ r -> r x }
;;
print_endline @@ (right "lol").cata (fun _ -> "") (fun x -> x)
function Left($val) {
return function($l, $r) use ($val) {
return $l($val);
};
}
function Right($val) {
return function($l, $r) use ($val) {
return $r($val);
};
}
echo Right("lol")(
function() { return ""; },
function($x) { return $x; }
);
echo "\n";
use feature 'signatures', 'say';
no warnings 'experimental::signatures';
sub Left($value) {
sub($l, $) { $l->($value) }
}
sub Right($value) {
sub($, $r) { $r->($value) }
}
say (Right("lol")->(sub($) { "" }, sub($x) { $x }));
function Left { param($val)
return { param($l, $r) return & $l $val }.getNewClosure()
}
function Right { param($val)
return { param($l, $r) return & $r $val }.getNewClosure()
}
Write-Output (& (Right "lol") {param($x) return ""} {param($x) return $x})
module Main where
import Prelude
import Control.Monad.Eff.Console (log)
type Either l r = forall a. (l -> a) -> (r -> a) -> a
left :: forall l r. l -> Either l r
left val l _ = l val
right :: forall l r. r -> Either l r
right val _ r = r val
main = log $ right "lol" (const "") id
Left = lambda val: lambda l: lambda _: l(val)
Right = lambda val: lambda _: lambda r: r(val)
print(Right("lol")(lambda _: "")(lambda x: x))
def Left(val)
-> (l, r) { l.call(val) }
end
def Right(val)
-> (l, r) { r.call(val) }
end
print Right("lol").call(-> (_) { "" }, -> (x) { x })
#lang racket
(define (Left val)
(lambda (l r) (l val)))
(define (Right val)
(lambda (l r) (r val)))
(displayln
((Right "lol") (const "") identity))
#lang typed/racket
(define-type (Either L R)
(All (T) (-> L T) (-> R T) -> T))
(: Left (All (L R) L -> (Either L R)))
(define (Left val)
(lambda (l r) (l val)))
(: Right (All (L R) R -> (Either L R)))
(define (Right val)
(lambda (l r) (r val)))
(displayln
((Right "lol") (lambda (x) "") (lambda (x) x)))
-- I haven't been able to actually run the program (broken archlinux packages), but it typechecks
open import Data.String
open import Function
open import IO.Primitive
data Either l r : Set where
Left : l → Either l r
Right : r → Either l r
match : {l r a : Set} → Either l r → (l → a) → (r → a) → a
match (Left val) l _ = l val
match (Right val) _ r = r val
main = putStrLn (toCostring (match {String} (Right "lol") (const "") id))
/*
* This is only a half solution, but that's the closest I could get while
* remaining portable and not defining my own closures.
*/
#include "stdio.h"
typedef enum { LEFT, RIGHT } either_tag;
typedef struct { either_tag tag; void* data; } either_t;
#define MATCH(e, l, r) (e.tag == LEFT ? l(e.data) : r(e.data))
/* This is a hack... that's required in order to use the macro just above */
#define CONST(x) x IGNORE
#define IGNORE(x)
#define ID(x) x
/* Of course, you could just use the raw ternary expression at each call site instead */
/* And that's what a C programmer would probably do */
/* He would also probably use a different tag and a different union type for each pair of types */
int main(void) {
either_t val = { RIGHT, "lol" };
printf("%s\n", MATCH(val, CONST(""), ID));
return 0;
}
// Templates aren't really types, but let's do what they're designed for:
// misuse them
// Actually this uses upcoming C++17 features
//
// Compile with: g++ Either.c++ --std=c++1z
// Tested with GCC 6.3.1
#include <functional>
#include <iostream>
#include <experimental/optional>
using namespace std;
using namespace std::experimental;
template <class L, class R>
struct Either {
template <class T>
T match(function<T(const L&)> l, function<T(const R&)> r) const {
optional<T> res;
match_([&](const L& val) { res = l(val); },
[&](const R& val) { res = r(val); });
return res.value();
}
protected:
virtual void match_(function<void(const L&)> l, function<void(const R&)> r) const = 0;
};
template <class L, class R>
struct Left : public Either<L, R> {
Left(L value) : value_(value) {}
private:
L value_;
protected:
void match_(function<void(const L&)> l, function<void(const R&)> r) const {
l(value_);
}
};
template <class L, class R>
struct Right : public Either<L, R> {
Right(R value) : value_(value) {}
private:
R value_;
protected:
void match_(function<void(const L&)> l, function<void(const R&)> r) const {
r(value_);
}
};
int main() {
cout <<
Right<string, string>("lol")
.match<string>([](auto& x) { return ""; },
[](auto& x) { return x ; })
<< endl;
return 0;
}
interface Either<out L, out R> {
shared formal T match<T>(T(L) l, T(R) r);
}
class Left<L>(L val) satisfies Either<L, Nothing> {
shared actual T match<T>(T(L) l, T(Nothing) r) => l(val);
}
class Right<R>(R val) satisfies Either<Nothing, R> {
shared actual T match<T>(T(Nothing) l, T(R) r) => r(val);
}
print(Right("lol").match((_) => "", (x) => x));
using System;
abstract class Either<L, R> {
public abstract T match<T>(Func<L, T> l, Func<R, T> r);
public static Either<L, R> Left (L value) { return new Left_ (value); }
public static Either<L, R> Right(R value) { return new Right_(value); }
private class Left_: Either<L, R> {
readonly L Value;
public Left_(L value) { Value = value; }
public override T match<T>(Func<L, T> l, Func<R, T> r) {
return l(Value);
}
}
private class Right_: Either<L, R> {
readonly R Value;
public Right_(R value) { Value = value; }
public override T match<T>(Func<L, T> l, Func<R, T> r) {
return r(Value);
}
}
}
class MainClass {
public static void Main (string[] args) {
Console.WriteLine (Either<String, String>.Right("lol").match(l => "", r => r));
}
}
import std.stdio;
import std.typecons : Typedef;
import std.variant : Algebraic;
alias Left (L) = Typedef!(L, L.init, "left" );
alias Right(R) = Typedef!(R, R.init, "right");
alias Either(L, R) = Algebraic!(Left!L, Right!R);
T match(L, R, T)(Either!(L, R) v, T delegate(L) l, T delegate(R) r)
{
if (v.peek!(Left!L) !is null)
return l(cast(L)v.get!(Left!L));
else
return r(cast(R)v.get!(Right!R));
}
void main()
{
writeln(
match!(string, string, string)(
Either!(string, string)(Right!string("lol")),
(string x) { return ""; },
(string x) { return x; }));
}
% This is early experimentation with Twelf...
% We have to define a language... An extended STLC where tp are going to be our types.
tp : type.
string : tp.
fun : tp -> tp -> tp.
% Of course, we'll also need terms.
tm : tp -> type.
string/hello : tm string.
string/empty : tm string.
lam : (tm A -> tm B) -> tm (fun A B).
app : tm (fun A B) -> tm A -> tm B.
% And an... "interpreter".
eval : tm A -> tm A -> type.
eval/string/hello : eval string/hello string/hello.
eval/string/empty : eval string/empty string/empty.
eval/lam-app : eval (app (lam F) X) R <- eval (F X) R.
% We can now define either.
either : tp -> tp -> tp.
left : tm A -> tm (either A B).
right : tm B -> tm (either A B).
match : tm (either A B) -> tm (fun A C) -> tm (fun B C) -> tm C.
% And its interpretations...
eval/left-match : eval (match (left X) F _) R <- eval (app F X) R.
eval/right-match : eval (match (right X) _ G) R <- eval (app G X) R.
main : tm string = match (right string/hello) (lam [x] string/empty) (lam [x] x).
%query 1 * eval main X.
% Twelf succesfully figures out that X = string/hello.
-module(main).
-export([main/0]).
-record(left, {value}).
-record(right, {value}).
match(#left {value=Value}, L, _) -> L(Value);
match(#right{value=Value}, _, R) -> R(Value).
main() ->
io:format("~s~n", [match(#right{value="lol"},
fun(_) -> "" end,
fun(X) -> X end)]).
type Either<'l, 'r> = Left of 'l | Right of 'r
let cata (x: Either<'l, 'r>) (l: 'l -> 'a) (r: 'r -> 'a) =
match x with
| Left v -> l v
| Right v -> r v
System.Console.WriteLine(cata (Right "lol") (fun _ -> "") id)
#include <stdio.h>
/* This uses two GNU C extensions: */
/* Statement expressions and nested functions */
typedef enum { LEFT, RIGHT } either_tag;
typedef struct { either_tag tag; void *data; } either_t;
#define MATCH(e, l, r, a) \
({ \
either_t e_ = (e); \
a l_ l; \
a r_ r; \
e_.tag == LEFT ? l_(e_.data) : r_(e_.data); \
})
int main() {
either_t val = {RIGHT, "lol"};
printf("%s\n",
MATCH(val,
(const char* l) { return ""; },
(const char* r) { return r; },
const char*));
return 0;
}
/* Also, don't be fooled by the occurences of the const char* type */
/* It's still some awfully unsafe code that requires the programmer never to make mistakes */
package main
import "fmt"
type Any interface{}
type F func(Any) Any
type Either[A any, B any] interface {
match(l func(A) any, r func(B) any) any
}
type Left[A any, B any] struct {
value A
}
func (val Left[A, B]) match(l func(A) any, r func(B) any) any {
return l(val.value)
}
type Right[A any, B any] struct {
value B
}
func (val Right[A, B]) match(l func(A) any, r func(B) any) any {
return r(val.value)
}
func left[A any, B any](x A) Either[A, B] {
return Left[A, B]{x}
}
func right[A any, B any](x B) Either[A, B] {
return Right[A, B]{x}
}
func main() {
fmt.Println(right[string, string]("lol").match(
func(x string) any { return "" },
func(x string) any { return x }))
}
data Either l r = Left l | Right r
match :: Either l r -> (l -> a) -> (r -> a) -> a
match (Left l) f _ = f l
match (Right r) _ f = f r
main :: IO ()
main = putStrLn (match (Right "lol") (const "") id)
data Either' l r = Left l | Right r
match : Either' l r -> (l -> a) -> (r -> a) -> a
match (Left val) l _ = l val
match (Right val) _ r = r val
main : IO ()
main = putStrLn (match {l=String} (Right "lol") (const "") id)
import java.util.function.Function;
interface Either<L, R> {
abstract <T> T match(Function<L, T> l, Function<R, T> r);
static <L, R> Either<L, R> left(L value) {
return new Either<L, R>() {
@Override
public <T> T match(Function<L, T> l, Function<R, T> r) {
return l.apply(value);
}
};
}
static <L, R> Either<L, R> right(R value) {
return new Either<L, R>() {
@Override
public <T> T match(Function<L, T> l, Function<R, T> r) {
return r.apply(value);
}
};
}
}
class Main {
public static void main(String[] args) {
System.out.println(Either.right("lol").<String>match(l -> "", r -> r));
}
}
sealed class Either<out L, out R> {
class Left <L>(val value: L) : Either<L, Nothing>()
class Right<R>(val value: R) : Either<Nothing, R>()
fun <T> match(l: (L) -> T, r: (R) -> T): T = when(this) {
is Left -> l(this.value)
is Right -> r(this.value)
}
}
fun main(args: Array<String>) {
println(Either.Right("lol").match({""}, {it}))
}
-- Lua is weird
function mk_ctor(methods)
local mt = { __index = methods }
return function(value)
local res = { value = value }
setmetatable(res, mt)
return res
end
end
Left = mk_ctor({
cata = function(self, l, r)
return l(self.value)
end
})
Right = mk_ctor({
cata = function(self, l, r)
return r(self.value)
end
})
print(Right("lol"):cata(
function(x) return "" end,
function(x) return x end
))
% Node: this is particularly long. But it also does much more than what the
% specification asks for. Namely, the catamorphism may be reverse applied for
% functions with varying properties.
:- module either.
:- interface.
:- import_module io.
:- type either(L, R) ---> left(L) ; right(R).
:- inst either(L, R) ---> left(L) ; right(R).
:- func match(either(L, R), func(L) = T, func(R) = T) = T.
:- pred main(io::di, io::uo) is det.
% Function application mode
:- mode match(
in(either(L, R)),
func(in(L)) = out(T) is det,
func(in(R)) = out(T) is det)
= out(T) is det.
% Partial function application mode
:- mode match(
in(either(L, R)),
func(in(L)) = out(T) is semidet,
func(in(R)) = out(T) is semidet)
= out(T) is semidet.
% nondet "co-application" does not require any property on the functions
:- mode match(
out(either(L, R)),
func(out(L)) = in(T) is nondet,
func(out(R)) = in(T) is nondet)
= in(T) is nondet.
% multi "co-application" requires either function to be surjective
:- mode match(
out(either(L, R)),
func(out(L)) = in(T) is nondet,
func(out(R)) = in(T) is multi)
= in(T) is multi.
:- mode match(
out(either(L, R)),
func(out(L)) = in(T) is multi,
func(out(R)) = in(T) is nondet)
= in(T) is multi.
% semidet "co-application" requires either function to be completely undefined.
% The other function has to be injective.
:- mode match(
out(either(L, R)),
func(out(L)) = in(T) is failure,
func(out(R)) = in(T) is semidet)
= in(T) is semidet.
:- mode match(
out(either(L, R)),
func(out(L)) = in(T) is semidet,
func(out(R)) = in(T) is failure)
= in(T) is semidet.
% det "co-application" requires either function to be completely undefined, and
% the other, bijective.
:- mode match(
out(either(L, R)),
func(out(L)) = in(T) is failure,
func(out(R)) = in(T) is det)
= in(T) is det.
:- mode match(
out(either(L, R)),
func(out(L)) = in(T) is det,
func(out(R)) = in(T) is failure)
= in(T) is det.
% I had to learn to reason about logical determinism in the process of write
% these modes out. My brain may have melted a bit. The manual's determinism
% lattice is tremendously useful as a tool for reasoning, btw.
:- implementation.
% Finally, I can show you the definition that satisfies all these modes !
match(left(Val) , L, _) = L(Val).
match(right(Val), _, R) = R(Val).
main(!IO) :-
io.write_string(match(right("lol"), (func(_) = ""), (func(X) = X)), !IO),
io.nl(!IO).
type ('l, 'r) either =
| Left of 'l
| Right of 'r
let cata = function
| Left x -> fun l _ -> l x
| Right x -> fun _ r -> r x
;;
print_endline @@ cata (Right "lol") (fun _ -> "") (fun x -> x)
class Left {
private $val;
function __construct($val) {
$this->val = $val;
}
function match($l, $r) {
return $l($this->val);
}
}
class Right {
private $val;
function __construct($val) {
$this->val = $val;
}
function match($l, $r) {
return $r($this->val);
}
}
echo ((new Right("lol"))->match(
function($x) { return ""; },
function($x) { return $x; }
));
echo "\n";
% Manually encoding our closures through the custom apply/3 predicate.
% Alternatively, we could somehow rely on call/X.
:- discontiguous apply/3.
match(left(X) , L, _, Res) :- apply(L, X, Res).
match(right(X), _, R, Res) :- apply(R, X, Res).
apply(id , X, X).
apply(const(X), _, X).
:-
match(right("lol"), const(""), id, Res),
writeln(Res).
% Credits go to aphyr for inspiring me with this technique:
% https://aphyr.com/posts/342-typing-the-technical-interview
module Main where
import Prelude
import Control.Monad.Eff.Console (log)
data Either l r = Left l | Right r
match :: forall l r a. Either l r -> (l -> a) -> (r -> a) -> a
match (Left val) l _ = l val
match (Right val) _ r = r val
main = log $ match (Right "lol") (const "") id
class Left:
def __init__(self, val):
self._val = val
def match(self, l, _):
return l(self._val)
class Right:
def __init__(self, val):
self._val = val
def match(self, _, r):
return r(self._val)
print(Right("lol").match(lambda _: "", lambda x: x))
class Left
def initialize(val)
@val = val
end
def match(l, _)
l.call(@val)
end
end
class Right
def initialize(val)
@val = val
end
def match(_, r)
r.call(@val)
end
end
print Right.new("lol").match(-> (_) { "" }, -> (x) { x })
#lang racket
(struct Left(val))
(struct Right(val))
(define (cata val l r)
(match val
[(Left x) (l x)]
[(Right x) (r x)]))
(displayln
(cata (Right "lol") (const "") identity))
enum Either<L, R> {
Left(L),
Right(R)
}
impl <L, R> Either<L, R> {
fn cata<T, F: FnOnce(&L) -> T, G: FnOnce(&R) -> T>(&self, l: F, r: G) -> T {
match *self {
Either::Left (ref val) => l(val),
Either::Right(ref val) => r(val)
}
}
}
fn main() {
let val: Either<&str, &str> = Either::Right("lol");
println!("{}", val.cata(|l| "", |r| r));
}
sealed trait Either[+L, +R]
case class Left [+L](value: L) extends Either[L, Nothing]
case class Right[+R](value: R) extends Either[Nothing, R]
def cata[L, R, T](x: Either[L, R], l: L => T, r: R => T): T
= x match {
case Left (v) => l(v)
case Right(v) => r(v)
}
println(cata(Right("lol"), (_: String) => "", (x: String) => x))
enum Either<L, R> {
case Left(L)
case Right(R)
func match<T>(l: (L) -> T, r: (R) -> T) -> T {
switch self {
case .Left (let v):
return l(v)
case .Right(let v):
return r(v)
}
}
}
print(Either.Right("lol").match(l: {""}, r: {$0}))
# See tuliplang.org
# The language is not really finished, so I'll just assume write-ln writes
# a line to stdout :
match l _ (.left v) = l v
match _ r (.right v) = r v
.right 'lol > match [ "" ] [ $ ] > write-ln
// C++11 compile time meta-programming
// Tested with GCC 6.3.1 with -std=c++11
#include <iostream>
template <typename Val>
struct Left {};
template <typename Val>
struct Right {};
template <
typename X,
template<typename> class L,
template<typename> class R
>
struct Match {};
template <
typename X,
template<typename> class L,
template<typename> class R
>
struct Match<Left<X>, L, R> {
using value = typename L<X>::value;
};
template <
typename X,
template<typename> class L,
template<typename> class R
>
struct Match<Right<X>, L, R> {
using value = typename R<X>::value;
};
template <typename A>
struct Id {
using value = A;
};
template <typename A>
struct Const {
private:
// Partial application of Const
template <typename B>
struct Partial {
using value = A;
};
public:
template <typename B>
using value = Partial<B>;
};
struct LolStr {
static constexpr const char (&unlift)[] = "lol";
};
struct EmptyStr {
static constexpr const char (&unlift)[] = "";
};
int main() {
std::cout
<<
Match<
Right<LolStr>,
Const<EmptyStr>::value,
Id
>::value::unlift
<<
std::endl;
}
class Left <T> { constructor(public value: T) { } }
class Right<T> { constructor(public value: T) { } }
type Either<L, R> = Left<L>|Right<R>
function match<L, R, T>(val: Either<L, R>, l: (x: L) => T, r: (x: R) => T): T {
if (val instanceof Left) {
return l((<Left<L>>val).value);
} else {
return r((<Right<R>>val).value);
}
}
console.log(match(new Right("lol"), _ => "", x => x));
#lang typed/racket
(define-type (Either L R)
(U (Left L) (Right R)))
(struct (L) Left ([val : L]))
(struct (R) Right([val : R]))
(: cata (All (L R T)
(Either L R) (-> L T) (-> R T) -> T))
(define (cata val l r)
(match val
[(Left x) (l x)]
[(Right x) (r x)]))
(displayln
(cata (Right "lol") (lambda (x) "") (lambda (x) x)))
class Left <L>(shared L val) { }
class Right<R>(shared R val) { }
alias Either<L, R> => Left<L>|Right<R>;
T match<L, R, T>(Either<L, R> x, T(L) l, T(R) r)
=> if (is Left<L> x) then l(x.val) else r(x.val);
print(match<String, String, String>(Right("lol"), (_) => "", (x) => x));
package main
import "fmt"
type Left[A any] struct{ value A }
type Right[B any] struct{ value B }
func match[A any, B any, R any](val any, l func(A) R, r func(B) R) R {
switch val := val.(type) {
case Left[A]:
return l(val.value)
case Right[B]:
return r(val.value)
}
panic("match: type error")
}
func main() {
fmt.Println(match(Right[string]{"lol"},
func(x string) string { return "" },
func(x string) string { return x }))
}
:- module either.
:- interface.
% This is the "minimalistic" mercury version. I.e, does nothing more than what
% the spec requires.
:- import_module io.
:- pred main(io::di, io::uo) is det.
:- type either(L, R) ---> left(L) ; right(R).
:- func match(either(L, R), func(L) = T, func(R) = T) = T.
:- implementation.
match(left(Val) , L, _) = L(Val).
match(right(Val), _, R) = R(Val).
main(!IO) :-
io.write_string(match(right("lol"), (func(_) = ""), (func(X) = X)), !IO),
io.nl(!IO).
interface Either<L, R> {
match<T>(l: (x: L) => T, r: (x: R) => T): T;
}
class Left<L> implements Either<L, never> {
constructor(private value: L) { }
match<T>(l: (x: L) => T, r: (x: never) => T): T {
return l(this.value);
}
}
class Right<R> implements Either<never, R> {
constructor(public value: R) { }
match<T>(l: (x: never) => T, r: (x: R) => T): T {
return r(this.value);
}
}
console.log(new Right("lol").match(_ => "", x => x));
@jstegle
Copy link

jstegle commented Sep 16, 2018

Finally had the time to fully read it. Nicely done, although a practical example with an evey day usecase might help :)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment