ocamlsexp/path.ml

   1 (* File: path.ml
   2
   3     Copyright (C) 2005-
   4
   5       Jane Street Holding, LLC
   6       Author: Markus Mottl
   7       email: mmottl\@janestcapital.com
   8       WWW: http://www.janestcapital.com/ocaml
   9
  10    This library is free software; you can redistribute it and/or
  11    modify it under the terms of the GNU Lesser General Public
  12    License as published by the Free Software Foundation; either
  13    version 2 of the License, or (at your option) any later version.
  14
  15    This library is distributed in the hope that it will be useful,
  16    but WITHOUT ANY WARRANTY; without even the implied warranty of
  17    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18    Lesser General Public License for more details.
  19
  20    You should have received a copy of the GNU Lesser General Public
  21    License along with this library; if not, write to the Free Software
  22    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  23 *)
  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