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.008 second using v1.01-cache-2.11-cpan-0bb4e1dffa6 )