daily pastebin goal
19%
SHARE
TWEET

Untitled

a guest Feb 18th, 2019 67 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Index: typing/env.ml
  2. ===================================================================
  3. --- typing/env.ml   (revision 15965)
  4. +++ typing/env.ml   (working copy)
  5. @@ -122,14 +122,26 @@
  6.  module EnvTbl =
  7.    struct
  8.      (* A table indexed by identifier, with an extra slot to record usage. *)
  9. -    type 'a t = ('a * (unit -> unit)) Ident.tbl
  10. +    type 'a t =
  11. +      {
  12. +        current: ('a * (unit -> unit)) Ident.tbl;
  13. +        previous: 'a t option;
  14. +      }
  15.  
  16. -    let empty = Ident.empty
  17. +    let empty =
  18. +      {
  19. +        current = Ident.empty;
  20. +        previous = None;
  21. +      }
  22. +
  23.      let nothing = fun () -> ()
  24.  
  25. -    let already_defined s tbl =
  26. -      try ignore (Ident.find_name s tbl); true
  27. -      with Not_found -> false
  28. +    let rec already_defined s tbl =
  29. +      try ignore (Ident.find_name s tbl.current); true
  30. +      with Not_found ->
  31. +        match tbl.previous with
  32. +        | None -> false
  33. +        | Some tbl -> already_defined s tbl
  34.  
  35.      let add kind slot id x tbl ref_tbl =
  36.        let slot =
  37. @@ -141,29 +153,79 @@
  38.               f kind s (already_defined s ref_tbl)
  39.            )
  40.        in
  41. -      Ident.add id (x, slot) tbl
  42. +      {
  43. +        current = Ident.add id (x, slot) tbl.current;
  44. +        previous = tbl.previous;
  45. +      }
  46.  
  47.      let add_dont_track id x tbl =
  48. -      Ident.add id (x, nothing) tbl
  49. +      {
  50. +        current = Ident.add id (x, nothing) tbl.current;
  51. +        previous = tbl.previous;
  52. +      }
  53.  
  54. -    let find_same_not_using id tbl =
  55. -      fst (Ident.find_same id tbl)
  56. +    let rec find_same_not_using id tbl =
  57. +      try fst (Ident.find_same id tbl.current)
  58. +      with Not_found ->
  59. +        match tbl.previous with
  60. +        | None -> raise Not_found
  61. +        | Some tbl -> find_same_not_using id tbl
  62.  
  63. -    let find_same id tbl =
  64. -      let (x, slot) = Ident.find_same id tbl in
  65. -      slot ();
  66. -      x
  67. +    let rec find_same id tbl =
  68. +      try
  69. +        let (x, slot) = Ident.find_same id tbl.current in
  70. +        slot ();
  71. +        x
  72. +      with Not_found ->
  73. +        match tbl.previous with
  74. +        | None -> raise Not_found
  75. +        | Some tbl -> find_same id tbl
  76.  
  77. -    let find_name s tbl =
  78. -      let (x, slot) = Ident.find_name s tbl in
  79. -      slot ();
  80. -      x
  81. +    let rec find_name s tbl =
  82. +      try
  83. +        let (x, slot) = Ident.find_name s tbl.current in
  84. +        slot ();
  85. +        x
  86. +      with Not_found ->
  87. +        match tbl.previous with
  88. +        | None -> raise Not_found
  89. +        | Some tbl -> find_name s tbl
  90.  
  91. -    let find_all s tbl =
  92. -      Ident.find_all s tbl
  93. +    let rec find_all s tbl =
  94. +      let l = Ident.find_all s tbl.current in
  95. +      match tbl.previous with
  96. +      | None -> l
  97. +      | Some tbl -> l @ find_all s tbl
  98.  
  99. -    let fold_name f = Ident.fold_name (fun k (d,_) -> f k d)
  100. -    let keys tbl = Ident.fold_all (fun k _ accu -> k::accu) tbl []
  101. +    let rec fold_name f tbl acc =
  102. +      (* TODO: this is wrong, since duplicates are not removed! *)
  103. +      let acc =
  104. +        match tbl.previous with
  105. +        | None -> acc
  106. +        | Some tbl -> fold_name f tbl acc
  107. +      in
  108. +      Ident.fold_name (fun k (d,_) -> f k d) tbl.current acc
  109. +
  110. +    let rec keys tbl =
  111. +      let acc =
  112. +        match tbl.previous with
  113. +        | None -> []
  114. +        | Some tbl -> keys tbl
  115. +      in
  116. +      Ident.fold_all (fun k _ accu -> k::accu) tbl.current acc
  117. +
  118. +    let merge tbl1 tbl2 =
  119. +      assert(tbl1.previous == None);
  120. +      {
  121. +        current = tbl1.current;
  122. +        previous = Some tbl2;
  123. +      }
  124. +
  125. +    let rec iter f tbl =
  126. +      Ident.iter (fun id (d, _) -> f id d) tbl.current;
  127. +      match tbl.previous with
  128. +      | None -> ()
  129. +      | Some tbl -> iter f tbl
  130.    end
  131.  
  132.  type type_descriptions =
  133. @@ -763,6 +825,7 @@
  134.    | Lapply(l1, l2) ->
  135.        raise Not_found
  136.  
  137. +(*
  138.  let lookup_simple proj1 proj2 lid env =
  139.    match lid with
  140.      Lident s ->
  141. @@ -778,6 +841,7 @@
  142.        end
  143.    | Lapply(l1, l2) ->
  144.        raise Not_found
  145. +*)
  146.  
  147.  let lookup_all_simple proj1 proj2 shadow lid env =
  148.    match lid with
  149. @@ -990,7 +1054,7 @@
  150.    | _ -> true
  151.  
  152.  let iter_env proj1 proj2 f env () =
  153. -  Ident.iter (fun id (x,_) -> f (Pident id) x) (proj1 env);
  154. +  EnvTbl.iter (fun id x -> f (Pident id) x) (proj1 env);
  155.    let rec iter_components path path' mcomps =
  156.      let cont () =
  157.        let safe =
  158. @@ -1018,8 +1082,8 @@
  159.            let id = Pident (Ident.create_persistent s) in
  160.            iter_components id id ps.ps_comps)
  161.      persistent_structures;
  162. -  Ident.iter
  163. -    (fun id ((path, comps), _) -> iter_components (Pident id) path comps)
  164. +  EnvTbl.iter
  165. +    (fun id (path, comps) -> iter_components (Pident id) path comps)
  166.      env.components
  167.  
  168.  let run_iter_cont l =
  169. @@ -1050,7 +1114,7 @@
  170.  let rec find_shadowed_comps path env =
  171.    match path with
  172.      Pident id ->
  173. -      List.map fst (Ident.find_all (Ident.name id) env.components)
  174. +      List.map fst (EnvTbl.find_all (Ident.name id) env.components)
  175.    | Pdot (p, s, _) ->
  176.        let l = find_shadowed_comps p env in
  177.        let l' =
  178. @@ -1061,7 +1125,7 @@
  179.  let find_shadowed proj1 proj2 path env =
  180.    match path with
  181.      Pident id ->
  182. -      List.map fst (Ident.find_all (Ident.name id) (proj1 env))
  183. +      List.map fst (EnvTbl.find_all (Ident.name id) (proj1 env))
  184.    | Pdot (p, s, _) ->
  185.        let l = find_shadowed_comps p env in
  186.        let l' = List.map (find_all_comps proj2 s) l in
  187. @@ -1589,35 +1653,59 @@
  188.  
  189.  (* Open a signature path *)
  190.  
  191. -let open_signature slot root sg env0 =
  192. +let open_sig_env root sg =
  193. +  let env0 = empty in
  194. +  let slot = None in
  195. +
  196.    (* First build the paths and substitution *)
  197.    let (pl, sub, sg) = prefix_idents_and_subst root Subst.identity sg in
  198.    let sg = Lazy.force sg in
  199.  
  200.    (* Then enter the components in the environment after substitution *)
  201. +  List.fold_left2
  202. +    (fun env item p ->
  203. +       match item with
  204. +         Sig_value(id, decl) ->
  205. +           store_value slot (Ident.hide id) p decl env env0
  206. +       | Sig_type(id, decl, _) ->
  207. +           store_type ~check:false slot (Ident.hide id) p decl env env0
  208. +       | Sig_typext(id, ext, _) ->
  209. +           store_extension ~check:false slot (Ident.hide id) p ext env env0
  210. +       | Sig_module(id, mty, _) ->
  211. +           store_module slot (Ident.hide id) p mty env env0
  212. +       | Sig_modtype(id, decl) ->
  213. +           store_modtype slot (Ident.hide id) p decl env env0
  214. +       | Sig_class(id, decl, _) ->
  215. +           store_class slot (Ident.hide id) p decl env env0
  216. +       | Sig_class_type(id, decl, _) ->
  217. +           store_cltype slot (Ident.hide id) p decl env env0
  218. +    )
  219. +    empty sg pl
  220.  
  221. -  let newenv =
  222. -    List.fold_left2
  223. -      (fun env item p ->
  224. -        match item with
  225. -          Sig_value(id, decl) ->
  226. -            store_value slot (Ident.hide id) p decl env env0
  227. -        | Sig_type(id, decl, _) ->
  228. -            store_type ~check:false slot (Ident.hide id) p decl env env0
  229. -        | Sig_typext(id, ext, _) ->
  230. -            store_extension ~check:false slot (Ident.hide id) p ext env env0
  231. -        | Sig_module(id, mty, _) ->
  232. -            store_module slot (Ident.hide id) p mty env env0
  233. -        | Sig_modtype(id, decl) ->
  234. -            store_modtype slot (Ident.hide id) p decl env env0
  235. -        | Sig_class(id, decl, _) ->
  236. -            store_class slot (Ident.hide id) p decl env env0
  237. -        | Sig_class_type(id, decl, _) ->
  238. -            store_cltype slot (Ident.hide id) p decl env env0
  239. -      )
  240. -      env0 sg pl in
  241. -  { newenv with summary = Env_open(env0.summary, root) }
  242. +let open_sig =
  243. +  let tbl = Hashtbl.create 16 in
  244. +  fun root sg ->
  245. +    try Hashtbl.find tbl (root, sg)
  246. +    with Not_found ->
  247. +      let r = open_sig_env root sg in
  248. +      Hashtbl.add tbl (root, sg) r;
  249. +      r
  250.  
  251. +let open_signature slot root sg env0 =
  252. +  let newenv = open_sig root sg in
  253. +  { env0 with
  254. +    values = EnvTbl.merge newenv.values env0.values;
  255. +    constrs = EnvTbl.merge newenv.constrs env0.constrs;
  256. +    labels = EnvTbl.merge newenv.labels env0.labels;
  257. +    types = EnvTbl.merge newenv.types env0.types;
  258. +    modules = EnvTbl.merge newenv.modules env0.modules;
  259. +    modtypes = EnvTbl.merge newenv.modtypes env0.modtypes;
  260. +    components = EnvTbl.merge newenv.components env0.components;
  261. +    classes = EnvTbl.merge newenv.classes env0.classes;
  262. +    cltypes = EnvTbl.merge newenv.cltypes env0.cltypes;
  263. +    summary = Env_open(env0.summary, root);
  264. +  }
  265. +
  266.  (* Open a signature from a file *)
  267.  
  268.  let open_pers_signature name env =
  269. @@ -1626,7 +1714,7 @@
  270.      (Lazy.force ps.ps_sig) env
  271.  
  272.  let open_signature ?(loc = Location.none) ?(toplevel = false) ovf root sg env =
  273. -  if not toplevel && ovf = Asttypes.Fresh && not loc.Location.loc_ghost
  274. +  if false && not toplevel && ovf = Asttypes.Fresh && not loc.Location.loc_ghost
  275.       && (Warnings.is_active (Warnings.Unused_open "")
  276.           || Warnings.is_active (Warnings.Open_shadow_identifier ("", ""))
  277.           || Warnings.is_active (Warnings.Open_shadow_label_constructor ("","")))
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