Algebraic data types: Difference between revisions

Added a Java (JDK 21 + Preview features) translation for the existing Kotlin solution. Removed the omission tag for Java.
imported>Maruseron
(Added a Java (JDK 21 + Preview features) translation for the existing Kotlin solution. Removed the omission tag for Java.)
 
(5 intermediate revisions by 4 users not shown)
Line 14:
=={{header|Bracmat}}==
 
<langsyntaxhighlight lang="bracmat">( ( balance
= a x b y c zd
. !arg
Line 60:
| insert$!arg
)
);</langsyntaxhighlight>
 
Test:
<langsyntaxhighlight lang="bracmat">( ( it allows for terse code which is easy to read
, and can represent the algorithm directly
.
Line 71:
& lst$tree
& done
);</langsyntaxhighlight>
 
Output:
<langsyntaxhighlight lang="bracmat">(tree=
B
. ( B
Line 95:
)
)
);</langsyntaxhighlight>
 
=={{header|C++}}==
Line 102:
C++ templates have a robust pattern matching facility, with some warts - for example, nested templates cannot be fully specialized, so we must use a dummy template parameter. This implementation uses C++17 deduced template parameters for genericity.
 
<langsyntaxhighlight lang="cpp">enum Color { R, B };
template<Color, class, auto, class> struct T;
struct E;
Line 146:
int main() {
print<insert_t<1, insert_t<2, insert_t<0, insert_t<4, E>>>>>();
}</langsyntaxhighlight>
 
===Run time===
Although C++ has structured bindings and pattern matching through function overloading, it is not yet possible to use them together so we must match the structure of the tree being rebalanced separately from decomposing it into its elements. A further issue is that function overloads are not ordered, so to avoid ambiguity we must explicitly reject any (ill-formed) trees that would match more than one case during rebalance.
 
<langsyntaxhighlight lang="cpp">#include <memory>
#include <variant>
 
Line 253:
t = insert(std::string{argv[i]}, std::move(t));
print(t);
}</langsyntaxhighlight>
 
=={{header|C sharp}}==
Translation of several
{{works with|C sharp|8}}
<langsyntaxhighlight lang="csharp">using System;
 
class Tree
Line 306:
_ => this
};
}</langsyntaxhighlight>
{{out}}
<pre>
Line 356:
{{libheader|toadstool}}
 
<langsyntaxhighlight lang="lisp">(mapc #'use-package '(#:toadstool #:toadstool-system))
(defstruct (red-black-tree (:constructor tree (color left val right)))
color left val right)
Line 394:
(defun insert (x s)
(toad-ecase1 (%insert x s)
((tree t a y b) (tree 'black a y b))))</langsyntaxhighlight>
 
=={{header|E}}==
Line 441:
 
=={{header|EchoLisp}}==
<langsyntaxhighlight lang="scheme">
;; code adapted from Racket and Common Lisp
;; Illustrates matching on structures
Line 469:
(match (ins x s) [(N _ l v r) (N '⚫️ l v r)]))
</syntaxhighlight>
</lang>
{{out}}
<langsyntaxhighlight lang="scheme">
(define (t-show n (depth 0))
(when (!eq? 'empty n)
Line 480:
(define T (for/fold [t 'empty] ([i 32]) (insert (random 100) t)))
(t-show T)
</syntaxhighlight>
</lang>
<small>
<pre>
Line 515:
{{trans|Erlang}}
But, it changed an API into the Elixir style.
<langsyntaxhighlight lang="elixir">defmodule RBtree do
def find(nil, _), do: :not_found
def find({ key, value, _, _, _ }, key), do: { :found, { key, value } }
Line 557:
|> RBtree.insert(6,-1) |> IO.inspect
|> RBtree.insert(7,0) |> IO.inspect
|> RBtree.find(4) |> IO.inspect</langsyntaxhighlight>
 
{{out}}
Line 580:
The <code>pcase</code> macro was added in Emacs 24.1. It's auto-loaded, so there's no need to add <code>(require 'pcase)</code> to your code.
 
<langsyntaxhighlight lang="lisp">(defun rbt-balance (tree)
(pcase tree
(`(B (R (R ,a ,x ,b) ,y ,c) ,z ,d) `(R (B ,a ,x ,b) ,y (B ,c ,z ,d)))
Line 607:
(dotimes (i 16)
(setq s (rbt-insert (1+ i) s)))
(pp s))</langsyntaxhighlight>
Output:
 
Line 639:
 
The code used here is extracted from [https://gist.github.com/mjn/2648040 Mark Northcott's GitHubGist].
<langsyntaxhighlight lang="erlang">
-module(rbtree).
-export([insert/3, find/2]).
Line 679:
balance(T) ->
T.
</syntaxhighlight>
</lang>
 
Output:
Line 714:
 
=={{header|F_Sharp|F#}}==
<langsyntaxhighlight lang="fsharp">
// Pattern Matching. Nigel Galloway: January 15th., 2021
type colour= |Red |Black
Line 727:
|N(i,g,e,l) as node->if item>l then repair(i,g,insert e,l) elif item<l then repair(i,insert g,e,l) else node
match insert rbt with N(_,g,e,l)->N(Black,g,e,l) |_->Empty
</syntaxhighlight>
</lang>
=={{header|Go}}==
{{trans|Kotlin}}
Line 734:
 
However, pattern matching on interfaces (via the type switch statement and type assertions) is limited to matching the implementing type and so the balance() method is not very pleasant.
<langsyntaxhighlight lang="go">package main
 
import "fmt"
Line 851:
}
fmt.Println(tr)
}</langsyntaxhighlight>
 
{{out}}
Line 860:
=={{header|Haskell}}==
 
<langsyntaxhighlight lang="haskell">data Color = R | B
data Tree a = E | T Color (Tree a) a (Tree a)
 
Line 877:
| x > y = balance col a y (ins b)
| otherwise = s
T _ a y b = ins s</langsyntaxhighlight>
 
=={{header|J}}==
Line 886:
The following code represents a best effort translation of the current Haskell implementation of this task:
 
<langsyntaxhighlight Jlang="j">insert=:{{
'R';'';y;a:
:
Line 924:
if. 'R'=wwC do. 'R';('B';e;K;<we);wK;<'B';wwe;wwK;<www return. end. end. end. end.
y
}}</langsyntaxhighlight>
 
Example use:
 
<langsyntaxhighlight Jlang="j"> 3 insert 2 insert 5
┌─┬───────┬─┬───────┐
│R│┌─┬┬─┬┐│3│┌─┬┬─┬┐│
│ ││B││2│││ ││B││5│││
│ │└─┴┴─┴┘│ │└─┴┴─┴┘│
└─┴───────┴─┴───────┘</langsyntaxhighlight>
 
Note that by convention we treat the root node as black. This approach always labels it with 'R' which we ignore. However, if we wish to validate these trees, we must account for the discrepancy.
 
<langsyntaxhighlight Jlang="j">NB. always treat root of tree as black
validate=: {{
if. 0=#y do. 1 return. end.
Line 954:
b=. check w
(*a)*(a=b)*b+'B'=C
}}</langsyntaxhighlight>
 
Here, validate returns the effective "black depth" of the tree (treating the root node as black and treating empty nodes as black), or 0 if the tree is not balanced properly.
Line 960:
For example:
 
<langsyntaxhighlight Jlang="j"> ?.~20
14 18 12 16 5 1 3 0 6 13 9 8 15 17 2 10 7 4 19 11
insert/?.~20
Line 975:
└─┴──────────────────────────────────────────────────────────────────────┴──┴────────────────────────────────────────────────────────────────────────┘
validate insert/?.~20
4</langsyntaxhighlight>
 
Finally a caution: red black trees exhibit poor cache coherency. In many (perhaps most or all) cases an amortized hierarchical linear sort mechanism will perform better than a red black tree implementation. (And that characteristic is especially true of this particular implementation.)
 
=={{header|Java}}==
{{trans|Kotlin}}
{{works with|OpenJDK|21 (Preview)}}
 
Java 21 has added support for ADTs (in the form of sealed types), which are narrowable through a switch expression. Despite having no fully-fledged pattern matching, a combination of record deconstruction patterns and guarded patterns allows for something very similar through switch expressions:
 
<syntaxhighlight lang="java">public class Task {
enum Color { R, B }
sealed interface Tree<A extends Comparable<A>> permits E, T {
default Tree<A> insert(A a) {
return switch(ins(a)) {
case T(_, var l, var v, var r) -> new T<>(Color.B, l, v, r);
case E() -> new E<>();
};
}
 
Tree<A> ins(A a);
}
 
record E<A extends Comparable<A>>() implements Tree<A> {
@Override
public Tree<A> ins(A a) {
return new T<>(Color.R, new E<>(), a, new E<>());
}
 
@Override
public String toString() { return "E"; }
}
 
record T<A extends Comparable<A>>(Color color, Tree<A> left,
A value, Tree<A> right) implements Tree<A> {
@Override
public Tree<A> ins(A a) {
return switch(Integer.valueOf(a.compareTo(value))) {
case Integer i when i < 0 -> new T<>(color, left.ins(a), value, right).balance();
case Integer i when i > 0 -> new T<>(color, left, value, right.ins(a)).balance();
default -> this;
};
}
 
private Tree<A> balance() {
if (color == Color.R) return this;
return switch (this) {
// unnamed patterns (case T<A>(_, ...)) are a JDK21 Preview feature
case T<A>(_, T<A>(_, T<A>(_, var a, var x, var b), var y, var c), var z, var d)
when left instanceof T<A> le && le.left instanceof T<A> le_le &&
le.color == Color.R && le_le.color == Color.R ->
new T<>(Color.R, new T<>(Color.B, a, x, b), y, new T<>(Color.B, c, z, d));
case T<A>(_, T<A>(_, var a, var x, T<A>(_, var b, var y, var c)), var z, var d)
when left instanceof T<A> le && le.right instanceof T<A> le_ri &&
le.color == Color.R && le_ri.color == Color.R ->
new T<>(Color.R, new T<>(Color.B, a, x, b), y, new T<>(Color.B, c, z, d));
case T<A>(_, var a, var x, T<A>(_, T<A>(_, var b, var y, var c), var z, var d))
when right instanceof T<A> ri && ri.left instanceof T<A> ri_le &&
ri.color == Color.R && ri_le.color == Color.R ->
new T<>(Color.R, new T<>(Color.B, a, x, b), y, new T<>(Color.B, c, z, d));
case T<A>(_, var a, var x, T<A>(_, var b, var y, T<A>(_, var c, var z, var d)))
when right instanceof T<A> ri && ri.right instanceof T<A> ri_ri &&
ri.color == Color.R && ri_ri.color == Color.R ->
new T<>(Color.R, new T<>(Color.B, a, x, b), y, new T<>(Color.B, c, z, d));
default -> this;
};
}
 
@Override
public String toString() {
return STR."T[\{color}, \{left}, \{value}, \{right}]"; // String templates are a JDK 21 Preview feature
}
}
 
public static void main(String[] args) {
Tree<Integer> tree = new E<>();
for (var i : IntStream.rangeClosed(1, 16).toArray()) {
tree = tree.insert(i);
}
System.out.println(tree);
}
}
</syntaxhighlight>
{{out}}
<pre>
T[B, T[B, T[B, T[B, E, 1, E], 2, T[B, E, 3, E]], 4, T[B, T[B, E, 5, E], 6, T[B, E, 7, E]]], 8, T[B, T[B, T[B, E, 9, E], 10, T[B, E, 11, E]], 12, T[B, T[B, E, 13, E], 14, T[B, E, 15, T[R, E, 16, E]]]]]
</pre>
 
=={{header|jq}}==
Line 990 ⟶ 1,074:
 
'''bindings.jq'''
<langsyntaxhighlight lang="jq"># bindings($x) attempts to match . and $x structurally on the
# assumption that . is free of JSON objects, and that any objects in
# $x will have distinct, singleton keys that are to be interpreted as
Line 1,017 ⟶ 1,101:
end
else null
end ;</langsyntaxhighlight>
 
'''pattern-matching.jq'''
<langsyntaxhighlight lang="jq">include "bindings" {search: "."};
 
def E: []; # the empty node
Line 1,061 ⟶ 1,145:
reduce range(0; $n) as $i (E; insert($i));
 
task(16) | pp</langsyntaxhighlight>
{{out}}
For brevity and perhaps visual appeal, the output from jq has been trimmed as per the following invocation:
<langsyntaxhighlight lang="sh">jq -n -f pattern-matching.jq | grep -v '[][]' | tr -d ',"'</langsyntaxhighlight>
<pre>
Line 1,101 ⟶ 1,185:
=={{header|Julia}}==
Julia's multiple dispatch model is based on the types of a function's arguments, but does not look deeper into the function's array arguments for the types of their contents. Therefore we do multi-dispatch on the balance function but then use an if statement within the multiply dispatched functions to further match based on argument vector contents.
<langsyntaxhighlight lang="julia">import Base.length
 
abstract type AbstractColoredNode end
Line 1,169 ⟶ 1,253:
 
testRB()
</langsyntaxhighlight>{{out}}
<pre>
[B, [R, [B, [R, E, 1, E], 2, [R, E, 3, E]], 4, [B, E, 6, E]], 14, [B, E, 18, E]]]
Line 1,179 ⟶ 1,263:
Whilst Kotlin supports algebraic data types (via 'sealed classes') and destructuring of data classes, pattern matching on them (via the 'when' expression) is currently limited to matching the type. Consequently the balance() function is not very pretty!
<langsyntaxhighlight lang="scala">// version 1.1.51
 
import Color.*
Line 1,262 ⟶ 1,346:
}
println(tree)
}</langsyntaxhighlight>
 
{{out}}
Line 1,270 ⟶ 1,354:
=={{header|Nim}}==
{{libheader|fusion/matching}}
<langsyntaxhighlight lang="nim">import fusion/matching
{.experimental: "caseStmtMacros".}
 
Line 1,314 ⟶ 1,398:
proc ins(t: var RBTree[T], x: T) = insImpl[T](t, x)
tt.ins(xx)
tt.colour = Black</langsyntaxhighlight>
 
=={{header|OCaml}}==
<langsyntaxhighlight lang="ocaml">
type color = R | B
type 'a tree = E | T of color * 'a tree * 'a * 'a tree
Line 1,342 ⟶ 1,426:
in let T (_,a,y,b) = ins s
in T (B,a,y,b)
</syntaxhighlight>
</lang>
 
=={{header|Oz}}==
Line 1,350 ⟶ 1,434:
To match multiple variables at once, we create temporary tuples with "#".
 
<langsyntaxhighlight lang="oz">fun {Balance Col A X B}
case Col#A#X#B
of b#t(r t(r A X B) Y C )#Z#D then t(r t(b A X B) Y t(b C Z D))
Line 1,373 ⟶ 1,457:
in
t(b A Y B)
end</langsyntaxhighlight>
 
=={{header|Perl}}==
Line 1,386 ⟶ 1,470:
Each of the single letter variables declared right after $balanced, match an instance of $balanced, and if they succeed, store the result into the %+ hash.
 
<langsyntaxhighlight lang="perl">#!perl
use 5.010;
use strict;
Line 1,451 ⟶ 1,535:
}
print "Done\n";
</syntaxhighlight>
</lang>
{{out}}
<pre>Tree: <B,_,9,_>.
Line 1,468 ⟶ 1,552:
There is no formal support for this sort of thing in Phix, but that's not to say that whipping
something up is likely to be particularly difficult, so let's give it a whirl.
<!--<langsyntaxhighlight Phixlang="phix">(phixonline)-->
<span style="color: #000080;font-style:italic;">--
-- demo\rosetta\Pattern_matching.exw
Line 1,595 ⟶ 1,679:
<span style="color: #0000FF;">?</span><span style="color: #008000;">"done"</span>
<span style="color: #0000FF;">{}</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">wait_key</span><span style="color: #0000FF;">()</span>
<!--</langsyntaxhighlight>-->
{{out}}
<pre>
Line 1,612 ⟶ 1,696:
=={{header|Picat}}==
{{trans|Prolog}}
<langsyntaxhighlight Picatlang="picat">main =>
T = e,
foreach (X in 1..10)
Line 1,642 ⟶ 1,726:
printf("%*w[%w]\n",Indent,C,Y),
output(B,Indent+6).
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,670 ⟶ 1,754:
=={{header|PicoLisp}}==
{{trans|Prolog}}
<langsyntaxhighlight PicoLisplang="picolisp">(be color (R))
(be color (B))
 
Line 1,704 ⟶ 1,788:
 
(be insert (@X @S (T B @A @Y @B))
(ins @X @S (T @ @A @Y @B)) )</langsyntaxhighlight>
Test:
<langsyntaxhighlight PicoLisplang="picolisp">: (? (insert 2 E @A) (insert 1 @A @B) (insert 3 @B @C))
@A=(T B E 2 E) @B=(T B (T R E 1 E) 2 E) @C=(T B (T R E 1 E) 2 (T R E 3 E))
-> NIL</langsyntaxhighlight>
 
=={{header|Prolog}}==
Line 1,739 ⟶ 1,823:
Structural pattern matching was added to Python in version 3.10.
 
<langsyntaxhighlight lang="python">from __future__ import annotations
from enum import Enum
from typing import NamedTuple
Line 1,829 ⟶ 1,913:
if __name__ == "__main__":
main()
</syntaxhighlight>
</lang>
 
{{out}}
Line 1,871 ⟶ 1,955:
{{trans|OCaml}}
 
<langsyntaxhighlight lang="racket">
#lang racket
 
Line 1,904 ⟶ 1,988:
 
(visualize (for/fold ([t 'empty]) ([i 16]) (insert i t)))
</syntaxhighlight>
</lang>
 
<pre>
Line 1,929 ⟶ 2,013:
{{works with|rakudo|2016.11}}
Raku doesn't have algebraic data types (yet), but it does have pretty good pattern matching in multi signatures.
<syntaxhighlight lang="raku" perl6line>enum RedBlack <R B>;
 
multi balance(B,[R,[R,$a,$x,$b],$y,$c],$z,$d) { [R,[B,$a,$x,$b],$y,[B,$c,$z,$d]] }
Line 1,953 ⟶ 2,037:
$t = insert($_, $t) for (1..10).pick(*);
say $t.gist;
}</langsyntaxhighlight>
This code uses generic comparison operators <tt>before</tt> and <tt>after</tt>, so it should work on any ordered type.
{{out}}
Line 1,965 ⟶ 2,049:
 
An abstract pattern is recursively defined and may contain, among others, the following elements: Literal, VariableDeclaration, MultiVariable, Variable, List, Set, Tuple, Node, Descendant, Labelled, TypedLabelled, TypeConstrained. More explanation can be found in the [http://http://tutor.rascal-mpl.org/Courses/Rascal/Rascal.html#/Courses/Rascal/Patterns/Abstract/Abstract.html Documentation]. Some examples:
<langsyntaxhighlight lang="rascal">
// Literal
rascal>123 := 123
Line 2,030 ⟶ 2,114:
Match black(leaf(3),leaf(4))
Match black(leaf(5),leaf(4))
list[void]: []</langsyntaxhighlight>
 
===Concrete===
Line 2,037 ⟶ 2,121:
 
A concrete pattern is a quoted concrete syntax fragment that may contain variables. The syntax that is used to parse the concrete pattern may come from any module that has been imported in the module in which the concrete pattern occurs. Some examples of concrete patterns:
<langsyntaxhighlight lang="rascal">// Quoted pattern
` Token1 Token2 ... Tokenn `
// A typed quoted pattern
Line 2,044 ⟶ 2,128:
<Type Var>
// A variable pattern
<Var></langsyntaxhighlight>
 
A full example of concrete patterns can be found in the [http://tutor.rascal-mpl.org/Courses/Recipes/Languages/Exp/Concrete/WithLayout/WithLayout.html Rascal Recipes].
Line 2,052 ⟶ 2,136:
There are two variants of the PatternsWitchAction. When the subject matches Pattern, the expression Exp is evaluated and the subject is replaced with the result. Secondly, when the subject matches Pattern, the (block of) Statement(s) is executed. See below for some ColoredTree examples:
 
<langsyntaxhighlight lang="rascal">// Define ColoredTrees with red and black nodes and integer leaves
data ColoredTree = leaf(int N)
| red(ColoredTree left, ColoredTree right)
Line 2,091 ⟶ 2,175:
case red(l, r) => green(l, r)
};
}</langsyntaxhighlight>
 
===Regular Expressions===
Line 2,097 ⟶ 2,181:
Regular expressions are noated between two slashes. Most normal regular expressions patterns are available, such as ., \n, \d, etc. Additionally, flags can be used to create case intensiveness.
 
<langsyntaxhighlight lang="rascal">rascal>/XX/i := "some xx";
bool: true
rascal>/a.c/ := "abc";
bool: true</langsyntaxhighlight>
 
=={{header|REXX}}==
The nodes used for this example are taken from the Wikipedia example at: &nbsp;
[[https://en.wikipedia.org/wiki/Red%E2%80%93black_tree#/media/File:Red-black_tree_example.svg red black tree, an example]]
<langsyntaxhighlight lang="rexx">/*REXX pgm builds a red/black tree (with verification & validation), balanced as needed.*/
parse arg nodes '/' insert /*obtain optional arguments from the CL*/
if nodes='' then nodes = 13.8.17 8.1.11 17.15.25 1.6 25.22.27 /*default nodes. */
Line 2,142 ⟶ 2,226:
if @.y\==. & @.y\=='' then call err "node is already defined: " y
end /*v*/
return</langsyntaxhighlight>
{{out|output|text=&nbsp; when using the default inputs:}}
<pre>
Line 2,156 ⟶ 2,240:
{{trans|Haskell}}
This would be a horribly inefficient way to implement a Red-Black Tree in Rust as nodes are being allocated and deallocated constantly, but it does show off Rust's pattern matching.
<langsyntaxhighlight lang="rust">#![feature(box_patterns, box_syntax)]
use self::Color::*;
use std::cmp::Ordering::*;
Line 2,198 ⟶ 2,282:
}
}
}</langsyntaxhighlight>
 
=={{header|Scala}}==
Line 2,233 ⟶ 2,317:
of that object.
 
<langsyntaxhighlight lang="scala">class RedBlackTree[A](implicit ord: Ordering[A]) {
sealed abstract class Color
case object R extends Color
Line 2,265 ⟶ 2,349:
}
}
}</langsyntaxhighlight>
 
Usage example:
Line 2,282 ⟶ 2,366:
 
=={{header|Standard ML}}==
<langsyntaxhighlight lang="sml">
datatype color = R | B
datatype 'a tree = E | T of color * 'a tree * 'a * 'a tree
Line 2,307 ⟶ 2,391:
T (B,a,y,b)
end
</syntaxhighlight>
</lang>
 
=={{header|Swift}}==
{{works with|Swift|2+}}
<langsyntaxhighlight lang="swift">enum Color { case R, B }
enum Tree<A> {
case E
Line 2,347 ⟶ 2,431:
return .E
}
}</langsyntaxhighlight>
 
=={{header|Tailspin}}==
Line 2,353 ⟶ 2,437:
 
Tailspin doesn't have type names, so here using a tag. Neither does it have destructuring (which seems to be posited in the problem statement). Arguably, pattern matching in Tailspin is more readable while still as concise.
<langsyntaxhighlight lang="tailspin">
processor RedBlackTree
data node <{VOID}|{colour: <='black'|='red'>, left: <node>, right: <node>, value: <> VOID}> local
Line 2,382 ⟶ 2,466:
end balance
templates ins&{into:}
when <?($into <´node´ ={}>)> do { colour: 'red', left: {}, value: $, right: {}} !
when <..$into.value::raw> do { $into..., left: $ -> ins&{into: $into.left}} -> balance !
otherwise { $into..., right: $ -> ins&{into: $into.right}} -> balance !
Line 2,396 ⟶ 2,480:
1..5 -> \('$tree::toString;$#10;' -> !OUT::write $ -> !tree::insert \) -> !VOID
$tree::toString -> !OUT::write
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 2,411 ⟶ 2,495:
 
Tcl doesn't have algebraic types built-in, but they can be simulated using tagged lists, and a custom pattern matching control structure can be built:
<langsyntaxhighlight lang="tcl"># From http://wiki.tcl.tk/9547
package require Tcl 8.5
package provide datatype 0.1
Line 2,481 ⟶ 2,565:
proc default body { return -code return [list {} $body] }
}
</syntaxhighlight>
</lang>
We can then code our solution similar to Haskell:
 
<langsyntaxhighlight lang="tcl">datatype define Color = R | B
datatype define Tree = E | T color left val right
 
Line 2,513 ⟶ 2,597:
}
}
}</langsyntaxhighlight>
 
=={{header|TXR}}==
 
TXR Lisp has structural pattern matching on objects of all kinds, including structures. We define a red-black tree structure like this, with a BOA constructor (by-order of arguments) for convenience:
 
<syntaxhighlight lang="txrlisp">
(defstruct (rbnode color left right data) ()
color
left
right
data)
</syntaxhighlight>
 
The empty tree case is handled by the <code>nil</code> symbol, so in terms of algebraic types, the tree is a sum of <code>nil</code> and the <code>rbnode</code> struct type, and that struct type is a product type of several properties. For the <code>color</code> slot, we use the keyword symbols <code>:red</code> and <code>:black</code> which needs not be declared anywhere. <code>data</code> can be any value.
 
TXR Lisp's syntax for matching structures looks like this:
 
<syntaxhighlight lang="txrlisp">
@(struct time year @y month @m)
</syntaxhighlight>
 
This example matches a time structure instance, capturing the year as <code>y</code>
and month as <code>m</code>.
 
Structures aren't ordered tuples; they are clumps of of named slots,
that cannot be accessed by position. This would break under
inheritance, in particular multiple inheritance.
 
Furthermore, variables have the <code>@</code> sigil in most pattern matching
constructs, because symbols without the sigil denote themselves as literal
patterns. The pattern <code>x</code> matches the symbol <code>x</code>
literally, and no other object. The pattern <code>@x</code> matches any
object and captures it as <code>x</code>.
 
These above features make it verbose and somewhat noisy to express
pattern matching of our <code>rbtree</code> node. However, TXR Lisp's
pattern matching sublanguage supports application-defined macro patterns,
defined by the <code>defmatch</code> macro. With these we can achieve
a shorthand notation which matches nodes as if they were ordered tuples,
and which drops the sigils from variables.
 
<syntaxhighlight lang="txrlisp">
(defmatch rb (color left right data)
(flet ((var? (sym) (if (bindable sym) ^@,sym sym)))
^@(struct rbnode
color ,(var? color)
left ,(var? left)
right ,(var? right)
data ,(var? data))))
 
(defmatch red (left right data)
^@(rb :red ,left ,right ,data))
 
(defmatch black (left right data)
^@(rb :black ,left ,right ,data))
</syntaxhighlight>
 
And with all the above, we can write the code like this:
 
<syntaxhighlight lang="txrlisp">
(defun-match rb-balance
((@(or @(black @(red @(red a b x) c y) d z)
@(black @(red a @(red b c x) x) d z)
@(black a @(red @(red b c y) d z) x)
@(black a @(red b @(red c d z) y) x)))
(new (rbnode :red
(new (rbnode :black a b x))
(new (rbnode :black c d z))
y)))
((@else) else))
 
(defun rb-insert-rec (tree x)
(match-ecase tree
(nil
(new (rbnode :red nil nil x)))
(@(rb color a b y)
(cond
((< x y)
(rb-balance (new (rbnode color (rb-insert-rec a) b y))))
((> x y)
(rb-balance (new (rbnode color a (rb-insert-rec b) y))))
(t tree)))))
 
(defun rb-insert (tree x)
(match-case (rb-insert-rec tree x)
(@(red a b y) (new (rbnode :black a b y)))
(@else else)))
</syntaxhighlight>
 
Insertion is split into two functions: a recursive one which works on its own, except that whenever the tree ends up with a red root, we would like to rewrite that node to a black one. We make the insertion function call the recursive one and then do this fix-up using pattern matching again.
 
=={{header|Wren}}==
{{trans|Go}}
Wren doesn't have either algebraic data types or pattern matching though, despite that, the ''T.balance()'' method looks better than I thought it would :)
<langsyntaxhighlight ecmascriptlang="wren">var R = "R"
var B = "B"
 
Line 2,601 ⟶ 2,775:
var tr = E.new()
for (i in 1..16) tr = tr.insert(i)
System.print(tr)</langsyntaxhighlight>
 
{{out}}
Line 2,611 ⟶ 2,785:
{{omit from|BBC BASIC}}
{{omit from|C}}
{{omit from|Java}}
{{omit from|Pascal}}
{{omit from|Processing}}
Anonymous user