SHARE
TWEET

Untitled

a guest Feb 16th, 2019 69 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. diff --git a/typing/typemod.ml b/typing/typemod.ml
  2. index 6273774..2aea121 100644
  3. --- a/typing/typemod.ml
  4. +++ b/typing/typemod.ml
  5. @@ -284,25 +284,25 @@ let map_rec fn decls rem =
  6.    | [] -> rem
  7.    | d1 :: dl -> fn Trec_first d1 :: map_end (fn Trec_next) dl rem
  8.  
  9. -let map_rec' = map_rec
  10. -(*
  11. -let rec map_rec' fn decls rem =
  12. +let map_rec_type ~rec_flag fn decls rem =
  13.    match decls with
  14. -  | (id,_ as d1) :: dl when Btype.is_row_name (Ident.name id) ->
  15. -      fn Trec_not d1 :: map_rec' fn dl rem
  16. -  | _ -> map_rec fn decls rem
  17. -*)
  18. +  | [] -> rem
  19. +  | d1 :: dl ->
  20. +      let first =
  21. +        match rec_flag with
  22. +        | Recursive -> Trec_first
  23. +        | Nonrecursive -> Trec_not
  24. +      in
  25. +      fn first d1 :: map_end (fn Trec_next) dl rem
  26.  
  27. -let rec map_rec'' fn decls rem =
  28. +let rec map_rec_type_with_row_types ~rec_flag fn decls rem =
  29.    match decls with
  30. -  | d1 :: dl when Btype.is_row_name (Ident.name d1.typ_id) ->
  31. -      fn Trec_not d1 :: map_rec'' fn dl rem
  32. -  | _ -> map_rec fn decls rem
  33. -
  34. -let maybe_rec rec_flag k fn decls rem =
  35. -  match rec_flag with
  36. -  | Recursive -> k fn decls rem
  37. -  | Nonrecursive -> map_end (fn Trec_not) decls rem
  38. +  | [] -> rem
  39. +  | d1 :: dl ->
  40. +      if Btype.is_row_name (Ident.name d1.typ_id) then
  41. +        fn Trec_not d1 :: map_rec_type_with_row_types ~rec_flag fn dl rem
  42. +      else
  43. +        map_rec_type ~rec_flag fn decls rem
  44.  
  45.  (* Add type extension flags to extension contructors *)
  46.  let map_ext fn exts rem =
  47. @@ -352,10 +352,10 @@ and approx_sig env ssg =
  48.      [] -> []
  49.    | item :: srem ->
  50.        match item.psig_desc with
  51. -      | Psig_type (rf, sdecls) ->
  52. +      | Psig_type (rec_flag, sdecls) ->
  53.            let decls = Typedecl.approx_type_decl env sdecls in
  54.            let rem = approx_sig env srem in
  55. -          maybe_rec rf map_rec'
  56. +          map_rec_type ~rec_flag
  57.              (fun rs (id, info) -> Sig_type(id, info, rs)) decls rem
  58.        | Psig_module pmd ->
  59.            let md = approx_module_declaration env pmd in
  60. @@ -574,8 +574,8 @@ and transl_signature env sg =
  61.              let (decls, newenv) = Typedecl.transl_type_decl env rec_flag sdecls in
  62.              let (trem, rem, final_env) = transl_sig newenv srem in
  63.              mksig (Tsig_type (rec_flag, decls)) env loc :: trem,
  64. -            maybe_rec rec_flag map_rec'' (fun rs td ->
  65. -                Sig_type(td.typ_id, td.typ_type, rs)) decls rem,
  66. +            map_rec_type_with_row_types ~rec_flag
  67. +              (fun rs td -> Sig_type(td.typ_id, td.typ_type, rs)) decls rem,
  68.              final_env
  69.          | Psig_typext styext ->
  70.              let (tyext, newenv) =
  71. @@ -1246,7 +1246,7 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope =
  72.            sdecls;
  73.          let (decls, newenv) = Typedecl.transl_type_decl env rec_flag sdecls in
  74.          Tstr_type (rec_flag, decls),
  75. -        maybe_rec rec_flag map_rec''
  76. +        map_rec_type_with_row_types ~rec_flag
  77.            (fun rs info -> Sig_type(info.typ_id, info.typ_type, rs))
  78.            decls [],
  79.          enrich_type_decls anchor decls env newenv
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top