util.ml 2.5 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788
  1. open Printf
  2. open Str
  3. open Types
  4. let input_all ic =
  5. let n = in_channel_length ic in
  6. let buf = String.create n in
  7. really_input ic buf 0 n;
  8. close_in ic;
  9. buf
  10. let input_buffered ic chunksize =
  11. let rec read_all buf bufsize pos =
  12. match input ic buf pos (bufsize - pos) with
  13. | 0 -> (close_in ic; buf)
  14. | nread when nread = bufsize - pos ->
  15. let bufsize = bufsize + chunksize in
  16. let pos = pos + nread in
  17. read_all (buf ^ String.create chunksize) bufsize pos
  18. | nread ->
  19. read_all buf bufsize (pos + nread)
  20. in
  21. read_all (String.create chunksize) chunksize 0
  22. let output_css oc decls =
  23. output_string oc (Stringify.string_of_stylesheet decls);
  24. output_char oc '\n'
  25. let print_css = output_css stdout
  26. let noloc = ("", 0, 0, 0, 0)
  27. let tabwidth = 4
  28. let count_tabs str upto =
  29. let rec count n = function
  30. | 0 -> n
  31. | i -> count (if String.get str (i - 1) = '\t' then n + 1 else n) (i - 1)
  32. in
  33. count 0 upto
  34. let rec repeat s n = if n < 1 then "" else s ^ (repeat s (n - 1))
  35. let retab str = global_replace (regexp "\t") (repeat " " tabwidth) str
  36. let indent n = repeat (repeat " " (tabwidth - 1)) n
  37. let prerr_loc (fname, ystart, yend, xstart, xend) =
  38. let file = open_in fname in
  39. (* skip lines until the first matched line *)
  40. for i = 1 to ystart - 1 do ignore (input_line file) done;
  41. (* for each line in `loc`, print the source line with an underline *)
  42. for l = ystart to yend do
  43. let line = input_line file in
  44. let linewidth = String.length line in
  45. let left = if l = ystart then xstart else 1 in
  46. let right = if l = yend then xend else linewidth in
  47. if linewidth > 0 then begin
  48. prerr_endline (retab line);
  49. prerr_string (indent (count_tabs line right));
  50. for i = 1 to left - 1 do prerr_char ' ' done;
  51. for i = left to right do prerr_char '^' done;
  52. prerr_endline "";
  53. end
  54. done
  55. let prerr_loc_msg verbose loc msg =
  56. if verbose then begin
  57. let (fname, ystart, yend, xstart, xend) = loc in
  58. if loc != noloc then begin
  59. let line_s = if yend != ystart
  60. then sprintf "lines %d-%d" ystart yend
  61. else sprintf "line %d" ystart
  62. in
  63. let char_s = if xend != xstart || yend != ystart
  64. then sprintf "characters %d-%d" xstart xend
  65. else sprintf "character %d" xstart
  66. in
  67. eprintf "File \"%s\", %s, %s:\n" fname line_s char_s;
  68. end;
  69. eprintf "%s\n" msg;
  70. if verbose && loc != noloc then
  71. try prerr_loc loc
  72. with Sys_error _ -> ()
  73. end