dok/example/red-black-tree

This example is taken from https://rosettacode.org/wiki/Algebraic_data_types

In the below code: `R` stays for red; `B` for black; `T` for tree; `E` for empty tree.

Haskell code

The Haskell code is compact, because it uses pattern matching.

data Color = R | B
data Tree a = E | T Color (Tree a) a (Tree a)

balance :: Color -> Tree a -> a -> Tree a -> Tree a
balance B (T R (T R a x b) y c          ) z d                               = T R (T B a x b) y (T B c z d)
balance B (T R a           x (T R b y c)) z d                               = T R (T B a x b) y (T B c z d)
balance B a                               x (T R (T R b y c) z d          ) = T R (T B a x b) y (T B c z d)
balance B a                               x (T R b           y (T R c z d)) = T R (T B a x b) y (T B c z d)
balance col a x b = T col a x b

insert :: Ord a => a -> Tree a -> Tree a
insert x s = T B a y b where
  ins E          =  T R E x E
  ins s@(T col a y b)
    | x < y      =  balance col (ins a) y b
    | x > y      =  balance col a y (ins b)
    | otherwise  =  s
  T _ a y b = ins s

Dok code

The Dok code uses transaction semantic instead of pattern matching. It is more verbose, but the mappings between the input tree and the resulting tree are more direct, because named fields are used, instead of equational/positional one.

data Color [
  variant ../R
  variant ../B
]

data Tree(A::Ord) [
  variant ../E
  :^# empty leaf

  variant ../T [
    slot ~::Color
    slot left::Self
    slot value::A
    slot rigth::Self
  ]

  fun !balance {
    when self.color.isa(Color/B) {
      case {
        when self.left.color.isa(R)
        when self.left.left.color.isa(R)

        set self.color R
        set self.left.color: B
        set self.value self.left.value
        set self.right ../T(
            with color B
            with left self.left.right
            with value self.value
            with right self.right
          )
      } -else {
        when self.left.color.isa(R)
        when self.left.right.color.isa(R)

        set self.color R
        set self.left ../T(
            with color B
            with left self.left.left
            with value self.right.value
            with right ../T(
              with color B
              with left self.right.right
              with value self.value
              with right self.right))
      } -else {
        when self.right.color.isa(R)
        when self.right.left.color.isa(R)

        set self.color R
        set self.left ../T(
            with color B
            with left self.left
            with value self.value
            with right self.right.left)
        set value self.right.left.value
        set self.right ../T(
            with color B
            with left self.right.left.right
            with value self.right.value
            with right self.right.right)
      } -else {
        when self.left.color.isa(R)
        when self.right.color.isa(R)

        set self.color R
        set self.left ../T(
            with color B
            with left self.left
            with value self.value
            with right self.right.left)
        set self.value self.right.value
        set self.right ../T(
            with color B
            with left self.right.right.left
            with value self.right.right.value
            with right self.right.right.right)
      }
    }
  }

  fun !_insert(x::A) {
    case-on self -isa ../E {
      set self ../T(
        with color R
        with left ../E
        with value x
        with right ../E)

    } -isa ../T {
      try self.value -when ~ > x {
        do self.left.!_insert(x)
      } -when ~ < x {
        do self.right.!_insert(x)
      }
    }
  }

  fun !insert(x::A) {
    do self.!_insert(x)
    set self.color Color/B
  }
}