Skip to content

GitLab

Commit f775a5cf authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2007-06-12 15:13:49 by afrisch] ocaml/cduce iface for OCaml 3.10 

Original author: afrisch
Date: 2007-06-12 15:13:49+00:00
parent 5dd9400e
Hide whitespace changes
Inline Side-by-side
META.in
View file @ f775a5cf
version="%VER%"
requires="%REQ% camlp4.gramlib"
requires="%REQ%"
description="Runtime support for CDuce"
archive(byte)="+camlp4/camlp4.cma +camlp4/pr_o.cmo cduce_lib.cma"
archive(native)="+camlp4/camlp4.cmxa +camlp4/pr_o.cmx cduce_lib.cmxa"
archive(byte)="+camlp4/camlp4lib.cma cduce_lib.cma"
archive(native)="+camlp4/camlp4lib.cmxa cduce_lib.cmxa"
depend
View file @ f775a5cf
......@@ -268,14 +268,28 @@ query/query_aggregates.cmo: runtime/value.cmi types/sequence.cmi \
compile/operators.cmi types/intervals.cmi types/builtin_defs.cmi
query/query_aggregates.cmx: runtime/value.cmx types/sequence.cmx \
compile/operators.cmx types/intervals.cmx types/builtin_defs.cmx
ocamliface/mltypes.cmo: types/ident.cmo ocamliface/config.cmo \
parser/cduce_loc.cmi ocamliface/mltypes.cmi
ocamliface/mltypes.cmx: types/ident.cmx ocamliface/config.cmx \
parser/cduce_loc.cmx ocamliface/mltypes.cmi
ocamliface/mlstub.cmo: types/types.cmi typing/typer.cmi types/sequence.cmi \
misc/ns.cmi ocamliface/mltypes.cmi driver/librarian.cmi types/ident.cmo \
types/externals.cmi ocamliface/config.cmo compile/compile.cmi \
parser/cduce_loc.cmi types/builtin_defs.cmi types/atoms.cmi \
parser/ast.cmo ocamliface/mlstub.cmi
ocamliface/mlstub.cmx: types/types.cmx typing/typer.cmx types/sequence.cmx \
misc/ns.cmx ocamliface/mltypes.cmx driver/librarian.cmx types/ident.cmx \
types/externals.cmx ocamliface/config.cmx compile/compile.cmx \
parser/cduce_loc.cmx types/builtin_defs.cmx types/atoms.cmx \
parser/ast.cmx ocamliface/mlstub.cmi
parser/cduce_netclient.cmo: runtime/value.cmi parser/url.cmi \
ocamliface/config.cmo
driver/cduce_config.cmi
parser/cduce_netclient.cmx: runtime/value.cmx parser/url.cmx \
ocamliface/config.cmx
driver/cduce_config.cmx
runtime/cduce_pxp.cmo: runtime/value.cmi parser/url.cmi schema/schema_xml.cmi \
runtime/load_xml.cmi ocamliface/config.cmo runtime/cduce_pxp.cmi
runtime/load_xml.cmi driver/cduce_config.cmi runtime/cduce_pxp.cmi
runtime/cduce_pxp.cmx: runtime/value.cmx parser/url.cmx schema/schema_xml.cmx \
runtime/load_xml.cmx ocamliface/config.cmx runtime/cduce_pxp.cmi
runtime/load_xml.cmx driver/cduce_config.cmx runtime/cduce_pxp.cmi
driver/run.cmo: runtime/value.cmi parser/ulexer.cmi misc/stats.cmi \
driver/librarian.cmi types/ident.cmo misc/html.cmi parser/cduce_loc.cmi \
driver/cduce_config.cmi driver/cduce.cmi types/builtin.cmi
......@@ -296,36 +310,38 @@ tools/validate.cmo: schema/schema_types.cmi schema/schema_parser.cmi \
schema/schema_common.cmi
tools/validate.cmx: schema/schema_types.cmx schema/schema_parser.cmx \
schema/schema_common.cmx
ocamliface/mltypes.cmo: ocamliface/location.cmo types/ident.cmo \
ocamliface/config.cmo ocamliface/mltypes.cmi
ocamliface/mltypes.cmx: ocamliface/location.cmx types/ident.cmx \
ocamliface/config.cmx ocamliface/mltypes.cmi
ocamliface/mltypes.cmo: types/ident.cmo ocamliface/config.cmo \
parser/cduce_loc.cmi ocamliface/mltypes.cmi
ocamliface/mltypes.cmx: types/ident.cmx ocamliface/config.cmx \
parser/cduce_loc.cmx ocamliface/mltypes.cmi
ocamliface/mlstub.cmo: types/types.cmi typing/typer.cmi types/sequence.cmi \
misc/ns.cmi ocamliface/mltypes.cmi ocamliface/location.cmo \
driver/librarian.cmi types/ident.cmo types/externals.cmi \
ocamliface/config.cmo compile/compile.cmi types/builtin_defs.cmi \
types/atoms.cmi parser/ast.cmo ocamliface/mlstub.cmi
misc/ns.cmi ocamliface/mltypes.cmi driver/librarian.cmi types/ident.cmo \
types/externals.cmi ocamliface/config.cmo compile/compile.cmi \
parser/cduce_loc.cmi types/builtin_defs.cmi types/atoms.cmi \
parser/ast.cmo ocamliface/mlstub.cmi
ocamliface/mlstub.cmx: types/types.cmx typing/typer.cmx types/sequence.cmx \
misc/ns.cmx ocamliface/mltypes.cmx ocamliface/location.cmx \
driver/librarian.cmx types/ident.cmx types/externals.cmx \
ocamliface/config.cmx compile/compile.cmx types/builtin_defs.cmx \
types/atoms.cmx parser/ast.cmx ocamliface/mlstub.cmi
parser/cduce_curl.cmo: runtime/value.cmi parser/url.cmi ocamliface/config.cmo
parser/cduce_curl.cmx: runtime/value.cmx parser/url.cmx ocamliface/config.cmx
misc/ns.cmx ocamliface/mltypes.cmx driver/librarian.cmx types/ident.cmx \
types/externals.cmx ocamliface/config.cmx compile/compile.cmx \
parser/cduce_loc.cmx types/builtin_defs.cmx types/atoms.cmx \
parser/ast.cmx ocamliface/mlstub.cmi
parser/cduce_curl.cmo: runtime/value.cmi parser/url.cmi \
driver/cduce_config.cmi
parser/cduce_curl.cmx: runtime/value.cmx parser/url.cmx \
driver/cduce_config.cmx
parser/cduce_netclient.cmo: runtime/value.cmi parser/url.cmi \
ocamliface/config.cmo
driver/cduce_config.cmi
parser/cduce_netclient.cmx: runtime/value.cmx parser/url.cmx \
ocamliface/config.cmx
driver/cduce_config.cmx
runtime/cduce_expat.cmo: runtime/value.cmi parser/url.cmi \
schema/schema_xml.cmi runtime/load_xml.cmi ocamliface/config.cmo \
schema/schema_xml.cmi runtime/load_xml.cmi driver/cduce_config.cmi \
runtime/cduce_expat.cmi
runtime/cduce_expat.cmx: runtime/value.cmx parser/url.cmx \
schema/schema_xml.cmx runtime/load_xml.cmx ocamliface/config.cmx \
schema/schema_xml.cmx runtime/load_xml.cmx driver/cduce_config.cmx \
runtime/cduce_expat.cmi
runtime/cduce_pxp.cmo: runtime/value.cmi parser/url.cmi schema/schema_xml.cmi \
runtime/load_xml.cmi ocamliface/config.cmo runtime/cduce_pxp.cmi
runtime/load_xml.cmi driver/cduce_config.cmi runtime/cduce_pxp.cmi
runtime/cduce_pxp.cmx: runtime/value.cmx parser/url.cmx schema/schema_xml.cmx \
runtime/load_xml.cmx ocamliface/config.cmx runtime/cduce_pxp.cmi
runtime/load_xml.cmx driver/cduce_config.cmx runtime/cduce_pxp.cmi
misc/encodings.cmi: misc/custom.cmo
misc/upool.cmi: misc/custom.cmo
misc/ns.cmi: misc/upool.cmi misc/encodings.cmi misc/custom.cmo
......@@ -386,5 +402,8 @@ driver/librarian.cmi: runtime/value.cmi types/types.cmi typing/typer.cmi \
types/sample.cmi: types/types.cmi
driver/cduce.cmi: runtime/value.cmi types/atoms.cmi
ocamliface/mltypes.cmi: types/types.cmi
ocamliface/mlstub.cmi: parser/ast.cmo
ocamliface/mltypes.cmi: types/types.cmi
ocamliface/mlstub.cmi: parser/ast.cmo
schema/schema_types.cmi: runtime/value.cmi misc/ns.cmi misc/encodings.cmi \
types/atoms.cmi
ocamliface/Makefile
View file @ f775a5cf
......@@ -19,14 +19,15 @@ endif
ocaml_files:
mkdir ocaml_files
$(HIDE)cp $(patsubst %,$(OCAML_SRC)/%, $(COPY_FILES)) ocaml_files/
cp location.ml ocaml_files
mv ocaml_files/asttypes.mli ocaml_files/asttypes.ml
cp location.ml ocaml_files/location.ml
cp ocaml_files/asttypes.mli ocaml_files/asttypes.ml
sed s=STDLIB=$(STDLIB)= config.ml > ocaml_files/config.ml
grep cmi_magic $(OCAML_SRC)/utils/config.mlp >> ocaml_files/config.ml
caml_cduce.cmo: ocaml_files
@echo "Build $@"
(cd ocaml_files; ocamlc $(FORPACKOPT1) -c $(COMPILE_FILES);\
(cd ocaml_files; \
ocamlc $(FORPACKOPT1) -c $(COMPILE_FILES);\
ocamlc $(FORPACKOPT2) -pack -o $@ $(OBJECTS); \
cp caml_cduce.cmo caml_cduce.cmi ..)
......@@ -42,7 +43,9 @@ clean:
COPY_FILES=\
utils/misc.ml utils/tbl.ml \
utils/consistbl.ml utils/warnings.ml utils/terminfo.ml utils/clflags.ml \
parsing/asttypes.mli parsing/longident.ml \
parsing/asttypes.mli parsing/location.mli \
parsing/longident.ml \
typing/outcometree.mli \
typing/ident.ml typing/path.ml \
typing/primitive.ml typing/types.ml \
typing/btype.ml typing/oprint.ml \
......@@ -51,9 +54,10 @@ COPY_FILES=\
typing/ctype.ml typing/ctype.mli typing/printtyp.ml
COMPILE_FILES=\
asttypes.mli outcometree.mli asttypes.ml \
config.ml misc.ml tbl.ml \
clflags.ml consistbl.ml warnings.ml terminfo.ml \
location.ml asttypes.ml longident.ml \
location.mli location.ml longident.ml \
ident.ml path.ml \
primitive.ml types.ml \
btype.ml oprint.ml \
......
ocamliface/location.ml
View file @ f775a5cf
(* An implementation of the OCaml's Location signature (to cut dependencies
to other OCaml modules *)
open Lexing
type t = { loc_start: position; loc_end: position; loc_ghost: bool }
let none = { loc_start = dummy_pos; loc_end = dummy_pos; loc_ghost = true }
let dummy x = assert false
let in_file = dummy
let init = dummy
let curr = dummy
let symbol_rloc = dummy
let symbol_gloc = dummy
let rhs_loc = dummy
let input_name = ref ""
let input_lexbuf = ref None
let get_pos_info = dummy
let print = dummy
let print_warning = dummy
let prerr_warning = dummy
let echo_eof = dummy
let reset = dummy
let highlight_locations = dummy
ocamliface/mlstub.ml
View file @ f775a5cf
#load "q_MLast.cmo";;
(* TODO:
- optimizations: generate labels and atoms only once.
- translate record to open record on positive occurence
*)
open Mltypes
open Ident
open Camlp4.PreCast
let _loc = Loc.ghost
module IntMap =
Map.Make(struct type t = int let compare : t -> t -> int = compare end)
......@@ -25,6 +26,17 @@ let atom lab = Types.atom (Atoms.atom (Atoms.V.mk_ascii lab))
let label lab = Label.mk (Ns.empty, U.mk lab)
let bigcup f l = List.fold_left (fun accu x -> Types.cup accu (f x)) Types.empty l
let id s =
let rec aux i : Ast.ident =
try
let j = String.index_from s i '.' in
<:ident< $uid:String.sub s i (j - i)$.$aux (j+1)$ >>
with Not_found ->
<:ident< $lid:String.sub s i (String.length s - i)$ >>
in
(* Printf.eprintf "*** %S\n" s; *)
aux 0
let rec typ t =
try IntHash.find memo_typ t.uid
with Not_found ->
......@@ -77,11 +89,6 @@ let mk_var _ =
let mk_vars = List.map mk_var
let _loc = (Lexing.dummy_pos,Lexing.dummy_pos)
let let_in p e body =
<:expr< let $list:[ p, e ]$ in $body$ >>
let atom_ascii lab =
<:expr< Value.atom_ascii $str: String.escaped lab$ >>
......@@ -91,16 +98,15 @@ let label_ascii lab =
let pair e1 e2 = <:expr< Value.Pair ($e1$,$e2$) >>
let pmatch e l =
let l = List.map (fun (p,e) -> p,None,e) l in
<:expr< match $e$ with [ $list:l$ ] >>
let rec matches ine oute = function
| [v1;v2] ->
let_in <:patt<($lid:v1$,$lid:v2$)>> <:expr< Value.get_pair $ine$ >> oute
<:expr< let ($lid:v1$,$lid:v2$) = Value.get_pair $ine$ in $oute$ >>
| v::vl ->
let r = mk_var () in
let oute = matches <:expr< $lid:r$ >> oute vl in
let_in <:patt<($lid:v$,$lid:r$)>> <:expr< Value.get_pair $ine$ >> oute
<:expr< let ($lid:v$,$lid:r$) = Value.get_pair $ine$ in $oute$ >>
| [] -> assert false
let list_lit el =
......@@ -169,7 +175,7 @@ let rec tuple = function
let pat_tuple vars =
let pl = List.map (fun id -> <:patt< $lid:id$ >>) vars in
<:patt< ($list:pl$) >>
<:patt< ($Ast.paCom_of_list pl$) >>
let call_lab f l x =
......@@ -196,7 +202,7 @@ let rec to_cd e t =
(* Format.fprintf Format.err_formatter "to_cd %a [uid=%i; recurs=%i]@."
Mltypes.print t t.uid t.recurs; *)
if t.recurs > 0 then <:expr< $lid:to_cd_fun t$ $e$ >>
else to_cd_descr e t.def
else to_cd_descr e t.def
and to_cd_descr e = function
| Link t -> to_cd e t
......@@ -219,7 +225,7 @@ and to_cd_descr e = function
| Tuple tl ->
(* let (x1,...,xn) = ... in Value.Pair (t1(x1), Value.Pair(...,tn(xn))) *)
let vars = mk_vars tl in
let_in (pat_tuple vars) e (tuple (tuple_to_cd tl vars))
<:expr< let $pat_tuple vars$ = $e$ in $tuple (tuple_to_cd tl vars)$ >>
| PVariant l ->
(* match <...> with
| `A -> Value.atom_ascii "A"
......@@ -228,10 +234,9 @@ and to_cd_descr e = function
let cases =
List.map
(function
| (lab,None) -> <:patt< `$lid:lab$ >>, atom_ascii lab
| (lab,Some t) ->
<:patt< `$lid:lab$ x >>,
pair (atom_ascii lab) (to_cd <:expr< x >> t)
| (lab,None) -> <:match_case< `$lid:lab$ -> $atom_ascii lab$ >>
| (lab,Some t) -> <:match_case< `$lid:lab$ x ->
$pair (atom_ascii lab) (to_cd <:expr< x >> t)$ >>
) l in
pmatch e cases
| Variant (p,l,_) ->
......@@ -246,13 +251,13 @@ and to_cd_descr e = function
let pat = match lab with (* Stupid Camlp4 *)
| "true" -> <:patt< True >>
| "false" -> <:patt< False >>
| lab -> <:patt< $lid:p^lab$ >>
| lab -> <:patt< $id: id (p^lab)$ >>
in
pat, atom_ascii lab
<:match_case< $pat$ -> $atom_ascii lab$ >>
| (lab,tl) ->
let vars = mk_vars tl in
<:patt< $lid:p^lab$ $pat_tuple vars$ >>,
tuple (atom_ascii lab :: tuple_to_cd tl vars)
<:match_case< $id: id (p^lab)$ $pat_tuple vars$ ->
$tuple (atom_ascii lab :: tuple_to_cd tl vars)$ >>
) l in
pmatch e cases
| Record (p,l,_) ->
......@@ -262,7 +267,7 @@ and to_cd_descr e = function
let l =
List.map
(fun (lab,t) ->
let e = to_cd <:expr<$x$.$lid:p^lab$>> t in
let e = to_cd <:expr<$x$.$id:id (p^lab)$>> t in
<:expr< ($label_ascii lab$, $e$) >>)
l
in
......@@ -314,7 +319,7 @@ and tuple_to_cd tl vars = List.map2 (fun t id -> to_cd <:expr< $lid:id$ >> t) tl
and to_ml e t =
and to_ml (e : Ast.expr) (t : Mltypes.t) =
(* Format.fprintf Format.err_formatter "to_ml %a@."
Mltypes.print t; *)
if t.recurs > 0 then <:expr< $lid:to_ml_fun t$ $e$ >>
......@@ -340,8 +345,7 @@ and to_ml_descr e = function
(t1(x1),...,tn(xn)) *)
let vars = mk_vars tl in
let el = tuple_to_ml tl vars in
matches e <:expr< ($list:el$) >> vars
matches e <:expr< $tuple_to_ml tl vars$ >> vars
| PVariant l ->
(* match Value.get_variant <...> with
| "A",None -> `A
......@@ -352,15 +356,16 @@ and to_ml_descr e = function
List.map
(function
| (lab,None) ->
<:patt< ($str: String.escaped lab$, None) >>,
<:expr< `$lid:lab$ >>
<:match_case<
($str: String.escaped lab$, None) -> `$lid:lab$ >>
| (lab,Some t) ->
let x = mk_var () in
let ex = <:expr< $lid:x$ >> in
<:patt< ($str: String.escaped lab$, Some $lid:x$) >>,
<:expr< `$lid:lab$ $to_ml ex t$ >>
<:match_case<
($str: String.escaped lab$, Some $lid:x$) ->
`$lid:lab$ $to_ml ex t$ >>
) l in
let cases = cases @ [ <:patt< _ >>, <:expr< assert False >> ] in
let cases = cases @ [ <:match_case< _ -> assert False >> ] in
pmatch <:expr< Value.get_variant $e$ >> cases
| Variant (_,l,false) ->
failwith "Private Sum type"
......@@ -373,25 +378,26 @@ and to_ml_descr e = function
List.map
(function
| (lab,[]) ->
<:patt< ($str: String.escaped lab$, None) >>,
(match lab with (* Stupid Camlp4 *)
let pa = <:patt< ($str: String.escaped lab$, None) >>
and e = match lab with (* Stupid Camlp4 *)
| "true" -> <:expr< True >>
| "false" -> <:expr< False >>
| lab -> <:expr< $lid:p^lab$ >>)
| lab -> <:expr< $id:id (p ^ lab)$ >> in
<:match_case< $pa$ -> $e$ >>
| (lab,[t]) ->
let x = mk_var () in
let ex = <:expr< $lid:x$ >> in
<:patt< ($str: String.escaped lab$, Some $lid:x$) >>,
<:expr< $lid:p^lab$ $to_ml ex t$ >>
<:match_case< ($str: String.escaped lab$, Some $lid:x$) ->
$id:id (p ^ lab)$ $to_ml ex t$ >>
| (lab,tl) ->
let vars = mk_vars tl in
let el = tuple_to_ml tl vars in
let x = mk_var () in
<:patt< ($str: String.escaped lab$, Some $lid:x$) >>,
matches <:expr< $lid:x$ >>
<:expr< $lid:p^lab$ ($list:el$) >> vars
<:match_case< ($str: String.escaped lab$, Some $lid:x$) ->
$matches <:expr< $lid:x$ >>
<:expr< $id:id (p ^ lab)$ $tuple_to_ml tl vars$ >>
vars$ >>
) l in
let cases = cases @ [ <:patt< _ >>, <:expr< assert False >> ] in
let cases = cases @ [ <:match_case< _ -> assert False >> ] in
pmatch <:expr< Value.get_variant $e$ >> cases
| Record (_,l,false) ->
failwith "Private Record type"
......@@ -403,9 +409,9 @@ and to_ml_descr e = function
let l =
List.map
(fun (lab,t) ->
(<:patt< $lid:p^lab$>>,
to_ml
<:expr< Value.get_field $x$ $label_ascii lab$ >> t)) l in
let e =
to_ml <:expr< Value.get_field $x$ $label_ascii lab$ >> t in
<:rec_binding< $id: id (p^lab)$ = $e$ >>) l in
<:expr< {$list:l$} >>)
| Abstract "int" -> <:expr< Value.cduce2ocaml_int $e$ >>
......@@ -436,7 +442,9 @@ and to_ml_descr e = function
| Var _ -> e
| _ -> assert false
and tuple_to_ml tl vars = List.map2 (fun t id -> to_ml <:expr< $lid:id$ >> t) tl vars
and tuple_to_ml tl vars =
Ast.exCom_of_list
(List.map2 (fun t id -> to_ml <:expr< $lid:id$ >> t) tl vars)
let to_ml_done = IntHash.create 13
......@@ -450,7 +458,7 @@ let global_transl () =
IntHash.add don hd.uid ();
let p = <:patt< $lid:fun_name hd$ >> in
let e = <:expr< fun x -> $to_descr <:expr< x >> hd.def$ >> in
defs := (p,e) :: !defs
defs := <:binding< $p$ = $e$ >> :: !defs
);
loop ()
and loop () = match !to_cd_gen,!to_ml_gen with
......@@ -500,13 +508,25 @@ let check_value ty_env c_env (s,caml_t,t) =
let x = mk_var () in
let slot = Compile.find_slot id c_env in
let e = to_ml <:expr< slots.($int:string_of_int slot$) >> t in
<:patt< $uid:s$ >>, <:expr< C.$uid:x$ >>, (<:patt< $uid:x$ >>, e)
<:patt< $lid:s$ >>, <:expr< C.$lid:x$ >>, <:binding< $lid:x$ = $e$ >>
module Cleaner = Camlp4.Struct.CleanAst.Make(Ast)
let cleaner = object
inherit Cleaner.clean_ast as super
method str_item st =
match super#str_item st with
| <:str_item< value $rec:_$ $ <:binding< >> $ >> ->
<:str_item< >>
| x -> x
end
let stub ty_env c_env exts values mk prolog =
gen_types := false;
let items = List.map (check_value ty_env c_env) values in
let exts = List.rev_map (fun (s,t) -> to_cd <:expr< $lid:s$ >> t) exts in
let exts = List.rev_map (fun (s,t) -> to_cd <:expr< $id:id s$ >> t) exts in
let g = global_transl () in
let types = get_registered_types () in
......@@ -518,20 +538,21 @@ let stub ty_env c_env exts values mk prolog =
let str_items =
<:str_item<
value ($paCom_of_list items_pat$) =
value $tup:Ast.paCom_of_list items_pat$ =
let module C = struct
open Cduce_lib;
Cduce_config.init_all ();
value (types,set_externals,slots,run) =
Librarian.ocaml_stub $str:String.escaped raw$;
value rec $biAnd_of_list g$;
set_externals [|$exSem_of_list exts$|];
value rec $Ast.biAnd_of_list g$;
set_externals [|$Ast.exSem_of_list exts$|];
run ();
value $biAnd_of_list items_def$;
end in ($exCom_of_list items_expr$) >> in
value $Ast.biAnd_of_list items_def$;
end in $tup:Ast.exCom_of_list items_expr$ >> in
print_endline prolog;
!Pcaml.print_implem str_items
try Printers.OCaml.print_implem (cleaner # str_item str_items)
with exn -> Format.printf "@."; raise exn
(* let exe = Filename.concat (Filename.dirname Sys.argv.(0)) "cdo2ml" in
let oc = Unix.open_process_out exe in
Marshal.to_channel oc str_items [];
......@@ -552,7 +573,7 @@ let stub_ml name ty_env c_env exts mk =
try Mltypes.read_cmi name
with Not_found -> ("",[]) in
stub ty_env c_env exts values mk prolog
with Mltypes.Error s -> raise (Location.Generic s)
with Mltypes.Error s -> raise (Cduce_loc.Generic s)
let register b s args =
......@@ -560,7 +581,7 @@ let register b s args =
let (t,n) = Mltypes.find_value s in
let m = List.length args in
if n <> m then
Location.raise_generic
Cduce_loc.raise_generic
(Printf.sprintf
"Wrong arity for external symbol %s (real arity = %i; given = %i)" s n m);
let i = if b then
......@@ -575,7 +596,7 @@ let register b s args =
vars := [| |];
i,cdt
with Not_found ->
Location.raise_generic
Cduce_loc.raise_generic
(Printf.sprintf "Cannot resolve ocaml external %s" s)
(* Generation of wrappers *)
......@@ -593,8 +614,8 @@ let wrapper values =
<:str_item<
open Cduce_lib;
Cduce_config.init_all ();
value rec $biAnd_of_list g$;
$stSem_of_list exts$;
value rec $Ast.biAnd_of_list g$;
$Ast.stSem_of_list exts$;
>>
let gen_wrapper vals =
......@@ -612,7 +633,7 @@ let gen_wrapper vals =
) [] vals in
wrapper values
with Mltypes.Error s -> raise (Location.Generic s)
with Mltypes.Error s -> raise (Cduce_loc.Generic s)
let make_wrapper fn =
let ic = open_in fn in
......@@ -627,9 +648,9 @@ let make_wrapper fn =
done
with End_of_file -> ());
let s = gen_wrapper !v in
!Pcaml.print_implem [ s,_loc ];
print_endline "let () = Location.obj_path := [";
List.iter (fun s -> Printf.printf " %S;\n" s) !Location.obj_path;
Printers.OCaml.print_implem s;
print_endline "let () = Cduce_loc.obj_path := [";
List.iter (fun s -> Printf.printf " %S;\n" s) !Cduce_loc.obj_path;
print_endline " ];;";
print_endline "let () = Run.main ();;"
......@@ -669,7 +690,7 @@ let register () =
Librarian.make_wrapper := make_wrapper
let () =
Config.register
Cduce_config.register
"ocaml"
"OCaml interface"
register
ocamliface/mlstub.mli
View file @ f775a5cf
val gen_wrapper: string list -> MLast.str_item
open Camlp4.PreCast
val gen_wrapper: string list -> Ast.str_item
ocamliface/mltypes.ml
View file @ f775a5cf
exception Error of string
module Loc = Location
module Loc = Cduce_loc
open Caml_cduce
open Caml_cduce.Types
......
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