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

« back to all changes in this revision

Viewing changes to ocamldoc/odoc_ast.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:
9
9
(*                                                                     *)
10
10
(***********************************************************************)
11
11
 
12
 
(* $Id: odoc_ast.ml 9371 2009-10-16 12:40:04Z doligez $ *)
 
12
(* $Id: odoc_ast.ml 10355 2010-05-03 15:06:17Z guesdon $ *)
13
13
 
14
14
(** Analysis of implementation files. *)
15
15
open Misc
514
514
            in
515
515
            (acc_inher, acc_fields @ ele_comments)
516
516
 
517
 
        | (Parsetree.Pcf_inher (p_clexp, _)) :: q  ->
 
517
        | (Parsetree.Pcf_inher (_, p_clexp, _)) :: q  ->
518
518
            let tt_clexp =
519
519
              let n = List.length acc_inher in
520
520
              try Typedtree_search.get_nth_inherit_class_expr tt_cls n
521
 
              with Not_found -> raise (Failure (Odoc_messages.inherit_classexp_not_found_in_typedtree n))
 
521
              with Not_found ->
 
522
                raise (Failure (
 
523
                       Odoc_messages.inherit_classexp_not_found_in_typedtree n))
522
524
            in
523
525
            let (info_opt, ele_comments) =
524
526
              get_comments_in_class last_pos
525
527
                p_clexp.Parsetree.pcl_loc.Location.loc_start.Lexing.pos_cnum
526
528
            in
527
 
            let text_opt = match info_opt with None -> None | Some i -> i.Odoc_types.i_desc in
 
529
            let text_opt =
 
530
              match info_opt with None -> None
 
531
              | Some i -> i.Odoc_types.i_desc in
528
532
            let name = tt_name_of_class_expr tt_clexp in
529
533
            let inher =
530
534
              {
537
541
              p_clexp.Parsetree.pcl_loc.Location.loc_end.Lexing.pos_cnum
538
542
              q
539
543
 
540
 
      | ((Parsetree.Pcf_val (label, mutable_flag, _, loc) |
541
 
              Parsetree.Pcf_valvirt (label, mutable_flag, _, loc) ) as x) :: q ->
 
544
      | ((Parsetree.Pcf_val (label, mutable_flag, _, _, loc) |
 
545
          Parsetree.Pcf_valvirt (label, mutable_flag, _, loc) ) as x) :: q ->
542
546
            let virt = match x with Parsetree.Pcf_val _ -> false | _ -> true in
543
547
            let complete_name = Name.concat current_class_name label in
544
548
            let (info_opt, ele_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
602
606
 
603
607
            iter acc_inher (acc_fields @ ele_comments @ [ Class_method met ]) loc.Location.loc_end.Lexing.pos_cnum q
604
608
 
605
 
        | (Parsetree.Pcf_meth  (label, private_flag, _, loc)) :: q ->
 
609
        | (Parsetree.Pcf_meth  (label, private_flag, _, _, loc)) :: q ->
606
610
            let complete_name = Name.concat current_class_name label in
607
611
            let (info_opt, ele_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
608
612
            let exp =
846
850
      | Typedtree.Tmod_constraint (m_exp, _, _) -> tt_name_from_module_expr m_exp
847
851
      | Typedtree.Tmod_structure _
848
852
      | Typedtree.Tmod_functor _
849
 
      | Typedtree.Tmod_apply _ ->
 
853
      | Typedtree.Tmod_apply _
 
854
      | Typedtree.Tmod_unpack _ ->
850
855
          Odoc_messages.struct_end
851
856
 
852
857
    (** Get the list of included modules in a module structure of a typed tree. *)
1642
1647
            m_kind = Module_struct elements2 ;
1643
1648
          }
1644
1649
 
 
1650
      | (Parsetree.Pmod_unpack (p_exp, pkg_type),
 
1651
         Typedtree.Tmod_unpack (t_exp, tt_modtype)) ->
 
1652
          print_DEBUG ("Odoc_ast: case Parsetree.Pmod_unpack + Typedtree.Tmod_unpack "^module_name);
 
1653
          let code =
 
1654
            let loc = p_module_expr.Parsetree.pmod_loc in
 
1655
            let loc_end = loc.Location.loc_end.Lexing.pos_cnum in
 
1656
            let exp_loc = p_exp.Parsetree.pexp_loc in
 
1657
            let exp_loc_end = exp_loc.Location.loc_end.Lexing.pos_cnum in
 
1658
            let s = get_string_of_file exp_loc_end loc_end in
 
1659
            Printf.sprintf "(val ...%s" s
 
1660
          in
 
1661
          let name = Odoc_env.full_module_type_name env (Name.from_longident (fst pkg_type)) in
 
1662
          let alias = { mta_name = name ; mta_module = None } in
 
1663
          { m_base with
 
1664
            m_type = Odoc_env.subst_module_type env tt_modtype ;
 
1665
            m_kind = Module_unpack (code, alias) ;
 
1666
          }
 
1667
 
1645
1668
      | (parsetree, typedtree) ->
1646
1669
          (*DEBUG*)let s_parse =
1647
1670
          (*DEBUG*)  match parsetree with
1650
1673
          (*DEBUG*)  | Parsetree.Pmod_functor _ -> "Pmod_functor"
1651
1674
          (*DEBUG*)  | Parsetree.Pmod_apply _ -> "Pmod_apply"
1652
1675
          (*DEBUG*)  | Parsetree.Pmod_constraint _ -> "Pmod_constraint"
 
1676
          (*DEBUG*)  | Parsetree.Pmod_unpack _ -> "Pmod_unpack"
1653
1677
          (*DEBUG*)in
1654
1678
          (*DEBUG*)let s_typed =
1655
1679
          (*DEBUG*)  match typedtree with
1658
1682
          (*DEBUG*)  | Typedtree.Tmod_functor _ -> "Tmod_functor"
1659
1683
          (*DEBUG*)  | Typedtree.Tmod_apply _ -> "Tmod_apply"
1660
1684
          (*DEBUG*)  | Typedtree.Tmod_constraint _ -> "Tmod_constraint"
 
1685
          (*DEBUG*)  | Typedtree.Tmod_unpack _ -> "Tmod_unpack"
1661
1686
          (*DEBUG*)in
1662
1687
          (*DEBUG*)let code = get_string_of_file pos_start pos_end in
1663
1688
          print_DEBUG (Printf.sprintf "code=%s\ns_parse=%s\ns_typed=%s\n" code s_parse s_typed);