coerce -> import

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/dynamics@4143 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

11 files changed, 17 insertions, 87 deletions

diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml
index 4b47b27e9c..1b326296eb 100644
--- a/bytecomp/translcore.ml
+++ b/bytecomp/translcore.ml
@@ -630,9 +630,9 @@ let rec transl_exp e =
 	  | Transltype.Contains_abstract_type (t,p) ->
 	      raise (Error (exp.exp_loc, Contains_abstract_type (t,p))) 
       end
-  | Texp_coerce (exp) ->
+  | Texp_import (exp) ->
       begin try 
-	Lapply(Transltype.rtype_prim "coerce_comp", 
+	Lapply(Transltype.rtype_prim "import_comp", 
 	       [ Lconst(Const_block(0, 
 		  [Const_base(Const_string !Location.input_name);
 		   Const_base(Const_int e.exp_loc.Location.loc_start);
diff --git a/bytecomp/transltype.ml b/bytecomp/transltype.ml
index 0f33f220a2..389083234c 100644
--- a/bytecomp/transltype.ml
+++ b/bytecomp/transltype.ml
@@ -64,75 +64,6 @@ let rec tree_of_run_ident = function
       Oide_apply(tree_of_run_ident r1, tree_of_run_ident r2)
 ;;	
 
-(********************************************************* data type digests *)
-
-(*********
-let names = ref [] (* type variable indices *)
-let name_counter = ref 0
-
-let reset_names () = names := []; name_counter := 0 ;;
-
-let push_names () =
-  let old_names = !names, !name_counter in
-  reset_names ();
-  old_names
-;;
-
-let pop_names old_names =
-  names := fst old_names;
-  name_counter := snd old_names
-;;
-
-let name_of_type ty =
-  try List.assq ty !names with Not_found ->
-    let name = !name_counter in
-    incr name_counter;
-    name
-;;    
-
-let rec val_type_of_typexp of_path ty =
-  let ty = repr ty in
-
-  match ty.desc with
-  | Tvar ->
-      Rtyp_var (name_of_type ty)
-  | Tarrow(l, ty1, ty2, _) ->
-      let rty1 =
-        if is_optional l then
-          match (repr ty1).desc with
-          | Tconstr(path, [ty], _)
-            when Path.same path Predef.path_option ->
-              val_type_of_typexp of_path ty
-          | _ -> raise Exit (* <hidden> *)
-        else val_type_of_typexp of_path ty1 
-      in
-      Rtyp_arrow (l, rty1, val_type_of_typexp of_path ty2)
-  | Ttuple tyl ->
-      Rtyp_tuple (val_type_of_typlist of_path tyl)
-  | Tconstr(p, tyl, _) ->
-      Rtyp_constr (of_path p, val_type_of_typlist of_path tyl)
-  | Tsubst ty -> 
-      val_type_of_typexp of_path ty
-  | Tlink _ | Tnil | Tfield _ ->
-      fatal_error "Transltype.val_type_of_typexp"
-  | _ -> 
-      fatal_error "Transltype.val_type_of_typexp: non supported type"
-
-and val_type_of_typlist of_path = function
-  | [] -> []
-  | ty :: tyl ->
-      let tr = val_type_of_typexp of_path ty in
-      tr :: val_type_of_typlist of_path tyl
-
-and val_type_of_type_scheme of_path ty = 
-  (* escape name space *)
-  let old_names = push_names () in
-  let rt = val_type_of_typexp of_path ty in
-  (* restore name space *)
-  pop_names old_names;
-  rt
-*******)
-
 (* We have a type expression, compile the runtime representation for it *)
  
 let rec transl_run_type = function
@@ -805,5 +736,6 @@ let run_type_of_typexp env ty =
 ;;
 
 let transl_run_type_of_typexp env ty =
+  reset ();
   transl_run_type (run_type_of_typexp env ty)
 ;;
diff --git a/parsing/lexer.mll b/parsing/lexer.mll
index 6d4a547b94..bb65a6d311 100644
--- a/parsing/lexer.mll
+++ b/parsing/lexer.mll
@@ -54,6 +54,7 @@ let keyword_table =
     "function", FUNCTION;
     "functor", FUNCTOR;
     "if", IF;
+    "import", IMPORT; (* DYN *) 
     "in", IN;
     "include", INCLUDE;
     "inherit", INHERIT;
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 847f5a78e0..ae6b26e42e 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -218,6 +218,7 @@ let bigarray_set arr arg newval =
 %token GREATERRBRACE
 %token GREATERRBRACKET
 %token IF
+%token IMPORT /* DYN */
 %token IN
 %token INCLUDE
 %token <string> INFIXOP0
@@ -838,12 +839,12 @@ expr:
   | LAZY simple_expr %prec prec_appl
       { mklazy $2 }
 /* DYN */
- | DYNAMIC seq_expr OF core_type END
+ | DYNAMIC seq_expr COLON core_type END
       { mkexp(Pexp_dynamic($2,Some $4)) }
  | DYNAMIC seq_expr END
       { mkexp(Pexp_dynamic($2,None)) }
- | COERCE seq_expr AS core_type END { mkexp(Pexp_coerce($2,Some $4)) } 
- | COERCE simple_expr END { mkexp(Pexp_coerce($2,None)) } 
+ | IMPORT seq_expr COLONGREATER core_type END { mkexp(Pexp_import($2,Some $4)) } 
+ | IMPORT simple_expr END { mkexp(Pexp_import($2,None)) } 
 /* /DYN */
 /* GENERIC
  | COERCE seq_expr WITH opt_bar coerce_cases %prec prec_match
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index d0bd4ff0fd..649874cc61 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -112,7 +112,7 @@ and expression_desc =
   | Pexp_assertfalse
 (* DYN *)  
   | Pexp_dynamic of expression * core_type option
-  | Pexp_coerce of expression * core_type option
+  | Pexp_import of expression * core_type option
 (* /DYN *)  
 (* GENERIC
   | Pexp_coerce of expression * (pattern * expression) list
diff --git a/parsing/printast.ml b/parsing/printast.ml
index 0a80c730a9..9e34abd492 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -282,8 +282,8 @@ and expression i ppf x =
       line i ppf "Pexp_dynamic";
       expression i ppf e;
       option i core_type ppf topt
-  | Pexp_coerce (e,topt) ->
-      line i ppf "Pexp_coerce";
+  | Pexp_import (e,topt) ->
+      line i ppf "Pexp_import";
       expression i ppf e;
       option i core_type ppf topt
 (* /DYN *)
diff --git a/stdlib/rtype.ml b/stdlib/rtype.ml
index d5adb93fca..2c30fd6d47 100644
--- a/stdlib/rtype.ml
+++ b/stdlib/rtype.ml
@@ -153,13 +153,11 @@ let fail t t' m s e =
   raise (Type_match_failure ( t, t', m, s, e ))
 ;;    
 
-(*
 let coerce_comp = fun (m,ls,le) [|ty1|] ((v, ty2) as d) ->
   if is_instance (=) ty2 ty1 then (v : 'a)
   else fail ty2 ty1 m ls le
-*)
 
-let coerce_comp = fun (m,ls,le) [|ty1|] ((v, ty2) as d) ->
+let import_comp = fun (m,ls,le) [|ty1|] ((v, ty2) as d) ->
   if is_instance (fun rp1 rp2 -> snd rp1 = snd rp2) ty2 ty1 then (v : 'a)
   else fail ty2 ty1 m ls le
 
diff --git a/stdlib/rtype.mli b/stdlib/rtype.mli
index cbbac27364..9b6391ddbf 100644
--- a/stdlib/rtype.mli
+++ b/stdlib/rtype.mli
@@ -29,6 +29,4 @@ exception Type_match_failure of run_type * run_type * string * int * int
 val dynamic_comp : run_type array -> 'a -> 'a * run_type
 val fail : run_type -> run_type -> string -> int -> int -> 'a
 val coerce_comp : string * int * int -> run_type array -> 'a * run_type -> 'a
-(*
 val import_comp : string * int * int -> run_type array -> 'a * run_type -> 'a
-*)
diff --git a/typing/typecore.ml b/typing/typecore.ml
index e6d8fd4758..5e4ebd95d4 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -547,7 +547,7 @@ let rec is_nonexpansive exp =
   | Texp_new (_, cl_decl) when Ctype.class_type_arity cl_decl.cty_type > 0 ->
       true
 (* DYN *)
-  | Texp_coerce _ -> true
+  | Texp_import _ -> true
 (* /DYN *)
 (* GENERIC with its more complex expression, 
    Texp_coerce will be expansive... *)
@@ -1198,7 +1198,7 @@ let rec type_exp env sexp =
 	exp_type= Predef.type_dyn;
 	exp_env= env;
       }	
-  | Pexp_coerce (sarg,stopt) ->
+  | Pexp_import (sarg,stopt) ->
       let arg = type_expect env sarg Predef.type_dyn in
       let ty_res =
 	match stopt with
@@ -1206,7 +1206,7 @@ let rec type_exp env sexp =
 	    Typetexp.transl_type_scheme_for_dynamic env st
 	| None -> newvar ()
       in
-      { exp_desc = Texp_coerce (arg);
+      { exp_desc = Texp_import (arg);
         exp_loc = sexp.pexp_loc;
         exp_type = ty_res;
         exp_env = env }
diff --git a/typing/typedtree.ml b/typing/typedtree.ml
index 9f5b653cc5..dd3bc1490c 100644
--- a/typing/typedtree.ml
+++ b/typing/typedtree.ml
@@ -81,7 +81,7 @@ and expression_desc =
   | Texp_assertfalse
 (* DYN *)
   | Texp_dynamic of expression
-  | Texp_coerce of expression
+  | Texp_import of expression
 (* /DYN *)
 (* GENERIC
   | Texp_coerce of expression * (pattern * Types.type_expr * expression) list
diff --git a/typing/typedtree.mli b/typing/typedtree.mli
index 2196d91fde..8017db4332 100644
--- a/typing/typedtree.mli
+++ b/typing/typedtree.mli
@@ -80,7 +80,7 @@ and expression_desc =
   | Texp_assertfalse
 (* DYN *)
   | Texp_dynamic of expression
-  | Texp_coerce of expression
+  | Texp_import of expression
 (* /DYN *)
 (* GENERIC
   | Texp_coerce of expression * (pattern * Types.type_expr * expression) list