Commit a4967d75 authored by Pietro Abate's avatar Pietro Abate

[r2005-10-30 14:23:02 by afrisch] Moving to OCaml 3.09

Original author: afrisch
Date: 2005-10-30 14:23:04+00:00
parent bd51ba1e
0.4.0
- Adapted to OCaml 3.09.
- To build the OCaml/CDuce interface, OCaml sources are now needed.
0.3.92
- Tools:
......
......@@ -26,7 +26,7 @@ Mandatory packages:
Before compiling CDuce, you need to install recent releases of the
following packages:
ocaml >= 3.08.3
ocaml >= 3.09
http://caml.inria.fr/ocaml/distrib.html
findlib >= 1.0.3
http://www.ocaml-programming.de/packages
......@@ -150,39 +150,11 @@ You need a GNU Make (or equivalent). The Makefile defines the following goals:
Building the CDuce/OCaml interface
------------------------------------------------------------------------------
If you want to build the OCaml/CDuce interface, you will need some
parts of the OCaml compilers which are not installed by default with
OCaml. The files you need are the compiled units from the
subdirectories utils/ parsing/ and typing/ of the OCaml standard
distribution (the .cmi files, and either the corresponding .cmo or the
.cmx+.o). If you still have the compiled OCaml source tree that you used
to build the current version of ocamlc/ocamlopt, in, say
$HOME/ocaml-3.07, you can activate the OCaml/CDuce interface with:
./configure --mliface=$HOME/ocaml-3.08
Another option is to copy all the needed files (.cmi,.cmo/.cmx+.o)
to a single directory, say $HOME/ocaml-modules. Then you can do:
./configure --mliface=$HOME/ocaml-modules
(the configure script automatically detect whether the files
are directly in the specified directory, or in utils/ parsing/ typing/
subdirectories)
Note for GODI users:
====================
The GODI distribution provides the required files by default.
The configure script will detect them automatically.
Note for Debian users:
======================
The Debian package ocaml-compiler-libs provides the required files.
The configure script will detect them automatically.
If you want to build the OCaml/CDuce interface, you need a copy
of the OCaml source tree matching your current OCaml version.
You must pass the location of this tree to the configure script:
./configure --mliface=$HOME/ocaml-3.09
------------------------------------------------------------------------------
Note on XML parsers
......
......@@ -47,7 +47,7 @@ else
CAMLOPT_P = ocamlopt -inline 10000
endif
OPT = -warn-error FPS
OPT = -warn-error FPSXY
ANNOT =
INTERFACE =
ifeq ($(ANNOT), true)
......@@ -283,7 +283,7 @@ misc/q_symbol.cmo: misc/q_symbol.ml
.ml.cmx:
@echo "Build $@"
$(HIDE)$(CAMLOPT) -c $(SYNTAX_PARSER) $(INCLUDES) $<
$(HIDE)$(CAMLOPT) -passopt -for-pack -passopt Cduce_lib -c $(SYNTAX_PARSER) $(INCLUDES) $<
.mli.cmi:
@echo "Build $@"
......@@ -317,10 +317,9 @@ install_doc: doc
ocamliface/caml_cduce.cmo:
@cd ocamliface; \
$(MAKE) PREFIX=$(ML_MODULES) MODEL=$(ML_INTERFACE) \
HIDE=$(HIDE) caml_cduce.cmo
$(MAKE) OCAML_SRC=$(OCAML_SRC) HIDE=$(HIDE) caml_cduce.cmo
ocamliface/caml_cduce.cmx:
@cd ocamliface; \
$(MAKE) PREFIX=$(ML_MODULES) MODEL=$(ML_INTERFACE) \
HIDE=$(HIDE) caml_cduce.cmx
$(MAKE) OCAML_SRC=$(OCAML_SRC) HIDE=$(HIDE) caml_cduce.cmx
......@@ -167,16 +167,7 @@ let exe = match Sys.os_type with
| _ -> ""
let check_mliface dir =
log ("Looking for ocaml modules in " ^ dir);
let file = if native then "types.cmx" else "types.cmo" in
if Sys.file_exists (Filename.concat dir file)
then `flat
else
if Sys.file_exists
(Filename.concat (Filename.concat dir "typing") file) then
`tree
else
`not_found
Sys.file_exists (Filename.concat dir "typing/types.ml")
let ocaml_stdlib () =
if (Sys.command "ocamlc -where > ocaml_stdlib" <> 0) then
......@@ -189,26 +180,19 @@ let ocaml_stdlib () =
let ml_interface =
let dir1 = !(List.assoc "mliface" vars) in
let dirs =
let std = ocaml_stdlib () in
Filename.concat (Filename.chop_suffix std "std-lib") "compiler-lib" ::
(* GODI *)
Filename.concat std "compiler-libs" :: (* Debian *)
src_dirs in
let dirs = [] in
let dirs = if dir1 = "" then dirs else dir1 :: dirs in
print "Looking for ocaml compiler modules ...";
print "ocaml sources... ";
let rec loop = function
| [] ->
print "not found\n";
`no
print "not found (the interface will not be built)\n";
None
| d::dirs ->
match check_mliface d with
| `flat -> print ("flat model: " ^ d ^ "\n"); `flat d
| `tree -> print ("tree model: " ^ d ^ "\n"); `tree d
| `not_found -> loop dirs
if check_mliface d then
(print ("found: " ^ d ^ "\n"); Some d)
else loop dirs
in
loop dirs
let pxp = check_feature "pxp" (check_pkg "pxp")
let expat = check_feature "expat" (check_pkg "expat")
......@@ -260,9 +244,8 @@ let () =
fprintf out "# This file has been generated by the configure script\n";
fprintf out "NATIVE=%b\n" native;
(match ml_interface with
| `no -> fprintf out "ML_INTERFACE=false\n"
| `flat d -> fprintf out "ML_INTERFACE=flat\nML_MODULES=%s\n" d
| `tree d -> fprintf out "ML_INTERFACE=tree\nML_MODULES=%s\n" d);
| Some d -> fprintf out "ML_INTERFACE=true\nOCAML_SRC=%s\n" d
| None -> fprintf out "ML_INTERFACE=false\n");
fprintf out "PXP=%b\n" pxp;
fprintf out "EXPAT=%b\n" expat;
fprintf out "CURL=%b\n" curl;
......
......@@ -249,7 +249,6 @@ let prepare_stub src =
let ocaml_stub stub =
let pools, types, (c : t) = Marshal.from_string stub 0 in
let i1,i2 = Compunit.get_hash c.descr in
if Tbl.mem tbl c.name then
failwith ("CDuce unit " ^ (U.get_str c.name) ^ " already loaded");
Value.intract_all pools;
......
......@@ -118,10 +118,10 @@ struct
let advance s i =
match s.[i] with
| '\000'..'\127' as c -> i + 1
| '\192'..'\223' as c -> i + 2
| '\224'..'\239' as c -> i + 3
| '\240'..'\247' as c -> i + 4
| '\000'..'\127' -> i + 1
| '\192'..'\223' -> i + 2
| '\224'..'\239' -> i + 3
| '\240'..'\247' -> i + 4
| _ -> failwith "Malformed UTF-8 bufffer"
(*
let width = Array.create 256 1
......
# This Makefile generates caml_cduce.cmo/.cmx
#
# We need the units such that typing/types.cmo (.cmx)
#
# - If OCaml has been compiled in a directory DIR,
# you can do:
# make MODEL=tree PREFIX=DIR
# e.g.: make caml_cduce.cmo MODEL=tree PREFIX=$HOME/ocaml-3.07
#
# - If you have a (flat) directory DIR will all the compiled units
# from utils/ parsing/ and typing/, you can do:
# make MODEL=flat PREFIX=DIR
# e.g.: make caml_cduce.cmo MODEL=flat PREFIX=$HOME/godi/lib/ocaml/compiler-lib
# It must be called with an OCAML_SRC argument pointing to the root
# of an OCaml source tree.
OCAML_OBJECTS=$(patsubst %,$(PREFIX)/%, $(UNITS))
all: caml_cduce.cmo caml_cduce.cmx
OBJECTS=$(OCAML_OBJECTS)
XOBJECTS=$(OBJECTS:.cmo=.cmx)
STDLIB=$(shell ocamlc -where)
ifeq ($(MODEL),flat)
UNITS= $(subst utils/,,$(UTILS)) \
$(subst parsing/,,$(PARSING)) \
$(subst typing/,,$(TYPING))
INCLUDES = -I $(PREFIX)
ASTTYPES = $(PREFIX)/asttypes.cmi
else
ifeq ($(MODEL),tree)
UNITS= $(UTILS) $(PARSING) $(TYPING)
INCLUDES = -I $(PREFIX)/utils -I $(PREFIX)/parsing -I $(PREFIX)/typing
ASTTYPES = $(PREFIX)/parsing/asttypes.cmi
else
$(error Set MODEL=flat or MODEL=tree)
endif
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
sed s=STDLIB=$(STDLIB)= config.ml > ocaml_files/config.ml
caml_cduce.cmo:
caml_cduce.cmo: ocaml_files
@echo "Build $@"
$(HIDE)ocamlc -pack -o $@ $(INCLUDES) $(OBJECTS)
(cd ocaml_files; ocamlc -for-pack Cduce_lib.Caml_cduce $@ -c $(COMPILE_FILES);\
ocamlc -for-pack Cduce_lib -pack -o $@ $(OBJECTS); \
cp caml_cduce.cmo caml_cduce.cmi ..)
caml_cduce.cmx:
caml_cduce.cmx: ocaml_files
@echo "Build $@"
$(HIDE)ocamlopt -pack -o $@ $(INCLUDES) $(XOBJECTS)
## Hack to rebuild asttypes.ml from asttypes.cmi
## (because -pack needs .cmo in 3.07)
.PHONY: asttypes.ml
asttypes.ml: cmi2ml
@echo "Create $@"
$(HIDE)./cmi2ml Asttypes $(ASTTYPES) > asttypes.ml
asttypes.mli: asttypes.ml
cp asttypes.ml asttypes.mli
cmi2ml: cmi2ml.ml
@echo "Build $@"
$(HIDE)ocamlc -o $@ $(INCLUDES) $(OCAML_OBJECTS) $<
UTILS=utils/misc.cmo utils/tbl.cmo utils/config.cmo \
utils/clflags.cmo utils/consistbl.cmo utils/warnings.cmo utils/terminfo.cmo
PARSING=parsing/linenum.cmo parsing/location.cmo parsing/longident.cmo parsing/asttypes.cmi
TYPING=typing/ident.cmo typing/path.cmo \
typing/primitive.cmo typing/types.cmo \
typing/btype.cmo typing/oprint.cmo \
typing/subst.cmo typing/predef.cmo \
typing/datarepr.cmo typing/env.cmo \
typing/ctype.cmo typing/printtyp.cmo
(cd ocaml_files; ocamlopt -for-pack Cduce_lib.Caml_cduce $@ -c $(COMPILE_FILES);\
ocamlopt -for-pack Cduce_lib -pack -o $@ $(XOBJECTS); \
cp caml_cduce.cmx caml_cduce.o caml_cduce.cmi ..)
clean:
rm -Rf ocaml_files *~ *.cm*
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 \
typing/ident.ml typing/path.ml \
typing/primitive.ml typing/types.ml \
typing/btype.ml typing/oprint.ml \
typing/subst.ml typing/predef.ml \
typing/datarepr.ml typing/env.ml \
typing/ctype.ml typing/ctype.mli typing/printtyp.ml
COMPILE_FILES=\
config.ml misc.ml tbl.ml \
clflags.ml consistbl.ml warnings.ml terminfo.ml \
location.ml asttypes.ml longident.ml \
ident.ml path.ml \
primitive.ml types.ml \
btype.ml oprint.ml \
subst.ml predef.ml \
datarepr.ml env.ml ctype.mli ctype.ml printtyp.ml
COMPILE_FILES_ML=$(filter %.ml,$(COMPILE_FILES))
OBJECTS=$(COMPILE_FILES_ML:.ml=.cmo)
XOBJECTS=$(COMPILE_FILES_ML:.ml=.cmx)
\ No newline at end of file
(*
let list_lit el =
List.fold_right (fun a e -> <:expr< [$a$ :: $e$] >>) el <:expr< [] >>
*)
let () =
let str_items = Marshal.from_channel stdin in
!Pcaml.print_implem str_items
let () =
let sg = Env.read_signature Sys.argv.(1) Sys.argv.(2) in
Printtyp.signature Format.std_formatter sg
let standard_library = "STDLIB"
let load_path = ref ([] : string list)
let cmi_magic_number = "Caml1999I010"
let bytecomp_c_compiler = ""
let bytecomp_c_linker = ""
open Lexing
type t = { loc_start: position; loc_end: position; loc_ghost: bool }
let loc = (Lexing.dummy_pos, Lexing.dummy_pos)
let usage =
"Usage: mlcduce_wrapper [-I path ...] <primitive file>
"
let err s = prerr_endline s; prerr_endline usage; exit 1
let rec args = function
| "-I"::path::rest ->
Librarian.obj_path := path::!Librarian.obj_path;
args rest
| [p] -> p
| _ -> err "Invalid command line"
let () =
let fn = args (List.tl (Array.to_list Sys.argv)) in
let ic =
try open_in fn
with Sys_error s -> err s in
let v = ref [] in
(try while true do
let s = input_line ic in
if s <> "" then
match s.[0] with
| 'A'..'Z' -> v := s :: !v
| '#' -> ()
| _ -> err "Names must start with a capitalized letter"
done
with End_of_file -> ());
let s = Mlstub.gen_wrapper !v in
!Pcaml.print_implem [ s,loc ];
print_endline "let () = Librarian.obj_path := [";
List.iter (fun s -> Printf.printf " %S;\n" s) !Librarian.obj_path;
print_endline " ];;";
print_endline "let () = Run.main ();;"
......@@ -77,7 +77,7 @@ let mk_var _ =
let mk_vars = List.map mk_var
let loc = (Lexing.dummy_pos,Lexing.dummy_pos)
let _loc = (Lexing.dummy_pos,Lexing.dummy_pos)
let let_in p e body =
<:expr< let $list:[ p, e ]$ in $body$ >>
......@@ -348,7 +348,6 @@ and to_ml_descr e = function
| "B",Some x -> `B (t(x))
| _ -> assert false
*)
let x = mk_var () in
let cases =
List.map
(function
......@@ -637,7 +636,7 @@ let make_wrapper fn =
done
with End_of_file -> ());
let s = gen_wrapper !v in
!Pcaml.print_implem [ s,loc ];
!Pcaml.print_implem [ s,_loc ];
print_endline "let () = Librarian.obj_path := [";
List.iter (fun s -> Printf.printf " %S;\n" s) !Librarian.obj_path;
print_endline " ];;";
......
......@@ -2,8 +2,7 @@ exception Error of string
module Loc = Location
open Caml_cduce
open Asttypes
open Types
open Caml_cduce.Types
(* Unfolding of OCaml types *)
......@@ -168,10 +167,10 @@ let rec unfold_constr env p args =
let cstrs =
List.map
(fun (cst,f) -> (cst,List.map (unfold env) f)) cstrs in
Variant (prefix, cstrs, pub = Public)
Variant (prefix, cstrs, pub = Caml_cduce.Asttypes.Public)
| Type_record (f,_,pub), _ ->
let f = List.map (fun (l,_,t) -> (l,unfold env t)) f in
Record (prefix, f, pub = Public)
Record (prefix, f, pub = Caml_cduce.Asttypes.Public)
| Type_abstract, Some t ->
Link (unfold env t)
| Type_abstract, None ->
......
This diff is collapsed.
......@@ -30,8 +30,6 @@ let rec push p s =
if Url.is_url s then Expat.parse p (Url.load_url s)
else load_from_file p s
with Expat.Expat_error e ->
let line = Expat.get_current_line_number p
and col = Expat.get_current_column_number p in
let msg =
Printf.sprintf
"load_xml,%s at line %i, column %i: %s"
......
......@@ -33,8 +33,7 @@ let merge_facets old_facets new_facets =
| Some _, Some _ -> assert false
| v -> v
in
{ old_facets with
length =
{ length =
(match new_facets.length with
| None -> old_facets.length
| v -> v);
......
......@@ -414,7 +414,6 @@ and validate_content_type ctx content_type =
| CT_simple st_def ->
validate_simple_type st_def (get_string ctx)
| CT_model (particle, mixed) ->
let mixold = ctx.ctx_mixed in
let ctx = subctx mixed ctx in
validate_particle ctx particle;
get ctx
......@@ -431,15 +430,14 @@ and validate_particle ctx particle =
cont_failure ev
in
let rec required = function
| 0 -> ()
| n ->
| 0 -> () | n ->
validate_once
~cont_ok:(fun () -> required (pred n))
~cont_failure:(fun event ->
if particle.part_nullable then ()
else
error ~ctx (sprintf "Unexpected content: %s"
(string_of_event event)))
error (sprintf "Unexpected content: %s"
(string_of_event event)))
in
let rec optional = function
| None ->
......@@ -482,7 +480,6 @@ and validate_all_group ctx particles =
let tbl = Atoms.mk_map
(List.map (fun (p,slot) -> p.part_first, (p,slot)) slots) in
let contents = ref Value.nil in
let rec aux () =
match peek ctx with
| E_start_tag q ->
......
......@@ -334,7 +334,7 @@ and filter_prod ?kind fv p1 p2 t =
and filter_node t p : Types.Positive.v id_map =
try MemoFilter.find (t,p) !memo_filter
with Not_found ->
let (_,fv,_) as d = descr p in
let (_,fv,_) = descr p in
let res = IdMap.map_from_slist (fun _ -> Types.Positive.forward ()) fv in
memo_filter := MemoFilter.add (t,p) res !memo_filter;
let r = filter_descr t (descr p) in
......@@ -364,7 +364,7 @@ module Factorize = struct
[DEBUG:approx]
x=(1,2)
*)
let rec approx_var seen ((a,fv,d) as p) t xs =
let rec approx_var seen (a,fv,d) t xs =
(* assert (Types.subtype t a);
assert (IdSet.subset xs fv); *)
if (IdSet.is_empty xs) || (Types.is_empty t) then xs
......@@ -400,7 +400,7 @@ x=(1,2)
(* Obviously not complete ! *)
let rec approx_nil seen ((a,fv,d) as p) t xs =
let rec approx_nil seen (a,fv,d) t xs =
assert (Types.subtype t a);
assert (IdSet.subset xs fv);
if (IdSet.is_empty xs) || (Types.is_empty t) then xs
......@@ -661,7 +661,7 @@ module Normal = struct
let nconstant lab x c = nany lab (IdMap.singleton x (SConst c))
let ncapture lab x = nany lab (IdMap.singleton x SCatch)
let rec nnormal lab ((acc,fv,d) as p) xs =
let rec nnormal lab (acc,fv,d) xs =
let xs = IdSet.cap xs fv in
if Types.is_empty acc then nempty lab
else if IdSet.is_empty xs then nconstr lab acc
......
......@@ -213,7 +213,7 @@ module Map = struct
let rec cap f l1 l2 =
match (l1,l2) with
| ((x1,y1) as t1)::q1, ((x2,y2) as t2)::q2 ->
| (x1,y1)::q1, (x2,y2)::q2 ->
let c = X.compare x1 x2 in
if c = 0 then (x1,(f y1 y2))::(cap f q1 q2)
else if c < 0 then cap f q1 l2
......@@ -222,7 +222,7 @@ module Map = struct
let rec sub f l1 l2 =
match (l1,l2) with
| ((x1,y1) as t1)::q1, ((x2,y2) as t2)::q2 ->
| ((x1,y1) as t1)::q1, (x2,y2)::q2 ->
let c = X.compare x1 x2 in
if c = 0 then (x1,(f y1 y2))::(sub f q1 q2)
else if c < 0 then t1::(sub f q1 l2)
......
......@@ -1094,7 +1094,7 @@ struct
if l == Label.dummy then
let (some1,none1) = empty_cases d1
and (some2,none2) = empty_cases d2 in
let none = none1 && none2 and some = some1 || some2 in
let _none = none1 && none2 and some = some1 || some2 in
let accu = LabelMap.from_list (fun _ _ -> assert false) accu in
(* approx for the case (some && not none) ... *)
res := cup !res (record_fields (some, accu))
......
......@@ -172,7 +172,7 @@ let deferr s = raise (Patterns.Error s)
| IRecord (_,r,_) -> LabelMap.iter (iter_field f) r
| _ -> ()
let minimize ((mem,add) as h) =
let minimize (mem,add) =
let rec aux n =
let n = repr n in
if mem n then () else (
......
......@@ -414,7 +414,6 @@ module IType = struct
if (loc <> noloc) && (Types.is_empty t) then
warning loc
("This definition yields an empty type for " ^ (U.to_string v));
let v = ident env loc v in
(v',t)) b b' in
List.iter (fun (v,t) -> Types.Print.register_global "" v t) b;
enter_types b env
......@@ -1018,7 +1017,6 @@ and type_check_string loc env ofs s i j e constr precise =
if Types.Product.is_empty rects
then should_have_str loc ofs constr "but it is a string"
else
let need_s = Types.Product.need_second rects in
let (ch,i') = U.next s i in
let ch = Chars.V.mk_int ch in
let tch = Types.constant (Types.Char ch) in
......
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