← Back to branch summary

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

« back to all changes in this revision

Viewing changes to bytecomp/typeopt.ml

  • Committer: Bazaar Package Importer
  • Author(s): Stefano Zacchiroli
  • Date: 2009-02-22 08:49:13 UTC
  • mfrom: (12.1.1 squeeze)
  • Revision ID: james.westby@ubuntu.com-20090222084913-3i0uw2bhd0lgw0ok
* Uploading to unstable
* debian/control: bump dh-ocaml to (>= 0.4) to avoid buggy ocamlinit.mk

Show diffs side-by-side

added added

removed removed

Lines of Context:
bytecomp/typeopt.ml
10
10
(*                                                                     *)
11
11
(***********************************************************************)
12
12
 
13
 
(* $Id: typeopt.ml,v 1.10.20.1 2008/01/18 03:54:57 garrigue Exp $ *)
 
13
(* $Id: typeopt.ml,v 1.13 2008/02/29 14:21:22 doligez Exp $ *)
14
14
 
15
15
(* Auxiliaries for type-based optimizations, e.g. array kinds *)
16
16
 
24
24
 
25
25
let has_base_type exp base_ty_path =
26
26
  let exp_ty =
27
 
    Ctype.expand_head exp.exp_env (Ctype.correct_levels exp.exp_type) in
 
27
    Ctype.expand_head_opt exp.exp_env (Ctype.correct_levels exp.exp_type) in
28
28
  match Ctype.repr exp_ty with
29
29
    {desc = Tconstr(p, _, _)} -> Path.same p base_ty_path
30
30
  | _ -> false
31
31
 
32
32
let maybe_pointer exp =
33
33
  let exp_ty =
34
 
    Ctype.expand_head exp.exp_env (Ctype.correct_levels exp.exp_type) in
 
34
    Ctype.expand_head_opt exp.exp_env (Ctype.correct_levels exp.exp_type) in
35
35
  match (Ctype.repr exp_ty).desc with
36
36
    Tconstr(p, args, abbrev) ->
37
37
      not (Path.same p Predef.path_int) &&
38
38
      not (Path.same p Predef.path_char) &&
39
39
      begin try
40
40
        match Env.find_type p exp.exp_env with
41
 
          {type_kind = Type_variant([], _)} -> true (* type exn *)
42
 
        | {type_kind = Type_variant(cstrs, _)} ->
 
41
          {type_kind = Type_variant []} -> true (* type exn *)
 
42
        | {type_kind = Type_variant cstrs} ->
43
43
            List.exists (fun (name, args) -> args <> []) cstrs
44
44
        | _ -> true
45
45
      with Not_found -> true
50
50
  | _ -> true
51
51
 
52
52
let array_element_kind env ty =
53
 
  let ty = Ctype.repr (Ctype.expand_head env ty) in
 
53
  let ty = Ctype.repr (Ctype.expand_head_opt env ty) in
54
54
  match ty.desc with
55
55
    Tvar | Tunivar ->
56
56
      Pgenarray
70
70
          match Env.find_type p env with
71
71
            {type_kind = Type_abstract} ->
72
72
              Pgenarray
73
 
          | {type_kind = Type_variant(cstrs, _)}
 
73
          | {type_kind = Type_variant cstrs}
74
74
            when List.for_all (fun (name, args) -> args = []) cstrs ->
75
75
              Pintarray
76
76
          | {type_kind = _} ->
85
85
      Paddrarray
86
86
 
87
87
let array_kind_gen ty env =
88
 
  let array_ty = Ctype.expand_head env (Ctype.correct_levels ty) in
 
88
  let array_ty = Ctype.expand_head_opt env (Ctype.correct_levels ty) in
89
89
  match (Ctype.repr array_ty).desc with
90
90
    Tconstr(p, [elt_ty], _) | Tpoly({desc = Tconstr(p, [elt_ty], _)}, _)
91
91
    when Path.same p Predef.path_array ->
125
125
   "fortran_layout", Pbigarray_fortran_layout]
126
126
 
127
127
let bigarray_kind_and_layout exp =
128
 
  let ty = Ctype.repr (Ctype.expand_head exp.exp_env exp.exp_type) in
 
128
  let ty = Ctype.repr (Ctype.expand_head_opt exp.exp_env exp.exp_type) in
129
129
  match ty.desc with
130
130
    Tconstr(p, [caml_type; elt_type; layout_type], abbrev) ->
131
131
      (bigarray_decode_type elt_type kind_table Pbigarray_unknown,