home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / compiler / ty_intf.ml < prev    next >
Encoding:
Text File  |  1993-09-24  |  1.6 KB  |  63 lines  |  [TEXT/MPS ]
  1. (* Consistency check between an interface and an implementation *)
  2.  
  3. #open "const";;
  4. #open "misc";;
  5. #open "globals";;
  6. #open "modules";;
  7. #open "types";;
  8. #open "ty_error";;
  9. #open "hashtbl";;
  10. #open "ty_decl";;
  11.  
  12. let enter_interface_definitions intf =
  13.   external_types := [];
  14.   hashtbl__do_table
  15.     (fun name ty_desc ->
  16.       let manifest =
  17.         match ty_desc.info.ty_desc with
  18.           Abstract_type -> false
  19.         | _ -> add_type ty_desc; true in
  20.       external_types :=
  21.         (ty_desc.qualid.id,
  22.          {et_descr = ty_desc; et_manifest = manifest; et_defined = false})
  23.         :: !external_types)
  24.     (types_of_module intf);
  25.   hashtbl__do_table
  26.     (fun name val_desc ->
  27.       match val_desc.info.val_prim with
  28.         ValuePrim(_,_) -> add_value val_desc
  29.       |       _        -> ())
  30.     (values_of_module intf);
  31.   hashtbl__do_table
  32.     (fun name constr_desc -> add_constr constr_desc)
  33.     (constrs_of_module intf);
  34.   hashtbl__do_table
  35.     (fun name label_desc -> add_label label_desc)
  36.     (labels_of_module intf)
  37. ;;
  38.  
  39. let check_interface intf =
  40.   let impl = !defined_module in
  41.   let check_value val_desc =
  42.     try
  43.       let val_desc' =
  44.         hashtbl__find (values_of_module impl) (little_name_of_global val_desc)
  45.       in
  46.         begin try
  47.           filter (type_instance val_desc'.info.val_typ, val_desc.info.val_typ)
  48.         with Unify ->
  49.           type_mismatch_err val_desc val_desc'
  50.         end
  51.     with Not_found ->
  52.       undefined_value_err val_desc
  53.   in
  54.     hashtbl__do_table
  55.       (fun name val_desc ->
  56.         match val_desc.info.val_prim with
  57.           ValueNotPrim -> check_value val_desc
  58.         |      _       -> ())
  59.       (values_of_module intf)
  60. ;;
  61.  
  62.  
  63.