166 lines
3.8 KiB
Coq
166 lines
3.8 KiB
Coq
(* https://coq.zulipchat.com/#narrow/stream/237977-Coq-users/topic/A.20date.20type.20in.20coq *)
|
|
|
|
Require Import NArith.
|
|
Require Import List.
|
|
Import ListNotations.
|
|
|
|
Record raw_date := mkRawDate {
|
|
year:nat
|
|
; month:nat
|
|
; day:nat
|
|
}.
|
|
|
|
Definition range_check (val low high:nat) : bool :=
|
|
(Nat.leb low val) && (Nat.leb val high).
|
|
|
|
Definition isLeapYear (y:nat) : bool :=
|
|
if (Nat.modulo y 4) then
|
|
if (Nat.modulo y 100) then
|
|
if (Nat.modulo y 400) then
|
|
true
|
|
else
|
|
false
|
|
else
|
|
true
|
|
else
|
|
false.
|
|
|
|
Fixpoint isin (a:nat) (ls:list nat) : bool :=
|
|
(* Check if [a] ∈ [ls] *)
|
|
match ls with
|
|
| nil => false
|
|
| cons x xs =>
|
|
if (Nat.eqb x a) then true
|
|
else isin a xs
|
|
end.
|
|
|
|
Definition range_check_N (val low high:N) : bool :=
|
|
(* Check if val ∈ [low, high] interval *)
|
|
(N.leb low val) && (N.leb val high).
|
|
|
|
Definition valid_year (y:nat) : bool := range_check y 1 9999.
|
|
Definition valid_month (m:nat) : bool := range_check m 1 12.
|
|
Definition valid_day (y m d:nat) : bool :=
|
|
if Nat.eqb m 2 then
|
|
(* It's February *)
|
|
if isLeapYear y then
|
|
range_check d 1 29
|
|
else
|
|
range_check d 1 28
|
|
else
|
|
if isin 2 [1; 3; 5; 7; 8; 10; 12]%list then
|
|
range_check d 1 31
|
|
else
|
|
range_check d 1 30.
|
|
|
|
Definition valid_date (d:raw_date) : bool :=
|
|
(valid_year d.(year) &&
|
|
valid_month d.(month) &&
|
|
valid_day d.(year) d.(month) d.(day))%bool.
|
|
|
|
Definition date : Type := {d:raw_date | valid_date d = true}.
|
|
|
|
Definition rawDateEq (a b:raw_date) : bool :=
|
|
(Nat.eqb a.(year) b.(year) &&
|
|
Nat.eqb a.(month) b.(month) &&
|
|
Nat.eqb a.(day) b.(day))%bool.
|
|
Definition rawDateLt (a b:raw_date) : bool :=
|
|
if (Nat.ltb a.(year) b.(year)) then
|
|
true
|
|
else
|
|
if (Nat.ltb a.(month) b.(month)) then
|
|
true
|
|
else
|
|
if (Nat.ltb a.(day) b.(day)) then
|
|
true
|
|
else
|
|
false.
|
|
Definition rawDateGt (a b:raw_date) : bool :=
|
|
rawDateLt b a.
|
|
Definition rawDateLe (a b:raw_date) : bool :=
|
|
orb (rawDateEq a b) (rawDateLt a b).
|
|
Definition rawDateGe (a b:raw_date) : bool :=
|
|
orb (rawDateEq a b) (rawDateGt a b).
|
|
|
|
Compute mkRawDate 2002 12 01.
|
|
Print existT.
|
|
Compute valid_date (mkRawDate 2002 12 01).
|
|
Check exist (fun d => valid_date d = true).
|
|
Compute
|
|
let x := (mkRawDate 2002 12 01) in
|
|
exist (fun d => valid_date d = true) x.
|
|
Compute
|
|
let x := (mkRawDate 2002 12 41) in
|
|
exist (fun d => valid_date d = true) x.
|
|
Program Example foo : date :=
|
|
let x := (mkRawDate 2002 12 41) in
|
|
exist (fun d => valid_date d = true) x _.
|
|
Next Obligation.
|
|
unfold valid_date.
|
|
simpl.
|
|
unfold valid_day.
|
|
simpl.
|
|
unfold range_check.
|
|
simpl.
|
|
(* Goal becomes [false = true] *)
|
|
Abort.
|
|
|
|
Program Example foo : date :=
|
|
let x := (mkRawDate 2002 12 11) in
|
|
exist (fun d => valid_date d = true) x _.
|
|
Compute foo.
|
|
Compute proj1_sig foo.
|
|
|
|
Check le_n.
|
|
Program Example bar2 : {n:nat | n < 2} :=
|
|
exist _ 1 _.
|
|
Compute bar2.
|
|
|
|
Program Example bar10 : {n:nat | n < 10} :=
|
|
exist _ 1 _.
|
|
Next Obligation.
|
|
repeat constructor.
|
|
Qed.
|
|
Compute bar10.
|
|
|
|
Notation "{{ y m d }}" :=
|
|
Program
|
|
|
|
Example foo' : date.
|
|
refine (exist (fun d => valid_date d = true) _ _).
|
|
(*
|
|
refine ((fun d => valid_date d = true) (mkRawDate 2002 12 11)).
|
|
*)
|
|
Abort.
|
|
Check 02.
|
|
|
|
Program Example foo1 : date :=
|
|
let x := (mkRawDate 2011 02 29) in
|
|
exist (fun d => valid_date d = true) x _.
|
|
Next Obligation.
|
|
Abort.
|
|
|
|
|
|
(*
|
|
Definition day28 : Set := { n:nat | n > 0 /\ n < 29}.
|
|
Definition day29 : Set := { n:nat | n > 0 /\ n < 30}.
|
|
Definition day30 : Set := { n:nat | n > 0 /\ n < 31}.
|
|
Definition day31 : Set := { n:nat | n > 0 /\ n < 32}.
|
|
|
|
Inductive day : Set :=
|
|
| D28 : day28 -> day
|
|
| D29 : day29 -> day
|
|
| D31 : day30 -> day
|
|
| D30 : day31 -> day.
|
|
|
|
Check 2:day28.
|
|
Check (D28 28).
|
|
Definition month : Set := { n:nat | n > 0 /\ n < 13}.
|
|
|
|
Inductive month : Set :=
|
|
| D28 : day28 -> day
|
|
| D29 : day29 -> day
|
|
| D31 : day30 -> day
|
|
| D30 : day31 -> day.
|
|
*)
|