home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Caml Light 0.61 / Source / src / lib / io.ml < prev    next >
Encoding:
Text File  |  1993-09-24  |  2.4 KB  |  127 lines  |  [TEXT/MPS ]
  1. (* Input-output *)
  2.  
  3. #open "eq";;
  4. #open "exc";;
  5. #open "int";;
  6. #open "sys";;
  7. #open "fstring";;
  8. #open "ref";;
  9.  
  10. type in_channel
  11.  and out_channel
  12. ;;
  13.  
  14. let std_in = open_descriptor_in 0
  15. and std_out = open_descriptor_out 1
  16. and std_err = open_descriptor_out 2
  17. ;;
  18.  
  19. let stdin = std_in
  20. and stdout = std_out
  21. and stderr = std_err
  22. ;;
  23.  
  24. let exit n =
  25.   flush std_out;
  26.   flush std_err;
  27.   sys__exit n
  28. ;;
  29.  
  30. let open_in_gen mode rights filename =
  31.   open_descriptor_in (open filename mode rights)
  32. ;;
  33.  
  34. let open_in = open_in_gen [O_RDONLY; O_TEXT] 0
  35. and open_in_bin = open_in_gen [O_RDONLY; O_BINARY] 0
  36. ;;
  37.  
  38. let input chan buff ofs len =
  39.   if len < 0 or ofs < 0 or ofs+len > string_length buff then
  40.     invalid_arg "input"
  41.   else
  42.     fast_input chan buff ofs len
  43. ;;
  44.  
  45. let rec fast_really_input chan buff ofs len =
  46.   if len <= 0 then () else
  47.     match fast_input chan buff ofs len with
  48.       0 -> raise End_of_file
  49.     | r -> fast_really_input chan buff (ofs+r) (len-r)
  50. ;;
  51.  
  52. let really_input chan buff ofs len =
  53.   if len < 0 or ofs < 0 or ofs+len > string_length buff then
  54.     invalid_arg "really_input"
  55.   else
  56.     fast_really_input chan buff ofs len
  57. ;;
  58.  
  59. let read_line () = flush std_out; input_line std_in
  60. ;;
  61. let read_int () = int__int_of_string (read_line())
  62. ;;
  63. let read_float () = float__float_of_string (read_line())
  64. ;;
  65.  
  66. let open_out_gen mode rights filename =
  67.   open_descriptor_out(open filename mode rights)
  68. ;;
  69.  
  70. let open_out =
  71.   open_out_gen [O_WRONLY; O_TRUNC; O_CREAT; O_TEXT] (s_irall + s_iwall)
  72. and open_out_bin =
  73.   open_out_gen [O_WRONLY; O_TRUNC; O_CREAT; O_BINARY] (s_irall + s_iwall)
  74. ;;
  75.  
  76. let output chan buff ofs len =
  77.   if len < 0 or ofs < 0 or ofs+len > string_length buff then
  78.     invalid_arg "output"
  79.   else
  80.     fast_output chan buff ofs len
  81. ;;
  82.  
  83. let output_string channel s =
  84.   fast_output channel s 0 (string_length s)
  85. ;;
  86.  
  87. let print_char =
  88.   output_char std_out
  89. ;;
  90. let print_string =
  91.   output_string std_out
  92. ;;
  93. let print_int i =
  94.   print_string (int__string_of_int i)
  95. ;;
  96. let print_float f =
  97.   print_string (float__string_of_float f)
  98. ;;
  99. let print_endline s =
  100.   print_string s;
  101.   print_char `\n`
  102. ;;
  103.  
  104. let print_newline () =
  105.   print_char `\n`;
  106.   flush std_out
  107. ;;
  108.  
  109. let prerr_char =
  110.   output_char std_err
  111. ;;
  112. let prerr_string =
  113.   output_string std_err
  114. ;;
  115. let prerr_int i =
  116.   prerr_string (int__string_of_int i)
  117. ;;
  118. let prerr_float f =
  119.   prerr_string (float__string_of_float f)
  120. ;;
  121. let prerr_endline s =
  122.   prerr_string s;
  123.   prerr_char `\n`;
  124.   flush std_err
  125. ;;
  126.  
  127.