(Beginner Coq question)
Related to Defining recursive function over product type, I'm trying to define a recursive function over a product type. The difference here is there's a mutually recursive definition. I keep running into this error:
Recursive definition of printObjItem is ill-formed.
Recursive call to printJson has principal argument equal to "val" instead of
a subterm of "item".
Conceptually it seems the recursion should go through since val is a subterm of item, is a subterm of items, is a subterm of x. I understand Coq is struggling with that first assertion but I'm not sure how to resolve. Is there a straightforward way without an explicit well-foundedness proof?
Require Import List.
Require Import String.
Import ListNotations.
Inductive Json :=
| Atom : Json
| String : string -> Json
| Array : nat -> list Json -> Json
| Object : list (string * Json) -> Json.
Fixpoint printJson (x : Json) :=
match x with
| Atom => "atom"
| String n => "'" ++ n ++ "'"
| Array _ els => "[" ++ (String.concat ", " (map printJson els)) ++ "]"
| Object items => "{" ++ (String.concat ", " (map printObjItem items)) ++ "}"
end%string
with printObjItem (item : string * Json) :=
let (key, val) := item in key ++ ": " ++ (printJson val).
One solution could be to make printObjItem a local definition:
Fixpoint printJson (x : Json) :=
let printObjItem (item : string * Json) :=
(let (key, val) := item in key ++ ": " ++ (printJson val))%string
in
match x with
| Atom => "atom"
| String n => "'" ++ n ++ "'"
| Array _ els => "[" ++ (String.concat ", " (map printJson els)) ++ "]"
| Object items => "{" ++ (String.concat ", " (map printObjItem items)) ++ "}"
end%string.
Related
I have the following definitions in Coq:
Inductive list_variable : Type :=
| nil
| cons (s : string) (l : list_variable).
Fixpoint getElement (l : list_variable) (s : Variabile) (v : Address) {struct l} : Address :=
match l with
| nil => v
| str :: nil => (updateValues v ((updateState (updateState s "memPointer" (s("memPointer")+1)) str (s("memPointer"))) "memPointer") undef)
| str :: l => getElement l s v
end.
For some reason, the bottom and second line return Found a constructor of inductive type list while a constructor of list_variable is expected.
For reference, the long return on str::nil works fine in another place. It's for a memory-like simulation.
Any ideas as to why this happens?
The notation :: desugars to List.cons, whereas you want the constructor MyModule.cons. If you want to use ::, you must define a new notation for it:
Inductive list_variable : Type :=
| nil
| cons : ...
.
(* Redefine "::" for new list type *)
Infix "::" := cons.
If you intend to use the same notation for both list and list_variable, it will be necessary to manage notation scopes. Refer to the Coq manual, the section on notations.
I was trying to define a function using Program Fixpoint, which uses another (anonymous) recursive function in its body. I tried using Admit Obligationsfor the moment, to see if something else made sense but I get an error.
This is a simple example that shows the same error (maybe there is a simpler one...).
Require Import List.
Import ListNotations.
Require Import Program.
Section Test.
Inductive FType : Type :=
| Base : RType -> FType
| Cons : RType -> FType -> FType
with RType : Type :=
| Empty : RType
| Nested : nat -> FType -> RType
| NestedList : nat -> list FType -> RType.
Variable ftype_size : FType -> nat.
Program Fixpoint failing (ft : FType) {measure (ftype_size ft)} : FType :=
match ft with
| Base _ => ft
| Cons hd tl =>
match hd with
| NestedList l rs =>
let fix loop (rs : list FType) (i : nat) : list FType :=
match rs with
| [] => []
| r' :: rs' => (failing r') :: (loop rs' (i + 1))
end
in
Base (NestedList l (loop rs 0))
| _ => ft
end
end.
Admit Obligations.
End Test.
So, when running this it says Recursive call to loop has not enough arguments.. I was wondering why is this happening? Is it somehow related to this issue?
Also, if I define an indexed map and repeat this, I don't get any error.
Section Map.
Variables (T1 T2 : Type) (f : nat -> T1 -> T2).
Definition indexed_map (s : list T1) :=
let fix imap s index : list T2 :=
match s with
| [] => []
| hd :: tl => (f index hd) :: imap tl (index + 1)
end
in
imap s 0.
End Map.
Arguments indexed_map [T1 T2].
Program Fixpoint failing (ft : FType) {measure (ftype_size ft)} : FType :=
match ft with
| Base _ => ft
| Cons hd tl =>
match hd with
| NestedList l rs => Base (NestedList l (indexed_map (fun i r' => (failing r')) rs))
| _ => ft
end
end.
Admit Obligations.
I can probably define it in a different way but I was still wondering why is this happening.
Reading the error message further, notice that loop occurs twice in the printed function. The second occurence is the one you wrote, but the first (the problematic one) is an argument to an axiom generated by Admit Obligations.
Recursive call to loop has not enough arguments.
Recursive definition is:
"fun (rs0 : list FType) (i : nat) =>
let program_branch_0 := fun _ : [] = rs0 => [] in
let program_branch_1 :=
fun (r' : FType) (rs' : list FType) (Heq_rs : r' :: rs' = rs0) =>
failing r'
(failing_obligation_1 ft failing hd tl Heq_ft l rs Heq_hd loop
rs0 i r' rs' Heq_rs) :: loop rs' (i + 1) in
match rs0 as rs' return (rs' = rs0 -> list FType) with
| [] => program_branch_0
| r' :: rs' => program_branch_1 r' rs'
end eq_refl".
To avoid that, you can step through the corresponding obligation manually and put your own axiom that doesn't depend on loop.
Parameter TODO : forall {A : Prop}, A.
Program Fixpoint failing ... (* Your definition *)
Next Obligation.
apply TODO.
Qed.
(* Now the rest can still be Admitted. *)
Admit Obligations.
Is there a way to use recursion with Coq's typeclasses? Like for e.g., in defining show for lists, if you want to call the show function for lists recursively, then you will have to use a fixpoint like so:
Require Import Strings.String.
Require Import Strings.Ascii.
Local Open Scope string_scope.
Class Show (A : Type) : Type :=
{
show : A -> string
}.
Section showNormal.
Instance showList {A : Type} `{Show A} : Show (list A) :=
{
show :=
fix lshow l :=
match l with
| nil => "[]"
| x :: xs => show x ++ " : " ++ lshow xs
end
}.
End showNormal.
Which is all well and good, but what if I want to define some helper function that I'll use for defining Show instances? Like I want to create a more DAZZLING show function called magicShow that prints stars around something...
Definition magicShow {A : Type} `{Show A} (a : A) : string :=
"** " ++ show a ++ " **".
Instance showMagicList {A : Type} `{Show A} : Show (list A) :=
{
show :=
fix lshow l :=
match l with
| nil => "[]"
| x :: xs => show x ++ " : " ++ magicShow xs
end
}.
However, in this case Coq can't find a show instance for the list xs to pass to magicShow:
Error:
Unable to satisfy the following constraints:
In environment:
A : Type
H : Show A
lshow : list A -> string
l : list A
x : A
xs : list A
?H : "Show (list A)"
Is there any way to do this in general? I.e., can you define a method for a typeclass using functions that rely upon the typeclass instance that you're defining?
No, there's no way to do this. This works in Haskell because arbitrary recursive bindings are allowed, and the language doesn't care about the order of bindings. Coq is more restrictive on both fronts. This makes sense if you think about what the desugaring looks like: the recursive call to show would refer to the currently-being-defined instance by name, but that binding isn't in scope yet. And you can't make the instance itself a fixpoint because you're recursing on the structure of a type, not on a value of an algebraic data type.
Your inline fixpoint works for show, but the problem gets thornier if your method implementations refer to each other, such as
newtype MyInteger = MyInteger Integer
instance Num MyInteger where
MyInteger m + MyInteger n = MyInteger $ m + n
negate (MyInteger m) = MyInteger $ negate m
m - n = m + negate n
-- other methods
Here, the calls to (+) and negate in the definition of (-) needs to refer to the definitions of (+) and negate above, but this also doesn't work in Coq. The only solution is to define all your methods separately, manually referencing each other, and then define the instance simply by setting each method to the one you defined above. For example,
Inductive MyInteger := Mk_MyInteger : Integer -> MyInteger.
Definition add__MyInteger (m n : MyInteger) : MyInteger :=
let 'Mk_MyInteger m' := m in
let 'Mk_MyInteger n' := n in
Mk_MyInteger (add m' n').
Definition negate__MyInteger (m : MyInteger) : MyInteger :=
let 'Mk_MyInteger m' := m in
Mk_MyInteger (negate m').
Definition sub__MyInteger (m n : MyInteger) : MyInteger :=
add__MyInteger m (negate__MyInteger n).
Instance Num__MyInteger : Num MyInteger := {|
add := add__MyInteger;
negate := negate__MyInteger;
sub := sub__MyInteger;
(* other methods *)
|}.
If you must do this, it can be simulated by explicitly using the constructor of the underlying Record (since "Typeclasses are Records", to quote from Software Foundations [1]), which can be instantiated using the function(s) being defined as a fixpoint. I'll post three examples and explain where this can be useful.
The example you posted could be solved like this (all code tested for Coq 8.10.1):
Require Import Strings.String.
Local Open Scope list_scope.
Local Open Scope string_scope.
Class Show (A : Type) : Type :=
{
show : A -> string
}.
Definition magicShow {A : Type} `{Show A} (a : A) : string :=
"** " ++ show a ++ " **".
Print Show.
(* Record Show (A : Type) : Type := Build_Show { show : A -> string }
*)
Check Build_Show.
(* Build_Show : forall A : Type, (A -> string) -> Show A *)
Check #magicShow.
(* #magicShow : forall A : Type, Show A -> A -> string *)
Instance showMagicList {A : Type} `{Show A} : Show (list A) :=
{
show :=
fix lshow l :=
match l with
| nil => "[]"
| x :: xs => show x ++ " : " ++ #magicShow _ (#Build_Show _ lshow) xs
end
}.
If you are trying to define several typeclass methods like this, it's tricky to instantiate the record constructor, but it can be done by treating the functions as if they were defined by mutual recursion (although there doesn't necessarily have to be any actual mutual recursion). Here's a contrived example where Show now has two methods. Notice that the typeclass instance is added to the context with an anonymous let-in binding. Evidently, this is enough to satisfy Coq's typeclass resolution mechanism.
Require Import Strings.String.
Local Open Scope list_scope.
Local Open Scope string_scope.
Class Show (A : Type) : Type :=
{
show1 : A -> string
; show2 : A -> string
}.
Definition magicShow1 {A : Type} `{Show A} (a : A) : string :=
"** " ++ show1 a ++ " **".
Definition magicShow2 {A : Type} `{Show A} (a : A) : string :=
"** " ++ show2 a ++ " **".
Fixpoint show1__list {A : Type} `{Show A} (l : list A) : string :=
let _ := (#Build_Show _ show1__list show2__list) in
match l with
| nil => "[]"
| x :: xs => show1 x ++ " : " ++ magicShow1 xs
end
with show2__list {A : Type} `{Show A} (l : list A) : string :=
let _ := (#Build_Show _ show1__list show2__list) in
match l with
| nil => "[]"
| x :: xs => show1 x ++ " : " ++ magicShow2 xs
end.
Instance showMagicList {A : Type} `{Show A} : Show (list A) :=
{
show1 := show1__list
; show2 := show2__list
}.
So why would you want to do this? A good example is when you are defining decidable equality on (rose) trees. In the middle of the definition, we have to recursively appeal to decidable equality of list (tree A). We would like to use the standard library helper function Coq.Classes.EquivDec.list_eqdec [2], which shows how to pass decidable equality on a type A to list A. Since list_eqdec requires a typeclass instance (the very one we are in the middle of defining), we have to use the same trick above:
Require Import Coq.Classes.EquivDec.
Require Import Coq.Program.Utils.
Set Implicit Arguments.
Generalizable Variables A.
Inductive tree (A : Type) : Type :=
| leaf : A -> tree A
| node : list (tree A) -> tree A.
Program Instance tree_eqdec `(eqa : EqDec A eq) : EqDec (tree A) eq :=
{ equiv_dec := fix tequiv t1 t2 :=
let _ := list_eqdec tequiv in
match t1, t2 with
| leaf a1, leaf a2 =>
if a1 == a2 then in_left else in_right
| node ts1, node ts2 =>
if ts1 == ts2 then in_left else in_right
| _, _ => in_right
end
}.
Solve Obligations with unfold not, equiv, complement in * ;
program_simpl ; intuition (discriminate || eauto).
Next Obligation.
destruct t1;
destruct t2;
( program_simpl || unfold complement, not, equiv in *; eauto ).
Qed.
Solve Obligations with split; (intros; try unfold complement, equiv ; program_simpl).
(*
No more obligations remaining
tree_eqdec is defined
*)
Commentary: There is no constructor for creating a record of type EqDec (since it only has one class method), so to convince Coq that list (tree A) has decidable equality, the invocation is simply list_eqdec tequiv. For the uninitiated, Program here is simply allowing for holes in the definition of the instance to be filled in later as Obligations, which is more convenient than writing the appropriate proofs inline.
This is a follow up to Coq equality implementation (though this question is self-contained).
I have a simple inductive type of trees (t) with a fixed set of tags (arityCode), each with a fixed number of children. I have a type (path) of paths into a tree. I'm trying to implement some manipulations. In particular, I want to be able to move a cursor around in a few directions. This seems pretty straightforward, but I'm running into a roadblock.
This is all in the code, but a quick explanation of where I'm stuck: To construct a there path, I need to produce a path (Vector.nth v i) (a path in one of the children). But the only path constructors (here and there) produce a path (Node c v). So in some sense I need to show the compiler that a path simultaneously has type path (Node c v) and path (Vector.nth v i), but Coq is not clever enough to compute (Vector.nth children fin_n) -> Node c v. How can I convince it that this is okay?
Require Coq.Bool.Bool. Open Scope bool.
Require Coq.Strings.String. Open Scope string_scope.
Require Coq.Arith.EqNat.
Require Coq.Arith.PeanoNat. Open Scope nat_scope.
Require Coq.Arith.Peano_dec.
Require Coq.Lists.List. Open Scope list_scope.
Require Coq.Vectors.Vector. Open Scope vector_scope.
Require Fin.
Module Export LocalVectorNotations.
Notation " [ ] " := (Vector.nil _) (format "[ ]") : vector_scope.
Notation " [ x ; .. ; y ] " := (Vector.cons _ x _ .. (Vector.cons _ y _ (Vector.nil _)) ..) : vector_scope.
Notation " [ x ; y ; .. ; z ] " := (Vector.cons _ x _ (Vector.cons _ y _ .. (Vector.cons _ z _ (Vector.nil _)) ..)) : vector_scope.
End LocalVectorNotations.
Module Core.
Module Typ.
Set Implicit Arguments.
Inductive arityCode : nat -> Type :=
| Num : arityCode 0
| Hole : arityCode 0
| Arrow : arityCode 2
| Sum : arityCode 2
.
Definition codeEq (n1 n2 : nat) (l: arityCode n1) (r: arityCode n2) : bool :=
match l, r with
| Num, Num => true
| Hole, Hole => true
| Arrow, Arrow => true
| Sum, Sum => true
| _, _ => false
end.
Inductive t : Type :=
| Node : forall n, arityCode n -> Vector.t t n -> t.
Inductive path : t -> Type :=
| Here : forall n (c : arityCode n) (v : Vector.t t n), path (Node c v)
| There : forall n (c : arityCode n) (v : Vector.t t n) (i : Fin.t n),
path (Vector.nth v i) -> path (Node c v).
Example node1 := Node Num [].
Example children : Vector.t t 2 := [node1; Node Hole []].
Example node2 := Node Arrow children.
(* This example can also be typed simply as `path node`, but we type it this way
to use it as a subath in the next example.
*)
Example here : path (*node1*) (Vector.nth children Fin.F1) := Here _ _.
Example there : path node2 := There _ children Fin.F1 here.
Inductive direction : Type :=
| Child : nat -> direction
| PrevSibling : direction
| NextSibling : direction
| Parent : direction.
Fixpoint move_in_path
(node : t)
(dir : direction)
(the_path : path node)
: option (path node) :=
match node with
| #Node num_children code children =>
match the_path with
| There _ _ i sub_path => move_in_path (Vector.nth children i) dir sub_path
| Here _ _ =>
match dir with
| Child n =>
match Fin.of_nat n num_children with
| inleft fin_n =>
(* The problem:
The term "Here ?a#{n0:=n; n:=n0} ?t#{n0:=n; n:=n0}" has type
"path (Node ?a#{n0:=n; n:=n0} ?t#{n0:=n; n:=n0})" while it is expected to have type
"path (Vector.nth children fin_n)".
How can I convince Coq that `Vector.nth children fin_n`
has type `path (Node a t)`?
*)
let here : path (Vector.nth children fin_n) := Here _ _ in
let there : path node := There _ children fin_n here in
Some there
| inright _ => None
end
| _ => None (* TODO handle other directions *)
end
end
end.
End Typ.
End Core.
You could define a smart constructor for Here which does not have any constraint on the shape of the t value it is applied to:
Definition Here' (v : t) : path v := match v return path v with
| Node c vs => Here c vs
end.
You can then write:
let here : path (Vector.nth children fin_n) := Here' _ in
EDIT
Require Import Bool List ZArith.
Variable A: Type.
Inductive error :=
| Todo.
Inductive result (A : Type) : Type :=
Ok : A -> result A | Ko : error -> result A.
Variable bool_of_result : result A -> bool.
Variable rules : Type.
Variable boolean : Type.
Variable positiveInteger : Type.
Variable OK: result unit.
Definition dps := rules.
Inductive dpProof :=
| DpProof_depGraphProc : list
(dps * boolean * option (list positiveInteger) * option dpProof) -> dpProof.
Fixpoint dpProof' (R D: rules) (p: dpProof) {struct p}:=
match p with
| DpProof_depGraphProc cs => dpGraphProc R D cs
end
with dpGraphProc (R D: rules ) cs {struct cs} :=
match cs with
| nil => Ko unit Todo
| (_, _, _, op) :: cs' =>
match op with
| None => Ko unit Todo
| Some p2 => dpProof' R D p2
end
end.
I got an error message saying that:
Recursive call to dpProof has principal argument equal to
"p2" instead of "cs'".
Recursive definition is:
"fun (R D : rules)
(cs : list
(dps * boolean * option (list positiveInteger) *
option dpProof)) =>
match cs with
| nil => Ko unit Todo
| (_, _, _, Some p2) :: _ => dpProof' R D p2
| (_, _, _, None) :: _ => OK
end".
If I do not use the mutual recursive and use the nested fixpoint, it will combine and pass the checker of termination. Here is the code that successfully combined.
Fixpoint dpProof' (R D: rules) (p: dpProof) {struct p}:=
match p with
| DpProof_depGraphProc cs =>
match cs with
| nil => Ko _ Todo
| (_, _, _, op) :: cs' =>
match op with
| None => Ko unit Todo
| Some p2 => dpProof' R D p2
end
end end.
I would like to understand deeper about the reason why it cannot pass the termination checker? Is it because they cannot guess the argument descreasing? Is there any way that I can use the mutually recursive to express my function dpGraphProc?
Also How can I write the function dpGraphProc that check in the whole list? Here I do not know how to use the argument cs'.
Mutual recursion is to be used either with a single inductive data-type or with different inductive data-types that have been defined together in a single inductive definition. In your case, you are using polymorphic data-types prod (the type of pairs), list, and option which were already defined before dpProof.
The nested fixpoint approach does not have the restriction.