- Added support for multiple return-types checks.

Example: func foo() -> (String, Number) { ("abc", 42) } var(str, num) = foo(); - "do" is no longer a keyword, unless it is followed by a pair of curly brackets. - Code simplifications.
trizen · Nov 11, 2015 · 9998e5c · 9998e5c
1 parent 6059550
commit 9998e5c
Show file tree

Hide file tree

Showing 14 changed files with 139 additions and 126 deletions.
diff --git a/MANIFEST b/MANIFEST
@@ -60,6 +60,7 @@ lib/Sidef/Types/Block/Gather.pod
 lib/Sidef/Types/Block/Given.pm
 lib/Sidef/Types/Block/If.pm
 lib/Sidef/Types/Block/If.pod
+lib/Sidef/Types/Block/Loop.pm
 lib/Sidef/Types/Block/Next.pm
 lib/Sidef/Types/Block/Next.pod
 lib/Sidef/Types/Block/Return.pm
@@ -648,6 +649,7 @@ scripts/Tests/magic_vars.sf
 scripts/Tests/man_or_boy.sf
 scripts/Tests/man_or_boy_2.sf
 scripts/Tests/man_or_boy_3.sf
+scripts/Tests/man_or_boy_cached.sf
 scripts/Tests/matrix_multiplication.sf
 scripts/Tests/median.sf
 scripts/Tests/memoize.sf

diff --git a/META.json b/META.json
@@ -164,6 +164,9 @@
       "Sidef::Types::Block::If" : {
          "file" : "lib/Sidef/Types/Block/If.pm"
       },
+      "Sidef::Types::Block::Loop" : {
+         "file" : "lib/Sidef/Types/Block/Loop.pm"
+      },
       "Sidef::Types::Block::Next" : {
          "file" : "lib/Sidef/Types/Block/Next.pm"
       },

diff --git a/META.yml b/META.yml
@@ -88,6 +88,8 @@ provides:
     file: lib/Sidef/Types/Block/Given.pm
   Sidef::Types::Block::If:
     file: lib/Sidef/Types/Block/If.pm
+  Sidef::Types::Block::Loop:
+    file: lib/Sidef/Types/Block/Loop.pm
   Sidef::Types::Block::Next:
     file: lib/Sidef/Types/Block/Next.pm
   Sidef::Types::Block::Return:

diff --git a/lib/Sidef/Deparse/Perl.pm b/lib/Sidef/Deparse/Perl.pm
@@ -111,7 +111,6 @@ HEADER
         my ($self, $obj) = @_;
 
         my $ref = ref($obj);
-
         $self->_dump_string(
                               $ref eq 'Sidef::Variable::ClassInit'    ? $self->_dump_class_name($obj)
                             : $ref eq 'Sidef::Variable::Ref'          ? 'REF'
@@ -502,19 +501,8 @@ HEADER
 
                     # Check the return value (when "-> Type" is specified)
                     if (exists $obj->{returns}) {
-
-                        my $type = $self->_dump_reftype($obj->{returns});
-
-                        $code =
-                            "do { $code;\n"
-                          . (' ' x $Sidef::SPACES)
-                          . "my \$_$refaddr = \$$obj->{name}$refaddr;\n"
-                          . (' ' x $Sidef::SPACES)
-                          . "\$$obj->{name}$refaddr = Sidef::Types::Block::Code->new("
-                          . "sub {my \$arg = \$_$refaddr->call(\@_); "
-                          . "(ref(\$arg) eq $type || ($type ne 'REF' && eval{\$arg->SUPER::isa($type)})) or "
-                          . " die q{[ERROR] Invalid return-type from $obj->{type} $self->{class_name}<<$name>>: got <<}"
-                          . " . ref(\$arg) . q{>>, but expected $type}; \$arg })}";
+                        my $types = '[' . join(',', map { $self->_dump_reftype($_) } @{$obj->{returns}}) . ']';
+                        $code = "do {$code; \$$obj->{name}$refaddr\->{returns} = $types; \$$obj->{name}$refaddr}";
                     }
 
                     # Memoize the method/function (when "is cached" trait is specified)
@@ -705,7 +693,7 @@ HEADER
         }
         elsif ($ref eq 'Sidef::Types::Block::CodeInit') {
             if ($addr{$refaddr}++) {
-                $code = 'Sidef::Types::Block::Code->new(__SUB__)';
+                $code = 'Sidef::Types::Block::Code->new(code => __SUB__)';
             }
             else {
                 if (%{$obj}) {
@@ -762,11 +750,9 @@ HEADER
                         $code = 'Sidef::Types::Block::Code->new(';
                     }
 
-                    if ($is_class) {
+                    if (not $is_class) {
 
-                    }
-                    else {
-                        $code .= "\n" . (" " x ($Sidef::SPACES - $Sidef::SPACES_INCR)) . "sub {\n";
+                        $code .= "\n" . (" " x ($Sidef::SPACES - $Sidef::SPACES_INCR)) . "code => sub {\n";
 
                         if (exists($obj->{init_vars}) and @{$obj->{init_vars}{vars}}) {
                             my @vars = @{$obj->{init_vars}{vars}};
@@ -814,7 +800,21 @@ HEADER
                       . join(";\n" . (" " x $Sidef::SPACES), @statements)
                       . ($is_function ? (";\n" . (" " x $Sidef::SPACES) . "END$refaddr: \@return;\n") : '') . "\n"
                       . (" " x ($Sidef::SPACES -= $Sidef::SPACES_INCR))
-                      . ($is_class ? '}' : '})');
+                      . '}';
+
+                    if (not $is_class) {
+                        if (exists $self->{parent_name}) {
+                            $code .= ','
+                              . join(',',
+                                     'type => ' . $self->_dump_string($self->{parent_name}[0]),
+                                     'name => ' . $self->_dump_string($self->{parent_name}[1]));
+                        }
+
+                        if (exists $self->{class_name}) {
+                            $code .= ',' . 'class => ' . $self->_dump_string($self->{class_name});
+                        }
+                        $code .= ')';
+                    }
                 }
                 else {
                     $code = 'Block';
@@ -848,6 +848,12 @@ HEADER
         elsif ($ref eq 'Sidef::Types::Block::While') {
             ## ok
         }
+        elsif ($ref eq 'Sidef::Types::Block::Do') {
+            $code = 'do {' . join(';', $self->deparse_script($obj->{block}{code})) . '}';
+        }
+        elsif ($ref eq 'Sidef::Types::Block::Loop') {
+            $code = 'while(1) {' . join(';', $self->deparse_script($obj->{block}{code})) . '}';
+        }
         elsif ($ref eq 'Sidef::Types::Block::Given') {
             $self->top_add(qq{use experimental 'smartmatch';\n});
         }
@@ -1140,18 +1146,6 @@ HEADER
                         }
                     }
 
-                    # Do-block
-                    if ($code eq '' and $ref eq 'Sidef::Types::Block::Do') {
-                        my $arg = $self->deparse_generic('', ';', '', @{$call->{arg}});
-
-                        if ($arg =~ s/^Sidef::Types::Block::Code->new\(\s*sub\h*\{//) {
-                            $arg =~ s/\}\)\z//;
-                        }
-
-                        $code = 'do { ' . $arg . '}';
-                        next;
-                    }
-
                     # Postfix ++ and -- operators on variables
                     if (exists($self->{inc_dec_ops}{$method})) {
                         $code = "do{my \$old=$code; $code=$code\->$self->{inc_dec_ops}{$method}; \$old}";
@@ -1244,30 +1238,8 @@ HEADER
                     }
                     elsif ($method =~ /^[\pL_]/) {
 
-                        # Optimize the "loop {}" construct
-                        if ($ref eq 'Sidef::Types::Block::CodeInit' and $method eq 'loop') {
-                            my $block = $code =~ s/^\(Sidef::Types::Block::Code->new\(\s*sub\h*(?=\{)//r =~ s/\)\)\z//r;
-
-                            if (not defined $block) {
-                                die "[ERROR] Failed to optimize the 'loop {}' construct...";
-                            }
-
-                            $code = 'while (1) ' . $block;
-                            next;
-                        }
-
-                        # Optimize the "n.times {}" construct
-                        elsif ($ref eq 'Sidef::Types::Number::Number' and $method eq 'times' and $$obj < (-1 >> 1)) {
-
-                            my $arg   = $self->deparse_args(@{$call->{arg}});
-                            my $block = $arg =~ s/^\(Sidef::Types::Block::Code->new\(\s*sub\h*\{//r =~ s/\)\)\z//r;
-
-                            $code = "for (1..$$obj) { local \@_ = (Sidef::Types::Number::Number->new(\$_));  " . $block;
-                            next;
-                        }
-
                         # Exclamation mark (!) at the end of a method
-                        elsif (substr($method, -1) eq '!') {
+                        if (substr($method, -1) eq '!') {
                             $code = '('
                               . "$old_code=$code->"
                               . substr($method, 0, -1)

diff --git a/lib/Sidef/Deparse/Sidef.pm b/lib/Sidef/Deparse/Sidef.pm
@@ -171,16 +171,12 @@ package Sidef::Deparse::Sidef {
                       . $self->_dump_vars(@{$var_obj->{vars}}[($obj->{type} eq 'method' ? 1 : 0) .. $#{$var_obj->{vars}} - 1])
                       . ') ';
 
-                   #$code .= $self->_dump_sub_init_vars($vars);
-                   #$code .= $self->_dump_init_vars($vars);
-                   #$code .= '(' . $self->_dump_init_vars(@{$vars}[($obj->{type} eq 'method' ? 1 : 0) .. $#{$vars} - 1]) . ')';
-
                     if (exists $obj->{cached}) {
                         $code .= 'is cached ';
                     }
 
                     if (exists $obj->{returns}) {
-                        $code .= '-> ' . $self->deparse_expr({self => $obj->{returns}}) . ' ';
+                        $code .= '-> (' . join(',', map { $self->deparse_expr({self => $_}) } @{$obj->{returns}}) . ') ';
                     }
 
                     $code .= $self->deparse_expr({self => $block});
@@ -385,6 +381,12 @@ package Sidef::Deparse::Sidef {
         elsif ($ref eq 'Sidef::Types::Block::Take') {
             $code = 'take' . $self->deparse_args($obj->{expr});
         }
+        elsif ($ref eq 'Sidef::Types::Block::Do') {
+            $code = 'do ' . $self->deparse_expr({self => $obj->{block}});
+        }
+        elsif ($ref eq 'Sidef::Types::Block::Loop') {
+            $code = 'loop ' . $self->deparse_expr({self => $obj->{block}});
+        }
         elsif ($ref eq 'Sidef::Math::Math') {
             $code = 'Math';
         }

diff --git a/lib/Sidef/Parser.pm b/lib/Sidef/Parser.pm
@@ -123,7 +123,6 @@ package Sidef::Parser {
             prefix_obj_re => qr{\G
               (?:
                   if\b                                            (?{ Sidef::Types::Block::If->new })
-                | do\b                                            (?{ Sidef::Types::Block::Do->new })
                 | while\b                                         (?{ Sidef::Types::Block::While->new })
                 | try\b                                           (?{ Sidef::Types::Block::Try->new })
                 | for(?:each)?+\b                                 (?{ Sidef::Types::Block::For->new })
@@ -1435,48 +1434,39 @@ package Sidef::Parser {
                     # Function return type (func name(...) -> Type {...})
                     if (/\G\h*->\h*/gc) {
 
-                        my $ret_name;
-                        my $try_expr;
-                        my $pos = pos($_);
-                        if (/\G($self->{var_name_re})\h*/gco) {
-                            $ret_name = $1;
+                        my @ref;
+                        if (/\G\(/gc) {    # multiple types
+                            while (1) {
+                                my ($ref) = $self->parse_expr(code => $opt{code});
+                                push @ref, $ref;
+
+                                /\G\s*\)/gc && last;
+                                /\G\s*,\s*/gc
+                                  || $self->fatal_error(
+                                                        error => "invalid return-type for $type $self->{class_name}<<$name>>",
+                                                        expected => "expected a comma",
+                                                        code     => $_,
+                                                        pos      => pos($_),
+                                                       );
+                            }
                         }
-                        else {
-                            $try_expr = 1;
+                        else {    # only one type
+                            my ($ref) = $self->parse_expr(code => $opt{code});
+                            push @ref, $ref;
                         }
 
-                        if (
-                            $try_expr or (
-                                defined($ret_name) and (
-                                    exists($self->{built_in_classes}{$ret_name}) or do {
-                                        my $obj = $self->find_var($ret_name, $class_name);
-                                        defined($obj) and $obj->{type} eq 'class';
-                                    }
-                                )
-                            )
-                          ) {
-                            local $self->{_want_name} = 1;
-                            my ($return_obj) = $self->parse_expr(code => $try_expr ? $opt{code} : \$ret_name);
-
-                            if (ref($return_obj) eq 'HASH') {
+                        foreach my $ref (@ref) {
+                            if (ref($ref) eq 'HASH') {
                                 $self->fatal_error(
                                                    error    => "invalid return-type for $type $self->{class_name}<<$name>>",
                                                    expected => "expected a valid type, such as: Str, Num, Arr, etc...",
                                                    code     => $_,
-                                                   pos      => $pos,
+                                                   pos      => pos($_),
                                                   );
                             }
-
-                            $obj->{returns} = $return_obj;
-                        }
-                        else {
-                            $self->fatal_error(
-                                               error    => "invalid return-type for $type $self->{class_name}<<$name>>",
-                                               expected => "expected a valid type, such as: Str, Num, Arr, etc...",
-                                               code     => $_,
-                                               pos      => $pos,
-                                              );
                         }
+
+                        $obj->{returns} = \@ref;
                     }
 
                     /\G\h*\{\h*/gc
@@ -1510,7 +1500,19 @@ package Sidef::Parser {
                 return Sidef::Types::Block::Default->new(block => $block);
             }
 
-            ## Experimental gather/take
+            # "do {...}" construct
+            if (/\Gdo\h*(?=\{)/gc) {
+                my $block = $self->parse_block(code => $opt{code});
+                return Sidef::Types::Block::Do->new(block => $block);
+            }
+
+            # "loop {...}" construct
+            if (/\Gloop\h*(?=\{)/gc) {
+                my $block = $self->parse_block(code => $opt{code});
+                return Sidef::Types::Block::Loop->new(block => $block);
+            }
+
+            # "gather/take" construct
             if (/\Ggather\h*(?=\{)/gc) {
                 my $obj = Sidef::Types::Block::Gather->new();
 
@@ -1625,7 +1627,6 @@ package Sidef::Parser {
                                         );
             }
 
-            #if (/\G(?:die|warn|assert(?:_(?:eq|ne))?)\b/gc) {
             if (/\Gassert(?:_(?:eq|ne))?\b/gc) {
                 pos($_) = $-[0];
                 return (Sidef::Sys::Sys->new(line => $self->{line}, file_name => $self->{file_name}), 1);

diff --git a/lib/Sidef/Types/Block/Code.pm b/lib/Sidef/Types/Block/Code.pm
@@ -7,31 +7,45 @@ package Sidef::Types::Block::Code {
       );
 
     sub new {
-        my (undef, $sub) = @_;
-        bless {code => $sub}, __PACKAGE__;
+        my (undef, %opt) = @_;
+        bless \%opt, __PACKAGE__;
     }
 
     sub run {
         my ($self, @args) = @_;
-        my @objs = $self->{code}->(@args);
-        wantarray ? @objs : $objs[-1];
+        $self->{code}->(@args);
     }
 
     sub call {
         my ($self, @args) = @_;
+
         my @objs = $self->{code}->(@args);
 
-        @objs == 1 && ref($objs[0]) eq 'Sidef::Types::Block::Return'
-          ? (
-             wantarray
-             ? @{$objs[0]{obj}}
-             : $objs[0]{obj}[-1]
-            )
-          : (
-             wantarray
-             ? @objs
-             : $objs[-1]
-            );
+        # Unpack 'return'ed arguments from bare-blocks
+        if (@objs == 1 and ref($objs[0]) eq 'Sidef::Types::Block::Return') {
+            @objs = @{$objs[0]{obj}};
+        }
+
+        # Check the return types
+        if (exists $self->{returns}) {
+
+            if ($#{$self->{returns}} != $#objs) {
+                die qq{[ERROR] Wrong number of return arguments from $self->{type} $self->{class}<<$self->{name}>>: got }
+                  . @objs
+                  . ", but expected "
+                  . @{$self->{returns}};
+            }
+
+            foreach my $i (0 .. $#{$self->{returns}}) {
+                if (ref($objs[$i]) ne ($self->{returns}[$i])) {
+                    die qq{[ERROR] Invalid return-type from $self->{type} $self->{class}<<$self->{name}>>: got <<}
+                      . ref($objs[$i])
+                      . qq{>>, but expected <<$self->{returns}[$i]>>};
+                }
+            }
+        }
+
+        wantarray ? @objs : $objs[-1];
     }
 
     {

diff --git a/lib/Sidef/Types/Block/Do.pm b/lib/Sidef/Types/Block/Do.pm
@@ -1,7 +1,8 @@
 package Sidef::Types::Block::Do {
 
     sub new {
-        bless {}, __PACKAGE__;
+        my (undef, %opt) = @_;
+        bless \%opt, __PACKAGE__;
     }
 
 }

diff --git a/lib/Sidef/Types/Block/Loop.pm b/lib/Sidef/Types/Block/Loop.pm
@@ -0,0 +1,10 @@
+package Sidef::Types::Block::Loop {
+
+    sub new {
+        my (undef, %opt) = @_;
+        bless \%opt, __PACKAGE__;
+    }
+
+}
+
+1;