提交: c5724a598d0e0e376b567fcadc9ead0999225881 - Text-Hjson-perl (git)

Commit MetaInfo

• 修訂: c5724a598d0e0e376b567fcadc9ead0999225881 (tree)
• 時間: 2023-04-03 02:44:20
• 作者: dyknon <dyknon@user...>
• Commiter: dyknon

Log Message

Remove unneeded "Grammar" file

Change Summary

• modified: lib/Text/Hjson.pm
• delete: lib/Text/Hjson/Grammar.pm

差異

--- a/lib/Text/Hjson.pm
+++ b/lib/Text/Hjson.pm
@@ -4,9 +4,6 @@ use warnings;
 use strict;
 use feature qw(postderef);
 use Carp;
-use Text::Hjson::Grammar;
-
-our $grammar = "Text::Hjson::Grammar";
 
 our $ws = qr/[\t\r\n ]/;
 our $inline_ws = qr/[\t\r ]/;
@@ -102,57 +99,6 @@ sub decode_quoted_string($$){
     $str
 }
 
-sub consume($$$$){
-    my ($self, $what, $in, $at) = @_;
-    croak "unknown grammar: $what" if(!$grammar->can($what));
-    my %g = $grammar->$what();
-    my $act = sub{scalar ($g{act} // sub{})->($self, @_)};
-    if($g{re}){
-        pos($in) = $at;
-        if($in =~ /\G$g{re}/g){
-            (
-                pos($in),
-                $act->([@{^CAPTURE}])
-            )
-        }else{
-            ()
-        }
-    }elsif($g{seq}){
-        my @got;
-        for($g{seq}->@*){
-            ($at, my $read) = $self->consume($_, $in, $at);
-            return () if(!defined $at);
-            push @got, $read;
-        }
-        ($at, $act->(@got))
-    }elsif($g{any}){
-        my ($i, $bt, $read);
-        for $i(0 .. $g{any}->$#*){
-            ($bt, $read) = $self->consume($g{any}[$i], $in, $at);
-            if(defined $bt){
-                return ($bt, $act->($i, $read));
-            }
-        }
-        ()
-    }elsif($g{many}){
-        my $bt;
-        my @got;
-        while(1){
-            ($bt, my $read) = $self->consume($g{many}, $in, $at);
-            last if(!defined $bt);
-            die "infinite loop detected in $what" if($at == $bt);
-            $at = $bt;
-            push @got, $read;
-        }
-        ($at, $act->(@got))
-    }elsif($g{opt}){
-        my ($bt, $read) = $self->consume($g{opt}, $in, $at);
-        ($bt//$at, $act->($read))
-    }else{
-        die "broken grammar";
-    }
-}
-
 sub consume_value($$$){
     my ($self, $in, $at) = @_;
     my $s = substr($in, $at, 1);

--- a/lib/Text/Hjson/Grammar.pm
+++ /dev/null
@@ -1,181 +0,0 @@
-package Text::Hjson::Grammar;
-
-use warnings;
-use strict;
-use feature qw(postderef);
-
-our $ws = qr/[\t\r\n ]/;
-our $inline_ws = qr/[\t\r ]/;
-our $inline = qr/$inline_ws|[^\0-\x20]/;
-our $any = qr/$ws|[^\0-\x20]/;
-our $line_comment = qr/(?:#|\/\/)$inline*+/;
-our $block_comment = qr/\/\*(?:[^*]|\*(?!\/))*+\*\//;
-our $comment = qr/$line_comment|$block_comment/;
-our $wsc = qr/(?:$ws|$comment)*+/;
-our $litend = qr/(?![ \t]*+[^\0-\x20#,\/\[\]{}])/;
-our $separator = qr/$wsc,|(?:$inline_ws|$comment)*+\n/;
-our $nonpunct = qr/[^\0-\x20,:\[\]{}]/;
-
-sub literal{
-    re => qr/$wsc(true|false|null)$litend/,
-    act => sub{
-        my ($self, $match) = @_;
-        {
-            true => $self->true,
-            false => $self->false,
-            null => $self->null,
-        }->{$match->[0]}
-    }
-}
-sub separator{re => qr/$separator/}
-sub optional_sep{re => qr/$separator?/}
-# XXX: not docuemnted, but tests say quoteless string
-#      starting with quote is not allowed.
-sub quoteless_guard{re => qr/$wsc(?!["'])/}
-sub value{
-    any => [qw(literal object array number string)],
-    act => sub{$_[2]}
-}
-sub root{
-    any => [qw(object_member_arr value)],
-    act => sub{$_[2]}
-}
-sub object{
-    seq => [qw(begin_object object_inner end_object)],
-    act => sub{$_[2]}
-}
-sub begin_object{re => qr/$wsc\{/}
-sub end_object{re => qr/$wsc\}/}
-sub object_inner{
-    opt => "object_member_arr",
-    act => sub{
-        my ($self, $match) = @_;
-        $match // $self->object
-    }
-}
-sub object_member_arr{
-    seq => [qw(object_member object_members optional_sep)],
-    act => sub{
-        my ($self, $first, $left) = @_;
-        $self->object($first, @$left)
-    }
-}
-sub object_member{
-    seq => [qw(object_key object_key_sep value)],
-    act => sub{
-        my ($self, $key, $sep, $val) = @_;
-        [$key, $val]
-    }
-}
-sub object_members{
-    many => "separated_object_member",
-    act => sub{shift; [@_]}
-}
-sub separated_object_member{
-    seq => [qw(separator object_member)],
-    act => sub{$_[2]}
-}
-sub object_key{
-    any => [qw(string_quoted object_key_noquote)],
-    act => sub{$_[2]}
-}
-sub object_key_noquote{
-    seq => [qw(quoteless_guard object_key_noquote_body)],
-    act => sub{$_[2]}
-}
-sub object_key_noquote_body{
-    re => qr/($nonpunct+)/,
-    act => sub{$_[1][0]}
-}
-sub wsc{re => qr/$wsc/}
-sub object_key_sep{re => qr/$wsc:/}
-sub array{
-    seq => [qw(begin_array array_inner end_array)],
-    act => sub{$_[2]}
-}
-sub begin_array{re => qr/$wsc\[/}
-sub end_array{re => qr/$wsc\]/}
-sub array_inner{
-    opt => "array_member_arr",
-    act => sub{
-        my ($self, $match) = @_;
-        $match // $self->array;
-    }
-}
-sub array_member_arr{
-    seq => [qw(value array_members optional_sep)],
-    act => sub{
-        my ($self, $first, $left) = @_;
-        $self->array($first, @$left)
-    }
-}
-sub array_members{
-    many => "separated_array_member",
-    act => sub{shift; [@_]}
-}
-sub separated_array_member{
-    seq => [qw(separator value)],
-    act => sub{$_[2]}
-}
-sub number{
-    re => qr/$wsc(-)?+((?:0|[1-9][0-9]*+)(?:\.[0-9]++)?+)(?:[eE]([-+]?+[0-9]++))?+$litend/,
-    act => sub{
-        my ($self, $match) = @_;
-        my $v = $match->[1] * 10**($match->[2] // 0);
-        $match->[0] ? -$v : $v
-    }
-}
-sub string{
-    any => [qw(string_multiline string_quoted string_noquote)],
-    act => sub{$_[2]}
-}
-# XXX: not in RFC but quote by ' is allowed.
-sub string_quoted{
-    re => qr/$wsc(["'])((?:(?!\g{1})[^\0-\x1f\\]|\\.)*+)\g{1}/,
-    act => sub{
-        my ($self, $match) = @_;
-        $self->string($self->decode_quoted_string($match->[1]))
-        #$match->[1] =~ s{\\(u(.{4})|.)}{
-        #    {
-        #        '"' => '"',
-        #        "'" => "'",
-        #        "\\" => "\\",
-        #        "/" => "/",
-        #        "b" => "\b",
-        #        "f" => "\f",
-        #        "n" => "\n",
-        #        "r" => "\r",
-        #        "t" => "\t",
-        #    }->{$1} // chr(hex($2))
-        #}ger;
-    }
-}
-sub string_noquote{
-    seq => [qw(quoteless_guard string_noquote_body)],
-    act => sub{$_[2]}
-}
-sub string_noquote_body{
-    re => qr/(${nonpunct}(?:\t|[^\0-\x1f])*)/,
-    act => sub{
-        my ($self, $match) = @_;
-        $match->[0] =~ s/$inline_ws*+\z//r;
-    }
-}
-sub string_multiline{
-    re => qr/($wsc)'''((?:(?!''')$any)*+)'''/,
-    act => sub{
-        my ($self, $match) = @_;
-        my $indent = length($match->[0] =~ s/.*\n//r);
-        my $s = $match->[1] =~ s/\r//r;
-
-        # XXX: What is "column"
-        $s =~ s/(?<=\n)${inline_ws}{0,$indent}//g;
-        # XXX: RFC says: Whitespace on the first line is ignored.
-        #      my understanding: first line is ignored if it contains only ws.
-        $s =~ s/^$inline_ws*\n//;
-
-        $s =~ s/\n\z//r
-    }
-}
-
-1;