playground/coq/unfinished/mult-arg-functor.v

72 lines
2.7 KiB
Coq

Require List.
Class Functor (f: Type -> Type) := {
fmap : forall {A B:Type}, (A -> B) -> f A -> f B
}.
Class Applicative (f: Type -> Type) `{Functor f} := {
pure: forall {A:Type}, A -> f A;
ap: forall {A B:Type}, f (A -> B) -> f A -> f B
}.
#[export] Instance option_functor : Functor option := {
fmap {A B:Type} (f:A->B) x :=
match x with
| Some x' => Some (f x')
| None => None
end
}.
#[export] Instance option_applicative : Applicative option := {
pure {A:Type} (x:A) := Some x;
ap {A B:Type} f a :=
match f, a with
| Some f', Some a' => Some (f' a')
| _, _ => None
end
}.
#[export] Instance list_functor : Functor list := {
fmap {A B:Type} :=
fix fmap f x :=
match x with
| List.cons x' xs => List.cons (f x') (fmap f xs)
| List.nil => List.nil
end
}.
#[export] Instance list_applicative : Applicative list := {
pure {A:Type} (x:A) := List.cons x List.nil;
ap {A B:Type} :=
fix ap f a :=
match f, a with
| List.cons f' ff, List.cons a' aa =>
List.cons (f' a') (ap ff aa)
| _, _ => List.nil
end
}.
Inductive tuple2 (A B:Type) : Type :=
| Tuple2: A -> B -> tuple2 A B.
Arguments Tuple2 {A B}.
Compute Tuple2 2 3.
Compute Tuple2 2 true.
#[export] Instance tuple2_functor : Functor tuple2 := {
fmap {A B C:Type} (f:A*B->C) x :=
let res := f x in
Tuple2 (fst res) (snd res)
}.
#[export] Instance list_applicative : Applicative list := {
pure {A:Type} (x:A) := List.cons x List.nil;
ap {A B:Type} :=
fix ap f a :=
match f, a with
| List.cons f' ff, List.cons a' aa =>
List.cons (f' a') (ap ff aa)
| _, _ => List.nil
end
}.