164 lines
4.4 KiB
Coq
164 lines
4.4 KiB
Coq
CoInductive stream (A : Type) : Type :=
|
|
| scons : option A -> stream A -> stream A.
|
|
Arguments scons {A}.
|
|
|
|
CoFixpoint nullstream {A : Type} : stream A :=
|
|
scons None nullstream.
|
|
|
|
Definition unitstream : stream unit := scons (Some tt) nullstream.
|
|
|
|
CoFixpoint lift2 {A B C : Type}
|
|
(f : option A -> option B -> option C)
|
|
(s1 : stream A) (s2 : stream B) : stream C :=
|
|
match s1, s2 with
|
|
| scons x xs, scons y ys => scons (f x y) (lift2 f xs ys)
|
|
end.
|
|
|
|
CoFixpoint lift1 {A B : Type}
|
|
(f : option A -> option B)
|
|
(s : stream A) : stream B :=
|
|
match s with
|
|
| scons x xs => scons (f x) (lift1 f xs)
|
|
end.
|
|
|
|
Definition lift {A B C : Type}
|
|
(f : option A -> option B -> option C)
|
|
(s1 : stream A) (s2 : stream B) : stream C := lift2 f s1 s2.
|
|
|
|
Definition helper_const {A B:Type} (c:A) (x:option B) : option A :=
|
|
match x with
|
|
| Some _ => Some c
|
|
| None => None
|
|
end.
|
|
|
|
CoFixpoint const {A B : Type} (c : A) (s : stream B) : stream A :=
|
|
lift1 (helper_const c) s.
|
|
|
|
Definition helper_merge {A : Type} (a b : option A) : option A :=
|
|
match a with
|
|
| Some a' => a
|
|
| None => b
|
|
end.
|
|
|
|
CoFixpoint merge {A : Type} (s1 s2 : stream A) : stream A :=
|
|
lift helper_merge s1 s2.
|
|
|
|
CoFixpoint last_helper {A B : Type}
|
|
(s1 : stream A) (s2 : stream B) (lx : option A)
|
|
: stream A :=
|
|
match s1, s2 with
|
|
| scons x xs, scons y ys =>
|
|
let newx :=
|
|
match x with
|
|
| None => lx
|
|
| _ => x
|
|
end
|
|
in
|
|
match y with
|
|
| None => scons None (last_helper xs ys newx)
|
|
| _ => scons lx (last_helper xs ys newx)
|
|
end
|
|
end.
|
|
Definition last {A B: Type} (s1 : stream A) (s2 : stream B)
|
|
: stream A := last_helper s1 s2 None.
|
|
|
|
CoFixpoint delay_helper {A:Type} (amt : stream nat)
|
|
(reset : stream A) (tick : option nat)
|
|
: stream unit :=
|
|
match amt, reset with
|
|
| scons None xs, scons None rs =>
|
|
match tick with
|
|
| Some O => scons (Some tt) (delay_helper xs rs None)
|
|
| Some (S t) => scons None (delay_helper xs rs (Some t))
|
|
| None => scons None (delay_helper xs rs None)
|
|
end
|
|
| scons (Some x) xs, scons (Some r) rs => (* set *)
|
|
match tick with
|
|
| Some O => scons (Some tt) (delay_helper xs rs (Some x))
|
|
| _ => scons None (delay_helper xs rs (Some x))
|
|
end
|
|
| scons None xs, scons (Some r) rs => (* reset *)
|
|
match tick with
|
|
| Some O => scons (Some tt) (delay_helper xs rs None)
|
|
| _ => scons None (delay_helper xs rs None)
|
|
end
|
|
| scons (Some x) xs, scons None rs =>
|
|
match tick with
|
|
| Some O => scons (Some tt) (delay_helper xs rs None)
|
|
| Some (S t) => scons None (delay_helper xs rs (Some t))
|
|
| None => scons None (delay_helper xs rs (Some x))
|
|
end
|
|
end.
|
|
Definition delay {A:Type} (amt : stream nat) (reset : stream A)
|
|
: stream unit :=
|
|
delay_helper amt reset None.
|
|
|
|
Fixpoint take {A : Type} (n : nat)
|
|
(s : stream A) : list (option A) :=
|
|
match n, s with
|
|
| O, _ => nil
|
|
| S n', scons x xs => cons x (take n' xs)
|
|
end.
|
|
|
|
Inductive type : Set :=
|
|
| Nat
|
|
| Unit.
|
|
Definition typeDenote (t:type) : Set :=
|
|
match t with
|
|
| Nat => nat
|
|
| Unit => unit
|
|
end.
|
|
Compute typeDenote Nat.
|
|
|
|
Inductive binop : type -> type -> type -> Set :=
|
|
| Merge: forall t:type, binop t t t
|
|
| Last: forall t1 t2:type, binop t1 t2 t1
|
|
| Delay: forall t:type, binop Nat t Unit.
|
|
Definition binopDenote {t1 t2 t3:type} (op:binop t1 t2 t3)
|
|
: stream (typeDenote t1) -> stream (typeDenote t2)
|
|
-> stream (typeDenote t3) :=
|
|
match op with
|
|
| Merge _ => merge
|
|
| Last _ _ => last
|
|
| Delay _ => delay
|
|
end.
|
|
|
|
Coercion Some_nat := (@Some nat).
|
|
Coercion Some_unit := (@Some unit).
|
|
|
|
|
|
Module StreamNotations.
|
|
|
|
Declare Scope stream_scope.
|
|
Delimit Scope stream_scope with stream.
|
|
|
|
Notation "[ ]" := nullstream
|
|
: stream_scope.
|
|
Notation "[[ x ]]" := (const x)
|
|
(at level 10) : stream_scope.
|
|
|
|
Notation "[[ x , y , .. , z ]]" :=
|
|
(cofix t' := (scons x (scons y .. (scons z t') .. )))
|
|
(at level 10, x constr, y constr, z constr) : stream_scope.
|
|
|
|
Notation "[ x , y , .. , z ]" :=
|
|
(scons x (scons y .. (scons z nullstream) .. ))
|
|
(at level 10, x constr, y constr, z constr) : stream_scope.
|
|
|
|
Notation "[ x ]" := (scons x nullstream)
|
|
: stream_scope.
|
|
|
|
Notation "x '[' ':' n ']'" := (take n x)
|
|
(at level 20, x constr, n constr) : stream_scope.
|
|
|
|
End StreamNotations.
|
|
|
|
Import StreamNotations.
|
|
Example s1 := [1,2]%stream.
|
|
Example s2 := [None,1]%stream.
|
|
Compute take 3 (merge s1 s2).
|
|
|
|
Check (binopDenote (Merge Nat)) s1 s2.
|
|
Check (binopDenote (Merge _)) s1 s2.
|
|
|