diff --git a/src/ppx_import.ml b/src/ppx_import.ml index 500e243..b6ed078 100644 --- a/src/ppx_import.ml +++ b/src/ppx_import.ml @@ -378,20 +378,27 @@ let type_declaration ~tool_name mapper type_decl = end | _ -> default_mapper.type_declaration mapper type_decl -let rec psig_of_tsig ~subst ?(trec=[]) tsig = +let rec cut_tsig_block_of_rec_types accu tsig = + match tsig with + | Sig_type (id, ttype_decl, Trec_next) :: rest -> + cut_tsig_block_of_rec_types ((id, ttype_decl) :: accu) rest + | _ -> + (List.rev accu, tsig) + +let rec psig_of_tsig ~subst tsig = match tsig with - | (Sig_type (_, _, Trec_first) | _) :: _ when trec <> [] -> - let psig_desc = Psig_type(Recursive, trec) in - { psig_desc; psig_loc = Location.none } :: psig_of_tsig ~subst tsig | Sig_type (id, ttype_decl, rec_flag) :: rest -> - let ptype_decl = ptype_decl_of_ttype_decl ~manifest:None ~subst (Location.mknoloc (Ident.name id)) ttype_decl in - begin match rec_flag with - | Trec_not -> - let psig_desc = Psig_type(Nonrecursive, [ptype_decl]) in + let accu = [(id, ttype_decl)] in + let (rec_flag, (block, rest)) = + match rec_flag with + | Trec_not -> (Nonrecursive, (accu, rest)) + | Trec_first -> (Recursive, cut_tsig_block_of_rec_types accu rest) + | Trec_next -> assert false in + let block = block |> List.map (fun (id, ttype_decl) -> + ptype_decl_of_ttype_decl ~manifest:None ~subst + (Location.mknoloc (Ident.name id)) ttype_decl) in + let psig_desc = Psig_type(rec_flag, block) in { psig_desc; psig_loc = Location.none } :: psig_of_tsig ~subst rest - | Trec_first | Trec_next -> - psig_of_tsig ~subst ~trec:(ptype_decl :: trec) rest - end | Sig_value (id, { val_type; val_kind; val_loc; val_attributes }) :: rest -> let pval_prim = match val_kind with diff --git a/src_test/stuff.ml b/src_test/stuff.ml index 0c441a1..5511f32 100644 --- a/src_test/stuff.ml +++ b/src_test/stuff.ml @@ -20,3 +20,8 @@ module MI = struct end open MI type nonrec i = I of i + +module type S_rec = sig + type t = A of u + and u = B of t +end diff --git a/src_test/test_ppx_import.ml b/src_test/test_ppx_import.ml index 1dbd849..1baf6d4 100644 --- a/src_test/test_ppx_import.ml +++ b/src_test/test_ppx_import.ml @@ -11,6 +11,7 @@ type 'b g' = [%import: 'b Stuff.g] type h = [%import: Stuff.h] module MI = Stuff.MI type i = [%import: Stuff.i] +module type S_rec = [%import: (module Stuff.S_rec)] let test_constr _ctxt = ignore ([A1; A2 "a"]);