I had previously posted problems like the following, but have not yet found a solution. I am having a store (mapping) from a record type (with five members) to a string value. A fold with a function guarding on the three elements of the record and returns a mapping (string to string). I need to solve some lemmas like gsc_MapsTo_iff_right below.
The code may contain some awkward syntax (for example fold) as I am not expert of Coq. Sorry for that.
Thank you for your help.
Wilayat
Require String.
Record c_id : Type := build_c_id {
c_id_d : String.string;
c_id_p : String.string;
c_id_s : bool;
c_id_h : bool;
c_id_k : String.string
}.
Definition skey := String.string.
Definition st (elt:Type) := list (String.string * elt).
Variable elt : Type.
Parameter Sadd : skey -> String.string -> st String.string -> st String.string.
Parameter SMapsTo : skey -> String.string -> st String.string -> Prop.
Definition ckey := c_id.
Definition ct (e:Type) := list (ckey * elt).
Implicit Type cm: ct elt.
Parameter Cadd : ckey -> String.string -> ct String.string -> st String.string.
Parameter CMapsTo : ckey -> String.string -> ct String.string -> Prop.
Parameter elements : ct String.string -> list (ckey*String.string).
Fixpoint rec_fold {A : Type} (f: ckey -> String.string -> A -> A) (l : list (ckey * String.string)) (b: A) : A :=
match l with
| nil => b
| cons (k, v) t => f k v (rec_fold f t b)
end.
Fixpoint fold {A: Type} (f: ckey -> String.string -> A -> A)
(cm: ct String.string) (b:A) : A :=
rec_fold f (elements cm) b.
Parameter empty : st String.string.
Axiom str_dec : forall a b : String.string, {a = b} + {a <> b}.
Definition str_eqdec (a b: String.string):bool :=
if str_dec a b then true else false.
Notation "x =?= y" := (str_eqdec x y) (at level 30).
Definition andb (b1 b2:bool) : bool := if b1 then b2 else false.
Notation "x & y" := (andb x y) (at level 40).
Definition get_sc (d p: String.string) (ckm: ct String.string)
: st String.string :=
fold
(fun cki v zm => if d =?= cki.(c_id_d) &
p =?= cki.(c_id_p) &
(negb (cki.(c_id_s)))
then Sadd cki.(c_id_k) v zm
else zm )
ckm
empty.
Lemma gsc_MapsTo_iff_right:
forall p d zk zv zh cm,
CMapsTo (build_c_id d p false zh zk) zv cm ->
SMapsTo zk zv (get_sc d p cm).
Proof.
Admitted.
Related
I'm playing around with idris and was trying to implement extensible records.
The main goal is to guarantee that the record's keys are unique.
For example
("Year" := 1998) +: rnil
is legal
("Title" := "test") +: ("Year" := 1998) +: rnil
also works, but
("Year" := "test") +: ("Year" := 1998) +: rnil
Should fail to compile.
I came up with the following implementation which compiles fine:
{-
See: http://lpaste.net/104020
and https://github.com/gonzaw/extensible-records
-}
module Record
import Data.List
%default total
data HList : List Type -> Type where
Nil : HList []
(::) : a -> HList xs -> HList (a :: xs)
infix 5 :=
data Field : lbl -> Type -> Type where
(:=) : (label : lbl) ->
(value : b) -> Field label b
labelsOf : List (lbl, Type) -> List lbl
labelsOf [] = []
labelsOf ((label, _) :: xs) = label :: labelsOf xs
toFields : List (lbl, Type) -> List Type
toFields [] = []
toFields ((l, t) :: xs) = (Field l t) :: toFields xs
data IsSet : List t -> Type where
IsSetNil : IsSet []
IsSetCons : Not (Elem x xs) -> IsSet xs -> IsSet (x :: xs)
data Record : List (lty, Type) -> Type where
MkRecord : IsSet (labelsOf ts) -> HList (toFields ts) ->
Record ts
infixr 6 +:
rnil : Record []
rnil = MkRecord IsSetNil []
prepend : { label : lbl,
xs : List (lbl, Type),
prf : Not (Elem label (labelsOf xs))
} ->
Field label t ->
Record xs ->
Record ((label, t) :: xs)
prepend {prf} f (MkRecord isSet fs) = MkRecord (IsSetCons prf isSet) (f :: fs)
data IsNo : Dec prop -> Type where
ItIsNo : IsNo (No y)
(+:) : DecEq lbl =>
{ label : lbl, xs : List (lbl, Type) } ->
Field label t ->
Record xs ->
{ auto isno : IsNo (isElem label $ labelsOf xs) } ->
Record ((label, t) :: xs)
(+:) {label} {xs} f r with (isElem label $ labelsOf xs)
(+:) { isno = ItIsNo } _ _ | (Yes _) impossible
(+:) f r | (No no) = prepend {prf = no} f r
The interesting bit is
{ auto isno : IsNo (isElem label $ labelsOf xs) } ->
The idea is that if the keys are unique, the compiler will trivialy find an instance of IsNo while it won't if keys are not unique and therefore fail to compile.
This works well with for those example
("Year" := 1998) +: rnil -- Compiles fine
("Year" := "test") +: ("Year" := 1998) +: rnil -- fails to compile as expected
But
("Title" := "test") +: ("Year" := 1998) +: rnil
fails to compile with the following error:
(input):Type mismatch between
("Title" = "Year") -> "Title" = "Year"
and
("Title" = "Year") -> Void
I must admit that this error baffles me. Can anyone explain what's happening here ?
It seems that you're the first to use the DecEq instance for String in anger and as a result, you're the first to find that the way we build proof terms for primitives here is wrong. Sorry about that. The good news is that it's easy to fix (I've just tried it on your example and it's fine), the bad news is that you'll need the git head once I've pushed the fix.
We're overdue a new release anyway. I'll try to do that this weekend. Your code certainly looks fine to me!
What is the syntax to constrain a function argument in an interface which takes a function? I tried:
interface Num a => Color (f : a -> Type) where
defs...
But it says the Name a is not bound in interface...
Your interface actually has two parameters: a and f. But f should be enough to pick an implementation:
interface Num a => Color (a : Type) (f : a -> Type) | f where
f here is called a determining parameter.
Here's a nonsensical full example:
import Data.Fin
interface Num a => Color (a : Type) (f : a -> Type) | f where
foo : (x : a) -> f (1 + x)
Color Nat Fin where
foo _ = FZ
x : Fin 6
x = foo {f = Fin} 5
Idris version: 0.9.16
I am attempting to describe constructions generated from a base value and an iterated step function:
namespace Iterate
data Iterate : (base : a) -> (step : a -> a) -> a -> Type where
IBase : Iterate base step base
IStep : Iterate base step v -> Iterate base step (step v)
Using this I can define Plus, describing constructs from iterated addition of a jump value:
namespace Plus
Plus : (base : Nat) -> (jump : Nat) -> Nat -> Type
Plus base jump = Iterate base (\v => jump + v)
Simple example uses of this:
namespace PlusExamples
Even : Nat -> Type; Even = Plus 0 2
even0 : Even 0; even0 = IBase
even2 : Even 2; even2 = IStep even0
even4 : Even 4; even4 = IStep even2
Odd : Nat -> Type; Odd = Plus 1 2
odd1 : Odd 1; odd1 = IBase
odd3 : Odd 3; odd3 = IStep odd1
Fizz : Nat -> Type; Fizz = Plus 0 3
fizz0 : Fizz 0; fizz0 = IBase
fizz3 : Fizz 3; fizz3 = IStep fizz0
fizz6 : Fizz 6; fizz6 = IStep fizz3
Buzz : Nat -> Type; Buzz = Plus 0 5
buzz0 : Buzz 0; buzz0 = IBase
buzz5 : Buzz 5; buzz5 = IStep buzz0
buzz10 : Buzz 10; buzz10 = IStep buzz5
The following describes that values below the base are impossible:
noLess : (base : Nat) ->
(i : Fin base) ->
Plus base jump (finToNat i) ->
Void
noLess Z FZ m impossible
noLess (S b) FZ IBase impossible
noLess (S b) (FS i) IBase impossible
And the following for values between base and jump + base:
noBetween : (base : Nat) ->
(predJump : Nat) ->
(i : Fin predJump) ->
Plus base (S predJump) (base + S (finToNat i)) ->
Void
noBetween b Z FZ m impossible
noBetween b (S s) FZ IBase impossible
noBetween b (S s) (FS i) IBase impossible
I am having trouble defining the following function:
noJump : (Plus base jump n -> Void) -> Plus base jump (jump + n) -> Void
noJump f m = ?noJump_rhs
That is: if n isn't base plus a natural multiple of jump, then neither is jump + n.
If I ask Idris to case split m it only shows me IBase - then I get stuck.
Would someone point me in the right direction?
Edit 0:
Applying induction to m gives me the following message:
Induction needs an eliminator for Iterate.Iterate.Iterate
Edit 1:
Name updates and here is a copy of the source: http://lpaste.net/125873
I think there's a good reason to get stuck on the IBase case of this proof, which is that the theorem is false! Consider:
noplus532 : Plus 5 3 2 -> Void
noplus532 IBase impossible
noplus532 (IStep _) impossible
plus535 : Plus 5 3 (3 + 2)
plus535 = IBase
To Edit 0: to induct on a type, it needs a special qualifier:
%elim data Iterate = <your definition>
To the main question: sorry that I haven't read through all your code, I only want to make some suggestion for falsifying proofs. From my experience (I even delved the standard library sources to find out some help), when you need to prove Not a (a -> Void), often you can use some Not b (b -> Void) and a way to convert a to b, then just pass it to the second proof. For example, a very simple proof that one list cannot be prefix of another if they have different heads:
%elim data Prefix : List a -> List a -> Type where
pEmpty : Prefix Nil ys
pNext : Prefix xs ys -> Prefix (x :: xs) (x :: ys)
prefixNotCons : Not (x = y) -> Not (Prefix (x :: xs) (y :: ys))
prefixNotCons r (pNext _) = r refl
In your case, I suppose you need to combine several proofs.
I can only do rank-n types in Idris 0.9.12 in a rather clumsy way:
tupleId : ((a : Type) -> a -> a) -> (a, b) -> (a, b)
tupleId f (a, b) = (f _ a, f _ b)
I need the underscores wherever there's a type application, because Idris throws parse errors when I try to make the (nested) type arguments implicit:
tupleId : ({a : Type} -> a -> a) -> (a, b) -> (a, b) -- doesn't compile
A probably bigger issue is that I can't do class constraints in higher-rank types at all. I can't translate the following Haskell function to Idris:
appShow :: Show a => (forall a. Show a => a -> String) -> a -> String
appShow show x = show x
This also prevents me from using Idris functions as type synonyms for types such as Lens, which is Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t in Haskell.
Any way to remedy or circumvent the above issues?
I've just implemented this in master, allowing implicits in arbitrary scopes, and it'll be in the next hackage release. It's not well tested yet though! I have at least tried the following simple examples, and a few others:
appShow : Show a => ({b : _} -> Show b => b -> String) -> a -> String
appShow s x = s x
AppendType : Type
AppendType = {a, n, m : _} -> Vect n a -> Vect m a -> Vect (n + m) a
append : AppendType
append [] ys = ys
append (x :: xs) ys = x :: append xs ys
tupleId : ({a : _} -> a -> a) -> (a, b) -> (a, b)
tupleId f (a, b) = (f a, f b)
Proxy : Type -> Type -> Type -> Type -> (Type -> Type) -> Type -> Type
Producer' : Type -> (Type -> Type) -> Type -> Type
Producer' a m t = {x', x : _} -> Proxy x' x () a m t
yield : Monad m => a -> Producer' a m ()
The main constraint at the minute is that you can't give values for implicit arguments directly, except at the top level. I'll do something about that eventually...
I am trying to implement a node delete function for a Binary Search Tree in SML/nj.
However I am getting a constraint error, that I don't understand why...
datatype 'a tree = Empty | Node of 'a * 'a tree * 'a tree;
datatype 'a stree = STree of ('a * 'a -> bool) * ('a * 'a -> bool) * 'a tree;
fun removeMin Empty = Empty
| removeMin (Node(_,Empty,r)) = r
| removeMin (Node(k,l,r)) = Node(k, removeMin l, r);
removeMin: 'a tree -> 'a tree;
fun get_left_most Empty = Empty
| get_left_most (Node(k,Empty,r)) = Node(k,Empty,r)
| get_left_most (Node(_,l,_)) = get_left_most l;
get_left_most: 'a tree -> 'a tree;
fun get_key (Node(k, l, r)) = k;
get_key: 'a tree -> 'a;
fun tree_empty Empty = true
| tree_empty (Node(_,_,_)) = false;
tree_empty: 'a tree -> bool;
fun remove v (STree(f, g, stree2)) =
let
fun remove2 v Empty = Empty
| remove2 v (Node(k,l,r)) =
if f(v, k) then
if (tree_empty l) then r
else if (tree_empty r) then l
else Node(get_key (get_left_most r), l, removeMin r)
else if g(v, k) then Node(k, (remove2 v l), r)
else Node(k, l, remove2 v r);
in
STree(f, g, (remove2 v stree2))
end;
remove: 'a -> 'a stree -> 'a stree;
This is the error that I am getting: (for get_key)
Warning: match nonexhaustive
Node (k,l,r) => ...
Does anyone know why this is happening?
Your comparison using = in remove means that the tree must contain equality types (hence the two ' characters in the ''Z type variable that SML inferred) but you have claimed that it's more general: remove: 'a -> 'a stree -> 'a stree;.
You need to either only use equality types (i.e. declare remove: ''a -> ''a stree -> ''a stree;)
or redefine remove2 to use case analysis instead of comparison.
For instance,
| remove2 v (node as Node(k, Empty, Empty)) = if f(v, k) then Empty else node