bug fixes, new features, refactor

- fixing character '\' in %mik expressions
- `patterns >>> function_name as res` implemented
	- this mikmatch extension takes all bound expressions to the left (in
	  order) and passes them to `function_name`
	- and the result from this application is named `res`
- `let re = {%mik|some regex|}` syntax implemented
- `match str with | {%mik|some regex|}` implemented
	- inside a regular match case, only patterns with %mik inside
	  the string definition are compiled to an RE.
	- raw string matching allowed
	- guards allowed
	- currently they aren't grouped by guard, so the performance is
	  worse

Author: zazedd

common/mik_lexer.mll

@@ -18,7 +18,7 @@ let predefined_classes = [
   ("cntrl", {|[[:cntrl:]]|});
   ("xdigit", {|[[:xdigit:]]|});
   ("space", {|[[:space:]]|});
-  ("word", {|[[:word:]]|});
+  (* ("word", {|[[:word:]]|}); *)
   ("eos", {|$|});
   ("eol", {|$|[\n]|});
   ("bnd", {|\b|});
@@ -82,8 +82,10 @@ rule token = parse
   | ':' { COLON }
   | '=' { EQUAL }
   | "as" { AS }
+  | ">>>" { PIPE }
   | "int" { INT_CONVERTER }
   | "float" { FLOAT_CONVERTER }
+  | "$" { PREDEFINED_CLASS "$" }
   | digit+ as n { INT (int_of_string n) }
   | module_ident as id { MOD_IDENT id }
   | ident as id {
@@ -97,6 +99,10 @@ rule token = parse
   | _ as c { raise (Error ("Unexpected character: " ^ String.make 1 c)) }
 
 and char_literal buf = parse
+  | '\\' '\\' {
+      Buffer.add_string buf "\\\\";
+      char_literal buf lexbuf
+    }
   | '\\' (_ as c) { 
       Buffer.add_char buf (escape_char c);
       char_literal buf lexbuf

common/mik_parser.mly

@@ -43,7 +43,7 @@ let unclosed_error what startpos endpos =
 %token <string> CHAR_LITERAL STRING_LITERAL IDENT MOD_IDENT PREDEFINED_CLASS
 %token <int> INT
 %token SLASH LPAREN RPAREN LBRACKET RBRACKET CARET LBRACE RBRACE
-%token DASH BAR STAR PLUS QUESTION UNDERSCORE COLON EQUAL AS
+%token DASH BAR STAR PLUS QUESTION UNDERSCORE COLON EQUAL AS PIPE
 %token INT_CONVERTER FLOAT_CONVERTER EOF
 
 %start <string t> main_match_case
@@ -69,6 +69,13 @@ main_let_expr:
 
 pattern:
   | alt_expr { $1 }
+  | alt_expr PIPE func = func_name AS name = IDENT {
+      let name_loc = wrap_loc $startpos(name) $endpos(name) name in
+      wrap_loc $startpos $endpos (Pipe_all (name_loc, func, $1))
+    }
+  | alt_expr PIPE { missing_error "function name after '|>'" $startpos($2) $endpos }
+  | alt_expr PIPE func_name { missing_error "'as' and result name after function" $startpos($3) $endpos }
+  | alt_expr PIPE func_name AS { missing_error "result name after 'as'" $startpos($4) $endpos }
   | { missing_error "pattern expression" $startpos $endpos }
 
 alt_expr:
@@ -132,6 +139,9 @@ basic_atom:
   | UNDERSCORE {
       to_pcre_regex "." $startpos $endpos
     }
+  | CARET {
+      to_pcre_regex "^" $startpos $endpos
+    }
   | PREDEFINED_CLASS {
       to_pcre_regex $1 $startpos $endpos
     }
@@ -187,8 +197,7 @@ basic_atom:
       let pattern_node = to_pcre_regex $2 $startpos($2) $endpos($2) in
       wrap_loc $startpos $endpos (Named_subs (ident_loc, Some name_loc, Some Float, pattern_node))
     }
-  | LPAREN IDENT AS name = IDENT COLON EQUAL func = MOD_IDENT RPAREN
-  | LPAREN IDENT AS name = IDENT COLON EQUAL func = IDENT RPAREN {
+  | LPAREN IDENT AS name = IDENT COLON EQUAL func = func_name RPAREN {
       let ident_loc = wrap_loc $startpos($2) $endpos($2) $2 in
       let name_loc = wrap_loc $startpos(name) $endpos(name) name in
       let pattern_node = to_pcre_regex $2 $startpos($2) $endpos($2) in
@@ -223,8 +232,7 @@ basic_atom:
       let name_loc = wrap_loc $startpos(name) $endpos(name) name in
       wrap_loc $startpos $endpos (Capture_as (name_loc, Some Float, $2))
     }
-  | LPAREN pattern AS name = IDENT COLON EQUAL func = MOD_IDENT RPAREN
-  | LPAREN pattern AS name = IDENT COLON EQUAL func = IDENT RPAREN {
+  | LPAREN pattern AS name = IDENT COLON EQUAL func = func_name RPAREN {
       let name_loc = wrap_loc $startpos(name) $endpos(name) name in
       wrap_loc $startpos $endpos (Capture_as (name_loc, Some (Func func), $2))
     }
@@ -238,8 +246,13 @@ basic_atom:
       unclosed_error "parentheses (missing ')')" $startpos($1) $endpos($6)
     }
 
+
   | LPAREN error { syntax_error "Invalid expression in parentheses" $startpos($2) $endpos }
 
+func_name:
+  | IDENT { $1 }
+  | MOD_IDENT { $1 }
+
 char_set:
   | char_set_item { $1 }
   | char_set_item char_set { $1 ^ $2 }

common/regexp_types.ml

@@ -16,10 +16,12 @@ and 'a node =
   | Capture_as of string Location.loc * conv_ty option * 'a t
   | Named_subs of string Location.loc * string Location.loc option * conv_ty option * 'a t
   | Unnamed_subs of string Location.loc * 'a t
+  | Pipe_all of string Location.loc * string * 'a t
   | Call of Longident.t Location.loc
 (* TODO: | Case_sense of t | Case_blind of t *)
 
 and conv_ty =
   | Int
   | Float
   | Func of string
+  | Pipe_all_func of string

common/regexp_types.mli

@@ -16,10 +16,12 @@ and 'a node =
   | Capture_as of string Location.loc * conv_ty option * 'a t
   | Named_subs of string Location.loc * string Location.loc option * conv_ty option * 'a t
   | Unnamed_subs of string Location.loc * 'a t
+  | Pipe_all of string Location.loc * string * 'a t
   | Call of Longident.t Location.loc
 (* TODO: | Case_sense of t | Case_blind of t *)
 
 and conv_ty =
   | Int
   | Float
   | Func of string
+  | Pipe_all_func of string

ppx_regexp/dune

@@ -2,7 +2,7 @@
   (name ppx_regexp)
   (public_name ppx_regexp_extended)
   (kind ppx_rewriter)
-  (modules regexp_types ppx_regexp regexp mik_parser mik_lexer)
+  (modules util transformations regexp_types ppx_regexp regexp mik_parser mik_lexer)
   (preprocess (pps ppxlib.metaquot))
   (libraries ppxlib re re.perl)
   (ppx_runtime_libraries re re.perl))