[r2004-06-26 19:04:49 by afrisch] Style

Original author: afrisch
Date: 2004-06-26 19:04:49+00:00

cdo2cmo/ml_cduce.ml

@@ -14,9 +14,6 @@ let translations = Translations.create 17
 
 (***********************************************************************************)
 
-let cd_type_nil = 
-  let nil = Atoms.atom ( Atoms.V.mk_ascii "nil" ) in Types.atom nil
-
 let rec from_ocaml_rec left array = function
   | { n_path = id; n_kind = ML_type _; n_decl = decl } ->
       Types.descr ( from_ocaml_type left array id decl )
@@ -98,7 +95,7 @@ and from_desc left array = function
   | ML_option desc ->
       let node = Types.make () in
       let trans = Types.descr ( from_desc left array desc ) in
-      Types.define node ( Types.cup trans cd_type_nil );
+      Types.define node ( Types.cup trans Sequence.nil_type );
       node
   | ML_reference desc ->
       let node = Types.make () in

cdo2cmo/ml_ocaml.ml

@@ -432,8 +432,7 @@ let empty_ctx = { hctx_curr = None; hctx_nodes = [] }
 
 let add_node_to_curr hctx node = match hctx.hctx_curr with
   | None -> assert false
-  | Some h -> 
-      h.h_nodes <- h.h_nodes @ [ node ]; { hctx with hctx_curr = Some h }
+  | Some h -> h.h_nodes <- h.h_nodes @ [ node ]; hctx
 
 let flush_curr_hnode hctx node = match hctx.hctx_curr with
   | None -> { hctx with hctx_curr = Some ( mk_hypernode [ node ] ) }
@@ -442,7 +441,7 @@ let flush_curr_hnode hctx node = match hctx.hctx_curr with
 	hctx_nodes = hctx.hctx_nodes @ [ h ] }
 
 let flush_curr_hnode_only hctx = match hctx.hctx_curr with
-  | None -> { hctx with hctx_curr = None }
+  | None -> hctx
   | Some h -> { hctx_curr = None; hctx_nodes = hctx.hctx_nodes @ [ h ] } 
 
 let push_hnode hctx hnode = { hctx with hctx_nodes = hctx.hctx_nodes @ [ hnode ] }
@@ -455,24 +454,20 @@ let is_cduce_any path =
 let is_pervasives_ref path =
   String.compare ( ML.Path.name path ) "Pervasives.ref" = 0
 
-let canonical_path path { ML.Types.type_kind = k; ML.Types.type_manifest = m } =
-  match k, m with
-    | ML.Types.Type_abstract, Some t -> 
-	begin
-	  match ML.Ctype.expand_head !ocaml_env t with
-	    | { ML.Types.desc = ML.Types.Tconstr ( path, _, _ ) } -> path 
-	    | _ -> path
-	end
-    | _ -> path
+let canonical_path path = function
+  | { ML.Types.type_kind = ML.Types.Type_abstract; 
+      ML.Types.type_manifest = Some t } ->
+      begin
+	match ML.Ctype.expand_head !ocaml_env t with
+	  | { ML.Types.desc = ML.Types.Tconstr ( path, _, _ ) } -> path 
+	  | _ -> path
+      end
+  | _ -> path
 
 let rec translate_parameters cduce lident map list =
-  let cnt = ref 0 in
-  let arr = Array.create ( List.length list ) ML_any in
-  let f = fun t -> 
-    arr.( !cnt ) <- translate_type_expr cduce lident map t; 
-    incr cnt
-  in
-  List.iter f list; arr
+  Array.map 
+    (translate_type_expr cduce lident map)
+    (Array.of_list list)
 
 and translate_type_constr cduce lident map name list =
   try