merge the branch mltk

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@4745 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 36 insertions, 0 deletions

diff --git a/otherlibs/labltk/compiler/ppparse.ml b/otherlibs/labltk/compiler/ppparse.ml
new file mode 100644
index 000000000..91287d34a
--- /dev/null
+++ b/otherlibs/labltk/compiler/ppparse.ml
@@ -0,0 +1,36 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                 MLTk, Tcl/Tk interface of Objective Caml            *)
+(*                                                                     *)
+(*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
+(*               projet Cristal, INRIA Rocquencourt                    *)
+(*            Jacques Garrigue, Kyoto University RIMS                  *)
+(*                                                                     *)
+(*  Copyright 2002 Institut National de Recherche en Informatique et   *)
+(*  en Automatique and Kyoto University.  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 file LICENSE found in the Objective Caml source tree. *)
+(*                                                                     *)
+(***********************************************************************)
+
+exception Error of string
+
+let parse_channel ic =
+  let lexbuf = Lexing.from_channel ic in
+  try
+    Ppyac.code_list Pplex.token lexbuf 
+  with
+  | Pplex.Error s ->
+      let loc_start = Lexing.lexeme_start lexbuf 
+      and loc_end = Lexing.lexeme_end lexbuf
+      in
+      raise (Error (Printf.sprintf "parse error at char %d, %d: %s" 
+      		 loc_start loc_end s))
+  | Parsing.Parse_error ->
+      let loc_start = Lexing.lexeme_start lexbuf 
+      and loc_end = Lexing.lexeme_end lexbuf
+      in
+      raise (Error (Printf.sprintf "parse error at char %d, %d" 
+      		loc_start loc_end))
+;;