diff options
66 files changed, 281 insertions, 277 deletions
diff --git a/asmcomp/closure.ml b/asmcomp/closure.ml index d887ac1af..49da63425 100644 --- a/asmcomp/closure.ml +++ b/asmcomp/closure.ml @@ -42,27 +42,27 @@ let occurs_var var u = Uvar v -> v = var | Uconst cst -> false | Udirect_apply(lbl, args) -> List.exists occurs args - | Ugeneric_apply(funct, args) -> occurs funct or List.exists occurs args + | Ugeneric_apply(funct, args) -> occurs funct || List.exists occurs args | Uclosure(fundecls, clos) -> List.exists occurs clos | Uoffset(u, ofs) -> occurs u - | Ulet(id, def, body) -> occurs def or occurs body + | Ulet(id, def, body) -> occurs def || occurs body | Uletrec(decls, body) -> - List.exists (fun (id, u) -> occurs u) decls or occurs body + List.exists (fun (id, u) -> occurs u) decls || occurs body | Uprim(p, args) -> List.exists occurs args | Uswitch(arg, s) -> - occurs arg or occurs_array s.us_cases_consts - or occurs_array s.us_cases_blocks + occurs arg || occurs_array s.us_cases_consts + || occurs_array s.us_cases_blocks | Ustaticfail (_, args) -> List.exists occurs args - | Ucatch(_, _, body, hdlr) -> occurs body or occurs hdlr - | Utrywith(body, exn, hdlr) -> occurs body or occurs hdlr + | Ucatch(_, _, body, hdlr) -> occurs body || occurs hdlr + | Utrywith(body, exn, hdlr) -> occurs body || occurs hdlr | Uifthenelse(cond, ifso, ifnot) -> - occurs cond or occurs ifso or occurs ifnot - | Usequence(u1, u2) -> occurs u1 or occurs u2 - | Uwhile(cond, body) -> occurs cond or occurs body - | Ufor(id, lo, hi, dir, body) -> occurs lo or occurs hi or occurs body - | Uassign(id, u) -> id = var or occurs u + occurs cond || occurs ifso || occurs ifnot + | Usequence(u1, u2) -> occurs u1 || occurs u2 + | Uwhile(cond, body) -> occurs cond || occurs body + | Ufor(id, lo, hi, dir, body) -> occurs lo || occurs hi || occurs body + | Uassign(id, u) -> id = var || occurs u | Usend(met, obj, args) -> - occurs met or occurs obj or List.exists occurs args + occurs met || occurs obj || List.exists occurs args and occurs_array a = try for i = 0 to Array.length a - 1 do diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 326792a82..96b8015d0 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -772,7 +772,7 @@ let rec transl = function let unboxed_id = Ident.create (Ident.name id) in let (tr_body, need_boxed, is_assigned) = subst_boxed_float id unboxed_id (transl body) in - if need_boxed & is_assigned then + if need_boxed && is_assigned then Clet(id, transl exp, transl body) else Clet(unboxed_id, transl_unbox_float exp, diff --git a/asmcomp/coloring.ml b/asmcomp/coloring.ml index 37ccc2eed..f34deb1b3 100644 --- a/asmcomp/coloring.ml +++ b/asmcomp/coloring.ml @@ -31,7 +31,7 @@ let allocate_spilled reg = | _ -> ()) reg.interf; let slot = ref 0 in - while !slot < nslots & conflict.(!slot) do incr slot done; + while !slot < nslots && conflict.(!slot) do incr slot done; reg.loc <- Stack(Local !slot); if !slot >= nslots then Proc.num_stack_slots.(cl) <- !slot + 1 end @@ -56,7 +56,7 @@ let find_degree reg = else begin let deg = ref 0 in List.iter - (fun r -> if not r.spill & Proc.register_class r = cl then incr deg) + (fun r -> if not r.spill && Proc.register_class r = cl then incr deg) reg.interf; reg.degree <- !deg; if !deg >= avail_regs @@ -72,7 +72,7 @@ let remove_reg reg = let cl = Proc.register_class reg in List.iter (fun r -> - if Proc.register_class r = cl & r.degree > 0 then begin + if Proc.register_class r = cl && r.degree > 0 then begin let olddeg = r.degree in r.degree <- olddeg - 1; if olddeg = Proc.num_available_registers.(cl) then begin @@ -154,13 +154,13 @@ let assign_location reg = iter_preferred (fun r w -> match r.loc with - Reg n -> if n >= first_reg & n < last_reg then + Reg n -> if n >= first_reg && n < last_reg then score.(n - first_reg) <- score.(n - first_reg) + w | Unknown -> List.iter (fun neighbour -> match neighbour.loc with - Reg n -> if n >= first_reg & n < last_reg then + Reg n -> if n >= first_reg && n < last_reg then score.(n - first_reg) <- score.(n - first_reg) - w | _ -> ()) r.interf @@ -171,7 +171,7 @@ let assign_location reg = (* Prohibit the registers that have been assigned to our neighbours *) begin match neighbour.loc with - Reg n -> if n >= first_reg & n < last_reg then + Reg n -> if n >= first_reg && n < last_reg then score.(n - first_reg) <- (-1000000) | _ -> () end; @@ -180,7 +180,7 @@ let assign_location reg = iter_preferred (fun r w -> match r.loc with - Reg n -> if n >= first_reg & n < last_reg then + Reg n -> if n >= first_reg && n < last_reg then score.(n - first_reg) <- score.(n - first_reg) - (w - 1) (* w-1 to break the symmetry when two conflicting regs have the same preference for a third reg. *) @@ -216,7 +216,7 @@ let assign_location reg = match r.loc with Stack(Incoming n) -> if w > !best_score - & List.for_all (fun neighbour -> neighbour.loc <> r.loc) + && List.for_all (fun neighbour -> neighbour.loc <> r.loc) reg.interf then begin best_score := w; diff --git a/asmcomp/power/selection.ml b/asmcomp/power/selection.ml index 48b012d96..37ac6cde1 100644 --- a/asmcomp/power/selection.ml +++ b/asmcomp/power/selection.ml @@ -51,7 +51,7 @@ class selector = object (self) inherit Selectgen.selector_generic as super -method is_immediate n = (n <= 32767) & (n >= -32768) +method is_immediate n = (n <= 32767) && (n >= -32768) method select_addressing exp = match select_addr exp with @@ -95,9 +95,9 @@ method select_operation op args = super#select_operation op args method select_logical op = function - [arg; Cconst_int n] when n >= 0 & n <= 0xFFFF -> + [arg; Cconst_int n] when n >= 0 && n <= 0xFFFF -> (Iintop_imm(op, n), [arg]) - | [Cconst_int n; arg] when n >= 0 & n <= 0xFFFF -> + | [Cconst_int n; arg] when n >= 0 && n <= 0xFFFF -> (Iintop_imm(op, n), [arg]) | args -> (Iintop op, args) diff --git a/asmcomp/schedgen.ml b/asmcomp/schedgen.ml index 6450b8afd..73696b9bd 100644 --- a/asmcomp/schedgen.ml +++ b/asmcomp/schedgen.ml @@ -87,7 +87,7 @@ let rec longest_path critical_outputs node = [] -> node.length <- if is_critical critical_outputs node.instr.res - or node.instr.desc = Lreloadretaddr (* alway critical *) + || node.instr.desc = Lreloadretaddr (* alway critical *) then node.delay else 0 | sons -> diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml index c0e4c2433..390069c55 100644 --- a/asmcomp/selectgen.ml +++ b/asmcomp/selectgen.ml @@ -275,7 +275,7 @@ method private select_arith op = function (Iintop op, args) method private select_shift op = function - [arg; Cconst_int n] when n >= 0 & n < Arch.size_int * 8 -> + [arg; Cconst_int n] when n >= 0 && n < Arch.size_int * 8 -> (Iintop_imm(op, n), [arg]) | args -> (Iintop op, args) diff --git a/asmcomp/sparc/selection.ml b/asmcomp/sparc/selection.ml index 03bc66ca1..4a9d78396 100644 --- a/asmcomp/sparc/selection.ml +++ b/asmcomp/sparc/selection.ml @@ -49,12 +49,12 @@ method select_operation op args = | (Cmuli, _) -> (Iextcall(".umul", false), args) | (Cdivi, [arg; Cconst_int n]) - when self#is_immediate n & n = 1 lsl (Misc.log2 n) -> + when self#is_immediate n && n = 1 lsl (Misc.log2 n) -> (Iintop_imm(Idiv, n), [arg]) | (Cdivi, _) -> (Iextcall(".div", false), args) | (Cmodi, [arg; Cconst_int n]) - when self#is_immediate n & n = 1 lsl (Misc.log2 n) -> + when self#is_immediate n && n = 1 lsl (Misc.log2 n) -> (Iintop_imm(Imod, n), [arg]) | (Cmodi, _) -> (Iextcall(".rem", false), args) diff --git a/bytecomp/emitcode.ml b/bytecomp/emitcode.ml index c09885c8d..7913e5482 100644 --- a/bytecomp/emitcode.ml +++ b/bytecomp/emitcode.ml @@ -228,13 +228,13 @@ let emit_instr = function | Kconst sc -> begin match sc with Const_base(Const_int i) when is_immed i -> - if i >= 0 & i <= 3 + if i >= 0 && i <= 3 then out (opCONST0 + i) else (out opCONSTINT; out_int i) | Const_base(Const_char c) -> out opCONSTINT; out_int (Char.code c) | Const_pointer i -> - if i >= 0 & i <= 3 + if i >= 0 && i <= 3 then out (opCONST0 + i) else (out opCONSTINT; out_int i) | Const_block(t, []) -> @@ -347,13 +347,13 @@ let rec emit = function | Kpush :: Kconst sc :: c -> begin match sc with Const_base(Const_int i) when is_immed i -> - if i >= 0 & i <= 3 + if i >= 0 && i <= 3 then out (opPUSHCONST0 + i) else (out opPUSHCONSTINT; out_int i) | Const_base(Const_char c) -> out opPUSHCONSTINT; out_int(Char.code c) | Const_pointer i -> - if i >= 0 & i <= 3 + if i >= 0 && i <= 3 then out (opPUSHCONST0 + i) else (out opPUSHCONSTINT; out_int i) | Const_block(t, []) -> diff --git a/bytecomp/matching.ml b/bytecomp/matching.ml index bc21088be..2b82f7e33 100644 --- a/bytecomp/matching.ml +++ b/bytecomp/matching.ml @@ -586,7 +586,7 @@ let rec cut n l = let make_test_sequence nofail check tst lt_tst arg const_lambda_list = let rec make_test_sequence const_lambda_list = - if List.length const_lambda_list >= 4 & lt_tst <> Praise then + if List.length const_lambda_list >= 4 && lt_tst <> Praise then split_sequence const_lambda_list else List.fold_right diff --git a/bytecomp/simplif.ml b/bytecomp/simplif.ml index 6a27cf7f2..bf1d65b59 100644 --- a/bytecomp/simplif.ml +++ b/bytecomp/simplif.ml @@ -136,7 +136,7 @@ let simplify_lambda lam = | Llet(str, v, l1, l2) -> count l2; (* If v is unused, l1 will be removed, so don't count its variables *) - if str = Strict or count_var v > 0 then count l1 + if str = Strict || count_var v > 0 then count l1 | Lletrec(bindings, body) -> List.iter (fun (v, l) -> count l) bindings; count body diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml index c4a7e3e5b..67417b4d1 100644 --- a/bytecomp/translcore.ml +++ b/bytecomp/translcore.ml @@ -239,7 +239,7 @@ let transl_prim prim args = | [{exp_desc = Texp_construct({cstr_tag = Cstr_constant _}, _)}; arg2] -> intcomp | [arg1; arg2] when has_base_type arg1 Predef.path_int - or has_base_type arg1 Predef.path_char -> + || has_base_type arg1 Predef.path_char -> intcomp | [arg1; arg2] when has_base_type arg1 Predef.path_float -> floatcomp diff --git a/debugger/pattern_matching.ml b/debugger/pattern_matching.ml index 26e5a61f4..a04dcae5b 100644 --- a/debugger/pattern_matching.ml +++ b/debugger/pattern_matching.ml @@ -60,7 +60,7 @@ let error_matching () = let same_name {qualid = name1} = function GRname name2 -> - (name2 = "") or (name1.id = name2) + (name2 = "") || (name1.id = name2) | GRmodname name2 -> name1 = name2 diff --git a/driver/main.ml b/driver/main.ml index 4ccc52d6c..ac008a9c9 100644 --- a/driver/main.ml +++ b/driver/main.ml @@ -24,17 +24,17 @@ let process_implementation_file ppf name = let process_file ppf name = if Filename.check_suffix name ".ml" - or Filename.check_suffix name ".mlt" then begin + || Filename.check_suffix name ".mlt" then begin Compile.implementation ppf name; objfiles := (Filename.chop_extension name ^ ".cmo") :: !objfiles end else if Filename.check_suffix name !Config.interface_suffix then Compile.interface ppf name else if Filename.check_suffix name ".cmo" - or Filename.check_suffix name ".cma" then + || Filename.check_suffix name ".cma" then objfiles := name :: !objfiles else if Filename.check_suffix name ext_obj - or Filename.check_suffix name ext_lib then + || Filename.check_suffix name ext_lib then ccobjs := name :: !ccobjs else if Filename.check_suffix name ".c" then begin Compile.c_file name; diff --git a/driver/optmain.ml b/driver/optmain.ml index 788b8e6d2..19b1941d2 100644 --- a/driver/optmain.ml +++ b/driver/optmain.ml @@ -24,17 +24,17 @@ let process_implementation_file ppf name = let process_file ppf name = if Filename.check_suffix name ".ml" - or Filename.check_suffix name ".mlt" then begin + || Filename.check_suffix name ".mlt" then begin Optcompile.implementation ppf name; objfiles := (Filename.chop_extension name ^ ".cmx") :: !objfiles end else if Filename.check_suffix name !Config.interface_suffix then Optcompile.interface ppf name else if Filename.check_suffix name ".cmx" - or Filename.check_suffix name ".cmxa" then + || Filename.check_suffix name ".cmxa" then objfiles := name :: !objfiles else if Filename.check_suffix name ext_obj - or Filename.check_suffix name ext_lib then + || Filename.check_suffix name ext_lib then ccobjs := name :: !ccobjs else if Filename.check_suffix name ".c" then begin Optcompile.c_file name; diff --git a/lex/lexgen.ml b/lex/lexgen.ml index f70e1eecd..dc8a655a3 100644 --- a/lex/lexgen.ml +++ b/lex/lexgen.ml @@ -113,8 +113,8 @@ let rec nullable = function Empty -> true | Chars _ -> false | Action _ -> false - | Seq(r1,r2) -> nullable r1 & nullable r2 - | Alt(r1,r2) -> nullable r1 or nullable r2 + | Seq(r1,r2) -> nullable r1 && nullable r2 + | Alt(r1,r2) -> nullable r1 || nullable r2 | Star r -> true let rec firstpos = function diff --git a/otherlibs/dynlink/dynlink.ml b/otherlibs/dynlink/dynlink.ml index db75219e2..4d9424194 100644 --- a/otherlibs/dynlink/dynlink.ml +++ b/otherlibs/dynlink/dynlink.ml @@ -106,7 +106,7 @@ let allow_unsafe_modules b = unsafe_allowed := b let check_unsafe_module cu = - if (not !unsafe_allowed) & cu.cu_primitives <> [] + if (not !unsafe_allowed) && cu.cu_primitives <> [] then raise(Error(Unsafe_file)) (* Check that all globals referenced in the object file have been diff --git a/otherlibs/labltk/browser/editor.ml b/otherlibs/labltk/browser/editor.ml index 773f71b0a..5174493a3 100644 --- a/otherlibs/labltk/browser/editor.ml +++ b/otherlibs/labltk/browser/editor.ml @@ -200,7 +200,7 @@ let send_phrase txt = sh#send ";;\n" let search_pos_window txt ~x ~y = - if txt.structure = [] & txt.psignature = [] then () else + if txt.structure = [] && txt.psignature = [] then () else let `Linechar (l, c) = Text.index txt.tw ~index:(`Atxy(x,y), []) in let text = Jg_text.get_all txt.tw in let pos = Searchpos.lines_to_chars l ~text + c in @@ -217,7 +217,7 @@ let search_pos_window txt ~x ~y = with Not_found -> () let search_pos_menu txt ~x ~y = - if txt.structure = [] & txt.psignature = [] then () else + if txt.structure = [] && txt.psignature = [] then () else let `Linechar (l, c) = Text.index txt.tw ~index:(`Atxy(x,y), []) in let text = Jg_text.get_all txt.tw in let pos = Searchpos.lines_to_chars l ~text + c in @@ -326,8 +326,8 @@ class editor ~top ~menus = object (self) bind tw ~events:[`Modified([`Alt], `KeyPress)] ~action:ignore; bind tw ~events:[`KeyPress] ~fields:[`Char] ~action:(fun ev -> - if ev.ev_Char <> "" & - (ev.ev_Char.[0] >= ' ' or + if ev.ev_Char <> "" && + (ev.ev_Char.[0] >= ' ' || List.mem ev.ev_Char.[0] (List.map ~f:control ['d'; 'h'; 'i'; 'k'; 'o'; 't'; 'w'; 'y'])) then Textvariable.set txt.modified "modified"); @@ -440,7 +440,7 @@ class editor ~top ~menus = object (self) close_in file; Text.mark_set tw ~mark:"insert" ~index; Text.see tw ~index; - if Filename.check_suffix name ".ml" or + if Filename.check_suffix name ".ml" || Filename.check_suffix name ".mli" then begin if !lex_on_load then self#lex (); diff --git a/otherlibs/labltk/browser/fileselect.ml b/otherlibs/labltk/browser/fileselect.ml index 4ddb7718f..0b513584f 100644 --- a/otherlibs/labltk/browser/fileselect.ml +++ b/otherlibs/labltk/browser/fileselect.ml @@ -70,7 +70,7 @@ let unix_regexp s = Str.regexp s let exact_match s ~pat = - Str.string_match ~pat s ~pos:0 & Str.match_end () = String.length s + Str.string_match ~pat s ~pos:0 && Str.match_end () = String.length s let ls ~dir ~pattern = let files = get_files_in_directory dir in @@ -117,16 +117,16 @@ let f ~title ~action:proc ?(dir = Unix.getcwd ()) else filter in let dir, pattern = parse_filter filter in - let dir = if !load_in_path & usepath then "" else + let dir = if !load_in_path && usepath then "" else (current_dir := Filename.dirname dir; dir) and pattern = if pattern = "" then "*" else pattern in current_pattern := pattern; let filter = - if !load_in_path & usepath then pattern else dir ^ pattern in + if !load_in_path && usepath then pattern else dir ^ pattern in let directories = get_directories_in_files ~path:dir (get_files_in_directory dir) in let matched_files = (* get matched file by subshell call. *) - if !load_in_path & usepath then + if !load_in_path && usepath then List.fold_left !Config.load_path ~init:[] ~f: begin fun acc dir -> let files = ls ~dir ~pattern in @@ -143,7 +143,7 @@ let f ~title ~action:proc ?(dir = Unix.getcwd ()) Listbox.delete filter_listbox ~first:(`Num 0) ~last:`End; Listbox.insert filter_listbox ~index:`End ~texts:matched_files; Jg_box.recenter filter_listbox ~index:(`Num 0); - if !load_in_path & usepath then + if !load_in_path && usepath then Listbox.configure directory_listbox ~takefocus:false else begin @@ -159,7 +159,7 @@ let f ~title ~action:proc ?(dir = Unix.getcwd ()) Grab.release tl; destroy tl; let l = - if !load_in_path & usepath then + if !load_in_path && usepath then List.fold_right l ~init:[] ~f: begin fun name acc -> if not (Filename.is_implicit name) then @@ -236,7 +236,7 @@ let f ~title ~action:proc ?(dir = Unix.getcwd ()) ~action:(fun ev -> let name = Listbox.get filter_listbox ~index:(Listbox.nearest filter_listbox ~y:ev.ev_MouseY) in - if !load_in_path & usepath then + if !load_in_path && usepath then try Textvariable.set selection_var (search_in_path ~name) with Not_found -> () else Textvariable.set selection_var (!current_dir ^ "/" ^ name)); @@ -279,7 +279,7 @@ let f ~title ~action:proc ?(dir = Unix.getcwd ()) pack [okb; flb; ccb] ~side:`Left ~fill:`X ~expand:true; pack [cfrm] ~before:frm ~side:`Bottom ~fill:`X; - if !load_in_path & usepath then begin + if !load_in_path && usepath then begin load_in_path := false; Checkbutton.invoke toggle_in_path; Checkbutton.select toggle_in_path diff --git a/otherlibs/labltk/browser/jg_completion.ml b/otherlibs/labltk/browser/jg_completion.ml index 9217fcf45..1bdedede5 100644 --- a/otherlibs/labltk/browser/jg_completion.ml +++ b/otherlibs/labltk/browser/jg_completion.ml @@ -23,7 +23,7 @@ class completion ?nocase texts = object val mutable current = 0 method add c = prefix <- prefix ^ c; - while current < List.length texts - 1 & + while current < List.length texts - 1 && lt_string (List.nth texts current) prefix ?nocase do current <- current + 1 diff --git a/otherlibs/labltk/browser/searchid.ml b/otherlibs/labltk/browser/searchid.ml index 2ce0d1674..6f427c235 100644 --- a/otherlibs/labltk/browser/searchid.ml +++ b/otherlibs/labltk/browser/searchid.ml @@ -106,38 +106,38 @@ let rec equal ~prefix t1 t2 = and fields2 = filter_row_fields false row1.row_fields in let r1, r2, pairs = merge_row_fields fields1 fields2 in - row1.row_closed = row2.row_closed & r1 = [] & r2 = [] & + row1.row_closed = row2.row_closed && r1 = [] && r2 = [] && List.for_all pairs ~f: begin fun (_,f1,f2) -> match row_field_repr f1, row_field_repr f2 with Rpresent None, Rpresent None -> true | Rpresent(Some t1), Rpresent (Some t2) -> equal t1 t2 ~prefix | Reither(c1, tl1, _), Reither(c2, tl2, _) -> - c1 = c2 & List.length tl1 = List.length tl2 & + c1 = c2 && List.length tl1 = List.length tl2 && List.for_all2 tl1 tl2 ~f:(equal ~prefix) | _ -> false end | Tarrow _, Tarrow _ -> let l1, t1 = all_args t1 and l2, t2 = all_args t2 in - equal t1 t2 ~prefix & - List.length l1 = List.length l2 & + equal t1 t2 ~prefix && + List.length l1 = List.length l2 && List.exists (permutations l1) ~f: begin fun l1 -> List.for_all2 l1 l2 ~f: begin fun (p1,t1) (p2,t2) -> - (p1 = "" or p1 = p2) & equal t1 t2 ~prefix + (p1 = "" || p1 = p2) && equal t1 t2 ~prefix end end | Ttuple l1, Ttuple l2 -> - List.length l1 = List.length l2 & + List.length l1 = List.length l2 && List.for_all2 l1 l2 ~f:(equal ~prefix) | Tconstr (p1, l1, _), Tconstr (p2, l2, _) -> remove_prefix ~prefix (longident_of_path p1) = (longident_of_path p2) - & List.length l1 = List.length l2 - & List.for_all2 l1 l2 ~f:(equal ~prefix) + && List.length l1 = List.length l2 + && List.for_all2 l1 l2 ~f:(equal ~prefix) | _ -> false -let is_opt s = s <> "" & s.[0] = '?' +let is_opt s = s <> "" && s.[0] = '?' let get_options = List.filter ~f:is_opt let rec included ~prefix t1 t2 = @@ -149,37 +149,37 @@ let rec included ~prefix t1 t2 = and fields2 = filter_row_fields false row1.row_fields in let r1, r2, pairs = merge_row_fields fields1 fields2 in - r1 = [] & + r1 = [] && List.for_all pairs ~f: begin fun (_,f1,f2) -> match row_field_repr f1, row_field_repr f2 with Rpresent None, Rpresent None -> true | Rpresent(Some t1), Rpresent (Some t2) -> included t1 t2 ~prefix | Reither(c1, tl1, _), Reither(c2, tl2, _) -> - c1 = c2 & List.length tl1 = List.length tl2 & + c1 = c2 && List.length tl1 = List.length tl2 && List.for_all2 tl1 tl2 ~f:(included ~prefix) | _ -> false end | Tarrow _, Tarrow _ -> let l1, t1 = all_args t1 and l2, t2 = all_args t2 in - included t1 t2 ~prefix & + included t1 t2 ~prefix && let len1 = List.length l1 and len2 = List.length l2 in let l2 = if arr len1 ~card:len2 < 100 then l2 else let ll1 = get_options (fst (List.split l1)) in List.filter l2 - ~f:(fun (l,_) -> not (is_opt l) or List.mem l ll1) + ~f:(fun (l,_) -> not (is_opt l) || List.mem l ll1) in - len1 <= len2 & + len1 <= len2 && List.exists (List2.flat_map ~f:permutations (choose len1 ~card:l2)) ~f: begin fun l2 -> List.for_all2 l1 l2 ~f: begin fun (p1,t1) (p2,t2) -> - (p1 = "" or p1 = p2) & included t1 t2 ~prefix + (p1 = "" || p1 = p2) && included t1 t2 ~prefix end end | Ttuple l1, Ttuple l2 -> let len1 = List.length l1 in - len1 <= List.length l2 & + len1 <= List.length l2 && List.exists (List2.flat_map ~f:permutations (choose len1 ~card:l2)) ~f: begin fun l2 -> List.for_all2 l1 l2 ~f:(included ~prefix) @@ -187,8 +187,8 @@ let rec included ~prefix t1 t2 = | _, Ttuple _ -> included (newty (Ttuple [t1])) t2 ~prefix | Tconstr (p1, l1, _), Tconstr (p2, l2, _) -> remove_prefix ~prefix (longident_of_path p1) = (longident_of_path p2) - & List.length l1 = List.length l2 - & List.for_all2 l1 l2 ~f:(included ~prefix) + && List.length l1 = List.length l2 + && List.for_all2 l1 l2 ~f:(included ~prefix) | _ -> false let mklid = function @@ -223,7 +223,7 @@ let rec search_type_in_signature t ~sign ~prefix ~mode = begin match td.type_manifest with None -> false | Some t -> matches t - end or + end || begin match td.type_kind with Type_abstract -> false | Type_variant l -> @@ -244,14 +244,14 @@ let rec search_type_in_signature t ~sign ~prefix ~mode = | Tsig_class (id, cl) -> let self = self_type cl.cty_type in if matches self - or (match cl.cty_new with None -> false | Some ty -> matches ty) - (* or List.exists (get_fields ~prefix ~sign self) + || (match cl.cty_new with None -> false | Some ty -> matches ty) + (* || List.exists (get_fields ~prefix ~sign self) ~f:(fun (_,_,ty_field) -> matches ty_field) *) then [lid_of_id id, Pclass] else [] | Tsig_cltype (id, cl) -> let self = self_type cl.clty_type in if matches self - (* or List.exists (get_fields ~prefix ~sign self) + (* || List.exists (get_fields ~prefix ~sign self) ~f:(fun (_,_,ty_field) -> matches ty_field) *) then [lid_of_id id, Pclass] else [] end @@ -323,7 +323,7 @@ let rec check_match ~pattern s = match pattern, s with [], [] -> true | '*'::l, l' -> check_match ~pattern:l l' - or check_match ~pattern:('?'::'*'::l) l' + || check_match ~pattern:('?'::'*'::l) l' | '?'::l, _::l' -> check_match ~pattern:l l' | x::l, y::l' when x == y -> check_match ~pattern:l l' | _ -> false @@ -344,12 +344,12 @@ let search_pattern_symbol text = | Tsig_module (i, _) when check i -> [i, Pmodule] | Tsig_modtype (i, _) when check i -> [i, Pmodtype] | Tsig_class (i, cl) when check i - or List.exists + || List.exists (get_fields ~prefix:[modname] ~sign (self_type cl.cty_type)) ~f:(fun (name,_,_) -> check_match ~pattern (explode name)) -> [i, Pclass] | Tsig_cltype (i, cl) when check i - or List.exists + || List.exists (get_fields ~prefix:[modname] ~sign (self_type cl.clty_type)) ~f:(fun (name,_,_) -> check_match ~pattern (explode name)) -> [i, Pcltype] @@ -367,7 +367,7 @@ let search_pattern_symbol text = (* let is_pattern s = try for i = 0 to String.length s -1 do - if s.[i] = '?' or s.[i] = '*' then raise Exit + if s.[i] = '?' || s.[i] = '*' then raise Exit done; false with Exit -> true *) @@ -446,13 +446,13 @@ let search_structure str ~name ~kind ~prefix = | Pstr_exception (s, _) when kind = Pconstructor -> name = s | Pstr_module (s, _) when kind = Pmodule -> name = s | Pstr_modtype (s, _) when kind = Pmodtype -> name = s - | Pstr_class l when kind = Pclass or kind = Ptype or kind = Pcltype -> + | Pstr_class l when kind = Pclass || kind = Ptype || kind = Pcltype -> List.iter l ~f: begin fun c -> if c.pci_name = name then loc := c.pci_loc.loc_start end; false - | Pstr_class_type l when kind = Pcltype or kind = Ptype -> + | Pstr_class_type l when kind = Pcltype || kind = Ptype -> List.iter l ~f: begin fun c -> if c.pci_name = name then loc := c.pci_loc.loc_start @@ -495,13 +495,13 @@ let search_signature sign ~name ~kind ~prefix = | Psig_exception (s, _) when kind = Pconstructor -> name = s | Psig_module (s, _) when kind = Pmodule -> name = s | Psig_modtype (s, _) when kind = Pmodtype -> name = s - | Psig_class l when kind = Pclass or kind = Ptype or kind = Pcltype -> + | Psig_class l when kind = Pclass || kind = Ptype || kind = Pcltype -> List.iter l ~f: begin fun c -> if c.pci_name = name then loc := c.pci_loc.loc_start end; false - | Psig_class_type l when kind = Ptype or kind = Pcltype -> + | Psig_class_type l when kind = Ptype || kind = Pcltype -> List.iter l ~f: begin fun c -> if c.pci_name = name then loc := c.pci_loc.loc_start diff --git a/otherlibs/labltk/browser/searchpos.ml b/otherlibs/labltk/browser/searchpos.ml index 3950e2b25..e887c3c10 100644 --- a/otherlibs/labltk/browser/searchpos.ml +++ b/otherlibs/labltk/browser/searchpos.ml @@ -31,12 +31,12 @@ let (~!) = Jg_memo.fast ~f:Str.regexp let lines_to_chars n ~text:s = let l = String.length s in let rec ltc n ~pos = - if n = 1 or pos >= l then pos else + if n = 1 || pos >= l then pos else if s.[pos] = '\n' then ltc (n-1) ~pos:(pos+1) else ltc n ~pos:(pos+1) in ltc n ~pos:0 let in_loc loc ~pos = - pos >= loc.loc_start & pos < loc.loc_end + pos >= loc.loc_start && pos < loc.loc_end let rec string_of_longident = function Lident s -> s @@ -457,7 +457,7 @@ and view_decl_menu lid ~kind ~env ~parent = Menu.add_command menu ~label ~command:(fun () -> view_decl lid ~kind ~env); end; - if kind = `Type or kind = `Modtype then begin + if kind = `Type || kind = `Modtype then begin let buf = new buffer ~size:60 in let (fo,ff) = Format.get_formatter_output_functions () and margin = Format.get_margin () in diff --git a/otherlibs/labltk/browser/shell.ml b/otherlibs/labltk/browser/shell.ml index b98a588d4..30870cf98 100644 --- a/otherlibs/labltk/browser/shell.ml +++ b/otherlibs/labltk/browser/shell.ml @@ -143,7 +143,7 @@ object (self) self#lex ~start:(idx,[`Linestart]) (); Text.see textw ~index:(`Mark"insert",[]) method private keypress c = - if not reading & c > " " then begin + if not reading && c > " " then begin reading <- true; Text.mark_set textw ~mark:"input" ~index:(`Mark"insert",[`Char(-1)]) end @@ -330,7 +330,7 @@ let f ~prog ~title = if l = [] then () else let name = List.hd l in current_dir := Filename.dirname name; - if Filename.check_suffix name ".cmo" or + if Filename.check_suffix name ".cmo" || Filename.check_suffix name ".cma" then let cmd = "#load \"" ^ name ^ "\";;\n" in diff --git a/otherlibs/labltk/browser/typecheck.ml b/otherlibs/labltk/browser/typecheck.ml index 8e1f62018..87a68a8c5 100644 --- a/otherlibs/labltk/browser/typecheck.ml +++ b/otherlibs/labltk/browser/typecheck.ml @@ -96,7 +96,7 @@ let f txt = Jg_text.tag_and_see txt.tw ~start:(tpos s) ~stop:(tpos e) ~tag:"error" end; end_message (); - if !nowarnings or Text.index ew ~index:tend = `Linechar (2,0) + if !nowarnings || Text.index ew ~index:tend = `Linechar (2,0) then destroy tl else begin error_messages := tl :: !error_messages; diff --git a/otherlibs/labltk/browser/viewer.ml b/otherlibs/labltk/browser/viewer.ml index ca7fe5101..c793c0bdf 100644 --- a/otherlibs/labltk/browser/viewer.ml +++ b/otherlibs/labltk/browser/viewer.ml @@ -290,7 +290,7 @@ let f ?(dir=Unix.getcwd()) ?on () = let s = Entry.get ew in let is_type = ref false and is_long = ref false in for i = 0 to String.length s - 2 do - if s.[i] = '-' & s.[i+1] = '>' then is_type := true; + if s.[i] = '-' && s.[i+1] = '>' then is_type := true; if s.[i] = '.' then is_long := true done; let l = diff --git a/otherlibs/labltk/compiler/compile.ml b/otherlibs/labltk/compiler/compile.ml index e20a666a7..25cf3be81 100644 --- a/otherlibs/labltk/compiler/compile.ml +++ b/otherlibs/labltk/compiler/compile.ml @@ -151,7 +151,7 @@ let ppMLtype ?(any=false) ?(return=false) ?(def=false) ?(counter=ref 0) = end) ^ "]" with Not_found -> prerr_endline ("ppMLtype " ^ s ^ " ?"); s - else if not def & List.length typdef.constructors > 1 then + else if not def && List.length typdef.constructors > 1 then "#" ^ s else s else s diff --git a/otherlibs/labltk/compiler/tables.ml b/otherlibs/labltk/compiler/tables.ml index d6eac7c2b..f5fc1435c 100644 --- a/otherlibs/labltk/compiler/tables.ml +++ b/otherlibs/labltk/compiler/tables.ml @@ -160,7 +160,7 @@ let new_type typname arity = (* Assume that types not yet defined are not subtyped *) (* Widget is builtin and implicitly subtyped *) let is_subtyped s = - s = "widget" or + s = "widget" || try let typdef = Hashtbl.find types_table s in typdef.subtypes <> [] @@ -312,7 +312,7 @@ let enter_type typname ?(variant = false) arity constructors = end; (* Callbacks require widget context *) typdef.requires_widget_context <- - typdef.requires_widget_context or + typdef.requires_widget_context || has_callback c.template end @@ -336,7 +336,7 @@ let enter_subtype typ arity subtyp constructors = typdef.constructors <- c :: typdef.constructors end; typdef.requires_widget_context <- - typdef.requires_widget_context or + typdef.requires_widget_context || has_callback c.template; c | Abbrev name -> find_constructor name typdef.constructors diff --git a/otherlibs/labltk/example/tetris.ml b/otherlibs/labltk/example/tetris.ml index 9f11fc769..e2d4277a7 100644 --- a/otherlibs/labltk/example/tetris.ml +++ b/otherlibs/labltk/example/tetris.ml @@ -212,7 +212,7 @@ class cell t1 t2 t3 ~canvas ~x ~y = object method get = color method set ~color:col = if color = col then () else - if color <> 0 & col = 0 then begin + if color <> 0 && col = 0 then begin Canvas.move canvas t1 ~x:(- block_size * (x + 1) -10 - cell_border * 2) ~y:(- block_size * (y + 1) -10 - cell_border * 2); @@ -232,7 +232,7 @@ class cell t1 t2 t3 ~canvas ~x ~y = object Canvas.configure_rectangle canvas t3 ~fill: (`Color "light gray") ~outline: (`Color "light gray"); - if color = 0 & col <> 0 then begin + if color = 0 && col <> 0 then begin Canvas.move canvas t1 ~x: (block_size * (x+1)+10+ cell_border*2) ~y: (block_size * (y+1)+10+ cell_border*2); @@ -250,7 +250,7 @@ end let cell_get (c, cf) x y = cf.(y).(x) #get let cell_set (c, cf) ~x ~y ~color = - if x >= 0 & y >= 0 & Array.length cf > y & Array.length cf.(y) > x then + if x >= 0 && y >= 0 && Array.length cf > y && Array.length cf.(y) > x then let cur = cf.(y).(x) in if cur#get = color then () else cur#set ~color @@ -443,7 +443,7 @@ let _ = and clear fb = let l = ref 0 in for i = 0 to 3 do - if i + fb.y >= 3 & i + fb.y <= 22 then + if i + fb.y >= 3 && i + fb.y <= 22 then if field.(i + fb.y) = line_full then begin incr l; diff --git a/otherlibs/num/nat.ml b/otherlibs/num/nat.ml index 98a994b2c..21e00ed63 100644 --- a/otherlibs/num/nat.ml +++ b/otherlibs/num/nat.ml @@ -64,7 +64,7 @@ let is_zero_nat n off len = compare_nat (make_nat 1) 0 1 n off (num_digits_nat n off len) = 0 let is_nat_int nat off len = - num_digits_nat nat off len = 1 & is_digit_int nat off + num_digits_nat nat off len = 1 && is_digit_int nat off let sys_int_of_nat nat off len = if is_nat_int nat off len @@ -329,7 +329,7 @@ let make_power_base base power_base = power_base (pred !i) 1 power_base 0 done; - while !j <= !i & is_digit_int power_base !j do incr j done; + while !j <= !i && is_digit_int power_base !j do incr j done; (!i - 2, !j) (* @@ -340,7 +340,7 @@ let make_power_base base power_base = let int_to_string int s pos_ref base times = let i = ref int and j = ref times in - while ((!i != 0) or (!j != 0)) & (!pos_ref != -1) do + while ((!i != 0) || (!j != 0)) && (!pos_ref != -1) do String.set s !pos_ref (String.get digits (!i mod base)); decr pos_ref; decr j; @@ -504,8 +504,8 @@ let string_of_nat nat = let base_digit_of_char c base = let n = Char.code c in - if n >= 48 & n <= 47 + min base 10 then n - 48 - else if n >= 65 & n <= 65 + base - 11 then n - 55 + if n >= 48 && n <= 47 + min base 10 then n - 48 + else if n >= 65 && n <= 65 + base - 11 then n - 55 else failwith "invalid digit" (* @@ -537,7 +537,7 @@ let sys_nat_of_string base s off len = | _ -> int := !int * base + base_digit_of_char c base; incr digits_read end; - if (!digits_read = pint or i = bound) & not (!digits_read = 0) then + if (!digits_read = pint || i = bound) && not (!digits_read = 0) then begin set_digit_nat nat1 0 !int; let erase_len = if !new_len = !current_len then !current_len - 1 diff --git a/otherlibs/num/num.ml b/otherlibs/num/num.ml index adde82d8a..ab281f87c 100644 --- a/otherlibs/num/num.ml +++ b/otherlibs/num/num.ml @@ -26,7 +26,7 @@ and least_INT = big_int_of_int least_int (* Coercion big_int -> num *) let num_of_big_int bi = - if le_big_int bi biggest_INT & ge_big_int bi least_INT + if le_big_int bi biggest_INT && ge_big_int bi least_INT then Int (int_of_big_int bi) else Big_int bi diff --git a/otherlibs/num/ratio.ml b/otherlibs/num/ratio.ml index 8f2da7b33..7f6f7caa0 100644 --- a/otherlibs/num/ratio.ml +++ b/otherlibs/num/ratio.ml @@ -219,7 +219,7 @@ let square_ratio r = normalized = r.normalized } let inverse_ratio r = - if !error_when_null_denominator_flag & (sign_big_int r.numerator) = 0 + if !error_when_null_denominator_flag && (sign_big_int r.numerator) = 0 then failwith_zero "inverse_ratio" else {numerator = report_sign_ratio r r.denominator; denominator = abs_big_int r.numerator; @@ -268,7 +268,7 @@ let ceiling_ratio r = let eq_ratio r1 r2 = normalize_ratio r1; normalize_ratio r2; - eq_big_int (r1.numerator) r2.numerator & + eq_big_int (r1.numerator) r2.numerator && eq_big_int (r1.denominator) r2.denominator let compare_ratio r1 r2 = @@ -277,8 +277,8 @@ let compare_ratio r1 r2 = if (verify_null_denominator r2) then let sign_num_r2 = sign_big_int r2.numerator in - if sign_num_r1 = 1 & sign_num_r2 = -1 then 1 - else if sign_num_r1 = -1 & sign_num_r2 = 1 then -1 + if sign_num_r1 = 1 && sign_num_r2 = -1 then 1 + else if sign_num_r1 = -1 && sign_num_r2 = 1 then -1 else 0 else sign_num_r1 else if verify_null_denominator r2 then @@ -303,7 +303,7 @@ let max_ratio r1 r2 = if lt_ratio r1 r2 then r2 else r1 and min_ratio r1 r2 = if gt_ratio r1 r2 then r2 else r1 let eq_big_int_ratio bi r = - (is_integer_ratio r) & eq_big_int bi r.numerator + (is_integer_ratio r) && eq_big_int bi r.numerator let compare_big_int_ratio bi r = normalize_ratio r; @@ -320,7 +320,7 @@ and ge_big_int_ratio bi r = compare_big_int_ratio bi r >= 0 (* Coercions with type int *) let int_of_ratio r = - if ((is_integer_ratio r) & (is_int_big_int r.numerator)) + if ((is_integer_ratio r) && (is_int_big_int r.numerator)) then (int_of_big_int r.numerator) else failwith "integer argument required" diff --git a/otherlibs/num/test/test_big_ints.ml b/otherlibs/num/test/test_big_ints.ml index 858dba270..1453788a9 100644 --- a/otherlibs/num/test/test_big_ints.ml +++ b/otherlibs/num/test/test_big_ints.ml @@ -193,42 +193,42 @@ testing_function "quomod_big_int";; let (quotient, modulo) = quomod_big_int (big_int_of_int 1) (big_int_of_int 1) in - test 1 eq_big_int (quotient, big_int_of_int 1) & + test 1 eq_big_int (quotient, big_int_of_int 1) && test 2 eq_big_int (modulo, zero_big_int);; let (quotient, modulo) = quomod_big_int (big_int_of_int 1) (big_int_of_int (-1)) in - test 3 eq_big_int (quotient, big_int_of_int (-1)) & + test 3 eq_big_int (quotient, big_int_of_int (-1)) && test 4 eq_big_int (modulo, zero_big_int);; let (quotient, modulo) = quomod_big_int (big_int_of_int (-1)) (big_int_of_int 1) in - test 5 eq_big_int (quotient, big_int_of_int (-1)) & + test 5 eq_big_int (quotient, big_int_of_int (-1)) && test 6 eq_big_int (modulo, zero_big_int);; let (quotient, modulo) = quomod_big_int (big_int_of_int 3) (big_int_of_int 2) in - test 7 eq_big_int (quotient, big_int_of_int 1) & + test 7 eq_big_int (quotient, big_int_of_int 1) && test 8 eq_big_int (modulo, big_int_of_int 1);; let (quotient, modulo) = quomod_big_int (big_int_of_int 5) (big_int_of_int 3) in - test 9 eq_big_int (quotient, big_int_of_int 1) & + test 9 eq_big_int (quotient, big_int_of_int 1) && test 10 eq_big_int (modulo, big_int_of_int 2);; let (quotient, modulo) = quomod_big_int (big_int_of_int (-5)) (big_int_of_int 3) in - test 11 eq_big_int (quotient, big_int_of_int (-2)) & + test 11 eq_big_int (quotient, big_int_of_int (-2)) && test 12 eq_big_int (modulo, big_int_of_int 1);; let (quotient, modulo) = quomod_big_int (big_int_of_int 1) (big_int_of_int 2) in - test 13 eq_big_int (quotient, zero_big_int) & + test 13 eq_big_int (quotient, zero_big_int) && test 14 eq_big_int (modulo, big_int_of_int 1);; let (quotient, modulo) = quomod_big_int (big_int_of_int (-1)) (big_int_of_int 3) in - test 15 eq_big_int (quotient, minus_big_int unit_big_int) & + test 15 eq_big_int (quotient, minus_big_int unit_big_int) && test 16 eq_big_int (modulo, big_int_of_int 2);; failwith_test 17 diff --git a/otherlibs/num/test/test_nats.ml b/otherlibs/num/test/test_nats.ml index b215d1ba7..0985dcec6 100644 --- a/otherlibs/num/test/test_nats.ml +++ b/otherlibs/num/test/test_nats.ml @@ -44,14 +44,14 @@ testing_function "incr_nat";; let zero = nat_of_int 0 in let res = incr_nat zero 0 1 1 in test 1 - equal_nat (zero, nat_of_int 1) & + equal_nat (zero, nat_of_int 1) && test 2 eq (res,0);; let n = nat_of_int 1 in let res = incr_nat n 0 1 1 in test 3 - equal_nat (n, nat_of_int 2) & + equal_nat (n, nat_of_int 2) && test 4 eq (res,0);; @@ -61,23 +61,23 @@ testing_function "decr_nat";; let n = nat_of_int 1 in let res = decr_nat n 0 1 0 in test 1 - equal_nat (n, nat_of_int 0) & + equal_nat (n, nat_of_int 0) && test 2 eq (res,1);; let n = nat_of_int 2 in let res = decr_nat n 0 1 0 in test 3 - equal_nat (n, nat_of_int 1) & + equal_nat (n, nat_of_int 1) && test 4 eq (res,1);; testing_function "is_zero_nat";; let n = nat_of_int 1 in -test 1 eq (is_zero_nat n 0 1,false) & -test 2 eq (is_zero_nat (make_nat 1) 0 1, true) & -test 3 eq (is_zero_nat (make_nat 2) 0 2, true) & +test 1 eq (is_zero_nat n 0 1,false) && +test 2 eq (is_zero_nat (make_nat 1) 0 1, true) && +test 3 eq (is_zero_nat (make_nat 2) 0 2, true) && (let r = make_nat 2 in set_digit_nat r 1 1; test 4 eq (is_zero_nat r 0 1, true)) @@ -93,7 +93,7 @@ complement_nat n 0 (if sixtyfour then 2 else 4);; test 2 eq_string (string_of_nat n, "340282366920938463463374607431768211455");; -testing_function "string_of_nat & nat_of_string";; +testing_function "string_of_nat && nat_of_string";; for i = 1 to 20 do let s = String.make i '0' in diff --git a/otherlibs/num/test/test_ratios.ml b/otherlibs/num/test/test_ratios.ml index 692713c67..45fdce8b1 100644 --- a/otherlibs/num/test/test_ratios.ml +++ b/otherlibs/num/test/test_ratios.ml @@ -12,49 +12,49 @@ let infinite_failure = "infinite or undefined rational number";; testing_function "create_ratio";; let r = create_ratio (big_int_of_int 1) (big_int_of_int (-2)) in -test 1 eq_big_int (numerator_ratio r, big_int_of_int (-1)) & +test 1 eq_big_int (numerator_ratio r, big_int_of_int (-1)) && test 2 eq_big_int (denominator_ratio r, big_int_of_int 2);; let r = create_ratio (big_int_of_int 2) (big_int_of_int 3) in -test 3 eq_big_int (numerator_ratio r, big_int_of_int 2) & +test 3 eq_big_int (numerator_ratio r, big_int_of_int 2) && test 4 eq_big_int (denominator_ratio r, big_int_of_int 3);; set_normalize_ratio true;; let r = create_ratio (big_int_of_int 12) (big_int_of_int (-16)) in -test 5 eq_big_int (numerator_ratio r, big_int_of_int (-3)) & +test 5 eq_big_int (numerator_ratio r, big_int_of_int (-3)) && test 6 eq_big_int (denominator_ratio r, big_int_of_int 4);; set_normalize_ratio false;; let r = create_ratio (big_int_of_int 0) (big_int_of_int 0) in -test 7 eq_big_int (numerator_ratio r, big_int_of_int 0) & +test 7 eq_big_int (numerator_ratio r, big_int_of_int 0) && test 8 eq_big_int (denominator_ratio r, big_int_of_int 0);; testing_function "create_normalized_ratio";; let r = create_normalized_ratio (big_int_of_int 1) (big_int_of_int (-2)) in -test 1 eq_big_int (numerator_ratio r, big_int_of_int (-1)) & +test 1 eq_big_int (numerator_ratio r, big_int_of_int (-1)) && test 2 eq_big_int (denominator_ratio r, big_int_of_int 2);; let r = create_normalized_ratio (big_int_of_int 2) (big_int_of_int 3) in -test 3 eq_big_int (numerator_ratio r, big_int_of_int 2) & +test 3 eq_big_int (numerator_ratio r, big_int_of_int 2) && test 4 eq_big_int (denominator_ratio r, big_int_of_int 3);; set_normalize_ratio true;; let r = create_normalized_ratio (big_int_of_int 12) (big_int_of_int (-16)) in -test 5 eq_big_int (numerator_ratio r, big_int_of_int (-12)) & +test 5 eq_big_int (numerator_ratio r, big_int_of_int (-12)) && test 6 eq_big_int (denominator_ratio r, big_int_of_int 16);; set_normalize_ratio false;; let r = create_normalized_ratio (big_int_of_int 1) (big_int_of_int 0) in -test 7 eq_big_int (numerator_ratio r, big_int_of_int 1) & +test 7 eq_big_int (numerator_ratio r, big_int_of_int 1) && test 8 eq_big_int (denominator_ratio r, big_int_of_int 0);; let r = create_normalized_ratio (big_int_of_int 0) (big_int_of_int 0) in -test 9 eq_big_int (numerator_ratio r, big_int_of_int 0) & +test 9 eq_big_int (numerator_ratio r, big_int_of_int 0) && test 10 eq_big_int (denominator_ratio r, big_int_of_int 0);; testing_function "null_denominator";; @@ -89,12 +89,12 @@ testing_function "normalize_ratio";; let r = create_ratio (big_int_of_int 12) (big_int_of_int (-16)) in normalize_ratio r; -test 1 eq_big_int (numerator_ratio r, big_int_of_int (-3)) & +test 1 eq_big_int (numerator_ratio r, big_int_of_int (-3)) && test 2 eq_big_int (denominator_ratio r, big_int_of_int 4);; let r = create_ratio (big_int_of_int (-1)) zero_big_int in normalize_ratio r; -test 3 eq_big_int (numerator_ratio r, big_int_of_int (-1)) & +test 3 eq_big_int (numerator_ratio r, big_int_of_int (-1)) && test 4 eq_big_int (denominator_ratio r, zero_big_int);; testing_function "report_sign_ratio";; @@ -123,27 +123,27 @@ testing_function "add_ratio";; let r = add_ratio (create_ratio (big_int_of_int 1) (big_int_of_int 2)) (create_ratio (big_int_of_int 2) (big_int_of_int 3)) in -test 1 eq_big_int (numerator_ratio r, big_int_of_int 7) & +test 1 eq_big_int (numerator_ratio r, big_int_of_int 7) && test 2 eq_big_int (denominator_ratio r, big_int_of_int 6);; let r = add_ratio (create_ratio (big_int_of_int 2) (big_int_of_int 3)) (create_ratio (big_int_of_int 1) (big_int_of_int (-2))) in -test 3 eq_big_int (numerator_ratio r, big_int_of_int 1) & +test 3 eq_big_int (numerator_ratio r, big_int_of_int 1) && test 4 eq_big_int (denominator_ratio r, big_int_of_int 6);; let r = add_ratio (create_ratio (big_int_of_int 2) zero_big_int) (create_ratio (big_int_of_int 1) (big_int_of_int (-2))) in -test 5 eq_big_int (numerator_ratio r, big_int_of_int 4) & +test 5 eq_big_int (numerator_ratio r, big_int_of_int 4) && test 6 eq_big_int (denominator_ratio r, zero_big_int);; let r = add_ratio (create_ratio (big_int_of_int 2) (big_int_of_int 3)) (create_ratio (big_int_of_int 1) zero_big_int) in -test 7 eq_big_int (numerator_ratio r, big_int_of_int 3) & +test 7 eq_big_int (numerator_ratio r, big_int_of_int 3) && test 8 eq_big_int (denominator_ratio r, zero_big_int);; let r = add_ratio (create_ratio (big_int_of_int 2) zero_big_int) (create_ratio (big_int_of_int 1) zero_big_int) in -test 9 eq_big_int (numerator_ratio r, zero_big_int) & +test 9 eq_big_int (numerator_ratio r, zero_big_int) && test 10 eq_big_int (denominator_ratio r, zero_big_int);; let r = add_ratio (create_ratio (big_int_of_string "12724951") @@ -151,7 +151,7 @@ let r = add_ratio (create_ratio (big_int_of_string "12724951") (create_ratio (big_int_of_string "-1") (big_int_of_string "81749606400")) in test 11 eq_big_int (numerator_ratio r, - big_int_of_string "1040259735682744320") & + big_int_of_string "1040259735682744320") && test 12 eq_big_int (denominator_ratio r, big_int_of_string "2169804593037312000");; @@ -167,14 +167,14 @@ in test 1 eq_big_int (bi1, big_int_of_string "1040259735709286400") -& +&& test 2 eq_big_int (bi2, big_int_of_string "-26542080") -& test 3 +&& test 3 eq_big_int (mult_big_int (denominator_ratio r1) (denominator_ratio r2), big_int_of_string "2169804593037312000") -& test 4 +&& test 4 eq_big_int (add_big_int bi1 bi2, big_int_of_string "1040259735682744320") ;; @@ -183,66 +183,66 @@ testing_function "sub_ratio";; let r = sub_ratio (create_ratio (big_int_of_int 2) (big_int_of_int 3)) (create_ratio (big_int_of_int 1) (big_int_of_int 2)) in -test 1 eq_big_int (numerator_ratio r, big_int_of_int 1) & +test 1 eq_big_int (numerator_ratio r, big_int_of_int 1) && test 2 eq_big_int (denominator_ratio r, big_int_of_int 6);; let r = sub_ratio (create_ratio (big_int_of_int 2) zero_big_int) (create_ratio (big_int_of_int 1) (big_int_of_int (-2))) in -test 3 eq_big_int (numerator_ratio r, big_int_of_int 4) & +test 3 eq_big_int (numerator_ratio r, big_int_of_int 4) && test 4 eq_big_int (denominator_ratio r, zero_big_int);; let r = sub_ratio (create_ratio (big_int_of_int 2) (big_int_of_int 3)) (create_ratio (big_int_of_int 1) zero_big_int) in -test 5 eq_big_int (numerator_ratio r, big_int_of_int (-3)) & +test 5 eq_big_int (numerator_ratio r, big_int_of_int (-3)) && test 6 eq_big_int (denominator_ratio r, zero_big_int);; let r = sub_ratio (create_ratio (big_int_of_int 2) zero_big_int) (create_ratio (big_int_of_int 1) zero_big_int) in -test 7 eq_big_int (numerator_ratio r, zero_big_int) & +test 7 eq_big_int (numerator_ratio r, zero_big_int) && test 8 eq_big_int (denominator_ratio r, zero_big_int);; testing_function "mult_ratio";; let r = mult_ratio (create_ratio (big_int_of_int 2) (big_int_of_int 3)) (create_ratio (big_int_of_int 7) (big_int_of_int 5)) in -test 1 eq_big_int (numerator_ratio r, big_int_of_int 14) & +test 1 eq_big_int (numerator_ratio r, big_int_of_int 14) && test 2 eq_big_int (denominator_ratio r, big_int_of_int 15);; let r = mult_ratio (create_ratio (big_int_of_int 2) zero_big_int) (create_ratio (big_int_of_int 1) (big_int_of_int (-2))) in -test 3 eq_big_int (numerator_ratio r, big_int_of_int (-2)) & +test 3 eq_big_int (numerator_ratio r, big_int_of_int (-2)) && test 4 eq_big_int (denominator_ratio r, zero_big_int);; let r = mult_ratio (create_ratio (big_int_of_int 2) (big_int_of_int 3)) (create_ratio (big_int_of_int 1) zero_big_int) in -test 5 eq_big_int (numerator_ratio r, big_int_of_int 2) & +test 5 eq_big_int (numerator_ratio r, big_int_of_int 2) && test 6 eq_big_int (denominator_ratio r, zero_big_int);; let r = mult_ratio (create_ratio (big_int_of_int 2) zero_big_int) (create_ratio (big_int_of_int 1) zero_big_int) in -test 7 eq_big_int (numerator_ratio r, big_int_of_int 2) & +test 7 eq_big_int (numerator_ratio r, big_int_of_int 2) && test 8 eq_big_int (denominator_ratio r, zero_big_int);; testing_function "div_ratio";; let r = div_ratio (create_ratio (big_int_of_int 2) (big_int_of_int 3)) (create_ratio (big_int_of_int 5) (big_int_of_int 7)) in -test 1 eq_big_int (numerator_ratio r, big_int_of_int 14) & +test 1 eq_big_int (numerator_ratio r, big_int_of_int 14) && test 2 eq_big_int (denominator_ratio r, big_int_of_int 15);; let r = div_ratio (create_ratio (big_int_of_int 2) zero_big_int) (create_ratio (big_int_of_int 1) (big_int_of_int (-2))) in -test 3 eq_big_int (numerator_ratio r, big_int_of_int (-4)) & +test 3 eq_big_int (numerator_ratio r, big_int_of_int (-4)) && test 4 eq_big_int (denominator_ratio r, zero_big_int);; let r = div_ratio (create_ratio (big_int_of_int 2) (big_int_of_int 3)) (create_ratio (big_int_of_int 1) zero_big_int) in -test 5 eq_big_int (numerator_ratio r, zero_big_int) & +test 5 eq_big_int (numerator_ratio r, zero_big_int) && test 6 eq_big_int (denominator_ratio r, big_int_of_int 3);; let r = div_ratio (create_ratio (big_int_of_int 2) zero_big_int) (create_ratio (big_int_of_int 1) zero_big_int) in -test 7 eq_big_int (numerator_ratio r, zero_big_int) & +test 7 eq_big_int (numerator_ratio r, zero_big_int) && test 8 eq_big_int (denominator_ratio r, zero_big_int);; testing_function "integer_ratio";; @@ -774,58 +774,58 @@ testing_function "round_futur_last_digit";; let s = "+123456" in test 1 eq (round_futur_last_digit s 1 (pred (String.length s)), - false) & + false) && test 2 eq_string (s, "+123466");; let s = "123456" in -test 3 eq (round_futur_last_digit s 0 (String.length s), false) & +test 3 eq (round_futur_last_digit s 0 (String.length s), false) && test 4 eq_string (s, "123466");; let s = "-123456" in test 5 eq (round_futur_last_digit s 1 (pred (String.length s)), - false) & + false) && test 6 eq_string (s, "-123466");; let s = "+123496" in test 7 eq (round_futur_last_digit s 1 (pred (String.length s)), - false) & + false) && test 8 eq_string (s, "+123506");; let s = "123496" in -test 9 eq (round_futur_last_digit s 0 (String.length s), false) & +test 9 eq (round_futur_last_digit s 0 (String.length s), false) && test 10 eq_string (s, "123506");; let s = "-123496" in test 11 eq (round_futur_last_digit s 1 (pred (String.length s)), - false) & + false) && test 12 eq_string (s, "-123506");; let s = "+996" in test 13 eq (round_futur_last_digit s 1 (pred (String.length s)), - true) & + true) && test 14 eq_string (s, "+006");; let s = "996" in -test 15 eq (round_futur_last_digit s 0 (String.length s), true) & +test 15 eq (round_futur_last_digit s 0 (String.length s), true) && test 16 eq_string (s, "006");; let s = "-996" in test 17 eq (round_futur_last_digit s 1 (pred (String.length s)), - true) & + true) && test 18 eq_string (s, "-006");; let s = "+6666666" in test 19 eq (round_futur_last_digit s 1 (pred (String.length s)), - false) & + false) && test 20 eq_string (s, "+6666676") ;; let s = "6666666" in -test 21 eq (round_futur_last_digit s 0 (String.length s), false) & +test 21 eq (round_futur_last_digit s 0 (String.length s), false) && test 22 eq_string (s, "6666676") ;; let s = "-6666666" in test 23 eq (round_futur_last_digit s 1 (pred (String.length s)), - false) & + false) && test 24 eq_string (s, "-6666676") ;; testing_function "approx_ratio_fix";; diff --git a/otherlibs/systhreads/event.ml b/otherlibs/systhreads/event.ml index c81886933..44af5760d 100644 --- a/otherlibs/systhreads/event.ml +++ b/otherlibs/systhreads/event.ml @@ -79,7 +79,7 @@ let basic_sync abort_env genev = let rec poll_events i = if i >= Array.length bev then false - else bev.(i).poll() or poll_events (i+1) in + else bev.(i).poll() || poll_events (i+1) in Mutex.lock masterlock; if not (poll_events 0) then begin (* Suspend on all events *) @@ -153,7 +153,7 @@ let basic_poll abort_env genev = let rec poll_events i = if i >= Array.length bev then false - else bev.(i).poll() or poll_events (i+1) in + else bev.(i).poll() || poll_events (i+1) in Mutex.lock masterlock; let ready = poll_events 0 in if ready then begin diff --git a/otherlibs/threads/Tests/sorts.ml b/otherlibs/threads/Tests/sorts.ml index ad6dea18c..abc8dc1b5 100644 --- a/otherlibs/threads/Tests/sorts.ml +++ b/otherlibs/threads/Tests/sorts.ml @@ -137,7 +137,7 @@ let insertion_sort gc = for i = 1 to Array.length gc.array - 1 do let val_i = gc.array.(i) in let j = ref (i - 1) in - while !j >= 0 & val_i < gc.array.(!j) do + while !j >= 0 && val_i < gc.array.(!j) do assign gc (!j + 1) gc.array.(!j); decr j done; @@ -164,8 +164,8 @@ let quick_sort gc = let j = ref hi in let pivot = gc.array.(hi) in while !i < !j do - while !i < hi & gc.array.(!i) <= pivot do incr i done; - while !j > lo & gc.array.(!j) >= pivot do decr j done; + while !i < hi && gc.array.(!i) <= pivot do incr i done; + while !j > lo && gc.array.(!j) >= pivot do decr j done; if !i < !j then exchange gc !i !j done; exchange gc !i hi; diff --git a/otherlibs/threads/event.ml b/otherlibs/threads/event.ml index c81886933..44af5760d 100644 --- a/otherlibs/threads/event.ml +++ b/otherlibs/threads/event.ml @@ -79,7 +79,7 @@ let basic_sync abort_env genev = let rec poll_events i = if i >= Array.length bev then false - else bev.(i).poll() or poll_events (i+1) in + else bev.(i).poll() || poll_events (i+1) in Mutex.lock masterlock; if not (poll_events 0) then begin (* Suspend on all events *) @@ -153,7 +153,7 @@ let basic_poll abort_env genev = let rec poll_events i = if i >= Array.length bev then false - else bev.(i).poll() or poll_events (i+1) in + else bev.(i).poll() || poll_events (i+1) in Mutex.lock masterlock; let ready = poll_events 0 in if ready then begin diff --git a/otherlibs/threads/marshal.ml b/otherlibs/threads/marshal.ml index 1d4703a0c..a0fe8d2bf 100644 --- a/otherlibs/threads/marshal.ml +++ b/otherlibs/threads/marshal.ml @@ -27,7 +27,7 @@ external to_buffer_unsafe: = "output_value_to_buffer" let to_buffer buff ofs len v flags = - if ofs < 0 or len < 0 or ofs + len > String.length buff + if ofs < 0 || len < 0 || ofs + len > String.length buff then invalid_arg "Marshal.to_buffer: substring out of bounds" else to_buffer_unsafe buff ofs len v flags diff --git a/otherlibs/threads/pervasives.ml b/otherlibs/threads/pervasives.ml index bde248a4b..8536b4680 100644 --- a/otherlibs/threads/pervasives.ml +++ b/otherlibs/threads/pervasives.ml @@ -131,7 +131,7 @@ let (^) s1 s2 = external int_of_char : char -> int = "%identity" external unsafe_char_of_int : int -> char = "%identity" let char_of_int n = - if n < 0 or n > 255 then invalid_arg "char_of_int" else unsafe_char_of_int n + if n < 0 || n > 255 then invalid_arg "char_of_int" else unsafe_char_of_int n (* Unit operations *) diff --git a/otherlibs/unix/unix.ml b/otherlibs/unix/unix.ml index 139afdff8..365d13185 100644 --- a/otherlibs/unix/unix.ml +++ b/otherlibs/unix/unix.ml @@ -157,11 +157,11 @@ external unsafe_read : file_descr -> string -> int -> int -> int = "unix_read" external unsafe_write : file_descr -> string -> int -> int -> int = "unix_write" let read fd buf ofs len = - if len < 0 or ofs + len > String.length buf + if len < 0 || ofs + len > String.length buf then invalid_arg "Unix.read" else unsafe_read fd buf ofs len let write fd buf ofs len = - if len < 0 or ofs + len > String.length buf + if len < 0 || ofs + len > String.length buf then invalid_arg "Unix.write" else unsafe_write fd buf ofs len @@ -411,19 +411,19 @@ external unsafe_sendto : = "unix_sendto" "unix_sendto_native" let recv fd buf ofs len flags = - if len < 0 or ofs + len > String.length buf + if len < 0 || ofs + len > String.length buf then invalid_arg "Unix.recv" else unsafe_recv fd buf ofs len flags let recvfrom fd buf ofs len flags = - if len < 0 or ofs + len > String.length buf + if len < 0 || ofs + len > String.length buf then invalid_arg "Unix.recvfrom" else unsafe_recvfrom fd buf ofs len flags let send fd buf ofs len flags = - if len < 0 or ofs + len > String.length buf + if len < 0 || ofs + len > String.length buf then invalid_arg "Unix.send" else unsafe_send fd buf ofs len flags let sendto fd buf ofs len flags addr = - if len < 0 or ofs + len > String.length buf + if len < 0 || ofs + len > String.length buf then invalid_arg "Unix.sendto" else unsafe_sendto fd buf ofs len flags addr diff --git a/otherlibs/win32unix/unix.ml b/otherlibs/win32unix/unix.ml index 4bacb36cb..25cc960ec 100644 --- a/otherlibs/win32unix/unix.ml +++ b/otherlibs/win32unix/unix.ml @@ -178,11 +178,11 @@ external unsafe_write : file_descr -> string -> int -> int -> int = "unix_write" let read fd buf ofs len = - if len < 0 or ofs + len > String.length buf + if len < 0 || ofs + len > String.length buf then invalid_arg "Unix.read" else unsafe_read fd buf ofs len let write fd buf ofs len = - if len < 0 or ofs + len > String.length buf + if len < 0 || ofs + len > String.length buf then invalid_arg "Unix.write" else unsafe_write fd buf ofs len @@ -502,19 +502,19 @@ external unsafe_sendto : = "unix_sendto" "unix_sendto_native" let recv fd buf ofs len flags = - if len < 0 or ofs + len > String.length buf + if len < 0 || ofs + len > String.length buf then invalid_arg "Unix.recv" else unsafe_recv fd buf ofs len flags let recvfrom fd buf ofs len flags = - if len < 0 or ofs + len > String.length buf + if len < 0 || ofs + len > String.length buf then invalid_arg "Unix.recvfrom" else unsafe_recvfrom fd buf ofs len flags let send fd buf ofs len flags = - if len < 0 or ofs + len > String.length buf + if len < 0 || ofs + len > String.length buf then invalid_arg "Unix.send" else unsafe_send fd buf ofs len flags let sendto fd buf ofs len flags addr = - if len < 0 or ofs + len > String.length buf + if len < 0 || ofs + len > String.length buf then invalid_arg "Unix.sendto" else unsafe_sendto fd buf ofs len flags addr diff --git a/parsing/parse.ml b/parsing/parse.ml index eaa26e56a..56e32c4aa 100644 --- a/parsing/parse.ml +++ b/parsing/parse.ml @@ -32,7 +32,7 @@ let rec skip_phrase lexbuf = let maybe_skip_phrase lexbuf = if Parsing.is_current_lookahead Parser.SEMISEMI - or Parsing.is_current_lookahead Parser.EOF + || Parsing.is_current_lookahead Parser.EOF then () else skip_phrase lexbuf diff --git a/stdlib/arg.ml b/stdlib/arg.ml index 48c3343bf..3e7133e20 100644 --- a/stdlib/arg.ml +++ b/stdlib/arg.ml @@ -70,7 +70,7 @@ let parse speclist anonfun errmsg = incr current; while !current < l do let s = Sys.argv.(!current) in - if String.length s >= 1 & String.get s 0 = '-' then begin + if String.length s >= 1 && String.get s 0 = '-' then begin let action = try assoc3 s speclist with Not_found -> stop (Unknown s) diff --git a/stdlib/array.ml b/stdlib/array.ml index 58e3f7ed9..38d99c066 100644 --- a/stdlib/array.ml +++ b/stdlib/array.ml @@ -84,7 +84,7 @@ let concat al = in find_init al let sub a ofs len = - if ofs < 0 or len < 0 or ofs + len > length a then invalid_arg "Array.sub" + if ofs < 0 || len < 0 || ofs + len > length a then invalid_arg "Array.sub" else if len = 0 then [||] else begin let r = create len (unsafe_get a ofs) in @@ -93,13 +93,13 @@ let sub a ofs len = end let fill a ofs len v = - if ofs < 0 or len < 0 or ofs + len > length a + if ofs < 0 || len < 0 || ofs + len > length a then invalid_arg "Array.fill" else for i = ofs to ofs + len - 1 do unsafe_set a i v done let blit a1 ofs1 a2 ofs2 len = - if len < 0 or ofs1 < 0 or ofs1 + len > length a1 - or ofs2 < 0 or ofs2 + len > length a2 + if len < 0 || ofs1 < 0 || ofs1 + len > length a1 + || ofs2 < 0 || ofs2 + len > length a2 then invalid_arg "Array.blit" else if ofs1 < ofs2 then (* Top-down copy *) diff --git a/stdlib/filename.ml b/stdlib/filename.ml index 1547d4ace..36c1e687e 100644 --- a/stdlib/filename.ml +++ b/stdlib/filename.ml @@ -17,7 +17,7 @@ module Unix = struct let parent_dir_name = ".." let concat dirname filename = let l = String.length dirname in - if l = 0 or dirname.[l-1] = '/' + if l = 0 || dirname.[l-1] = '/' then dirname ^ filename else dirname ^ "/" ^ filename let is_relative n = String.length n < 1 || n.[0] <> '/';; @@ -51,7 +51,7 @@ module Win32 = struct let parent_dir_name = ".." let concat dirname filename = let l = String.length dirname in - if l = 0 or (let c = dirname.[l-1] in c = '/' or c = '\\' or c = ':') + if l = 0 || (let c = dirname.[l-1] in c = '/' || c = '\\' || c = ':') then dirname ^ filename else dirname ^ "\\" ^ filename let is_relative n = @@ -101,7 +101,7 @@ module MacOS = struct let parent_dir_name = ".." let concat dirname filename = let l = String.length dirname in - if l = 0 or dirname.[l-1] = ':' + if l = 0 || dirname.[l-1] = ':' then dirname ^ filename else dirname ^ ":" ^ filename let contains_colon n = String.contains n ':' diff --git a/stdlib/format.ml b/stdlib/format.ml index a512b1db1..0d3563f4f 100644 --- a/stdlib/format.ml +++ b/stdlib/format.ml @@ -780,14 +780,13 @@ let fprintf_out str out ppf format = invalid_arg ("fprintf: bad %s format, " ^ format) in if p > 0 && String.length s < p then begin pp_print_as_string ppf - (String.make (p - String.length s) ' '); - pp_print_as_string ppf s - end else if p < 0 && String.length s < -p then begin + (String.make (p - String.length s) ' '); + pp_print_as_string ppf s end else + if p < 0 && String.length s < -p then begin pp_print_as_string ppf s; pp_print_as_string ppf - (String.make (-p - String.length s) ' ') - end else - pp_print_as_string ppf s + (String.make (-p - String.length s) ' ') end + else pp_print_as_string ppf s end; doprn (succ j)) | 'c' -> @@ -807,25 +806,25 @@ let fprintf_out str out ppf format = | 'b' -> Obj.magic(fun b -> pp_print_as_string ppf (string_of_bool b); - doprn(succ j)) + doprn (succ j)) | 'a' -> if str then Obj.magic(fun printer arg -> pp_print_as_string ppf (printer () arg); - doprn(succ j)) + doprn (succ j)) else Obj.magic(fun printer arg -> printer ppf arg; - doprn(succ j)) + doprn (succ j)) | 't' -> if str then Obj.magic(fun printer -> pp_print_as_string ppf (printer ()); - doprn(succ j)) + doprn (succ j)) else Obj.magic(fun printer -> printer ppf; - doprn(succ j)) + doprn (succ j)) | c -> format_invalid_arg "fprintf: unknown format " c end @@ -859,13 +858,13 @@ let fprintf_out str out ppf format = let j = succ j in if j >= limit then Pp_hbox, j else begin match format.[j] with - | 'o' -> + | 'o' -> let j = succ j in if j >= limit then invalid_arg ("fprintf: bad box format " ^ format) else begin match format.[j] with | 'v' -> Pp_hovbox, succ j - | c -> format_invalid_arg "fprintf: bad name " c end + | c -> format_invalid_arg "fprintf: bad box name " c end | 'v' -> Pp_hvbox, succ j | c -> Pp_hbox, j end @@ -885,17 +884,17 @@ let fprintf_out str out ppf format = then invalid_arg "fprintf: bad break format" format else pp_print_break ppf nspaces offset; j - | c -> pp_print_space ppf (); i + | c -> pp_print_space ppf (); i and do_pp_open ppf i = if i >= limit then begin pp_open_box_gen ppf 0 Pp_box; i end else match format.[i] with | '<' -> - let k, j = get_box_kind (succ i) in + let kind, j = get_box_kind (succ i) in let size, j = get_int "fprintf: bad box format " format j in - pp_open_box_gen ppf size k; + pp_open_box_gen ppf size kind; j - | c -> pp_open_box_gen ppf 0 Pp_box; i + | c -> pp_open_box_gen ppf 0 Pp_box; i in doprn 0;; diff --git a/stdlib/format.mli b/stdlib/format.mli index 964c879c1..66eccf97f 100644 --- a/stdlib/format.mli +++ b/stdlib/format.mli @@ -33,7 +33,8 @@ For instance, the sequence [open_box (); print_string "x ="; print_space (); print_int 1; close_box ()] that prints [x = 1] within a pretty-printing box, can be - abbreviated as [printf "@\[%s@ %i@\]" "x =" 1]. *) + abbreviated as [printf "@\[%s@ %i@\]" "x =" 1], or even shorter + [printf "@\[x =@ %i@\]" 1]. *) (* Rule of thumb for casual users of this library: - use simple boxes (as obtained by [open_box 0]); @@ -61,7 +62,7 @@ (*** Boxes *) val open_box : int -> unit;; (* [open_box d] opens a new pretty-printing box - with offset [d]. + with offset [d]. This box is the general purpose pretty-printing box. Material in this box is displayed ``horizontal or vertical'': break hints inside the box may lead to a new line, if there @@ -107,7 +108,8 @@ val print_break : int -> int -> unit;; (* Insert a break hint in a pretty-printing box. [print_break nspaces offset] indicates that the line may be split (a newline character is printed) at this point, - if the contents of the current box does not fit on one line. + if the contents of the current box does not fit on the + current line. If the line is split at that point, [offset] is added to the current indentation. If the line is not split, [nspaces] spaces are printed. *) @@ -169,14 +171,14 @@ val open_hbox : unit -> unit;; (new lines may still occur inside boxes nested deeper). *) val open_vbox : int -> unit;; (* [open_vbox d] opens a new pretty-printing box - with offset [d]. + with offset [d]. This box is ``vertical'': every break hint inside this box leads to a new line. When a new line is printed in the box, [d] is added to the current indentation. *) val open_hvbox : int -> unit;; (* [open_hvbox d] opens a new pretty-printing box - with offset [d]. + with offset [d]. This box is ``horizontal-vertical'': it behaves as an ``horizontal'' box if it fits on a single line, otherwise it behaves as a ``vertical'' box. @@ -184,7 +186,7 @@ val open_hvbox : int -> unit;; current indentation. *) val open_hovbox : int -> unit;; (* [open_hovbox d] opens a new pretty-printing box - with offset [d]. + with offset [d]. This box is ``horizontal or vertical'': break hints inside this box may lead to a new line, if there is no more room on the line to print the remainder of the box. @@ -223,6 +225,7 @@ val get_ellipsis_text : unit -> string;; val set_formatter_out_channel : out_channel -> unit;; (* Redirect the pretty-printer output to the given channel. *) +(*** Changing the meaning of printing material *) val set_formatter_output_functions : out:(buf:string -> pos:int -> len:int -> unit) -> flush:(unit -> unit) -> unit;; @@ -238,7 +241,8 @@ val get_formatter_output_functions : unit -> (buf:string -> pos:int -> len:int -> unit) * (unit -> unit);; (* Return the current output functions of the pretty-printer. *) -(*** Changing the meaning of indentation and line breaking *) +(*** Changing the meaning of pretty printing (indentation, line breaking, + and printing material) *) val set_all_formatter_output_functions : out:(buf:string -> pos:int -> len:int -> unit) -> flush:(unit -> unit) -> diff --git a/stdlib/marshal.ml b/stdlib/marshal.ml index e18ee2862..cf49605d0 100644 --- a/stdlib/marshal.ml +++ b/stdlib/marshal.ml @@ -25,7 +25,7 @@ external to_buffer_unsafe: = "output_value_to_buffer" let to_buffer buff ofs len v flags = - if ofs < 0 or len < 0 or ofs + len > String.length buff + if ofs < 0 || len < 0 || ofs + len > String.length buff then invalid_arg "Marshal.to_buffer: substring out of bounds" else to_buffer_unsafe buff ofs len v flags diff --git a/stdlib/oo.ml b/stdlib/oo.ml index 1ea69e90d..78abbbc3f 100644 --- a/stdlib/oo.ml +++ b/stdlib/oo.ml @@ -161,7 +161,7 @@ let rec except e = let merge_buckets b1 b2 = for i = 0 to bucket_size - 1 do if - (b2.(i) != dummy_item) & (b1.(i) != dummy_item) & (b2.(i) != b1.(i)) + (b2.(i) != dummy_item) && (b1.(i) != dummy_item) && (b2.(i) != b1.(i)) then raise Failed done; @@ -173,7 +173,7 @@ let merge_buckets b1 b2 = b1 let rec choose bucket i = - if (i > 0) & (!small_bucket_count > 0) then begin + if (i > 0) && (!small_bucket_count > 0) then begin let n = Random.int !small_bucket_count in if not (small_bucket !small_buckets.(n)) then begin remove_bucket n; choose bucket i @@ -189,7 +189,7 @@ let rec choose bucket i = let compact b = if - (b != empty_bucket) & (bucket_version b = !version) & (small_bucket b) + (b != empty_bucket) && (bucket_version b = !version) && (small_bucket b) then choose b params.retry_count else diff --git a/stdlib/set.ml b/stdlib/set.ml index 4ef4ed54f..c2e499ab1 100644 --- a/stdlib/set.ml +++ b/stdlib/set.ml @@ -113,7 +113,7 @@ module Make(Ord: OrderedType) = Empty -> invalid_arg "Set.join" | Node(l', x', r', _) as t' -> let d = height l' - height r' in - if d < -2 or d > 2 then join l' x' r' else t' + if d < -2 || d > 2 then join l' x' r' else t' (* Merge two trees l and r into one. All elements of l must precede the elements of r. diff --git a/stdlib/string.ml b/stdlib/string.ml index 5e4f36a21..21543abfb 100644 --- a/stdlib/string.ml +++ b/stdlib/string.ml @@ -37,7 +37,7 @@ let copy s = r let sub s ofs len = - if ofs < 0 or len < 0 or ofs + len > length s + if ofs < 0 || len < 0 || ofs + len > length s then invalid_arg "String.sub" else begin let r = create len in @@ -46,13 +46,13 @@ let sub s ofs len = end let fill s ofs len c = - if ofs < 0 or len < 0 or ofs + len > length s + if ofs < 0 || len < 0 || ofs + len > length s then invalid_arg "String.fill" else unsafe_fill s ofs len c let blit s1 ofs1 s2 ofs2 len = - if len < 0 or ofs1 < 0 or ofs1 + len > length s1 - or ofs2 < 0 or ofs2 + len > length s2 + if len < 0 || ofs1 < 0 || ofs1 + len > length s1 + || ofs2 < 0 || ofs2 + len > length s2 then invalid_arg "String.blit" else unsafe_blit s1 ofs1 s2 ofs2 len diff --git a/test/Lex/lexgen.ml b/test/Lex/lexgen.ml index 006664e18..42ff47c57 100644 --- a/test/Lex/lexgen.ml +++ b/test/Lex/lexgen.ml @@ -138,8 +138,8 @@ let rec nullable = function Empty -> true | Chars _ -> false | Action _ -> false - | Seq(r1,r2) -> nullable r1 & nullable r2 - | Alt(r1,r2) -> nullable r1 or nullable r2 + | Seq(r1,r2) -> nullable r1 && nullable r2 + | Alt(r1,r2) -> nullable r1 || nullable r2 | Star r -> true diff --git a/test/Lex/output.ml b/test/Lex/output.ml index 1c3b1dc7b..97d757771 100644 --- a/test/Lex/output.ml +++ b/test/Lex/output.ml @@ -80,7 +80,7 @@ let output_char_lit oc = function | '\\' -> output_string oc "\\\\" | '\n' -> output_string oc "\\n" | '\t' -> output_string oc "\\t" - | c -> if Char.code c >= 32 & Char.code c < 128 then + | c -> if Char.code c >= 32 && Char.code c < 128 then output_char oc c else begin let n = Char.code c in diff --git a/test/Moretest/intext.ml b/test/Moretest/intext.ml index fff66da4e..966200429 100644 --- a/test/Moretest/intext.ml +++ b/test/Moretest/intext.ml @@ -111,7 +111,7 @@ let test_in filename = | _ -> false); test 21 (match input_value ic with G((G((D "sharing" as t1), t2) as t3), G(t4, t5)) -> - t1 == t2 & t3 == t5 & t4 == t1 + t1 == t2 && t3 == t5 && t4 == t1 | _ -> false); test 22 (input_value ic = [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|]); let rec check_big n t = @@ -211,7 +211,7 @@ let test_string () = let s = Marshal.to_string z [] in test 121 (match Marshal.from_string s 0 with G((G((D "sharing" as t1), t2) as t3), G(t4, t5)) -> - t1 == t2 & t3 == t5 & t4 == t1 + t1 == t2 && t3 == t5 && t4 == t1 | _ -> false); let s = Marshal.to_string [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|] [] in test 122 (Marshal.from_string s 0 = [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|]); @@ -294,7 +294,7 @@ let test_buffer () = Marshal.to_buffer s 0 512 z []; test 221 (match Marshal.from_string s 0 with G((G((D "sharing" as t1), t2) as t3), G(t4, t5)) -> - t1 == t2 & t3 == t5 & t4 == t1 + t1 == t2 && t3 == t5 && t4 == t1 | _ -> false); Marshal.to_buffer s 0 512 [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|] []; test 222 (Marshal.from_string s 0 = [|1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16|]); diff --git a/test/bdd.ml b/test/bdd.ml index cdcf2bcb4..d639746f4 100644 --- a/test/bdd.ml +++ b/test/bdd.ml @@ -93,8 +93,9 @@ let mkNode low v high = insert (getId low) (getId high) v ind bucket n; n | n :: ns -> match n with - | Node(l,v',id,h) -> if v=v' & idl=getId l & idh=getId h - then n else lookup ns + | Node(l,v',id,h) -> + if v = v' && idl = getId l && idh = getId h + then n else lookup ns | _ -> assert false in lookup bucket @@ -140,7 +141,7 @@ match n1 with Node(l2, v2, i2, r2) -> let h = hash i1 i2 in - if i1=andslot1.(h) & i2=andslot2.(h) then andslot3.(h) + if i1=andslot1.(h) && i2=andslot2.(h) then andslot3.(h) else let f = match cmpVar v1 v2 with EQUAL -> mkNode (and2 l1 l2) v1 (and2 r1 r2) | LESS -> mkNode (and2 l1 n2) v1 (and2 r1 n2) @@ -163,7 +164,7 @@ match n1 with Node(l2, v2, i2, r2) -> let h = hash i1 i2 in - if i1=andslot1.(h) & i2=andslot2.(h) then andslot3.(h) + if i1=andslot1.(h) && i2=andslot2.(h) then andslot3.(h) else let f = match cmpVar v1 v2 with EQUAL -> mkNode (xor l1 l2) v1 (xor r1 r2) | LESS -> mkNode (xor l1 n2) v1 (xor r1 n2) diff --git a/test/boyer.ml b/test/boyer.ml index 09e25696b..3a55e03c1 100644 --- a/test/boyer.ml +++ b/test/boyer.ml @@ -788,14 +788,14 @@ add (CProp let truep x lst = match x with Prop(head, _) -> - head.name = "true" or List.mem x lst + head.name = "true" || List.mem x lst | _ -> List.mem x lst and falsep x lst = match x with Prop(head, _) -> - head.name = "false" or List.mem x lst + head.name = "false" || List.mem x lst | _ -> List.mem x lst @@ -814,7 +814,7 @@ let rec tautologyp x true_lst false_lst = tautologyp yes true_lst false_lst else if falsep test false_lst then tautologyp no true_lst false_lst - else tautologyp yes (test::true_lst) false_lst & + else tautologyp yes (test::true_lst) false_lst && tautologyp no true_lst (test::false_lst) else false diff --git a/test/quicksort.ml b/test/quicksort.ml index ea79bcebe..9ec223823 100644 --- a/test/quicksort.ml +++ b/test/quicksort.ml @@ -20,8 +20,8 @@ let rec qsort lo hi (a : int array) = let j = ref hi in let pivot = a.(hi) in while !i < !j do - while !i < hi & a.(!i) <= pivot do incr i done; - while !j > lo & a.(!j) >= pivot do decr j done; + while !i < hi && a.(!i) <= pivot do incr i done; + while !j > lo && a.(!j) >= pivot do decr j done; if !i < !j then begin let temp = a.(!i) in a.(!i) <- a.(!j); a.(!j) <- temp end @@ -42,8 +42,8 @@ let rec qsort2 lo hi (a : int array) = let j = ref hi in let pivot = a.(hi) in while !i < !j do - while !i < hi & cmp a.(!i) pivot <= 0 do incr i done; - while !j > lo & cmp a.(!j) pivot >= 0 do decr j done; + while !i < hi && cmp a.(!i) pivot <= 0 do incr i done; + while !j > lo && cmp a.(!j) pivot >= 0 do decr j done; if !i < !j then begin let temp = a.(!i) in a.(!i) <- a.(!j); a.(!j) <- temp end diff --git a/tools/profiling.ml b/tools/profiling.ml index 55c26592c..80296d669 100644 --- a/tools/profiling.ml +++ b/tools/profiling.ml @@ -29,8 +29,8 @@ let dump_counters () = List.iter2 (fun (curname, (curmodes,curcount)) (prevname, (prevmodes,prevcount)) -> if curname <> prevname - or curmodes <> prevmodes - or Array.length curcount <> Array.length prevcount + || curmodes <> prevmodes + || Array.length curcount <> Array.length prevcount then raise Bad_profile) !counters prevl; List.iter2 diff --git a/toplevel/genprintval.ml b/toplevel/genprintval.ml index e6deee198..e291ac3c5 100644 --- a/toplevel/genprintval.ml +++ b/toplevel/genprintval.ml @@ -178,7 +178,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type value = O.t) = struct let rec print_val prio depth obj ppf ty = decr printer_steps; - if !printer_steps < 0 or depth < 0 then raise Ellipsis; + if !printer_steps < 0 || depth < 0 then raise Ellipsis; try find_printer env ty ppf obj with Not_found -> diff --git a/toplevel/topmain.ml b/toplevel/topmain.ml index 85bd04fb7..192435b71 100644 --- a/toplevel/topmain.ml +++ b/toplevel/topmain.ml @@ -26,7 +26,6 @@ let main () = include_dirs := dir :: !include_dirs), "<dir> Add <dir> to the list of include directories"; "-labels", Arg.Clear classic, " Use commuting label mode"; - "-modern", Arg.Clear classic, " (deprecated) same as -labels"; "-noassert", Arg.Set noassert, " Do not compile assertion checks"; "-rectypes", Arg.Set recursive_types, " Allow arbitrary recursive types"; "-unsafe", Arg.Set fast, " No bound checking on array and string access"; diff --git a/typing/ctype.ml b/typing/ctype.ml index bece56f68..b9451d385 100644 --- a/typing/ctype.ml +++ b/typing/ctype.ml @@ -1182,7 +1182,7 @@ and unify3 env t1 t1' t2 t2' = t2'.desc <- Tlink t1 end | (Tarrow (l1, t1, u1), Tarrow (l2, t2, u2)) when l1 = l2 - or !Clflags.classic && not (is_optional l1 or is_optional l2) -> + || !Clflags.classic && not (is_optional l1 || is_optional l2) -> unify env t1 t2; unify env u1 u2 | (Ttuple tl1, Ttuple tl2) -> unify_list env tl1 tl2 @@ -1353,7 +1353,7 @@ and unify_row env row1 row2 = List.iter (unify env t1) tl; [t1] in - let f = Reither(c1 or c2, tl, ref None) in + let f = Reither(c1 || c2, tl, ref None) in e1 := Some f; e2 := Some f | Reither(false, tl, e1), Rpresent(Some t2) -> e1 := Some f2; @@ -1532,7 +1532,7 @@ let rec moregen inst_nongen type_pairs env t1 t2 = moregen_occur env t1'.level t2; t1'.desc <- Tlink t2 | (Tarrow (l1, t1, u1), Tarrow (l2, t2, u2)) when l1 = l2 - or !Clflags.classic && not (is_optional l1 or is_optional l2) -> + || !Clflags.classic && not (is_optional l1 || is_optional l2) -> moregen inst_nongen type_pairs env t1 t2; moregen inst_nongen type_pairs env u1 u2 | (Ttuple tl1, Ttuple tl2) -> @@ -1702,7 +1702,7 @@ let rec eqtype rename type_pairs subst env t1 t2 = subst := (t1', t2') :: !subst end | (Tarrow (l1, t1, u1), Tarrow (l2, t2, u2)) when l1 = l2 - or !Clflags.classic && not (is_optional l1 or is_optional l2) -> + || !Clflags.classic && not (is_optional l1 || is_optional l2) -> eqtype rename type_pairs subst env t1 t2; eqtype rename type_pairs subst env u1 u2; | (Ttuple tl1, Ttuple tl2) -> @@ -2092,7 +2092,7 @@ let rec build_subtype env visited posi t = (* let (t1', c1) = build_subtype env visited (not posi) t1 in *) let (t1', c1) = (t1, false) in let (t2', c2) = build_subtype env visited posi t2 in - if c1 or c2 then (newty (Tarrow(l, t1', t2')), true) + if c1 || c2 then (newty (Tarrow(l, t1', t2')), true) else (t, false) | Ttuple tlist -> if List.memq t visited then (t, false) else @@ -2264,7 +2264,7 @@ let rec subtype_rec env trace t1 t2 cstrs = (Tvar, _) | (_, Tvar) -> (trace, t1, t2)::cstrs | (Tarrow(l1, t1, u1), Tarrow(l2, t2, u2)) when l1 = l2 - or !Clflags.classic && not (is_optional l1 or is_optional l2) -> + || !Clflags.classic && not (is_optional l1 || is_optional l2) -> let cstrs = subtype_rec env ((t2, t1)::trace) t2 t1 cstrs in subtype_rec env ((u1, u2)::trace) u1 u2 cstrs | (Ttuple tl1, Ttuple tl2) -> @@ -2289,7 +2289,7 @@ let rec subtype_rec env trace t1 t2 cstrs = else cstrs) cstrs decl.type_variance (List.combine tl1 tl2) | (Tobject (f1, _), Tobject (f2, _)) - when opened_object f1 & opened_object f2 -> + when opened_object f1 && opened_object f2 -> (* Same row variable implies same object. *) (trace, t1, t2)::cstrs | (Tobject (f1, _), Tobject (f2, _)) -> diff --git a/typing/ident.ml b/typing/ident.ml index ce84f4dbf..afa589bad 100644 --- a/typing/ident.ml +++ b/typing/ident.ml @@ -43,7 +43,7 @@ let same i1 i2 = i1 = i2 (* Possibly more efficient version (with a real compiler, at least): if i1.stamp <> 0 then i1.stamp = i2.stamp - else i2.stamp = 0 & i1.name = i2.name *) + else i2.stamp = 0 && i1.name = i2.name *) let binding_time i = i.stamp diff --git a/typing/includemod.ml b/typing/includemod.ml index c0c89e751..72aea86dd 100644 --- a/typing/includemod.ml +++ b/typing/includemod.ml @@ -118,7 +118,7 @@ let simplify_structure_coercion cc = try List.iter (fun (n, c) -> - if n <> !pos or c <> Tcoerce_none then raise Exit; + if n <> !pos || c <> Tcoerce_none then raise Exit; incr pos) cc; Tcoerce_none diff --git a/typing/parmatch.ml b/typing/parmatch.ml index f53b27e64..d868440d5 100644 --- a/typing/parmatch.ml +++ b/typing/parmatch.ml @@ -685,7 +685,7 @@ let rec le_pat p q = | Tpat_construct(c1,ps), Tpat_construct(c2,qs) -> c1.cstr_tag = c2.cstr_tag && le_pats ps qs | Tpat_variant(l1,Some p1,_), Tpat_variant(l2,Some p2,_) -> - l1 = l2 & le_pat p1 p2 + l1 = l2 && le_pat p1 p2 | Tpat_variant(l1,None,_), Tpat_variant(l2,None,_) -> l1 = l2 | Tpat_tuple(ps), Tpat_tuple(qs) -> le_pats ps qs | Tpat_record l1, Tpat_record l2 -> diff --git a/typing/path.ml b/typing/path.ml index b40b6131f..efe4a2617 100644 --- a/typing/path.ml +++ b/typing/path.ml @@ -22,14 +22,15 @@ let nopos = -1 let rec same p1 p2 = match (p1, p2) with (Pident id1, Pident id2) -> Ident.same id1 id2 - | (Pdot(p1, s1, pos1), Pdot(p2, s2, pos2)) -> s1 = s2 & same p1 p2 - | (Papply(fun1, arg1), Papply(fun2, arg2)) -> same fun1 fun2 & same arg1 arg2 + | (Pdot(p1, s1, pos1), Pdot(p2, s2, pos2)) -> s1 = s2 && same p1 p2 + | (Papply(fun1, arg1), Papply(fun2, arg2)) -> + same fun1 fun2 && same arg1 arg2 | (_, _) -> false let rec isfree id = function Pident id' -> Ident.same id id' | Pdot(p, s, pos) -> isfree id p - | Papply(p1, p2) -> isfree id p1 or isfree id p2 + | Papply(p1, p2) -> isfree id p1 || isfree id p2 let rec binding_time = function Pident id -> Ident.binding_time id diff --git a/utils/ccomp.ml b/utils/ccomp.ml index 7147baf4f..9cbf9501c 100644 --- a/utils/ccomp.ml +++ b/utils/ccomp.ml @@ -61,7 +61,7 @@ let create_archive archive file_list = let r1 = command(Printf.sprintf "ar rc %s %s" archive (String.concat " " file_list)) in - if r1 <> 0 or String.length Config.ranlib = 0 + if r1 <> 0 || String.length Config.ranlib = 0 then r1 else command(Config.ranlib ^ " " ^ archive) diff --git a/utils/misc.ml b/utils/misc.ml index e6b659290..c101f2bc5 100644 --- a/utils/misc.ml +++ b/utils/misc.ml @@ -29,7 +29,7 @@ let rec map_end f l1 l2 = let rec for_all2 pred l1 l2 = match (l1, l2) with ([], []) -> true - | (hd1::tl1, hd2::tl2) -> pred hd1 hd2 & for_all2 pred tl1 tl2 + | (hd1::tl1, hd2::tl2) -> pred hd1 hd2 && for_all2 pred tl1 tl2 | (_, _) -> false let rec replicate_list elem n = |