How to combine a comonad and a monad into a comonad? - scala

Assume I have
a comonad D
a monad T
a distributive law l : D T -> T D of the comonad D over the monad T.
How can I define the comonad D T?

You can't. Suppose D is the identity comonad and T is Cont Void, i.e. the continuation monad at the empty type.
newtype D a = D {runD :: a}
newtype T a = T {runT :: (a -> Void) -> Void}
Then distributivity holds trivially. But extract :: D (T a) -> a is not definable as a total computable program. It would be double negation elimination forall a. ((a -> Void) -> Void) -> a, which is not definable in constructive languages.

Related

Composition with multiple params

I quite often find myself in a need to use point-free functional compositon for functions with multiple params with methods like that:
compose2 :: ∀ a b c r. (c -> r) -> (a -> b -> c) -> a -> b -> r
compose2 g f a b = g (f a b)
compose3 :: ∀ a b c d r. (d -> r) -> (a -> b -> c -> d) -> a -> b -> c -> r
compose3 g f a b c = g (f a b c)
I see no standard lib offering such methods directly, are there some other more simple means to get the same result?
Searching on Pursuit by your type signatures reveals a library called purescript-point-free that offers both compose2 and compose3, operator aliases for them, and many more.

Induction on a datatype with non-uniform type parameters produces ill-typed terms

I'm working towards formalising Free Selective Applicative Functors in Coq, but struggling with proofs by induction for inductive data types with non-uniform type parameters.
Let me give a bit of an introduction on the datatype I'm dealing with.
In Haskell, we encode Free Selective Functors as a GADT:
data Select f a where
Pure :: a -> Select f a
Select :: Select f (Either a b) -> f (a -> b) -> Select f b
The crucial thing here is the existential type variable b in the second data constructor.
We can translate this definition to Coq:
Inductive Select (F : Type -> Type) (A : Set) : Set :=
Pure : A -> Select F A
| MkSelect : forall (B : Set), Select F (B + A) -> F (B -> A) -> Select F A.
As a side note, I use the -impredicative-set option to encode it.
Coq generates the following induction principle for this datatype:
Select_ind :
forall (F : Type -> Type) (P : forall A : Set, Select F A -> Prop),
(forall (A : Set) (a : A), P A (Pure a)) ->
(forall (A B : Set) (s : Select F (B + A)), P (B + A)%type s ->
forall f0 : F (B -> A), P A (MkSelect s f0)) ->
forall (A : Set) (s : Select F A), P A s
Here, the interesting bit is the predicate P : forall A : Set, Select F A -> Prop which is parametrised not only in the expression, but also in the expressions type parameter. As I understand, the induction principle has this particular form because of the first argument of the MkSelect constructor of type Select F (B + A).
Now, I would like to prove statements like the third Applicative law for the defined datatype:
Theorem Select_Applicative_law3
`{FunctorLaws F} :
forall (A B : Set) (u : Select F (A -> B)) (y : A),
u <*> pure y = pure (fun f => f y) <*> u.
Which involve values of type Select F (A -> B), i.e. expressions containing functions. However,
calling induction on variables of such types produces ill-typed terms. Consider an oversimplified example of an equality that can be trivially proved by reflexivity, but can't be proved using induction:
Lemma Select_induction_fail `{Functor F} :
forall (A B : Set) (a : A) (x : Select F (A -> B)),
Select_map (fun f => f a) x = Select_map (fun f => f a) x.
Proof.
induction x.
Coq complains with the error:
Error: Abstracting over the terms "P" and "x" leads to a term
fun (P0 : Set) (x0 : Select F P0) =>
Select_map (fun f : P0 => f a) x0 = Select_map (fun f : P0 => f a) x0
which is ill-typed.
Reason is: Illegal application (Non-functional construction):
The expression "f" of type "P0" cannot be applied to the term
"a" : "A"
Here, Coq can't construct the predicate abstracted over the type variable because the reversed function application from the statement becomes ill-typed.
My question is, how do I use induction on my datatype? I can't see a way how to modify the induction principle in such a way so the predicate would not abstract the type. I tried to use dependent induction, but it has been producing inductive hypothesis constrained by equalities similar to (A -> B -> C) = (X + (A -> B -> C)) which I think would not be possible to instantiate.
Please see the complete example on GitHub: https://github.com/tuura/selective-theory-coq/blob/impredicative-set/src/Control/Selective/RigidImpredSetMinimal.v
UPDATE:
Following the discussio in the gist I have tried to carry out proofs by induction on depth of expression. Unfortunately, this path was not very fruitful since the induction hypothesis I get in theorems similar to Select_Applicative_law3 appear to be unusable. I will leave this problem for now and will give it a try later.
Li-yao, many thanks again for helping me to improve my understanding!
Proofs by induction are motivated by recursive definitions. So to know what to apply induction to, look for Fixpoints.
Your Fixpoints most likely work on terms indexed by single type variables Select F A, that's exactly where you want to use induction, not at the toplevel of the goal.
A Fixpoint on terms indexed by function types A -> B is useless since no subterms of any Select term are indexed by function types. For the same reason, induction is useless on such terms.
Here I think the strong type discipline actually forces you to work everything out on paper before trying to do anything in Coq (which is a good thing in my opinion). Try to do the proof on paper, without even worrying about types; explicitly write down the predicate(s) you want to prove by induction. Here's a template to see what I mean:
By induction on u, we will show
u <*> pure x = pure (fun f => f x) <*> u
(* Dummy induction predicate for the sake of example. *)
(* Find the right one. *)
(* It may use quantifiers... *)
Base case (set u = Pure f). Prove:
Pure f <*> pure x = pure (fun f => f x) <*> Pure f
Induction step (set u = MkSelect v h). Prove:
MkSelect v h <*> pure x = pure (fun f => f x) <*> MkSelect v h
assuming the induction hypothesis for the subterm v (set u = v):
v <*> pure x = pure (fun f => f x) <*> v
Notice in particular that the last equation is ill-typed, but you can still run along with it to do equational reasoning. Regardless, it will likely turn out that there is no way to apply that hypothesis after simplifying the goal.
If you really need to use Coq to do some exploration, there is a trick, consisting in erasing the problematic type parameter (and all terms that depend on it). Depending on your familiarity with Coq, this tip may turn out to be more confusing than anything. So be careful.
The terms will still have the same recursive structure. Keep in mind that the proof should also follow the same structure, because the point is to add more types on top afterwards, so you should avoid shortcuts that rely on the lack of types if you can.
(* Replace all A and B by unit. *)
Inductive Select_ (F : unit -> Type) : Set :=
| Pure_ : unit -> Select_ F
| MkSelect_ : Select_ F -> F tt -> Select_ F
.
Arguments Pure_ {F}.
Arguments MkSelect_ {F}.
(* Example translating Select_map. The Functor f constraint gets replaced with a dummy function argument. *)
(* forall A B, (A -> B) -> (F A -> F B) *)
Fixpoint Select_map_ {F : unit -> Type} (fmap : forall t, unit -> (F t -> F t)) (f : unit -> unit) (v : Select_ F) : Select_ F :=
match v with
| Pure_ a => Pure_ (f a)
| MkSelect_ w h => MkSelect_ (Select_map_ fmap f w) (fmap _ tt h)
end.
With that, you can try to prove this trimmed down version of the functor laws for example:
Select_map_ fmap f (Select_map_ fmap g v) = Select_map_ fmap (fun x => f (g x)) v
(* Original theorem:
Select_map f (Select_map g v) = Select_map (fun x => f (g x)) v
*)
The point is that removing the parameter avoids the associated typing problems, so you can try to use induction naively to see how things (don't) work out.

Purescript treats class as circular type synonym

I'm trying to define instances that only work on type level natural numbers. When I compile this file:
module Main where
data NatZero
data NatSucc n
class NatClass n where
switch :: f NatZero -> (forall m. NatClass m => f (NatSucc m)) -> f n
it tells me:
Error found:
at src/Main.purs:6:1 - 7:73 (line 6, column 1 - line 7, column 73)
A cycle appears in the definition of type synonym NatClass
Cycles are disallowed because they can lead to loops in the type checker.
Consider using a 'newtype' instead.
Why did NatClass become a type synonym? I thought it was a type class. And where is there a loop? What should I change to make this work like in Haskell? It's telling me to newtype, what do I newtype?
The error message is misleading and unfortunate - it's not anything you're doing wrong with the code here, it's happening due to how the compiler desugars type classes.
Currently a dictionary is represented as a record, so the synonym mentioned in the error here is because the compiler creates something like this for the class:
type NatClass n =
{ switch :: forall f. f NatZero -> (forall m. NatClass m => f (NatSucc m)) -> f n }
So that it can do a fairly direct replacement of constraints with dictionary arguments.
I think right now this class (or any that uses itself as a constraint in a member) will have the same problem.
I've been wanting to change the representation for type classes for a while, and have a WIP PR for it, I think after that this kind of thing will be allowed. After this classes will be desugared into a data type rather than a synonym, so the reference should be allowed.
You can work around the Purescript limitation pretty easily by reifying the dictionary yourself. Something like -
data NatZero
data NatSucc n
newtype NatClassDict n = NatClassDict (forall f. f NatZero -> (forall m. NatClass m => f (NatSucc m)) -> f n)
getSwitch :: NatClassDict n -> (forall f. f NatZero -> (forall m. NatClass m => f (NatSucc m)) -> f n)
getSwitch (NatClassDict f) = f
class NatClass n where
natClassDict :: NatClassDict n
switch :: NatClass n => forall f. f NatZero -> (forall m. NatClass m => f (NatSucc m)) -> f n
switch = getSwitch natClassDict

Specifying polarity in a module type

The following inductive definition of U is accepted by Coq because it can see that the occurrences of U in M.T U -> U are strictly positive.
Module M.
Definition T (A : Type) : Type := unit -> A.
End M.
Module N.
Inductive U : Type :=
| c : M.T U -> U.
End N.
On the other hand, the following inductive definition of U is not accepted by Coq because, depending on the definition of M.T, it might have non-strictly positive occurrences.
Module Type S.
Parameter T : Type -> Type.
End S.
Module N (M : S).
Fail Inductive U : Type :=
| c : M.T U -> U.
End N.
How can I specify in the signature S that the parameter of T should only have strictly negative occurrences? Thus preventing any non-strictly positive occurrences of U in its definition.
This U type can be seen as the least fixed point of M.T. Another common encoding is
Definition Mu (T : Type -> Type) := forall A, (T A -> A) -> A.
Definition U := Mu M.T.
Provided that T is a functor (which strict positivity would imply, maybe?):
Parameter map : forall A B, (A -> B) -> T A -> T B. (* in module M *)
we have a constructor and destructor:
Definition c : M.T U -> U := fun x A f =>
f (M.map _ _ (fun y => y _ f) x).
Definition d : U -> M.T U := fun y => y _ (fun x => M.map _ _ c x).
Showing they are inverses requires parametricity, so there is no direct way to prove it. If you don't want to axiomatize it, you can probably enrich T and U to carry evidence of parametricity.
Essentially, the requirement above that T be a functor is a semantic replacement/approximation of the strict positivity condition, which is syntactic.
It is also possible to switch off positivity checking with this new plugin:
https://github.com/SimonBoulier/TypingFlags

Type that contains all functions of N elements in Coq

I am learning Coq and as an exercise I want to define a type FnArity (N:nat) to encode all functions of N arguments. That is:
Check FnArity 3 : (forall A B C : Set, A -> B -> C).
Should work but
Check FnArity 2 : (forall A B C D : Set, A -> B -> C -> D).
Should not work.
This is for pedagogic purposes so any relevant resources are welcome.
EDIT: From the answers so far I realize I am probably approaching this wrong so here is the proposition I am trying to prove:
Composing N composition operators is equivalent to a composition operator that composes f and g where g expects N arguments. In haskell-ish terms:
(.).(.) ... N times ... (.).(.) f g = \a1, .. aN -> f (g (a1, .. , aN))
EDIT2: In coq terms:
Definition compose { A B C : Type } (F : C -> B) (G : A -> C ) : A -> B :=
fun x => F ( G (x) ).
Definition compose2 {A1 A2 B C : Type} (F : C -> B) (G : A1 -> A2 -> C)
: A1 -> A2 -> B := fun x y => F ( G x y ).
Definition compose3 {A1 A2 A3 B C : Type} (F : C -> B) (G : A1 -> A2 -> A3 -> C)
: A1 -> A2 -> A3 -> B := fun x y z => F ( G x y z ).
(* The simplest case *)
Theorem dual_compose : forall {A B C D : Type} (f: D -> C) (g : A -> B -> D) ,
(compose compose compose) f g = compose2 f g.
Proof. reflexivity. Qed.
Theorem triple_compose : forall {A1 A2 A3 B C : Type} (f: C -> B) (g : A1 -> A2 -> A3 -> C) ,
(compose (compose (compose) compose) compose) f g =
compose3 f g.
What I want is to define the generalized theorem for composeN.
The types that you wrote down do not quite represent what you stated in your problem: forall A B C, A -> B -> C is not the type of all functions of three arguments, but the type of certain polymorphic functions of two arguments. You probably meant to write something like { A & { B & { C & A -> B -> C }}} instead, where A, B and C are existentially quantified. You probably also meant to say Compute (FnArity 3) instead of using the Check command, since the latter is the one that evaluates a term (and, as jbapple pointed out, no term can have the type that you had originally written).
Here's a piece of code that does what you want, I think. We start by writing a function FnArityAux1 : list Type -> Type -> Type, that computes a function type with arguments given on a list:
Fixpoint FnArityAux1 (args : list Type) (res : Type) : Type :=
match args with
| [] => res
| T :: args' => T -> FnArityAux1 args' res
end.
For instance, FnArityAux1 [nat; bool] bool evaluates to nat -> bool -> bool. We can then use this function to define FnArity as follows:
Fixpoint FnArityAux2 (args : list Type) (n : nat) : Type :=
match n with
| 0 => { T : Type & FnArityAux1 args T }
| S n' => { T : Type & FnArityAux2 (args ++ [T]) n' }
end.
Definition FnArity n := FnArityAux2 [] n.
In this definition, we use another auxiliary function FnArityAux2 that has an argument args whose purpose is to carry around all the existentially quantified types produced so far. For each "iteration step", it quantifies over another type T, adds that type to the list of arguments, and recurses. When the recursion is over, we use FnArityAux1 to combine all accumulated types into a single function type. Then, we can define FnArity simply by starting the process with an empty list -- that is, no quantified types at all.
No, this is not possible, since (forall A B C : Set, A -> B -> C) is uninhabited.
Goal (forall A B C : Set, A -> B -> C) -> False.
intros f.
specialize (f True True False).
apply f; trivial.
Qed.
As such, Check FnArity 3 : (forall A B C : Set, A -> B -> C). can never work.