1 ! Copyright (C) 2013 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: accessors ascii assocs combinators.short-circuit fry
5 grouping kernel make regexp sequences ;
9 TUPLE: verbal-expression prefix source suffix modifiers ;
11 : <verbal-expressions> ( -- verbexp )
12 "" "" "" "" verbal-expression boa ; inline
14 ALIAS: <verbexp> <verbal-expressions>
16 : >regexp ( verbexp -- regexp )
17 [ [ prefix>> ] [ source>> ] [ suffix>> ] tri 3append ]
18 [ modifiers>> ] bi <optioned-regexp> ; inline
20 : build-regexp ( ... quot: ( ... verbexp -- ... verbexp ) -- ... regexp )
21 '[ <verbexp> @ >regexp ] call ; inline
25 : add ( verbexp str -- verbexp )
26 '[ _ append ] change-source ;
28 : add-modifier ( verbexp ch -- verbexp )
29 '[ _ suffix ] change-modifiers ;
31 : remove-modifier ( verbexp ch -- verbexp )
32 '[ _ swap remove ] change-modifiers ;
34 : re-escape ( str -- str' )
37 dup { [ Letter? ] [ digit? ] } 1||
38 [ CHAR: \ , ] unless ,
44 : anything ( verbexp -- verbexp )
47 : anything-but ( verbexp value -- verbexp )
48 re-escape "(?:[^" "]*)" surround add ;
50 : something ( verbexp -- verbexp )
53 : something-but ( verbexp value -- verbexp )
54 re-escape "(?:[^" "]+)" surround add ;
56 : end-of-line ( verbexp -- verbexp )
57 [ "$" append ] change-suffix ;
59 : maybe ( verbexp value -- verbexp )
60 re-escape "(?:" ")?" surround add ;
62 : start-of-line ( verbexp -- verbexp )
63 [ "^" append ] change-prefix ;
65 : -find- ( verbexp value -- verbexp )
66 re-escape "(" ")" surround add ;
68 : then ( verbexp value -- verbexp )
69 re-escape "(?:" ")" surround add ;
71 : any-of ( verbexp value -- verbexp )
72 re-escape "(?:[" "])" surround add ;
74 : line-break ( verbexp -- verbexp )
75 "(?:(?:\\n)|(?:\\r\\n))" add ;
79 : range ( verbexp alist -- verbexp )
80 [ [ re-escape ] bi@ "-" glue ] { } assoc>map concat
81 "([" "])" surround add ;
83 : tab ( verbexp -- verbexp ) "\\t" add ;
85 : word ( verbexp -- verbexp ) "\\w+" add ;
87 : space ( verbexp -- verbexp ) "\\s" add ;
89 : many ( verbexp -- verbexp )
91 dup ?last "*+" member? [ "+" append ] unless
94 : -or- ( verbexp -- verbexp )
95 [ "(" append ] change-prefix
96 [ ")|(" append ] change-source
97 [ ")" prepend ] change-suffix ;
99 : case-insensitive ( verbexp -- verbexp )
100 CHAR: i add-modifier ;
102 : case-sensitive ( verbexp -- verbexp )
103 CHAR: i remove-modifier ;
105 : multiline ( verbexp -- verbexp )
106 CHAR: m add-modifier ;
108 : singleline ( verbexp -- verbexp )
109 CHAR: m remove-modifier ;
111 ALIAS: ^( start-of-line
116 ALIAS: ^]* anything-but
118 ALIAS: [^]+ something-but
120 ALIAS: )$ end-of-line