3.09.1 updategcaml3090

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

5 files changed, 37 insertions, 2 deletions

diff --git a/parsing/lexer.mli b/parsing/lexer.mli
index 3ddb5dde7c..765db2c900 100644
--- a/parsing/lexer.mli
+++ b/parsing/lexer.mli
@@ -25,6 +25,7 @@ type error =
   | Unterminated_string_in_comment
   | Keyword_as_label of string
   | Literal_overflow of string
+  | Unterminated_regexp
 ;;
 
 exception Error of error * Location.t
diff --git a/parsing/lexer.mll b/parsing/lexer.mll
index 2ac3036ea7..2670e8f0e5 100644
--- a/parsing/lexer.mll
+++ b/parsing/lexer.mll
@@ -27,6 +27,7 @@ type error =
   | Unterminated_string_in_comment
   | Keyword_as_label of string
   | Literal_overflow of string
+  | Unterminated_regexp
 ;;
 
 exception Error of error * Location.t;;
@@ -203,6 +204,8 @@ let report_error ppf = function
       fprintf ppf "`%s' is a keyword, it cannot be used as label name" kwd
   | Literal_overflow ty ->
       fprintf ppf "Integer literal exceeds the range of representable integers of type %s" ty
+  | Unterminated_regexp ->
+      fprintf ppf "Regular expression not terminated"
 ;;
 
 }
@@ -331,6 +334,15 @@ rule token = parse
         lexbuf.lex_curr_p <- { curpos with pos_cnum = curpos.pos_cnum - 1 };
         STAR
       }
+  | "[/"
+      { reset_string_buffer ();
+        let string_start = lexbuf.lex_start_p in
+	(* let switches = regexp lexbuf in *)
+	let _ = regexp lexbuf in
+	lexbuf.lex_start_p <- string_start;
+        REGEXP (get_stored_string())
+      }
+
   | "#" [' ' '\t']* (['0'-'9']+ as num) [' ' '\t']*
         ("\"" ([^ '\010' '\013' '"' ] * as name) "\"")?
         [^ '\010' '\013'] * newline
@@ -503,3 +515,18 @@ and skip_sharp_bang = parse
   | "#!" [^ '\n']* '\n'
        { update_loc lexbuf None 1 false 0 }
   | "" { () }
+
+and regexp = parse
+  | '/' ['i' 'm' 's']* ']' 
+      (* x is not supported, due to the lexer complexity *)
+      { let lx = Lexing.lexeme lexbuf in
+        String.sub lx 1 (String.length lx - 2)
+      }
+  | ((_ # ['/' '\\']) | '\\' _) +
+      { String.iter store_string_char (Lexing.lexeme lexbuf);
+	regexp lexbuf
+      }
+  | '/' (* never matches with /] *)
+      { store_string_char '/';
+	regexp lexbuf }
+  | "" { raise (Error (Unterminated_regexp, !string_start_loc)) }
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 855dcc23d5..41cc0782cf 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -279,6 +279,7 @@ let bigarray_set arr arg newval =
 %token RBRACE
 %token RBRACKET
 %token REC
+%token <string> REGEXP
 %token RPAREN
 %token SEMI
 %token SEMISEMI
@@ -360,7 +361,7 @@ The precedences must be listed from low to high.
 /* Finally, the first tokens of simple_expr are above everything else. */
 %nonassoc BACKQUOTE BEGIN CHAR FALSE FLOAT INT INT32 INT64
           LBRACE LBRACELESS LBRACKET LBRACKETBAR LIDENT LPAREN
-          NEW NATIVEINT PREFIXOP STRING TRUE UIDENT
+          NEW NATIVEINT PREFIXOP REGEXP STRING TRUE UIDENT
           LBRACKETCOLON 
 
 
@@ -923,6 +924,9 @@ simple_expr:
       { unclosed "begin" 1 "end" 3 }
   | LPAREN seq_expr type_constraint RPAREN
       { let (t, t') = $3 in mkexp(Pexp_constraint($2, t, t')) }
+
+  | REGEXP { mkexp(Pexp_regexp $1) }
+
   | simple_expr DOT label_longident
       { mkexp(Pexp_field($1, $3)) }
   | simple_expr DOT LPAREN seq_expr RPAREN
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index adae54df21..ab159d0563 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -124,6 +124,7 @@ and expression_desc =
   | Pexp_rtype of core_type
   | Pexp_typedecl of Longident.t
   | Pexp_generic of (core_type option * expression) list
+  | Pexp_regexp of string
 
 (* Value descriptions *)
 
diff --git a/parsing/printast.ml b/parsing/printast.ml
index b9d9f0efce..c65a660e99 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -322,6 +322,8 @@ and expression i ppf x =
   | Pexp_generic cases ->
       line i ppf "Pexp_generic";
       list i generic_case ppf cases
+  | Pexp_regexp s ->
+      line i ppf "Pexp_regexp %S" s
 
 and generic_case i ppf (po, e) =
   line i ppf "<gcase>\n";
@@ -457,7 +459,7 @@ and class_structure i ppf (p, l) =
 and class_field i ppf x =
   match x with
   | Pcf_inher (ce, so) ->
-      printf "Pcf_inher\n";
+      line i ppf "Pcf_inher\n";
       class_expr (i+1) ppf ce;
       option (i+1) string ppf so;
   | Pcf_val (s, mf, e, loc) ->