Path algebra

alg.ml

type path =
  | Var of string
  | Ref
  | Trans of path * path
  | Rev of path

let rec show : path -> string = function
  | Var x -> x
  | Ref -> "ref"
  | Trans (p, q) -> Printf.sprintf "(%s * %s)" (show p) (show q)
  | Rev p -> show p ^ "⁻¹"

let rec eval : path -> path = function
  | Trans (p, q) -> trans (eval p, eval q)
  | Rev p        -> rev (eval p)
  | v            -> v
and trans : path * path -> path = function
  | Trans (p, q), r     -> trans (p, trans (q, r))
  | Ref, p | p, Ref     -> p
  | Rev p, Trans (q, r) -> if p = q then r else Trans (Rev p, Trans (q, r))
  | p, Trans (Rev q, r) -> if p = q then r else Trans (p, Trans (Rev q, r))
  | Rev p, q            -> if p = q then Ref else Trans (Rev p, q)
  | p, Rev q            -> if p = q then Ref else Trans (p, Rev q)
  | p, q                -> Trans (p, q)
and rev : path -> path = function
  | Rev p        -> p
  | Ref          -> Ref
  | Trans (p, q) -> trans (rev q, rev p)
  | v            -> Rev v

let expr = Trans (Trans (Var "r", Var "p"), Trans (Rev (Trans (Var "p", Ref)), Rev (Trans (Var "q", Rev (Trans (Var "p", Var "q"))))))
let () = Printf.printf "%s ~> %s\n" (show expr) (show (eval expr))