DMS-Parser
view release on metacpan or search on metacpan
lib/DMS/Parser/Tier1.pm view on Meta::CPAN
# (TIER1.md §"Tier-0 reserved decorator sigil set")
my %SIGIL_CHAR = map { $_ => 1 } split //, '!@$%^&*|~`.,><;?=';
sub is_sigil_char { exists $SIGIL_CHAR{$_[0]} }
# ── Extended_Pictographic ranges (frozen Unicode 15.1) ─────────────────────────
# Ported from dms-rs/crates/dms/src/lib.rs `EXTENDED_PICTOGRAPHIC_RANGES`.
my @EXTENDED_PICTOGRAPHIC_RANGES = (
[0x00A9, 0x00A9], [0x00AE, 0x00AE], [0x203C, 0x203C], [0x2049, 0x2049],
[0x2122, 0x2122], [0x2139, 0x2139], [0x2194, 0x2199], [0x21A9, 0x21AA],
[0x231A, 0x231B], [0x2328, 0x2328], [0x2388, 0x2388], [0x23CF, 0x23CF],
[0x23E9, 0x23F3], [0x23F8, 0x23FA], [0x24C2, 0x24C2], [0x25AA, 0x25AB],
[0x25B6, 0x25B6], [0x25C0, 0x25C0], [0x25FB, 0x25FE], [0x2600, 0x2605],
[0x2607, 0x2612], [0x2614, 0x2685], [0x2690, 0x2705], [0x2708, 0x2712],
[0x2714, 0x2714], [0x2716, 0x2716], [0x271D, 0x271D], [0x2721, 0x2721],
[0x2728, 0x2728], [0x2733, 0x2734], [0x2744, 0x2744], [0x2747, 0x2747],
[0x274C, 0x274C], [0x274E, 0x274E], [0x2753, 0x2755], [0x2757, 0x2757],
[0x2763, 0x2767], [0x2795, 0x2797], [0x27A1, 0x27A1], [0x27B0, 0x27B0],
[0x27BF, 0x27BF], [0x2934, 0x2935], [0x2B05, 0x2B07], [0x2B1B, 0x2B1C],
[0x2B50, 0x2B50], [0x2B55, 0x2B55], [0x3030, 0x3030], [0x303D, 0x303D],
[0x3297, 0x3297], [0x3299, 0x3299], [0x1F000, 0x1F0FF], [0x1F10D, 0x1F10F],
[0x1F12F, 0x1F12F], [0x1F16C, 0x1F171], [0x1F17E, 0x1F17F], [0x1F18E, 0x1F18E],
[0x1F191, 0x1F19A], [0x1F1AD, 0x1F1E5], [0x1F201, 0x1F20F], [0x1F21A, 0x1F21A],
[0x1F22F, 0x1F22F], [0x1F232, 0x1F23A], [0x1F23C, 0x1F23F], [0x1F249, 0x1F3FA],
[0x1F400, 0x1F53D], [0x1F546, 0x1F64F], [0x1F680, 0x1F6FF], [0x1F774, 0x1F77F],
[0x1F7D5, 0x1F7FF], [0x1F80C, 0x1F80F], [0x1F848, 0x1F84F], [0x1F85A, 0x1F85F],
[0x1F888, 0x1F88F], [0x1F8AE, 0x1F8FF], [0x1F90C, 0x1F93A], [0x1F93C, 0x1F945],
[0x1F947, 0x1FAFF], [0x1FC00, 0x1FFFD],
);
# Binary search over @EXTENDED_PICTOGRAPHIC_RANGES.
sub _is_extended_pictographic {
my ($cp) = @_;
return 0 if $cp < 0xA9;
my ($lo, $hi) = (0, $#EXTENDED_PICTOGRAPHIC_RANGES);
while ($lo <= $hi) {
my $mid = int(($lo + $hi) / 2);
my ($rlo, $rhi) = @{$EXTENDED_PICTOGRAPHIC_RANGES[$mid]};
if ($cp < $rlo) { $hi = $mid - 1; }
elsif ($cp > $rhi) { $lo = $mid + 1; }
else { return 1; }
}
return 0;
}
# True iff $cp is in the Reserved Emoji Set (SPEC/TIER1).
sub _is_reserved_emoji_codepoint {
my ($cp) = @_;
return 1 if $cp >= 0x1F1E6 && $cp <= 0x1F1FF; # Regional Indicators
return 1 if $cp >= 0x1F3FB && $cp <= 0x1F3FF; # Skin-tone modifiers
return 1 if $cp == 0x20E3; # Combining Enclosing Keycap
return _is_extended_pictographic($cp);
}
sub _is_regional_indicator { my ($cp) = @_; $cp >= 0x1F1E6 && $cp <= 0x1F1FF }
sub _is_emoji_modifier { my ($cp) = @_; $cp >= 0x1F3FB && $cp <= 0x1F3FF }
# Read one Reserved-Emoji extended grapheme cluster from a *character* string
# starting at character offset $pos. Returns the new position (past the cluster)
# or undef if no emoji cluster starts at $pos.
# The input $str must be a Perl character string (decoded Unicode).
sub _read_reserved_emoji_atom_char {
my ($str, $pos) = @_;
my $len = length($str);
return undef if $pos >= $len;
my $c0 = substr($str, $pos, 1);
my $cp0 = ord($c0);
return undef unless _is_reserved_emoji_codepoint($cp0);
my $end = $pos + 1;
# Regional-indicator pair (UAX #29 GB12/GB13)
if (_is_regional_indicator($cp0)) {
if ($end < $len) {
my $c1 = substr($str, $end, 1);
if (_is_regional_indicator(ord($c1))) {
$end++;
}
}
return $end;
}
# GB9/GB9a/GB11 loop: extend across modifiers, VS-16, keycap combiner, ZWJ+EP
while ($end < $len) {
my $c = substr($str, $end, 1);
my $cp = ord($c);
if (_is_emoji_modifier($cp) || $cp == 0xFE0F || $cp == 0x20E3) {
$end++;
next;
}
if ($cp == 0x200D) {
# ZWJ — continue only if followed by Extended_Pictographic
my $after_zwj = $end + 1;
if ($after_zwj < $len) {
my $nc = substr($str, $after_zwj, 1);
if (_is_extended_pictographic(ord($nc))) {
$end = $after_zwj + 1;
next;
}
}
last; # ZWJ not followed by E_P
}
last;
}
return $end;
}
# True iff a sigil atom can start at character offset $pos in $str.
# An atom is either an ASCII sigil char or a Reserved-Emoji cluster start.
sub _is_sigil_atom_start {
my ($str, $pos) = @_;
return 0 if $pos >= length($str);
my $c = substr($str, $pos, 1);
return 1 if is_sigil_char($c);
return _is_reserved_emoji_codepoint(ord($c));
}
# Consume one sigil atom from character string $str at position $pos.
# Returns new position (past the atom), or undef if not a sigil atom.
sub _consume_sigil_atom {
lib/DMS/Parser/Tier1.pm view on Meta::CPAN
next;
}
push @out, $ln;
$i++;
}
return join("\n", @out);
}
1;
__END__
=encoding UTF-8
=head1 NAME
DMS::Parser::Tier1 - Tier-1 DMS decoder: decorator calls, imports, sigil lexing
=head1 SYNOPSIS
# Typically called via the high-level wrapper:
use DMS::Parser;
my $result = DMS::Parser::decode_t1($src);
# $result->{tier} — 0 or 1
# $result->{imports} — arrayref of ImportSpec hashrefs
# $result->{body} — value tree (same shape as decode())
# $result->{decorators} — arrayref of decorator entry hashrefs
# Internal helpers (advanced use):
use DMS::Parser::Tier1;
my $imports = DMS::Parser::Tier1::extract_imports($fm_hashref);
my ($clean_body, $raw_decs) = DMS::Parser::Tier1::scan_body($body_text, $imports);
=head1 DESCRIPTION
DMS::Parser::Tier1 implements the tier-1 DMS decoder. Tier-1 documents carry an
C<_dms_tier: 1> key in their front matter and may contain decorator calls —
sigil-prefixed annotations attached to values at leading, inner, trailing, or
flow-inner positions.
This module is B<internal-ish>: most callers should use C<DMS::Parser::decode_t1>
rather than calling these helpers directly. The public functions are documented
here for integrators who need low-level access to the sigil lexer or import
extractor.
=head1 FUNCTIONS
=head2 decode_t1($src)
Main entry point. Parses C<$src> as a tier-0 or tier-1 DMS document. Returns a
hashref:
=over 4
=item * C<tier> — integer 0 or 1.
=item * C<imports> — arrayref of ImportSpec hashrefs (empty for tier-0 docs).
Each ImportSpec has keys C<dialect>, C<version>, C<ns>, C<bind>, C<allow>,
C<deny>, C<alias>.
=item * C<body> — the decoded value tree (same shape as C<DMS::Parser::decode>).
=item * C<decorators> — arrayref of decorator entry hashrefs, each with C<path>,
C<calls> (hashref of sigil → arrayref of call records), and C<comments>.
=item * C<_raw_doc> — the underlying tier-0 Document (for callers that need the
full Document including front matter and comments).
=back
Dies with a C<line:col: message> diagnostic on parse or validation error.
=head2 extract_imports($meta_hashref)
Extract and validate the C<_dms_imports> list from a parsed front-matter hashref.
Returns an arrayref of ImportSpec hashrefs. Dies on validation error (bad semver,
binding collision, invalid sigil, etc.).
=head2 scan_body($body_src, $imports, $line_offset)
Scan the body source text for decorator calls. Returns C<($clean_body,
$raw_decs)> where C<$clean_body> has all decorator tokens removed (safe to feed
to the tier-0 parser) and C<$raw_decs> is an arrayref of raw decorator records.
=head2 is_sigil_char($char)
Returns true if C<$char> is in the tier-0 reserved ASCII decorator sigil set
(C<! @ $ % ^ & * | ~ ` . , E<gt> E<lt> ; ? =>).
=head2 resolve_call($sigil, $ns, $fn_name, $imports)
Resolve a decorator call through the import table. Returns C<($family,
$canonical_fn)>. Dies on unknown namespace, ambiguous family, or deny-listed
function.
=head1 SEE ALSO
L<DMS::Parser>, L<DMS::Parser::Emitter>,
L<https://gitlab.com/flo-labs/pub/dms>
=head1 AUTHOR
Filip Lopes
=head1 LICENSE
Dual-licensed under the Apache License 2.0 and the MIT license, at your option.
=cut
( run in 0.632 second using v1.01-cache-2.11-cpan-600a1bdf6e4 )