[enhance] compiler, packages: New directive to resolve ident conflict…

…s beetween packages

opa/passes.ml

@@ -324,9 +324,10 @@ let pass_simple_slicer ~(options:opa_options) (env:'tmp_env env_Gen) =
       let updated =
         StringMap.fold
           (fun k v updated ->
-             match QmlRenamingMap.new_from_original_opt renaming v with
-             | None -> updated
-             | Some r -> StringMap.add k r updated
+             let v = List.filter_map (QmlRenamingMap.new_from_original_opt renaming) v in
+             match  v with
+             | [] -> updated
+             | r -> StringMap.add k r updated
 
           )
           map_before StringMap.empty
@@ -490,12 +491,16 @@ let pass_DbAccessorsGeneration ~options:(_ : opa_options) env =
     let map =
       OpaMapToIdent.fold_val_map
         (fun k v map ->
-           IdentMap.add (Ident.source k) v map)
+           match v with
+           | [] -> map
+           | v::_ -> IdentMap.add (Ident.source k) v map)
         IdentMap.empty in
     let revmap =
       OpaMapToIdent.fold_val_map
         (fun k v revmap ->
-           IdentMap.add v (Ident.source k) revmap)
+           List.fold_left
+             (fun revmap v -> IdentMap.add v (Ident.source k) revmap)
+             revmap v)
         IdentMap.empty in
     Some (QmlAlphaConv.create_from_maps ~map:map ~revmap:revmap)
   in

opa/s3Passes.ml

@@ -1,5 +1,5 @@
 (*
-    Copyright © 2011 MLstate
+    Copyright © 2011, 2012 MLstate
 
     This file is part of OPA.
 
@@ -681,10 +681,21 @@ let pass_SaToQml =
          let options = OpaToQml.options in
          OpaToQml.UidsOpaToQml.code ~options env.P.sa_lcode
        in
-       let type_renaming = SurfaceAstRenaming.ObjectType.fold StringMap.safe_merge env.P.sa_type_renaming in
-       let type_renaming = StringMap.map (fun (i,_) -> OpaToQml.UidsOpaToQml.typeident_aux ~check:false i) type_renaming in
+       let duplicated = Hashtbl.create 16 in
+       let type_renaming =
+         SurfaceAstRenaming.ObjectType.fold
+           (StringMap.merge_i
+              (fun i x y -> Hashtbl.add duplicated i y; x)
+           )
+           env.P.sa_type_renaming in
+       let type_renaming = StringMap.map
+         (fun (i,_) -> OpaToQml.UidsOpaToQml.typeident_aux ~check:false i)
+         type_renaming in
        let type_renamer ?(check=true) str =
-         try StringMap.find str type_renaming
+         try let x = StringMap.find str type_renaming in
+         match Hashtbl.find_all duplicated str with
+         | [] -> x
+         | _ -> OManager.error "Duplicated type ident is found %s\n" str
          with Not_found ->
            (* need to do that because the db uses bypasses with type [embed_info]
             * but this type is not defined in the code because the bypasses can only

opalang/js_syntax/opa_parser.trx

@@ -1168,6 +1168,9 @@ directive1 <-
   / "unsafe_cast" {{ `unsafe_cast }}
   / "wait" {{ `wait }}
 
+directive0pack <-
+  / "from" {{ fun x -> `from x }}
+
 directive2 <-
   / "catch" {{ `catch }}
   / "deprecated" {{ `deprecated }}
@@ -1203,6 +1206,8 @@ directive <-
     }}
   / "@" (=exact_ident(directive0)):v !"("
     {{ Directive (v,[],[]) }}
+  / "@" (=exact_ident(directive0pack)):v Opa_lexer.lpar_nosp package_identifier:pck rpar
+    {{ Directive (v pck,[],[]) }}
   / "@" (=exact_ident(directive1)):v Opa_lexer.lpar_nosp expr:e rpar
     {{ Directive (v,[e],[]) }}
   / "@" (=exact_ident(directive1str)):v Opa_lexer.lpar_nosp string:str rpar
@@ -1212,6 +1217,7 @@ directive <-
   / "@" (=exact_ident(directive2)):v Opa_lexer.lpar_nosp expr:e1 comma expr:e2 rpar
     {{ Directive (v,[e1;e2],[]) }}
   / "@" (=exact_ident(directive1or2str)):v Opa_lexer.lpar_nosp string:str (comma expr:e {{ [e] }} / _succeed {{ [] }}):el rpar
+
     {{ Directive (v str,el,[]) }}
   / "@" !strict_spacing deco_ml_identifier_nosp:v (function_arguments_nosp / !"(" {{ [] }}):l
       {|

opalang/opaMapToIdent.ml

@@ -16,6 +16,8 @@
     along with OPA. If not, see <http://www.gnu.org/licenses/>.
 *)
 
+module Format = BaseFormat
+
 (*
   We test strictly than the val_ function is called only on
   identifiers registred in opacapi, using the opacapi interface.
@@ -60,9 +62,9 @@ let other_side = function
 *)
 
 (* Reference to the maps*)
-let r_var = ref (StringMap.empty : Ident.t StringMap.t)
-let r_var_client = ref (StringMap.empty : Ident.t StringMap.t)
-let r_type = ref (StringMap.empty : Ident.t StringMap.t)
+let r_var = ref (StringMap.empty : Ident.t list StringMap.t)
+let r_var_client = ref (StringMap.empty : Ident.t list StringMap.t)
+let r_type = ref (StringMap.empty : Ident.t list StringMap.t)
 
 (* registering the references to be able to save them *)
 let () =
@@ -78,7 +80,9 @@ let print_side = function
   | `client -> "client"
 
 let val_no_opacapi_check ?(side=`server) s =
-  StringMap.find s !(get_rmap side)
+  match StringMap.find s !(get_rmap side) with
+  | [i] -> i
+  | l -> OManager.i_error "Found multiple ident for %s : %a" s (Format.pp_list " " (fun f i -> Format.fprintf f "%s" (Ident.to_uniq_string i))) l
 
 let val_noerr ?(side=`server) s =
   opacapi_check s ;
@@ -119,7 +123,9 @@ let typed_val ?(label=Annot.nolabel "OpaMapToIdent") ?(side=`server) ?(ty=[]) ?(
 let typ s =
   opacapi_check s ;
   try
-    StringMap.find s !r_type
+    match StringMap.find s !r_type with
+    | [i] -> i
+    | l -> OManager.i_error "Found multiple ident for %s : %a" s (Format.pp_list " " (fun f i -> Format.fprintf f "%s" (Ident.to_uniq_string i))) l
   with Not_found ->
     OManager.i_error
       "OpaMapToIdent: Type not found: %S\nIt contains:@\n%a@\n"
@@ -133,19 +139,18 @@ let specialized_typ ?(ty = []) ?(ty_row = []) name gamma =
   QmlTypes.Scheme.specialize ~typeident ~ty ~ty_row scheme
 
 let val_opt ?(side=`server) s =
-  opacapi_check s ;
-  StringMap.find_opt s !(get_rmap side)
+  try Some (val_noerr ~side s) with Not_found -> None
 
 let val_add ?(side=`server) s =
   let new_s = Ident.next s in
   let r_var = get_rmap side in
-  r_var := StringMap.safe_add s new_s !r_var;
+  r_var := StringMap.replace s (function | None -> [new_s] | Some l -> new_s::l)  !r_var;
   new_s
 
 let val_unsafe_add ?(side=`server) s =
   let new_s = Ident.next s in
   let r_var = get_rmap side in
-  r_var := StringMap.add s new_s !r_var;
+  r_var := StringMap.replace s (function | None -> [new_s] | Some l -> new_s::l)  !r_var;
   new_s
 
 let set_val_map ?(side=`server) v = (get_rmap side) := v
@@ -174,7 +179,7 @@ let val_start_server_add () =
   | None ->
       let ident = Ident.next "run_services" in
       start_server := (Some str_start_server);
-      set_val_map (StringMap.add str_start_server ident (get_val_map ()));
+      set_val_map (StringMap.add str_start_server [ident] (get_val_map ()));
       ident
 (** Hack for opacapi - To be cleanned by introduce dependencies
     beetween initialisations values (css, etc...) and init server *)
@@ -183,8 +188,16 @@ let _ = Opacapi.(!!) str_start_server
 let get_toplevel_vars () = StringMap.elts !r_var
 
 let filter f =
-  r_var := StringMap.filter_val f !r_var;
-  r_var_client := StringMap.filter_val f !r_var_client
+  let fil map =
+    StringMap.fold
+      (fun s i acc ->
+         match List.filter f i with
+         | [] -> acc
+         | l -> StringMap.add s l acc)
+      map StringMap.empty
+  in
+  r_var := fil !r_var;
+  r_var_client := fil !r_var_client
 
 let reset () =
   set_val_map ~side:`server StringMap.empty;

opalang/opaMapToIdent.mli

@@ -106,23 +106,23 @@ val specialized_typ : ?ty:QmlAst.ty list -> ?ty_row:QmlAst.ty_row list -> string
 
 (** {6 Map setter & getter}*)
 (** Directly get the map of values *)
-val get_val_map : ?side: side -> unit -> QmlAst.ident StringMap.t
+val get_val_map : ?side: side -> unit -> QmlAst.ident list StringMap.t
 
 (** Directly set the map of values *)
-val set_val_map : ?side:side -> QmlAst.ident StringMap.t -> unit
+val set_val_map : ?side:side -> QmlAst.ident list StringMap.t -> unit
 
 (** Directly set the map of types *)
-val set_typ_map : QmlAst.ident StringMap.t -> unit
+val set_typ_map : QmlAst.ident list StringMap.t -> unit
 
 (** {6 Iterators}*)
 (** Iter on the map of value.*)
-val iter_val_map : ?side:side -> (string -> QmlAst.ident -> unit) -> unit
+val iter_val_map : ?side:side -> (string -> QmlAst.ident list -> unit) -> unit
 
 (** Map on the map of value.*)
-val map_val_map : ?side:side -> (QmlAst.ident -> 'a) -> 'a StringMap.t
+val map_val_map : ?side:side -> (QmlAst.ident list -> 'a) -> 'a StringMap.t
 
 (** Fold on the map of value.*)
-val fold_val_map : ?side:side -> (string -> QmlAst.ident -> 'a -> 'a) -> 'a -> 'a
+val fold_val_map : ?side:side -> (string -> QmlAst.ident list -> 'a -> 'a) -> 'a -> 'a
 
 (** keep the maps only the identifiers satisfying the given predicates
     this function is applied to the two maps of identifiers (client and server) *)

opalang/opaPrint.ml

@@ -796,6 +796,7 @@ module Classic = struct
       | `open_ -> Format.pp_print_string f "open_"
       | `toplevel_open -> Format.pp_print_string f "toplevel_open"
       | `toplevel -> Format.pp_print_string f "toplevel"
+      | `from s -> Format.fprintf f "from(%s)" s
       | `local s -> pp f "local[%s]" (Ident.to_string s)
       | `doctype (sl, access) ->
           pp f "doctype([%a], %a)" (list ",@ " Format.pp_print_string) sl self#variant access
@@ -1356,6 +1357,7 @@ module Js = struct
       | `open_ -> Format.pp_print_string f "open_"
       | `toplevel_open -> Format.pp_print_string f "toplevel_open"
       | `toplevel -> Format.pp_print_string f "toplevel"
+      | `from s -> Format.fprintf f "from(%s)" s
       | `local s -> pp f "local[%s]" (Ident.to_string s)
       | `doctype (sl, access) ->
           pp f "doctype([%a], %a)" (list ",@ " Format.pp_print_string) sl self#variant access

opalang/surfaceAst.ml

@@ -370,6 +370,7 @@ type alpha_renaming_directive =
     | `toplevel_open
     | `module_
     | `toplevel
+    | `from of string (* to manage conflicts beetween packages *)
     ]
 
 (**