madidier · November 25, 2024 11:14 · Jul 6, 2023 · Jul 6, 2023 · Jul 6, 2023 · Sep 30, 2021
diff --git a/Either2.go b/Either2.go
@@ -2,24 +2,21 @@ package main
 
 import "fmt"
 
-type Any   interface{}
-type Left  struct { value Any }
-type Right struct { value Any }
-type F     func(Any) Any
+type Left[A any] struct{ value A }
+type Right[B any] struct{ value B }
 
-func match(val Any, l F, r F) Any {
-  switch val := val.(type) {
-    case Left:
-      return l(val.value)
-    case Right:
-      return r(val.value)
-  }
-  panic("match: type error");
+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{"lol"},
-    func(x Any) Any { return "" },
-    func(x Any) Any { return x  }))
+	fmt.Println(match(Right[string]{"lol"},
+		func(x string) string { return "" },
+		func(x string) string { return x }))
 }
diff --git a/Either.go b/Either.go
@@ -3,33 +3,38 @@ package main
 import "fmt"
 
 type Any interface{}
-type F  func(Any) Any
+type F func(Any) Any
 
-type Either interface {
-  match(l F, r F) Any
+type Either[A any, B any] interface {
+	match(l func(A) any, r func(B) any) any
 }
 
-
-type Left struct {
-  value Any
+type Left[A any, B any] struct {
+	value A
 }
 
-func (val Left) match(l F, r F) Any {
-  return l(val.value)
+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
+}
 
-type Right struct {
-  value Any
+func (val Right[A, B]) match(l func(A) any, r func(B) any) any {
+	return r(val.value)
 }
 
-func (val Right) match(l F, r F) 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{"lol"}.match(
-    func(x Any) Any { return "" },
-    func(x Any) Any { return x  }))
+	fmt.Println(right[string, string]("lol").match(
+		func(x string) any { return "" },
+		func(x string) any { return x }))
 }
diff --git a/Either-hof.go b/Either-hof.go
@@ -2,24 +2,22 @@ package main
 
 import "fmt"
 
-type Any    interface{}
-type F      func(Any)  Any
-type Either func(F, F) Any
+type Either[A any, B any] func(func(A) any, func(B) any) any
 
-func Left(value Any) Either {
-  return func(l F, r F) Any {
-    return l(value)
-  }
+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(value Any) Either {
-  return func(l F, r F)Any {
-    return r(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("lol")(
-    func(x Any) Any { return "" },
-    func(x Any) Any { return x  }))
+	fmt.Println(Right[string, string]("lol")(
+		func(x string) any { return "" },
+		func(x string) any { return x }))
 }
diff --git a/README.md b/README.md
@@ -57,7 +57,7 @@ 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
+## Examples / Use cases in languages that support sum types
 
 In a haskell-like language:
 

diff --git a/README.md b/README.md
@@ -59,7 +59,7 @@ interested.
 
 ## Examples / Use cases
 
-
+In a haskell-like language:
 
 ```haskell
 data Settlement
@@ -74,6 +74,23 @@ messages (LoyaltyPoints _) = [info "Thanks for your loyalty to ACME services !"]
 messages _ = []
 ```
 
+In a ML-like language (ie, OCaml or F#):
+
+```ocaml
+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

diff --git a/README.md b/README.md
@@ -70,7 +70,7 @@ data Settlement
 
 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 (Loyalty _) = [info "Thanks for your loyalty to ACME services !"]
+messages (LoyaltyPoints _) = [info "Thanks for your loyalty to ACME services !"]
 messages _ = []
 ```
 

diff --git a/README.md b/README.md
@@ -57,6 +57,23 @@ 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
+
+
+
+```haskell
+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 (Loyalty _) = [info "Thanks for your loyalty to ACME services !"]
+messages _ = []
+```
+
 ## Specimen Naming
 
 The specimens fall roughly in two cases (there may be more than one specimen for
@@ -136,9 +153,7 @@ a given programming language):
 
 ## Excluded Languages
 
- - Bash:  It lacks  anything that  would remotely look  like a  closure. Writing
-   various wrappers  to interact  with native  win32 CLI  commands from  a msys2
-   shell at work is already "fun" enough.
+ - Bash: It lacks anything that would remotely look like a closure.
 
 ## Why ?
 

diff --git a/README.md b/README.md
@@ -54,7 +54,8 @@ displayed on the screen. That is, the program should display "lol".
 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 if you're interested.
+great articles detailing  the concept online.  Have a peek with Google if you're
+interested.
 
 ## Specimen Naming
 

diff --git a/README.md b/README.md
@@ -53,20 +53,8 @@ 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.  A first
-example of actually  recursive catamorphism are list folds.  When a `List(A)` is
-either `Empty` or some `Cons(a, b)`  where `a` is an `A` and `b` is a `List(A)`,
-then we have a `Fold(init, f)` catamorphism  where `Fold(init, f)(Empty) = init`
-and  `Fold(init, f)(List(x, xs)) = f(x, Fold(init, xs))`.  Another  example  for
-binary trees :  if a `Tree(A)`  is either `Leaf` or  some `Node(l, x, r)`  where
-`x` is an `A` and both `l` and `r` are `Tree(A)`, the catamorphism `FoldTree(init, f)`
-is defined as `FoldTree(init, f)(Leaf) = init` and `FoldTree(init, f)(Node(l, x,
-r)) = f(FoldTree(init, f)(l), x, FoldTree(init, f)(r))`. The general idea is
-that catamorphisms allow to "condense" data structures by folding them, and to
-separate the recursion from the "condensation" logic while doing so. For
-instance, in the previous examples, summation can be defined by having
-`init = 0` and `f(x, y) = x + y` or `f(x, y, z) = x + y + z` for lists or binary
-trees respectively.
+data type can be considered  a special case of  recursive data types.  There are
+great articles detailing the concept online. Have a peek if you're interested.
 
 ## Specimen Naming
 

diff --git a/README.md b/README.md
@@ -35,7 +35,7 @@ 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.
+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
@@ -50,6 +50,24 @@ 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.  A first
+example of actually  recursive catamorphism are list folds.  When a `List(A)` is
+either `Empty` or some `Cons(a, b)`  where `a` is an `A` and `b` is a `List(A)`,
+then we have a `Fold(init, f)` catamorphism  where `Fold(init, f)(Empty) = init`
+and  `Fold(init, f)(List(x, xs)) = f(x, Fold(init, xs))`.  Another  example  for
+binary trees :  if a `Tree(A)`  is either `Leaf` or  some `Node(l, x, r)`  where
+`x` is an `A` and both `l` and `r` are `Tree(A)`, the catamorphism `FoldTree(init, f)`
+is defined as `FoldTree(init, f)(Leaf) = init` and `FoldTree(init, f)(Node(l, x,
+r)) = f(FoldTree(init, f)(l), x, FoldTree(init, f)(r))`. The general idea is
+that catamorphisms allow to "condense" data structures by folding them, and to
+separate the recursion from the "condensation" logic while doing so. For
+instance, in the previous examples, summation can be defined by having
+`init = 0` and `f(x, y) = x + y` or `f(x, y, z) = x + y + z` for lists or binary
+trees respectively.
+
 ## Specimen Naming
 
 The specimens fall roughly in two cases (there may be more than one specimen for

diff --git a/Either.elf b/Either.elf
@@ -34,5 +34,5 @@ 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).
 
-%solve evalMain : eval main X.
+%query 1 * eval main X.
 % Twelf succesfully figures out that X = string/hello.
diff --git a/Either.elf b/Either.elf
@@ -19,7 +19,7 @@ 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) (F X).
+eval/lam-app : eval (app (lam F) X) R <- eval (F X) R.
 
 % We can now define either.
 either : tp -> tp -> tp.

diff --git a/Either.elf b/Either.elf
@@ -0,0 +1,38 @@
+% 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) (F X).
+
+% 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).
+
+%solve evalMain : eval main X.
+% Twelf succesfully figures out that X = string/hello.
diff --git a/Either.ml b/Either.ml
@@ -2,9 +2,9 @@ type ('l, 'r) either =
   | Left of 'l
   | Right of 'r
 
-let cata x l r = match x with
-  | Left  x' -> l x'
-  | Right x' -> r x'
+let cata = function
+  | Left  x -> fun l _ -> l x
+  | Right x -> fun _ r -> r x
 ;;
 
 print_endline @@ cata (Right "lol") (fun _ -> "") (fun x -> x)
diff --git a/Either-hof.c b/Either-hof.c
@@ -11,7 +11,7 @@
     union value (*call)(void*, union value);
   } closure_t;
 
-  /* value_t is just a horrible hack to avoid closure_t allocs in HOFs */
+  /* value_t is just a hack to reduce the need for heap allocations... */
   typedef union value {
     void* ptr;
     struct closure closure;
@@ -64,10 +64,10 @@
 
 int main(void) {
   printf("%s\n",
-    apply(
-      apply(Right("lol"), (value_t){.closure = constant("")}).closure,
-      (value_t){.closure = identity}
-    ).ptr
+    apply(apply(
+      Right("lol"),
+      (value_t){.closure = constant("")}).closure,
+      (value_t){.closure = identity    }).ptr
   );
   return 0;
 }
diff --git a/Either.tpl.c++ b/Either.tpl.c++
@@ -0,0 +1,74 @@
+// 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;
+}
diff --git a/Either.pro b/Either.pro
@@ -0,0 +1,16 @@
+% 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
diff --git a/README.md b/README.md
@@ -90,6 +90,7 @@ a given programming language):
  - PHP
  - Perl
  - PowerShell
+ - Prolog
  - PureScript
  - Python 2 *and* 3 (specimens use a compatible subset)
  - Ruby
@@ -131,11 +132,6 @@ a given programming language):
  - Bash:  It lacks  anything that  would remotely look  like a  closure. Writing
    various wrappers  to interact  with native  win32 CLI  commands from  a msys2
    shell at work is already "fun" enough.
- - Prolog: Actually, I've tried. And  had at least a partially working solution.
-   Problem is,  it relied  on call/2.  I may  be wrong,  especially since  I'm a
-   prolog beginner, but  I think first order logic programming  is not enough to
-   solve  this  ménagerie's   problem  in  the  required   general  manner. I've
-   done a mercury version, though.
 
 ## Why ?
 

diff --git a/Either-hof.ml b/Either-hof.ml
@@ -1,7 +1,7 @@
-type ('l, 'r) either = { f: 'a . ('l -> 'a) -> ('r -> 'a) -> 'a }
+type ('l, 'r) either = { cata: 'a . ('l -> 'a) -> ('r -> 'a) -> 'a }
 
-let left  x = { f = fun l _ -> l x }
-let right x = { f = fun _ r -> r x }
+let left  x = { cata = fun l _ -> l x }
+let right x = { cata = fun _ r -> r x }
 ;;
 
-print_endline @@ (right "lol").f (fun _ -> "") (fun x -> x)
+print_endline @@ (right "lol").cata (fun _ -> "") (fun x -> x)
diff --git a/Either-hof.fs b/Either-hof.fs
@@ -0,0 +1,6 @@
+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)
diff --git a/Either-hof.ml b/Either-hof.ml
@@ -0,0 +1,7 @@
+type ('l, 'r) either = { f: 'a . ('l -> 'a) -> ('r -> 'a) -> 'a }
+
+let left  x = { f = fun l _ -> l x }
+let right x = { f = fun _ r -> r x }
+;;
+
+print_endline @@ (right "lol").f (fun _ -> "") (fun x -> x)
diff --git a/Either.ml b/Either.ml
@@ -0,0 +1,10 @@
+type ('l, 'r) either =
+  | Left of 'l
+  | Right of 'r
+
+let cata x l r = match x with
+  | Left  x' -> l x'
+  | Right x' -> r x'
+;;
+
+print_endline @@ cata (Right "lol") (fun _ -> "") (fun x -> x)
diff --git a/README.md b/README.md
@@ -86,6 +86,7 @@ a given programming language):
  - LiveScript
  - Lua
  - Mercury
+ - OCaml
  - PHP
  - Perl
  - PowerShell

diff --git a/README.md b/README.md
@@ -133,8 +133,8 @@ a given programming language):
  - Prolog: Actually, I've tried. And  had at least a partially working solution.
    Problem is,  it relied  on call/2.  I may  be wrong,  especially since  I'm a
    prolog beginner, but  I think first order logic programming  is not enough to
-   solve  this  ménagerie's   problem  in  the  required   general  manner.  I'm
-   considering mercury, though.
+   solve  this  ménagerie's   problem  in  the  required   general  manner. I've
+   done a mercury version, though.
 
 ## Why ?
 

diff --git a/README.md b/README.md
@@ -103,8 +103,6 @@ a given programming language):
 
 ## (Probable) Future Languages
 
- - PowerShell: I  already wrote several scripts  in it for some  gigs. Cherry on
-   the cake: it's been ported on linux and there's an AUR package.
  - 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

diff --git a/Either-hof.ps1 b/Either-hof.ps1
@@ -0,0 +1,9 @@
+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})
diff --git a/README.md b/README.md
@@ -88,6 +88,7 @@ a given programming language):
  - Mercury
  - PHP
  - Perl
+ - PowerShell
  - PureScript
  - Python 2 *and* 3 (specimens use a compatible subset)
  - Ruby

diff --git a/Either-hof.c b/Either-hof.c
@@ -6,45 +6,29 @@
 
   /* This actually lacks a memory management solution... */
   /* The least painful to implement half-solution would be an arena */
-  typedef struct closure closure_t;
-
-  /* value_t is just a horrible hack to avoid closure_t allocs in HOFs */
-  typedef union value value_t;
-
-  struct closure {
+  typedef struct closure {
     void* ctx;
-    value_t (*call)(void*, value_t);
-  };
+    union value (*call)(void*, union value);
+  } closure_t;
 
-  union value {
+  /* value_t is just a horrible hack to avoid closure_t allocs in HOFs */
+  typedef union value {
     void* ptr;
-    closure_t closure;
-  };
-
-  closure_t mk_closure(void* ctx, value_t (*call)(void*, value_t)) {
-    return (closure_t){ ctx, call };
-  }
+    struct closure closure;
+  } value_t;
 
   value_t apply(closure_t fn, value_t arg) {
     return fn.call(fn.ctx, arg);
   }
 
-  value_t ptr_value(void* ptr) {
-    return (value_t){ .ptr = ptr };
-  }
-
-  value_t closure_value(closure_t closure) {
-    return (value_t){ .closure = closure };
-  }
-
 /* Utility closures */
 
   /* forall a. a -> (forall b. b -> a) */
   value_t constant_impl(void* x, value_t arg) {
-    return ptr_value(x);
+    return (value_t){.ptr = x};
   }
   closure_t constant(void* x) {
-    return mk_closure(x, constant_impl);
+    return (closure_t){ x, constant_impl };
   }
 
   /* forall a. a -> a */
@@ -57,26 +41,33 @@
 
   /* forall l r. l -> (forall t. (l -> t) -> (r -> t) -> t) */
   value_t Left_impl(void* val, value_t leftFn) {
-    return closure_value(constant(apply(leftFn.closure, ptr_value(val)).ptr));
+    return (value_t){.closure = constant(
+      apply(leftFn.closure, (value_t){.ptr = val}).ptr
+    )};
   }
   closure_t Left(void* val) {
-    return mk_closure(val, Left_impl);
+    return (closure_t){ val, Left_impl };
   }
 
 /* And, of Right */
 
-  /* forall l r. r -> (forall t. (l -> t) -> (r -> t) -> t */
+  /* forall l r. r -> (forall t. (l -> t) -> (r -> t) -> t) */
   value_t Right_impl1(void* val, value_t rightFn) {
-    return apply(rightFn.closure, ptr_value(val));
+    return apply(rightFn.closure, (value_t){.ptr = val});
   }
   value_t Right_impl0(void* val, value_t leftFn) {
-    return closure_value(mk_closure(val, Right_impl1));
+    return (value_t){.closure = { val, Right_impl1 }};
   }
   closure_t Right(void* val) {
-    return mk_closure(val, Right_impl0);
+    return (closure_t){ val, Right_impl0 };
   }
 
 int main(void) {
-  printf("%s\n", apply(apply(Right("lol"), closure_value(constant(""))).closure, closure_value(identity)).ptr);
+  printf("%s\n",
+    apply(
+      apply(Right("lol"), (value_t){.closure = constant("")}).closure,
+      (value_t){.closure = identity}
+    ).ptr
+  );
   return 0;
 }
diff --git a/Either-hof.pl b/Either-hof.pl
@@ -1,18 +1,12 @@
-sub Left {
-    my ($value) = @_;
-    sub {
-        my ($l, $r) = @_;
-        $l->($value)
-    }
+use feature 'signatures', 'say';
+no warnings 'experimental::signatures';
+
+sub Left($value) {
+    sub($l, $) { $l->($value) }
 }
 
-sub Right {
-    my ($value) = @_;
-    sub {
-        my ($l, $r) = @_;
-        $r->($value)
-    }
+sub Right($value) {
+    sub($, $r) { $r->($value) }
 }
 
-print (Right("lol")->(sub { "" }, sub { @_ }));
-print "\n";
+say (Right("lol")->(sub($) { "" }, sub($x) { $x }));
diff --git a/Either.tlp b/Either.tlp
@@ -0,0 +1,8 @@
+# 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
diff --git a/README.md b/README.md
@@ -95,6 +95,7 @@ a given programming language):
  - Racket
  - Scala
  - Swift
+ - Tulip
  - TypeScript
  - Untyped  lambda calculus  (encoded through  prolog terms  and tested  with an
    interpreter I wrote)

diff --git a/Either-hof.c b/Either-hof.c
@@ -22,24 +22,19 @@
   };
 
   closure_t mk_closure(void* ctx, value_t (*call)(void*, value_t)) {
-    closure_t res = { ctx, call };
-    return res;
+    return (closure_t){ ctx, call };
   }
 
   value_t apply(closure_t fn, value_t arg) {
     return fn.call(fn.ctx, arg);
   }
 
   value_t ptr_value(void* ptr) {
-    value_t val;
-    val.ptr = ptr;
-    return val;
+    return (value_t){ .ptr = ptr };
   }
 
   value_t closure_value(closure_t closure) {
-    value_t val;
-    val.closure = closure;
-    return val;
+    return (value_t){ .closure = closure };
   }
 
 /* Utility closures */

diff --git a/README.md b/README.md
@@ -99,25 +99,6 @@ a given programming language):
  - Untyped  lambda calculus  (encoded through  prolog terms  and tested  with an
    interpreter I wrote)
 
-## Special mentions
-
- - C, for  the longest implementation thus  far (the HOF one) and  for being the
-   least safe of the typed languages.
- - C++, for  being the only language thus far  where the implementation required
-   mutating  a   variable.  Also,  I  only   noticed  a  major  mistake   in  my
-   implementation two days after writing it.
- - C#, for the longest implementation in a garbage-collected language.
- - Racket, for allowing four significantly different implementations ; typed and
-   untyped  HOF-based   representation  plus  typed  and   untyped  struct-based
-   representation.
- - ES6, for having IMO the nicest syntax in dynamically typed land.
- - Ceylon,  for having  at the  same time subtyping  and rank-n  typed anonymous
-   functions. What a weird mix !
- - Perl, for giving me the most trouble getting the implementation right.
- - Idris, for lowering the barrier to entry on dependent types.
- - Untyped  lambda  calculus,  because  yay,  I  implemented  a  specimen  in  a
-   "programming language" from the 1930s !
-
 ## (Probable) Future Languages
 
  - PowerShell: I  already wrote several scripts  in it for some  gigs. Cherry on

diff --git a/Either.mercury b/Either.mercury
@@ -83,8 +83,8 @@
 
 % Finally, I can show you the definition that satisfies all these modes !
 
-match(left(Val) , L, _) = apply(L, Val).
-match(right(Val), _, R) = apply(R, Val).
+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),

diff --git a/Either2.mercury b/Either2.mercury
@@ -12,8 +12,8 @@
 
 :- implementation.
 
-match(left(Val) , L, _) = apply(L, Val).
-match(right(Val), _, R) = apply(R, Val).
+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),

diff --git a/Either2.mercury b/Either2.mercury
@@ -0,0 +1,20 @@
+:- 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, _) = apply(L, Val).
+match(right(Val), _, R) = apply(R, Val).
+
+main(!IO) :-
+    io.write_string(match(right("lol"), (func(_) = ""), (func(X) = X)), !IO),
+       io.nl(!IO).
diff --git a/Either.mercury b/Either.mercury
@@ -0,0 +1,91 @@
+% 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, _) = apply(L, Val).
+match(right(Val), _, R) = apply(R, Val).
+
+main(!IO) :-
+    io.write_string(match(right("lol"), (func(_) = ""), (func(X) = X)), !IO),
+       io.nl(!IO).
diff --git a/README.md b/README.md
@@ -85,6 +85,7 @@ a given programming language):
  - Kotlin
  - LiveScript
  - Lua
+ - Mercury
  - PHP
  - Perl
  - PureScript
@@ -137,7 +138,6 @@ a given programming language):
    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.
- - Mercury: A typed, higher order prolog :-)
  - 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.
No results found