diff --git a/lib/assign/Array.pm b/lib/assign/Array.pm index 64db4b5..608f9ed 100644 --- a/lib/assign/Array.pm +++ b/lib/assign/Array.pm @@ -98,12 +98,19 @@ sub gen_code { my $def = $elem->{def} // ''; $def &&= " // $def"; - push @$code, - ($elem->sigil eq '@') - ? "$var $oper \@$from\[$i..\@$from-1\]$def;" : - ($elem->{cast}) - ? "$var $oper \[\@$from\[$i..\@$from-1\]\]$def;" : - "$var $oper $from\->[$i]$def;"; + if ($elem->sigil eq '@' || $elem->{cast}) { + my $begin = $i; + my $end = abs(@$elems - $i); + $i = - $end; + + push @$code, + ($elem->sigil eq '@') + ? "$var $oper \@$from\[$begin..\@$from-$end\]$def;" + : "$var $oper \[\@$from\[$begin..\@$from-$end\]\]$def;"; + } + else { + push @$code, "$var $oper $from\->[$i]$def;"; + } $i++; } diff --git a/lib/assign/Hash.pm b/lib/assign/Hash.pm index 6280a6d..acb979f 100644 --- a/lib/assign/Hash.pm +++ b/lib/assign/Hash.pm @@ -5,6 +5,7 @@ use assign::Struct; use base 'assign::Struct'; use assign::Types; +use assign::Array; use XXX; @@ -17,6 +18,30 @@ sub parse_elem { my $type = ref($tok); next if $type eq 'PPI::Token::Whitespace'; + if ($type eq 'PPI::Token::Word') { + $self->parse_fat_comma; + $self->parse_whitespaces; + + my $str = $tok->content; + my $v = shift(@$in); + if ($v && ref($v) eq 'PPI::Structure::Constructor') { + my $deepkey = "{$str}"; + if ($v->braces eq '[]') { + my $struct = assign::Array->new(node => $v, deepkey => $deepkey)->parse; + push @$elems, $struct; + } + elsif ($v->braces eq '{}') { + my $struct = assign::Hash->new(node => $v, deepkey => $deepkey)->parse; + push @$elems, $struct; + } + else { + XXX $v, "Expecting [...] or {...}"; + } + } + + return 1; + } + if ($type eq 'PPI::Token::Symbol') { my $str = $tok->content; if ($str =~ /^\$\w+$/) { @@ -24,6 +49,7 @@ sub parse_elem { return 1; } } + XXX $tok, "unexpected token"; } return 0; @@ -35,21 +61,27 @@ sub gen_code { my $code = [ @$init ]; my $elems = $self->{elems}; - if ($decl) { + if ($decl && (my @to_declares = grep $_->can("val"), @$elems)) { push @$code, "$decl(" . join(', ', - map $_->val, - @$elems - ) . - ');'; + map $_->val, + @to_declares + ) . ');' } for my $elem (@$elems) { my $type = ref $elem; - my $var = $elem->val; - (my $key = $var) =~ s/^\$//; - push @$code, "$var $oper $from\->{$key};"; + if ( $type eq 'assign::Hash' || $type eq 'assign::Array' ) { + my $_from = $from . ($elem->{deepkey} ? "->" . $elem->{deepkey} : ""); + push @$code, $elem->gen_code($decl, $oper, $_from, $init); + } + else { + my $var = $elem->val; + (my $key = $var) =~ s/^\$//; + my $deepkey = $elem->{deepkey}; + push @$code, "$var $oper $from\->$deepkey\{$key\};"; + } } return join "\n", @$code; diff --git a/lib/assign/Struct.pm b/lib/assign/Struct.pm index 6543c90..4ab5b24 100644 --- a/lib/assign/Struct.pm +++ b/lib/assign/Struct.pm @@ -7,6 +7,7 @@ sub new { my $class = shift; bless { elems => [], + deepkey => "", @_, }, $class; } @@ -37,7 +38,7 @@ sub parse { while (1) { $self->parse_elem or last; - $self->parse_comma or last; + $self->parse_optional_comma or last; } return $self; @@ -63,6 +64,61 @@ sub parse_comma { return 0; } +sub parse_optional_comma { + my ($self) = @_; + my $in = $self->{in}; + while (@$in) { + my $tok = shift(@$in); + my $type = ref($tok); + next if $type eq 'PPI::Token::Whitespace'; + + if ($type eq 'PPI::Token::Operator' and + $tok->content eq ',' + ) { + return 1; + } + else { + unshift(@$in, $tok); + last; + } + } + return 0; +} + +sub parse_fat_comma { + my ($self) = @_; + + $self->parse_whitespaces; + + my $in = $self->{in}; + while (@$in) { + my $tok = shift(@$in); + my $type = ref($tok); + + if ($type eq 'PPI::Token::Operator' and + $tok->content eq '=>' + ) { + return 1; + } + else { + XXX $tok, $in, "fat comma expected"; + } + } + return 0; +} + +sub parse_whitespaces { + my ($self) = @_; + my $in = $self->{in}; + while (@$in) { + my $tok = shift(@$in); + next if ref($tok) eq 'PPI::Token::Whitespace'; + unshift @$in, $tok; + last; + } + return 0; +} + sub get_var { my ($self, $var) = @_; my $def; diff --git a/lib/assign/Types.pm b/lib/assign/Types.pm index 3e18b6c..b946a22 100644 --- a/lib/assign/Types.pm +++ b/lib/assign/Types.pm @@ -11,6 +11,7 @@ sub new { bless { var => $var, def => $def, + deepkey => "", }, $class; } diff --git a/talk/Makefile b/talk/Makefile new file mode 100644 index 0000000..2313cd9 --- /dev/null +++ b/talk/Makefile @@ -0,0 +1,15 @@ +SHELL := bash + +VROOM := \ + vroom \ + clean \ + +default: +ifdef s + vroom vroom --skip=$s +else + vroom vroom +endif + +$(VROOM): + vroom $@ diff --git a/talk/destructure.clj b/talk/destructure.clj new file mode 100644 index 0000000..2df821b --- /dev/null +++ b/talk/destructure.clj @@ -0,0 +1,10 @@ +#!/usr/bin/env clojure + +(def people [ + { :name "Ingy" :favs ["coffee" "yellow"] } + { :name "Gugod" :favs ["tea" "blue"] }]) + +(defn about [{:keys [name] [color drink] :favs}] + (println (str name " wears " color " and drinks " drink "."))) + +(map about people) diff --git a/talk/destructure.js b/talk/destructure.js new file mode 100644 index 0000000..48ca2e8 --- /dev/null +++ b/talk/destructure.js @@ -0,0 +1,11 @@ +#!/usr/bin/env node + +const people = [ + { name: 'Ingy', favs: ['coffee', 'yellow'] }, + { name: 'Gugod', favs: ['tea', 'blue'] }, +]; + +people.forEach((person) => { + const { name, favs: [ drink, color ] } = person; + console.log(`${name} wears ${color} and drinks ${drink}.`); +}); diff --git a/talk/destructure.pl b/talk/destructure.pl new file mode 100644 index 0000000..ebb351b --- /dev/null +++ b/talk/destructure.pl @@ -0,0 +1,19 @@ +#!/usr/bin/env perl + +use v5.16; + +use assign::0; + +my $people = [ + { name => 'Ingy', favs => ['coffee', 'yellow'] }, + { name => 'Gugod', favs => ['tea', 'blue'] }, +]; + +for my $person (@people) { + my { + $name, + favs => [ $drink, $color ], + } = $person; + + say "$name wears $color and drinks $drink."; +} diff --git a/talk/destructure2.js b/talk/destructure2.js new file mode 100644 index 0000000..f3aa306 --- /dev/null +++ b/talk/destructure2.js @@ -0,0 +1,10 @@ +#!/usr/bin/env node + +const people = [ + { name: 'Ingy', favs: ['coffee', 'yellow'] }, + { name: 'Gugod', favs: ['tea', 'blue'] }, +]; + +people.forEach(({ name, favs: [ drink, color ] }) => { + console.log(`${name} wears ${color} and drinks ${drink}.`); +}); diff --git a/talk/slides.vroom b/talk/slides.vroom new file mode 100644 index 0000000..3bb715f --- /dev/null +++ b/talk/slides.vroom @@ -0,0 +1,262 @@ +---- config +title: Destructuring Syntax for Perl +indent: 5 +auto_size: 1 +vim_opts: '-u NONE' +skip: 0 +top: 1 + +vimrc: | + source ./vimrc + + +---- center +Destructuring + +A New Syntax for Perl Assignment Statements + +by Ingy dot Net + +The Perl and Raku Conference +July 13, 2023 +Toronto + + +---- +== I Love Coffee! + ++$ vim some.coffee + +$ coffee some.coffee + + +---- +== A Short Drip, Please + + {name, favs: [drink, color]} = person + ++ name = person.name + drink = person.favs.drink + color = person.favs.color + + +---- +== Introducing Destructuring Assignment + +* First saw it in CoffeeScript 10+ years ago + +* A way to concisely unpack a structure into variables + +* Lets us to write more concise and readable code + + +---- +== Now JavaScript has it! + +$ vim destructure.js + +$ node destructure.js + +$ vim destructure.js destructure2.js -o + +$ node destructure2.js + + +---- +== Coffee Tastes Better + +$ coffee -e '[a, b, ...m, y, z] = [1..10]; console.log [a, b, m, y, z]' + +$ node -e '[a, b, ...m, y, z] = [...Array(10).keys()]' + + +---- +== Clojure has it! + +$ vim destructure.clj + +$ clojure -M -e '(load-file "destructure.clj")' + + +---- +== OpenAI Says These 20 Languages Have It + +Clojure +CoffeeScript +Dart +Elixir +Erlang +F# +Go +Groovy +JavaScript +Julia +Kotlin +Lua +PHP +Python +Racket +Ruby +Rust +Scala +Swift +TypeScript + + +---- +== Now Perl has it too!!! + ++== And it's Better than the Others! + ++$ cpanm assign + ++* https://metacpan.org/pod/assign + ++ my { $name, + favs => [$drink, $color], + } = $person; + ++ my $name = $person->{name}; + my $drink = $person->{favs}[0]; + my $color = $person->{favs}[1]; + + +$ vim destructure.js + +$ node destructure.js + + +---- +== Perl Destructuring Basic Rules + + use assign::0; + my [ $a, $b ] = $self->doit; + +* Use 'use assign::0;' +* NOT 'use assign;' + +* Supports 'my', 'our', 'local', none or inline + + [ my $a, our $b ] = $self->doit; + +* LHS is [] or {} literal array or hash reference syntax + +* RHS must be an array ref or hash ref (matching LHS type) + +* Will work anywhere assignments work + * Assignment statements + * Loop variables + * Function signatures + * etc + + +---- +== Array Destructuring Forms + +my [ $a, $b, $c ] = $aref; + ++my [ $a, $b, $c ] = (1, 2, 3); # ERROR + ++my ( $a, [$b, $c] ) = (1, [2, 3]); # OK! + ++my [ $a, $b, @c] = $aref; + ++my [ $a, $b, @$c] = $aref; + ++my [ $a, @$b, $c] = $aref; + ++my [ $a, $b, @$m, $y, $z] = $aref; + ++my [ $a, _, $c] = $aref; +my [ $a, undef, $c] = $aref; + ++my [ $a, @, $z] = $aref; + ++my [ $a, $_, $c] = $aref; + ++my [ $a, 24, $z] = $aref; + ++my [ $a, 11, $m, 12, $z] = $aref; + + +---- +== Hash Destructuring Forms + +my {$a, $b, $c} = $href; + ++my {$a, b => [$b1, $b2]} = $href; + ++my {$a, $b => [$b1, $b2]} = $href; + ++my {a => $foo, b => $bar, $c} = $href; + ++my {$a, $b=42, $c='foo'} = $href; # Defaults= values + ++my {$a!, $b, $c!} = $href; # Required keys + ++my {'a key', 'another/key'} = $href; ++my {'a key' => $a_key, 'another/key' => $another_key} = $href; + ++my {@$keys} = $href; ++my {_ => @$vals} = $href; ++my {@$keys => @$vals} = $href; # unzip hash ref + ++my [@$keys, @$vals] = $href; # sorted + + +---- +== More Forms! + +[ $a, $b ] //= $d; # Only assign undefined variables +[ $a, $b ] .= $d; # Append string to every var +[ $a, $b ] += $d; # Add number to every var + ++for my { k => [ $a1, $a2 ]} (@list) { ... + ++for my { $k => $v } (%hash) { ... + ++sub foo { + my ($self, { $b, c => [$c1, $c2] }) = @_; + ++sub foo($self, { $b, c => [$c1, $c2] }) { ... + +# Regex: +my [ $match, $cap1, $cap2 ] = $str =~ /…/; +my [ $match, $cap1, $cap2 ] = /…/; # Match using $_ + ++my [ $a, @$m{reverse}, $z ] = $aref; ++my [ $a, @$l{map ($_ + 1), grep ($_ > 10)}, $z ] = $aref; ++my [ $a, @{join '-'} => $s, $z ] = $d; + + +---- +== Current Implementation + +* This is a Prototype + +* But a Usable & Supported Prototype on CPAN! + +* It uses Filter::Simple and PPI + + +---- +== Getting This Into Perl 5 Core + + +---- +== The End + +* I want your feedback and ideas! + +* https://github.com/ingydotnet/assign-pm + + +---- +== Extra Stuff +my [ $a!, $b ] = # die if not $a + +my [ $a, $b=42 ] = + +for my { name, favs: [ drink, color ] } (@l) {} + +sub foo({ name, favs: [ drink, color ] }) {} diff --git a/talk/some.coffee b/talk/some.coffee new file mode 100644 index 0000000..260d432 --- /dev/null +++ b/talk/some.coffee @@ -0,0 +1,20 @@ +#!/usr/bin/env coffee + +people = [ + name: 'Ingy' + favs: ['coffee', 'yellow'] +, + name: 'Gugod' + favs: ['tea', 'blue'] +] + +for person in people + { + name, + favs: [ + drink, + color + ] + } = person + + console.log "#{name} wears #{color} and drinks #{drink}." diff --git a/talk/vimrc b/talk/vimrc new file mode 100644 index 0000000..c0fb050 --- /dev/null +++ b/talk/vimrc @@ -0,0 +1,40 @@ +unmap AA +map QQ ; + +set nohlsearch + +au BufRead * syn match vroom_command "\v^\s*\$.*$" +hi vroom_command term=bold,italic,underline ctermfg=Brown +au BufRead * syn match https_url "\vhttps:.*" +hi https_url term=bold,italic,underline ctermfg=LightBlue + +autocmd BufWritePre *.json :syn off + +autocmd BufRead,BufNewFile *.ly set filetype=clojure +autocmd BufRead,BufNewFile *.ys set filetype=yaml +autocmd BufRead,BufNewFile *.yaml set filetype=yaml + +map j /^\(\s\+\$\\|.*https:\) +map k ?^\(\s\+\$\\|.*https:\) + +function! VroomSlideRunner() + if getline('.') != '' + :execute + \ "!./vroom-slide-runner <<'...'\n" . + \ bufname('%') . "\n" . + \ trim(getline('.')) . "\n" . + \ "..." + endif +endfunction + +map :call VroomSlideRunner() + +map q ; +map qq :q! + +map rr :e! % +map yy :set ft=yaml % + +map 1 :wincmd o +map 2 :wincmd v +map \1 :w diff --git a/talk/vroom-slide-runner b/talk/vroom-slide-runner new file mode 100755 index 0000000..e297013 --- /dev/null +++ b/talk/vroom-slide-runner @@ -0,0 +1,32 @@ +#!/usr/bin/env bash + +read -r file +read -r line + +line=${line#\* } + +if [[ $line == https://* ]]; then + if [[ $OSTYPE == darwin* ]]; then + open "$line" + else + xdg-open "$line" + fi + +elif [[ $line == \$\ * ]]; then + line=${line#\$\ } + + if [[ $line == vim\ * ]]; then + line=${line/vim\ /vim --not-a-term } + fi + + clear + echo "+ $line" + echo + # sleep .5 + + if [[ $line =~ [\>\<\|] ]]; then + eval "$line" + else + eval "$line [ $b1, $b2 ] } = $foo; ++++ +my ($b1, $b2); +$b1 = $foo->{b}->[0]; +$b2 = $foo->{b}->[1]; +#line 1 +... + +test <<'...', "Unpack hash nested with a hash"; +my { a => { $a1, $a2 } } = $foo; ++++ +my ($a1, $a2); +$a1 = $foo->{a}->{a1}; +$a2 = $foo->{a}->{a2}; +#line 1 +... + +test <<'...', "Unpack a mixed bag"; +my { a => { $a1, $a2 }, b => [ $b1, $b2 ] } = $foo; ++++ +my ($a1, $a2); +$a1 = $foo->{a}->{a1}; +$a2 = $foo->{a}->{a2}; +my ($b1, $b2); +$b1 = $foo->{b}->[0]; +$b2 = $foo->{b}->[1]; +#line 1 +... + +test <<'...', q!Unpack from: my $person = { name => 'Gugod', favs => ['tea', 'blue'] };!; +my { $name, favs => [ $drink, $color ] } = $person; ++++ +my ($name); +$name = $person->{name}; +my ($drink, $color); +$drink = $person->{favs}->[0]; +$color = $person->{favs}->[1]; +#line 1 +... diff --git a/test/07-tail.t b/test/07-tail.t new file mode 100644 index 0000000..759f605 --- /dev/null +++ b/test/07-tail.t @@ -0,0 +1,13 @@ +use assign::Test; + +test <<'...', "Assign scalars at start end of array, and array of in-betweens"; +my [$a, $b, @$m, $y, $z] = $o; ++++ +my ($a, $b, $m, $y, $z); +$a = $o->[0]; +$b = $o->[1]; +$m = [@$o[2..@$o-3]]; +$y = $o->[-2]; +$z = $o->[-1]; +#line 1 +...