Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- diff --git a/typing/typemod.ml b/typing/typemod.ml
- index 6273774..2aea121 100644
- --- a/typing/typemod.ml
- +++ b/typing/typemod.ml
- @@ -284,25 +284,25 @@ let map_rec fn decls rem =
- | [] -> rem
- | d1 :: dl -> fn Trec_first d1 :: map_end (fn Trec_next) dl rem
- -let map_rec' = map_rec
- -(*
- -let rec map_rec' fn decls rem =
- +let map_rec_type ~rec_flag fn decls rem =
- match decls with
- - | (id,_ as d1) :: dl when Btype.is_row_name (Ident.name id) ->
- - fn Trec_not d1 :: map_rec' fn dl rem
- - | _ -> map_rec fn decls rem
- -*)
- + | [] -> rem
- + | d1 :: dl ->
- + let first =
- + match rec_flag with
- + | Recursive -> Trec_first
- + | Nonrecursive -> Trec_not
- + in
- + fn first d1 :: map_end (fn Trec_next) dl rem
- -let rec map_rec'' fn decls rem =
- +let rec map_rec_type_with_row_types ~rec_flag fn decls rem =
- match decls with
- - | d1 :: dl when Btype.is_row_name (Ident.name d1.typ_id) ->
- - fn Trec_not d1 :: map_rec'' fn dl rem
- - | _ -> map_rec fn decls rem
- -
- -let maybe_rec rec_flag k fn decls rem =
- - match rec_flag with
- - | Recursive -> k fn decls rem
- - | Nonrecursive -> map_end (fn Trec_not) decls rem
- + | [] -> rem
- + | d1 :: dl ->
- + if Btype.is_row_name (Ident.name d1.typ_id) then
- + fn Trec_not d1 :: map_rec_type_with_row_types ~rec_flag fn dl rem
- + else
- + map_rec_type ~rec_flag fn decls rem
- (* Add type extension flags to extension contructors *)
- let map_ext fn exts rem =
- @@ -352,10 +352,10 @@ and approx_sig env ssg =
- [] -> []
- | item :: srem ->
- match item.psig_desc with
- - | Psig_type (rf, sdecls) ->
- + | Psig_type (rec_flag, sdecls) ->
- let decls = Typedecl.approx_type_decl env sdecls in
- let rem = approx_sig env srem in
- - maybe_rec rf map_rec'
- + map_rec_type ~rec_flag
- (fun rs (id, info) -> Sig_type(id, info, rs)) decls rem
- | Psig_module pmd ->
- let md = approx_module_declaration env pmd in
- @@ -574,8 +574,8 @@ and transl_signature env sg =
- let (decls, newenv) = Typedecl.transl_type_decl env rec_flag sdecls in
- let (trem, rem, final_env) = transl_sig newenv srem in
- mksig (Tsig_type (rec_flag, decls)) env loc :: trem,
- - maybe_rec rec_flag map_rec'' (fun rs td ->
- - Sig_type(td.typ_id, td.typ_type, rs)) decls rem,
- + map_rec_type_with_row_types ~rec_flag
- + (fun rs td -> Sig_type(td.typ_id, td.typ_type, rs)) decls rem,
- final_env
- | Psig_typext styext ->
- let (tyext, newenv) =
- @@ -1246,7 +1246,7 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
- sdecls;
- let (decls, newenv) = Typedecl.transl_type_decl env rec_flag sdecls in
- Tstr_type (rec_flag, decls),
- - maybe_rec rec_flag map_rec''
- + map_rec_type_with_row_types ~rec_flag
- (fun rs info -> Sig_type(info.typ_id, info.typ_type, rs))
- decls [],
- enrich_type_decls anchor decls env newenv
Add Comment
Please, Sign In to add comment