diff options
106 files changed, 1096 insertions, 1060 deletions
diff --git a/Makefile.Mac.depend b/Makefile.Mac.depend index 174312af2c..50897af5bc 100644 --- a/Makefile.Mac.depend +++ b/Makefile.Mac.depend @@ -67,7 +67,7 @@ :typing:env.cmi :typing:ident.cmi :parsing:location.cmi :parsing:longident.cmi :parsing:parsetree.cmi :typing:path.cmi :typing:typedtree.cmi :typing:types.cmi -:typing:typecore.cmi :parsing:asttypes.cmi :typing:env.cmi +:typing:typecore.cmi :parsing:asttypes.cmi :typing:env.cmi :typing:ident.cmi :parsing:location.cmi :parsing:longident.cmi :parsing:parsetree.cmi :typing:typedtree.cmi :typing:types.cmi :typing:typedecl.cmi :typing:env.cmi :typing:ident.cmi :parsing:location.cmi @@ -134,8 +134,8 @@ :typing:types.cmi :typing:predef.cmi :typing:predef.cmx :typing:btype.cmx :typing:ident.cmx :typing:path.cmx :typing:types.cmx :typing:predef.cmi -:typing:primitive.cmo :typing:primitive.cmi -:typing:primitive.cmx :typing:primitive.cmi +:typing:primitive.cmo :utils:misc.cmi :typing:primitive.cmi +:typing:primitive.cmx :utils:misc.cmx :typing:primitive.cmi :typing:printtyp.cmo :parsing:asttypes.cmi :typing:btype.cmi :typing:ctype.cmi :typing:ident.cmi :parsing:longident.cmi :utils:misc.cmi :typing:path.cmi :typing:primitive.cmi :typing:types.cmi @@ -148,14 +148,14 @@ :typing:path.cmi :utils:tbl.cmi :typing:types.cmi :typing:subst.cmi :typing:subst.cmx :typing:btype.cmx :typing:ident.cmx :utils:misc.cmx :typing:path.cmx :utils:tbl.cmx :typing:types.cmx :typing:subst.cmi -:typing:typeclass.cmo :parsing:asttypes.cmi :typing:ctype.cmi - :typing:env.cmi :typing:ident.cmi :parsing:location.cmi +:typing:typeclass.cmo :parsing:asttypes.cmi :typing:btype.cmi + :typing:ctype.cmi :typing:env.cmi :typing:ident.cmi :parsing:location.cmi :parsing:longident.cmi :utils:misc.cmi :parsing:parsetree.cmi :typing:path.cmi :typing:printtyp.cmi :typing:subst.cmi :typing:typecore.cmi :typing:typedtree.cmi :typing:types.cmi :typing:typetexp.cmi :typing:typeclass.cmi -:typing:typeclass.cmx :parsing:asttypes.cmi :typing:ctype.cmx - :typing:env.cmx :typing:ident.cmx :parsing:location.cmx +:typing:typeclass.cmx :parsing:asttypes.cmi :typing:btype.cmx + :typing:ctype.cmx :typing:env.cmx :typing:ident.cmx :parsing:location.cmx :parsing:longident.cmx :utils:misc.cmx :parsing:parsetree.cmi :typing:path.cmx :typing:printtyp.cmx :typing:subst.cmx :typing:typecore.cmx :typing:typedtree.cmx :typing:types.cmx diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index a9c26457a8..fe06d2eadd 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -452,7 +452,7 @@ let rec transl = function bind "met" (lookup_label obj (transl met)) (fun clos -> Cop(Capply typ_addr, Cconst_symbol(apply_function arity) :: - obj :: (List.map transl args) @ [clos]))) + obj :: (List.map transl args) @ [clos]))) | Ulet(id, exp, body) -> if is_unboxed_float exp then begin let unboxed_id = Ident.create (Ident.name id) in diff --git a/asmrun/alpha.S b/asmrun/alpha.S index 0091b2520f..7c02ec230c 100644 --- a/asmrun/alpha.S +++ b/asmrun/alpha.S @@ -259,7 +259,7 @@ caml_start_program: /* Code shared with callback* */ $107: /* Save return address */ - lda $sp, -128($sp) + lda $sp, -128($sp) stq $26, 0($sp) /* Save all callee-save registers */ stq $9, 8($sp) diff --git a/asmrun/i386.S b/asmrun/i386.S index 7a4635505b..a700b1f58c 100644 --- a/asmrun/i386.S +++ b/asmrun/i386.S @@ -30,7 +30,7 @@ /* Allocation */ .text - .globl G(caml_call_gc) + .globl G(caml_call_gc) .globl G(caml_alloc1) .globl G(caml_alloc2) .globl G(caml_alloc3) @@ -108,13 +108,13 @@ L102: movl 0(%esp), %eax .align FUNCTION_ALIGN G(caml_alloc): - subl G(young_ptr), %eax /* eax = size - young_ptr */ + subl G(young_ptr), %eax /* eax = size - young_ptr */ negl %eax /* eax = young_ptr - size */ cmpl G(young_limit), %eax jb L103 movl %eax, G(young_ptr) ret -L103: subl G(young_ptr), %eax /* eax = - size */ +L103: subl G(young_ptr), %eax /* eax = - size */ negl %eax /* eax = size */ pushl %eax /* save desired size */ subl %eax, G(young_ptr) /* must update young_ptr */ diff --git a/asmrun/m68k.S b/asmrun/m68k.S index 7b3ee4a1fd..38b9c58fb2 100644 --- a/asmrun/m68k.S +++ b/asmrun/m68k.S @@ -19,7 +19,7 @@ | Allocation .text - .globl _caml_call_gc + .globl _caml_call_gc .globl _caml_alloc1 .globl _caml_alloc2 .globl _caml_alloc3 diff --git a/asmrun/mips.S b/asmrun/mips.S index fa7b3d6cfb..7ddc96ae67 100644 --- a/asmrun/mips.S +++ b/asmrun/mips.S @@ -72,8 +72,8 @@ caml_call_gc: #ifdef _PIC - .set noreorder - .cpload $25 + .set noreorder + .cpload $25 .set reorder #endif /* Record return address and adjust it to point back to @@ -82,7 +82,7 @@ caml_call_gc: subu $31, $31, 16 /* Don't request any allocation, will be redone at return */ li $24, 0 - b $110 + b $110 #ifndef _PIC @@ -91,21 +91,21 @@ caml_call_gc: caml_alloc1: subu $22, $22, 8 bltu $22, $23, $100 - j $31 + j $31 $100: li $24, 8 b caml_call_gc_internal caml_alloc2: subu $22, $22, 12 bltu $22, $23, $101 - j $31 + j $31 $101: li $24, 12 b caml_call_gc_internal caml_alloc3: subu $22, $22, 16 bltu $22, $23, $102 - j $31 + j $31 $102: li $24, 16 b caml_call_gc_internal @@ -219,7 +219,7 @@ $110: /* Say that we are back into Caml code */ sw $0, caml_last_return_address /* Return to caller */ - lw $31, 28($sp) + lw $31, 28($sp) addu $sp, $sp, 32 j $31 @@ -256,19 +256,19 @@ caml_c_call: .set noreorder .cpload $25 .set reorder - la $16, caml_last_return_address - la $17, young_ptr - la $18, young_limit - sw $31, 0($16) /* caml_last_return_address */ + la $16, caml_last_return_address + la $17, young_ptr + la $18, young_limit + sw $31, 0($16) /* caml_last_return_address */ sw $sp, caml_bottom_of_stack - sw $22, 0($17) /* young_ptr */ + sw $22, 0($17) /* young_ptr */ sw $30, caml_exception_pointer move $25, $24 jal $24 - lw $31, 0($16) /* caml_last_return_address */ - lw $22, 0($17) /* young_ptr */ - lw $23, 0($18) /* young_limit */ - sw $0, 0($16) /* caml_last_return_address */ + lw $31, 0($16) /* caml_last_return_address */ + lw $22, 0($17) /* young_ptr */ + lw $23, 0($18) /* young_limit */ + sw $0, 0($16) /* caml_last_return_address */ j $31 #endif .end caml_c_call @@ -289,10 +289,10 @@ caml_start_program: /* Code shared with callback* */ $103: /* Save return address */ - subu $sp, $sp, 96 + subu $sp, $sp, 96 sw $31, 88($sp) /* Save all callee-save registers */ - SAVE_CALLEE_SAVE_REGS + SAVE_CALLEE_SAVE_REGS /* Set up a callback link on the stack. */ subu $sp, $sp, 8 lw $2, caml_bottom_of_stack @@ -307,8 +307,8 @@ $103: sw $2, 4($sp) move $30, $sp /* Reload allocation pointers */ - lw $22, young_ptr - lw $23, young_limit + lw $22, young_ptr + lw $23, young_limit /* Say that we are back into Caml code */ sw $0, caml_last_return_address /* Call the Caml code */ @@ -337,7 +337,7 @@ $104: jal $24 sw $22, young_ptr /* Reload callee-save registers and return */ lw $31, 88($sp) - RELOAD_CALLEE_SAVE_REGS + RELOAD_CALLEE_SAVE_REGS addu $sp, $sp, 96 j $31 diff --git a/asmrun/power-elf.S b/asmrun/power-elf.S index 4447e41874..df60540bcc 100644 --- a/asmrun/power-elf.S +++ b/asmrun/power-elf.S @@ -119,7 +119,7 @@ caml_call_gc: mflr 0 Storeglobal(0, caml_last_return_address, 11) /* Record lowest stack address */ - addic 0, 1, 32 + addic 0, 1, 32 Storeglobal(0, caml_bottom_of_stack, 11) /* Save current allocation pointer for debugging purposes */ Storeglobal(31, young_ptr, 11) @@ -261,7 +261,7 @@ caml_call_gc: .type caml_c_call, @function caml_c_call: /* Save return address */ - mflr 25 + mflr 25 /* Get ready to call C function (address in 11) */ mtlr 11 /* Record lowest stack address and return address */ @@ -312,7 +312,7 @@ caml_start_program: stwu 1, -256(1) /* Save return address */ mflr 0 - stw 0, 256+4(1) + stw 0, 256+4(1) /* Save all callee-save registers */ Save_callee_save /* Set up a callback link */ diff --git a/asmrun/sparc.S b/asmrun/sparc.S index b1eeb0cb1c..d7581e159f 100644 --- a/asmrun/sparc.S +++ b/asmrun/sparc.S @@ -91,7 +91,7 @@ /* Required size in %g4 */ Caml_alloc: - ld [%g7], %g1 + ld [%g7], %g1 sub %g6, %g4, %g6 cmp %g6, %g1 blu Caml_call_gc @@ -278,9 +278,9 @@ Raise_caml_exception: /* Save exception bucket in a register outside the reg windows */ mov %o0, %g1 /* Pop some frames until the trap pointer is in the current frame. */ - cmp %g5, %fp + cmp %g5, %fp blt L107 /* if Trap_handler_reg < %fp, over */ - nop + nop L106: restore cmp %fp, %g5 /* if %fp <= Trap_handler_reg, loop */ ble L106 @@ -290,7 +290,7 @@ L107: mov %g5, %sp add %sp, 8, %sp jmp %g4 + 8 /* Restore bucket, in delay slot */ - mov %g1, %o0 + mov %g1, %o0 /* Callbacks C -> ML */ diff --git a/asmrun/startup.c b/asmrun/startup.c index f578e97b60..423b47639b 100644 --- a/asmrun/startup.c +++ b/asmrun/startup.c @@ -80,7 +80,7 @@ static void parse_camlrunparam() if (opt != NULL){ while (*opt != '\0'){ switch (*opt++){ - case 's': scanmult (opt, &minor_heap_init); break; + case 's': scanmult (opt, &minor_heap_init); break; case 'i': scanmult (opt, &heap_chunk_init); break; case 'h': scanmult (opt, &heap_size_init); break; case 'l': scanmult (opt, &max_stack_init); break; @@ -105,7 +105,7 @@ void caml_main(argv) #endif parse_camlrunparam(); init_gc (minor_heap_init, heap_size_init, heap_chunk_init, - percent_free_init, max_percent_free_init, verbose_init); + percent_free_init, max_percent_free_init, verbose_init); init_atoms(); init_signals(); sys_init(argv); diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml index fbddca1e30..82124a4086 100644 --- a/bytecomp/bytelink.ml +++ b/bytecomp/bytelink.ml @@ -372,51 +372,51 @@ let build_custom_runtime prim_name exec_name = | "MacOS" -> let c68k = "sc" and libs68k = "\"{libraries}IntEnv.far.o\" " ^ - "\"{libraries}MacRuntime.o\" " ^ - "\"{clibraries}StdCLib.far.o\" " ^ - "\"{libraries}MathLib.far.o\" " ^ - "\"{libraries}ToolLibs.o\" " ^ - "\"{libraries}Interface.o\"" + "\"{libraries}MacRuntime.o\" " ^ + "\"{clibraries}StdCLib.far.o\" " ^ + "\"{libraries}MathLib.far.o\" " ^ + "\"{libraries}ToolLibs.o\" " ^ + "\"{libraries}Interface.o\"" and link68k = "ilink -compact -state nouse -model far -msg nodup" and cppc = "mrc" and libsppc = "\"{sharedlibraries}MathLib\" " ^ "\"{ppclibraries}PPCCRuntime.o\" " ^ "\"{ppclibraries}PPCToolLibs.o\" " ^ - "\"{sharedlibraries}StdCLib\" " ^ - "\"{ppclibraries}StdCRuntime.o\" " ^ - "\"{sharedlibraries}InterfaceLib\" " + "\"{sharedlibraries}StdCLib\" " ^ + "\"{ppclibraries}StdCRuntime.o\" " ^ + "\"{sharedlibraries}InterfaceLib\" " and linkppc = "ppclink -d" and objs68k = extract ".o" (List.rev !Clflags.ccobjs) and objsppc = extract ".x" (List.rev !Clflags.ccobjs) in Ccomp.command (Printf.sprintf "%s -i \"%s\" %s \"%s\" -o \"%s.o\"" - c68k - Config.standard_library - (String.concat " " (List.rev !Clflags.ccopts)) - prim_name - prim_name); + c68k + Config.standard_library + (String.concat " " (List.rev !Clflags.ccopts)) + prim_name + prim_name); Ccomp.command (Printf.sprintf "%s -i \"%s\" %s \"%s\" -o \"%s.x\"" - cppc - Config.standard_library - (String.concat " " (List.rev !Clflags.ccopts)) - prim_name - prim_name); + cppc + Config.standard_library + (String.concat " " (List.rev !Clflags.ccopts)) + prim_name + prim_name); Ccomp.command ("delete -i \""^exec_name^"\""); Ccomp.command (Printf.sprintf - "%s -t MPST -c 'MPS ' -o \"%s\" \"%s.o\" \"%s\" \"%s\" %s" - link68k - exec_name - prim_name - (String.concat "\" \"" objs68k) - (Filename.concat Config.standard_library "libcamlrun.o") + "%s -t MPST -c 'MPS ' -o \"%s\" \"%s.o\" \"%s\" \"%s\" %s" + link68k + exec_name + prim_name + (String.concat "\" \"" objs68k) + (Filename.concat Config.standard_library "libcamlrun.o") libs68k); Ccomp.command (Printf.sprintf - "%s -t MPST -c 'MPS ' -o \"%s\" \"%s.x\" \"%s\" \"%s\" %s" - linkppc - exec_name - prim_name - (String.concat "\" \"" objsppc) - (Filename.concat Config.standard_library "libcamlrun.x") + "%s -t MPST -c 'MPS ' -o \"%s\" \"%s.x\" \"%s\" \"%s\" %s" + linkppc + exec_name + prim_name + (String.concat "\" \"" objsppc) + (Filename.concat Config.standard_library "libcamlrun.x") libsppc) | _ -> fatal_error "Bytelink.build_custom_runtime" diff --git a/bytecomp/translclass.ml b/bytecomp/translclass.ml index 856bf22689..01dc29c2c5 100644 --- a/bytecomp/translclass.ml +++ b/bytecomp/translclass.ml @@ -38,18 +38,18 @@ let transl_super tbl meths inh_methods rem = List.fold_right (fun (nm, id) rem -> Llet(StrictOpt, id, Lapply (oo_prim "get_method", - [Lvar tbl; Lvar (Meths.find nm meths)]), + [Lvar tbl; Lvar (Meths.find nm meths)]), rem)) inh_methods rem let transl_val tbl name id rem = Llet(StrictOpt, id, Lapply (oo_prim "get_variable", - [Lvar tbl; transl_label name]), + [Lvar tbl; transl_label name]), rem) let transl_private_val tbl name id rem = Llet(StrictOpt, id, Lapply (oo_prim "get_private_variable", - [Lvar tbl; transl_label name]), + [Lvar tbl; transl_label name]), rem) let transl_vals tbl vals rem = @@ -76,7 +76,7 @@ let transl_field_obj obj field (obj_init, anc_id) = Cf_inher (name, args, vals, inh_meths, meths') -> let init = Ident.create "init" in (Lsequence(Lapply(Lvar init, Lvar obj :: (List.map transl_exp args)), - obj_init), + obj_init), init::anc_id) | Cf_val (name, id, priv, Some exp) -> (Lsequence(set_inst_var obj name id exp, obj_init), @@ -93,7 +93,7 @@ let transl_field_cl tbl meths field cl_init = [Lvar tbl; transl_path name; inherited_values vals; inherited_meths meths']), - transl_vals tbl vals ( + transl_vals tbl vals ( transl_super tbl meths inh_meths cl_init)) | Cf_val (name, id, priv, exp) -> if priv = Private then @@ -103,7 +103,7 @@ let transl_field_cl tbl meths field cl_init = | Cf_meth (name, exp) -> Lsequence(Lapply (oo_prim "set_method", [Lvar tbl; transl_label name; transl_exp exp]), - cl_init) + cl_init) let transl_val_hiding tbl cl_init = function @@ -112,7 +112,7 @@ let transl_val_hiding tbl cl_init = | Cf_val (name, id, Private, exp) -> Lsequence(Lapply (oo_prim "hide_variable", [Lvar tbl; transl_label name]), - cl_init) + cl_init) let bind_methods tbl public_methods lab id cl_init = if List.mem lab public_methods then @@ -154,7 +154,7 @@ let transl_class cl_id cl = Lfunction (Curried, [table], List.fold_left (transl_val_hiding table) (transl_fields table cl.cl_pub_meths cl.cl_meths cl.cl_field - (Lapply (oo_prim "set_initializer", + (Lapply (oo_prim "set_initializer", [Lvar table; obj_init]))) cl.cl_field) in diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml index 796f31c39b..be890b39f8 100644 --- a/bytecomp/translcore.ml +++ b/bytecomp/translcore.ml @@ -488,11 +488,11 @@ let rec transl_exp e = let cpy = Ident.create "copy" in Llet(Strict, cpy, Lapply(oo_prim "copy", [transl_path path_self]), List.fold_right - (fun (path, expr) rem -> - Lsequence(transl_setinstvar (Lvar cpy) path expr, - rem)) - modifs - (Lvar cpy)) + (fun (path, expr) rem -> + Lsequence(transl_setinstvar (Lvar cpy) path expr, + rem)) + modifs + (Lvar cpy)) | _ -> fatal_error "Translcore.transl" diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml index e469843342..c1a0d8b1b7 100644 --- a/bytecomp/translmod.ml +++ b/bytecomp/translmod.ml @@ -141,14 +141,14 @@ and transl_structure fields cc = function transl_structure fields cc rem | Tstr_class cl_list :: rem -> List.fold_right - (fun (id, cl) re -> - Llet(Strict, id, class_stub, re)) - cl_list + (fun (id, cl) re -> + Llet(Strict, id, class_stub, re)) + cl_list (List.fold_right (fun (id, cl) re -> Lsequence(transl_class id cl, re)) cl_list - (transl_structure + (transl_structure ((List.rev (List.map fst cl_list)) @ fields) cc rem)) (* Compile an implementation *) @@ -197,14 +197,14 @@ let transl_store_structure glob map prims str = transl_store rem | Tstr_class cl_list :: rem -> List.fold_right - (fun (id, cl) re -> - Llet(Strict, id, class_stub, re)) - cl_list + (fun (id, cl) re -> + Llet(Strict, id, class_stub, re)) + cl_list (List.fold_right (fun (id, cl) re -> - Lsequence(transl_class id cl, re)) - cl_list - (store_idents glob map (List.map fst cl_list) (transl_store rem))) + Lsequence(transl_class id cl, re)) + cl_list + (store_idents glob map (List.map fst cl_list) (transl_store rem))) and store_ident glob map id cont = try @@ -322,13 +322,13 @@ let transl_toplevel_item = function | Tstr_class cl_list -> let lam = List.fold_right - (fun (id, cl) re -> - Llet(Strict, id, class_stub, re)) + (fun (id, cl) re -> + Llet(Strict, id, class_stub, re)) cl_list (make_sequence (fun (id, cl) -> Lsequence(Lprim(Psetglobal id, [Lvar id]), transl_class id cl)) - cl_list) + cl_list) in List.iter (fun (id, cl) -> Ident.make_global id) cl_list; lam diff --git a/byterun/Makefile.Mac.depend b/byterun/Makefile.Mac.depend index 5e54c11457..6beaf52463 100644 --- a/byterun/Makefile.Mac.depend +++ b/byterun/Makefile.Mac.depend @@ -41,6 +41,20 @@ fix_code.h stacks.h +"compact.c.x" compact.c + config.h + ::config:sm-Mac.h + freelist.h + misc.h + mlvalues.h + gc.h + gc_ctrl.h + major_gc.h + memory.h + minor_gc.h + roots.h + weak.h + "compare.c.x" compare.c fail.h misc.h @@ -150,11 +164,14 @@ config.h ::config:sm-Mac.h mlvalues.h + compact.h gc.h gc_ctrl.h major_gc.h freelist.h - minor_gc.h + minor_gc.h + stacks.h + memory.h "hash.c.x" hash.c mlvalues.h @@ -273,10 +290,11 @@ signals.h "major_gc.c.x" major_gc.c + compact.h config.h ::config:sm-Mac.h - fail.h misc.h + fail.h mlvalues.h freelist.h gc.h @@ -547,6 +565,20 @@ fix_code.h stacks.h +"compact.c.o" compact.c + config.h + ::config:sm-Mac.h + freelist.h + misc.h + mlvalues.h + gc.h + gc_ctrl.h + major_gc.h + memory.h + minor_gc.h + roots.h + weak.h + "compare.c.o" compare.c fail.h misc.h @@ -656,11 +688,14 @@ config.h ::config:sm-Mac.h mlvalues.h + compact.h gc.h gc_ctrl.h major_gc.h freelist.h - minor_gc.h + minor_gc.h + stacks.h + memory.h "hash.c.o" hash.c mlvalues.h @@ -779,10 +814,11 @@ signals.h "major_gc.c.o" major_gc.c + compact.h config.h ::config:sm-Mac.h - fail.h misc.h + fail.h mlvalues.h freelist.h gc.h diff --git a/byterun/compact.c b/byterun/compact.c index 91cef96673..70c31977e6 100644 --- a/byterun/compact.c +++ b/byterun/compact.c @@ -63,30 +63,30 @@ static void invert_pointer_at (p) the next infix header in this block. The last of the last list contains the original block header. */ { - /* This block as a value. */ - value val = (value) q - Infix_offset_val (q); - /* Get the block header. */ - word *hp = (word *) Hp_val (val); - while (Ecolor (*hp) == 0) hp = (word *) *hp; + /* This block as a value. */ + value val = (value) q - Infix_offset_val (q); + /* Get the block header. */ + word *hp = (word *) Hp_val (val); + while (Ecolor (*hp) == 0) hp = (word *) *hp; Assert (Ecolor (*hp) == 3); - if (Tag_ehd (*hp) == Closure_tag){ - /* This is the first infix found in this block. */ + if (Tag_ehd (*hp) == Closure_tag){ + /* This is the first infix found in this block. */ /* Save original header. */ - *p = *hp; + *p = *hp; /* Link inverted infix list. */ - Hd_val (q) = (header_t) ((word) p | 2); - /* Change block header's tag to Infix_tag, and change its size + Hd_val (q) = (header_t) ((word) p | 2); + /* Change block header's tag to Infix_tag, and change its size to point to the infix list. */ - *hp = Make_ehd (Wosize_bhsize (q - val), Infix_tag, 3); - }else{ Assert (Tag_ehd (*hp) == Infix_tag); - /* Point the last of this infix list to the current first infix + *hp = Make_ehd (Wosize_bhsize (q - val), Infix_tag, 3); + }else{ Assert (Tag_ehd (*hp) == Infix_tag); + /* Point the last of this infix list to the current first infix list of the block. */ *p = (word) &Field (val, Wosize_ehd (*hp)) | 1; - /* Point the head of this infix list to the above. */ - Hd_val (q) = (header_t) ((word) p | 2); - /* Change block header's size to point to this infix list. */ - *hp = Make_ehd (Wosize_bhsize (q - val), Infix_tag, 3); - } + /* Point the head of this infix list to the above. */ + Hd_val (q) = (header_t) ((word) p | 2); + /* Change block header's size to point to this infix list. */ + *hp = Make_ehd (Wosize_bhsize (q - val), Infix_tag, 3); + } } break; case 2: /* Inverted infix list: insert. */ @@ -122,8 +122,8 @@ static char *compact_allocate (size) char *chunk, *adr; while (Chunk_size (compact_fl) - Chunk_alloc (compact_fl) <= Bhsize_wosize (3) - && Chunk_size (Chunk_next (compact_fl)) - - Chunk_alloc (Chunk_next (compact_fl)) + && Chunk_size (Chunk_next (compact_fl)) + - Chunk_alloc (Chunk_next (compact_fl)) <= Bhsize_wosize (3)){ compact_fl = Chunk_next (compact_fl); } @@ -149,17 +149,17 @@ void compact_heap (void) chend = ch + Chunk_size (ch); while ((char *) p < chend){ - header_t hd = Hd_hp (p); - mlsize_t sz = Wosize_hd (hd); - - if (Is_blue_hd (hd)){ - /* Free object. Give it a string tag. */ - Hd_hp (p) = Make_ehd (sz, String_tag, 3); - }else{ Assert (Is_white_hd (hd)); - /* Live object. Keep its tag. */ + header_t hd = Hd_hp (p); + mlsize_t sz = Wosize_hd (hd); + + if (Is_blue_hd (hd)){ + /* Free object. Give it a string tag. */ + Hd_hp (p) = Make_ehd (sz, String_tag, 3); + }else{ Assert (Is_white_hd (hd)); + /* Live object. Keep its tag. */ Hd_hp (p) = Make_ehd (sz, Tag_hd (hd), 3); - } - p += Whsize_wosize (sz); + } + p += Whsize_wosize (sz); } ch = Chunk_next (ch); } @@ -176,28 +176,28 @@ void compact_heap (void) chend = ch + Chunk_size (ch); while ((char *) p < chend){ - word q = *p; - size_t sz, i; - tag_t t; - word *infixes; - - while (Ecolor (q) == 0) q = * (word *) q; - sz = Whsize_ehd (q); - t = Tag_ehd (q); - - if (t == Infix_tag){ - /* Get the original header of this block. */ - infixes = p + sz; - q = *infixes; - while (Ecolor (q) != 3) q = * (word *) (q & ~(unsigned long)3); - sz = Whsize_ehd (q); - t = Tag_ehd (q); - } - - if (t < No_scan_tag){ - for (i = 1; i < sz; i++) invert_pointer_at (&(p[i])); - } - p += sz; + word q = *p; + size_t sz, i; + tag_t t; + word *infixes; + + while (Ecolor (q) == 0) q = * (word *) q; + sz = Whsize_ehd (q); + t = Tag_ehd (q); + + if (t == Infix_tag){ + /* Get the original header of this block. */ + infixes = p + sz; + q = *infixes; + while (Ecolor (q) != 3) q = * (word *) (q & ~(unsigned long)3); + sz = Whsize_ehd (q); + t = Tag_ehd (q); + } + + if (t < No_scan_tag){ + for (i = 1; i < sz; i++) invert_pointer_at (&(p[i])); + } + p += sz; } ch = Chunk_next (ch); } @@ -208,13 +208,13 @@ void compact_heap (void) size_t sz, i; while (p != (value) NULL){ - q = Hd_val (p); - while (Ecolor (q) == 0) q = * (word *) q; - sz = Wosize_ehd (q); - for (i = 1; i < sz; i++){ - if (Field (p,i) != 0) invert_pointer_at (&(Field (p,i))); - } - p = Field (p, 0); + q = Hd_val (p); + while (Ecolor (q) == 0) q = * (word *) q; + sz = Wosize_ehd (q); + for (i = 1; i < sz; i++){ + if (Field (p,i) != 0) invert_pointer_at (&(Field (p,i))); + } + p = Field (p, 0); } } /* Invert roots */ @@ -232,63 +232,63 @@ void compact_heap (void) chend = ch + Chunk_size (ch); while ((char *) p < chend){ - word q = *p; - - if (Ecolor (q) == 0 || Tag_ehd (q) == Infix_tag){ - /* There were (normal or infix) pointers to this block. */ - size_t sz; - tag_t t; - char *newadr; - word *infixes = NULL; - - while (Ecolor (q) == 0) q = * (word *) q; - sz = Whsize_ehd (q); - t = Tag_ehd (q); - - if (t == Infix_tag){ - /* Get the original header of this block. */ - infixes = p + sz; - q = *infixes; Assert (Ecolor (q) == 2); - while (Ecolor (q) != 3) q = * (word *) (q & ~(unsigned long)3); - sz = Whsize_ehd (q); - t = Tag_ehd (q); - } - - newadr = compact_allocate (Bsize_wsize (sz)); - q = *p; - while (Ecolor (q) == 0){ - word next = * (word *) q; - * (word *) q = (word) Val_hp (newadr); - q = next; - } - *p = Make_header (Wosize_whsize (sz), t, White); - - if (infixes != NULL){ - /* Rebuild the infix headers and revert the infix pointers. */ - while (Ecolor ((word) infixes) != 3){ - infixes = (word *) ((word) infixes & ~(unsigned long) 3); - q = *infixes; - while (Ecolor (q) == 2){ - word next; - q = (word) q & ~(unsigned long) 3; - next = * (word *) q; - * (word *) q = (word) Val_hp ((word *) newadr + (infixes - p)); - q = next; - } Assert (Ecolor (q) == 1 || Ecolor (q) == 3); - *infixes = Make_header (infixes - p, Infix_tag, White); - infixes = (word *) q; - } - } - p += sz; - }else{ Assert (Ecolor (q) == 3); + word q = *p; + + if (Ecolor (q) == 0 || Tag_ehd (q) == Infix_tag){ + /* There were (normal or infix) pointers to this block. */ + size_t sz; + tag_t t; + char *newadr; + word *infixes = NULL; + + while (Ecolor (q) == 0) q = * (word *) q; + sz = Whsize_ehd (q); + t = Tag_ehd (q); + + if (t == Infix_tag){ + /* Get the original header of this block. */ + infixes = p + sz; + q = *infixes; Assert (Ecolor (q) == 2); + while (Ecolor (q) != 3) q = * (word *) (q & ~(unsigned long)3); + sz = Whsize_ehd (q); + t = Tag_ehd (q); + } + + newadr = compact_allocate (Bsize_wsize (sz)); + q = *p; + while (Ecolor (q) == 0){ + word next = * (word *) q; + * (word *) q = (word) Val_hp (newadr); + q = next; + } + *p = Make_header (Wosize_whsize (sz), t, White); + + if (infixes != NULL){ + /* Rebuild the infix headers and revert the infix pointers. */ + while (Ecolor ((word) infixes) != 3){ + infixes = (word *) ((word) infixes & ~(unsigned long) 3); + q = *infixes; + while (Ecolor (q) == 2){ + word next; + q = (word) q & ~(unsigned long) 3; + next = * (word *) q; + * (word *) q = (word) Val_hp ((word *) newadr + (infixes - p)); + q = next; + } Assert (Ecolor (q) == 1 || Ecolor (q) == 3); + *infixes = Make_header (infixes - p, Infix_tag, White); + infixes = (word *) q; + } + } + p += sz; + }else{ Assert (Ecolor (q) == 3); /* This is guaranteed only if compact_heap was called after a nonincremental major GC: Assert (Tag_ehd (q) == String_tag); */ - /* No pointers to the header and no infix header: - the object was free. */ - *p = Make_header (Wosize_ehd (q), Tag_ehd (q), Blue); - p += Whsize_ehd (q); - } + /* No pointers to the header and no infix header: + the object was free. */ + *p = Make_header (Wosize_ehd (q), Tag_ehd (q), Blue); + p += Whsize_ehd (q); + } } ch = Chunk_next (ch); } @@ -305,17 +305,17 @@ void compact_heap (void) chend = ch + Chunk_size (ch); while ((char *) p < chend){ - word q = *p; - if (Color_hd (q) == White){ - size_t sz = Bhsize_hd (q); - char *newadr = compact_allocate (sz); Assert (newadr <= (char *)p); - /* bcopy (source, destination, length) */ - bcopy (p, newadr, sz); - p += Wsize_bsize (sz); - }else{ - Assert (Color_hd (q) == Blue); - p += Whsize_hd (q); - } + word q = *p; + if (Color_hd (q) == White){ + size_t sz = Bhsize_hd (q); + char *newadr = compact_allocate (sz); Assert (newadr <= (char *)p); + /* bcopy (source, destination, length) */ + bcopy (p, newadr, sz); + p += Wsize_bsize (sz); + }else{ + Assert (Color_hd (q) == Blue); + p += Whsize_hd (q); + } } ch = Chunk_next (ch); } @@ -331,8 +331,8 @@ void compact_heap (void) ch = heap_start; while (ch != NULL){ if (Chunk_alloc (ch) != 0){ - live += Wsize_bsize (Chunk_alloc (ch)); - free += Wsize_bsize (Chunk_size (ch) - Chunk_alloc (ch)); + live += Wsize_bsize (Chunk_alloc (ch)); + free += Wsize_bsize (Chunk_size (ch) - Chunk_alloc (ch)); } ch = Chunk_next (ch); } @@ -345,11 +345,11 @@ void compact_heap (void) char *next_chunk = Chunk_next (ch); /* Chunk_next (ch) will be erased */ if (Chunk_alloc (ch) == 0){ - if (free < wanted){ - free += Chunk_size (ch); - }else{ - shrink_heap (ch); - } + if (free < wanted){ + free += Chunk_size (ch); + }else{ + shrink_heap (ch); + } } ch = next_chunk; } @@ -361,10 +361,10 @@ void compact_heap (void) fl_reset (); while (ch != NULL){ if (Chunk_size (ch) > Chunk_alloc (ch)){ - header_t *p = (header_t *) (ch + Chunk_alloc (ch)); - *p = Make_header (Wosize_bhsize (Chunk_size (ch) - Chunk_alloc (ch)), - 0, White); - fl_merge_block (Bp_hp (p)); + header_t *p = (header_t *) (ch + Chunk_alloc (ch)); + *p = Make_header (Wosize_bhsize (Chunk_size (ch) - Chunk_alloc (ch)), + 0, White); + fl_merge_block (Bp_hp (p)); } ch = Chunk_next (ch); } diff --git a/byterun/debugger.c b/byterun/debugger.c index c6f38d02ff..801de39ee7 100644 --- a/byterun/debugger.c +++ b/byterun/debugger.c @@ -217,11 +217,11 @@ void debugger(event) case REQ_CHECKPOINT: i = fork(); if (i == 0) { - close_connection(); /* Close parent connection. */ - open_connection(); /* Open new connection with debugger */ + close_connection(); /* Close parent connection. */ + open_connection(); /* Open new connection with debugger */ } else { - putword(dbg_out, i); - flush(dbg_out); + putword(dbg_out, i); + flush(dbg_out); } break; case REQ_GO: diff --git a/byterun/freelist.c b/byterun/freelist.c index 37322707df..63f8ca7af9 100644 --- a/byterun/freelist.c +++ b/byterun/freelist.c @@ -44,7 +44,7 @@ static char *fl_last = NULL; /* Last block in the list. Only valid char *fl_merge = Fl_head; /* Current insertion pointer. Managed jointly with [sweep_slice]. */ asize_t fl_cur_size = 0; /* How many free words were added since - the latest fl_init_merge. */ + the latest fl_init_merge. */ #define Next(b) (((block *) (b))->next_bp) diff --git a/byterun/freelist.h b/byterun/freelist.h index 2fb90ed0e3..4c5067c678 100644 --- a/byterun/freelist.h +++ b/byterun/freelist.h @@ -20,7 +20,7 @@ #include "misc.h" #include "mlvalues.h" -asize_t fl_cur_size; +extern asize_t fl_cur_size; char *fl_allocate P((mlsize_t)); void fl_init_merge P((void)); diff --git a/byterun/gc.h b/byterun/gc.h index 09e9ef1976..f98da37ed0 100644 --- a/byterun/gc.h +++ b/byterun/gc.h @@ -36,10 +36,10 @@ #define Bluehd_hd(hd) (((hd) & ~Black) | Blue) /* This depends on the layout of the header. See [mlvalues.h]. */ -#define Make_header(wosize, tag, color) \ - ((header_t) (((header_t) (wosize) << 10) \ - + (color) \ - + (tag_t) (tag))) +#define Make_header(wosize, tag, color) \ + ((header_t) (((header_t) (wosize) << 10) \ + + (color) \ + + (tag_t) (tag))) #define Color_val(val) (Color_hd (Hd_val (val))) diff --git a/byterun/gc_ctrl.c b/byterun/gc_ctrl.c index e4df55e52d..c0280ad499 100644 --- a/byterun/gc_ctrl.c +++ b/byterun/gc_ctrl.c @@ -60,36 +60,36 @@ value gc_stat(v) /* ML */ cur_hd = Hd_hp (cur_hp); switch (Color_hd (cur_hd)){ case White: - if (Wosize_hd (cur_hd) == 0){ - ++fragments; - Assert (prev_hp == NULL - || (Color_hp (prev_hp) != Blue - && Wosize_hp (prev_hp) > 0)); - Assert (Next (cur_hp) == chunk_end - || (Color_hp (Next (cur_hp)) != Blue - && Wosize_hp (Next (cur_hp)) > 0)); - break; - } - /* FALLTHROUGH */ + if (Wosize_hd (cur_hd) == 0){ + ++fragments; + Assert (prev_hp == NULL + || (Color_hp (prev_hp) != Blue + && Wosize_hp (prev_hp) > 0)); + Assert (Next (cur_hp) == chunk_end + || (Color_hp (Next (cur_hp)) != Blue + && Wosize_hp (Next (cur_hp)) > 0)); + break; + } + /* FALLTHROUGH */ case Gray: case Black: - Assert (Wosize_hd (cur_hd) > 0); - ++ live_blocks; - live_words += Whsize_hd (cur_hd); - break; + Assert (Wosize_hd (cur_hd) > 0); + ++ live_blocks; + live_words += Whsize_hd (cur_hd); + break; case Blue: - Assert (Wosize_hd (cur_hd) > 0); - ++ free_blocks; - free_words += Whsize_hd (cur_hd); - if (Whsize_hd (cur_hd) > largest_free){ - largest_free = Whsize_hd (cur_hd); - } - Assert (prev_hp == NULL - || (Color_hp (prev_hp) != Blue - && Wosize_hp (prev_hp) > 0)); - Assert (Next (cur_hp) == chunk_end - || (Color_hp (Next (cur_hp)) != Blue - && Wosize_hp (Next (cur_hp)) > 0)); - break; + Assert (Wosize_hd (cur_hd) > 0); + ++ free_blocks; + free_words += Whsize_hd (cur_hd); + if (Whsize_hd (cur_hd) > largest_free){ + largest_free = Whsize_hd (cur_hd); + } + Assert (prev_hp == NULL + || (Color_hp (prev_hp) != Blue + && Wosize_hp (prev_hp) > 0)); + Assert (Next (cur_hp) == chunk_end + || (Color_hp (Next (cur_hp)) != Blue + && Wosize_hp (Next (cur_hp)) > 0)); + break; } prev_hp = cur_hp; cur_hp = Next (cur_hp); @@ -192,7 +192,7 @@ value gc_set(v) /* ML */ if (newheapincr != major_heap_increment){ major_heap_increment = newheapincr; gc_message ("New heap increment size: %luk bytes\n", - major_heap_increment/1024); + major_heap_increment/1024); } /* Minor heap size comes last because it will trigger a minor collection @@ -263,5 +263,5 @@ void init_gc (minor_size, major_size, major_incr, percent_fr, percent_m, verb) gc_message ("Initial space overhead: %d%%\n", percent_free); gc_message ("Initial max overhead: %d%%\n", percent_max); gc_message ("Initial heap increment: %ldk bytes\n", - major_heap_increment / 1024); + major_heap_increment / 1024); } diff --git a/byterun/interp.a b/byterun/interp.a index 3c28066c5b..f2227c0da4 100644 --- a/byterun/interp.a +++ b/byterun/interp.a @@ -111,19 +111,19 @@ initial_callback_depth_ equ $00 Call_restore MOVE.L local_var_size_+4*10+$4(A7), D0 ; code - BNE.S noinit ; == NULL => init + BNE.S noinit ; == NULL => init LEA.L table(PC), A0 MOVE.L A0, (instr_table).L CLR.L (instr_base).L - MOVEQ.L #1, D0 + MOVEQ.L #1, D0 Call_setup ; 2eme copie: "lbl_1B88" LEA.L local_var_size_(A7), A7 MOVEM.L (A7)+, D3-D7/A2-A6 RTS noinit: MOVEA.L local_var_size_+4*10+$4(A7), A0 ; code - CMPI.L #124, (A0) - BHI.S nothread ; deja tresse + CMPI.L #124, (A0) + BHI.S nothread ; deja tresse MOVE.L local_var_size_+4*10+$8(A7), -(A7) ; argument 1 (size) MOVE.L local_var_size_+4*10+$8(A7), -(A7) ; argument 0 (code) @@ -156,7 +156,7 @@ nothread: LEA.L i_start(PC), A6 MOVE.L initial_local_roots_(A7), (local_roots).L MOVE.L initial_callback_depth_(A7), (callback_depth).L MOVEA.L (exn_bucket).L, accu_ - MOVEA.L (extern_sp).L, sp_ + MOVEA.L (extern_sp).L, sp_ JMP i_82-i_base(A6) ; RAISE lbl_78: LEA.L raise_buf_(A7), A0 MOVE.L A0, (external_raise).L @@ -1219,13 +1219,13 @@ lbl_mod: MOVE.L (A1), D5 ; A1 = modify_dest; D5 = _old_ BEQ i_90 TST.L (gc_phase).L BNE.S lbl_CC2 - MOVE.L A1, D3 ; A1 est caller-save + MOVE.L A1, D3 ; A1 est caller-save MOVE.L D5, -(A7) Call_setup JSR (darken).L Call_restore ADDQ.L #4 ,A7 - MOVEA.L D3, A1 ; A1 est caller-save + MOVEA.L D3, A1 ; A1 est caller-save lbl_CC2: BTST.L #0, D4 BNE i_90 CMP.L (young_start).L, D4 diff --git a/byterun/interp.c b/byterun/interp.c index 39a6b0a271..0b7e7052d6 100644 --- a/byterun/interp.c +++ b/byterun/interp.c @@ -36,11 +36,11 @@ extern int volatile have_to_interact; #endif /* Registers for the abstract machine: - pc the code pointer - sp the stack pointer (grows downward) + pc the code pointer + sp the stack pointer (grows downward) accu the accumulator env heap-allocated environment - trapsp pointer to the current trap frame + trapsp pointer to the current trap frame extra_args number of extra arguments provided by the caller sp is a local copy of the global variable extern_sp. */ @@ -419,7 +419,7 @@ value interprete(prog, prog_size) pc = (code_t)(sp[0]); env = sp[1]; extra_args = Long_val(sp[2]); - sp += 3; + sp += 3; } Next; } @@ -736,9 +736,9 @@ value interprete(prog, prog_size) process_signal: something_to_do = 0; if (force_major_slice){ - Setup_for_gc; - minor_collection (); - Restore_after_gc; + Setup_for_gc; + minor_collection (); + Restore_after_gc; } /* If a signal arrives between the following two instructions, it will be lost. */ @@ -902,7 +902,7 @@ value interprete(prog, prog_size) #define Lookup(obj, lab) \ Field (Field (Field (obj, 0), ((lab) >> 16) / sizeof (value)), \ - ((lab) / sizeof (value)) & 0xFF) + ((lab) / sizeof (value)) & 0xFF) Instruct(GETMETHOD): accu = Lookup(sp[0], accu); diff --git a/byterun/io.c b/byterun/io.c index d516739ad3..0aef48fed1 100644 --- a/byterun/io.c +++ b/byterun/io.c @@ -137,11 +137,11 @@ again: if (errno == EINTR) goto again; if (errno == EAGAIN || errno == EWOULDBLOCK) { /* We couldn't do a partial write here, probably because - n <= PIPE_BUF and POSIX says that writes of less than - PIPE_BUF characters must be atomic. - So, we force a partial write of 1 character. - This should always succeed if we've done a select - on writing just before. */ + n <= PIPE_BUF and POSIX says that writes of less than + PIPE_BUF characters must be atomic. + So, we force a partial write of 1 character. + This should always succeed if we've done a select + on writing just before. */ if (n > 1) { n = 1; goto again; } } } diff --git a/byterun/lexing.c b/byterun/lexing.c index df7fdfe987..17dc0ad993 100644 --- a/byterun/lexing.c +++ b/byterun/lexing.c @@ -75,9 +75,9 @@ value lex_engine(tbl, start_state, lexbuf) /* ML */ /* See if we need a refill */ if (lexbuf->lex_curr_pos >= lexbuf->lex_buffer_len){ if (lexbuf->lex_eof_reached == Val_bool (0)){ - return Val_int(-state - 1); + return Val_int(-state - 1); }else{ - c = 256; + c = 256; } }else{ /* Read next input char */ @@ -99,7 +99,7 @@ value lex_engine(tbl, start_state, lexbuf) /* ML */ } }else{ /* Erase the EOF condition only if the EOF pseudo-character was - consumed by the automaton (i.e. there was no backtrack above) + consumed by the automaton (i.e. there was no backtrack above) */ if (c == 256) lexbuf->lex_eof_reached = Val_bool (0); } diff --git a/byterun/macintosh.c b/byterun/macintosh.c index 61660b1a16..a1c08cbc78 100644 --- a/byterun/macintosh.c +++ b/byterun/macintosh.c @@ -70,8 +70,8 @@ int chdir (char *dir) if (result != noErr) return -1; if (prevdir != 0){ prevdir = 0; - pb.ioVRefNum = prevdir; - PBCloseWDSync (&pb); + pb.ioVRefNum = prevdir; + PBCloseWDSync (&pb); } return 0; } @@ -97,12 +97,12 @@ static char *getfullpathpb (CInfoPBPtr pb) char *result; if (pb->hFileInfo.ioFlParID == fsRtParID){ - result = malloc (1); - if (result == NULL) return NULL; - result [0] = '\0'; + result = malloc (1); + if (result == NULL) return NULL; + result [0] = '\0'; }else{ result = getfullpathid (pb->hFileInfo.ioVRefNum, pb->hFileInfo.ioFlParID); - if (result == NULL) return NULL; + if (result == NULL) return NULL; } cat_cp_str (&result, pb->hFileInfo.ioNamePtr); if (pb->hFileInfo.ioFlAttrib & (1<<4)) cat_cp_str (&result, "\p:"); diff --git a/byterun/major_gc.c b/byterun/major_gc.c index 6df677ced7..45ac6e363a 100644 --- a/byterun/major_gc.c +++ b/byterun/major_gc.c @@ -60,7 +60,7 @@ static void realloc_gray_vals () Assert (gray_vals_cur == gray_vals_end); if (gray_vals_size < stat_heap_size / 128){ gc_message ("Growing gray_vals to %luk bytes\n", - (long) gray_vals_size * sizeof (value) / 512); + (long) gray_vals_size * sizeof (value) / 512); new = (value *) realloc ((char *) gray_vals, 2 * gray_vals_size * sizeof (value)); if (new == NULL){ @@ -119,8 +119,8 @@ static void mark_slice (work) Hd_val (v) = Blackhd_hd (hd); size = Wosize_hd(hd); if (Tag_hd (hd) < No_scan_tag){ - for (i = 0; i < size; i++){ - child = Field (v, i); + for (i = 0; i < size; i++){ + child = Field (v, i); if (Is_block (child) && Is_in_heap (child)) { hd = Hd_val(child); if (Tag_hd(hd) == Infix_tag) { @@ -142,19 +142,19 @@ static void mark_slice (work) work -= Whsize_wosize(size); }else if (markhp != NULL){ if (markhp == limit){ - chunk = Chunk_next (chunk); - if (chunk == NULL){ - markhp = NULL; - }else{ - markhp = chunk; - limit = chunk + Chunk_size (chunk); - } + chunk = Chunk_next (chunk); + if (chunk == NULL){ + markhp = NULL; + }else{ + markhp = chunk; + limit = chunk + Chunk_size (chunk); + } }else{ - if (Is_gray_val (Val_hp (markhp))){ - Assert (gray_vals_ptr == gray_vals); - *gray_vals_ptr++ = Val_hp (markhp); - } - markhp += Bhsize_hp (markhp); + if (Is_gray_val (Val_hp (markhp))){ + Assert (gray_vals_ptr == gray_vals); + *gray_vals_ptr++ = Val_hp (markhp); + } + markhp += Bhsize_hp (markhp); } }else if (!heap_is_pure){ heap_is_pure = 1; @@ -199,10 +199,10 @@ static void update_weak_pointers () sz = Wosize_val (cur); for (i = 1; i < sz; i++){ - curfield = Field (cur, i); - if (curfield != 0 && Is_block (curfield) && Is_white_val (curfield)){ - Field (cur, i) = 0; - } + curfield = Field (cur, i); + if (curfield != 0 && Is_block (curfield) && Is_white_val (curfield)){ + Field (cur, i) = 0; + } } prev = &Field (cur, 0); cur = (value *) *prev; @@ -224,31 +224,31 @@ static void sweep_slice (work) gc_sweep_hp += Bhsize_hd (hd); switch (Color_hd (hd)){ case White: - if (Tag_hd (hd) == Final_tag){ - Final_fun (Val_hp (hp)) (Val_hp (hp)); - } - gc_sweep_hp = fl_merge_block (Bp_hp (hp)); - break; + if (Tag_hd (hd) == Final_tag){ + Final_fun (Val_hp (hp)) (Val_hp (hp)); + } + gc_sweep_hp = fl_merge_block (Bp_hp (hp)); + break; case Blue: - /* Only the blocks of the free-list are blue. See [freelist.c]. */ - fl_merge = Bp_hp (hp); - break; + /* Only the blocks of the free-list are blue. See [freelist.c]. */ + fl_merge = Bp_hp (hp); + break; default: /* Gray or Black */ Assert(Color_hd(hd) == Black); - Hd_hp (hp) = Whitehd_hd (hd); - break; + Hd_hp (hp) = Whitehd_hd (hd); + break; } Assert (gc_sweep_hp <= limit); }else{ chunk = Chunk_next (chunk); if (chunk == NULL){ - /* Sweeping is done. */ + /* Sweeping is done. */ ++ stat_major_collections; work = 0; gc_phase = Phase_idle; }else{ - gc_sweep_hp = chunk; - limit = chunk + Chunk_size (chunk); + gc_sweep_hp = chunk; + limit = chunk + Chunk_size (chunk); } } } @@ -273,11 +273,11 @@ void major_collection_slice () MS = MW * P MS = (100 - percent_free) * (allocated_words * 3 / percent_free / 2 - + 100 * extra_heap_memory) + + 100 * extra_heap_memory) Amount of sweeping work for this slice: SS = SW * P SS = 100 * (allocated_words * 3 / percent_free / 2 - + 100 * extra_heap_memory) + + 100 * extra_heap_memory) This slice will either mark 2*MS words or sweep 2*SS words. */ @@ -287,15 +287,15 @@ void major_collection_slice () if (gc_phase == Phase_mark){ mark_slice (2 * (100 - percent_free) - * (allocated_words * 3 / percent_free / 2 + * (allocated_words * 3 / percent_free / 2 + 100 * extra_heap_memory) - + Margin); + + Margin); gc_message ("!", 0); }else{ Assert (gc_phase == Phase_sweep); sweep_slice (200 * (allocated_words * 3 / percent_free / 2 - + 100 * extra_heap_memory) - + Margin); + + 100 * extra_heap_memory) + + Margin); gc_message ("$", 0); } @@ -345,7 +345,7 @@ void init_major_heap (heap_size) stat_heap_size = round_heap_chunk_size (heap_size); Assert (stat_heap_size % Page_size == 0); heap_start = aligned_malloc (stat_heap_size + sizeof (heap_chunk_head), - sizeof (heap_chunk_head), &block); + sizeof (heap_chunk_head), &block); if (heap_start == NULL) fatal_error ("Fatal error: not enough memory for the initial heap.\n"); heap_start += sizeof (heap_chunk_head); diff --git a/byterun/md5.c b/byterun/md5.c index bdaa9244bb..9c8b0bbc39 100644 --- a/byterun/md5.c +++ b/byterun/md5.c @@ -20,14 +20,14 @@ /* MD5 message digest */ struct MD5Context { - uint32 buf[4]; - uint32 bits[2]; - unsigned char in[64]; + uint32 buf[4]; + uint32 bits[2]; + unsigned char in[64]; }; static void MD5Init P((struct MD5Context *context)); static void MD5Update P((struct MD5Context *context, unsigned char *buf, - unsigned len)); + unsigned len)); static void MD5Final P((unsigned char digest[16], struct MD5Context *ctx)); static void MD5Transform P((uint32 buf[4], uint32 in[16])); @@ -84,7 +84,7 @@ value md5_chan(chan, len) /* ML */ */ #ifndef ARCH_BIG_ENDIAN -#define byteReverse(buf, len) /* Nothing */ +#define byteReverse(buf, len) /* Nothing */ #else void byteReverse(buf, longs) unsigned char *buf; @@ -92,10 +92,10 @@ void byteReverse(buf, longs) { uint32 t; do { - t = (uint32) ((unsigned) buf[3] << 8 | buf[2]) << 16 | - ((unsigned) buf[1] << 8 | buf[0]); - *(uint32 *) buf = t; - buf += 4; + t = (uint32) ((unsigned) buf[3] << 8 | buf[2]) << 16 | + ((unsigned) buf[1] << 8 | buf[0]); + *(uint32 *) buf = t; + buf += 4; } while (--longs); } #endif @@ -131,35 +131,35 @@ static void MD5Update(ctx, buf, len) t = ctx->bits[0]; if ((ctx->bits[0] = t + ((uint32) len << 3)) < t) - ctx->bits[1]++; /* Carry from low to high */ + ctx->bits[1]++; /* Carry from low to high */ ctx->bits[1] += len >> 29; - t = (t >> 3) & 0x3f; /* Bytes already in shsInfo->data */ + t = (t >> 3) & 0x3f; /* Bytes already in shsInfo->data */ /* Handle any leading odd-sized chunks */ if (t) { - unsigned char *p = (unsigned char *) ctx->in + t; - - t = 64 - t; - if (len < t) { - memcpy(p, buf, len); - return; - } - memcpy(p, buf, t); - byteReverse(ctx->in, 16); - MD5Transform(ctx->buf, (uint32 *) ctx->in); - buf += t; - len -= t; + unsigned char *p = (unsigned char *) ctx->in + t; + + t = 64 - t; + if (len < t) { + memcpy(p, buf, len); + return; + } + memcpy(p, buf, t); + byteReverse(ctx->in, 16); + MD5Transform(ctx->buf, (uint32 *) ctx->in); + buf += t; + len -= t; } /* Process data in 64-byte chunks */ while (len >= 64) { - memcpy(ctx->in, buf, 64); - byteReverse(ctx->in, 16); - MD5Transform(ctx->buf, (uint32 *) ctx->in); - buf += 64; - len -= 64; + memcpy(ctx->in, buf, 64); + byteReverse(ctx->in, 16); + MD5Transform(ctx->buf, (uint32 *) ctx->in); + buf += 64; + len -= 64; } /* Handle any remaining bytes of data. */ @@ -191,16 +191,16 @@ static void MD5Final(digest, ctx) /* Pad out to 56 mod 64 */ if (count < 8) { - /* Two lots of padding: Pad the first block to 64 bytes */ - memset(p, 0, count); - byteReverse(ctx->in, 16); - MD5Transform(ctx->buf, (uint32 *) ctx->in); + /* Two lots of padding: Pad the first block to 64 bytes */ + memset(p, 0, count); + byteReverse(ctx->in, 16); + MD5Transform(ctx->buf, (uint32 *) ctx->in); - /* Now fill the next block with 56 bytes */ - memset(ctx->in, 0, 56); + /* Now fill the next block with 56 bytes */ + memset(ctx->in, 0, 56); } else { - /* Pad block to 56 bytes */ - memset(p, 0, count - 8); + /* Pad block to 56 bytes */ + memset(p, 0, count - 8); } byteReverse(ctx->in, 14); @@ -211,7 +211,7 @@ static void MD5Final(digest, ctx) MD5Transform(ctx->buf, (uint32 *) ctx->in); byteReverse((unsigned char *) ctx->buf, 4); memcpy(digest, ctx->buf, 16); - memset(ctx, 0, sizeof(ctx)); /* In case it's sensitive */ + memset(ctx, 0, sizeof(ctx)); /* In case it's sensitive */ } /* The four core functions - F1 is optimized somewhat */ @@ -224,7 +224,7 @@ static void MD5Final(digest, ctx) /* This is the central step in the MD5 algorithm. */ #define MD5STEP(f, w, x, y, z, data, s) \ - ( w += f(x, y, z) + data, w = w<<s | w>>(32-s), w += x ) + ( w += f(x, y, z) + data, w = w<<s | w>>(32-s), w += x ) /* * The core of the MD5 algorithm, this alters an existing MD5 hash to diff --git a/byterun/memory.c b/byterun/memory.c index ff9eda9feb..cacceadf65 100644 --- a/byterun/memory.c +++ b/byterun/memory.c @@ -42,7 +42,7 @@ static char *expand_heap (request) malloc_request = round_heap_chunk_size (Bhsize_wosize (request)); gc_message ("Growing heap to %luk bytes\n", - (stat_heap_size + malloc_request) / 1024); + (stat_heap_size + malloc_request) / 1024); mem = aligned_malloc (malloc_request + sizeof (heap_chunk_head), sizeof (heap_chunk_head), &block); if (mem == NULL){ @@ -191,7 +191,7 @@ value alloc_shr (wosize, tag) Hd_hp (hp) = Make_header (wosize, tag, Black); }else{ Assert (gc_phase == Phase_idle - || (gc_phase == Phase_sweep && (addr)hp < (addr)gc_sweep_hp)); + || (gc_phase == Phase_sweep && (addr)hp < (addr)gc_sweep_hp)); Hd_hp (hp) = Make_header (wosize, tag, White); } allocated_words += Whsize_wosize (wosize); diff --git a/byterun/memory.h b/byterun/memory.h index 6d6d634934..9f8958afe7 100644 --- a/byterun/memory.h +++ b/byterun/memory.h @@ -29,7 +29,7 @@ void adjust_gc_speed P((mlsize_t, mlsize_t)); void modify P((value *, value)); void initialize P((value *, value)); value check_urgent_gc P((value)); -char * stat_alloc P((asize_t)); /* Size in bytes. */ +char * stat_alloc P((asize_t)); /* Size in bytes. */ void stat_free P((char *)); char * stat_resize P((char *, asize_t)); /* Size in bytes. */ @@ -64,11 +64,11 @@ char * stat_resize P((char *, asize_t)); /* Size in bytes. */ if (Is_in_heap (fp)){ \ if (gc_phase == Phase_mark) darken (_old_, NULL); \ if (Is_block (val) && Is_young (val) \ - && ! (Is_block (_old_) && Is_young (_old_))){ \ + && ! (Is_block (_old_) && Is_young (_old_))){ \ *ref_table_ptr++ = (fp); \ if (ref_table_ptr >= ref_table_limit){ \ Assert (ref_table_ptr == ref_table_limit); \ - realloc_ref_table (); \ + realloc_ref_table (); \ } \ } \ } \ diff --git a/byterun/minor_gc.c b/byterun/minor_gc.c index ea96e06201..5755bff7f1 100644 --- a/byterun/minor_gc.c +++ b/byterun/minor_gc.c @@ -56,7 +56,7 @@ void set_minor_heap_size (size) ref_table_size = minor_heap_size / sizeof (value) / 8; ref_table_reserve = 256; new_table = (value **) stat_alloc ((ref_table_size + ref_table_reserve) - * sizeof (value *)); + * sizeof (value *)); if (ref_table != NULL) stat_free ((char *) ref_table); ref_table = new_table; ref_table_ptr = ref_table; diff --git a/byterun/misc.c b/byterun/misc.c index a63c0ddc2c..01da481268 100644 --- a/byterun/misc.c +++ b/byterun/misc.c @@ -25,7 +25,7 @@ void failed_assert (expr, file, line) int line; { fprintf (stderr, "Assertion failed: %s; file %s; line %d\n", - expr, file, line); + expr, file, line); exit (100); } @@ -98,30 +98,30 @@ void memmov (dst, src, length) /* The pointers are not equal modulo sizeof (long). Copy byte by byte. */ for (; length != 0; length--){ - *dst++ = *src++; + *dst++ = *src++; } }else{ /* Copy the first few bytes. */ i = (unsigned long) dst % sizeof (long); if (i != 0){ - i = sizeof (long) - i; /* Number of bytes to copy. */ - if (i > length) i = length; /* Never copy more than length.*/ - for (; i != 0; i--){ - *dst++ = *src++; --length; - } + i = sizeof (long) - i; /* Number of bytes to copy. */ + if (i > length) i = length; /* Never copy more than length.*/ + for (; i != 0; i--){ + *dst++ = *src++; --length; + } } Assert ((unsigned long) dst % sizeof (long) == 0); Assert ((unsigned long) src % sizeof (long) == 0); /* Then copy as many entire words as possible. */ for (i = length / sizeof (long); i > 0; i--){ - *(long *) dst = *(long *) src; - dst += sizeof (long); src += sizeof (long); + *(long *) dst = *(long *) src; + dst += sizeof (long); src += sizeof (long); } /* Then copy the last few bytes. */ for (i = length % sizeof (long); i > 0; i--){ - *dst++ = *src++; + *dst++ = *src++; } } }else{ /* Copy in descending order. */ @@ -129,9 +129,9 @@ void memmov (dst, src, length) if (((unsigned long) dst - (unsigned long) src) % sizeof (long) != 0){ /* The pointers are not equal modulo sizeof (long). - Copy byte by byte. */ + Copy byte by byte. */ for (; length > 0; length--){ - *--dst = *--src; + *--dst = *--src; } }else{ @@ -139,18 +139,18 @@ void memmov (dst, src, length) i = (unsigned long) dst % sizeof (long); if (i > length) i = length; /* Never copy more than length. */ for (; i > 0; i--){ - *--dst = *--src; --length; + *--dst = *--src; --length; } /* Then copy as many entire words as possible. */ for (i = length / sizeof (long); i > 0; i--){ - dst -= sizeof (long); src -= sizeof (long); - *(long *) dst = *(long *) src; + dst -= sizeof (long); src -= sizeof (long); + *(long *) dst = *(long *) src; } /* Then copy the last few bytes. */ for (i = length % sizeof (long); i > 0; i--){ - *--dst = *--src; + *--dst = *--src; } } } @@ -169,7 +169,7 @@ char *aligned_malloc (size, modulo, block) raw_mem = (char *) malloc (size + Page_size); if (raw_mem == NULL) return NULL; *block = raw_mem; - raw_mem += modulo; /* Address to be aligned */ + raw_mem += modulo; /* Address to be aligned */ aligned_mem = (((unsigned long) raw_mem / Page_size + 1) * Page_size); return (char *) (aligned_mem - modulo); } diff --git a/byterun/stacks.c b/byterun/stacks.c index 82f7541767..b9b6cece92 100644 --- a/byterun/stacks.c +++ b/byterun/stacks.c @@ -53,7 +53,7 @@ void realloc_stack() if (size >= max_stack_size) raise_stack_overflow(); size *= 2; gc_message ("Growing stack to %luk bytes\n", - (unsigned long) size * sizeof(value) / 1024); + (unsigned long) size * sizeof(value) / 1024); new_low = (value *) stat_alloc(size * sizeof(value)); new_high = new_low + size; @@ -84,6 +84,6 @@ void change_max_stack_size (new_max_size) if (new_max_size < size) new_max_size = size; gc_message ("Changing stack limit to %luk bytes\n", - new_max_size * sizeof (value) / 1024); + new_max_size * sizeof (value) / 1024); max_stack_size = new_max_size; } diff --git a/byterun/startup.c b/byterun/startup.c index 89aa220f10..d06ace0417 100644 --- a/byterun/startup.c +++ b/byterun/startup.c @@ -188,7 +188,7 @@ static void parse_camlrunparam() if (opt != NULL){ while (*opt != '\0'){ switch (*opt++){ - case 's': scanmult (opt, &minor_heap_init); break; + case 's': scanmult (opt, &minor_heap_init); break; case 'i': scanmult (opt, &heap_chunk_init); break; case 'h': scanmult (opt, &heap_size_init); break; case 'l': scanmult (opt, &max_stack_init); break; @@ -297,7 +297,7 @@ void caml_startup_code(code, code_size, data, argv) external_raise = &raise_buf; /* Initialize the abstract machine */ init_gc (minor_heap_init, heap_size_init, heap_chunk_init, - percent_free_init, max_percent_free_init, verbose_init); + percent_free_init, max_percent_free_init, verbose_init); init_stack (max_stack_init); init_atoms(); /* Initialize the interpreter */ diff --git a/byterun/sys.c b/byterun/sys.c index 100e942ea7..e664f5b040 100644 --- a/byterun/sys.c +++ b/byterun/sys.c @@ -129,7 +129,7 @@ value sys_open(path, flags, perm) /* ML */ #if !macintosh ,Int_val(perm) #endif - ); + ); if (ret == -1) sys_error(path); return Val_long(ret); } @@ -180,7 +180,7 @@ value sys_chdir(dirname) /* ML */ return Val_unit; } -value sys_getcwd(unit) /* ML */ +value sys_getcwd(unit) /* ML */ value unit; { char buff[4096]; @@ -280,9 +280,9 @@ char * searchpath(name) /* We don't need searchpath on the Macintosh because there are no #! scripts */ char *searchpath (name) - char *name; + char *name; { - return name; + return name; } #else diff --git a/byterun/wincmdline.c b/byterun/wincmdline.c index a125fb7faf..c01658df05 100644 --- a/byterun/wincmdline.c +++ b/byterun/wincmdline.c @@ -72,8 +72,8 @@ static void expand_pattern(pat) handle = _findfirst(pat, &ffblk); if (handle == -1) { - store_argument(pat); /* a la Bourne shell */ - return; + store_argument(pat); /* a la Bourne shell */ + return; } do { store_argument(strdup(ffblk.name)); @@ -101,7 +101,7 @@ static void expand_diversion(filename) for (p = buf; p < endbuf; /*nothing*/) { /* Skip leading blanks */ while (p < endbuf && isspace(*p)) p++; - if (p >= endbuf) break; + if (p >= endbuf) break; s = p; /* Skip to next blank or end of buffer */ while (p < endbuf && !isspace(*p)) p++; diff --git a/debugger/breakpoints.ml b/debugger/breakpoints.ml index c72e4646db..5ebe6edb0c 100644 --- a/debugger/breakpoints.ml +++ b/debugger/breakpoints.ml @@ -96,7 +96,7 @@ let set_breakpoints pos = (function (pos, _) -> if !debug_breakpoints then begin print_int pos; - print_newline() + print_newline() end; set_breakpoint pos) pos @@ -193,7 +193,7 @@ let remove_breakpoint number = try let pos = (List.assoc number !breakpoints).ev_pos in Exec.protected - (function () -> + (function () -> breakpoints := assoc_remove !breakpoints number; remove_position pos) with @@ -221,8 +221,8 @@ let exec_with_temporary_breakpoint pc funct = if !count = 0 then begin positions := assoc_remove !positions pc; reset_instr pc; - try Symbols.event_at_pc pc; set_event pc with Not_found -> () - end + try Symbols.event_at_pc pc; set_event pc with Not_found -> () + end in Exec.protected (function () -> insert_position pc); diff --git a/debugger/debugger_config.ml b/debugger/debugger_config.ml index 165391a301..360b1ad6c9 100644 --- a/debugger/debugger_config.ml +++ b/debugger/debugger_config.ml @@ -19,26 +19,26 @@ exception Toplevel (*** Miscellaneous parameters. ***) (*ISO 6429 color sequences -00 to restore default color -01 for brighter colors -04 for underlined text -05 for flashing text -30 for black foreground -31 for red foreground -32 for green foreground -33 for yellow (or brown) foreground -34 for blue foreground -35 for purple foreground -36 for cyan foreground -37 for white (or gray) foreground -40 for black background -41 for red background -42 for green background -43 for yellow (or brown) background -44 for blue background -45 for purple background -46 for cyan background -47 for white (or gray) background +00 to restore default color +01 for brighter colors +04 for underlined text +05 for flashing text +30 for black foreground +31 for red foreground +32 for green foreground +33 for yellow (or brown) foreground +34 for blue foreground +35 for purple foreground +36 for cyan foreground +37 for white (or gray) foreground +40 for black background +41 for red background +42 for green background +43 for yellow (or brown) background +44 for blue background +45 for purple background +46 for cyan background +47 for white (or gray) background let debugger_prompt = "\027[1;04m(ocd)\027[0m " and event_mark_before = "\027[1;31m$\027[0m" and event_mark_after = "\027[1;34m$\027[0m" diff --git a/debugger/input_handling.ml b/debugger/input_handling.ml index 76bd981585..1e821b18b0 100644 --- a/debugger/input_handling.ml +++ b/debugger/input_handling.ml @@ -51,7 +51,7 @@ let execute_with_other_controller controller file funct = with x -> change_controller file old_controller; - raise x + raise x (*** The "Main Loop" ***) @@ -67,17 +67,17 @@ let main_loop () = try continue_main_loop := true; while !continue_main_loop do - try + try let (input, _, _) = select (List.map fst !active_files) [] [] (-1.) in List.iter (function fd -> let (funct, iochan) = (List.assoc fd !active_files) in - funct iochan) + funct iochan) input - with - Unix_error (EINTR, _, _) -> () + with + Unix_error (EINTR, _, _) -> () done; continue_main_loop := old_state with @@ -122,26 +122,26 @@ let yes_or_no message = let answer = let rec ask () = resume_user_input (); - let line = + let line = string_trim (Lexer.line (Lexing.from_function read_user_input)) in - stop_user_input (); + stop_user_input (); match (if String.length line > 0 then line.[0] else ' ') with - 'y' -> true - | 'n' -> false - | _ -> - print_string "Please answer y or n."; - print_newline (); - ask () + 'y' -> true + | 'n' -> false + | _ -> + print_string "Please answer y or n."; + print_newline (); + ask () in ask () in - current_prompt := old_prompt; - answer + current_prompt := old_prompt; + answer with - x -> - current_prompt := old_prompt; - stop_user_input (); - raise x + x -> + current_prompt := old_prompt; + stop_user_input (); + raise x else false diff --git a/debugger/lexer.mll b/debugger/lexer.mll index 4a97129971..bd32346987 100644 --- a/debugger/lexer.mll +++ b/debugger/lexer.mll @@ -19,7 +19,7 @@ open Parser } -rule line = (* Read a whole line *) +rule line = (* Read a whole line *) parse [ ^ '\n' ]* '\n' { let line = Lexing.lexeme lexbuf in @@ -29,7 +29,7 @@ rule line = (* Read a whole line *) | eof { raise Exit } -and argument = (* Read a raw argument *) +and argument = (* Read a raw argument *) parse [ ^ ' ' '\t' ]+ { ARGUMENT (Lexing.lexeme lexbuf) } @@ -47,7 +47,7 @@ and line_argument = | eof { EOL } -and lexeme = (* Read a lexeme *) +and lexeme = (* Read a lexeme *) parse [' ' '\t'] + { lexeme lexbuf } diff --git a/debugger/parser.mly b/debugger/parser.mly index f79d28cb22..ce0c9c249b 100644 --- a/debugger/parser.mly +++ b/debugger/parser.mly @@ -21,23 +21,23 @@ open Parser_aux %} -%token <string> ARGUMENT -%token <string> LIDENT -%token <string> UIDENT -%token <string> OPERATOR -%token <int> INTEGER -%token STAR /* * */ -%token MINUS /* - */ -%token DOT /* . */ -%token SHARP /* # */ -%token AT /* @ */ -%token DOLLAR /* $ */ -%token BANG /* ! */ -%token LPAREN /* ( */ -%token RPAREN /* ) */ -%token LBRACKET /* [ */ -%token RBRACKET /* ] */ -%token EOL +%token <string> ARGUMENT +%token <string> LIDENT +%token <string> UIDENT +%token <string> OPERATOR +%token <int> INTEGER +%token STAR /* * */ +%token MINUS /* - */ +%token DOT /* . */ +%token SHARP /* # */ +%token AT /* @ */ +%token DOLLAR /* $ */ +%token BANG /* ! */ +%token LPAREN /* ( */ +%token RPAREN /* ) */ +%token LBRACKET /* [ */ +%token RBRACKET /* ] */ +%token EOL %right DOT %right BANG diff --git a/debugger/pattern_matching.ml b/debugger/pattern_matching.ml index 3f58106559..71e4df8066 100644 --- a/debugger/pattern_matching.ml +++ b/debugger/pattern_matching.ml @@ -82,19 +82,19 @@ let rec pattern_matching pattern obj ty = | _ -> match (Ctype.repr ty).desc with Tvar | Tarrow _ -> - error_matching () + error_matching () | Ttuple(ty_list) -> - (match pattern with - P_tuple pattern_list -> + (match pattern with + P_tuple pattern_list -> pattern_matching_list pattern_list obj ty_list - | P_nth (n, patt) -> - if n >= List.length ty_list then - (prerr_endline "Out of range."; raise Toplevel); - pattern_matching patt (Debugcom.get_field obj n) (List.nth ty_list n) - | _ -> - error_matching ()) + | P_nth (n, patt) -> + if n >= List.length ty_list then + (prerr_endline "Out of range."; raise Toplevel); + pattern_matching patt (Debugcom.get_field obj n) (List.nth ty_list n) + | _ -> + error_matching ()) | Tconstr(cstr, [ty_arg],_) when same_type_constr cstr constr_type_list -> - (match pattern with + (match pattern with P_list pattern_list -> let (last, list) = it_list @@ -126,7 +126,7 @@ let rec pattern_matching pattern obj ty = | _ -> error_matching ()) | Tconstr(cstr, [ty_arg]) when same_type_constr cstr constr_type_vect -> - (match pattern with + (match pattern with P_nth (n, patt) -> if n >= value_size obj then (prerr_endline "Out of range."; raise Toplevel); @@ -161,63 +161,63 @@ and match_concrete_type pattern obj cstr ty ty_list = filter (ty_res, ty); match constr.info.cs_kind with Constr_constant -> - error_matching () + error_matching () | Constr_regular -> - (match pattern with - P_constr (constr2, patt) -> - check_same_constr constr constr2; + (match pattern with + P_constr (constr2, patt) -> + check_same_constr constr constr2; pattern_matching patt (Debugcom.get_field obj 0) ty_arg - | _ -> - error_matching ()) + | _ -> + error_matching ()) | Constr_superfluous n -> - (match pattern with - P_constr (constr2, patt) -> - check_same_constr constr constr2; - (match patt with - P_tuple pattern_list -> + (match pattern with + P_constr (constr2, patt) -> + check_same_constr constr constr2; + (match patt with + P_tuple pattern_list -> pattern_matching_list pattern_list obj (filter_product n ty_arg) - | P_nth (n2, patt) -> - let ty_list = filter_product n ty_arg in - if n2 >= n then - (prerr_endline "Out of range."; + | P_nth (n2, patt) -> + let ty_list = filter_product n ty_arg in + if n2 >= n then + (prerr_endline "Out of range."; raise Toplevel); - pattern_matching + pattern_matching patt (Debugcom.get_field obj n2) - (List.nth ty_list n2) - | P_variable var -> - [var, - obj, - {typ_desc = Tproduct (filter_product n ty_arg); - typ_level = generic}] - | P_dummy -> - [] - | _ -> - error_matching ()) - | _ -> - error_matching ()) + (List.nth ty_list n2) + | P_variable var -> + [var, + obj, + {typ_desc = Tproduct (filter_product n ty_arg); + typ_level = generic}] + | P_dummy -> + [] + | _ -> + error_matching ()) + | _ -> + error_matching ()) with Not_found -> - error_matching () + error_matching () | Unify -> fatal_error "pattern_matching: types should match") | Record_type label_list -> let match_field (label, patt) = let lbl = - try - primitives__find - (function l -> same_name l label) - label_list - with Not_found -> - prerr_endline "Label not found."; - raise Toplevel + try + primitives__find + (function l -> same_name l label) + label_list + with Not_found -> + prerr_endline "Label not found."; + raise Toplevel in let (ty_res, ty_arg) = type_pair_instance (lbl.info.lbl_res, lbl.info.lbl_arg) - in + in (try filter (ty_res, ty) with Unify -> @@ -225,10 +225,10 @@ and match_concrete_type pattern obj cstr ty ty_list = pattern_matching patt (Debugcom.get_field obj lbl.info.lbl_pos) ty_arg in (match pattern with - P_record pattern_label_list -> - flat_map match_field pattern_label_list - | _ -> - error_matching ()) + P_record pattern_label_list -> + flat_map match_field pattern_label_list + | _ -> + error_matching ()) | Abbrev_type(_,_) -> fatal_error "pattern_matching: abbrev type" @@ -242,7 +242,7 @@ and pattern_matching_list pattern_list obj ty_list = flat_map (function (x, y, z) -> pattern_matching x y z) (rev - (snd + (snd (it_list (fun (num, list) (pattern, typ) -> (num + 1, (pattern, Debugcom.get_field obj num, typ)::list)) diff --git a/debugger/primitives.ml b/debugger/primitives.ml index 19eeaad1ce..85dba8401f 100644 --- a/debugger/primitives.ml +++ b/debugger/primitives.ml @@ -95,9 +95,9 @@ let filter p = [] | a::l -> if p a then - a::(filter2 l) + a::(filter2 l) else - filter2 l + filter2 l in filter2 (* Find the first element `element' of `list' *) @@ -107,10 +107,10 @@ let find p = let rec find2 = function [] -> - raise Not_found + raise Not_found | a::l -> - if p a then a - else find2 l + if p a then a + else find2 l in find2 (*** Operations on strings. ***) @@ -183,8 +183,8 @@ let close_io io_channel = (try close_out io_channel.io_out with - Sys_error _ -> ()) - with End_of_file -> ()); (* SIGPIPE during flush. *) + Sys_error _ -> ()) + with End_of_file -> ()); (* SIGPIPE during flush. *) close_in io_channel.io_in let std_io = { diff --git a/debugger/program_management.ml b/debugger/program_management.ml index 59fec7c3a2..53f34906f8 100644 --- a/debugger/program_management.ml +++ b/debugger/program_management.ml @@ -64,18 +64,18 @@ let open_connection address continue = let (sock_domain, sock_address) = convert_address address in file_name := (match sock_address with - ADDR_UNIX file -> - Some file + ADDR_UNIX file -> + Some file | _ -> - None); + None); let sock = socket sock_domain SOCK_STREAM 0 in - (try + (try bind sock sock_address; listen sock 3; - connection := io_channel_of_descr sock; + connection := io_channel_of_descr sock; Input_handling.add_file !connection (accept_connection continue); - connection_opened := true - with x -> close sock; raise x) + connection_opened := true + with x -> close sock; raise x) with Failure _ -> raise Toplevel | (Unix_error _) as err -> report_error err; raise Toplevel @@ -119,7 +119,7 @@ let initialize_loading () = Symbols.read_symbols (try search_in_path !program_name with Not_found -> - prerr_endline "Program not found."; + prerr_endline "Program not found."; raise Toplevel); if !debug_loading then prerr_endline "Opening a socket..."; @@ -148,6 +148,6 @@ let ensure_loaded () = prerr_endline "done." with x -> - kill_program(); - raise x + kill_program(); + raise x end diff --git a/debugger/show_information.ml b/debugger/show_information.ml index 1c51c9a161..47c25a2b81 100644 --- a/debugger/show_information.ml +++ b/debugger/show_information.ml @@ -39,20 +39,20 @@ let show_current_event () = show_no_point () | Some {rep_type = (Event | Breakpoint); rep_program_pointer = pc} -> let (mdle, point) = current_point () in - print_string (" - module " ^ mdle); - print_newline (); - (match breakpoints_at_pc pc with - [] -> - () - | [breakpoint] -> - print_string "Breakpoint : "; print_int breakpoint; + print_string (" - module " ^ mdle); + print_newline (); + (match breakpoints_at_pc pc with + [] -> + () + | [breakpoint] -> + print_string "Breakpoint : "; print_int breakpoint; print_newline () - | breakpoints -> - print_string "Breakpoints : "; - List.iter + | breakpoints -> + print_string "Breakpoints : "; + List.iter (function x -> print_int x; print_string " ") (Sort.list (<) breakpoints); - print_newline ()); + print_newline ()); show_point mdle point (current_event_is_before ()) true | Some {rep_type = Exited} -> print_newline (); print_string "Program exit."; print_newline (); @@ -68,8 +68,8 @@ let show_current_event () = print_newline(); show_no_point () | Some {rep_type = Trap_barrier} -> - (* Trap_barrier not visible outside *) - (* of module `time_travel'. *) + (* Trap_barrier not visible outside *) + (* of module `time_travel'. *) Misc.fatal_error "Show_information.show_current_event" (* Display short information about one frame. *) diff --git a/debugger/show_source.ml b/debugger/show_source.ml index f38fa382b7..df8693f3d0 100644 --- a/debugger/show_source.ml +++ b/debugger/show_source.ml @@ -69,7 +69,7 @@ let show_listing mdle start stop point before = try let buffer = get_buffer mdle in let rec aff (line_start, line_number) = - if line_number <= stop then + if line_number <= stop then aff (print_line buffer line_number line_start point before + 1, line_number + 1) in aff (pos_of_line buffer start) diff --git a/debugger/source.ml b/debugger/source.ml index acd9b9623e..ca8c40dddf 100644 --- a/debugger/source.ml +++ b/debugger/source.ml @@ -41,13 +41,13 @@ let get_buffer mdle = try List.assoc mdle !buffer_list with Not_found -> let inchan = open_in (source_of_module mdle) in - let (content, _) as buffer = - (String.create (in_channel_length inchan), ref []) + let (content, _) as buffer = + (String.create (in_channel_length inchan), ref []) in - unsafe_really_input inchan content 0 (in_channel_length inchan); - buffer_list := - (list_truncate !buffer_max_count ((mdle, buffer)::!buffer_list)); - buffer + unsafe_really_input inchan content 0 (in_channel_length inchan); + buffer_list := + (list_truncate !buffer_max_count ((mdle, buffer)::!buffer_list)); + buffer let buffer_content = (fst : buffer -> string) @@ -64,14 +64,14 @@ let insert_pos buffer ((position, line) as pair) = let rec new_list = function [] -> - [(position, line)] + [(position, line)] | ((pos, lin) as a::l) as l' -> if lin < line then - pair::l' - else if lin = line then - l' - else - a::(new_list l) + pair::l' + else if lin = line then + l' + else + a::(new_list l) in let buffer_cache = snd buffer in buffer_cache := new_list !buffer_cache @@ -88,7 +88,7 @@ let next_linefeed (buffer, _) pos = if (p = len) or (String.get buffer p = '\n') then p else - search (succ p) + search (succ p) in search pos @@ -101,21 +101,21 @@ let line_of_pos buffer position = let rec find = function [] -> - if position < 0 then - raise Out_of_range - else - (0, 1) + if position < 0 then + raise Out_of_range + else + (0, 1) | ((pos, line) as pair)::l -> - if pos > position then - find l - else - pair + if pos > position then + find l + else + pair and find_line previous = let (pos, line) as next = next_line buffer previous in if pos <= position then - find_line next + find_line next else - previous + previous in let result = find_line (find !(snd buffer)) in insert_pos buffer result; @@ -128,19 +128,19 @@ let pos_of_line buffer line = [] -> if line <= 0 then raise Out_of_range - else + else (0, 1) | ((pos, lin) as pair)::l -> - if lin > line then - find l - else - pair + if lin > line then + find l + else + pair and find_pos previous = let (_, lin) as next = next_line buffer previous in if lin <= line then - find_pos next + find_pos next else - previous + previous in let result = find_pos (find !(snd buffer)) in insert_pos buffer result; diff --git a/debugger/symbols.ml b/debugger/symbols.ml index 5cfbd9ace4..dc8bf26670 100644 --- a/debugger/symbols.ml +++ b/debugger/symbols.ml @@ -62,8 +62,8 @@ let read_symbols bytecode_file = (fun evl -> List.iter (fun ev -> - events := ev :: !events; - Hashtbl.add events_by_pc ev.ev_pos ev) + events := ev :: !events; + Hashtbl.add events_by_pc ev.ev_pos ev) evl) all_events; @@ -71,10 +71,10 @@ let read_symbols bytecode_file = (function [] -> () | ev :: _ as evl -> - let md = ev.ev_module in + let md = ev.ev_module in let sorted_evl = Sort.list (fun ev1 ev2 -> ev1.ev_char <= ev2.ev_char) evl in - modules := md :: !modules; + modules := md :: !modules; Hashtbl.add all_events_by_module md sorted_evl; let real_evl = Primitives.filter diff --git a/debugger/unix_tools.ml b/debugger/unix_tools.ml index 4bcfc25c4e..268371329d 100644 --- a/debugger/unix_tools.ml +++ b/debugger/unix_tools.ml @@ -26,14 +26,14 @@ let convert_address address = and port = String.sub address (n + 1) (String.length address) in (PF_INET, - ADDR_INET - ((try inet_addr_of_string host with Failure _ -> - try (gethostbyname host).h_addr_list.(0) with Not_found -> - prerr_endline ("Unknown host : " ^ host); - failwith "Can't convert address"), - (try int_of_string port with Failure _ -> - prerr_endline "The port number should be an integer"; - failwith "Can't convert address"))) + ADDR_INET + ((try inet_addr_of_string host with Failure _ -> + try (gethostbyname host).h_addr_list.(0) with Not_found -> + prerr_endline ("Unknown host : " ^ host); + failwith "Can't convert address"), + (try int_of_string port with Failure _ -> + prerr_endline "The port number should be an integer"; + failwith "Can't convert address"))) with Not_found -> (PF_UNIX, ADDR_UNIX address) @@ -72,18 +72,18 @@ let search_in_path name = let rec find pos = let pos2 = traverse pos in let directory = (String.sub path pos (pos2 - pos)) in - let fullname = - if directory = "" then - name + let fullname = + if directory = "" then + name else - directory ^ "/" ^ name + directory ^ "/" ^ name in try check fullname with Not_found -> if pos2 < length then find (pos2 + 1) else - raise Not_found + raise Not_found in find 0 @@ -94,9 +94,9 @@ let rec expand_path ch = try let pos = string_pos ch '$' in if (pos + 1 < String.length ch) & (ch.[pos + 1] = '$') then - (String.sub ch 0 (pos + 1)) - ^ (subst_variable - (String.sub ch (pos + 2) (String.length ch - pos - 2))) + (String.sub ch 0 (pos + 1)) + ^ (subst_variable + (String.sub ch (pos + 2) (String.length ch - pos - 2))) else (String.sub ch 0 pos) ^ (subst2 (String.sub ch (pos + 1) (String.length ch - pos - 1))) @@ -122,7 +122,7 @@ let rec expand_path ch = "~" ^ nom in if ch.[0] = '~' then - try + try match string_pos ch '/' with 1 -> (let tail = String.sub ch 2 (String.length ch - 2) @@ -134,6 +134,6 @@ let rec expand_path ch = (String.sub ch 1 (n - 1)) (String.sub ch (n + 1) (String.length ch - n - 1)) with - Not_found -> + Not_found -> expand_path (ch ^ "/") else ch diff --git a/lex/Makefile.Mac b/lex/Makefile.Mac index 18ca267363..2959226e00 100644 --- a/lex/Makefile.Mac +++ b/lex/Makefile.Mac @@ -14,36 +14,36 @@ OBJS = parser.cmo lexer.cmo lexgen.cmo compact.cmo output.cmo main.cmo all ocamllex ocamllex {OBJS} - {CAMLC} {LINKFLAGS} -o ocamllex {OBJS} + {CAMLC} {LINKFLAGS} -o ocamllex {OBJS} clean - delete -i ocamllex - delete -i .cm[io] || set status 0 + delete -i ocamllex + delete -i .cm[io] || set status 0 parser.mli parser.ml - echo -n + echo -n parser.ml parser.mly - {CAMLYACC} {YACCFLAGS} parser.mly + {CAMLYACC} {YACCFLAGS} parser.mly clean - delete -i parser.ml parser.mli + delete -i parser.ml parser.mli beforedepend parser.ml parser.mli lexer.ml lexer.mll - {CAMLLEX} lexer.mll + {CAMLLEX} lexer.mll clean - delete -i lexer.ml + delete -i lexer.ml beforedepend lexer.ml .cmo .ml - {CAMLC} -c {COMPFLAGS} {default}.ml + {CAMLC} -c {COMPFLAGS} {default}.ml .cmi .mli - {CAMLC} -c {COMPFLAGS} {default}.mli + {CAMLC} -c {COMPFLAGS} {default}.mli depend beforedepend - {CAMLDEP} .mli .ml > Makefile.Mac.depend + {CAMLDEP} .mli .ml > Makefile.Mac.depend diff --git a/lex/parser.mly b/lex/parser.mly index 044f2b5616..b74b94d520 100644 --- a/lex/parser.mly +++ b/lex/parser.mly @@ -82,7 +82,7 @@ entry: Tparse case rest_of_entry { $2::List.rev $3 } | Tparse rest_of_entry - { List.rev $2 } + { List.rev $2 } ; rest_of_entry: rest_of_entry Tor case diff --git a/otherlibs/dbm/dbm.c b/otherlibs/dbm/dbm.c index 82398f9dcc..88121caffc 100644 --- a/otherlibs/dbm/dbm.c +++ b/otherlibs/dbm/dbm.c @@ -58,7 +58,7 @@ value caml_dbm_open(vfile, vflags, vmode) /* ML */ } /* Dbm.close: t -> unit */ -value caml_dbm_close(vdb) /* ML */ +value caml_dbm_close(vdb) /* ML */ value vdb; { dbm_close((DBM *)vdb); @@ -66,7 +66,7 @@ value caml_dbm_close(vdb) /* ML */ } /* Dbm.fetch: t -> string -> string */ -value caml_dbm_fetch(vdb,vkey) /* ML */ +value caml_dbm_fetch(vdb,vkey) /* ML */ value vdb; value vkey; { @@ -95,7 +95,7 @@ value caml_dbm_insert(vdb,vkey,vcontent) /* ML */ switch(dbm_store((DBM *)vdb, key, content, DBM_INSERT)) { case 0: return Val_unit; - case 1: /* DBM_INSERT and already existing */ + case 1: /* DBM_INSERT and already existing */ raise_dbm("Entry already exists"); default: raise_dbm("dbm_store failed"); @@ -121,7 +121,7 @@ value caml_dbm_replace(vdb,vkey,vcontent) /* ML */ } } -value caml_dbm_delete(vdb,vkey) /* ML */ +value caml_dbm_delete(vdb,vkey) /* ML */ value vdb, vkey; { datum key; @@ -133,7 +133,7 @@ value caml_dbm_delete(vdb,vkey) /* ML */ else return Val_unit; } -value caml_dbm_firstkey(vdb) /* ML */ +value caml_dbm_firstkey(vdb) /* ML */ value vdb; { datum key = dbm_firstkey((DBM *)vdb); @@ -146,7 +146,7 @@ value caml_dbm_firstkey(vdb) /* ML */ else raise_not_found(); } -value caml_dbm_nextkey(vdb) /* ML */ +value caml_dbm_nextkey(vdb) /* ML */ value vdb; { datum key = dbm_nextkey((DBM *)vdb); diff --git a/otherlibs/dbm/dbm.ml b/otherlibs/dbm/dbm.ml index b237c97594..58a76e48f6 100644 --- a/otherlibs/dbm/dbm.ml +++ b/otherlibs/dbm/dbm.ml @@ -23,9 +23,9 @@ type dbm_flag = exception Dbm_error of string external install_exn : exn -> unit - = "caml_dbm_install_exn" + = "caml_dbm_install_exn" external opendbm : string -> open_flag list -> int -> t - = "caml_dbm_open" + = "caml_dbm_open" external close : t -> unit = "caml_dbm_close" external find : t -> string -> string = "caml_dbm_fetch" external add : t -> string -> string -> unit = "caml_dbm_insert" @@ -42,7 +42,7 @@ let iter f t = f k (find t k); match try Some(nextkey t) with Not_found -> None with - None -> () + None -> () | Some k -> walk k in walk (firstkey t) diff --git a/otherlibs/dynlink/Makefile.Mac b/otherlibs/dynlink/Makefile.Mac index 04d86d4568..fcef110c2b 100644 --- a/otherlibs/dynlink/Makefile.Mac +++ b/otherlibs/dynlink/Makefile.Mac @@ -13,27 +13,27 @@ all dynlink.cma extract_crc allopt dynlink.cma {OBJS} - {CAMLC} {COMPFLAGS} -a -o dynlink.cma {COMPILEROBJS} {OBJS} + {CAMLC} {COMPFLAGS} -a -o dynlink.cma {COMPILEROBJS} {OBJS} extract_crc dynlink.cma extract_crc.cmo - {CAMLC} {COMPFLAGS} -o extract_crc dynlink.cma extract_crc.cmo + {CAMLC} {COMPFLAGS} -o extract_crc dynlink.cma extract_crc.cmo install - duplicate -y dynlink.cmi dynlink.cma extract_crc "{LIBDIR}" + duplicate -y dynlink.cmi dynlink.cma extract_crc "{LIBDIR}" installopt partialclean - delete -i extract_crc - delete -i .cm[aio] || set status 0 + delete -i extract_crc + delete -i .cm[aio] || set status 0 clean partialclean .cmi .mli - {CAMLC} -c {COMPFLAGS} {default}.mli + {CAMLC} -c {COMPFLAGS} {default}.mli .cmo .ml - {CAMLC} -c {COMPFLAGS} {default}.ml + {CAMLC} -c {COMPFLAGS} {default}.ml depend - :::boot:ocamlrun :::tools:ocamldep .mli .ml > Makefile.Mac.depend + :::boot:ocamlrun :::tools:ocamldep .mli .ml > Makefile.Mac.depend diff --git a/otherlibs/num/Makefile.Mac b/otherlibs/num/Makefile.Mac index c0f50fd045..6b0bcbda37 100644 --- a/otherlibs/num/Makefile.Mac +++ b/otherlibs/num/Makefile.Mac @@ -20,39 +20,39 @@ PPCCOBJS = nat_stubs.c.x all libnums.o libnums.x nums.cma {CMIFILES} nums.cma {CAMLOBJS} - {CAMLC} -a -o nums.cma {CAMLOBJS} + {CAMLC} -a -o nums.cma {CAMLOBJS} libnums.o :bignum:libbignum.o {COBJS} - lib -o libnums.o :bignum:libbignum.o {COBJS} + lib -o libnums.o :bignum:libbignum.o {COBJS} libnums.x :bignum:libbignum.x {PPCCOBJS} - ppclink -xm library -o libnums.x :bignum:libbignum.x {PPCCOBJS} + ppclink -xm library -o libnums.x :bignum:libbignum.x {PPCCOBJS} :bignum:libbignum.x :bignum:libbignum.o - echo -n + echo -n :bignum:libbignum.o - directory :bignum; domake C; directory :: + directory :bignum; domake C; directory :: install - duplicate -y libnums.o libnums.x nums.cma {CMIFILES} "{LIBDIR}" + duplicate -y libnums.o libnums.x nums.cma {CMIFILES} "{LIBDIR}" partialclean - delete -i .cm[aio] || set status 0 + delete -i .cm[aio] || set status 0 clean partialclean - delete -i .[ox] || set status 0 - directory :bignum; domake scratch; directory :: - directory :test; domake clean; directory :: + delete -i .[ox] || set status 0 + directory :bignum; domake scratch; directory :: + directory :test; domake clean; directory :: .cmi .mli - {CAMLC} -c {COMPFLAGS} {default}.mli + {CAMLC} -c {COMPFLAGS} {default}.mli .cmo .ml - {CAMLC} -c {COMPFLAGS} {default}.ml + {CAMLC} -c {COMPFLAGS} {default}.ml nat_stubs.c.o nat.h depend - MakeDepend .c > Makefile.Mac.depend - :::boot:ocamlrun :::tools:ocamldep .mli .ml >> Makefile.Mac.depend + MakeDepend .c > Makefile.Mac.depend + :::boot:ocamlrun :::tools:ocamldep .mli .ml >> Makefile.Mac.depend diff --git a/otherlibs/num/big_int.ml b/otherlibs/num/big_int.ml index 60ecadb5ea..1719ab54b1 100644 --- a/otherlibs/num/big_int.ml +++ b/otherlibs/num/big_int.ml @@ -90,10 +90,10 @@ let pred_big_int bi = { sign = if is_zero_nat copy_bi 0 size_bi then 0 else 1; abs_value = copy_bi } | _ -> let size_bi = num_digits_big_int bi in - let size_res = succ (size_bi) in + let size_res = succ (size_bi) in let copy_bi = create_nat (size_res) in blit_nat copy_bi 0 (bi.abs_value) 0 size_bi; - set_digit_nat copy_bi size_bi 0; + set_digit_nat copy_bi size_bi 0; incr_nat copy_bi 0 size_res 1; { sign = -1; abs_value = copy_bi } @@ -107,11 +107,11 @@ let succ_big_int bi = { sign = if is_zero_nat copy_bi 0 size_bi then 0 else -1; abs_value = copy_bi } | _ -> let size_bi = num_digits_big_int bi in - let size_res = succ (size_bi) in + let size_res = succ (size_bi) in let copy_bi = create_nat (size_res) in blit_nat copy_bi 0 (bi.abs_value) 0 size_bi; set_digit_nat copy_bi size_bi 0; - incr_nat copy_bi 0 size_res 1; + incr_nat copy_bi 0 size_res 1; { sign = 1; abs_value = copy_bi } diff --git a/otherlibs/num/bignum/Makefile.Mac b/otherlibs/num/bignum/Makefile.Mac index 196acc8b4d..00e88b3278 100644 --- a/otherlibs/num/bignum/Makefile.Mac +++ b/otherlibs/num/bignum/Makefile.Mac @@ -12,7 +12,7 @@ PPCCOptions = -i :h: -d CAML_LIGHT -w 30 PPCLinkOptions = PPCLibs = "{sharedlibraries}MathLib" "{ppclibraries}PPCCRuntime.o" "{ppclibraries}PPCToolLibs.o" "{sharedlibraries}StdCLib" - "{ppclibraries}StdCRuntime.o" "{sharedlibraries}InterfaceLib" + "{ppclibraries}StdCRuntime.o" "{sharedlibraries}InterfaceLib" LIB = libbignum.o OBJECT = :o:KerN.o :o:bnInit.o :o:bnMult.o :o:bnDivide.o :o:bnCmp.o :o:bzf.o @@ -30,42 +30,42 @@ KERNH = :h:BigNum.h # scratch - start from scratch default - echo "Usage: make <version>" - echo "see README for valid versions." + echo "Usage: make <version>" + echo "see README for valid versions." #all testKerN bztest -# echo All is done +# echo All is done all {LIB} {PPCLIB} - echo All is done + echo All is done scratch - delete -i :o:.[ox] || set status 0 - delete -i libbignum.o libbignum.x - delete -i bztest testKerN + delete -i :o:.[ox] || set status 0 + delete -i libbignum.o libbignum.x + delete -i bztest testKerN # build the BigNum library {LIB} {OBJECT} - lib -o {LIB} {OBJECT} + lib -o {LIB} {OBJECT} {PPCLIB} {PPCOBJECT} - ppclink -xm library -o {PPCLIB} {PPCOBJECT} + ppclink -xm library -o {PPCLIB} {PPCOBJECT} # How to choose the machine dependent version. All produce KerN.o :o:KerN.o :c:KerN.c - echo "The Default is KerN written in C with digits on long" - domake C -d C="{C}" -d COptions="{COptions}" + echo "The Default is KerN written in C with digits on long" + domake C -d C="{C}" -d COptions="{COptions}" C scratch - {C} {COptions} :c:KerN.c -o :o:KerN.o - {PPCC} {PPCCOptions} :c:KerN.c -o :o:KerN.x - domake all + {C} {COptions} :c:KerN.c -o :o:KerN.o + {PPCC} {PPCCOptions} :c:KerN.c -o :o:KerN.x + domake all .o .c {KERNH} - {C} {COptions} {depdir}{default}.c -o {targdir}{default}.o + {C} {COptions} {depdir}{default}.c -o {targdir}{default}.o .x .c {KERNH} - {PPCC} {PPCCOptions} {depdir}{default}.c -o {targdir}{default}.x + {PPCC} {PPCCOptions} {depdir}{default}.c -o {targdir}{default}.x :o: :c: :c:bn: @@ -83,20 +83,20 @@ C scratch # Tests Of KerN testKerN :o:testKerN.o {LIB} - ilink -c 'MPS ' -t MPST :o:testKerN.o {LIB} {LinkOptions} -o testKerN {Libs} + ilink -c 'MPS ' -t MPST :o:testKerN.o {LIB} {LinkOptions} -o testKerN {Libs} testKerN :o:testKerN.x {PPCLIB} - ppclink -c 'MPS ' -t MPST :o:testKerN.x {PPCLIB} {PPCLinkOptions} - -o testKerN {PPCLibs} + ppclink -c 'MPS ' -t MPST :o:testKerN.x {PPCLIB} {PPCLinkOptions} + -o testKerN {PPCLibs} :o:testKerN.o :o:testKerN.x {KERNH} # Tests Of BigZ bztest :o:bztest.o {LIB} - ilink -c 'MPS ' -t MPST :o:bztest.o {LIB} {LinkOptions} -o bztest {Libs} + ilink -c 'MPS ' -t MPST :o:bztest.o {LIB} {LinkOptions} -o bztest {Libs} bztest :o:bztest.x {PPCLIB} - ppclink -c 'MPS ' -t MPST :o:bztest.x {PPCLIB} {PPCLinkOptions} - -o bztest {PPCLibs} + ppclink -c 'MPS ' -t MPST :o:bztest.x {PPCLIB} {PPCLinkOptions} + -o bztest {PPCLibs} :o:bztest.o :o:bztest.x :h:BigZ.h {KERNH} diff --git a/otherlibs/num/nat_stubs.c b/otherlibs/num/nat_stubs.c index 55b2947c0f..2900509162 100644 --- a/otherlibs/num/nat_stubs.c +++ b/otherlibs/num/nat_stubs.c @@ -21,7 +21,7 @@ /* Stub code for the BigNum package. */ -value create_nat(size) /* ML */ +value create_nat(size) /* ML */ value size; { mlsize_t sz = Long_val(size); @@ -33,14 +33,14 @@ value create_nat(size) /* ML */ } } -value set_to_zero_nat(nat, ofs, len) /* ML */ +value set_to_zero_nat(nat, ofs, len) /* ML */ value nat, ofs, len; { BnSetToZero(Bignum_val(nat), Long_val(ofs), Long_val(len)); return Val_unit; } -value blit_nat(nat1, ofs1, nat2, ofs2, len) /* ML */ +value blit_nat(nat1, ofs1, nat2, ofs2, len) /* ML */ value nat1, ofs1, nat2, ofs2, len; { BnAssign(Bignum_val(nat1), Long_val(ofs1), @@ -49,57 +49,57 @@ value blit_nat(nat1, ofs1, nat2, ofs2, len) /* ML */ return Val_unit; } -value set_digit_nat(nat, ofs, digit) /* ML */ +value set_digit_nat(nat, ofs, digit) /* ML */ value nat, ofs, digit; { BnSetDigit(Bignum_val(nat), Long_val(ofs), Long_val(digit)); return Val_unit; } -value nth_digit_nat(nat, ofs) /* ML */ +value nth_digit_nat(nat, ofs) /* ML */ value nat, ofs; { return Val_long(BnGetDigit(Bignum_val(nat), Long_val(ofs))); } -value num_digits_nat(nat, ofs, len) /* ML */ +value num_digits_nat(nat, ofs, len) /* ML */ value nat, ofs, len; { return Val_long(BnNumDigits(Bignum_val(nat), Long_val(ofs), Long_val(len))); } -value num_leading_zero_bits_in_digit(nat, ofs) /* ML */ +value num_leading_zero_bits_in_digit(nat, ofs) /* ML */ value nat, ofs; { return Val_long(BnNumLeadingZeroBitsInDigit(Bignum_val(nat), Long_val(ofs))); } -value is_digit_int(nat, ofs) /* ML */ +value is_digit_int(nat, ofs) /* ML */ value nat, ofs; { return Val_bool(BnDoesDigitFitInWord(Bignum_val(nat), Long_val(ofs))); } -value is_digit_zero(nat, ofs) /* ML */ +value is_digit_zero(nat, ofs) /* ML */ value nat, ofs; { return Val_bool(BnIsDigitZero(Bignum_val(nat), Long_val(ofs))); } -value is_digit_normalized(nat, ofs) /* ML */ +value is_digit_normalized(nat, ofs) /* ML */ value nat, ofs; { return Val_bool(BnIsDigitNormalized(Bignum_val(nat), Long_val(ofs))); } -value is_digit_odd(nat, ofs) /* ML */ +value is_digit_odd(nat, ofs) /* ML */ value nat, ofs; { return Val_bool(BnIsDigitOdd(Bignum_val(nat), Long_val(ofs))); } -value incr_nat(nat, ofs, len, carry_in) /* ML */ +value incr_nat(nat, ofs, len, carry_in) /* ML */ value nat, ofs, len, carry_in; { return Val_long(BnAddCarry(Bignum_val(nat), Long_val(ofs), @@ -114,7 +114,7 @@ value add_nat_native(nat1, ofs1, len1, nat2, ofs2, len2, carry_in) Long_val(carry_in))); } -value add_nat(argv, argn) /* ML */ +value add_nat(argv, argn) /* ML */ value * argv; int argn; { @@ -122,14 +122,14 @@ value add_nat(argv, argn) /* ML */ argv[4], argv[5], argv[6]); } -value complement_nat(nat, ofs, len) /* ML */ +value complement_nat(nat, ofs, len) /* ML */ value nat, ofs, len; { BnComplement(Bignum_val(nat), Long_val(ofs), Long_val(len)); return Val_unit; } -value decr_nat(nat, ofs, len, carry_in) /* ML */ +value decr_nat(nat, ofs, len, carry_in) /* ML */ value nat, ofs, len, carry_in; { return Val_long(BnSubtractBorrow(Bignum_val(nat), Long_val(ofs), @@ -144,7 +144,7 @@ value sub_nat_native(nat1, ofs1, len1, nat2, ofs2, len2, carry_in) Long_val(carry_in))); } -value sub_nat(argv, argn) /* ML */ +value sub_nat(argv, argn) /* ML */ value * argv; int argn; { @@ -161,7 +161,7 @@ value mult_digit_nat_native(nat1, ofs1, len1, nat2, ofs2, len2, nat3, ofs3) Bignum_val(nat3), Long_val(ofs3))); } -value mult_digit_nat(argv, argn) /* ML */ +value mult_digit_nat(argv, argn) /* ML */ value * argv; int argn; { @@ -178,7 +178,7 @@ value mult_nat_native(nat1, ofs1, len1, nat2, ofs2, len2, nat3, ofs3, len3) Bignum_val(nat3), Long_val(ofs3), Long_val(len3))); } -value mult_nat(argv, argn) /* ML */ +value mult_nat(argv, argn) /* ML */ value * argv; int argn; { @@ -194,7 +194,7 @@ value shift_left_nat_native(nat1, ofs1, len1, nat2, ofs2, nbits) return Val_unit; } -value shift_left_nat(argv, argn) /* ML */ +value shift_left_nat(argv, argn) /* ML */ value * argv; int argn; { @@ -212,7 +212,7 @@ value div_digit_nat_native(natq, ofsq, natr, ofsr, nat1, ofs1, len1, nat2, ofs2) return Val_unit; } -value div_digit_nat(argv, argn) /* ML */ +value div_digit_nat(argv, argn) /* ML */ value * argv; int argn; { @@ -228,7 +228,7 @@ value div_nat_native(nat1, ofs1, len1, nat2, ofs2, len2) return Val_unit; } -value div_nat(argv, argn) /* ML */ +value div_nat(argv, argn) /* ML */ value * argv; int argn; { @@ -244,7 +244,7 @@ value shift_right_nat_native(nat1, ofs1, len1, nat2, ofs2, nbits) return Val_unit; } -value shift_right_nat(argv, argn) /* ML */ +value shift_right_nat(argv, argn) /* ML */ value * argv; int argn; { @@ -252,7 +252,7 @@ value shift_right_nat(argv, argn) /* ML */ argv[3], argv[4], argv[5]); } -value compare_digits_nat(nat1, ofs1, nat2, ofs2) /* ML */ +value compare_digits_nat(nat1, ofs1, nat2, ofs2) /* ML */ value nat1, ofs1, nat2, ofs2; { return Val_long(BnCompareDigits(Bignum_val(nat1), Long_val(ofs1), @@ -266,7 +266,7 @@ value compare_nat_native(nat1, ofs1, len1, nat2, ofs2, len2) Bignum_val(nat2), Long_val(ofs2), Long_val(len2))); } -value compare_nat(argv, argn) /* ML */ +value compare_nat(argv, argn) /* ML */ value * argv; int argn; { @@ -274,7 +274,7 @@ value compare_nat(argv, argn) /* ML */ argv[3], argv[4], argv[5]); } -value land_digit_nat(nat1, ofs1, nat2, ofs2) /* ML */ +value land_digit_nat(nat1, ofs1, nat2, ofs2) /* ML */ value nat1, ofs1, nat2, ofs2; { BnAndDigits(Bignum_val(nat1), Long_val(ofs1), @@ -282,7 +282,7 @@ value land_digit_nat(nat1, ofs1, nat2, ofs2) /* ML */ return Val_unit; } -value lor_digit_nat(nat1, ofs1, nat2, ofs2) /* ML */ +value lor_digit_nat(nat1, ofs1, nat2, ofs2) /* ML */ value nat1, ofs1, nat2, ofs2; { BnOrDigits(Bignum_val(nat1), Long_val(ofs1), @@ -290,7 +290,7 @@ value lor_digit_nat(nat1, ofs1, nat2, ofs2) /* ML */ return Val_unit; } -value lxor_digit_nat(nat1, ofs1, nat2, ofs2) /* ML */ +value lxor_digit_nat(nat1, ofs1, nat2, ofs2) /* ML */ value nat1, ofs1, nat2, ofs2; { BnXorDigits(Bignum_val(nat1), Long_val(ofs1), diff --git a/otherlibs/str/Makefile.Mac b/otherlibs/str/Makefile.Mac index da6dae5baa..06bb6b560e 100644 --- a/otherlibs/str/Makefile.Mac +++ b/otherlibs/str/Makefile.Mac @@ -16,36 +16,36 @@ PPCCOBJS = strstubs.c.x {REGEXLIB}regex.c.x all libstr.o libstr.x str.cmi str.cma libstr.o {COBJS} - lib -o libstr.o {COBJS} + lib -o libstr.o {COBJS} libstr.x {PPCCOBJS} - ppclink -xm library -o libstr.x {PPCCOBJS} + ppclink -xm library -o libstr.x {PPCCOBJS} str.cma str.cmo - {CAMLC} -a -o str.cma str.cmo + {CAMLC} -a -o str.cma str.cmo {REGEXLIB}regex.c.x {REGEXLIB}regex.c.o - echo -n + echo -n {REGEXLIB}regex.c.o {REGEXLIB}regex.c {REGEXLIB}regex.h - directory {REGEXLIB}; domake; directory :: + directory {REGEXLIB}; domake; directory :: partialclean - delete -i .cm[aio] || set status 0 + delete -i .cm[aio] || set status 0 clean partialclean - delete -i .[ox] || set status 0 - directory {REGEXLIB}; domake distclean; directory :: + delete -i .[ox] || set status 0 + directory {REGEXLIB}; domake distclean; directory :: install - duplicate -y libstr.o libstr.x str.cma str.cmi "{LIBDIR}" + duplicate -y libstr.o libstr.x str.cma str.cmi "{LIBDIR}" .cmi .mli - {CAMLC} -c {COMPFLAGS} {default}.mli + {CAMLC} -c {COMPFLAGS} {default}.mli .cmo .ml - {CAMLC} -c {COMPFLAGS} {default}.ml + {CAMLC} -c {COMPFLAGS} {default}.ml depend - MakeDepend .c > Makefile.Mac.depend - :::boot:ocamlrun :::tools:ocamldep .mli .ml >> Makefile.Mac.depend + MakeDepend .c > Makefile.Mac.depend + :::boot:ocamlrun :::tools:ocamldep .mli .ml >> Makefile.Mac.depend diff --git a/otherlibs/unix/unix.mli b/otherlibs/unix/unix.mli index 36556a93ff..dce5ee185d 100644 --- a/otherlibs/unix/unix.mli +++ b/otherlibs/unix/unix.mli @@ -154,12 +154,12 @@ external wait : unit -> int * process_status = "unix_wait" external waitpid : wait_flag list -> int -> int * process_status = "unix_waitpid" (* Same as [wait], but waits for the process whose pid is given. - A pid of [-1] means wait for any child. + A pid of [-1] means wait for any child. A pid of [0] means wait for any child in the same process group as the current process. Negative pid arguments represent process groups. - The list of options indicates whether [waitpid] should return - immediately without waiting, or also report stopped children. *) + The list of options indicates whether [waitpid] should return + immediately without waiting, or also report stopped children. *) val system : string -> process_status (* Execute the given command, wait until it terminates, and return its termination status. The string is interpreted by the shell diff --git a/otherlibs/win32unix/accept.c b/otherlibs/win32unix/accept.c index 21a07d7109..6b6633b85a 100644 --- a/otherlibs/win32unix/accept.c +++ b/otherlibs/win32unix/accept.c @@ -36,7 +36,7 @@ value unix_accept(sock) /* ML */ sock_addr_len = sizeof(sock_addr); enter_blocking_section(); s = accept((SOCKET) _get_osfhandle(Int_val(sock)), - &sock_addr.s_gen, &sock_addr_len); + &sock_addr.s_gen, &sock_addr_len); leave_blocking_section(); if (s == INVALID_SOCKET) { _dosmaperr(WSAGetLastError()); diff --git a/otherlibs/win32unix/close_on.c b/otherlibs/win32unix/close_on.c index 324c16209e..179a5ae481 100644 --- a/otherlibs/win32unix/close_on.c +++ b/otherlibs/win32unix/close_on.c @@ -63,19 +63,19 @@ static int win_open_osfhandle2(handle, flags, reqd_fd) if (fd == -1) return -1; if (fd == reqd_fd) - return 0; /* Got it! */ + return 0; /* Got it! */ /* Make a copy of the handle, since we're going to close "handle" when we close "fd". */ if (! DuplicateHandle(GetCurrentProcess(), handle, - GetCurrentProcess(), &new_handle, - 0L, FALSE, DUPLICATE_SAME_ACCESS)) { + GetCurrentProcess(), &new_handle, + 0L, FALSE, DUPLICATE_SAME_ACCESS)) { _dosmaperr(GetLastError()); return -1; } /* Keep fd open during the recursive call, thus forcing _open_osfhandle to return reqd_fd eventually. */ retcode = win_open_osfhandle2(new_handle, flags, reqd_fd); - close(fd); /* Also closes "handle" */ + close(fd); /* Also closes "handle" */ return retcode; } @@ -86,8 +86,8 @@ static int win_set_noninherit(fd) oldh = (HANDLE) _get_osfhandle(fd); if (oldh == (HANDLE) -1) return -1; if (! DuplicateHandle(GetCurrentProcess(), oldh, - GetCurrentProcess(), &newh, - 0L, FALSE, DUPLICATE_SAME_ACCESS)) { + GetCurrentProcess(), &newh, + 0L, FALSE, DUPLICATE_SAME_ACCESS)) { _dosmaperr(GetLastError()); return -1; } diff --git a/otherlibs/win32unix/connect.c b/otherlibs/win32unix/connect.c index db2a9f66a7..650d32b77d 100644 --- a/otherlibs/win32unix/connect.c +++ b/otherlibs/win32unix/connect.c @@ -18,7 +18,7 @@ value unix_connect(socket, address) /* ML */ value socket, address; { - int retcode; + int retcode; get_sockaddr(address); enter_blocking_section(); diff --git a/otherlibs/win32unix/createprocess.c b/otherlibs/win32unix/createprocess.c index 9600cf0fe8..64917ba757 100644 --- a/otherlibs/win32unix/createprocess.c +++ b/otherlibs/win32unix/createprocess.c @@ -47,8 +47,8 @@ value win_create_process_native(cmd, cmdline, env, fd1, fd2, fd3) } value win_create_process(argv, argn) /* ML */ - value * argv; - int argn; + value * argv; + int argn; { return win_create_process_native(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); diff --git a/otherlibs/win32unix/sockopt.c b/otherlibs/win32unix/sockopt.c index a3832cb21f..c858627a5f 100644 --- a/otherlibs/win32unix/sockopt.c +++ b/otherlibs/win32unix/sockopt.c @@ -37,7 +37,7 @@ value unix_setsockopt(socket, option, status) /* ML */ int optval = Int_val(status); if (setsockopt(_get_osfhandle(Int_val(socket)), SOL_SOCKET, sockopt[Int_val(option)], - (char *) &optval, sizeof(optval)) == -1) + (char *) &optval, sizeof(optval)) == -1) uerror("setsockopt", Nothing); return Val_unit; } diff --git a/otherlibs/win32unix/unix.ml b/otherlibs/win32unix/unix.ml index aad5033679..f07a673025 100644 --- a/otherlibs/win32unix/unix.ml +++ b/otherlibs/win32unix/unix.ml @@ -408,7 +408,7 @@ external win_create_process : string -> string -> string option -> let create_process prog args fd1 fd2 fd3 = win_create_process prog (String.concat " " (Array.to_list args)) None fd1 fd2 fd3 - + let create_process_env prog args env fd1 fd2 fd3 = win_create_process prog (String.concat " " (Array.to_list args)) (Some(String.concat "\000" (Array.to_list env) ^ "\000")) diff --git a/otherlibs/win32unix/windir.c b/otherlibs/win32unix/windir.c index df6b5aa138..0461c1e34c 100644 --- a/otherlibs/win32unix/windir.c +++ b/otherlibs/win32unix/windir.c @@ -51,10 +51,10 @@ value win_findnext(valh) /* ML */ retcode = _findnext(Int_val(valh), &fileinfo); if (retcode != 0) raise_end_of_file(); return copy_string(fileinfo.name); -} +} value win_findclose(valh) /* ML */ - value valh; + value valh; { if (_findclose(Int_val(valh)) != 0) uerror("closedir", Nothing); return Val_unit; diff --git a/otherlibs/win32unix/winwait.c b/otherlibs/win32unix/winwait.c index ebba52ff4b..16fbece8ff 100644 --- a/otherlibs/win32unix/winwait.c +++ b/otherlibs/win32unix/winwait.c @@ -43,6 +43,6 @@ value win_waitpid(flags, vpid_req) /* ML */ int status, pid_req; pid_req = Int_val(vpid_req); if (_cwait(&status, pid_req, 0/* ignored by win32 */) == -1) - uerror("waitpid", Nothing); + uerror("waitpid", Nothing); return alloc_process_status(pid_req, status); } diff --git a/parsing/parser.mly b/parsing/parser.mly index 1f905faf6b..f3341bde4a 100644 --- a/parsing/parser.mly +++ b/parsing/parser.mly @@ -42,9 +42,9 @@ let mkoperator name pos = let mkassert e = let {loc_start = st; loc_end = en} = symbol_loc () in let triple = mkexp (Pexp_tuple - [mkexp (Pexp_constant (Const_string !input_name)); - mkexp (Pexp_constant (Const_int st)); - mkexp (Pexp_constant (Const_int en))]) in + [mkexp (Pexp_constant (Const_string !input_name)); + mkexp (Pexp_constant (Const_int st)); + mkexp (Pexp_constant (Const_int en))]) in let ex = Ldot (Lident "Pervasives", "Assert_failure") in let bucket = mkexp (Pexp_construct (ex, Some triple)) in let ra = Ldot (Lident "Pervasives", "raise") in diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli index 1f6ed64706..124263ceb3 100644 --- a/parsing/parsetree.mli +++ b/parsing/parsetree.mli @@ -129,7 +129,7 @@ type class_type = type class_field = Pcf_inher of (Longident.t * core_type list * expression list * - string option * Location.t) + string option * Location.t) | Pcf_val of (string * private_flag * mutable_flag * expression option * Location.t) | Pcf_virt of (string * private_flag * core_type * Location.t) diff --git a/stdlib/Makefile.Mac b/stdlib/Makefile.Mac index 5b4fb081ba..728482021e 100644 --- a/stdlib/Makefile.Mac +++ b/stdlib/Makefile.Mac @@ -12,34 +12,34 @@ OBJS = pervasives.cmo list.cmo char.cmo string.cmo array.cmo sys.cmo all stdlib.cma std_exit.cmo camlheader install - duplicate -y stdlib.cma std_exit.cmo .cmi .mli camlheader "{LIBDIR}" + duplicate -y stdlib.cma std_exit.cmo .cmi .mli camlheader "{LIBDIR}" stdlib.cma {OBJS} - {CAMLC} -a -o stdlib.cma {OBJS} + {CAMLC} -a -o stdlib.cma {OBJS} camlheader - echo "`quote "{BINDIR}ocamlrun"`" - '"{command}" {"Parameters"}; exit {status}' > camlheader + echo "`quote "{BINDIR}ocamlrun"`" + '"{command}" {"Parameters"}; exit {status}' > camlheader clean - delete -i camlheader + delete -i camlheader pervasives.cmi pervasives.mli - {CAMLC} {COMPFLAGS} -nopervasives -c pervasives.mli + {CAMLC} {COMPFLAGS} -nopervasives -c pervasives.mli pervasives.cmo pervasives.ml - {CAMLC} {COMPFLAGS} -nopervasives -c pervasives.ml + {CAMLC} {COMPFLAGS} -nopervasives -c pervasives.ml .cmi .mli - {CAMLC} {COMPFLAGS} -c {default}.mli + {CAMLC} {COMPFLAGS} -c {default}.mli .cmo .ml - {CAMLC} {COMPFLAGS} -c {default}.ml + {CAMLC} {COMPFLAGS} -c {default}.ml {OBJS} std_exit.cmo pervasives.cmi clean - delete -i .cm[aio] || set status 0 + delete -i .cm[aio] || set status 0 depend - {CAMLDEP} .mli .ml > Makefile.Mac.depend + {CAMLDEP} .mli .ml > Makefile.Mac.depend diff --git a/stdlib/array.mli b/stdlib/array.mli index 6591a65de7..343565f5a6 100644 --- a/stdlib/array.mli +++ b/stdlib/array.mli @@ -31,7 +31,7 @@ external set: 'a array -> int -> 'a -> unit = "%array_safe_set" external create: int -> 'a -> 'a array = "make_vect" (* [Array.create n x] returns a fresh array of length [n], initialized with [x]. - All the elements of this new array are initially + All the elements of this new array are initially physically equal to [x] (in the sense of the [==] predicate). Consequently, if [x] is mutable, it is shared among all elements of the array, and modifying [x] through one of the array entries @@ -40,7 +40,7 @@ val create_matrix: int -> int -> 'a -> 'a array array (* [Array.create_matrix dimx dimy e] returns a two-dimensional array (an array of arrays) with first dimension [dimx] and second dimension [dimy]. All the elements of this new matrix - are initially physically equal to [e]. + are initially physically equal to [e]. The element ([x,y]) of a matrix [m] is accessed with the notation [m.(x).(y)]. *) val append: 'a array -> 'a array -> 'a array diff --git a/stdlib/filename.mli b/stdlib/filename.mli index 61013232ca..9763c6cc74 100644 --- a/stdlib/filename.mli +++ b/stdlib/filename.mli @@ -42,7 +42,7 @@ val dirname : string -> string which is equivalent to [name]. Moreover, after setting the current directory to [dirname name] (with [Sys.chdir]), references to [basename name] (which is a relative file name) - designate the same file as [name] before the call to [chdir]. *) + designate the same file as [name] before the call to [chdir]. *) val temp_file: string -> string -> string (* [temp_file prefix suffix] returns the name of a non-existent temporary file in the temporary directory. diff --git a/stdlib/format.ml b/stdlib/format.ml index a15b4f5af5..8302fbde00 100644 --- a/stdlib/format.ml +++ b/stdlib/format.ml @@ -83,10 +83,10 @@ type formatter = mutable pp_max_indent : int; mutable pp_space_left : int; (* space remaining on the current line *) mutable pp_current_indent : int;(* current value of indentation *) - mutable pp_left_total : int; (* total width of tokens already printed *) - mutable pp_right_total : int; (* total width of tokens ever put in queue *) - mutable pp_curr_depth : int; (* current number of opened blocks *) - mutable pp_max_boxes : int; (* maximum number of blocks which can be + mutable pp_left_total : int; (* total width of tokens already printed *) + mutable pp_right_total : int; (* total width of tokens ever put in queue *) + mutable pp_curr_depth : int; (* current number of opened blocks *) + mutable pp_max_boxes : int; (* maximum number of blocks which can be opened at the same time *) mutable pp_ellipsis : string; (* ellipsis string *) mutable pp_output_function : string -> int -> int -> unit; diff --git a/stdlib/gc.mli b/stdlib/gc.mli index e3db1ca58c..58fdb1e426 100644 --- a/stdlib/gc.mli +++ b/stdlib/gc.mli @@ -86,8 +86,8 @@ type control = { of live data. If [max_overhead] is set to 0, heap compaction is never triggered. If [max_overhead] is set to 1, heap compaction is triggered at the end of each major GC cycle - (this last setting is intended for testing purposes only). - The default is 0 (i.e. compaction is never triggered). + (this last setting is intended for testing purposes only). + The default is 0 (i.e. compaction is never triggered). - [verbose] This flag controls the GC messages on standard error output. - [stack_limit] The maximum size of the stack (in words). This is only relevant to the byte-code runtime, as the native code runtime diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli index 10096c9faa..18015b7022 100644 --- a/stdlib/hashtbl.mli +++ b/stdlib/hashtbl.mli @@ -54,7 +54,7 @@ val remove : ('a, 'b) t -> 'a -> unit val iter : ('a -> 'b -> 'c) -> ('a, 'b) t -> unit (* [Hashtbl.iter f tbl] applies [f] to all bindings in table [tbl], - discarding all the results. + discarding all the results. [f] receives the key as first argument, and the associated value as second argument. The order in which the bindings are passed to [f] is unspecified. Each binding is presented exactly once diff --git a/stdlib/list.mli b/stdlib/list.mli index febf35314c..87a367a76e 100644 --- a/stdlib/list.mli +++ b/stdlib/list.mli @@ -36,7 +36,7 @@ val flatten : 'a list list -> 'a list val iter : ('a -> 'b) -> 'a list -> unit (* [List.iter f [a1; ...; an]] applies function [f] in turn to [a1; ...; an], discarding all the results. It is equivalent to - [begin f a1; f a2; ...; f an; () end]. *) + [begin f a1; f a2; ...; f an; () end]. *) val map : ('a -> 'b) -> 'a list -> 'b list (* [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an], and builds the list [[f a1; ...; f an]] @@ -53,23 +53,23 @@ val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b val iter2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> unit (* [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn [f a1 b1; ...; f an bn], discarding the results. - Raise [Invalid_argument] if the two lists have - different lengths. *) + Raise [Invalid_argument] if the two lists have + different lengths. *) val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list (* [List.map2 f [a1; ...; an] [b1; ...; bn]] is [[f a1 b1; ...; f an bn]]. - Raise [Invalid_argument] if the two lists have + Raise [Invalid_argument] if the two lists have different lengths. *) val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b list -> 'c list -> 'a (* [List.fold_left2 f a [b1; ...; bn] [c1; ...; cn]] is [f (... (f (f a b1 c1) b2 c2) ...) bn cn]. - Raise [Invalid_argument] if the two lists have - different lengths. *) + Raise [Invalid_argument] if the two lists have + different lengths. *) val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c (* [List.fold_right2 f [a1; ...; an] [b1; ...; bn] c] is [f a1 b1 (f a2 b2 (... (f an bn c) ...))]. - Raise [Invalid_argument] if the two lists have - different lengths. *) + Raise [Invalid_argument] if the two lists have + different lengths. *) (** List scanning *) @@ -85,7 +85,7 @@ val for_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool val exists2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool (* Same as [for_all] and [exists], but for a two-argument predicate. Raise [Invalid_argument] if the two lists have - different lengths. *) + different lengths. *) val mem : 'a -> 'a list -> bool (* [mem a l] is true if and only if [a] is equal to an element of [l]. *) diff --git a/stdlib/map.mli b/stdlib/map.mli index 56bfb64fbc..ec5e03be55 100644 --- a/stdlib/map.mli +++ b/stdlib/map.mli @@ -56,7 +56,7 @@ module type S = [m], except for [x] which is unbound in the returned map. *) val iter: (key -> 'a -> 'b) -> 'a t -> unit (* [iter f m] applies [f] to all bindings in map [m], - discarding the results. + discarding the results. [f] receives the key as first argument, and the associated value as second argument. The order in which the bindings are passed to [f] is unspecified. Only current bindings are presented to [f]: diff --git a/stdlib/oo.ml b/stdlib/oo.ml index 61dab0e5b3..f3260c5b00 100644 --- a/stdlib/oo.ml +++ b/stdlib/oo.ml @@ -44,7 +44,7 @@ let bucket_small_size = ref 16 let step = Sys.word_size / 16 let first_bucket = 0 -let bucket_size = 32 (* Must be 256 or less *) +let bucket_size = 32 (* Must be 256 or less *) let initial_object_size = 2 (**** Version ****) @@ -105,7 +105,7 @@ let new_filled_bucket pos methods = (fun (lab, met) -> let (buck, elem) = decode lab in if buck = pos then - bucket.(elem) <- (magic met : item)) + bucket.(elem) <- (magic met : item)) (List.rev methods); bucket @@ -165,7 +165,7 @@ let rec choose bucket i = remove_bucket n; choose bucket i end else try - merge_buckets !small_buckets.(n) bucket + merge_buckets !small_buckets.(n) bucket with Failed -> choose bucket (i - 1) end else begin @@ -300,7 +300,7 @@ let set_initializer table init = let i = List.fold_right (fun init2 init1 -> (magic init1 : obj_init -> obj_init) init2) - l init + l init in table.init <- (i::l')::l'' | _ -> @@ -501,7 +501,7 @@ let show_buckets () = List.iter (function b -> for i = 0 to bucket_size - 1 do - print_char (if b.(i) == dummy_item then '.' else '*') + print_char (if b.(i) == dummy_item then '.' else '*') done; print_newline ()) (sort_buck !bucket_list) diff --git a/stdlib/oo.mli b/stdlib/oo.mli index dc52813129..07447097d9 100644 --- a/stdlib/oo.mli +++ b/stdlib/oo.mli @@ -43,7 +43,7 @@ val create_class: class_info -> string list -> (table -> unit) -> unit (* Objects *) type t type object -val send: object -> label -> t +val send: object -> label -> t (* Parameters *) diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli index 2f352ed7d5..906c8b436c 100644 --- a/stdlib/pervasives.mli +++ b/stdlib/pervasives.mli @@ -90,7 +90,7 @@ exception Assert_failure of (string * int * int) when their second argument is null. *) exception Exit (* This exception is not raised by any library function. It is - provided for use in your programs. *) + provided for use in your programs. *) val invalid_arg: string -> 'a (* Raise exception [Invalid_argument] with the given string. *) @@ -355,7 +355,7 @@ val prerr_float : float -> unit (* Print a floating-point number, in decimal, on standard error. *) val prerr_endline : string -> unit (* Print a string, followed by a newline character on standard error - and flush standard error. *) + and flush standard error. *) val prerr_newline : unit -> unit (* Print a newline character on standard error, and flush standard error. *) @@ -364,7 +364,7 @@ val prerr_newline : unit -> unit val read_line : unit -> string (* Flush standard output, then read characters from standard input - until a newline character is encountered. Return the string of + until a newline character is encountered. Return the string of all characters read, without the newline character at the end. *) val read_int : unit -> int (* Flush standard output, then read one line from standard input @@ -432,18 +432,18 @@ val output_binary_int : out_channel -> int -> unit (* Write one integer in binary format on the given output channel. The only reliable way to read it back is through the [input_binary_int] function. The format is compatible across - all machines for a given version of Caml Light. *) + all machines for a given version of Caml Light. *) val output_value : out_channel -> 'a -> unit (* Write the representation of a structured value of any type to a channel. Circularities and sharing inside the value are detected and preserved. The object can be read back, by the function [input_value]. The format is compatible across - all machines for a given version of Caml Light. *) + all machines for a given version of Caml Light. *) val seek_out : out_channel -> int -> unit (* [seek_out chan pos] sets the current writing position to [pos] for channel [chan]. This works only for regular files. On files of other kinds (such as terminals, pipes and sockets), - the behavior is unspecified. *) + the behavior is unspecified. *) val pos_out : out_channel -> int (* Return the current writing position for the given channel. *) val out_channel_length : out_channel -> int @@ -452,8 +452,8 @@ val out_channel_length : out_channel -> int other kinds, the result is meaningless. *) val close_out : out_channel -> unit (* Close the given channel, flushing all buffered write operations. - The behavior is unspecified if any of the functions above is - called on a closed channel. *) + The behavior is unspecified if any of the functions above is + called on a closed channel. *) (** General input functions *) @@ -506,7 +506,7 @@ val input_binary_int : in_channel -> int (* Read an integer encoded in binary format from the given input channel. See [output_binary_int]. Raise [End_of_file] if an end of file was reached while reading the - integer. *) + integer. *) val input_value : in_channel -> 'a (* Read the representation of a structured value, as produced by [output_value], and return the corresponding value. @@ -516,8 +516,8 @@ val input_value : in_channel -> 'a The programmer should explicitly give the expected type of the returned value, using the following syntax: [(input_value chan : type)]. - The behavior is unspecified if the object in the file does not - belong to the given type. *) + The behavior is unspecified if the object in the file does not + belong to the given type. *) val seek_in : in_channel -> int -> unit (* [seek_in chan pos] sets the current reading position to [pos] for channel [chan]. This works only for regular files. On @@ -557,7 +557,7 @@ external decr : int ref -> unit = "%decr" val exit : int -> 'a (* Flush all pending writes on [stdout] and [stderr], and terminate the process, returning the given status code - to the operating system (usually 0 to indicate no errors, + to the operating system (usually 0 to indicate no errors, and a small positive integer to indicate failure.) An implicit [exit 0] is performed each time a program terminates normally (but not if it terminates because of diff --git a/stdlib/stream.mli b/stdlib/stream.mli index 9f6d615a19..536e4fea51 100644 --- a/stdlib/stream.mli +++ b/stdlib/stream.mli @@ -14,14 +14,14 @@ (* Module [Stream]: streams and stream parsers operations *) type 'a t - (* The type of streams containing values of type ['a]. *) + (* The type of streams containing values of type ['a]. *) exception Parse_failure - (* Raised by parsers when none of the first components of the stream + (* Raised by parsers when none of the first components of the stream patterns is accepted. *) exception Parse_error of string - (* Raised by parsers when the first component of a stream pattern is - accepted, but one of the following components is rejected. *) + (* Raised by parsers when the first component of a stream pattern is + accepted, but one of the following components is rejected. *) (** Stream builders *) (* Warning: these functions create streams with fast access; it is illegal @@ -29,7 +29,7 @@ exception Parse_error of string when accessing such mixed streams. *) val from : (int -> 'a option) -> 'a t - (* [Stream.from f] returns a stream built from the function [f]. + (* [Stream.from f] returns a stream built from the function [f]. To create a new stream element, the function [f] is called with the current stream count. The user function [f] must return either [Some <value>] for a value or [None] to specify the end of the @@ -40,7 +40,7 @@ val of_list : 'a list -> 'a t val of_string : string -> char t (* Return the stream of the characters of the string parameter. *) val of_channel : in_channel -> char t - (* Return the stream of the characters read from the input channel. *) + (* Return the stream of the characters read from the input channel. *) (** Stream iterator *) @@ -51,10 +51,10 @@ val iter : ('a -> 'b) -> 'a t -> unit (** Predefined parsers *) val next : 'a t -> 'a - (* Return the first element of the stream and remove it from the + (* Return the first element of the stream and remove it from the stream. Raise [Parse_failure] if the stream is empty. *) val empty : 'a t -> unit - (* Return [()] if the stream is empty, else raise [Parse_failure]. *) + (* Return [()] if the stream is empty, else raise [Parse_failure]. *) (** Useful functions *) @@ -65,7 +65,7 @@ val junk : 'a t -> unit (* Remove the first element of the stream, possibly unfreezing it before. *) val count : 'a t -> int - (* Return the current count of the stream elements, i.e. the number + (* Return the current count of the stream elements, i.e. the number of the stream elements discarded. *) (*--*) diff --git a/stdlib/sys.mli b/stdlib/sys.mli index 3d6099899f..e10319ba83 100644 --- a/stdlib/sys.mli +++ b/stdlib/sys.mli @@ -32,7 +32,7 @@ external command: string -> int = "sys_system_command" external chdir: string -> unit = "sys_chdir" (* Change the current working directory of the process. *) external getcwd: unit -> string = "sys_getcwd" - (* Return the current working directory of the process. *) + (* Return the current working directory of the process. *) val interactive: bool ref (* This reference is initially set to [false] in standalone programs and to [true] if the code is being executed under @@ -92,4 +92,4 @@ val catch_break: bool -> unit terminates the program or raises the [Break] exception. Call [catch_break true] to enable raising [Break], and [catch_break false] to let the system - terminate the program on user interrupt. *) + terminate the program on user interrupt. *) diff --git a/test/KB/kb.ml b/test/KB/kb.ml index 52c9e8d1eb..329c0b5915 100644 --- a/test/KB/kb.ml +++ b/test/KB/kb.ml @@ -168,7 +168,7 @@ let kb_completion greater = let ek = (rk.lhs, rk.rhs) in process failures (k,l) (mutual_critical_pairs el (rename rl.numvars ek)) - with Not_found -> next_criticals failures (k+1,l) + with Not_found -> next_criticals failures (k+1,l) with Not_found -> next_criticals failures (1,l+1) in process in kbrec diff --git a/test/KB/terms.ml b/test/KB/terms.ml index 493bfb2625..9f9acffbc6 100644 --- a/test/KB/terms.ml +++ b/test/KB/terms.ml @@ -63,7 +63,7 @@ let matching term1 term2 = else (v, t2) :: subst | Term(op1,sons1), Term(op2,sons2) -> - if op1 = op2 + if op1 = op2 then List.fold_left2 match_rec subst sons1 sons2 else failwith "matching" | _ -> failwith "matching" in @@ -92,7 +92,7 @@ let rec unify term1 term2 = else [n2, term1] | Term(op1,sons1), Term(op2,sons2) -> if op1 = op2 then - List.fold_left2 (fun s t1 t2 -> compsubst (unify (substitute s t1) + List.fold_left2 (fun s t1 t2 -> compsubst (unify (substitute s t1) (substitute s t2)) s) [] sons1 sons2 else failwith "unify" @@ -117,7 +117,7 @@ let rec pretty_term = function end else begin print_string oper; match sons with - [] -> () + [] -> () | t::lt -> print_string "("; pretty_term t; List.iter (fun t -> print_string ","; pretty_term t) lt; diff --git a/test/Makefile.Mac b/test/Makefile.Mac index 499ac49922..42399e101c 100644 --- a/test/Makefile.Mac +++ b/test/Makefile.Mac @@ -16,10 +16,10 @@ BYTE_KB = :KB:terms.cmo :KB:equations.cmo :KB:kb.cmo :KB:orderings.cmo :KB:kbmain.cmo kb.byt {BYTE_KB} - {CAMLC} {BYTE_KB} -o kb.byt + {CAMLC} {BYTE_KB} -o kb.byt clean - delete -i :KB:.cm[io] || set status 0 + delete -i :KB:.cm[io] || set status 0 # Genlex @@ -27,43 +27,43 @@ BYTE_GENLEX = :Lex:syntax.cmo :Lex:scan_aux.cmo :Lex:scanner.cmo :Lex:gram_aux.cmo :Lex:grammar.cmo :Lex:lexgen.cmo :Lex:output.cmo :Lex:main.cmo genlex.byt {BYTE_GENLEX} - {CAMLC} {BYTE_GENLEX} -o genlex.byt + {CAMLC} {BYTE_GENLEX} -o genlex.byt clean - delete -i :Lex:.cm[io] || set status 0 + delete -i :Lex:.cm[io] || set status 0 :Lex:grammar.mli :Lex:grammar.ml - echo -n + echo -n :Lex:grammar.ml :Lex:grammar.mly ::yacc:ocamlyacc - {CAMLYACC} {YACCFLAGS} :Lex:grammar.mly + {CAMLYACC} {YACCFLAGS} :Lex:grammar.mly clean - delete -i :Lex:grammar.ml :Lex:grammar.mli + delete -i :Lex:grammar.ml :Lex:grammar.mli beforedepend :Lex:grammar.ml :Lex:grammar.mli :Lex:scanner.ml :Lex:scanner.mll ::lex:ocamllex - {CAMLLEX} :Lex:scanner.mll + {CAMLLEX} :Lex:scanner.mll clean - delete -i :Lex:scanner.ml + delete -i :Lex:scanner.ml beforedepend :Lex:scanner.ml # Common rules .byt .ml - {CAMLC} -o {targdir}{default}.byt {depdir}{default}.ml + {CAMLC} -o {targdir}{default}.byt {depdir}{default}.ml .fast.byt .ml - {CAMLC} -unsafe -o {targdir}{default}.fast.byt {depdir}{default}.ml + {CAMLC} -unsafe -o {targdir}{default}.fast.byt {depdir}{default}.ml .cmi .mli - {CAMLC} -c {depdir}{default}.mli + {CAMLC} -c {depdir}{default}.mli .cmo .ml - {CAMLC} -c {depdir}{default}.ml + {CAMLC} -c {depdir}{default}.ml {BYTE_EXE} {BYTE_KB} {BYTE_GENLEX} ::ocamlc {BYTE_EXE} ::stdlib:stdlib.cma @@ -76,33 +76,33 @@ clean # Regression test test {BYTE_EXE} - for prog in `echo {BYTE_EXE} | streamedit -e '1 replace /.byt/ "" -c '` - echo {prog} - if "`exists :Results:{prog}.runtest.Mac`" - :Results:{prog}.runtest.Mac test {CAMLRUN} {prog}.byt - else - {CAMLRUN} {prog}.byt > "{tempfolder}ocaml-test" - equal -d "{tempfolder}ocaml-test" :Results:{prog}.out - end - end + for prog in `echo {BYTE_EXE} | streamedit -e '1 replace /.byt/ "" -c '` + echo {prog} + if "`exists :Results:{prog}.runtest.Mac`" + :Results:{prog}.runtest.Mac test {CAMLRUN} {prog}.byt + else + {CAMLRUN} {prog}.byt > "{tempfolder}ocaml-test" + equal -d "{tempfolder}ocaml-test" :Results:{prog}.out + end + end clean - delete -i :Lex:testscanner.ml "{tempfolder}ocaml-test" + delete -i :Lex:testscanner.ml "{tempfolder}ocaml-test" # Benchmark bench {BYTE_EXE} - for prog in `echo {BYTE_EXE} | streamedit -e '1 replace /.byt/ "" -c '` - echo {prog} - if "`exists :Results:{prog}.runtest.Mac`" - :Results:{prog}.runtest.Mac bench {CAMLRUN} {prog}.byt - else - time "{CAMLRUN} {prog}.byt dev:null" - end - end + for prog in `echo {BYTE_EXE} | streamedit -e '1 replace /.byt/ "" -c '` + echo {prog} + if "`exists :Results:{prog}.runtest.Mac`" + :Results:{prog}.runtest.Mac bench {CAMLRUN} {prog}.byt + else + time "{CAMLRUN} {prog}.byt dev:null" + end + end # Dependencies depend beforedepend - {CAMLDEP} -I :KB: -I :Lex: .ml :KB:.mli :KB:.ml :Lex:.mli - :Lex:.ml > Makefile.Mac.depend + {CAMLDEP} -I :KB: -I :Lex: .ml :KB:.mli :KB:.ml :Lex:.mli + :Lex:.ml > Makefile.Mac.depend diff --git a/test/boyer.ml b/test/boyer.ml index 5eaceff9af..8f81dc0750 100644 --- a/test/boyer.ml +++ b/test/boyer.ml @@ -28,7 +28,7 @@ let rec print_term = function 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 *) diff --git a/test/fft.ml b/test/fft.ml index 9dabe517d6..13f2f956fd 100644 --- a/test/fft.ml +++ b/test/fft.ml @@ -50,35 +50,35 @@ let fft px py np = 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 i0 = !i0r in - let i1 = i0 + n4 in - let i2 = i1 + n4 in - let i3 = i2 + n4 in - let r1 = px.(i0) -. px.(i2) in - px.(i0) <- px.(i0) +. px.(i2); - let r2 = px.(i1) -. px.(i3) in - px.(i1) <- px.(i1) +. px.(i3); - let s1 = py.(i0) -. py.(i2) in - py.(i0) <- py.(i0) +. py.(i2); - let s2 = py.(i1) -. py.(i3) in - py.(i1) <- py.(i1) +. py.(i3); - let s3 = r1 -. s2 in + let i1 = i0 + n4 in + let i2 = i1 + n4 in + let i3 = i2 + n4 in + let r1 = px.(i0) -. px.(i2) in + px.(i0) <- px.(i0) +. px.(i2); + let r2 = px.(i1) -. px.(i3) in + px.(i1) <- px.(i1) +. px.(i3); + let s1 = py.(i0) -. py.(i2) in + py.(i0) <- py.(i0) +. py.(i2); + let s2 = py.(i1) -. py.(i3) in + py.(i1) <- py.(i1) +. py.(i3); + let s3 = r1 -. s2 in let r1 = r1 +. s2 in - let s2 = r2 -. s1 in + let s2 = r2 -. s1 in let r2 = r2 +. s1 in - px.(i2) <- r1*.cc1 -. s2*.ss1; - py.(i2) <- -.s2*.cc1 -. r1*.ss1; - px.(i3) <- s3*.cc3 +. r2*.ss3; - py.(i3) <- r2*.cc3 -. s3*.ss3; + 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; - id := 4 * !id - done + is := 2 * !id - !n2 + j; + id := 4 * !id + done done done; diff --git a/testobjects/Exemples.ml b/testobjects/Exemples.ml index a6bf391ab3..30db53ab4f 100644 --- a/testobjects/Exemples.ml +++ b/testobjects/Exemples.ml @@ -78,7 +78,7 @@ let c'' = new color_circle p;; let c'' = new color_circle p';; (c'' :> color_point circle);; -(c'' :> point circle);; (* Echec *) +(c'' :> point circle);; (* Echec *) fun x -> (x : color_point color_circle :> point circle);; class printable_point y as s = @@ -216,7 +216,7 @@ end;; let c3 = new int_comparable3 15;; l#add (c3 :> int_comparable);; -(new sorted_list ())#add c3;; (* Echec : leq n'est pas binaire *) +(new sorted_list ())#add c3;; (* Echec : leq n'est pas binaire *) let sort (l : #comparable list) = Sort.list (fun x -> x#leq) l;; let pr l = @@ -248,9 +248,9 @@ class 'a link (x : 'a) as self : 'b = method append l = match next with None -> - self#set_next l + self#set_next l | Some l' -> - l'#append l + l'#append l end;; class 'a double_link x as self = @@ -259,7 +259,7 @@ class 'a double_link x as self = method prev = prev method set_next l = next <- l; - match l with Some l -> l#set_prev (Some self) | None -> () + match l with Some l -> l#set_prev (Some self) | None -> () method set_prev l = prev <- l end;; diff --git a/tools/MakeDepend b/tools/MakeDepend index 3a637a97ff..52b745d085 100644 --- a/tools/MakeDepend +++ b/tools/MakeDepend @@ -13,6 +13,6 @@ clear (:\{tmp}\):/nn/: {tmp}.make close -y {tmp}.make streamedit -e '1,$ replace /"{ObjDir"???"}"/ ""' -e '1,$ replace /"{MondoBuild}"/ ""' - -e '/t/ delete' + -e '/t/ delete' {tmp}.make delete -i {tmp}.make diff --git a/tools/Makefile.Mac b/tools/Makefile.Mac index 98f4d538c4..90442cc5c2 100644 --- a/tools/Makefile.Mac +++ b/tools/Makefile.Mac @@ -36,15 +36,15 @@ beforedepend ocamldep # parser.cmo lexer.cmo parse.cmo # #ocamlprof {CSLPROF} profiling.cmo -# {CAMLC} {LINKFLAGS} -o ocamlprof {CSLPROF_IMPORTS} {CSLPROF} +# {CAMLC} {LINKFLAGS} -o ocamlprof {CSLPROF_IMPORTS} {CSLPROF} # #install -# duplicate -y ocamlprof "{BINDIR}ocamlprof" -# duplicate -y ocamlcp "{BINDIR}ocamlcp" -# duplicate -y profiling.cmi profiling.cmo "{LIBDIR}" +# duplicate -y ocamlprof "{BINDIR}ocamlprof" +# duplicate -y ocamlcp "{BINDIR}ocamlcp" +# duplicate -y profiling.cmi profiling.cmo "{LIBDIR}" # #clean -# delete -i ocamlprof +# delete -i ocamlprof # To make custom toplevels @@ -58,18 +58,18 @@ DUMPOBJ = opnames.cmo dumpobj.cmo DumpCamlObj {DUMPOBJ} {CAMLC} {LINKFLAGS} -o DumpCamlObj misc.cmo tbl.cmo config.cmo ident.cmo - opcodes.cmo runtimedef.cmo {DUMPOBJ} + opcodes.cmo runtimedef.cmo {DUMPOBJ} clean delete -i DumpCamlObj opnames.ml ::byterun:instruct.h streamedit -e '//*/ delete' - -e '/enum ()0 {/ replace // "let names_of_" 0 "= [|"' - -e '/};/ replace // "|]"' - -e '/([A-Z][A-Z_0-9a-z]*)0/ replace // """ 0 """ -c ' - -e '/,/ replace // ";" -c ' - ::byterun:instruct.h > opnames.ml + -e '/enum ()0 {/ replace // "let names_of_" 0 "= [|"' + -e '/};/ replace // "|]"' + -e '/([A-Z][A-Z_0-9a-z]*)0/ replace // """ 0 """ -c ' + -e '/,/ replace // ";" -c ' + ::byterun:instruct.h > opnames.ml clean delete -i opnames.ml diff --git a/tools/ocamlprof.ml b/tools/ocamlprof.ml index 43de3b4cd3..7fb1f18f8f 100644 --- a/tools/ocamlprof.ml +++ b/tools/ocamlprof.ml @@ -26,9 +26,9 @@ exception Profiler of string (* Modes *) let instr_fun = ref false and instr_match = ref false -and instr_if = ref false +and instr_if = ref false and instr_loops = ref false -and instr_try = ref false +and instr_try = ref false let cur_point = ref 0 and inchan = ref stdin @@ -311,8 +311,8 @@ let set_flags s = | 'l' -> instr_loops := true | 't' -> instr_try := true | 'a' -> instr_fun := true; instr_match := true; - instr_if := true; instr_loops := true; - instr_try := true + instr_if := true; instr_loops := true; + instr_try := true | _ -> () done diff --git a/typing/ctype.mli b/typing/ctype.mli index 85e7bca1e6..426f57fa70 100644 --- a/typing/ctype.mli +++ b/typing/ctype.mli @@ -47,11 +47,11 @@ val repr: type_expr -> type_expr val flatten_fields : type_expr -> (string * field_kind * type_expr) list * type_expr - (* Transform a field type into a list of pairs label-type *) + (* Transform a field type into a list of pairs label-type *) val opened_object: type_expr -> bool val close_object: type_expr -> unit val set_object_name: - type_expr -> type_expr list -> Ident.t -> unit + type_expr -> type_expr list -> Ident.t -> unit val remove_object_name: type_expr -> unit val hide_private_methods: type_expr -> unit @@ -72,12 +72,12 @@ val instance_constructor: val instance_label: label_description -> type_expr * type_expr (* Same, for a label *) val instance_parameterized_type: - type_expr list -> type_expr -> type_expr list * type_expr + type_expr list -> type_expr -> type_expr list * type_expr val instance_parameterized_type_2: - type_expr list -> type_expr list -> type_expr -> + type_expr list -> type_expr list -> type_expr -> type_expr list * type_expr list * type_expr val instance_class: - class_type -> + class_type -> type_expr list * type_expr list * (mutable_flag * type_expr) Vars.t * type_expr Meths.t * type_expr val apply: @@ -88,8 +88,8 @@ val apply: val expand_abbrev: Env.t -> Path.t -> type_expr list -> Types.abbrev_memo ref -> - int -> type_expr - (* Expand an abbreviation *) + int -> type_expr + (* Expand an abbreviation *) val expand_head: Env.t -> type_expr -> type_expr val full_expand: Env.t -> type_expr -> type_expr @@ -98,7 +98,7 @@ val unify: Env.t -> type_expr -> type_expr -> unit val filter_arrow: Env.t -> type_expr -> type_expr * type_expr (* A special case of unification (with 'a -> 'b). *) val filter_method: Env.t -> string -> private_flag -> type_expr -> type_expr - (* A special case of unification (with {m : 'a; 'b}). *) + (* A special case of unification (with {m : 'a; 'b}). *) val moregeneral: Env.t -> bool -> type_expr -> type_expr -> bool (* Check if the first type scheme is more general than the second. *) @@ -109,7 +109,7 @@ val equal: Env.t -> bool -> type_expr list -> type_expr list -> bool [/\x1.../\xn.tau] and [/\y1.../\yn.sigma] are equivalent. *) val enlarge_type: Env.t -> type_expr -> type_expr - (* Make a type larger *) + (* Make a type larger *) val subtype : Env.t -> type_expr -> type_expr -> unit -> unit (* [subtype env t1 t2] checks that [t1] is a subtype of [t2]. It accumulates the constraints the type variables must diff --git a/typing/datarepr.ml b/typing/datarepr.ml index 40c211a4a8..df9491d959 100644 --- a/typing/datarepr.ml +++ b/typing/datarepr.ml @@ -52,7 +52,7 @@ let exception_descr path_exc decl = cstr_nonconsts = -1 } let none = {desc = Ttuple []; level = -1} - (* Clearly ill-formed type *) + (* Clearly ill-formed type *) let dummy_label = { lbl_res = none; lbl_arg = none; lbl_mut = Immutable; lbl_pos = (-1); lbl_all = [||]; lbl_repres = Record_regular } diff --git a/typing/env.ml b/typing/env.ml index e72272dcdc..0e12be9261 100644 --- a/typing/env.ml +++ b/typing/env.ml @@ -152,18 +152,18 @@ let rec find_module_descr path env = end | Pdot(p, s, pos) -> begin match find_module_descr p env with - Structure_comps c -> - let (descr, pos) = Tbl.find s c.comp_components in + Structure_comps c -> + let (descr, pos) = Tbl.find s c.comp_components in descr | Functor_comps f -> - raise Not_found + raise Not_found end | Papply(p1, p2) -> begin match find_module_descr p1 env with - Functor_comps f -> + Functor_comps f -> !components_of_functor_appl f p1 p2 | Structure_comps c -> - raise Not_found + raise Not_found end let find proj1 proj2 path env = @@ -237,21 +237,21 @@ let rec lookup_module_descr lid env = | Ldot(l, s) -> let (p, descr) = lookup_module_descr l env in begin match descr with - Structure_comps c -> - let (descr, pos) = Tbl.find s c.comp_components in + Structure_comps c -> + let (descr, pos) = Tbl.find s c.comp_components in (Pdot(p, s, pos), descr) | Functor_comps f -> - raise Not_found + raise Not_found end | Lapply(l1, l2) -> let (p1, desc1) = lookup_module_descr l1 env in let (p2, mty2) = lookup_module l2 env in begin match desc1 with - Functor_comps f -> + Functor_comps f -> !check_modtype_inclusion env mty2 f.fcomp_arg; (Papply(p1, p2), !components_of_functor_appl f p1 p2) | Structure_comps c -> - raise Not_found + raise Not_found end and lookup_module lid env = @@ -266,23 +266,23 @@ and lookup_module lid env = | Ldot(l, s) -> let (p, descr) = lookup_module_descr l env in begin match descr with - Structure_comps c -> + Structure_comps c -> let (data, pos) = Tbl.find s c.comp_modules in (Pdot(p, s, pos), data) | Functor_comps f -> - raise Not_found + raise Not_found end | Lapply(l1, l2) -> let (p1, desc1) = lookup_module_descr l1 env in let (p2, mty2) = lookup_module l2 env in let p = Papply(p1, p2) in begin match desc1 with - Functor_comps f -> + Functor_comps f -> !check_modtype_inclusion env mty2 f.fcomp_arg; (p, Subst.modtype (Subst.add_module f.fcomp_param p2 Subst.identity) - f.fcomp_res) + f.fcomp_res) | Structure_comps c -> - raise Not_found + raise Not_found end let lookup proj1 proj2 lid env = @@ -291,11 +291,11 @@ let lookup proj1 proj2 lid env = Ident.find_name s (proj1 env) | Ldot(l, s) -> begin match lookup_module_descr l env with - (p, Structure_comps c) -> - let (data, pos) = Tbl.find s (proj2 c) in + (p, Structure_comps c) -> + let (data, pos) = Tbl.find s (proj2 c) in (Pdot(p, s, pos), data) | (p, Functor_comps f) -> - raise Not_found + raise Not_found end | Lapply(l1, l2) -> raise Not_found @@ -306,11 +306,11 @@ let lookup_simple proj1 proj2 lid env = Ident.find_name s (proj1 env) | Ldot(l, s) -> begin match lookup_module_descr l env with - (p, Structure_comps c) -> - let (data, pos) = Tbl.find s (proj2 c) in + (p, Structure_comps c) -> + let (data, pos) = Tbl.find s (proj2 c) in data | (p, Functor_comps f) -> - raise Not_found + raise Not_found end | Lapply(l1, l2) -> raise Not_found @@ -451,22 +451,22 @@ let rec components_of_module env sub path mty = c.comp_modtypes <- Tbl.add (Ident.name id) (decl', nopos) c.comp_modtypes; env := store_modtype id path decl' !env - | Tsig_class(id, decl) -> - let decl' = Subst.class_type sub decl in + | Tsig_class(id, decl) -> + let decl' = Subst.class_type sub decl in c.comp_classes <- Tbl.add (Ident.name id) (decl', !pos) c.comp_classes; - incr pos) + incr pos) sg pl; - Structure_comps c + Structure_comps c | Tmty_functor(param, ty_arg, ty_res) -> - Functor_comps { - fcomp_param = param; - fcomp_arg = Subst.modtype sub ty_arg; - fcomp_res = Subst.modtype sub ty_res; - fcomp_env = env } + Functor_comps { + fcomp_param = param; + fcomp_arg = Subst.modtype sub ty_arg; + fcomp_res = Subst.modtype sub ty_res; + fcomp_env = env } | Tmty_ident p -> - Structure_comps { - comp_values = Tbl.empty; comp_constrs = Tbl.empty; + Structure_comps { + comp_values = Tbl.empty; comp_constrs = Tbl.empty; comp_labels = Tbl.empty; comp_types = Tbl.empty; comp_modules = Tbl.empty; comp_modtypes = Tbl.empty; comp_components = Tbl.empty; comp_classes = Tbl.empty } diff --git a/typing/includecore.mli b/typing/includecore.mli index c426ad8fb7..11fe4e4a29 100644 --- a/typing/includecore.mli +++ b/typing/includecore.mli @@ -25,4 +25,4 @@ val type_declarations: val exception_declarations: Env.t -> exception_declaration -> exception_declaration -> bool val class_types: - Env.t -> class_type -> class_type -> bool + Env.t -> class_type -> class_type -> bool diff --git a/typing/includemod.ml b/typing/includemod.ml index 35c0159752..0a962142b1 100644 --- a/typing/includemod.ml +++ b/typing/includemod.ml @@ -177,7 +177,7 @@ and signatures env subst sig1 sig2 = | Tsig_value(_,_) | Tsig_exception(_,_) | Tsig_module(_,_) - | Tsig_class(_, _) -> pos+1 in + | Tsig_class(_, _) -> pos+1 in build_component_table nextpos (Tbl.add name (id, item, pos) tbl) rem in let comps1 = diff --git a/typing/mtype.ml b/typing/mtype.ml index b1e45ff617..09d71f0624 100644 --- a/typing/mtype.ml +++ b/typing/mtype.ml @@ -49,9 +49,9 @@ and strengthen_sig env sg p = type_arity = decl.type_arity; type_kind = decl.type_kind; type_manifest = Some(Ctype.newgenty( - Tconstr(Pdot(p, Ident.name id, nopos), + Tconstr(Pdot(p, Ident.name id, nopos), decl.type_params, - ref Mnil))) } + ref Mnil))) } | _ -> decl in Tsig_type(id, newdecl) :: strengthen_sig env rem p | (Tsig_exception(id, d) as sigelt) :: rem -> diff --git a/typing/subst.ml b/typing/subst.ml index 4e199642e3..ba036f4a49 100644 --- a/typing/subst.ml +++ b/typing/subst.ml @@ -169,9 +169,9 @@ let class_type s decl = cty_concr = decl.cty_concr; cty_new = begin match decl.cty_new with - None -> None + None -> None | Some ty -> Some (typexp s ty) - end } + end } in cleanup_types (); List.iter unmark_type decl.cty_params; diff --git a/typing/typeclass.ml b/typing/typeclass.ml index 1622816736..520998fd2e 100644 --- a/typing/typeclass.ml +++ b/typing/typeclass.ml @@ -156,11 +156,11 @@ let missing_method env ty ty' = Tfield(lab, k, _, met') -> begin try if Btype.field_kind_repr k = Fpresent then begin - Ctype.filter_method env lab Public ty; () + Ctype.filter_method env lab Public ty; () end; - missing_method_rec met' + missing_method_rec met' with Ctype.Unify _ -> - lab + lab end | _ -> fatal_error "Typeclass.missing_method (1)" @@ -195,28 +195,28 @@ let make_stub env (cl, obj_id, cl_id) = let concr_meths = List.fold_left (function meths -> - function - Pcf_inher (nm, _, _, _, loc) -> + function + Pcf_inher (nm, _, _, _, loc) -> let (_, anc) = - try - Env.lookup_class nm env - with Not_found -> - raise(Error(loc, Unbound_class nm)) + try + Env.lookup_class nm env + with Not_found -> + raise(Error(loc, Unbound_class nm)) in - begin match (Ctype.expand_head env anc.cty_self).desc with + begin match (Ctype.expand_head env anc.cty_self).desc with Tobject (ty, _) -> add_methods env self ty; - Concr.union anc.cty_concr meths + Concr.union anc.cty_concr meths | _ -> fatal_error "Typeclass.make_stub" end - | Pcf_val _ -> - meths - | Pcf_virt (lab, priv, _, _) -> - Ctype.filter_method env lab priv self; - meths - | Pcf_meth (lab, priv, _, _) -> - Ctype.filter_method env lab priv self; - Concr.add lab meths) + | Pcf_val _ -> + meths + | Pcf_virt (lab, priv, _, _) -> + Ctype.filter_method env lab priv self; + meths + | Pcf_meth (lab, priv, _, _) -> + Ctype.filter_method env lab priv self; + Concr.add lab meths) Concr.empty cl.pcl_field in @@ -397,10 +397,10 @@ let type_class_field env var_env self cl {val_type = exp.exp_type; val_kind = Val_ivar mut} met_env in (met_env, Cf_val (lab, id, priv, Some exp)::fields, - insert_value var_env lab priv mut exp.exp_type loc vars_sig, + insert_value var_env lab priv mut exp.exp_type loc vars_sig, meths) | None -> - let (vars_sig, ty) = + let (vars_sig, ty) = change_value_status lab priv mut loc vars_sig in let (id, met_env) = @@ -499,9 +499,9 @@ let transl_class temp_env env List.iter2 (Ctype.unify temp_env) temp_cl_params cl_params with Ctype.Unify _ -> raise(Error(cl.pcl_loc, - Bad_parameters (cl_id, cl_abbrev, - Ctype.newty (Tconstr (Path.Pident cl_id, cl_params, - ref Mnil))))) + Bad_parameters (cl_id, cl_abbrev, + Ctype.newty (Tconstr (Path.Pident cl_id, cl_params, + ref Mnil))))) end; (* Object abbreviation and arguments for new *) @@ -516,16 +516,16 @@ let transl_class temp_env env with Ctype.Unify _ -> raise(Error(cl.pcl_loc, Bad_parameters (obj_id, abbrev, - Ctype.newty (Tconstr (Path.Pident obj_id, obj_params, - ref Mnil))))) + Ctype.newty (Tconstr (Path.Pident obj_id, obj_params, + ref Mnil))))) end; Ctype.close_object temp_obj; List.iter2 (fun ty (exp, ty') -> begin try - Ctype.unify temp_env ty' ty + Ctype.unify temp_env ty' ty with Ctype.Unify trace -> - raise(Error(exp.pat_loc, Argument_type_mismatch trace)) + raise(Error(exp.pat_loc, Argument_type_mismatch trace)) end) new_args (List.combine args arg_sig'); @@ -557,7 +557,7 @@ let build_new_type temp_env env (* Modify constrainsts to ensure the object abbreviation is well-formed *) let (params, args, vars, meths, self) = Ctype.instance_class cl_sig in List.iter2 (Ctype.unify temp_env) params temp_obj_params; - (* Never fails *) + (* Never fails *) (* Hide private methods *) Ctype.hide_private_methods cl_sig.cty_self; @@ -602,7 +602,7 @@ let build_new_type temp_env env cty_meths = meths; cty_self = exp_self; cty_concr = cl_sig.cty_concr; - cty_new = cl_sig.cty_new } (* new is still monomorphic *) + cty_new = cl_sig.cty_new } (* new is still monomorphic *) in let new_env = Env.add_class id cl_sig env in ((cl, id, cl_id, obj_id, cl_sig, cl_imp), new_env) @@ -690,28 +690,28 @@ let make_stub env (cl, obj_id, cl_id) = let concr_meths = List.fold_left (function meths -> - function - Pctf_inher (nm, _, loc) -> + function + Pctf_inher (nm, _, loc) -> let (_, anc) = - try - Env.lookup_class nm env - with Not_found -> - raise(Error(loc, Unbound_class nm)) + try + Env.lookup_class nm env + with Not_found -> + raise(Error(loc, Unbound_class nm)) in - begin match (Ctype.expand_head env anc.cty_self).desc with + begin match (Ctype.expand_head env anc.cty_self).desc with Tobject (ty, _) -> add_methods env self ty; - Concr.union anc.cty_concr meths + Concr.union anc.cty_concr meths | _ -> fatal_error "Typeclass.make_stub (type)" end - | Pctf_val _ -> - meths - | Pctf_virt (lab, priv, _, _) -> - Ctype.filter_method env lab priv self; - meths - | Pctf_meth (lab, priv, _, _) -> - Ctype.filter_method env lab priv self; - Concr.add lab meths) + | Pctf_val _ -> + meths + | Pctf_virt (lab, priv, _, _) -> + Ctype.filter_method env lab priv self; + meths + | Pctf_meth (lab, priv, _, _) -> + Ctype.filter_method env lab priv self; + Concr.add lab meths) Concr.empty cl.pcty_field in @@ -836,11 +836,11 @@ let type_class_field env var_env self cl (vars_sig, meths_sig) = | Pctf_val (lab, priv, mut, sty, loc) -> begin match sty with - Some sty -> + Some sty -> let ty = transl_simple_type var_env false sty in (insert_value var_env lab priv mut ty loc vars_sig, meths_sig) | None -> - (fst (change_value_status lab priv mut loc vars_sig), meths_sig) + (fst (change_value_status lab priv mut loc vars_sig), meths_sig) end | Pctf_virt (lab, priv, sty, loc) -> @@ -930,9 +930,9 @@ let transl_class temp_env env List.iter2 (Ctype.unify temp_env) temp_cl_params cl_params with Ctype.Unify _ -> raise(Error(cl.pcty_loc, - Bad_parameters (cl_id, cl_abbrev, - Ctype.newty (Tconstr (Path.Pident cl_id, cl_params, - ref Mnil))))) + Bad_parameters (cl_id, cl_abbrev, + Ctype.newty (Tconstr (Path.Pident cl_id, cl_params, + ref Mnil))))) end; (* Object abbreviation and arguments for new *) @@ -947,8 +947,8 @@ let transl_class temp_env env with Ctype.Unify _ -> raise(Error(cl.pcty_loc, Bad_parameters (obj_id, abbrev, - Ctype.newty (Tconstr (Path.Pident obj_id, obj_params, - ref Mnil))))) + Ctype.newty (Tconstr (Path.Pident obj_id, obj_params, + ref Mnil))))) end; Ctype.close_object temp_obj; @@ -975,7 +975,7 @@ let build_new_type temp_env env (* Modify constrainsts to ensure the object abbreviation is well-formed *) let (params, args, vars, meths, self) = Ctype.instance_class cl_sig in List.iter2 (Ctype.unify temp_env) params temp_obj_params; - (* Never fails *) + (* Never fails *) (* Hide private methods *) Ctype.hide_private_methods cl_sig.cty_self; @@ -1037,12 +1037,12 @@ let make_abbrev env type_kind = Type_abstract; type_manifest = Some (if cl.pcty_closed = Closed then - Ctype.newgenty (Tconstr(Path.Pident obj_id, cl_sig.cty_params, + Ctype.newgenty (Tconstr(Path.Pident obj_id, cl_sig.cty_params, ref Mnil)) else begin Ctype.set_object_name cl_sig.cty_self cl_sig.cty_params obj_id; cl_sig.cty_self - end) } + end) } in let new_env = Env.add_type cl_id cl_abbrev env in (* Object type abbreviation *) diff --git a/typing/typecore.ml b/typing/typecore.ml index 0ce889fa4f..e839f70174 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -255,11 +255,11 @@ let type_format loc fmt = | 'a' -> let ty_arg = newvar() in newty (Tarrow (newty (Tarrow(ty_input, - newty (Tarrow (ty_arg, ty_result)))), + newty (Tarrow (ty_arg, ty_result)))), newty (Tarrow (ty_arg, scan_format (j+1))))) | 't' -> newty (Tarrow(newty (Tarrow(ty_input, ty_result)), - scan_format (j+1))) + scan_format (j+1))) | c -> raise(Error(loc, Bad_format(String.sub fmt i (j-i)))) end @@ -282,14 +282,14 @@ let rec type_exp env sexp = let (path, desc) = Env.lookup_value lid env in { exp_desc = begin match (desc.val_kind, lid) with - (Val_ivar _, Longident.Lident lab) -> - let (path_self, _) = + (Val_ivar _, Longident.Lident lab) -> + let (path_self, _) = Env.lookup_value (Longident.Lident "*self*") env in Texp_instvar (path_self, path) - | _ -> - Texp_ident(path, desc) - end; + | _ -> + Texp_ident(path, desc) + end; exp_loc = sexp.pexp_loc; exp_type = instance desc.val_type; exp_env = env } @@ -495,13 +495,13 @@ let rec type_exp env sexp = | Pexp_constraint(sarg, sty, sty') -> let (arg, ty') = match (sty, sty') with - (None, None) -> (* Case actually unused *) + (None, None) -> (* Case actually unused *) let arg = type_exp env sarg in - (arg, arg.exp_type) - | (Some sty, None) -> + (arg, arg.exp_type) + | (Some sty, None) -> let ty = Typetexp.transl_simple_type env false sty in (type_expect env sarg ty, ty) - | (None, Some sty') -> + | (None, Some sty') -> let (ty', force) = Typetexp.transl_simple_type_delayed env sty' in @@ -513,7 +513,7 @@ let rec type_exp env sexp = Coercion_failure(ty', full_expand env ty', trace))) end; (arg, ty') - | (Some sty, Some sty') -> + | (Some sty, Some sty') -> let (ty, force) = Typetexp.transl_simple_type_delayed env sty and (ty', force') = @@ -523,9 +523,9 @@ let rec type_exp env sexp = let force'' = subtype env ty ty' in force (); force' (); force'' () with Subtype (tr1, tr2) -> - raise(Error(sexp.pexp_loc, Not_subtype(tr1, tr2))) + raise(Error(sexp.pexp_loc, Not_subtype(tr1, tr2))) end; - (type_expect env sarg ty, ty') + (type_expect env sarg ty, ty') in { exp_desc = arg.exp_desc; exp_loc = arg.exp_loc; @@ -590,68 +590,68 @@ let rec type_exp env sexp = try Env.lookup_class cl env with Not_found -> raise(Error(sexp.pexp_loc, Unbound_class cl)) in - begin match cl_typ.cty_new with - None -> - raise(Error(sexp.pexp_loc, Virtual_class cl)) + begin match cl_typ.cty_new with + None -> + raise(Error(sexp.pexp_loc, Virtual_class cl)) | Some ty -> { exp_desc = Texp_new cl_path; - exp_loc = sexp.pexp_loc; - exp_type = instance ty; + exp_loc = sexp.pexp_loc; + exp_type = instance ty; exp_env = env } end | Pexp_setinstvar (lab, snewval) -> begin try let (path, desc) = Env.lookup_value (Longident.Lident lab) env in match desc.val_kind with - Val_ivar Mutable -> - let newval = type_expect env snewval desc.val_type in - let (path_self, _) = + Val_ivar Mutable -> + let newval = type_expect env snewval desc.val_type in + let (path_self, _) = Env.lookup_value (Longident.Lident "*self*") env in { exp_desc = Texp_setinstvar(path_self, path, newval); exp_loc = sexp.pexp_loc; exp_type = instance Predef.type_unit; exp_env = env } - | Val_ivar _ -> - raise(Error(sexp.pexp_loc, Instance_variable_not_mutable lab)) - | _ -> + | Val_ivar _ -> + raise(Error(sexp.pexp_loc, Instance_variable_not_mutable lab)) + | _ -> raise(Error(sexp.pexp_loc, Unbound_instance_variable lab)) with - Not_found -> + Not_found -> raise(Error(sexp.pexp_loc, Unbound_instance_variable lab)) end | Pexp_override lst -> List.fold_right - (fun (lab, _) l -> - if List.exists ((=) lab) l then - raise(Error(sexp.pexp_loc, - Value_multiply_overridden lab)); - lab::l) - lst - []; + (fun (lab, _) l -> + if List.exists ((=) lab) l then + raise(Error(sexp.pexp_loc, + Value_multiply_overridden lab)); + lab::l) + lst + []; let (path_self, {val_type = self_ty}) = - try + try Env.lookup_value (Longident.Lident "*self*") env - with Not_found -> - raise(Error(sexp.pexp_loc, Outside_class)) + with Not_found -> + raise(Error(sexp.pexp_loc, Outside_class)) in let type_override (lab, snewval) = begin try let (path, desc) = Env.lookup_value (Longident.Lident lab) env in match desc.val_kind with - Val_ivar _ -> + Val_ivar _ -> (path, type_expect env snewval desc.val_type) - | _ -> + | _ -> raise(Error(sexp.pexp_loc, Unbound_instance_variable lab)) with - Not_found -> + Not_found -> raise(Error(sexp.pexp_loc, Unbound_instance_variable lab)) end in let modifs = List.map type_override lst in { exp_desc = Texp_override(path_self, modifs); - exp_loc = sexp.pexp_loc; - exp_type = self_ty; + exp_loc = sexp.pexp_loc; + exp_type = self_ty; exp_env = env } (* let obj = Oo.copy self in obj.x <- e; obj *) @@ -807,9 +807,9 @@ let type_method env self self_name meths sexp ty_expected = Env.enter_value name {val_type = self; val_kind = Val_self meths} env in ({ pat_desc = Tpat_alias (pattern, self_name); - pat_loc = Location.none; - pat_type = self }, - env) + pat_loc = Location.none; + pat_type = self }, + env) in let exp = type_expect_fun env sexp ty_expected in { exp_desc = Texp_function [(pattern, exp)]; diff --git a/typing/typecore.mli b/typing/typecore.mli index d3d210860d..cfa707bc2f 100644 --- a/typing/typecore.mli +++ b/typing/typecore.mli @@ -33,7 +33,7 @@ val type_expect: Env.t -> Parsetree.expression -> type_expr -> Typedtree.expression val type_exp: - Env.t -> Parsetree.expression -> Typedtree.expression + Env.t -> Parsetree.expression -> Typedtree.expression type error = Unbound_value of Longident.t diff --git a/typing/typemod.ml b/typing/typemod.ml index 593ece951a..de55679d86 100644 --- a/typing/typemod.ml +++ b/typing/typemod.ml @@ -293,11 +293,11 @@ let rec type_module env smod = with Includemod.Error msg -> raise(Error(sarg.pmod_loc, Not_included msg)) in let mty_appl = - try - let path = path_of_module arg in + try + let path = path_of_module arg in Subst.modtype (Subst.add_module param path Subst.identity) - mty_res - with Not_a_path -> + mty_res + with Not_a_path -> try Mtype.nondep_supertype (Env.add_module param arg.mod_type env) param mty_res @@ -394,7 +394,7 @@ and type_struct env sstr = :: str_rem, List.flatten (map_end - (fun (i, d, i', d', i'', d'', _) -> + (fun (i, d, i', d', i'', d'', _) -> [Tsig_class(i, d); Tsig_type(i', d'); Tsig_type(i'', d'')]) classes [sig_rem]), final_env) diff --git a/typing/types.ml b/typing/types.ml index b742ef6272..ab8dc46daf 100644 --- a/typing/types.ml +++ b/typing/types.ml @@ -54,9 +54,9 @@ type value_description = val_kind: value_kind } and value_kind = - Val_reg (* Regular value *) - | Val_prim of Primitive.description (* Primitive *) - | Val_ivar of mutable_flag (* Instance variable (mutable ?) *) + Val_reg (* Regular value *) + | Val_prim of Primitive.description (* Primitive *) + | Val_ivar of mutable_flag (* Instance variable (mutable ?) *) | Val_self of (Ident.t * type_expr) Meths.t ref (* Self *) | Val_anc of (string * Ident.t) list (* Ancestor *) diff --git a/typing/types.mli b/typing/types.mli index 292966e299..ea0665d512 100644 --- a/typing/types.mli +++ b/typing/types.mli @@ -52,9 +52,9 @@ type value_description = val_kind: value_kind } and value_kind = - Val_reg (* Regular value *) - | Val_prim of Primitive.description (* Primitive *) - | Val_ivar of mutable_flag (* Instance variable (mutable ?) *) + Val_reg (* Regular value *) + | Val_prim of Primitive.description (* Primitive *) + | Val_ivar of mutable_flag (* Instance variable (mutable ?) *) | Val_self of (Ident.t * type_expr) Meths.t ref (* Self *) | Val_anc of (string * Ident.t) list (* Ancestor *) diff --git a/utils/misc.ml b/utils/misc.ml index b0ff4dc11f..1c1d0946b7 100644 --- a/utils/misc.ml +++ b/utils/misc.ml @@ -37,9 +37,9 @@ let rec filter pred = [] | a::l -> if pred a then - a::(filter pred l) + a::(filter pred l) else - filter pred l + filter pred l let rec mem_assq x = function [] -> false diff --git a/yacc/Makefile.Mac b/yacc/Makefile.Mac index 3367834cfb..1c3632d51b 100644 --- a/yacc/Makefile.Mac +++ b/yacc/Makefile.Mac @@ -12,34 +12,34 @@ PPCCOptions = -d NDEBUG -w 2 -w 35 PPCLinkOptions = -d PPCLibs = "{sharedlibraries}MathLib" "{ppclibraries}PPCCRuntime.o" "{ppclibraries}PPCToolLibs.o" "{sharedlibraries}StdCLib" - "{ppclibraries}StdCRuntime.o" "{sharedlibraries}InterfaceLib" + "{ppclibraries}StdCRuntime.o" "{sharedlibraries}InterfaceLib" OBJS = closure.c.o error.c.o lalr.c.o lr0.c.o main.c.o mkpar.c.o output.c.o reader.c.o skeleton.c.o symtab.c.o verbose.c.o warshall.c.o - ::byterun:rotatecursor.c.o + ::byterun:rotatecursor.c.o PPCOBJS = closure.c.x error.c.x lalr.c.x lr0.c.x main.c.x mkpar.c.x output.c.x reader.c.x skeleton.c.x symtab.c.x verbose.c.x warshall.c.x - ::byterun:rotatecursor.c.x + ::byterun:rotatecursor.c.x all ocamlyacc ocamlyacc {OBJS} - ilink -c 'MPS ' -t MPST {LinkOptions} -o ocamlyacc {OBJS} {Libs} + ilink -c 'MPS ' -t MPST {LinkOptions} -o ocamlyacc {OBJS} {Libs} ocamlyacc {PPCOBJS} - ppclink -c 'MPS ' -t MPST {PPCLinkOptions} -o ocamlyacc {PPCOBJS} {PPCLibs} + ppclink -c 'MPS ' -t MPST {PPCLinkOptions} -o ocamlyacc {PPCOBJS} {PPCLibs} clean - delete -i .c.[ox] || set status 0 - delete -i ocamlyacc + delete -i .c.[ox] || set status 0 + delete -i ocamlyacc ::byterun:rotatecursor.c.o ::byterun:rotatecursor.c ::byterun:rotatecursor.h - directory ::byterun; domake rotatecursor.c.o; directory ::yacc + directory ::byterun; domake rotatecursor.c.o; directory ::yacc ::byterun:rotatecursor.c.x ::byterun:rotatecursor.c ::byterun:rotatecursor.h - directory ::byterun; domake rotatecursor.c.x; directory ::yacc + directory ::byterun; domake rotatecursor.c.x; directory ::yacc depend |