1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)
(* Objective Caml port by John Malecki and Xavier Leroy *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(************************ Source management ****************************)
open Misc
open Primitives
(*** Conversion function. ***)
let source_of_module mdle =
find_in_path_uncap !Config.load_path (mdle ^ ".ml")
(*** Buffer cache ***)
(* Buffer and cache (to associate lines and positions in the buffer). *)
type buffer = string * (int * int) list ref
let buffer_max_count = ref 10
let cache_size = 30
let buffer_list =
ref ([] : (string * buffer) list)
let flush_buffer_list () =
buffer_list := []
let get_buffer mdle =
try List.assoc mdle !buffer_list with
Not_found ->
let inchan = open_in_bin (source_of_module mdle) in
let (content, _) as buffer =
(String.create (in_channel_length inchan), ref [])
in
unsafe_really_input inchan content 0 (in_channel_length inchan);
buffer_list :=
(list_truncate !buffer_max_count ((mdle, buffer)::!buffer_list));
buffer
let buffer_content =
(fst : buffer -> string)
let buffer_length x =
String.length (buffer_content x)
(*** Position conversions. ***)
type position = int * int
(* Insert a new pair (position, line) in the cache of the given buffer. *)
let insert_pos buffer ((position, line) as pair) =
let rec new_list =
function
[] ->
[(position, line)]
| ((pos, lin) as a::l) as l' ->
if lin < line then
pair::l'
else if lin = line then
l'
else
a::(new_list l)
in
let buffer_cache = snd buffer in
buffer_cache := new_list !buffer_cache
(* Position of the next linefeed after `pos'. *)
(* Position just after the buffer end if no linefeed found. *)
(* Raise `Out_of_range' if already there. *)
let next_linefeed (buffer, _) pos =
let len = String.length buffer in
if pos >= len then
raise Out_of_range
else
let rec search p =
if p = len || String.get buffer p = '\n' then
p
else
search (succ p)
in
search pos
(* Go to next line. *)
let next_line buffer (pos, line) =
(next_linefeed buffer pos + 1, line + 1)
(* Convert a position in the buffer to a line number. *)
let line_of_pos buffer position =
let rec find =
function
| [] ->
if position < 0 then
raise Out_of_range
else
(0, 1)
| ((pos, line) as pair)::l ->
if pos > position then
find l
else
pair
and find_line previous =
let (pos, line) as next = next_line buffer previous in
if pos <= position then
find_line next
else
previous
in
let result = find_line (find !(snd buffer)) in
insert_pos buffer result;
result
(* Convert a line number to a position. *)
let pos_of_line buffer line =
let rec find =
function
[] ->
if line <= 0 then
raise Out_of_range
else
(0, 1)
| ((pos, lin) as pair)::l ->
if lin > line then
find l
else
pair
and find_pos previous =
let (_, lin) as next = next_line buffer previous in
if lin <= line then
find_pos next
else
previous
in
let result = find_pos (find !(snd buffer)) in
insert_pos buffer result;
result
(* Convert a coordinate (line / column) into a position. *)
(* --- The first line and column are line 1 and column 1. *)
let point_of_coord buffer line column =
fst (pos_of_line buffer line) + (pred column)
|
