Skip to content

C
cduce
Commit 9062d6f1 authored by Julien Lopez's avatar Julien Lopez
Browse files
Options

Fix test schema/po2.xsd

parent c96cecb2
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 14 additions and 8886 deletions
ocamliface/ocaml_files/annot.mli deleted 100644 → 0
View file @ c96cecb2
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Damien Doligez, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2007 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* Data types for annotations (Stypes.ml) *)
type call = Tail | Stack | Inline;;
type ident =
| Iref_internal of Location.t (* defining occurrence *)
| Iref_external
| Idef of Location.t (* scope *)
;;
ocamliface/ocaml_files/asttypes.mli deleted 100644 → 0
View file @ c96cecb2
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* Auxiliary a.s.t. types used by parsetree and typedtree. *)
type constant =
Const_int of int
| Const_char of char
| Const_string of string
| Const_float of string
| Const_int32 of int32
| Const_int64 of int64
| Const_nativeint of nativeint
type rec_flag = Nonrecursive | Recursive | Default
type direction_flag = Upto | Downto
type private_flag = Private | Public
type mutable_flag = Immutable | Mutable
type virtual_flag = Virtual | Concrete
type override_flag = Override | Fresh
type closed_flag = Closed | Open
type label = string
ocamliface/ocaml_files/btype.ml deleted 100644 → 0
View file @ c96cecb2
This diff is collapsed.
ocamliface/ocaml_files/clflags.ml deleted 100644 → 0
View file @ c96cecb2
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* Command-line parameters *)
let objfiles = ref ([] : string list) (* .cmo and .cma files *)
and ccobjs = ref ([] : string list) (* .o, .a, .so and -cclib -lxxx *)
and dllibs = ref ([] : string list) (* .so and -dllib -lxxx *)
let compile_only = ref false (* -c *)
and output_name = ref (None : string option) (* -o *)
and include_dirs = ref ([] : string list)(* -I *)
and no_std_include = ref false (* -nostdlib *)
and print_types = ref false (* -i *)
and make_archive = ref false (* -a *)
and debug = ref false (* -g *)
and fast = ref false (* -unsafe *)
and link_everything = ref false (* -linkall *)
and custom_runtime = ref false (* -custom *)
and output_c_object = ref false (* -output-obj *)
and ccopts = ref ([] : string list) (* -ccopt *)
and classic = ref false (* -nolabels *)
and nopervasives = ref false (* -nopervasives *)
and preprocessor = ref(None : string option) (* -pp *)
let annotations = ref false (* -annot *)
and use_threads = ref false (* -thread *)
and use_vmthreads = ref false (* -vmthread *)
and noassert = ref false (* -noassert *)
and verbose = ref false (* -verbose *)
and noprompt = ref false (* -noprompt *)
and init_file = ref (None : string option) (* -init *)
and use_prims = ref "" (* -use-prims ... *)
and use_runtime = ref "" (* -use-runtime ... *)
and principal = ref false (* -principal *)
and recursive_types = ref false (* -rectypes *)
and strict_sequence = ref false (* -strict-sequence *)
and applicative_functors = ref true (* -no-app-funct *)
and make_runtime = ref false (* -make_runtime *)
and gprofile = ref false (* -p *)
and c_compiler = ref (None: string option) (* -cc *)
and no_auto_link = ref false (* -noautolink *)
and dllpaths = ref ([] : string list) (* -dllpath *)
and make_package = ref false (* -pack *)
and for_package = ref (None: string option) (* -for-pack *)
let dump_parsetree = ref false (* -dparsetree *)
and dump_rawlambda = ref false (* -drawlambda *)
and dump_lambda = ref false (* -dlambda *)
and dump_instr = ref false (* -dinstr *)
let keep_asm_file = ref false (* -S *)
let optimize_for_speed = ref true (* -compact *)
and dump_cmm = ref false (* -dcmm *)
let dump_selection = ref false (* -dsel *)
let dump_live = ref false (* -dlive *)
let dump_spill = ref false (* -dspill *)
let dump_split = ref false (* -dsplit *)
let dump_scheduling = ref false (* -dscheduling *)
let dump_interf = ref false (* -dinterf *)
let dump_prefer = ref false (* -dprefer *)
let dump_regalloc = ref false (* -dalloc *)
let dump_reload = ref false (* -dreload *)
let dump_scheduling = ref false (* -dscheduling *)
let dump_linear = ref false (* -dlinear *)
let keep_startup_file = ref false (* -dstartup *)
let dump_combine = ref false (* -dcombine *)
let native_code = ref false (* set to true under ocamlopt *)
let inline_threshold = ref 10
let dont_write_files = ref false (* set to true under ocamldoc *)
let std_include_flag prefix =
if !no_std_include then ""
else (prefix ^ (Filename.quote Config.standard_library))
;;
let std_include_dir () =
if !no_std_include then [] else [Config.standard_library]
;;
let shared = ref false (* -shared *)
let dlcode = ref true (* not -nodynlink *)
ocamliface/ocaml_files/consistbl.ml deleted 100644 → 0
View file @ c96cecb2
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 2002 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* Consistency tables: for checking consistency of module CRCs *)
type t = (string, Digest.t * string) Hashtbl.t
let create () = Hashtbl.create 13
let clear = Hashtbl.clear
exception Inconsistency of string * string * string
exception Not_available of string
let check tbl name crc source =
try
let (old_crc, old_source) = Hashtbl.find tbl name in
if crc <> old_crc then raise(Inconsistency(name, source, old_source))
with Not_found ->
Hashtbl.add tbl name (crc, source)
let check_noadd tbl name crc source =
try
let (old_crc, old_source) = Hashtbl.find tbl name in
if crc <> old_crc then raise(Inconsistency(name, source, old_source))
with Not_found ->
raise (Not_available name)
let set tbl name crc source = Hashtbl.add tbl name (crc, source)
let source tbl name = snd (Hashtbl.find tbl name)
let extract tbl =
Hashtbl.fold (fun name (crc, auth) accu -> (name, crc) :: accu) tbl []
let filter p tbl =
let to_remove = ref [] in
Hashtbl.iter
(fun name (crc, auth) ->
if not (p name) then to_remove := name :: !to_remove)
tbl;
List.iter
(fun name ->
while Hashtbl.mem tbl name do Hashtbl.remove tbl name done)
!to_remove
ocamliface/ocaml_files/ctype.ml deleted 100644 → 0
View file @ c96cecb2
This source diff could not be displayed because it is too large. You can view the blob instead.
ocamliface/ocaml_files/ctype.mli deleted 100644 → 0
View file @ c96cecb2
This diff is collapsed.
ocamliface/ocaml_files/datarepr.ml deleted 100644 → 0
View file @ c96cecb2
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* Compute constructor and label descriptions from type declarations,
determining their representation. *)
open Misc
open Asttypes
open Types
let constructor_descrs ty_res cstrs priv =
let num_consts = ref 0 and num_nonconsts = ref 0 in
List.iter
(function (name, []) -> incr num_consts
| (name, _) -> incr num_nonconsts)
cstrs;
let rec describe_constructors idx_const idx_nonconst = function
[] -> []
| (name, ty_args) :: rem ->
let (tag, descr_rem) =
match ty_args with
[] -> (Cstr_constant idx_const,
describe_constructors (idx_const+1) idx_nonconst rem)
| _ -> (Cstr_block idx_nonconst,
describe_constructors idx_const (idx_nonconst+1) rem) in
let cstr =
{ cstr_res = ty_res;
cstr_args = ty_args;
cstr_arity = List.length ty_args;
cstr_tag = tag;
cstr_consts = !num_consts;
cstr_nonconsts = !num_nonconsts;
cstr_private = priv } in
(name, cstr) :: descr_rem in
describe_constructors 0 0 cstrs
let exception_descr path_exc decl =
{ cstr_res = Predef.type_exn;
cstr_args = decl;
cstr_arity = List.length decl;
cstr_tag = Cstr_exception path_exc;
cstr_consts = -1;
cstr_nonconsts = -1;
cstr_private = Public }
let none = {desc = Ttuple []; level = -1; id = -1}
(* Clearly ill-formed type *)
let dummy_label =
{ lbl_name = ""; lbl_res = none; lbl_arg = none; lbl_mut = Immutable;
lbl_pos = (-1); lbl_all = [||]; lbl_repres = Record_regular;
lbl_private = Public }
let label_descrs ty_res lbls repres priv =
let all_labels = Array.create (List.length lbls) dummy_label in
let rec describe_labels num = function
[] -> []
| (name, mut_flag, ty_arg) :: rest ->
let lbl =
{ lbl_name = name;
lbl_res = ty_res;
lbl_arg = ty_arg;
lbl_mut = mut_flag;
lbl_pos = num;
lbl_all = all_labels;
lbl_repres = repres;
lbl_private = priv } in
all_labels.(num) <- lbl;
(name, lbl) :: describe_labels (num+1) rest in
describe_labels 0 lbls
exception Constr_not_found
let rec find_constr tag num_const num_nonconst = function
[] ->
raise Constr_not_found
| (name, [] as cstr) :: rem ->
if tag = Cstr_constant num_const
then cstr
else find_constr tag (num_const + 1) num_nonconst rem
| (name, _ as cstr) :: rem ->
if tag = Cstr_block num_nonconst
then cstr
else find_constr tag num_const (num_nonconst + 1) rem
let find_constr_by_tag tag cstrlist =
find_constr tag 0 0 cstrlist
ocamliface/ocaml_files/env.ml deleted 100644 → 0
View file @ c96cecb2
This diff is collapsed.
ocamliface/ocaml_files/ident.ml deleted 100644 → 0
View file @ c96cecb2
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
open Format
type t = { stamp: int; name: string; mutable flags: int }
let global_flag = 1
let predef_exn_flag = 2
(* A stamp of 0 denotes a persistent identifier *)
let currentstamp = ref 0
let create s =
incr currentstamp;
{ name = s; stamp = !currentstamp; flags = 0 }
let create_predef_exn s =
incr currentstamp;
{ name = s; stamp = !currentstamp; flags = predef_exn_flag }
let create_persistent s =
{ name = s; stamp = 0; flags = global_flag }
let rename i =
incr currentstamp;
{ i with stamp = !currentstamp }
let name i = i.name
let stamp i = i.stamp
let unique_name i = i.name ^ "_" ^ string_of_int i.stamp
let unique_toplevel_name i = i.name ^ "/" ^ string_of_int i.stamp
let persistent i = (i.stamp = 0)
let equal i1 i2 = i1.name = i2.name
let same i1 i2 = i1 = i2
(* Possibly more efficient version (with a real compiler, at least):
if i1.stamp <> 0
then i1.stamp = i2.stamp
else i2.stamp = 0 && i1.name = i2.name *)
let binding_time i = i.stamp
let current_time() = !currentstamp
let set_current_time t = currentstamp := max !currentstamp t
let reinit_level = ref (-1)
let reinit () =
if !reinit_level < 0
then reinit_level := !currentstamp
else currentstamp := !reinit_level
let hide i =
{ i with stamp = -1 }
let make_global i =
i.flags <- i.flags lor global_flag
let global i =
(i.flags land global_flag) <> 0
let is_predef_exn i =
(i.flags land predef_exn_flag) <> 0
let print ppf i =
match i.stamp with
| 0 -> fprintf ppf "%s!" i.name
| -1 -> fprintf ppf "%s#" i.name
| n -> fprintf ppf "%s/%i%s" i.name n (if global i then "g" else "")
type 'a tbl =
Empty
| Node of 'a tbl * 'a data * 'a tbl * int
and 'a data =
{ ident: t;
data: 'a;
previous: 'a data option }
let empty = Empty
(* Inline expansion of height for better speed
* let height = function
* Empty -> 0
* | Node(_,_,_,h) -> h
*)
let mknode l d r =
let hl = match l with Empty -> 0 | Node(_,_,_,h) -> h
and hr = match r with Empty -> 0 | Node(_,_,_,h) -> h in
Node(l, d, r, (if hl >= hr then hl + 1 else hr + 1))
let balance l d r =
let hl = match l with Empty -> 0 | Node(_,_,_,h) -> h
and hr = match r with Empty -> 0 | Node(_,_,_,h) -> h in
if hl > hr + 1 then
match l with
| Node (ll, ld, lr, _)
when (match ll with Empty -> 0 | Node(_,_,_,h) -> h) >=
(match lr with Empty -> 0 | Node(_,_,_,h) -> h) ->
mknode ll ld (mknode lr d r)
| Node (ll, ld, Node(lrl, lrd, lrr, _), _) ->
mknode (mknode ll ld lrl) lrd (mknode lrr d r)
| _ -> assert false
else if hr > hl + 1 then
match r with
| Node (rl, rd, rr, _)
when (match rr with Empty -> 0 | Node(_,_,_,h) -> h) >=
(match rl with Empty -> 0 | Node(_,_,_,h) -> h) ->
mknode (mknode l d rl) rd rr
| Node (Node (rll, rld, rlr, _), rd, rr, _) ->
mknode (mknode l d rll) rld (mknode rlr rd rr)
| _ -> assert false
else
mknode l d r
let rec add id data = function
Empty ->
Node(Empty, {ident = id; data = data; previous = None}, Empty, 1)
| Node(l, k, r, h) ->
let c = compare id.name k.ident.name in
if c = 0 then
Node(l, {ident = id; data = data; previous = Some k}, r, h)
else if c < 0 then
balance (add id data l) k r
else
balance l k (add id data r)
let rec find_stamp s = function
None ->
raise Not_found
| Some k ->
if k.ident.stamp = s then k.data else find_stamp s k.previous
let rec find_same id = function
Empty ->
raise Not_found
| Node(l, k, r, _) ->
let c = compare id.name k.ident.name in
if c = 0 then
if id.stamp = k.ident.stamp
then k.data
else find_stamp id.stamp k.previous
else
find_same id (if c < 0 then l else r)
let rec find_name name = function
Empty ->
raise Not_found
| Node(l, k, r, _) ->
let c = compare name k.ident.name in
if c = 0 then
k.data
else
find_name name (if c < 0 then l else r)
let rec keys_aux stack accu = function
Empty ->
begin match stack with
[] -> accu
| a :: l -> keys_aux l accu a
end
| Node(l, k, r, _) ->
keys_aux (l :: stack) (k.ident :: accu) r
let keys tbl = keys_aux [] [] tbl
ocamliface/ocaml_files/location.mli deleted 100644 → 0
View file @ c96cecb2
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* Source code locations (ranges of positions), used in parsetree. *)
open Format
type t = {
loc_start: Lexing.position;
loc_end: Lexing.position;
loc_ghost: bool;
}
(* Note on the use of Lexing.position in this module.
If [pos_fname = ""], then use [!input_name] instead.
If [pos_lnum = -1], then [pos_bol = 0]. Use [pos_cnum] and
re-parse the file to get the line and character numbers.
Else all fields are correct.
*)
val none : t
(** An arbitrary value of type [t]; describes an empty ghost range. *)
val in_file : string -> t;;
(** Return an empty ghost range located in a given file. *)
val init : Lexing.lexbuf -> string -> unit
(** Set the file name and line number of the [lexbuf] to be the start
of the named file. *)
val curr : Lexing.lexbuf -> t
(** Get the location of the current token from the [lexbuf]. *)
val symbol_rloc: unit -> t
val symbol_gloc: unit -> t
val rhs_loc: int -> t
val input_name: string ref
val input_lexbuf: Lexing.lexbuf option ref
val get_pos_info : Lexing.position -> string * int * int (* file, line, char *)
val print_error: formatter -> t -> unit
val print_error_cur_file: formatter -> unit
val print_warning: t -> formatter -> Warnings.t -> unit
val prerr_warning: t -> Warnings.t -> unit
val echo_eof: unit -> unit
val reset: unit -> unit
val highlight_locations: formatter -> t -> t -> bool
ocamliface/ocaml_files/longident.ml deleted 100644 → 0
View file @ c96cecb2
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
type t =
Lident of string
| Ldot of t * string
| Lapply of t * t
let rec flat accu = function
Lident s -> s :: accu
| Ldot(lid, s) -> flat (s :: accu) lid
| Lapply(l1, l2) -> Misc.fatal_error "Longident.flat"
let flatten lid = flat [] lid
let last = function
Lident s -> s
| Ldot(lid, s) -> s
| Lapply(l1, l2) -> Misc.fatal_error "Longident.last"
let rec split_at_dots s pos =
try
let dot = String.index_from s pos '.' in
String.sub s pos (dot - pos) :: split_at_dots s (dot + 1)
with Not_found ->
[String.sub s pos (String.length s - pos)]
let parse s =
match split_at_dots s 0 with
[] -> Lident "" (* should not happen, but don't put assert false
so as not to crash the toplevel (see Genprintval) *)
| hd :: tl -> List.fold_left (fun p s -> Ldot(p, s)) (Lident hd) tl
ocamliface/ocaml_files/misc.ml deleted 100644 → 0
View file @ c96cecb2
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* Errors *)
exception Fatal_error
let fatal_error msg =
prerr_string ">> Fatal error: "; prerr_endline msg; raise Fatal_error
(* Exceptions *)
let try_finally f1 f2 =
try
let result = f1 () in
f2 ();
result
with x -> f2 (); raise x
;;
(* List functions *)
let rec map_end f l1 l2 =
match l1 with
[] -> l2
| hd::tl -> f hd :: map_end f tl l2
let rec map_left_right f = function
[] -> []
| hd::tl -> let res = f hd in res :: map_left_right f tl
let rec for_all2 pred l1 l2 =
match (l1, l2) with
([], []) -> true
| (hd1::tl1, hd2::tl2) -> pred hd1 hd2 && for_all2 pred tl1 tl2
| (_, _) -> false
let rec replicate_list elem n =
if n <= 0 then [] else elem :: replicate_list elem (n-1)
let rec list_remove x = function
[] -> []
| hd :: tl ->
if hd = x then tl else hd :: list_remove x tl
let rec split_last = function
[] -> assert false
| [x] -> ([], x)
| hd :: tl ->
let (lst, last) = split_last tl in
(hd :: lst, last)
let rec samelist pred l1 l2 =
match (l1, l2) with
| ([], []) -> true
| (hd1 :: tl1, hd2 :: tl2) -> pred hd1 hd2 && samelist pred tl1 tl2
| (_, _) -> false
(* Options *)
let may f = function
Some x -> f x
| None -> ()
let may_map f = function
Some x -> Some (f x)
| None -> None
(* File functions *)
let find_in_path path name =
if not (Filename.is_implicit name) then
if Sys.file_exists name then name else raise Not_found
else begin
let rec try_dir = function
[] -> raise Not_found
| dir::rem ->
let fullname = Filename.concat dir name in
if Sys.file_exists fullname then fullname else try_dir rem
in try_dir path
end
let find_in_path_uncap path name =
let uname = String.uncapitalize name in
let rec try_dir = function
[] -> raise Not_found
| dir::rem ->
let fullname = Filename.concat dir name
and ufullname = Filename.concat dir