Commit | Line | Data |
---|---|---|
feec80c3 C |
1 | (****************************************************************************** |
2 | * Sexplib * | |
3 | * * | |
4 | * Copyright (C) 2005- Jane Street Holding, LLC * | |
5 | * Contact: opensource@janestreet.com * | |
6 | * WWW: http://www.janestreet.com/ocaml * | |
7 | * Author: Markus Mottl * | |
8 | * * | |
9 | * This library is free software; you can redistribute it and/or * | |
10 | * modify it under the terms of the GNU Lesser General Public * | |
11 | * License as published by the Free Software Foundation; either * | |
12 | * version 2 of the License, or (at your option) any later version. * | |
13 | * * | |
14 | * This library is distributed in the hope that it will be useful, * | |
15 | * but WITHOUT ANY WARRANTY; without even the implied warranty of * | |
16 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * | |
17 | * Lesser General Public License for more details. * | |
18 | * * | |
19 | * You should have received a copy of the GNU Lesser General Public * | |
20 | * License along with this library; if not, write to the Free Software * | |
21 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * | |
22 | * * | |
23 | ******************************************************************************) | |
b1b2de81 C |
24 | |
25 | (* Path: Module for Substitutions within S-expressions *) | |
26 | ||
27 | open Format | |
28 | ||
29 | open Sexp | |
30 | ||
31 | type el = Pos of int | Match of string * int | Rec of string | |
32 | type t = el list | |
33 | ||
34 | let illegal_atom loc sexp = | |
35 | failwith (sprintf "Path.%s: illegal atom: %s" loc (Sexp.to_string sexp)) | |
36 | ||
37 | let extract_pos_lst loc sexp ix lst = | |
38 | let rec loop acc n = function | |
39 | | [] -> | |
40 | let sexp_str = Sexp.to_string sexp in | |
41 | failwith ( | |
42 | sprintf "Path.%s: illegal index %d in: %s" loc ix sexp_str) | |
43 | | h :: t -> | |
44 | if n = 0 then | |
45 | let subst = function | |
46 | | None -> List.rev_append acc t | |
47 | | Some x -> List.rev_append acc (x :: t) in | |
48 | subst, h | |
49 | else loop (h :: acc) (n - 1) t in | |
50 | loop [] ix lst | |
51 | ||
52 | let extract_pos n = function | |
53 | | List lst as sexp -> | |
54 | let subst, el = extract_pos_lst "extract_pos" sexp n lst in | |
55 | (fun x -> List (subst x)), el | |
56 | | Atom _ as sexp -> illegal_atom "extract_pos" sexp | |
57 | ||
58 | let extract_match tag arg_ix = function | |
59 | | List (Atom str as sexp :: args) when str = tag -> | |
60 | let subst, el = extract_pos_lst "extract_match" (List args) arg_ix args in | |
61 | (fun maybe_x -> List (sexp :: subst maybe_x)), el | |
62 | | List _ as sexp -> | |
63 | let sexp_str = Sexp.to_string sexp in | |
64 | failwith ("Path.extract_match: unexpected nested list in: " ^ sexp_str) | |
65 | | Atom _ as sexp -> illegal_atom "extract_match" sexp | |
66 | ||
67 | let extract_rec key = function | |
68 | | List lst as sexp -> | |
69 | let rec loop acc = function | |
70 | | [] -> | |
71 | let sexp_str = Sexp.to_string sexp in | |
72 | failwith ( | |
73 | sprintf "Path.extract_rec: key \"%s\" not found in: %s" | |
74 | key sexp_str) | |
75 | | List [Atom str as sexp; v] :: rest when str = key -> | |
76 | let subst x = List (List.rev_append acc (List [sexp; x] :: rest)) in | |
77 | subst, v | |
78 | | h :: t -> loop (h :: acc) t in | |
79 | loop [] lst | |
80 | | Atom _ as sexp -> illegal_atom "extract_rec" sexp | |
81 | ||
82 | let id x = x | |
83 | ||
84 | let rec subst_option (sup_subst, el) rest = | |
85 | let sub_subst, sub_el = subst_path el rest in | |
86 | let subst x = sup_subst (Some (sub_subst x)) in | |
87 | subst, sub_el | |
88 | ||
89 | and subst_path sexp = function | |
90 | | Pos n :: t -> subst_option (extract_pos n sexp) t | |
91 | | Match (tag, arg_ix) :: t -> subst_option (extract_match tag arg_ix sexp) t | |
92 | | Rec key :: rest -> | |
93 | let rec_subst, el = extract_rec key sexp in | |
94 | let sub_subst, sub_el = subst_path el rest in | |
95 | let subst x = rec_subst (sub_subst x) in | |
96 | subst, sub_el | |
97 | | [] -> id, sexp | |
98 | ||
99 | let implode lst = | |
100 | let len = List.length lst in | |
101 | let str = String.create len in | |
102 | let rec loop ix = function | |
103 | | h :: t -> str.[ix] <- h; loop (ix + 1) t | |
104 | | [] -> str in | |
105 | loop 0 lst | |
106 | ||
107 | let fail_parse msg = failwith ("Path.parse: " ^ msg) | |
108 | ||
109 | let parse str = | |
110 | let len = String.length str in | |
111 | if len = 0 then fail_parse "path empty" | |
112 | else | |
113 | let rec loop acc dot_ix = | |
114 | match str.[dot_ix] with | |
115 | | '.' -> | |
116 | let dot_ix1 = dot_ix + 1 in | |
117 | if dot_ix1 = len then List.rev acc | |
118 | else | |
119 | let rec parse_dot acc str_acc ix = | |
120 | if ix = len then | |
121 | List.rev_append acc [Rec (implode (List.rev str_acc))] | |
122 | else | |
123 | match str.[ix] with | |
124 | | '[' -> | |
125 | let rec parse_index index_acc ix = | |
126 | if ix = len then fail_parse "EOF reading index" | |
127 | else | |
128 | match str.[ix], index_acc with | |
129 | | '0'..'9' as c, None -> | |
130 | parse_index (Some (int_of_char c - 48)) (ix + 1) | |
131 | | '0'..'9' as c, Some index_acc -> | |
132 | let new_index_acc = | |
133 | Some (10 * index_acc + int_of_char c - 48) in | |
134 | parse_index new_index_acc (ix + 1) | |
135 | | ']', None -> fail_parse "empty index" | |
136 | | ']', Some index_acc -> | |
137 | let path_el = | |
138 | if str_acc = [] then Pos index_acc | |
139 | else | |
140 | Match (implode (List.rev str_acc), index_acc) in | |
141 | let ix1 = ix + 1 in | |
142 | if ix1 = len then List.rev_append acc [path_el] | |
143 | else loop (path_el :: acc) ix1 | |
144 | | c, _ -> | |
145 | fail_parse ( | |
146 | sprintf "illegal character in index: %c" c) in | |
147 | parse_index None (ix + 1) | |
148 | | '\\' -> | |
149 | let ix1 = ix + 1 in | |
150 | if ix1 = len then fail_parse "EOF after escape" | |
151 | else parse_dot acc (str.[ix1] :: str_acc) (ix + 1) | |
152 | | '.' -> | |
153 | if str_acc = [] then fail_parse "double '.'"; | |
154 | let path_el = Rec (implode (List.rev str_acc)) in | |
155 | parse_dot (path_el :: acc) [] (ix + 1) | |
156 | | c -> parse_dot acc (c :: str_acc) (ix + 1) in | |
157 | parse_dot acc [] dot_ix1 | |
158 | | c -> fail_parse (sprintf "'.' expected; got '%c'" c) in | |
159 | loop [] 0 | |
160 | ||
161 | let get_subst path str sexp = | |
162 | let path = | |
163 | match path, str with | |
164 | | Some path, _ -> path | |
165 | | None, Some str -> parse str | |
166 | | None, None -> [] in | |
167 | subst_path sexp path | |
168 | ||
169 | let get ?path ?str sexp = snd (get_subst path str sexp) | |
170 | ||
171 | let replace ?path ?str sexp ~subst = | |
172 | let subst_fun, _ = get_subst path str sexp in | |
173 | subst_fun subst | |
174 | ||
175 | let replace_no_path ~str sexp ~subst = replace ~str sexp ~subst |