+OCaml 4.00.1:
+-------------
+
+Bug fixes:
+- PR#4019: better documentation of Str.matched_string
+- PR#5111: ocamldoc, heading tags inside spans tags is illegal in html
+- PR#5278: better error message when typing "make"
+- PR#5468: ocamlbuild should preserve order of parametric tags
+- PR#5563: harden Unix.select against file descriptors above FD_SETSIZE
+- PR#5690: "ocamldoc ... -text README" raises exception
+- PR#5700: crash with native-code stack backtraces under MacOS 10.8 x86-64
+- PR#5707: AMD64 code generator: do not use r10 and r11 for parameter passing,
+ as these registers can be destroyed by the dynamic loader
+- PR#5712: some documentation problems
+- PR#5715: configuring with -no-shared-libs breaks under cygwin
+- PR#5718: false positive on 'unused constructor' warning
+- PR#5719: ocamlyacc generates code that is not warning 33-compliant
+- PR#5725: ocamldoc output of preformatted code
+- PR#5727: emacs caml-mode indents shebang line in toplevel scripts
+- PR#5729: tools/untypeast.ml creates unary Pexp_tuple
+- PR#5731: instruction scheduling forgot to account for destroyed registers
+- PR#5735: %apply and %revapply not first class citizens
+- PR#5738: first class module patterns not handled by ocamldep
+- PR#5742: missing bound checks in Array.sub
+- PR#5744: ocamldoc error on "val virtual"
+- PR#5757: GC compaction bug (crash)
+- PR#5758: Compiler bug when matching on floats
+- PR#5761: Incorrect bigarray custom block size
+
+
OCaml 4.00.0:
-------------
- The official name of the language is now OCaml.
Language features:
-- Added Generalized Abstract Data Types (GADTs) to the language.
+- Added Generalized Algebraic Data Types (GADTs) to the language.
See chapter "Language extensions" of the reference manual for documentation.
- It is now possible to omit type annotations when packing and unpacking
first-class modules. The type-checker attempts to infer it from the context.
- PR#5261, PR#5497: Ocaml source-code examples are not "copy-paste-able"
* PR#5279: executable name is not initialized properly in caml_startup_code
- PR#5290: added hash functions for channels, nats, mutexes, conditions
+- PR#5291: undetected loop in class initialization
- PR#5295: OS threads: problem with caml_c_thread_unregister()
- PR#5301: camlp4r and exception equal to another one with parameters
- PR#5305: prevent ocamlbuild from complaining about links to _build/
- PR#5518: segfault with lazy empty array
- PR#5531: Allow ocamlbuild to add ocamldoc flags through -docflag
and -docflags switches
-- PR#5543: in Bigarray.map_file, try to avoid using lseek() when growing file
- PR#5538: combining -i and -annot in ocamlc
+- PR#5543: in Bigarray.map_file, try to avoid using lseek() when growing file
- PR#5648: (probably fixed) test failures in tests/lib-threads
- PR#5551: repeated calls to find_in_path degrade performance
- PR#5552: Mac OS X: unrecognized gcc option "-no-cpp-precomp"
# #
#########################################################################
-# $Id: Makefile 12750 2012-07-20 08:06:01Z doligez $
+# $Id: Makefile 12929 2012-09-17 16:23:06Z doligez $
# The main Makefile
@echo "Please refer to the installation instructions in file INSTALL."
@echo "If you've just unpacked the distribution, something like"
@echo " ./configure"
- @echo " make world"
- @echo " make opt"
+ @echo " make world.opt"
@echo " make install"
@echo "should work. But see the file INSTALL for more details."
world.opt:
$(MAKE) coldstart
$(MAKE) opt.opt
- $(MAKE) ocamltoolsopt
# Hard bootstrap how-to:
# (only necessary in some cases, for example if you remove some primitive)
# Native-code versions of the tools
opt.opt: checkstack runtime core ocaml opt-core ocamlc.opt otherlibraries \
$(DEBUGGER) ocamldoc ocamlbuild.byte $(CAMLP4OUT) \
- ocamlopt.opt otherlibrariesopt ocamllex.opt ocamltoolsopt.opt \
- ocamldoc.opt ocamlbuild.native $(CAMLP4OPT)
+ ocamlopt.opt otherlibrariesopt ocamllex.opt \
+ ocamltoolsopt ocamltoolsopt.opt ocamldoc.opt ocamlbuild.native \
+ $(CAMLP4OPT)
base.opt: checkstack runtime core ocaml opt-core ocamlc.opt otherlibraries \
ocamlbuild.byte $(CAMLP4OUT) $(DEBUGGER) ocamldoc ocamlopt.opt \
.PHONY: partialclean beforedepend alldepend cleanboot coldstart
.PHONY: compare core coreall
.PHONY: coreboot defaultentry depend distclean install installopt
-.PHONY: library library-cross libraryopt ocamlbuild-mixed-boot
+.PHONY: library library-cross libraryopt
.PHONY: ocamlbuild.byte ocamlbuild.native ocamldebugger ocamldoc
.PHONY: ocamldoc.opt ocamllex ocamllex.opt ocamltools ocamltoolsopt
.PHONY: ocamltoolsopt.opt ocamlyacc opt-core opt opt.opt otherlibraries
-4.00.0
+4.00.1
# The version string is the first line of this file.
# It must be in the format described in stdlib/sys.mli
-# $Id: VERSION 12779 2012-07-26 09:34:15Z doligez $
+# $Id: VERSION 12983 2012-10-03 15:11:00Z doligez $
(* *)
(***********************************************************************)
-(* $Id: emit.mlp 12664 2012-07-09 08:35:23Z lefessan $ *)
+(* $Id: emit.mlp 12907 2012-09-08 16:51:03Z xleroy $ *)
(* Emission of x86-64 (AMD 64) assembly code *)
let reg_low_8_name =
[| "%al"; "%bl"; "%dil"; "%sil"; "%dl"; "%cl"; "%r8b"; "%r9b";
- "%r10b"; "%r11b"; "%bpl"; "%r12b"; "%r13b" |]
+ "%r12b"; "%r13b"; "%bpl"; "%r10b"; "%r11b" |]
let reg_low_16_name =
[| "%ax"; "%bx"; "%di"; "%si"; "%dx"; "%cx"; "%r8w"; "%r9w";
- "%r10w"; "%r11w"; "%bp"; "%r12w"; "%r13w" |]
+ "%r12w"; "%r13w"; "%bp"; "%r10w"; "%r11w" |]
let reg_low_32_name =
[| "%eax"; "%ebx"; "%edi"; "%esi"; "%edx"; "%ecx"; "%r8d"; "%r9d";
- "%r10d"; "%r11d"; "%ebp"; "%r12d"; "%r13d" |]
+ "%r12d"; "%r13d"; "%ebp"; "%r10d"; "%r11d" |]
let emit_subreg tbl r =
match r.loc with
match Config.system with
| "linux" | "gnu" ->
(* mcount preserves rax, rcx, rdx, rsi, rdi, r8, r9 explicitly
- and rbx, rbp, r12-r15 like all C functions.
- We need to preserve r10 and r11 ourselves, since OCaml can
- use them for argument passing. *)
+ and rbx, rbp, r12-r15 like all C functions. This includes
+ all the registers used for argument passing, so we don't
+ need to preserve other regs. We do need to initialize rbp
+ like mcount expects it, though. *)
` pushq %r10\n`;
` movq %rsp, %rbp\n`;
- ` pushq %r11\n`;
` {emit_call "mcount"}\n`;
- ` popq %r11\n`;
` popq %r10\n`
| _ ->
() (*unsupported yet*)
(* *)
(***********************************************************************)
-(* $Id: emit_nt.mlp 11887 2011-12-18 10:00:56Z xleroy $ *)
+(* $Id: emit_nt.mlp 12907 2012-09-08 16:51:03Z xleroy $ *)
(* Emission of x86-64 (AMD 64) assembly code, MASM syntax *)
let reg_low_8_name =
[| "al"; "bl"; "dil"; "sil"; "dl"; "cl"; "r8b"; "r9b";
- "r10b"; "r11b"; "bpl"; "r12b"; "r13b" |]
+ "r12b"; "r13b"; "bpl"; "r10b"; "r11b" |]
let reg_low_16_name =
[| "ax"; "bx"; "di"; "si"; "dx"; "cx"; "r8w"; "r9w";
- "r10w"; "r11w"; "bp"; "r12w"; "r13w" |]
+ "r12w"; "r13w"; "bp"; "r10w"; "r11w" |]
let reg_low_32_name =
[| "eax"; "ebx"; "edi"; "esi"; "edx"; "ecx"; "r8d"; "r9d";
- "r10d"; "r11d"; "ebp"; "r12d"; "r13d" |]
+ "r12d"; "r13d"; "ebp"; "r10d"; "r11d" |]
let emit_subreg tbl pref r =
match r.loc with
(* *)
(***********************************************************************)
-(* $Id: proc.ml 12149 2012-02-10 16:15:24Z doligez $ *)
+(* $Id: proc.ml 12907 2012-09-08 16:51:03Z xleroy $ *)
(* Description of the AMD64 processor *)
rcx 5
r8 6
r9 7
- r10 8
- r11 9
+ r12 8
+ r13 9
rbp 10
- r12 11
- r13 12
+ r10 11
+ r11 12
r14 trap pointer
r15 allocation pointer
xmm0 - xmm15 100 - 115 *)
(* Conventions:
- rax - r11: OCaml function arguments
+ rax - r13: OCaml function arguments
rax: OCaml and C function results
xmm0 - xmm9: OCaml function arguments
xmm0: OCaml and C function results
xmm0 - xmm3: C function arguments
rbx, rbp, rsi, rdi r12-r15 are preserved by C
xmm6-xmm15 are preserved by C
+ Note (PR#5707): r11 should not be used for parameter passing, as it
+ can be destroyed by the dynamic loader according to SVR4 ABI.
+ Linux's dynamic loader also destroys r10.
*)
let int_reg_name =
match Config.ccomp_type with
| "msvc" ->
[| "rax"; "rbx"; "rdi"; "rsi"; "rdx"; "rcx"; "r8"; "r9";
- "r10"; "r11"; "rbp"; "r12"; "r13" |]
+ "r12"; "r13"; "rbp"; "r10"; "r11" |]
| _ ->
[| "%rax"; "%rbx"; "%rdi"; "%rsi"; "%rdx"; "%rcx"; "%r8"; "%r9";
- "%r10"; "%r11"; "%rbp"; "%r12"; "%r13" |]
+ "%r12"; "%r13"; "%rbp"; "%r10"; "%r11" |]
let float_reg_name =
match Config.ccomp_type with
return value in rax or xmm0.
C calling conventions under Win64:
first integer args in rcx, rdx, r8, r9
- first float args in xmm0 ... xmm3
+ first float args in xmm0 ... xmm3
each integer arg consumes a float reg, and conversely
remaining args on stack
always 32 bytes reserved at bottom of stack.
if win64 then
(* Win64: rbx, rbp, rsi, rdi, r12-r15, xmm6-xmm15 preserved *)
Array.of_list(List.map phys_reg
- [0;4;5;6;7;8;9;
+ [0;4;5;6;7;11;12;
100;101;102;103;104;105])
else
(* Unix: rbp, rbx, r12-r15 preserved *)
Array.of_list(List.map phys_reg
- [0;2;3;4;5;6;7;8;9;
+ [0;2;3;4;5;6;7;11;12;
100;101;102;103;104;105;106;107;
108;109;110;111;112;113;114;115])
(* *)
(***********************************************************************)
-(* $Id: emit.mlp 12547 2012-06-02 18:00:43Z bmeurer $ *)
+(* $Id: emit.mlp 12800 2012-07-30 18:59:07Z doligez $ *)
(* Emission of ARM assembly code *)
(* *)
(***********************************************************************)
-(* $Id: closure.ml 12179 2012-02-21 17:41:02Z xleroy $ *)
+(* $Id: closure.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* Introduction of closures, uncurrying, recognition of direct calls *)
match lam with
Uvar v -> ()
| Uconst(
- (Const_base(Const_int _ | Const_char _ | Const_float _ |
+ (Const_base(Const_int _ | Const_char _ | Const_float _ |
Const_int32 _ | Const_int64 _ | Const_nativeint _) |
Const_pointer _), _) -> incr size
(* Structured Constants are now emitted during closure conversion. *)
| Lfunction(kind, params, body) as funct ->
close_one_function fenv cenv (Ident.create "fun") funct
- (* We convert [f a] to [let a' = a in fun b c -> f a' b c]
+ (* We convert [f a] to [let a' = a in fun b c -> f a' b c]
when fun_arity > nargs *)
| Lapply(funct, args, loc) ->
let nargs = List.length args in
| ((ufunct, Value_closure(fundesc, approx_res)), uargs)
when nargs < fundesc.fun_arity ->
- let first_args = List.map (fun arg ->
- (Ident.create "arg", arg) ) uargs in
- let final_args = Array.to_list (Array.init (fundesc.fun_arity - nargs) (fun _ ->
- Ident.create "arg")) in
- let rec iter args body =
- match args with
- [] -> body
- | (arg1, arg2) :: args ->
- iter args
- (Ulet ( arg1, arg2, body))
- in
- let internal_args =
- (List.map (fun (arg1, arg2) -> Lvar arg1) first_args)
- @ (List.map (fun arg -> Lvar arg ) final_args)
- in
- let (new_fun, approx) = close fenv cenv
- (Lfunction(
- Curried, final_args, Lapply(funct, internal_args, loc)))
- in
- let new_fun = iter first_args new_fun in
- (new_fun, approx)
+ let first_args = List.map (fun arg ->
+ (Ident.create "arg", arg) ) uargs in
+ let final_args = Array.to_list (Array.init (fundesc.fun_arity - nargs) (fun _ ->
+ Ident.create "arg")) in
+ let rec iter args body =
+ match args with
+ [] -> body
+ | (arg1, arg2) :: args ->
+ iter args
+ (Ulet ( arg1, arg2, body))
+ in
+ let internal_args =
+ (List.map (fun (arg1, arg2) -> Lvar arg1) first_args)
+ @ (List.map (fun arg -> Lvar arg ) final_args)
+ in
+ let (new_fun, approx) = close fenv cenv
+ (Lfunction(
+ Curried, final_args, Lapply(funct, internal_args, loc)))
+ in
+ let new_fun = iter first_args new_fun in
+ (new_fun, approx)
| ((ufunct, Value_closure(fundesc, approx_res)), uargs)
when fundesc.fun_arity > 0 && nargs > fundesc.fun_arity ->
(* *)
(***********************************************************************)
-(* $Id: cmmgen.ml 12237 2012-03-14 09:26:54Z xleroy $ *)
+(* $Id: cmmgen.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* Translation from closed lambda to C-- *)
bind "header" (header arr) (fun hdr ->
if wordsize_shift = numfloat_shift then
Csequence(make_checkbound dbg [addr_array_length hdr; idx],
- Cifthenelse(is_addr_array_hdr hdr,
+ Cifthenelse(is_addr_array_hdr hdr,
addr_array_ref arr idx,
float_array_ref arr idx))
else
bind "header" (header arr) (fun hdr ->
if wordsize_shift = numfloat_shift then
Csequence(make_checkbound dbg [addr_array_length hdr; idx],
- Cifthenelse(is_addr_array_hdr hdr,
+ Cifthenelse(is_addr_array_hdr hdr,
addr_array_set arr idx newval,
float_array_set arr idx
(unbox_float newval)))
let emit_all_constants cont =
let c = ref cont in
List.iter
- (fun (lbl, global, cst) ->
+ (fun (lbl, global, cst) ->
let cst = emit_constant lbl cst [] in
- let cst = if global then
- Cglobal_symbol lbl :: cst
+ let cst = if global then
+ Cglobal_symbol lbl :: cst
else cst in
- c:= Cdata(cst):: !c)
+ c:= Cdata(cst):: !c)
(Compilenv.structured_constants());
(* structured_constants := []; done in Compilenv.reset() *)
Hashtbl.clear immstrings; (* PR#3979 *)
args @ [Cvar last_arg; Cvar clos])
else
if n = arity - 1 then
- begin
+ begin
let newclos = Ident.create "clos" in
Clet(newclos,
get_field (Cvar clos) 3,
curry_fun (get_field (Cvar clos) 2 :: args) newclos (n-1))
- end else
- begin
- let newclos = Ident.create "clos" in
- Clet(newclos,
+ end else
+ begin
+ let newclos = Ident.create "clos" in
+ Clet(newclos,
get_field (Cvar clos) 4,
curry_fun (get_field (Cvar clos) 3 :: args) newclos (n-1))
end in
{fun_name = name2;
fun_args = [arg, typ_addr; clos, typ_addr];
fun_body =
- if arity - num > 2 then
- Cop(Calloc,
+ if arity - num > 2 then
+ Cop(Calloc,
[alloc_closure_header 5;
Cconst_symbol(name1 ^ "_" ^ string_of_int (num+1));
int_const (arity - num - 1);
Cconst_symbol(name1 ^ "_" ^ string_of_int (num+1) ^ "_app");
- Cvar arg; Cvar clos])
- else
- Cop(Calloc,
+ Cvar arg; Cvar clos])
+ else
+ Cop(Calloc,
[alloc_closure_header 4;
Cconst_symbol(name1 ^ "_" ^ string_of_int (num+1));
int_const 1; Cvar arg; Cvar clos]);
fun_dbg = Debuginfo.none }
::
(if arity - num > 2 then
- let rec iter i =
- if i <= arity then
- let arg = Ident.create (Printf.sprintf "arg%d" i) in
- (arg, typ_addr) :: iter (i+1)
- else []
- in
- let direct_args = iter (num+2) in
- let rec iter i args clos =
- if i = 0 then
- Cop(Capply(typ_addr, Debuginfo.none),
- (get_field (Cvar clos) 2) :: args @ [Cvar clos])
- else
- let newclos = Ident.create "clos" in
- Clet(newclos,
- get_field (Cvar clos) 4,
- iter (i-1) (get_field (Cvar clos) 3 :: args) newclos)
- in
- let cf =
- Cfunction
- {fun_name = name1 ^ "_" ^ string_of_int (num+1) ^ "_app";
- fun_args = direct_args @ [clos, typ_addr];
- fun_body = iter (num+1)
- (List.map (fun (arg,_) -> Cvar arg) direct_args) clos;
- fun_fast = true;
+ let rec iter i =
+ if i <= arity then
+ let arg = Ident.create (Printf.sprintf "arg%d" i) in
+ (arg, typ_addr) :: iter (i+1)
+ else []
+ in
+ let direct_args = iter (num+2) in
+ let rec iter i args clos =
+ if i = 0 then
+ Cop(Capply(typ_addr, Debuginfo.none),
+ (get_field (Cvar clos) 2) :: args @ [Cvar clos])
+ else
+ let newclos = Ident.create "clos" in
+ Clet(newclos,
+ get_field (Cvar clos) 4,
+ iter (i-1) (get_field (Cvar clos) 3 :: args) newclos)
+ in
+ let cf =
+ Cfunction
+ {fun_name = name1 ^ "_" ^ string_of_int (num+1) ^ "_app";
+ fun_args = direct_args @ [clos, typ_addr];
+ fun_body = iter (num+1)
+ (List.map (fun (arg,_) -> Cvar arg) direct_args) clos;
+ fun_fast = true;
fun_dbg = Debuginfo.none }
- in
- cf :: intermediate_curry_functions arity (num+1)
+ in
+ cf :: intermediate_curry_functions arity (num+1)
else
- intermediate_curry_functions arity (num+1))
+ intermediate_curry_functions arity (num+1))
end
let curry_function arity =
(* *)
(***********************************************************************)
-(* $Id: cmx_format.mli 12210 2012-03-08 19:52:03Z doligez $ *)
+(* $Id: cmx_format.mli 12800 2012-07-30 18:59:07Z doligez $ *)
(* Format of .cmx, .cmxa and .cmxs files *)
dynu_magic: string;
dynu_units: dynunit list;
}
-
let from_call ev = from_location Dinfo_call ev.Lambda.lev_loc
let from_raise ev = from_location Dinfo_raise ev.Lambda.lev_loc
-
(* *)
(***********************************************************************)
-(* $Id: emitaux.ml 12699 2012-07-11 15:26:15Z lefessan $ *)
+(* $Id: emitaux.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* Common functions for emitting assembly code *)
let cfi_startproc () =
if is_cfi_enabled () then
- emit_string " .cfi_startproc\n"
+ emit_string "\t.cfi_startproc\n"
let cfi_endproc () =
if is_cfi_enabled () then
- emit_string " .cfi_endproc\n"
+ emit_string "\t.cfi_endproc\n"
let cfi_adjust_cfa_offset n =
if is_cfi_enabled () then
begin
- emit_string " .cfi_adjust_cfa_offset "; emit_int n; emit_string "\n";
+ emit_string "\t.cfi_adjust_cfa_offset\t"; emit_int n; emit_string "\n";
end
(* Emit debug information *)
with Not_found ->
let file_num = !file_pos_num_cnt in
incr file_pos_num_cnt;
- emit_string " .file ";
- emit_int file_num; emit_char ' ';
+ emit_string "\t.file\t";
+ emit_int file_num; emit_char '\t';
emit_string_literal file_name; emit_char '\n';
file_pos_nums := (file_name,file_num) :: !file_pos_nums;
file_num in
- emit_string " .loc ";
- emit_int file_num; emit_char ' ';
+ emit_string "\t.loc\t";
+ emit_int file_num; emit_char '\t';
emit_int line; emit_char '\n'
end
(* *)
(***********************************************************************)
-(* $Id: emit.mlp 12448 2012-05-12 09:49:40Z xleroy $ *)
+(* $Id: emit.mlp 12800 2012-07-30 18:59:07Z doligez $ *)
(* Emission of Intel 386 assembly code *)
(* *)
(***********************************************************************)
-(* $Id: emit_nt.mlp 12166 2012-02-18 16:56:29Z xleroy $ *)
+(* $Id: emit_nt.mlp 12800 2012-07-30 18:59:07Z doligez $ *)
(* Emission of Intel 386 assembly code, MASM syntax. *)
(* *)
(***********************************************************************)
-(* $Id: emit.mlp 11887 2011-12-18 10:00:56Z xleroy $ *)
+(* $Id: emit.mlp 12800 2012-07-30 18:59:07Z doligez $ *)
(* Emission of PowerPC assembly code *)
(* *)
(***********************************************************************)
-(* $Id: schedgen.ml 12179 2012-02-21 17:41:02Z xleroy $ *)
+(* $Id: schedgen.ml 12876 2012-08-24 08:14:30Z xleroy $ *)
(* Instruction scheduling *)
let add_edge_after son ancestor = add_edge ancestor son 0
+(* Add edges from all instructions that define a pseudoregister [arg] being used
+ as argument to node [node] (RAW dependencies *)
+
+let add_RAW_dependencies node arg =
+ try
+ let ancestor = Hashtbl.find code_results arg.loc in
+ add_edge ancestor node ancestor.delay
+ with Not_found ->
+ ()
+
+(* Add edges from all instructions that use a pseudoregister [res] that is
+ defined by node [node] (WAR dependencies). *)
+
+let add_WAR_dependencies node res =
+ let ancestors = Hashtbl.find_all code_uses res.loc in
+ List.iter (add_edge_after node) ancestors
+
+(* Add edges from all instructions that have already defined a pseudoregister
+ [res] that is defined by node [node] (WAW dependencies). *)
+
+let add_WAW_dependencies node res =
+ try
+ let ancestor = Hashtbl.find code_results res.loc in
+ add_edge ancestor node 0
+ with Not_found ->
+ ()
+
(* Compute length of longest path to a result.
For leafs of the DAG, see whether their result is used in the instruction
immediately following the basic block (a "critical" output). *)
| Lreloadretaddr -> self#reload_retaddr_issue_cycles
| _ -> assert false
+(* Pseudoregisters destroyed by an instruction *)
+
+method private destroyed_by_instr instr =
+ match instr.desc with
+ | Lop op -> Proc.destroyed_at_oper (Iop op)
+ | Lreloadretaddr -> [||]
+ | _ -> assert false
+
(* Add an instruction to the code dag *)
method private add_instruction ready_queue instr =
let delay = self#instr_latency instr in
+ let destroyed = self#destroyed_by_instr instr in
let node =
{ instr = instr;
delay = delay;
emitted_ancestors = 0 } in
(* Add edges from all instructions that define one of the registers used
(RAW dependencies) *)
- for i = 0 to Array.length instr.arg - 1 do
- try
- let ancestor = Hashtbl.find code_results instr.arg.(i).loc in
- add_edge ancestor node ancestor.delay
- with Not_found ->
- ()
- done;
+ Array.iter (add_RAW_dependencies node) instr.arg;
(* Also add edges from all instructions that use one of the result regs
- of this instruction (WAR dependencies). *)
- for i = 0 to Array.length instr.res - 1 do
- let ancestors = Hashtbl.find_all code_uses instr.res.(i).loc in
- List.iter (add_edge_after node) ancestors
- done;
+ of this instruction, or a reg destroyed by this instruction
+ (WAR dependencies). *)
+ Array.iter (add_WAR_dependencies node) instr.res;
+ Array.iter (add_WAR_dependencies node) destroyed; (* PR#5731 *)
(* Also add edges from all instructions that have already defined one
- of the results of this instruction (WAW dependencies). *)
- for i = 0 to Array.length instr.res - 1 do
- try
- let ancestor = Hashtbl.find code_results instr.res.(i).loc in
- add_edge ancestor node 0
- with Not_found ->
- ()
- done;
+ of the results of this instruction, or a reg destroyed by
+ this instruction (WAW dependencies). *)
+ Array.iter (add_WAW_dependencies node) instr.res;
+ Array.iter (add_WAW_dependencies node) destroyed; (* PR#5731 *)
(* If this is a load, add edges from the most recent store viewed so
far (if any) and remember the load. Also add edges from the most
recent checkbound and forget that checkbound. *)
for i = 0 to Array.length instr.res - 1 do
Hashtbl.add code_results instr.res.(i).loc node
done;
+ for i = 0 to Array.length destroyed - 1 do
+ Hashtbl.add code_results destroyed.(i).loc node (* PR#5731 *)
+ done;
for i = 0 to Array.length instr.arg - 1 do
Hashtbl.add code_uses instr.arg.(i).loc node
done;
(* *)
(***********************************************************************)
-(* $Id: emit.mlp 11887 2011-12-18 10:00:56Z xleroy $ *)
+(* $Id: emit.mlp 12800 2012-07-30 18:59:07Z doligez $ *)
(* Emission of Sparc assembly code *)
/* */
/***********************************************************************/
-/* $Id: amd64.S 12664 2012-07-09 08:35:23Z lefessan $ */
+/* $Id: amd64.S 12907 2012-09-08 16:51:03Z xleroy $ */
/* Asm part of the runtime system, AMD64 processor */
/* Must be preprocessed by cpp */
/* Record lowest stack address and return address. Clobbers %rax. */
#define RECORD_STACK_FRAME(OFFSET) \
- pushq %r11 ; \
+ pushq %r11 ; \
movq 8+OFFSET(%rsp), %rax ; \
- STORE_VAR(%rax,caml_last_return_address) ; \
+ STORE_VAR(%rax,caml_last_return_address) ; \
leaq 16+OFFSET(%rsp), %rax ; \
- STORE_VAR(%rax,caml_bottom_of_stack) ; \
- popq %r11
+ STORE_VAR(%rax,caml_bottom_of_stack) ; \
+ popq %r11
#else
#define RECORD_STACK_FRAME(OFFSET) \
movq OFFSET(%rsp), %rax ; \
- STORE_VAR(%rax,caml_last_return_address) ; \
+ STORE_VAR(%rax,caml_last_return_address) ; \
leaq 8+OFFSET(%rsp), %rax ; \
- STORE_VAR(%rax,caml_bottom_of_stack)
+ STORE_VAR(%rax,caml_bottom_of_stack)
#endif
pushq %r13; \
pushq %r14; \
pushq %r15; \
- subq $(8+10*16), %rsp; \
- movupd %xmm6, 0*16(%rsp); \
+ subq $(8+10*16), %rsp; \
+ movupd %xmm6, 0*16(%rsp); \
movupd %xmm7, 1*16(%rsp); \
movupd %xmm8, 2*16(%rsp); \
movupd %xmm9, 3*16(%rsp); \
pushq %r13; \
pushq %r14; \
pushq %r15; \
- subq $8, %rsp
+ subq $8, %rsp
#define POP_CALLEE_SAVE_REGS \
- addq $8, %rsp; \
+ addq $8, %rsp; \
popq %r15; \
popq %r14; \
popq %r13; \
addq $32768, %rsp
#endif
/* Build array of registers, save it into caml_gc_regs */
- pushq %r13
- pushq %r12
- pushq %rbp
pushq %r11
pushq %r10
+ pushq %rbp
+ pushq %r13
+ pushq %r12
pushq %r9
pushq %r8
pushq %rcx
pushq %rax
STORE_VAR(%rsp, caml_gc_regs)
/* Save caml_young_ptr, caml_exception_pointer */
- STORE_VAR(%r15, caml_young_ptr)
- STORE_VAR(%r14, caml_exception_pointer)
+ STORE_VAR(%r15, caml_young_ptr)
+ STORE_VAR(%r14, caml_exception_pointer)
/* Save floating-point registers */
subq $(16*8), %rsp
CFI_ADJUST(232)
movsd %xmm14, 14*8(%rsp)
movsd %xmm15, 15*8(%rsp)
/* Call the garbage collector */
- PREPARE_FOR_C_CALL
+ PREPARE_FOR_C_CALL
call GCALL(caml_garbage_collection)
- CLEANUP_AFTER_C_CALL
+ CLEANUP_AFTER_C_CALL
/* Restore caml_young_ptr, caml_exception_pointer */
- LOAD_VAR(caml_young_ptr, %r15)
- LOAD_VAR(caml_exception_pointer, %r14)
+ LOAD_VAR(caml_young_ptr, %r15)
+ LOAD_VAR(caml_exception_pointer, %r14)
/* Restore all regs used by the code generator */
movsd 0*8(%rsp), %xmm0
movsd 1*8(%rsp), %xmm1
popq %rcx
popq %r8
popq %r9
- popq %r10
- popq %r11
- popq %rbp
popq %r12
popq %r13
+ popq %rbp
+ popq %r10
+ popq %r11
CFI_ADJUST(-232)
/* Return to caller */
ret
ret
LBL(100):
RECORD_STACK_FRAME(0)
- subq $8, %rsp
+ subq $8, %rsp
call LBL(caml_call_gc)
- addq $8, %rsp
+ addq $8, %rsp
jmp LBL(caml_alloc1)
FUNCTION(G(caml_alloc2))
ret
LBL(101):
RECORD_STACK_FRAME(0)
- subq $8, %rsp
+ subq $8, %rsp
call LBL(caml_call_gc)
- addq $8, %rsp
+ addq $8, %rsp
jmp LBL(caml_alloc2)
FUNCTION(G(caml_alloc3))
ret
LBL(102):
RECORD_STACK_FRAME(0)
- subq $8, %rsp
+ subq $8, %rsp
call LBL(caml_call_gc)
- addq $8, %rsp
+ addq $8, %rsp
jmp LBL(caml_alloc3)
FUNCTION(G(caml_allocN))
addq $32768, %rsp
#endif
/* Make the exception handler and alloc ptr available to the C code */
- STORE_VAR(%r15, caml_young_ptr)
- STORE_VAR(%r14, caml_exception_pointer)
+ STORE_VAR(%r15, caml_young_ptr)
+ STORE_VAR(%r14, caml_exception_pointer)
/* Call the function (address in %rax) */
/* No need to PREPARE_FOR_C_CALL since the caller already
reserved the stack space if needed (cf. amd64/proc.ml) */
/* Common code for caml_start_program and caml_callback* */
LBL(caml_start_program):
/* Build a callback link */
- subq $8, %rsp /* stack 16-aligned */
+ subq $8, %rsp /* stack 16-aligned */
PUSH_VAR(caml_gc_regs)
PUSH_VAR(caml_last_return_address)
PUSH_VAR(caml_bottom_of_stack)
CFI_ADJUST(32)
/* Setup alloc ptr and exception ptr */
- LOAD_VAR(caml_young_ptr, %r15)
- LOAD_VAR(caml_exception_pointer, %r14)
+ LOAD_VAR(caml_young_ptr, %r15)
+ LOAD_VAR(caml_exception_pointer, %r14)
/* Build an exception handler */
lea LBL(108)(%rip), %r13
pushq %r13
CFI_ADJUST(-16)
LBL(109):
/* Update alloc ptr and exception ptr */
- STORE_VAR(%r15,caml_young_ptr)
- STORE_VAR(%r14,caml_exception_pointer)
+ STORE_VAR(%r15,caml_young_ptr)
+ STORE_VAR(%r14,caml_exception_pointer)
/* Pop the callback link, restoring the global variables */
- POP_VAR(caml_bottom_of_stack)
+ POP_VAR(caml_bottom_of_stack)
POP_VAR(caml_last_return_address)
POP_VAR(caml_gc_regs)
- addq $8, %rsp
+ addq $8, %rsp
/* Restore callee-save registers. */
POP_CALLEE_SAVE_REGS
/* Return to caller. */
LBL(110):
movq %rax, %r12 /* Save exception bucket */
movq %rax, C_ARG_1 /* arg 1: exception bucket */
- movq 0(%rsp), C_ARG_2 /* arg 2: pc of raise */
- leaq 8(%rsp), C_ARG_3 /* arg 3: sp of raise */
+ popq C_ARG_2 /* arg 2: pc of raise */
+ movq %rsp, C_ARG_3 /* arg 3: sp at raise */
movq %r14, C_ARG_4 /* arg 4: sp of handler */
- PREPARE_FOR_C_CALL /* no need to cleanup after */
+ /* PR#5700: thanks to popq above, stack is now 16-aligned */
+ PREPARE_FOR_C_CALL /* no need to cleanup after */
call GCALL(caml_stash_backtrace)
movq %r12, %rax /* Recover exception bucket */
movq %r14, %rsp
LBL(111):
movq C_ARG_1, %r12 /* Save exception bucket */
/* arg 1: exception bucket */
- LOAD_VAR(caml_last_return_address,C_ARG_2) /* arg 2: pc of raise */
+ LOAD_VAR(caml_last_return_address,C_ARG_2) /* arg 2: pc of raise */
LOAD_VAR(caml_bottom_of_stack,C_ARG_3) /* arg 3: sp of raise */
LOAD_VAR(caml_exception_pointer,C_ARG_4) /* arg 4: sp of handler */
- PREPARE_FOR_C_CALL /* no need to cleanup after */
+ subq $8, %rsp /* PR#5700: maintain stack alignment */
+ PREPARE_FOR_C_CALL /* no need to cleanup after */
call GCALL(caml_stash_backtrace)
movq %r12, %rax /* Recover exception bucket */
- LOAD_VAR(caml_exception_pointer,%rsp)
+ LOAD_VAR(caml_exception_pointer,%rsp)
popq %r14 /* Recover previous exception handler */
- LOAD_VAR(caml_young_ptr,%r15) /* Reload alloc ptr */
+ LOAD_VAR(caml_young_ptr,%r15) /* Reload alloc ptr */
ret
/* Callback from C to OCaml */
.align EIGHT_ALIGN
#if defined(SYS_macosx)
- .literal16
+ .literal16
#elif defined(SYS_mingw64)
- .section .rdata,"dr"
+ .section .rdata,"dr"
#else
- .section .rodata.cst8,"a",@progbits
+ .section .rodata.cst8,"a",@progbits
#endif
.globl G(caml_negf_mask)
.align SIXTEEN_ALIGN
G(caml_negf_mask):
- .quad 0x8000000000000000, 0
+ .quad 0x8000000000000000, 0
.globl G(caml_absf_mask)
.align SIXTEEN_ALIGN
G(caml_absf_mask):
- .quad 0x7FFFFFFFFFFFFFFF, 0xFFFFFFFFFFFFFFFF
+ .quad 0x7FFFFFFFFFFFFFFF, 0xFFFFFFFFFFFFFFFF
#if defined(SYS_linux)
/* Mark stack as non-executable, PR#4564 */
;* *
;***********************************************************************
-; $Id: amd64nt.asm 12149 2012-02-10 16:15:24Z doligez $
+; $Id: amd64nt.asm 12907 2012-09-08 16:51:03Z xleroy $
; Asm part of the runtime system, AMD64 processor, Intel syntax
EXTRN caml_bottom_of_stack: QWORD
EXTRN caml_last_return_address: QWORD
EXTRN caml_gc_regs: QWORD
- EXTRN caml_exception_pointer: QWORD
+ EXTRN caml_exception_pointer: QWORD
EXTRN caml_backtrace_active: DWORD
EXTRN caml_stash_backtrace: NEAR
mov caml_bottom_of_stack, rax
L105:
; Save caml_young_ptr, caml_exception_pointer
- mov caml_young_ptr, r15
- mov caml_exception_pointer, r14
+ mov caml_young_ptr, r15
+ mov caml_exception_pointer, r14
; Build array of registers, save it into caml_gc_regs
- push r13
- push r12
- push rbp
push r11
push r10
+ push rbp
+ push r13
+ push r12
push r9
push r8
push rcx
pop rcx
pop r8
pop r9
- pop r10
- pop r11
- pop rbp
pop r12
pop r13
+ pop rbp
+ pop r10
+ pop r11
; Restore caml_young_ptr, caml_exception_pointer
- mov r15, caml_young_ptr
- mov r14, caml_exception_pointer
+ mov r15, caml_young_ptr
+ mov r14, caml_exception_pointer
; Return to caller
ret
mov caml_last_return_address, rax
lea rax, [rsp + 8]
mov caml_bottom_of_stack, rax
- sub rsp, 8
+ sub rsp, 8
call L105
- add rsp, 8
+ add rsp, 8
jmp caml_alloc1
PUBLIC caml_alloc2
mov caml_last_return_address, rax
lea rax, [rsp + 8]
mov caml_bottom_of_stack, rax
- sub rsp, 8
+ sub rsp, 8
call L105
- add rsp, 8
+ add rsp, 8
jmp caml_alloc2
PUBLIC caml_alloc3
mov caml_last_return_address, rax
lea rax, [rsp + 8]
mov caml_bottom_of_stack, rax
- sub rsp, 8
+ sub rsp, 8
call L105
- add rsp, 8
+ add rsp, 8
jmp caml_alloc3
PUBLIC caml_allocN
mov caml_last_return_address, r12
mov caml_bottom_of_stack, rsp
; Make the exception handler and alloc ptr available to the C code
- mov caml_young_ptr, r15
- mov caml_exception_pointer, r14
+ mov caml_young_ptr, r15
+ mov caml_exception_pointer, r14
; Call the function (address in rax)
call rax
; Reload alloc ptr
- mov r15, caml_young_ptr
+ mov r15, caml_young_ptr
; Return to caller
- push r12
- ret
+ push r12
+ ret
; Start the OCaml program
; Common code for caml_start_program and caml_callback*
L106:
; Build a callback link
- sub rsp, 8 ; stack 16-aligned
+ sub rsp, 8 ; stack 16-aligned
push caml_gc_regs
push caml_last_return_address
push caml_bottom_of_stack
; Setup alloc ptr and exception ptr
- mov r15, caml_young_ptr
- mov r14, caml_exception_pointer
+ mov r15, caml_young_ptr
+ mov r14, caml_exception_pointer
; Build an exception handler
lea r13, L108
push r13
pop r12 ; dummy register
L109:
; Update alloc ptr and exception ptr
- mov caml_young_ptr, r15
- mov caml_exception_pointer, r14
+ mov caml_young_ptr, r15
+ mov caml_exception_pointer, r14
; Pop the callback restoring, link the global variables
pop caml_bottom_of_stack
pop caml_last_return_address
pop caml_gc_regs
- add rsp, 8
+ add rsp, 8
; Restore callee-save registers.
movapd xmm6, OWORD PTR [rsp + 0*16]
movapd xmm7, OWORD PTR [rsp + 1*16]
PUBLIC caml_ml_array_bound_error
ALIGN 16
caml_ml_array_bound_error:
- lea rax, caml_array_bound_error
- jmp caml_c_call
+ lea rax, caml_array_bound_error
+ jmp caml_c_call
.DATA
PUBLIC caml_system__frametable
PUBLIC caml_negf_mask
ALIGN 16
caml_negf_mask LABEL QWORD
- QWORD 8000000000000000H, 0
+ QWORD 8000000000000000H, 0
PUBLIC caml_absf_mask
ALIGN 16
caml_absf_mask LABEL QWORD
- QWORD 7FFFFFFFFFFFFFFFH, 0FFFFFFFFFFFFFFFFH
+ QWORD 7FFFFFFFFFFFFFFFH, 0FFFFFFFFFFFFFFFFH
END
/* */
/***********************************************************************/
-/* $Id: arm.S 12210 2012-03-08 19:52:03Z doligez $ */
+/* $Id: arm.S 12800 2012-07-30 18:59:07Z doligez $ */
/* Asm part of the runtime system, ARM processor */
/* Must be preprocessed by cpp */
.globl caml_system__code_begin
caml_system__code_begin:
-
+
.align 2
.globl caml_call_gc
.type caml_call_gc, %function
/* */
/***********************************************************************/
-/* $Id: i386.S 12179 2012-02-21 17:41:02Z xleroy $ */
+/* $Id: i386.S 12800 2012-07-30 18:59:07Z doligez $ */
/* Asm part of the runtime system, Intel 386 processor */
/* Must be preprocessed by cpp */
/* Pop the exception handler */
popl G(caml_exception_pointer)
#ifdef SYS_macosx
- addl $12, %esp
+ addl $12, %esp
#else
- addl $4, %esp
+ addl $4, %esp
#endif
CFI_ADJUST(-8)
LBL(109):
.align FUNCTION_ALIGN
G(caml_raise_exception):
PROFILE_C
- testl $1, G(caml_backtrace_active)
+ testl $1, G(caml_backtrace_active)
jne LBL(111)
movl 4(%esp), %eax
movl G(caml_exception_pointer), %esp
movl %edx, G(caml_bottom_of_stack)
/* For MacOS X: re-align the stack */
#ifdef SYS_macosx
- andl $-16, %esp
+ andl $-16, %esp
#endif
/* Branch to [caml_array_bound_error] (never returns) */
call G(caml_array_bound_error)
;* *
;***********************************************************************
-; $Id: i386nt.asm 12149 2012-02-10 16:15:24Z doligez $
+; $Id: i386nt.asm 12800 2012-07-30 18:59:07Z doligez $
; Asm part of the runtime system, Intel 386 processor, Intel syntax
- .386
- .MODEL FLAT
+ .386
+ .MODEL FLAT
EXTERN _caml_garbage_collection: PROC
EXTERN _caml_apply2: PROC
EXTERN _caml_array_bound_error: PROC
EXTERN _caml_young_limit: DWORD
EXTERN _caml_young_ptr: DWORD
- EXTERN _caml_bottom_of_stack: DWORD
- EXTERN _caml_last_return_address: DWORD
- EXTERN _caml_gc_regs: DWORD
- EXTERN _caml_exception_pointer: DWORD
+ EXTERN _caml_bottom_of_stack: DWORD
+ EXTERN _caml_last_return_address: DWORD
+ EXTERN _caml_gc_regs: DWORD
+ EXTERN _caml_exception_pointer: DWORD
EXTERN _caml_backtrace_active: DWORD
EXTERN _caml_stash_backtrace: PROC
PUBLIC _caml_alloc2
PUBLIC _caml_alloc3
PUBLIC _caml_allocN
- PUBLIC _caml_call_gc
+ PUBLIC _caml_call_gc
_caml_call_gc:
; Record lowest stack address and return address
- mov eax, [esp]
+ mov eax, [esp]
mov _caml_last_return_address, eax
lea eax, [esp+4]
mov _caml_bottom_of_stack, eax
push eax
mov _caml_gc_regs, esp
; Call the garbage collector
- call _caml_garbage_collection
+ call _caml_garbage_collection
; Restore all regs used by the code generator
- pop eax
+ pop eax
pop ebx
pop ecx
pop edx
ALIGN 4
_caml_alloc1:
- mov eax, _caml_young_ptr
- sub eax, 8
- mov _caml_young_ptr, eax
- cmp eax, _caml_young_limit
- jb L100
+ mov eax, _caml_young_ptr
+ sub eax, 8
+ mov _caml_young_ptr, eax
+ cmp eax, _caml_young_limit
+ jb L100
ret
-L100: mov eax, [esp]
+L100: mov eax, [esp]
mov _caml_last_return_address, eax
lea eax, [esp+4]
mov _caml_bottom_of_stack, eax
ALIGN 4
_caml_alloc2:
- mov eax, _caml_young_ptr
- sub eax, 12
- mov _caml_young_ptr, eax
- cmp eax, _caml_young_limit
- jb L101
+ mov eax, _caml_young_ptr
+ sub eax, 12
+ mov _caml_young_ptr, eax
+ cmp eax, _caml_young_limit
+ jb L101
ret
-L101: mov eax, [esp]
+L101: mov eax, [esp]
mov _caml_last_return_address, eax
lea eax, [esp+4]
mov _caml_bottom_of_stack, eax
ALIGN 4
_caml_alloc3:
- mov eax, _caml_young_ptr
- sub eax, 16
- mov _caml_young_ptr, eax
- cmp eax, _caml_young_limit
- jb L102
+ mov eax, _caml_young_ptr
+ sub eax, 16
+ mov _caml_young_ptr, eax
+ cmp eax, _caml_young_limit
+ jb L102
ret
-L102: mov eax, [esp]
+L102: mov eax, [esp]
mov _caml_last_return_address, eax
lea eax, [esp+4]
mov _caml_bottom_of_stack, eax
neg eax ; eax = size
push eax ; save desired size
sub _caml_young_ptr, eax ; must update young_ptr
- mov eax, [esp+4]
+ mov eax, [esp+4]
mov _caml_last_return_address, eax
lea eax, [esp+8]
mov _caml_bottom_of_stack, eax
ALIGN 4
_caml_c_call:
; Record lowest stack address and return address
- mov edx, [esp]
- mov _caml_last_return_address, edx
- lea edx, [esp+4]
- mov _caml_bottom_of_stack, edx
+ mov edx, [esp]
+ mov _caml_last_return_address, edx
+ lea edx, [esp+4]
+ mov _caml_bottom_of_stack, edx
; Call the function (address in %eax)
- jmp eax
+ jmp eax
; Start the OCaml program
ALIGN 4
_caml_start_program:
; Save callee-save registers
- push ebx
- push esi
- push edi
- push ebp
+ push ebx
+ push esi
+ push edi
+ push ebp
; Initial code pointer is caml_program
mov esi, offset _caml_program
L106:
; Build a callback link
push _caml_gc_regs
- push _caml_last_return_address
- push _caml_bottom_of_stack
+ push _caml_last_return_address
+ push _caml_bottom_of_stack
; Build an exception handler
- push L108
- push _caml_exception_pointer
- mov _caml_exception_pointer, esp
+ push L108
+ push _caml_exception_pointer
+ mov _caml_exception_pointer, esp
; Call the OCaml code
- call esi
+ call esi
L107:
; Pop the exception handler
- pop _caml_exception_pointer
- pop esi ; dummy register
+ pop _caml_exception_pointer
+ pop esi ; dummy register
L109:
; Pop the callback link, restoring the global variables
; used by caml_c_call
- pop _caml_bottom_of_stack
- pop _caml_last_return_address
+ pop _caml_bottom_of_stack
+ pop _caml_last_return_address
pop _caml_gc_regs
; Restore callee-save registers.
- pop ebp
- pop edi
- pop esi
- pop ebx
+ pop ebp
+ pop edi
+ pop esi
+ pop ebx
; Return to caller.
ret
L108:
_caml_raise_exn:
test _caml_backtrace_active, 1
jne L110
- mov esp, _caml_exception_pointer
- pop _caml_exception_pointer
+ mov esp, _caml_exception_pointer
+ pop _caml_exception_pointer
ret
L110:
mov esi, eax ; Save exception bucket in esi
_caml_raise_exception:
test _caml_backtrace_active, 1
jne L111
- mov eax, [esp+4]
- mov esp, _caml_exception_pointer
- pop _caml_exception_pointer
+ mov eax, [esp+4]
+ mov esp, _caml_exception_pointer
+ pop _caml_exception_pointer
ret
L111:
mov esi, [esp+4] ; Save exception bucket in esi
ALIGN 4
_caml_callback_exn:
; Save callee-save registers
- push ebx
- push esi
- push edi
- push ebp
+ push ebx
+ push esi
+ push edi
+ push ebp
; Initial loading of arguments
- mov ebx, [esp+20] ; closure
- mov eax, [esp+24] ; argument
- mov esi, [ebx] ; code pointer
+ mov ebx, [esp+20] ; closure
+ mov eax, [esp+24] ; argument
+ mov esi, [ebx] ; code pointer
jmp L106
PUBLIC _caml_callback2_exn
ALIGN 4
_caml_callback2_exn:
; Save callee-save registers
- push ebx
- push esi
- push edi
- push ebp
+ push ebx
+ push esi
+ push edi
+ push ebp
; Initial loading of arguments
- mov ecx, [esp+20] ; closure
- mov eax, [esp+24] ; first argument
- mov ebx, [esp+28] ; second argument
- mov esi, offset _caml_apply2 ; code pointer
- jmp L106
+ mov ecx, [esp+20] ; closure
+ mov eax, [esp+24] ; first argument
+ mov ebx, [esp+28] ; second argument
+ mov esi, offset _caml_apply2 ; code pointer
+ jmp L106
PUBLIC _caml_callback3_exn
- ALIGN 4
+ ALIGN 4
_caml_callback3_exn:
; Save callee-save registers
- push ebx
- push esi
- push edi
- push ebp
+ push ebx
+ push esi
+ push edi
+ push ebp
; Initial loading of arguments
- mov edx, [esp+20] ; closure
- mov eax, [esp+24] ; first argument
- mov ebx, [esp+28] ; second argument
- mov ecx, [esp+32] ; third argument
- mov esi, offset _caml_apply3 ; code pointer
- jmp L106
+ mov edx, [esp+20] ; closure
+ mov eax, [esp+24] ; first argument
+ mov ebx, [esp+28] ; second argument
+ mov ecx, [esp+32] ; third argument
+ mov esi, offset _caml_apply3 ; code pointer
+ jmp L106
PUBLIC _caml_ml_array_bound_error
ALIGN 4
/* */
/***********************************************************************/
-/* $Id: power-elf.S 12160 2012-02-17 10:43:50Z xleroy $ */
+/* $Id: power-elf.S 12800 2012-07-30 18:59:07Z doligez $ */
#define Addrglobal(reg,glob) \
addis reg, 0, glob@ha; \
.globl caml_system__code_begin
caml_system__code_begin:
-
+
.globl caml_call_gc
.type caml_call_gc, @function
caml_call_gc:
/* */
/***********************************************************************/
-/* $Id: power-rhapsody.S 12159 2012-02-17 10:12:09Z xleroy $ */
+/* $Id: power-rhapsody.S 12800 2012-07-30 18:59:07Z doligez $ */
#ifdef __ppc64__
#define X(a,b) b
.globl _caml_system__code_begin
_caml_system__code_begin:
-
+
/* Invoke the garbage collector. */
.globl _caml_call_gc
L112:
mr r28, r3 /* preserve exn bucket in callee-save */
/* arg 1: exception bucket (already in r3) */
- Loadglobal r4, _caml_last_return_address, r11 /* arg 2: PC of raise */
- Loadglobal r5, _caml_bottom_of_stack, r11 /* arg 3: SP of raise */
+ Loadglobal r4, _caml_last_return_address, r11 /* arg 2: PC of raise */
+ Loadglobal r5, _caml_bottom_of_stack, r11 /* arg 3: SP of raise */
Loadglobal r6, _caml_exception_pointer, r11 /* arg 4: SP of handler */
addi r1, r1, -(16*WORD) /* reserve stack space for C call */
bl _caml_stash_backtrace
gdata L105 + 4 /* return address into callback */
.short -1 /* negative size count => use callback link */
.short 0 /* no roots here */
- .align X(2,3)
+ .align X(2,3)
/* */
/***********************************************************************/
-/* $Id: roots.c 12149 2012-02-10 16:15:24Z doligez $ */
+/* $Id: roots.c 12800 2012-07-30 18:59:07Z doligez $ */
/* To walk the memory roots for garbage collection */
sz += (*caml_stack_usage_hook)();
return sz;
}
-
-
/* */
/***********************************************************************/
-/* $Id: sparc.S 12159 2012-02-17 10:12:09Z xleroy $ */
+/* $Id: sparc.S 12800 2012-07-30 18:59:07Z doligez $ */
/* Asm part of the runtime system for the Sparc processor. */
/* Must be preprocessed by cpp */
.half 0 /* no roots */
#ifdef SYS_solaris
- .type caml_allocN, #function
- .type caml_call_gc, #function
+ .type caml_allocN, #function
+ .type caml_call_gc, #function
.type caml_c_call, #function
.type caml_start_program, #function
.type caml_raise_exception, #function
- .type caml_system__frametable, #object
+ .type caml_system__frametable, #object
#endif
(* *)
(***********************************************************************)
-(* $Id: bytepackager.ml 12202 2012-03-07 17:50:17Z frisch $ *)
+(* $Id: bytepackager.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* "Package" a set of .cmo files into one .cmo file having the
original compilation units as sub-modules. *)
(* PR#5276, as above *)
let name = Ident.name id in
if String.contains name '.' then
- Reloc_setglobal (Ident.create_persistent (packagename ^ "." ^ name))
+ Reloc_setglobal (Ident.create_persistent (packagename ^ "." ^ name))
else
rel
end
let package_files ppf files targetfile =
let files =
List.map
- (fun f ->
+ (fun f ->
try find_in_path !Config.load_path f
with Not_found -> raise(Error(File_not_found f)))
- files in
+ files in
let prefix = chop_extensions targetfile in
let targetcmi = prefix ^ ".cmi" in
let targetname = String.capitalize(Filename.basename prefix) in
(* *)
(***********************************************************************)
-(* $Id: matching.ml 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* $Id: matching.ml 12961 2012-09-27 13:30:07Z garrigue $ *)
(* Compilation of pattern matching *)
| _ -> raise NoMatch)
| Tpat_constant cst ->
(fun q rem -> match q.pat_desc with
- | Tpat_constant cst' when cst=cst' ->
+ | Tpat_constant cst' when const_compare cst cst' = 0 ->
p,rem
| Tpat_any -> p,rem
| _ -> raise NoMatch)
add jumps
-let rec jumps_union env1 env2 = match env1,env2 with
+let rec jumps_union (env1:(int*ctx list)list) env2 = match env1,env2 with
| [],_ -> env2
| _,[] -> env1
| ((i1,pss1) as x1::rem1), ((i2,pss2) as x2::rem2) ->
(* A slight attempt to identify semantically equivalent lambda-expressions *)
exception Not_simple
-let rec raw_rec env = function
+let rec raw_rec env : lambda -> lambda = function
| Llet(Alias,x,ex, body) -> raw_rec ((x,raw_rec env ex)::env) body
| Lvar id as l ->
begin try List.assoc id env with
simplify rem
| Tpat_record (lbls, closed) ->
let all_lbls = all_record_args lbls in
- let full_pat = {pat with pat_desc=Tpat_record (all_lbls, closed)} in
+ let full_pat =
+ {pat with pat_desc=Tpat_record (all_lbls, closed)} in
(full_pat::patl,action)::
simplify rem
| Tpat_or _ ->
ctx : ctx list ;
pat : pattern}
-let add make_matching_fun division key patl_action args =
+let add make_matching_fun division eq_key key patl_action args =
try
- let cell = List.assoc key division in
+ let (_,cell) = List.find (fun (k,_) -> eq_key key k) division in
cell.pm.cases <- patl_action :: cell.pm.cases;
division
with Not_found ->
(key, cell) :: division
-let divide make get_key get_args ctx pm =
+let divide make eq_key get_key get_args ctx pm =
let rec divide_rec = function
| (p::patl,action) :: rem ->
let this_match = divide_rec rem in
add
(make p pm.default ctx)
- this_match (get_key p) (get_args p patl,action) pm.args
+ this_match eq_key (get_key p) (get_args p patl,action) pm.args
| _ -> [] in
divide_rec pm.cases
matcher_const cst p1 rem with
| NoMatch -> matcher_const cst p2 rem
end
-| Tpat_constant c1 when c1=cst -> rem
-| Tpat_any -> rem
+| Tpat_constant c1 when const_compare c1 cst = 0 -> rem
+| Tpat_any -> rem
| _ -> raise NoMatch
let get_key_constant caller = function
let divide_constant ctx m =
divide
- make_constant_matching (get_key_constant "divide")
+ make_constant_matching
+ (fun c d -> const_compare c d = 0) (get_key_constant "divide")
get_args_constant
ctx m
| None, Some r2 -> r2
| Some (a1::rem1), Some (a2::_) ->
{a1 with
-pat_loc = Location.none ;
-pat_desc = Tpat_or (a1, a2, None)}::
+ pat_loc = Location.none ;
+ pat_desc = Tpat_or (a1, a2, None)}::
rem
| _, _ -> assert false
end
- | Tpat_construct (_, _, cstr1, [arg],_) when cstr.cstr_tag = cstr1.cstr_tag ->
- arg::rem
+ | Tpat_construct (_, _, cstr1, [arg],_)
+ when cstr.cstr_tag = cstr1.cstr_tag -> arg::rem
| Tpat_any -> omega::rem
| _ -> raise NoMatch in
matcher_rec
fun q rem -> match q.pat_desc with
| Tpat_or (_,_,_) -> raise OrPat
| Tpat_construct (_, _, cstr1, args,_)
- when cstr.cstr_tag = cstr1.cstr_tag -> args @ rem
+ when cstr.cstr_tag = cstr1.cstr_tag -> args @ rem
| Tpat_any -> Parmatch.omegas cstr.cstr_arity @ rem
| _ -> raise NoMatch
let divide_constructor ctx pm =
divide
make_constr_matching
- get_key_constr get_args_constr
+ (=) get_key_constr get_args_constr
ctx pm
(* Matching against a variant *)
match pato with
None ->
add (make_variant_matching_constant p lab def ctx) variants
- (Cstr_constant tag) (patl, action) al
+ (=) (Cstr_constant tag) (patl, action) al
| Some pat ->
add (make_variant_matching_nonconst p lab def ctx) variants
- (Cstr_block tag) (pat :: patl, action) al
+ (=) (Cstr_block tag) (pat :: patl, action) al
end
| cl -> []
in
let divide_array kind ctx pm =
divide
(make_array_matching kind)
- get_key_array get_args_array ctx pm
+ (=) get_key_array get_args_array ctx pm
(* To combine sub-matchings together *)
-let float_compare s1 s2 =
- let f1 = float_of_string s1 and f2 = float_of_string s2 in
- Pervasives.compare f1 f2
-
let sort_lambda_list l =
- List.sort
- (fun (x,_) (y,_) -> match x,y with
- | Const_float f1, Const_float f2 -> float_compare f1 f2
- | _, _ -> Pervasives.compare x y)
- l
+ List.sort (fun (x,_) (y,_) -> const_compare x y) l
let rec cut n l =
if n = 0 then [],l
-let rec comp_match_handlers comp_fun partial ctx arg first_match next_matchs = match next_matchs with
+let rec comp_match_handlers comp_fun partial ctx arg first_match next_matchs =
+ match next_matchs with
| [] -> comp_fun partial ctx arg first_match
| rem ->
let rec c_rec body total_body = function
(* *)
(***********************************************************************)
-(* $Id: translcore.ml 12681 2012-07-10 08:33:16Z garrigue $ *)
+(* $Id: translcore.ml 12871 2012-08-21 07:14:03Z lefessan $ *)
(* Translation from typed abstract syntax to lambda terms,
for the core language *)
{ prim_name = "caml_obj_dup"; prim_arity = 1; prim_alloc = true;
prim_native_name = ""; prim_native_float = false }
+let find_primitive loc prim_name =
+ match prim_name with
+ "%revapply" -> Prevapply loc
+ | "%apply" -> Pdirapply loc
+ | name -> Hashtbl.find primitives_table name
+
let transl_prim loc prim args =
let prim_name = prim.prim_name in
try
end
with Not_found ->
try
- let p =
- match prim_name with
- "%revapply" -> Prevapply loc
- | "%apply" -> Pdirapply loc
- | name -> Hashtbl.find primitives_table name in
+ let p = find_primitive loc prim_name in
(* Try strength reduction based on the type of the argument *)
begin match (p, args) with
(Psetfield(n, _), [arg1; arg2]) -> Psetfield(n, maybe_pointer arg2)
(* Eta-expand a primitive without knowing the types of its arguments *)
-let transl_primitive p =
+let transl_primitive loc p =
let prim =
try
let (gencomp, _, _, _, _, _, _, _) =
gencomp
with Not_found ->
try
- Hashtbl.find primitives_table p.prim_name
+ find_primitive loc p.prim_name
with Not_found ->
Pccall p in
match prim with
Lfunction(Curried, [obj; meth; cache; pos],
Lsend(Cached, Lvar meth, Lvar obj, [Lvar cache; Lvar pos], e.exp_loc))
else
- transl_primitive p
+ transl_primitive e.exp_loc p
| Texp_ident(path, _, {val_kind = Val_anc _}) ->
raise(Error(e.exp_loc, Free_super_var))
| Texp_ident(path, _, {val_kind = Val_reg | Val_self _}) ->
(* *)
(***********************************************************************)
-(* $Id: translcore.mli 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* $Id: translcore.mli 12871 2012-08-21 07:14:03Z lefessan $ *)
(* Translation from typed abstract syntax to lambda terms,
for the core language *)
-> Location.t -> lambda
val transl_let:
rec_flag -> (pattern * expression) list -> lambda -> lambda
-val transl_primitive: Primitive.description -> lambda
+val transl_primitive: Location.t -> Primitive.description -> lambda
val transl_exception:
Ident.t -> Path.t option -> exception_declaration -> lambda
(* *)
(***********************************************************************)
-(* $Id: translmod.ml 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* $Id: translmod.ml 12871 2012-08-21 07:14:03Z lefessan $ *)
(* Translation from typed abstract syntax to lambda terms,
for the module language *)
(Lapply(Lvar id, [apply_coercion cc_arg (Lvar param)],
Location.none))))
| Tcoerce_primitive p ->
- transl_primitive p
+ transl_primitive Location.none p
and apply_coercion_field id (pos, cc) =
apply_coercion cc (Lprim(Pfield pos, [Lvar id]))
List.map
(fun (pos, cc) ->
match cc with
- Tcoerce_primitive p -> transl_primitive p
+ Tcoerce_primitive p -> transl_primitive Location.none p
| _ -> apply_coercion cc (Lvar v.(pos)))
pos_cc_list)
| _ ->
and store_primitive (pos, prim) cont =
Lsequence(Lprim(Psetfield(pos, false),
- [Lprim(Pgetglobal glob, []); transl_primitive prim]),
+ [Lprim(Pgetglobal glob, []);
+ transl_primitive Location.none prim]),
cont)
in List.fold_right store_primitive prims (transl_store !transl_store_subst str)
/* */
/***********************************************************************/
-/* $Id: compact.c 12621 2012-06-20 15:39:09Z doligez $ */
+/* $Id: compact.c 12910 2012-09-10 09:52:09Z doligez $ */
#include <string.h>
word q = *p;
if (Color_hd (q) == Caml_white){
size_t sz = Bhsize_hd (q);
- char *newadr = compact_allocate (sz); Assert (newadr <= (char *)p);
+ char *newadr = compact_allocate (sz);
memmove (newadr, p, sz);
p += Wsize_bsize (sz);
}else{
while (ch != NULL){
if (Chunk_size (ch) > Chunk_alloc (ch)){
caml_make_free_blocks ((value *) (ch + Chunk_alloc (ch)),
- Wsize_bsize (Chunk_size(ch)-Chunk_alloc(ch)), 1);
+ Wsize_bsize (Chunk_size(ch)-Chunk_alloc(ch)), 1,
+ Caml_white);
}
ch = Chunk_next (ch);
}
void caml_compact_heap (void)
{
- uintnat target_size, live;
+ uintnat target_words, target_size, live;
do_compaction ();
/* Compaction may fail to shrink the heap to a reasonable size
See PR#5389
*/
/* We compute:
- freewords = caml_fl_cur_size (exact)
- heapsize = caml_heap_size (exact)
- live = heap_size - freewords
- target_size = live * (1 + caml_percent_free / 100)
- = live / 100 * (100 + caml_percent_free)
- We add 1 to live/100 to make sure it isn't 0.
+ freewords = caml_fl_cur_size (exact)
+ heapwords = Wsize_bsize (caml_heap_size) (exact)
+ live = heapwords - freewords
+ wanted = caml_percent_free * (live / 100 + 1) (same as in do_compaction)
+ target_words = live + wanted
+ We add one page to make sure a small difference in counting sizes
+ won't make [do_compaction] keep the second block (and break all sorts
+ of invariants).
We recompact if target_size < heap_size / 2
*/
- live = caml_stat_heap_size - Bsize_wsize (caml_fl_cur_size);
- target_size = (live / 100 + 1) * (100 + caml_percent_free);
- target_size = caml_round_heap_chunk_size (target_size);
+ live = Wsize_bsize (caml_stat_heap_size) - caml_fl_cur_size;
+ target_words = live + caml_percent_free * (live / 100 + 1)
+ + Wsize_bsize (Page_size);
+ target_size = caml_round_heap_chunk_size (Bsize_wsize (target_words));
if (target_size < caml_stat_heap_size / 2){
char *chunk;
- /* round it up to a page size */
+ caml_gc_message (0x10, "Recompacting heap (target=%luk)\n",
+ target_size / 1024);
+
chunk = caml_alloc_for_heap (target_size);
if (chunk == NULL) return;
+ /* PR#5757: we need to make the new blocks blue, or they won't be
+ recognized as free by the recompaction. */
caml_make_free_blocks ((value *) chunk,
- Wsize_bsize (Chunk_size (chunk)), 0);
+ Wsize_bsize (Chunk_size (chunk)), 0, Caml_blue);
if (caml_page_table_add (In_heap, chunk, chunk + Chunk_size (chunk)) != 0){
caml_free_for_heap (chunk);
return;
do_compaction ();
Assert (caml_stat_heap_chunks == 1);
Assert (Chunk_next (caml_heap_start) == NULL);
+ Assert (caml_stat_heap_size == Chunk_size (chunk));
}
}
/* */
/***********************************************************************/
-/* $Id: extern.c 12394 2012-04-25 00:40:46Z meyer $ */
+/* $Id: extern.c 12800 2012-07-30 18:59:07Z doligez $ */
/* Structured output */
}
return NULL;
}
-
/* */
/***********************************************************************/
-/* $Id: freelist.c 12708 2012-07-13 12:03:26Z doligez $ */
+/* $Id: freelist.c 12910 2012-09-10 09:52:09Z doligez $ */
#define FREELIST_DEBUG 0
#if FREELIST_DEBUG
p: pointer to the first word of the block
size: size of the block (in words)
do_merge: 1 -> do merge; 0 -> do not merge
+ color: which color to give to the pieces; if [do_merge] is 1, this
+ is overridden by the merge code, but we have historically used
+ [Caml_white].
*/
-void caml_make_free_blocks (value *p, mlsize_t size, int do_merge)
+void caml_make_free_blocks (value *p, mlsize_t size, int do_merge, int color)
{
mlsize_t sz;
}else{
sz = size;
}
- *(header_t *)p = Make_header (Wosize_whsize (sz), 0, Caml_white);
+ *(header_t *)p = Make_header (Wosize_whsize (sz), 0, color);
if (do_merge) caml_fl_merge_block (Bp_hp (p));
size -= sz;
p += sz;
/* */
/***********************************************************************/
-/* $Id: freelist.h 11156 2011-07-27 14:17:02Z doligez $ */
+/* $Id: freelist.h 12910 2012-09-10 09:52:09Z doligez $ */
/* Free lists of heap blocks. */
void caml_fl_reset (void);
char *caml_fl_merge_block (char *);
void caml_fl_add_blocks (char *);
-void caml_make_free_blocks (value *, mlsize_t, int);
+void caml_make_free_blocks (value *, mlsize_t, int, int);
void caml_set_allocation_policy (uintnat);
/* */
/***********************************************************************/
-/* $Id: intern.c 12441 2012-05-08 13:48:33Z xleroy $ */
+/* $Id: intern.c 12910 2012-09-10 09:52:09Z doligez $ */
/* Structured input, compact format */
ReadItems(&Field(v, 2), size - 2);
/* Request freshing OID */
PushItem();
- sp->op = OFreshOID;
+ sp->op = OFreshOID;
sp->dest = &Field(v, 1);
sp->arg = 1;
/* Finally read first two block elements: method table and old OID */
case CODE_INFIXPOINTER:
ofs = read32u();
/* Read a value to *dest, then offset *dest by ofs */
- PushItem();
+ PushItem();
sp->dest = dest;
- sp->op = OShift;
+ sp->op = OShift;
sp->arg = ofs;
ReadItems(dest, 1);
continue; /* with next iteration of main loop, skipping *dest = v */
caml_failwith("input_value: ill-formed message");
}
}
- }
+ }
/* end of case OReadItems */
*dest = v;
break;
Assert(intern_dest <= end_extra_block);
if (intern_dest < end_extra_block){
caml_make_free_blocks ((value *) intern_dest,
- end_extra_block - intern_dest, 0);
+ end_extra_block - intern_dest, 0, Caml_white);
}
caml_allocated_words +=
Wsize_bsize ((char *) intern_dest - intern_extra_block);
/* */
/***********************************************************************/
-/* $Id: major_gc.c 12625 2012-06-21 13:43:03Z doligez $ */
+/* $Id: major_gc.c 12910 2012-09-10 09:52:09Z doligez $ */
#include <limits.h>
caml_fl_init_merge ();
caml_make_free_blocks ((value *) caml_heap_start,
- Wsize_bsize (caml_stat_heap_size), 1);
+ Wsize_bsize (caml_stat_heap_size), 1, Caml_white);
caml_gc_phase = Phase_idle;
gray_vals_size = 2048;
gray_vals = (value *) malloc (gray_vals_size * sizeof (value));
/* */
/***********************************************************************/
-/* $Id: md5.c 12227 2012-03-13 14:44:48Z xleroy $ */
+/* $Id: md5.c 12800 2012-07-30 18:59:07Z doligez $ */
#include <string.h>
#include "alloc.h"
CAMLreturn (res);
}
-CAMLexport void caml_md5_block(unsigned char digest[16],
+CAMLexport void caml_md5_block(unsigned char digest[16],
void * data, uintnat len)
{
struct MD5Context ctx;
/* */
/***********************************************************************/
-/* $Id: md5.h 12227 2012-03-13 14:44:48Z xleroy $ */
+/* $Id: md5.h 12800 2012-07-30 18:59:07Z doligez $ */
/* MD5 message digest */
CAMLextern value caml_md5_string (value str, value ofs, value len);
CAMLextern value caml_md5_chan (value vchan, value len);
-CAMLextern void caml_md5_block(unsigned char digest[16],
+CAMLextern void caml_md5_block(unsigned char digest[16],
void * data, uintnat len);
struct MD5Context {
/* */
/***********************************************************************/
-/* $Id: memory.c 12364 2012-04-17 08:20:35Z doligez $ */
+/* $Id: memory.c 12910 2012-09-10 09:52:09Z doligez $ */
#include <stdlib.h>
#include <string.h>
}
remain = malloc_request;
prev = hp = mem;
- /* XXX find a way to do this with a call to caml_make_free_blocks */
+ /* FIXME find a way to do this with a call to caml_make_free_blocks */
while (Wosize_bhsize (remain) > Max_wosize){
Hd_hp (hp) = Make_header (Max_wosize, 0, Caml_blue);
#ifdef DEBUG
| TyAnt loc _ -> error loc "antiquotation not allowed here"
| TyOfAmp _ _ _ |TyAmp _ _ _ |TySta _ _ _ |
TyCom _ _ _ |TyVrn _ _ |TyQuM _ _ |TyQuP _ _ |TyDcl _ _ _ _ _ |
- TyAnP _ | TyAnM _ | TyTypePol _ _ _ |
+ TyAnP _ | TyAnM _ | TyTypePol _ _ _ |
TyObj _ _ (RvAnt _) | TyNil _ | TyTup _ _ ->
assert False ]
and row_field = fun
let rec loop t =
let desc =
match t.ptyp_desc with
- [
+ [
Ptyp_any -> Ptyp_any
| Ptyp_var x -> Ptyp_var x
| Ptyp_arrow label core_type core_type' ->
- Ptyp_arrow label (loop core_type) (loop core_type')
+ Ptyp_arrow label (loop core_type) (loop core_type')
| Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst)
| Ptyp_constr ({ txt = Lident s }) [] when List.mem s var_names ->
- Ptyp_var ("&" ^ s)
+ Ptyp_var ("&" ^ s)
| Ptyp_constr longident lst ->
- Ptyp_constr longident (List.map loop lst)
+ Ptyp_constr longident (List.map loop lst)
| Ptyp_object lst ->
- Ptyp_object (List.map loop_core_field lst)
+ Ptyp_object (List.map loop_core_field lst)
| Ptyp_class longident lst lbl_list ->
- Ptyp_class (longident, List.map loop lst, lbl_list)
+ Ptyp_class (longident, List.map loop lst, lbl_list)
| Ptyp_alias core_type string ->
- Ptyp_alias(loop core_type, string)
+ Ptyp_alias(loop core_type, string)
| Ptyp_variant row_field_list flag lbl_lst_option ->
- Ptyp_variant(List.map loop_row_field row_field_list, flag, lbl_lst_option)
+ Ptyp_variant(List.map loop_row_field row_field_list, flag, lbl_lst_option)
| Ptyp_poly string_lst core_type ->
- Ptyp_poly(string_lst, loop core_type)
+ Ptyp_poly(string_lst, loop core_type)
| Ptyp_package longident lst ->
- Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst)
+ Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst)
]
in
{(t) with ptyp_desc = desc}
let desc =
match t.pfield_desc with
[ Pfield(n,typ) ->
- Pfield(n,loop typ)
+ Pfield(n,loop typ)
| Pfield_var ->
- Pfield_var]
+ Pfield_var]
in
{ (t) with pfield_desc=desc}
and loop_row_field x =
match x with
[ Rtag(label,flag,lst) ->
- Rtag(label,flag,List.map loop lst)
+ Rtag(label,flag,List.map loop lst)
| Rinherit t ->
- Rinherit (loop t) ]
+ Rinherit (loop t) ]
in
loop;
| <:binding@_loc< $pat:( <:patt@sloc< $lid:bind_name$ >> )$ = ($e$ : $TyTypePol _ vs ty$) >> ->
(* this code is not pretty because it is temporary *)
let rec id_to_string x =
- match x with
- [ <:ctyp< $lid:x$ >> -> [x]
- | <:ctyp< $x$ $y$ >> -> (id_to_string x) @ (id_to_string y)
- | _ -> assert False]
+ match x with
+ [ <:ctyp< $lid:x$ >> -> [x]
+ | <:ctyp< $x$ $y$ >> -> (id_to_string x) @ (id_to_string y)
+ | _ -> assert False]
in
let vars = id_to_string vs in
let ampersand_vars = List.map (fun x -> "&" ^ x) vars in
let mkpat = mkpat _loc in
let e = mkexp (Pexp_constraint (expr e) (Some (ctyp ty)) None) in
let rec mk_newtypes x =
- match x with
- [ [newtype :: []] -> mkexp (Pexp_newtype(newtype, e))
- | [newtype :: newtypes] ->
- mkexp(Pexp_newtype (newtype,mk_newtypes newtypes))
- | [] -> assert False]
+ match x with
+ [ [newtype :: []] -> mkexp (Pexp_newtype(newtype, e))
+ | [newtype :: newtypes] ->
+ mkexp(Pexp_newtype (newtype,mk_newtypes newtypes))
+ | [] -> assert False]
in
let pat =
- mkpat (Ppat_constraint (mkpat (Ppat_var (with_loc bind_name sloc)),
+ mkpat (Ppat_constraint (mkpat (Ppat_var (with_loc bind_name sloc)),
mktyp _loc (Ptyp_poly ampersand_vars ty')))
in
let e = mk_newtypes vars in
pos_lnum = if absolute then line else pos.pos_lnum + line;
pos_bol = pos.pos_cnum - chars;
}
-
+
(* To convert integer literals, copied from "../parsing/lexer.mll" *)
-
+
let cvt_int_literal s =
- int_of_string ("-" ^ s)
let cvt_int32_literal s =
| _ -> 1 ])
;
- value lident_colon =
- Gram.Entry.of_parser "lident_colon"
- (fun strm ->
- match Stream.npeek 2 strm with
- [ [(LIDENT i, _); (KEYWORD ":", _)] ->
- do { Stream.junk strm; Stream.junk strm; i }
- | _ -> raise Stream.Failure ])
+ value lident_colon =
+ Gram.Entry.of_parser "lident_colon"
+ (fun strm ->
+ match Stream.npeek 2 strm with
+ [ [(LIDENT i, _); (KEYWORD ":", _)] ->
+ do { Stream.junk strm; Stream.junk strm; i }
+ | _ -> raise Stream.Failure ])
;
value rec is_ident_constr_call =
optional_type_parameter:
[ [ `ANTIQUOT (""|"typ"|"anti" as n) s -> <:ctyp< $anti:mk_anti n s$ >>
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.ctyp_tag
- | "+"; "_" -> Ast.TyAnP _loc
+ | "+"; "_" -> Ast.TyAnP _loc
| "+"; "'"; i = a_ident -> <:ctyp< +'$lid:i$ >>
| "-"; "_" -> Ast.TyAnM _loc
| "-"; "'"; i = a_ident -> <:ctyp< -'$lid:i$ >>
| "'"; i = a_ident -> <:ctyp< '$lid:i$ >>
| "+"; "'"; i = a_ident -> <:ctyp< +'$lid:i$ >>
| "-"; "'"; i = a_ident -> <:ctyp< -'$lid:i$ >>
- | "+"; "_" -> Ast.TyAnP _loc
+ | "+"; "_" -> Ast.TyAnP _loc
| "-"; "_" -> Ast.TyAnM _loc
| "_" -> Ast.TyAny _loc
let (tl, rt) = generalized_type_of_type t in
<:ctyp< $uid:s$ : ($Ast.tyAnd_of_list tl$ -> $rt$) >>
| s = a_UIDENT ->
- <:ctyp< $uid:s$ >>
+ <:ctyp< $uid:s$ >>
] ]
;
constructor_declaration:
;
cvalue_binding:
[ [ "="; e = expr -> e
- | ":"; "type"; t1 = unquoted_typevars; "." ; t2 = ctyp ; "="; e = expr ->
- let u = Ast.TyTypePol _loc t1 t2 in
- <:expr< ($e$ : $u$) >>
+ | ":"; "type"; t1 = unquoted_typevars; "." ; t2 = ctyp ; "="; e = expr ->
+ let u = Ast.TyTypePol _loc t1 t2 in
+ <:expr< ($e$ : $u$) >>
| ":"; t = poly_type; "="; e = expr -> <:expr< ($e$ : $t$) >>
| ":"; t = poly_type; ":>"; t2 = ctyp; "="; e = expr ->
match t with
match ty with
[ Otyp_abstract ->
fprintf ppf "@[<2>@[<hv 2>@[%s %t@]@]%a@]" kwd type_defined
- print_constraints constraints
+ print_constraints constraints
| _ ->
fprintf ppf "@[<2>@[<hv 2>@[%s %t@] =%a@]%a@]" kwd type_defined
- print_types ty print_constraints constraints ]
+ print_types ty print_constraints constraints ]
;
(* Phrases *)
open Camlp4.PreCast;;
module ArithGram = MakeGram(Lexer);;
-
+
type t = Local of string * t * t
| Binop of t * (int -> int -> int) * t
| Int of int
| Var of string;;
-
+
let expression = ArithGram.Entry.mk "expression";;
-
+
EXTEND ArithGram
GLOBAL: expression;
-
+
expression: (* A grammar entry for expressions *)
[ "top"
[ "let"; `LIDENT s; "="; e1 = SELF; "in"; e2 = SELF -> Local(s,e1,e2) ]
| `LIDENT s -> Var(s)
| "("; e = expression; ")" -> e ]
];
-
+
END;;
-
+
let parse_arith s =
ArithGram.parse_string expression (Loc.mk "<string>") s;;
-
+
let rec eval env =
function
| Local(x, e1, e2) ->
op (eval env e1) (eval env e2)
| Int(i) -> i
| Var(x) -> List.assoc x env;;
-
+
let calc s =
Format.printf "%s ==> %d@." s (eval [] (parse_arith s));;
-
+
calc "42 * let x = 21 in x + x";;
.\"* *
.\"***********************************************************************
.\"
-.\" $Id: camlp4.1.tpl 11156 2011-07-27 14:17:02Z doligez $
+.\" $Id: camlp4.1.tpl 12800 2012-07-30 18:59:07Z doligez $
.\"
.TH CAMLP4 1 "" "INRIA"
.SH NAME
(* *)
(***********************************************************************)
-(* $Id: command_line.ml 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* $Id: command_line.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(************************ Reading and executing commands ***************)
if cmdarg <> "" then
try
if (String.index cmdarg '=') > 0 then
- Debugger_config.environment := cmdarg :: !Debugger_config.environment
+ Debugger_config.environment := cmdarg :: !Debugger_config.environment
else
- eprintf "Environment variables should not have an empty name\n%!"
+ eprintf "Environment variables should not have an empty name\n%!"
with Not_found ->
eprintf "Environment variables should have the \"name=value\" format\n%!"
else
;(* *)
;(***********************************************************************)
-;(* $Id: caml-types.el 12695 2012-07-10 17:49:46Z doligez $ *)
+;(* $Id: caml-types.el 12800 2012-07-30 18:59:07Z doligez $ *)
; An emacs-lisp complement to the "-annot" option of ocamlc and ocamlopt.
(vector target-file target-line target-bol cnum))
(save-excursion
(setq node (caml-types-find-location target-pos "type" ()
- target-tree))
+ target-tree))
(set-buffer caml-types-buffer)
(erase-buffer)
(cond
- ((null node)
+ ((null node)
(delete-overlay caml-types-expr-ovl)
(setq type "*no type information*")
(setq limits
(caml-types-find-interval
target-buf target-pos target-tree)))
(t
- (let ((left
- (caml-types-get-pos target-buf (elt node 0)))
+ (let ((left
+ (caml-types-get-pos target-buf (elt node 0)))
(right
- (caml-types-get-pos target-buf (elt node 1))))
+ (caml-types-get-pos target-buf (elt node 1))))
(move-overlay
caml-types-expr-ovl left right target-buf)
(setq limits
target-pos node)
type (cdr (assoc "type" (elt node 2))))
))
- )
+ )
(setq mes (format "type: %s" type))
(insert type)
))
;(* *)
;(***********************************************************************)
-;(* $Id: caml.el 12152 2012-02-13 17:48:41Z doligez $ *)
+;(* $Id: caml.el 12973 2012-09-28 16:54:20Z doligez $ *)
;;; caml.el --- OCaml code editing commands for Emacs
(defconst caml-kwop-regexps (make-vector 9 nil)
"Array of regexps representing caml keywords of different priorities.")
+(defun caml-in-shebang-line ()
+ (save-excursion
+ (beginning-of-line)
+ (and (= 1 (point)) (looking-at "#!"))))
+
(defun caml-in-expr-p ()
(let ((pos (point)) (in-expr t))
(caml-find-kwop
caml-matching-kw-regexp "\\|"
(aref caml-kwop-regexps caml-max-indent-priority)))
(cond
+ ; special case for #! at beginning of file
+ ((caml-in-shebang-line) (setq in-expr nil))
; special case for ;;
((and (> (point) 1) (= (preceding-char) ?\;) (= (following-char) ?\;))
(setq in-expr nil))
;(* *)
;(***********************************************************************)
-;(* $Id: camldebug.el 12149 2012-02-10 16:15:24Z doligez $ *)
+;(* $Id: camldebug.el 12800 2012-07-30 18:59:07Z doligez $ *)
;;; Run camldebug under Emacs
;;; Derived from gdb.el.
(let ((process-window))
;; it does not seem necessary to save excursion here,
;; since set-buffer as a temporary effect.
- ;; comint-output-filter explicitly avoids it.
+ ;; comint-output-filter explicitly avoids it.
;; in version 23, it prevents the marker to stay at end of buffer
;; (save-excursion
(set-buffer (process-buffer proc))
(get-buffer-window (current-buffer))))
;; Insert the text, moving the process-marker.
(comint-output-filter proc output)
- ;; )
- ;; this was the end of save-excursion.
+ ;; )
+ ;; this was the end of save-excursion.
;; if save-excursion is used (comint-next-prompt 1) would be needed
;; to move the mark past then next prompt, but this is not as good
;; as solution.
;(* *)
;(***********************************************************************)
-;(* $Id: ocamltags.in 11156 2011-07-27 14:17:02Z doligez $ *)
+;(* $Id: ocamltags.in 12800 2012-07-30 18:59:07Z doligez $ *)
;; Copyright (C) 1998 Ian Zimmerman <itz@transbay.net>
;; This program is free software; you can redistribute it and/or
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
-;; $Id: ocamltags.in 11156 2011-07-27 14:17:02Z doligez $
+;; $Id: ocamltags.in 12800 2012-07-30 18:59:07Z doligez $
(require 'caml)
.\"* *
.\"***********************************************************************
.\"
-.\" $Id: ocamlc.m 12527 2012-05-31 15:15:03Z doligez $
+.\" $Id: ocamlc.m 12800 2012-07-30 18:59:07Z doligez $
.\"
.TH OCAMLC 1
.B \-output\-obj
Cause the linker to produce a C object file instead of a bytecode
executable file. This is useful to wrap OCaml code as a C library,
-callable from any C program. The name of the output object file
+callable from any C program. The name of the output object file
must be set with the
.B \-o
option. This
.\"* *
.\"***********************************************************************
.\"
-.\" $Id: ocamldoc.m 11156 2011-07-27 14:17:02Z doligez $
+.\" $Id: ocamldoc.m 12800 2012-07-30 18:59:07Z doligez $
.\"
.TH OCAMLDOC 1
.BI \-intro \ file
Use content of
.I file
-as
+as
.B ocamldoc
text to use as introduction (HTML, LaTeX and TeXinfo only).
For HTML, the file is used to create the whole "index.html" file.
.\"* *
.\"***********************************************************************
.\"
-.\" $Id: ocamlopt.m 12428 2012-05-03 17:01:27Z doligez $
+.\" $Id: ocamlopt.m 12800 2012-07-30 18:59:07Z doligez $
.\"
.TH OCAMLOPT 1
to display types and other annotations interactively.
.TP
.B \-dtypes
-Has been deprecated. Please use
-.BI \-annot
+Has been deprecated. Please use
+.BI \-annot
instead.
.TP
.B \-c
.B \-output\-obj
Cause the linker to produce a C object file instead of an executable
file. This is useful to wrap OCaml code as a C library,
-callable from any C program. The name of the output object file
+callable from any C program. The name of the output object file
must be set with the
.B \-o
option.
* ocamlbuild.ml: Add some flags -lflag, -ppflag, -cflag, --.
Also add a detection mechanism for dependencies.
* discard_printf.ml, Makefile: Update.
-
let union a b =
rev (rev_append_uniq (rev_append_uniq [] a) b)
+ let ordered_unique (type el) (lst : el list) =
+ let module Set = Set.Make(struct
+ type t = el
+ let compare = Pervasives.compare
+ let print _ _ = ()
+ end)
+ in
+ let _, lst =
+ List.fold_left (fun (set,acc) el ->
+ if Set.mem el set
+ then set, acc
+ else Set.add el set, el :: acc) (Set.empty,[]) lst
+ in
+ List.rev lst
+
end
module String = struct
(fun param -> S [A "-pp"; A param]);
pflag ["ocaml"; "infer_interface"] "pp"
(fun param -> S [A "-pp"; A param]);
- pflag ["ocaml";"compile";] "warn"
+ pflag ["ocaml";"compile";] "warn"
(fun param -> S [A "-w"; A param])
let camlp4_flags camlp4s =
Exit_codes
Digest_cache
Ocamlbuild_plugin
-Findlib
\ No newline at end of file
+Findlib
Exit_codes
Digest_cache
Findlib
-Param_tags
\ No newline at end of file
+Param_tags
(* Original author: Romain Bardou *)
module StringSet = Set.Make(String)
-module SSOSet = Set.Make(struct
- type t = string * string option
- let compare = Pervasives.compare
-end)
(* tag name -> tag action (string -> unit) *)
let declared_tags = Hashtbl.create 17
-let acknowledged_tags = ref SSOSet.empty
+let acknowledged_tags = ref []
let only_once f =
let instances = ref StringSet.empty in
let acknowledge tag =
let tag = Lexers.tag_gen (Lexing.from_string tag) in
- acknowledged_tags := SSOSet.add tag !acknowledged_tags
+ acknowledged_tags := tag :: !acknowledged_tags
+
let really_acknowledge (name, param) =
match param with
List.iter (fun f -> f param) actions
let init () =
- SSOSet.iter really_acknowledge !acknowledged_tags
+ List.iter really_acknowledge (My_std.List.ordered_unique !acknowledged_tags)
let make = Printf.sprintf "%s(%s)"
val print : (Format.formatter -> 'a -> 'b) -> Format.formatter -> 'a list -> unit
val filter_opt : ('a -> 'b option) -> 'a list -> 'b list
val union : 'a list -> 'a list -> 'a list
-
+ val ordered_unique : 'a list -> 'a list
(* Original functions *)
include module type of List
end
module type M = sig type u end
module N : sig include M val f: u -> unit end
Here, in html for example, f in displayed being of type Foo.u instead of Foo.M.u
- - latex: types variant polymorphes dépassent de la page quand ils sont trop longs
- - utilisation nouvelles infos de Xavier: "début de rec", etc.
+ - latex: types variant polymorphes depassent de la page quand ils sont trop longs
+ - utilisation nouvelles infos de Xavier: "debut de rec", etc.
- xml generator
=====
Release 3.08.0:
- fix: method parameters names in signature are now retrieved correctly
(fix of Odoc_value.parameter_list_from_arrows to handle Tpoly for methods)
- - ajout à la doc de Module_list et Index_list (utilisé dans le html seulement)
- - ajout à la doc: fichier de l'option -intro utilisé pour l'index en html
+ - ajout a la doc de Module_list et Index_list (utilise dans le html seulement)
+ - ajout a la doc: fichier de l'option -intro utilise pour l'index en html
- fix: create a Module_with instead of a Module_alias when we encounter
module A : Foo in a signature
- latex: style latex pour indenter dans les module kind et les class kind
- - latex: il manque la génération des paramètres de classe
+ - latex: il manque la generation des parametres de classe
- parse des {!modules: } et {!indexlist}
- gestion des Module_list et Index_list
- no need to Dynlink.add_available_units any more
method private gen_if_tag name target info_opt =
match info_opt with
None -> ()
- | Some i ->
+ | Some i ->
let l =
List.fold_left
(fun acc (t, text) ->
| _ -> (None, text) :: acc
end
- | _ -> acc
+ | _ -> acc
)
[]
i.i_custom
(* *)
(***********************************************************************)
-(* $Id: odoc_analyse.ml 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* $Id: odoc_analyse.ml 12862 2012-08-16 09:44:48Z guesdon $ *)
(** Analysis of source files. This module is strongly inspired from
driver/main.ml :-) *)
let parsetree = parse_file inputfile Parse.implementation ast_impl_magic_number in
let typedtree =
Typemod.type_implementation
- sourcefile prefixname modulename env parsetree
+ sourcefile prefixname modulename env parsetree
in
(Some (parsetree, typedtree), inputfile)
with
Location.input_name := file;
try
let mod_name =
- String.capitalize (Filename.basename (Filename.chop_extension file))
+ let s =
+ try Filename.chop_extension file
+ with _ -> file
+ in
+ String.capitalize (Filename.basename s)
in
let txt =
try Odoc_text.Texter.text_of_string (Odoc_misc.input_file_as_string file)
(* *)
(***********************************************************************)
-(* $Id: odoc_ast.ml 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* $Id: odoc_ast.ml 12951 2012-09-25 07:14:43Z guesdon $ *)
(** Analysis of implementation files. *)
open Misc
| { cf_desc = Typedtree.Tcf_val (_, _, _, ident, Tcfk_concrete exp, _) } :: q
when Name.from_ident ident = name ->
exp.Typedtree.exp_type
+ | { cf_desc = Typedtree.Tcf_val (_, _, _, ident, Tcfk_virtual typ, _) } :: q
+ when Name.from_ident ident = name ->
+ typ.Typedtree.ctyp_type
| _ :: q ->
iter q
in
in
fun ct_decl -> iter ct_decl.Types.clty_type
- let search_virtual_attribute_type table ctname name =
- let ct_decl = search_class_type_declaration table ctname in
- let cls_sig = class_sig_of_cltype_decl ct_decl.ci_type_decl in
- let (_,_,texp) = Types.Vars.find name cls_sig.cty_vars in
- texp
-
let search_method_expression cls name =
let rec iter = function
| [] ->
| l ->
match l with
[] ->
- (* cas impossible, on l'a filtré avant *)
+ (* cas impossible, on l'a filtre avant *)
assert false
| (pattern_param, exp) :: second_ele :: q ->
(* implicit pattern matching -> anonymous parameter *)
let complete_name = Name.concat current_class_name label in
let (info_opt, ele_comments) = get_comments_in_class last_pos loc.Location.loc_start.Lexing.pos_cnum in
let type_exp =
- try
- if virt then
- Typedtree_search.search_virtual_attribute_type table
- (Name.simple current_class_name) label
- else
- Typedtree_search.search_attribute_type tt_cls label
+ try Typedtree_search.search_attribute_type tt_cls label
with Not_found ->
raise (Failure (Odoc_messages.attribute_not_found_in_typedtree complete_name))
in
Typedtree.Tcl_ident (p,_,_) -> Name.from_path p
| _ ->
(* we try to get the name from the environment. *)
- (* A VOIR : dommage qu'on n'ait pas un Tclass_ident :-( même quand on a class tutu = toto *)
+ (* A VOIR : dommage qu'on n'ait pas un Tclass_ident :-( meme quand on a class tutu = toto *)
Name.from_longident lid.txt
in
- (* On n'a pas ici les paramètres de type sous forme de Types.type_expr,
+ (* On n'a pas ici les parametres de type sous forme de Types.type_expr,
par contre on peut les trouver dans le class_type *)
let params =
match tt_class_exp.Typedtree.cl_type with
match tt_class_expr2.Typedtree.cl_desc with
Typedtree.Tcl_ident (p,_,_) -> Name.from_path p (* A VOIR : obtenir le nom complet *)
| _ ->
- (* A VOIR : dommage qu'on n'ait pas un Tclass_ident :-( même quand on a class tutu = toto *)
+ (* A VOIR : dommage qu'on n'ait pas un Tclass_ident :-( meme quand on a class tutu = toto *)
match p_class_expr2.Parsetree.pcl_desc with
Parsetree.Pcl_constr (lid, _) ->
(* we try to get the name from the environment. *)
| Element_type t ->
(function
Types.Sig_type (ident,_,_) ->
- (* A VOIR: il est possible que le détail du type soit caché *)
+ (* A VOIR: il est possible que le detail du type soit cache *)
let n1 = Name.simple t.ty_name
and n2 = Ident.name ident in
n1 = n2
let new_env = Odoc_env.add_module env new_module.m_name in
let new_env2 =
match new_module.m_type with
- (* A VOIR : cela peut-il être Tmty_ident ? dans ce cas, on aurait pas la signature *)
+ (* A VOIR : cela peut-il etre Tmty_ident ? dans ce cas, on aurait pas la signature *)
Types.Mty_signature s ->
Odoc_env.add_signature new_env new_module.m_name
~rel: (Name.simple new_module.m_name) s
let new_env = Odoc_env.add_module_type env mt.mt_name in
let new_env2 =
match tt_module_type.mty_type with
- (* A VOIR : cela peut-il être Tmty_ident ? dans ce cas, on n'aurait pas la signature *)
+ (* A VOIR : cela peut-il etre Tmty_ident ? dans ce cas, on n'aurait pas la signature *)
Types.Mty_signature s ->
Odoc_env.add_signature new_env mt.mt_name ~rel: (Name.simple mt.mt_name) s
| _ ->
im_info = comment_opt ;
}
in
- (0, env, [ Element_included_module im ]) (* A VOIR : étendre l'environnement ? avec quoi ? *)
+ (0, env, [ Element_included_module im ]) (* A VOIR : etendre l'environnement ? avec quoi ? *)
(** Analysis of a [Parsetree.module_expr] and a name to return a [t_module].*)
and analyse_module env current_module_name module_name comment_opt p_module_expr tt_module_expr =
(* *)
(***********************************************************************)
-(* $Id: odoc_class.ml 12341 2012-04-11 16:46:30Z guesdon $ *)
+(* $Id: odoc_class.ml 12796 2012-07-30 11:22:29Z doligez $ *)
(** Representation and manipulation of classes and class types.*)
| Class_constraint (c_kind, ct_kind) ->
iter_kind c_kind
(* A VOIR : utiliser le c_kind ou le ct_kind ?
- Pour l'instant, comme le ct_kind n'est pas analysé,
+ Pour l'instant, comme le ct_kind n'est pas analyse,
on cherche dans le c_kind
class_type_elements ~trans: trans
{ clt_name = "" ; clt_info = None ;
None
-(* eof $Id: odoc_class.ml 12341 2012-04-11 16:46:30Z guesdon $ *)
+(* eof $Id: odoc_class.ml 12796 2012-07-30 11:22:29Z doligez $ *)
(* *)
(***********************************************************************)
-(* $Id: odoc_dot.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: odoc_dot.ml 12798 2012-07-30 11:53:27Z doligez $ *)
(** Definition of a class which outputs a dot file showing
top modules dependencies.*)
end
module type Dot_generator = module type of Generator
-
(* *)
(***********************************************************************)
-(* $Id: odoc_env.ml 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* $Id: odoc_env.ml 12796 2012-07-30 11:22:29Z doligez $ *)
(** Environment for finding complete names from relative names. *)
| Types.Sig_exception (ident, _) -> { env with env_exceptions = (rel_name ident, qualify ident) :: env.env_exceptions }
| Types.Sig_module (ident, modtype, _) ->
let env2 =
- match modtype with (* A VOIR : le cas où c'est un identificateur, dans ce cas on n'a pas de signature *)
+ match modtype with (* A VOIR : le cas ou c'est un identificateur, dans ce cas on n'a pas de signature *)
Types.Mty_signature s -> add_signature env (qualify ident) ~rel: (rel_name ident) s
| _ -> env
in
env
| Types.Modtype_manifest modtype ->
match modtype with
- (* A VOIR : le cas où c'est un identificateur, dans ce cas on n'a pas de signature *)
+ (* A VOIR : le cas ou c'est un identificateur, dans ce cas on n'a pas de signature *)
Types.Mty_signature s -> add_signature env (qualify ident) ~rel: (rel_name ident) s
| _ -> env
in
in
iter t
-(* eof $Id: odoc_env.ml 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* eof $Id: odoc_env.ml 12796 2012-07-30 11:22:29Z doligez $ *)
(* *)
(***********************************************************************)
-(* $Id: odoc_global.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: odoc_global.ml 12798 2012-07-30 11:53:27Z doligez $ *)
(** Global variables. *)
let with_toc = ref true
let with_index = ref true
-
-
-
(* *)
(***********************************************************************)
-(* $Id: odoc_html.ml 12434 2012-05-07 09:41:28Z guesdon $ *)
+(* $Id: odoc_html.ml 12953 2012-09-25 07:50:40Z guesdon $ *)
(** Generation of html documentation.*)
in
fun b s ->
if !colorize_code then
- self#html_of_code b (remove_useless_newlines s)
+ (
+ bs b "<pre class=\"codepre\">";
+ self#html_of_code b (remove_useless_newlines s);
+ bs b "</pre>"
+ )
else
(
bs b "<pre class=\"codepre\"><code class=\"";
method html_of_Title b n label_opt t =
let label1 = self#create_title_label (n, label_opt, t) in
- bp b "<span id=\"%s\">" (Naming.label_target label1);
let (tag_o, tag_c) =
if n > 6 then
(Printf.sprintf "div class=\"h%d\"" n, "div")
let t = Printf.sprintf "h%d" n in (t, t)
in
bs b "<";
- bs b tag_o;
+ bp b "%s id=\"%s\"" tag_o (Naming.label_target label1);
bs b ">";
self#html_of_text b t;
bs b "</";
bs b tag_c;
- bs b ">";
- bs b "</span>"
+ bs b ">"
method html_of_Latex b _ = ()
(* don't care about LaTeX stuff in HTML. *)
"pre.verbatim, pre.codepre { }";
".indextable {border: 1px #ddd solid; border-collapse: collapse}";
- ".indextable td, .indextable th {border: 1px #ddd solid; min-width: 80px}";
+ ".indextable td, .indextable th {border: 1px #ddd solid; min-width: 80px}";
".indextable td.module {background-color: #eee ; padding-left: 2px; padding-right: 2px}";
- ".indextable td.module a {color: 4E6272; text-decoration: none; display: block; width: 100%}";
+ ".indextable td.module a {color: 4E6272; text-decoration: none; display: block; width: 100%}";
".indextable td.module a:hover {text-decoration: underline; background-color: transparent}";
".deprecated {color: #888; font-style: italic}" ;
| l,Some r ->
bs b (" " ^ (self#keyword ":") ^ " ");
self#html_of_type_expr_list ~par: false b father " * " l;
- bs b (" " ^ (self#keyword "->") ^ " ");
+ bs b (" " ^ (self#keyword "->") ^ " ");
self#html_of_type_expr b father r;
);
bs b "</code></td>\n";
if info then
(
if complete then
- self#html_of_info ~indent: false
+ self#html_of_info ~indent: true
else
self#html_of_info_first_sentence
) b m.m_info
if info then
(
if complete then
- self#html_of_info ~indent: false
+ self#html_of_info ~indent: true
else
self#html_of_info_first_sentence
) b mt.mt_info
print_DEBUG "html#html_of_class : info" ;
(
if complete then
- self#html_of_info ~indent: false
+ self#html_of_info ~indent: true
else
self#html_of_info_first_sentence
) b c.cl_info
bs b "</pre>";
(
if complete then
- self#html_of_info ~indent: false
+ self#html_of_info ~indent: true
else
self#html_of_info_first_sentence
) b ct.clt_info
(* *)
(***********************************************************************)
-(* $Id: odoc_info.mli 12435 2012-05-07 10:31:18Z guesdon $ *)
+(* $Id: odoc_info.mli 12798 2012-07-30 11:53:27Z doligez $ *)
(** Interface to the information collected in source files. *)
{
vc_name : string ; (** Name of the constructor. *)
vc_args : Types.type_expr list ; (** Arguments of the constructor. *)
- vc_ret : Types.type_expr option ;
+ vc_ret : Types.type_expr option ;
mutable vc_text : text option ; (** Optional description in the associated comment. *)
}
(* *)
(***********************************************************************)
-(* $Id: odoc_latex.ml 12249 2012-03-20 12:00:11Z guesdon $ *)
+(* $Id: odoc_latex.ml 12798 2012-07-30 11:53:27Z doligez $ *)
(** Generation of LaTeX documentation. *)
"}", "\\\\}";
"\\$", "\\\\$";
"\\^", "{\\\\textasciicircum}";
- "à", "\\\\`a";
- "â", "\\\\^a";
- "é", "\\\\'e";
- "è", "\\\\`e";
- "ê", "\\\\^e";
- "ë", "\\\\\"e";
- "ç", "\\\\c{c}";
- "ô", "\\\\^o";
- "ö", "\\\\\"o";
- "î", "\\\\^i";
- "ï", "\\\\\"i";
- "ù", "\\\\`u";
- "û", "\\\\^u";
+ "\xE0", "\\\\`a";
+ "\xE2", "\\\\^a";
+ "\xE9", "\\\\'e";
+ "\xE8", "\\\\`e";
+ "\xEA", "\\\\^e";
+ "\xEB", "\\\\\"e";
+ "\xE7", "\\\\c{c}";
+ "\xF4", "\\\\^o";
+ "\xF6", "\\\\\"o";
+ "\xEE", "\\\\^i";
+ "\xEF", "\\\\\"i";
+ "\xF9", "\\\\`u";
+ "\xFB", "\\\\^u";
"%", "\\\\%";
"_", "\\\\_";
"~", "\\\\~{}";
p fmt2 " %s@ %s@ %s@ %s"
":"
(self#normal_type_list ~par: false mod_name " * " l)
- "->"
+ "->"
(self#normal_type mod_name r)
);
flush2 ()
self#latex_of_module_kind fmt father k2;
self#latex_of_text fmt [Code ")"]
| Module_with (k, s) ->
- (* TODO: à modifier quand Module_with sera plus détaillé *)
+ (* TODO: a modifier quand Module_with sera plus detaille *)
self#latex_of_module_type_kind fmt father k;
self#latex_of_text fmt
[ Code " ";
self#latex_of_text fmt [Latex "\\end{ocamldocobjectend}\n"]
| Class_apply capp ->
- (* TODO: afficher le type final à partir du typedtree *)
+ (* TODO: afficher le type final a partir du typedtree *)
self#latex_of_text fmt [Raw "class application not handled yet"]
| Class_constr cco ->
(* *)
(***********************************************************************)
-(* $Id: odoc_lexer.mll 10652 2010-08-24 09:45:45Z guesdon $ *)
+(* $Id: odoc_lexer.mll 12796 2012-07-30 11:22:29Z doligez $ *)
(** The lexer for special comments. *)
let string_buffer = Buffer.create 32
-(** Fonction de remise à zéro de la chaine de caractères tampon *)
+(** Fonction de remise a zero de la chaine de caracteres tampon *)
let reset_string_buffer () = Buffer.reset string_buffer
-(** Fonction d'ajout d'un caractère dans la chaine de caractères tampon *)
+(** Fonction d'ajout d'un caractere dans la chaine de caracteres tampon *)
let ajout_char_string = Buffer.add_char string_buffer
(** Add a string to the buffer. *)
(* *)
(***********************************************************************)
-(* $Id: odoc_man.ml 12249 2012-03-20 12:00:11Z guesdon $ *)
+(* $Id: odoc_man.ml 12798 2012-07-30 11:53:27Z doligez $ *)
(** The man pages generator. *)
open Odoc_info
| l, None, Some r ->
bs b "\n.B : ";
self#man_of_type_expr_list ~par: false b father " * " l;
- bs b ".B -> ";
+ bs b ".B -> ";
self#man_of_type_expr b father r;
bs b " "
| l, (Some t), Some r ->
bs b "\n.B of ";
self#man_of_type_expr_list ~par: false b father " * " l;
- bs b ".B -> ";
+ bs b ".B -> ";
self#man_of_type_expr b father r;
bs b ".I \" \"\n";
bs b "(* ";
(* *)
(***********************************************************************)
-(* $Id: odoc_merge.mli 12341 2012-04-11 16:46:30Z guesdon $ *)
+(* $Id: odoc_merge.mli 12796 2012-07-30 11:22:29Z doligez $ *)
(** Merge of information from [.ml] and [.mli] for a module.*)
-(** Merging \@before tags. *)
+(** Merging \@before tags. *)
val merge_before_tags :
(string * Odoc_types.text) list -> (string * Odoc_types.text) list
(* *)
(***********************************************************************)
-(* $Id: odoc_misc.ml 12341 2012-04-11 16:46:30Z guesdon $ *)
+(* $Id: odoc_misc.ml 12796 2012-07-30 11:22:29Z doligez $ *)
let no_blanks s =
let len = String.length s in
let len = String.length s in
let n = String.index s '.' in
if n + 1 >= len then
- (* le point est le dernier caractère *)
+ (* le point est le dernier caractere *)
(true, s, "")
else
match s.[n+1] with
(* *)
(***********************************************************************)
-(* $Id: odoc_name.ml 12622 2012-06-21 05:46:28Z guesdon $ *)
+(* $Id: odoc_name.ml 12798 2012-07-30 11:53:27Z doligez $ *)
(** Representation of element names. *)
else
match s.[n] with
' ' | '\t' | '\n' | '\r' -> iter_last (n-1)
- | _ -> Some n
+ | _ -> Some n
in
match iter_last (len-1) with
None -> String.sub s first 1
- | Some last -> String.sub s first ((last-first)+1)
+ | Some last -> String.sub s first ((last-first)+1)
let parens_if_infix name =
match strip_string name with
(* *)
(***********************************************************************)
-(* $Id: odoc_print.ml 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* $Id: odoc_print.ml 12796 2012-07-30 11:22:29Z doligez $ *)
open Format
match t with
Types.Cty_constr (p,texp_list,ct) -> t
| Types.Cty_signature cs ->
- (* on vire les vals et methods pour ne pas qu'elles soient imprimées
+ (* on vire les vals et methods pour ne pas qu'elles soient imprimees
quand on affichera le type *)
let tnil = { Types.desc = Types.Tnil ; Types.level = 0; Types.id = 0 } in
Types.Cty_signature { Types.cty_self = { cs.Types.cty_self with
(* *)
(***********************************************************************)
-(* $Id: odoc_scan.ml 12341 2012-04-11 16:46:30Z guesdon $ *)
+(* $Id: odoc_scan.ml 12796 2012-07-30 11:22:29Z doligez $ *)
(** Scanning of modules and elements.
method scan_class_pre (c : Odoc_class.t_class) = true
(** This method scan the elements of the given class.
- A VOIR : scan des classes héritées.*)
+ A VOIR : scan des classes heritees.*)
method scan_class_elements c =
List.iter
(fun ele ->
method scan_class_type_pre (ct : Odoc_class.t_class_type) = true
(** This method scan the elements of the given class type.
- A VOIR : scan des classes héritées.*)
+ A VOIR : scan des classes heritees.*)
method scan_class_type_elements ct =
List.iter
(fun ele ->
(* *)
(***********************************************************************)
-(* $Id: odoc_sig.ml 12622 2012-06-21 05:46:28Z guesdon $ *)
+(* $Id: odoc_sig.ml 12798 2012-07-30 11:53:27Z doligez $ *)
(** Analysis of interface files. *)
{
vc_name = constructor_name ;
vc_args = List.map (Odoc_env.subst_type env) type_expr_list ;
- vc_ret = may_map (Odoc_env.subst_type env) ret_type;
+ vc_ret = may_map (Odoc_env.subst_type env) ret_type;
vc_text = comment_opt
}
in
new_module.m_info <- merge_infos new_module.m_info info_after_opt ;
let new_env = Odoc_env.add_module env new_module.m_name in
let new_env2 =
- match new_module.m_type with (* A VOIR : cela peut-il être Tmty_ident ? dans ce cas, on aurait pas la signature *)
+ match new_module.m_type with (* A VOIR : cela peut-il etre Tmty_ident ? dans ce cas, on aurait pas la signature *)
Types.Mty_signature s -> Odoc_env.add_signature new_env new_module.m_name ~rel: (Name.simple new_module.m_name) s
| _ -> new_env
in
raise (Failure (Odoc_messages.module_not_found current_module_name name))
in
match sig_module_type with
- (* A VOIR : cela peut-il être Tmty_ident ? dans ce cas, on aurait pas la signature *)
+ (* A VOIR : cela peut-il etre Tmty_ident ? dans ce cas, on aurait pas la signature *)
Types.Mty_signature s ->
Odoc_env.add_signature e complete_name ~rel: name s
| _ ->
mt.mt_info <- merge_infos mt.mt_info info_after_opt ;
let new_env = Odoc_env.add_module_type env mt.mt_name in
let new_env2 =
- match sig_mtype with (* A VOIR : cela peut-il être Tmty_ident ? dans ce cas, on aurait pas la signature *)
+ match sig_mtype with (* A VOIR : cela peut-il etre Tmty_ident ? dans ce cas, on aurait pas la signature *)
Some (Types.Mty_signature s) -> Odoc_env.add_signature new_env mt.mt_name ~rel: (Name.simple mt.mt_name) s
| _ -> new_env
in
([], Class_structure (inher_l, ele))
| (Parsetree.Pcty_fun (parse_label, _, pclass_type), Types.Cty_fun (label, type_expr, class_type)) ->
- (* label = string. Dans les signatures, pas de nom de paramètres à l'intérieur des tuples *)
+ (* label = string. Dans les signatures, pas de nom de parametres a l'interieur des tuples *)
(* si label = "", pas de label. ici on a l'information pour savoir si on a un label explicite. *)
if parse_label = label then
(
(* *)
(***********************************************************************)
-(* $Id: odoc_texi.ml 11160 2011-07-29 10:32:43Z garrigue $ *)
+(* $Id: odoc_texi.ml 12798 2012-07-30 11:53:27Z doligez $ *)
(** Generation of Texinfo documentation. *)
] @
(if !esc_8bits
then [
- (Str.regexp "à", "@`a") ;
- (Str.regexp "â", "@^a") ;
- (Str.regexp "é", "@'e") ;
- (Str.regexp "è", "@`e") ;
- (Str.regexp "ê", "@^e") ;
- (Str.regexp "ë", "@\"e") ;
- (Str.regexp "ç", "@,{c}") ;
- (Str.regexp "ô", "@^o") ;
- (Str.regexp "ö", "@\"o") ;
- (Str.regexp "î", "@^i") ;
- (Str.regexp "ï", "@\"i") ;
- (Str.regexp "ù", "@`u") ;
- (Str.regexp "û", "@^u") ;
- (Str.regexp "æ", "@ae{}" ) ;
- (Str.regexp "Æ", "@AE{}" ) ;
- (Str.regexp "ß", "@ss{}" ) ;
- (Str.regexp "©", "@copyright{}" ) ;
+ (Str.regexp "\xE0", "@`a") ;
+ (Str.regexp "\xE2", "@^a") ;
+ (Str.regexp "\xE9", "@'e") ;
+ (Str.regexp "\xE8", "@`e") ;
+ (Str.regexp "\xEA", "@^e") ;
+ (Str.regexp "\xEB", "@\"e") ;
+ (Str.regexp "\xF7", "@,{c}") ;
+ (Str.regexp "\xF4", "@^o") ;
+ (Str.regexp "\xF6", "@\"o") ;
+ (Str.regexp "\xEE", "@^i") ;
+ (Str.regexp "\xEF", "@\"i") ;
+ (Str.regexp "\xF9", "@`u") ;
+ (Str.regexp "\xFB", "@^u") ;
+ (Str.regexp "\xE6", "@ae{}" ) ;
+ (Str.regexp "\xC6", "@AE{}" ) ;
+ (Str.regexp "\xDF", "@ss{}" ) ;
+ (Str.regexp "\xA9", "@copyright{}" ) ;
]
else [])
Printf.sprintf "(%s) "
(String.concat ", " (List.map f l))
- method string_of_type_args (args:Types.type_expr list) (ret:Types.type_expr option) =
+ method string_of_type_args (args:Types.type_expr list) (ret:Types.type_expr option) =
match args, ret with
| [], None -> ""
| args, None -> " of " ^ (Odoc_info.string_of_type_list " * " args)
| [], Some r -> " : " ^ (Odoc_info.string_of_type_expr r)
- | args, Some r -> " : " ^ (Odoc_info.string_of_type_list " * " args) ^
- " -> " ^ (Odoc_info.string_of_type_expr r)
+ | args, Some r -> " : " ^ (Odoc_info.string_of_type_list " * " args) ^
+ " -> " ^ (Odoc_info.string_of_type_expr r)
(** Return Texinfo code for a type. *)
method texi_of_type ty =
(* *)
(***********************************************************************)
-(* $Id: odoc_text_lexer.mll 12249 2012-03-20 12:00:11Z guesdon $ *)
+(* $Id: odoc_text_lexer.mll 12796 2012-07-30 11:22:29Z doligez $ *)
(** The lexer for string to build text structures. *)
let string_buffer = Buffer.create 32
-(** Fonction de remise à zéro de la chaine de caractères tampon *)
+(** Fonction de remise a zero de la chaine de caracteres tampon *)
let reset_string_buffer () = Buffer.reset string_buffer
-(** Fonction d'ajout d'un caractère dans la chaine de caractères tampon *)
+(** Fonction d'ajout d'un caractere dans la chaine de caracteres tampon *)
let ajout_char_string = Buffer.add_char string_buffer
(** Add a string to the buffer. *)
/* */
/***********************************************************************/
-/* $Id: bigarray_stubs.c 12433 2012-05-06 08:23:37Z xleroy $ */
+/* $Id: bigarray_stubs.c 12963 2012-09-27 15:48:40Z doligez $ */
#include <stddef.h>
#include <stdarg.h>
}
/* Compute required size in OCaml heap. Assumes struct caml_ba_array
is exactly 4 + num_dims words */
+ /* PR#5516: use C99's flexible array types if possible */
+#if (__STDC_VERSION__ >= 199901L)
+ Assert(sizeof(struct caml_ba_array) == 4 * sizeof(value));
+#else
Assert(sizeof(struct caml_ba_array) == 5 * sizeof(value));
+#endif
*wsize_32 = (4 + b->num_dims) * 4;
*wsize_64 = (4 + b->num_dims) * 8;
}
case CAML_BA_NATIVE_INT:
caml_ba_deserialize_longarray(b->data, num_elts); break;
}
+ /* PR#5516: use C99's flexible array types if possible */
+#if (__STDC_VERSION__ >= 199901L)
+ return sizeof(struct caml_ba_array) + b->num_dims * sizeof(intnat);
+#else
return sizeof(struct caml_ba_array) + (b->num_dims - 1) * sizeof(intnat);
+#endif
}
/* Create / update proxy to indicate that b2 is a sub-array of b1 */
/* */
/***********************************************************************/
-/* $Id: mmap_unix.c 12582 2012-06-07 12:17:44Z xleroy $ */
+/* $Id: mmap_unix.c 12800 2012-07-30 18:59:07Z doligez $ */
/* Needed (under Linux at least) to get pwrite's prototype in unistd.h.
Must be defined before the first system .h is included. */
if (p != -1) {
c = 0;
p = write(fd, &c, 1);
- if (p != -1)
+ if (p != -1)
p = lseek(fd, currpos, SEEK_SET);
}
}
../../byterun/mlvalues.h ../../byterun/compatibility.h \
../../byterun/config.h ../../byterun/../config/m.h \
../../byterun/../config/s.h ../../byterun/misc.h \
-
+
draw.o: draw.c libgraph.h \
\
\
This is Francois Rouaix's widget set library, Frx.
-It uses CamlTk API.
\ No newline at end of file
+It uses CamlTk API.
opt: $(LIBNAME).cmxa
clean:
- rm -f $(LIBNAME)top$(EXE) $(LIBNAME) *.cm* *.$(A)
+ rm -f $(LIBNAME)top$(EXE) $(LIBNAME) *.cm* *.$(A) *$(EXT_DLL)
superclean:
- if test -f tk.cmo; then \
cd ../camltk; $(MAKE)
$(MKLIB) -ocamlc '$(CAMLCB)' -o $(LIBNAME) \
-I ../labltk -I ../camltk $(TKOBJS) \
- -ccopt "\"$(TK_LINK)\""
+ -cclib "\"$(TK_LINK)\""
$(LIBNAME).cmxa: $(SUPPORT:.cmo=.cmx) ../Widgets.src
$(MAKE) superclean
cd ../camltk; $(MAKE) opt
$(MKLIB) -ocamlopt '$(CAMLOPTB)' -o $(LIBNAME) -oc $(LIBNAME) \
-I ../labltk -I ../camltk $(TKOBJS:.cmo=.cmx) \
- -ccopt "\"$(TK_LINK)\""
+ -cclib "\"$(TK_LINK)\""
$(LIBNAME)top$(EXE) : $(TOPDEPS) $(LIBNAME).cma ../support/lib$(LIBNAME).$(A)
$(CAMLC) -verbose -linkall -o $(LIBNAME)top$(EXE) -I ../support \
-include Makefile
\ No newline at end of file
+include Makefile
-@ocaml -I +labltk labltk.cma %1 %2 %3 %4 %5 %6 %7 %8 %9
\ No newline at end of file
+@ocaml -I +labltk labltk.cma %1 %2 %3 %4 %5 %6 %7 %8 %9
/* */
/***********************************************************************/
-/* $Id: cltkVar.c 12149 2012-02-10 16:15:24Z doligez $ */
+/* $Id: cltkVar.c 12800 2012-07-30 18:59:07Z doligez $ */
/* Alternative to tkwait variable */
#include <string.h>
if (s == NULL)
tk_error(Tcl_GetStringResult(cltclinterp));
- else
+ else
return(Val_unit);
}
/* */
/***********************************************************************/
-/* $Id: nat_stubs.c 11156 2011-07-27 14:17:02Z doligez $ */
+/* $Id: nat_stubs.c 12800 2012-07-30 18:59:07Z doligez $ */
#include "alloc.h"
#include "config.h"
}
return h;
}
-
(* *)
(***********************************************************************)
-(* $Id: str.mli 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: str.mli 12922 2012-09-11 14:40:43Z doligez $ *)
(** Regular expressions and high-level string processing *)
([\2] for the second expression, and so on up to [\9]).
- [\b ] Matches word boundaries.
- [\ ] Quotes special characters. The special characters
- are [$^.*+?[]].
+ are [$^\.*+?[]].
*)
val regexp_case_fold : string -> regexp
matching the regular expression [r]. The search starts at position
[start] and proceeds towards the end of the string.
Return the position of the first character of the matched
- substring, or raise [Not_found] if no substring matches. *)
+ substring.
+ @raise Not_found if no substring matches. *)
val search_backward : regexp -> string -> int -> int
(** [search_backward r s last] searches the string [s] for a
substring matching the regular expression [r]. The search first
considers substrings that start at position [last] and proceeds
towards the beginning of string. Return the position of the first
- character of the matched substring; raise [Not_found] if no
- substring matches. *)
+ character of the matched substring.
+ @raise Not_found if no substring matches. *)
val string_partial_match : regexp -> string -> int -> bool
(** Similar to {!Str.string_match}, but also returns true if
val matched_string : string -> string
(** [matched_string s] returns the substring of [s] that was matched
- by the latest {!Str.string_match}, {!Str.search_forward} or
- {!Str.search_backward}.
+ by the last call to one of the following matching or searching
+ functions:
+ - {!Str.string_match}
+ - {!Str.search_forward}
+ - {!Str.search_backward}
+ - {!Str.string_partial_match}
+ - {!Str.global_substitute}
+ - {!Str.substitute_first}
+ provided that none of the following functions was called inbetween:
+ - {!Str.global_replace}
+ - {!Str.replace_first}
+ - {!Str.split}
+ - {!Str.bounded_split}
+ - {!Str.split_delim}
+ - {!Str.bounded_split_delim}
+ - {!Str.full_split}
+ - {!Str.bounded_full_split}
+
+ Note: in the case of [global_substitute] and [substitute_first],
+ a call to [matched_string] is only valid within the [subst] argument,
+ not after [global_substitute] or [substitute_first] returns.
+
The user must make sure that the parameter [s] is the same string
that was passed to the matching or searching function. *)
val match_beginning : unit -> int
(** [match_beginning()] returns the position of the first character
- of the substring that was matched by {!Str.string_match},
- {!Str.search_forward} or {!Str.search_backward}. *)
+ of the substring that was matched by the last call to a matching
+ or searching function (see {!Str.matched_string} for details). *)
val match_end : unit -> int
(** [match_end()] returns the position of the character following the
- last character of the substring that was matched by [string_match],
- [search_forward] or [search_backward]. *)
+ last character of the substring that was matched by the last call
+ to a matching or searching function (see {!Str.matched_string} for
+ details). *)
val matched_group : int -> string -> string
(** [matched_group n s] returns the substring of [s] that was matched
- by the [n]th group [\(...\)] of the regular expression during
- the latest {!Str.string_match}, {!Str.search_forward} or
- {!Str.search_backward}.
+ by the [n]th group [\(...\)] of the regular expression that was
+ matched by the last call to a matching or searching function (see
+ {!Str.matched_string} for details).
The user must make sure that the parameter [s] is the same string
that was passed to the matching or searching function.
- [matched_group n s] raises [Not_found] if the [n]th group
+ @raise Not_found if the [n]th group
of the regular expression was not matched. This can happen
with groups inside alternatives [\|], options [?]
or repetitions [*]. For instance, the empty string will match
val group_beginning : int -> int
(** [group_beginning n] returns the position of the first character
of the substring that was matched by the [n]th group of
- the regular expression.
+ the regular expression that was matched by the last call to a
+ matching or searching function (see {!Str.matched_string} for details).
@raise Not_found if the [n]th group of the regular expression
was not matched.
@raise Invalid_argument if there are fewer than [n] groups in
val group_end : int -> int
(** [group_end n] returns
the position of the character following the last character of
- substring that was matched by the [n]th group of the regular expression.
+ substring that was matched by the [n]th group of the regular
+ expression that was matched by the last call to a matching or
+ searching function (see {!Str.matched_string} for details).
@raise Not_found if the [n]th group of the regular expression
was not matched.
@raise Invalid_argument if there are fewer than [n] groups in
val replace_matched : string -> string -> string
(** [replace_matched repl s] returns the replacement text [repl]
in which [\1], [\2], etc. have been replaced by the text
- matched by the corresponding groups in the most recent matching
- operation. [s] must be the same string that was matched during
- this matching operation. *)
+ matched by the corresponding groups in the regular expression
+ that was matched by the last call to a matching or searching
+ function (see {!Str.matched_string} for details).
+ [s] must be the same string that was passed to the matching or
+ searching function. *)
(** {6 Splitting} *)
the substrings that match [r], and returns the list of substrings.
For instance, [split (regexp "[ \t]+") s] splits [s] into
blank-separated words. An occurrence of the delimiter at the
- beginning and at the end of the string is ignored. *)
+ beginning or at the end of the string is ignored. *)
val bounded_split : regexp -> string -> int -> string list
(** Same as {!Str.split}, but splits into at most [n] substrings,
{
return m->waiters;
}
-
+
/* Mutexes */
typedef pthread_mutex_t * st_mutex;
return Val_int(signo);
#else
invalid_argument("Thread.wait_signal not implemented");
- return Val_int(0); /* not reached */
+ return Val_int(0); /* not reached */
#endif
}
/* */
/***********************************************************************/
-/* $Id: st_stubs.c 12324 2012-04-08 17:11:47Z xleroy $ */
+/* $Id: st_stubs.c 12800 2012-07-30 18:59:07Z doligez $ */
#include "alloc.h"
#include "backtrace.h"
sz += (value *) th->top_of_stack - (value *) th->bottom_of_stack;
#else
sz += th->stack_high - th->sp;
-#endif
+#endif
}
if (prev_stack_usage_hook != NULL)
sz += prev_stack_usage_hook();
#endif
/* The thread now stops running */
return 0;
-}
+}
CAMLprim value caml_thread_new(value clos) /* ML */
{
caml_thread_remove_info(th);
st_check_error(err, "Thread.create");
}
- /* Create the tick thread if not already done.
+ /* Create the tick thread if not already done.
Because of PR#4666, we start the tick thread late, only when we create
the first additional thread in the current process*/
if (! caml_tick_thread_running) {
return 1;
}
-/* Unregister a thread that was created from C and registered with
+/* Unregister a thread that was created from C and registered with
the function above */
CAMLexport int caml_c_thread_unregister(void)
typedef HANDLE st_thread_id;
-static DWORD st_thread_create(st_thread_id * res,
+static DWORD st_thread_create(st_thread_id * res,
LPTHREAD_START_ROUTINE fn, void * arg)
{
HANDLE h = CreateThread(NULL, 0, fn, arg, 0, NULL);
{
return 1; /* info not maintained */
}
-
+
/* Mutexes */
typedef CRITICAL_SECTION * st_mutex;
if (retcode == 0) return;
if (retcode == ERROR_NOT_ENOUGH_MEMORY) raise_out_of_memory();
if (! FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS,
- NULL,
- retcode,
- 0,
- err,
- sizeof(err),
- NULL)) {
+ NULL,
+ retcode,
+ 0,
+ err,
+ sizeof(err),
+ NULL)) {
sprintf(err, "error code %lx", retcode);
}
msglen = strlen(msg);
value caml_thread_sigmask(value cmd, value sigs) /* ML */
{
invalid_argument("Thread.sigmask not implemented");
- return Val_int(0); /* not reached */
+ return Val_int(0); /* not reached */
}
value caml_wait_signal(value sigs) /* ML */
{
invalid_argument("Thread.wait_signal not implemented");
- return Val_int(0); /* not reached */
+ return Val_int(0); /* not reached */
}
# #
#########################################################################
-# $Id: Makefile 12383 2012-04-19 13:12:23Z xleroy $
+# $Id: Makefile 12867 2012-08-21 04:39:34Z garrigue $
include ../../config/Makefile
$(LIB)/lazy.cmo $(LIB)/stream.cmo $(LIB)/buffer.cmo \
$(LIB)/printf.cmo $(LIB)/arg.cmo $(LIB)/printexc.cmo $(LIB)/gc.cmo \
$(LIB)/digest.cmo $(LIB)/random.cmo $(LIB)/hashtbl.cmo \
- $(LIB)/format.cmo $(LIB)/scanf.cmo $(LIB)/camlinternalOO.cmo \
+ $(LIB)/format.cmo $(LIB)/scanf.cmo $(LIB)/callback.cmo \
+ $(LIB)/camlinternalOO.cmo \
$(LIB)/oo.cmo $(LIB)/camlinternalMod.cmo $(LIB)/genlex.cmo \
- $(LIB)/callback.cmo $(LIB)/weak.cmo $(LIB)/filename.cmo \
+ $(LIB)/weak.cmo $(LIB)/filename.cmo \
$(LIB)/complex.cmo $(LIB)/arrayLabels.cmo $(LIB)/listLabels.cmo \
$(LIB)/stringLabels.cmo $(LIB)/stdLabels.cmo $(LIB)/moreLabels.cmo
/* */
/***********************************************************************/
-/* $Id: select.c 11156 2011-07-27 14:17:02Z doligez $ */
+/* $Id: select.c 12947 2012-09-24 11:25:32Z xleroy $ */
#include <mlvalues.h>
#include <alloc.h>
#endif
#include <string.h>
#include <unistd.h>
+#include <errno.h>
-typedef fd_set file_descr_set;
-
-static void fdlist_to_fdset(value fdlist, fd_set *fdset, int *maxfd)
+static int fdlist_to_fdset(value fdlist, fd_set *fdset, int *maxfd)
{
value l;
FD_ZERO(fdset);
for (l = fdlist; l != Val_int(0); l = Field(l, 1)) {
- int fd = Int_val(Field(l, 0));
- FD_SET(fd, fdset);
+ long fd = Long_val(Field(l, 0));
+ /* PR#5563: harden against bad fds */
+ if (fd < 0 || fd >= FD_SETSIZE) return -1;
+ FD_SET((int) fd, fdset);
if (fd > *maxfd) *maxfd = fd;
}
+ return 0;
}
static value fdset_to_fdlist(value fdlist, fd_set *fdset)
Begin_roots3 (readfds, writefds, exceptfds);
maxfd = -1;
- fdlist_to_fdset(readfds, &read, &maxfd);
- fdlist_to_fdset(writefds, &write, &maxfd);
- fdlist_to_fdset(exceptfds, &except, &maxfd);
+ retcode = fdlist_to_fdset(readfds, &read, &maxfd);
+ retcode += fdlist_to_fdset(writefds, &write, &maxfd);
+ retcode += fdlist_to_fdset(exceptfds, &except, &maxfd);
+ /* PR#5563: if a bad fd was encountered, report EINVAL error */
+ if (retcode != 0) unix_error(EINVAL, "select", Nothing);
tm = Double_val(timeout);
if (tm < 0.0)
tvp = (struct timeval *) NULL;
/* */
/***********************************************************************/
-/* $Id: close_on.c 11888 2011-12-20 08:59:09Z xleroy $ */
+/* $Id: close_on.c 12800 2012-07-30 18:59:07Z doligez $ */
#include <mlvalues.h>
#include <windows.h>
/* According to the MSDN, SetHandleInformation may not work
for console handles on WinNT4 and earlier versions. */
if (! SetHandleInformation(Handle_val(fd),
- HANDLE_FLAG_INHERIT,
- inherit ? HANDLE_FLAG_INHERIT : 0)) {
+ HANDLE_FLAG_INHERIT,
+ inherit ? HANDLE_FLAG_INHERIT : 0)) {
win32_maperr(GetLastError());
return -1;
}
/* */
/***********************************************************************/
-/* $Id: select.c 12023 2012-01-14 09:40:49Z xleroy $ */
+/* $Id: select.c 12800 2012-07-30 18:59:07Z doligez $ */
#include <mlvalues.h>
#include <alloc.h>
* It takes the following parameters into account:
* - limitation on number of objects is mostly due to limitation
* a WaitForMultipleObjects
- * - there is always an event "hStop" to watch
+ * - there is always an event "hStop" to watch
*
* This lead to pick the following value as the biggest possible
* value
typedef enum _SELECTMODE {
SELECT_MODE_NONE = 0,
SELECT_MODE_READ = 1,
- SELECT_MODE_WRITE = 2,
+ SELECT_MODE_WRITE = 2,
SELECT_MODE_EXCEPT = 4,
} SELECTMODE;
/* Allocate the data structure */
LPSELECTDATA res;
DWORD i;
-
- res = (LPSELECTDATA)caml_stat_alloc(sizeof(SELECTDATA));
+
+ res = (LPSELECTDATA)caml_stat_alloc(sizeof(SELECTDATA));
/* Init common data */
list_init((LPLIST)res);
list_next_set((LPLIST)res, (LPLIST)lpSelectData);
res->EType = EType;
res->nResultsCount = 0;
-
+
/* Data following are dedicated to APC like call, they
- will be initialized if required. For now they are set to
+ will be initialized if required. For now they are set to
invalid values.
*/
res->funcWorker = NULL;
}
/* Add a query to select data, return zero if something goes wrong */
-DWORD select_data_query_add (LPSELECTDATA lpSelectData,
- SELECTMODE EMode,
- HANDLE hFileDescr,
+DWORD select_data_query_add (LPSELECTDATA lpSelectData,
+ SELECTMODE EMode,
+ HANDLE hFileDescr,
int lpOrigIdx,
unsigned int uFlagsFd)
{
DWORD res;
- DWORD i;
+ DWORD i;
res = 0;
if (lpSelectData->nQueriesCount < MAXIMUM_SELECT_OBJECTS)
}
/* Search for a job that has available query slots and that match provided type.
- * If none is found, create a new one. Return the corresponding SELECTDATA, and
+ * If none is found, create a new one. Return the corresponding SELECTDATA, and
* update provided SELECTDATA head, if required.
*/
LPSELECTDATA select_data_job_search (LPSELECTDATA *lppSelectData, SELECTTYPE EType)
{
LPSELECTDATA res;
-
+
res = NULL;
-
+
/* Search for job */
DEBUG_PRINT("Searching an available job for type %d", EType);
res = *lppSelectData;
while (
res != NULL
&& !(
- res->EType == EType
+ res->EType == EType
&& res->nQueriesCount < MAXIMUM_SELECT_OBJECTS
)
)
DWORD n;
LPSELECTDATA lpSelectData;
LPSELECTQUERY lpQuery;
-
+
DEBUG_PRINT("Waiting for data on console");
record;
events[0] = hStop;
events[1] = lpQuery->hFileDescr;
while (lpSelectData->EState == SELECT_STATE_NONE)
- {
+ {
waitRes = WaitForMultipleObjects(2, events, FALSE, INFINITE);
if (waitRes == WAIT_OBJECT_0 || check_error(lpSelectData, waitRes == WAIT_FAILED))
{
lpSelectData->EState = SELECT_STATE_SIGNALED;
break;
}
- else
+ else
{
/* discard everything else and try again */
if (check_error(lpSelectData, ReadConsoleInput(lpQuery->hFileDescr, &record, 1, &n) == 0))
}
/* Add a function to monitor console input */
-LPSELECTDATA read_console_poll_add (LPSELECTDATA lpSelectData,
- SELECTMODE EMode,
- HANDLE hFileDescr,
+LPSELECTDATA read_console_poll_add (LPSELECTDATA lpSelectData,
+ SELECTMODE EMode,
+ HANDLE hFileDescr,
int lpOrigIdx,
unsigned int uFlagsFd)
{
{
iterQuery = &(lpSelectData->aQueries[i]);
res = PeekNamedPipe(
- iterQuery->hFileDescr,
- NULL,
- 0,
- NULL,
- &n,
+ iterQuery->hFileDescr,
+ NULL,
+ 0,
+ NULL,
+ &n,
NULL);
- if (check_error(lpSelectData,
- (res == 0) &&
+ if (check_error(lpSelectData,
+ (res == 0) &&
(GetLastError() != ERROR_BROKEN_PIPE)))
{
break;
};
/* Alas, nothing except polling seems to work for pipes.
- Check the state & stop_worker_event every 10 ms
+ Check the state & stop_worker_event every 10 ms
*/
if (lpSelectData->EState == SELECT_STATE_NONE)
{
* a chance that one of the 4 first calls succeed.
*/
wait = 2 * wait;
- if (wait > 10)
+ if (wait > 10)
{
wait = 10;
};
}
/* Add a function to monitor pipe input */
-LPSELECTDATA read_pipe_poll_add (LPSELECTDATA lpSelectData,
- SELECTMODE EMode,
- HANDLE hFileDescr,
+LPSELECTDATA read_pipe_poll_add (LPSELECTDATA lpSelectData,
+ SELECTMODE EMode,
+ HANDLE hFileDescr,
int lpOrigIdx,
unsigned int uFlagsFd)
{
LPSELECTDATA res;
LPSELECTDATA hd;
-
+
hd = lpSelectData;
/* Polling pipe is a non blocking operation by default. This means that each
- worker can handle many pipe. We begin to try to find a worker that is
+ worker can handle many pipe. We begin to try to find a worker that is
polling pipe, but for which there is under the limit of pipe per worker.
*/
DEBUG_PRINT("Searching an available worker handling pipe");
res = select_data_job_search(&hd, SELECT_TYPE_PIPE_READ);
-
+
/* Add a new pipe to poll */
res->funcWorker = read_pipe_poll;
select_data_query_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
check_error(lpSelectData,
WSAEventSelect(
- (SOCKET)(iterQuery->hFileDescr),
- aEvents[nEvents],
+ (SOCKET)(iterQuery->hFileDescr),
+ aEvents[nEvents],
maskEvents) == SOCKET_ERROR);
}
-
+
/* Add stop event */
aEvents[nEvents] = hStop;
nEvents++;
if (lpSelectData->nError == 0)
{
- check_error(lpSelectData,
+ check_error(lpSelectData,
WaitForMultipleObjects(
- nEvents,
- aEvents,
- FALSE,
+ nEvents,
+ aEvents,
+ FALSE,
INFINITE) == WAIT_FAILED);
};
}
/* Add a function to monitor socket */
-LPSELECTDATA socket_poll_add (LPSELECTDATA lpSelectData,
- SELECTMODE EMode,
- HANDLE hFileDescr,
+LPSELECTDATA socket_poll_add (LPSELECTDATA lpSelectData,
+ SELECTMODE EMode,
+ HANDLE hFileDescr,
int lpOrigIdx,
unsigned int uFlagsFd)
{
LPSELECTDATA candidate;
DWORD i;
LPSELECTQUERY aQueries;
-
+
res = lpSelectData;
candidate = NULL;
aQueries = NULL;
/***********************/
/* Add a static result */
-LPSELECTDATA static_poll_add (LPSELECTDATA lpSelectData,
- SELECTMODE EMode,
- HANDLE hFileDescr,
+LPSELECTDATA static_poll_add (LPSELECTDATA lpSelectData,
+ SELECTMODE EMode,
+ HANDLE hFileDescr,
int lpOrigIdx,
unsigned int uFlagsFd)
{
LPSELECTDATA res;
LPSELECTDATA hd;
-
+
/* Look for an already initialized static element */
hd = lpSelectData;
res = select_data_job_search(&hd, SELECT_TYPE_STATIC);
-
+
/* Add a new query/result */
select_data_query_add(res, EMode, hFileDescr, lpOrigIdx, uFlagsFd);
select_data_result_add(res, EMode, lpOrigIdx);
{
switch(GetFileType(Handle_val(fd)))
{
- case FILE_TYPE_DISK:
+ case FILE_TYPE_DISK:
res = SELECT_HANDLE_DISK;
break;
DEBUG_PRINT("Begin dispatching handle %x", hFileDescr);
DEBUG_PRINT("Waiting for %d on handle %x", EMode, hFileDescr);
-
- /* There is only 2 way to have except mode: transmission of OOB data through
+
+ /* There is only 2 way to have except mode: transmission of OOB data through
a socket TCP/IP and through a strange interaction with a TTY.
With windows, we only consider the TCP/IP except condition
*/
CAMLlocal2(result, list);
int i;
- switch( iterResult->EMode )
+ switch( iterResult->EMode )
{
case SELECT_MODE_READ:
list = readfds;
break;
};
- for(i=0; list != Val_unit && i < iterResult->lpOrigIdx; ++i )
+ for(i=0; list != Val_unit && i < iterResult->lpOrigIdx; ++i )
{
list = Field(list, 1);
}
- if (list == Val_unit)
+ if (list == Val_unit)
failwith ("select.c: original file handle not found");
result = Field(list, 0);
}
CAMLprim value unix_select(value readfds, value writefds, value exceptfds, value timeout)
-{
+{
/* Event associated to handle */
DWORD nEventsCount;
DWORD nEventsMax;
HANDLE *lpEventsDone;
-
+
/* Data for all handles */
LPSELECTDATA lpSelectData;
LPSELECTDATA iterSelectData;
double tm;
struct timeval tv;
struct timeval * tvp;
-
+
DEBUG_PRINT("in select");
err = 0;
leave_blocking_section();
}
read_list = write_list = except_list = Val_int(0);
- } else {
+ } else {
if (fdlist_to_fdset(readfds, &read) && fdlist_to_fdset(writefds, &write) && fdlist_to_fdset(exceptfds, &except)) {
DEBUG_PRINT("only sockets to select on, using classic select");
if (tm < 0.0) {
writefds_len = caml_list_length(writefds);
exceptfds_len = caml_list_length(exceptfds);
hdsMax = MAX(readfds_len, MAX(writefds_len, exceptfds_len));
-
+
hdsData = (HANDLE *)caml_stat_alloc(sizeof(HANDLE) * hdsMax);
-
+
if (tm >= 0.0)
{
milliseconds = 1000 * tm;
{
milliseconds = INFINITE;
}
-
-
+
+
/* Create list of select data, based on the different list of fd to watch */
DEBUG_PRINT("Dispatch read fd");
handle_set_init(&hds, hdsData, hdsMax);
}
}
handle_set_reset(&hds);
-
+
DEBUG_PRINT("Dispatch write fd");
handle_set_init(&hds, hdsData, hdsMax);
i=0;
}
}
handle_set_reset(&hds);
-
+
DEBUG_PRINT("Dispatch exceptional fd");
handle_set_init(&hds, hdsData, hdsMax);
i=0;
}
}
handle_set_reset(&hds);
-
+
/* Building the list of handle to wait for */
DEBUG_PRINT("Building events done array");
nEventsMax = list_length((LPLIST)lpSelectData);
nEventsCount = 0;
lpEventsDone = (HANDLE *)caml_stat_alloc(sizeof(HANDLE) * nEventsMax);
-
+
iterSelectData = lpSelectData;
while (iterSelectData != NULL)
{
{
hasStaticData = TRUE;
};
-
+
/* Execute APC */
if (iterSelectData->funcWorker != NULL)
{
- iterSelectData->lpWorker =
+ iterSelectData->lpWorker =
worker_job_submit(
- iterSelectData->funcWorker,
+ iterSelectData->funcWorker,
(void *)iterSelectData);
- DEBUG_PRINT("Job submitted to worker %x", iterSelectData->lpWorker);
+ DEBUG_PRINT("Job submitted to worker %x", iterSelectData->lpWorker);
lpEventsDone[nEventsCount] = worker_job_event_done(iterSelectData->lpWorker);
nEventsCount++;
};
iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
};
-
+
DEBUG_PRINT("Need to watch %d workers", nEventsCount);
-
+
/* Processing select itself */
enter_blocking_section();
/* There are worker started, waiting to be monitored */
case WAIT_FAILED:
err = GetLastError();
break;
-
+
case WAIT_TIMEOUT:
DEBUG_PRINT("Select timeout");
break;
-
+
default:
DEBUG_PRINT("One worker is done");
break;
};
}
-
+
/* Ordering stop to every worker */
DEBUG_PRINT("Sending stop signal to every select workers");
iterSelectData = lpSelectData;
};
iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
};
-
+
DEBUG_PRINT("Waiting for every select worker to be done");
switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, TRUE, INFINITE))
{
case WAIT_FAILED:
err = GetLastError();
break;
-
+
default:
DEBUG_PRINT("Every worker is done");
break;
Sleep(milliseconds);
}
leave_blocking_section();
-
+
DEBUG_PRINT("Error status: %d (0 is ok)", err);
/* Build results */
if (err == 0)
{
DEBUG_PRINT("Building result");
- read_list = Val_unit;
+ read_list = Val_unit;
write_list = Val_unit;
except_list = Val_unit;
-
+
iterSelectData = lpSelectData;
while (iterSelectData != NULL)
{
iterSelectData = LIST_NEXT(LPSELECTDATA, iterSelectData);
}
}
-
+
/* Free resources */
DEBUG_PRINT("Free selectdata resources");
iterSelectData = lpSelectData;
select_data_free(lpSelectData);
}
lpSelectData = NULL;
-
+
/* Free allocated events/handle set array */
DEBUG_PRINT("Free local allocated resources");
caml_stat_free(lpEventsDone);
caml_stat_free(hdsData);
-
+
DEBUG_PRINT("Raise error if required");
if (err != 0)
{
-#include <windows.h>\r
-#include <mlvalues.h>\r
-#include "unixsupport.h"\r
-\r
-\r
-double to_sec(FILETIME ft) {\r
- ULARGE_INTEGER tmp;\r
-\r
- tmp.u.LowPart = ft.dwLowDateTime;\r
- tmp.u.HighPart = ft.dwHighDateTime;\r
-\r
- /* convert to seconds:\r
- GetProcessTimes returns number of 100-nanosecond intervals */\r
- return tmp.QuadPart / 1e7;\r
-}\r
-\r
-\r
-value unix_times(value unit) {\r
-\r
- value res;\r
- FILETIME creation, exit, stime, utime;\r
-\r
- if (!(GetProcessTimes(GetCurrentProcess(), &creation, &exit, &stime, &utime))) {\r
- win32_maperr(GetLastError());\r
- uerror("times", Nothing);\r
- }\r
-\r
- res = alloc_small(4 * Double_wosize, Double_array_tag);\r
- Store_double_field(res, 0, to_sec(utime));\r
- Store_double_field(res, 1, to_sec(stime));\r
- Store_double_field(res, 2, 0);\r
- Store_double_field(res, 3, 0);\r
- return res;\r
-\r
-}\r
+#include <windows.h>
+#include <mlvalues.h>
+#include "unixsupport.h"
+
+
+double to_sec(FILETIME ft) {
+ ULARGE_INTEGER tmp;
+
+ tmp.u.LowPart = ft.dwLowDateTime;
+ tmp.u.HighPart = ft.dwHighDateTime;
+
+ /* convert to seconds:
+ GetProcessTimes returns number of 100-nanosecond intervals */
+ return tmp.QuadPart / 1e7;
+}
+
+
+value unix_times(value unit) {
+
+ value res;
+ FILETIME creation, exit, stime, utime;
+
+ if (!(GetProcessTimes(GetCurrentProcess(), &creation, &exit, &stime, &utime))) {
+ win32_maperr(GetLastError());
+ uerror("times", Nothing);
+ }
+
+ res = alloc_small(4 * Double_wosize, Double_array_tag);
+ Store_double_field(res, 0, to_sec(utime));
+ Store_double_field(res, 1, to_sec(stime));
+ Store_double_field(res, 2, 0);
+ Store_double_field(res, 3, 0);
+ return res;
+
+}
/* */
/***********************************************************************/
-/* $Id: windbug.c 11156 2011-07-27 14:17:02Z doligez $ */
+/* $Id: windbug.c 12800 2012-07-30 18:59:07Z doligez $ */
#include "windbug.h"
debug = (getenv("OCAMLDEBUG") != NULL);
debug_init = 1;
};
-#endif
+#endif
return debug;
}
(* *)
(***********************************************************************)
-(* $Id: location.mli 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* $Id: location.mli 12800 2012-07-30 18:59:07Z doligez $ *)
(* Source code locations (ranges of positions), used in parsetree. *)
val absname: bool ref
-
/* */
/***********************************************************************/
-/* $Id: parser.mly 12638 2012-06-21 17:10:58Z frisch $ */
+/* $Id: parser.mly 12800 2012-07-30 18:59:07Z doligez $ */
/* The parser definition */
| constr_ident generalized_constructor_arguments
{ let arg_types,ret_type = $2 in
- (mkrhs $1 1, arg_types,ret_type, symbol_rloc()) }
+ (mkrhs $1 1, arg_types,ret_type, symbol_rloc()) }
;
constructor_arguments:
(* *)
(***********************************************************************)
-(* $Id: printast.ml 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* $Id: printast.ml 12800 2012-07-30 18:59:07Z doligez $ *)
open Asttypes;;
open Format;;
and string_option_underscore i ppf =
function
| Some x ->
- string i ppf x.txt
+ string i ppf x.txt
| None ->
- string i ppf "_"
+ string i ppf "_"
and type_declaration i ppf x =
line i ppf "type_declaration %a\n" fmt_location x.ptype_loc;
(* *)
(***********************************************************************)
-(* $Id: array.ml 11914 2011-12-21 10:41:59Z xleroy $ *)
+(* $Id: array.ml 12891 2012-08-28 15:07:45Z xleroy $ *)
(* Array operations *)
external unsafe_set: 'a array -> int -> 'a -> unit = "%array_unsafe_set"
external make: int -> 'a -> 'a array = "caml_make_vect"
external create: int -> 'a -> 'a array = "caml_make_vect"
-external sub : 'a array -> int -> int -> 'a array = "caml_array_sub"
+external unsafe_sub : 'a array -> int -> int -> 'a array = "caml_array_sub"
external append_prim : 'a array -> 'a array -> 'a array = "caml_array_append"
external concat : 'a array list -> 'a array = "caml_array_concat"
external unsafe_blit : 'a array -> int -> 'a array -> int -> int -> unit = "caml_array_blit"
let create_matrix = make_matrix
let copy a =
- let l = length a in if l = 0 then [||] else sub a 0 l
+ let l = length a in if l = 0 then [||] else unsafe_sub a 0 l
let append a1 a2 =
let l1 = length a1 in
if l1 = 0 then copy a2
- else if length a2 = 0 then sub a1 0 l1
+ else if length a2 = 0 then unsafe_sub a1 0 l1
else append_prim a1 a2
+let sub a ofs len =
+ if len < 0 || ofs > length a - len
+ then invalid_arg "Array.sub"
+ else unsafe_sub a ofs len
+
let fill a ofs len v =
if ofs < 0 || len < 0 || ofs > length a - len
then invalid_arg "Array.fill"
(* *)
(***********************************************************************)
-(* $Id: format.mli 12213 2012-03-08 22:36:21Z doligez $ *)
+(* $Id: format.mli 12906 2012-09-08 15:27:53Z doligez $ *)
(** Pretty printing.
overflows that leads to split lines.
Nothing happens if [d] is smaller than 2.
If [d] is too large, the right margin is set to the maximum
- admissible value (which is greater than [10^10]). *)
+ admissible value (which is greater than [10^9]). *)
val get_margin : unit -> int;;
(** Returns the position of the right margin. *)
if they do not fit on the current line.
Nothing happens if [d] is smaller than 2.
If [d] is too large, the limit is set to the maximum
- admissible value (which is greater than [10^10]). *)
+ admissible value (which is greater than [10^9]). *)
val get_max_indent : unit -> int;;
(** Return the value of the maximum indentation limit (in characters). *)
For more details about tags, see the functions [open_tag] and
[close_tag].
- [@\}]: close the most recently opened tag.
- - [@%]: print a plain [%] character.
Example: [printf "@[%s@ %d@]@." "x =" 1] is equivalent to
[open_box (); print_string "x ="; print_space ();
(* *)
(***********************************************************************)
-(* $Id: stdLabels.mli 12210 2012-03-08 19:52:03Z doligez $ *)
+(* $Id: stdLabels.mli 12823 2012-08-06 11:41:12Z doligez $ *)
(** Standard labeled libraries.
unit
val concat : sep:string -> string list -> string
val iter : f:(char -> unit) -> string -> unit
+ val iteri : f:(int -> char -> unit) -> string -> unit
+ val map : f:(char -> char) -> string -> string
val trim : string -> string
val escaped : string -> string
val index : string -> char -> int
(* *)
(***********************************************************************)
-(* $Id: stream.ml 12683 2012-07-10 10:01:57Z scherer $ *)
+(* $Id: stream.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* The fields of type t are not mutable to preserve polymorphism of
the empty stream. This is type safe because the empty stream is never
(* Only return a "forced stream", that is either Sempty or
Scons(a,_). If d is a generator or a buffer, the item a is seen as
extracted from the generator/buffer.
-
+
Forcing also updates the "count" field of the delayed stream,
in the Sapp and Slazy cases (see slazy/lapp implementation below). *)
Sempty | Scons (_, _) -> d
(* *)
(***********************************************************************)
-(* $Id: alloc.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: alloc.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* Random allocation test *)
Arg.parse argspecs (fun _ -> ()) "Usage: alloc [-c]";;
main ();;
-
(* *)
(***********************************************************************)
-(* $Id: testing.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: testing.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* Testing auxilliaries. *)
let test_num = ref (-1);;
let print_test_number () =
- print_int !test_num; print_string " "; flush stdout;;
+ print_string " "; print_int !test_num; flush stdout;;
let next_test () =
incr test_num;
let scan_failure_test f x =
test_raises_exc_p (function Scan_failure _ -> true | _ -> false) f x;;
-
/* */
/***********************************************************************/
-/* $Id: amd64.S 11156 2011-07-27 14:17:02Z doligez $ */
+/* $Id: amd64.S 12800 2012-07-30 18:59:07Z doligez $ */
#ifdef SYS_macosx
#define ALIGN 4
pushq %r13
pushq %r14
pushq %r15
- movq %rdi, %r10
- movq %rsi, %rax
- movq %rdx, %rbx
- movq %rcx, %rdi
- movq %r8, %rsi
- call *%r10
+ movq %rdi, %r10
+ movq %rsi, %rax
+ movq %rdx, %rbx
+ movq %rcx, %rdi
+ movq %r8, %rsi
+ call *%r10
popq %r15
popq %r14
popq %r13
jmp *%rax
#ifdef SYS_macosx
- .literal16
+ .literal16
#else
- .section .rodata.cst8,"aM",@progbits,8
+ .section .rodata.cst8,"aM",@progbits,8
#endif
.globl CAML_NEGF_MASK
.align ALIGN
CAML_NEGF_MASK:
- .quad 0x8000000000000000, 0
+ .quad 0x8000000000000000, 0
.globl CAML_ABSF_MASK
.align ALIGN
CAML_ABSF_MASK:
- .quad 0x7FFFFFFFFFFFFFFF, 0
+ .quad 0x7FFFFFFFFFFFFFFF, 0
.comm young_limit, 8
(* *)
(***********************************************************************)
-(* $Id: arith.cmm 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: arith.cmm 12800 2012-07-30 18:59:07Z doligez $ *)
(* Regression test for arithmetic instructions *)
(floataset d 38 (absf f))
)))))))
-
-
-
/* */
/***********************************************************************/
-/* $Id: arm.S 11156 2011-07-27 14:17:02Z doligez $ */
+/* $Id: arm.S 12800 2012-07-30 18:59:07Z doligez $ */
.text
caml_c_call:
@ function to call is in r10
mov pc, r10
-
(* *)
(***********************************************************************)
-(* $Id: checkbound.cmm 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: checkbound.cmm 12800 2012-07-30 18:59:07Z doligez $ *)
(function "checkbound2" (x: int y: int)
(checkbound x y))
(function "checkbound1" (x: int)
(checkbound x 2))
-
-
;* *
;*********************************************************************
-; $Id: hppa.S 11156 2011-07-27 14:17:02Z doligez $
+; $Id: hppa.S 12800 2012-07-30 18:59:07Z doligez $
; Must be preprocessed by cpp
#ifdef SYS_hpux
#endif
#ifdef SYS_hpux
- .space $PRIVATE$
- .subspa $DATA$,quad=1,align=8,access=31
- .subspa $BSS$,quad=1,align=8,access=31,zero,sort=82
- .space $TEXT$
- .subspa $LIT$,quad=0,align=8,access=44
- .subspa $CODE$,quad=0,align=8,access=44,code_only
- .import $global$, data
+ .space $PRIVATE$
+ .subspa $DATA$,quad=1,align=8,access=31
+ .subspa $BSS$,quad=1,align=8,access=31,zero,sort=82
+ .space $TEXT$
+ .subspa $LIT$,quad=0,align=8,access=44
+ .subspa $CODE$,quad=0,align=8,access=44,code_only
+ .import $global$, data
.import $$dyncall, millicode
#endif
EXPORT_CODE(G(call_gen_code))
G(call_gen_code):
STARTPROC
- stw %r2,-20(%r30)
- ldo 256(%r30), %r30
+ stw %r2,-20(%r30)
+ ldo 256(%r30), %r30
; Save the callee-save registers
ldo -32(%r30), %r1
stws,ma %r3, -4(%r1)
stws,ma %r16, -4(%r1)
stws,ma %r17, -4(%r1)
stws,ma %r18, -4(%r1)
- fstds,ma %fr12, -8(%r1)
- fstds,ma %fr13, -8(%r1)
- fstds,ma %fr14, -8(%r1)
- fstds,ma %fr15, -8(%r1)
- fstds,ma %fr16, -8(%r1)
- fstds,ma %fr17, -8(%r1)
- fstds,ma %fr18, -8(%r1)
- fstds,ma %fr19, -8(%r1)
- fstds,ma %fr20, -8(%r1)
- fstds,ma %fr21, -8(%r1)
- fstds,ma %fr22, -8(%r1)
- fstds,ma %fr23, -8(%r1)
- fstds,ma %fr24, -8(%r1)
- fstds,ma %fr25, -8(%r1)
- fstds,ma %fr26, -8(%r1)
- fstds,ma %fr27, -8(%r1)
- fstds,ma %fr28, -8(%r1)
- fstds,ma %fr29, -8(%r1)
- fstds,ma %fr30, -8(%r1)
- fstds,ma %fr31, -8(%r1)
+ fstds,ma %fr12, -8(%r1)
+ fstds,ma %fr13, -8(%r1)
+ fstds,ma %fr14, -8(%r1)
+ fstds,ma %fr15, -8(%r1)
+ fstds,ma %fr16, -8(%r1)
+ fstds,ma %fr17, -8(%r1)
+ fstds,ma %fr18, -8(%r1)
+ fstds,ma %fr19, -8(%r1)
+ fstds,ma %fr20, -8(%r1)
+ fstds,ma %fr21, -8(%r1)
+ fstds,ma %fr22, -8(%r1)
+ fstds,ma %fr23, -8(%r1)
+ fstds,ma %fr24, -8(%r1)
+ fstds,ma %fr25, -8(%r1)
+ fstds,ma %fr26, -8(%r1)
+ fstds,ma %fr27, -8(%r1)
+ fstds,ma %fr28, -8(%r1)
+ fstds,ma %fr29, -8(%r1)
+ fstds,ma %fr30, -8(%r1)
+ fstds,ma %fr31, -8(%r1)
; Shuffle the arguments and call
copy %r26, %r22
ldws,ma -4(%r1), %r16
ldws,ma -4(%r1), %r17
ldws,ma -4(%r1), %r18
- fldds,ma -8(%r1), %fr12
- fldds,ma -8(%r1), %fr13
- fldds,ma -8(%r1), %fr14
- fldds,ma -8(%r1), %fr15
- fldds,ma -8(%r1), %fr16
- fldds,ma -8(%r1), %fr17
- fldds,ma -8(%r1), %fr18
- fldds,ma -8(%r1), %fr19
- fldds,ma -8(%r1), %fr20
- fldds,ma -8(%r1), %fr21
- fldds,ma -8(%r1), %fr22
- fldds,ma -8(%r1), %fr23
- fldds,ma -8(%r1), %fr24
- fldds,ma -8(%r1), %fr25
- fldds,ma -8(%r1), %fr26
- fldds,ma -8(%r1), %fr27
- fldds,ma -8(%r1), %fr28
- fldds,ma -8(%r1), %fr29
- fldds,ma -8(%r1), %fr30
- fldds,ma -8(%r1), %fr31
+ fldds,ma -8(%r1), %fr12
+ fldds,ma -8(%r1), %fr13
+ fldds,ma -8(%r1), %fr14
+ fldds,ma -8(%r1), %fr15
+ fldds,ma -8(%r1), %fr16
+ fldds,ma -8(%r1), %fr17
+ fldds,ma -8(%r1), %fr18
+ fldds,ma -8(%r1), %fr19
+ fldds,ma -8(%r1), %fr20
+ fldds,ma -8(%r1), %fr21
+ fldds,ma -8(%r1), %fr22
+ fldds,ma -8(%r1), %fr23
+ fldds,ma -8(%r1), %fr24
+ fldds,ma -8(%r1), %fr25
+ fldds,ma -8(%r1), %fr26
+ fldds,ma -8(%r1), %fr27
+ fldds,ma -8(%r1), %fr28
+ fldds,ma -8(%r1), %fr29
+ fldds,ma -8(%r1), %fr30
+ fldds,ma -8(%r1), %fr31
- ldo -256(%r30), %r30
- ldw -20(%r30), %r2
+ ldo -256(%r30), %r30
+ ldw -20(%r30), %r2
bv 0(%r2)
nop
ENDPROC
- .align CODE_ALIGN
- EXPORT_CODE(caml_c_call)
+ .align CODE_ALIGN
+ EXPORT_CODE(caml_c_call)
G(caml_c_call):
STARTPROC
#ifdef SYS_hpux
bl $$dyncall, %r0
nop
#else
- bv 0(%r22)
+ bv 0(%r22)
nop
#endif
ENDPROC
-;*********************************************************************
-;
-; OCaml
-;
-; 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.
-;
-;*********************************************************************
+;*********************************************************************;
+; ;
+; OCaml ;
+; ;
+; 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: i386nt.asm 11156 2011-07-27 14:17:02Z doligez $
+; $Id: i386nt.asm 12800 2012-07-30 18:59:07Z doligez $
- .386
- .MODEL FLAT
+ .386
+ .MODEL FLAT
.CODE
PUBLIC _call_gen_code
ALIGN 4
_call_gen_code:
- push ebp
- mov ebp, esp
- push ebx
- push esi
- push edi
- mov eax, [ebp+12]
- mov ebx, [ebp+16]
- mov ecx, [ebp+20]
- mov edx, [ebp+24]
- call DWORD PTR [ebp+8]
- pop edi
- pop esi
- pop ebx
- pop ebp
- ret
+ push ebp
+ mov ebp, esp
+ push ebx
+ push esi
+ push edi
+ mov eax, [ebp+12]
+ mov ebx, [ebp+16]
+ mov ecx, [ebp+20]
+ mov edx, [ebp+24]
+ call DWORD PTR [ebp+8]
+ pop edi
+ pop esi
+ pop ebx
+ pop ebp
+ ret
PUBLIC _caml_c_call
ALIGN 4
_caml_c_call:
- ffree st(0)
- ffree st(1)
- ffree st(2)
- ffree st(3)
- jmp eax
+ ffree st(0)
+ ffree st(1)
+ ffree st(2)
+ ffree st(3)
+ jmp eax
PUBLIC _caml_call_gc
PUBLIC _caml_alloc
PUBLIC _caml_alloc1
PUBLIC _caml_alloc2
- PUBLIC _caml_alloc3
+ PUBLIC _caml_alloc3
_caml_call_gc:
_caml_alloc:
_caml_alloc1:
_caml_alloc2:
_caml_alloc3:
- int 3
+ int 3
.DATA
- PUBLIC _caml_exception_pointer
-_caml_exception_pointer dword 0
- PUBLIC _young_ptr
-_young_ptr dword 0
- PUBLIC _young_limit
-_young_limit dword 0
+ PUBLIC _caml_exception_pointer
+_caml_exception_pointer dword 0
+ PUBLIC _young_ptr
+_young_ptr dword 0
+ PUBLIC _young_limit
+_young_limit dword 0
END
|* *
|***********************************************************************
-| $Id: m68k.S 11156 2011-07-27 14:17:02Z doligez $
+| $Id: m68k.S 12800 2012-07-30 18:59:07Z doligez $
| call_gen_code is used with the following types:
| unit -> int
| int * int * address -> void
| int * int -> void
| unit -> unit
-| Hence arg1 -> d0, arg2 -> d1, arg3 -> a0,
+| Hence arg1 -> d0, arg2 -> d1, arg3 -> a0,
| and we need a special case for int -> double
.text
(* *)
(***********************************************************************)
-(* $Id: main.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: main.ml 12800 2012-07-30 18:59:07Z doligez $ *)
open Clflags
] compile_file usage
let _ = (*Printexc.catch*) main (); exit 0
-
/* */
/***********************************************************************/
-/* $Id: mainarith.c 11156 2011-07-27 14:17:02Z doligez $ */
+/* $Id: mainarith.c 12800 2012-07-30 18:59:07Z doligez $ */
#include <stdio.h>
#include <math.h>
}
return 0;
}
-
/* */
/***********************************************************************/
-/* $Id: parsecmm.mly 12235 2012-03-14 09:24:19Z xleroy $ */
+/* $Id: parsecmm.mly 12800 2012-07-30 18:59:07Z doligez $ */
/* A simple parser for C-- */
| SKIP INTCONST { Cskip $2 }
| ALIGN INTCONST { Calign $2 }
;
-
(* *)
(***********************************************************************)
-(* $Id: tagged-fib.cmm 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: tagged-fib.cmm 12800 2012-07-30 18:59:07Z doligez $ *)
(function "fib" (n: int)
(if (< n 5)
3
(- (+ (app "fib" (- n 2) int) (app "fib" (- n 4) int)) 1)))
-
(* *)
(***********************************************************************)
-(* $Id: tagged-integr.cmm 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: tagged-integr.cmm 12800 2012-07-30 18:59:07Z doligez $ *)
("res_square": skip 8)
("h": skip 8)
(store float "low" 0.0)
(store float "hi" 1.0)
(load float (app "integr" "square" "low" "hi" n addr)))
-
print_float (Float_record.from s.Float_record.f);;
print_newline ();;
-
print_string "Trail:";
List.iter (fun n -> print_string " "; print_int n) !trail;
print_newline()
-
-
test "deux" g 9 7 ; ()
;;
-
+
let g x = match x with
1 -> 1
| 2 -> 2
| 3 -> 3
| 4 | 5 -> 4
-| 6 -> 5
+| 6 -> 5
| 7 | 8 -> 6
| 9 -> 7
| _ -> 8;;
| 2 -> 2
| 3 -> 3
| 4 | 5 -> 4
-| 6 -> 5
+| 6 -> 5
| 4|5|7 -> 100
| 7 | 8 -> 6
| 9 -> 7
test "fin" f (E (C,A)) (D (A,0)) ; ()
;;
-type length =
+type length =
Char of int | Pixel of int | Percent of int | No of string | Default
let length = function
(* Les bugs de jerome *)
type f =
- | ABSENT
+ | ABSENT
| FILE
| SYMLINK
| DIRECTORY
;;
-test "jerome_constr"
+test "jerome_constr"
replicaContent2shortString (ABSENT, Unchanged) " " ;
-test "jerome_constr"
+test "jerome_constr"
replicaContent2shortString (ABSENT, Deleted) "deleted " ;
-test "jerome_constr"
+test "jerome_constr"
replicaContent2shortString (FILE, Modified) "changed " ;
-test "jerome_constr"
+test "jerome_constr"
replicaContent2shortString (DIRECTORY, PropsChanged) "props " ;
-test "jerome_constr"
+test "jerome_constr"
replicaContent2shortString (FILE, Deleted) "assert false" ;
-test "jerome_constr"
+test "jerome_constr"
replicaContent2shortString (SYMLINK, Deleted) "assert false" ;
-test "jerome_constr"
+test "jerome_constr"
replicaContent2shortString (SYMLINK, PropsChanged) "assert false" ;
-test "jerome_constr"
+test "jerome_constr"
replicaContent2shortString (DIRECTORY, Deleted) "assert false" ;
-test "jerome_constr"
+test "jerome_constr"
replicaContent2shortString (ABSENT, Created) "assert false" ;
-test "jerome_constr"
+test "jerome_constr"
replicaContent2shortString (ABSENT, Modified) "assert false" ;
-test "jerome_constr"
+test "jerome_constr"
replicaContent2shortString (ABSENT, PropsChanged) "assert false" ;
;;
;;
-test "jerome_variant"
+test "jerome_variant"
replicaContent2shortString (`ABSENT, `Unchanged) " " ;
-test "jerome_variant"
+test "jerome_variant"
replicaContent2shortString (`ABSENT, `Deleted) "deleted " ;
-test "jerome_variant"
+test "jerome_variant"
replicaContent2shortString (`FILE, `Modified) "changed " ;
-test "jerome_variant"
+test "jerome_variant"
replicaContent2shortString (`DIRECTORY, `PropsChanged) "props " ;
-test "jerome_variant"
+test "jerome_variant"
replicaContent2shortString (`FILE, `Deleted) "assert false" ;
-test "jerome_variant"
+test "jerome_variant"
replicaContent2shortString (`SYMLINK, `Deleted) "assert false" ;
-test "jerome_variant"
+test "jerome_variant"
replicaContent2shortString (`SYMLINK, `PropsChanged) "assert false" ;
-test "jerome_variant"
+test "jerome_variant"
replicaContent2shortString (`DIRECTORY, `Deleted) "assert false" ;
-test "jerome_variant"
+test "jerome_variant"
replicaContent2shortString (`ABSENT, `Created) "assert false" ;
-test "jerome_variant"
+test "jerome_variant"
replicaContent2shortString (`ABSENT, `Modified) "assert false" ;
-test "jerome_variant"
+test "jerome_variant"
replicaContent2shortString (`ABSENT, `PropsChanged) "assert false" ;
;;
type habert_a=
| A of habert_c
| B of habert_c
-
-and habert_c= {lvar:int; lassoc: habert_c;lnb:int}
-
-
+
+and habert_c= {lvar:int; lassoc: habert_c;lnb:int}
+
+
let habert=function
| (A {lnb=i}|B {lnb=i}) when i=0 -> 1
| A {lassoc=({lnb=j});lnb=i} -> 2
| `TVariant of string list
| `TBlock of int
| `TCopy of type_expr
- ]
+ ]
and recurs_type_expr = [
| `TTuple of type_expr list
| `TConstr of type_expr list
| `TVariant of string list
- ]
+ ]
let rec maf te =
| `False
| `True
]
-
+
type vg = [
| `A
| `B
x : bg;
}
-let predg x = true
+let predg x = true
let rec gilles o = match o with
| {v = (`U data | `V data); x = `False} when predg o -> 1
test "lucexn1" lucexn (Error "coucou") "coucou" ;
test "lucexn2" lucexn (Found ("int: ",0)) "int: 0" ;
()
+
+(*
+ PR#5758: different representations of floats
+*)
+
+let pr5758 x str =
+ match (x, str) with
+ | (1. , "A") -> "Matched A"
+ | (1.0, "B") -> "Matched B"
+ | (1. , "C") -> "Matched C"
+ | result ->
+ match result with
+ | (1., "A") -> "Failed match A then later matched"
+ | _ -> "Failed twice"
+;;
+
+let () =
+ test "pr5758" (pr5758 1.) "A" "Matched A"
+;;
Buffer.add_substitute b identity pat1;
test (String.length (Buffer.contents b) = n1)
;;
-
-0 1
+ 0 1
All tests succeeded.
let _ =
for i = 0 to 20 do
- print_int (int 1000); print_char ' '
+ print_char ' '; print_int (int 1000);
done;
print_newline (); print_newline ();
for i = 0 to 20 do
- print_float (float 1000.); print_char ' '
+ print_char ' '; print_float (float 1000.);
done
let _ = exit 0
-344 685 182 641 439 500 104 20 921 370 217 885 949 678 615 412 401 606 428 869 289
+ 344 685 182 641 439 500 104 20 921 370 217 885 949 678 615 412 401 606 428 869 289
-122.128067547 461.324792129 360.006556146 768.75882284 396.500946942 190.217751234 567.660068681 403.59226778 59.8488223602 363.816246826 764.705761642 172.627051105 481.861849093 399.173195422 629.424106752 391.547032203 676.701133948 174.382120878 994.425675487 585.00027757 34.3270777955
+ 122.128067547 461.324792129 360.006556146 768.75882284 396.500946942 190.217751234 567.660068681 403.59226778 59.8488223602 363.816246826 764.705761642 172.627051105 481.861849093 399.173195422 629.424106752 391.547032203 676.701133948 174.382120878 994.425675487 585.00027757 34.3270777955
All tests succeeded.
-0
+ 0
All tests succeeded.
let test2 () = true
(* sprintf "%1$d\n" 5 1 = " 1\n" &&
sprintf "%01$d\n" 5 1 = "00001\n" *);;
-
+
test (test2 ());;
(* Testing meta format string printing. *)
-0 1 2 3 4 5
+ 0 1 2 3 4 5
All tests succeeded.
if a <> [|"a"; "a"; "a"; "a"; "a"; "b1"; "b1"; "b2"; "b3"; "a"|]
then print_string "Test7: failed(2)\n"
+let test8 () =
+ (try
+ ignore (Array.sub [||] 0 1); print_string "Test 8.1: failed\n"
+ with Invalid_argument _ -> ());
+ (try
+ ignore (Array.sub [|3;4|] 1 (-1)); print_string "Test 8.2: failed\n"
+ with Invalid_argument _ -> ());
+ (try
+ ignore (Array.sub [|3;4|] max_int 1); print_string "Test 8.3: failed\n"
+ with Invalid_argument _ -> ())
+
let _ =
test1();
test2();
test5();
test6();
test7();
+ test8();
exit 0
module type TESTSIG = sig
type t
module Ops : sig
- val neg: t -> t
- val add: t -> t -> t
- val sub: t -> t -> t
- val mul: t -> t -> t
- val div: t -> t -> t
- val rem: t -> t -> t
- val logand: t -> t -> t
- val logor: t -> t -> t
- val logxor: t -> t -> t
- val shift_left: t -> int -> t
- val shift_right: t -> int -> t
- val shift_right_logical: t -> int -> t
- val of_int: int -> t
- val to_int: t -> int
- val of_float: float -> t
+ val neg: t -> t
+ val add: t -> t -> t
+ val sub: t -> t -> t
+ val mul: t -> t -> t
+ val div: t -> t -> t
+ val rem: t -> t -> t
+ val logand: t -> t -> t
+ val logor: t -> t -> t
+ val logxor: t -> t -> t
+ val shift_left: t -> int -> t
+ val shift_right: t -> int -> t
+ val shift_right_logical: t -> int -> t
+ val of_int: int -> t
+ val to_int: t -> int
+ val of_float: float -> t
val to_float: t -> float
val zero: t
val one: t
val minus_one: t
val min_int: t
val max_int: t
- val format : string -> t -> string
+ val format : string -> t -> string
val to_string: t -> string
- val of_string: string -> t
+ val of_string: string -> t
end
val testcomp: t -> t -> bool*bool*bool*bool*bool*bool*int
val skip_float_tests: bool
test 5 (add (of_int (-123)) (of_int 456)) (of_int 333);
test 6 (add (of_int 123) (of_int (-456))) (of_int (-333));
test 7 (add (of_int (-123)) (of_int (-456))) (of_int (-579));
- test 8 (add (of_string "0x1234567812345678")
+ test 8 (add (of_string "0x1234567812345678")
(of_string "0x9ABCDEF09ABCDEF"))
(of_string "0x1be024671be02467");
test 9 (add max_int max_int) (of_int (-2));
test 5 (sub (of_int (-123)) (of_int 456)) (of_int (-579));
test 6 (sub (of_int 123) (of_int (-456))) (of_int 579);
test 7 (sub (of_int (-123)) (of_int (-456))) (of_int 333);
- test 8 (sub (of_string "0x1234567812345678")
+ test 8 (sub (of_string "0x1234567812345678")
(of_string "0x9ABCDEF09ABCDEF"))
(of_string "0x888888908888889");
test 9 (sub max_int min_int) minus_one;
begin match Sys.word_size with
32 ->
let module C =
- Test32(struct type t = nativeint
+ Test32(struct type t = nativeint
module Ops = Nativeint
let testcomp = testcomp_nativeint
let skip_float_tests = true end)
let module C =
Test64(struct type t = nativeint
module Ops = Nativeint
- let testcomp = testcomp_nativeint
+ let testcomp = testcomp_nativeint
let skip_float_tests = true end)
in ()
| _ ->
test 53 eqtrue (testcmpfloat 0.0 0.0);
test 54 eqtrue (testcmpfloat 1.0 0.0);
test 55 eqtrue (testcmpfloat 0.0 1.0)
-
include F(struct end)
let test() = print_t A; print_newline(); print_t (B 42); print_newline()
end
-
+
let _ =
D.test();
D.print_t D.A; print_newline(); D.print_t (D.B 42); print_newline()
let _ =
begin try raise (G.Exn "foo") with G.Exn s -> print_string s end;
print_int ((new G.c)#m); print_newline()
-
(* *)
(***********************************************************************)
-(* $Id: maps.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: maps.ml 12800 2012-07-30 18:59:07Z doligez $ *)
module IntMap = Map.Make(struct type t = int let compare x y = x-y end)
print_endline "Inter";
show (IntMap.merge (fun _ l r -> match l, r with Some x, Some y when x = y -> Some x | _ -> None) m1 m2);
()
-
done;
for i = 0 to 255 do
let c = Char.chr i in
- printf "k(%s) = %s\t" (escaped c) (k c)
+ printf "\tk(%s) = %s" (escaped c) (k c)
done;
printf "\n";
printf "p([|\"hello\"|]) = %s\n" (p [|"hello"|]);
printf "l([|2;3|]) = %d\n" (l [|2;3|]);
printf "l([|4;5;6|]) = %d\n" (l [|4;5;6|]);
exit 0
-
-
-
h(|) = ?
h(}) = ?
h(~) = ?
-k(\000) = othr k(\001) = othr k(\002) = othr k(\003) = othr k(\004) = othr k(\005) = othr k(\006) = othr k(\007) = othr k(\b) = othr k(\t) = blk k(\n) = blk k(\011) = othr k(\012) = othr k(\r) = blk k(\014) = othr k(\015) = othr k(\016) = othr k(\017) = othr k(\018) = othr k(\019) = othr k(\020) = othr k(\021) = othr k(\022) = othr k(\023) = othr k(\024) = othr k(\025) = othr k(\026) = othr k(\027) = othr k(\028) = othr k(\029) = othr k(\030) = othr k(\031) = othr k( ) = blk k(!) = oper k(\034) = othr k(#) = oper k($) = oper k(%) = oper k(&) = oper k(\') = othr k(\040) = othr k(\041) = othr k(*) = oper k(+) = oper k(\044) = othr k(\045) = othr k(\046) = othr k(/) = oper k(0) = dig k(1) = dig k(2) = dig k(3) = dig k(4) = dig k(5) = dig k(6) = dig k(7) = dig k(8) = dig k(9) = dig k(:) = oper k(\059) = othr k(<) = oper k(=) = oper k(>) = oper k(?) = oper k(@) = oper k(A) = letr k(B) = letr k(C) = letr k(D) = letr k(E) = letr k(F) = letr k(G) = letr k(H) = letr k(I) = letr k(J) = letr k(K) = letr k(L) = letr k(M) = letr k(N) = letr k(O) = letr k(P) = letr k(Q) = letr k(R) = letr k(S) = letr k(T) = letr k(U) = letr k(V) = letr k(W) = letr k(X) = letr k(Y) = letr k(Z) = letr k(\091) = othr k(\\) = oper k(\093) = othr k(^) = oper k(\095) = othr k(\096) = othr k(a) = letr k(b) = letr k(c) = letr k(d) = letr k(e) = letr k(f) = letr k(g) = letr k(h) = letr k(i) = letr k(j) = letr k(k) = letr k(l) = letr k(m) = letr k(n) = letr k(o) = letr k(p) = letr k(q) = letr k(r) = letr k(s) = letr k(t) = letr k(u) = letr k(v) = letr k(w) = letr k(x) = letr k(y) = letr k(z) = letr k(\123) = othr k(|) = oper k(\125) = othr k(~) = oper k(\127) = othr k(\128) = othr k(\129) = othr k(\130) = othr k(\131) = othr k(\132) = othr k(\133) = othr k(\134) = othr k(\135) = othr k(\136) = othr k(\137) = othr k(\138) = othr k(\139) = othr k(\140) = othr k(\141) = othr k(\142) = othr k(\143) = othr k(\144) = othr k(\145) = othr k(\146) = othr k(\147) = othr k(\148) = othr k(\149) = othr k(\150) = othr k(\151) = othr k(\152) = othr k(\153) = othr k(\154) = othr k(\155) = othr k(\156) = othr k(\157) = othr k(\158) = othr k(\159) = othr k(\160) = othr k(\161) = othr k(\162) = othr k(\163) = othr k(\164) = othr k(\165) = othr k(\166) = othr k(\167) = othr k(\168) = othr k(\169) = othr k(\170) = othr k(\171) = othr k(\172) = othr k(\173) = othr k(\174) = othr k(\175) = othr k(\176) = othr k(\177) = othr k(\178) = othr k(\179) = othr k(\180) = othr k(\181) = othr k(\182) = othr k(\183) = othr k(\184) = othr k(\185) = othr k(\186) = othr k(\187) = othr k(\188) = othr k(\189) = othr k(\190) = othr k(\191) = othr k(\192) = letr k(\193) = letr k(\194) = letr k(\195) = letr k(\196) = letr k(\197) = letr k(\198) = letr k(\199) = letr k(\200) = letr k(\201) = letr k(\202) = letr k(\203) = letr k(\204) = letr k(\205) = letr k(\206) = letr k(\207) = letr k(\208) = letr k(\209) = letr k(\210) = letr k(\211) = letr k(\212) = letr k(\213) = letr k(\214) = letr k(\215) = letr k(\216) = letr k(\217) = letr k(\218) = letr k(\219) = letr k(\220) = letr k(\221) = letr k(\222) = letr k(\223) = letr k(\224) = letr k(\225) = letr k(\226) = letr k(\227) = letr k(\228) = letr k(\229) = letr k(\230) = letr k(\231) = letr k(\232) = letr k(\233) = letr k(\234) = letr k(\235) = letr k(\236) = letr k(\237) = letr k(\238) = letr k(\239) = letr k(\240) = letr k(\241) = letr k(\242) = letr k(\243) = letr k(\244) = letr k(\245) = letr k(\246) = letr k(\247) = letr k(\248) = letr k(\249) = letr k(\250) = letr k(\251) = letr k(\252) = letr k(\253) = letr k(\254) = letr k(\255) = letr
+ k(\000) = othr k(\001) = othr k(\002) = othr k(\003) = othr k(\004) = othr k(\005) = othr k(\006) = othr k(\007) = othr k(\b) = othr k(\t) = blk k(\n) = blk k(\011) = othr k(\012) = othr k(\r) = blk k(\014) = othr k(\015) = othr k(\016) = othr k(\017) = othr k(\018) = othr k(\019) = othr k(\020) = othr k(\021) = othr k(\022) = othr k(\023) = othr k(\024) = othr k(\025) = othr k(\026) = othr k(\027) = othr k(\028) = othr k(\029) = othr k(\030) = othr k(\031) = othr k( ) = blk k(!) = oper k(\034) = othr k(#) = oper k($) = oper k(%) = oper k(&) = oper k(\') = othr k(\040) = othr k(\041) = othr k(*) = oper k(+) = oper k(\044) = othr k(\045) = othr k(\046) = othr k(/) = oper k(0) = dig k(1) = dig k(2) = dig k(3) = dig k(4) = dig k(5) = dig k(6) = dig k(7) = dig k(8) = dig k(9) = dig k(:) = oper k(\059) = othr k(<) = oper k(=) = oper k(>) = oper k(?) = oper k(@) = oper k(A) = letr k(B) = letr k(C) = letr k(D) = letr k(E) = letr k(F) = letr k(G) = letr k(H) = letr k(I) = letr k(J) = letr k(K) = letr k(L) = letr k(M) = letr k(N) = letr k(O) = letr k(P) = letr k(Q) = letr k(R) = letr k(S) = letr k(T) = letr k(U) = letr k(V) = letr k(W) = letr k(X) = letr k(Y) = letr k(Z) = letr k(\091) = othr k(\\) = oper k(\093) = othr k(^) = oper k(\095) = othr k(\096) = othr k(a) = letr k(b) = letr k(c) = letr k(d) = letr k(e) = letr k(f) = letr k(g) = letr k(h) = letr k(i) = letr k(j) = letr k(k) = letr k(l) = letr k(m) = letr k(n) = letr k(o) = letr k(p) = letr k(q) = letr k(r) = letr k(s) = letr k(t) = letr k(u) = letr k(v) = letr k(w) = letr k(x) = letr k(y) = letr k(z) = letr k(\123) = othr k(|) = oper k(\125) = othr k(~) = oper k(\127) = othr k(\128) = othr k(\129) = othr k(\130) = othr k(\131) = othr k(\132) = othr k(\133) = othr k(\134) = othr k(\135) = othr k(\136) = othr k(\137) = othr k(\138) = othr k(\139) = othr k(\140) = othr k(\141) = othr k(\142) = othr k(\143) = othr k(\144) = othr k(\145) = othr k(\146) = othr k(\147) = othr k(\148) = othr k(\149) = othr k(\150) = othr k(\151) = othr k(\152) = othr k(\153) = othr k(\154) = othr k(\155) = othr k(\156) = othr k(\157) = othr k(\158) = othr k(\159) = othr k(\160) = othr k(\161) = othr k(\162) = othr k(\163) = othr k(\164) = othr k(\165) = othr k(\166) = othr k(\167) = othr k(\168) = othr k(\169) = othr k(\170) = othr k(\171) = othr k(\172) = othr k(\173) = othr k(\174) = othr k(\175) = othr k(\176) = othr k(\177) = othr k(\178) = othr k(\179) = othr k(\180) = othr k(\181) = othr k(\182) = othr k(\183) = othr k(\184) = othr k(\185) = othr k(\186) = othr k(\187) = othr k(\188) = othr k(\189) = othr k(\190) = othr k(\191) = othr k(\192) = letr k(\193) = letr k(\194) = letr k(\195) = letr k(\196) = letr k(\197) = letr k(\198) = letr k(\199) = letr k(\200) = letr k(\201) = letr k(\202) = letr k(\203) = letr k(\204) = letr k(\205) = letr k(\206) = letr k(\207) = letr k(\208) = letr k(\209) = letr k(\210) = letr k(\211) = letr k(\212) = letr k(\213) = letr k(\214) = letr k(\215) = letr k(\216) = letr k(\217) = letr k(\218) = letr k(\219) = letr k(\220) = letr k(\221) = letr k(\222) = letr k(\223) = letr k(\224) = letr k(\225) = letr k(\226) = letr k(\227) = letr k(\228) = letr k(\229) = letr k(\230) = letr k(\231) = letr k(\232) = letr k(\233) = letr k(\234) = letr k(\235) = letr k(\236) = letr k(\237) = letr k(\238) = letr k(\239) = letr k(\240) = letr k(\241) = letr k(\242) = letr k(\243) = letr k(\244) = letr k(\245) = letr k(\246) = letr k(\247) = letr k(\248) = letr k(\249) = letr k(\250) = letr k(\251) = letr k(\252) = letr k(\253) = letr k(\254) = letr k(\255) = letr
p([|"hello"|]) = hello
p([|1.0|]) = 1.000000
q([|2|]) = 2
then print_string "Test 1: passed\n"
else print_string "Test 1: FAILED\n";
let one = 1 in
- let rec y = (one, one+1) :: y in
+ let rec y = (one, one+1) :: y in
if match y with
(1,2) :: y' -> y == y'
| _ -> false
fn a b c d e f g h
let indtailcall16 fn a b c d e f g h i j k l m n o p =
- fn a b c d e f g h i j k l m n o p
+ fn a b c d e f g h i j k l m n o p
let _ =
print_int (tailcall4 10000000 0 0 0); print_newline();
@$(OCAMLC) -c tcallback.ml
@$(OCAMLC) -o ./program -custom unix.cma callbackprim.$(O) tcallback.cmo
@./program > bytecode.result
- @$(DIFF) reference bytecode.result || (echo " => failed" && exit 1)
+ @$(DIFF) reference bytecode.result || (echo " => failed" && exit 1)
@echo " => passed"
run-opt: common
$(DIFF) reference native.result || (echo " => failed" && exit 1); \
echo " => passed"; \
fi
-
+
promote: defaultpromote
clean: defaultclean
print_string(tripwire mycamlparam); print_newline();
Sys.set_signal Sys.sigusr1 (Sys.Signal_handle sighandler);
print_string(callbacksig ()); print_newline()
-
@./program > program.result
@$(DIFF) program.reference program.result > /dev/null || (echo " => failed" && exit 1)
@echo " => passed"
-
+
promote: defaultpromote
clean: defaultclean
caml_remove_generational_global_root(&(Block_val(vblock)->v));
return Val_unit;
}
-
-
300 format(/1X, I3, 2X, 10F6.1/)
200 continue
end
-
test 2 a.{2,1} 201.0;
test 3 a.{1,2} 102.0;
test 4 a.{5,4} 504.0;
-
printtab_(Data_bigarray_val(ba), &dimx, &dimy);
return Val_unit;
}
-
let from_list kind vals =
let a = Array1.create kind c_layout (List.length vals) in
let rec set i = function
- [] -> ()
+ [] -> ()
| hd :: tl -> a.{i} <- hd; set (i+1) tl in
set 0 vals;
a in
let from_list_fortran kind vals =
let a = Array1.create kind fortran_layout (List.length vals) in
let rec set i = function
- [] -> ()
+ [] -> ()
| hd :: tl -> a.{i} <- hd; set (i+1) tl in
set 1 vals;
a in
for i = 0 to 2 do test (i+1) a.{i} i done;
test 4 true (try ignore a.{3}; false with Invalid_argument _ -> true);
test 5 true (try ignore a.{-1}; false with Invalid_argument _ -> true);
-
+
let b = Array1.create float64 fortran_layout 3 in
for i = 1 to 3 do b.{i} <- float i done;
for i = 1 to 3 do test (5 + i) b.{i} (float i) done;
let a = Array1.create int c_layout 3 in
for i = 0 to 2 do Array1.unsafe_set a i i done;
for i = 0 to 2 do test (i+1) (Array1.unsafe_get a i) i done;
-
+
let b = Array1.create float64 fortran_layout 3 in
for i = 1 to 3 do Array1.unsafe_set b i (float i) done;
for i = 1 to 3 do test (5 + i) (Array1.unsafe_get b i) (float i) done;
test 3 true (try ignore a.{-1,0}; false with Invalid_argument _ -> true);
test 4 true (try ignore a.{0,3}; false with Invalid_argument _ -> true);
test 5 true (try ignore a.{0,-1}; false with Invalid_argument _ -> true);
-
+
let b = Array2.create float32 fortran_layout 3 3 in
for i = 1 to 3 do for j = 1 to 3 do b.{i,j} <- float(i-j) done done;
let ok = ref true in
for j = 0 to 2 do if Array2.unsafe_get a i j <> i-j then ok := false done
done;
test 1 true !ok;
-
+
let b = Array2.create float32 fortran_layout 3 3 in
for i = 1 to 3 do for j = 1 to 3 do Array2.unsafe_set b i j (float(i-j)) done done;
let ok = ref true in
if Int32.to_int a.{i,j,k} <> (i lsl 4) + (j lsl 2) + k then ok := false
done done done;
test 1 true !ok;
-
+
let b = Array3.create int64 fortran_layout 2 3 4 in
for i = 1 to 2 do for j = 1 to 3 do for k = 1 to 4 do
b.{i,j,k} <- Int64.of_int((i lsl 4) + (j lsl 2) + k)
Sys.remove mapped_file;
()
-
+
(********* End of test *********)
let _ =
(* *)
(***********************************************************************)
-(* $Id: fftba.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: fftba.ml 12800 2012-07-30 18:59:07Z doligez $ *)
open Bigarray
(py : (float, float64_elt, c_layout) Array1.t) np =
let i = ref 2 in
let m = ref 1 in
-
+
while (!i < np) do
- i := !i + !i;
+ i := !i + !i;
m := !m + 1
done;
- let n = !i in
-
+ let n = !i in
+
if n <> np then begin
for i = np+1 to n do
- px.{i} <- 0.0;
+ px.{i} <- 0.0;
py.{i} <- 0.0
done;
print_string "Use "; print_int n;
let n2 = ref(n+n) in
for k = 1 to !m-1 do
- n2 := !n2 / 2;
+ n2 := !n2 / 2;
let n4 = !n2 / 4 in
let e = tpi /. float !n2 in
let ss3 = sin(a3) in
let is = ref j in
let id = ref(2 * !n2) in
-
+
while !is < n do
let i0r = ref !is in
while !i0r < n do
let r1 = r1 +. s2 in
let s2 = r2 -. s1 in
let r2 = r2 +. s1 in
- px.{i2} <- r1*.cc1 -. s2*.ss1;
+ px.{i2} <- r1*.cc1 -. s2*.ss1;
py.{i2} <- -.s2*.cc1 -. r1*.ss1;
px.{i3} <- s3*.cc3 +. r2*.ss3;
py.{i3} <- r2*.cc3 -. s3*.ss3;
i0r := i0 + !id
done;
- is := 2 * !id - !n2 + j;
+ is := 2 * !id - !n2 + j;
id := 4 * !id
done
done
let is = ref 1 in
let id = ref 4 in
-
+
while !is < n do
let i0r = ref !is in
while !i0r <= n do
py.{i1} <- r1 -. py.{i1};
i0r := i0 + !id
done;
- is := 2 * !id - 1;
+ is := 2 * !id - 1;
id := 4 * !id
done;
(*************************)
let j = ref 1 in
-
+
for i = 1 to n - 1 do
if i < !j then begin
let xt = px.{!j} in
- px.{!j} <- px.{i};
+ px.{!j} <- px.{i};
px.{i} <- xt;
let xt = py.{!j} in
py.{!j} <- py.{i};
end;
let k = ref(n / 2) in
while !k < !j do
- j := !j - !k;
+ j := !j - !k;
k := !k / 2
done;
j := !j + !k
for i = 0 to np-1 do
let a = abs_float(pxr.{i+1} -. float i) in
if !zr < a then begin
- zr := a;
+ zr := a;
kr := i
end;
let a = abs_float(pxi.{i+1}) in
if !zi < a then begin
- zi := a;
+ zi := a;
ki := i
end
done;
let _ =
let np = ref 16 in for i = 1 to 13 do test !np; np := !np*2 done
-
let y = Array1.of_array float64 fortran_layout [| 1. |] in
(f y).{1};
(f y).{1} <- 3.14
-
@export LD_LIBRARY_PATH=`pwd` && ./custom > custom.result
@$(DIFF) custom.reference custom.result > /dev/null || (echo " => failed" && exit 1)
@echo " => passed"
-
+
promote: defaultpromote
clean: defaultclean
for i = 1 to Array.length Sys.argv - 1 do
let name = Sys.argv.(i) in
Printf.printf "Loading %s\n" name; flush stdout;
- try
+ try
if name.[0] = '-'
- then Dynlink.loadfile_private
- (String.sub name 1 (String.length name - 1))
+ then Dynlink.loadfile_private
+ (String.sub name 1 (String.length name - 1))
else Dynlink.loadfile name
with
| Dynlink.Error err ->
- Printf.printf "Dynlink error: %s\n"
- (Dynlink.error_message err)
+ Printf.printf "Dynlink error: %s\n"
+ (Dynlink.error_message err)
| exn ->
- Printf.printf "Error: %s\n" (Printexc.to_string exn)
+ Printf.printf "Error: %s\n" (Printexc.to_string exn)
done;
flush stdout;
try
"../../../otherlibs/bigarray/bigarray.cma",
"plugin.cmo"
in
- load s1;
+ load s1;
load s2;
print_endline "OK."
-
let f x = x.{2}
-
+
let () =
print_endline "I'm the plugin."
let mods = ref []
let reg_mod name =
- if List.mem name !mods then
+ if List.mem name !mods then
Printf.printf "Reloading module %s\n" name
else (
mods := name :: !mods;
print_endline "B is running";
incr A.x;
Printf.printf "A.x = %i\n" !A.x
-
-let () = try raise (Invalid_argument "X") with Invalid_argument s ->
+let () = try raise (Invalid_argument "X") with Invalid_argument s ->
raise (Invalid_argument (s ^ s))
for i = 1 to Array.length Sys.argv - 1 do
let name = Sys.argv.(i) in
Printf.printf "Loading %s\n" name; flush stdout;
- try
+ try
if name.[0] = '-'
- then Dynlink.loadfile_private
- (String.sub name 1 (String.length name - 1))
+ then Dynlink.loadfile_private
+ (String.sub name 1 (String.length name - 1))
else Dynlink.loadfile name
with
| Dynlink.Error err ->
- Printf.printf "Dynlink error: %s\n"
- (Dynlink.error_message err)
+ Printf.printf "Dynlink error: %s\n"
+ (Dynlink.error_message err)
| exn ->
- Printf.printf "Error: %s\n" (Printexc.to_string exn)
+ Printf.printf "Error: %s\n" (Printexc.to_string exn)
done;
flush stdout;
try
List.iter (fun f -> f()) l
with Failure s ->
Printf.printf "Failure: %s\n" s
-
-
-
let bla = Sys.argv.(0) ^ "XXX"
let mykey = Sys.argv.(0)
-
let () =
Api.reg_mod "Plugin";
Api.add_cb (fun () -> print_endline "Callback from plugin");
- print_endline "COUCOU";
+ print_endline "COUCOU";
()
let () =
Printf.printf "time = %f\n" (Unix.time ());
Api.reg_mod "Plugin"
-
-
let () =
Api.reg_mod "Plugin_ref";
-
- Api.add_cb
+
+ Api.add_cb
(fun () ->
Printf.printf "current value for ref = %i\n" !x;
incr x
)
-
let () =
Api.reg_mod "Plugin_thread";
let _t =
- Thread.create
+ Thread.create
(fun () ->
- for i = 1 to 5 do
- print_endline "Thread"; flush stdout;
- Thread.delay 1.;
- done
+ for i = 1 to 5 do
+ print_endline "Thread"; flush stdout;
+ Thread.delay 1.;
+ done
) ()
in
for i = 1 to 10 do
print_endline "Thread"; flush stdout;
Thread.delay 0.50;
done
-
-
-
-
-
-
let () =
Api.reg_mod "Plugin'"
-
let () =
ignore (Api.f 10)
-
printf "[10..0]\t\t%08x\n" (Hashtbl.hash [10;9;8;7;6;5;4;3;2;1;0]);
()
-
-
-
-
-
-
-
-
-
TSP.test (pair_data d);
printf "-- Lists of strings\n%!";
TSL.test (list_data d)
-
test 426 (Marshal.from_string s 0 = x)
(* Test for objects *)
-class foo = object (self : 'self)
+class foo = object (self : 'self)
val data1 = "foo"
val data2 = "bar"
val data3 = 42L
val! data2 = "test5"
val data4 = "test3"
val data5 = "test4"
- method test1 =
- data1
- ^ data2
- ^ data4
- ^ data5
+ method test1 =
+ data1
+ ^ data2
+ ^ data4
+ ^ data5
^ Int64.to_string self#test4
end
test 605 (even' 41 = even 41);
test 606 (even' 142 = true);
test 607 (even' 142 = even 142)
-
+
let main() =
if Array.length Sys.argv <= 2 then begin
test_out "intext.data"; test_in "intext.data";
value marshal_to_block(value vbuf, value vlen, value v, value vflags)
{
- return Val_long(output_value_to_block(v, vflags,
+ return Val_long(output_value_to_block(v, vflags,
(char *) vbuf, Long_val(vlen)));
}
test 1
eq_big_int (add_big_int zero_big_int zero_big_int, zero_big_int);;
test 2
-eq_big_int (add_big_int zero_big_int (big_int_of_int 1),
+eq_big_int (add_big_int zero_big_int (big_int_of_int 1),
big_int_of_int 1);;
test 3
-eq_big_int (add_big_int (big_int_of_int 1) zero_big_int,
+eq_big_int (add_big_int (big_int_of_int 1) zero_big_int,
big_int_of_int 1);;
test 4
-eq_big_int (add_big_int zero_big_int (big_int_of_int (-1)),
+eq_big_int (add_big_int zero_big_int (big_int_of_int (-1)),
big_int_of_int (-1));;
test 5
-eq_big_int (add_big_int (big_int_of_int (-1)) zero_big_int,
+eq_big_int (add_big_int (big_int_of_int (-1)) zero_big_int,
big_int_of_int (-1));;
test 6
-eq_big_int (add_big_int (big_int_of_int 1) (big_int_of_int 1),
+eq_big_int (add_big_int (big_int_of_int 1) (big_int_of_int 1),
big_int_of_int 2);;
test 7
-eq_big_int (add_big_int (big_int_of_int 1) (big_int_of_int 2),
+eq_big_int (add_big_int (big_int_of_int 1) (big_int_of_int 2),
big_int_of_int 3);;
test 8
-eq_big_int (add_big_int (big_int_of_int 2) (big_int_of_int 1),
+eq_big_int (add_big_int (big_int_of_int 2) (big_int_of_int 1),
big_int_of_int 3);;
test 9
-eq_big_int (add_big_int (big_int_of_int (-1)) (big_int_of_int (-1)),
+eq_big_int (add_big_int (big_int_of_int (-1)) (big_int_of_int (-1)),
big_int_of_int (-2));;
test 10
-eq_big_int (add_big_int (big_int_of_int (-1)) (big_int_of_int (-2)),
+eq_big_int (add_big_int (big_int_of_int (-1)) (big_int_of_int (-2)),
big_int_of_int (-3));;
test 11
-eq_big_int (add_big_int (big_int_of_int (-2)) (big_int_of_int (-1)),
+eq_big_int (add_big_int (big_int_of_int (-2)) (big_int_of_int (-1)),
big_int_of_int (-3));;
test 12
-eq_big_int (add_big_int (big_int_of_int 1) (big_int_of_int (-1)),
+eq_big_int (add_big_int (big_int_of_int 1) (big_int_of_int (-1)),
zero_big_int);;
test 13
-eq_big_int (add_big_int (big_int_of_int (-1)) (big_int_of_int 1),
+eq_big_int (add_big_int (big_int_of_int (-1)) (big_int_of_int 1),
zero_big_int);;
test 14
-eq_big_int (add_big_int (big_int_of_int 1) (big_int_of_int (-2)),
+eq_big_int (add_big_int (big_int_of_int 1) (big_int_of_int (-2)),
big_int_of_int (-1));;
test 15
-eq_big_int (add_big_int (big_int_of_int (-2)) (big_int_of_int 1),
+eq_big_int (add_big_int (big_int_of_int (-2)) (big_int_of_int 1),
big_int_of_int (-1));;
test 16
-eq_big_int (add_big_int (big_int_of_int (-1)) (big_int_of_int 2),
+eq_big_int (add_big_int (big_int_of_int (-1)) (big_int_of_int 2),
big_int_of_int 1);;
test 17
-eq_big_int (add_big_int (big_int_of_int 2) (big_int_of_int (-1)),
+eq_big_int (add_big_int (big_int_of_int 2) (big_int_of_int (-1)),
big_int_of_int 1);;
test 1
eq_big_int (sub_big_int zero_big_int zero_big_int, zero_big_int);;
test 2
-eq_big_int (sub_big_int zero_big_int (big_int_of_int 1),
+eq_big_int (sub_big_int zero_big_int (big_int_of_int 1),
big_int_of_int (-1));;
test 3
-eq_big_int (sub_big_int (big_int_of_int 1) zero_big_int,
+eq_big_int (sub_big_int (big_int_of_int 1) zero_big_int,
big_int_of_int 1);;
test 4
-eq_big_int (sub_big_int zero_big_int (big_int_of_int (-1)),
+eq_big_int (sub_big_int zero_big_int (big_int_of_int (-1)),
big_int_of_int 1);;
test 5
-eq_big_int (sub_big_int (big_int_of_int (-1)) zero_big_int,
+eq_big_int (sub_big_int (big_int_of_int (-1)) zero_big_int,
big_int_of_int (-1));;
test 6
-eq_big_int (sub_big_int (big_int_of_int 1) (big_int_of_int 1),
+eq_big_int (sub_big_int (big_int_of_int 1) (big_int_of_int 1),
zero_big_int);;
test 7
-eq_big_int (sub_big_int (big_int_of_int 1) (big_int_of_int 2),
+eq_big_int (sub_big_int (big_int_of_int 1) (big_int_of_int 2),
big_int_of_int (-1));;
test 8
-eq_big_int (sub_big_int (big_int_of_int 2) (big_int_of_int 1),
+eq_big_int (sub_big_int (big_int_of_int 2) (big_int_of_int 1),
big_int_of_int 1);;
test 9
-eq_big_int (sub_big_int (big_int_of_int (-1)) (big_int_of_int (-1)),
+eq_big_int (sub_big_int (big_int_of_int (-1)) (big_int_of_int (-1)),
zero_big_int);;
test 10
-eq_big_int (sub_big_int (big_int_of_int (-1)) (big_int_of_int (-2)),
+eq_big_int (sub_big_int (big_int_of_int (-1)) (big_int_of_int (-2)),
big_int_of_int 1);;
test 11
-eq_big_int (sub_big_int (big_int_of_int (-2)) (big_int_of_int (-1)),
+eq_big_int (sub_big_int (big_int_of_int (-2)) (big_int_of_int (-1)),
big_int_of_int (-1));;
test 12
-eq_big_int (sub_big_int (big_int_of_int 1) (big_int_of_int (-1)),
+eq_big_int (sub_big_int (big_int_of_int 1) (big_int_of_int (-1)),
big_int_of_int 2);;
test 13
-eq_big_int (sub_big_int (big_int_of_int (-1)) (big_int_of_int 1),
+eq_big_int (sub_big_int (big_int_of_int (-1)) (big_int_of_int 1),
big_int_of_int (-2));;
test 14
-eq_big_int (sub_big_int (big_int_of_int 1) (big_int_of_int (-2)),
+eq_big_int (sub_big_int (big_int_of_int 1) (big_int_of_int (-2)),
big_int_of_int 3);;
test 15
-eq_big_int (sub_big_int (big_int_of_int (-2)) (big_int_of_int 1),
+eq_big_int (sub_big_int (big_int_of_int (-2)) (big_int_of_int 1),
big_int_of_int (-3));;
test 16
-eq_big_int (sub_big_int (big_int_of_int (-1)) (big_int_of_int 2),
+eq_big_int (sub_big_int (big_int_of_int (-1)) (big_int_of_int 2),
big_int_of_int (-3));;
test 17
-eq_big_int (sub_big_int (big_int_of_int 2) (big_int_of_int (-1)),
+eq_big_int (sub_big_int (big_int_of_int 2) (big_int_of_int (-1)),
big_int_of_int 3);;
testing_function "mult_int_big_int";;
testing_function "mult_big_int";;
test 1
-eq_big_int (mult_big_int zero_big_int zero_big_int,
+eq_big_int (mult_big_int zero_big_int zero_big_int,
zero_big_int);;
test 2
-eq_big_int (mult_big_int (big_int_of_int 2) (big_int_of_int 3),
+eq_big_int (mult_big_int (big_int_of_int 2) (big_int_of_int 3),
big_int_of_int 6);;
test 3
-eq_big_int (mult_big_int (big_int_of_int 2) (big_int_of_int (-3)),
+eq_big_int (mult_big_int (big_int_of_int 2) (big_int_of_int (-3)),
big_int_of_int (-6));;
-test 4
-eq_big_int (mult_big_int (big_int_of_string "12724951")
- (big_int_of_string "81749606400"),
+test 4
+eq_big_int (mult_big_int (big_int_of_string "12724951")
+ (big_int_of_string "81749606400"),
big_int_of_string "1040259735709286400");;
-test 5
-eq_big_int (mult_big_int (big_int_of_string "26542080")
- (big_int_of_string "81749606400"),
+test 5
+eq_big_int (mult_big_int (big_int_of_string "26542080")
+ (big_int_of_string "81749606400"),
big_int_of_string "2169804593037312000");;
testing_function "quomod_big_int";;
test 3 eq_big_int (quotient, big_int_of_int (-1)) &&
test 4 eq_big_int (modulo, zero_big_int);;
-let (quotient, modulo) =
+let (quotient, modulo) =
quomod_big_int (big_int_of_int (-1)) (big_int_of_int 1) in
- test 5 eq_big_int (quotient, big_int_of_int (-1)) &&
+ test 5 eq_big_int (quotient, big_int_of_int (-1)) &&
test 6 eq_big_int (modulo, zero_big_int);;
-let (quotient, modulo) =
+let (quotient, modulo) =
quomod_big_int (big_int_of_int 3) (big_int_of_int 2) in
- test 7 eq_big_int (quotient, big_int_of_int 1) &&
+ test 7 eq_big_int (quotient, big_int_of_int 1) &&
test 8 eq_big_int (modulo, big_int_of_int 1);;
let (quotient, modulo) =
test 11 eq_big_int (quotient, big_int_of_int (-2)) &&
test 12 eq_big_int (modulo, big_int_of_int 1);;
-let (quotient, modulo) =
+let (quotient, modulo) =
quomod_big_int (big_int_of_int 1) (big_int_of_int 2) in
- test 13 eq_big_int (quotient, zero_big_int) &&
+ test 13 eq_big_int (quotient, zero_big_int) &&
test 14 eq_big_int (modulo, big_int_of_int 1);;
-let (quotient, modulo) =
+let (quotient, modulo) =
quomod_big_int (big_int_of_int (-1)) (big_int_of_int 3) in
test 15 eq_big_int (quotient, minus_big_int unit_big_int) &&
test 16 eq_big_int (modulo, big_int_of_int 2);;
Division_by_zero
;;
-let (quotient, modulo) =
+let (quotient, modulo) =
quomod_big_int (big_int_of_int 10) (big_int_of_int 20) in
test 18 eq_big_int (quotient, big_int_of_int 0) &&
test 19 eq_big_int (modulo, big_int_of_int 10);;
-let (quotient, modulo) =
+let (quotient, modulo) =
quomod_big_int (big_int_of_int (-10)) (big_int_of_int 20) in
test 20 eq_big_int (quotient, big_int_of_int (-1)) &&
test 21 eq_big_int (modulo, big_int_of_int 10);;
-let (quotient, modulo) =
+let (quotient, modulo) =
quomod_big_int (big_int_of_int 10) (big_int_of_int (-20)) in
test 22 eq_big_int (quotient, big_int_of_int 0) &&
test 23 eq_big_int (modulo, big_int_of_int 10);;
-let (quotient, modulo) =
+let (quotient, modulo) =
quomod_big_int (big_int_of_int (-10)) (big_int_of_int (-20)) in
test 24 eq_big_int (quotient, big_int_of_int 1) &&
test 25 eq_big_int (modulo, big_int_of_int 10);;
testing_function "gcd_big_int";;
test 1
-eq_big_int (gcd_big_int zero_big_int zero_big_int,
+eq_big_int (gcd_big_int zero_big_int zero_big_int,
zero_big_int);;
test 2
-eq_big_int (gcd_big_int zero_big_int (big_int_of_int 1),
+eq_big_int (gcd_big_int zero_big_int (big_int_of_int 1),
big_int_of_int 1);;
test 3
-eq_big_int (gcd_big_int (big_int_of_int 1) zero_big_int,
+eq_big_int (gcd_big_int (big_int_of_int 1) zero_big_int,
big_int_of_int 1);;
test 4
-eq_big_int (gcd_big_int (big_int_of_int 1) (big_int_of_int 2),
+eq_big_int (gcd_big_int (big_int_of_int 1) (big_int_of_int 2),
big_int_of_int 1);;
test 5
-eq_big_int (gcd_big_int (big_int_of_int 2) (big_int_of_int 1),
+eq_big_int (gcd_big_int (big_int_of_int 2) (big_int_of_int 1),
big_int_of_int 1);;
test 6
-eq_big_int (gcd_big_int (big_int_of_int 1) (big_int_of_int 1),
+eq_big_int (gcd_big_int (big_int_of_int 1) (big_int_of_int 1),
big_int_of_int 1);;
test 7
-eq_big_int (gcd_big_int (big_int_of_int 9) (big_int_of_int 16),
+eq_big_int (gcd_big_int (big_int_of_int 9) (big_int_of_int 16),
big_int_of_int 1);;
test 8
-eq_big_int (gcd_big_int (big_int_of_int 12) (big_int_of_int 16),
+eq_big_int (gcd_big_int (big_int_of_int 12) (big_int_of_int 16),
big_int_of_int 4);;
for i = 9 to 28 do
let bi2 = big_int_of_string (implode (rev ("3" :: tl l))) in
test 10
-eq_big_int (bi1, (add_big_int (mult_big_int bi2 (big_int_of_string "10"))
+eq_big_int (bi1, (add_big_int (mult_big_int bi2 (big_int_of_string "10"))
(big_int_of_string "2")))
(* test 11
&&
eq_big_int (big_int_of_nat (power_base_int 10 8), big_int_of_int 100000000)
;;
test 3
-eq_big_int (big_int_of_nat (power_base_int 2 (length_of_int + 2)),
+eq_big_int (big_int_of_nat (power_base_int 2 (length_of_int + 2)),
big_int_of_nat (let nat = make_nat 2 in
set_digit_nat nat 1 1;
nat))
161678167);;
test 4 eq_int (Hashtbl.hash (big_int_of_string "123456789123456789"),
755417385);;
-test 5 eq_int (Hashtbl.hash (sub_big_int
+test 5 eq_int (Hashtbl.hash (sub_big_int
(big_int_of_string "123456789123456789")
(big_int_of_string "123456789123456789")),
955772237);;
-test 6 eq_int (Hashtbl.hash (sub_big_int
+test 6 eq_int (Hashtbl.hash (sub_big_int
(big_int_of_string "123456789123456789")
(big_int_of_string "123456789123456788")),
992063522);;
-
(* Can compare nats less than 2**32 *)
let equal_nat n1 n2 =
- eq_nat n1 0 (num_digits_nat n1 0 1)
+ eq_nat n1 0 (num_digits_nat n1 0 1)
n2 0 (num_digits_nat n2 0 1);;
testing_function "num_digits_nat";;
let s = "3333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333" in
test 21 equal_nat (
nat_of_string s,
-(let nat = make_nat 15 in
+(let nat = make_nat 15 in
set_digit_nat nat 0 3;
- set_mult_digit_nat nat 0 15
- (nat_of_string (String.sub s 0 135)) 0 14
+ set_mult_digit_nat nat 0 15
+ (nat_of_string (String.sub s 0 135)) 0 14
(nat_of_int 10) 0;
nat))
;;
test 2
eq_num (add_num (Int 1) (Big_int (big_int_of_int 3)), Int 4);;
test 3
-eq_num (add_num (Int 1) (Ratio (ratio_of_string "3/4")),
+eq_num (add_num (Int 1) (Ratio (ratio_of_string "3/4")),
Ratio (ratio_of_string "7/4"));;
test 4
-eq_num (add_num (Big_int (big_int_of_int 1)) (Ratio (ratio_of_string "3/4")),
+eq_num (add_num (Big_int (big_int_of_int 1)) (Ratio (ratio_of_string "3/4")),
Ratio (ratio_of_string "7/4"));;
test 5
eq_num (add_num (Big_int (big_int_of_int 1)) (Big_int (big_int_of_int 3)),
eq_num (add_num (Ratio (ratio_of_string "2/3")) (Ratio (ratio_of_string "3/4")),
Ratio (ratio_of_string "17/12"));;
test 8
-eq_num (add_num (Int least_int) (Int 1),
+eq_num (add_num (Int least_int) (Int 1),
Int (- (pred biggest_int)));;
test 9
-eq_num (add_num (Int biggest_int) (Int 1),
+eq_num (add_num (Int biggest_int) (Int 1),
Big_int (minus_big_int (pred_big_int (big_int_of_int least_int))));;
testing_function "sub_num";;
test 2
eq_num (sub_num (Int 1) (Big_int (big_int_of_int 3)), Int (-2));;
test 3
-eq_num (sub_num (Int 1) (Ratio (ratio_of_string "3/4")),
+eq_num (sub_num (Int 1) (Ratio (ratio_of_string "3/4")),
Ratio (ratio_of_string "1/4"));;
test 4
-eq_num (sub_num (Big_int (big_int_of_int 1)) (Ratio (ratio_of_string "3/4")),
+eq_num (sub_num (Big_int (big_int_of_int 1)) (Ratio (ratio_of_string "3/4")),
Ratio (ratio_of_string "1/4"));;
test 5
eq_num (sub_num (Big_int (big_int_of_int 1)) (Big_int (big_int_of_int 3)),
eq_num (sub_num (Ratio (ratio_of_string "2/3")) (Ratio (ratio_of_string "3/4")),
Ratio (ratio_of_string "-1/12"));;
test 9
-eq_num (sub_num (Int least_int) (Int (-1)),
+eq_num (sub_num (Int least_int) (Int (-1)),
Int (- (pred biggest_int)));;
test 10
eq_num (sub_num (Int (-1)) (Int biggest_int), pred_num (Int least_int));;
eq_num (mult_num (Int 127) (Int (int_of_string "257")),
Int (int_of_string "32639"));;
test 3
-eq_num (mult_num (Int 257) (Int (int_of_string "260")),
+eq_num (mult_num (Int 257) (Int (int_of_string "260")),
Big_int (big_int_of_string "66820"));;
test 4
eq_num (mult_num (Int 2) (Big_int (big_int_of_int 3)), Int 6);;
test 5
-eq_num (mult_num (Int 10) (Ratio (ratio_of_string "3/4")),
+eq_num (mult_num (Int 10) (Ratio (ratio_of_string "3/4")),
Ratio (ratio_of_string "15/2"));;
test 6
eq_num (mult_num (Big_int (big_int_of_int 10)) (Ratio (ratio_of_string "3/4")),
test 1
eq_num (div_num (Int 6) (Int 3), Int 2);;
test 2
-eq_num (div_num (Int (int_of_string "32639"))
+eq_num (div_num (Int (int_of_string "32639"))
(Int (int_of_string "257")), Int 127);;
test 3
-eq_num (div_num (Big_int (big_int_of_string "66820"))
- (Int (int_of_string "257")),
+eq_num (div_num (Big_int (big_int_of_string "66820"))
+ (Int (int_of_string "257")),
Int 260);;
test 4
eq_num (div_num (Int 6) (Big_int (big_int_of_int 3)), Int 2);;
test 5
-eq_num (div_num (Ratio (ratio_of_string "15/2"))
+eq_num (div_num (Ratio (ratio_of_string "15/2"))
(Int 10),
- Ratio (ratio_of_string "3/4"));;
+ Ratio (ratio_of_string "3/4"));;
test 6
eq_num (div_num (Big_int (big_int_of_int 6)) (Big_int (big_int_of_int 3)),
Int 2);;
-test 7
-eq_num (div_num (Ratio (ratio_of_string "15/2"))
+test 7
+eq_num (div_num (Ratio (ratio_of_string "15/2"))
(Big_int (big_int_of_int 10)),
Ratio (ratio_of_string "3/4"));;
test 8
-eq_num (div_num (Ratio (ratio_of_string "15/2"))
+eq_num (div_num (Ratio (ratio_of_string "15/2"))
(Ratio (ratio_of_string "3/4")),
Big_int (big_int_of_int 10));;
test 9
-eq_num (div_num (Ratio (ratio_of_string "1/2"))
+eq_num (div_num (Ratio (ratio_of_string "1/2"))
(Ratio (ratio_of_string "3/4")),
Ratio (ratio_of_string "2/3"));;
test 1
eq_num (num_of_ratio (ratio_of_string "4/2"), Int 2);;
test 2
-eq_num (num_of_ratio (ratio_of_string "11811160075/11"),
+eq_num (num_of_ratio (ratio_of_string "11811160075/11"),
Big_int (big_int_of_string "1073741825"));;
test 3
eq_num (num_of_ratio (ratio_of_string "123456789012/1234"),
test 3 eq (f1 (0/1), true);;
-test 4 eq (f1 (let n = num_of_string "2000000000000000000000000" in n-n) ,
+test 4 eq (f1 (let n = num_of_string "2000000000000000000000000" in n-n) ,
true);;
-test 5 eq (f1 (let n = num_of_string "2000000000000000000000000" in n/n-1) ,
+test 5 eq (f1 (let n = num_of_string "2000000000000000000000000" in n/n-1) ,
true);;
-test 6 eq (f1 (let n = num_of_string "2000000000000000000000000" in n+1) ,
+test 6 eq (f1 (let n = num_of_string "2000000000000000000000000" in n+1) ,
false);;
test 7 eq (f1 (1/2), false);;
test (sprintf "%B" true = "true");
test (sprintf "%B" false = "false");
- printf "ld/li positive\n%!";
+ printf "\nld/li positive\n%!";
test (sprintf "%ld/%li" 42l 43l = "42/43");
test (sprintf "%-4ld/%-5li" 42l 43l = "42 /43 ");
test (sprintf "%04ld/%05li" 42l 43l = "0042/00043");
(* Nativeint not tested: looks like too much work, and anyway it should
work like Int32 or Int64. *)
- printf "Ld/Li positive\n%!";
+ printf "\nLd/Li positive\n%!";
test (sprintf "%Ld/%Li" 42L 43L = "42/43");
test (sprintf "%-4Ld/%-5Li" 42L 43L = "42 /43 ");
test (sprintf "%04Ld/%05Li" 42L 43L = "0042/00043");
d/i positive
-0 1 2 3 4 5 6 7 8
+ 0 1 2 3 4 5 6 7 8
d/i negative
-9 10 11 12 13 14 15 16 17
+ 9 10 11 12 13 14 15 16 17
u positive
-18 19 20 21 22 23 24 25 26
+ 18 19 20 21 22 23 24 25 26
u negative
-27
+ 27
x positive
-28 29 30 31 32 33 34 35 36
+ 28 29 30 31 32 33 34 35 36
x negative
-37
+ 37
X positive
-38 39 40 41 42 43 44 45 46
+ 38 39 40 41 42 43 44 45 46
x negative
-47
+ 47
o positive
-48 49 50 51 52 53 54 55 56
+ 48 49 50 51 52 53 54 55 56
o negative
-57
+ 57
s
-58 59 60 61 62 63 64 65 66 67 68 69 70 71
+ 58 59 60 61 62 63 64 65 66 67 68 69 70 71
S
-72 73 74 75 76 77 78 79 80
+ 72 73 74 75 76 77 78 79 80
c
-81 82 83 84
+ 81 82 83 84
C
-85 86 87 88 89
+ 85 86 87 88 89
f
-90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107
+ 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107
F
-108 109 110 111
+ 108 109 110 111
e
-112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129
+ 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129
E
-130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147
+ 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147
B
-148 149 ld/li positive
-150 151 152 153 154 155 156 157 158
+ 148 149
+ld/li positive
+ 150 151 152 153 154 155 156 157 158
ld/li negative
-159 160 161 162 163 164 165 166 167
+ 159 160 161 162 163 164 165 166 167
lu positive
-168 169 170 171 172 173 174 175 176
+ 168 169 170 171 172 173 174 175 176
lu negative
-177
+ 177
lx positive
-178 179 180 181 182 183 184 185 186
+ 178 179 180 181 182 183 184 185 186
lx negative
-187
+ 187
lX positive
-188 189 190 191 192 193 194 195 196
+ 188 189 190 191 192 193 194 195 196
lx negative
-197
+ 197
lo positive
-198 199 200 201 202 203 204 205 206
+ 198 199 200 201 202 203 204 205 206
lo negative
-207 Ld/Li positive
-208 209 210 211 212 213 214 215 216
+ 207
+Ld/Li positive
+ 208 209 210 211 212 213 214 215 216
Ld/Li negative
-217 218 219 220 221 222 223 224 225
+ 217 218 219 220 221 222 223 224 225
Lu positive
-226 227 228 229 230 231 232 233 234
+ 226 227 228 229 230 231 232 233 234
Lu negative
-235
+ 235
Lx positive
-236 237 238 239 240 241 242 243 244
+ 236 237 238 239 240 241 242 243 244
Lx negative
-245
+ 245
LX positive
-246 247 248 249 250 251 252 253 254
+ 246 247 248 249 250 251 252 253 254
Lx negative
-255
+ 255
Lo positive
-256 257 258 259 260 261 262 263 264
+ 256 257 258 259 260 261 262 263 264
Lo negative
-265
+ 265
a
-266
+ 266
t
-267
+ 267
(...%)
-268
+ 268
! % @ , and constants
-269 270 271 272 273 274 275
+ 269 270 271 272 273 274 275
end of tests
All tests succeeded.
(* *)
(*************************************************************************)
-(* $Id: tscanf.ml 12210 2012-03-08 19:52:03Z doligez $
+(* $Id: tscanf.ml 12800 2012-07-30 18:59:07Z doligez $
A testbed file for the module Scanf.
(* %[] style *)
let test11 () =
- sscanf "Pierre Weis 70" "%s %s %s"
+ sscanf "Pierre\tWeis\t70" "%s %s %s"
(fun prenom nom poids ->
prenom = "Pierre" && nom = "Weis" && int_of_string poids = 70)
&&
- sscanf "Jean-Luc de Léage 68" "%[^ ] %[^ ] %d"
+ sscanf "Jean-Luc\tde Léage\t68" "%[^\t] %[^\t] %d"
(fun prenom nom poids ->
prenom = "Jean-Luc" && nom = "de Léage" && poids = 68)
&&
- sscanf "Daniel de Rauglaudre 66" "%s@\t %s@\t %d"
+ sscanf "Daniel\tde Rauglaudre\t66" "%s@\t %s@\t %d"
(fun prenom nom poids ->
prenom = "Daniel" && nom = "de Rauglaudre" && poids = 66)
;;
-0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
+ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
All tests succeeded.
check "split"
(let (l, p, r) = M.split x s1 in
- fun i ->
+ fun i ->
if i < x then img i l = img i s1
else if i > x then img i r = img i s1
else p = img i s1)
let _ =
Random.init 42;
for i = 1 to 25000 do test (rkey()) (rdata()) (rmap()) (rmap()) done
-
check "split"
(let (l, p, r) = S.split x s1 in
- fun i ->
+ fun i ->
if i < x then S.mem i l = S.mem i s1
else if i > x then S.mem i r = S.mem i s1
else p = S.mem i s1)
let _ =
Random.init 42;
for i = 1 to 25000 do test (relt()) (rset()) (rset()) done
-
let num_failures = ref 0
let test res1 res2 =
- if res1 = res2
+ if res1 = res2
then print_char '.'
else begin print_string " FAIL "; incr num_failures end
test (Str.split_delim (Str.regexp "[ \t]+") " si non e vero\t")
[""; "si"; "non"; "e"; "vero"; ""];
test (Str.full_split (Str.regexp "[ \t]+") " si non\te vero\t")
- [Str.Delim " "; Str.Text "si";
+ [Str.Delim " "; Str.Text "si";
Str.Delim " "; Str.Text "non";
Str.Delim "\t"; Str.Text "e";
Str.Delim " "; Str.Text "vero"; Str.Delim "\t"];
(* See "REX: XML Shallow Parsing with Regular Expressions",
Robert D. Cameron, Simon Fraser University, CMPT TR 1998-17. *)
start_test "XML tokenization";
- begin
+ begin
let _TextSE = "[^<]+" in
let _UntilHyphen = "[^-]*-" in
let _Until2Hyphens = _UntilHyphen ^ "\\([^-]" ^ _UntilHyphen ^ "\\)*-" in
-0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
+ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
All tests succeeded.
let compute_thread c = ignore c
(*
- while true do
+ while true do
print_char c; flush stdout;
for i = 1 to 100000 do ignore(ref []) done
done
print_string "Forking..."; print_newline();
match Unix.fork() with
| 0 ->
+ Thread.delay 0.5;
print_string "In child..."; print_newline();
Gc.minor();
print_string "Child did minor GC."; print_newline();
exit 0
| pid ->
print_string "In parent..."; print_newline();
- Thread.delay 2.0;
+ Thread.delay 4.0;
print_string "Parent is exiting."; print_newline();
exit 0
let _ = main()
-
-
./program > test3.result &
pid=$!
sleep 5
-kill -9 $pid
\ No newline at end of file
+kill -9 $pid
-./program < test4.data > test4.result 2> /dev/null || true
\ No newline at end of file
+./program < test4.data > test4.result 2> /dev/null || true
./program > test5.result &
pid=$!
-sleep 1
-kill -9 $pid
\ No newline at end of file
+sleep 3
+kill -9 $pid
-test `grep -E '^-?[0123456789]+$' test7.result | wc -l` = `cat test7.result | wc -l`
\ No newline at end of file
+test `grep -E '^-?[0123456789]+$' test7.result | wc -l` = `cat test7.result | wc -l`
-sed -e 1q testsignal.result | grep -q '^[ab]*Got ctrl-C, exiting...$'
+sed -e 1q testsignal.result | grep -q '^[ab]*Got ctrl-C, exiting...$'
./program > testsignal.result &
pid=$!
sleep 3
-kill -INT $pid
\ No newline at end of file
+kill -INT $pid
let stdin_thread () =
while true do
- print_string "> "; flush stdout;
+ print_string ">"; flush stdout;
let s = read_line() in
- print_string ">>> "; print_string s; print_newline()
+ print_string " >>> "; print_string s; print_newline()
done
let writer_thread (oc, size) =
> >>> abc
> >>> def
> >>> ghi
->
\ No newline at end of file
+>
\ No newline at end of file
-./program < torture.data > torture.result 2> /dev/null || true
\ No newline at end of file
+./program < torture.data > torture.result 2> /dev/null || true
(* *)
(***********************************************************************)
-(* $Id: equations.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: equations.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(****************** Equation manipulations *************)
open Terms
-type rule =
+type rule =
{ number: int;
numvars: int;
lhs: term;
let pretty_rules rules = List.iter pretty_rule rules
-
+
(****************** Rewriting **************************)
(* Top-level rewriting. Let eq:L=R be an equation, M be a term such that L<=M.
mrewrite_all rules (mrewrite1 rules m)
with Failure _ ->
m
-
(* *)
(***********************************************************************)
-(* $Id: equations.mli 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: equations.mli 12800 2012-07-30 18:59:07Z doligez $ *)
open Terms
-type rule =
+type rule =
{ number: int;
numvars: int;
lhs: term;
(* *)
(***********************************************************************)
-(* $Id: kb.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: kb.ml 12800 2012-07-30 18:59:07Z doligez $ *)
open Terms
open Equations
(* Ex :
-let (m,_) = <<F(A,B)>>
+let (m,_) = <<F(A,B)>>
and (n,_) = <<H(F(A,x),F(x,y))>> in super m n
==> [[1],[2,Term ("B",[])]; x <- B
[2],[2,Term ("A",[]); 1,Term ("B",[])]] x <- A y <- B
(* Improved Knuth-Bendix completion procedure *)
-let kb_completion greater =
+let kb_completion greater =
let rec kbrec j rules =
let rec process failures (k,l) eqs =
(****
(strict_critical_pairs el (rename rl.numvars el))
else
try
- let rk = get_rule k rules in
+ let rk = get_rule k rules in
let ek = (rk.lhs, rk.rhs) in
process failures (k,l)
(mutual_critical_pairs el (rename rl.numvars ek))
kb_completion greater n complete_rules [] (n,n) eqs in
print_string "Canonical set found :"; print_newline();
pretty_rules (List.rev completed_rules)
-
(* *)
(***********************************************************************)
-(* $Id: kbmain.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: kbmain.ml 12800 2012-07-30 18:59:07Z doligez $ *)
open Terms
open Equations
if r1 = r2 then Equal else
if r1 > r2 then Greater else NotGE
-let group_order = rpo group_precedence lex_ext
+let group_order = rpo group_precedence lex_ext
let greater pair =
match group_order pair with Greater -> true | _ -> false
let _ =
for i = 1 to 20 do kb_complete greater [] geom_rules done
-
(* *)
(***********************************************************************)
-(* $Id: orderings.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: orderings.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(*********************** Recursive Path Ordering ****************************)
open Terms
-type ordering =
+type ordering =
Greater
| Equal
| NotGE
| ( _ , []) -> Greater
| (x1::l1, x2::l2) ->
match order (x1,x2) with
- Greater -> if List.for_all (fun n' -> gt_ord order (m,n')) l2
+ Greater -> if List.for_all (fun n' -> gt_ord order (m,n')) l2
then Greater else NotGE
| Equal -> lexrec (l1,l2)
- | NotGE -> if List.exists (fun m' -> ge_ord order (m',n)) l1
+ | NotGE -> if List.exists (fun m' -> ge_ord order (m',n)) l1
then Greater else NotGE in
lexrec (sons1, sons2)
| _ -> failwith "lex_ext"
(* Recursive path ordering *)
-let rpo op_order ext =
+let rpo op_order ext =
let rec rporec (m,n) =
- if m = n then Equal else
+ if m = n then Equal else
match m with
Var vm -> NotGE
| Term(op1,sons1) ->
if List.exists (fun m' -> ge_ord rporec (m',n)) sons1
then Greater else NotGE
in rporec
-
(* *)
(***********************************************************************)
-(* $Id: orderings.mli 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: orderings.mli 12800 2012-07-30 18:59:07Z doligez $ *)
open Terms
-type ordering =
+type ordering =
Greater
| Equal
| NotGE
(* *)
(***********************************************************************)
-(* $Id: terms.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: terms.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(****************** Term manipulations *****************)
-type term =
+type term =
Var of int
| Term of string * term list
match l1 with
[] -> l2
| a::r -> if List.mem a l2 then union r l2 else a :: union r l2
-
+
let rec vars = function
Var n -> [n]
(* A naive unification algorithm. *)
-let compsubst subst1 subst2 =
+let compsubst subst1 subst2 =
(List.map (fun (v,t) -> (v, substitute subst1 t)) subst2) @ subst1
pretty_term m
| m ->
pretty_term m
-
-
(* *)
(***********************************************************************)
-(* $Id: terms.mli 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: terms.mli 12800 2012-07-30 18:59:07Z doligez $ *)
-type term =
+type term =
Var of int
| Term of string * term list
* Longitudes, Paris, France), as detailed in Astronomy & Astrophysics
* 282, 663 (1994)
*
- * Note that the code herein is design for the purpose of testing
+ * Note that the code herein is design for the purpose of testing
* computational performance; error handling and other such "niceties"
* is virtually non-existent.
*
[| 19.2184460618; -3716e-10; 979e-10 |];
[| 30.1103868694; -16635e-10; 686e-10 |] |]
-and dlm =
+and dlm =
[| [| 252.25090552; 5381016286.88982; -1.92789 |];
[| 181.97980085; 2106641364.33548; 0.59381 |];
[| 100.46645683; 1295977422.83429; -2.04411 |];
(* tables giving the trigonometric terms to be added to the mean elements of
the mean longitudes . *)
-and kq =
+and kq =
[| [| 3086.0; 15746.0; 69613.0; 59899.0; 75645.0; 88306.0; 12661.0; 2658.0; 0.0; 0.0 |];
[| 21863.0; 32794.0; 10931.0; 73.0; 4387.0; 26934.0; 1473.0; 2157.0; 0.0; 0.0 |];
[| 10.0; 16002.0; 21863.0; 10931.0; 1473.0; 32004.0; 4387.0; 73.0; 0.0; 0.0 |];
[| 71234.0;-41116.0; 5334.0;-4935.0;-1848.0; 66.0; 434.0;-1748.0; 3780.0; -701.0 |];
[| -47645.0; 11647.0; 2166.0; 3194.0; 679.0; 0.0; -244.0; -419.0; -2531.0; 48.0 |] |]
-
+
(* Normalize angle into the range -pi <= A < +pi. *)
let anpm a =
let w = mod_float a twopi in
if abs_float w >= pic then begin
if a < 0.0 then
- w +. twopi
+ w +. twopi
else
- w -. twopi
+ w -. twopi
end else
w
and de = e.(np).(0) +. (e.(np).(1) +. e.(np).(2) *. t ) *. t
and dp = anpm ((3600.0 *. pi.(np).(0) +. (pi.(np).(1) +. pi.(np).(2) *. t ) *. t ) *. a2r )
and di = (3600.0 *. dinc.(np).(0) +. (dinc.(np).(1) +. dinc.(np).(2) *. t ) *. t ) *. a2r
- and doh = anpm ((3600.0 *. omega.(np).(0) +. (omega.(np).(1) +. omega.(np).(2) *. t ) *. t ) *. a2r )
- (* apply the trigonometric terms. *)
+ and doh = anpm ((3600.0 *. omega.(np).(0) +. (omega.(np).(1) +. omega.(np).(2) *. t ) *. t ) *. a2r )
+ (* apply the trigonometric terms. *)
and dmu = 0.35953620 *. t in
-
+
(* loop invariant *)
let kp = kp.(np) and kq = kq.(np) and ca = ca.(np) and sa = sa.(np)
and cl = cl.(np) and sl = sl.(np) in
(* iterative solution of kepler's equation to get eccentric anomaly. *)
let am = !dl -. dp in
let ae = ref (am +. de *. sin am)
- and k = ref 0 in
+ and k = ref 0 in
let dae = ref ((am -. !ae +. de *. sin !ae) /. (1.0 -. de *. cos !ae)) in
ae := !ae +. !dae;
incr k;
while !k < 10 or abs_float !dae >= 1e-12 do
- dae := (am -. !ae +. de *. sin !ae) /. (1.0 -. de *. cos !ae);
- ae := !ae +. !dae;
- incr k
+ dae := (am -. !ae +. de *. sin !ae) /. (1.0 -. de *. cos !ae);
+ ae := !ae +. !dae;
+ incr k
done;
-
+
(* true anomaly. *)
let ae2 = !ae /. 2.0 in
- let at = 2.0 *. atan2 (sqrt ((1.0 +. de) /. (1.0 -. de)) *. sin ae2) (cos ae2)
- (* distance (au) and speed (radians per day). *)
+ let at = 2.0 *. atan2 (sqrt ((1.0 +. de) /. (1.0 -. de)) *. sin ae2) (cos ae2)
+ (* distance (au) and speed (radians per day). *)
and r = !da *. (1.0 -. de *. cos !ae)
and v = gaussk *. sqrt ((1.0 +. 1.0 /. amas.(np) ) /. (!da *. !da *. !da))
and si2 = sin (di /. 2.0) in
and tl = at +. dp in
let xsw = sin tl
and xcw = cos tl in
- let xm2 = 2.0 *. (xp *. xcw -. xq *. xsw )
+ let xm2 = 2.0 *. (xp *. xcw -. xq *. xsw )
and xf = !da /. sqrt (1.0 -. de *. de)
and ci2 = cos (di /. 2.0) in
let xms = (de *. sin dp +. xsw) *. xf
and y = r *. (xsw +. xm2 *. xq)
and z = r *. (-.xm2 *. ci2) in
- (* rotate to equatorial. *)
- pv.(0).(0) <- x;
- pv.(0).(1) <- y *. coseps -. z *. sineps;
- pv.(0).(2) <- y *. sineps +. z *. coseps;
+ (* rotate to equatorial. *)
+ pv.(0).(0) <- x;
+ pv.(0).(1) <- y *. coseps -. z *. sineps;
+ pv.(0).(2) <- y *. sineps +. z *. coseps;
- (* velocity (j2000 ecliptic xdot,ydot,zdot in au/d). *)
- let x = v *. ((-1.0 +. 2.0 *. xp *. xp) *. xms +. xpxq2 *. xmc)
- and y = v *. (( 1.0 -. 2.0 *. xq *. xq ) *. xmc -. xpxq2 *. xms)
- and z = v *. (2.0 *. ci2 *. (xp *. xms +. xq *. xmc)) in
+ (* velocity (j2000 ecliptic xdot,ydot,zdot in au/d). *)
+ let x = v *. ((-1.0 +. 2.0 *. xp *. xp) *. xms +. xpxq2 *. xmc)
+ and y = v *. (( 1.0 -. 2.0 *. xq *. xq ) *. xmc -. xpxq2 *. xms)
+ and z = v *. (2.0 *. ci2 *. (xp *. xms +. xq *. xmc)) in
- (* rotate to equatorial *)
- pv.(1).(0) <- x;
- pv.(1).(1) <- y *. coseps -. z *. sineps;
- pv.(1).(2) <- y *. sineps +. z *. coseps
+ (* rotate to equatorial *)
+ pv.(1).(0) <- x;
+ pv.(1).(1) <- y *. coseps -. z *. sineps;
+ pv.(1).(2) <- y *. sineps +. z *. coseps
-(* Computes RA, Declination, and distance from a state vector returned by
+(* Computes RA, Declination, and distance from a state vector returned by
* planetpv. *)
let radecdist state rdd =
(* Distance *)
rdd.(2) <- sqrt (state.(0).(0) *. state.(0).(0)
- +. state.(0).(1) *. state.(0).(1)
- +. state.(0).(2) *. state.(0).(2));
+ +. state.(0).(1) *. state.(0).(1)
+ +. state.(0).(2) *. state.(0).(2));
(* RA *)
rdd.(0) <- atan2 state.(0).(1) state.(0).(0) *. r2h;
if rdd.(0) < 0.0 then rdd.(0) <- rdd.(0) +. 24.0;
-
+
(* Declination *)
rdd.(1) <- asin (state.(0).(2) /. rdd.(2)) *. r2d
-
+
(* Entry point. Calculate RA and Dec for noon on every day in 1900-2100 *)
let _ =
let jd = [| 0.0; 0.0 |]
- and pv = [| [| 0.0; 0.0; 0.0 |]; [| 0.0; 0.0; 0.0 |] |]
+ and pv = [| [| 0.0; 0.0; 0.0 |]; [| 0.0; 0.0; 0.0 |] |]
and position = [| 0.0; 0.0; 0.0 |] in
(* Test *)
jd.(0) <- j2000;
for n = 0 to test_length - 1 do
jd.(0) <- jd.(0) +. 1.0;
for p = 0 to 7 do
- planetpv jd p pv;
- radecdist pv position;
+ planetpv jd p pv;
+ radecdist pv position;
done
done
done
(* *)
(***********************************************************************)
-(* $Id: fft.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: fft.ml 12800 2012-07-30 18:59:07Z doligez $ *)
let pi = 3.14159265358979323846
let fft px py np =
let i = ref 2 in
let m = ref 1 in
-
+
while (!i < np) do
- i := !i + !i;
+ i := !i + !i;
m := !m + 1
done;
- let n = !i in
-
+ let n = !i in
+
if n <> np then begin
for i = np+1 to n do
- px.(i) <- 0.0;
+ px.(i) <- 0.0;
py.(i) <- 0.0
done;
print_string "Use "; print_int n;
let n2 = ref(n+n) in
for k = 1 to !m-1 do
- n2 := !n2 / 2;
+ n2 := !n2 / 2;
let n4 = !n2 / 4 in
let e = tpi /. float !n2 in
let ss3 = sin(a3) in
let is = ref j in
let id = ref(2 * !n2) in
-
+
while !is < n do
let i0r = ref !is in
while !i0r < n do
let r1 = r1 +. s2 in
let s2 = r2 -. s1 in
let r2 = r2 +. s1 in
- px.(i2) <- r1*.cc1 -. s2*.ss1;
+ px.(i2) <- r1*.cc1 -. s2*.ss1;
py.(i2) <- -.s2*.cc1 -. r1*.ss1;
px.(i3) <- s3*.cc3 +. r2*.ss3;
py.(i3) <- r2*.cc3 -. s3*.ss3;
i0r := i0 + !id
done;
- is := 2 * !id - !n2 + j;
+ is := 2 * !id - !n2 + j;
id := 4 * !id
done
done
let is = ref 1 in
let id = ref 4 in
-
+
while !is < n do
let i0r = ref !is in
while !i0r <= n do
py.(i1) <- r1 -. py.(i1);
i0r := i0 + !id
done;
- is := 2 * !id - 1;
+ is := 2 * !id - 1;
id := 4 * !id
done;
(*************************)
let j = ref 1 in
-
+
for i = 1 to n - 1 do
if i < !j then begin
let xt = px.(!j) in
- px.(!j) <- px.(i);
+ px.(!j) <- px.(i);
px.(i) <- xt;
let xt = py.(!j) in
py.(!j) <- py.(i);
end;
let k = ref(n / 2) in
while !k < !j do
- j := !j - !k;
+ j := !j - !k;
k := !k / 2
done;
j := !j + !k
for i = 0 to np-1 do
let a = abs_float(pxr.(i+1) -. float i) in
if !zr < a then begin
- zr := a;
+ zr := a;
kr := i
end;
let a = abs_float(pxi.(i+1)) in
if !zi < a then begin
- zi := a;
+ zi := a;
ki := i
end
done;
let _ =
let np = ref 16 in for i = 1 to 16 do test !np; np := !np*2 done
-
(* *)
(***********************************************************************)
-(* $Id: bdd.ml 12149 2012-02-10 16:15:24Z doligez $ *)
+(* $Id: bdd.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* Translated to OCaml by Xavier Leroy *)
(* Original code written in SML by ... *)
| Node(l, v, _, h) ->
if vars.(v) then eval h vars else eval l vars
-let getId bdd =
- match bdd with
+let getId bdd =
+ match bdd with
Node(_,_,id,_) -> id
| Zero -> 0
| One -> 1
let newSz_1 = newSize-1 in
let newArr = Array.create newSize [] in
let rec copyBucket bucket =
- match bucket with
+ match bucket with
[] -> ()
- | n :: ns ->
- match n with
+ | n :: ns ->
+ match n with
| Node(l,v,_,h) ->
let ind = hashVal (getId l) (getId h) v land newSz_1
in
let mkNode low v high =
let idl = getId low in
- let idh = getId high
+ let idh = getId high
in
if idl = idh
then low
else let ind = hashVal idl idh v land (!sz_1) in
let bucket = (!htab).(ind) in
- let rec lookup b =
- match b with
+ let rec lookup b =
+ match b with
[] -> let n = Node(low, v, (incr nodeC; !nodeC), high)
in
insert (getId low) (getId high) v ind bucket n; n
- | n :: ns ->
+ | n :: ns ->
match n with
| Node(l,v',id,h) ->
if v = v' && idl = getId l && idh = getId h
type ordering = LESS | EQUAL | GREATER
let cmpVar (x : int) (y : int) =
- if x<y then LESS else if x>y then GREATER else EQUAL
+ if x<y then LESS else if x>y then GREATER else EQUAL
let zero = Zero
let one = One
let notslot2 = Array.create cacheSize one
let hash x y = ((x lsl 1)+y) mod cacheSize
-let rec not n =
+let rec not n =
match n with
Zero -> One
| One -> Zero
in
notslot1.(h) <- id; notslot2.(h) <- f; f
-let rec and2 n1 n2 =
+let rec and2 n1 n2 =
match n1 with
- Node(l1, v1, i1, r1)
+ Node(l1, v1, i1, r1)
-> (match n2 with
Node(l2, v2, i2, r2)
-> let h = hash i1 i2
| LESS -> mkNode (and2 l1 n2) v1 (and2 r1 n2)
| GREATER -> mkNode (and2 n1 l2) v2 (and2 n1 r2)
in
- andslot1.(h) <- i1;
- andslot2.(h) <- i2;
+ andslot1.(h) <- i1;
+ andslot2.(h) <- i2;
andslot3.(h) <- f;
f
| Zero -> Zero
| One -> n2
-let rec xor n1 n2 =
+let rec xor n1 n2 =
match n1 with
- Node(l1, v1, i1, r1)
+ Node(l1, v1, i1, r1)
-> (match n2 with
Node(l2, v2, i2, r2)
-> let h = hash i1 i2
andslot2.(h) <- i2;
andslot3.(h) <- f;
f
- | Zero -> n1
+ | Zero -> n1
| One -> not n1)
| Zero -> n2
| One -> not n2
-let hwb n =
+let hwb n =
let rec h i j = if i=j
then mkVar i
else xor (and2 (not(mkVar j)) (h i (j-1)))
(and2 (mkVar j) (g i (j-1)))
and g i j = if i=j
then mkVar i
- else xor (and2 (not(mkVar i)) (h (i+1) j))
+ else xor (and2 (not(mkVar i)) (h (i+1) j))
(and2 (mkVar i) (g (i+1) j))
in
h 0 (n-1)
(* *)
(***********************************************************************)
-(* $Id: boyer.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: boyer.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* Manipulations over terms *)
print_string head.name;
List.iter (fun t -> print_string " "; print_term t) argl;
print_string ")"
-
+
let lemmas = ref ([] : head list)
(* Replacement for property lists *)
let _ =
add (CProp
("equal",
- [CProp ("compile",[CVar 5]);
+ [CProp ("compile",[CVar 5]);
CProp
("reverse",
[CProp ("codegen",[CProp ("optimize",[CVar 5]); CProp ("nil",[])])])]));
add (CProp
("equal",
- [CProp ("eqp",[CVar 23; CVar 24]);
+ [CProp ("eqp",[CVar 23; CVar 24]);
CProp ("equal",[CProp ("fix",[CVar 23]); CProp ("fix",[CVar 24])])]));
add (CProp
("equal",
[CProp ("ge",[CVar 23; CVar 24]); CProp ("le",[CVar 24; CVar 23])]));
add (CProp
("equal",
- [CProp ("boolean",[CVar 23]);
+ [CProp ("boolean",[CVar 23]);
CProp
("or",
- [CProp ("equal",[CVar 23; CProp ("true",[])]);
+ [CProp ("equal",[CVar 23; CProp ("true",[])]);
CProp ("equal",[CVar 23; CProp ("false",[])])])]));
add (CProp
("equal",
- [CProp ("iff",[CVar 23; CVar 24]);
+ [CProp ("iff",[CVar 23; CVar 24]);
CProp
("and",
- [CProp ("implies",[CVar 23; CVar 24]);
+ [CProp ("implies",[CVar 23; CVar 24]);
CProp ("implies",[CVar 24; CVar 23])])]));
add (CProp
("equal",
- [CProp ("even1",[CVar 23]);
+ [CProp ("even1",[CVar 23]);
CProp
("if",
- [CProp ("zerop",[CVar 23]); CProp ("true",[]);
+ [CProp ("zerop",[CVar 23]); CProp ("true",[]);
CProp ("odd",[CProp ("sub1",[CVar 23])])])]));
add (CProp
("equal",
- [CProp ("countps_",[CVar 11; CVar 15]);
+ [CProp ("countps_",[CVar 11; CVar 15]);
CProp ("countps_loop",[CVar 11; CVar 15; CProp ("zero",[])])]));
add (CProp
("equal",
- [CProp ("fact_",[CVar 8]);
+ [CProp ("fact_",[CVar 8]);
CProp ("fact_loop",[CVar 8; CProp ("one",[])])]));
add (CProp
("equal",
- [CProp ("reverse_",[CVar 23]);
+ [CProp ("reverse_",[CVar 23]);
CProp ("reverse_loop",[CVar 23; CProp ("nil",[])])]));
add (CProp
("equal",
- [CProp ("divides",[CVar 23; CVar 24]);
+ [CProp ("divides",[CVar 23; CVar 24]);
CProp ("zerop",[CProp ("remainder",[CVar 24; CVar 23])])]));
add (CProp
("equal",
- [CProp ("assume_true",[CVar 21; CVar 0]);
+ [CProp ("assume_true",[CVar 21; CVar 0]);
CProp ("cons",[CProp ("cons",[CVar 21; CProp ("true",[])]); CVar 0])]));
add (CProp
("equal",
- [CProp ("assume_false",[CVar 21; CVar 0]);
+ [CProp ("assume_false",[CVar 21; CVar 0]);
CProp ("cons",[CProp ("cons",[CVar 21; CProp ("false",[])]); CVar 0])]));
add (CProp
("equal",
- [CProp ("tautology_checker",[CVar 23]);
+ [CProp ("tautology_checker",[CVar 23]);
CProp ("tautologyp",[CProp ("normalize",[CVar 23]); CProp ("nil",[])])]));
add (CProp
("equal",
- [CProp ("falsify",[CVar 23]);
+ [CProp ("falsify",[CVar 23]);
CProp ("falsify1",[CProp ("normalize",[CVar 23]); CProp ("nil",[])])]));
add (CProp
("equal",
- [CProp ("prime",[CVar 23]);
+ [CProp ("prime",[CVar 23]);
CProp
("and",
- [CProp ("not",[CProp ("zerop",[CVar 23])]);
+ [CProp ("not",[CProp ("zerop",[CVar 23])]);
CProp
("not",
- [CProp ("equal",[CVar 23; CProp ("add1",[CProp ("zero",[])])])]);
+ [CProp ("equal",[CVar 23; CProp ("add1",[CProp ("zero",[])])])]);
CProp ("prime1",[CVar 23; CProp ("sub1",[CVar 23])])])]));
add (CProp
("equal",
- [CProp ("and",[CVar 15; CVar 16]);
+ [CProp ("and",[CVar 15; CVar 16]);
CProp
("if",
- [CVar 15;
- CProp ("if",[CVar 16; CProp ("true",[]); CProp ("false",[])]);
+ [CVar 15;
+ CProp ("if",[CVar 16; CProp ("true",[]); CProp ("false",[])]);
CProp ("false",[])])]));
add (CProp
("equal",
- [CProp ("or",[CVar 15; CVar 16]);
+ [CProp ("or",[CVar 15; CVar 16]);
CProp
("if",
- [CVar 15; CProp ("true",[]);
- CProp ("if",[CVar 16; CProp ("true",[]); CProp ("false",[])]);
+ [CVar 15; CProp ("true",[]);
+ CProp ("if",[CVar 16; CProp ("true",[]); CProp ("false",[])]);
CProp ("false",[])])]));
add (CProp
("equal",
- [CProp ("not",[CVar 15]);
+ [CProp ("not",[CVar 15]);
CProp ("if",[CVar 15; CProp ("false",[]); CProp ("true",[])])]));
add (CProp
("equal",
- [CProp ("implies",[CVar 15; CVar 16]);
+ [CProp ("implies",[CVar 15; CVar 16]);
CProp
("if",
- [CVar 15;
- CProp ("if",[CVar 16; CProp ("true",[]); CProp ("false",[])]);
+ [CVar 15;
+ CProp ("if",[CVar 16; CProp ("true",[]); CProp ("false",[])]);
CProp ("true",[])])]));
add (CProp
("equal",
- [CProp ("fix",[CVar 23]);
+ [CProp ("fix",[CVar 23]);
CProp ("if",[CProp ("numberp",[CVar 23]); CVar 23; CProp ("zero",[])])]));
add (CProp
("equal",
- [CProp ("if",[CProp ("if",[CVar 0; CVar 1; CVar 2]); CVar 3; CVar 4]);
+ [CProp ("if",[CProp ("if",[CVar 0; CVar 1; CVar 2]); CVar 3; CVar 4]);
CProp
("if",
- [CVar 0; CProp ("if",[CVar 1; CVar 3; CVar 4]);
+ [CVar 0; CProp ("if",[CVar 1; CVar 3; CVar 4]);
CProp ("if",[CVar 2; CVar 3; CVar 4])])]));
add (CProp
("equal",
- [CProp ("zerop",[CVar 23]);
+ [CProp ("zerop",[CVar 23]);
CProp
("or",
- [CProp ("equal",[CVar 23; CProp ("zero",[])]);
+ [CProp ("equal",[CVar 23; CProp ("zero",[])]);
CProp ("not",[CProp ("numberp",[CVar 23])])])]));
add (CProp
("equal",
- [CProp ("plus",[CProp ("plus",[CVar 23; CVar 24]); CVar 25]);
+ [CProp ("plus",[CProp ("plus",[CVar 23; CVar 24]); CVar 25]);
CProp ("plus",[CVar 23; CProp ("plus",[CVar 24; CVar 25])])]));
add (CProp
("equal",
- [CProp ("equal",[CProp ("plus",[CVar 0; CVar 1]); CProp ("zero",[])]);
+ [CProp ("equal",[CProp ("plus",[CVar 0; CVar 1]); CProp ("zero",[])]);
CProp ("and",[CProp ("zerop",[CVar 0]); CProp ("zerop",[CVar 1])])]));
add (CProp
("equal",[CProp ("difference",[CVar 23; CVar 23]); CProp ("zero",[])]));
("equal",
[CProp
("equal",
- [CProp ("plus",[CVar 0; CVar 1]); CProp ("plus",[CVar 0; CVar 2])]);
+ [CProp ("plus",[CVar 0; CVar 1]); CProp ("plus",[CVar 0; CVar 2])]);
CProp ("equal",[CProp ("fix",[CVar 1]); CProp ("fix",[CVar 2])])]));
add (CProp
("equal",
[CProp
- ("equal",[CProp ("zero",[]); CProp ("difference",[CVar 23; CVar 24])]);
+ ("equal",[CProp ("zero",[]); CProp ("difference",[CVar 23; CVar 24])]);
CProp ("not",[CProp ("gt",[CVar 24; CVar 23])])]));
add (CProp
("equal",
- [CProp ("equal",[CVar 23; CProp ("difference",[CVar 23; CVar 24])]);
+ [CProp ("equal",[CVar 23; CProp ("difference",[CVar 23; CVar 24])]);
CProp
("and",
- [CProp ("numberp",[CVar 23]);
+ [CProp ("numberp",[CVar 23]);
CProp
("or",
- [CProp ("equal",[CVar 23; CProp ("zero",[])]);
+ [CProp ("equal",[CVar 23; CProp ("zero",[])]);
CProp ("zerop",[CVar 24])])])]));
add (CProp
("equal",
[CProp
("meaning",
- [CProp ("plus_tree",[CProp ("append",[CVar 23; CVar 24])]); CVar 0]);
+ [CProp ("plus_tree",[CProp ("append",[CVar 23; CVar 24])]); CVar 0]);
CProp
("plus",
- [CProp ("meaning",[CProp ("plus_tree",[CVar 23]); CVar 0]);
+ [CProp ("meaning",[CProp ("plus_tree",[CVar 23]); CVar 0]);
CProp ("meaning",[CProp ("plus_tree",[CVar 24]); CVar 0])])]));
add (CProp
("equal",
[CProp
("meaning",
- [CProp ("plus_tree",[CProp ("plus_fringe",[CVar 23])]); CVar 0]);
+ [CProp ("plus_tree",[CProp ("plus_fringe",[CVar 23])]); CVar 0]);
CProp ("fix",[CProp ("meaning",[CVar 23; CVar 0])])]));
add (CProp
("equal",
- [CProp ("append",[CProp ("append",[CVar 23; CVar 24]); CVar 25]);
+ [CProp ("append",[CProp ("append",[CVar 23; CVar 24]); CVar 25]);
CProp ("append",[CVar 23; CProp ("append",[CVar 24; CVar 25])])]));
add (CProp
("equal",
- [CProp ("reverse",[CProp ("append",[CVar 0; CVar 1])]);
+ [CProp ("reverse",[CProp ("append",[CVar 0; CVar 1])]);
CProp
("append",[CProp ("reverse",[CVar 1]); CProp ("reverse",[CVar 0])])]));
add (CProp
("equal",
- [CProp ("times",[CVar 23; CProp ("plus",[CVar 24; CVar 25])]);
+ [CProp ("times",[CVar 23; CProp ("plus",[CVar 24; CVar 25])]);
CProp
("plus",
- [CProp ("times",[CVar 23; CVar 24]);
+ [CProp ("times",[CVar 23; CVar 24]);
CProp ("times",[CVar 23; CVar 25])])]));
add (CProp
("equal",
- [CProp ("times",[CProp ("times",[CVar 23; CVar 24]); CVar 25]);
+ [CProp ("times",[CProp ("times",[CVar 23; CVar 24]); CVar 25]);
CProp ("times",[CVar 23; CProp ("times",[CVar 24; CVar 25])])]));
add (CProp
("equal",
[CProp
- ("equal",[CProp ("times",[CVar 23; CVar 24]); CProp ("zero",[])]);
+ ("equal",[CProp ("times",[CVar 23; CVar 24]); CProp ("zero",[])]);
CProp ("or",[CProp ("zerop",[CVar 23]); CProp ("zerop",[CVar 24])])]));
add (CProp
("equal",
- [CProp ("exec",[CProp ("append",[CVar 23; CVar 24]); CVar 15; CVar 4]);
+ [CProp ("exec",[CProp ("append",[CVar 23; CVar 24]); CVar 15; CVar 4]);
CProp
("exec",[CVar 24; CProp ("exec",[CVar 23; CVar 15; CVar 4]); CVar 4])]));
add (CProp
("equal",
- [CProp ("mc_flatten",[CVar 23; CVar 24]);
+ [CProp ("mc_flatten",[CVar 23; CVar 24]);
CProp ("append",[CProp ("flatten",[CVar 23]); CVar 24])]));
add (CProp
("equal",
- [CProp ("member",[CVar 23; CProp ("append",[CVar 0; CVar 1])]);
+ [CProp ("member",[CVar 23; CProp ("append",[CVar 0; CVar 1])]);
CProp
("or",
- [CProp ("member",[CVar 23; CVar 0]);
+ [CProp ("member",[CVar 23; CVar 0]);
CProp ("member",[CVar 23; CVar 1])])]));
add (CProp
("equal",
- [CProp ("member",[CVar 23; CProp ("reverse",[CVar 24])]);
+ [CProp ("member",[CVar 23; CProp ("reverse",[CVar 24])]);
CProp ("member",[CVar 23; CVar 24])]));
add (CProp
("equal",
- [CProp ("length",[CProp ("reverse",[CVar 23])]);
+ [CProp ("length",[CProp ("reverse",[CVar 23])]);
CProp ("length",[CVar 23])]));
add (CProp
("equal",
- [CProp ("member",[CVar 0; CProp ("intersect",[CVar 1; CVar 2])]);
+ [CProp ("member",[CVar 0; CProp ("intersect",[CVar 1; CVar 2])]);
CProp
("and",
[CProp ("member",[CVar 0; CVar 1]); CProp ("member",[CVar 0; CVar 2])])]));
("equal",[CProp ("nth",[CProp ("zero",[]); CVar 8]); CProp ("zero",[])]));
add (CProp
("equal",
- [CProp ("exp",[CVar 8; CProp ("plus",[CVar 9; CVar 10])]);
+ [CProp ("exp",[CVar 8; CProp ("plus",[CVar 9; CVar 10])]);
CProp
("times",
[CProp ("exp",[CVar 8; CVar 9]); CProp ("exp",[CVar 8; CVar 10])])]));
add (CProp
("equal",
- [CProp ("exp",[CVar 8; CProp ("times",[CVar 9; CVar 10])]);
+ [CProp ("exp",[CVar 8; CProp ("times",[CVar 9; CVar 10])]);
CProp ("exp",[CProp ("exp",[CVar 8; CVar 9]); CVar 10])]));
add (CProp
("equal",
- [CProp ("reverse_loop",[CVar 23; CVar 24]);
+ [CProp ("reverse_loop",[CVar 23; CVar 24]);
CProp ("append",[CProp ("reverse",[CVar 23]); CVar 24])]));
add (CProp
("equal",
- [CProp ("reverse_loop",[CVar 23; CProp ("nil",[])]);
+ [CProp ("reverse_loop",[CVar 23; CProp ("nil",[])]);
CProp ("reverse",[CVar 23])]));
add (CProp
("equal",
- [CProp ("count_list",[CVar 25; CProp ("sort_lp",[CVar 23; CVar 24])]);
+ [CProp ("count_list",[CVar 25; CProp ("sort_lp",[CVar 23; CVar 24])]);
CProp
("plus",
- [CProp ("count_list",[CVar 25; CVar 23]);
+ [CProp ("count_list",[CVar 25; CVar 23]);
CProp ("count_list",[CVar 25; CVar 24])])]));
add (CProp
("equal",
[CProp
("equal",
- [CProp ("append",[CVar 0; CVar 1]); CProp ("append",[CVar 0; CVar 2])]);
+ [CProp ("append",[CVar 0; CVar 1]); CProp ("append",[CVar 0; CVar 2])]);
CProp ("equal",[CVar 1; CVar 2])]));
add (CProp
("equal",
[CProp
("plus",
- [CProp ("remainder",[CVar 23; CVar 24]);
- CProp ("times",[CVar 24; CProp ("quotient",[CVar 23; CVar 24])])]);
+ [CProp ("remainder",[CVar 23; CVar 24]);
+ CProp ("times",[CVar 24; CProp ("quotient",[CVar 23; CVar 24])])]);
CProp ("fix",[CVar 23])]));
add (CProp
("equal",
[CProp
- ("power_eval",[CProp ("big_plus",[CVar 11; CVar 8; CVar 1]); CVar 1]);
+ ("power_eval",[CProp ("big_plus",[CVar 11; CVar 8; CVar 1]); CVar 1]);
CProp ("plus",[CProp ("power_eval",[CVar 11; CVar 1]); CVar 8])]));
add (CProp
("equal",
[CProp
("power_eval",
- [CProp ("big_plus",[CVar 23; CVar 24; CVar 8; CVar 1]); CVar 1]);
+ [CProp ("big_plus",[CVar 23; CVar 24; CVar 8; CVar 1]); CVar 1]);
CProp
("plus",
- [CVar 8;
+ [CVar 8;
CProp
("plus",
- [CProp ("power_eval",[CVar 23; CVar 1]);
+ [CProp ("power_eval",[CVar 23; CVar 1]);
CProp ("power_eval",[CVar 24; CVar 1])])])]));
add (CProp
("equal",
[CProp ("remainder",[CVar 24; CProp ("one",[])]); CProp ("zero",[])]));
add (CProp
("equal",
- [CProp ("lt",[CProp ("remainder",[CVar 23; CVar 24]); CVar 24]);
+ [CProp ("lt",[CProp ("remainder",[CVar 23; CVar 24]); CVar 24]);
CProp ("not",[CProp ("zerop",[CVar 24])])]));
add (CProp
("equal",[CProp ("remainder",[CVar 23; CVar 23]); CProp ("zero",[])]));
add (CProp
("equal",
- [CProp ("lt",[CProp ("quotient",[CVar 8; CVar 9]); CVar 8]);
+ [CProp ("lt",[CProp ("quotient",[CVar 8; CVar 9]); CVar 8]);
CProp
("and",
- [CProp ("not",[CProp ("zerop",[CVar 8])]);
+ [CProp ("not",[CProp ("zerop",[CVar 8])]);
CProp
("or",
- [CProp ("zerop",[CVar 9]);
+ [CProp ("zerop",[CVar 9]);
CProp ("not",[CProp ("equal",[CVar 9; CProp ("one",[])])])])])]));
add (CProp
("equal",
- [CProp ("lt",[CProp ("remainder",[CVar 23; CVar 24]); CVar 23]);
+ [CProp ("lt",[CProp ("remainder",[CVar 23; CVar 24]); CVar 23]);
CProp
("and",
- [CProp ("not",[CProp ("zerop",[CVar 24])]);
- CProp ("not",[CProp ("zerop",[CVar 23])]);
+ [CProp ("not",[CProp ("zerop",[CVar 24])]);
+ CProp ("not",[CProp ("zerop",[CVar 23])]);
CProp ("not",[CProp ("lt",[CVar 23; CVar 24])])])]));
add (CProp
("equal",
- [CProp ("power_eval",[CProp ("power_rep",[CVar 8; CVar 1]); CVar 1]);
+ [CProp ("power_eval",[CProp ("power_rep",[CVar 8; CVar 1]); CVar 1]);
CProp ("fix",[CVar 8])]));
add (CProp
("equal",
("power_eval",
[CProp
("big_plus",
- [CProp ("power_rep",[CVar 8; CVar 1]);
- CProp ("power_rep",[CVar 9; CVar 1]); CProp ("zero",[]);
- CVar 1]);
- CVar 1]);
+ [CProp ("power_rep",[CVar 8; CVar 1]);
+ CProp ("power_rep",[CVar 9; CVar 1]); CProp ("zero",[]);
+ CVar 1]);
+ CVar 1]);
CProp ("plus",[CVar 8; CVar 9])]));
add (CProp
("equal",
[CProp ("gcd",[CVar 23; CVar 24]); CProp ("gcd",[CVar 24; CVar 23])]));
add (CProp
("equal",
- [CProp ("nth",[CProp ("append",[CVar 0; CVar 1]); CVar 8]);
+ [CProp ("nth",[CProp ("append",[CVar 0; CVar 1]); CVar 8]);
CProp
("append",
- [CProp ("nth",[CVar 0; CVar 8]);
+ [CProp ("nth",[CVar 0; CVar 8]);
CProp
("nth",
[CVar 1; CProp ("difference",[CVar 8; CProp ("length",[CVar 0])])])])]));
add (CProp
("equal",
- [CProp ("difference",[CProp ("plus",[CVar 23; CVar 24]); CVar 23]);
+ [CProp ("difference",[CProp ("plus",[CVar 23; CVar 24]); CVar 23]);
CProp ("fix",[CVar 24])]));
add (CProp
("equal",
- [CProp ("difference",[CProp ("plus",[CVar 24; CVar 23]); CVar 23]);
+ [CProp ("difference",[CProp ("plus",[CVar 24; CVar 23]); CVar 23]);
CProp ("fix",[CVar 24])]));
add (CProp
("equal",
[CProp
("difference",
- [CProp ("plus",[CVar 23; CVar 24]); CProp ("plus",[CVar 23; CVar 25])]);
+ [CProp ("plus",[CVar 23; CVar 24]); CProp ("plus",[CVar 23; CVar 25])]);
CProp ("difference",[CVar 24; CVar 25])]));
add (CProp
("equal",
- [CProp ("times",[CVar 23; CProp ("difference",[CVar 2; CVar 22])]);
+ [CProp ("times",[CVar 23; CProp ("difference",[CVar 2; CVar 22])]);
CProp
("difference",
- [CProp ("times",[CVar 2; CVar 23]);
+ [CProp ("times",[CVar 2; CVar 23]);
CProp ("times",[CVar 22; CVar 23])])]));
add (CProp
("equal",
- [CProp ("remainder",[CProp ("times",[CVar 23; CVar 25]); CVar 25]);
+ [CProp ("remainder",[CProp ("times",[CVar 23; CVar 25]); CVar 25]);
CProp ("zero",[])]));
add (CProp
("equal",
[CProp
("difference",
- [CProp ("plus",[CVar 1; CProp ("plus",[CVar 0; CVar 2])]); CVar 0]);
+ [CProp ("plus",[CVar 1; CProp ("plus",[CVar 0; CVar 2])]); CVar 0]);
CProp ("plus",[CVar 1; CVar 2])]));
add (CProp
("equal",
[CProp
("difference",
- [CProp ("add1",[CProp ("plus",[CVar 24; CVar 25])]); CVar 25]);
+ [CProp ("add1",[CProp ("plus",[CVar 24; CVar 25])]); CVar 25]);
CProp ("add1",[CVar 24])]));
add (CProp
("equal",
[CProp
("lt",
- [CProp ("plus",[CVar 23; CVar 24]); CProp ("plus",[CVar 23; CVar 25])]);
+ [CProp ("plus",[CVar 23; CVar 24]); CProp ("plus",[CVar 23; CVar 25])]);
CProp ("lt",[CVar 24; CVar 25])]));
add (CProp
("equal",
[CProp
("lt",
- [CProp ("times",[CVar 23; CVar 25]);
- CProp ("times",[CVar 24; CVar 25])]);
+ [CProp ("times",[CVar 23; CVar 25]);
+ CProp ("times",[CVar 24; CVar 25])]);
CProp
("and",
- [CProp ("not",[CProp ("zerop",[CVar 25])]);
+ [CProp ("not",[CProp ("zerop",[CVar 25])]);
CProp ("lt",[CVar 23; CVar 24])])]));
add (CProp
("equal",
- [CProp ("lt",[CVar 24; CProp ("plus",[CVar 23; CVar 24])]);
+ [CProp ("lt",[CVar 24; CProp ("plus",[CVar 23; CVar 24])]);
CProp ("not",[CProp ("zerop",[CVar 23])])]));
add (CProp
("equal",
[CProp
("gcd",
- [CProp ("times",[CVar 23; CVar 25]);
- CProp ("times",[CVar 24; CVar 25])]);
+ [CProp ("times",[CVar 23; CVar 25]);
+ CProp ("times",[CVar 24; CVar 25])]);
CProp ("times",[CVar 25; CProp ("gcd",[CVar 23; CVar 24])])]));
add (CProp
("equal",
- [CProp ("value",[CProp ("normalize",[CVar 23]); CVar 0]);
+ [CProp ("value",[CProp ("normalize",[CVar 23]); CVar 0]);
CProp ("value",[CVar 23; CVar 0])]));
add (CProp
("equal",
[CProp
("equal",
- [CProp ("flatten",[CVar 23]);
- CProp ("cons",[CVar 24; CProp ("nil",[])])]);
+ [CProp ("flatten",[CVar 23]);
+ CProp ("cons",[CVar 24; CProp ("nil",[])])]);
CProp
("and",
[CProp ("nlistp",[CVar 23]); CProp ("equal",[CVar 23; CVar 24])])]));
add (CProp
("equal",
- [CProp ("listp",[CProp ("gother",[CVar 23])]);
+ [CProp ("listp",[CProp ("gother",[CVar 23])]);
CProp ("listp",[CVar 23])]));
add (CProp
("equal",
- [CProp ("samefringe",[CVar 23; CVar 24]);
+ [CProp ("samefringe",[CVar 23; CVar 24]);
CProp
("equal",[CProp ("flatten",[CVar 23]); CProp ("flatten",[CVar 24])])]));
add (CProp
("equal",
[CProp
("equal",
- [CProp ("greatest_factor",[CVar 23; CVar 24]); CProp ("zero",[])]);
+ [CProp ("greatest_factor",[CVar 23; CVar 24]); CProp ("zero",[])]);
CProp
("and",
[CProp
("or",
- [CProp ("zerop",[CVar 24]);
- CProp ("equal",[CVar 24; CProp ("one",[])])]);
+ [CProp ("zerop",[CVar 24]);
+ CProp ("equal",[CVar 24; CProp ("one",[])])]);
CProp ("equal",[CVar 23; CProp ("zero",[])])])]));
add (CProp
("equal",
[CProp
("equal",
- [CProp ("greatest_factor",[CVar 23; CVar 24]); CProp ("one",[])]);
+ [CProp ("greatest_factor",[CVar 23; CVar 24]); CProp ("one",[])]);
CProp ("equal",[CVar 23; CProp ("one",[])])]));
add (CProp
("equal",
- [CProp ("numberp",[CProp ("greatest_factor",[CVar 23; CVar 24])]);
+ [CProp ("numberp",[CProp ("greatest_factor",[CVar 23; CVar 24])]);
CProp
("not",
[CProp
("and",
[CProp
("or",
- [CProp ("zerop",[CVar 24]);
- CProp ("equal",[CVar 24; CProp ("one",[])])]);
+ [CProp ("zerop",[CVar 24]);
+ CProp ("equal",[CVar 24; CProp ("one",[])])]);
CProp ("not",[CProp ("numberp",[CVar 23])])])])]));
add (CProp
("equal",
- [CProp ("times_list",[CProp ("append",[CVar 23; CVar 24])]);
+ [CProp ("times_list",[CProp ("append",[CVar 23; CVar 24])]);
CProp
("times",
[CProp ("times_list",[CVar 23]); CProp ("times_list",[CVar 24])])]));
add (CProp
("equal",
- [CProp ("prime_list",[CProp ("append",[CVar 23; CVar 24])]);
+ [CProp ("prime_list",[CProp ("append",[CVar 23; CVar 24])]);
CProp
("and",
[CProp ("prime_list",[CVar 23]); CProp ("prime_list",[CVar 24])])]));
add (CProp
("equal",
- [CProp ("equal",[CVar 25; CProp ("times",[CVar 22; CVar 25])]);
+ [CProp ("equal",[CVar 25; CProp ("times",[CVar 22; CVar 25])]);
CProp
("and",
- [CProp ("numberp",[CVar 25]);
+ [CProp ("numberp",[CVar 25]);
CProp
("or",
- [CProp ("equal",[CVar 25; CProp ("zero",[])]);
+ [CProp ("equal",[CVar 25; CProp ("zero",[])]);
CProp ("equal",[CVar 22; CProp ("one",[])])])])]));
add (CProp
("equal",
- [CProp ("ge",[CVar 23; CVar 24]);
+ [CProp ("ge",[CVar 23; CVar 24]);
CProp ("not",[CProp ("lt",[CVar 23; CVar 24])])]));
add (CProp
("equal",
- [CProp ("equal",[CVar 23; CProp ("times",[CVar 23; CVar 24])]);
+ [CProp ("equal",[CVar 23; CProp ("times",[CVar 23; CVar 24])]);
CProp
("or",
- [CProp ("equal",[CVar 23; CProp ("zero",[])]);
+ [CProp ("equal",[CVar 23; CProp ("zero",[])]);
CProp
("and",
- [CProp ("numberp",[CVar 23]);
+ [CProp ("numberp",[CVar 23]);
CProp ("equal",[CVar 24; CProp ("one",[])])])])]));
add (CProp
("equal",
- [CProp ("remainder",[CProp ("times",[CVar 24; CVar 23]); CVar 24]);
+ [CProp ("remainder",[CProp ("times",[CVar 24; CVar 23]); CVar 24]);
CProp ("zero",[])]));
add (CProp
("equal",
- [CProp ("equal",[CProp ("times",[CVar 0; CVar 1]); CProp ("one",[])]);
+ [CProp ("equal",[CProp ("times",[CVar 0; CVar 1]); CProp ("one",[])]);
CProp
("and",
- [CProp ("not",[CProp ("equal",[CVar 0; CProp ("zero",[])])]);
- CProp ("not",[CProp ("equal",[CVar 1; CProp ("zero",[])])]);
- CProp ("numberp",[CVar 0]); CProp ("numberp",[CVar 1]);
- CProp ("equal",[CProp ("sub1",[CVar 0]); CProp ("zero",[])]);
+ [CProp ("not",[CProp ("equal",[CVar 0; CProp ("zero",[])])]);
+ CProp ("not",[CProp ("equal",[CVar 1; CProp ("zero",[])])]);
+ CProp ("numberp",[CVar 0]); CProp ("numberp",[CVar 1]);
+ CProp ("equal",[CProp ("sub1",[CVar 0]); CProp ("zero",[])]);
CProp ("equal",[CProp ("sub1",[CVar 1]); CProp ("zero",[])])])]));
add (CProp
("equal",
[CProp
("lt",
- [CProp ("length",[CProp ("delete",[CVar 23; CVar 11])]);
- CProp ("length",[CVar 11])]);
+ [CProp ("length",[CProp ("delete",[CVar 23; CVar 11])]);
+ CProp ("length",[CVar 11])]);
CProp ("member",[CVar 23; CVar 11])]));
add (CProp
("equal",
- [CProp ("sort2",[CProp ("delete",[CVar 23; CVar 11])]);
+ [CProp ("sort2",[CProp ("delete",[CVar 23; CVar 11])]);
CProp ("delete",[CVar 23; CProp ("sort2",[CVar 11])])]));
add (CProp ("equal",[CProp ("dsort",[CVar 23]); CProp ("sort2",[CVar 23])]));
add (CProp
("length",
[CProp
("cons",
- [CVar 0;
+ [CVar 0;
CProp
("cons",
- [CVar 1;
+ [CVar 1;
CProp
("cons",
- [CVar 2;
+ [CVar 2;
CProp
("cons",
- [CVar 3;
+ [CVar 3;
CProp ("cons",[CVar 4; CProp ("cons",[CVar 5; CVar 6])])])])])])])
; CProp ("plus",[CProp ("six",[]); CProp ("length",[CVar 6])])]));
add (CProp
("equal",
[CProp
("difference",
- [CProp ("add1",[CProp ("add1",[CVar 23])]); CProp ("two",[])]);
+ [CProp ("add1",[CProp ("add1",[CVar 23])]); CProp ("two",[])]);
CProp ("fix",[CVar 23])]));
add (CProp
("equal",
[CProp
("quotient",
- [CProp ("plus",[CVar 23; CProp ("plus",[CVar 23; CVar 24])]);
- CProp ("two",[])]);
+ [CProp ("plus",[CVar 23; CProp ("plus",[CVar 23; CVar 24])]);
+ CProp ("two",[])]);
CProp
("plus",[CVar 23; CProp ("quotient",[CVar 24; CProp ("two",[])])])]));
add (CProp
("equal",
- [CProp ("sigma",[CProp ("zero",[]); CVar 8]);
+ [CProp ("sigma",[CProp ("zero",[]); CVar 8]);
CProp
("quotient",
[CProp ("times",[CVar 8; CProp ("add1",[CVar 8])]); CProp ("two",[])])]));
add (CProp
("equal",
- [CProp ("plus",[CVar 23; CProp ("add1",[CVar 24])]);
+ [CProp ("plus",[CVar 23; CProp ("add1",[CVar 24])]);
CProp
("if",
- [CProp ("numberp",[CVar 24]);
- CProp ("add1",[CProp ("plus",[CVar 23; CVar 24])]);
+ [CProp ("numberp",[CVar 24]);
+ CProp ("add1",[CProp ("plus",[CVar 23; CVar 24])]);
CProp ("add1",[CVar 23])])]));
add (CProp
("equal",
[CProp
("equal",
- [CProp ("difference",[CVar 23; CVar 24]);
- CProp ("difference",[CVar 25; CVar 24])]);
+ [CProp ("difference",[CVar 23; CVar 24]);
+ CProp ("difference",[CVar 25; CVar 24])]);
CProp
("if",
- [CProp ("lt",[CVar 23; CVar 24]);
- CProp ("not",[CProp ("lt",[CVar 24; CVar 25])]);
+ [CProp ("lt",[CVar 23; CVar 24]);
+ CProp ("not",[CProp ("lt",[CVar 24; CVar 25])]);
CProp
("if",
- [CProp ("lt",[CVar 25; CVar 24]);
- CProp ("not",[CProp ("lt",[CVar 24; CVar 23])]);
+ [CProp ("lt",[CVar 25; CVar 24]);
+ CProp ("not",[CProp ("lt",[CVar 24; CVar 23])]);
CProp ("equal",[CProp ("fix",[CVar 23]); CProp ("fix",[CVar 25])])])])])
);
add (CProp
("equal",
[CProp
("meaning",
- [CProp ("plus_tree",[CProp ("delete",[CVar 23; CVar 24])]); CVar 0]);
+ [CProp ("plus_tree",[CProp ("delete",[CVar 23; CVar 24])]); CVar 0]);
CProp
("if",
- [CProp ("member",[CVar 23; CVar 24]);
+ [CProp ("member",[CVar 23; CVar 24]);
CProp
("difference",
- [CProp ("meaning",[CProp ("plus_tree",[CVar 24]); CVar 0]);
- CProp ("meaning",[CVar 23; CVar 0])]);
+ [CProp ("meaning",[CProp ("plus_tree",[CVar 24]); CVar 0]);
+ CProp ("meaning",[CVar 23; CVar 0])]);
CProp ("meaning",[CProp ("plus_tree",[CVar 24]); CVar 0])])]));
add (CProp
("equal",
- [CProp ("times",[CVar 23; CProp ("add1",[CVar 24])]);
+ [CProp ("times",[CVar 23; CProp ("add1",[CVar 24])]);
CProp
("if",
- [CProp ("numberp",[CVar 24]);
+ [CProp ("numberp",[CVar 24]);
CProp
("plus",
- [CVar 23; CProp ("times",[CVar 23; CVar 24]);
+ [CVar 23; CProp ("times",[CVar 23; CVar 24]);
CProp ("fix",[CVar 23])])])]));
add (CProp
("equal",
- [CProp ("nth",[CProp ("nil",[]); CVar 8]);
+ [CProp ("nth",[CProp ("nil",[]); CVar 8]);
CProp
("if",[CProp ("zerop",[CVar 8]); CProp ("nil",[]); CProp ("zero",[])])]));
add (CProp
("equal",
- [CProp ("last",[CProp ("append",[CVar 0; CVar 1])]);
+ [CProp ("last",[CProp ("append",[CVar 0; CVar 1])]);
CProp
("if",
- [CProp ("listp",[CVar 1]); CProp ("last",[CVar 1]);
+ [CProp ("listp",[CVar 1]); CProp ("last",[CVar 1]);
CProp
("if",
- [CProp ("listp",[CVar 0]);
- CProp ("cons",[CProp ("car",[CProp ("last",[CVar 0])]); CVar 1]);
+ [CProp ("listp",[CVar 0]);
+ CProp ("cons",[CProp ("car",[CProp ("last",[CVar 0])]); CVar 1]);
CVar 1])])]));
add (CProp
("equal",
- [CProp ("equal",[CProp ("lt",[CVar 23; CVar 24]); CVar 25]);
+ [CProp ("equal",[CProp ("lt",[CVar 23; CVar 24]); CVar 25]);
CProp
("if",
- [CProp ("lt",[CVar 23; CVar 24]);
- CProp ("equal",[CProp ("true",[]); CVar 25]);
+ [CProp ("lt",[CVar 23; CVar 24]);
+ CProp ("equal",[CProp ("true",[]); CVar 25]);
CProp ("equal",[CProp ("false",[]); CVar 25])])]));
add (CProp
("equal",
- [CProp ("assignment",[CVar 23; CProp ("append",[CVar 0; CVar 1])]);
+ [CProp ("assignment",[CVar 23; CProp ("append",[CVar 0; CVar 1])]);
CProp
("if",
- [CProp ("assignedp",[CVar 23; CVar 0]);
- CProp ("assignment",[CVar 23; CVar 0]);
+ [CProp ("assignedp",[CVar 23; CVar 0]);
+ CProp ("assignment",[CVar 23; CVar 0]);
CProp ("assignment",[CVar 23; CVar 1])])]));
add (CProp
("equal",
- [CProp ("car",[CProp ("gother",[CVar 23])]);
+ [CProp ("car",[CProp ("gother",[CVar 23])]);
CProp
("if",
- [CProp ("listp",[CVar 23]);
+ [CProp ("listp",[CVar 23]);
CProp ("car",[CProp ("flatten",[CVar 23])]); CProp ("zero",[])])]));
add (CProp
("equal",
- [CProp ("flatten",[CProp ("cdr",[CProp ("gother",[CVar 23])])]);
+ [CProp ("flatten",[CProp ("cdr",[CProp ("gother",[CVar 23])])]);
CProp
("if",
- [CProp ("listp",[CVar 23]);
- CProp ("cdr",[CProp ("flatten",[CVar 23])]);
+ [CProp ("listp",[CVar 23]);
+ CProp ("cdr",[CProp ("flatten",[CVar 23])]);
CProp ("cons",[CProp ("zero",[]); CProp ("nil",[])])])]));
add (CProp
("equal",
- [CProp ("quotient",[CProp ("times",[CVar 24; CVar 23]); CVar 24]);
+ [CProp ("quotient",[CProp ("times",[CVar 24; CVar 23]); CVar 24]);
CProp
("if",
- [CProp ("zerop",[CVar 24]); CProp ("zero",[]);
+ [CProp ("zerop",[CVar 24]); CProp ("zero",[]);
CProp ("fix",[CVar 23])])]));
add (CProp
("equal",
- [CProp ("get",[CVar 9; CProp ("set",[CVar 8; CVar 21; CVar 12])]);
+ [CProp ("get",[CVar 9; CProp ("set",[CVar 8; CVar 21; CVar 12])]);
CProp
("if",
- [CProp ("eqp",[CVar 9; CVar 8]); CVar 21;
+ [CProp ("eqp",[CVar 9; CVar 8]); CVar 21;
CProp ("get",[CVar 9; CVar 12])])]))
(* Tautology checker *)
end
-let tautp x =
+let tautp x =
(* print_term x; print_string"\n"; *)
let y = rewrite x in
(* print_term y; print_string "\n"; *)
(* *)
(***********************************************************************)
-(* $Id: fib.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: fib.ml 12800 2012-07-30 18:59:07Z doligez $ *)
let rec fib n =
if n < 2 then 1 else fib(n-1) + fib(n-2)
let _ =
let n =
- if Array.length Sys.argv >= 2
+ if Array.length Sys.argv >= 2
then int_of_string Sys.argv.(1)
else 40 in
print_int(fib n); print_newline(); exit 0
-
(* *)
(***********************************************************************)
-(* $Id: nucleic.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: nucleic.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* Use floating-point arithmetic *)
matrices don't have the perspective terms and are the transpose of
Paul's one. See also "M\"antyl\"a, M. (1985) An Introduction to
Solid Modeling, Computer Science Press" Appendix A.
-
+
The components of a transformation matrix are named like this:
-
+
a b c
d e f
g h i
tx ty tz
-
+
The components tx, ty, and tz are the translation vector.
*)
(*
Numbering of atoms follows the paper:
-
+
IUPAC-IUB Joint Commission on Biochemical Nomenclature (JCBN)
(1983) Abbreviations and Symbols for the Description of
Conformations of Polynucleotide Chains. Eur. J. Biochem 131,
= c1'
let
-nuc_C2
+nuc_C2
(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
= c3'
let
-nuc_C4
+nuc_C4
(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
= c4'
let
-nuc_N1
+nuc_N1
(N(dgf_base_tfo,p_o3'_275_tfo,p_o3'_180_tfo,p_o3'_60_tfo,
p,o1p,o2p,o5',c5',h5',h5'',c4',h4',o4',c1',h1',c2',h2'',o2',h2',
c3',h3',o3',n1,n3,c2,c4,c5,c6,_))
(* -- DOMAINS ---------------------------------------------------------------*)
(* Primary structure: strand A CUGCCACGUCUG, strand B CAGACGUGGCAG
-
+
Secondary structure: strand A CUGCCACGUCUG
||||||||||||
GACGGUGCAGAC strand B
-
+
Tertiary structure:
-
+
5' end of strand A C1----G12 3' end of strand B
U2-------A11
G3-------C10
G3--------C10
A2-------U11
5' end of strand B C1----G12 3' end of strand A
-
+
"helix", "stacked" and "connected" describe the spatial relationship
between two consecutive nucleotides. E.g. the nucleotides C1 and U2
from the strand A.
-
+
"wc" (stands for Watson-Crick and is a type of base-pairing),
- and "wc-dumas" describe the spatial relationship between
+ and "wc-dumas" describe the spatial relationship between
nucleotides from two chains that are growing in opposite directions.
E.g. the nucleotides C1 from strand A and G12 from strand B.
*)
reference n i partial_inst = [ mk_var i tfo_id n ]
(* The transformation matrix for wc is from:
-
+
Chandrasekaran R. et al (1989) A Re-Examination of the Crystal
Structure of A-DNA Using Fiber Diffraction Data. J. Biomol.
Struct. & Dynamics 6(6):1189-1202.
a38_g37 nucl i j partial_inst
= mk_var i (dgf_base a38_g37_tfo (get_var j partial_inst) nucl) nucl
-let
+let
stacked3' nucl i j partial_inst
= (a38_g37 nucl i j partial_inst) :: (helix3' nucl i j partial_inst)
stacked5' rU 5 4; (* | 4.5 Angstroms *)
stacked5' rC 6 5 (* <-' *)
]
-
+
(* Pseudoknot constraint *)
let
let max_dist = ref 0.0 in
for i = 0 to pred (Array.length atoms) do
let p = atoms.(i) in
- let distance =
+ let distance =
let pos = absolute_pos v p
in sqrt ((pos.x * pos.x) + (pos.y * pos.y) + (pos.z * pos.z)) in
if distance > !max_dist then max_dist := distance
(* *)
(***********************************************************************)
-(* $Id: sieve.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: sieve.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* Eratosthene's sieve *)
let _ =
- do_list (fun n -> print_int n; print_string " ") (sieve 50000);
+ do_list (fun n -> print_string " "; print_int n) (sieve 50000);
print_newline();
exit 0
-2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499 503 509 521 523 541 547 557 563 569 571 577 587 593 599 601 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691 701 709 719 727 733 739 743 751 757 761 769 773 787 797 809 811 821 823 827 829 839 853 857 859 863 877 881 883 887 907 911 919 929 937 941 947 953 967 971 977 983 991 997 1009 1013 1019 1021 1031 1033 1039 1049 1051 1061 1063 1069 1087 1091 1093 1097 1103 1109 1117 1123 1129 1151 1153 1163 1171 1181 1187 1193 1201 1213 1217 1223 1229 1231 1237 1249 1259 1277 1279 1283 1289 1291 1297 1301 1303 1307 1319 1321 1327 1361 1367 1373 1381 1399 1409 1423 1427 1429 1433 1439 1447 1451 1453 1459 1471 1481 1483 1487 1489 1493 1499 1511 1523 1531 1543 1549 1553 1559 1567 1571 1579 1583 1597 1601 1607 1609 1613 1619 1621 1627 1637 1657 1663 1667 1669 1693 1697 1699 1709 1721 1723 1733 1741 1747 1753 1759 1777 1783 1787 1789 1801 1811 1823 1831 1847 1861 1867 1871 1873 1877 1879 1889 1901 1907 1913 1931 1933 1949 1951 1973 1979 1987 1993 1997 1999 2003 2011 2017 2027 2029 2039 2053 2063 2069 2081 2083 2087 2089 2099 2111 2113 2129 2131 2137 2141 2143 2153 2161 2179 2203 2207 2213 2221 2237 2239 2243 2251 2267 2269 2273 2281 2287 2293 2297 2309 2311 2333 2339 2341 2347 2351 2357 2371 2377 2381 2383 2389 2393 2399 2411 2417 2423 2437 2441 2447 2459 2467 2473 2477 2503 2521 2531 2539 2543 2549 2551 2557 2579 2591 2593 2609 2617 2621 2633 2647 2657 2659 2663 2671 2677 2683 2687 2689 2693 2699 2707 2711 2713 2719 2729 2731 2741 2749 2753 2767 2777 2789 2791 2797 2801 2803 2819 2833 2837 2843 2851 2857 2861 2879 2887 2897 2903 2909 2917 2927 2939 2953 2957 2963 2969 2971 2999 3001 3011 3019 3023 3037 3041 3049 3061 3067 3079 3083 3089 3109 3119 3121 3137 3163 3167 3169 3181 3187 3191 3203 3209 3217 3221 3229 3251 3253 3257 3259 3271 3299 3301 3307 3313 3319 3323 3329 3331 3343 3347 3359 3361 3371 3373 3389 3391 3407 3413 3433 3449 3457 3461 3463 3467 3469 3491 3499 3511 3517 3527 3529 3533 3539 3541 3547 3557 3559 3571 3581 3583 3593 3607 3613 3617 3623 3631 3637 3643 3659 3671 3673 3677 3691 3697 3701 3709 3719 3727 3733 3739 3761 3767 3769 3779 3793 3797 3803 3821 3823 3833 3847 3851 3853 3863 3877 3881 3889 3907 3911 3917 3919 3923 3929 3931 3943 3947 3967 3989 4001 4003 4007 4013 4019 4021 4027 4049 4051 4057 4073 4079 4091 4093 4099 4111 4127 4129 4133 4139 4153 4157 4159 4177 4201 4211 4217 4219 4229 4231 4241 4243 4253 4259 4261 4271 4273 4283 4289 4297 4327 4337 4339 4349 4357 4363 4373 4391 4397 4409 4421 4423 4441 4447 4451 4457 4463 4481 4483 4493 4507 4513 4517 4519 4523 4547 4549 4561 4567 4583 4591 4597 4603 4621 4637 4639 4643 4649 4651 4657 4663 4673 4679 4691 4703 4721 4723 4729 4733 4751 4759 4783 4787 4789 4793 4799 4801 4813 4817 4831 4861 4871 4877 4889 4903 4909 4919 4931 4933 4937 4943 4951 4957 4967 4969 4973 4987 4993 4999 5003 5009 5011 5021 5023 5039 5051 5059 5077 5081 5087 5099 5101 5107 5113 5119 5147 5153 5167 5171 5179 5189 5197 5209 5227 5231 5233 5237 5261 5273 5279 5281 5297 5303 5309 5323 5333 5347 5351 5381 5387 5393 5399 5407 5413 5417 5419 5431 5437 5441 5443 5449 5471 5477 5479 5483 5501 5503 5507 5519 5521 5527 5531 5557 5563 5569 5573 5581 5591 5623 5639 5641 5647 5651 5653 5657 5659 5669 5683 5689 5693 5701 5711 5717 5737 5741 5743 5749 5779 5783 5791 5801 5807 5813 5821 5827 5839 5843 5849 5851 5857 5861 5867 5869 5879 5881 5897 5903 5923 5927 5939 5953 5981 5987 6007 6011 6029 6037 6043 6047 6053 6067 6073 6079 6089 6091 6101 6113 6121 6131 6133 6143 6151 6163 6173 6197 6199 6203 6211 6217 6221 6229 6247 6257 6263 6269 6271 6277 6287 6299 6301 6311 6317 6323 6329 6337 6343 6353 6359 6361 6367 6373 6379 6389 6397 6421 6427 6449 6451 6469 6473 6481 6491 6521 6529 6547 6551 6553 6563 6569 6571 6577 6581 6599 6607 6619 6637 6653 6659 6661 6673 6679 6689 6691 6701 6703 6709 6719 6733 6737 6761 6763 6779 6781 6791 6793 6803 6823 6827 6829 6833 6841 6857 6863 6869 6871 6883 6899 6907 6911 6917 6947 6949 6959 6961 6967 6971 6977 6983 6991 6997 7001 7013 7019 7027 7039 7043 7057 7069 7079 7103 7109 7121 7127 7129 7151 7159 7177 7187 7193 7207 7211 7213 7219 7229 7237 7243 7247 7253 7283 7297 7307 7309 7321 7331 7333 7349 7351 7369 7393 7411 7417 7433 7451 7457 7459 7477 7481 7487 7489 7499 7507 7517 7523 7529 7537 7541 7547 7549 7559 7561 7573 7577 7583 7589 7591 7603 7607 7621 7639 7643 7649 7669 7673 7681 7687 7691 7699 7703 7717 7723 7727 7741 7753 7757 7759 7789 7793 7817 7823 7829 7841 7853 7867 7873 7877 7879 7883 7901 7907 7919 7927 7933 7937 7949 7951 7963 7993 8009 8011 8017 8039 8053 8059 8069 8081 8087 8089 8093 8101 8111 8117 8123 8147 8161 8167 8171 8179 8191 8209 8219 8221 8231 8233 8237 8243 8263 8269 8273 8287 8291 8293 8297 8311 8317 8329 8353 8363 8369 8377 8387 8389 8419 8423 8429 8431 8443 8447 8461 8467 8501 8513 8521 8527 8537 8539 8543 8563 8573 8581 8597 8599 8609 8623 8627 8629 8641 8647 8663 8669 8677 8681 8689 8693 8699 8707 8713 8719 8731 8737 8741 8747 8753 8761 8779 8783 8803 8807 8819 8821 8831 8837 8839 8849 8861 8863 8867 8887 8893 8923 8929 8933 8941 8951 8963 8969 8971 8999 9001 9007 9011 9013 9029 9041 9043 9049 9059 9067 9091 9103 9109 9127 9133 9137 9151 9157 9161 9173 9181 9187 9199 9203 9209 9221 9227 9239 9241 9257 9277 9281 9283 9293 9311 9319 9323 9337 9341 9343 9349 9371 9377 9391 9397 9403 9413 9419 9421 9431 9433 9437 9439 9461 9463 9467 9473 9479 9491 9497 9511 9521 9533 9539 9547 9551 9587 9601 9613 9619 9623 9629 9631 9643 9649 9661 9677 9679 9689 9697 9719 9721 9733 9739 9743 9749 9767 9769 9781 9787 9791 9803 9811 9817 9829 9833 9839 9851 9857 9859 9871 9883 9887 9901 9907 9923 9929 9931 9941 9949 9967 9973 10007 10009 10037 10039 10061 10067 10069 10079 10091 10093 10099 10103 10111 10133 10139 10141 10151 10159 10163 10169 10177 10181 10193 10211 10223 10243 10247 10253 10259 10267 10271 10273 10289 10301 10303 10313 10321 10331 10333 10337 10343 10357 10369 10391 10399 10427 10429 10433 10453 10457 10459 10463 10477 10487 10499 10501 10513 10529 10531 10559 10567 10589 10597 10601 10607 10613 10627 10631 10639 10651 10657 10663 10667 10687 10691 10709 10711 10723 10729 10733 10739 10753 10771 10781 10789 10799 10831 10837 10847 10853 10859 10861 10867 10883 10889 10891 10903 10909 10937 10939 10949 10957 10973 10979 10987 10993 11003 11027 11047 11057 11059 11069 11071 11083 11087 11093 11113 11117 11119 11131 11149 11159 11161 11171 11173 11177 11197 11213 11239 11243 11251 11257 11261 11273 11279 11287 11299 11311 11317 11321 11329 11351 11353 11369 11383 11393 11399 11411 11423 11437 11443 11447 11467 11471 11483 11489 11491 11497 11503 11519 11527 11549 11551 11579 11587 11593 11597 11617 11621 11633 11657 11677 11681 11689 11699 11701 11717 11719 11731 11743 11777 11779 11783 11789 11801 11807 11813 11821 11827 11831 11833 11839 11863 11867 11887 11897 11903 11909 11923 11927 11933 11939 11941 11953 11959 11969 11971 11981 11987 12007 12011 12037 12041 12043 12049 12071 12073 12097 12101 12107 12109 12113 12119 12143 12149 12157 12161 12163 12197 12203 12211 12227 12239 12241 12251 12253 12263 12269 12277 12281 12289 12301 12323 12329 12343 12347 12373 12377 12379 12391 12401 12409 12413 12421 12433 12437 12451 12457 12473 12479 12487 12491 12497 12503 12511 12517 12527 12539 12541 12547 12553 12569 12577 12583 12589 12601 12611 12613 12619 12637 12641 12647 12653 12659 12671 12689 12697 12703 12713 12721 12739 12743 12757 12763 12781 12791 12799 12809 12821 12823 12829 12841 12853 12889 12893 12899 12907 12911 12917 12919 12923 12941 12953 12959 12967 12973 12979 12983 13001 13003 13007 13009 13033 13037 13043 13049 13063 13093 13099 13103 13109 13121 13127 13147 13151 13159 13163 13171 13177 13183 13187 13217 13219 13229 13241 13249 13259 13267 13291 13297 13309 13313 13327 13331 13337 13339 13367 13381 13397 13399 13411 13417 13421 13441 13451 13457 13463 13469 13477 13487 13499 13513 13523 13537 13553 13567 13577 13591 13597 13613 13619 13627 13633 13649 13669 13679 13681 13687 13691 13693 13697 13709 13711 13721 13723 13729 13751 13757 13759 13763 13781 13789 13799 13807 13829 13831 13841 13859 13873 13877 13879 13883 13901 13903 13907 13913 13921 13931 13933 13963 13967 13997 13999 14009 14011 14029 14033 14051 14057 14071 14081 14083 14087 14107 14143 14149 14153 14159 14173 14177 14197 14207 14221 14243 14249 14251 14281 14293 14303 14321 14323 14327 14341 14347 14369 14387 14389 14401 14407 14411 14419 14423 14431 14437 14447 14449 14461 14479 14489 14503 14519 14533 14537 14543 14549 14551 14557 14561 14563 14591 14593 14621 14627 14629 14633 14639 14653 14657 14669 14683 14699 14713 14717 14723 14731 14737 14741 14747 14753 14759 14767 14771 14779 14783 14797 14813 14821 14827 14831 14843 14851 14867 14869 14879 14887 14891 14897 14923 14929 14939 14947 14951 14957 14969 14983 15013 15017 15031 15053 15061 15073 15077 15083 15091 15101 15107 15121 15131 15137 15139 15149 15161 15173 15187 15193 15199 15217 15227 15233 15241 15259 15263 15269 15271 15277 15287 15289 15299 15307 15313 15319 15329 15331 15349 15359 15361 15373 15377 15383 15391 15401 15413 15427 15439 15443 15451 15461 15467 15473 15493 15497 15511 15527 15541 15551 15559 15569 15581 15583 15601 15607 15619 15629 15641 15643 15647 15649 15661 15667 15671 15679 15683 15727 15731 15733 15737 15739 15749 15761 15767 15773 15787 15791 15797 15803 15809 15817 15823 15859 15877 15881 15887 15889 15901 15907 15913 15919 15923 15937 15959 15971 15973 15991 16001 16007 16033 16057 16061 16063 16067 16069 16073 16087 16091 16097 16103 16111 16127 16139 16141 16183 16187 16189 16193 16217 16223 16229 16231 16249 16253 16267 16273 16301 16319 16333 16339 16349 16361 16363 16369 16381 16411 16417 16421 16427 16433 16447 16451 16453 16477 16481 16487 16493 16519 16529 16547 16553 16561 16567 16573 16603 16607 16619 16631 16633 16649 16651 16657 16661 16673 16691 16693 16699 16703 16729 16741 16747 16759 16763 16787 16811 16823 16829 16831 16843 16871 16879 16883 16889 16901 16903 16921 16927 16931 16937 16943 16963 16979 16981 16987 16993 17011 17021 17027 17029 17033 17041 17047 17053 17077 17093 17099 17107 17117 17123 17137 17159 17167 17183 17189 17191 17203 17207 17209 17231 17239 17257 17291 17293 17299 17317 17321 17327 17333 17341 17351 17359 17377 17383 17387 17389 17393 17401 17417 17419 17431 17443 17449 17467 17471 17477 17483 17489 17491 17497 17509 17519 17539 17551 17569 17573 17579 17581 17597 17599 17609 17623 17627 17657 17659 17669 17681 17683 17707 17713 17729 17737 17747 17749 17761 17783 17789 17791 17807 17827 17837 17839 17851 17863 17881 17891 17903 17909 17911 17921 17923 17929 17939 17957 17959 17971 17977 17981 17987 17989 18013 18041 18043 18047 18049 18059 18061 18077 18089 18097 18119 18121 18127 18131 18133 18143 18149 18169 18181 18191 18199 18211 18217 18223 18229 18233 18251 18253 18257 18269 18287 18289 18301 18307 18311 18313 18329 18341 18353 18367 18371 18379 18397 18401 18413 18427 18433 18439 18443 18451 18457 18461 18481 18493 18503 18517 18521 18523 18539 18541 18553 18583 18587 18593 18617 18637 18661 18671 18679 18691 18701 18713 18719 18731 18743 18749 18757 18773 18787 18793 18797 18803 18839 18859 18869 18899 18911 18913 18917 18919 18947 18959 18973 18979 19001 19009 19013 19031 19037 19051 19069 19073 19079 19081 19087 19121 19139 19141 19157 19163 19181 19183 19207 19211 19213 19219 19231 19237 19249 19259 19267 19273 19289 19301 19309 19319 19333 19373 19379 19381 19387 19391 19403 19417 19421 19423 19427 19429 19433 19441 19447 19457 19463 19469 19471 19477 19483 19489 19501 19507 19531 19541 19543 19553 19559 19571 19577 19583 19597 19603 19609 19661 19681 19687 19697 19699 19709 19717 19727 19739 19751 19753 19759 19763 19777 19793 19801 19813 19819 19841 19843 19853 19861 19867 19889 19891 19913 19919 19927 19937 19949 19961 19963 19973 19979 19991 19993 19997 20011 20021 20023 20029 20047 20051 20063 20071 20089 20101 20107 20113 20117 20123 20129 20143 20147 20149 20161 20173 20177 20183 20201 20219 20231 20233 20249 20261 20269 20287 20297 20323 20327 20333 20341 20347 20353 20357 20359 20369 20389 20393 20399 20407 20411 20431 20441 20443 20477 20479 20483 20507 20509 20521 20533 20543 20549 20551 20563 20593 20599 20611 20627 20639 20641 20663 20681 20693 20707 20717 20719 20731 20743 20747 20749 20753 20759 20771 20773 20789 20807 20809 20849 20857 20873 20879 20887 20897 20899 20903 20921 20929 20939 20947 20959 20963 20981 20983 21001 21011 21013 21017 21019 21023 21031 21059 21061 21067 21089 21101 21107 21121 21139 21143 21149 21157 21163 21169 21179 21187 21191 21193 21211 21221 21227 21247 21269 21277 21283 21313 21317 21319 21323 21341 21347 21377 21379 21383 21391 21397 21401 21407 21419 21433 21467 21481 21487 21491 21493 21499 21503 21517 21521 21523 21529 21557 21559 21563 21569 21577 21587 21589 21599 21601 21611 21613 21617 21647 21649 21661 21673 21683 21701 21713 21727 21737 21739 21751 21757 21767 21773 21787 21799 21803 21817 21821 21839 21841 21851 21859 21863 21871 21881 21893 21911 21929 21937 21943 21961 21977 21991 21997 22003 22013 22027 22031 22037 22039 22051 22063 22067 22073 22079 22091 22093 22109 22111 22123 22129 22133 22147 22153 22157 22159 22171 22189 22193 22229 22247 22259 22271 22273 22277 22279 22283 22291 22303 22307 22343 22349 22367 22369 22381 22391 22397 22409 22433 22441 22447 22453 22469 22481 22483 22501 22511 22531 22541 22543 22549 22567 22571 22573 22613 22619 22621 22637 22639 22643 22651 22669 22679 22691 22697 22699 22709 22717 22721 22727 22739 22741 22751 22769 22777 22783 22787 22807 22811 22817 22853 22859 22861 22871 22877 22901 22907 22921 22937 22943 22961 22963 22973 22993 23003 23011 23017 23021 23027 23029 23039 23041 23053 23057 23059 23063 23071 23081 23087 23099 23117 23131 23143 23159 23167 23173 23189 23197 23201 23203 23209 23227 23251 23269 23279 23291 23293 23297 23311 23321 23327 23333 23339 23357 23369 23371 23399 23417 23431 23447 23459 23473 23497 23509 23531 23537 23539 23549 23557 23561 23563 23567 23581 23593 23599 23603 23609 23623 23627 23629 23633 23663 23669 23671 23677 23687 23689 23719 23741 23743 23747 23753 23761 23767 23773 23789 23801 23813 23819 23827 23831 23833 23857 23869 23873 23879 23887 23893 23899 23909 23911 23917 23929 23957 23971 23977 23981 23993 24001 24007 24019 24023 24029 24043 24049 24061 24071 24077 24083 24091 24097 24103 24107 24109 24113 24121 24133 24137 24151 24169 24179 24181 24197 24203 24223 24229 24239 24247 24251 24281 24317 24329 24337 24359 24371 24373 24379 24391 24407 24413 24419 24421 24439 24443 24469 24473 24481 24499 24509 24517 24527 24533 24547 24551 24571 24593 24611 24623 24631 24659 24671 24677 24683 24691 24697 24709 24733 24749 24763 24767 24781 24793 24799 24809 24821 24841 24847 24851 24859 24877 24889 24907 24917 24919 24923 24943 24953 24967 24971 24977 24979 24989 25013 25031 25033 25037 25057 25073 25087 25097 25111 25117 25121 25127 25147 25153 25163 25169 25171 25183 25189 25219 25229 25237 25243 25247 25253 25261 25301 25303 25307 25309 25321 25339 25343 25349 25357 25367 25373 25391 25409 25411 25423 25439 25447 25453 25457 25463 25469 25471 25523 25537 25541 25561 25577 25579 25583 25589 25601 25603 25609 25621 25633 25639 25643 25657 25667 25673 25679 25693 25703 25717 25733 25741 25747 25759 25763 25771 25793 25799 25801 25819 25841 25847 25849 25867 25873 25889 25903 25913 25919 25931 25933 25939 25943 25951 25969 25981 25997 25999 26003 26017 26021 26029 26041 26053 26083 26099 26107 26111 26113 26119 26141 26153 26161 26171 26177 26183 26189 26203 26209 26227 26237 26249 26251 26261 26263 26267 26293 26297 26309 26317 26321 26339 26347 26357 26371 26387 26393 26399 26407 26417 26423 26431 26437 26449 26459 26479 26489 26497 26501 26513 26539 26557 26561 26573 26591 26597 26627 26633 26641 26647 26669 26681 26683 26687 26693 26699 26701 26711 26713 26717 26723 26729 26731 26737 26759 26777 26783 26801 26813 26821 26833 26839 26849 26861 26863 26879 26881 26891 26893 26903 26921 26927 26947 26951 26953 26959 26981 26987 26993 27011 27017 27031 27043 27059 27061 27067 27073 27077 27091 27103 27107 27109 27127 27143 27179 27191 27197 27211 27239 27241 27253 27259 27271 27277 27281 27283 27299 27329 27337 27361 27367 27397 27407 27409 27427 27431 27437 27449 27457 27479 27481 27487 27509 27527 27529 27539 27541 27551 27581 27583 27611 27617 27631 27647 27653 27673 27689 27691 27697 27701 27733 27737 27739 27743 27749 27751 27763 27767 27773 27779 27791 27793 27799 27803 27809 27817 27823 27827 27847 27851 27883 27893 27901 27917 27919 27941 27943 27947 27953 27961 27967 27983 27997 28001 28019 28027 28031 28051 28057 28069 28081 28087 28097 28099 28109 28111 28123 28151 28163 28181 28183 28201 28211 28219 28229 28277 28279 28283 28289 28297 28307 28309 28319 28349 28351 28387 28393 28403 28409 28411 28429 28433 28439 28447 28463 28477 28493 28499 28513 28517 28537 28541 28547 28549 28559 28571 28573 28579 28591 28597 28603 28607 28619 28621 28627 28631 28643 28649 28657 28661 28663 28669 28687 28697 28703 28711 28723 28729 28751 28753 28759 28771 28789 28793 28807 28813 28817 28837 28843 28859 28867 28871 28879 28901 28909 28921 28927 28933 28949 28961 28979 29009 29017 29021 29023 29027 29033 29059 29063 29077 29101 29123 29129 29131 29137 29147 29153 29167 29173 29179 29191 29201 29207 29209 29221 29231 29243 29251 29269 29287 29297 29303 29311 29327 29333 29339 29347 29363 29383 29387 29389 29399 29401 29411 29423 29429 29437 29443 29453 29473 29483 29501 29527 29531 29537 29567 29569 29573 29581 29587 29599 29611 29629 29633 29641 29663 29669 29671 29683 29717 29723 29741 29753 29759 29761 29789 29803 29819 29833 29837 29851 29863 29867 29873 29879 29881 29917 29921 29927 29947 29959 29983 29989 30011 30013 30029 30047 30059 30071 30089 30091 30097 30103 30109 30113 30119 30133 30137 30139 30161 30169 30181 30187 30197 30203 30211 30223 30241 30253 30259 30269 30271 30293 30307 30313 30319 30323 30341 30347 30367 30389 30391 30403 30427 30431 30449 30467 30469 30491 30493 30497 30509 30517 30529 30539 30553 30557 30559 30577 30593 30631 30637 30643 30649 30661 30671 30677 30689 30697 30703 30707 30713 30727 30757 30763 30773 30781 30803 30809 30817 30829 30839 30841 30851 30853 30859 30869 30871 30881 30893 30911 30931 30937 30941 30949 30971 30977 30983 31013 31019 31033 31039 31051 31063 31069 31079 31081 31091 31121 31123 31139 31147 31151 31153 31159 31177 31181 31183 31189 31193 31219 31223 31231 31237 31247 31249 31253 31259 31267 31271 31277 31307 31319 31321 31327 31333 31337 31357 31379 31387 31391 31393 31397 31469 31477 31481 31489 31511 31513 31517 31531 31541 31543 31547 31567 31573 31583 31601 31607 31627 31643 31649 31657 31663 31667 31687 31699 31721 31723 31727 31729 31741 31751 31769 31771 31793 31799 31817 31847 31849 31859 31873 31883 31891 31907 31957 31963 31973 31981 31991 32003 32009 32027 32029 32051 32057 32059 32063 32069 32077 32083 32089 32099 32117 32119 32141 32143 32159 32173 32183 32189 32191 32203 32213 32233 32237 32251 32257 32261 32297 32299 32303 32309 32321 32323 32327 32341 32353 32359 32363 32369 32371 32377 32381 32401 32411 32413 32423 32429 32441 32443 32467 32479 32491 32497 32503 32507 32531 32533 32537 32561 32563 32569 32573 32579 32587 32603 32609 32611 32621 32633 32647 32653 32687 32693 32707 32713 32717 32719 32749 32771 32779 32783 32789 32797 32801 32803 32831 32833 32839 32843 32869 32887 32909 32911 32917 32933 32939 32941 32957 32969 32971 32983 32987 32993 32999 33013 33023 33029 33037 33049 33053 33071 33073 33083 33091 33107 33113 33119 33149 33151 33161 33179 33181 33191 33199 33203 33211 33223 33247 33287 33289 33301 33311 33317 33329 33331 33343 33347 33349 33353 33359 33377 33391 33403 33409 33413 33427 33457 33461 33469 33479 33487 33493 33503 33521 33529 33533 33547 33563 33569 33577 33581 33587 33589 33599 33601 33613 33617 33619 33623 33629 33637 33641 33647 33679 33703 33713 33721 33739 33749 33751 33757 33767 33769 33773 33791 33797 33809 33811 33827 33829 33851 33857 33863 33871 33889 33893 33911 33923 33931 33937 33941 33961 33967 33997 34019 34031 34033 34039 34057 34061 34123 34127 34129 34141 34147 34157 34159 34171 34183 34211 34213 34217 34231 34253 34259 34261 34267 34273 34283 34297 34301 34303 34313 34319 34327 34337 34351 34361 34367 34369 34381 34403 34421 34429 34439 34457 34469 34471 34483 34487 34499 34501 34511 34513 34519 34537 34543 34549 34583 34589 34591 34603 34607 34613 34631 34649 34651 34667 34673 34679 34687 34693 34703 34721 34729 34739 34747 34757 34759 34763 34781 34807 34819 34841 34843 34847 34849 34871 34877 34883 34897 34913 34919 34939 34949 34961 34963 34981 35023 35027 35051 35053 35059 35069 35081 35083 35089 35099 35107 35111 35117 35129 35141 35149 35153 35159 35171 35201 35221 35227 35251 35257 35267 35279 35281 35291 35311 35317 35323 35327 35339 35353 35363 35381 35393 35401 35407 35419 35423 35437 35447 35449 35461 35491 35507 35509 35521 35527 35531 35533 35537 35543 35569 35573 35591 35593 35597 35603 35617 35671 35677 35729 35731 35747 35753 35759 35771 35797 35801 35803 35809 35831 35837 35839 35851 35863 35869 35879 35897 35899 35911 35923 35933 35951 35963 35969 35977 35983 35993 35999 36007 36011 36013 36017 36037 36061 36067 36073 36083 36097 36107 36109 36131 36137 36151 36161 36187 36191 36209 36217 36229 36241 36251 36263 36269 36277 36293 36299 36307 36313 36319 36341 36343 36353 36373 36383 36389 36433 36451 36457 36467 36469 36473 36479 36493 36497 36523 36527 36529 36541 36551 36559 36563 36571 36583 36587 36599 36607 36629 36637 36643 36653 36671 36677 36683 36691 36697 36709 36713 36721 36739 36749 36761 36767 36779 36781 36787 36791 36793 36809 36821 36833 36847 36857 36871 36877 36887 36899 36901 36913 36919 36923 36929 36931 36943 36947 36973 36979 36997 37003 37013 37019 37021 37039 37049 37057 37061 37087 37097 37117 37123 37139 37159 37171 37181 37189 37199 37201 37217 37223 37243 37253 37273 37277 37307 37309 37313 37321 37337 37339 37357 37361 37363 37369 37379 37397 37409 37423 37441 37447 37463 37483 37489 37493 37501 37507 37511 37517 37529 37537 37547 37549 37561 37567 37571 37573 37579 37589 37591 37607 37619 37633 37643 37649 37657 37663 37691 37693 37699 37717 37747 37781 37783 37799 37811 37813 37831 37847 37853 37861 37871 37879 37889 37897 37907 37951 37957 37963 37967 37987 37991 37993 37997 38011 38039 38047 38053 38069 38083 38113 38119 38149 38153 38167 38177 38183 38189 38197 38201 38219 38231 38237 38239 38261 38273 38281 38287 38299 38303 38317 38321 38327 38329 38333 38351 38371 38377 38393 38431 38447 38449 38453 38459 38461 38501 38543 38557 38561 38567 38569 38593 38603 38609 38611 38629 38639 38651 38653 38669 38671 38677 38693 38699 38707 38711 38713 38723 38729 38737 38747 38749 38767 38783 38791 38803 38821 38833 38839 38851 38861 38867 38873 38891 38903 38917 38921 38923 38933 38953 38959 38971 38977 38993 39019 39023 39041 39043 39047 39079 39089 39097 39103 39107 39113 39119 39133 39139 39157 39161 39163 39181 39191 39199 39209 39217 39227 39229 39233 39239 39241 39251 39293 39301 39313 39317 39323 39341 39343 39359 39367 39371 39373 39383 39397 39409 39419 39439 39443 39451 39461 39499 39503 39509 39511 39521 39541 39551 39563 39569 39581 39607 39619 39623 39631 39659 39667 39671 39679 39703 39709 39719 39727 39733 39749 39761 39769 39779 39791 39799 39821 39827 39829 39839 39841 39847 39857 39863 39869 39877 39883 39887 39901 39929 39937 39953 39971 39979 39983 39989 40009 40013 40031 40037 40039 40063 40087 40093 40099 40111 40123 40127 40129 40151 40153 40163 40169 40177 40189 40193 40213 40231 40237 40241 40253 40277 40283 40289 40343 40351 40357 40361 40387 40423 40427 40429 40433 40459 40471 40483 40487 40493 40499 40507 40519 40529 40531 40543 40559 40577 40583 40591 40597 40609 40627 40637 40639 40693 40697 40699 40709 40739 40751 40759 40763 40771 40787 40801 40813 40819 40823 40829 40841 40847 40849 40853 40867 40879 40883 40897 40903 40927 40933 40939 40949 40961 40973 40993 41011 41017 41023 41039 41047 41051 41057 41077 41081 41113 41117 41131 41141 41143 41149 41161 41177 41179 41183 41189 41201 41203 41213 41221 41227 41231 41233 41243 41257 41263 41269 41281 41299 41333 41341 41351 41357 41381 41387 41389 41399 41411 41413 41443 41453 41467 41479 41491 41507 41513 41519 41521 41539 41543 41549 41579 41593 41597 41603 41609 41611 41617 41621 41627 41641 41647 41651 41659 41669 41681 41687 41719 41729 41737 41759 41761 41771 41777 41801 41809 41813 41843 41849 41851 41863 41879 41887 41893 41897 41903 41911 41927 41941 41947 41953 41957 41959 41969 41981 41983 41999 42013 42017 42019 42023 42043 42061 42071 42073 42083 42089 42101 42131 42139 42157 42169 42179 42181 42187 42193 42197 42209 42221 42223 42227 42239 42257 42281 42283 42293 42299 42307 42323 42331 42337 42349 42359 42373 42379 42391 42397 42403 42407 42409 42433 42437 42443 42451 42457 42461 42463 42467 42473 42487 42491 42499 42509 42533 42557 42569 42571 42577 42589 42611 42641 42643 42649 42667 42677 42683 42689 42697 42701 42703 42709 42719 42727 42737 42743 42751 42767 42773 42787 42793 42797 42821 42829 42839 42841 42853 42859 42863 42899 42901 42923 42929 42937 42943 42953 42961 42967 42979 42989 43003 43013 43019 43037 43049 43051 43063 43067 43093 43103 43117 43133 43151 43159 43177 43189 43201 43207 43223 43237 43261 43271 43283 43291 43313 43319 43321 43331 43391 43397 43399 43403 43411 43427 43441 43451 43457 43481 43487 43499 43517 43541 43543 43573 43577 43579 43591 43597 43607 43609 43613 43627 43633 43649 43651 43661 43669 43691 43711 43717 43721 43753 43759 43777 43781 43783 43787 43789 43793 43801 43853 43867 43889 43891 43913 43933 43943 43951 43961 43963 43969 43973 43987 43991 43997 44017 44021 44027 44029 44041 44053 44059 44071 44087 44089 44101 44111 44119 44123 44129 44131 44159 44171 44179 44189 44201 44203 44207 44221 44249 44257 44263 44267 44269 44273 44279 44281 44293 44351 44357 44371 44381 44383 44389 44417 44449 44453 44483 44491 44497 44501 44507 44519 44531 44533 44537 44543 44549 44563 44579 44587 44617 44621 44623 44633 44641 44647 44651 44657 44683 44687 44699 44701 44711 44729 44741 44753 44771 44773 44777 44789 44797 44809 44819 44839 44843 44851 44867 44879 44887 44893 44909 44917 44927 44939 44953 44959 44963 44971 44983 44987 45007 45013 45053 45061 45077 45083 45119 45121 45127 45131 45137 45139 45161 45179 45181 45191 45197 45233 45247 45259 45263 45281 45289 45293 45307 45317 45319 45329 45337 45341 45343 45361 45377 45389 45403 45413 45427 45433 45439 45481 45491 45497 45503 45523 45533 45541 45553 45557 45569 45587 45589 45599 45613 45631 45641 45659 45667 45673 45677 45691 45697 45707 45737 45751 45757 45763 45767 45779 45817 45821 45823 45827 45833 45841 45853 45863 45869 45887 45893 45943 45949 45953 45959 45971 45979 45989 46021 46027 46049 46051 46061 46073 46091 46093 46099 46103 46133 46141 46147 46153 46171 46181 46183 46187 46199 46219 46229 46237 46261 46271 46273 46279 46301 46307 46309 46327 46337 46349 46351 46381 46399 46411 46439 46441 46447 46451 46457 46471 46477 46489 46499 46507 46511 46523 46549 46559 46567 46573 46589 46591 46601 46619 46633 46639 46643 46649 46663 46679 46681 46687 46691 46703 46723 46727 46747 46751 46757 46769 46771 46807 46811 46817 46819 46829 46831 46853 46861 46867 46877 46889 46901 46919 46933 46957 46993 46997 47017 47041 47051 47057 47059 47087 47093 47111 47119 47123 47129 47137 47143 47147 47149 47161 47189 47207 47221 47237 47251 47269 47279 47287 47293 47297 47303 47309 47317 47339 47351 47353 47363 47381 47387 47389 47407 47417 47419 47431 47441 47459 47491 47497 47501 47507 47513 47521 47527 47533 47543 47563 47569 47581 47591 47599 47609 47623 47629 47639 47653 47657 47659 47681 47699 47701 47711 47713 47717 47737 47741 47743 47777 47779 47791 47797 47807 47809 47819 47837 47843 47857 47869 47881 47903 47911 47917 47933 47939 47947 47951 47963 47969 47977 47981 48017 48023 48029 48049 48073 48079 48091 48109 48119 48121 48131 48157 48163 48179 48187 48193 48197 48221 48239 48247 48259 48271 48281 48299 48311 48313 48337 48341 48353 48371 48383 48397 48407 48409 48413 48437 48449 48463 48473 48479 48481 48487 48491 48497 48523 48527 48533 48539 48541 48563 48571 48589 48593 48611 48619 48623 48647 48649 48661 48673 48677 48679 48731 48733 48751 48757 48761 48767 48779 48781 48787 48799 48809 48817 48821 48823 48847 48857 48859 48869 48871 48883 48889 48907 48947 48953 48973 48989 48991 49003 49009 49019 49031 49033 49037 49043 49057 49069 49081 49103 49109 49117 49121 49123 49139 49157 49169 49171 49177 49193 49199 49201 49207 49211 49223 49253 49261 49277 49279 49297 49307 49331 49333 49339 49363 49367 49369 49391 49393 49409 49411 49417 49429 49433 49451 49459 49463 49477 49481 49499 49523 49529 49531 49537 49547 49549 49559 49597 49603 49613 49627 49633 49639 49663 49667 49669 49681 49697 49711 49727 49739 49741 49747 49757 49783 49787 49789 49801 49807 49811 49823 49831 49843 49853 49871 49877 49891 49919 49921 49927 49937 49939 49943 49957 49991 49993 49999
+ 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499 503 509 521 523 541 547 557 563 569 571 577 587 593 599 601 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691 701 709 719 727 733 739 743 751 757 761 769 773 787 797 809 811 821 823 827 829 839 853 857 859 863 877 881 883 887 907 911 919 929 937 941 947 953 967 971 977 983 991 997 1009 1013 1019 1021 1031 1033 1039 1049 1051 1061 1063 1069 1087 1091 1093 1097 1103 1109 1117 1123 1129 1151 1153 1163 1171 1181 1187 1193 1201 1213 1217 1223 1229 1231 1237 1249 1259 1277 1279 1283 1289 1291 1297 1301 1303 1307 1319 1321 1327 1361 1367 1373 1381 1399 1409 1423 1427 1429 1433 1439 1447 1451 1453 1459 1471 1481 1483 1487 1489 1493 1499 1511 1523 1531 1543 1549 1553 1559 1567 1571 1579 1583 1597 1601 1607 1609 1613 1619 1621 1627 1637 1657 1663 1667 1669 1693 1697 1699 1709 1721 1723 1733 1741 1747 1753 1759 1777 1783 1787 1789 1801 1811 1823 1831 1847 1861 1867 1871 1873 1877 1879 1889 1901 1907 1913 1931 1933 1949 1951 1973 1979 1987 1993 1997 1999 2003 2011 2017 2027 2029 2039 2053 2063 2069 2081 2083 2087 2089 2099 2111 2113 2129 2131 2137 2141 2143 2153 2161 2179 2203 2207 2213 2221 2237 2239 2243 2251 2267 2269 2273 2281 2287 2293 2297 2309 2311 2333 2339 2341 2347 2351 2357 2371 2377 2381 2383 2389 2393 2399 2411 2417 2423 2437 2441 2447 2459 2467 2473 2477 2503 2521 2531 2539 2543 2549 2551 2557 2579 2591 2593 2609 2617 2621 2633 2647 2657 2659 2663 2671 2677 2683 2687 2689 2693 2699 2707 2711 2713 2719 2729 2731 2741 2749 2753 2767 2777 2789 2791 2797 2801 2803 2819 2833 2837 2843 2851 2857 2861 2879 2887 2897 2903 2909 2917 2927 2939 2953 2957 2963 2969 2971 2999 3001 3011 3019 3023 3037 3041 3049 3061 3067 3079 3083 3089 3109 3119 3121 3137 3163 3167 3169 3181 3187 3191 3203 3209 3217 3221 3229 3251 3253 3257 3259 3271 3299 3301 3307 3313 3319 3323 3329 3331 3343 3347 3359 3361 3371 3373 3389 3391 3407 3413 3433 3449 3457 3461 3463 3467 3469 3491 3499 3511 3517 3527 3529 3533 3539 3541 3547 3557 3559 3571 3581 3583 3593 3607 3613 3617 3623 3631 3637 3643 3659 3671 3673 3677 3691 3697 3701 3709 3719 3727 3733 3739 3761 3767 3769 3779 3793 3797 3803 3821 3823 3833 3847 3851 3853 3863 3877 3881 3889 3907 3911 3917 3919 3923 3929 3931 3943 3947 3967 3989 4001 4003 4007 4013 4019 4021 4027 4049 4051 4057 4073 4079 4091 4093 4099 4111 4127 4129 4133 4139 4153 4157 4159 4177 4201 4211 4217 4219 4229 4231 4241 4243 4253 4259 4261 4271 4273 4283 4289 4297 4327 4337 4339 4349 4357 4363 4373 4391 4397 4409 4421 4423 4441 4447 4451 4457 4463 4481 4483 4493 4507 4513 4517 4519 4523 4547 4549 4561 4567 4583 4591 4597 4603 4621 4637 4639 4643 4649 4651 4657 4663 4673 4679 4691 4703 4721 4723 4729 4733 4751 4759 4783 4787 4789 4793 4799 4801 4813 4817 4831 4861 4871 4877 4889 4903 4909 4919 4931 4933 4937 4943 4951 4957 4967 4969 4973 4987 4993 4999 5003 5009 5011 5021 5023 5039 5051 5059 5077 5081 5087 5099 5101 5107 5113 5119 5147 5153 5167 5171 5179 5189 5197 5209 5227 5231 5233 5237 5261 5273 5279 5281 5297 5303 5309 5323 5333 5347 5351 5381 5387 5393 5399 5407 5413 5417 5419 5431 5437 5441 5443 5449 5471 5477 5479 5483 5501 5503 5507 5519 5521 5527 5531 5557 5563 5569 5573 5581 5591 5623 5639 5641 5647 5651 5653 5657 5659 5669 5683 5689 5693 5701 5711 5717 5737 5741 5743 5749 5779 5783 5791 5801 5807 5813 5821 5827 5839 5843 5849 5851 5857 5861 5867 5869 5879 5881 5897 5903 5923 5927 5939 5953 5981 5987 6007 6011 6029 6037 6043 6047 6053 6067 6073 6079 6089 6091 6101 6113 6121 6131 6133 6143 6151 6163 6173 6197 6199 6203 6211 6217 6221 6229 6247 6257 6263 6269 6271 6277 6287 6299 6301 6311 6317 6323 6329 6337 6343 6353 6359 6361 6367 6373 6379 6389 6397 6421 6427 6449 6451 6469 6473 6481 6491 6521 6529 6547 6551 6553 6563 6569 6571 6577 6581 6599 6607 6619 6637 6653 6659 6661 6673 6679 6689 6691 6701 6703 6709 6719 6733 6737 6761 6763 6779 6781 6791 6793 6803 6823 6827 6829 6833 6841 6857 6863 6869 6871 6883 6899 6907 6911 6917 6947 6949 6959 6961 6967 6971 6977 6983 6991 6997 7001 7013 7019 7027 7039 7043 7057 7069 7079 7103 7109 7121 7127 7129 7151 7159 7177 7187 7193 7207 7211 7213 7219 7229 7237 7243 7247 7253 7283 7297 7307 7309 7321 7331 7333 7349 7351 7369 7393 7411 7417 7433 7451 7457 7459 7477 7481 7487 7489 7499 7507 7517 7523 7529 7537 7541 7547 7549 7559 7561 7573 7577 7583 7589 7591 7603 7607 7621 7639 7643 7649 7669 7673 7681 7687 7691 7699 7703 7717 7723 7727 7741 7753 7757 7759 7789 7793 7817 7823 7829 7841 7853 7867 7873 7877 7879 7883 7901 7907 7919 7927 7933 7937 7949 7951 7963 7993 8009 8011 8017 8039 8053 8059 8069 8081 8087 8089 8093 8101 8111 8117 8123 8147 8161 8167 8171 8179 8191 8209 8219 8221 8231 8233 8237 8243 8263 8269 8273 8287 8291 8293 8297 8311 8317 8329 8353 8363 8369 8377 8387 8389 8419 8423 8429 8431 8443 8447 8461 8467 8501 8513 8521 8527 8537 8539 8543 8563 8573 8581 8597 8599 8609 8623 8627 8629 8641 8647 8663 8669 8677 8681 8689 8693 8699 8707 8713 8719 8731 8737 8741 8747 8753 8761 8779 8783 8803 8807 8819 8821 8831 8837 8839 8849 8861 8863 8867 8887 8893 8923 8929 8933 8941 8951 8963 8969 8971 8999 9001 9007 9011 9013 9029 9041 9043 9049 9059 9067 9091 9103 9109 9127 9133 9137 9151 9157 9161 9173 9181 9187 9199 9203 9209 9221 9227 9239 9241 9257 9277 9281 9283 9293 9311 9319 9323 9337 9341 9343 9349 9371 9377 9391 9397 9403 9413 9419 9421 9431 9433 9437 9439 9461 9463 9467 9473 9479 9491 9497 9511 9521 9533 9539 9547 9551 9587 9601 9613 9619 9623 9629 9631 9643 9649 9661 9677 9679 9689 9697 9719 9721 9733 9739 9743 9749 9767 9769 9781 9787 9791 9803 9811 9817 9829 9833 9839 9851 9857 9859 9871 9883 9887 9901 9907 9923 9929 9931 9941 9949 9967 9973 10007 10009 10037 10039 10061 10067 10069 10079 10091 10093 10099 10103 10111 10133 10139 10141 10151 10159 10163 10169 10177 10181 10193 10211 10223 10243 10247 10253 10259 10267 10271 10273 10289 10301 10303 10313 10321 10331 10333 10337 10343 10357 10369 10391 10399 10427 10429 10433 10453 10457 10459 10463 10477 10487 10499 10501 10513 10529 10531 10559 10567 10589 10597 10601 10607 10613 10627 10631 10639 10651 10657 10663 10667 10687 10691 10709 10711 10723 10729 10733 10739 10753 10771 10781 10789 10799 10831 10837 10847 10853 10859 10861 10867 10883 10889 10891 10903 10909 10937 10939 10949 10957 10973 10979 10987 10993 11003 11027 11047 11057 11059 11069 11071 11083 11087 11093 11113 11117 11119 11131 11149 11159 11161 11171 11173 11177 11197 11213 11239 11243 11251 11257 11261 11273 11279 11287 11299 11311 11317 11321 11329 11351 11353 11369 11383 11393 11399 11411 11423 11437 11443 11447 11467 11471 11483 11489 11491 11497 11503 11519 11527 11549 11551 11579 11587 11593 11597 11617 11621 11633 11657 11677 11681 11689 11699 11701 11717 11719 11731 11743 11777 11779 11783 11789 11801 11807 11813 11821 11827 11831 11833 11839 11863 11867 11887 11897 11903 11909 11923 11927 11933 11939 11941 11953 11959 11969 11971 11981 11987 12007 12011 12037 12041 12043 12049 12071 12073 12097 12101 12107 12109 12113 12119 12143 12149 12157 12161 12163 12197 12203 12211 12227 12239 12241 12251 12253 12263 12269 12277 12281 12289 12301 12323 12329 12343 12347 12373 12377 12379 12391 12401 12409 12413 12421 12433 12437 12451 12457 12473 12479 12487 12491 12497 12503 12511 12517 12527 12539 12541 12547 12553 12569 12577 12583 12589 12601 12611 12613 12619 12637 12641 12647 12653 12659 12671 12689 12697 12703 12713 12721 12739 12743 12757 12763 12781 12791 12799 12809 12821 12823 12829 12841 12853 12889 12893 12899 12907 12911 12917 12919 12923 12941 12953 12959 12967 12973 12979 12983 13001 13003 13007 13009 13033 13037 13043 13049 13063 13093 13099 13103 13109 13121 13127 13147 13151 13159 13163 13171 13177 13183 13187 13217 13219 13229 13241 13249 13259 13267 13291 13297 13309 13313 13327 13331 13337 13339 13367 13381 13397 13399 13411 13417 13421 13441 13451 13457 13463 13469 13477 13487 13499 13513 13523 13537 13553 13567 13577 13591 13597 13613 13619 13627 13633 13649 13669 13679 13681 13687 13691 13693 13697 13709 13711 13721 13723 13729 13751 13757 13759 13763 13781 13789 13799 13807 13829 13831 13841 13859 13873 13877 13879 13883 13901 13903 13907 13913 13921 13931 13933 13963 13967 13997 13999 14009 14011 14029 14033 14051 14057 14071 14081 14083 14087 14107 14143 14149 14153 14159 14173 14177 14197 14207 14221 14243 14249 14251 14281 14293 14303 14321 14323 14327 14341 14347 14369 14387 14389 14401 14407 14411 14419 14423 14431 14437 14447 14449 14461 14479 14489 14503 14519 14533 14537 14543 14549 14551 14557 14561 14563 14591 14593 14621 14627 14629 14633 14639 14653 14657 14669 14683 14699 14713 14717 14723 14731 14737 14741 14747 14753 14759 14767 14771 14779 14783 14797 14813 14821 14827 14831 14843 14851 14867 14869 14879 14887 14891 14897 14923 14929 14939 14947 14951 14957 14969 14983 15013 15017 15031 15053 15061 15073 15077 15083 15091 15101 15107 15121 15131 15137 15139 15149 15161 15173 15187 15193 15199 15217 15227 15233 15241 15259 15263 15269 15271 15277 15287 15289 15299 15307 15313 15319 15329 15331 15349 15359 15361 15373 15377 15383 15391 15401 15413 15427 15439 15443 15451 15461 15467 15473 15493 15497 15511 15527 15541 15551 15559 15569 15581 15583 15601 15607 15619 15629 15641 15643 15647 15649 15661 15667 15671 15679 15683 15727 15731 15733 15737 15739 15749 15761 15767 15773 15787 15791 15797 15803 15809 15817 15823 15859 15877 15881 15887 15889 15901 15907 15913 15919 15923 15937 15959 15971 15973 15991 16001 16007 16033 16057 16061 16063 16067 16069 16073 16087 16091 16097 16103 16111 16127 16139 16141 16183 16187 16189 16193 16217 16223 16229 16231 16249 16253 16267 16273 16301 16319 16333 16339 16349 16361 16363 16369 16381 16411 16417 16421 16427 16433 16447 16451 16453 16477 16481 16487 16493 16519 16529 16547 16553 16561 16567 16573 16603 16607 16619 16631 16633 16649 16651 16657 16661 16673 16691 16693 16699 16703 16729 16741 16747 16759 16763 16787 16811 16823 16829 16831 16843 16871 16879 16883 16889 16901 16903 16921 16927 16931 16937 16943 16963 16979 16981 16987 16993 17011 17021 17027 17029 17033 17041 17047 17053 17077 17093 17099 17107 17117 17123 17137 17159 17167 17183 17189 17191 17203 17207 17209 17231 17239 17257 17291 17293 17299 17317 17321 17327 17333 17341 17351 17359 17377 17383 17387 17389 17393 17401 17417 17419 17431 17443 17449 17467 17471 17477 17483 17489 17491 17497 17509 17519 17539 17551 17569 17573 17579 17581 17597 17599 17609 17623 17627 17657 17659 17669 17681 17683 17707 17713 17729 17737 17747 17749 17761 17783 17789 17791 17807 17827 17837 17839 17851 17863 17881 17891 17903 17909 17911 17921 17923 17929 17939 17957 17959 17971 17977 17981 17987 17989 18013 18041 18043 18047 18049 18059 18061 18077 18089 18097 18119 18121 18127 18131 18133 18143 18149 18169 18181 18191 18199 18211 18217 18223 18229 18233 18251 18253 18257 18269 18287 18289 18301 18307 18311 18313 18329 18341 18353 18367 18371 18379 18397 18401 18413 18427 18433 18439 18443 18451 18457 18461 18481 18493 18503 18517 18521 18523 18539 18541 18553 18583 18587 18593 18617 18637 18661 18671 18679 18691 18701 18713 18719 18731 18743 18749 18757 18773 18787 18793 18797 18803 18839 18859 18869 18899 18911 18913 18917 18919 18947 18959 18973 18979 19001 19009 19013 19031 19037 19051 19069 19073 19079 19081 19087 19121 19139 19141 19157 19163 19181 19183 19207 19211 19213 19219 19231 19237 19249 19259 19267 19273 19289 19301 19309 19319 19333 19373 19379 19381 19387 19391 19403 19417 19421 19423 19427 19429 19433 19441 19447 19457 19463 19469 19471 19477 19483 19489 19501 19507 19531 19541 19543 19553 19559 19571 19577 19583 19597 19603 19609 19661 19681 19687 19697 19699 19709 19717 19727 19739 19751 19753 19759 19763 19777 19793 19801 19813 19819 19841 19843 19853 19861 19867 19889 19891 19913 19919 19927 19937 19949 19961 19963 19973 19979 19991 19993 19997 20011 20021 20023 20029 20047 20051 20063 20071 20089 20101 20107 20113 20117 20123 20129 20143 20147 20149 20161 20173 20177 20183 20201 20219 20231 20233 20249 20261 20269 20287 20297 20323 20327 20333 20341 20347 20353 20357 20359 20369 20389 20393 20399 20407 20411 20431 20441 20443 20477 20479 20483 20507 20509 20521 20533 20543 20549 20551 20563 20593 20599 20611 20627 20639 20641 20663 20681 20693 20707 20717 20719 20731 20743 20747 20749 20753 20759 20771 20773 20789 20807 20809 20849 20857 20873 20879 20887 20897 20899 20903 20921 20929 20939 20947 20959 20963 20981 20983 21001 21011 21013 21017 21019 21023 21031 21059 21061 21067 21089 21101 21107 21121 21139 21143 21149 21157 21163 21169 21179 21187 21191 21193 21211 21221 21227 21247 21269 21277 21283 21313 21317 21319 21323 21341 21347 21377 21379 21383 21391 21397 21401 21407 21419 21433 21467 21481 21487 21491 21493 21499 21503 21517 21521 21523 21529 21557 21559 21563 21569 21577 21587 21589 21599 21601 21611 21613 21617 21647 21649 21661 21673 21683 21701 21713 21727 21737 21739 21751 21757 21767 21773 21787 21799 21803 21817 21821 21839 21841 21851 21859 21863 21871 21881 21893 21911 21929 21937 21943 21961 21977 21991 21997 22003 22013 22027 22031 22037 22039 22051 22063 22067 22073 22079 22091 22093 22109 22111 22123 22129 22133 22147 22153 22157 22159 22171 22189 22193 22229 22247 22259 22271 22273 22277 22279 22283 22291 22303 22307 22343 22349 22367 22369 22381 22391 22397 22409 22433 22441 22447 22453 22469 22481 22483 22501 22511 22531 22541 22543 22549 22567 22571 22573 22613 22619 22621 22637 22639 22643 22651 22669 22679 22691 22697 22699 22709 22717 22721 22727 22739 22741 22751 22769 22777 22783 22787 22807 22811 22817 22853 22859 22861 22871 22877 22901 22907 22921 22937 22943 22961 22963 22973 22993 23003 23011 23017 23021 23027 23029 23039 23041 23053 23057 23059 23063 23071 23081 23087 23099 23117 23131 23143 23159 23167 23173 23189 23197 23201 23203 23209 23227 23251 23269 23279 23291 23293 23297 23311 23321 23327 23333 23339 23357 23369 23371 23399 23417 23431 23447 23459 23473 23497 23509 23531 23537 23539 23549 23557 23561 23563 23567 23581 23593 23599 23603 23609 23623 23627 23629 23633 23663 23669 23671 23677 23687 23689 23719 23741 23743 23747 23753 23761 23767 23773 23789 23801 23813 23819 23827 23831 23833 23857 23869 23873 23879 23887 23893 23899 23909 23911 23917 23929 23957 23971 23977 23981 23993 24001 24007 24019 24023 24029 24043 24049 24061 24071 24077 24083 24091 24097 24103 24107 24109 24113 24121 24133 24137 24151 24169 24179 24181 24197 24203 24223 24229 24239 24247 24251 24281 24317 24329 24337 24359 24371 24373 24379 24391 24407 24413 24419 24421 24439 24443 24469 24473 24481 24499 24509 24517 24527 24533 24547 24551 24571 24593 24611 24623 24631 24659 24671 24677 24683 24691 24697 24709 24733 24749 24763 24767 24781 24793 24799 24809 24821 24841 24847 24851 24859 24877 24889 24907 24917 24919 24923 24943 24953 24967 24971 24977 24979 24989 25013 25031 25033 25037 25057 25073 25087 25097 25111 25117 25121 25127 25147 25153 25163 25169 25171 25183 25189 25219 25229 25237 25243 25247 25253 25261 25301 25303 25307 25309 25321 25339 25343 25349 25357 25367 25373 25391 25409 25411 25423 25439 25447 25453 25457 25463 25469 25471 25523 25537 25541 25561 25577 25579 25583 25589 25601 25603 25609 25621 25633 25639 25643 25657 25667 25673 25679 25693 25703 25717 25733 25741 25747 25759 25763 25771 25793 25799 25801 25819 25841 25847 25849 25867 25873 25889 25903 25913 25919 25931 25933 25939 25943 25951 25969 25981 25997 25999 26003 26017 26021 26029 26041 26053 26083 26099 26107 26111 26113 26119 26141 26153 26161 26171 26177 26183 26189 26203 26209 26227 26237 26249 26251 26261 26263 26267 26293 26297 26309 26317 26321 26339 26347 26357 26371 26387 26393 26399 26407 26417 26423 26431 26437 26449 26459 26479 26489 26497 26501 26513 26539 26557 26561 26573 26591 26597 26627 26633 26641 26647 26669 26681 26683 26687 26693 26699 26701 26711 26713 26717 26723 26729 26731 26737 26759 26777 26783 26801 26813 26821 26833 26839 26849 26861 26863 26879 26881 26891 26893 26903 26921 26927 26947 26951 26953 26959 26981 26987 26993 27011 27017 27031 27043 27059 27061 27067 27073 27077 27091 27103 27107 27109 27127 27143 27179 27191 27197 27211 27239 27241 27253 27259 27271 27277 27281 27283 27299 27329 27337 27361 27367 27397 27407 27409 27427 27431 27437 27449 27457 27479 27481 27487 27509 27527 27529 27539 27541 27551 27581 27583 27611 27617 27631 27647 27653 27673 27689 27691 27697 27701 27733 27737 27739 27743 27749 27751 27763 27767 27773 27779 27791 27793 27799 27803 27809 27817 27823 27827 27847 27851 27883 27893 27901 27917 27919 27941 27943 27947 27953 27961 27967 27983 27997 28001 28019 28027 28031 28051 28057 28069 28081 28087 28097 28099 28109 28111 28123 28151 28163 28181 28183 28201 28211 28219 28229 28277 28279 28283 28289 28297 28307 28309 28319 28349 28351 28387 28393 28403 28409 28411 28429 28433 28439 28447 28463 28477 28493 28499 28513 28517 28537 28541 28547 28549 28559 28571 28573 28579 28591 28597 28603 28607 28619 28621 28627 28631 28643 28649 28657 28661 28663 28669 28687 28697 28703 28711 28723 28729 28751 28753 28759 28771 28789 28793 28807 28813 28817 28837 28843 28859 28867 28871 28879 28901 28909 28921 28927 28933 28949 28961 28979 29009 29017 29021 29023 29027 29033 29059 29063 29077 29101 29123 29129 29131 29137 29147 29153 29167 29173 29179 29191 29201 29207 29209 29221 29231 29243 29251 29269 29287 29297 29303 29311 29327 29333 29339 29347 29363 29383 29387 29389 29399 29401 29411 29423 29429 29437 29443 29453 29473 29483 29501 29527 29531 29537 29567 29569 29573 29581 29587 29599 29611 29629 29633 29641 29663 29669 29671 29683 29717 29723 29741 29753 29759 29761 29789 29803 29819 29833 29837 29851 29863 29867 29873 29879 29881 29917 29921 29927 29947 29959 29983 29989 30011 30013 30029 30047 30059 30071 30089 30091 30097 30103 30109 30113 30119 30133 30137 30139 30161 30169 30181 30187 30197 30203 30211 30223 30241 30253 30259 30269 30271 30293 30307 30313 30319 30323 30341 30347 30367 30389 30391 30403 30427 30431 30449 30467 30469 30491 30493 30497 30509 30517 30529 30539 30553 30557 30559 30577 30593 30631 30637 30643 30649 30661 30671 30677 30689 30697 30703 30707 30713 30727 30757 30763 30773 30781 30803 30809 30817 30829 30839 30841 30851 30853 30859 30869 30871 30881 30893 30911 30931 30937 30941 30949 30971 30977 30983 31013 31019 31033 31039 31051 31063 31069 31079 31081 31091 31121 31123 31139 31147 31151 31153 31159 31177 31181 31183 31189 31193 31219 31223 31231 31237 31247 31249 31253 31259 31267 31271 31277 31307 31319 31321 31327 31333 31337 31357 31379 31387 31391 31393 31397 31469 31477 31481 31489 31511 31513 31517 31531 31541 31543 31547 31567 31573 31583 31601 31607 31627 31643 31649 31657 31663 31667 31687 31699 31721 31723 31727 31729 31741 31751 31769 31771 31793 31799 31817 31847 31849 31859 31873 31883 31891 31907 31957 31963 31973 31981 31991 32003 32009 32027 32029 32051 32057 32059 32063 32069 32077 32083 32089 32099 32117 32119 32141 32143 32159 32173 32183 32189 32191 32203 32213 32233 32237 32251 32257 32261 32297 32299 32303 32309 32321 32323 32327 32341 32353 32359 32363 32369 32371 32377 32381 32401 32411 32413 32423 32429 32441 32443 32467 32479 32491 32497 32503 32507 32531 32533 32537 32561 32563 32569 32573 32579 32587 32603 32609 32611 32621 32633 32647 32653 32687 32693 32707 32713 32717 32719 32749 32771 32779 32783 32789 32797 32801 32803 32831 32833 32839 32843 32869 32887 32909 32911 32917 32933 32939 32941 32957 32969 32971 32983 32987 32993 32999 33013 33023 33029 33037 33049 33053 33071 33073 33083 33091 33107 33113 33119 33149 33151 33161 33179 33181 33191 33199 33203 33211 33223 33247 33287 33289 33301 33311 33317 33329 33331 33343 33347 33349 33353 33359 33377 33391 33403 33409 33413 33427 33457 33461 33469 33479 33487 33493 33503 33521 33529 33533 33547 33563 33569 33577 33581 33587 33589 33599 33601 33613 33617 33619 33623 33629 33637 33641 33647 33679 33703 33713 33721 33739 33749 33751 33757 33767 33769 33773 33791 33797 33809 33811 33827 33829 33851 33857 33863 33871 33889 33893 33911 33923 33931 33937 33941 33961 33967 33997 34019 34031 34033 34039 34057 34061 34123 34127 34129 34141 34147 34157 34159 34171 34183 34211 34213 34217 34231 34253 34259 34261 34267 34273 34283 34297 34301 34303 34313 34319 34327 34337 34351 34361 34367 34369 34381 34403 34421 34429 34439 34457 34469 34471 34483 34487 34499 34501 34511 34513 34519 34537 34543 34549 34583 34589 34591 34603 34607 34613 34631 34649 34651 34667 34673 34679 34687 34693 34703 34721 34729 34739 34747 34757 34759 34763 34781 34807 34819 34841 34843 34847 34849 34871 34877 34883 34897 34913 34919 34939 34949 34961 34963 34981 35023 35027 35051 35053 35059 35069 35081 35083 35089 35099 35107 35111 35117 35129 35141 35149 35153 35159 35171 35201 35221 35227 35251 35257 35267 35279 35281 35291 35311 35317 35323 35327 35339 35353 35363 35381 35393 35401 35407 35419 35423 35437 35447 35449 35461 35491 35507 35509 35521 35527 35531 35533 35537 35543 35569 35573 35591 35593 35597 35603 35617 35671 35677 35729 35731 35747 35753 35759 35771 35797 35801 35803 35809 35831 35837 35839 35851 35863 35869 35879 35897 35899 35911 35923 35933 35951 35963 35969 35977 35983 35993 35999 36007 36011 36013 36017 36037 36061 36067 36073 36083 36097 36107 36109 36131 36137 36151 36161 36187 36191 36209 36217 36229 36241 36251 36263 36269 36277 36293 36299 36307 36313 36319 36341 36343 36353 36373 36383 36389 36433 36451 36457 36467 36469 36473 36479 36493 36497 36523 36527 36529 36541 36551 36559 36563 36571 36583 36587 36599 36607 36629 36637 36643 36653 36671 36677 36683 36691 36697 36709 36713 36721 36739 36749 36761 36767 36779 36781 36787 36791 36793 36809 36821 36833 36847 36857 36871 36877 36887 36899 36901 36913 36919 36923 36929 36931 36943 36947 36973 36979 36997 37003 37013 37019 37021 37039 37049 37057 37061 37087 37097 37117 37123 37139 37159 37171 37181 37189 37199 37201 37217 37223 37243 37253 37273 37277 37307 37309 37313 37321 37337 37339 37357 37361 37363 37369 37379 37397 37409 37423 37441 37447 37463 37483 37489 37493 37501 37507 37511 37517 37529 37537 37547 37549 37561 37567 37571 37573 37579 37589 37591 37607 37619 37633 37643 37649 37657 37663 37691 37693 37699 37717 37747 37781 37783 37799 37811 37813 37831 37847 37853 37861 37871 37879 37889 37897 37907 37951 37957 37963 37967 37987 37991 37993 37997 38011 38039 38047 38053 38069 38083 38113 38119 38149 38153 38167 38177 38183 38189 38197 38201 38219 38231 38237 38239 38261 38273 38281 38287 38299 38303 38317 38321 38327 38329 38333 38351 38371 38377 38393 38431 38447 38449 38453 38459 38461 38501 38543 38557 38561 38567 38569 38593 38603 38609 38611 38629 38639 38651 38653 38669 38671 38677 38693 38699 38707 38711 38713 38723 38729 38737 38747 38749 38767 38783 38791 38803 38821 38833 38839 38851 38861 38867 38873 38891 38903 38917 38921 38923 38933 38953 38959 38971 38977 38993 39019 39023 39041 39043 39047 39079 39089 39097 39103 39107 39113 39119 39133 39139 39157 39161 39163 39181 39191 39199 39209 39217 39227 39229 39233 39239 39241 39251 39293 39301 39313 39317 39323 39341 39343 39359 39367 39371 39373 39383 39397 39409 39419 39439 39443 39451 39461 39499 39503 39509 39511 39521 39541 39551 39563 39569 39581 39607 39619 39623 39631 39659 39667 39671 39679 39703 39709 39719 39727 39733 39749 39761 39769 39779 39791 39799 39821 39827 39829 39839 39841 39847 39857 39863 39869 39877 39883 39887 39901 39929 39937 39953 39971 39979 39983 39989 40009 40013 40031 40037 40039 40063 40087 40093 40099 40111 40123 40127 40129 40151 40153 40163 40169 40177 40189 40193 40213 40231 40237 40241 40253 40277 40283 40289 40343 40351 40357 40361 40387 40423 40427 40429 40433 40459 40471 40483 40487 40493 40499 40507 40519 40529 40531 40543 40559 40577 40583 40591 40597 40609 40627 40637 40639 40693 40697 40699 40709 40739 40751 40759 40763 40771 40787 40801 40813 40819 40823 40829 40841 40847 40849 40853 40867 40879 40883 40897 40903 40927 40933 40939 40949 40961 40973 40993 41011 41017 41023 41039 41047 41051 41057 41077 41081 41113 41117 41131 41141 41143 41149 41161 41177 41179 41183 41189 41201 41203 41213 41221 41227 41231 41233 41243 41257 41263 41269 41281 41299 41333 41341 41351 41357 41381 41387 41389 41399 41411 41413 41443 41453 41467 41479 41491 41507 41513 41519 41521 41539 41543 41549 41579 41593 41597 41603 41609 41611 41617 41621 41627 41641 41647 41651 41659 41669 41681 41687 41719 41729 41737 41759 41761 41771 41777 41801 41809 41813 41843 41849 41851 41863 41879 41887 41893 41897 41903 41911 41927 41941 41947 41953 41957 41959 41969 41981 41983 41999 42013 42017 42019 42023 42043 42061 42071 42073 42083 42089 42101 42131 42139 42157 42169 42179 42181 42187 42193 42197 42209 42221 42223 42227 42239 42257 42281 42283 42293 42299 42307 42323 42331 42337 42349 42359 42373 42379 42391 42397 42403 42407 42409 42433 42437 42443 42451 42457 42461 42463 42467 42473 42487 42491 42499 42509 42533 42557 42569 42571 42577 42589 42611 42641 42643 42649 42667 42677 42683 42689 42697 42701 42703 42709 42719 42727 42737 42743 42751 42767 42773 42787 42793 42797 42821 42829 42839 42841 42853 42859 42863 42899 42901 42923 42929 42937 42943 42953 42961 42967 42979 42989 43003 43013 43019 43037 43049 43051 43063 43067 43093 43103 43117 43133 43151 43159 43177 43189 43201 43207 43223 43237 43261 43271 43283 43291 43313 43319 43321 43331 43391 43397 43399 43403 43411 43427 43441 43451 43457 43481 43487 43499 43517 43541 43543 43573 43577 43579 43591 43597 43607 43609 43613 43627 43633 43649 43651 43661 43669 43691 43711 43717 43721 43753 43759 43777 43781 43783 43787 43789 43793 43801 43853 43867 43889 43891 43913 43933 43943 43951 43961 43963 43969 43973 43987 43991 43997 44017 44021 44027 44029 44041 44053 44059 44071 44087 44089 44101 44111 44119 44123 44129 44131 44159 44171 44179 44189 44201 44203 44207 44221 44249 44257 44263 44267 44269 44273 44279 44281 44293 44351 44357 44371 44381 44383 44389 44417 44449 44453 44483 44491 44497 44501 44507 44519 44531 44533 44537 44543 44549 44563 44579 44587 44617 44621 44623 44633 44641 44647 44651 44657 44683 44687 44699 44701 44711 44729 44741 44753 44771 44773 44777 44789 44797 44809 44819 44839 44843 44851 44867 44879 44887 44893 44909 44917 44927 44939 44953 44959 44963 44971 44983 44987 45007 45013 45053 45061 45077 45083 45119 45121 45127 45131 45137 45139 45161 45179 45181 45191 45197 45233 45247 45259 45263 45281 45289 45293 45307 45317 45319 45329 45337 45341 45343 45361 45377 45389 45403 45413 45427 45433 45439 45481 45491 45497 45503 45523 45533 45541 45553 45557 45569 45587 45589 45599 45613 45631 45641 45659 45667 45673 45677 45691 45697 45707 45737 45751 45757 45763 45767 45779 45817 45821 45823 45827 45833 45841 45853 45863 45869 45887 45893 45943 45949 45953 45959 45971 45979 45989 46021 46027 46049 46051 46061 46073 46091 46093 46099 46103 46133 46141 46147 46153 46171 46181 46183 46187 46199 46219 46229 46237 46261 46271 46273 46279 46301 46307 46309 46327 46337 46349 46351 46381 46399 46411 46439 46441 46447 46451 46457 46471 46477 46489 46499 46507 46511 46523 46549 46559 46567 46573 46589 46591 46601 46619 46633 46639 46643 46649 46663 46679 46681 46687 46691 46703 46723 46727 46747 46751 46757 46769 46771 46807 46811 46817 46819 46829 46831 46853 46861 46867 46877 46889 46901 46919 46933 46957 46993 46997 47017 47041 47051 47057 47059 47087 47093 47111 47119 47123 47129 47137 47143 47147 47149 47161 47189 47207 47221 47237 47251 47269 47279 47287 47293 47297 47303 47309 47317 47339 47351 47353 47363 47381 47387 47389 47407 47417 47419 47431 47441 47459 47491 47497 47501 47507 47513 47521 47527 47533 47543 47563 47569 47581 47591 47599 47609 47623 47629 47639 47653 47657 47659 47681 47699 47701 47711 47713 47717 47737 47741 47743 47777 47779 47791 47797 47807 47809 47819 47837 47843 47857 47869 47881 47903 47911 47917 47933 47939 47947 47951 47963 47969 47977 47981 48017 48023 48029 48049 48073 48079 48091 48109 48119 48121 48131 48157 48163 48179 48187 48193 48197 48221 48239 48247 48259 48271 48281 48299 48311 48313 48337 48341 48353 48371 48383 48397 48407 48409 48413 48437 48449 48463 48473 48479 48481 48487 48491 48497 48523 48527 48533 48539 48541 48563 48571 48589 48593 48611 48619 48623 48647 48649 48661 48673 48677 48679 48731 48733 48751 48757 48761 48767 48779 48781 48787 48799 48809 48817 48821 48823 48847 48857 48859 48869 48871 48883 48889 48907 48947 48953 48973 48989 48991 49003 49009 49019 49031 49033 49037 49043 49057 49069 49081 49103 49109 49117 49121 49123 49139 49157 49169 49171 49177 49193 49199 49201 49207 49211 49223 49253 49261 49277 49279 49297 49307 49331 49333 49339 49363 49367 49369 49391 49393 49409 49411 49417 49429 49433 49451 49459 49463 49477 49481 49499 49523 49529 49531 49537 49547 49549 49559 49597 49603 49613 49627 49633 49639 49663 49667 49669 49681 49697 49711 49727 49739 49741 49747 49757 49783 49787 49789 49801 49807 49811 49823 49831 49843 49853 49871 49877 49891 49919 49921 49927 49937 49939 49943 49957 49991 49993 49999
(* *)
(***********************************************************************)
-(* $Id: takc.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: takc.ml 12800 2012-07-30 18:59:07Z doligez $ *)
let rec tak x y z =
if x > y then tak (tak (x-1) y z) (tak (y-1) z x) (tak (z-1) x y)
if n <= 0 then 0 else tak 18 12 6 + repeat(n-1)
let _ = print_int (repeat 2000); print_newline(); exit 0
-
--- /dev/null
+MAIN_MODULE=pr5757
+
+include ../../../makefiles/Makefile.one
+include ../../../makefiles/Makefile.common
--- /dev/null
+Random.init 3;;
+for i = 0 to 100_000 do
+ ignore (String.create (Random.int 1_000_000))
+done;;
+Printf.printf "hello world\n";;
--- /dev/null
+hello world
(* *)
(***********************************************************************)
-(* $Id: gram_aux.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: gram_aux.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* Auxiliaries for the parser. *)
match l1 with
[] -> []
| a::l -> if List.mem a l2 then subtract l l2 else a :: subtract l l2
-
/* */
/***********************************************************************/
-/* $Id: grammar.mly 11156 2011-07-27 14:17:02Z doligez $ */
+/* $Id: grammar.mly 12800 2012-07-30 18:59:07Z doligez $ */
/* The grammar for lexer definitions */
other_definitions:
other_definitions Tand definition
{ $3::$1 }
- |
+ |
{ [] }
;
definition:
;
%%
-
(* *)
(***********************************************************************)
-(* $Id: input 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: input 12800 2012-07-30 18:59:07Z doligez $ *)
(* The lexical analyzer for lexer definitions. *)
}
rule main = parse
- [' ' '\010' '\013' '\009' ] +
+ [' ' '\010' '\013' '\009' ] +
{ main lexbuf }
- | "(*"
+ | "(*"
{ comment_depth := 1;
comment lexbuf;
main lexbuf }
| (['A'-'Z' 'a'-'z'] | '_' ['A'-'Z' 'a'-'z' '\'' '0'-'9'])
- ( '_' ? ['A'-'Z' 'a'-'z' ''' '0'-'9'] ) *
+ ( '_' ? ['A'-'Z' 'a'-'z' ''' '0'-'9'] ) *
{ match Lexing.lexeme lexbuf with
"rule" -> Trule
| "parse" -> Tparse
| "and" -> Tand
| "eof" -> Teof
| s -> Tident s }
- | '"'
+ | '"'
{ reset_string_buffer();
string lexbuf;
Tstring(get_stored_string()) }
- | "'"
+ | "'"
{ Tchar(char lexbuf) }
- | '{'
+ | '{'
{ let n1 = Lexing.lexeme_end lexbuf in
brace_depth := 1;
let n2 = action lexbuf in
{ raise(Lexical_error("illegal character " ^ Lexing.lexeme lexbuf)) }
and action = parse
- '{'
+ '{'
{ incr brace_depth;
action lexbuf }
- | '}'
+ | '}'
{ decr brace_depth;
if !brace_depth = 0 then Lexing.lexeme_start lexbuf else action lexbuf }
- | '"'
+ | '"'
{ reset_string_buffer();
string lexbuf;
reset_string_buffer();
action lexbuf }
| '\''
{ let _ = char lexbuf in action lexbuf }
- | "(*"
+ | "(*"
{ comment_depth := 1;
comment lexbuf;
action lexbuf }
- | eof
+ | eof
{ raise (Lexical_error "unterminated action") }
- | _
+ | _
{ action lexbuf }
-
+
and string = parse
- '"'
+ '"'
{ () }
| '\\' [' ' '\010' '\013' '\009' '\026' '\012'] +
{ string lexbuf }
- | '\\' ['\\' '"' 'n' 't' 'b' 'r']
+ | '\\' ['\\' '"' 'n' 't' 'b' 'r']
{ store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1));
string lexbuf }
- | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
+ | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
{ store_string_char(char_for_decimal_code lexbuf 1);
string lexbuf }
- | eof
+ | eof
{ raise(Lexical_error "unterminated string") }
- | _
+ | _
{ store_string_char(Lexing.lexeme_char lexbuf 0);
string lexbuf }
and char = parse
- [^ '\\'] "'"
+ [^ '\\'] "'"
{ Lexing.lexeme_char lexbuf 0 }
- | '\\' ['\\' '\'' 'n' 't' 'b' 'r'] "'"
+ | '\\' ['\\' '\'' 'n' 't' 'b' 'r'] "'"
{ char_for_backslash (Lexing.lexeme_char lexbuf 1) }
- | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'"
+ | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'"
{ char_for_decimal_code lexbuf 1 }
- | _
+ | _
{ raise(Lexical_error "bad character constant") }
and comment = parse
- "(*"
+ "(*"
{ incr comment_depth; comment lexbuf }
- | "*)"
+ | "*)"
{ decr comment_depth;
if !comment_depth = 0 then () else comment lexbuf }
- | '"'
+ | '"'
{ reset_string_buffer();
string lexbuf;
reset_string_buffer();
comment lexbuf }
- | eof
+ | eof
{ raise(Lexical_error "unterminated comment") }
- | _
+ | _
{ comment lexbuf }
;;
and comment lexbuf =
Lexing.init lexbuf;
state_4 lexbuf
-
(* *)
(***********************************************************************)
-(* $Id: lexgen.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: lexgen.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* Compiling a lexer definition *)
let todo = ref ([] : (transition list * int) list)
let next = ref 0
-let get_state st =
+let get_state st =
try
Hashtbl.find memory st
with Not_found ->
| ps -> Goto (get_state ps)
-let transition_from chars follow pos_set =
+let transition_from chars follow pos_set =
let tr = Array.create 256 []
and shift = Array.create 256 Backtrack in
List.iter
Array.create (number_of_states()) (Perform 0) in
List.iter (fun (auto, i) -> v.(i) <- auto) states;
(initial_states, v, actions)
-
and comment lexbuf =
Lexing.init lexbuf;
state_4 lexbuf
-
(* *)
(***********************************************************************)
-(* $Id: output.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: output.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* Generating a DFA as a set of mutually recursive functions *)
(* 3- Generating the entry points *)
-
+
let rec output_entries = function
[] -> failwith "output_entries"
| (name,state_num) :: rest ->
output_string !oc (" state_" ^ string_of_int state_num ^
" lexbuf\n");
match rest with
- [] -> output_string !oc "\n"; ()
+ [] -> ()
| _ -> output_string !oc "\nand "; output_entries rest
output_state i st.(i)
done;
output_entries initial_st
-
-
-
(* *)
(***********************************************************************)
-(* $Id: scan_aux.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: scan_aux.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* Auxiliaries for the lexical analyzer *)
Char.chr(100 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) +
10 * (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) +
(Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48))
-
(* *)
(***********************************************************************)
-(* $Id: scanner.mll 11156 2011-07-27 14:17:02Z doligez $ *)
+(* $Id: scanner.mll 12800 2012-07-30 18:59:07Z doligez $ *)
(* The lexical analyzer for lexer definitions. *)
}
rule main = parse
- [' ' '\010' '\013' '\009' ] +
+ [' ' '\010' '\013' '\009' ] +
{ main lexbuf }
- | "(*"
+ | "(*"
{ comment_depth := 1;
comment lexbuf;
main lexbuf }
| (['A'-'Z' 'a'-'z'] | '_' ['A'-'Z' 'a'-'z' '\'' '0'-'9'])
- ( '_' ? ['A'-'Z' 'a'-'z' ''' '0'-'9'] ) *
+ ( '_' ? ['A'-'Z' 'a'-'z' ''' '0'-'9'] ) *
{ match Lexing.lexeme lexbuf with
"rule" -> Trule
| "parse" -> Tparse
| "and" -> Tand
| "eof" -> Teof
| s -> Tident s }
- | '"'
+ | '"'
{ reset_string_buffer();
string lexbuf;
Tstring(get_stored_string()) }
- | "'"
+ | "'"
{ Tchar(char lexbuf) }
- | '{'
+ | '{'
{ let n1 = Lexing.lexeme_end lexbuf in
brace_depth := 1;
let n2 = action lexbuf in
{ raise(Lexical_error("illegal character " ^ Lexing.lexeme lexbuf)) }
and action = parse
- '{'
+ '{'
{ incr brace_depth;
action lexbuf }
- | '}'
+ | '}'
{ decr brace_depth;
if !brace_depth = 0 then Lexing.lexeme_start lexbuf else action lexbuf }
- | '"'
+ | '"'
{ reset_string_buffer();
string lexbuf;
reset_string_buffer();
action lexbuf }
| '\''
{ let _ = char lexbuf in action lexbuf }
- | "(*"
+ | "(*"
{ comment_depth := 1;
comment lexbuf;
action lexbuf }
- | eof
+ | eof
{ raise (Lexical_error "unterminated action") }
- | _
+ | _
{ action lexbuf }
-
+
and string = parse
- '"'
+ '"'
{ () }
| '\\' [' ' '\010' '\013' '\009' '\026' '\012'] +
{ string lexbuf }
- | '\\' ['\\' '"' 'n' 't' 'b' 'r']
+ | '\\' ['\\' '"' 'n' 't' 'b' 'r']
{ store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1));
string lexbuf }
- | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
+ | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
{ store_string_char(char_for_decimal_code lexbuf 1);
string lexbuf }
- | eof
+ | eof
{ raise(Lexical_error "unterminated string") }
- | _
+ | _
{ store_string_char(Lexing.lexeme_char lexbuf 0);
string lexbuf }
and char = parse
- [^ '\\'] "'"
+ [^ '\\'] "'"
{ Lexing.lexeme_char lexbuf 0 }
- | '\\' ['\\' '\'' 'n' 't' 'b' 'r'] "'"
+ | '\\' ['\\' '\'' 'n' 't' 'b' 'r'] "'"
{ char_for_backslash (Lexing.lexeme_char lexbuf 1) }
- | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'"
+ | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'"
{ char_for_decimal_code lexbuf 1 }
- | _
+ | _
{ raise(Lexical_error "bad character constant") }
and comment = parse
- "(*"
+ "(*"
{ incr comment_depth; comment lexbuf }
- | "*)"
+ | "*)"
{ decr comment_depth;
if !comment_depth = 0 then () else comment lexbuf }
- | '"'
+ | '"'
{ reset_string_buffer();
string lexbuf;
reset_string_buffer();
comment lexbuf }
- | eof
+ | eof
{ raise(Lexical_error "unterminated comment") }
- | _
+ | _
{ comment lexbuf }
t301-object.ml -o t301-object.byte
***)
-(* $Id: t301-object.ml 11123 2011-07-20 09:17:07Z doligez $ *)
+(* $Id: t301-object.ml 12800 2012-07-30 18:59:07Z doligez $ *)
class c = object (self)
if y <> 2 then raise Not_found;
if z <> 4 then raise Not_found;;
-(**** eof $Id: t301-object.ml 11123 2011-07-20 09:17:07Z doligez $ *)
+(**** eof $Id: t301-object.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* *)
(***********************************************************************)
-(* $Id: odoc_test.ml 12354 2012-04-13 13:49:23Z doligez $ *)
+(* $Id: odoc_test.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(** Custom generator to perform test on ocamldoc. *)
inherit Odoc_info.Scan.scanner
val mutable test_kinds = []
- val mutable fmt = Format.str_formatter
+ val mutable fmt = Format.str_formatter
method must_display_types = List.mem Types_display test_kinds
method set_test_kinds_from_module m =
test_kinds <- List.fold_left
- (fun acc (s, _) ->
- match s with
- "test_types_display" -> Types_display :: acc
- | _ -> acc
- )
- []
- (
- match m.m_info with
- None -> []
- | Some i -> i.i_custom
- )
+ (fun acc (s, _) ->
+ match s with
+ "test_types_display" -> Types_display :: acc
+ | _ -> acc
+ )
+ []
+ (
+ match m.m_info with
+ None -> []
+ | Some i -> i.i_custom
+ )
method! scan_type t =
match test_kinds with
- [] -> ()
- | _ ->
- p fmt "# type %s:\n" t.ty_name;
- if self#must_display_types then
- (
- p fmt "# manifest (Odoc_info.string_of_type_expr):\n<[%s]>\n"
- (match t.ty_manifest with
- None -> "None"
- | Some e -> Odoc_info.string_of_type_expr e
- );
- );
+ [] -> ()
+ | _ ->
+ p fmt "# type %s:\n" t.ty_name;
+ if self#must_display_types then
+ (
+ p fmt "# manifest (Odoc_info.string_of_type_expr):\n<[%s]>\n"
+ (match t.ty_manifest with
+ None -> "None"
+ | Some e -> Odoc_info.string_of_type_expr e
+ );
+ );
method! scan_module_pre m =
p fmt "#\n# module %s:\n" m.m_name ;
if self#must_display_types then
- (
- p fmt "# Odoc_info.string_of_module_type:\n<[%s]>\n"
- (Odoc_info.string_of_module_type m.m_type);
- p fmt "# Odoc_info.string_of_module_type ~complete: true :\n<[%s]>\n"
- (Odoc_info.string_of_module_type ~complete: true m.m_type);
- );
+ (
+ p fmt "# Odoc_info.string_of_module_type:\n<[%s]>\n"
+ (Odoc_info.string_of_module_type m.m_type);
+ p fmt "# Odoc_info.string_of_module_type ~complete: true :\n<[%s]>\n"
+ (Odoc_info.string_of_module_type ~complete: true m.m_type);
+ );
true
method! scan_module_type_pre m =
p fmt "#\n# module type %s:\n" m.mt_name ;
if self#must_display_types then
- (
- p fmt "# Odoc_info.string_of_module_type:\n<[%s]>\n"
- (match m.mt_type with
- None -> "None"
- | Some t -> Odoc_info.string_of_module_type t
- );
- p fmt "# Odoc_info.string_of_module_type ~complete: true :\n<[%s]>\n"
- (match m.mt_type with
- None -> "None"
- | Some t -> Odoc_info.string_of_module_type ~complete: true t
- );
- );
+ (
+ p fmt "# Odoc_info.string_of_module_type:\n<[%s]>\n"
+ (match m.mt_type with
+ None -> "None"
+ | Some t -> Odoc_info.string_of_module_type t
+ );
+ p fmt "# Odoc_info.string_of_module_type ~complete: true :\n<[%s]>\n"
+ (match m.mt_type with
+ None -> "None"
+ | Some t -> Odoc_info.string_of_module_type ~complete: true t
+ );
+ );
true
method generate (module_list: Odoc_info.Module.t_module list) =
fmt <- Format.formatter_of_out_channel oc;
(
try
- List.iter
- (fun m ->
- self#set_test_kinds_from_module m;
- self#scan_module_list [m];
- )
- module_list
+ List.iter
+ (fun m ->
+ self#set_test_kinds_from_module m;
+ self#scan_module_list [m];
+ )
+ module_list
with
- e ->
- prerr_endline (Printexc.to_string e)
+ e ->
+ prerr_endline (Printexc.to_string e)
);
Format.pp_print_flush fmt ();
close_out oc
module M = struct
- let y = 2
+ let y = 2
end
module type MT2 = sig type t val x : t end;;
module type Gee = MT2 with type t = float ;;
-module T = (val (if true then (module Foo:MT2 with type t = int) else (module Bar: MT2 with type t = int)) : MT2 with type t = int);;
\ No newline at end of file
+module T = (val (if true then (module Foo:MT2 with type t = int) else (module Bar: MT2 with type t = int)) : MT2 with type t = int);;
let () =
print_endline (Print.to_string int 10);
print_endline (Print.to_string (pair int (pair str int)) (123, ("A", 456)))
-
BASEDIR=../..
include $(BASEDIR)/makefiles/Makefile.toplevel
include $(BASEDIR)/makefiles/Makefile.common
-
| VString of string
| VList of variant list
| VPair of variant * variant
-
+
let rec variantize: type t. t ty -> t -> variant =
fun ty x ->
(* type t is abstract here *)
| Pair (ty1, ty2) ->
VPair (variantize ty1 (fst x), variantize ty2 (snd x))
(* t = ('a, 'b) for some 'a and 'b *)
-
+
exception VariantMismatch
-
+
let rec devariantize: type t. t ty -> variant -> t =
fun ty v ->
match ty, v with
| List: 'a ty -> 'a list ty
| Pair: ('a ty * 'b ty) -> ('a * 'b) ty
| Record: 'a record -> 'a ty
-
+
and 'a record =
{
path: string;
fields: 'a field_ list;
}
-
+
and 'a field_ =
| Field: ('a, 'b) field -> 'a field_
-
+
and ('a, 'b) field =
{
label: string;
(List.map (fun (Field{field_type; label; get}) ->
(label, variantize field_type (get x))) fields)
;;
-
+
(* Extraction *)
type 'a ty =
| List: 'a ty -> 'a list ty
| Pair: ('a ty * 'b ty) -> ('a * 'b) ty
| Record: ('a, 'builder) record -> 'a ty
-
+
and ('a, 'builder) record =
{
path: string;
create_builder: (unit -> 'builder);
of_builder: ('builder -> 'a);
}
-
+
and ('a, 'builder) field =
| Field: ('a, 'builder, 'b) field_ -> ('a, 'builder) field
-
+
and ('a, 'builder, 'b) field_ =
{
label: string;
get: ('a -> 'b);
set: ('builder -> 'b -> unit);
}
-
+
let rec devariantize: type t. t ty -> variant -> t =
fun ty v ->
match ty, v with
a: int;
b: string list;
}
-
+
let my_record =
let fields =
[
-module Exp =
+module Exp =
struct
- type _ t =
+ type _ t =
| IntLit : int -> int t
| BoolLit : bool -> bool t
| Pair : 'a t * 'b t -> ('a * 'b) t
| App : ('a -> 'b) t * 'a t -> 'b t
- | Abs : ('a -> 'b) -> ('a -> 'b) t
+ | Abs : ('a -> 'b) -> ('a -> 'b) t
- let rec eval : type s . s t -> s =
+ let rec eval : type s . s t -> s =
function
- | IntLit x -> x
- | BoolLit y -> y
- | Pair (x,y) ->
+ | IntLit x -> x
+ | BoolLit y -> y
+ | Pair (x,y) ->
(eval x,eval y)
- | App (f,a) ->
- (eval f) (eval a)
- | Abs f -> f
+ | App (f,a) ->
+ (eval f) (eval a)
+ | Abs f -> f
let discern : type a. a t -> _ = function
IntLit _ -> 1
end
;;
-module List =
+module List =
struct
type zero
- type _ t =
+ type _ t =
| Nil : zero t
| Cons : 'a * 'b t -> ('a * 'b) t
let head =
function
- | Cons (a,b) -> a
+ | Cons (a,b) -> a
let tail =
function
- | Cons (a,b) -> b
- let rec length : type a . a t -> int =
+ | Cons (a,b) -> b
+ let rec length : type a . a t -> int =
function
- | Nil -> 0
- | Cons (a,b) -> length b
+ | Nil -> 0
+ | Cons (a,b) -> length b
end
;;
-module Nonexhaustive =
+module Nonexhaustive =
struct
- type 'a u =
- | C1 : int -> int u
+ type 'a u =
+ | C1 : int -> int u
| C2 : bool -> bool u
-
- type 'a v =
+
+ type 'a v =
| C1 : int -> int v
- let unexhaustive : type s . s u -> s =
+ let unexhaustive : type s . s u -> s =
function
- | C2 x -> x
+ | C2 x -> x
- module M : sig type t type u end =
+ module M : sig type t type u end =
struct
type t = int
type u = bool
- end
- type 'a t =
- | Foo : M.t -> M.t t
+ end
+ type 'a t =
+ | Foo : M.t -> M.t t
| Bar : M.u -> M.u t
let same_type : type s . s t * s t -> bool =
function
- | Foo _ , Foo _ -> true
- | Bar _, Bar _ -> true
+ | Foo _ , Foo _ -> true
+ | Bar _, Bar _ -> true
end
;;
-module Exhaustive =
+module Exhaustive =
struct
type t = int
type u = bool
- type 'a v =
- | Foo : t -> t v
+ type 'a v =
+ | Foo : t -> t v
| Bar : u -> u v
let same_type : type s . s v * s v -> bool =
function
- | Foo _ , Foo _ -> true
- | Bar _, Bar _ -> true
+ | Foo _ , Foo _ -> true
+ | Bar _, Bar _ -> true
end
;;
-module Existential_escape =
+module Existential_escape =
struct
type _ t = C : int -> int t
type u = D : 'a t -> u
end
;;
-module Rectype =
+module Rectype =
struct
- type (_,_) t = C : ('a,'a) t
- let _ =
+ type (_,_) t = C : ('a,'a) t
+ let _ =
fun (type s) ->
- let a : (s, s * s) t = failwith "foo" in
- match a with
- C ->
- ()
+ let a : (s, s * s) t = failwith "foo" in
+ match a with
+ C ->
+ ()
end
;;
-module Or_patterns =
+module Or_patterns =
struct
- type _ t =
+ type _ t =
| IntLit : int -> int t
| BoolLit : bool -> bool t
- let rec eval : type s . s t -> unit =
+ let rec eval : type s . s t -> unit =
function
- | (IntLit _ | BoolLit _) -> ()
+ | (IntLit _ | BoolLit _) -> ()
end
;;
-module Polymorphic_variants =
+module Polymorphic_variants =
struct
- type _ t =
+ type _ t =
| IntLit : int -> int t
| BoolLit : bool -> bool t
- let rec eval : type s . [`A] * s t -> unit =
+ let rec eval : type s . [`A] * s t -> unit =
function
- | `A, IntLit _ -> ()
- | `A, BoolLit _ -> ()
- end
+ | `A, IntLit _ -> ()
+ | `A, BoolLit _ -> ()
+ end
;;
module Propagation = struct
- type _ t =
+ type _ t =
IntLit : int -> int t
| BoolLit : bool -> bool t
type _ int_foo =
| IF_constr : <foo:int; ..> int_foo
-type _ int_bar =
+type _ int_bar =
| IB_constr : <bar:int; ..> int_bar
;;
val tail : ('a * 'b) t -> 'b t
val length : 'a t -> int
end
-# Characters 206-227:
+# Characters 196-224:
......function
- | C2 x -> x
+ | C2 x -> x
Warning 8: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
C1 _
-Characters 469-526:
+Characters 458-529:
......function
- | Foo _ , Foo _ -> true
- | Bar _, Bar _ -> true
+ | Foo _ , Foo _ -> true
+ | Bar _, Bar _ -> true
Warning 8: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
(Bar _, Foo _)
type 'a v = Foo : t -> t v | Bar : u -> u v
val same_type : 's v * 's v -> bool
end
-# Characters 119-120:
+# Characters 118-119:
let eval (D x) = x
^
Error: This expression has type ex#16 t
but an expression was expected of type ex#16 t
The type constructor ex#16 would escape its scope
-# Characters 157-158:
- C ->
- ^
+# Characters 174-175:
+ C ->
+ ^
Error: Recursive local constraint when unifying (s, s) t with (s, s * s) t
-# Characters 174-182:
- | (IntLit _ | BoolLit _) -> ()
- ^^^^^^^^
+# Characters 178-186:
+ | (IntLit _ | BoolLit _) -> ()
+ ^^^^^^^^
Error: This pattern matches values of type int t
but a pattern was expected which matches values of type s t
-# Characters 213-226:
- | `A, BoolLit _ -> ()
- ^^^^^^^^^^^^^
+# Characters 224-237:
+ | `A, BoolLit _ -> ()
+ ^^^^^^^^^^^^^
Error: This pattern matches values of type ([? `A ] as 'a) * bool t
but a pattern was expected which matches values of type 'a * int t
-# Characters 300-301:
+# Characters 299-300:
| BoolLit b -> b
^
Error: This expression has type bool but an expression was expected of type s
val tail : ('a * 'b) t -> 'b t
val length : 'a t -> int
end
-# Characters 206-227:
+# Characters 196-224:
......function
- | C2 x -> x
+ | C2 x -> x
Warning 8: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
C1 _
-Characters 469-526:
+Characters 458-529:
......function
- | Foo _ , Foo _ -> true
- | Bar _, Bar _ -> true
+ | Foo _ , Foo _ -> true
+ | Bar _, Bar _ -> true
Warning 8: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
(Bar _, Foo _)
type 'a v = Foo : t -> t v | Bar : u -> u v
val same_type : 's v * 's v -> bool
end
-# Characters 119-120:
+# Characters 118-119:
let eval (D x) = x
^
Error: This expression has type ex#16 t
but an expression was expected of type ex#16 t
The type constructor ex#16 would escape its scope
-# Characters 157-158:
- C ->
- ^
+# Characters 174-175:
+ C ->
+ ^
Error: Recursive local constraint when unifying (s, s) t with (s, s * s) t
-# Characters 174-182:
- | (IntLit _ | BoolLit _) -> ()
- ^^^^^^^^
+# Characters 178-186:
+ | (IntLit _ | BoolLit _) -> ()
+ ^^^^^^^^
Error: This pattern matches values of type int t
but a pattern was expected which matches values of type s t
-# Characters 213-226:
- | `A, BoolLit _ -> ()
- ^^^^^^^^^^^^^
+# Characters 224-237:
+ | `A, BoolLit _ -> ()
+ ^^^^^^^^^^^^^
Error: This pattern matches values of type ([? `A ] as 'a) * bool t
but a pattern was expected which matches values of type 'a * int t
# module Propagation :
BASEDIR=../..
include $(BASEDIR)/makefiles/Makefile.toplevel
include $(BASEDIR)/makefiles/Makefile.common
-
let ssmap =
(let module S = struct include SSMap end in (module S) :
- (module
+ (module
MapT with type key = string and type data = string and type map = SSMap.map))
;;
BASEDIR=../..
include $(BASEDIR)/makefiles/Makefile.toplevel
include $(BASEDIR)/makefiles/Makefile.common
-
module type INCLUDING = sig
include module type of List
include module type of ListLabels
-end
+end
module Including_typed: INCLUDING = struct
include List
include ../../makefiles/Makefile.toplevel
include ../../makefiles/Makefile.common
-
-type expr =
+type expr =
[ `Abs of string * expr
| `App of expr * expr
]
-class type exp =
+class type exp =
object
method eval : (string, exp) Hashtbl.t -> expr
end;;
-class app e1 e2 : exp =
+class app e1 e2 : exp =
object
- val l = e1
+ val l = e1
val r = e2
- method eval env =
+ method eval env =
match l with
| `Abs(var,body) ->
Hashtbl.add env var r;
object (self : 'subject)
val mutable observers = ([]: (('subject, 'event) observer) list)
method add_observer obs = observers <- (obs :: observers)
- method notify_observers (e : 'event) =
+ method notify_observers (e : 'event) =
List.iter (fun x -> x#notify self e) observers
end
-class virtual ['a] c =
-object (s : 'a)
- method virtual m : 'b
+class virtual ['a] c =
+object (s : 'a)
+ method virtual m : 'b
end
-let o =
+let o =
object (s :'a)
inherit ['a] c
method m = 42
method fold : 'b. ('a -> int -> 'b -> 'b) -> 'b -> 'b = fun f a0 ->
let cur = self#first in
let rec loop count a =
- if count >= self#len then a else
- let a' = f cur#get count a in
- cur#incr (); loop (count + 1) a'
+ if count >= self#len then a else
+ let a' = f cur#get count a in
+ cur#incr (); loop (count + 1) a'
in
loop 0 a0
method iter proc =
let highest_bit = 1 lsl 30
let lower_bits = highest_bit - 1
- let char_of c =
+ let char_of c =
try Char.chr c with Invalid_argument _ -> raise Out_of_range
let of_char = Char.code
object (self : 'self)
inherit [cursor] ustorage_base
val contents = buf
- method first = new cursor (self :> text_raw) 0
+ method first = new cursor (self :> text_raw) 0
method len = (String.length contents) / 4
method get i = get_buf contents (4 * i)
method nth i = new cursor (self :> text_raw) i
BASEDIR=../..
include $(BASEDIR)/makefiles/Makefile.toplevel
include $(BASEDIR)/makefiles/Makefile.common
-
class c a = object val x = 1 val y = 1 val z = 1 val a = a end;;
class d b = object val z = 2 val t = 2 val u = 2 val b = b end;;
-class e () = object
+class e () = object
val x = 3
inherit c 5
val y = 3
# - : int * int * int * int * int = (1, 3, 2, 2, 3)
# class c : 'a -> object val a : 'a val x : int val y : int val z : int end
# class d : 'a -> object val b : 'a val t : int val u : int val z : int end
-# Characters 43-46:
+# Characters 42-45:
inherit c 5
^^^
Warning 13: the following instance variables are overridden by the class c :
x
The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
-Characters 53-54:
+Characters 52-53:
val y = 3
^
Warning 13: the instance variable y is overridden.
The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
-Characters 81-84:
+Characters 80-83:
inherit d 7
^^^
Warning 13: the following instance variables are overridden by the class d :
t z
The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
-Characters 91-92:
+Characters 90-91:
val u = 3
^
Warning 13: the instance variable u is overridden.
# - : int * int * int * int * int = (1, 3, 2, 2, 3)
# class c : 'a -> object val a : 'a val x : int val y : int val z : int end
# class d : 'a -> object val b : 'a val t : int val u : int val z : int end
-# Characters 43-46:
+# Characters 42-45:
inherit c 5
^^^
Warning 13: the following instance variables are overridden by the class c :
x
The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
-Characters 53-54:
+Characters 52-53:
val y = 3
^
Warning 13: the instance variable y is overridden.
The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
-Characters 81-84:
+Characters 80-83:
inherit d 7
^^^
Warning 13: the following instance variables are overridden by the class d :
t z
The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
-Characters 91-92:
+Characters 90-91:
val u = 3
^
Warning 13: the instance variable u is overridden.
method foo: string
end
-type 'a name =
+type 'a name =
Foo: foo_t name
| Int: int name
;;
let ident v = v
class alias = object method alias : 'a . 'a t -> 'a = ident end
-
BASEDIR=../..
include $(BASEDIR)/makefiles/Makefile.toplevel
include $(BASEDIR)/makefiles/Makefile.common
-
-(* $Id: poly.ml 12534 2012-06-01 05:24:38Z garrigue $ *)
+(* $Id: poly.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(*
Polymorphic methods are now available in the main branch.
Enjoy.
function 1,`B -> 1 | 1,_ -> 2;;
(* pass typetexp, but fails during Typedecl.check_recursion *)
-type ('a, 'b) a = 'a -> unit constraint 'a = [> `B of ('a, 'b) b as 'b]
+type ('a, 'b) a = 'a -> unit constraint 'a = [> `B of ('a, 'b) b as 'b]
and ('a, 'b) b = 'b -> unit constraint 'b = [> `A of ('a, 'b) a as 'a];;
(* PR#1917: expanding may change original in Ctype.unify2 *)
method as_a: ('a, 'b) a
end and ['a, 'b] b = object
method a: ('a, 'b) #a as 'a
- method as_b: ('a, 'b) b
+ method as_b: ('a, 'b) b
end
class type ['b] ca = object ('s) inherit ['s, 'b] a end
class type ['a] cb = object ('s) inherit ['a, 's] b end
-
+
type bt = 'b ca cb as 'b
;;
Warning 11: this match case is unused.
- : int * [< `B ] -> int = <fun>
# Characters 69-135:
- type ('a, 'b) a = 'a -> unit constraint 'a = [> `B of ('a, 'b) b as 'b]
+ type ('a, 'b) a = 'a -> unit constraint 'a = [> `B of ('a, 'b) b as 'b]
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: Constraints are not satisfied in this type.
Type
Warning 11: this match case is unused.
- : int * [< `B ] -> int = <fun>
# Characters 69-135:
- type ('a, 'b) a = 'a -> unit constraint 'a = [> `B of ('a, 'b) b as 'b]
+ type ('a, 'b) a = 'a -> unit constraint 'a = [> `B of ('a, 'b) b as 'b]
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: Constraints are not satisfied in this type.
Type
end
let () =
- let f flag =
+ let f flag =
let module T = TT in
let _ = match flag with `A -> 0 | `B r -> r in
let _ = match flag with `A -> T.IntSet.mem | `B r -> r in
(* This one should fail *)
-let f flag =
+let f flag =
let module T = Set.Make(struct type t = int let compare = compare end) in
let _ = match flag with `A -> 0 | `B r -> r in
let _ = match flag with `A -> T.mem | `B r -> r in
type -'typing wrapped = private sexp
and +'a t = 'a typed wrapped
and sexp = private untyped wrapped;;
-class type ['a] s3 = object
+class type ['a] s3 = object
val underlying : 'a t
end;;
class ['a] s3object r : ['a] s3 = object
BASEDIR=../..
include $(BASEDIR)/makefiles/Makefile.toplevel
include $(BASEDIR)/makefiles/Makefile.common
-
val mk : int -> t
end = M;;
-module M4 : sig
+module M4 : sig
type t = M.t = T of int
val mk : int -> t
end = M;;
(* Error: The variant or record definition does not match that of type M.t *)
-module M5 : sig
+module M5 : sig
type t = M.t = private T of int
val mk : int -> t
end = M;;
-module M6 : sig
+module M6 : sig
type t = private T of int
val mk : int -> t
end = M;;
# module M1 : sig type t = M.t val mk : int -> t end
# module M2 : sig type t = M.t val mk : int -> t end
# module M3 : sig type t = M.t val mk : int -> t end
-# Characters 29-47:
+# Characters 26-44:
type t = M.t = T of int
^^^^^^^^^^^^^^^^^^
Error: This variant or record definition does not match that of type M.t
(* Bad (t = t) *)
module rec A : sig type t = B.t end = struct type t = B.t end
and B : sig type t = A.t end = struct type t = A.t end;;
-
module rec A : sig type 'a t = <m: 'a list B.t; n: 'a array B.t> end
= struct type 'a t = <m: 'a list B.t; n: 'a array B.t> end
and B : sig type 'a t = 'a A.t end = struct type 'a t = 'a A.t end;;
-
(* OK *)
class type [ 'node ] extension = object method node : 'node end
-class type [ 'ext ] node = object constraint 'ext = 'ext node #extension end
+class type [ 'ext ] node = object constraint 'ext = 'ext node #extension end
class x = object method node : x node = assert false end
type t = x node;;
end
module rec U : T with module D = U' = U
- and U' : S with type t = U'.t = U
+ and U' : S with type t = U'.t = U
end;;
let create l = new c l
end
end;;
-
type t = I of int * int | D of int * Diet.t * int
val compare : t -> t -> int
val iter : (int -> unit) -> t -> unit
- end =
+ end =
struct
type t = I of int * int | D of int * Diet.t * int
let compare x1 x2 = 0
let rec iter f = function
| I (l, r) -> for i = l to r do f i done
| D (_, d, _) -> Diet.iter (iter f) d
- end
+ end
and Diet : SET with type t = Elt.t tree and type elt = Elt.t = MakeDiet(Elt)
type t = Diet.t
let iter f = Diet.iter (Elt.iter f)
end
-
end
= struct
type t = DirCompare.t list
- end
-
+ end
module Other = A
end
end
-
;;
module rec Strengthen2
- : sig type t
+ : sig type t
val f : t -> t
module M : sig type u end
module R : sig type v end
| Node(l,r) -> 1 + max (PolyRec.depth l) (PolyRec.depth r)
end
;;
-
+
(* Wrong LHS signatures (PR#4336) *)
(*
: sig
type t = (string * Expr.t) list
val fv: t -> StringSet.t
- val bv: t -> StringSet.t
+ val bv: t -> StringSet.t
val simpl: t -> t
end
= struct
val deleteMin: heap -> heap
end
-module Bootstrap (MakeH: functor (Element:ORDERED) ->
+module Bootstrap (MakeH: functor (Element:ORDERED) ->
HEAP with module Elem = Element)
(Element: ORDERED) : HEAP with module Elem = Element =
struct
val eq: t -> t -> bool
val lt: t -> t -> bool
val leq: t -> t -> bool
- end
+ end
= struct
type t = E | H of Elem.t * PrimH.heap
let leq t1 t2 =
module A = (Coerce1: sig val f: int -> int end)
let g x = x
let f x = if x <= 0 then 1 else A.f (x-1) * x
- end
+ end
;;
let _ =
end
module rec Coerce5
- : sig val blabla: int -> int val f: int -> int end
+ : sig val blabla: int -> int val f: int -> int end
= struct let blabla x = 0 let f x = 5 end
and Coerce6
: sig val at: int -> int end
(* Miscellaneous bug reports *)
-module rec F
+module rec F
: sig type t = X of int | Y of int
val f: t -> bool
end
= struct
- type t = X of int | Y of int
+ type t = X of int | Y of int
let f = function
| X _ -> false
| _ -> true
- end;;
+ end;;
let _ =
test 100 (F.f (F.X 1)) false;
BASEDIR=../..
include $(BASEDIR)/makefiles/Makefile.toplevel
include $(BASEDIR)/makefiles/Makefile.common
-
include EVALUATOR
module Parser : PARSER with type chunk = Ast.chunk
val dostring : state -> string -> value list
- val mk : unit -> state
+ val mk : unit -> state
end;;
module type USERTYPE = sig
type t
- val eq : t -> t -> bool
+ val eq : t -> t -> bool
val to_string : t -> string
end;;
BASEDIR=../..
include $(BASEDIR)/makefiles/Makefile.toplevel
include $(BASEDIR)/makefiles/Makefile.common
-
BASEDIR=../..
include $(BASEDIR)/makefiles/Makefile.toplevel
include $(BASEDIR)/makefiles/Makefile.common
-
(* *)
(***********************************************************************)
-(* $Id: depend.ml 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* $Id: depend.ml 12883 2012-08-25 11:35:20Z garrigue $ *)
open Asttypes
open Format
let add_class_type_declaration = add_class_description
+let pattern_bv = ref StringSet.empty
+
let rec add_pattern bv pat =
match pat.ppat_desc with
Ppat_any -> ()
| Ppat_variant(_, op) -> add_opt add_pattern bv op
| Ppat_type li -> add bv li
| Ppat_lazy p -> add_pattern bv p
- | Ppat_unpack _ -> ()
+ | Ppat_unpack id -> pattern_bv := StringSet.add id.txt !pattern_bv
+
+let add_pattern bv pat =
+ pattern_bv := bv;
+ add_pattern bv pat;
+ !pattern_bv
let rec add_expr bv exp =
match exp.pexp_desc with
Pexp_ident l -> add bv l
| Pexp_constant _ -> ()
- | Pexp_let(_, pel, e) -> add_pat_expr_list bv pel; add_expr bv e
+ | Pexp_let(rf, pel, e) ->
+ let bv = add_bindings rf bv pel in add_expr bv e
| Pexp_function (_, opte, pel) ->
add_opt add_expr bv opte; add_pat_expr_list bv pel
| Pexp_apply(e, el) ->
| Pexp_lazy (e) -> add_expr bv e
| Pexp_poly (e, t) -> add_expr bv e; add_opt add_type bv t
| Pexp_object { pcstr_pat = pat; pcstr_fields = fieldl } ->
- add_pattern bv pat; List.iter (add_class_field bv) fieldl
+ let bv = add_pattern bv pat in List.iter (add_class_field bv) fieldl
| Pexp_newtype (_, e) -> add_expr bv e
| Pexp_pack m -> add_module bv m
| Pexp_open (m, e) -> addmodule bv m; add_expr bv e
+
and add_pat_expr_list bv pel =
- List.iter (fun (p, e) -> add_pattern bv p; add_expr bv e) pel
+ List.iter (fun (p, e) -> let bv = add_pattern bv p in add_expr bv e) pel
+
+and add_bindings recf bv pel =
+ let bv' = List.fold_left (fun bv (p, _) -> add_pattern bv p) bv pel in
+ let bv = if recf = Recursive then bv' else bv in
+ List.iter (fun (_, e) -> add_expr bv e) pel;
+ bv'
and add_modtype bv mty =
match mty.pmty_desc with
match item.pstr_desc with
Pstr_eval e ->
add_expr bv e; bv
- | Pstr_value(id, pel) ->
- add_pat_expr_list bv pel; bv
+ | Pstr_value(rf, pel) ->
+ let bv = add_bindings rf bv pel in bv
| Pstr_primitive(id, vd) ->
add_type bv vd.pval_type; bv
| Pstr_type dcls ->
Pcl_constr(l, tyl) ->
add bv l; List.iter (add_type bv) tyl
| Pcl_structure { pcstr_pat = pat; pcstr_fields = fieldl } ->
- add_pattern bv pat; List.iter (add_class_field bv) fieldl
+ let bv = add_pattern bv pat in List.iter (add_class_field bv) fieldl
| Pcl_fun(_, opte, pat, ce) ->
- add_opt add_expr bv opte; add_pattern bv pat; add_class_expr bv ce
+ add_opt add_expr bv opte;
+ let bv = add_pattern bv pat in add_class_expr bv ce
| Pcl_apply(ce, exprl) ->
add_class_expr bv ce; List.iter (fun (_,e) -> add_expr bv e) exprl
- | Pcl_let(_, pel, ce) ->
- add_pat_expr_list bv pel; add_class_expr bv ce
+ | Pcl_let(rf, pel, ce) ->
+ let bv = add_bindings rf bv pel in add_class_expr bv ce
| Pcl_constraint(ce, ct) ->
add_class_expr bv ce; add_class_type bv ct
# #
#########################################################################
-# $Id: make-package-macosx 12773 2012-07-25 12:32:19Z doligez $
+# $Id: make-package-macosx 12783 2012-07-26 12:37:40Z doligez $
cd package-macosx
rm -rf ocaml.pkg ocaml-rw.dmg
cat >resources/ReadMe.txt <<EOF
This package installs OCaml version ${VERSION}.
You need Mac OS X 10.7.x (Lion), with the
-XCode tools installed (v3.2.6 or later).
+XCode tools installed (v4.3.3 or later).
Files will be installed in the following directories:
(fixity_of_longident li)
(*
| Pexp_cspval (_,li) ->
- if false (* default valu of !Clflags.prettycsp *)
- then (fixity_of_longident li)
- else Prefix
+ if false (* default valu of !Clflags.prettycsp *)
+ then (fixity_of_longident li)
+ else Prefix
*)
| _ -> Prefix ;;
);
| s ->
fprintf ppf "%s :@ " s ;
- core_type ppf ct1; (* todo: what do we do here? *)
+ core_type ppf ct1; (* todo: what do we do here? *)
);
fprintf ppf "@ ->@ " ;
core_type ppf ct2 ;
fprintf ppf "%a@ " fmt_longident li
| Pexp_ident (li) -> (* was (li, b) *)
if is_infix (fixity_of_longident li)
- || match li.txt with
- | Longident.Lident (li) -> List.mem li.[0] prefix_symbols
- | _ -> false
+ || match li.txt with
+ | Longident.Lident (li) -> List.mem li.[0] prefix_symbols
+ | _ -> false
then
fprintf ppf "(%a)" fmt_longident li
else
(match x.ptype_manifest with
| None -> ()
| Some(y) ->
- core_type ppf y;
- match x.ptype_kind with
- | Ptype_variant _ | Ptype_record _ -> fprintf ppf " = "
- | Ptype_abstract -> ());
+ core_type ppf y;
+ match x.ptype_kind with
+ | Ptype_variant _ | Ptype_record _ -> fprintf ppf " = "
+ | Ptype_abstract -> ());
(match x.ptype_kind with
| Ptype_variant (first::rest) ->
pp_open_hovbox ppf indent ;
| Psig_value (s, vd) ->
let intro = if vd.pval_prim = [] then "val" else "external" in
pp_open_hovbox ppf indent ;
- if (is_infix (fixity_of_string s.txt))
- || List.mem s.txt.[0] prefix_symbols then
+ if (is_infix (fixity_of_string s.txt))
+ || List.mem s.txt.[0] prefix_symbols then
fprintf ppf "%s ( %s ) :@ "
intro s.txt (* OXX done *)
- else
+ else
fprintf ppf "%s %s :@ " intro s.txt;
value_description ppf vd;
pp_close_box ppf () ;
let print_structure = structure
let print_signature = signature
-
-
Arg.usage arg_list arg_usage
end
) arg_usage
-
iter_expression exp2
| Texp_send (exp, meth, expo) ->
iter_expression exp;
- begin
- match expo with
- None -> ()
- | Some exp -> iter_expression exp
- end
+ begin
+ match expo with
+ None -> ()
+ | Some exp -> iter_expression exp
+ end
| Texp_new (path, _, _) -> ()
| Texp_instvar (_, path, _) -> ()
| Texp_setinstvar (_, _, _, exp) ->
| Tcl_structure clstr -> iter_class_structure clstr
| Tcl_fun (label, pat, priv, cl, partial) ->
iter_pattern pat;
- List.iter (fun (id, _, exp) -> iter_expression exp) priv;
+ List.iter (fun (id, _, exp) -> iter_expression exp) priv;
iter_class_expr cl
| Tcl_apply (cl, args) ->
| Tcl_let (rec_flat, bindings, ivars, cl) ->
iter_bindings rec_flat bindings;
- List.iter (fun (id, _, exp) -> iter_expression exp) ivars;
+ List.iter (fun (id, _, exp) -> iter_expression exp) ivars;
iter_class_expr cl
| Tcl_constraint (cl, Some clty, vals, meths, concrs) ->
iter_expression exp
(* | Tcf_let (rec_flag, bindings, exps) ->
iter_bindings rec_flag bindings;
- List.iter (fun (id, _, exp) -> iter_expression exp) exps; *)
+ List.iter (fun (id, _, exp) -> iter_expression exp) exps; *)
| Tcf_init exp ->
iter_expression exp
end;
let leave_bindings _ = ()
end
-
-
end
module DefaultIteratorArgument : IteratorArgument
-
Path.Pident id -> Longident.Lident (Ident.name id)
| Path.Pdot (p, s, _) -> Longident.Ldot (lident_of_path p, s)
| Path.Papply (p1, p2) ->
- Longident.Lapply (lident_of_path p1, lident_of_path p2)
+ Longident.Lapply (lident_of_path p1, lident_of_path p2)
let rec untype_structure str =
List.map untype_structure_item str.str_items
in
{ pexp_desc = desc;
pexp_loc = loc }
-
+
and untype_expression exp =
let desc =
match exp.exp_desc with
Pexp_construct (lid,
(match args with
[] -> None
- | args -> Some
- { pexp_desc = Pexp_tuple (List.map untype_expression args);
- pexp_loc = exp.exp_loc; }
+ | [ arg ] -> Some (untype_expression arg)
+ | args -> Some
+ { pexp_desc = Pexp_tuple (List.map untype_expression args);
+ pexp_loc = exp.exp_loc; }
), explicit_arity)
| Texp_variant (label, expo) ->
Pexp_variant (label, match expo with
(* *)
(***********************************************************************)
-(* $Id: expunge.ml 12061 2012-01-20 15:43:29Z frisch $ *)
+(* $Id: expunge.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* "Expunge" a toplevel by removing compiler modules from the global List.map.
Usage: expunge <source file> <dest file> <names of modules to keep> *)
let negate = Sys.argv.(3) = "-v"
-let keep =
+let keep =
if negate then fun name -> is_exn name || not (StringSet.mem name !to_keep)
else fun name -> is_exn name || (StringSet.mem name !to_keep)
(* *)
(***********************************************************************)
-(* $Id: genprintval.ml 12689 2012-07-10 14:54:19Z doligez $ *)
+(* $Id: genprintval.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* To print values *)
else Cstr_constant(O.obj obj) in
let (constr_name, constr_args,ret_type) =
Datarepr.find_constr_by_tag tag constr_list in
- let type_params =
- match ret_type with
- Some t ->
- begin match (Ctype.repr t).desc with
- Tconstr (_,params,_) ->
- params
- | _ -> assert false end
- | None -> decl.type_params
- in
+ let type_params =
+ match ret_type with
+ Some t ->
+ begin match (Ctype.repr t).desc with
+ Tconstr (_,params,_) ->
+ params
+ | _ -> assert false end
+ | None -> decl.type_params
+ in
let ty_args =
List.map
(function ty ->
(* *)
(***********************************************************************)
-(* $Id: btype.ml 12726 2012-07-18 03:34:36Z garrigue $ *)
+(* $Id: btype.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* Basic operations on core types *)
begin match decl.type_kind with
Type_abstract -> ()
| Type_variant cstrs ->
- List.iter
- (fun (c, tl, ret_type_opt) ->
- List.iter unmark_type tl;
- Misc.may unmark_type ret_type_opt)
- cstrs
+ List.iter
+ (fun (c, tl, ret_type_opt) ->
+ List.iter unmark_type tl;
+ Misc.may unmark_type ret_type_opt)
+ cstrs
| Type_record(lbls, rep) ->
List.iter (fun (c, mut, t) -> unmark_type t) lbls
end;
let may_map f v =
match v with
None -> v
- | Some x -> Some (f x)
+ | Some x -> Some (f x)
open Misc
| Tstr_module (id, name, mexpr) ->
Tstr_module (id, name, map_module_expr mexpr)
| Tstr_recmodule list ->
- let list =
+ let list =
List.map (fun (id, name, mtype, mexpr) ->
(id, name, map_module_type mtype, map_module_expr mexpr)
- ) list
- in
- Tstr_recmodule list
+ ) list
+ in
+ Tstr_recmodule list
| Tstr_modtype (id, name, mtype) ->
Tstr_modtype (id, name, map_module_type mtype)
| Tstr_open (path, lid) -> Tstr_open (path, lid)
| Tstr_class list ->
- let list =
+ let list =
List.map (fun (ci, string_list, virtual_flag) ->
- let ci = Map.enter_class_infos ci in
- let ci_expr = map_class_expr ci.ci_expr in
- (Map.leave_class_infos { ci with ci_expr = ci_expr},
+ let ci = Map.enter_class_infos ci in
+ let ci_expr = map_class_expr ci.ci_expr in
+ (Map.leave_class_infos { ci with ci_expr = ci_expr},
string_list, virtual_flag)
) list
- in
- Tstr_class list
+ in
+ Tstr_class list
| Tstr_class_type list ->
let list = List.map (fun (id, name, ct) ->
let ct = Map.enter_class_infos ct in
let ci_expr = map_class_type ct.ci_expr in
- (id, name, Map.leave_class_infos { ct with ci_expr = ci_expr})
+ (id, name, Map.leave_class_infos { ct with ci_expr = ci_expr})
) list in
- Tstr_class_type list
+ Tstr_class_type list
| Tstr_include (mexpr, idents) ->
Tstr_include (map_module_expr mexpr, idents)
in
let typ_cstrs = List.map (fun (ct1, ct2, loc) ->
(map_core_type ct1,
map_core_type ct2,
- loc)
+ loc)
) decl.typ_cstrs in
let typ_kind = match decl.typ_kind with
Ttype_abstract -> Ttype_abstract
let list = List.map (fun (s, name, cts, loc) ->
(s, name, List.map map_core_type cts, loc)
) list in
- Ttype_variant list
+ Ttype_variant list
| Ttype_record list ->
- let list =
+ let list =
List.map (fun (s, name, mut, ct, loc) ->
(s, name, mut, map_core_type ct, loc)
) list in
- Ttype_record list
+ Ttype_record list
in
let typ_manifest =
- match decl.typ_manifest with
+ match decl.typ_manifest with
None -> None
| Some ct -> Some (map_core_type ct)
in
match pat.pat_desc with
| Tpat_alias (pat1, p, text) ->
let pat1 = map_pattern pat1 in
- Tpat_alias (pat1, p, text)
- | Tpat_tuple list -> Tpat_tuple (List.map map_pattern list)
+ Tpat_alias (pat1, p, text)
+ | Tpat_tuple list -> Tpat_tuple (List.map map_pattern list)
| Tpat_construct (path, lid, cstr_decl, args, arity) ->
Tpat_construct (path, lid, cstr_decl,
List.map map_pattern args, arity)
None -> pato
| Some pat -> Some (map_pattern pat)
in
- Tpat_variant (label, pato, rowo)
+ Tpat_variant (label, pato, rowo)
| Tpat_record (list, closed) ->
Tpat_record (List.map (fun (path, lid, lab_desc, pat) ->
(path, lid, lab_desc, map_pattern pat) ) list, closed)
Texp_ident (_, _, _)
| Texp_constant _ -> exp.exp_desc
| Texp_let (rec_flag, list, exp) ->
- Texp_let (rec_flag,
- map_bindings rec_flag list,
- map_expression exp)
+ Texp_let (rec_flag,
+ map_bindings rec_flag list,
+ map_expression exp)
| Texp_function (label, cases, partial) ->
Texp_function (label, map_bindings Nonrecursive cases, partial)
| Texp_apply (exp, list) ->
Texp_apply (map_expression exp,
- List.map (fun (label, expo, optional) ->
- let expo =
- match expo with
- None -> expo
- | Some exp -> Some (map_expression exp)
- in
- (label, expo, optional)
- ) list )
+ List.map (fun (label, expo, optional) ->
+ let expo =
+ match expo with
+ None -> expo
+ | Some exp -> Some (map_expression exp)
+ in
+ (label, expo, optional)
+ ) list )
| Texp_match (exp, list, partial) ->
Texp_match (
- map_expression exp,
+ map_expression exp,
map_bindings Nonrecursive list,
- partial
- )
+ partial
+ )
| Texp_try (exp, list) ->
Texp_try (
- map_expression exp,
+ map_expression exp,
map_bindings Nonrecursive list
- )
+ )
| Texp_tuple list ->
Texp_tuple (List.map map_expression list)
| Texp_construct (path, lid, cstr_desc, args, arity) ->
let expo =match expo with
None -> expo
| Some exp -> Some (map_expression exp)
- in
- Texp_variant (label, expo)
+ in
+ Texp_variant (label, expo)
| Texp_record (list, expo) ->
- let list =
+ let list =
List.map (fun (path, lid, lab_desc, exp) ->
(path, lid, lab_desc, map_expression exp)
) list in
let expo = match expo with
None -> expo
| Some exp -> Some (map_expression exp)
- in
- Texp_record (list, expo)
+ in
+ Texp_record (list, expo)
| Texp_field (exp, path, lid, label) ->
Texp_field (map_expression exp, path, lid, label)
| Texp_setfield (exp1, path, lid, label, exp2) ->
Texp_setfield (
- map_expression exp1,
- path, lid,
- label,
+ map_expression exp1,
+ path, lid,
+ label,
map_expression exp2)
| Texp_array list ->
Texp_array (List.map map_expression list)
| Texp_ifthenelse (exp1, exp2, expo) ->
Texp_ifthenelse (
- map_expression exp1,
+ map_expression exp1,
map_expression exp2,
match expo with
None -> expo
- | Some exp -> Some (map_expression exp)
- )
+ | Some exp -> Some (map_expression exp)
+ )
| Texp_sequence (exp1, exp2) ->
- Texp_sequence (
+ Texp_sequence (
map_expression exp1,
map_expression exp2
- )
+ )
| Texp_while (exp1, exp2) ->
- Texp_while (
+ Texp_while (
map_expression exp1,
map_expression exp2
- )
+ )
| Texp_for (id, name, exp1, exp2, dir, exp3) ->
- Texp_for (
- id, name,
- map_expression exp1,
- map_expression exp2,
- dir,
- map_expression exp3
- )
- | Texp_when (exp1, exp2) ->
- Texp_when (
- map_expression exp1,
- map_expression exp2
- )
- | Texp_send (exp, meth, expo) ->
- Texp_send (map_expression exp, meth, may_map map_expression expo)
- | Texp_new (path, lid, cl_decl) -> exp.exp_desc
- | Texp_instvar (_, path, _) -> exp.exp_desc
- | Texp_setinstvar (path, lid, path2, exp) ->
- Texp_setinstvar (path, lid, path2, map_expression exp)
- | Texp_override (path, list) ->
- Texp_override (
- path,
- List.map (fun (path, lid, exp) ->
- (path, lid, map_expression exp)
- ) list
- )
- | Texp_letmodule (id, name, mexpr, exp) ->
- Texp_letmodule (
- id, name,
- map_module_expr mexpr,
- map_expression exp
- )
- | Texp_assert exp -> Texp_assert (map_expression exp)
- | Texp_assertfalse -> exp.exp_desc
- | Texp_lazy exp -> Texp_lazy (map_expression exp)
- | Texp_object (cl, string_list) ->
- Texp_object (map_class_structure cl, string_list)
- | Texp_pack (mexpr) ->
- Texp_pack (map_module_expr mexpr)
+ Texp_for (
+ id, name,
+ map_expression exp1,
+ map_expression exp2,
+ dir,
+ map_expression exp3
+ )
+ | Texp_when (exp1, exp2) ->
+ Texp_when (
+ map_expression exp1,
+ map_expression exp2
+ )
+ | Texp_send (exp, meth, expo) ->
+ Texp_send (map_expression exp, meth, may_map map_expression expo)
+ | Texp_new (path, lid, cl_decl) -> exp.exp_desc
+ | Texp_instvar (_, path, _) -> exp.exp_desc
+ | Texp_setinstvar (path, lid, path2, exp) ->
+ Texp_setinstvar (path, lid, path2, map_expression exp)
+ | Texp_override (path, list) ->
+ Texp_override (
+ path,
+ List.map (fun (path, lid, exp) ->
+ (path, lid, map_expression exp)
+ ) list
+ )
+ | Texp_letmodule (id, name, mexpr, exp) ->
+ Texp_letmodule (
+ id, name,
+ map_module_expr mexpr,
+ map_expression exp
+ )
+ | Texp_assert exp -> Texp_assert (map_expression exp)
+ | Texp_assertfalse -> exp.exp_desc
+ | Texp_lazy exp -> Texp_lazy (map_expression exp)
+ | Texp_object (cl, string_list) ->
+ Texp_object (map_class_structure cl, string_list)
+ | Texp_pack (mexpr) ->
+ Texp_pack (map_module_expr mexpr)
in
let exp_extra = List.map map_exp_extra exp.exp_extra in
Map.leave_expression {
| Texp_constraint (Some ct1, Some ct2) ->
Texp_constraint (Some (map_core_type ct1),
Some (map_core_type ct2)), loc
- | Texp_poly (Some ct) ->
- Texp_poly (Some ( map_core_type ct )), loc
- | Texp_newtype _
+ | Texp_poly (Some ct) ->
+ Texp_poly (Some ( map_core_type ct )), loc
+ | Texp_newtype _
| Texp_constraint (None, None)
| Texp_open _
- | Texp_poly None -> exp_extra
+ | Texp_poly None -> exp_extra
and map_package_type pack =
List.map (fun (id, name, decl) ->
(id, name, map_type_declaration decl)
) list
- )
+ )
| Tsig_exception (id, name, decl) ->
Tsig_exception (id, name, map_exception_declaration decl)
| Tsig_module (id, name, mtype) ->
Tmty_ident (path, lid) -> mty.mty_desc
| Tmty_signature sg -> Tmty_signature (map_signature sg)
| Tmty_functor (id, name, mtype1, mtype2) ->
- Tmty_functor (id, name, map_module_type mtype1,
+ Tmty_functor (id, name, map_module_type mtype1,
map_module_type mtype2)
| Tmty_with (mtype, list) ->
Tmty_with (map_module_type mtype,
- List.map (fun (path, lid, withc) ->
- (path, lid, map_with_constraint withc)
- ) list)
+ List.map (fun (path, lid, withc) ->
+ (path, lid, map_with_constraint withc)
+ ) list)
| Tmty_typeof mexpr ->
Tmty_typeof (map_module_expr mexpr)
in
| Tcl_structure clstr -> Tcl_structure (map_class_structure clstr)
| Tcl_fun (label, pat, priv, cl, partial) ->
Tcl_fun (label, map_pattern pat,
- List.map (fun (id, name, exp) ->
+ List.map (fun (id, name, exp) ->
(id, name, map_expression exp)) priv,
- map_class_expr cl, partial)
+ map_class_expr cl, partial)
| Tcl_apply (cl, args) ->
Tcl_apply (map_class_expr cl,
- List.map (fun (label, expo, optional) ->
+ List.map (fun (label, expo, optional) ->
(label, may_map map_expression expo,
optional)
- ) args)
+ ) args)
| Tcl_let (rec_flat, bindings, ivars, cl) ->
Tcl_let (rec_flat, map_bindings rec_flat bindings,
- List.map (fun (id, name, exp) ->
+ List.map (fun (id, name, exp) ->
(id, name, map_expression exp)) ivars,
- map_class_expr cl)
+ map_class_expr cl)
| Tcl_constraint (cl, Some clty, vals, meths, concrs) ->
Tcl_constraint ( map_class_expr cl,
match rf with
Ttag (label, bool, list) ->
Ttag (label, bool, List.map map_core_type list)
- | Tinherit ct -> Tinherit (map_core_type ct)
+ | Tinherit ct -> Tinherit (map_core_type ct)
and map_class_field cf =
let cf = Map.enter_class_field cf in
match cf.cf_desc with
Tcf_inher (ovf, cl, super, vals, meths) ->
Tcf_inher (ovf, map_class_expr cl, super, vals, meths)
- | Tcf_constr (cty, cty') ->
+ | Tcf_constr (cty, cty') ->
Tcf_constr (map_core_type cty, map_core_type cty')
- | Tcf_val (lab, name, mut, ident, Tcfk_virtual cty, override) ->
+ | Tcf_val (lab, name, mut, ident, Tcfk_virtual cty, override) ->
Tcf_val (lab, name, mut, ident, Tcfk_virtual (map_core_type cty),
override)
- | Tcf_val (lab, name, mut, ident, Tcfk_concrete exp, override) ->
+ | Tcf_val (lab, name, mut, ident, Tcfk_concrete exp, override) ->
Tcf_val (lab, name, mut, ident, Tcfk_concrete (map_expression exp),
override)
- | Tcf_meth (lab, name, priv, Tcfk_virtual cty, override) ->
+ | Tcf_meth (lab, name, priv, Tcfk_virtual cty, override) ->
Tcf_meth (lab, name, priv, Tcfk_virtual (map_core_type cty),
override)
- | Tcf_meth (lab, name, priv, Tcfk_concrete exp, override) ->
+ | Tcf_meth (lab, name, priv, Tcfk_concrete exp, override) ->
Tcf_meth (lab, name, priv, Tcfk_concrete (map_expression exp),
override)
- | Tcf_init exp -> Tcf_init (map_expression exp)
+ | Tcf_init exp -> Tcf_init (map_expression exp)
in
Map.leave_class_field { cf with cf_desc = cf_desc }
(* *)
(***********************************************************************)
-(* $Id: ctype.mli 12534 2012-06-01 05:24:38Z garrigue $ *)
+(* $Id: ctype.mli 12800 2012-07-30 18:59:07Z doligez $ *)
(* Operations on core types *)
val instance_list: Env.t -> type_expr list -> type_expr list
(* Take an instance of a list of type schemes *)
val instance_constructor:
- ?in_pattern:Env.t ref * int ->
+ ?in_pattern:Env.t ref * int ->
constructor_description -> type_expr list * type_expr
(* Same, for a constructor *)
val instance_parameterized_type:
(* *)
(***********************************************************************)
-(* $Id: datarepr.ml 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* $Id: datarepr.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* Compute constructor and label descriptions from type declarations,
determining their representation. *)
(* Simplified version of Ctype.free_vars *)
let rec free_vars ty =
let ret = ref TypeSet.empty in
- let rec loop ty =
+ let rec loop ty =
let ty = repr ty in
if ty.level >= lowest_level then begin
ty.level <- pivot_level - ty.level;
iter_row loop row;
if not (static_row row) then loop row.row_more
| _ ->
- iter_type_expr loop ty
+ iter_type_expr loop ty
end
in
loop ty;
let rec describe_constructors idx_const idx_nonconst = function
[] -> []
| (name, ty_args, ty_res_opt) :: rem ->
- let ty_res =
- match ty_res_opt with
- | Some ty_res' -> ty_res'
- | None -> ty_res
- in
+ let ty_res =
+ match ty_res_opt with
+ | Some ty_res' -> ty_res'
+ | None -> ty_res
+ in
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 existentials =
- match ty_res_opt with
- | None -> []
- | Some type_ret ->
- let res_vars = free_vars type_ret in
- let arg_vars = free_vars (newgenty (Ttuple ty_args)) in
- TypeSet.elements (TypeSet.diff arg_vars res_vars)
- in
- let cstr =
- { cstr_res = ty_res;
- cstr_existentials = existentials;
+ let existentials =
+ match ty_res_opt with
+ | None -> []
+ | Some type_ret ->
+ let res_vars = free_vars type_ret in
+ let arg_vars = free_vars (newgenty (Ttuple ty_args)) in
+ TypeSet.elements (TypeSet.diff arg_vars res_vars)
+ in
+ let cstr =
+ { cstr_res = ty_res;
+ cstr_existentials = existentials;
cstr_args = ty_args;
cstr_arity = List.length ty_args;
cstr_tag = tag;
cstr_consts = !num_consts;
cstr_nonconsts = !num_nonconsts;
- cstr_normal = !num_normal;
+ cstr_normal = !num_normal;
cstr_private = priv;
- cstr_generalized = ty_res_opt <> None
- } in
+ cstr_generalized = ty_res_opt <> None
+ } in
(name, cstr) :: descr_rem in
- describe_constructors 0 0 cstrs
+ describe_constructors 0 0 cstrs
let exception_descr path_exc decl =
{ cstr_res = Predef.type_exn;
(* *)
(***********************************************************************)
-(* $Id: env.ml 12706 2012-07-13 08:49:06Z lefessan $ *)
+(* $Id: env.ml 12820 2012-08-03 20:23:26Z frisch $ *)
(* Environment handling *)
let decl' = Subst.type_declaration sub decl in
c.comp_types <-
Tbl.add (Ident.name id) (decl', nopos) c.comp_types;
- let constructors = constructors_of_type path decl' in
- c.comp_constrs_by_path <-
- Tbl.add (Ident.name id)
- (List.map snd constructors, nopos) c.comp_constrs_by_path;
+ let constructors = constructors_of_type path decl' in
+ c.comp_constrs_by_path <-
+ Tbl.add (Ident.name id)
+ (List.map snd constructors, nopos) c.comp_constrs_by_path;
List.iter
(fun (name, descr) ->
c.comp_constrs <-
Tbl.add (Ident.name name) (descr, nopos) c.comp_constrs)
constructors;
- let labels = labels_of_type path decl' in
+ let labels = labels_of_type path decl' in
List.iter
(fun (name, descr) ->
c.comp_labels <-
let constructors = constructors_of_type path info in
let labels = labels_of_type path info in
- if not env.in_signature && not loc.Location.loc_ghost &&
+ if not loc.Location.loc_ghost &&
Warnings.is_active (Warnings.Unused_constructor ("", false, false))
then begin
let ty = Ident.name id in
if not (ty = "" || ty.[0] = '_')
then !add_delayed_check_forward
(fun () ->
- if not used.cu_positive then
+ if not env.in_signature && not used.cu_positive then
Location.prerr_warning loc
(Warnings.Unused_constructor
(c, used.cu_pattern, used.cu_privatize)))
and store_exception id path decl env =
let loc = decl.exn_loc in
- if not env.in_signature && not loc.Location.loc_ghost &&
+ if not loc.Location.loc_ghost &&
Warnings.is_active (Warnings.Unused_exception ("", false))
then begin
let ty = "exn" in
Hashtbl.add used_constructors k (add_constructor_usage used);
!add_delayed_check_forward
(fun () ->
- if not used.cu_positive then
+ if not env.in_signature && not used.cu_positive then
Location.prerr_warning loc
(Warnings.Unused_exception
(c, used.cu_pattern)
(* *)
(***********************************************************************)
-(* $Id: env.mli 12706 2012-07-13 08:49:06Z lefessan $ *)
+(* $Id: env.mli 12800 2012-07-30 18:59:07Z doligez $ *)
(* Environment handling *)
val fold_cltypes:
(string -> Path.t -> Types.class_type_declaration -> 'a -> 'a) ->
Longident.t option -> t -> 'a -> 'a
-
-
-
(* *)
(***********************************************************************)
-(* $Id: includecore.ml 12520 2012-05-31 07:41:37Z garrigue $ *)
+(* $Id: includecore.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* Inclusion checks for the core language *)
[Field_arity cstr1]
else match ret1, ret2 with
| Some r1, Some r2 when not (Ctype.equal env true [r1] [r2]) ->
- [Field_type cstr1]
+ [Field_type cstr1]
| Some _, None | None, Some _ ->
- [Field_type cstr1]
+ [Field_type cstr1]
| _ ->
- if Misc.for_all2
- (fun ty1 ty2 ->
- Ctype.equal env true (ty1::decl1.type_params)
- (ty2::decl2.type_params))
- (arg1) (arg2)
- then
- compare_variants env decl1 decl2 (n+1) rem1 rem2
- else [Field_type cstr1]
+ if Misc.for_all2
+ (fun ty1 ty2 ->
+ Ctype.equal env true (ty1::decl1.type_params)
+ (ty2::decl2.type_params))
+ (arg1) (arg2)
+ then
+ compare_variants env decl1 decl2 (n+1) rem1 rem2
+ else [Field_type cstr1]
let rec compare_records env decl1 decl2 n labels1 labels2 =
(* *)
(***********************************************************************)
-(* $Id: parmatch.ml 12726 2012-07-18 03:34:36Z garrigue $ *)
+(* $Id: parmatch.ml 12961 2012-09-27 13:30:07Z garrigue $ *)
(* Detection of partial matches and unused match cases. *)
| Tpat_variant (tag, _, row) -> is_absent tag row
| _ -> false
+let const_compare x y =
+ match x,y with
+ | Const_float f1, Const_float f2 ->
+ Pervasives.compare (float_of_string f1) (float_of_string f2)
+ | _, _ -> Pervasives.compare x y
+
let records_args l1 l2 =
(* Invariant: fields are already sorted by Typecore.type_label_a_list *)
let rec combine r1 r2 l1 l2 = match l1,l2 with
| _,(Tpat_any|Tpat_var _) -> true
| Tpat_or (p1,p2,_),_ -> compat p1 q || compat p2 q
| _,Tpat_or (q1,q2,_) -> compat p q1 || compat p q2
- | Tpat_constant c1, Tpat_constant c2 -> c1=c2
+ | Tpat_constant c1, Tpat_constant c2 -> const_compare c1 c2 = 0
| Tpat_tuple ps, Tpat_tuple qs -> compats ps qs
| Tpat_lazy p, Tpat_lazy q -> compat p q
| Tpat_construct (_, _, c1,ps1, _), Tpat_construct (_, _, c2,ps2, _) ->
c1.cstr_tag = c2.cstr_tag
| Tpat_variant(l1, _, _), Tpat_variant(l2, _, _) ->
l1 = l2
- | Tpat_constant(Const_float s1), Tpat_constant(Const_float s2) ->
- float_of_string s1 = float_of_string s2
- | Tpat_constant(c1), Tpat_constant(c2) -> c1 = c2
+ | Tpat_constant(c1), Tpat_constant(c2) -> const_compare c1 c2 = 0
| Tpat_tuple _, Tpat_tuple _ -> true
| Tpat_lazy _, Tpat_lazy _ -> true
| Tpat_record _ , Tpat_record _ -> true
function
| [] -> []
| x :: xs ->
- if generalized_constructor x then loop xs else x :: loop xs
+ if generalized_constructor x then loop xs else x :: loop xs
in
loop env
let should_extend ext env = match ext with
| None -> false
| Some ext -> match env with
- | ({pat_desc =
+ | ({pat_desc =
Tpat_construct(_, _, {cstr_tag=(Cstr_constant _|Cstr_block _)},_,_)}
as p, _) :: _ ->
let path = get_type_path p.pat_type p.pat_env in
| {type_kind=Type_variant constr_list} ->
begin match (Ctype.repr ty).desc with
| Tconstr (path,_,_) ->
- path
+ path
| _ -> assert false end
| {type_manifest = Some _} ->
adt_path env (Ctype.expand_head_once env (clean_copy ty))
function
[] -> []
| x :: xs ->
- match f x with
- | None -> map_filter f xs
- | Some y -> y :: map_filter f xs
+ match f x with
+ | None -> map_filter f xs
+ | Some y -> y :: map_filter f xs
(* Sends back a pattern that complements constructor tags all_tag *)
let complete_constrs p all_tags =
match p.pat_desc with
| Tpat_construct (_,_,c,_,_) ->
begin try
- let not_tags = complete_tags c.cstr_consts c.cstr_nonconsts all_tags in
- let constrs =
+ let not_tags = complete_tags c.cstr_consts c.cstr_nonconsts all_tags in
+ let constrs =
Env.find_constructors (adt_path p.pat_env p.pat_type) p.pat_env in
- map_filter
+ map_filter
(fun cnstr ->
- if List.mem cnstr.cstr_tag not_tags then Some cnstr else None)
- constrs
+ if List.mem cnstr.cstr_tag not_tags then Some cnstr else None)
+ constrs
with
| Datarepr.Constr_not_found ->
- fatal_error "Parmatch.complete_constr: constr_not_found"
+ fatal_error "Parmatch.complete_constr: constr_not_found"
end
| _ -> fatal_error "Parmatch.complete_constr"
| {pat_desc = Tpat_construct (_,_,c,_,_)} -> c.cstr_tag
| _ -> fatal_error "Parmatch.get_tag" in
let all_tags = List.map (fun (p,_) -> get_tag p) env in
- let cnstrs = complete_constrs p all_tags in
- let pats = List.map (pat_of_constr p) cnstrs in
+ let cnstrs = complete_constrs p all_tags in
+ let pats = List.map (pat_of_constr p) cnstrs in
(* List.iter (Format.eprintf "%a@." top_pretty) pats;
Format.eprintf "@.@."; *)
pats
match f (p,pss) with
| Rnone -> try_many f rest
| Rsome sofar ->
- let others = try_many f rest in
- match others with
- Rnone -> Rsome sofar
- | Rsome sofar' ->
- Rsome (sofar @ sofar')
+ let others = try_many f rest in
+ match others with
+ Rnone -> Rsome sofar
+ | Rsome sofar' ->
+ Rsome (sofar @ sofar')
let combinations f lst lst' =
let rec iter2 x =
function
- [] -> []
+ [] -> []
| y :: ys ->
- f x y :: iter2 x ys
+ f x y :: iter2 x ys
in
let rec iter =
function
- [] -> []
+ [] -> []
| x :: xs -> iter2 x lst' @ iter xs
in
iter lst
with
| Rsome r -> Rsome (List.map (fun row -> (set_args p row)) r)
| r -> r in
- let before = try_many_gadt try_non_omega constrs in
+ let before = try_many_gadt try_non_omega constrs in
if
- full_match_gadt constrs && not (should_extend ext constrs)
+ full_match_gadt constrs && not (should_extend ext constrs)
then
- before
+ before
else
(*
D = filter_extra pss is the default matrix
| Rnone -> before
| Rsome r ->
try
- let missing_trailing = build_other_gadt ext constrs in
- let before =
- match before with
- Rnone -> []
- | Rsome lst -> lst
- in
- let dug =
- combinations
- (fun head tail -> head :: tail)
- missing_trailing
- r
- in
+ let missing_trailing = build_other_gadt ext constrs in
+ let before =
+ match before with
+ Rnone -> []
+ | Rsome lst -> lst
+ in
+ let dug =
+ combinations
+ (fun head tail -> head :: tail)
+ missing_trailing
+ r
+ in
Rsome (dug @ before)
with
(* cannot occur, since constructors don't make a full signature *)
(* The following line is needed to compile stdlib/printf.ml *)
if lst = [] then Rsome (omegas n) else
let singletons =
- List.map
- (function
- [x] -> x
- | _ -> assert false)
- lst
+ List.map
+ (function
+ [x] -> x
+ | _ -> assert false)
+ lst
in
Rsome [orify_many singletons]
| (Tpat_var _|Tpat_any),_ -> true
| Tpat_alias(p,_,_), _ -> le_pat p q
| _, Tpat_alias(q,_,_) -> le_pat p q
- | Tpat_constant(c1), Tpat_constant(c2) -> c1 = c2
+ | Tpat_constant(c1), Tpat_constant(c2) -> const_compare c1 c2 = 0
| Tpat_construct(_,_,c1,ps,_), Tpat_construct(_,_,c2,qs,_) ->
c1.cstr_tag = c2.cstr_tag && le_pats ps qs
| Tpat_variant(l1,Some p1,_), Tpat_variant(l2,Some p2,_) ->
| _,(Tpat_any|Tpat_var _) -> p
| Tpat_or (p1,p2,_),_ -> orlub p1 p2 q
| _,Tpat_or (q1,q2,_) -> orlub q1 q2 p (* Thanks god, lub is commutative *)
-| Tpat_constant c1, Tpat_constant c2 when c1=c2 -> p
+| Tpat_constant c1, Tpat_constant c2 when const_compare c1 c2 = 0 -> p
| Tpat_tuple ps, Tpat_tuple qs ->
let rs = lubs ps qs in
make_pat (Tpat_tuple rs) p.pat_type p.pat_env
function
| [] -> None
| x :: xs ->
- match f x with
- | None -> get_first f xs
- | x -> x
+ match f x with
+ | None -> get_first f xs
+ | x -> x
(* conversion from Typedtree.pattern to Parsetree.pattern list *)
function
| xs :: [] -> List.map (fun y -> [y]) xs
| (x::xs)::ys ->
- List.map
- (fun lst -> x :: lst)
- (select ys)
- @
- select (xs::ys)
+ List.map
+ (fun lst -> x :: lst)
+ (select ys)
+ @
+ select (xs::ys)
| _ -> []
let name_counter = ref 0
let rec loop pat =
match pat.pat_desc with
Tpat_or (a,b,_) ->
- loop a @ loop b
+ loop a @ loop b
| Tpat_any | Tpat_constant _ | Tpat_var _ ->
- [mkpat Ppat_any]
+ [mkpat Ppat_any]
| Tpat_alias (p,_,_) -> loop p
| Tpat_tuple lst ->
- let results = select (List.map loop lst) in
- List.map
- (fun lst -> mkpat (Ppat_tuple lst))
- results
+ let results = select (List.map loop lst) in
+ List.map
+ (fun lst -> mkpat (Ppat_tuple lst))
+ results
| Tpat_construct (cstr_path, cstr_lid, cstr,lst,_) ->
- let id = fresh () in
+ let id = fresh () in
let lid = { cstr_lid with txt = Longident.Lident id } in
- Hashtbl.add constrs id (cstr_path,cstr);
- let results = select (List.map loop lst) in
- begin match lst with
- [] ->
- [mkpat (Ppat_construct(lid, None, false))]
+ Hashtbl.add constrs id (cstr_path,cstr);
+ let results = select (List.map loop lst) in
+ begin match lst with
+ [] ->
+ [mkpat (Ppat_construct(lid, None, false))]
| _ ->
- List.map
- (fun lst ->
- let arg =
- match lst with
- [] -> assert false
- | [x] -> Some x
- | _ -> Some (mkpat (Ppat_tuple lst))
- in
- mkpat (Ppat_construct(lid, arg, false)))
- results
+ List.map
+ (fun lst ->
+ let arg =
+ match lst with
+ [] -> assert false
+ | [x] -> Some x
+ | _ -> Some (mkpat (Ppat_tuple lst))
+ in
+ mkpat (Ppat_construct(lid, arg, false)))
+ results
end
| Tpat_variant(label,p_opt,row_desc) ->
- begin match p_opt with
- | None ->
- [mkpat (Ppat_variant(label, None))]
- | Some p ->
- let results = loop p in
- List.map
- (fun p ->
- mkpat (Ppat_variant(label, Some p)))
- results
+ begin match p_opt with
+ | None ->
+ [mkpat (Ppat_variant(label, None))]
+ | Some p ->
+ let results = loop p in
+ List.map
+ (fun p ->
+ mkpat (Ppat_variant(label, Some p)))
+ results
end
| Tpat_record (subpatterns, _closed_flag) ->
- let pats =
- select
- (List.map (fun (_,_,_,x) -> (loop x)) subpatterns)
- in
- let label_idents =
- List.map
- (fun (lbl_path,_,lbl,_) ->
- let id = fresh () in
- Hashtbl.add labels id (lbl_path, lbl);
- Longident.Lident id)
- subpatterns
- in
- List.map
- (fun lst ->
- let lst = List.map2 (fun lid pat ->
+ let pats =
+ select
+ (List.map (fun (_,_,_,x) -> (loop x)) subpatterns)
+ in
+ let label_idents =
+ List.map
+ (fun (lbl_path,_,lbl,_) ->
+ let id = fresh () in
+ Hashtbl.add labels id (lbl_path, lbl);
+ Longident.Lident id)
+ subpatterns
+ in
+ List.map
+ (fun lst ->
+ let lst = List.map2 (fun lid pat ->
(mknoloc lid, pat)
) label_idents lst in
mkpat (Ppat_record (lst, Open)))
- pats
+ pats
| Tpat_array lst ->
- let results = select (List.map loop lst) in
- List.map (fun lst -> mkpat (Ppat_array lst)) results
+ let results = select (List.map loop lst) in
+ List.map (fun lst -> mkpat (Ppat_array lst)) results
| Tpat_lazy p ->
- let results = loop p in
- List.map (fun p -> mkpat (Ppat_lazy p)) results
+ let results = loop p in
+ List.map (fun p -> mkpat (Ppat_lazy p)) results
in
let ps = loop typed in
(ps, constrs, labels)
begin match exhaust None pss (List.length ps) with
| Rnone -> Total
| Rsome [u] ->
- let v =
- match pred with
- | Some pred ->
- let (patterns,constrs,labels) = Conv.conv u in
+ let v =
+ match pred with
+ | Some pred ->
+ let (patterns,constrs,labels) = Conv.conv u in
(* Hashtbl.iter (fun s (path, _) ->
Printf.fprintf stderr "CONV: %s -> %s \n%!" s (Path.name path))
constrs
; *)
- get_first (pred constrs labels) patterns
- | None -> Some u
- in
- begin match v with
- None -> Total
- | Some v ->
+ get_first (pred constrs labels) patterns
+ | None -> Some u
+ in
+ begin match v with
+ None -> Total
+ | Some v ->
let errmsg =
try
- let buf = Buffer.create 16 in
- let fmt = formatter_of_buffer buf in
- top_pretty fmt v;
- begin match check_partial_all v casel with
- | None -> ()
- | Some _ ->
+ let buf = Buffer.create 16 in
+ let fmt = formatter_of_buffer buf in
+ top_pretty fmt v;
+ begin match check_partial_all v casel with
+ | None -> ()
+ | Some _ ->
(* This is 'Some loc', where loc is the location of
a possibly matching clause.
Forget about loc, because printing two locations
is a pain in the top-level *)
Buffer.add_string buf
"\n(However, some guarded clause may match this value.)"
- end ;
- Buffer.contents buf
+ end ;
+ Buffer.contents buf
with _ ->
- "" in
+ "" in
Location.prerr_warning loc (Warnings.Partial_match errmsg) ;
Partial end
| _ ->
let pss = get_mins le_pats pss in
let total = do_check_partial loc casel pss in
if
- total = Total && Warnings.is_active (Warnings.Fragile_match "")
+ total = Total && Warnings.is_active (Warnings.Fragile_match "")
then begin
- do_check_fragile loc casel pss
+ do_check_fragile loc casel pss
end ;
total
end else
(* *)
(***********************************************************************)
-(* $Id: parmatch.mli 12521 2012-05-31 07:57:32Z garrigue $ *)
+(* $Id: parmatch.mli 12961 2012-09-27 13:30:07Z garrigue $ *)
(* Detection of partial matches and unused match cases. *)
open Asttypes
val all_record_args :
(Path.t * Longident.t loc * label_description * pattern) list ->
(Path.t * Longident.t loc * label_description * pattern) list
+val const_compare : constant -> constant -> int
val le_pat : pattern -> pattern -> bool
val le_pats : pattern list -> pattern list -> bool
(* *)
(***********************************************************************)
-(* $Id: printtyp.ml 12520 2012-05-31 07:41:37Z garrigue $ *)
+(* $Id: printtyp.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* Printing functions *)
| Type_abstract -> ()
| Type_variant cstrs ->
List.iter
- (fun (_, args,ret_type_opt) ->
- List.iter mark_loops args;
- may mark_loops ret_type_opt)
- cstrs
+ (fun (_, args,ret_type_opt) ->
+ List.iter mark_loops args;
+ may mark_loops ret_type_opt)
+ cstrs
| Type_record(l, rep) ->
List.iter (fun (_, _, ty) -> mark_loops ty) l
end;
and string_option_underscore i ppf =
function
| Some x ->
- string i ppf x.txt
+ string i ppf x.txt
| None ->
- string i ppf "_"
+ string i ppf "_"
and type_declaration i ppf x =
line i ppf "type_declaration %a\n" fmt_location x.typ_loc;
(* *)
(***********************************************************************)
-(* $Id: subst.ml 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* $Id: subst.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* Substitutions *)
Type_variant
(List.map
(fun (n, args, ret_type) ->
- (n, List.map (typexp s) args, may_map (typexp s) ret_type))
+ (n, List.map (typexp s) args, may_map (typexp s) ret_type))
cstrs)
| Type_record(lbls, rep) ->
Type_record
end;
type_manifest =
begin
- match decl.type_manifest with
+ match decl.type_manifest with
None -> None
| Some ty -> Some(typexp s ty)
end;
(* *)
(***********************************************************************)
-(* $Id: typeclass.ml 12616 2012-06-19 10:51:33Z garrigue $ *)
+(* $Id: typeclass.ml 12800 2012-07-30 18:59:07Z doligez $ *)
open Misc
open Parsetree
"instance variable"
| No_overriding (kind, name) ->
fprintf ppf "@[The %s `%s'@ has no previous definition@]" kind name
-
(* *)
(***********************************************************************)
-(* $Id: typecore.ml 12726 2012-07-18 03:34:36Z garrigue $ *)
+(* $Id: typecore.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* Typechecking for the core language *)
let create_package_type loc env (p, l) =
let s = !Typetexp.transl_modtype_longident loc env p in
let fields = List.map (fun (name, ct) ->
- name, Typetexp.transl_simple_type env false ct) l in
+ name, Typetexp.transl_simple_type env false ct) l in
let ty = newty (Tpackage (s,
List.map fst l,
List.map (fun (_, cty) -> cty.ctyp_type) fields))
let (obj_ty, res_ty) = filter_arrow env method_type "" in
unify env obj_ty desc.val_type;
unify env res_ty (instance env typ);
- let exp =
- Texp_apply({exp_desc =
+ let exp =
+ Texp_apply({exp_desc =
Texp_ident(Path.Pident method_id, lid,
{val_type = method_type;
val_kind = Val_reg;
exp_type = desc.val_type;
exp_env = env},
Required])
- in
+ in
(Tmeth_name met, Some (re {exp_desc = exp;
- exp_loc = loc; exp_extra = [];
- exp_type = typ;
- exp_env = env}), typ)
+ exp_loc = loc; exp_extra = [];
+ exp_type = typ;
+ exp_env = env}), typ)
| _ ->
assert false
end
let () =
Env.add_delayed_check_forward := add_delayed_check
-
(* *)
(***********************************************************************)
-(* $Id: typedecl.ml 12609 2012-06-14 10:47:30Z garrigue $ *)
+(* $Id: typedecl.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(**** Typing of type definitions ****)
try
List.map
(function
- None -> Ctype.new_global_var ~name:"_" ()
- | Some x -> enter_type_variable true sdecl.ptype_loc x.txt)
+ None -> Ctype.new_global_var ~name:"_" ()
+ | Some x -> enter_type_variable true sdecl.ptype_loc x.txt)
sdecl.ptype_params
with Already_bound ->
raise(Error(sdecl.ptype_loc, Repeated_parameter))
all_constrs := StringSet.add name !all_constrs)
cstrs;
if List.length
- (List.filter (fun (_, args, _, _) -> args <> []) cstrs)
- > (Config.max_tag + 1) then
+ (List.filter (fun (_, args, _, _) -> args <> []) cstrs)
+ > (Config.max_tag + 1) then
raise(Error(sdecl.ptype_loc, Too_many_constructors));
- let make_cstr (lid, args, ret_type, loc) =
- let name = Ident.create lid.txt in
- match ret_type with
- | None ->
- (name, lid, List.map (transl_simple_type env true) args, None, loc)
- | Some sty ->
+ let make_cstr (lid, args, ret_type, loc) =
+ let name = Ident.create lid.txt in
+ match ret_type with
+ | None ->
+ (name, lid, List.map (transl_simple_type env true) args, None, loc)
+ | Some sty ->
(* if it's a generalized constructor we must first narrow and
then widen so as to not introduce any new constraints *)
- let z = narrow () in
- reset_type_variables ();
- let args = List.map (transl_simple_type env false) args in
- let ret_type =
+ let z = narrow () in
+ reset_type_variables ();
+ let args = List.map (transl_simple_type env false) args in
+ let ret_type =
let cty = transl_simple_type env false sty in
let ty = cty.ctyp_type in
let p = Path.Pident id in
| _ ->
raise (Error (sty.ptyp_loc, Constraint_failed
(ty, Ctype.newconstr p params)))
- in
- widen z;
- (name, lid, args, Some ret_type, loc)
- in
+ in
+ widen z;
+ (name, lid, args, Some ret_type, loc)
+ in
let cstrs = List.map make_cstr cstrs in
- Ttype_variant (List.map (fun (name, lid, ctys, _, loc) ->
+ Ttype_variant (List.map (fun (name, lid, ctys, _, loc) ->
name, lid, ctys, loc
) cstrs),
Type_variant (List.map (fun (name, name_loc, ctys, option, loc) ->
()
| Type_variant v ->
List.iter
- (fun (_, tyl, ret_type) ->
- List.iter Ctype.generalize tyl;
- may Ctype.generalize ret_type)
- v
+ (fun (_, tyl, ret_type) ->
+ List.iter Ctype.generalize tyl;
+ may Ctype.generalize ret_type)
+ v
| Type_record(r, rep) ->
List.iter (fun (_, _, ty) -> Ctype.generalize ty) r
end;
(fun (name, tyl, ret_type) ->
let (styl, sret_type) =
try
- let (_, sty, sret_type, _) =
- List.find (fun (n,_,_,_) -> n.txt = Ident.name name) pl
- in (sty, sret_type)
+ let (_, sty, sret_type, _) =
+ List.find (fun (n,_,_,_) -> n.txt = Ident.name name) pl
+ in (sty, sret_type)
with Not_found -> assert false in
List.iter2
(fun sty ty ->
check_constraints_rec env sty.ptyp_loc visited ty)
styl tyl;
- match sret_type, ret_type with
- | Some sr, Some r ->
- check_constraints_rec env sr.ptyp_loc visited r
- | _ ->
- () )
- l
+ match sret_type, ret_type with
+ | Some sr, Some r ->
+ check_constraints_rec env sr.ptyp_loc visited r
+ | _ ->
+ () )
+ l
| Type_record (l, _) ->
let rec find_pl = function
Ptype_record pl -> pl
let constraints = List.map
(function (ty, ty', loc) ->
try
- let cty = transl_simple_type env false ty in
- let cty' = transl_simple_type env false ty' in
+ let cty = transl_simple_type env false ty in
+ let cty' = transl_simple_type env false ty' in
let ty = cty.ctyp_type in
let ty' = cty'.ctyp_type in
Ctype.unify env ty ty';
begin match decl.type_kind, decl.type_manifest with
| Type_variant tl, _ ->
explain_unbound ppf ty tl (fun (_,tl,_) ->
- Btype.newgenty (Ttuple tl))
+ Btype.newgenty (Ttuple tl))
"case" (fun (lab,_,_) -> Ident.name lab ^ " of ")
| Type_record (tl, _), _ ->
explain_unbound ppf ty tl (fun (_,_,t) -> t)
(* *)
(***********************************************************************)
-(* $Id: typemod.ml 12755 2012-07-21 01:19:45Z garrigue $ *)
+(* $Id: typemod.ml 12800 2012-07-30 18:59:07Z doligez $ *)
open Misc
open Longident
List.map (fun (c,n) -> (not n, not c, not c))
sdecl.ptype_variance;
type_loc = Location.none;
- type_newtype_level = None }
+ type_newtype_level = None }
and id_row = Ident.create (s^"#row") in
let initial_env = Env.add_type id_row decl_row initial_env in
let tdecl = Typedecl.transl_with_constraint
match sg with
[] -> [], [], env
| item :: srem ->
- let loc = item.psig_loc in
+ let loc = item.psig_loc in
match item.psig_desc with
| Psig_value(name, sdesc) ->
let tdesc = Typedecl.transl_value_decl env item.psig_loc sdesc in
mksig (Tsig_class
(List.map2
(fun pcl tcl ->
- let (_, _, _, _, _, _, _, _, _, _, _, tcl) = tcl in
+ let (_, _, _, _, _, _, _, _, _, _, _, tcl) = tcl in
tcl)
- cl classes)) env loc
+ cl classes)) env loc
:: trem,
List.flatten
(map_rec
let (classes, newenv) = Typeclass.class_type_declarations env cl in
let (trem,rem, final_env) = transl_sig newenv srem in
mksig (Tsig_class_type (List.map2 (fun pcl tcl ->
- let (_, _, _, _, _, _, _, tcl) = tcl in
- tcl
- ) cl classes)) env loc :: trem,
+ let (_, _, _, _, _, _, _, tcl) = tcl in
+ tcl
+ ) cl classes)) env loc :: trem,
List.flatten
(map_rec
(fun rs (i, _, d, i', d', i'', d'', _) ->
[] ->
([], [], env)
| pstr :: srem ->
- let loc = pstr.pstr_loc in
- match pstr.pstr_desc with
- | Pstr_eval sexpr ->
- let expr = Typecore.type_expression env sexpr in
- let (str_rem, sig_rem, final_env) = type_struct env srem in
- (mkstr (Tstr_eval expr) loc :: str_rem, sig_rem, final_env)
- | Pstr_value(rec_flag, sdefs) ->
+ let loc = pstr.pstr_loc in
+ match pstr.pstr_desc with
+ | Pstr_eval sexpr ->
+ let expr = Typecore.type_expression env sexpr in
+ let (str_rem, sig_rem, final_env) = type_struct env srem in
+ (mkstr (Tstr_eval expr) loc :: str_rem, sig_rem, final_env)
+ | Pstr_value(rec_flag, sdefs) ->
let scope =
match rec_flag with
| Recursive -> Some (Annot.Idef {scope with
Sig_modtype(id, Modtype_manifest mty.mty_type) :: sig_rem,
final_env)
| Pstr_open (lid) ->
- let (path, newenv) = type_open ~toplevel env loc lid in
- let (str_rem, sig_rem, final_env) = type_struct newenv srem in
- (mkstr (Tstr_open (path, lid)) loc :: str_rem, sig_rem, final_env)
+ let (path, newenv) = type_open ~toplevel env loc lid in
+ let (str_rem, sig_rem, final_env) = type_struct newenv srem in
+ (mkstr (Tstr_open (path, lid)) loc :: str_rem, sig_rem, final_env)
| Pstr_class cl ->
List.iter
(fun {pci_name = name} -> check "type" loc type_names name.txt)
(* *)
(***********************************************************************)
-(* $Id: types.mli 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* $Id: types.mli 12800 2012-07-30 18:59:07Z doligez $ *)
(* Representation of types and declarations *)
cstr_args: type_expr list; (* Type of the arguments *)
cstr_arity: int; (* Number of arguments *)
cstr_tag: constructor_tag; (* Tag for heap blocks *)
- cstr_consts: int; (* Number of constant constructors *)
+ cstr_consts: int; (* Number of constant constructors *)
cstr_nonconsts: int; (* Number of non-const constructors *)
cstr_normal: int; (* Number of non generalized constrs *)
cstr_generalized: bool; (* Constrained return type? *)
with Unify trace ->
raise (Error(styp.ptyp_loc, Type_mismatch trace))
end;
- ctyp (Ttyp_constr (path, lid, args)) constr env loc
+ ctyp (Ttyp_constr (path, lid, args)) constr env loc
| Ptyp_object fields ->
let fields = List.map
(fun pf ->
- let desc =
- match pf.pfield_desc with
- | Pfield_var -> Tcfield_var
- | Pfield (s,e) ->
- let ty1 = transl_type env policy e in
- Tcfield (s, ty1)
- in
- { field_desc = desc; field_loc = pf.pfield_loc })
- fields in
+ let desc =
+ match pf.pfield_desc with
+ | Pfield_var -> Tcfield_var
+ | Pfield (s,e) ->
+ let ty1 = transl_type env policy e in
+ Tcfield (s, ty1)
+ in
+ { field_desc = desc; field_loc = pf.pfield_loc })
+ fields in
let ty = newobj (transl_fields env policy [] fields) in
- ctyp (Ttyp_object fields) ty env loc
+ ctyp (Ttyp_object fields) ty env loc
| Ptyp_class(lid, stl, present) ->
let (path, decl, is_variant) =
try
try unify_var env ty' cty.ctyp_type with Unify trace ->
raise (Error(sty.ptyp_loc, Type_mismatch (swap_list trace))))
(List.combine stl args) params;
- let ty_args = List.map (fun ctyp -> ctyp.ctyp_type) args in
+ let ty_args = List.map (fun ctyp -> ctyp.ctyp_type) args in
let ty =
try Ctype.expand_head env (newconstr path ty_args)
with Unify trace ->
| _ ->
assert false
in
- ctyp (Ttyp_class (path, lid, args, present)) ty env loc
+ ctyp (Ttyp_class (path, lid, args, present)) ty env loc
| Ptyp_alias(st, alias) ->
let cty =
try
let tl = List.map (transl_type env policy) stl in
let f = match present with
Some present when not (List.mem l present) ->
- let ty_tl = List.map (fun cty -> cty.ctyp_type) tl in
+ let ty_tl = List.map (fun cty -> cty.ctyp_type) tl in
Reither(c, ty_tl, false, ref None)
| _ ->
if List.length stl > 1 || c && stl <> [] then
raise(Error(styp.ptyp_loc, Present_has_conjunction l));
match tl with [] -> Rpresent None
| st :: _ ->
- Rpresent (Some st.ctyp_type)
+ Rpresent (Some st.ctyp_type)
in
add_typed_field styp.ptyp_loc l f;
- Ttag (l,c,tl)
+ Ttag (l,c,tl)
| Rinherit sty ->
let cty = transl_type env policy sty in
- let ty = cty.ctyp_type in
+ let ty = cty.ctyp_type in
let nm =
match repr cty.ctyp_type with
{desc=Tconstr(p, tl, _)} -> Some(p, tl)
in
add_typed_field sty.ptyp_loc l f)
fl;
- Tinherit cty
+ Tinherit cty
in
let tfields = List.map add_field fields in
let fields = Hashtbl.fold (fun _ p l -> p :: l) hfields [] in
let mty = !transl_modtype env mty in
widen z;
let ptys = List.map (fun (s, pty) ->
- s, transl_type env policy pty
- ) l in
+ s, transl_type env policy pty
+ ) l in
let path = !transl_modtype_longident styp.ptyp_loc env p.txt in
let ty = newty (Tpackage (path,
List.map (fun (s, pty) -> s.txt) l,
List.map (fun (_,cty) -> cty.ctyp_type) ptys))
in
- ctyp (Ttyp_package {
- pack_name = path;
- pack_type = mty.mty_type;
- pack_fields = ptys;
+ ctyp (Ttyp_package {
+ pack_name = path;
+ pack_type = mty.mty_type;
+ pack_fields = ptys;
pack_txt = p;
- }) ty env loc
+ }) ty env loc
and transl_fields env policy seen =
function
in
make_fixed_univars typ.ctyp_type;
{ typ with ctyp_type =
- instance env (Btype.newgenty (Tpoly (typ.ctyp_type, univs))) }
+ instance env (Btype.newgenty (Tpoly (typ.ctyp_type, univs))) }
let transl_simple_type_delayed env styp =
univars := []; used_variables := Tbl.empty;
(* *)
(***********************************************************************)
-(* $Id: clflags.mli 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* $Id: clflags.mli 12800 2012-07-30 18:59:07Z doligez $ *)
val objfiles : string list ref
val ccobjs : string list ref
val shared : bool ref
val dlcode : bool ref
val runtime_variant : string ref
-
(* *)
(***********************************************************************)
-(* $Id: misc.ml 12511 2012-05-30 13:29:48Z lefessan $ *)
+(* $Id: misc.ml 12800 2012-07-30 18:59:07Z doligez $ *)
(* Errors *)
let fst4 (x, _, _, _) = x
let snd4 (_,x,_, _) = x
let thd4 (_,_,x,_) = x
-
/* Based on public-domain code from Berkeley Yacc */
-/* $Id: main.c 11156 2011-07-27 14:17:02Z doligez $ */
+/* $Id: main.c 12800 2012-07-30 18:59:07Z doligez $ */
#include <signal.h>
#include <string.h>
if (action_fd == -1)
open_error(action_file_name);
entry_fd = mkstemp(entry_file_name);
- if (entry_fd == -1)
+ if (entry_fd == -1)
open_error(entry_file_name);
text_fd = mkstemp(text_file_name);
if (text_fd == -1)
/* Based on public-domain code from Berkeley Yacc */
-/* $Id: skeleton.c 11156 2011-07-27 14:17:02Z doligez $ */
+/* $Id: skeleton.c 12834 2012-08-06 14:16:24Z doligez $ */
#include "defs.h"
char *header[] =
{
"open Parsing;;",
+ "let _ = parse_error;;", /* avoid warning 33 (PR#5719) */
0
};
projects / ocaml.git / commitdiff