Commit 4aff96c1 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2004-06-27 21:52:53 by afrisch] Error message

Original author: afrisch
Date: 2004-06-27 21:52:53+00:00
parent c78699d9
......@@ -95,7 +95,7 @@ ifneq ($(ML_INTERFACE), false)
all: cdml.$(EXTENSION_LIB)
endif
install: all
install: all install_cdml
mkdir -p $(BINDIR)
mkdir -p $(MANDIR)/man1
$(INSTALL) -m755 cduce$(EXE) dtd2cduce$(EXE) \
......@@ -103,6 +103,8 @@ install: all
$(INSTALL) -m644 doc/cduce.1 $(MANDIR)/man1/
$(INSTALL) -m644 doc/dtd2cduce.1 $(MANDIR)/man1/
$(INSTALL) -m644 doc/validate.1 $(MANDIR)/man1/
install_cdml:
ifneq ($(ML_INTERFACE), false)
$(OCAMLFIND) install cduce META \
cdml.$(EXTENSION_LIB) cdo2cmo/cdml.cmi \
......
......@@ -282,9 +282,9 @@ ifdef ML_INTERFACE then
let (prolog, values) = Mltypes.read_cmi name in
let stub = Mlstub.stub cu id values in
Some (prolog,stub)
with Not_found ->
Printf.eprintf "Warning: no caml interface\n";
None
with
| Mltypes.Error s -> raise (Generic s)
| Not_found -> Printf.eprintf "Warning: no caml interface\n"; None
else
let stub_ml cu id = None;;
......
......@@ -298,14 +298,16 @@ let global_transl () =
(* Check type constraints and generate stub code *)
let check_value ty_env c_env (s,t) =
let err_ppf = Format.err_formatter
let check_value ty_env c_env (s,caml_t,t) =
(* Find the type for the value in the CDuce module *)
let id = Id.mk (U.mk s) in
let vt =
try Typer.find_value id ty_env
with Not_found ->
Printf.eprintf
"The interface exports a value %s which is not available in the module\n" s;
Format.fprintf err_ppf
"The interface exports a value %s which is not available in the module@." s;
exit 1
in
......@@ -316,9 +318,13 @@ let check_value ty_env c_env (s,t) =
if not (Types.subtype vt et) then
(
Format.fprintf
Format.err_formatter
"The type for the value %s is invalid@\nExpected type:@[%a@]@\nInferred type:@[%a@]@."
err_ppf
"The type for the value %s is invalid@\n\
Expected Caml type:@[%a@]@\n\
Expected CDuce type:@[%a@]@\n\
Inferred type:@[%a@]@."
s
print_ocaml caml_t
Types.Print.print et
Types.Print.print vt;
exit 1
......
val stub:
string -> Types.CompUnit.t -> (string * Mltypes.t) list ->
string -> Types.CompUnit.t -> (string * OCaml_all.Types.type_expr * Mltypes.t ) list ->
MLast.str_item list
(* ocamlc -o mltypes -I .. oCaml_all.cma mltypes.ml *)
exception Error of string
open OCaml_all
open Asttypes
......@@ -152,9 +151,11 @@ let unfold = unfold IntMap.empty StringMap.empty
(* Reading .cmi *)
open Config
let unsupported s =
raise (Error (Printf.sprintf "Unsupport feature (%s) found in .cmi" s))
let read_cmi name =
Config.load_path := !Librarian.obj_path;
let filename = Misc.find_in_path_uncap !Config.load_path (name ^ ".cmi") in
let sg = Env.read_signature name filename in
ocaml_env := Env.add_signature sg Env.initial;
......@@ -164,20 +165,16 @@ let read_cmi name =
List.iter
(function
| Tsig_value (id, {val_type=t;val_kind=Val_reg}) ->
values := (Ident.name id, unfold t) :: !values
values := (Ident.name id, t, unfold t) :: !values
| Tsig_type (id,t) ->
Format.fprintf ppf "%a@." (Printtyp.type_declaration id) t
| _ -> failwith "Unsupported feature in .cmi"
| Tsig_value (_,_) -> unsupported "external value"
| Tsig_exception (_,_) -> unsupported "exception"
| Tsig_module (_,_) -> unsupported "module"
| Tsig_modtype (_,_) -> unsupported "module type"
| Tsig_class (_,_) -> unsupported "class"
| Tsig_cltype (_,_) -> unsupported "class type"
) sg;
(Buffer.contents buf, !values)
let _ =
Config.load_path := [".";"/home/frisch/godi/lib/ocaml/std-lib"]
(*
let (p,d) = Env.lookup_type (Longident.parse (Sys.argv.(1))) Env.initial in
match d.type_manifest with
| Some ty ->
Format.fprintf Format.std_formatter "%a@." print_slot (unfold ty)
| None -> assert false
*)
let print_ocaml = Printtyp.type_expr
......@@ -2,6 +2,8 @@ open OCaml_all
open Asttypes
open Types
exception Error of string
type t = { uid : int; mutable recurs : int; mutable def : def }
and def =
| Link of t
......@@ -14,6 +16,7 @@ and def =
| Abstract of string
val read_cmi: string -> string * (string * t) list
val read_cmi: string -> string * (string * Types.type_expr * t) list
val print : Format.formatter -> t -> unit
val print_ocaml : Format.formatter -> Types.type_expr -> unit
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment