Skip to content

Instantly share code, notes, and snippets.

@hacklex
hacklex / Sandbox.fst
Created June 18, 2022 03:00
Simple key-based search in a seq of key-value pairs
module Sandbox
open FStar.Seq
let under (x: nat) = z:nat{z<x}
let index_for #t (x:seq t) = under (length x)
let rec select_by_key (#key_type: eqtype)
(#value_type: Type)
@hacklex
hacklex / FStar.Algebra.Classes.Equatable.fst
Last active May 12, 2022 16:00
Experiments with custom equivalence relation
module FStar.Algebra.Classes.Equatable
module TC = FStar.Tactics.Typeclasses
class equatable (t:Type) = {
eq: t -> t -> bool;
reflexivity : (x:t -> Lemma (eq x x));
symmetry: (x:t -> y:t -> Lemma (requires eq x y)
(ensures eq y x));
transitivity: (x:t -> y:t -> z:t -> Lemma (requires eq x y /\ eq y z)
@hacklex
hacklex / Sandbox.fst
Last active May 7, 2022 03:06
FStar Algebra Typeclasses Sandbox
module Sandbox
module TC = FStar.Tactics.Typeclasses
class equatable (t:Type) = {
eq: t -> t -> bool;
reflexivity : (x:t -> Lemma (eq x x));
symmetry: (x:t -> y:t -> Lemma (requires eq x y) (ensures eq y x));
transitivity: (x:t -> y:t -> z:t -> Lemma (requires (x `eq` y /\ y `eq` z)) (ensures (x `eq` z)));
}
@hacklex
hacklex / Sandbox.fst
Last active May 1, 2022 06:17
Fstar requires redundancy or just fails to resolve TC here
module Sandbox
module TC = FStar.Tactics.Typeclasses
class equatable (t:Type) = {
eq: t -> t -> bool;
reflexivity : (x:t -> Lemma (eq x x));
symmetry: (x:t -> y:t -> Lemma (requires eq x y) (ensures eq y x));
transitivity: (x:t -> y:t -> z:t -> Lemma (requires (x `eq` y /\ y `eq` z)) (ensures (x `eq` z)))
}
@hacklex
hacklex / Sandbox.fst
Created April 30, 2022 12:33
This one freezes F* at the last definition
module Sandbox
module TC = FStar.Tactics.Typeclasses
class has_eq (t:Type) = {
eq: t -> t -> bool;
reflexivity : (x:t -> Lemma (eq x x));
symmetry: (x:t -> y:t -> Lemma (requires eq x y) (ensures eq y x));
transitivity: (x:t -> y:t -> z:t -> Lemma (requires (x `eq` y /\ y `eq` z)) (ensures (x `eq` z)))
}
@hacklex
hacklex / Sandbox.fst
Created April 22, 2022 06:30
fmap sandbox
module Sandbox
open FStar.List
open FStar.Set
type nat_from (l: set nat) = x:nat{mem x l}
type nonempty_set a = l:set a { l =!= empty }
let list_len = FStar.List.Tot.Base.length
@hacklex
hacklex / Sandbox.fst
Last active March 25, 2022 16:00
Found a weird bug in F*, line 35
module Sandbox
module CE = FStar.Algebra.CommMonoid.Equiv
module SProp = FStar.Seq.Properties
module SB = FStar.Seq.Base
module SP = FStar.Seq.Permutation
type under (x:nat) = (t:nat{t<x})
let is_left_distributive #c #eq (mul add: CE.cm c eq) =
forall (x y z: c). mul.mult x (add.mult y z) `eq.eq` add.mult (mul.mult x y) (mul.mult x z)
@hacklex
hacklex / Polynomial.Multiplication.fst
Created March 10, 2022 12:09
Polynomial associativity proof; in context of CuteCas.Polynomial.Multiplication.fst
#push-options "--ifuel 0 --fuel 0 --z3refresh --z3rlimit 20"
let poly_mul_is_associative #c (#r: commutative_ring #c) (p q w: noncompact_poly_over_ring r)
: Lemma (requires length p>0 /\ length q>0 /\ length w > 0)
(ensures poly_mul p (poly_mul q w) `ncpoly_eq` poly_mul (poly_mul p q) w) =
Classical.forall_intro (ncpoly_eq_is_reflexive_lemma #c #r);
Classical.forall_intro_2 (ncpoly_eq_is_symmetric_lemma #c #r);
Classical.forall_intro_3 (ncpoly_eq_is_transitive_lemma #c #r);
let cm = poly_add_commutative_monoid r in
let gen_qw = poly_mul_mgen q w in
let mx_qw = matrix_seq gen_qw in
@hacklex
hacklex / MatrixIndexTransform.fst
Last active January 26, 2022 18:35
Fstar is having trouble with this if we were to remove "--z3cliopt 'smt.arith.nl=false'"
module MatrixIndexTransform
let ( *) (x y: int) : (t:int{(x>0 /\ y>0) ==> t>0}) = op_Multiply x y
let under (k: pos) = x:nat{x<k}
let flattened_index_is_under_flattened_size (m n: pos) (i: under m) (j: under n)
: Lemma ((((i*n)+j)) < m*n) = assert (i*n <= (m-1)*n)
let get_ij (m n: pos) (i:under m) (j: under n) : under (m*n) = flattened_index_is_under_flattened_size m n i j; i*n + j
@hacklex
hacklex / Bug.fst
Last active October 11, 2021 07:04
New FStar versions crash on this one with "out of memory"
module Bug
type binary_op (a:Type) = a -> a -> a
type unary_op (a:Type) = a -> a
type predicate (a:Type) = a -> bool
type binary_relation (a: Type) = a -> a -> bool
[@@"opaque_to_smt"]
let is_reflexive (#a:Type) (r: binary_relation a) = forall (x:a). x `r` x
[@@"opaque_to_smt"]