diff options
Diffstat (limited to 'stdlib/pervasives.ml')
| -rw-r--r-- | stdlib/pervasives.ml | 278 |
1 files changed, 0 insertions, 278 deletions
diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml deleted file mode 100644 index e406db952b..0000000000 --- a/stdlib/pervasives.ml +++ /dev/null @@ -1,278 +0,0 @@ -(* Exceptions *) - -external raise : exn -> 'a = "%raise" - -let failwith s = raise(Failure s) -let invalid_arg s = raise(Invalid_argument s) - -exception Exit - -(* Comparisons *) - -external (=) : 'a -> 'a -> bool = "%equal" -external (<>) : 'a -> 'a -> bool = "%notequal" -external (<) : 'a -> 'a -> bool = "%lessthan" -external (>) : 'a -> 'a -> bool = "%greaterthan" -external (<=) : 'a -> 'a -> bool = "%lessequal" -external (>=) : 'a -> 'a -> bool = "%greaterequal" -external compare: 'a -> 'a -> int = "compare" - -let min x y = if x <= y then x else y -let max x y = if x >= y then x else y - -external (==) : 'a -> 'a -> bool = "%eq" -external (!=) : 'a -> 'a -> bool = "%noteq" - -(* Boolean operations *) - -external not : bool -> bool = "%boolnot" -external (&) : bool -> bool -> bool = "%sequand" -external (or) : bool -> bool -> bool = "%sequor" - -(* Integer operations *) - -external (~-) : int -> int = "%negint" -external succ : int -> int = "%succint" -external pred : int -> int = "%predint" -external (+) : int -> int -> int = "%addint" -external (-) : int -> int -> int = "%subint" -external ( * ) : int -> int -> int = "%mulint" -external (/) : int -> int -> int = "%divint" -external (mod) : int -> int -> int = "%modint" - -let abs x = if x >= 0 then x else -x - -external (land) : int -> int -> int = "%andint" -external (lor) : int -> int -> int = "%orint" -external (lxor) : int -> int -> int = "%xorint" - -let lnot x = x lxor (-1) - -external (lsl) : int -> int -> int = "%lslint" -external (lsr) : int -> int -> int = "%lsrint" -external (asr) : int -> int -> int = "%asrint" - -(* Floating-point operations *) - -external (~-.) : float -> float = "neg_float" -external (+.) : float -> float -> float = "add_float" -external (-.) : float -> float -> float = "sub_float" -external ( *. ) : float -> float -> float = "mul_float" -external (/.) : float -> float -> float = "div_float" -external ( ** ) : float -> float -> float = "power_float" -external exp : float -> float = "exp_float" -external log : float -> float = "log_float" -external sqrt : float -> float = "sqrt_float" -external sin : float -> float = "sin_float" -external cos : float -> float = "cos_float" -external tan : float -> float = "tan_float" -external asin : float -> float = "asin_float" -external acos : float -> float = "acos_float" -external atan : float -> float = "atan_float" -external atan2 : float -> float -> float = "atan2_float" - -let abs_float f = if f >= 0.0 then f else -. f - -external float : int -> float = "float_of_int" -external truncate : float -> int = "int_of_float" - -(* String operations -- more in module String *) - -external string_length : string -> int = "ml_string_length" -external string_create: int -> string = "create_string" -external string_blit : string -> int -> string -> int -> int -> unit - = "blit_string" - -let (^) s1 s2 = - let l1 = string_length s1 and l2 = string_length s2 in - let s = string_create (l1 + l2) in - string_blit s1 0 s 0 l1; - string_blit s2 0 s l1 l2; - s - -(* Pair operations *) - -external fst : 'a * 'b -> 'a = "%field0" -external snd : 'a * 'b -> 'b = "%field1" - -(* String conversion functions *) - -external format_int: string -> int -> string = "format_int" -external format_float: string -> float -> string = "format_float" - -let string_of_bool b = - if b then "true" else "false" - -let string_of_int n = - format_int "%d" n - -external int_of_string : string -> int = "int_of_string" - -let string_of_float f = - format_float "%.12g" f - -external float_of_string : string -> float = "float_of_string" - -(* List operations -- more in module List *) - -let rec (@) l1 l2 = - match l1 with - [] -> l2 - | hd :: tl -> hd :: (tl @ l2) - -(* I/O operations *) - -type in_channel -type out_channel - -external open_descriptor_out: int -> out_channel = "open_descriptor" -external open_descriptor_in: int -> in_channel = "open_descriptor" - -let stdin = open_descriptor_in 0 -let stdout = open_descriptor_out 1 -let stderr = open_descriptor_out 2 - -(* General output functions *) - -type open_flag = - Open_rdonly | Open_wronly | Open_rdwr - | Open_append | Open_creat | Open_trunc | Open_excl - | Open_binary | Open_text - -external open_desc: string -> open_flag list -> int -> int = "sys_open" - -let open_out_gen mode perm name = - open_descriptor_out(open_desc name mode perm) - -let open_out name = - open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_text] 0o666 name - -let open_out_bin name = - open_out_gen [Open_wronly; Open_creat; Open_trunc; Open_binary] 0o666 name - -external flush : out_channel -> unit = "flush" - -external unsafe_output : out_channel -> string -> int -> int -> unit = "output" - -external output_char : out_channel -> char -> unit = "output_char" - -let output_string oc s = - unsafe_output oc s 0 (string_length s) - -let output oc s ofs len = - if ofs < 0 or ofs + len > string_length s - then invalid_arg "output" - else unsafe_output oc s ofs len - -external output_byte : out_channel -> int -> unit = "output_char" -external output_binary_int : out_channel -> int -> unit = "output_int" -external output_value : out_channel -> 'a -> unit = "output_value" -external output_compact_value : out_channel -> 'a -> unit = "output_value" -external seek_out : out_channel -> int -> unit = "seek_out" -external pos_out : out_channel -> int = "pos_out" -external size_out : out_channel -> int = "channel_size" -external close_out : out_channel -> unit = "close_out" - -(* General input functions *) - -let open_in_gen mode perm name = - open_descriptor_in(open_desc name mode perm) - -let open_in name = - open_in_gen [Open_rdonly; Open_text] 0 name - -let open_in_bin name = - open_in_gen [Open_rdonly; Open_binary] 0 name - -external input_char : in_channel -> char = "input_char" - -external unsafe_input : in_channel -> string -> int -> int -> int = "input" - -let input ic s ofs len = - if ofs < 0 or ofs + len > string_length s - then invalid_arg "input" - else unsafe_input ic s ofs len - -let rec unsafe_really_input ic s ofs len = - if len <= 0 then () else begin - let r = unsafe_input ic s ofs len in - if r = 0 - then raise End_of_file - else unsafe_really_input ic s (ofs+r) (len-r) - end - -let really_input ic s ofs len = - if ofs < 0 or ofs + len > string_length s - then invalid_arg "really_input" - else unsafe_really_input ic s ofs len - -external input_scan_line : in_channel -> int = "input_scan_line" - -let rec input_line chan = - let n = input_scan_line chan in - if n = 0 then (* n = 0: we are at EOF *) - raise End_of_file - else if n > 0 then begin (* n > 0: newline found in buffer *) - let res = string_create (n-1) in - unsafe_input chan res 0 (n-1); - input_char chan; (* skip the newline *) - res - end else begin (* n < 0: newline not found *) - let beg = string_create (-n) in - unsafe_input chan beg 0 (-n); - try - beg ^ input_line chan - with End_of_file -> - beg - end - -external input_byte : in_channel -> int = "input_char" -external input_binary_int : in_channel -> int = "input_int" -external input_value : in_channel -> 'a = "input_value" -external seek_in : in_channel -> int -> unit = "seek_in" -external pos_in : in_channel -> int = "pos_in" -external in_channel_length : in_channel -> int = "channel_size" -external close_in : in_channel -> unit = "close_in" - -(* Output functions on standard output *) - -let print_char c = output_char stdout c -let print_string s = output_string stdout s -let print_int i = output_string stdout (string_of_int i) -let print_float f = output_string stdout (string_of_float f) -let print_endline s = output_string stdout s; output_char stdout '\n' -let print_newline () = output_char stdout '\n'; flush stdout - -(* Output functions on standard error *) - -let prerr_char c = output_char stderr c -let prerr_string s = output_string stderr s -let prerr_int i = output_string stderr (string_of_int i) -let prerr_float f = output_string stderr (string_of_float f) -let prerr_endline s = - output_string stderr s; output_char stderr '\n'; flush stderr -let prerr_newline () = output_char stderr '\n'; flush stderr - -(* Input functions on standard input *) - -let read_line () = flush stdout; input_line stdin -let read_int () = int_of_string(read_line()) -let read_float () = float_of_string(read_line()) - -(* References *) - -type 'a ref = { mutable contents: 'a } -external ref: 'a -> 'a ref = "%makeblock" -external (!): 'a ref -> 'a = "%field0" -external (:=): 'a ref -> 'a -> unit = "%setfield0" -external incr: int ref -> unit = "%incr" -external decr: int ref -> unit = "%decr" - -(* Miscellaneous *) - -external sys_exit : int -> 'a = "sys_exit" - -let exit retcode = - flush stdout; flush stderr; sys_exit retcode - -type 'a option = None | Some of 'a |