develooper Front page | perl.perl5.porters | Postings from June 2013

[PATCH] use dots - allow '.' instead of '->' everywhere and concatwith '~'

Thread Next
From:
Rev. Chip
Date:
June 9, 2013 22:08
Subject:
[PATCH] use dots - allow '.' instead of '->' everywhere and concatwith '~'
Message ID:
20130609220758.GA2150@tytlal.tinsaucer.com
As discussed at YAPC, this patch adds the pragma "use dots" allowing users to
write . instead of -> in all places.  Infix ~ (a la Perl 6) provides string
concatenation.

To any skeptics, I suggest you find a nice big OO module of your own and
globally replace arrows with dots, then just look at it.  You'll be amazed
how much easier it is to read (and write) modern Perl this way.

Under "use dots", "->" is disallowed by default to avoid user confusion.
Any user who uses dots will also be reading a lot of code that doesn't.  We
want any arrows present to be a signal that dot is concatenation.  In cases
where intermixing is Really Wanted, "use dots 'mixed'" is available, but not
recommended.

Incidentally, Leon Brocard had the same basic idea a few years ago, but his
implementation didn't mature.  For example, it looks like it wouldn't
properly handle autoquoting of method names.  Also, he made it a feature.
This seems good at first, but we don't want "use v5.20" to imply "use dots".

This patch is also pushed in branch "chip/dots".

commit 7e4b75ad02fa8593c1fc7237cc24026cd19a97cb
Author: Chip Salzenberg <chip@pobox.com>
Date:   Wed Jun 5 16:49:52 2013 -0500

    "use dots":  Class.method  $obj.method  [$a].[0]  {a=>1}.{a}  $str ~ $concat

diff --git a/MANIFEST b/MANIFEST
index e76d4af..e7caff5 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4083,6 +4083,8 @@ lib/diagnostics.pm		Print verbose diagnostics
 lib/diagnostics.t		See if diagnostics.pm works
 lib/DirHandle.pm		like FileHandle only for directories
 lib/DirHandle.t			See if DirHandle works
+lib/dots.pm			For "use dots"
+lib/dots.t			See if "use dots" works
 lib/dumpvar.pl			A variable dumper
 lib/dumpvar.t			A variable dumper tester
 lib/English.pm			Readable aliases for short variables
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index 2f94757..83873b0 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -2068,6 +2068,7 @@ use File::Glob qw(:case);
                 lib/charnames.{pm,t}
                 lib/dbm_filter_util.pl
                 lib/deprecate.pm
+                lib/dots.{pm,t}
                 lib/dumpvar.{pl,t}
                 lib/feature.{pm,t}
                 lib/feature/
diff --git a/lib/dots.pm b/lib/dots.pm
new file mode 100644
index 0000000..2a1f48a
--- /dev/null
+++ b/lib/dots.pm
@@ -0,0 +1,97 @@
+package dots;
+use strict;
+
+our $VERSION = '1.00';
+
+our $enable_bit = 0x00000001;
+our $mixed_bit  = 0x00000002;
+
+sub import {
+    shift;
+    $^H{dots} = $enable_bit;
+    while (@_) {
+        local $_ = shift;
+        if ($_ eq 'mixed') {
+            $^H{dots} |= $mixed_bit;
+        }
+        else {
+            require Carp;
+            Carp::croak("dots: unknown subpragma '$_'");
+        }
+    }
+}
+
+sub unimport {
+    shift;
+    my $mask;
+    while (@_) {
+        local $_ = shift;
+        if ($_ eq 'mixed') {
+            $mask = $mixed_bit;
+        }
+        else {
+            require Carp;
+            Carp::croak("dots: unknown subpragma '$_'");
+        }
+    }
+    if (defined $mask) {
+        $^H{dots} &= ~$mask;
+    }
+    else {
+        delete $^H{dots};
+    }
+}
+
+'dot dot dot';
+__END__
+
+=head1 NAME
+
+dots - perl pragma to use dots to follow references and call methods
+
+=head1 SYNOPSIS
+
+    use dots;                   # '.' follows refs; '~' is concat
+
+    my $obj = Foo.new(...);     # call class method
+    $obj.method;                # call object method
+    my $href = { a => 1 };
+    $href.{a};                  # follow hash ref
+    my $aref = [ sub {...} ];
+    $aref.[0].(@args);          # follow array ref; call code
+
+    say "hello" ~ " world";     # '~' concatenates strings
+
+    say $a->[0];                # '->' is not allowed by default
+    use dots 'mixed';
+    say $a->[0];                # allow '->' explicitly
+
+    no dots 'mixed';            # disallow '->' again
+
+    no dots;                    # back to Perl defaults again
+
+=head1 DESCRIPTION
+
+With the C<dots> pragma you can switch out Perl's '->' operator for the much
+easier to type, easier to read, and industry standard '.' operator.  It does
+everything '->' usually does in following references and calling methods.
+
+The '~' binary operator, previously unused, becomes string concatenation.
+
+By default, C<use dots> forbids using '->'.  This is important for
+readability; seeing an arrow should be a reliable sign that C<use dots> is
+off and '.' does string concatenation.  It also leaves open that '->' can be
+repurposed someday.  But if you really want to mix arrows and dots, this is
+supported; just write C<use dots 'mixed'>.
+
+To undo C<use dots 'mixed'>, write C<no dots 'mixed'>.
+
+To turn off dots, write C<no dots>.
+
+=head1 CAVEATS
+
+This pragma is lexically scoped and only has effect at compile time.
+Decompilers like C<-MO=Deparse> will generate the arrow version until
+someone teaches them to write dots instead (hint hint).
+
+=cut
diff --git a/lib/dots.t b/lib/dots.t
new file mode 100644
index 0000000..7214653
--- /dev/null
+++ b/lib/dots.t
@@ -0,0 +1,47 @@
+#!./perl
+
+# This tests syntax under variations of "use dots".
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = qw(../lib);
+}
+
+use strict;
+use warnings;
+
+use Test::More tests => 9;
+
+my $a = ['foo', 'bar'];
+my $h = { corge => 1, grault => 2 };
+my $c = sub { '"Bob"' };
+
+eval q{
+     use strict;
+     use dots;
+     ok($a.[0] eq 'foo');
+     ok($h.{corge} == 1);
+     ok($c.() eq '"Bob"');
+};
+diag($@) if $@;
+ok(!$@, "dots");
+
+eval q{
+     use strict;
+     use dots;
+     is('Praise ' ~ '"Bob"!', 'Praise "Bob"!', "~ concat");
+};
+diag($@) if $@;
+ok(!$@, "dots");
+
+eval q{
+     use strict;
+     use dots 'mixed';
+     my $x = [ sub { "hi" } ];
+     is($x.[0]->(), 'hi', "mixed expression");
+};
+diag($@) if $@;
+ok(!$@, "use dots 'mixed'");
+
+eval q{ use dots; [0]->[0] };
+ok($@, "mixed is off by default");
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index e41038c..808cb66 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -24,6 +24,23 @@ here, but most should go in the L</Performance Enhancements> section.
 
 [ List each enhancement as a =head2 entry ]
 
+=head2 C<use dots>
+
+The new C<use dots> pragma replaces the '->' operator with the shorter,
+easier-to-read, and industry standard '.' operator within a lexical scope.
+
+Under C<use dots>:
+
+=over 4
+
+=item '.' follows references and invokes methods
+
+=item '~' concatenates strings (same as Perl 6)
+
+=item '->' is disallowed, unless requested by writing C<use dots 'mixed'>
+
+=back
+
 =head1 Security
 
 XXX Any security-related notices go here.  In particular, any security
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index a228d23..416dc2f 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -6318,6 +6318,18 @@ what you want, put an & in front.)
 not get any randomness out of your system.  This usually indicates
 Something Very Wrong.
 
+=item use dots in effect; replace '->' with '.'
+
+(F) You should replace all instances of '->' with '.' under C<use dots>.
+
+The C<use dots> pragma makes code easier to write and read by using '.'
+intead of '->' for all purposes, and using the infix '~' operator for string
+concatenation.  When C<use dots> is in effect, '->' is forbidden, so readers
+know that if they see '->' then '.' means concatenation.
+
+If you know what you're doing, you can request mixing of '->' and '.' by
+writing C<use dots 'mixed'>.
+
 =back
 
 =head1 SEE ALSO
diff --git a/toke.c b/toke.c
index d3bc457..b3f6824 100644
--- a/toke.c
+++ b/toke.c
@@ -4585,6 +4585,23 @@ S_word_takes_any_delimeter(char *p, STRLEN len)
 	    (p[0] == 'q' && strchr("qwxr", p[1]))));
 }
 
+/* coordinate with dots.pm */
+
+#define HINT_DOTS_ENABLED 0x00000001
+#define HINT_DOTS_MIXED   0x00000002
+
+#define hint_dots()  S_hint_dots(aTHX)
+STATIC U32
+S_hint_dots(pTHX) {
+    HV * const hinthv = GvHV(PL_hintgv);
+    if (hinthv) {
+        SV ** const svp = hv_fetchs(hinthv, "dots", FALSE);
+        if (svp)
+            return SvUV(*svp);
+    }
+    return 0;
+}
+
 /*
   yylex
 
@@ -5613,40 +5630,41 @@ Perl_yylex(pTHX)
 		s = --PL_bufptr;
 	    }
 	}
-	{
-	    const char tmp = *s++;
-	    if (*s == tmp) {
-		s++;
-		if (PL_expect == XOPERATOR)
-		    TERM(POSTDEC);
-		else
-		    OPERATOR(PREDEC);
-	    }
-	    else if (*s == '>') {
-		s++;
-		s = SKIPSPACE1(s);
-		if (isIDFIRST_lazy_if(s,UTF)) {
-		    s = force_word(s,METHOD,FALSE,TRUE,FALSE);
-		    TOKEN(ARROW);
-		}
-		else if (*s == '$')
-		    OPERATOR(ARROW);
-		else
-		    TERM(ARROW);
-	    }
-	    if (PL_expect == XOPERATOR) {
-		if (*s == '=' && !PL_lex_allbrackets &&
-			PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN) {
-		    s--;
-		    TOKEN(0);
-		}
-		Aop(OP_SUBTRACT);
+	s++;
+	if (*s == '-') {
+	    s++;
+	    if (PL_expect == XOPERATOR)
+		TERM(POSTDEC);
+	    else
+		OPERATOR(PREDEC);
+	}
+	else if (*s == '>') {
+	    s++;
+	    if ((hint_dots() & (HINT_DOTS_ENABLED|HINT_DOTS_MIXED)) == HINT_DOTS_ENABLED)
+	        Perl_croak(aTHX_ "use dots in effect; replace '->' with '.'");
+	  arrow:
+	    s = SKIPSPACE1(s);
+	    if (isIDFIRST_lazy_if(s,UTF)) {
+		s = force_word(s,METHOD,FALSE,TRUE,FALSE);
+		TOKEN(ARROW);
 	    }
-	    else {
-		if (isSPACE(*s) || !isSPACE(*PL_bufptr))
-		    check_uni();
-		OPERATOR('-');		/* unary minus */
+	    else if (*s == '$')
+		OPERATOR(ARROW);
+	    else
+		TERM(ARROW);
+	}
+	if (PL_expect == XOPERATOR) {
+	    if (*s == '=' && !PL_lex_allbrackets &&
+	    	PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN) {
+		s--;
+		TOKEN(0);
 	    }
+	    Aop(OP_SUBTRACT);
+	}
+	else {
+	    if (isSPACE(*s) || !isSPACE(*PL_bufptr))
+		check_uni();
+	    OPERATOR('-');		/* unary minus */
 	}
 
     case '+':
@@ -5746,7 +5764,10 @@ Perl_yylex(pTHX)
 	    Eop(OP_SMARTMATCH);
 	}
 	s++;
-	OPERATOR('~');
+        if (PL_expect == XOPERATOR && (hint_dots() & HINT_DOTS_ENABLED))
+            Aop(OP_CONCAT);
+        else
+            OPERATOR('~');
     case ',':
 	if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMMA)
 	    TOKEN(0);
@@ -6693,11 +6714,13 @@ Perl_yylex(pTHX)
 		    pl_yylval.ival = 0;
 		OPERATOR(DOTDOT);
 	    }
-	    if (*s == '=' && !PL_lex_allbrackets &&
-		    PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN) {
-		s--;
-		TOKEN(0);
-	    }
+            if (hint_dots() & HINT_DOTS_ENABLED)
+                goto arrow;
+            if (*s == '=' && !PL_lex_allbrackets &&
+                    PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN) {
+                s--;
+                TOKEN(0);
+            }
 	    Aop(OP_CONCAT);
 	}
 	/* FALL THROUGH */

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About