2 library(pcre): Perl compatible regular expression matching for SWI-Prolog
AllApplicationManualNameSummaryHelp

  • Documentation
    • Reference manual
    • Packages
      • SWI-Prolog Regular Expression library
        • library(pcre): Perl compatible regular expression matching for SWI-Prolog
          • re_match/2
          • re_match/3
          • re_matchsub/3
          • re_matchsub/4
          • re_foldl/6
          • re_split/3
          • re_split/4
          • re_replace/4
          • re_replace/5
          • re_compile/3
          • re_flush/0
          • re_config/1
Availability::- use_module(library(pcre)).(can be autoloaded)
Source[semidet]re_foldl(:Goal, +Regex, +String, ?V0, ?V, +Options)
Fold all matches of Regex on String. Each match is represented by a dict as specified for re_matchsub/4. V0 and V are related using a sequence of invocations of Goal as illustrated below.
call(Goal, Dict1, V0, V1),
call(Goal, Dict2, V1, V2),
...
call(Goal, Dictn, Vn, V).

This predicate is used to implement re_split/4 and re_replace/4. For example, we can count all matches of a Regex on String using this code:

re_match_count(Regex, String, Count) :-
    re_foldl(increment, Regex, String, 0, Count, []).

increment(_Match, V0, V1) :-
    V1 is V0+1.

After which we can query

?- re_match_count("a", "aap", X).
X = 2.

Here is an example Goal for extracting all the matches with their offsets within the string:

range_match(Dict, StringIndex-[MatchStart-Substring|List], StringIndex-List) :-
    Dict.(StringIndex.index) = MatchStart-MatchLen,
    sub_string(StringIndex.string, MatchStart, MatchLen, _, Substring).

And can be used with this query (note the capture_type(range) option, which is needed by range_match/3, and greedy(false) to invert the meaning of *?):

?- String = "{START} Mary {END} had a {START} little lamb {END}",
   re_foldl(range_match,
            "{START} *?(?<piece>.*) *?{END}",
            String, _{string:String,index:piece}-Matches, _-[],
            [capture_type(range),greedy(false)]).
Matches = [8-"Mary", 33-"little lamb"].