util.ml 2.5 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889
  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 count 0 upto
  33. let rec repeat s n = if n < 1 then "" else s ^ (repeat s (n - 1))
  34. let retab str = global_replace (regexp "\t") (repeat " " tabwidth) str
  35. let indent n = repeat (repeat " " (tabwidth - 1)) n
  36. let prerr_loc (fname, ystart, yend, xstart, xend) =
  37. let file = open_in fname in
  38. (* skip lines until the first matched line *)
  39. for i = 1 to ystart - 1 do let _ = input_line file in () done;
  40. (* for each line in `loc`, print the source line with an underline *)
  41. for l = ystart to yend do
  42. let line = input_line file in
  43. let linewidth = String.length line in
  44. let left = if l = ystart then xstart else 1 in
  45. let right = if l = yend then xend else linewidth in
  46. if linewidth > 0 then begin
  47. prerr_endline (retab line);
  48. prerr_string (indent (count_tabs line right));
  49. for i = 1 to left - 1 do prerr_char ' ' done;
  50. for i = left to right do prerr_char '^' done;
  51. prerr_endline "";
  52. end
  53. done;
  54. ()
  55. let prerr_loc_msg args loc msg =
  56. if args.verbose >= 1 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 args.verbose >= 1 && loc != noloc then
  71. try prerr_loc loc
  72. with Sys_error _ -> ()
  73. end;
  74. ()