Algebraic data types: Difference between revisions
Content added Content deleted
Thundergnat (talk | contribs) m (Automated syntax highlighting fixup (second round - minor fixes)) |
(→{{header|TXR}}: New section.) |
||
Line 2,514: | Line 2,514: | ||
} |
} |
||
}</syntaxhighlight> |
}</syntaxhighlight> |
||
=={{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}}== |
=={{header|Wren}}== |