Sidef

 view release on metacpan or  search on metacpan

lib/Sidef/Parser.pm  view on Meta::CPAN

                                   code  => $_,
                                   pos   => (pos($_) - length($name)),
                                   error => "`$name` is either a keyword or a predefined variable!",
                                  );
            }

            my $struct = bless(
                               {
                                name  => $name,
                                class => $class_name,
                               },
                               'Sidef::Variable::Struct'
                              );

            if (defined $name) {
                unshift @{$self->{vars}{$class_name}},
                  {
                    obj   => $struct,
                    name  => $name,
                    count => 0,
                    type  => 'struct',
                    line  => $self->{line},
                  };
            }

            my $vars =
              $self->parse_init_vars(
                                     code    => $opt{code},
                                     type    => 'var',
                                     private => 1,
                                    );

            $struct->{vars} = $vars;

            return $struct;
        }

        # Subset declaration
        if (/\Gsubset\b\h*/gc) {

            my ($name, $class_name);
            if (/\G($self->{var_name_re})\h*/goc) {
                ($name, $class_name) = $self->get_name_and_class($1);
            }
            else {
                $self->fatal_error(
                                   code  => $_,
                                   pos   => pos($_),
                                   error => "expected a name after the keyword 'subset'",
                                  );
            }

            if (exists($self->{keywords}{$name}) or exists($self->{built_in_classes}{$name})) {
                $self->fatal_error(
                                   code  => $_,
                                   pos   => (pos($_) - length($name)),
                                   error => "`$name` is either a keyword or a predefined variable!",
                                  );
            }

            my $subset = bless({name => $name, class => $class_name}, 'Sidef::Variable::Subset');

            unshift @{$self->{vars}{$class_name}},
              {
                obj   => $subset,
                name  => $name,
                count => 0,
                type  => 'subset',
                line  => $self->{line},
              };

            # Inheritance
            if (/\G<<?\h*/gc) {
                {
                    my ($name) = /\G($self->{var_name_re})\h*/goc;

                    $name // $self->fatal_error(
                                                code  => $_,
                                                pos   => pos($_),
                                                error => "expected a type name for subsetting",
                                               );

                    my $code = $name;
                    my $type = $self->parse_expr(code => \$code);

                    push @{$subset->{inherits}}, $type;

                    /\G,\h*/gc && redo;
                }
            }

            if (/\G(?=\{)/) {
                my $block = $self->parse_block(code => $opt{code}, topic_var => 1);
                $subset->{block} = $block;
            }

            return $subset;
        }

        # Declaration of enums
        if (/\Genum\b\h*/gc) {
            my $vars =
              $self->parse_init_vars(
                                     code    => $opt{code},
                                     type    => 'var',
                                     private => 1,
                                    );

            @{$vars}
              || $self->fatal_error(
                                    code  => $_,
                                    pos   => pos($_),
                                    error => q{expected one or more variable names after <enum>},
                                   );

            my $value = Sidef::Types::Number::Number::_set_int(-1);

            foreach my $var (@{$vars}) {
                my $name = $var->{name};

                if (ref $var->{value} eq 'HASH') {

lib/Sidef/Parser.pm  view on Meta::CPAN

               /\G(func|class)\b\h*/gc
            || /\G(->)\h*/gc
            || (exists($self->{current_class})
                && /\G(method)\b\h*/gc)
          ) {

            my $beg_pos = $-[0];
            my $type =
                $1 eq '->'
              ? exists($self->{current_class}) && !(exists($self->{current_method}))
                  ? 'method'
                  : 'func'
              : $1;

            my $name       = '';
            my $class_name = $self->{class};
            my $built_in_obj;

            if ($type eq 'class' and /\G($self->{var_name_re})\h*/gco) {

                $name = $1;

                if (exists($self->{built_in_classes}{$name}) and /\G(?=[{<])/) {

                    my ($obj) = $self->parse_expr(code => \$name);

                    if (defined($obj)) {
                        $name         = '';
                        $built_in_obj = $obj;
                    }
                }
                else {
                    ($name, $class_name) = $self->get_name_and_class($1);
                }
            }

            if ($type eq 'method') {
                $name = (
                           /\G($self->{method_name_re})\h*/goc ? $1
                         : /\G($self->{operators_re})\h*/goc   ? $+
                         :                                       ''
                        );
                ($name, $class_name) = $self->get_name_and_class($name);
            }
            elsif ($type ne 'class') {
                $name = /\G($self->{var_name_re})\h*/goc ? $1 : '';
                ($name, $class_name) = $self->get_name_and_class($name);
            }

            if (    $type ne 'method'
                and $type ne 'class'
                and (exists($self->{keywords}{$name}) or exists($self->{built_in_classes}{$name}))) {
                $self->fatal_error(
                                   code  => $_,
                                   pos   => $-[0],
                                   error => "`$name` is either a keyword or a predefined variable!",
                                  );
            }

            my $obj =
                ($type eq 'func' or $type eq 'method') ? bless({name => $name, type => $type, class => $class_name}, 'Sidef::Variable::Variable')
              : $type eq 'class' ? bless({name => ($built_in_obj // $name), class => $class_name}, 'Sidef::Variable::ClassInit')
              : $self->fatal_error(
                                   error  => "invalid type",
                                   reason => "expected a magic thing to happen",
                                   code   => $_,
                                   pos    => pos($_),
                                  );

            if ($name ne '') {
                my $var = $self->find_var($name, $class_name);

                if (defined($var) and $var->{type} eq 'class') {
                    $obj->{parent} = $var->{obj};
                    push @{$obj->{inherit}}, ref($var->{obj}{name}) ? $var->{obj}{name} : $var->{obj};
                }
            }

            my $has_kids = 0;
            my $parent;
            if (($type eq 'method' or $type eq 'func') and $name ne '') {
                my $var = $self->find_var($name, $class_name);

                # A function or a method must be declared in the same scope
                if (defined($var) and $var->{obj}{type} eq $type) {

                    $parent   = $var->{obj};
                    $has_kids = 1;

                    #~ push @{$var->{obj}{value}{kids}}, $obj;
                    $parent->{has_kids} = 1;
                    $obj->{parent}      = $parent;
                }
            }

            if (not $has_kids) {
                unshift @{$self->{vars}{$class_name}},
                  {
                    obj   => $obj,
                    name  => $name,
                    count => 0,
                    type  => $type,
                    line  => $self->{line},
                  };
            }

            if ($type eq 'class') {
                my $var_names =
                  $self->parse_init_vars(
                                         code         => $opt{code},
                                         params       => 1,
                                         private      => 1,
                                         type         => 'has',
                                         ignore_delim => {
                                                          '{' => 1,
                                                          '<' => 1,
                                                         },
                                        );

                # Set the class parameters
                $obj->{vars} = $var_names;

lib/Sidef/Parser.pm  view on Meta::CPAN


        # die/warn
        if (/\G(die|warn)\b\h*/gc) {
            my $action = $1;

            my $arg = (
                       /\G(?=\()/
                       ? $self->parse_arg(code => $opt{code})
                       : $self->parse_obj(code => $opt{code})
                      );

            return
              bless(
                    {
                     arg  => $arg,
                     line => $self->{line},
                     file => $self->{file_name},
                    },
                    $action eq 'die'
                    ? "Sidef::Meta::Error"
                    : "Sidef::Meta::Warning"
                   );
        }

        # Eval keyword
        if (/\Geval\b\h*/gc) {

            my $obj = (
                       /\G(?=\()/
                       ? $self->parse_arg(code => $opt{code})
                       : $self->parse_obj(code => $opt{code})
                      );

#<<<
            return bless(
                {
                 expr   => $obj,
                 parser => Sidef::Object::Object::dclone(scalar {%$self}),

                 #vars          => {$self->{class} => [@{$self->{vars}{$self->{class}}}]},
                 #ref_vars_refs => {$self->{class} => [@{$self->{ref_vars_refs}{$self->{class}}}]},

                }, 'Sidef::Eval::Eval');
#>>>
        }

        if (/\GParser\b/gc) {
            return $self;
        }

        # Regular expression
        if (m{\G(?=/)} || /\G%r\b/gc) {
            my $string = $self->get_quoted_string(code => $opt{code});
            return Sidef::Types::Regex::Regex->new($string, /\G($self->{match_flags_re})/goc ? $1 : undef);
        }

        # Class variable in form of `Class!var_name`
        if (/\G($self->{var_name_re})!($self->{var_name_re})/goc) {
            my ($class_name, $var_name) = ($1, $2);
            my $class_obj = $self->parse_expr(code => \$class_name);
            return (bless {class => $class_obj, name => $var_name}, 'Sidef::Variable::ClassVar');
        }

        # Static object (like String or nil)
        if (/$self->{static_obj_re}/goc) {
            return $^R;
        }

        if (/\G__MAIN__\b/gc) {
            if (-e $self->{script_name}) {
                state $x = require Cwd;
                return Sidef::Types::String::String->new(Cwd::abs_path($self->{script_name}));
            }
            return Sidef::Types::String::String->new($self->{script_name});
        }

        if (/\G__FILE__\b/gc) {
            if (-e $self->{file_name}) {
                state $x = require Cwd;
                return Sidef::Types::String::String->new(Cwd::abs_path($self->{file_name}));
            }
            return Sidef::Types::String::String->new($self->{file_name});
        }

        if (/\G__DATE__\b/gc) {
            my (undef, undef, undef, $day, $mon, $year) = localtime;
            return Sidef::Types::String::String->new(join('-', $year + 1900, map { sprintf "%02d", $_ } $mon + 1, $day));
        }

        if (/\G__TIME__\b/gc) {
            my ($sec, $min, $hour) = localtime;
            return Sidef::Types::String::String->new(join(':', map { sprintf "%02d", $_ } $hour, $min, $sec));
        }

        if (/\G__LINE__\b/gc) {
            return Sidef::Types::Number::Number->new($self->{line});
        }

        if (/\G__COMPILED__\b/gc) {
            return Sidef::Types::Bool::Bool->new($self->{opt}{R} eq 'Perl' or $self->{opt}{c});
        }

        if (/\G__OPTIMIZED__\b/gc) {
            return Sidef::Types::Bool::Bool->new(($self->{opt}{O} || 0) > 0);
        }

        if (/\G__(?:END|DATA)__\b\h*+\R?/gc) {
            if (exists $self->{'__DATA__'}) {
                $self->{'__DATA__'} = substr($_, pos);
            }
            pos($_) = length($_);
            return;
        }

        if (/\GDATA\b/gc) {
            return (
                $self->{static_objects}{'__DATA__'} //= do {
                    bless({data => \$self->{'__DATA__'}}, 'Sidef::Meta::Glob::DATA');
                }
            );
        }

lib/Sidef/Parser.pm  view on Meta::CPAN

            my $obj = {$self->{class} => []};
            push @{$self->{EOT}},
              {
                name   => $name,
                indent => $indent,
                type   => $type,
                obj    => $obj,
                pos    => $pos,
                line   => $self->{line},
              };

            return $obj;
        }

        if (exists($self->{current_block}) && /\G__BLOCK__\b/gc) {
            return $self->{current_block};
        }

        if (/\G__NAMESPACE__\b/gc) {
            return Sidef::Types::String::String->new($self->{class});
        }

        if (exists($self->{current_function})) {
            /\G__FUNC__\b/gc      && return $self->{current_function};
            /\G__FUNC_NAME__\b/gc && return Sidef::Types::String::String->new($self->{current_function}{name});
        }

        if (exists($self->{current_class})) {
            /\G__CLASS__\b/gc      && return $self->{current_class};
            /\G__CLASS_NAME__\b/gc && return Sidef::Types::String::String->new($self->{class_name});
        }

        if (exists($self->{current_method})) {
            /\G__METHOD__\b/gc      && return $self->{current_method};
            /\G__METHOD_NAME__\b/gc && return Sidef::Types::String::String->new($self->{current_method}{name});
        }

        # Variable access
        if (/\G($self->{var_name_re})/goc) {
            my $len_var = length($1);
            my ($name, $class) = $self->get_name_and_class($1);

            if (defined(my $var = $self->find_var($name, $class))) {

                if ($var->{type} eq 'del') {
                    $self->fatal_error(
                                       code  => $_,
                                       pos   => (pos($_) - length($name)),
                                       var   => ($class . '::' . $name),
                                       error => "attempt to use the deleted variable <$name>",
                                      );
                }

                $var->{count}++;
                return $var->{obj};
            }

            if ($name eq 'ARGV' or $name eq 'ENV') {

                my $type     = 'var';
                my $variable = bless({name => $name, type => $type, class => $class}, 'Sidef::Variable::Variable');

                unshift @{$self->{vars}{$class}},
                  {
                    obj   => $variable,
                    name  => $name,
                    count => 1,
                    type  => $type,
                    line  => $self->{line},
                  };

                return $variable;
            }

            # Class instance variables
            if (
                ref($self->{current_class}) eq 'Sidef::Variable::ClassInit'
                and defined(
                        my $var = (first { $_->{name} eq $name } (@{$self->{current_class}{vars}}, map { @{$_->{vars}} } @{$self->{current_class}{attributes}}))
                )
              ) {
                if (exists $self->{current_method}) {
                    if (defined(my $var = $self->find_var('self', $class))) {

                        if ($self->{opt}{k}) {
                            print STDERR "[INFO] `$name` is parsed as `self.$name` at $self->{file_name} line $self->{line}\n";
                        }

                        $var->{count}++;
                        return
                          scalar {
                                  $self->{class} => [
                                                     {
                                                      self => $var->{obj},
                                                      ind  => [{hash => [$name]}],
                                                     }
                                                    ]
                                 };
                    }
                }
                elsif (exists $self->{allow_class_variable}) {
                    return $var;
                }
                elsif ($var->{type} eq 'has') {
                    $self->fatal_error(
                                       error => "class variable <<$var->{name}>> can't be used outside a method",
                                       pos   => (pos($_) - length($name)),
                                       var   => $var,
                                       code  => $_,
                                      );
                }
                else {    # this should not happen
                    $self->fatal_error(
                                       error => "can't use undeclared variable <<$var->{name}>> in this context",
                                       pos   => (pos($_) - length($name)),
                                       var   => $var,
                                       code  => $_,
                                      );
                }
            }



( run in 1.001 second using v1.01-cache-2.11-cpan-a9496e3eb41 )