This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Import perl5321delta.pod
[perl5.git] / regcomp.c
CommitLineData
a0d0e21e
LW		 1/* regcomp.c
2 */
3
4/*
4ac71550
TC		 5 * 'A fair jaw-cracker dwarf-language must be.' --Samwise Gamgee
6 *
7 * [p.285 of _The Lord of the Rings_, II/iii: "The Ring Goes South"]
a0d0e21e
LW		 8 */
9
61296642
DM		 10/* This file contains functions for compiling a regular expression. See
11 * also regexec.c which funnily enough, contains functions for executing
166f8a29 12 * a regular expression.
e4a054ea
DM		 13 *
14 * This file is also copied at build time to ext/re/re_comp.c, where
15 * it's built with -DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG -DPERL_EXT.
16 * This causes the main functions to be compiled under new names and with
17 * debugging support added, which makes "use re 'debug'" work.
166f8a29
DM		 18 */
19
a687059c
LW		 20/* NOTE: this is derived from Henry Spencer's regexp code, and should not
21 * confused with the original package (see point 3 below). Thanks, Henry!
22 */
23
24/* Additional note: this code is very heavily munged from Henry's version
25 * in places. In some spots I've traded clarity for efficiency, so don't
26 * blame Henry for some of the lack of readability.
27 */
28
e50aee73 29/* The names of the functions have been changed from regcomp and
3b753521 30 * regexec to pregcomp and pregexec in order to avoid conflicts
e50aee73
AD		 31 * with the POSIX routines of the same names.
32*/
33
b9d5759e 34#ifdef PERL_EXT_RE_BUILD
54df2634 35#include "re_top.h"
b81d288d 36#endif
56953603 37
a687059c 38/*
e50aee73 39 * pregcomp and pregexec -- regsub and regerror are not used in perl
a687059c
LW		 40 *
41 * Copyright (c) 1986 by University of Toronto.
42 * Written by Henry Spencer. Not derived from licensed software.
43 *
44 * Permission is granted to anyone to use this software for any
45 * purpose on any computer system, and to redistribute it freely,
46 * subject to the following restrictions:
47 *
48 * 1. The author is not responsible for the consequences of use of
49 * this software, no matter how awful, even if they arise
50 * from defects in it.
51 *
52 * 2. The origin of this software must not be misrepresented, either
53 * by explicit claim or by omission.
54 *
55 * 3. Altered versions must be plainly marked as such, and must not
56 * be misrepresented as being the original software.
57 *
58 *
59 **** Alterations to Henry's code are...
60 ****
4bb101f2 61 **** Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
1129b882
NC		 62 **** 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
63 **** by Larry Wall and others
a687059c 64 ****
9ef589d8
LW		 65 **** You may distribute under the terms of either the GNU General Public
66 **** License or the Artistic License, as specified in the README file.
67
a687059c
LW		 68 *
69 * Beware that some of this code is subtly aware of the way operator
70 * precedence is structured in regular expressions. Serious changes in
71 * regular-expression syntax might require a total rethink.
72 */
aa2885ce
KW		 73
74/* Note on debug output:
75 *
76 * This is set up so that -Dr turns on debugging like all other flags that are
77 * enabled by -DDEBUGGING. -Drv gives more verbose output. This applies to
78 * all regular expressions encountered in a program, and gives a huge amount of
79 * output for all but the shortest programs.
80 *
81 * The ability to output pattern debugging information lexically, and with much
82 * finer grained control was added, with 'use re qw(Debug ....);' available even
83 * in non-DEBUGGING builds. This is accomplished by copying the contents of
84 * regcomp.c to ext/re/re_comp.c, and regexec.c is copied to ext/re/re_exec.c.
85 * Those files are compiled and linked into the perl executable, and they are
86 * compiled essentially as if DEBUGGING were enabled, and controlled by calls
87 * to re.pm.
88 *
89 * That would normally mean linking errors when two functions of the same name
90 * are attempted to be placed into the same executable. That is solved in one
91 * of four ways:
92 * 1) Static functions aren't known outside the file they are in, so for the
93 * many functions of that type in this file, it just isn't a problem.
94 * 2) Most externally known functions are enclosed in
95 * #ifndef PERL_IN_XSUB_RE
96 * ...
97 * #endif
98 * blocks, so there is only one defintion for them in the whole
99 * executable, the one in regcomp.c (or regexec.c). The implication of
100 * that is any debugging info that comes from them is controlled only by
101 * -Dr. Further, any static function they call will also be the version
102 * in regcomp.c (or regexec.c), so its debugging will also be by -Dr.
103 * 3) About a dozen external functions are re-#defined in ext/re/re_top.h, to
104 * have different names, so that what gets loaded in the executable is
105 * 'Perl_foo' from regcomp.c (and regexec.c), and the identical function
106 * from re_comp.c (and re_exec.c), but with the name 'my_foo' Debugging
107 * in the 'Perl_foo' versions is controlled by -Dr, but the 'my_foo'
108 * versions and their callees are under control of re.pm. The catch is
109 * that references to all these go through the regexp_engine structure,
110 * which is initialized in regcomp.h to the Perl_foo versions, and
111 * substituted out in lexical scopes where 'use re' is in effect to the
112 * 'my_foo' ones. That structure is public API, so it would be a hard
113 * sell to add any additional members.
114 * 4) For functions in regcomp.c and re_comp.c that are called only from,
115 * respectively, regexec.c and re_exec.c, they can have two different
116 * names, depending on #ifdef'ing PERL_IN_XSUB_RE, in both regexec.c and
117 * embed.fnc.
118 *
119 * The bottom line is that if you add code to one of the public functions
120 * listed in ext/re/re_top.h, debugging automagically works. But if you write
121 * a new function that needs to do debugging or there is a chain of calls from
122 * it that need to do debugging, all functions in the chain should use options
123 * 2) or 4) above.
124 *
125 * A function may have to be split so that debugging stuff is static, but it
126 * calls out to some other function that only gets compiled in regcomp.c to
127 * access data that we don't want to duplicate.
128 */
129
a687059c 130#include "EXTERN.h"
864dbfa3 131#define PERL_IN_REGCOMP_C
a687059c 132#include "perl.h"
d06ea78c 133
c277df42 134#define REG_COMP_C
54df2634
NC		 135#ifdef PERL_IN_XSUB_RE
136# include "re_comp.h"
afda64e8 137EXTERN_C const struct regexp_engine my_reg_engine;
51bd1941 138EXTERN_C const struct regexp_engine wild_reg_engine;
54df2634
NC		 139#else
140# include "regcomp.h"
141#endif
a687059c 142
b992490d 143#include "invlist_inline.h"
1b0f46bf 144#include "unicode_constants.h"
04e98a4d 145
a687059c
LW		 146#ifndef STATIC
147#define STATIC static
148#endif
149
3f910e62
YO		 150/* this is a chain of data about sub patterns we are processing that
151 need to be handled separately/specially in study_chunk. Its so
152 we can simulate recursion without losing state. */
153struct scan_frame;
154typedef struct scan_frame {
155 regnode *last_regnode; /* last node to process in this frame */
156 regnode *next_regnode; /* next node to process when last is reached */
157 U32 prev_recursed_depth;
158 I32 stopparen; /* what stopparen do we use */
089ad25d 159 bool in_gosub; /* this or an outer frame is for GOSUB */
3f910e62
YO		 160
161 struct scan_frame *this_prev_frame; /* this previous frame */
162 struct scan_frame *prev_frame; /* previous frame */
163 struct scan_frame *next_frame; /* next frame */
164} scan_frame;
165
f4ae5a27
KW		 166/* Certain characters are output as a sequence with the first being a
167 * backslash. */
4aada8b9 168#define isBACKSLASHED_PUNCT(c) memCHRs("-[]\\^", c)
f4ae5a27
KW		 169
170
09b2b2e6 171struct RExC_state_t {
514a91f1
DM		 172 U32 flags; /* RXf_* are we folding, multilining? */
173 U32 pm_flags; /* PMf_* stuff from the calling PMOP */
830247a4 174 char *precomp; /* uncompiled string. */
711b303b 175 char *precomp_end; /* pointer to end of uncompiled string. */
288b8c02 176 REGEXP *rx_sv; /* The SV that is the regexp. */
f8fc2ecf 177 regexp *rx; /* perl core regexp structure */
538e84ed
KW		 178 regexp_internal *rxi; /* internal data for regexp object
179 pprivate field */
fac92740 180 char *start; /* Start of input for compile */
830247a4
IZ		 181 char *end; /* End of input for compile */
182 char *parse; /* Input-scan pointer. */
51684e3c
KW		 183 char *copy_start; /* start of copy of input within
184 constructed parse string */
cc16d262
KW		 185 char *save_copy_start; /* Provides one level of saving
186 and restoring 'copy_start' */
51684e3c
KW		 187 char *copy_start_in_input; /* Position in input string
188 corresponding to copy_start */
ea3daa5d 189 SSize_t whilem_seen; /* number of WHILEM in this expr */
fac92740 190 regnode *emit_start; /* Start of emitted-code area */
f55b7b26 191 regnode_offset emit; /* Code-emit pointer */
830247a4
IZ		 192 I32 naughty; /* How bad is this pattern? */
193 I32 sawback; /* Did we see \1, ...? */
88f063b4
KW		 194 SSize_t size; /* Number of regnode equivalents in
195 pattern */
d8d1dede
KW		 196 Size_t sets_depth; /* Counts recursion depth of already-
197 compiled regex set patterns */
2475254e
RL		 198 U32 seen;
199
200 I32 parens_buf_size; /* #slots malloced open/close_parens */
201 regnode_offset *open_parens; /* offsets to open parens */
202 regnode_offset *close_parens; /* offsets to close parens */
203 HV *paren_names; /* Paren names */
7c932d07
KW		 204
205 /* position beyond 'precomp' of the warning message furthest away from
206 * 'precomp'. During the parse, no warnings are raised for any problems
207 * earlier in the parse than this position. This works if warnings are
208 * raised the first time a given spot is parsed, and if only one
209 * independent warning is raised for any given spot */
210 Size_t latest_warn_offset;
211
212 I32 npar; /* Capture buffer count so far in the
213 parse, (OPEN) plus one. ("par" 0 is
214 the whole pattern)*/
215 I32 total_par; /* During initial parse, is either 0,
216 or -1; the latter indicating a
217 reparse is needed. After that pass,
218 it is what 'npar' became after the
219 pass. Hence, it being > 0 indicates
220 we are in a reparse situation */
538e84ed
KW		 221 I32 nestroot; /* root parens we are in - used by
222 accept */
830247a4 223 I32 seen_zerolen;
d5a00e4a 224 regnode *end_op; /* END node in program */
02daf0ab
YO		 225 I32 utf8; /* whether the pattern is utf8 or not */
226 I32 orig_utf8; /* whether the pattern was originally in utf8 */
a7b8d88a
KW		 227 /* XXX use this for future optimisation of case
228 * where pattern must be upgraded to utf8. */
e40e74fe 229 I32 uni_semantics; /* If a d charset modifier should use unicode
a7b8d88a
KW		 230 rules, even if the pattern is not in
231 utf8 */
538e84ed 232
88f063b4 233 I32 recurse_count; /* Number of recurse regops we have generated */
2475254e 234 regnode **recurse; /* Recurse regops */
4286711a 235 U8 *study_chunk_recursed; /* bitmap of which subs we have moved
538e84ed 236 through */
09a65838 237 U32 study_chunk_recursed_bytes; /* bytes in bitmap */
80f44cf4 238 I32 in_lookaround;
4624b182 239 I32 contains_locale;
bb3f3ed2 240 I32 override_recoding;
4caef9c3 241 I32 recode_x_to_native;
9d53c457 242 I32 in_multi_char_class;
2475254e 243 int code_index; /* next code_blocks[] slot */
1acab4c5 244 struct reg_code_blocks *code_blocks;/* positions of literal (?{})
a7b8d88a 245 within pattern */
ee273784 246 SSize_t maxlen; /* mininum possible number of chars in string to match */
3f910e62
YO		 247 scan_frame *frame_head;
248 scan_frame *frame_last;
249 U32 frame_count;
7eec73eb 250 AV *warn_text;
945961fd 251 HV *unlexed_names;
d24ca0c5 252 SV *runtime_code_qr; /* qr with the runtime code blocks */
3dab1dad 253#ifdef DEBUGGING
be8e71aa 254 const char *lastparse;
3dab1dad 255 I32 lastnum;
d9a72fcc 256 U32 study_chunk_recursed_count;
2475254e 257 AV *paren_name_list; /* idx -> name */
c9f0d54c
YO		 258 SV *mysv1;
259 SV *mysv2;
88f063b4 260
3dab1dad
YO		 261#define RExC_lastparse (pRExC_state->lastparse)
262#define RExC_lastnum (pRExC_state->lastnum)
1f1031fe 263#define RExC_paren_name_list (pRExC_state->paren_name_list)
d9a72fcc 264#define RExC_study_chunk_recursed_count (pRExC_state->study_chunk_recursed_count)
c9f0d54c
YO		 265#define RExC_mysv (pRExC_state->mysv1)
266#define RExC_mysv1 (pRExC_state->mysv1)
267#define RExC_mysv2 (pRExC_state->mysv2)
268
3dab1dad 269#endif
bd0b62a6 270 bool seen_d_op;
911bd04e 271 bool strict;
da7cf1cc 272 bool study_started;
034602eb 273 bool in_script_run;
7c932d07 274 bool use_BRANCHJ;
5aabce33
KW		 275 bool sWARN_EXPERIMENTAL__VLB;
276 bool sWARN_EXPERIMENTAL__REGEX_SETS;
09b2b2e6 277};
830247a4 278
e2509266 279#define RExC_flags (pRExC_state->flags)
514a91f1 280#define RExC_pm_flags (pRExC_state->pm_flags)
830247a4 281#define RExC_precomp (pRExC_state->precomp)
51684e3c
KW		 282#define RExC_copy_start_in_input (pRExC_state->copy_start_in_input)
283#define RExC_copy_start_in_constructed (pRExC_state->copy_start)
cc16d262 284#define RExC_save_copy_start_in_constructed (pRExC_state->save_copy_start)
711b303b 285#define RExC_precomp_end (pRExC_state->precomp_end)
288b8c02 286#define RExC_rx_sv (pRExC_state->rx_sv)
830247a4 287#define RExC_rx (pRExC_state->rx)
f8fc2ecf 288#define RExC_rxi (pRExC_state->rxi)
fac92740 289#define RExC_start (pRExC_state->start)
830247a4
IZ		 290#define RExC_end (pRExC_state->end)
291#define RExC_parse (pRExC_state->parse)
7c932d07 292#define RExC_latest_warn_offset (pRExC_state->latest_warn_offset )
830247a4 293#define RExC_whilem_seen (pRExC_state->whilem_seen)
bd0b62a6
KW		 294#define RExC_seen_d_op (pRExC_state->seen_d_op) /* Seen something that differs
295 under /d from /u ? */
512c0f5a 296
7122b237 297#ifdef RE_TRACK_PATTERN_OFFSETS
44f36cd3 298# define RExC_offsets (RExC_rxi->u.offsets) /* I am not like the
538e84ed 299 others */
7122b237 300#endif
830247a4 301#define RExC_emit (pRExC_state->emit)
fac92740 302#define RExC_emit_start (pRExC_state->emit_start)
830247a4
IZ		 303#define RExC_sawback (pRExC_state->sawback)
304#define RExC_seen (pRExC_state->seen)
305#define RExC_size (pRExC_state->size)
ee273784 306#define RExC_maxlen (pRExC_state->maxlen)
830247a4 307#define RExC_npar (pRExC_state->npar)
1533d1d2 308#define RExC_total_parens (pRExC_state->total_par)
0275405c 309#define RExC_parens_buf_size (pRExC_state->parens_buf_size)
e2e6a0f1 310#define RExC_nestroot (pRExC_state->nestroot)
830247a4 311#define RExC_seen_zerolen (pRExC_state->seen_zerolen)
1aa99e6b 312#define RExC_utf8 (pRExC_state->utf8)
e40e74fe 313#define RExC_uni_semantics (pRExC_state->uni_semantics)
02daf0ab 314#define RExC_orig_utf8 (pRExC_state->orig_utf8)
40d049e4
YO		 315#define RExC_open_parens (pRExC_state->open_parens)
316#define RExC_close_parens (pRExC_state->close_parens)
5bd2d46e 317#define RExC_end_op (pRExC_state->end_op)
81714fb9 318#define RExC_paren_names (pRExC_state->paren_names)
40d049e4
YO		 319#define RExC_recurse (pRExC_state->recurse)
320#define RExC_recurse_count (pRExC_state->recurse_count)
d8d1dede 321#define RExC_sets_depth (pRExC_state->sets_depth)
09a65838 322#define RExC_study_chunk_recursed (pRExC_state->study_chunk_recursed)
538e84ed
KW		 323#define RExC_study_chunk_recursed_bytes \
324 (pRExC_state->study_chunk_recursed_bytes)
80f44cf4 325#define RExC_in_lookaround (pRExC_state->in_lookaround)
4624b182 326#define RExC_contains_locale (pRExC_state->contains_locale)
4caef9c3
KW		 327#define RExC_recode_x_to_native (pRExC_state->recode_x_to_native)
328
b6d67071 329#ifdef EBCDIC
4caef9c3
KW		 330# define SET_recode_x_to_native(x) \
331 STMT_START { RExC_recode_x_to_native = (x); } STMT_END
332#else
333# define SET_recode_x_to_native(x) NOOP
b6d67071 334#endif
4caef9c3 335
9d53c457 336#define RExC_in_multi_char_class (pRExC_state->in_multi_char_class)
3f910e62
YO		 337#define RExC_frame_head (pRExC_state->frame_head)
338#define RExC_frame_last (pRExC_state->frame_last)
339#define RExC_frame_count (pRExC_state->frame_count)
67cdf558 340#define RExC_strict (pRExC_state->strict)
da7cf1cc 341#define RExC_study_started (pRExC_state->study_started)
7eec73eb 342#define RExC_warn_text (pRExC_state->warn_text)
034602eb 343#define RExC_in_script_run (pRExC_state->in_script_run)
7c932d07 344#define RExC_use_BRANCHJ (pRExC_state->use_BRANCHJ)
5aabce33
KW		 345#define RExC_warned_WARN_EXPERIMENTAL__VLB (pRExC_state->sWARN_EXPERIMENTAL__VLB)
346#define RExC_warned_WARN_EXPERIMENTAL__REGEX_SETS (pRExC_state->sWARN_EXPERIMENTAL__REGEX_SETS)
945961fd 347#define RExC_unlexed_names (pRExC_state->unlexed_names)
830247a4 348
99807a43
HS		 349/* Heuristic check on the complexity of the pattern: if TOO_NAUGHTY, we set
350 * a flag to disable back-off on the fixed/floating substrings - if it's
351 * a high complexity pattern we assume the benefit of avoiding a full match
352 * is worth the cost of checking for the substrings even if they rarely help.
353 */
354#define RExC_naughty (pRExC_state->naughty)
355#define TOO_NAUGHTY (10)
356#define MARK_NAUGHTY(add) \
357 if (RExC_naughty < TOO_NAUGHTY) \
358 RExC_naughty += (add)
359#define MARK_NAUGHTY_EXP(exp, add) \
360 if (RExC_naughty < TOO_NAUGHTY) \
361 RExC_naughty += RExC_naughty / (exp) + (add)
cde0cee5 362
a7b8d88a
KW		 363#define isNON_BRACE_QUANTIFIER(c) ((c) == '*' || (c) == '+' || (c) == '?')
364#define isQUANTIFIER(s,e) ( isNON_BRACE_QUANTIFIER(*s) \
e513125a 365 || ((*s) == '{' && regcurly(s, e, NULL)))
a687059c
LW		 366
367/*
368 * Flags to be passed up and down.
369 */
c4ead770
KW		 370#define HASWIDTH 0x01 /* Known to not match null strings, could match
371 non-null ones. */
fc7dfe8e
HS		 372#define SIMPLE 0x02 /* Exactly one character wide */
373 /* (or LNBREAK as a special case) */
8d9c2815
NC		 374#define POSTPONED 0x08 /* (?1),(?&name), (??{...}) or similar */
375#define TRYAGAIN 0x10 /* Weeded out a declaration. */
c36361b2
KW		 376#define RESTART_PARSE 0x20 /* Need to redo the parse */
377#define NEED_UTF8 0x40 /* In conjunction with RESTART_PARSE, need to
378 calcuate sizes as UTF-8 */
a687059c 379
3dab1dad
YO		 380#define REG_NODE_NUM(x) ((x) ? (int)((x)-RExC_emit_start) : -1)
381
07be1b83
YO		 382/* whether trie related optimizations are enabled */
383#if PERL_ENABLE_EXTENDED_TRIE_OPTIMISATION
384#define TRIE_STUDY_OPT
786e8c11 385#define FULL_TRIE_STUDY
07be1b83
YO		 386#define TRIE_STCLASS
387#endif
1de06328
YO		 388
389
40d049e4
YO		 390
391#define PBYTE(u8str,paren) ((U8*)(u8str))[(paren) >> 3]
392#define PBITVAL(paren) (1 << ((paren) & 7))
ac3ef366
HS		 393#define PAREN_OFFSET(depth) \
394 (RExC_study_chunk_recursed + (depth) * RExC_study_chunk_recursed_bytes)
395#define PAREN_TEST(depth, paren) \
396 (PBYTE(PAREN_OFFSET(depth), paren) & PBITVAL(paren))
397#define PAREN_SET(depth, paren) \
398 (PBYTE(PAREN_OFFSET(depth), paren) |= PBITVAL(paren))
399#define PAREN_UNSET(depth, paren) \
400 (PBYTE(PAREN_OFFSET(depth), paren) &= ~PBITVAL(paren))
40d049e4 401
82a6ada4 402#define REQUIRE_UTF8(flagp) STMT_START { \
8d9c2815 403 if (!UTF) { \
c36361b2 404 *flagp = RESTART_PARSE|NEED_UTF8; \
f55b7b26 405 return 0; \
8d9c2815 406 } \
82a6ada4 407 } STMT_END
40d049e4 408
bb58640a
KW		 409/* /u is to be chosen if we are supposed to use Unicode rules, or if the
410 * pattern is in UTF-8. This latter condition is in case the outermost rules
411 * are locale. See GH #17278 */
412#define toUSE_UNI_CHARSET_NOT_DEPENDS (RExC_uni_semantics || UTF)
413
d63d75f5 414/* Change from /d into /u rules, and restart the parse. RExC_uni_semantics is
f6e8f31e
KW		 415 * a flag that indicates we need to override /d with /u as a result of
416 * something in the pattern. It should only be used in regards to calling
b2090782 417 * set_regex_charset() or get_regex_charset() */
512c0f5a
KW		 418#define REQUIRE_UNI_RULES(flagp, restart_retval) \
419 STMT_START { \
420 if (DEPENDS_SEMANTICS) { \
512c0f5a
KW		 421 set_regex_charset(&RExC_flags, REGEX_UNICODE_CHARSET); \
422 RExC_uni_semantics = 1; \
b76e1c04 423 if (RExC_seen_d_op && LIKELY(! IN_PARENS_PASS)) { \
bd0b62a6
KW		 424 /* No need to restart the parse if we haven't seen \
425 * anything that differs between /u and /d, and no need \
426 * to restart immediately if we're going to reparse \
427 * anyway to count parens */ \
c36361b2 428 *flagp |= RESTART_PARSE; \
512c0f5a 429 return restart_retval; \
d1be211c 430 } \
512c0f5a
KW		 431 } \
432 } STMT_END
433
7c932d07
KW		 434#define REQUIRE_BRANCHJ(flagp, restart_retval) \
435 STMT_START { \
436 RExC_use_BRANCHJ = 1; \
439a3bfe
KW		 437 *flagp |= RESTART_PARSE; \
438 return restart_retval; \
7c932d07
KW		 439 } STMT_END
440
b76e1c04
KW		 441/* Until we have completed the parse, we leave RExC_total_parens at 0 or
442 * less. After that, it must always be positive, because the whole re is
443 * considered to be surrounded by virtual parens. Setting it to negative
444 * indicates there is some construct that needs to know the actual number of
445 * parens to be properly handled. And that means an extra pass will be
446 * required after we've counted them all */
447#define ALL_PARENS_COUNTED (RExC_total_parens > 0)
7c932d07 448#define REQUIRE_PARENS_PASS \
b76e1c04
KW		 449 STMT_START { /* No-op if have completed a pass */ \
450 if (! ALL_PARENS_COUNTED) RExC_total_parens = -1; \
7c932d07 451 } STMT_END
b76e1c04
KW		 452#define IN_PARENS_PASS (RExC_total_parens < 0)
453
7c932d07 454
f358228e
KW		 455/* This is used to return failure (zero) early from the calling function if
456 * various flags in 'flags' are set. Two flags always cause a return:
457 * 'RESTART_PARSE' and 'NEED_UTF8'. 'extra' can be used to specify any
458 * additional flags that should cause a return; 0 if none. If the return will
459 * be done, '*flagp' is first set to be all of the flags that caused the
460 * return. */
461#define RETURN_FAIL_ON_RESTART_OR_FLAGS(flags,flagp,extra) \
fd7fc6ae 462 STMT_START { \
c36361b2
KW		 463 if ((flags) & (RESTART_PARSE|NEED_UTF8|(extra))) { \
464 *(flagp) = (flags) & (RESTART_PARSE|NEED_UTF8|(extra)); \
f358228e 465 return 0; \
fd7fc6ae
YO		 466 } \
467 } STMT_END
468
c36361b2 469#define MUST_RESTART(flags) ((flags) & (RESTART_PARSE))
fd7fc6ae 470
5d555bb8 471#define RETURN_FAIL_ON_RESTART(flags,flagp) \
f358228e 472 RETURN_FAIL_ON_RESTART_OR_FLAGS( flags, flagp, 0)
5d555bb8 473#define RETURN_FAIL_ON_RESTART_FLAGP(flagp) \
f358228e 474 if (MUST_RESTART(*(flagp))) return 0
fd7fc6ae 475
f19b1a63
KW		 476/* This converts the named class defined in regcomp.h to its equivalent class
477 * number defined in handy.h. */
478#define namedclass_to_classnum(class) ((int) ((class) / 2))
479#define classnum_to_namedclass(classnum) ((classnum) * 2)
480
de92f5e6
KW		 481#define _invlist_union_complement_2nd(a, b, output) \
482 _invlist_union_maybe_complement_2nd(a, b, TRUE, output)
483#define _invlist_intersection_complement_2nd(a, b, output) \
484 _invlist_intersection_maybe_complement_2nd(a, b, TRUE, output)
485
4a808c87
KW		 486/* We add a marker if we are deferring expansion of a property that is both
487 * 1) potentiallly user-defined; and
488 * 2) could also be an official Unicode property.
489 *
490 * Without this marker, any deferred expansion can only be for a user-defined
491 * one. This marker shouldn't conflict with any that could be in a legal name,
492 * and is appended to its name to indicate this. There is a string and
493 * character form */
043cdb9a
KW		 494#define DEFERRED_COULD_BE_OFFICIAL_MARKERs "~"
495#define DEFERRED_COULD_BE_OFFICIAL_MARKERc '~'
1c2f3d7a 496
0069caf1
KW		 497/* What is infinity for optimization purposes */
498#define OPTIMIZE_INFTY SSize_t_MAX
499
1de06328
YO		 500/* About scan_data_t.
501
502 During optimisation we recurse through the regexp program performing
503 various inplace (keyhole style) optimisations. In addition study_chunk
504 and scan_commit populate this data structure with information about
538e84ed 505 what strings MUST appear in the pattern. We look for the longest
3b753521 506 string that must appear at a fixed location, and we look for the
1de06328
YO		 507 longest string that may appear at a floating location. So for instance
508 in the pattern:
538e84ed 509
1de06328 510 /FOO[xX]A.*B[xX]BAR/
538e84ed 511
1de06328
YO		 512 Both 'FOO' and 'A' are fixed strings. Both 'B' and 'BAR' are floating
513 strings (because they follow a .* construct). study_chunk will identify
514 both FOO and BAR as being the longest fixed and floating strings respectively.
538e84ed 515
1de06328 516 The strings can be composites, for instance
538e84ed 517
1de06328 518 /(f)(o)(o)/
538e84ed 519
1de06328 520 will result in a composite fixed substring 'foo'.
538e84ed 521
1de06328 522 For each string some basic information is maintained:
538e84ed 523
6ea77169 524 - min_offset
1de06328
YO		 525 This is the position the string must appear at, or not before.
526 It also implicitly (when combined with minlenp) tells us how many
3b753521
FN		 527 characters must match before the string we are searching for.
528 Likewise when combined with minlenp and the length of the string it
538e84ed 529 tells us how many characters must appear after the string we have
1de06328 530 found.
538e84ed 531
1de06328
YO		 532 - max_offset
533 Only used for floating strings. This is the rightmost point that
0069caf1 534 the string can appear at. If set to OPTIMIZE_INFTY it indicates that the
1de06328 535 string can occur infinitely far to the right.
6e12f832 536 For fixed strings, it is equal to min_offset.
538e84ed 537
1de06328 538 - minlenp
2d608413
KW		 539 A pointer to the minimum number of characters of the pattern that the
540 string was found inside. This is important as in the case of positive
538e84ed 541 lookahead or positive lookbehind we can have multiple patterns
1de06328 542 involved. Consider
538e84ed 543
1de06328 544 /(?=FOO).*F/
538e84ed 545
1de06328
YO		 546 The minimum length of the pattern overall is 3, the minimum length
547 of the lookahead part is 3, but the minimum length of the part that
538e84ed 548 will actually match is 1. So 'FOO's minimum length is 3, but the
1de06328 549 minimum length for the F is 1. This is important as the minimum length
538e84ed 550 is used to determine offsets in front of and behind the string being
1de06328 551 looked for. Since strings can be composites this is the length of the
486ec47a 552 pattern at the time it was committed with a scan_commit. Note that
1de06328 553 the length is calculated by study_chunk, so that the minimum lengths
538e84ed 554 are not known until the full pattern has been compiled, thus the
1de06328 555 pointer to the value.
538e84ed 556
1de06328 557 - lookbehind
538e84ed 558
1de06328 559 In the case of lookbehind the string being searched for can be
538e84ed 560 offset past the start point of the final matching string.
1de06328
YO		 561 If this value was just blithely removed from the min_offset it would
562 invalidate some of the calculations for how many chars must match
563 before or after (as they are derived from min_offset and minlen and
538e84ed 564 the length of the string being searched for).
1de06328
YO		 565 When the final pattern is compiled and the data is moved from the
566 scan_data_t structure into the regexp structure the information
538e84ed
KW		 567 about lookbehind is factored in, with the information that would
568 have been lost precalculated in the end_shift field for the
1de06328
YO		 569 associated string.
570
571 The fields pos_min and pos_delta are used to store the minimum offset
538e84ed 572 and the delta to the maximum offset at the current point in the pattern.
1de06328
YO		 573
574*/
2c2d71f5 575
cb6aef8b
DM		 576struct scan_data_substrs {
577 SV *str; /* longest substring found in pattern */
578 SSize_t min_offset; /* earliest point in string it can appear */
579 SSize_t max_offset; /* latest point in string it can appear */
580 SSize_t *minlenp; /* pointer to the minlen relevant to the string */
581 SSize_t lookbehind; /* is the pos of the string modified by LB */
11683ecb 582 I32 flags; /* per substring SF_* and SCF_* flags */
cb6aef8b
DM		 583};
584
2c2d71f5 585typedef struct scan_data_t {
1de06328
YO		 586 /*I32 len_min; unused */
587 /*I32 len_delta; unused */
49f55535 588 SSize_t pos_min;
ea3daa5d 589 SSize_t pos_delta;
2c2d71f5 590 SV *last_found;
ea3daa5d 591 SSize_t last_end; /* min value, <0 unless valid. */
49f55535 592 SSize_t last_start_min;
ea3daa5d 593 SSize_t last_start_max;
2099df82
DM		 594 U8 cur_is_floating; /* whether the last_* values should be set as
595 * the next fixed (0) or floating (1)
596 * substring */
6ea77169 597
2099df82
DM		 598 /* [0] is longest fixed substring so far, [1] is longest float so far */
599 struct scan_data_substrs substrs[2];
6ea77169 600
11683ecb 601 I32 flags; /* common SF_* and SCF_* flags */
2c2d71f5 602 I32 whilem_c;
49f55535 603 SSize_t *last_closep;
b8f7bb16 604 regnode_ssc *start_class;
2c2d71f5
JH		 605} scan_data_t;
606
a687059c 607/*
e50aee73 608 * Forward declarations for pregcomp()'s friends.
a687059c 609 */
a0d0e21e 610
6ea77169 611static const scan_data_t zero_scan_data = {
a2ca2017 612 0, 0, NULL, 0, 0, 0, 0,
6ea77169 613 {
11683ecb
DM		 614 { NULL, 0, 0, 0, 0, 0 },
615 { NULL, 0, 0, 0, 0, 0 },
6ea77169
DM		 616 },
617 0, 0, NULL, NULL
618};
c277df42 619
11683ecb
DM		 620/* study flags */
621
07be1b83
YO		 622#define SF_BEFORE_SEOL 0x0001
623#define SF_BEFORE_MEOL 0x0002
11683ecb 624#define SF_BEFORE_EOL (SF_BEFORE_SEOL|SF_BEFORE_MEOL)
c277df42 625
07be1b83
YO		 626#define SF_IS_INF 0x0040
627#define SF_HAS_PAR 0x0080
628#define SF_IN_PAR 0x0100
629#define SF_HAS_EVAL 0x0200
bc604ad8
KW		 630
631
632/* SCF_DO_SUBSTR is the flag that tells the regexp analyzer to track the
633 * longest substring in the pattern. When it is not set the optimiser keeps
634 * track of position, but does not keep track of the actual strings seen,
635 *
636 * So for instance /foo/ will be parsed with SCF_DO_SUBSTR being true, but
637 * /foo/i will not.
638 *
639 * Similarly, /foo.*(blah|erm|huh).*fnorble/ will have "foo" and "fnorble"
640 * parsed with SCF_DO_SUBSTR on, but while processing the (...) it will be
641 * turned off because of the alternation (BRANCH). */
07be1b83 642#define SCF_DO_SUBSTR 0x0400
bc604ad8 643
653099ff
GS		 644#define SCF_DO_STCLASS_AND 0x0800
645#define SCF_DO_STCLASS_OR 0x1000
646#define SCF_DO_STCLASS (SCF_DO_STCLASS_AND|SCF_DO_STCLASS_OR)
e1901655 647#define SCF_WHILEM_VISITED_POS 0x2000
c277df42 648
786e8c11 649#define SCF_TRIE_RESTUDY 0x4000 /* Do restudy? */
538e84ed 650#define SCF_SEEN_ACCEPT 0x8000
688e0391 651#define SCF_TRIE_DOING_RESTUDY 0x10000
4286711a
YO		 652#define SCF_IN_DEFINE 0x20000
653
654
655
07be1b83 656
43fead97 657#define UTF cBOOL(RExC_utf8)
00b27cfc
KW		 658
659/* The enums for all these are ordered so things work out correctly */
a62b1201 660#define LOC (get_regex_charset(RExC_flags) == REGEX_LOCALE_CHARSET)
538e84ed
KW		 661#define DEPENDS_SEMANTICS (get_regex_charset(RExC_flags) \
662 == REGEX_DEPENDS_CHARSET)
00b27cfc 663#define UNI_SEMANTICS (get_regex_charset(RExC_flags) == REGEX_UNICODE_CHARSET)
538e84ed
KW		 664#define AT_LEAST_UNI_SEMANTICS (get_regex_charset(RExC_flags) \
665 >= REGEX_UNICODE_CHARSET)
666#define ASCII_RESTRICTED (get_regex_charset(RExC_flags) \
667 == REGEX_ASCII_RESTRICTED_CHARSET)
668#define AT_LEAST_ASCII_RESTRICTED (get_regex_charset(RExC_flags) \
669 >= REGEX_ASCII_RESTRICTED_CHARSET)
670#define ASCII_FOLD_RESTRICTED (get_regex_charset(RExC_flags) \
671 == REGEX_ASCII_MORE_RESTRICTED_CHARSET)
a62b1201 672
43fead97 673#define FOLD cBOOL(RExC_flags & RXf_PMf_FOLD)
a0ed51b3 674
f2c2a6ab
KW		 675/* For programs that want to be strictly Unicode compatible by dying if any
676 * attempt is made to match a non-Unicode code point against a Unicode
677 * property. */
678#define ALWAYS_WARN_SUPER ckDEAD(packWARN(WARN_NON_UNICODE))
679
93733859 680#define OOB_NAMEDCLASS -1
b8c5462f 681
8e661ac5
KW		 682/* There is no code point that is out-of-bounds, so this is problematic. But
683 * its only current use is to initialize a variable that is always set before
684 * looked at. */
685#define OOB_UNICODE 0xDEADBEEF
686
a0ed51b3 687#define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
a0ed51b3 688
8615cb43 689
b45f050a
JF		 690/* length of regex to show in messages that don't mark a position within */
691#define RegexLengthToShowInErrorMessages 127
692
693/*
694 * If MARKER[12] are adjusted, be sure to adjust the constants at the top
695 * of t/op/regmesg.t, the tests in t/op/re_tests, and those in
696 * op/pragma/warn/regcomp.
697 */
7253e4e3
RK		 698#define MARKER1 "<-- HERE" /* marker as it appears in the description */
699#define MARKER2 " <-- HERE " /* marker as it appears within the regex */
b81d288d 700
538e84ed 701#define REPORT_LOCATION " in regex; marked by " MARKER1 \
147e3846 702 " in m/%" UTF8f MARKER2 "%" UTF8f "/"
b45f050a 703
285b5ca0
KW		 704/* The code in this file in places uses one level of recursion with parsing
705 * rebased to an alternate string constructed by us in memory. This can take
706 * the form of something that is completely different from the input, or
707 * something that uses the input as part of the alternate. In the first case,
708 * there should be no possibility of an error, as we are in complete control of
51684e3c
KW		 709 * the alternate string. But in the second case we don't completely control
710 * the input portion, so there may be errors in that. Here's an example:
285b5ca0
KW		 711 * /[abc\x{DF}def]/ui
712 * is handled specially because \x{df} folds to a sequence of more than one
51684e3c 713 * character: 'ss'. What is done is to create and parse an alternate string,
285b5ca0
KW		 714 * which looks like this:
715 * /(?:\x{DF}|[abc\x{DF}def])/ui
716 * where it uses the input unchanged in the middle of something it constructs,
717 * which is a branch for the DF outside the character class, and clustering
718 * parens around the whole thing. (It knows enough to skip the DF inside the
719 * class while in this substitute parse.) 'abc' and 'def' may have errors that
720 * need to be reported. The general situation looks like this:
721 *
51684e3c 722 * |<------- identical ------>|
285b5ca0 723 * sI tI xI eI
51684e3c 724 * Input: ---------------------------------------------------------------
285b5ca0
KW		 725 * Constructed: ---------------------------------------------------
726 * sC tC xC eC EC
51684e3c 727 * |<------- identical ------>|
285b5ca0 728 *
51684e3c
KW		 729 * sI..eI is the portion of the input pattern we are concerned with here.
730 * sC..EC is the constructed substitute parse string.
731 * sC..tC is constructed by us
732 * tC..eC is an exact duplicate of the portion of the input pattern tI..eI.
733 * In the diagram, these are vertically aligned.
734 * eC..EC is also constructed by us.
735 * xC is the position in the substitute parse string where we found a
736 * problem.
737 * xI is the position in the original pattern corresponding to xC.
285b5ca0 738 *
51684e3c
KW		 739 * We want to display a message showing the real input string. Thus we need to
740 * translate from xC to xI. We know that xC >= tC, since the portion of the
741 * string sC..tC has been constructed by us, and so shouldn't have errors. We
742 * get:
743 * xI = tI + (xC - tC)
285b5ca0 744 *
51684e3c
KW		 745 * When the substitute parse is constructed, the code needs to set:
746 * RExC_start (sC)
747 * RExC_end (eC)
748 * RExC_copy_start_in_input (tI)
749 * RExC_copy_start_in_constructed (tC)
750 * and restore them when done.
285b5ca0 751 *
51684e3c
KW		 752 * During normal processing of the input pattern, both
753 * 'RExC_copy_start_in_input' and 'RExC_copy_start_in_constructed' are set to
754 * sI, so that xC equals xI.
285b5ca0
KW		 755 */
756
51684e3c
KW		 757#define sI RExC_precomp
758#define eI RExC_precomp_end
759#define sC RExC_start
760#define eC RExC_end
761#define tI RExC_copy_start_in_input
762#define tC RExC_copy_start_in_constructed
763#define xI(xC) (tI + (xC - tC))
764#define xI_offset(xC) (xI(xC) - sI)
285b5ca0
KW		 765
766#define REPORT_LOCATION_ARGS(xC) \
767 UTF8fARG(UTF, \
51684e3c 768 (xI(xC) > eI) /* Don't run off end */ \
232b691f 769 ? eI - sI /* Length before the <--HERE */ \
bc929b61
KW		 770 : ((xI_offset(xC) >= 0) \
771 ? xI_offset(xC) \
772 : (Perl_croak(aTHX_ "panic: %s: %d: negative offset: %" \
773 IVdf " trying to output message for " \
774 " pattern %.*s", \
51684e3c 775 __FILE__, __LINE__, (IV) xI_offset(xC), \
bc929b61 776 ((int) (eC - sC)), sC), 0)), \
51684e3c 777 sI), /* The input pattern printed up to the <--HERE */ \
285b5ca0 778 UTF8fARG(UTF, \
51684e3c
KW		 779 (xI(xC) > eI) ? 0 : eI - xI(xC), /* Length after <--HERE */ \
780 (xI(xC) > eI) ? eI : xI(xC)) /* pattern after <--HERE */
c1d900c3 781
8a6d8ec6
HS		 782/* Used to point after bad bytes for an error message, but avoid skipping
783 * past a nul byte. */
e3304382 784#define SKIP_IF_CHAR(s, e) (!*(s) ? 0 : UTF ? UTF8_SAFE_SKIP(s, e) : 1)
8a6d8ec6 785
ed68fe11
KW		 786/* Set up to clean up after our imminent demise */
787#define PREPARE_TO_DIE \
788 STMT_START { \
789 if (RExC_rx_sv) \
790 SAVEFREESV(RExC_rx_sv); \
7c932d07
KW		 791 if (RExC_open_parens) \
792 SAVEFREEPV(RExC_open_parens); \
793 if (RExC_close_parens) \
794 SAVEFREEPV(RExC_close_parens); \
ed68fe11
KW		 795 } STMT_END
796
b45f050a
JF		 797/*
798 * Calls SAVEDESTRUCTOR_X if needed, then calls Perl_croak with the given
799 * arg. Show regex, up to a maximum length. If it's too long, chop and add
800 * "...".
801 */
58e23c8d 802#define _FAIL(code) STMT_START { \
bfed75c6 803 const char *ellipses = ""; \
88f063b4 804 IV len = RExC_precomp_end - RExC_precomp; \
a7b8d88a 805 \
ed68fe11 806 PREPARE_TO_DIE; \
ccb2c380 807 if (len > RegexLengthToShowInErrorMessages) { \
a7b8d88a
KW		 808 /* chop 10 shorter than the max, to ensure meaning of "..." */ \
809 len = RegexLengthToShowInErrorMessages - 10; \
810 ellipses = "..."; \
ccb2c380 811 } \
58e23c8d 812 code; \
ccb2c380 813} STMT_END
8615cb43 814
58e23c8d 815#define FAIL(msg) _FAIL( \
147e3846 816 Perl_croak(aTHX_ "%s in regex m/%" UTF8f "%s/", \
a7b8d88a 817 msg, UTF8fARG(UTF, len, RExC_precomp), ellipses))
58e23c8d
YO		 818
819#define FAIL2(msg,arg) _FAIL( \
147e3846 820 Perl_croak(aTHX_ msg " in regex m/%" UTF8f "%s/", \
a7b8d88a 821 arg, UTF8fARG(UTF, len, RExC_precomp), ellipses))
58e23c8d 822
4b7718d6
KW		 823#define FAIL3(msg,arg1,arg2) _FAIL( \
824 Perl_croak(aTHX_ msg " in regex m/%" UTF8f "%s/", \
825 arg1, arg2, UTF8fARG(UTF, len, RExC_precomp), ellipses))
826
b45f050a 827/*
b45f050a
JF		 828 * Simple_vFAIL -- like FAIL, but marks the current location in the scan
829 */
ccb2c380 830#define Simple_vFAIL(m) STMT_START { \
ccb2c380 831 Perl_croak(aTHX_ "%s" REPORT_LOCATION, \
a7b8d88a 832 m, REPORT_LOCATION_ARGS(RExC_parse)); \
ccb2c380 833} STMT_END
b45f050a
JF		 834
835/*
836 * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL()
837 */
ccb2c380 838#define vFAIL(m) STMT_START { \
ed68fe11 839 PREPARE_TO_DIE; \
ccb2c380
MP		 840 Simple_vFAIL(m); \
841} STMT_END
b45f050a
JF		 842
843/*
844 * Like Simple_vFAIL(), but accepts two arguments.
845 */
ccb2c380 846#define Simple_vFAIL2(m,a1) STMT_START { \
c6572a6d 847 S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, \
d528642a 848 REPORT_LOCATION_ARGS(RExC_parse)); \
ccb2c380 849} STMT_END
b45f050a
JF		 850
851/*
852 * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL2().
853 */
ccb2c380 854#define vFAIL2(m,a1) STMT_START { \
ed68fe11 855 PREPARE_TO_DIE; \
ccb2c380
MP		 856 Simple_vFAIL2(m, a1); \
857} STMT_END
b45f050a
JF		 858
859
860/*
861 * Like Simple_vFAIL(), but accepts three arguments.
862 */
ccb2c380 863#define Simple_vFAIL3(m, a1, a2) STMT_START { \
c6572a6d 864 S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, a2, \
a7b8d88a 865 REPORT_LOCATION_ARGS(RExC_parse)); \
ccb2c380 866} STMT_END
b45f050a
JF		 867
868/*
869 * Calls SAVEDESTRUCTOR_X if needed, then Simple_vFAIL3().
870 */
ccb2c380 871#define vFAIL3(m,a1,a2) STMT_START { \
ed68fe11 872 PREPARE_TO_DIE; \
ccb2c380
MP		 873 Simple_vFAIL3(m, a1, a2); \
874} STMT_END
b45f050a
JF		 875
876/*
877 * Like Simple_vFAIL(), but accepts four arguments.
878 */
ccb2c380 879#define Simple_vFAIL4(m, a1, a2, a3) STMT_START { \
c6572a6d 880 S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, a2, a3, \
a7b8d88a 881 REPORT_LOCATION_ARGS(RExC_parse)); \
ccb2c380 882} STMT_END
b45f050a 883
95db3ffa 884#define vFAIL4(m,a1,a2,a3) STMT_START { \
ed68fe11 885 PREPARE_TO_DIE; \
95db3ffa
KW		 886 Simple_vFAIL4(m, a1, a2, a3); \
887} STMT_END
888
946095af 889/* A specialized version of vFAIL2 that works with UTF8f */
d528642a 890#define vFAIL2utf8f(m, a1) STMT_START { \
ed68fe11 891 PREPARE_TO_DIE; \
c6572a6d 892 S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, \
d528642a 893 REPORT_LOCATION_ARGS(RExC_parse)); \
946095af
BF		 894} STMT_END
895
3ba22297 896#define vFAIL3utf8f(m, a1, a2) STMT_START { \
ed68fe11 897 PREPARE_TO_DIE; \
c6572a6d 898 S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, a2, \
d528642a 899 REPORT_LOCATION_ARGS(RExC_parse)); \
3ba22297
KW		 900} STMT_END
901
d62e749e 902/* Setting this to NULL is a signal to not output warnings */
cc16d262
KW		 903#define TURN_OFF_WARNINGS_IN_SUBSTITUTE_PARSE \
904 STMT_START { \
905 RExC_save_copy_start_in_constructed = RExC_copy_start_in_constructed;\
906 RExC_copy_start_in_constructed = NULL; \
907 } STMT_END
908#define RESTORE_WARNINGS \
909 RExC_copy_start_in_constructed = RExC_save_copy_start_in_constructed
d62e749e 910
7c932d07
KW		 911/* Since a warning can be generated multiple times as the input is reparsed, we
912 * output it the first time we come to that point in the parse, but suppress it
913 * otherwise. 'RExC_copy_start_in_constructed' being NULL is a flag to not
914 * generate any warnings */
55bcf857 915#define TO_OUTPUT_WARNINGS(loc) \
7c932d07
KW		 916 ( RExC_copy_start_in_constructed \
917 && ((xI(loc)) - RExC_precomp) > (Ptrdiff_t) RExC_latest_warn_offset)
55bcf857 918
7c932d07
KW		 919/* After we've emitted a warning, we save the position in the input so we don't
920 * output it again */
921#define UPDATE_WARNINGS_LOC(loc) \
922 STMT_START { \
923 if (TO_OUTPUT_WARNINGS(loc)) { \
5d894ca5
KW		 924 RExC_latest_warn_offset = MAX(sI, MIN(eI, xI(loc))) \
925 - RExC_precomp; \
7c932d07
KW		 926 } \
927 } STMT_END
77ccba3c 928
086f21bf 929/* 'warns' is the output of the packWARNx macro used in 'code' */
f8220fe2
KW		 930#define _WARN_HELPER(loc, warns, code) \
931 STMT_START { \
d62e749e
KW		 932 if (! RExC_copy_start_in_constructed) { \
933 Perl_croak( aTHX_ "panic! %s: %d: Tried to warn when none" \
934 " expected at '%s'", \
935 __FILE__, __LINE__, loc); \
936 } \
55bcf857 937 if (TO_OUTPUT_WARNINGS(loc)) { \
086f21bf
KW		 938 if (ckDEAD(warns)) \
939 PREPARE_TO_DIE; \
338190a1 940 code; \
77ccba3c 941 UPDATE_WARNINGS_LOC(loc); \
338190a1 942 } \
f8220fe2 943 } STMT_END
946095af 944
5e0a247b 945/* m is not necessarily a "literal string", in this macro */
58ad8160
KW		 946#define warn_non_literal_string(loc, packed_warn, m) \
947 _WARN_HELPER(loc, packed_warn, \
948 Perl_warner(aTHX_ packed_warn, \
d528642a 949 "%s" REPORT_LOCATION, \
f8220fe2 950 m, REPORT_LOCATION_ARGS(loc)))
58ad8160
KW		 951#define reg_warn_non_literal_string(loc, m) \
952 warn_non_literal_string(loc, packWARN(WARN_REGEXP), m)
5e0a247b 953
eb761011
KW		 954#define ckWARN2_non_literal_string(loc, packwarn, m, a1) \
955 STMT_START { \
956 char * format; \
957 Size_t format_size = strlen(m) + strlen(REPORT_LOCATION)+ 1;\
958 Newx(format, format_size, char); \
959 my_strlcpy(format, m, format_size); \
960 my_strlcat(format, REPORT_LOCATION, format_size); \
961 SAVEFREEPV(format); \
962 _WARN_HELPER(loc, packwarn, \
963 Perl_ck_warner(aTHX_ packwarn, \
964 format, \
965 a1, REPORT_LOCATION_ARGS(loc))); \
966 } STMT_END
967
f8220fe2
KW		 968#define ckWARNreg(loc,m) \
969 _WARN_HELPER(loc, packWARN(WARN_REGEXP), \
970 Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \
d528642a 971 m REPORT_LOCATION, \
a7b8d88a 972 REPORT_LOCATION_ARGS(loc)))
ccb2c380 973
f8220fe2
KW		 974#define vWARN(loc, m) \
975 _WARN_HELPER(loc, packWARN(WARN_REGEXP), \
976 Perl_warner(aTHX_ packWARN(WARN_REGEXP), \
d528642a 977 m REPORT_LOCATION, \
f8220fe2 978 REPORT_LOCATION_ARGS(loc))) \
b927b7e9 979
f8220fe2
KW		 980#define vWARN_dep(loc, m) \
981 _WARN_HELPER(loc, packWARN(WARN_DEPRECATED), \
982 Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), \
d528642a 983 m REPORT_LOCATION, \
a7b8d88a 984 REPORT_LOCATION_ARGS(loc)))
0d6106aa 985
f8220fe2
KW		 986#define ckWARNdep(loc,m) \
987 _WARN_HELPER(loc, packWARN(WARN_DEPRECATED), \
988 Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), \
a7b8d88a
KW		 989 m REPORT_LOCATION, \
990 REPORT_LOCATION_ARGS(loc)))
147508a2 991
f8220fe2
KW		 992#define ckWARNregdep(loc,m) \
993 _WARN_HELPER(loc, packWARN2(WARN_DEPRECATED, WARN_REGEXP), \
994 Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, \
d528642a 995 WARN_REGEXP), \
a7b8d88a
KW		 996 m REPORT_LOCATION, \
997 REPORT_LOCATION_ARGS(loc)))
ccb2c380 998
f8220fe2
KW		 999#define ckWARN2reg_d(loc,m, a1) \
1000 _WARN_HELPER(loc, packWARN(WARN_REGEXP), \
1001 Perl_ck_warner_d(aTHX_ packWARN(WARN_REGEXP), \
a7b8d88a
KW		 1002 m REPORT_LOCATION, \
1003 a1, REPORT_LOCATION_ARGS(loc)))
2335b3d3 1004
f8220fe2
KW		 1005#define ckWARN2reg(loc, m, a1) \
1006 _WARN_HELPER(loc, packWARN(WARN_REGEXP), \
1007 Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \
d528642a 1008 m REPORT_LOCATION, \
f8220fe2 1009 a1, REPORT_LOCATION_ARGS(loc)))
ccb2c380 1010
f8220fe2
KW		 1011#define vWARN3(loc, m, a1, a2) \
1012 _WARN_HELPER(loc, packWARN(WARN_REGEXP), \
1013 Perl_warner(aTHX_ packWARN(WARN_REGEXP), \
d528642a 1014 m REPORT_LOCATION, \
a7b8d88a 1015 a1, a2, REPORT_LOCATION_ARGS(loc)))
ccb2c380 1016
f8220fe2
KW		 1017#define ckWARN3reg(loc, m, a1, a2) \
1018 _WARN_HELPER(loc, packWARN(WARN_REGEXP), \
1019 Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \
d528642a 1020 m REPORT_LOCATION, \
a7b8d88a 1021 a1, a2, \
f8220fe2 1022 REPORT_LOCATION_ARGS(loc)))
668c081a 1023
f8220fe2
KW		 1024#define vWARN4(loc, m, a1, a2, a3) \
1025 _WARN_HELPER(loc, packWARN(WARN_REGEXP), \
1026 Perl_warner(aTHX_ packWARN(WARN_REGEXP), \
d528642a 1027 m REPORT_LOCATION, \
a7b8d88a 1028 a1, a2, a3, \
f8220fe2 1029 REPORT_LOCATION_ARGS(loc)))
ccb2c380 1030
f8220fe2
KW		 1031#define ckWARN4reg(loc, m, a1, a2, a3) \
1032 _WARN_HELPER(loc, packWARN(WARN_REGEXP), \
1033 Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \
d528642a 1034 m REPORT_LOCATION, \
a7b8d88a 1035 a1, a2, a3, \
f8220fe2 1036 REPORT_LOCATION_ARGS(loc)))
668c081a 1037
f8220fe2
KW		 1038#define vWARN5(loc, m, a1, a2, a3, a4) \
1039 _WARN_HELPER(loc, packWARN(WARN_REGEXP), \
1040 Perl_warner(aTHX_ packWARN(WARN_REGEXP), \
d528642a 1041 m REPORT_LOCATION, \
a7b8d88a 1042 a1, a2, a3, a4, \
f8220fe2 1043 REPORT_LOCATION_ARGS(loc)))
9d1d55b5 1044
aea5f181 1045#define ckWARNexperimental(loc, class, m) \
5aabce33
KW		 1046 STMT_START { \
1047 if (! RExC_warned_ ## class) { /* warn once per compilation */ \
1048 RExC_warned_ ## class = 1; \
1049 _WARN_HELPER(loc, packWARN(class), \
aea5f181
KW		 1050 Perl_ck_warner_d(aTHX_ packWARN(class), \
1051 m REPORT_LOCATION, \
5aabce33
KW		 1052 REPORT_LOCATION_ARGS(loc)));\
1053 } \
1054 } STMT_END
aea5f181 1055
1a322bb4
KW		 1056/* Convert between a pointer to a node and its offset from the beginning of the
1057 * program */
1058#define REGNODE_p(offset) (RExC_emit_start + (offset))
1059#define REGNODE_OFFSET(node) ((node) - RExC_emit_start)
1060
538e84ed 1061/* Macros for recording node offsets. 20001227 mjd@plover.com
fac92740
MJD		 1062 * Nodes are numbered 1, 2, 3, 4. Node #n's position is recorded in
1063 * element 2*n-1 of the array. Element #2n holds the byte length node #n.
1064 * Element 0 holds the number n.
07be1b83 1065 * Position is 1 indexed.
fac92740 1066 */
7122b237 1067#ifndef RE_TRACK_PATTERN_OFFSETS
d7c442ce 1068#define Set_Node_Offset_To_R(offset,byte)
7122b237
YO		 1069#define Set_Node_Offset(node,byte)
1070#define Set_Cur_Node_Offset
1071#define Set_Node_Length_To_R(node,len)
1072#define Set_Node_Length(node,len)
6a86c6ad 1073#define Set_Node_Cur_Length(node,start)
538e84ed
KW		 1074#define Node_Offset(n)
1075#define Node_Length(n)
7122b237
YO		 1076#define Set_Node_Offset_Length(node,offset,len)
1077#define ProgLen(ri) ri->u.proglen
1078#define SetProgLen(ri,x) ri->u.proglen = x
4cbeff97 1079#define Track_Code(code)
7122b237
YO		 1080#else
1081#define ProgLen(ri) ri->u.offsets[0]
1082#define SetProgLen(ri,x) ri->u.offsets[0] = x
d7c442ce 1083#define Set_Node_Offset_To_R(offset,byte) STMT_START { \
a7b8d88a
KW		 1084 MJD_OFFSET_DEBUG(("** (%d) offset of node %d is %d.\n", \
1085 __LINE__, (int)(offset), (int)(byte))); \
1086 if((offset) < 0) { \
1087 Perl_croak(aTHX_ "value of node is %d in Offset macro", \
d7c442ce 1088 (int)(offset)); \
a7b8d88a 1089 } else { \
d7c442ce 1090 RExC_offsets[2*(offset)-1] = (byte); \
a7b8d88a 1091 } \
ccb2c380
MP		 1092} STMT_END
1093
88f063b4 1094#define Set_Node_Offset(node,byte) \
1a322bb4 1095 Set_Node_Offset_To_R(REGNODE_OFFSET(node), (byte)-RExC_start)
ccb2c380
MP		 1096#define Set_Cur_Node_Offset Set_Node_Offset(RExC_emit, RExC_parse)
1097
1098#define Set_Node_Length_To_R(node,len) STMT_START { \
a7b8d88a
KW		 1099 MJD_OFFSET_DEBUG(("** (%d) size of node %d is %d.\n", \
1100 __LINE__, (int)(node), (int)(len))); \
1101 if((node) < 0) { \
1102 Perl_croak(aTHX_ "value of node is %d in Length macro", \
538e84ed 1103 (int)(node)); \
a7b8d88a
KW		 1104 } else { \
1105 RExC_offsets[2*(node)] = (len); \
1106 } \
ccb2c380
MP		 1107} STMT_END
1108
1109#define Set_Node_Length(node,len) \
1a322bb4 1110 Set_Node_Length_To_R(REGNODE_OFFSET(node), len)
6a86c6ad
NC		 1111#define Set_Node_Cur_Length(node, start) \
1112 Set_Node_Length(node, RExC_parse - start)
fac92740
MJD		 1113
1114/* Get offsets and lengths */
1a322bb4
KW		 1115#define Node_Offset(n) (RExC_offsets[2*(REGNODE_OFFSET(n))-1])
1116#define Node_Length(n) (RExC_offsets[2*(REGNODE_OFFSET(n))])
fac92740 1117
07be1b83 1118#define Set_Node_Offset_Length(node,offset,len) STMT_START { \
1a322bb4
KW		 1119 Set_Node_Offset_To_R(REGNODE_OFFSET(node), (offset)); \
1120 Set_Node_Length_To_R(REGNODE_OFFSET(node), (len)); \
07be1b83 1121} STMT_END
4cbeff97
TC		 1122
1123#define Track_Code(code) STMT_START { code } STMT_END
7122b237 1124#endif
07be1b83
YO		 1125
1126#if PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS
1127#define EXPERIMENTAL_INPLACESCAN
f427392e 1128#endif /*PERL_ENABLE_EXPERIMENTAL_REGEX_OPTIMISATIONS*/
07be1b83 1129
cb41e5d6
YO		 1130#ifdef DEBUGGING
1131int
6ad9a8ab 1132Perl_re_printf(pTHX_ const char *fmt, ...)
cb41e5d6
YO		 1133{
1134 va_list ap;
1135 int result;
1136 PerlIO *f= Perl_debug_log;
1137 PERL_ARGS_ASSERT_RE_PRINTF;
1138 va_start(ap, fmt);
1139 result = PerlIO_vprintf(f, fmt, ap);
1140 va_end(ap);
1141 return result;
1142}
1143
1144int
7b031478 1145Perl_re_indentf(pTHX_ const char *fmt, U32 depth, ...)
cb41e5d6
YO		 1146{
1147 va_list ap;
1148 int result;
1149 PerlIO *f= Perl_debug_log;
1150 PERL_ARGS_ASSERT_RE_INDENTF;
1151 va_start(ap, depth);
daeb874b 1152 PerlIO_printf(f, "%*s", ( (int)depth % 20 ) * 2, "");
cb41e5d6
YO		 1153 result = PerlIO_vprintf(f, fmt, ap);
1154 va_end(ap);
1155 return result;
1156}
1157#endif /* DEBUGGING */
1158
7b031478 1159#define DEBUG_RExC_seen() \
538e84ed 1160 DEBUG_OPTIMISE_MORE_r({ \
88f063b4 1161 Perl_re_printf( aTHX_ "RExC_seen: "); \
538e84ed 1162 \
e384d5c1 1163 if (RExC_seen & REG_ZERO_LEN_SEEN) \
88f063b4 1164 Perl_re_printf( aTHX_ "REG_ZERO_LEN_SEEN "); \
538e84ed 1165 \
e384d5c1 1166 if (RExC_seen & REG_LOOKBEHIND_SEEN) \
88f063b4 1167 Perl_re_printf( aTHX_ "REG_LOOKBEHIND_SEEN "); \
538e84ed 1168 \
e384d5c1 1169 if (RExC_seen & REG_GPOS_SEEN) \
88f063b4 1170 Perl_re_printf( aTHX_ "REG_GPOS_SEEN "); \
538e84ed 1171 \
e384d5c1 1172 if (RExC_seen & REG_RECURSE_SEEN) \
88f063b4 1173 Perl_re_printf( aTHX_ "REG_RECURSE_SEEN "); \
538e84ed 1174 \
7b031478 1175 if (RExC_seen & REG_TOP_LEVEL_BRANCHES_SEEN) \
88f063b4 1176 Perl_re_printf( aTHX_ "REG_TOP_LEVEL_BRANCHES_SEEN "); \
538e84ed 1177 \
e384d5c1 1178 if (RExC_seen & REG_VERBARG_SEEN) \
88f063b4 1179 Perl_re_printf( aTHX_ "REG_VERBARG_SEEN "); \
538e84ed 1180 \
e384d5c1 1181 if (RExC_seen & REG_CUTGROUP_SEEN) \
88f063b4 1182 Perl_re_printf( aTHX_ "REG_CUTGROUP_SEEN "); \
538e84ed 1183 \
e384d5c1 1184 if (RExC_seen & REG_RUN_ON_COMMENT_SEEN) \
88f063b4 1185 Perl_re_printf( aTHX_ "REG_RUN_ON_COMMENT_SEEN "); \
538e84ed 1186 \
e384d5c1 1187 if (RExC_seen & REG_UNFOLDED_MULTI_SEEN) \
88f063b4 1188 Perl_re_printf( aTHX_ "REG_UNFOLDED_MULTI_SEEN "); \
538e84ed 1189 \
7b031478 1190 if (RExC_seen & REG_UNBOUNDED_QUANTIFIER_SEEN) \
88f063b4 1191 Perl_re_printf( aTHX_ "REG_UNBOUNDED_QUANTIFIER_SEEN "); \
ee273784 1192 \
88f063b4 1193 Perl_re_printf( aTHX_ "\n"); \
9e9ecfdf
YO		 1194 });
1195
fdfb4f21 1196#define DEBUG_SHOW_STUDY_FLAG(flags,flag) \
6ad9a8ab 1197 if ((flags) & flag) Perl_re_printf( aTHX_ "%s ", #flag)
fdfb4f21 1198
fdfb4f21 1199
f5a36d78
DM		 1200#ifdef DEBUGGING
1201static void
1202S_debug_show_study_flags(pTHX_ U32 flags, const char *open_str,
1203 const char *close_str)
1204{
1205 if (!flags)
1206 return;
1207
1208 Perl_re_printf( aTHX_ "%s", open_str);
11683ecb
DM		 1209 DEBUG_SHOW_STUDY_FLAG(flags, SF_BEFORE_SEOL);
1210 DEBUG_SHOW_STUDY_FLAG(flags, SF_BEFORE_MEOL);
f5a36d78
DM		 1211 DEBUG_SHOW_STUDY_FLAG(flags, SF_IS_INF);
1212 DEBUG_SHOW_STUDY_FLAG(flags, SF_HAS_PAR);
1213 DEBUG_SHOW_STUDY_FLAG(flags, SF_IN_PAR);
1214 DEBUG_SHOW_STUDY_FLAG(flags, SF_HAS_EVAL);
1215 DEBUG_SHOW_STUDY_FLAG(flags, SCF_DO_SUBSTR);
1216 DEBUG_SHOW_STUDY_FLAG(flags, SCF_DO_STCLASS_AND);
1217 DEBUG_SHOW_STUDY_FLAG(flags, SCF_DO_STCLASS_OR);
1218 DEBUG_SHOW_STUDY_FLAG(flags, SCF_DO_STCLASS);
1219 DEBUG_SHOW_STUDY_FLAG(flags, SCF_WHILEM_VISITED_POS);
1220 DEBUG_SHOW_STUDY_FLAG(flags, SCF_TRIE_RESTUDY);
1221 DEBUG_SHOW_STUDY_FLAG(flags, SCF_SEEN_ACCEPT);
1222 DEBUG_SHOW_STUDY_FLAG(flags, SCF_TRIE_DOING_RESTUDY);
1223 DEBUG_SHOW_STUDY_FLAG(flags, SCF_IN_DEFINE);
1224 Perl_re_printf( aTHX_ "%s", close_str);
1225}
1226
1227
1228static void
1229S_debug_studydata(pTHX_ const char *where, scan_data_t *data,
1230 U32 depth, int is_inf)
1231{
271b36b1 1232 DECLARE_AND_GET_RE_DEBUG_FLAGS;
f5a36d78
DM		 1233
1234 DEBUG_OPTIMISE_MORE_r({
1235 if (!data)
1236 return;
1237 Perl_re_indentf(aTHX_ "%s: Pos:%" IVdf "/%" IVdf " Flags: 0x%" UVXf,
1238 depth,
1239 where,
1240 (IV)data->pos_min,
1241 (IV)data->pos_delta,
1242 (UV)data->flags
1243 );
1244
1245 S_debug_show_study_flags(aTHX_ data->flags," [","]");
fdfb4f21 1246
f5a36d78
DM		 1247 Perl_re_printf( aTHX_
1248 " Whilem_c: %" IVdf " Lcp: %" IVdf " %s",
1249 (IV)data->whilem_c,
1250 (IV)(data->last_closep ? *((data)->last_closep) : -1),
1251 is_inf ? "INF " : ""
1252 );
1253
11683ecb 1254 if (data->last_found) {
37b6262f 1255 int i;
11683ecb
DM		 1256 Perl_re_printf(aTHX_
1257 "Last:'%s' %" IVdf ":%" IVdf "/%" IVdf,
1258 SvPVX_const(data->last_found),
1259 (IV)data->last_end,
1260 (IV)data->last_start_min,
1261 (IV)data->last_start_max
1262 );
1263
2099df82 1264 for (i = 0; i < 2; i++) {
37b6262f
DM		 1265 Perl_re_printf(aTHX_
1266 " %s%s: '%s' @ %" IVdf "/%" IVdf,
2099df82
DM		 1267 data->cur_is_floating == i ? "*" : "",
1268 i ? "Float" : "Fixed",
37b6262f
DM		 1269 SvPVX_const(data->substrs[i].str),
1270 (IV)data->substrs[i].min_offset,
1271 (IV)data->substrs[i].max_offset
1272 );
1273 S_debug_show_study_flags(aTHX_ data->substrs[i].flags," [","]");
1274 }
11683ecb 1275 }
f5a36d78
DM		 1276
1277 Perl_re_printf( aTHX_ "\n");
1278 });
1279}
1280
1281
1282static void
1283S_debug_peep(pTHX_ const char *str, const RExC_state_t *pRExC_state,
1284 regnode *scan, U32 depth, U32 flags)
1285{
271b36b1 1286 DECLARE_AND_GET_RE_DEBUG_FLAGS;
f5a36d78
DM		 1287
1288 DEBUG_OPTIMISE_r({
1289 regnode *Next;
1290
1291 if (!scan)
1292 return;
1293 Next = regnext(scan);
1294 regprop(RExC_rx, RExC_mysv, scan, NULL, pRExC_state);
1295 Perl_re_indentf( aTHX_ "%s>%3d: %s (%d)",
1296 depth,
1297 str,
1298 REG_NODE_NUM(scan), SvPV_nolen_const(RExC_mysv),
1299 Next ? (REG_NODE_NUM(Next)) : 0 );
1300 S_debug_show_study_flags(aTHX_ flags," [ ","]");
1301 Perl_re_printf( aTHX_ "\n");
1302 });
1303}
1304
1305
1306# define DEBUG_STUDYDATA(where, data, depth, is_inf) \
1307 S_debug_studydata(aTHX_ where, data, depth, is_inf)
1308
1309# define DEBUG_PEEP(str, scan, depth, flags) \
1310 S_debug_peep(aTHX_ str, pRExC_state, scan, depth, flags)
1311
1312#else
1313# define DEBUG_STUDYDATA(where, data, depth, is_inf) NOOP
1314# define DEBUG_PEEP(str, scan, depth, flags) NOOP
1315#endif
1de06328 1316
cb41e5d6 1317
c6871b76
KW		 1318/* =========================================================
1319 * BEGIN edit_distance stuff.
1320 *
1321 * This calculates how many single character changes of any type are needed to
1322 * transform a string into another one. It is taken from version 3.1 of
1323 *
1324 * https://metacpan.org/pod/Text::Levenshtein::Damerau::XS
1325 */
1326
1327/* Our unsorted dictionary linked list. */
1328/* Note we use UVs, not chars. */
1329
1330struct dictionary{
1331 UV key;
1332 UV value;
1333 struct dictionary* next;
1334};
1335typedef struct dictionary item;
1336
1337
1338PERL_STATIC_INLINE item*
88f063b4 1339push(UV key, item* curr)
c6871b76
KW		 1340{
1341 item* head;
d09f14bf 1342 Newx(head, 1, item);
c6871b76
KW		 1343 head->key = key;
1344 head->value = 0;
1345 head->next = curr;
1346 return head;
1347}
1348
1349
1350PERL_STATIC_INLINE item*
1351find(item* head, UV key)
1352{
1353 item* iterator = head;
1354 while (iterator){
1355 if (iterator->key == key){
1356 return iterator;
1357 }
1358 iterator = iterator->next;
1359 }
1360
1361 return NULL;
1362}
1363
1364PERL_STATIC_INLINE item*
88f063b4 1365uniquePush(item* head, UV key)
c6871b76
KW		 1366{
1367 item* iterator = head;
1368
1369 while (iterator){
1370 if (iterator->key == key) {
1371 return head;
1372 }
1373 iterator = iterator->next;
1374 }
1375
88f063b4 1376 return push(key, head);
c6871b76
KW		 1377}
1378
1379PERL_STATIC_INLINE void
1380dict_free(item* head)
1381{
1382 item* iterator = head;
1383
1384 while (iterator) {
1385 item* temp = iterator;
1386 iterator = iterator->next;
1387 Safefree(temp);
1388 }
1389
1390 head = NULL;
1391}
1392
1393/* End of Dictionary Stuff */
1394
1395/* All calculations/work are done here */
1396STATIC int
1397S_edit_distance(const UV* src,
1398 const UV* tgt,
1399 const STRLEN x, /* length of src[] */
1400 const STRLEN y, /* length of tgt[] */
1401 const SSize_t maxDistance
1402)
1403{
1404 item *head = NULL;
88f063b4 1405 UV swapCount, swapScore, targetCharCount, i, j;
c6871b76
KW		 1406 UV *scores;
1407 UV score_ceil = x + y;
1408
1409 PERL_ARGS_ASSERT_EDIT_DISTANCE;
1410
1411 /* intialize matrix start values */
d09f14bf 1412 Newx(scores, ( (x + 2) * (y + 2)), UV);
c6871b76
KW		 1413 scores[0] = score_ceil;
1414 scores[1 * (y + 2) + 0] = score_ceil;
1415 scores[0 * (y + 2) + 1] = score_ceil;
1416 scores[1 * (y + 2) + 1] = 0;
88f063b4 1417 head = uniquePush(uniquePush(head, src[0]), tgt[0]);
c6871b76
KW		 1418
1419 /* work loops */
1420 /* i = src index */
1421 /* j = tgt index */
1422 for (i=1;i<=x;i++) {
1423 if (i < x)
88f063b4 1424 head = uniquePush(head, src[i]);
c6871b76
KW		 1425 scores[(i+1) * (y + 2) + 1] = i;
1426 scores[(i+1) * (y + 2) + 0] = score_ceil;
1427 swapCount = 0;
1428
1429 for (j=1;j<=y;j++) {
1430 if (i == 1) {
1431 if(j < y)
88f063b4 1432 head = uniquePush(head, tgt[j]);
c6871b76
KW		 1433 scores[1 * (y + 2) + (j + 1)] = j;
1434 scores[0 * (y + 2) + (j + 1)] = score_ceil;
1435 }
1436
88f063b4 1437 targetCharCount = find(head, tgt[j-1])->value;
c6871b76
KW		 1438 swapScore = scores[targetCharCount * (y + 2) + swapCount] + i - targetCharCount - 1 + j - swapCount;
1439
1440 if (src[i-1] != tgt[j-1]){
1441 scores[(i+1) * (y + 2) + (j + 1)] = MIN(swapScore,(MIN(scores[i * (y + 2) + j], MIN(scores[(i+1) * (y + 2) + j], scores[i * (y + 2) + (j + 1)])) + 1));
1442 }
1443 else {
1444 swapCount = j;
1445 scores[(i+1) * (y + 2) + (j + 1)] = MIN(scores[i * (y + 2) + j], swapScore);
1446 }
1447 }
1448
88f063b4 1449 find(head, src[i-1])->value = i;
c6871b76
KW		 1450 }
1451
1452 {
1453 IV score = scores[(x+1) * (y + 2) + (y + 1)];
1454 dict_free(head);
1455 Safefree(scores);
1456 return (maxDistance != 0 && maxDistance < score)?(-1):score;
1457 }
1458}
1459
1460/* END of edit_distance() stuff
1461 * ========================================================= */
1462
653099ff 1463/* Mark that we cannot extend a found fixed substring at this point.
37b6262f 1464 Update the longest found anchored substring or the longest found
653099ff
GS		 1465 floating substrings if needed. */
1466
4327152a 1467STATIC void
ea3daa5d
FC		 1468S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data,
1469 SSize_t *minlenp, int is_inf)
c277df42 1470{
e1ec3a88 1471 const STRLEN l = CHR_SVLEN(data->last_found);
2099df82 1472 SV * const longest_sv = data->substrs[data->cur_is_floating].str;
a2ca2017 1473 const STRLEN old_l = CHR_SVLEN(longest_sv);
271b36b1 1474 DECLARE_AND_GET_RE_DEBUG_FLAGS;
b81d288d 1475
7918f24d
NC		 1476 PERL_ARGS_ASSERT_SCAN_COMMIT;
1477
c277df42 1478 if ((l >= old_l) && ((l > old_l) || (data->flags & SF_BEFORE_EOL))) {
2099df82 1479 const U8 i = data->cur_is_floating;
a7b8d88a 1480 SvSetMagicSV(longest_sv, data->last_found);
37b6262f
DM		 1481 data->substrs[i].min_offset = l ? data->last_start_min : data->pos_min;
1482
a7b8d88a
KW		 1483 if (!i) /* fixed */
1484 data->substrs[0].max_offset = data->substrs[0].min_offset;
1485 else { /* float */
1486 data->substrs[1].max_offset =
f6231ebf
KW		 1487 (is_inf)
1488 ? OPTIMIZE_INFTY
1489 : (l
646e8787 1490 ? data->last_start_max
d23733db
HS		 1491 /* temporary underflow guard for 5.32 */
1492 : data->pos_delta < 0 ? OPTIMIZE_INFTY
0069caf1 1493 : (data->pos_delta > OPTIMIZE_INFTY - data->pos_min
a7b8d88a
KW		 1494 ? OPTIMIZE_INFTY
1495 : data->pos_min + data->pos_delta));
37b6262f 1496 }
11683ecb 1497
5de22a40
HS		 1498 data->substrs[i].flags &= ~SF_BEFORE_EOL;
1499 data->substrs[i].flags |= data->flags & SF_BEFORE_EOL;
37b6262f
DM		 1500 data->substrs[i].minlenp = minlenp;
1501 data->substrs[i].lookbehind = 0;
c277df42 1502 }
37b6262f 1503
c277df42 1504 SvCUR_set(data->last_found, 0);
0eda9292 1505 {
a7b8d88a
KW		 1506 SV * const sv = data->last_found;
1507 if (SvUTF8(sv) && SvMAGICAL(sv)) {
1508 MAGIC * const mg = mg_find(sv, PERL_MAGIC_utf8);
1509 if (mg)
1510 mg->mg_len = 0;
1511 }
0eda9292 1512 }
c277df42
IZ		 1513 data->last_end = -1;
1514 data->flags &= ~SF_BEFORE_EOL;
f5a36d78 1515 DEBUG_STUDYDATA("commit", data, 0, is_inf);
c277df42
IZ		 1516}
1517
cdd87c1d
KW		 1518/* An SSC is just a regnode_charclass_posix with an extra field: the inversion
1519 * list that describes which code points it matches */
1520
653099ff 1521STATIC void
3420edd7 1522S_ssc_anything(pTHX_ regnode_ssc *ssc)
653099ff 1523{
cdd87c1d
KW		 1524 /* Set the SSC 'ssc' to match an empty string or any code point */
1525
557bd3fb 1526 PERL_ARGS_ASSERT_SSC_ANYTHING;
7918f24d 1527
71068078 1528 assert(is_ANYOF_SYNTHETIC(ssc));
3fffb88a 1529
0854ea0b
KW		 1530 /* mortalize so won't leak */
1531 ssc->invlist = sv_2mortal(_add_range_to_invlist(NULL, 0, UV_MAX));
93e92956 1532 ANYOF_FLAGS(ssc) |= SSC_MATCHES_EMPTY_STRING; /* Plus matches empty */
653099ff
GS		 1533}
1534
653099ff 1535STATIC int
dc3bf405 1536S_ssc_is_anything(const regnode_ssc *ssc)
653099ff 1537{
c144baaa
KW		 1538 /* Returns TRUE if the SSC 'ssc' can match the empty string and any code
1539 * point; FALSE otherwise. Thus, this is used to see if using 'ssc' buys
1540 * us anything: if the function returns TRUE, 'ssc' hasn't been restricted
1541 * in any way, so there's no point in using it */
cdd87c1d
KW		 1542
1543 UV start, end;
1544 bool ret;
653099ff 1545
557bd3fb 1546 PERL_ARGS_ASSERT_SSC_IS_ANYTHING;
7918f24d 1547
71068078 1548 assert(is_ANYOF_SYNTHETIC(ssc));
cdd87c1d 1549
93e92956 1550 if (! (ANYOF_FLAGS(ssc) & SSC_MATCHES_EMPTY_STRING)) {
cdd87c1d
KW		 1551 return FALSE;
1552 }
1553
1554 /* See if the list consists solely of the range 0 - Infinity */
1555 invlist_iterinit(ssc->invlist);
1556 ret = invlist_iternext(ssc->invlist, &start, &end)
1557 && start == 0
1558 && end == UV_MAX;
1559
1560 invlist_iterfinish(ssc->invlist);
1561
1562 if (ret) {
1563 return TRUE;
1564 }
1565
1566 /* If e.g., both \w and \W are set, matches everything */
e0e1be5f 1567 if (ANYOF_POSIXL_SSC_TEST_ANY_SET(ssc)) {
cdd87c1d
KW		 1568 int i;
1569 for (i = 0; i < ANYOF_POSIXL_MAX; i += 2) {
1570 if (ANYOF_POSIXL_TEST(ssc, i) && ANYOF_POSIXL_TEST(ssc, i+1)) {
1571 return TRUE;
1572 }
1573 }
1574 }
1575
1576 return FALSE;
653099ff
GS		 1577}
1578
653099ff 1579STATIC void
cdd87c1d 1580S_ssc_init(pTHX_ const RExC_state_t *pRExC_state, regnode_ssc *ssc)
653099ff 1581{
cdd87c1d
KW		 1582 /* Initializes the SSC 'ssc'. This includes setting it to match an empty
1583 * string, any code point, or any posix class under locale */
1584
557bd3fb 1585 PERL_ARGS_ASSERT_SSC_INIT;
7918f24d 1586
557bd3fb 1587 Zero(ssc, 1, regnode_ssc);
71068078 1588 set_ANYOF_SYNTHETIC(ssc);
93e92956 1589 ARG_SET(ssc, ANYOF_ONLY_HAS_BITMAP);
3420edd7 1590 ssc_anything(ssc);
cdd87c1d 1591
2f306ab9
KW		 1592 /* If any portion of the regex is to operate under locale rules that aren't
1593 * fully known at compile time, initialization includes it. The reason
1594 * this isn't done for all regexes is that the optimizer was written under
1595 * the assumption that locale was all-or-nothing. Given the complexity and
1596 * lack of documentation in the optimizer, and that there are inadequate
1597 * test cases for locale, many parts of it may not work properly, it is
1598 * safest to avoid locale unless necessary. */
cdd87c1d 1599 if (RExC_contains_locale) {
a7b8d88a 1600 ANYOF_POSIXL_SETALL(ssc);
cdd87c1d
KW		 1601 }
1602 else {
a7b8d88a 1603 ANYOF_POSIXL_ZERO(ssc);
cdd87c1d 1604 }
653099ff
GS		 1605}
1606
b423522f 1607STATIC int
dc3bf405
BF		 1608S_ssc_is_cp_posixl_init(const RExC_state_t *pRExC_state,
1609 const regnode_ssc *ssc)
b423522f
KW		 1610{
1611 /* Returns TRUE if the SSC 'ssc' is in its initial state with regard only
1612 * to the list of code points matched, and locale posix classes; hence does
1613 * not check its flags) */
1614
1615 UV start, end;
1616 bool ret;
1617
1618 PERL_ARGS_ASSERT_SSC_IS_CP_POSIXL_INIT;
1619
71068078 1620 assert(is_ANYOF_SYNTHETIC(ssc));
b423522f
KW		 1621
1622 invlist_iterinit(ssc->invlist);
1623 ret = invlist_iternext(ssc->invlist, &start, &end)
1624 && start == 0
1625 && end == UV_MAX;
1626
1627 invlist_iterfinish(ssc->invlist);
1628
1629 if (! ret) {
1630 return FALSE;
1631 }
1632
e0e1be5f 1633 if (RExC_contains_locale && ! ANYOF_POSIXL_SSC_TEST_ALL_SET(ssc)) {
31f05a37 1634 return FALSE;
b423522f
KW		 1635 }
1636
1637 return TRUE;
1638}
1639
4ebed06a
KW		 1640#define INVLIST_INDEX 0
1641#define ONLY_LOCALE_MATCHES_INDEX 1
1642#define DEFERRED_USER_DEFINED_INDEX 2
1643
b423522f
KW		 1644STATIC SV*
1645S_get_ANYOF_cp_list_for_ssc(pTHX_ const RExC_state_t *pRExC_state,
5c0f85ef 1646 const regnode_charclass* const node)
b423522f
KW		 1647{
1648 /* Returns a mortal inversion list defining which code points are matched
1649 * by 'node', which is of type ANYOF. Handles complementing the result if
1650 * appropriate. If some code points aren't knowable at this time, the
31f05a37
KW		 1651 * returned list must, and will, contain every code point that is a
1652 * possibility. */
b423522f 1653
e2506fa7 1654 SV* invlist = NULL;
1ee208c4 1655 SV* only_utf8_locale_invlist = NULL;
b423522f
KW		 1656 unsigned int i;
1657 const U32 n = ARG(node);
31f05a37 1658 bool new_node_has_latin1 = FALSE;
2d5613be 1659 const U8 flags = (inRANGE(OP(node), ANYOFH, ANYOFRb))
29a889ef
KW		 1660 ? 0
1661 : ANYOF_FLAGS(node);
b423522f
KW		 1662
1663 PERL_ARGS_ASSERT_GET_ANYOF_CP_LIST_FOR_SSC;
1664
1665 /* Look at the data structure created by S_set_ANYOF_arg() */
93e92956 1666 if (n != ANYOF_ONLY_HAS_BITMAP) {
b423522f
KW		 1667 SV * const rv = MUTABLE_SV(RExC_rxi->data->data[n]);
1668 AV * const av = MUTABLE_AV(SvRV(rv));
1669 SV **const ary = AvARRAY(av);
1670 assert(RExC_rxi->data->what[n] == 's');
1671
4ebed06a 1672 if (av_tindex_skip_len_mg(av) >= DEFERRED_USER_DEFINED_INDEX) {
b423522f 1673
6ed02bb6
KW		 1674 /* Here there are things that won't be known until runtime -- we
1675 * have to assume it could be anything */
e2506fa7 1676 invlist = sv_2mortal(_new_invlist(1));
b423522f
KW		 1677 return _add_range_to_invlist(invlist, 0, UV_MAX);
1678 }
4ebed06a 1679 else if (ary[INVLIST_INDEX]) {
b423522f 1680
6ed02bb6 1681 /* Use the node's inversion list */
4ebed06a 1682 invlist = sv_2mortal(invlist_clone(ary[INVLIST_INDEX], NULL));
1ee208c4
KW		 1683 }
1684
1685 /* Get the code points valid only under UTF-8 locales */
766d6d33 1686 if ( (flags & ANYOFL_FOLD)
4ebed06a 1687 && av_tindex_skip_len_mg(av) >= ONLY_LOCALE_MATCHES_INDEX)
1ee208c4 1688 {
4ebed06a 1689 only_utf8_locale_invlist = ary[ONLY_LOCALE_MATCHES_INDEX];
b423522f
KW		 1690 }
1691 }
1692
e2506fa7
KW		 1693 if (! invlist) {
1694 invlist = sv_2mortal(_new_invlist(0));
1695 }
1696
dcb20b36
KW		 1697 /* An ANYOF node contains a bitmap for the first NUM_ANYOF_CODE_POINTS
1698 * code points, and an inversion list for the others, but if there are code
1699 * points that should match only conditionally on the target string being
1700 * UTF-8, those are placed in the inversion list, and not the bitmap.
1701 * Since there are circumstances under which they could match, they are
1702 * included in the SSC. But if the ANYOF node is to be inverted, we have
1703 * to exclude them here, so that when we invert below, the end result
1704 * actually does include them. (Think about "\xe0" =~ /[^\xc0]/di;). We
1705 * have to do this here before we add the unconditionally matched code
1706 * points */
766d6d33 1707 if (flags & ANYOF_INVERT) {
b423522f
KW		 1708 _invlist_intersection_complement_2nd(invlist,
1709 PL_UpperLatin1,
1710 &invlist);
1711 }
1712
1713 /* Add in the points from the bit map */
2d5613be 1714 if (! inRANGE(OP(node), ANYOFH, ANYOFRb)) {
90973738
KW		 1715 for (i = 0; i < NUM_ANYOF_CODE_POINTS; i++) {
1716 if (ANYOF_BITMAP_TEST(node, i)) {
1717 unsigned int start = i++;
1718
1719 for (; i < NUM_ANYOF_CODE_POINTS
1720 && ANYOF_BITMAP_TEST(node, i); ++i)
1721 {
1722 /* empty */
1723 }
1724 invlist = _add_range_to_invlist(invlist, start, i-1);
1725 new_node_has_latin1 = TRUE;
6f8848d5 1726 }
b423522f
KW		 1727 }
1728 }
1729
1730 /* If this can match all upper Latin1 code points, have to add them
ac33c516
KW		 1731 * as well. But don't add them if inverting, as when that gets done below,
1732 * it would exclude all these characters, including the ones it shouldn't
1733 * that were added just above */
766d6d33
KW		 1734 if (! (flags & ANYOF_INVERT) && OP(node) == ANYOFD
1735 && (flags & ANYOF_SHARED_d_MATCHES_ALL_NON_UTF8_NON_ASCII_non_d_WARN_SUPER))
f240c685 1736 {
b423522f
KW		 1737 _invlist_union(invlist, PL_UpperLatin1, &invlist);
1738 }
1739
1740 /* Similarly for these */
766d6d33 1741 if (flags & ANYOF_MATCHES_ALL_ABOVE_BITMAP) {
e0a1ff7a 1742 _invlist_union_complement_2nd(invlist, PL_InBitmap, &invlist);
b423522f
KW		 1743 }
1744
766d6d33 1745 if (flags & ANYOF_INVERT) {
b423522f
KW		 1746 _invlist_invert(invlist);
1747 }
766d6d33 1748 else if (flags & ANYOFL_FOLD) {
35b8412f 1749 if (new_node_has_latin1) {
31f05a37 1750
26be5fe6
KW		 1751 /* Under /li, any 0-255 could fold to any other 0-255, depending on
1752 * the locale. We can skip this if there are no 0-255 at all. */
1753 _invlist_union(invlist, PL_Latin1, &invlist);
35b8412f
KW		 1754
1755 invlist = add_cp_to_invlist(invlist, LATIN_SMALL_LETTER_DOTLESS_I);
1756 invlist = add_cp_to_invlist(invlist, LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE);
1757 }
1758 else {
1759 if (_invlist_contains_cp(invlist, LATIN_SMALL_LETTER_DOTLESS_I)) {
1760 invlist = add_cp_to_invlist(invlist, 'I');
1761 }
1762 if (_invlist_contains_cp(invlist,
1763 LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE))
1764 {
1765 invlist = add_cp_to_invlist(invlist, 'i');
1766 }
1767 }
31f05a37
KW		 1768 }
1769
1ee208c4
KW		 1770 /* Similarly add the UTF-8 locale possible matches. These have to be
1771 * deferred until after the non-UTF-8 locale ones are taken care of just
1772 * above, or it leads to wrong results under ANYOF_INVERT */
1773 if (only_utf8_locale_invlist) {
31f05a37 1774 _invlist_union_maybe_complement_2nd(invlist,
1ee208c4 1775 only_utf8_locale_invlist,
766d6d33 1776 flags & ANYOF_INVERT,
31f05a37
KW		 1777 &invlist);
1778 }
b423522f
KW		 1779
1780 return invlist;
1781}
1782
1051e1c4 1783/* These two functions currently do the exact same thing */
557bd3fb 1784#define ssc_init_zero ssc_init
653099ff 1785
cdd87c1d
KW		 1786#define ssc_add_cp(ssc, cp) ssc_add_range((ssc), (cp), (cp))
1787#define ssc_match_all_cp(ssc) ssc_add_range(ssc, 0, UV_MAX)
1788
557bd3fb 1789/* 'AND' a given class with another one. Can create false positives. 'ssc'
93e92956
KW		 1790 * should not be inverted. 'and_with->flags & ANYOF_MATCHES_POSIXL' should be
1791 * 0 if 'and_with' is a regnode_charclass instead of a regnode_ssc. */
cdd87c1d 1792
653099ff 1793STATIC void
b423522f 1794S_ssc_and(pTHX_ const RExC_state_t *pRExC_state, regnode_ssc *ssc,
7dcac5f6 1795 const regnode_charclass *and_with)
653099ff 1796{
cdd87c1d
KW		 1797 /* Accumulate into SSC 'ssc' its 'AND' with 'and_with', which is either
1798 * another SSC or a regular ANYOF class. Can create false positives. */
40d049e4 1799
a0dd4231 1800 SV* anded_cp_list;
2d5613be 1801 U8 and_with_flags = inRANGE(OP(and_with), ANYOFH, ANYOFRb)
29a889ef
KW		 1802 ? 0
1803 : ANYOF_FLAGS(and_with);
a0dd4231 1804 U8 anded_flags;
1e6ade67 1805
cdd87c1d 1806 PERL_ARGS_ASSERT_SSC_AND;
653099ff 1807
71068078 1808 assert(is_ANYOF_SYNTHETIC(ssc));
a0dd4231
KW		 1809
1810 /* 'and_with' is used as-is if it too is an SSC; otherwise have to extract
1811 * the code point inversion list and just the relevant flags */
71068078 1812 if (is_ANYOF_SYNTHETIC(and_with)) {
7dcac5f6 1813 anded_cp_list = ((regnode_ssc *)and_with)->invlist;
765e6ecf 1814 anded_flags = and_with_flags;
e9b08962
KW		 1815
1816 /* XXX This is a kludge around what appears to be deficiencies in the
1817 * optimizer. If we make S_ssc_anything() add in the WARN_SUPER flag,
1818 * there are paths through the optimizer where it doesn't get weeded
1819 * out when it should. And if we don't make some extra provision for
1820 * it like the code just below, it doesn't get added when it should.
1821 * This solution is to add it only when AND'ing, which is here, and
1822 * only when what is being AND'ed is the pristine, original node
1823 * matching anything. Thus it is like adding it to ssc_anything() but
1824 * only when the result is to be AND'ed. Probably the same solution
1825 * could be adopted for the same problem we have with /l matching,
1826 * which is solved differently in S_ssc_init(), and that would lead to
1827 * fewer false positives than that solution has. But if this solution
1828 * creates bugs, the consequences are only that a warning isn't raised
1829 * that should be; while the consequences for having /l bugs is
1830 * incorrect matches */
7dcac5f6 1831 if (ssc_is_anything((regnode_ssc *)and_with)) {
f240c685 1832 anded_flags |= ANYOF_SHARED_d_MATCHES_ALL_NON_UTF8_NON_ASCII_non_d_WARN_SUPER;
e9b08962 1833 }
a0dd4231
KW		 1834 }
1835 else {
5c0f85ef 1836 anded_cp_list = get_ANYOF_cp_list_for_ssc(pRExC_state, and_with);
f240c685 1837 if (OP(and_with) == ANYOFD) {
765e6ecf 1838 anded_flags = and_with_flags & ANYOF_COMMON_FLAGS;
f240c685
KW		 1839 }
1840 else {
765e6ecf 1841 anded_flags = and_with_flags
f240c685 1842 &( ANYOF_COMMON_FLAGS
108316fb
KW		 1843 |ANYOF_SHARED_d_MATCHES_ALL_NON_UTF8_NON_ASCII_non_d_WARN_SUPER
1844 |ANYOF_SHARED_d_UPPER_LATIN1_UTF8_STRING_MATCHES_non_d_RUNTIME_USER_PROP);
765e6ecf 1845 if (ANYOFL_UTF8_LOCALE_REQD(and_with_flags)) {
d1c40ef5
KW		 1846 anded_flags &=
1847 ANYOFL_SHARED_UTF8_LOCALE_fold_HAS_MATCHES_nonfold_REQD;
1848 }
f240c685 1849 }
a0dd4231
KW		 1850 }
1851
1852 ANYOF_FLAGS(ssc) &= anded_flags;
cdd87c1d
KW		 1853
1854 /* Below, C1 is the list of code points in 'ssc'; P1, its posix classes.
1855 * C2 is the list of code points in 'and-with'; P2, its posix classes.
1856 * 'and_with' may be inverted. When not inverted, we have the situation of
1857 * computing:
1858 * (C1 | P1) & (C2 | P2)
1859 * = (C1 & (C2 | P2)) | (P1 & (C2 | P2))
1860 * = ((C1 & C2) | (C1 & P2)) | ((P1 & C2) | (P1 & P2))
1861 * <= ((C1 & C2) | P2)) | ( P1 | (P1 & P2))
1862 * <= ((C1 & C2) | P1 | P2)
1863 * Alternatively, the last few steps could be:
1864 * = ((C1 & C2) | (C1 & P2)) | ((P1 & C2) | (P1 & P2))
1865 * <= ((C1 & C2) | C1 ) | ( C2 | (P1 & P2))
1866 * <= (C1 | C2 | (P1 & P2))
1867 * We favor the second approach if either P1 or P2 is non-empty. This is
1868 * because these components are a barrier to doing optimizations, as what
1869 * they match cannot be known until the moment of matching as they are
1870 * dependent on the current locale, 'AND"ing them likely will reduce or
1871 * eliminate them.
1872 * But we can do better if we know that C1,P1 are in their initial state (a
1873 * frequent occurrence), each matching everything:
1874 * (<everything>) & (C2 | P2) = C2 | P2
1875 * Similarly, if C2,P2 are in their initial state (again a frequent
1876 * occurrence), the result is a no-op
1877 * (C1 | P1) & (<everything>) = C1 | P1
1878 *
1879 * Inverted, we have
1880 * (C1 | P1) & ~(C2 | P2) = (C1 | P1) & (~C2 & ~P2)
1881 * = (C1 & (~C2 & ~P2)) | (P1 & (~C2 & ~P2))
1882 * <= (C1 & ~C2) | (P1 & ~P2)
1883 * */
1aa99e6b 1884
765e6ecf 1885 if ((and_with_flags & ANYOF_INVERT)
71068078 1886 && ! is_ANYOF_SYNTHETIC(and_with))
a0dd4231 1887 {
cdd87c1d 1888 unsigned int i;
8951c461 1889
cdd87c1d
KW		 1890 ssc_intersection(ssc,
1891 anded_cp_list,
1892 FALSE /* Has already been inverted */
1893 );
c6b76537 1894
cdd87c1d
KW		 1895 /* If either P1 or P2 is empty, the intersection will be also; can skip
1896 * the loop */
765e6ecf 1897 if (! (and_with_flags & ANYOF_MATCHES_POSIXL)) {
cdd87c1d
KW		 1898 ANYOF_POSIXL_ZERO(ssc);
1899 }
e0e1be5f 1900 else if (ANYOF_POSIXL_SSC_TEST_ANY_SET(ssc)) {
cdd87c1d
KW		 1901
1902 /* Note that the Posix class component P from 'and_with' actually
1903 * looks like:
1904 * P = Pa | Pb | ... | Pn
1905 * where each component is one posix class, such as in [\w\s].
1906 * Thus
1907 * ~P = ~(Pa | Pb | ... | Pn)
1908 * = ~Pa & ~Pb & ... & ~Pn
1909 * <= ~Pa | ~Pb | ... | ~Pn
1910 * The last is something we can easily calculate, but unfortunately
1911 * is likely to have many false positives. We could do better
1912 * in some (but certainly not all) instances if two classes in
1913 * P have known relationships. For example
1914 * :lower: <= :alpha: <= :alnum: <= \w <= :graph: <= :print:
1915 * So
1916 * :lower: & :print: = :lower:
1917 * And similarly for classes that must be disjoint. For example,
1918 * since \s and \w can have no elements in common based on rules in
1919 * the POSIX standard,
1920 * \w & ^\S = nothing
1921 * Unfortunately, some vendor locales do not meet the Posix
1922 * standard, in particular almost everything by Microsoft.
1923 * The loop below just changes e.g., \w into \W and vice versa */
1924
1ee208c4 1925 regnode_charclass_posixl temp;
cdd87c1d
KW		 1926 int add = 1; /* To calculate the index of the complement */
1927
b1234259 1928 Zero(&temp, 1, regnode_charclass_posixl);
cdd87c1d
KW		 1929 ANYOF_POSIXL_ZERO(&temp);
1930 for (i = 0; i < ANYOF_MAX; i++) {
1931 assert(i % 2 != 0
7dcac5f6
KW		 1932 || ! ANYOF_POSIXL_TEST((regnode_charclass_posixl*) and_with, i)
1933 || ! ANYOF_POSIXL_TEST((regnode_charclass_posixl*) and_with, i + 1));
cdd87c1d 1934
7dcac5f6 1935 if (ANYOF_POSIXL_TEST((regnode_charclass_posixl*) and_with, i)) {
cdd87c1d
KW		 1936 ANYOF_POSIXL_SET(&temp, i + add);
1937 }
1938 add = 0 - add; /* 1 goes to -1; -1 goes to 1 */
1939 }
1940 ANYOF_POSIXL_AND(&temp, ssc);
c6b76537 1941
cdd87c1d
KW		 1942 } /* else ssc already has no posixes */
1943 } /* else: Not inverted. This routine is a no-op if 'and_with' is an SSC
1944 in its initial state */
71068078 1945 else if (! is_ANYOF_SYNTHETIC(and_with)
7dcac5f6 1946 || ! ssc_is_cp_posixl_init(pRExC_state, (regnode_ssc *)and_with))
cdd87c1d
KW		 1947 {
1948 /* But if 'ssc' is in its initial state, the result is just 'and_with';
1949 * copy it over 'ssc' */
1950 if (ssc_is_cp_posixl_init(pRExC_state, ssc)) {
71068078 1951 if (is_ANYOF_SYNTHETIC(and_with)) {
cdd87c1d
KW		 1952 StructCopy(and_with, ssc, regnode_ssc);
1953 }
1954 else {
1955 ssc->invlist = anded_cp_list;
1956 ANYOF_POSIXL_ZERO(ssc);
765e6ecf 1957 if (and_with_flags & ANYOF_MATCHES_POSIXL) {
7dcac5f6 1958 ANYOF_POSIXL_OR((regnode_charclass_posixl*) and_with, ssc);
cdd87c1d
KW		 1959 }
1960 }
1961 }
e0e1be5f 1962 else if (ANYOF_POSIXL_SSC_TEST_ANY_SET(ssc)
765e6ecf 1963 || (and_with_flags & ANYOF_MATCHES_POSIXL))
cdd87c1d
KW		 1964 {
1965 /* One or the other of P1, P2 is non-empty. */
765e6ecf 1966 if (and_with_flags & ANYOF_MATCHES_POSIXL) {
1ea8b7fe
KW		 1967 ANYOF_POSIXL_AND((regnode_charclass_posixl*) and_with, ssc);
1968 }
cdd87c1d
KW		 1969 ssc_union(ssc, anded_cp_list, FALSE);
1970 }
1971 else { /* P1 = P2 = empty */
1972 ssc_intersection(ssc, anded_cp_list, FALSE);
1973 }
137165a6 1974 }
653099ff
GS		 1975}
1976
653099ff 1977STATIC void
cdd87c1d 1978S_ssc_or(pTHX_ const RExC_state_t *pRExC_state, regnode_ssc *ssc,
7dcac5f6 1979 const regnode_charclass *or_with)
653099ff 1980{
cdd87c1d
KW		 1981 /* Accumulate into SSC 'ssc' its 'OR' with 'or_with', which is either
1982 * another SSC or a regular ANYOF class. Can create false positives if
1983 * 'or_with' is to be inverted. */
7918f24d 1984
a0dd4231
KW		 1985 SV* ored_cp_list;
1986 U8 ored_flags;
2d5613be 1987 U8 or_with_flags = inRANGE(OP(or_with), ANYOFH, ANYOFRb)
29a889ef
KW		 1988 ? 0
1989 : ANYOF_FLAGS(or_with);
c6b76537 1990
cdd87c1d 1991 PERL_ARGS_ASSERT_SSC_OR;
c6b76537 1992
71068078 1993 assert(is_ANYOF_SYNTHETIC(ssc));
a0dd4231
KW		 1994
1995 /* 'or_with' is used as-is if it too is an SSC; otherwise have to extract
1996 * the code point inversion list and just the relevant flags */
71068078 1997 if (is_ANYOF_SYNTHETIC(or_with)) {
7dcac5f6 1998 ored_cp_list = ((regnode_ssc*) or_with)->invlist;
765e6ecf 1999 ored_flags = or_with_flags;
a0dd4231
KW		 2000 }
2001 else {
5c0f85ef 2002 ored_cp_list = get_ANYOF_cp_list_for_ssc(pRExC_state, or_with);
765e6ecf 2003 ored_flags = or_with_flags & ANYOF_COMMON_FLAGS;
f240c685
KW		 2004 if (OP(or_with) != ANYOFD) {
2005 ored_flags
765e6ecf 2006 |= or_with_flags
108316fb
KW		 2007 & ( ANYOF_SHARED_d_MATCHES_ALL_NON_UTF8_NON_ASCII_non_d_WARN_SUPER
2008 |ANYOF_SHARED_d_UPPER_LATIN1_UTF8_STRING_MATCHES_non_d_RUNTIME_USER_PROP);
765e6ecf 2009 if (ANYOFL_UTF8_LOCALE_REQD(or_with_flags)) {
d1c40ef5
KW		 2010 ored_flags |=
2011 ANYOFL_SHARED_UTF8_LOCALE_fold_HAS_MATCHES_nonfold_REQD;
2012 }
f240c685 2013 }
a0dd4231
KW		 2014 }
2015
2016 ANYOF_FLAGS(ssc) |= ored_flags;
cdd87c1d
KW		 2017
2018 /* Below, C1 is the list of code points in 'ssc'; P1, its posix classes.
2019 * C2 is the list of code points in 'or-with'; P2, its posix classes.
2020 * 'or_with' may be inverted. When not inverted, we have the simple
2021 * situation of computing:
2022 * (C1 | P1) | (C2 | P2) = (C1 | C2) | (P1 | P2)
2023 * If P1|P2 yields a situation with both a class and its complement are
2024 * set, like having both \w and \W, this matches all code points, and we
2025 * can delete these from the P component of the ssc going forward. XXX We
2026 * might be able to delete all the P components, but I (khw) am not certain
2027 * about this, and it is better to be safe.
2028 *
2029 * Inverted, we have
2030 * (C1 | P1) | ~(C2 | P2) = (C1 | P1) | (~C2 & ~P2)
2031 * <= (C1 | P1) | ~C2
2032 * <= (C1 | ~C2) | P1
2033 * (which results in actually simpler code than the non-inverted case)
2034 * */
9826f543 2035
765e6ecf 2036 if ((or_with_flags & ANYOF_INVERT)
71068078 2037 && ! is_ANYOF_SYNTHETIC(or_with))
a0dd4231 2038 {
cdd87c1d 2039 /* We ignore P2, leaving P1 going forward */
1ea8b7fe 2040 } /* else Not inverted */
765e6ecf 2041 else if (or_with_flags & ANYOF_MATCHES_POSIXL) {
7dcac5f6 2042 ANYOF_POSIXL_OR((regnode_charclass_posixl*)or_with, ssc);
e0e1be5f 2043 if (ANYOF_POSIXL_SSC_TEST_ANY_SET(ssc)) {
cdd87c1d
KW		 2044 unsigned int i;
2045 for (i = 0; i < ANYOF_MAX; i += 2) {
2046 if (ANYOF_POSIXL_TEST(ssc, i) && ANYOF_POSIXL_TEST(ssc, i + 1))
2047 {
2048 ssc_match_all_cp(ssc);
2049 ANYOF_POSIXL_CLEAR(ssc, i);
2050 ANYOF_POSIXL_CLEAR(ssc, i+1);
cdd87c1d
KW		 2051 }
2052 }
2053 }
1aa99e6b 2054 }
cdd87c1d
KW		 2055
2056 ssc_union(ssc,
2057 ored_cp_list,
2058 FALSE /* Already has been inverted */
2059 );
653099ff
GS		 2060}
2061
19bb2455 2062STATIC void
b423522f
KW		 2063S_ssc_union(pTHX_ regnode_ssc *ssc, SV* const invlist, const bool invert2nd)
2064{
2065 PERL_ARGS_ASSERT_SSC_UNION;
2066
71068078 2067 assert(is_ANYOF_SYNTHETIC(ssc));
b423522f
KW		 2068
2069 _invlist_union_maybe_complement_2nd(ssc->invlist,
2070 invlist,
2071 invert2nd,
2072 &ssc->invlist);
2073}
2074
19bb2455 2075STATIC void
b423522f
KW		 2076S_ssc_intersection(pTHX_ regnode_ssc *ssc,
2077 SV* const invlist,
2078 const bool invert2nd)
2079{
2080 PERL_ARGS_ASSERT_SSC_INTERSECTION;
2081
71068078 2082 assert(is_ANYOF_SYNTHETIC(ssc));
b423522f
KW		 2083
2084 _invlist_intersection_maybe_complement_2nd(ssc->invlist,
2085 invlist,
2086 invert2nd,
2087 &ssc->invlist);
2088}
2089
19bb2455 2090STATIC void
b423522f
KW		 2091S_ssc_add_range(pTHX_ regnode_ssc *ssc, const UV start, const UV end)
2092{
2093 PERL_ARGS_ASSERT_SSC_ADD_RANGE;
2094
71068078 2095 assert(is_ANYOF_SYNTHETIC(ssc));
b423522f
KW		 2096
2097 ssc->invlist = _add_range_to_invlist(ssc->invlist, start, end);
2098}
2099
19bb2455 2100STATIC void
b423522f
KW		 2101S_ssc_cp_and(pTHX_ regnode_ssc *ssc, const UV cp)
2102{
2103 /* AND just the single code point 'cp' into the SSC 'ssc' */
2104
2105 SV* cp_list = _new_invlist(2);
2106
2107 PERL_ARGS_ASSERT_SSC_CP_AND;
2108
71068078 2109 assert(is_ANYOF_SYNTHETIC(ssc));
b423522f
KW		 2110
2111 cp_list = add_cp_to_invlist(cp_list, cp);
2112 ssc_intersection(ssc, cp_list,
2113 FALSE /* Not inverted */
2114 );
2115 SvREFCNT_dec_NN(cp_list);
2116}
2117
19bb2455 2118STATIC void
dc3bf405 2119S_ssc_clear_locale(regnode_ssc *ssc)
b423522f
KW		 2120{
2121 /* Set the SSC 'ssc' to not match any locale things */
b423522f
KW		 2122 PERL_ARGS_ASSERT_SSC_CLEAR_LOCALE;
2123
71068078 2124 assert(is_ANYOF_SYNTHETIC(ssc));
b423522f
KW		 2125
2126 ANYOF_POSIXL_ZERO(ssc);
2127 ANYOF_FLAGS(ssc) &= ~ANYOF_LOCALE_FLAGS;
2128}
2129
b35552de
KW		 2130STATIC bool
2131S_is_ssc_worth_it(const RExC_state_t * pRExC_state, const regnode_ssc * ssc)
2132{
2133 /* The synthetic start class is used to hopefully quickly winnow down
2134 * places where a pattern could start a match in the target string. If it
2135 * doesn't really narrow things down that much, there isn't much point to
2136 * having the overhead of using it. This function uses some very crude
2137 * heuristics to decide if to use the ssc or not.
2138 *
2139 * It returns TRUE if 'ssc' rules out more than half what it considers to
2140 * be the "likely" possible matches, but of course it doesn't know what the
2141 * actual things being matched are going to be; these are only guesses
2142 *
2143 * For /l matches, it assumes that the only likely matches are going to be
2144 * in the 0-255 range, uniformly distributed, so half of that is 127
2145 * For /a and /d matches, it assumes that the likely matches will be just
2146 * the ASCII range, so half of that is 63
2147 * For /u and there isn't anything matching above the Latin1 range, it
2148 * assumes that that is the only range likely to be matched, and uses
2149 * half that as the cut-off: 127. If anything matches above Latin1,
2150 * it assumes that all of Unicode could match (uniformly), except for
2151 * non-Unicode code points and things in the General Category "Other"
2152 * (unassigned, private use, surrogates, controls and formats). This
2153 * is a much large number. */
2154
b35552de
KW		 2155 U32 count = 0; /* Running total of number of code points matched by
2156 'ssc' */
2157 UV start, end; /* Start and end points of current range in inversion
26be5fe6 2158 XXX outdated. UTF-8 locales are common, what about invert? list */
72400949
KW		 2159 const U32 max_code_points = (LOC)
2160 ? 256
f6e8f31e 2161 : (( ! UNI_SEMANTICS
1a26cbcb 2162 || invlist_highest(ssc->invlist) < 256)
72400949
KW		 2163 ? 128
2164 : NON_OTHER_COUNT);
2165 const U32 max_match = max_code_points / 2;
b35552de
KW		 2166
2167 PERL_ARGS_ASSERT_IS_SSC_WORTH_IT;
2168
2169 invlist_iterinit(ssc->invlist);
2170 while (invlist_iternext(ssc->invlist, &start, &end)) {
72400949
KW		 2171 if (start >= max_code_points) {
2172 break;
b35552de 2173 }
72400949 2174 end = MIN(end, max_code_points - 1);
b35552de 2175 count += end - start + 1;
72400949 2176 if (count >= max_match) {
b35552de
KW		 2177 invlist_iterfinish(ssc->invlist);
2178 return FALSE;
2179 }
2180 }
2181
2182 return TRUE;
2183}
2184
2185
b423522f
KW		 2186STATIC void
2187S_ssc_finalize(pTHX_ RExC_state_t *pRExC_state, regnode_ssc *ssc)
2188{
2189 /* The inversion list in the SSC is marked mortal; now we need a more
2190 * permanent copy, which is stored the same way that is done in a regular
dcb20b36
KW		 2191 * ANYOF node, with the first NUM_ANYOF_CODE_POINTS code points in a bit
2192 * map */
b423522f 2193
28118b9c 2194 SV* invlist = invlist_clone(ssc->invlist, NULL);
b423522f
KW		 2195
2196 PERL_ARGS_ASSERT_SSC_FINALIZE;
2197
71068078 2198 assert(is_ANYOF_SYNTHETIC(ssc));
b423522f 2199
a0dd4231 2200 /* The code in this file assumes that all but these flags aren't relevant
93e92956
KW		 2201 * to the SSC, except SSC_MATCHES_EMPTY_STRING, which should be cleared
2202 * by the time we reach here */
f240c685
KW		 2203 assert(! (ANYOF_FLAGS(ssc)
2204 & ~( ANYOF_COMMON_FLAGS
108316fb
KW		 2205 |ANYOF_SHARED_d_MATCHES_ALL_NON_UTF8_NON_ASCII_non_d_WARN_SUPER
2206 |ANYOF_SHARED_d_UPPER_LATIN1_UTF8_STRING_MATCHES_non_d_RUNTIME_USER_PROP)));
a0dd4231 2207
b423522f
KW		 2208 populate_ANYOF_from_invlist( (regnode *) ssc, &invlist);
2209
4c404f26 2210 set_ANYOF_arg(pRExC_state, (regnode *) ssc, invlist, NULL, NULL);
21c3fd9d 2211 SvREFCNT_dec(invlist);
b423522f 2212
85c8e306
KW		 2213 /* Make sure is clone-safe */
2214 ssc->invlist = NULL;
2215
e0e1be5f 2216 if (ANYOF_POSIXL_SSC_TEST_ANY_SET(ssc)) {
93e92956 2217 ANYOF_FLAGS(ssc) |= ANYOF_MATCHES_POSIXL;
d156f5cb 2218 OP(ssc) = ANYOFPOSIXL;
e0e1be5f 2219 }
d156f5cb 2220 else if (RExC_contains_locale) {
b2e90ddf
KW		 2221 OP(ssc) = ANYOFL;
2222 }
2223
1462525b 2224 assert(! (ANYOF_FLAGS(ssc) & ANYOF_LOCALE_FLAGS) || RExC_contains_locale);
b423522f
KW		 2225}
2226
a3621e74
YO		 2227#define TRIE_LIST_ITEM(state,idx) (trie->states[state].trans.list)[ idx ]
2228#define TRIE_LIST_CUR(state) ( TRIE_LIST_ITEM( state, 0 ).forid )
2229#define TRIE_LIST_LEN(state) ( TRIE_LIST_ITEM( state, 0 ).newstate )
538e84ed
KW		 2230#define TRIE_LIST_USED(idx) ( trie->states[state].trans.list \
2231 ? (TRIE_LIST_CUR( idx ) - 1) \
2232 : 0 )
a3621e74 2233
3dab1dad
YO		 2234
2235#ifdef DEBUGGING
07be1b83 2236/*
2b8b4781
NC		 2237 dump_trie(trie,widecharmap,revcharmap)
2238 dump_trie_interim_list(trie,widecharmap,revcharmap,next_alloc)
2239 dump_trie_interim_table(trie,widecharmap,revcharmap,next_alloc)
3dab1dad
YO		 2240
2241 These routines dump out a trie in a somewhat readable format.
07be1b83
YO		 2242 The _interim_ variants are used for debugging the interim
2243 tables that are used to generate the final compressed
2244 representation which is what dump_trie expects.
2245
486ec47a 2246 Part of the reason for their existence is to provide a form
3dab1dad 2247 of documentation as to how the different representations function.
07be1b83
YO		 2248
2249*/
3dab1dad
YO		 2250
2251/*
3dab1dad
YO		 2252 Dumps the final compressed table form of the trie to Perl_debug_log.
2253 Used for debugging make_trie().
2254*/
b9a59e08 2255
3dab1dad 2256STATIC void
2b8b4781 2257S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap,
a7b8d88a 2258 AV *revcharmap, U32 depth)
3dab1dad
YO		 2259{
2260 U32 state;
ab3bbdeb 2261 SV *sv=sv_newmortal();
55eed653 2262 int colwidth= widecharmap ? 6 : 4;
2e64971a 2263 U16 word;
271b36b1 2264 DECLARE_AND_GET_RE_DEBUG_FLAGS;
3dab1dad 2265
7918f24d 2266 PERL_ARGS_ASSERT_DUMP_TRIE;
ab3bbdeb 2267
6ad9a8ab 2268 Perl_re_indentf( aTHX_ "Char : %-6s%-6s%-4s ",
1e37780e 2269 depth+1, "Match","Base","Ofs" );
3dab1dad
YO		 2270
2271 for( state = 0 ; state < trie->uniquecharcount ; state++ ) {
a7b8d88a 2272 SV ** const tmp = av_fetch( revcharmap, state, 0);
3dab1dad 2273 if ( tmp ) {
6ad9a8ab 2274 Perl_re_printf( aTHX_ "%*s",
ab3bbdeb 2275 colwidth,
538e84ed 2276 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
a7b8d88a
KW		 2277 PL_colors[0], PL_colors[1],
2278 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
2279 PERL_PV_ESCAPE_FIRSTCHAR
538e84ed 2280 )
ab3bbdeb 2281 );
3dab1dad
YO		 2282 }
2283 }
1e37780e
YO		 2284 Perl_re_printf( aTHX_ "\n");
2285 Perl_re_indentf( aTHX_ "State|-----------------------", depth+1);
3dab1dad
YO		 2286
2287 for( state = 0 ; state < trie->uniquecharcount ; state++ )
6ad9a8ab
YO		 2288 Perl_re_printf( aTHX_ "%.*s", colwidth, "--------");
2289 Perl_re_printf( aTHX_ "\n");
3dab1dad 2290
1e2e3d02 2291 for( state = 1 ; state < trie->statecount ; state++ ) {
a7b8d88a 2292 const U32 base = trie->states[ state ].trans.base;
3dab1dad 2293
147e3846 2294 Perl_re_indentf( aTHX_ "#%4" UVXf "|", depth+1, (UV)state);
3dab1dad
YO		 2295
2296 if ( trie->states[ state ].wordnum ) {
1e37780e 2297 Perl_re_printf( aTHX_ " W%4X", trie->states[ state ].wordnum );
3dab1dad 2298 } else {
6ad9a8ab 2299 Perl_re_printf( aTHX_ "%6s", "" );
3dab1dad
YO		 2300 }
2301
147e3846 2302 Perl_re_printf( aTHX_ " @%4" UVXf " ", (UV)base );
3dab1dad
YO		 2303
2304 if ( base ) {
2305 U32 ofs = 0;
2306
2307 while( ( base + ofs < trie->uniquecharcount ) ||
2308 ( base + ofs - trie->uniquecharcount < trie->lasttrans
538e84ed
KW		 2309 && trie->trans[ base + ofs - trie->uniquecharcount ].check
2310 != state))
3dab1dad
YO		 2311 ofs++;
2312
147e3846 2313 Perl_re_printf( aTHX_ "+%2" UVXf "[ ", (UV)ofs);
3dab1dad
YO		 2314
2315 for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
538e84ed
KW		 2316 if ( ( base + ofs >= trie->uniquecharcount )
2317 && ( base + ofs - trie->uniquecharcount
2318 < trie->lasttrans )
2319 && trie->trans[ base + ofs
2320 - trie->uniquecharcount ].check == state )
3dab1dad 2321 {
147e3846 2322 Perl_re_printf( aTHX_ "%*" UVXf, colwidth,
1e37780e
YO		 2323 (UV)trie->trans[ base + ofs - trie->uniquecharcount ].next
2324 );
3dab1dad 2325 } else {
88f063b4 2326 Perl_re_printf( aTHX_ "%*s", colwidth," ." );
3dab1dad
YO		 2327 }
2328 }
2329
6ad9a8ab 2330 Perl_re_printf( aTHX_ "]");
3dab1dad
YO		 2331
2332 }
6ad9a8ab 2333 Perl_re_printf( aTHX_ "\n" );
3dab1dad 2334 }
6ad9a8ab 2335 Perl_re_indentf( aTHX_ "word_info N:(prev,len)=",
cb41e5d6 2336 depth);
2e64971a 2337 for (word=1; word <= trie->wordcount; word++) {
6ad9a8ab 2338 Perl_re_printf( aTHX_ " %d:(%d,%d)",
a7b8d88a
KW		 2339 (int)word, (int)(trie->wordinfo[word].prev),
2340 (int)(trie->wordinfo[word].len));
2e64971a 2341 }
6ad9a8ab 2342 Perl_re_printf( aTHX_ "\n" );
538e84ed 2343}
3dab1dad 2344/*
3dab1dad 2345 Dumps a fully constructed but uncompressed trie in list form.
538e84ed 2346 List tries normally only are used for construction when the number of
3dab1dad
YO		 2347 possible chars (trie->uniquecharcount) is very high.
2348 Used for debugging make_trie().
2349*/
2350STATIC void
55eed653 2351S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie,
a7b8d88a
KW		 2352 HV *widecharmap, AV *revcharmap, U32 next_alloc,
2353 U32 depth)
3dab1dad
YO		 2354{
2355 U32 state;
ab3bbdeb 2356 SV *sv=sv_newmortal();
55eed653 2357 int colwidth= widecharmap ? 6 : 4;
271b36b1 2358 DECLARE_AND_GET_RE_DEBUG_FLAGS;
7918f24d
NC		 2359
2360 PERL_ARGS_ASSERT_DUMP_TRIE_INTERIM_LIST;
2361
3dab1dad 2362 /* print out the table precompression. */
6ad9a8ab 2363 Perl_re_indentf( aTHX_ "State :Word | Transition Data\n",
cb41e5d6 2364 depth+1 );
6ad9a8ab 2365 Perl_re_indentf( aTHX_ "%s",
cb41e5d6 2366 depth+1, "------:-----+-----------------\n" );
538e84ed 2367
3dab1dad
YO		 2368 for( state=1 ; state < next_alloc ; state ++ ) {
2369 U16 charid;
538e84ed 2370
147e3846 2371 Perl_re_indentf( aTHX_ " %4" UVXf " :",
cb41e5d6 2372 depth+1, (UV)state );
3dab1dad 2373 if ( ! trie->states[ state ].wordnum ) {
6ad9a8ab 2374 Perl_re_printf( aTHX_ "%5s| ","");
3dab1dad 2375 } else {
6ad9a8ab 2376 Perl_re_printf( aTHX_ "W%4x| ",
3dab1dad
YO		 2377 trie->states[ state ].wordnum
2378 );
2379 }
2380 for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) {
a7b8d88a 2381 SV ** const tmp = av_fetch( revcharmap,
88f063b4 2382 TRIE_LIST_ITEM(state, charid).forid, 0);
a7b8d88a 2383 if ( tmp ) {
147e3846 2384 Perl_re_printf( aTHX_ "%*s:%3X=%4" UVXf " | ",
ab3bbdeb 2385 colwidth,
538e84ed
KW		 2386 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp),
2387 colwidth,
2388 PL_colors[0], PL_colors[1],
2389 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0)
2390 | PERL_PV_ESCAPE_FIRSTCHAR
ab3bbdeb 2391 ) ,
88f063b4
KW		 2392 TRIE_LIST_ITEM(state, charid).forid,
2393 (UV)TRIE_LIST_ITEM(state, charid).newstate
1e2e3d02 2394 );
538e84ed 2395 if (!(charid % 10))
6ad9a8ab 2396 Perl_re_printf( aTHX_ "\n%*s| ",
664e119d 2397 (int)((depth * 2) + 14), "");
1e2e3d02 2398 }
ab3bbdeb 2399 }
6ad9a8ab 2400 Perl_re_printf( aTHX_ "\n");
3dab1dad 2401 }
538e84ed 2402}
3dab1dad
YO		 2403
2404/*
3dab1dad 2405 Dumps a fully constructed but uncompressed trie in table form.
538e84ed
KW		 2406 This is the normal DFA style state transition table, with a few
2407 twists to facilitate compression later.
3dab1dad
YO		 2408 Used for debugging make_trie().
2409*/
2410STATIC void
55eed653 2411S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie,
a7b8d88a
KW		 2412 HV *widecharmap, AV *revcharmap, U32 next_alloc,
2413 U32 depth)
3dab1dad
YO		 2414{
2415 U32 state;
2416 U16 charid;
ab3bbdeb 2417 SV *sv=sv_newmortal();
55eed653 2418 int colwidth= widecharmap ? 6 : 4;
271b36b1 2419 DECLARE_AND_GET_RE_DEBUG_FLAGS;
7918f24d
NC		 2420
2421 PERL_ARGS_ASSERT_DUMP_TRIE_INTERIM_TABLE;
538e84ed 2422
3dab1dad
YO		 2423 /*
2424 print out the table precompression so that we can do a visual check
2425 that they are identical.
2426 */
538e84ed 2427
6ad9a8ab 2428 Perl_re_indentf( aTHX_ "Char : ", depth+1 );
3dab1dad
YO		 2429
2430 for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
a7b8d88a 2431 SV ** const tmp = av_fetch( revcharmap, charid, 0);
3dab1dad 2432 if ( tmp ) {
6ad9a8ab 2433 Perl_re_printf( aTHX_ "%*s",
ab3bbdeb 2434 colwidth,
538e84ed 2435 pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth,
a7b8d88a
KW		 2436 PL_colors[0], PL_colors[1],
2437 (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
2438 PERL_PV_ESCAPE_FIRSTCHAR
538e84ed 2439 )
ab3bbdeb 2440 );
3dab1dad
YO		 2441 }
2442 }
2443
4aaafc03
YO		 2444 Perl_re_printf( aTHX_ "\n");
2445 Perl_re_indentf( aTHX_ "State+-", depth+1 );
3dab1dad
YO		 2446
2447 for( charid=0 ; charid < trie->uniquecharcount ; charid++ ) {
6ad9a8ab 2448 Perl_re_printf( aTHX_ "%.*s", colwidth,"--------");
3dab1dad
YO		 2449 }
2450
6ad9a8ab 2451 Perl_re_printf( aTHX_ "\n" );
3dab1dad
YO		 2452
2453 for( state=1 ; state < next_alloc ; state += trie->uniquecharcount ) {
2454
147e3846 2455 Perl_re_indentf( aTHX_ "%4" UVXf " : ",
cb41e5d6 2456 depth+1,
3dab1dad
YO		 2457 (UV)TRIE_NODENUM( state ) );
2458
2459 for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
ab3bbdeb
YO		 2460 UV v=(UV)SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next );
2461 if (v)
147e3846 2462 Perl_re_printf( aTHX_ "%*" UVXf, colwidth, v );
ab3bbdeb 2463 else
6ad9a8ab 2464 Perl_re_printf( aTHX_ "%*s", colwidth, "." );
3dab1dad
YO		 2465 }
2466 if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) {
147e3846 2467 Perl_re_printf( aTHX_ " (%4" UVXf ")\n",
538e84ed 2468 (UV)trie->trans[ state ].check );
3dab1dad 2469 } else {
147e3846 2470 Perl_re_printf( aTHX_ " (%4" UVXf ") W%4X\n",
538e84ed 2471 (UV)trie->trans[ state ].check,
3dab1dad
YO		 2472 trie->states[ TRIE_NODENUM( state ) ].wordnum );
2473 }
2474 }
07be1b83 2475}
3dab1dad
YO		 2476
2477#endif
2478
2e64971a 2479
786e8c11
YO		 2480/* make_trie(startbranch,first,last,tail,word_count,flags,depth)
2481 startbranch: the first branch in the whole branch sequence
2482 first : start branch of sequence of branch-exact nodes.
a7b8d88a 2483 May be the same as startbranch
786e8c11 2484 last : Thing following the last branch.
a7b8d88a 2485 May be the same as tail.
786e8c11
YO		 2486 tail : item following the branch sequence
2487 count : words in the sequence
a4525e78 2488 flags : currently the OP() type we will be building one of /EXACT(|F|FA|FU|FU_SS|L|FLU8)/
786e8c11 2489 depth : indent depth
3dab1dad 2490
786e8c11 2491Inplace optimizes a sequence of 2 or more Branch-Exact nodes into a TRIE node.
07be1b83 2492
786e8c11
YO		 2493A trie is an N'ary tree where the branches are determined by digital
2494decomposition of the key. IE, at the root node you look up the 1st character and
2495follow that branch repeat until you find the end of the branches. Nodes can be
2496marked as "accepting" meaning they represent a complete word. Eg:
07be1b83 2497
786e8c11 2498 /he|she|his|hers/
72f13be8 2499
786e8c11
YO		 2500would convert into the following structure. Numbers represent states, letters
2501following numbers represent valid transitions on the letter from that state, if
2502the number is in square brackets it represents an accepting state, otherwise it
2503will be in parenthesis.
07be1b83 2504
786e8c11
YO		 2505 +-h->+-e->[3]-+-r->(8)-+-s->[9]
2506 | |
2507 | (2)
2508 | |
2509 (1) +-i->(6)-+-s->[7]
2510 |
2511 +-s->(3)-+-h->(4)-+-e->[5]
07be1b83 2512
786e8c11
YO		 2513 Accept Word Mapping: 3=>1 (he),5=>2 (she), 7=>3 (his), 9=>4 (hers)
2514
2515This shows that when matching against the string 'hers' we will begin at state 1
2516read 'h' and move to state 2, read 'e' and move to state 3 which is accepting,
2517then read 'r' and go to state 8 followed by 's' which takes us to state 9 which
2518is also accepting. Thus we know that we can match both 'he' and 'hers' with a
2519single traverse. We store a mapping from accepting to state to which word was
2520matched, and then when we have multiple possibilities we try to complete the
b8fda935 2521rest of the regex in the order in which they occurred in the alternation.
786e8c11
YO		 2522
2523The only prior NFA like behaviour that would be changed by the TRIE support is
2524the silent ignoring of duplicate alternations which are of the form:
2525
2526 / (DUPE|DUPE) X? (?{ ... }) Y /x
2527
4b714af6 2528Thus EVAL blocks following a trie may be called a different number of times with
786e8c11 2529and without the optimisation. With the optimisations dupes will be silently
486ec47a 2530ignored. This inconsistent behaviour of EVAL type nodes is well established as
786e8c11
YO		 2531the following demonstrates:
2532
2533 'words'=~/(word|word|word)(?{ print $1 })[xyz]/
2534
2535which prints out 'word' three times, but
2536
2537 'words'=~/(word|word|word)(?{ print $1 })S/
2538
2539which doesnt print it out at all. This is due to other optimisations kicking in.
2540
2541Example of what happens on a structural level:
2542
486ec47a 2543The regexp /(ac|ad|ab)+/ will produce the following debug output:
786e8c11
YO		 2544
2545 1: CURLYM[1] {1,32767}(18)
2546 5: BRANCH(8)
2547 6: EXACT <ac>(16)
2548 8: BRANCH(11)
2549 9: EXACT <ad>(16)
2550 11: BRANCH(14)
2551 12: EXACT <ab>(16)
2552 16: SUCCEED(0)
2553 17: NOTHING(18)
2554 18: END(0)
2555
2556This would be optimizable with startbranch=5, first=5, last=16, tail=16
2557and should turn into:
2558
2559 1: CURLYM[1] {1,32767}(18)
2560 5: TRIE(16)
a7b8d88a
KW		 2561 [Words:3 Chars Stored:6 Unique Chars:4 States:5 NCP:1]
2562 <ac>
2563 <ad>
2564 <ab>
786e8c11
YO		 2565 16: SUCCEED(0)
2566 17: NOTHING(18)
2567 18: END(0)
2568
2569Cases where tail != last would be like /(?foo|bar)baz/:
2570
2571 1: BRANCH(4)
2572 2: EXACT <foo>(8)
2573 4: BRANCH(7)
2574 5: EXACT <bar>(8)
2575 7: TAIL(8)
2576 8: EXACT <baz>(10)
2577 10: END(0)
2578
2579which would be optimizable with startbranch=1, first=1, last=7, tail=8
2580and would end up looking like:
2581
2582 1: TRIE(8)
2583 [Words:2 Chars Stored:6 Unique Chars:5 States:7 NCP:1]
a7b8d88a
KW		 2584 <foo>
2585 <bar>
786e8c11
YO		 2586 7: TAIL(8)
2587 8: EXACT <baz>(10)
2588 10: END(0)
2589
c80e42f3 2590 d = uvchr_to_utf8_flags(d, uv, 0);
786e8c11
YO		 2591
2592is the recommended Unicode-aware way of saying
2593
2594 *(d++) = uv;
2595*/
2596
fab2782b 2597#define TRIE_STORE_REVCHAR(val) \
786e8c11 2598 STMT_START { \
a7b8d88a 2599 if (UTF) { \
668fcfea 2600 SV *zlopp = newSV(UTF8_MAXBYTES); \
a7b8d88a 2601 unsigned char *flrbbbbb = (unsigned char *) SvPVX(zlopp); \
1d84a256
DM		 2602 unsigned char *const kapow = uvchr_to_utf8(flrbbbbb, val); \
2603 *kapow = '\0'; \
a7b8d88a
KW		 2604 SvCUR_set(zlopp, kapow - flrbbbbb); \
2605 SvPOK_on(zlopp); \
2606 SvUTF8_on(zlopp); \
2607 av_push(revcharmap, zlopp); \
2608 } else { \
fab2782b 2609 char ooooff = (char)val; \
a7b8d88a
KW		 2610 av_push(revcharmap, newSVpvn(&ooooff, 1)); \
2611 } \
73031816 2612 } STMT_END
786e8c11 2613
914a25d5
KW		 2614/* This gets the next character from the input, folding it if not already
2615 * folded. */
2616#define TRIE_READ_CHAR STMT_START { \
2617 wordlen++; \
2618 if ( UTF ) { \
2619 /* if it is UTF then it is either already folded, or does not need \
2620 * folding */ \
1c1d615a 2621 uvc = valid_utf8_to_uvchr( (const U8*) uc, &len); \
914a25d5
KW		 2622 } \
2623 else if (folder == PL_fold_latin1) { \
7d006b13
KW		 2624 /* This folder implies Unicode rules, which in the range expressible \
2625 * by not UTF is the lower case, with the two exceptions, one of \
2626 * which should have been taken care of before calling this */ \
2627 assert(*uc != LATIN_SMALL_LETTER_SHARP_S); \
2628 uvc = toLOWER_L1(*uc); \
2629 if (UNLIKELY(uvc == MICRO_SIGN)) uvc = GREEK_SMALL_LETTER_MU; \
2630 len = 1; \
914a25d5
KW		 2631 } else { \
2632 /* raw data, will be folded later if needed */ \
2633 uvc = (U32)*uc; \
2634 len = 1; \
2635 } \
786e8c11
YO		 2636} STMT_END
2637
2638
2639
2640#define TRIE_LIST_PUSH(state,fid,ns) STMT_START { \
2641 if ( TRIE_LIST_CUR( state ) >=TRIE_LIST_LEN( state ) ) { \
a7b8d88a
KW		 2642 U32 ging = TRIE_LIST_LEN( state ) * 2; \
2643 Renew( trie->states[ state ].trans.list, ging, reg_trie_trans_le ); \
00195859 2644 TRIE_LIST_LEN( state ) = ging; \
786e8c11
YO		 2645 } \
2646 TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).forid = fid; \
2647 TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).newstate = ns; \
2648 TRIE_LIST_CUR( state )++; \
2649} STMT_END
07be1b83 2650
786e8c11 2651#define TRIE_LIST_NEW(state) STMT_START { \
d09f14bf 2652 Newx( trie->states[ state ].trans.list, \
a7b8d88a 2653 4, reg_trie_trans_le ); \
786e8c11
YO		 2654 TRIE_LIST_CUR( state ) = 1; \
2655 TRIE_LIST_LEN( state ) = 4; \
2656} STMT_END
07be1b83 2657
786e8c11
YO		 2658#define TRIE_HANDLE_WORD(state) STMT_START { \
2659 U16 dupe= trie->states[ state ].wordnum; \
2660 regnode * const noper_next = regnext( noper ); \
2661 \
786e8c11
YO		 2662 DEBUG_r({ \
2663 /* store the word for dumping */ \
2664 SV* tmp; \
2665 if (OP(noper) != NOTHING) \
740cce10 2666 tmp = newSVpvn_utf8(STRING(noper), STR_LEN(noper), UTF); \
786e8c11 2667 else \
740cce10 2668 tmp = newSVpvn_utf8( "", 0, UTF ); \
2b8b4781 2669 av_push( trie_words, tmp ); \
786e8c11
YO		 2670 }); \
2671 \
2672 curword++; \
2e64971a
DM		 2673 trie->wordinfo[curword].prev = 0; \
2674 trie->wordinfo[curword].len = wordlen; \
2675 trie->wordinfo[curword].accept = state; \
786e8c11
YO		 2676 \
2677 if ( noper_next < tail ) { \
2678 if (!trie->jump) \
538e84ed
KW		 2679 trie->jump = (U16 *) PerlMemShared_calloc( word_count + 1, \
2680 sizeof(U16) ); \
7f69552c 2681 trie->jump[curword] = (U16)(noper_next - convert); \
786e8c11
YO		 2682 if (!jumper) \
2683 jumper = noper_next; \
2684 if (!nextbranch) \
2685 nextbranch= regnext(cur); \
2686 } \
2687 \
2688 if ( dupe ) { \
2e64971a
DM		 2689 /* It's a dupe. Pre-insert into the wordinfo[].prev */\
2690 /* chain, so that when the bits of chain are later */\
2691 /* linked together, the dups appear in the chain */\
a7b8d88a
KW		 2692 trie->wordinfo[curword].prev = trie->wordinfo[dupe].prev; \
2693 trie->wordinfo[dupe].prev = curword; \
786e8c11
YO		 2694 } else { \
2695 /* we haven't inserted this word yet. */ \
2696 trie->states[ state ].wordnum = curword; \
2697 } \
2698} STMT_END
07be1b83 2699
3dab1dad 2700
786e8c11
YO		 2701#define TRIE_TRANS_STATE(state,base,ucharcount,charid,special) \
2702 ( ( base + charid >= ucharcount \
2703 && base + charid < ubound \
2704 && state == trie->trans[ base - ucharcount + charid ].check \
2705 && trie->trans[ base - ucharcount + charid ].next ) \
2706 ? trie->trans[ base - ucharcount + charid ].next \
2707 : ( state==1 ? special : 0 ) \
2708 )
3dab1dad 2709
8bcafbf4
YO		 2710#define TRIE_BITMAP_SET_FOLDED(trie, uvc, folder) \
2711STMT_START { \
2712 TRIE_BITMAP_SET(trie, uvc); \
2713 /* store the folded codepoint */ \
2714 if ( folder ) \
2715 TRIE_BITMAP_SET(trie, folder[(U8) uvc ]); \
2716 \
2717 if ( !UTF ) { \
2718 /* store first byte of utf8 representation of */ \
2719 /* variant codepoints */ \
2720 if (! UVCHR_IS_INVARIANT(uvc)) { \
2721 TRIE_BITMAP_SET(trie, UTF8_TWO_BYTE_HI(uvc)); \
2722 } \
2723 } \
2724} STMT_END
786e8c11
YO		 2725#define MADE_TRIE 1
2726#define MADE_JUMP_TRIE 2
2727#define MADE_EXACT_TRIE 4
3dab1dad 2728
a3621e74 2729STATIC I32
538e84ed
KW		 2730S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch,
2731 regnode *first, regnode *last, regnode *tail,
2732 U32 word_count, U32 flags, U32 depth)
a3621e74
YO		 2733{
2734 /* first pass, loop through and scan words */
2735 reg_trie_data *trie;
55eed653 2736 HV *widecharmap = NULL;
2b8b4781 2737 AV *revcharmap = newAV();
a3621e74 2738 regnode *cur;
a3621e74
YO		 2739 STRLEN len = 0;
2740 UV uvc = 0;
2741 U16 curword = 0;
2742 U32 next_alloc = 0;
786e8c11
YO		 2743 regnode *jumper = NULL;
2744 regnode *nextbranch = NULL;
7f69552c 2745 regnode *convert = NULL;
2e64971a 2746 U32 *prev_states; /* temp array mapping each state to previous one */
a3621e74 2747 /* we just use folder as a flag in utf8 */
1e696034 2748 const U8 * folder = NULL;
a3621e74 2749
3a611511
YO		 2750 /* in the below add_data call we are storing either 'tu' or 'tuaa'
2751 * which stands for one trie structure, one hash, optionally followed
2752 * by two arrays */
2b8b4781 2753#ifdef DEBUGGING
3a611511 2754 const U32 data_slot = add_data( pRExC_state, STR_WITH_LEN("tuaa"));
2b8b4781
NC		 2755 AV *trie_words = NULL;
2756 /* along with revcharmap, this only used during construction but both are
2757 * useful during debugging so we store them in the struct when debugging.
8e11feef 2758 */
2b8b4781 2759#else
cf78de0b 2760 const U32 data_slot = add_data( pRExC_state, STR_WITH_LEN("tu"));
3dab1dad 2761 STRLEN trie_charcount=0;
3dab1dad 2762#endif
2b8b4781 2763 SV *re_trie_maxbuff;
271b36b1 2764 DECLARE_AND_GET_RE_DEBUG_FLAGS;
7918f24d
NC		 2765
2766 PERL_ARGS_ASSERT_MAKE_TRIE;
72f13be8
YO		 2767#ifndef DEBUGGING
2768 PERL_UNUSED_ARG(depth);
2769#endif
a3621e74 2770
1e696034 2771 switch (flags) {
3f2416ae 2772 case EXACT: case EXACT_REQ8: case EXACTL: break;
a7b8d88a 2773 case EXACTFAA:
0ea669f4 2774 case EXACTFUP:
a7b8d88a
KW		 2775 case EXACTFU:
2776 case EXACTFLU8: folder = PL_fold_latin1; break;
2777 case EXACTF: folder = PL_fold; break;
fab2782b 2778 default: Perl_croak( aTHX_ "panic! In trie construction, unknown node type %u %s", (unsigned) flags, PL_reg_name[flags] );
1e696034
KW		 2779 }
2780
c944940b 2781 trie = (reg_trie_data *) PerlMemShared_calloc( 1, sizeof(reg_trie_data) );
a3621e74 2782 trie->refcount = 1;
3dab1dad 2783 trie->startstate = 1;
786e8c11 2784 trie->wordcount = word_count;
f8fc2ecf 2785 RExC_rxi->data->data[ data_slot ] = (void*)trie;
c944940b 2786 trie->charmap = (U16 *) PerlMemShared_calloc( 256, sizeof(U16) );
3f2416ae 2787 if (flags == EXACT || flags == EXACT_REQ8 || flags == EXACTL)
a7b8d88a 2788 trie->bitmap = (char *) PerlMemShared_calloc( ANYOF_BITMAP_SIZE, 1 );
2e64971a
DM		 2789 trie->wordinfo = (reg_trie_wordinfo *) PerlMemShared_calloc(
2790 trie->wordcount+1, sizeof(reg_trie_wordinfo));
2791
a3621e74 2792 DEBUG_r({
2b8b4781 2793 trie_words = newAV();
a3621e74 2794 });
a3621e74 2795
3b89859a 2796 re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, GV_ADD);
316ebaf2 2797 assert(re_trie_maxbuff);
a3621e74 2798 if (!SvIOK(re_trie_maxbuff)) {
0111c4fd 2799 sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT);
a3621e74 2800 }
df826430 2801 DEBUG_TRIE_COMPILE_r({
6ad9a8ab 2802 Perl_re_indentf( aTHX_
cb41e5d6
YO		 2803 "make_trie start==%d, first==%d, last==%d, tail==%d depth=%d\n",
2804 depth+1,
88f063b4 2805 REG_NODE_NUM(startbranch), REG_NODE_NUM(first),
538e84ed 2806 REG_NODE_NUM(last), REG_NODE_NUM(tail), (int)depth);
3dab1dad 2807 });
538e84ed 2808
7f69552c
YO		 2809 /* Find the node we are going to overwrite */
2810 if ( first == startbranch && OP( last ) != BRANCH ) {
2811 /* whole branch chain */
2812 convert = first;
2813 } else {
2814 /* branch sub-chain */
2815 convert = NEXTOPER( first );
2816 }
538e84ed 2817
a3621e74
YO		 2818 /* -- First loop and Setup --
2819
2820 We first traverse the branches and scan each word to determine if it
2821 contains widechars, and how many unique chars there are, this is
2822 important as we have to build a table with at least as many columns as we
2823 have unique chars.
2824
2825 We use an array of integers to represent the character codes 0..255
538e84ed
KW		 2826 (trie->charmap) and we use a an HV* to store Unicode characters. We use
2827 the native representation of the character value as the key and IV's for
2828 the coded index.
a3621e74
YO		 2829
2830 *TODO* If we keep track of how many times each character is used we can
2831 remap the columns so that the table compression later on is more
3b753521 2832 efficient in terms of memory by ensuring the most common value is in the
a3621e74
YO		 2833 middle and the least common are on the outside. IMO this would be better
2834 than a most to least common mapping as theres a decent chance the most
2835 common letter will share a node with the least common, meaning the node
486ec47a 2836 will not be compressible. With a middle is most common approach the worst
a3621e74
YO		 2837 case is when we have the least common nodes twice.
2838
2839 */
2840
a3621e74 2841 for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
df826430 2842 regnode *noper = NEXTOPER( cur );
944e05e3
YO		 2843 const U8 *uc;
2844 const U8 *e;
bc031a7d 2845 int foldlen = 0;
07be1b83 2846 U32 wordlen = 0; /* required init */
bc031a7d
KW		 2847 STRLEN minchars = 0;
2848 STRLEN maxchars = 0;
538e84ed
KW		 2849 bool set_bit = trie->bitmap ? 1 : 0; /*store the first char in the
2850 bitmap?*/
a3621e74 2851
3dab1dad 2852 if (OP(noper) == NOTHING) {
20ed8c88
YO		 2853 /* skip past a NOTHING at the start of an alternation
2854 * eg, /(?:)a|(?:b)/ should be the same as /a|b/
ca902fb8
YO		 2855 *
2856 * If the next node is not something we are supposed to process
2857 * we will just ignore it due to the condition guarding the
2858 * next block.
20ed8c88 2859 */
ca902fb8 2860
df826430 2861 regnode *noper_next= regnext(noper);
944e05e3
YO		 2862 if (noper_next < tail)
2863 noper= noper_next;
2864 }
2865
f6b4b99d
KW		 2866 if ( noper < tail
2867 && ( OP(noper) == flags
3f2416ae
KW		 2868 || (flags == EXACT && OP(noper) == EXACT_REQ8)
2869 || (flags == EXACTFU && ( OP(noper) == EXACTFU_REQ8
0ea669f4 2870 || OP(noper) == EXACTFUP))))
f6b4b99d 2871 {
944e05e3
YO		 2872 uc= (U8*)STRING(noper);
2873 e= uc + STR_LEN(noper);
2874 } else {
2875 trie->minlen= 0;
2876 continue;
3dab1dad 2877 }
df826430 2878
944e05e3 2879
fab2782b 2880 if ( set_bit ) { /* bitmap only alloced when !(UTF&&Folding) */
02daf0ab
YO		 2881 TRIE_BITMAP_SET(trie,*uc); /* store the raw first byte
2882 regardless of encoding */
0ea669f4 2883 if (OP( noper ) == EXACTFUP) {
fab2782b 2884 /* false positives are ok, so just set this */
0dc4a61d 2885 TRIE_BITMAP_SET(trie, LATIN_SMALL_LETTER_SHARP_S);
fab2782b
YO		 2886 }
2887 }
dca5fc4c 2888
bc031a7d
KW		 2889 for ( ; uc < e ; uc += len ) { /* Look at each char in the current
2890 branch */
3dab1dad 2891 TRIE_CHARCOUNT(trie)++;
a3621e74 2892 TRIE_READ_CHAR;
645de4ce 2893
bc031a7d
KW		 2894 /* TRIE_READ_CHAR returns the current character, or its fold if /i
2895 * is in effect. Under /i, this character can match itself, or
2896 * anything that folds to it. If not under /i, it can match just
2897 * itself. Most folds are 1-1, for example k, K, and KELVIN SIGN
2898 * all fold to k, and all are single characters. But some folds
2899 * expand to more than one character, so for example LATIN SMALL
2900 * LIGATURE FFI folds to the three character sequence 'ffi'. If
2901 * the string beginning at 'uc' is 'ffi', it could be matched by
2902 * three characters, or just by the one ligature character. (It
2903 * could also be matched by two characters: LATIN SMALL LIGATURE FF
2904 * followed by 'i', or by 'f' followed by LATIN SMALL LIGATURE FI).
2905 * (Of course 'I' and/or 'F' instead of 'i' and 'f' can also
2906 * match.) The trie needs to know the minimum and maximum number
2907 * of characters that could match so that it can use size alone to
2908 * quickly reject many match attempts. The max is simple: it is
2909 * the number of folded characters in this branch (since a fold is
2910 * never shorter than what folds to it. */
2911
2912 maxchars++;
2913
2914 /* And the min is equal to the max if not under /i (indicated by
2915 * 'folder' being NULL), or there are no multi-character folds. If
2916 * there is a multi-character fold, the min is incremented just
2917 * once, for the character that folds to the sequence. Each
2918 * character in the sequence needs to be added to the list below of
2919 * characters in the trie, but we count only the first towards the
2920 * min number of characters needed. This is done through the
2921 * variable 'foldlen', which is returned by the macros that look
2922 * for these sequences as the number of bytes the sequence
2923 * occupies. Each time through the loop, we decrement 'foldlen' by
2924 * how many bytes the current char occupies. Only when it reaches
2925 * 0 do we increment 'minchars' or look for another multi-character
2926 * sequence. */
2927 if (folder == NULL) {
2928 minchars++;
2929 }
2930 else if (foldlen > 0) {
2931 foldlen -= (UTF) ? UTF8SKIP(uc) : 1;
645de4ce
KW		 2932 }
2933 else {
bc031a7d
KW		 2934 minchars++;
2935
2936 /* See if *uc is the beginning of a multi-character fold. If
2937 * so, we decrement the length remaining to look at, to account
2938 * for the current character this iteration. (We can use 'uc'
cf9d46fd
KW		 2939 * instead of the fold returned by TRIE_READ_CHAR because the
2940 * macro is smart enough to account for any unfolded
2941 * characters. */
bc031a7d
KW		 2942 if (UTF) {
2943 if ((foldlen = is_MULTI_CHAR_FOLD_utf8_safe(uc, e))) {
2944 foldlen -= UTF8SKIP(uc);
645de4ce
KW		 2945 }
2946 }
bc031a7d
KW		 2947 else if ((foldlen = is_MULTI_CHAR_FOLD_latin1_safe(uc, e))) {
2948 foldlen--;
2949 }
645de4ce 2950 }
bc031a7d
KW		 2951
2952 /* The current character (and any potential folds) should be added
2953 * to the possible matching characters for this position in this
2954 * branch */
a3621e74 2955 if ( uvc < 256 ) {
fab2782b
YO		 2956 if ( folder ) {
2957 U8 folded= folder[ (U8) uvc ];
2958 if ( !trie->charmap[ folded ] ) {
2959 trie->charmap[ folded ]=( ++trie->uniquecharcount );
2960 TRIE_STORE_REVCHAR( folded );
2961 }
2962 }
a3621e74
YO		 2963 if ( !trie->charmap[ uvc ] ) {
2964 trie->charmap[ uvc ]=( ++trie->uniquecharcount );
fab2782b 2965 TRIE_STORE_REVCHAR( uvc );
a3621e74 2966 }
02daf0ab 2967 if ( set_bit ) {
a7b8d88a
KW		 2968 /* store the codepoint in the bitmap, and its folded
2969 * equivalent. */
8bcafbf4 2970 TRIE_BITMAP_SET_FOLDED(trie, uvc, folder);
02daf0ab
YO		 2971 set_bit = 0; /* We've done our bit :-) */
2972 }
a3621e74 2973 } else {
bc031a7d
KW		 2974
2975 /* XXX We could come up with the list of code points that fold
2976 * to this using PL_utf8_foldclosures, except not for
2977 * multi-char folds, as there may be multiple combinations
2978 * there that could work, which needs to wait until runtime to
2979 * resolve (The comment about LIGATURE FFI above is such an
2980 * example */
2981
a3621e74 2982 SV** svpp;
55eed653
NC		 2983 if ( !widecharmap )
2984 widecharmap = newHV();
a3621e74 2985
55eed653 2986 svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), 1 );
a3621e74
YO		 2987
2988 if ( !svpp )
147e3846 2989 Perl_croak( aTHX_ "error creating/fetching widecharmap entry for 0x%" UVXf, uvc );
a3621e74
YO		 2990
2991 if ( !SvTRUE( *svpp ) ) {
2992 sv_setiv( *svpp, ++trie->uniquecharcount );
fab2782b 2993 TRIE_STORE_REVCHAR(uvc);
a3621e74
YO		 2994 }
2995 }
bc031a7d
KW		 2996 } /* end loop through characters in this branch of the trie */
2997
2998 /* We take the min and max for this branch and combine to find the min
2999 * and max for all branches processed so far */
3dab1dad 3000 if( cur == first ) {
bc031a7d
KW		 3001 trie->minlen = minchars;
3002 trie->maxlen = maxchars;
3003 } else if (minchars < trie->minlen) {
3004 trie->minlen = minchars;
3005 } else if (maxchars > trie->maxlen) {
3006 trie->maxlen = maxchars;
fab2782b 3007 }
a3621e74
YO		 3008 } /* end first pass */
3009 DEBUG_TRIE_COMPILE_r(
6ad9a8ab 3010 Perl_re_indentf( aTHX_
cb41e5d6
YO		 3011 "TRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n",
3012 depth+1,
55eed653 3013 ( widecharmap ? "UTF8" : "NATIVE" ), (int)word_count,
a7b8d88a
KW		 3014 (int)TRIE_CHARCOUNT(trie), trie->uniquecharcount,
3015 (int)trie->minlen, (int)trie->maxlen )
a3621e74 3016 );
a3621e74
YO		 3017
3018 /*
3019 We now know what we are dealing with in terms of unique chars and
3020 string sizes so we can calculate how much memory a naive
0111c4fd
RGS		 3021 representation using a flat table will take. If it's over a reasonable
3022 limit (as specified by ${^RE_TRIE_MAXBUF}) we use a more memory
a3621e74
YO		 3023 conservative but potentially much slower representation using an array
3024 of lists.
3025
3026 At the end we convert both representations into the same compressed
3027 form that will be used in regexec.c for matching with. The latter
3028 is a form that cannot be used to construct with but has memory
3029 properties similar to the list form and access properties similar
3030 to the table form making it both suitable for fast searches and
3031 small enough that its feasable to store for the duration of a program.
3032
3033 See the comment in the code where the compressed table is produced
3034 inplace from the flat tabe representation for an explanation of how
3035 the compression works.
3036
3037 */
3038
3039
2e64971a
DM		 3040 Newx(prev_states, TRIE_CHARCOUNT(trie) + 2, U32);
3041 prev_states[1] = 0;
3042
538e84ed
KW		 3043 if ( (IV)( ( TRIE_CHARCOUNT(trie) + 1 ) * trie->uniquecharcount + 1)
3044 > SvIV(re_trie_maxbuff) )
3045 {
a3621e74
YO		 3046 /*
3047 Second Pass -- Array Of Lists Representation
3048
3049 Each state will be represented by a list of charid:state records
3050 (reg_trie_trans_le) the first such element holds the CUR and LEN
3051 points of the allocated array. (See defines above).
3052
3053 We build the initial structure using the lists, and then convert
3054 it into the compressed table form which allows faster lookups
3055 (but cant be modified once converted).
a3621e74
YO		 3056 */
3057
a3621e74
YO		 3058 STRLEN transcount = 1;
3059
6ad9a8ab 3060 DEBUG_TRIE_COMPILE_MORE_r( Perl_re_indentf( aTHX_ "Compiling trie using list compiler\n",
cb41e5d6 3061 depth+1));
686b73d4 3062
a7b8d88a
KW		 3063 trie->states = (reg_trie_state *)
3064 PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2,
3065 sizeof(reg_trie_state) );
a3621e74
YO		 3066 TRIE_LIST_NEW(1);
3067 next_alloc = 2;
3068
3069 for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
3070
df826430 3071 regnode *noper = NEXTOPER( cur );
a7b8d88a
KW		 3072 U32 state = 1; /* required init */
3073 U16 charid = 0; /* sanity init */
07be1b83 3074 U32 wordlen = 0; /* required init */
c445ea15 3075
df826430
YO		 3076 if (OP(noper) == NOTHING) {
3077 regnode *noper_next= regnext(noper);
944e05e3
YO		 3078 if (noper_next < tail)
3079 noper= noper_next;
ca902fb8
YO		 3080 /* we will undo this assignment if noper does not
3081 * point at a trieable type in the else clause of
3082 * the following statement. */
df826430
YO		 3083 }
3084
f6b4b99d
KW		 3085 if ( noper < tail
3086 && ( OP(noper) == flags
3f2416ae
KW		 3087 || (flags == EXACT && OP(noper) == EXACT_REQ8)
3088 || (flags == EXACTFU && ( OP(noper) == EXACTFU_REQ8
0ea669f4 3089 || OP(noper) == EXACTFUP))))
f6b4b99d 3090 {
944e05e3
YO		 3091 const U8 *uc= (U8*)STRING(noper);
3092 const U8 *e= uc + STR_LEN(noper);
3093
786e8c11 3094 for ( ; uc < e ; uc += len ) {
c445ea15 3095
786e8c11 3096 TRIE_READ_CHAR;
c445ea15 3097
786e8c11
YO		 3098 if ( uvc < 256 ) {
3099 charid = trie->charmap[ uvc ];
a7b8d88a 3100 } else {
538e84ed
KW		 3101 SV** const svpp = hv_fetch( widecharmap,
3102 (char*)&uvc,
3103 sizeof( UV ),
3104 0);
786e8c11
YO		 3105 if ( !svpp ) {
3106 charid = 0;
3107 } else {
3108 charid=(U16)SvIV( *svpp );
3109 }
a7b8d88a 3110 }
538e84ed
KW		 3111 /* charid is now 0 if we dont know the char read, or
3112 * nonzero if we do */
786e8c11 3113 if ( charid ) {
a3621e74 3114
786e8c11
YO		 3115 U16 check;
3116 U32 newstate = 0;
a3621e74 3117
786e8c11
YO		 3118 charid--;
3119 if ( !trie->states[ state ].trans.list ) {
3120 TRIE_LIST_NEW( state );
a7b8d88a 3121 }
538e84ed
KW		 3122 for ( check = 1;
3123 check <= TRIE_LIST_USED( state );
3124 check++ )
3125 {
3126 if ( TRIE_LIST_ITEM( state, check ).forid
3127 == charid )
3128 {
786e8c11
YO		 3129 newstate = TRIE_LIST_ITEM( state, check ).newstate;
3130 break;
3131 }
3132 }
3133 if ( ! newstate ) {
3134 newstate = next_alloc++;
a7b8d88a 3135 prev_states[newstate] = state;
786e8c11
YO		 3136 TRIE_LIST_PUSH( state, charid, newstate );
3137 transcount++;
3138 }
3139 state = newstate;
3140 } else {
147e3846 3141 Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %" IVdf, uvc );
a7b8d88a
KW		 3142 }
3143 }
ca902fb8
YO		 3144 } else {
3145 /* If we end up here it is because we skipped past a NOTHING, but did not end up
3146 * on a trieable type. So we need to reset noper back to point at the first regop
3147 * in the branch before we call TRIE_HANDLE_WORD()
3148 */
3149 noper= NEXTOPER(cur);
3150 }
3dab1dad 3151 TRIE_HANDLE_WORD(state);
a3621e74
YO		 3152
3153 } /* end second pass */
3154
1e2e3d02 3155 /* next alloc is the NEXT state to be allocated */
538e84ed 3156 trie->statecount = next_alloc;
c944940b 3157 trie->states = (reg_trie_state *)
a7b8d88a
KW		 3158 PerlMemShared_realloc( trie->states,
3159 next_alloc
3160 * sizeof(reg_trie_state) );
a3621e74 3161
3dab1dad 3162 /* and now dump it out before we compress it */
2b8b4781 3163 DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_list(trie, widecharmap,
a7b8d88a
KW		 3164 revcharmap, next_alloc,
3165 depth+1)
1e2e3d02 3166 );
a3621e74 3167
c944940b 3168 trie->trans = (reg_trie_trans *)
a7b8d88a 3169 PerlMemShared_calloc( transcount, sizeof(reg_trie_trans) );
a3621e74
YO		 3170 {
3171 U32 state;
a3621e74
YO		 3172 U32 tp = 0;
3173 U32 zp = 0;
3174
3175
3176 for( state=1 ; state < next_alloc ; state ++ ) {
3177 U32 base=0;
3178
3179 /*
3180 DEBUG_TRIE_COMPILE_MORE_r(
6ad9a8ab 3181 Perl_re_printf( aTHX_ "tp: %d zp: %d ",tp,zp)
a3621e74
YO		 3182 );
3183 */
3184
3185 if (trie->states[state].trans.list) {
3186 U16 minid=TRIE_LIST_ITEM( state, 1).forid;
3187 U16 maxid=minid;
a7b8d88a 3188 U16 idx;
a3621e74
YO		 3189
3190 for( idx = 2 ; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
a7b8d88a
KW		 3191 const U16 forid = TRIE_LIST_ITEM( state, idx).forid;
3192 if ( forid < minid ) {
3193 minid=forid;
3194 } else if ( forid > maxid ) {
3195 maxid=forid;
3196 }
a3621e74
YO		 3197 }
3198 if ( transcount < tp + maxid - minid + 1) {
3199 transcount *= 2;
a7b8d88a
KW		 3200 trie->trans = (reg_trie_trans *)
3201 PerlMemShared_realloc( trie->trans,
3202 transcount
3203 * sizeof(reg_trie_trans) );
538e84ed
KW		 3204 Zero( trie->trans + (transcount / 2),
3205 transcount / 2,
3206 reg_trie_trans );
a3621e74
YO		 3207 }
3208 base = trie->uniquecharcount + tp - minid;
3209 if ( maxid == minid ) {
3210 U32 set = 0;
3211 for ( ; zp < tp ; zp++ ) {
3212 if ( ! trie->trans[ zp ].next ) {
3213 base = trie->uniquecharcount + zp - minid;
538e84ed
KW		 3214 trie->trans[ zp ].next = TRIE_LIST_ITEM( state,
3215 1).newstate;
a3621e74
YO		 3216 trie->trans[ zp ].check = state;
3217 set = 1;
3218 break;
3219 }
3220 }
3221 if ( !set ) {
538e84ed
KW		 3222 trie->trans[ tp ].next = TRIE_LIST_ITEM( state,
3223 1).newstate;
a3621e74
YO		 3224 trie->trans[ tp ].check = state;
3225 tp++;
3226 zp = tp;
3227 }
3228 } else {
3229 for ( idx=1; idx <= TRIE_LIST_USED( state ) ; idx++ ) {
538e84ed
KW		 3230 const U32 tid = base
3231 - trie->uniquecharcount
3232 + TRIE_LIST_ITEM( state, idx ).forid;
3233 trie->trans[ tid ].next = TRIE_LIST_ITEM( state,
3234 idx ).newstate;
a3621e74
YO		 3235 trie->trans[ tid ].check = state;
3236 }
3237 tp += ( maxid - minid + 1 );
3238 }
3239 Safefree(trie->states[ state ].trans.list);
3240 }
3241 /*
3242 DEBUG_TRIE_COMPILE_MORE_r(
6ad9a8ab 3243 Perl_re_printf( aTHX_ " base: %d\n",base);
a3621e74
YO		 3244 );
3245 */
3246 trie->states[ state ].trans.base=base;
3247 }
cc601c31 3248 trie->lasttrans = tp + 1;
a3621e74
YO		 3249 }
3250 } else {
3251 /*
3252 Second Pass -- Flat Table Representation.
3253
b423522f
KW		 3254 we dont use the 0 slot of either trans[] or states[] so we add 1 to
3255 each. We know that we will need Charcount+1 trans at most to store
3256 the data (one row per char at worst case) So we preallocate both
3257 structures assuming worst case.
a3621e74
YO		 3258
3259 We then construct the trie using only the .next slots of the entry
3260 structs.
3261
b423522f
KW		 3262 We use the .check field of the first entry of the node temporarily
3263 to make compression both faster and easier by keeping track of how
3264 many non zero fields are in the node.
a3621e74
YO		 3265
3266 Since trans are numbered from 1 any 0 pointer in the table is a FAIL
3267 transition.
3268
b423522f
KW		 3269 There are two terms at use here: state as a TRIE_NODEIDX() which is
3270 a number representing the first entry of the node, and state as a
3271 TRIE_NODENUM() which is the trans number. state 1 is TRIE_NODEIDX(1)
3272 and TRIE_NODENUM(1), state 2 is TRIE_NODEIDX(2) and TRIE_NODENUM(3)
3273 if there are 2 entrys per node. eg:
a3621e74
YO		 3274
3275 A B A B
3276 1. 2 4 1. 3 7
3277 2. 0 3 3. 0 5
3278 3. 0 0 5. 0 0
3279 4. 0 0 7. 0 0
3280
b423522f
KW		 3281 The table is internally in the right hand, idx form. However as we
3282 also have to deal with the states array which is indexed by nodenum
3283 we have to use TRIE_NODENUM() to convert.
a3621e74
YO		 3284
3285 */
6ad9a8ab 3286 DEBUG_TRIE_COMPILE_MORE_r( Perl_re_indentf( aTHX_ "Compiling trie using table compiler\n",
cb41e5d6 3287 depth+1));
3dab1dad 3288
a7b8d88a
KW		 3289 trie->trans = (reg_trie_trans *)
3290 PerlMemShared_calloc( ( TRIE_CHARCOUNT(trie) + 1 )
3291 * trie->uniquecharcount + 1,
3292 sizeof(reg_trie_trans) );
c944940b 3293 trie->states = (reg_trie_state *)
a7b8d88a
KW		 3294 PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2,
3295 sizeof(reg_trie_state) );
a3621e74
YO		 3296 next_alloc = trie->uniquecharcount + 1;
3297
3dab1dad 3298
a3621e74
YO		 3299 for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
3300
df826430 3301 regnode *noper = NEXTOPER( cur );
a3621e74
YO		 3302
3303 U32 state = 1; /* required init */
3304
3305 U16 charid = 0; /* sanity init */
3306 U32 accept_state = 0; /* sanity init */
a3621e74 3307
07be1b83 3308 U32 wordlen = 0; /* required init */
a3621e74 3309
df826430
YO		 3310 if (OP(noper) == NOTHING) {
3311 regnode *noper_next= regnext(noper);
944e05e3
YO		 3312 if (noper_next < tail)
3313 noper= noper_next;
ca902fb8
YO		 3314 /* we will undo this assignment if noper does not
3315 * point at a trieable type in the else clause of
3316 * the following statement. */
df826430 3317 }
fab2782b 3318
f6b4b99d
KW		 3319 if ( noper < tail
3320 && ( OP(noper) == flags
3f2416ae
KW		 3321 || (flags == EXACT && OP(noper) == EXACT_REQ8)
3322 || (flags == EXACTFU && ( OP(noper) == EXACTFU_REQ8
0ea669f4 3323 || OP(noper) == EXACTFUP))))
f6b4b99d 3324 {
944e05e3
YO		 3325 const U8 *uc= (U8*)STRING(noper);
3326 const U8 *e= uc + STR_LEN(noper);
3327
786e8c11 3328 for ( ; uc < e ; uc += len ) {
a3621e74 3329
786e8c11 3330 TRIE_READ_CHAR;
a3621e74 3331
786e8c11
YO		 3332 if ( uvc < 256 ) {
3333 charid = trie->charmap[ uvc ];
3334 } else {
538e84ed
KW		 3335 SV* const * const svpp = hv_fetch( widecharmap,
3336 (char*)&uvc,
3337 sizeof( UV ),
3338 0);
786e8c11 3339 charid = svpp ? (U16)SvIV(*svpp) : 0;
a3621e74 3340 }
786e8c11
YO		 3341 if ( charid ) {
3342 charid--;
3343 if ( !trie->trans[ state + charid ].next ) {
3344 trie->trans[ state + charid ].next = next_alloc;
3345 trie->trans[ state ].check++;
a7b8d88a
KW		 3346 prev_states[TRIE_NODENUM(next_alloc)]
3347 = TRIE_NODENUM(state);
786e8c11
YO		 3348 next_alloc += trie->uniquecharcount;
3349 }
3350 state = trie->trans[ state + charid ].next;
3351 } else {
147e3846 3352 Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %" IVdf, uvc );
786e8c11 3353 }
538e84ed
KW		 3354 /* charid is now 0 if we dont know the char read, or
3355 * nonzero if we do */
a3621e74 3356 }
ca902fb8
YO		 3357 } else {
3358 /* If we end up here it is because we skipped past a NOTHING, but did not end up
3359 * on a trieable type. So we need to reset noper back to point at the first regop
3360 * in the branch before we call TRIE_HANDLE_WORD().
3361 */
3362 noper= NEXTOPER(cur);
a3621e74 3363 }
3dab1dad
YO		 3364 accept_state = TRIE_NODENUM( state );
3365 TRIE_HANDLE_WORD(accept_state);
a3621e74
YO		 3366
3367 } /* end second pass */
3368
3dab1dad 3369 /* and now dump it out before we compress it */
2b8b4781 3370 DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_table(trie, widecharmap,
a7b8d88a
KW		 3371 revcharmap,
3372 next_alloc, depth+1));
a3621e74 3373
a3621e74
YO		 3374 {
3375 /*
3376 * Inplace compress the table.*
3377
3378 For sparse data sets the table constructed by the trie algorithm will
3379 be mostly 0/FAIL transitions or to put it another way mostly empty.
3380 (Note that leaf nodes will not contain any transitions.)
3381
3382 This algorithm compresses the tables by eliminating most such
3383 transitions, at the cost of a modest bit of extra work during lookup:
3384
3385 - Each states[] entry contains a .base field which indicates the
3386 index in the state[] array wheres its transition data is stored.
3387
3b753521 3388 - If .base is 0 there are no valid transitions from that node.
a3621e74
YO		 3389
3390 - If .base is nonzero then charid is added to it to find an entry in
3391 the trans array.
3392
3393 -If trans[states[state].base+charid].check!=state then the
3394 transition is taken to be a 0/Fail transition. Thus if there are fail
3395 transitions at the front of the node then the .base offset will point
3396 somewhere inside the previous nodes data (or maybe even into a node
3397 even earlier), but the .check field determines if