Skip to content

Commit

Permalink
Merge pull request #25 from camlspotter/jun@gen_wf_preambles
Browse files Browse the repository at this point in the history
Apply [@gen_wf] conversions to preambles
  • Loading branch information
westpaddy authored Mar 5, 2024
2 parents 26e900b + 3d7deae commit 95f89f5
Show file tree
Hide file tree
Showing 3 changed files with 17 additions and 16 deletions.
4 changes: 4 additions & 0 deletions lib/error_monad.ml
Original file line number Diff line number Diff line change
Expand Up @@ -91,4 +91,8 @@ module List = struct

let iter_e (f : 'a -> unit iresult) (l : 'a list) : unit iresult =
fold_left_e (fun () x -> f x) () l

let concat_map_e f l =
let* xs = map_e f l in
return @@ concat xs
end
1 change: 1 addition & 0 deletions lib/error_monad.mli
Original file line number Diff line number Diff line change
Expand Up @@ -43,4 +43,5 @@ module List : sig

val map_e : ('a -> 'b iresult) -> 'a list -> 'b list iresult
val iter_e : ('a -> unit iresult) -> 'a list -> unit iresult
val concat_map_e : ('a -> 'b list iresult) -> 'a list -> 'b list iresult
end
28 changes: 12 additions & 16 deletions lib/gen_mlw.ml
Original file line number Diff line number Diff line change
Expand Up @@ -369,6 +369,16 @@ module Is_type_wf = struct
let* decls = List.map_e gen_decl type_decls in
return [ Dlogic decls ]
else return []

let add_wfs (decls : decl list) : decl list iresult =
(* Adds predicate [is_type_wf] for type decls with [@gen_wf] in the preambles *)
List.concat_map_e
(function
| Dtype dts as d ->
let* xs = gen_decls dts in
return ([ d ] @ xs)
| d -> return [ d ])
decls
end

let sort_wf (s : Sort.t) (p : expr) : term =
Expand Down Expand Up @@ -929,22 +939,7 @@ let convert_contract (epp : Sort.t list StringMap.t StringMap.t)
|> Option.to_iresult ~none:(error_of_fmt "")
in
let* param_wf = gen_param_wf ep in

let other_decls =
List.concat_map
(fun d ->
match d with
| Dtype dts -> (
[ d ]
@
(* Adds is_type_wf if [@gen_wf] is attached *)
match Is_type_wf.gen_decls dts with
| Error _e -> assert false
| Ok xs -> xs)
| _ -> [ d ])
c.c_other_decls
in

let* other_decls = Is_type_wf.add_wfs c.c_other_decls in
return
(* scope Contract .. *)
@@ Dscope
Expand Down Expand Up @@ -1079,6 +1074,7 @@ let convert_mlw (tzw : Tzw.t) =
| Decls ds -> return (ds @ tzw.tzw_preambles)
| _ -> error_with "invalid prembles: preambles must be list of declarations"
in
let* preambles = Is_type_wf.add_wfs preambles in
let module G = Generator (struct
let desc = { d_contracts; d_whyml = [] }
end) in
Expand Down

0 comments on commit 95f89f5

Please sign in to comment.