Skip to content

Commit 907f16f

Browse files
jvanbrueggejvanbruegge
committed
Fix composition for types that have lives and frees
1 parent 74c7ea2 commit 907f16f

File tree

3 files changed

+196
-83
lines changed

3 files changed

+196
-83
lines changed

‎Tools/bmv_monad_def.ML‎

Lines changed: 167 additions & 73 deletions
Original file line numberDiff line numberDiff line change
@@ -379,39 +379,42 @@ fun mk_bmv_monad_axioms ops bd Sb Injs Vrs bmv_ops lthy =
379379
) ops Injs Sb Vrs;
380380
in axioms end;
381381

382-
fun mk_param_axioms (model: 'a bmv_monad_model) lthy = @{map 5} (fn T => fn Sb => fn Injs => fn Vrs => Option.map (fn param =>
382+
fun mk_param_axiom Map Supps Sb Injs Vrs bd lthy =
383383
let
384+
val (f_Ts, T) = split_last (binder_types (fastype_of Map));
385+
val (lives, lives') = split_list (map dest_funT f_Ts);
386+
384387
val (Cs, _) = lthy
385-
|> mk_TFrees (length (#lives model));
388+
|> mk_TFrees (length lives);
386389
val ((((fs, gs), rhos), x), _) = lthy
387-
|> mk_Frees "f" (map2 (curry (op-->)) (#lives model) (#lives' model))
388-
||>> mk_Frees "g" (map2 (curry (op-->)) (#lives' model) Cs)
390+
|> mk_Frees "f" (map2 (curry (op-->)) lives lives')
391+
||>> mk_Frees "g" (map2 (curry (op-->)) lives' Cs)
389392
||>> mk_Frees "\<rho>" (map fastype_of Injs)
390393
||>> apfst hd o mk_Frees "x" [T];;
391394

392-
val Map_id = Term.subst_atomic_types (#lives' model ~~ #lives model) (
395+
val Map_id = Term.subst_atomic_types (lives' ~~ lives) (
393396
mk_Trueprop_eq (
394-
Term.list_comb (#Map param, map HOLogic.id_const (#lives model)), HOLogic.id_const T
397+
Term.list_comb (Map, map HOLogic.id_const lives), HOLogic.id_const T
395398
)
396399
);
397400

398401
val Map_comp = fold_rev Logic.all (fs @ gs) (mk_Trueprop_eq (
399402
HOLogic.mk_comp (Term.list_comb (
400-
Term.subst_atomic_types ((#lives model @ #lives' model) ~~ (#lives' model @ Cs)) (#Map param), gs
401-
), Term.list_comb (#Map param, fs)),
402-
Term.list_comb (Term.subst_atomic_types (#lives' model ~~ Cs) (#Map param), map2 (curry HOLogic.mk_comp) gs fs)
403+
Term.subst_atomic_types ((lives @ lives') ~~ (lives' @ Cs)) Map, gs
404+
), Term.list_comb (Map, fs)),
405+
Term.list_comb (Term.subst_atomic_types (lives' ~~ Cs) Map, map2 (curry HOLogic.mk_comp) gs fs)
403406
));
404407

405408
val Supp_Maps = map2 (fn Supp => fn f =>
406409
fold_rev Logic.all (fs @ [x]) (mk_Trueprop_eq (
407-
Term.subst_atomic_types (#lives model ~~ #lives' model) Supp $ (Term.list_comb (#Map param, fs) $ x),
410+
Term.subst_atomic_types (lives ~~ lives') Supp $ (Term.list_comb (Map, fs) $ x),
408411
mk_image f $ (Supp $ x)
409412
))
410-
) (#Supps param) fs;
413+
) Supps fs;
411414

412415
val Supp_bds = map (fn Supp => Logic.all x (HOLogic.mk_Trueprop (
413-
mk_ordLess (mk_card_of (Supp $ x)) (#bd model)
414-
))) (#Supps param);
416+
mk_ordLess (mk_card_of (Supp $ x)) bd
417+
))) Supps;
415418

416419
val (gs', _) = lthy
417420
|> mk_Frees "g" (map fastype_of fs);
@@ -422,23 +425,23 @@ fun mk_param_axioms (model: 'a bmv_monad_model) lthy = @{map 5} (fn T => fn Sb =
422425
HOLogic.mk_Trueprop (HOLogic.mk_mem (a, Supp $ x)),
423426
mk_Trueprop_eq (f $ a, g $ a)
424427
)) end
425-
) (#Supps param) fs gs') (mk_Trueprop_eq (
426-
Term.list_comb (#Map param, fs) $ x,
427-
Term.list_comb (#Map param, gs') $ x
428+
) Supps fs gs') (mk_Trueprop_eq (
429+
Term.list_comb (Map, fs) $ x,
430+
Term.list_comb (Map, gs') $ x
428431
)));
429432

430433
val Map_Sb = fold_rev Logic.all (fs @ rhos) (
431434
fold_rev (curry Logic.mk_implies) (mk_small_prems rhos Injs) (mk_Trueprop_eq (
432-
HOLogic.mk_comp (Term.list_comb (#Map param, fs), Term.list_comb (Sb, rhos)),
435+
HOLogic.mk_comp (Term.list_comb (Map, fs), Term.list_comb (Sb, rhos)),
433436
HOLogic.mk_comp (Term.list_comb (
434-
Term.subst_atomic_types (#lives model ~~ #lives' model) Sb, rhos
435-
), Term.list_comb (#Map param, fs))
437+
Term.subst_atomic_types (lives ~~ lives') Sb, rhos
438+
), Term.list_comb (Map, fs))
436439
))
437440
);
438441

439442
val Map_Vrs = map (map (Option.map (fn Vrs =>
440443
fold_rev Logic.all (fs @ [x]) (mk_Trueprop_eq (
441-
Term.subst_atomic_types (#lives model ~~ #lives' model) Vrs $ (Term.list_comb (#Map param, fs) $ x),
444+
Term.subst_atomic_types (lives ~~ lives') Vrs $ (Term.list_comb (Map, fs) $ x),
442445
Vrs $ x
443446
))
444447
))) Vrs;
@@ -447,10 +450,10 @@ fun mk_param_axioms (model: 'a bmv_monad_model) lthy = @{map 5} (fn T => fn Sb =
447450
fold_rev Logic.all (rhos @ [x]) (mk_Trueprop_eq (
448451
Supp $ (Term.list_comb (Sb, rhos) $ x), Supp $ x
449452
))
450-
) (#Supps param);
453+
) Supps;
451454
in {
452-
Map = #Map param,
453-
Supps = #Supps param,
455+
Map = Map,
456+
Supps = Supps,
454457
axioms = {
455458
Map_id = Map_id,
456459
Map_comp = Map_comp,
@@ -461,8 +464,7 @@ fun mk_param_axioms (model: 'a bmv_monad_model) lthy = @{map 5} (fn T => fn Sb =
461464
Map_Sb = Map_Sb,
462465
Supp_Sb = Supp_Sb,
463466
Map_Vrs = Map_Vrs
464-
}: term bmv_monad_param end
465-
)) (#ops model) (#Sbs model) (#Injs model) (#Vrs model) (#params model);
467+
}: term bmv_monad_param end;
466468

467469
val smart_max_inline_term_size = 25; (*FUDGE*)
468470

@@ -601,7 +603,9 @@ fun prove_axioms (model: (Proof.context -> tactic) bmv_monad_model) defs lthy =
601603

602604
fun prove_params (model: (Proof.context -> tactic) bmv_monad_model) defs lthy =
603605
let
604-
val goals = mk_param_axioms model lthy;
606+
val goals = @{map 4} (fn Sb => fn Vrs => fn Injs => Option.map (fn param =>
607+
mk_param_axiom (#Map param) (#Supps param) Sb Injs Vrs (#bd model) lthy
608+
)) (#Sbs model) (#Vrs model) (#Injs model) (#params model)
605609
val tacs' = map (Option.map (morph_bmv_monad_param Morphism.identity (fn tac => fn goal =>
606610
Goal.prove_sorry lthy [] [] goal (fn {context=ctxt, ...} =>
607611
Local_Defs.unfold0_tac ctxt defs THEN tac ctxt
@@ -734,23 +738,31 @@ fun compose_bmv_monad qualify (outer : bmv_monad) (inners : (bmv_monad, typ) eit
734738

735739
val filter_bmvs = map_filter (fn Inl x => SOME x | _ => NONE);
736740

737-
val frees = fold (fn a =>
738-
let val (n, s) = dest_TFree a
739-
in Symtab.map_default (n, s) (curry (Sign.inter_sort (Proof_Context.theory_of lthy)) s) end
740-
) (frees_of_bmv_monad outer @ maps frees_of_bmv_monad (filter_bmvs inners)) Symtab.empty;
741+
fun vars_of_bmv_monad bmv = @{fold 2} (fn T => fn param => case param of
742+
SOME param => Term.add_tfrees (#Map param)
743+
| NONE => Term.add_tfreesT T
744+
) (ops_of_bmv_monad bmv) (params_of_bmv_monad bmv) [];
745+
746+
fun sum_collapse (Inl x) = x
747+
| sum_collapse (Inr x) = x
748+
749+
val vars = fold (fn (n, s) =>
750+
Symtab.map_default (n, s) (curry (Sign.inter_sort (Proof_Context.theory_of lthy)) s)
751+
) (vars_of_bmv_monad outer @ maps (
752+
sum_collapse o map_sum vars_of_bmv_monad (fn T => Term.add_tfreesT T [])
753+
) inners) Symtab.empty;
741754

742755
fun mk_sign_morph bmv =
743-
morph_bmv_monad (MRBNF_Util.subst_typ_morphism (map (fn a =>
744-
let val (n, _) = dest_TFree a;
745-
in (a, TFree (n, the (Symtab.lookup frees n))) end
746-
) (frees_of_bmv_monad bmv))) bmv;
756+
morph_bmv_monad (MRBNF_Util.subst_typ_morphism (map (fn (n, s) =>
757+
(TFree (n, s), TFree (n, the (Symtab.lookup vars n)))
758+
) (vars_of_bmv_monad bmv))) bmv;
747759
fun mk_T_morph T =
748-
let val vars = Term.add_tfreesT T [];
749-
in Term.typ_subst_atomic (map (fn x =>
750-
(TFree x, the_default (TFree x) (Option.map (TFree o pair (fst x)) (Symtab.lookup frees (fst x))))
751-
) vars) T end
760+
Term.typ_subst_atomic (map (fn x =>
761+
(TFree x, the_default (TFree x) (Option.map (TFree o pair (fst x)) (Symtab.lookup vars (fst x))))
762+
) (Term.add_tfreesT T [])) T
752763
val outer = mk_sign_morph outer;
753764
val inners = map (map_sum mk_sign_morph mk_T_morph) inners;
765+
val inners' = filter_bmvs inners;
754766

755767
val bmvs = Typtab.make_distinct (flat (map (fn bmv => (#ops bmv ~~
756768
((#params bmv) ~~ (#Injs bmv) ~~ (#Sbs bmv) ~~ (#Vrs bmv) ~~ map SOME (#axioms bmv) ~~ replicate (length (#Sbs bmv)) (SOME bmv))
@@ -848,6 +860,7 @@ fun compose_bmv_monad qualify (outer : bmv_monad) (inners : (bmv_monad, typ) eit
848860
) Injs bmvs)));
849861

850862
fun pick xs = nth xs (leader_of_bmv_monad outer)
863+
851864
val ops = add_ops (the (pick outer_ops')) (the (pick Injs)) bmvs;
852865

853866
val bmv_ops = map_filter (fn T => case Typtab.lookup bmvs T of
@@ -871,8 +884,6 @@ fun compose_bmv_monad qualify (outer : bmv_monad) (inners : (bmv_monad, typ) eit
871884

872885
val ops' = subtract (fn (bmv, T) => hd (ops_of_bmv_monad bmv) = T) bmv_ops ops;
873886

874-
val inners' = filter_bmvs inners;
875-
876887
val idxs = map (fn T => find_index (curry (op=) T) ops) ops';
877888
val Vrs = map (the o nth Vrs) idxs;
878889
val Injs = map (the o nth Injs) idxs;
@@ -1048,49 +1059,125 @@ fun pbmv_monad_cmd ((((((b, ops), Sbs), Injs), Vrs), param_opt), bd) lthy =
10481059
val goals = mk_bmv_monad_axioms ops bd Sbs Injs Vrs [] lthy;
10491060

10501061
val vars = distinct (op=) (map TFree (fold Term.add_tfreesT ops []));
1051-
val lives = [];
1062+
1063+
val names_lthy = lthy
1064+
|> fold Variable.declare_typ vars
1065+
1066+
val (lives, lives', params) = case param_opt of
1067+
NONE => ([], [], replicate (length ops) NONE)
1068+
| SOME (Maps, Suppss) =>
1069+
let
1070+
val Maps = map (fn "_" => NONE | s => SOME (Syntax.read_term lthy s)) Maps;
1071+
val Suppss = map (fn [] => NONE | xs => SOME (map (Syntax.read_term lthy) xs)) Suppss;
1072+
1073+
val lives = the_default [] (Option.map (fn Map =>
1074+
let
1075+
val Map = Term.subst_atomic_types (map (apply2 TFree) (
1076+
Term.add_tfreesT (snd (split_last (binder_types (fastype_of Map)))) []
1077+
~~ Term.add_tfreesT (hd ops) []
1078+
)) Map;
1079+
in map (fst o dest_funT) (fst (split_last (binder_types (fastype_of Map)))) end
1080+
) (hd Maps));
1081+
val (lives', _) = names_lthy
1082+
|> mk_TFrees' (map Type.sort_of_atyp lives);
1083+
1084+
val Maps = map2 (fn T => Option.map (fn Map =>
1085+
let
1086+
val l' = map (snd o dest_funT) (fst (split_last (binder_types (fastype_of Map))));
1087+
val TA = snd (split_last (binder_types (fastype_of Map)));
1088+
val Map = Term.subst_atomic_types (map (apply2 TFree) (
1089+
Term.add_tfreesT TA [] ~~ Term.add_tfreesT T []
1090+
)) Map;
1091+
val TA = snd (split_last (binder_types (fastype_of Map)));
1092+
val TB = body_type (fastype_of Map);
1093+
val old_vars = map TFree (Term.add_tfreesT TB []);
1094+
in Term.subst_atomic_types (
1095+
(l' ~~ lives') @ (
1096+
subtract (op=) l' old_vars ~~ subtract (op=) lives (map TFree (Term.add_tfreesT TA []))
1097+
)
1098+
) Map end
1099+
)) ops (Maps @ replicate (length ops - length Maps) NONE);
1100+
1101+
val Suppss = map2 (fn T => Option.map (map (fn Supp => Term.subst_atomic_types (map (apply2 TFree) (
1102+
Term.add_tfreesT (hd (binder_types (fastype_of Supp))) [] ~~ Term.add_tfreesT T []
1103+
)) Supp))) ops (Suppss @ replicate (length ops - length Suppss) NONE);
1104+
1105+
in (lives, lives', @{map 5} (fn Sb => fn Injs => fn Vrs => @{map_option 2} (fn Map => fn Supps =>
1106+
mk_param_axiom Map Supps Sb Injs Vrs bd lthy
1107+
)) Sbs Injs Vrs Maps Suppss
1108+
) end;
10521109

10531110
fun after_qed thmss lthy =
10541111
let
10551112
val thms = map hd thmss;
1113+
val bd_irco = hd thms;
1114+
1115+
val chop_many = fold_map (fold_map (
1116+
fn NONE => (fn thms => (NONE, thms))
1117+
| SOME _ => fn thms => (SOME (hd thms), tl thms)
1118+
));
1119+
1120+
val ((axioms, params), _) = apfst split_list (@{fold_map 2} (fn goal => fn param => fn thms =>
1121+
let
1122+
val (((((((Sb_Inj, Sb_comp_Injs), Sb_comp), Vrs_bds), Vrs_Injs), Vrs_Sbs), Sb_cong), thms) = thms
1123+
|> apfst hd o chop 1
1124+
||>> chop (length (#Sb_comp_Injs goal))
1125+
||>> apfst hd o chop 1
1126+
||>> chop_many (#Vrs_bds goal)
1127+
||>> chop_many (#Vrs_Injs goal)
1128+
||>> chop_many (#Vrs_Sbs goal)
1129+
||>> apfst hd o chop 1;
1130+
val (param, thms) = case param of NONE => (NONE, thms) | SOME goals =>
1131+
let val ((((((((Map_id, Map_comp), Supp_maps), Supp_bds), Map_cong), Map_Sb), Supp_Sb), Map_Vrs), thms) = thms
1132+
|> apfst hd o chop 1
1133+
||>> apfst hd o chop 1
1134+
||>> chop (length (#Supps goals))
1135+
||>> chop (length (#Supps goals))
1136+
||>> apfst hd o chop 1
1137+
||>> apfst hd o chop 1
1138+
||>> chop (length (#Supps goals))
1139+
||>> chop_many (#Map_Vrs goals)
1140+
in (SOME ({
1141+
Map = #Map goals,
1142+
Supps = #Supps goals,
1143+
axioms = {
1144+
Map_id = Map_id,
1145+
Map_comp = Map_comp,
1146+
Supp_Map = Supp_maps,
1147+
Supp_bd = Supp_bds,
1148+
Map_cong = Map_cong
1149+
},
1150+
Map_Sb = Map_Sb,
1151+
Supp_Sb = Supp_Sb,
1152+
Map_Vrs = Map_Vrs
1153+
} : thm bmv_monad_param), thms) end;
1154+
in (({
1155+
Sb_Inj = Sb_Inj,
1156+
Sb_comp_Injs = Sb_comp_Injs,
1157+
Sb_comp = Sb_comp,
1158+
Vrs_bds = Vrs_bds,
1159+
Vrs_Injs = Vrs_Injs,
1160+
Vrs_Sbs = Vrs_Sbs,
1161+
Sb_cong = Sb_cong
1162+
}: thm bmv_monad_axioms, param), thms) end
1163+
) goals params (tl thms));
1164+
10561165
val model = {
10571166
ops = ops,
10581167
bd = bd,
10591168
var_class = @{class var}, (* TODO: change *)
10601169
leader = 0,
10611170
frees = frees,
1062-
lives = [],
1063-
lives' = [],
1171+
lives = lives,
1172+
lives' = lives',
10641173
deads = subtract (op=) (lives @ frees) vars,
10651174
bmv_ops = [],
1066-
params = replicate (length ops) NONE,
1175+
params = params,
10671176
Injs = Injs,
10681177
Sbs = Sbs,
10691178
Vrs = Vrs,
1070-
bd_infinite_regular_card_order = hd thms,
1071-
tacs = fst (fold_map (fn goal => fn thms =>
1072-
let
1073-
val chop_many = fold_map (fold_map (
1074-
fn NONE => (fn thms => (NONE, thms))
1075-
| SOME _ => fn thms => (SOME (hd thms), tl thms)
1076-
));
1077-
val ((((((Sb_Inj, Sb_comp_Injs), Sb_comp), Vrs_bds), Vrs_Injs), Vrs_Sbs), thms) = thms
1078-
|> apfst hd o chop 1
1079-
||>> chop (length (#Sb_comp_Injs goal))
1080-
||>> apfst hd o chop 1
1081-
||>> chop_many (#Vrs_bds goal)
1082-
||>> chop_many (#Vrs_Injs goal)
1083-
||>> chop_many (#Vrs_Sbs goal);
1084-
in ({
1085-
Sb_Inj = Sb_Inj,
1086-
Sb_comp_Injs = Sb_comp_Injs,
1087-
Sb_comp = Sb_comp,
1088-
Vrs_bds = Vrs_bds,
1089-
Vrs_Injs = Vrs_Injs,
1090-
Vrs_Sbs = Vrs_Sbs,
1091-
Sb_cong = hd thms
1092-
}: thm bmv_monad_axioms, thms) end
1093-
) goals (tl thms))
1179+
bd_infinite_regular_card_order = bd_irco,
1180+
tacs = axioms
10941181
} : thm bmv_monad_model;
10951182

10961183
val (bmv, lthy) = mk_bmv_monad BNF_Def.Smart_Inline (K BNF_Def.Note_Some) model lthy;
@@ -1099,10 +1186,14 @@ fun pbmv_monad_cmd ((((((b, ops), Sbs), Injs), Vrs), param_opt), bd) lthy =
10991186
in lthy end;
11001187
in Proof.theorem NONE after_qed (map (single o rpair []) (
11011188
[HOLogic.mk_Trueprop (mk_infinite_regular_card_order bd)]
1102-
@ maps (fn goal => #Sb_Inj goal :: #Sb_comp_Injs goal @ [#Sb_comp goal]
1189+
@ flat (map2 (fn goal => fn param => #Sb_Inj goal :: #Sb_comp_Injs goal @ [#Sb_comp goal]
11031190
@ maps (map_filter I) (#Vrs_bds goal @ #Vrs_Injs goal @ #Vrs_Sbs goal)
1104-
@ [#Sb_cong goal]
1105-
) goals
1191+
@ [#Sb_cong goal] @ the_default [] (Option.map (fn param =>
1192+
[#Map_id (#axioms param), #Map_comp (#axioms param)] @ #Supp_Map (#axioms param)
1193+
@ #Supp_bd (#axioms param) @ [#Map_cong (#axioms param), #Map_Sb param]
1194+
@ #Supp_Sb param @ maps (map_filter I) (#Map_Vrs param)
1195+
) param)
1196+
) goals params)
11061197
)) lthy
11071198
|> Proof.refine_singleton (Method.Basic (fn ctxt => Method.SIMPLE_METHOD (TRYALL (rtac ctxt refl))))
11081199
end;
@@ -1142,8 +1233,11 @@ val _ = Outer_Syntax.local_theory_to_proof @{command_keyword pbmv_monad}
11421233
Scan.repeat1 (Scan.unless (Parse.reserved "Map" || Parse.reserved "bd") (Parse.term || Parse.reserved "_"))
11431234
)) --
11441235
Scan.optional (
1145-
(Parse.reserved "Map" -- @{keyword ":"}) |-- Scan.repeat1 (Scan.unless (Parse.reserved "Supps") Parse.term) --|
1146-
(Parse.reserved "Supps" -- @{keyword ":"}) -- Parse.list (Scan.repeat1 (Scan.unless (Parse.reserved "bd") Parse.term))
1236+
(Parse.reserved "Map" -- @{keyword ":"}) |-- Parse.and_list1 (Parse.term || Parse.reserved "_") --|
1237+
(Parse.reserved "Supps" -- @{keyword ":"}) -- Parse.and_list1 (
1238+
Scan.repeat1 (Scan.unless (Parse.reserved "bd") Parse.term)
1239+
|| (Parse.reserved "_" >> K [])
1240+
)
11471241
>> SOME
11481242
) NONE --|
11491243
(Parse.reserved "bd" -- @{keyword ":"}) -- Parse.term

‎Tools/pbmv_monad_comp.ML‎

Lines changed: 13 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -36,16 +36,25 @@ fun pbmv_monad_of_typ _ _ _ _ (TFree x) accum = (SOME (mk_id_bmv_monad x), accum
3636
rev (map TFree (Term.add_tfreesT T []) @ map TVar (Term.add_tvarsT T [])) ~~ Ts
3737
)) bmv), (accum, lthy)) end
3838
else let
39-
(* TODO: outer with mixed/frees lives *)
4039
val name = Long_Name.base_name n;
4140

4241
fun qualify i =
4342
let val namei = name ^ nonzero_string_of_int i;
4443
in qualify' o Binding.qualify true namei end;
4544

46-
val qualifies = map qualify (1 upto length Ts);
47-
val (bmv_opts, (accum, lthy)) = @{fold_map 2} (pbmv_monad_of_typ optim const_policy inline_policy) qualifies Ts (accum, lthy)
48-
val bmvs = map2 (fn T => fn NONE => Inr T | SOME bmv => Inl bmv) Ts bmv_opts;
45+
val leader = BMV_Monad_Def.leader_of_bmv_monad bmv;
46+
val T = nth (BMV_Monad_Def.ops_of_bmv_monad bmv) leader;
47+
val bmv = BMV_Monad_Def.morph_bmv_monad (
48+
MRBNF_Util.subst_typ_morphism (snd (dest_Type T) ~~ Ts)
49+
) bmv;
50+
val bmv = BMV_Monad_Def.morph_bmv_monad (MRBNF_Util.subst_typ_morphism (
51+
BMV_Monad_Def.lives'_of_bmv_monad bmv ~~ BMV_Monad_Def.lives_of_bmv_monad bmv
52+
)) bmv;
53+
val live_Ts = BMV_Monad_Def.lives_of_bmv_monad bmv;
54+
55+
val qualifies = map qualify (1 upto length live_Ts);
56+
val (bmv_opts, (accum, lthy)) = @{fold_map 2} (pbmv_monad_of_typ optim const_policy inline_policy) qualifies live_Ts (accum, lthy)
57+
val bmvs = map2 (fn T => fn NONE => Inr T | SOME bmv => Inl bmv) live_Ts bmv_opts;
4958
in if exists Option.isSome bmv_opts then
5059
let val ((bmv, unfold_set), lthy) = BMV_Monad_Def.compose_bmv_monad (qualify 0) bmv bmvs lthy;
5160
in (SOME bmv, (unfold_set @ accum, lthy)) end

0 commit comments

Comments
 (0)