(*******************************************************)
(*                                                     *)
(* OCamlNS                                             *)
(*                                                     *)
(* Copyright (c) 2001, 2002.                           *)
(* E/AS Software Foundation                            *)
(*                                                     *)
(* Author(s):                                          *)
(*    Yurii A. Rashkovskii                             *)
(*                                                     *)
(* This program is free software; you can redistribute *)
(* it and/or modify it under the terms of the GNU      *)
(* Lesser General Public License as published by the   *)
(* Free Software Foundation; version 2 of the License. *)
(*                                                     *)
(*******************************************************)

open Stdpp;;
open Pcaml;;

let mod_ident = Grammar.Entry.create gram "mod_ident";;
let module_binding = Grammar.Entry.create gram "module_binding";;


let rename_module = ref (fun loc -> <:str_item< open Pervasives >>);;

let gen_mod_name l =
    let nsname = ref "" in
    List.iter (fun x -> nsname := !nsname ^ (x ^ "_")) l ; 
    (String.sub !nsname 0 ((String.length !nsname)-1));;

let gen_ns_name l =
    let nsname = ref "" in
    List.iter (fun x -> nsname := !nsname ^ (x ^ "_")) l ; !nsname;;
    
let gen_module loc mn ns me =
    let name = "caml_namespace___" ^ (gen_ns_name ns) ^ "__module___" ^ mn in
    <:str_item< module $uid:name$ = $me$ >>
;;    

let gen_module_type loc mn ns mt =
    let name = "caml_namespace___" ^ (gen_ns_name ns) ^ "__moduletype___" ^ mn in
    <:str_item< module type$uid:name$ = $mt$ >>
;;    

let gen_module_open loc mn ns =
    let name = "caml_namespace___" ^ (gen_ns_name ns) ^ "__module___" ^ mn in
    rename_module := (fun loc -> <:str_item< module $uid:mn$ = $uid:name$>>);    
    <:str_item< open $uid:name$>>
;;    

let gen_module_use loc ns =
    let name = (gen_mod_name ns) in
    <:str_item< open $uid:name$>>
;;    

let gen_module_open_as loc mn ns asn =
    let name = "caml_namespace___" ^ (gen_ns_name ns) ^ "__module___" ^ mn in
    rename_module := (fun loc -> <:str_item< module $uid:asn$ = $uid:name$>>);    
    <:str_item< open $uid:name$>>
;;    

let gen_module_sig loc mn ns mt =
    let name = "caml_namespace___" ^ (gen_ns_name ns) ^ "__module___" ^ mn in
    <:sig_item< module $uid:name$ : $mt$ >>
;;    

EXTEND

  mod_ident:
    [ RIGHTA
      [ i = UIDENT -> [i]
      | i = LIDENT -> [i]
      | i = UIDENT; "."; j = SELF -> i :: j ] ]
  ;

  module_binding:
    [ RIGHTA
      [ "("; m = UIDENT; ":"; mt = module_type; ")"; mb = SELF ->
          <:module_expr< functor ( $m$ : $mt$ ) -> $mb$ >>
      | ":"; mt = module_type; "="; me = module_expr ->
          <:module_expr< ( $me$ : $mt$ ) >>
      | "="; me = module_expr -> <:module_expr< $me$ >> ] ]
  ;

  str_item: LEVEL "top"
  [
    [ "module"; i = UIDENT; "in" ; ns = mod_ident ; 
       me = module_binding ->
      gen_module loc i ns me
     |
     "module";"type"; i = UIDENT; "in" ; ns = mod_ident ; "=";
       mt = module_type ->
      gen_module_type loc i ns mt
     | 
     "open"; i = UIDENT; "in" ; ns = mod_ident ->
      gen_module_open loc i ns ; !rename_module loc
     | 
     "open"; i = UIDENT; "in" ; ns = mod_ident ; "as" ; asn = UIDENT ->
      gen_module_open_as loc i ns asn; !rename_module loc
     | 
     "use"; ns = mod_ident  ->
      gen_module_use loc ns
    ]

  ];

  sig_item: LEVEL "top"
  [
    [ "module"; i = UIDENT; "in" ; ns = mod_ident ; ":" ; mt = module_type ->
      gen_module_sig loc i ns mt
    ]

  ];

END
;