comparison tools/prepare_spellcheck.ml @ 295:6833a1b778c0

First cut at spellcheck filter
author Adam Chlipala <adam@chlipala.net>
date Thu, 09 Dec 2010 14:30:24 -0500
parents
children 3fc43e261f67
comparison
equal deleted inserted replaced
294:1b6c81e51799 295:6833a1b778c0
1 let read_line () =
2 try
3 Some (read_line ())
4 with End_of_file -> None
5
6 let strstr' p s n =
7 try
8 Some (Str.search_forward (Str.regexp_string p) s n)
9 with Not_found -> None
10
11 let strstr p s = strstr' p s 0
12
13 let prefix s1 s2 = String.length s2 >= String.length s1 && Str.string_before s2 (String.length s1) = s1
14
15 let sanitize s =
16 let rec san n acc =
17 try
18 let pos = Str.search_forward (Str.regexp "\\[\\|%\\|#") s n in
19 let ender = match s.[pos] with
20 | '[' -> ']'
21 | _ -> s.[pos] in
22 let pos' = String.index_from s (pos+1) ender in
23 san (pos'+1) (acc ^ String.sub s n (pos-n))
24 with Not_found -> acc ^ Str.string_after s n
25 in san 0 ""
26
27 let rec initial () =
28 match read_line () with
29 | None -> ()
30 | Some line ->
31 match strstr "(**" line with
32 | None -> initial ()
33 | Some pos ->
34 match strstr "*)" line with
35 | None ->
36 begin match strstr "[[" line with
37 | None ->
38 print_endline (sanitize (Str.string_after line (pos+3)));
39 comment ()
40 | Some _ -> runTo "]]"
41 end
42 | Some pos' ->
43 let rest = Str.string_after line (pos+3) in
44 if not (prefix " printing" rest || prefix " begin" rest || prefix " end" rest) then
45 print_endline (sanitize (String.sub line (pos+3) (pos' - (pos+3))));
46 initial ()
47
48 and comment () =
49 match read_line () with
50 | None -> ()
51 | Some line ->
52 match strstr "*)" line with
53 | None ->
54 begin match strstr "[[" line with
55 | None ->
56 begin match strstr "<<" line with
57 | None ->
58 print_endline (sanitize line);
59 comment ()
60 | Some _ -> runTo ">>"
61 end
62 | Some _ -> runTo "]]"
63 end
64 | Some pos ->
65 print_endline (sanitize (Str.string_before line pos));
66 initial ()
67
68 and runTo ender =
69 match read_line () with
70 | None -> ()
71 | Some line ->
72 match strstr ender line with
73 | None -> runTo ender
74 | _ ->
75 match strstr "*)" line with
76 | None -> comment ()
77 | _ -> initial ()
78
79 let () = initial ()