Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add high-level serializer for 3D types #127

Draft
wants to merge 3 commits into
base: master
Choose a base branch
from
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 4 additions & 0 deletions src/3d/InterpreterTarget.fst
Original file line number Diff line number Diff line change
Expand Up @@ -1020,6 +1020,7 @@ let print_binding mname (td:type_decl)
%s\n\
(type_%s %s)\n\
(coerce (_ by (T.norm [delta_only [`%%type_%s]]; T.trefl())) (parser_%s %s))\n\
(coerce (_ by (T.norm [delta_only [`%%type_%s]]; T.trefl())) (serializer_%s %s))\n\
%s\n\
%b\n\
(coerce (_ by %s) (validate_%s %s))\n\
Expand All @@ -1032,6 +1033,8 @@ let print_binding mname (td:type_decl)
root_name args
root_name
root_name args
root_name
root_name args
reader
td.allow_reading
coerce_validator root_name args
Expand All @@ -1051,6 +1054,7 @@ let print_binding mname (td:type_decl)
def';
(as_type_or_parser "type");
(as_type_or_parser "parser");
(as_type_or_parser "serializer");
validate_binding;
dtyp;
enum_typ_of_binding]
Expand Down
67 changes: 33 additions & 34 deletions src/3d/prelude/EverParse3d.Actions.Base.fst
Original file line number Diff line number Diff line change
Expand Up @@ -1132,13 +1132,13 @@ noextract
inline_for_extraction
let validate_nlist
(n:U32.t)
#wk
(#k:parser_kind true wk)
(#k:parser_kind true WeakKindStrongPrefix)
#t
(#p:parser k t)
(s:serializer p)
#inv #disj #l #ar
(v: validate_with_action_t p inv disj l ar)
: Tot (validate_with_action_t (parse_nlist n p) inv disj l false)
: Tot (validate_with_action_t (parse_nlist n s) inv disj l false)
= validate_weaken
#false #WeakKindStrongPrefix #(LowParse.Spec.FLData.parse_fldata_kind (U32.v n) LowParse.Spec.List.parse_list_kind) #(list t)
(validate_fldata_consumes_all n (validate_list v))
Expand Down Expand Up @@ -1189,14 +1189,14 @@ let validate_total_constant_size_no_read
inline_for_extraction noextract
let validate_nlist_total_constant_size_mod_ok
(n:U32.t)
#wk
(#k:parser_kind true wk)
(#k:parser_kind true WeakKindStrongPrefix)
(#t: Type)
(p:parser k t)
(s:serializer p)
inv
disj
l
: Pure (validate_with_action_t (parse_nlist n p) inv disj l true)
: Pure (validate_with_action_t (parse_nlist n s) inv disj l true)
(requires (
let open LP in
k.parser_kind_subkind == Some ParserStrong /\
Expand All @@ -1208,22 +1208,22 @@ let validate_nlist_total_constant_size_mod_ok
(ensures (fun _ -> True))
= [@inline_let]
let _ =
parse_nlist_total_fixed_size_kind_correct n p
parse_nlist_total_fixed_size_kind_correct n p s
in
validate_total_constant_size_no_read'
(LP.strengthen (LP.total_constant_size_parser_kind (U32.v n)) (parse_nlist n p))
(LP.strengthen (LP.total_constant_size_parser_kind (U32.v n)) (parse_nlist n s))
(Cast.uint32_to_uint64 n)
() inv disj l

inline_for_extraction noextract
let validate_nlist_constant_size_mod_ko
(n:U32.t)
(#wk: _)
(#k:parser_kind true wk)
(#k:parser_kind true WeakKindStrongPrefix)
#t
(p:parser k t)
(s:serializer p)
inv disj l
: Pure (validate_with_action_t (parse_nlist n p) inv disj l true)
: Pure (validate_with_action_t (parse_nlist n s) inv disj l true)
(requires (
let open LP in
k.parser_kind_subkind == Some ParserStrong /\
Expand All @@ -1237,12 +1237,12 @@ let validate_nlist_constant_size_mod_ko
let h = FStar.HyperStack.ST.get () in
[@inline_let]
let f () : Lemma
(requires (Some? (LP.parse (parse_nlist n p) (I.get_remaining input h))))
(requires (Some? (LP.parse (parse_nlist n s) (I.get_remaining input h))))
(ensures False)
= let sq = I.get_remaining input h in
let sq' = Seq.slice sq 0 (U32.v n) in
LowParse.Spec.List.list_length_constant_size_parser_correct p sq' ;
let Some (l, _) = LP.parse (parse_nlist n p) sq in
let Some (l, _) = LP.parse (parse_nlist n s) sq in
assert (U32.v n == FStar.List.Tot.length l `Prims.op_Multiply` k.LP.parser_kind_low) ;
FStar.Math.Lemmas.cancel_mul_mod (FStar.List.Tot.length l) k.LP.parser_kind_low ;
assert (U32.v n % k.LP.parser_kind_low == 0)
Expand All @@ -1255,12 +1255,12 @@ let validate_nlist_constant_size_mod_ko
inline_for_extraction noextract
let validate_nlist_total_constant_size'
(n:U32.t)
#wk
(#k:parser_kind true wk)
(#k:parser_kind true WeakKindStrongPrefix)
#t
(p:parser k t)
(s:serializer p)
inv disj l
: Pure (validate_with_action_t (parse_nlist n p) inv disj l true)
: Pure (validate_with_action_t (parse_nlist n s) inv disj l true)
(requires (
let open LP in
k.parser_kind_subkind == Some ParserStrong /\
Expand All @@ -1271,19 +1271,19 @@ let validate_nlist_total_constant_size'
(ensures (fun _ -> True))
= fun ctxt error_handler_fn input start_position -> // n is not an integer constant, so we need to eta-expand and swap fun and if
if n `U32.rem` U32.uint_to_t k.LP.parser_kind_low = 0ul
then validate_nlist_total_constant_size_mod_ok n p inv disj l ctxt error_handler_fn input start_position
else validate_nlist_constant_size_mod_ko n p inv disj l ctxt error_handler_fn input start_position
then validate_nlist_total_constant_size_mod_ok n p s inv disj l ctxt error_handler_fn input start_position
else validate_nlist_constant_size_mod_ko n p s inv disj l ctxt error_handler_fn input start_position

inline_for_extraction noextract
let validate_nlist_total_constant_size
(n_is_const: bool)
(n:U32.t)
#wk
(#k:parser_kind true wk)
(#k:parser_kind true WeakKindStrongPrefix)
(#t: Type)
(p:parser k t)
(s:serializer p)
inv disj l
: Pure (validate_with_action_t (parse_nlist n p) inv disj l true)
: Pure (validate_with_action_t (parse_nlist n s) inv disj l true)
(requires (
let open LP in
k.parser_kind_subkind = Some ParserStrong /\
Expand All @@ -1300,26 +1300,25 @@ let validate_nlist_total_constant_size
then U32.v n % k.LP.parser_kind_low = 0
else false
then
validate_nlist_total_constant_size_mod_ok n p inv disj l
validate_nlist_total_constant_size_mod_ok n p s inv disj l
else if
if n_is_const
then U32.v n % k.LP.parser_kind_low <> 0
else false
then
validate_nlist_constant_size_mod_ko n p inv disj l
validate_nlist_constant_size_mod_ko n p s inv disj l
else
validate_nlist_total_constant_size' n p inv disj l
validate_nlist_total_constant_size' n p s inv disj l

noextract
inline_for_extraction
let validate_nlist_constant_size_without_actions
(n_is_const: bool)
(n:U32.t)
#wk
(#k:parser_kind true wk)
#t (#p:parser k t) #inv #disj #l #ar
(#k:parser_kind true WeakKindStrongPrefix)
#t (#p:parser k t) (s:serializer p) #inv #disj #l #ar
(v: validate_with_action_t p inv disj l ar)
: Tot (validate_with_action_t (parse_nlist n p) inv disj l false)
: Tot (validate_with_action_t (parse_nlist n s) inv disj l false)
=
if
let open LP in
Expand All @@ -1328,18 +1327,18 @@ let validate_nlist_constant_size_without_actions
k.parser_kind_metadata = Some ParserKindMetadataTotal &&
k.parser_kind_low < 4294967296
then
validate_drop (validate_nlist_total_constant_size n_is_const n p inv disj l)
validate_drop (validate_nlist_total_constant_size n_is_const n p s inv disj l)
else
validate_nlist n v
validate_nlist n s v

#push-options "--z3rlimit_factor 16 --z3cliopt smt.arith.nl=false"
#restart-solver

noextract inline_for_extraction
let validate_t_at_most
(n:U32.t) #nz #wk (#k:parser_kind nz wk) (#t:_) (#p:parser k t)
(n:U32.t) #nz (#k:parser_kind nz WeakKindStrongPrefix) (#t:_) (#p:parser k t) s
#inv #disj #l #ar (v:validate_with_action_t p inv disj l ar)
: Tot (validate_with_action_t (parse_t_at_most n p) inv disj l false)
: Tot (validate_with_action_t (parse_t_at_most n s) inv disj l false)
= fun ctxt error_handler_fn input input_length start_position ->
[@inline_let] let pos = start_position in
let h = HST.get () in
Expand Down Expand Up @@ -1377,10 +1376,10 @@ let validate_t_at_most

noextract inline_for_extraction
let validate_t_exact
(n:U32.t) #nz #wk (#k:parser_kind nz wk) (#t:_) (#p:parser k t)
(n:U32.t) #nz (#k:parser_kind nz WeakKindStrongPrefix) (#t:_) (#p:parser k t) s
#inv #disj #l #ar
(v:validate_with_action_t p inv disj l ar)
: validate_with_action_t (parse_t_exact n p) inv disj l false
: validate_with_action_t (parse_t_exact n s) inv disj l false
= fun ctxt error_handler_fn input input_length start_position ->
[@inline_let] let pos = start_position in
let h = HST.get () in
Expand Down
24 changes: 12 additions & 12 deletions src/3d/prelude/EverParse3d.Actions.Base.fsti
Original file line number Diff line number Diff line change
Expand Up @@ -526,61 +526,61 @@ val validate_ite
noextract inline_for_extraction
val validate_nlist
(n:U32.t)
(#wk: _)
(#k:parser_kind true wk)
(#k:parser_kind true WeakKindStrongPrefix)
(#[@@@erasable] t:Type)
(#[@@@erasable] p:parser k t)
((*[@@@erasable]*) s:serializer p)
(#[@@@erasable] inv:slice_inv)
(#[@@@erasable] disj:disjointness_pre)
(#[@@@erasable] l:eloc)
(#allow_reading:bool)
(v: validate_with_action_t p inv disj l allow_reading)
: validate_with_action_t (parse_nlist n p) inv disj l false
: validate_with_action_t (parse_nlist n s) inv disj l false

noextract inline_for_extraction
val validate_nlist_constant_size_without_actions
(n_is_const: bool)
(n:U32.t)
(#wk: _)
(#k:parser_kind true wk)
(#k:parser_kind true WeakKindStrongPrefix)
(#[@@@erasable] t:Type)
(#[@@@erasable] p:parser k t)
((*[@@@erasable]*) s:serializer p)
(#[@@@erasable] inv:slice_inv)
(#[@@@erasable] disj:disjointness_pre)
(#[@@@erasable] l:eloc)
(#allow_reading:bool)
(v: validate_with_action_t p inv disj l allow_reading)
: Tot (validate_with_action_t (parse_nlist n p) inv disj l false)
: Tot (validate_with_action_t (parse_nlist n s) inv disj l false)

noextract inline_for_extraction
val validate_t_at_most
(n:U32.t)
(#nz: _)
(#wk: _)
(#k:parser_kind nz wk)
(#k:parser_kind nz WeakKindStrongPrefix)
(#[@@@erasable] t:Type)
(#[@@@erasable] p:parser k t)
((*[@@@erasable]*) s:serializer p)
(#[@@@erasable] inv:slice_inv)
(#[@@@erasable] disj:disjointness_pre)
(#[@@@erasable] l:eloc)
(#ar:_)
(v:validate_with_action_t p inv disj l ar)
: Tot (validate_with_action_t (parse_t_at_most n p) inv disj l false)
: Tot (validate_with_action_t (parse_t_at_most n s) inv disj l false)

noextract inline_for_extraction
val validate_t_exact
(n:U32.t)
(#nz:bool)
(#wk: _)
(#k:parser_kind nz wk)
(#k:parser_kind nz WeakKindStrongPrefix)
(#[@@@erasable] t:Type)
(#[@@@erasable] p:parser k t)
((*[@@@erasable]*) s:serializer p)
(#[@@@erasable] inv:slice_inv)
(#[@@@erasable] disj:disjointness_pre)
(#[@@@erasable] l:eloc)
(#ar:_)
(v:validate_with_action_t p inv disj l ar)
: Tot (validate_with_action_t (parse_t_exact n p) inv disj l false)
: Tot (validate_with_action_t (parse_t_exact n s) inv disj l false)

inline_for_extraction noextract
val validate_with_comment
Expand Down
Loading
Loading