diff options
Diffstat (limited to 'camlp4/Camlp4/Struct/Grammar/Failed.ml')
| -rw-r--r-- | camlp4/Camlp4/Struct/Grammar/Failed.ml | 132 |
1 files changed, 0 insertions, 132 deletions
diff --git a/camlp4/Camlp4/Struct/Grammar/Failed.ml b/camlp4/Camlp4/Struct/Grammar/Failed.ml deleted file mode 100644 index a0327b152..000000000 --- a/camlp4/Camlp4/Struct/Grammar/Failed.ml +++ /dev/null @@ -1,132 +0,0 @@ -(****************************************************************************) -(* *) -(* OCaml *) -(* *) -(* INRIA Rocquencourt *) -(* *) -(* Copyright 2006 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed under *) -(* the terms of the GNU Library General Public License, with the special *) -(* exception on linking described in LICENSE at the top of the OCaml *) -(* source tree. *) -(* *) -(****************************************************************************) - -(* Authors: - * - Daniel de Rauglaudre: initial version - * - Nicolas Pouillard: refactoring - *) - -module Make (Structure : Structure.S) = struct - module Tools = Tools.Make Structure; - module Search = Search.Make Structure; - module Print = Print.Make Structure; - open Structure; - open Format; - -value rec name_of_symbol entry = - fun - [ Snterm e -> "[" ^ e.ename ^ "]" - | Snterml e l -> "[" ^ e.ename ^ " level " ^ l ^ "]" - | Sself | Snext -> "[" ^ entry.ename ^ "]" - | Stoken (_, descr) -> descr - | Skeyword kwd -> "\"" ^ kwd ^ "\"" - | _ -> "???" ] -; - - -value rec name_of_symbol_failed entry = - fun - [ Slist0 s | Slist0sep s _ | - Slist1 s | Slist1sep s _ | - Sopt s | Stry s -> name_of_symbol_failed entry s - | Stree t -> name_of_tree_failed entry t - | s -> name_of_symbol entry s ] -and name_of_tree_failed entry = - fun - [ Node {node = s; brother = bro; son = son} -> - let tokl = - match s with - [ Stoken _ | Skeyword _ -> Tools.get_token_list entry [] s son - | _ -> None ] - in - match tokl with - [ None -> - let txt = name_of_symbol_failed entry s in - let txt = - match (s, son) with - [ (Sopt _, Node _) -> txt ^ " or " ^ name_of_tree_failed entry son - | _ -> txt ] - in - let txt = - match bro with - [ DeadEnd | LocAct _ _ -> txt - | Node _ -> txt ^ " or " ^ name_of_tree_failed entry bro ] - in - txt - | Some (tokl, _, _) -> - List.fold_left - (fun s tok -> - (if s = "" then "" else s ^ " then ") ^ - match tok with - [ Stoken (_, descr) -> descr - | Skeyword kwd -> kwd - | _ -> assert False ]) - "" tokl ] - | DeadEnd | LocAct _ _ -> "???" ] -; -value magic _s x = debug magic "Obj.magic: %s@." _s in Obj.magic x; -value tree_failed entry prev_symb_result prev_symb tree = - let txt = name_of_tree_failed entry tree in - let txt = - match prev_symb with - [ Slist0 s -> - let txt1 = name_of_symbol_failed entry s in - txt1 ^ " or " ^ txt ^ " expected" - | Slist1 s -> - let txt1 = name_of_symbol_failed entry s in - txt1 ^ " or " ^ txt ^ " expected" - | Slist0sep s sep -> - match magic "tree_failed: 'a -> list 'b" prev_symb_result with - [ [] -> - let txt1 = name_of_symbol_failed entry s in - txt1 ^ " or " ^ txt ^ " expected" - | _ -> - let txt1 = name_of_symbol_failed entry sep in - txt1 ^ " or " ^ txt ^ " expected" ] - | Slist1sep s sep -> - match magic "tree_failed: 'a -> list 'b" prev_symb_result with - [ [] -> - let txt1 = name_of_symbol_failed entry s in - txt1 ^ " or " ^ txt ^ " expected" - | _ -> - let txt1 = name_of_symbol_failed entry sep in - txt1 ^ " or " ^ txt ^ " expected" ] - | Stry _(*NP: not sure about this*) | Sopt _ | Stree _ -> txt ^ " expected" - | _ -> txt ^ " expected after " ^ name_of_symbol entry prev_symb ] - in - do { - if entry.egram.error_verbose.val then do { - let tree = Search.tree_in_entry prev_symb tree entry.edesc; - let ppf = err_formatter; - fprintf ppf "@[<v 0>@,"; - fprintf ppf "----------------------------------@,"; - fprintf ppf "Parse error in entry [%s], rule:@;<0 2>" entry.ename; - fprintf ppf "@["; - Print.print_level ppf pp_force_newline (Print.flatten_tree tree); - fprintf ppf "@]@,"; - fprintf ppf "----------------------------------@,"; - fprintf ppf "@]@." - } - else (); - txt ^ " (in [" ^ entry.ename ^ "])" - } -; -value symb_failed entry prev_symb_result prev_symb symb = - let tree = Node {node = symb; brother = DeadEnd; son = DeadEnd} in - tree_failed entry prev_symb_result prev_symb tree -; - -value symb_failed_txt e s1 s2 = symb_failed e 0 s1 s2; - -end; |