← Back to branch summary

~ubuntu-branches/debian/sid/ocaml/sid

« back to all changes in this revision

Viewing changes to typing/subst.ml

  • Committer: Bazaar Package Importer
  • Author(s): Stéphane Glondu
  • Date: 2011-04-21 21:35:08 UTC
  • mfrom: (1.1.11 upstream) (12.1.14 sid)
  • Revision ID: james.westby@ubuntu.com-20110421213508-kg34453aqmb0moha
* Fixes related to -output-obj with g++ (in debian/patches):
  - add Declare-primitive-name-table-as-const-char
  - add Avoid-multiple-declarations-in-generated-.c-files-in
  - fix Embed-bytecode-in-C-object-when-using-custom: the closing
    brace for extern "C" { ... } was missing in some cases

Show diffs side-by-side

added added

removed removed

Lines of Context:
typing/subst.ml
10
10
(*                                                                     *)
11
11
(***********************************************************************)
12
12
 
13
 
(* $Id: subst.ml 9221 2009-04-02 09:06:33Z xclerc $ *)
 
13
(* $Id: subst.ml 10285 2010-04-20 14:11:28Z xleroy $ *)
14
14
 
15
15
(* Substitutions *)
16
16
 
19
19
open Types
20
20
open Btype
21
21
 
22
 
type t = 
 
22
type t =
23
23
  { types: (Ident.t, Path.t) Tbl.t;
24
24
    modules: (Ident.t, Path.t) Tbl.t;
25
25
    modtypes: (Ident.t, module_type) Tbl.t;
45
45
  | Papply(p1, p2) ->
46
46
      Papply(module_path s p1, module_path s p2)
47
47
 
 
48
let rec modtype_path s = function
 
49
    Pident id as p ->
 
50
      begin try
 
51
        match Tbl.find id s.modtypes with
 
52
          | Tmty_ident p -> p
 
53
          | _ -> fatal_error "Subst.modtype_path"
 
54
      with Not_found -> p end
 
55
  | Pdot(p, n, pos) ->
 
56
      Pdot(module_path s p, n, pos)
 
57
  | Papply(p1, p2) ->
 
58
      fatal_error "Subst.modtype_path"
 
59
 
48
60
let type_path s = function
49
61
    Pident id as p ->
50
62
      begin try Tbl.find id s.types with Not_found -> p end
88
100
      begin match desc with
89
101
      | Tconstr(p, tl, abbrev) ->
90
102
          Tconstr(type_path s p, List.map (typexp s) tl, ref Mnil)
 
103
      | Tpackage(p, n, tl) ->
 
104
          Tpackage(modtype_path s p, n, List.map (typexp s) tl)
91
105
      | Tobject (t1, name) ->
92
106
          Tobject (typexp s t1,
93
107
                 ref (match !name with
244
258
      let id' = Ident.rename id in
245
259
      rename_bound_idents (add_modtype id (Tmty_ident(Pident id')) s)
246
260
                          (id' :: idents) sg
247
 
  | (Tsig_value(id, _) | Tsig_exception(id, _) | 
 
261
  | (Tsig_value(id, _) | Tsig_exception(id, _) |
248
262
     Tsig_class(id, _, _) | Tsig_cltype(id, _, _)) :: sg ->
249
263
      let id' = Ident.rename id in
250
264
      rename_bound_idents s (id' :: idents) sg
295
309
    Tmodtype_abstract -> Tmodtype_abstract
296
310
  | Tmodtype_manifest mty -> Tmodtype_manifest(modtype s mty)
297
311
 
298
 
(* Composition of substitutions:  
 
312
(* For every binding k |-> d of m1, add k |-> f d to m2 
 
313
   and return resulting merged map. *)
 
314
 
 
315
let merge_tbls f m1 m2 =
 
316
  Tbl.fold (fun k d accu -> Tbl.add k (f d) accu) m1 m2
 
317
 
 
318
(* Composition of substitutions:
299
319
     apply (compose s1 s2) x = apply s2 (apply s1 x) *)
300
320
 
301
321
let compose s1 s2 =
302
 
  { types = Tbl.map (fun id p -> type_path s2 p) s1.types;
303
 
    modules = Tbl.map (fun id p -> module_path s2 p) s1.modules;
304
 
    modtypes = Tbl.map (fun id mty -> modtype s2 mty) s1.modtypes;
 
322
  { types = merge_tbls (type_path s2) s1.types s2.types;
 
323
    modules = merge_tbls (module_path s2) s1.modules s2.modules;
 
324
    modtypes = merge_tbls (modtype s2) s1.modtypes s2.modtypes;
305
325
    for_saving = false }