Can I do “complex” mutual recursion in Coq without let-binding?

Question

Consider the following pair of mutually recursive Coq data types, which represent a Forest of nonempty Trees. Each Branch of a Tree holds an extra boolean flag, which we can extract with isOK.

Inductive Forest a : Type
  := Empty    : Forest a
  |  WithTree : Tree a -> Forest a -> Forest a
with Tree a : Type
  := Branch : bool -> a -> Forest a -> Tree a.

Arguments Empty    {_}.
Arguments WithTree {_} _ _.
Arguments Branch   {_} _ _ _.

Definition isOK {a} (t : Tree a) : bool :=
  match t with
  | Branch ok _ _ => ok
  end.

Now, if we ignore this boolean flag, we can write a pair of mapping functions to apply a function to every value in a Forest or a Tree, and this works fine:

Fixpoint mapForest_always {a} (f : a -> a) (ts0 : Forest a) {struct ts0} : Forest a :=
  match ts0 with
  | Empty         => Empty
  | WithTree t ts => WithTree (mapTree_always f t) (mapForest_always f ts)
  end
with mapTree_always {a} (f : a -> a) (t : Tree a) {struct t} : Tree a :=
  match t with
  | Branch ok x ts => Branch ok (f x) (mapForest_always f ts)
  end.

However, suppose the boolean represents some validity check, which would be more complicated in real code. So we check the boolean first, and only actually recurse if necessary. This means we have three mutually recursive functions, but one of them is just handing the work along. Unfortunately, this doesn’t work:

Fail Fixpoint mapForest_bad {a} (f : a -> a) (ts0 : Forest a) {struct ts0} : Forest a :=
  match ts0 with
  | Empty         => Empty
  | WithTree t ts => WithTree (mapTree_bad f t) (mapForest_bad f ts)
  end
with mapTree_bad {a} (f : a -> a) (t : Tree a) {struct t} : Tree a :=
  if isOK t
  then mapOKTree_bad f t
  else t
with mapOKTree_bad {a} (f : a -> a) (t : Tree a) {struct t} : Tree a :=
  match t with
  | Branch ok x ts => Branch ok (f x) (mapForest_bad f ts)
  end.

The problem is that mapTree_bad calls into mapOKTree_bad on an argument that isn’t actually smaller.

Except… all mapOKTree_bad is doing is an extra step after some preprocessing. This will always terminate, but Coq can’t see that. To persuade the termination checker, we can instead define mapOKTree_good, which is the same but is a local let-binding; then, the termination checker will see through the let-binding and allow us to define mapForest_good and mapTree_good. If we want to get mapOKTree_good, we can just use a plain old definition after we’ve defined the mutually recursive functions, which just has the same body as the let-binding:

Fixpoint mapForest_good {a} (f : a -> a) (ts0 : Forest a) {struct ts0} : Forest a :=
  match ts0 with
  | Empty         => Empty
  | WithTree t ts => WithTree (mapTree_good f t) (mapForest_good f ts)
  end
with mapTree_good {a} (f : a -> a) (t : Tree a) {struct t} : Tree a :=
  let mapOKTree_good {a} (f : a -> a) (t : Tree a) : Tree a :=
        match t with
        | Branch ok x ts => Branch ok (f x) (mapForest_good f ts)
        end in
  if isOK t
  then mapOKTree_good f t
  else t.

Definition mapOKTree_good {a} (f : a -> a) (t : Tree a) : Tree a :=
  match t with
  | Branch ok x ts => Branch ok (f x) (mapForest_good f ts)
  end.

This works, but it’s not pretty. Is there any way to convince Coq’s termination checker to accept the _bad variants, or is the _good trick the best I’ve got? A command that does work for me, such as Program Fixpoint or Function, is a totally reasonable solution as well.

Answer 1

Very partial answer: we can refactor the two definitions of mapOKTree_good with an intermediate definition parameterized by mapForest_good just before it is defined.

Definition mapOKTree_good_ {a} mapForest_good
           (f : a -> a) (t : Tree a) : Tree a :=
  match t with
  | Branch ok x ts => Branch ok (f x) (mapForest_good f ts)
  end.

Fixpoint mapForest_good {a} (f : a -> a) (ts0 : Forest a) {struct ts0} : Forest a :=
  match ts0 with
  | Empty         => Empty
  | WithTree t ts => WithTree (mapTree_good f t) (mapForest_good f ts)
  end
with mapTree_good {a} (f : a -> a) (t : Tree a) {struct t} : Tree a :=
  if isOK t
  then mapOKTree_good_ mapForest_good f t
  else t.

Definition mapOKTree_good {a} := @mapOKTree_good_ a mapForest_good.