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