diff options
Diffstat (limited to 'parsing')
| -rw-r--r-- | parsing/lexer.mli | 1 | ||||
| -rw-r--r-- | parsing/lexer.mll | 27 | ||||
| -rw-r--r-- | parsing/parser.mly | 6 | ||||
| -rw-r--r-- | parsing/parsetree.mli | 1 | ||||
| -rw-r--r-- | parsing/printast.ml | 4 |
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) -> |