=head1 TITLE

Synopsis 2: Bits and Pieces

=head1 AUTHOR

Larry Wall <larry@wall.org>

=head1 VERSION

  Maintainer: Larry Wall <larry@wall.org>
  Date: 10 Aug 2004
  Last Modified: 29 Jan 2005
  Number: 2
  Version: 6

This document summarizes Apocalypse 2, which covers small-scale
lexical items and typological issues.  (These Synopses also contain
updates to reflect the evolving design of Perl 6 over time, unlike the
Apocalypses, which are frozen in time as "historical documents".
These updates are not marked--if a Synopsis disagrees with its
Apocalypse, assume the Synopsis is correct.)

=head1 Atoms

=over 4

=item *

In the abstract, Perl is written in Unicode, and has consistent Unicode
semantics regardless of the underlying text representations.

=item *

Perl can count Unicode line and paragraph separators as line markers,
but that behavior had better be configurable so that Perl's idea of
line numbers matches what your editor thinks about Unicode lines.

=item *

Unicode horizontal whitespace is counted as whitespace, but it's better
not to use thin spaces where they will make adjoining tokens look like
a single token.

=back

=head1 Molecules

=over 4

=item *

In general, whitespace is optional in Perl 6 except where it is
needed to separate constructs that would be misconstrued as a single
token or other syntactic unit.  (In other words, Perl 6 follows the
standard "longest-token" principle, or in the cases of large constructs,
a "prefer shifting to reducing" principle.)

This is an unchanging deep rule, but the surface ramifications of it
change as various operators and macros are added to or removed from
the language, which we expect to happen because Perl 6 is designed to
be a mutable language.  In particular, there is a natural conflict
between postfix operators and infix operators, either of which may
occur after a term.  If a given token may be interpreted as either a
postfix operator or an infix operator, the infix operator requires
space before it, and the postfix operator requires a lack of space
before it, unless it begins with a dot.  (Infix operators may not
start with a dot.)  For instance, if you were to add your own
C<< infix:<++> >> operator, then it must have space before it, and the
normal autoincrementing C<< postfix:<++> >> operator may not have
space before it, or must be written as C<.++> instead.  In standard Perl
6, however, it doesn't matter if you put a space in front of
C<< postfix:<++> >>.

=item *

Single-line comments work as in Perl 5, starting with a C<#> character
and ending with the subsequent newline.  They count as whitespace for
purposes of separation.  Certain quoting tokens may make use of C<#>
characters as delimiters without starting a comment.

=item *

Multiline comments will be provided by extending the syntax of POD
to nest C<=begin COMMENT>/C<=end COMMENT> correctly without the need
for C<=cut>.  (Doesn't have to be "COMMENT"--any unrecognized POD
stream will do to make it a comment.  Bare C<=begin> and C<=end>
probably aren't good enough though, unless you want all your comments
to end up in the manpage...)

Probably we could have single paragraph comments with C<=for COMMENT>
as well.  That would let C<=for> keep its meaning as the equivalent
of a C<=begin> and C<=end> combined.

=item *

Intra-line comments will not be supported in standard Perl (but it would
be trivial to declare them as a macro).

=back

=head1 Built-In Data Types

=over 4

=item *

In support of OO encapsulation, there is a new fundamental datatype:
"opaque".  External access to opaque objects is always through method
calls, even for attributes.

=item *

Perl 6 will have an optional type system that helps you write safer
code that performs better.

=item *

Perl 6 will support the notion of "properties" on various kinds of
objects.  Properties are like object attributes, except that they're
managed by the individual object rather than by the object's class.
According to A12, properties are actually implemented by a
kind of mixin mechanism.

=item *

Properties applied to compile-time objects such as variables and
classes are also called "traits".  Traits are not expected to change
at run time.

=item *

Perl 6 is an OO engine, but you're not generally required to think
in OO when that's inconvenient.  However, some built-in concepts such
as filehandles will be more object-oriented in a user-visible way.

=item *

A variable's type is an interface contract indicating what sorts
of values the variable may contain. More precisely, it's a promise
that the object or objects contained in the variable are capable of
responding to the methods of the indicated "role".  See A12 for more
about roles.  A variable object may itself be bound to a container
type that specifies how the container works without necessarily
specifying what kinds of things it contains.

=item *

You'll be able to ask for the length of an array, but it won't be
called that, because "length" does not specify units.  So
C<.elems> is the number of array elements.  (You can also
ask for the length of an array in bytes or codepoints or graphemes.
Same for strings.)

=item *

C<my Dog $spot> by itself does not automatically call a C<Dog> constructor.
The actual constructor syntax turns out to be C<my Dog $spot.=new;>,
making use of the C<.=> mutator method-call syntax.

=item *

If you say

    my int @array is MyArray;

you are declaring that the elements of C<@array> are integers,
but that the array itself is implemented by the C<MyArray> class.
Untyped arrays and hashes are still perfectly acceptable, but have
the same performance issues they have in Perl 5.

=item *

Built-in object types start with an uppercase letter: C<Int>, C<Num>,
C<Str>, C<Bit>, C<Ref>, C<Scalar>, C<Array>, C<Hash>, C<Rule> and
C<Code>.  Non-object (value) types are lowercase: C<int>, C<num>,
C<str>, C<bit>, and C<ref>.  Value types are primarily intended for
declaring compact array storage.  However, Perl will try to make
those look like their corresponding uppercase types if you treat them
that way.

=item *

Perl 6 will intrinsically support big integers and rationals through
its system of type declarations.  C<Int> automatically supports
promotion to arbitrary precision.  C<Rat> supports arbitrary precision
rational arithmetic.  Value types like C<int> and C<num> imply
the natural machine representation for integers and floating-point
numbers, respectively, and do not promote to arbitrary precision.
Untyped scalars use C<Int> semantics rather than C<int>.

=item *

Perl 6 should by default make standard IEEE floating point concepts
visible, such as C<Inf> (infinity) and C<NaN> (not a number).
It should also be at least pragmatically possible to throw exceptions
on overflow.

=item *

A C<Str> is a Unicode string object of some sort.  A C<str> is
a stringish view of an array of integers, and has no Unicode or
character properties without explicit conversion to some kind of C<Str>.
Typically it's an array of bytes serving as a buffer.

=back

=head1 Names and Variables

=item *

The C<$pkg'var> syntax is dead.  Use C<$pkg::var> instead.

=item *

You may no longer put whitespace between a sigil and its following
name or construct.

=item *

You may interpolate a string into a package or variable name using
C<::($expr)> where you'd ordinarily put a package or variable name.
The string is allowed to contain additional instances of C<::>, which
will be interpreted as package nesting.  You may only interpolate
entire names, since the construct starts with C<::>, and either ends
immediately or is continued with another C<::> outside the curlies.
All symbolic references are done with this notation:

    $foo = "Foo";
    $foobar = "Foo::Bar";
    $::($foo)		# package-scoped $Foo
    $::("MY::$foo")	# lexically-scoped $Foo
    $::("*::$foo")	# global $Foo
    $::($foobar)	# $Foo::Bar
    $::($foobar)::baz	# $Foo::Bar::baz
    $::($foo)::Bar::baz	# $Foo::Bar::baz
    $::($foobar)baz	# ILLEGAL at compile time (no operator baz)

Note that unlike in Perl 5, initial C<::> doesn't imply global.
Package names are searched for from inner lexical scopes to outer,
then from inner packages to outer.  The global namespace is the last
place it looks.  You must use the C<*> package to force the search
to start in the global namespace.

=item *

Sigils are now invariant.  C<$> always means a scalar variable, C<@>
an array variable, and C<%> a hash variable, even when subscripting.
Array and hash variable names in scalar context automatically produce
references.

=item *

In string contexts these container references automatically dereference
to appropriate (white-space separated) string values.  In numeric
contexts, the number of elements in the container is returned.
In boolean contexts, a true value is returned if and only if there
are any elements in the container.

=item *

To get a Perlish representation of any data value, use the C<.perl>
method.  This will put quotes around strings, square brackets around
list values, curlies around hash values, etc., such that standard
Perl could reparse the result.

=item *

To get a formatted representation of any scalar data value, use
the C<.as('%03d')> method to do an implicit sprintf on the value.
To format an array value separated by commas, supply a second argument:
C<.as('%03d', ', ')>.  To format a hash value or list of pairs, include
formats for both key and value in the first string: C<< .as('%s: %s', "\n") >>.

=item *

Subscripts now consistently dereference the reference produced by
whatever was to their left.  Whitespace is not allowed between a
variable name and its subscript.  However, there is a corresponding
"dot" form of each subscript (C<@foo.[1]> and C<%bar.{'a'}>) which
allows optional whitespace before the dot (except when interpolating).
Constant string subscripts may be placed in angles, so C<%bar.{'a'}>
may also be written as C<< %bar<a> >> or C<< %bar.<a> >>.

=item *

Slicing will be specified by the nature of the subscript, not by
the sigil.

=item *

The context in which a subscript is evaluated is no longer controlled
by the sigil either.  The inner context turns out to be whatever
the outer context was, since we now have convenient single-character
context specifiers to force either scalar or list context.

=item *

There is a need to distinguish list assignment from list binding.
List assignment works exactly as it does in Perl 5, copying the
values.  There's a new C<:=> binding operator that lets you bind
names to array and hash references without copying, just as function
arguments are bound to formal parameters.  See A6.

=item *

Unlike in Perl 5, the notation C<&foo> merely creates a reference
to function "foo" without calling it.  Any function reference may
be dereferenced and called using parens (which may, of course,
contain arguments).  Whitespace is not allowed before the parens,
but there is a corresponding C<.()> operator, which allows you to
insert optional whitespace before the dot.

=item *

With multis, C<&foo> may not be sufficient to uniquely name a specific
function.  In that case, a type signature may also be included in angles:
C<< &foo<int,num> >>.  It still just returns a function reference.

=item *

Slicing syntax is covered in S9.  Multidimensional
slices will be done with semicolons between individual slice subscripts.

=item *

Slicing hashes to return pairs rather than values should probably
be done with an optional selection argument to C<.pairs()> or C<.kv()>.

=item *

A hash reference in numeric context returns the number of pairs
contained in the hash.  A hash reference in a boolean context returns
true if there are any pairs in the hash.  In either case, any intrinsic
iterator would be reset.  (If hashes do carry an intrinsic iterator
(as they do in Perl 5), there will be a C<.reset> method on the hash
object to reset the iterator explicitly.)

=item *

Sorting a list of pairs should sort on their keys by default.  For
more on C<sort> see S29.  (If there is no S29 yet, write one.)

=item *

Many of the special variables of Perl 5 are going away.  Those that
apply to some object such as a filehandle will instead be attributes
of the appropriate object.  Those that are truly global will have
global alphabetic names, such as C<$*PID> or C<@*ARGS>.

=item *

Any remaining special variables will be lexically scoped.
This includes C<$_> and C<@_>.  As well as the new C<$/>, which
is the return value of the last regex match.  C<$0>, C<$1>, C<$2>, etc.,
are aliases into the C<$/> object.

[Update: The C<$0> object has been renamed to C<$/>, but it's
still lexical.]

=item *

The C<$#foo> notation is dead.  Use C<@foo.end> or C<[-1]> instead.
(Or C<@foo.shape[$dimension]> for multidimensional arrays.)

=item *

A2 proposes C<$(...)> and C<@(...)> to interpolate arbitrary
expressions, but these have been replaced with interpolation of curlies
(closures).

=back

=head1 Names

=over 4

=item *

The current lexical symbol table may now be referenced through the
pseudo-package C<MY>, or the corresponding variable C<%MY::>:

    my $foo = 42;
    say %MY::<$foo>;	# prints "42"

=item *

Typeglobs are gone.  Use binding (C<:=> or C<::=>) to do aliasing.
Individual variable objects are still accessible through the
hash representing each symbol table, but you have to include the
sigil in the variable name now: C<%MyPackage::{'$foo'}> (or also
C<< %MyPackage::<$foo> >> these days).

=item *

Truly global variables live in the C<*> package: C<$*UID>, C<%*ENV>.
(The C<*> may generally be omitted if there is no inner declaration
hiding the global name.)  C<$*foo> is short for C<$*::foo>, suggesting
that the variable is "wild carded" into every package.

=item *

Standard input is C<$*IN>, standard output is C<$*OUT>, and standard error
is C<$*ERR>.  The magic command-line input handle is C<$*ARGS>.

=item *

Magical file-scoped values live in variables with a C<=> secondary
sigil.  C<$=DATA> is the name of your C<DATA> filehandle, for instance.
All pod structures are available through C<%=POD> (or some such).
As with C<*>, the C<=> may also be used as a package name: C<$=::DATA>.

=item *

Magical lexically scoped values live in variables with a C<?>
secondary sigil.  These are all values that are known to the compiler.
(Run-time values go into the C<*> namespace.)  C<$?FILE> and C<$?LINE>
are your current file and line number, for instance.  As with C<*>,
the C<?> may also be used as a package name: C<$?::SUB>.  Here are some
possibilities:

    $?OS        Which os am I compiled for?
    $?OSVER     Which os version am I compiled for?
    $?PERLVER   Which Perl version am I compiled for?
    $?FILE      Which file am I in?
    $?LINE      Which line am I at?
    $?PACKAGE   Which package am I in?
    @?PACKAGE   Which packages am I in?
    $?MODULE    Which module am I in?
    @?MODULE    Which modules am I in?
    ::?CLASS	Which class am I in? (as package name)
    $?CLASS     Which class am I in? (as variable)
    @?CLASS     Which classes am I in?
    ::?ROLE     Which role am I in? (as package name)
    $?ROLE      Which role am I in? (as variable)
    @?ROLE      Which roles am I in?
    $?GRAMMAR   Which grammar am I in?
    @?GRAMMAR   Which grammars am I in?
    &?SUB       Which sub am I in?
    @?SUB       Which subs am I in?
    $?SUBNAME   Which sub name am I in?
    @?SUBNAME   Which sub names am I in?
    &?BLOCK     Which block am I in?
    @?BLOCK     Which blocks am I in?
    $?LABEL	Which block label am I in?
    @?LABEL	Which block labels am I in?

Note that some of these things have parallels in the * space:

    $*OS	Which OS I'm running under
    $*OSVER	Which OS version I'm running under
    $*PERLVER	Which Perl version I'm running under

=back

=head1 Literals

=over 4

=item *

Underscores are allowed between any two digits in a literal number.

=item *

The C<qw/foo bar/> quote operator now has a bracketed form: C<< <foo bar> >>.
When used as a subscript it performs a slice equivalent to C<{'foo','bar'}>.
Much like the relationship between single quotes and double quotes, single
angles do not interpolate while double angles do.  The double angles may
be written either with French quotes, C<«$foo @bar»>, or
with "Texas" quotes, C<<< <<$foo @bar>> >>>, as the ASCII workaround.
The implicit split is done after interpolation, but respects quotes
in a shell-like fashion, so that C<«'$foo' "@bar"»> is guaranteed to
produce a list of two "words" equivalent to C<< ('$foo', "@bar") >>.
C<Pair> notation is also recognized inside C<«...»> and such "words" are
returned as C<Pair> objects.

=item *

Generalized quotes may now take adverbs:

    Short	Long		Meaning
    =====	====		=======
    :x		:exec		Execute as command and return results
    :w		:words		Split result on words (no quote protection)
    :ww		:quotewords	Split result on words (with quote protection)
    :t		:to		Interpret result as heredoc terminator
    :0		:raw		No escapes at all (unless otherwise adverbed)
    :1		:single		Interpolate \\, \q and \' (or whatever)
    :2		:double		Interpolate all the following
    :s		:scalar		Interpolate $ vars
    :a		:array		Interpolate @ vars
    :h		:hash		Interpolate % vars
    :f		:function	Interpolate & calls
    :c		:closure	Interpolate {...} expressions
    :b		:backslash	Interpolate \n, \t, etc. (implies :m)

Any of these may omit the colon after an initial "q", so we automatically
get the forms:

    Form	Same as
    ====	=======
    qx//	q:x//
    qw//	q:w//
    qww//	q:ww//
    qt//	q:t//
    q0//	q:0//
    q1//	q:1//	(same as q//)
    q2//	q:2//	(same as qq//)
    qs//	q:s//
    qa//	q:a//
    qh//	q:h//
    qf//	q:f//
    qc//	q:c//
    qb//	q:b//

If this is all too much of a hardship, you can define your own quote
adverbs and operators.  All the uppercase adverbs are reserved for
user-defined quotes.  All of Unicode above Latin-1 is reserved for
user-defined quotes.

=item *

A consequence of the previous item is that we can now say:

    %hash = qw:c/a b c d {@array} {%hash}/;

or

    %hash = qq:w/a b c d {@array} {%hash}/;

to interpolate items into a C<qw>.  Conveniently, arrays and hashes
interpolate with only whitespace separators by default, so the subsequent
split on whitespace still works out.  (But the built-in C<«...»> quoter
automatically does interpolation equivalent to C<qq:ww/.../>.  The
built-in C<< <...> >> is equivalent to C<q:w/.../>.)

=item *

Whitespace is allowed between the "q" and its adverb: C<q :w /.../>.

=item *

For these "q" forms the choice of delimiters has no influence on the
semantics.  That is, C<''>, C<"">, C<< <> >>, C<«»>, C<``>, C<()>,
C<[]>, and C<{}> have no special significance when used in place of
C<//> as delimiters.  There may be whitespace or a colon before the
opening delimiter. (Which is mandatory for parens because C<q()> is
a subroutine call and C<q:w(0)> is an adverb with arguments).  Other
brackets may also require a colon or space when they would be understood as
an argument to an adverb in something like C<< q:z<foo>// >>.
A colon may never be used as the delimiter since it will always be
taken to mean something else regardless of what's in front of it.

=item *

New quoting constructs may be declared as macros:

    macro quote:<qX> (*%adverbs) {...}

Note: macro adverbs are automatically evaluated at macro call
time if the adverbs are included in the parse.  If the adverbs are
to affect the parsing of the quoted text of the macro, then the text must
be parsed by the body of the macro rather than by an C<is parsed> rule.

=item *

You may interpolate double-quotish text into a single-quoted string
using the C<\qq[...]> construct.  Other "q" forms also work, including
user-defined ones, as long as they start with "q".  Otherwise you'll
just have to embed your construct inside a C<\qq[...]>.

=item *

Bare scalar variables always interpolate in double-quotish strings.
Bare array, hash, and subroutine variables may I<never> be interpolated.
However, any sigiled variable may start an interpolation if it is
followed by a sequence of one or more bracketed dereferencers: that
is, any of 1) an array subscript, 2) a hash subscript, 3) a set of
parentheses indicating a function call, 4) any of 1 through 3 in their
"dot" form, or 5) a dot-form method call that includes argument parentheses if
it's the last item in the sequence.

=item *

In order to interpolate an entire array, it's necessary now to subscript
with empty brackets:

    print "The answers are @foo[]\n"

Note that this fixes the spurious "@" problem in double-quoted email addresses.

As with Perl 5 array interpolation, the elements are separated by a space.
(Except that a space is not added if the element already ends in some kind
of whitespace.  In particular, a list of pairs will interpolate with a
tab between the key and value, and a newline after the pair.)

=item *

In order to interpolate an entire hash, it's necessary to subscript
with empty braces or angles:

    print "The associations are:\n%bar{}"
    print "The associations are:\n%bar<>"

Note that this avoids the spurious "%" problem in double-quoted printf formats.

By default, keys and values are separated by tab characters, and pairs
are terminated by newlines.  (This is almost never what you want, but
if you want something polished, you can be more specific.)

=item *

In order to interpolate the result of a sub call, it's necessary to include
both the sigil and parentheses:

    print "The results are &baz().\n"

The function is called in scalar context.  (If it returns a list,
that list is interpolated as if it were an array.)

=item *

In order to interpolate the result of a method call without arguments,
it's necessary to include parentheses:

    print "The attribute is $obj.attr().\n"

The method is called in scalar context.  (If it returns a list,
that list is interpolated as if it were an array.)

It is allowed to have a cascade of argumentless methods as long as
the last one ends with parens:

    print "The attribute is %obj.keys.sort.reverse().\n"

(The cascade is basically counted as a single method call for the
end-bracket rule.)

=item *

Multiple dereferencers may be stacked as long as each one ends in
some kind of bracket:

    print "The attribute is @baz[3](1,2,3){$xyz}<blurfl>.attr().\n"

Note that the final period above is not taken as part of the expression since
it doesn't introduce a bracketed dereferencer.  Spaces are not allowed
between the dereferencers even when you use the dotted forms.

=item *

A bare closure also interpolates in double-quotish context.  It may
not be followed by any dereferencers, since you can always put them
inside the closure.  The expression inside is evaluated in scalar
(string) context.  You can force list context on the expression using
either the C<*> or C<list> operator if necessary.

The following means the same as the previous example.

    print "The attribute is { @baz[3](1,2,3){$xyz}<blurfl>.attr }.\n"

The final parens are unnecessary since we're providing "real" code in
the curlies.  If you need to have double quotes that don't interpolate
curlies, you can explicitly remove the capability:

    qq:c(0) "Here are { $two uninterpolated } curlies";

Alternately, you can build up capabilities from single quote to tell
it exactly what you I<do> want to interpolate:

    q:s 'Here are { $two uninterpolated } curlies';

=item *

Secondary sigils have no influence over whether the primary sigil
interpolates.  That is, if C<$a> interpolates, so do C<$^a>, C<$*a>,
C<$=a>, C<$?a>, C<$.a>, and C<$:a>.  It only depends on the C<$>.

=item *

No other expressions interpolate.  Use curlies.

=item *

The old disambiguation syntax:

    ${foo[$bar]}
    ${foo}[$bar]

is dead.  Use closure curlies instead:

    {$foo[$bar]}
    {$foo}[$bar]

(You may be detecting a trend here...)

=item *

To interpolate a class method, use curlies: C<"{Dog.bark}">.

=item *

To interpolate a topical method, use curlies: C<"{.bark}">.

=item *

To interpolate a function call without a sigil, use curlies: C<"{abs $var}">.

=item *

And so on.

=item *

Backslash sequences still interpolate, but there's no longer any C<\v>
to mean "vertical tab", whatever that is...

=item *

There's also no longer any C<\L>, C<\U>, C<\l>, C<\u>, or C<\Q>.
Use curlies with the appropriate function instead: C<"{ucfirst $word}">.

=item *

There are no barewords in Perl 6.  An undeclared bare identifier will
always be taken to mean a subroutine or method name.  (Class names
are predeclared, or prefixed with the C<::> sigil.)  A consequence of
this is that there's no longer any "C<use strict subs>".  There's also no
"C<use strict refs>" because symbolic dereferences are now syntactically
distinguished from hard dereferences.  C<@{$arrayref}> must now be a
hard reference, while C<@::($string)> is explicitly a symbolic reference.
(Yes, this may give fits to the P5-to-P6 translator, but I think it's
worth it to separate the concepts.  Perhaps the symbolic ref form will
admit hard refs in a pinch.)

=item *

There is no hash subscript autoquoting in Perl 6.  Use C<< %x<foo> >>
for constant hash subscripts, or the old standby C<< %x{'foo'} >>.  (It
also works to say C<%x«foo»> as long as you realized it's subject to
interpolation.)

But C<< => >> still autoquotes any bare identifier to its immediate
left (horizontal whitespace allowed but not comments).  The identifier is not
subject to keyword or even macro interpretation.  If you say

    $x = do {
	call_something();
	if => 1;
    }

then C<$x> ends up containing the pair C<< ("if" => 1) >>.  Always.

You can also use the :key($value) form to quote the keys of option
pairs.  To align values of option pairs, you may use the dot postfix
forms:

    :longkey  .($value)
    :shortkey .<string>
    :fookey   .{ $^a <=> $^b }

=item *

The double-underscore forms are going away:

    Old                 New
    ---                 ---
    __LINE__            $?LINE
    __FILE__            $?FILE
    __PACKAGE__         $?PACKAGE
    __END__             =begin END
    __DATA__            =begin DATA

The C<=begin END> pod stream is special in that it assumes there's
no corresponding C<=end END> before end of file.  The C<DATA>
stream is no longer special--any POD stream in the current file
can be accessed via a filehandle, named as C<< %=POD{'DATA'} >> and such.
Alternately, you can treat a pod stream as a scalar via C<$=DATA>
or as an array via C<@=DATA>.  Presumably a module could read all
its COMMENT blocks from C<@=COMMENT>, for instance.  Each chunk of
pod comes as a separate array element.  You have to split it into lines
yourself.  Each chunk has a C<.linenum> property that indicates its
starting line within the source file.

There is also a new C<$?SUBNAME> variable containing the name of current
lexical sub.  The lexical sub itself is C<&?SUB>.  The current block
is C<&?BLOCK>.  If the block has a label, that shows up in C<$?BLOCKLABEL>.

=item *

Heredocs are no longer written with C<<< << >>>, but with an adverb on
any other quote construct:

    print qq:to/END/
	Give $amount to the man behind curtain number $curtain.
	END

Other adverbs are also allowed:

    print q:c:to/END/
	Give $100 to the man behind curtain number {$curtain}.
	END

=item *

Here docs allow optional whitespace both before and after terminating
delimiter.  Leading whitespace equivalent to the indentation of the
delimiter will be removed from all preceding lines.  If a line is
deemed to have less whitespace than the terminator, only whitespace
is removed, and a warning may be issued.  (Hard tabs will be assumed
to be 8 spaces, but as long as tabs and spaces are used consistently
that doesn't matter.)  A null terminating delimiter terminates on
the next line consisting only of whitespace, but such a terminator
will be assumed to have no indentation.  (That is, it's assumed to
match at the beginning of any whitespace.)

=back

=head1 Context

=over 4

=item *

Perl still has the three main contexts: void, scalar, and list.

=item *

In addition to undifferentiated scalars, we also have these scalar contexts:

    Context	Type	OOtype	Operator
    -------	----	------	--------
    boolean	bit	Bit	?
    integer	int	Int	int
    numeric	num	Num	+
    string	str	Str	~

There are also various reference contexts that require particular kinds of
container references.

=item *

Unlike in Perl 5, references are no longer always considered true.
It depends on the state of their C<.bit> property.  Classes get to decide
which of their values are true and which are false.  Individual objects
can override the class definition:

    return 0 but true;

=back

=head1 Lists

=over 4

=item *

List context in Perl 6 is by default lazy.  This means a list can
contain infinite generators without blowing up.  No flattening happens
to a lazy list until it is bound to the signature of a function or
method at call time (and maybe not even then).  We say that such
an argument list is "lazily flattened", meaning that we promise to
flatten the list on demand, but not before.

=item *

There is a "C<list>" operator which imposes a list context on
its arguments even if C<list> itself occurs in a scalar context.
In list context, it flattens lazily.  In a scalar context, it returns
a reference to the resulting list.  (So the C<list> operator really
does exactly the same thing as putting a list in parentheses.  But
it's more readable in some situations.)

=item *

The C<*> unary operator may be used to force list context on its
argument and I<also> defeat any scalar argument checking imposed by
subroutine signature declarations.  This list flattens lazily.
When applied to a scalar value containing an iterator, C<*> causes
the iterator's return values be interpolated into the list lazily.
Note that C<*> is destructive when applied to a scalar iterator,
but non-destructive when applied to an array, even if that array
represents an iterator.

There is an argumentless form of C<*> which may be used within a
multi-dimensional array or hash subscript to indicate all of the
current set of subscripts available for this dimension.  It actually
returns a class value of C<Any>, so it can be used in any selector
where you would use C<Any>.

=item *

To force non-lazy list flattening, use the C<**> unary operator.
Don't use it on an infinite generator unless you have a machine with
infinite memory, and are willing to wait a long time.  It may also
be applied to a scalar iterator to force immediate iteration to completion.

Argumentless C<**> in a multi-dimensional subscript indicates 0
or more dimensions of C<*> where the number of dimension isn't
necessarily known: C<@foo[1;**;5]>.  It has a value of C<List of Any>,
or something like that.

=item *

Signatures on non-multi subs can be checked at compile time, whereas
multi sub and method call signatures can only be checked at run time
(in the absence of special instructions to the optimizer).
This is not a problem for arguments that are arrays or hashes,
since they don't have to care about their context, but just return
a reference in any event, which may or may not be lazily flattened.
However, function calls in the argument list can't know their eventual
context because the method hasn't been dispatched yet, so we don't
know which signature to check against.  As in Perl 5, list context
is assumed unless you explicitly qualify the argument with a scalar
context operator.

=item *

The C<< => >> operator now constructs C<Pair> objects rather than merely
functioning as a comma.  Both sides are in scalar context.

=item *

There is no such thing as a hash list context.  Assignment to a hash
produces an ordinary list context.  You may assign alternating keys
and values just as in Perl 5.  You may also assign lists of C<Pair> objects, in
which case each pair provides a key and a value.  You may, in fact,
mix the two forms, as long as the pairs come when a key is expected.
If you wish to supply a C<Pair> as a key, you must compose an outer C<Pair>
in which the key is the inner C<Pair>:

    %hash = (($keykey => $keyval) => $value);

=item *

The anonymous C<enum> function takes a list of keys or pairs, and adds
values to any keys that are not already part of a key.  The value added
is one more than the previous key or pair's value.  This works nicely with
the new C<qq:ww> form:

    %hash = enum <<:Mon(1) Tue Wed Thu Fri Sat Sun>>;
    %hash = enum « :Mon(1) Tue Wed Thu Fri Sat Sun »;

are the same as:

    %hash = ();
    %hash<Mon Tue Wed Thu Fri Sat Sun> = 1..7;

=item *

In contrast to assignment, binding to a hash requires a C<Hash> (or
C<Pair>) reference.  Binding to a "splat" hash requires a list of pairs
or hashes, and stops processing the argument list when it runs out
of pairs or hashes.  See S6 for much more about parameter binding.

=back

=head1 Files

=over 4

=item *

Filename globs are no longer done with angle brackets.  Use the C<glob>
function.

=item *

Input from a filehandle is no longer done with angle brackets.  Instead
of

    while (<HANDLE>) {...}

you now write

    for *$handle {...}

As a unary prefix operator, you may also apply adverbs:

    for *$handle :prompt('$ ') { say $_ + 1 }

or

    for *($handle):prompt('$ ') { say $_ + 1 }

or you may even write it in its functional form, passing the adverbs
as ordinary named arguments.

    for prefix:<*>($handle, :prompt('$ ')) { say $_ + 1 }

=back

=head1 Properties

=over 4

=item *

Properties work as detailed in A12.  They're actually object
attributes provided by role mixins.  Compile-time properties applied
to containers and such still use the C<is> keyword, but are now called
"traits".  On the other hand, run-time properties are attached to
individual objects using the C<but> keyword instead, but are still
called "properties".

=item *

Properties are accessed just like attributes because they are in fact
attributes of some class or other, even if it's an anonymous singleton
class generated on the fly for that purpose.  Since "rw" attributes
behave in all respects as variables, properties may therefore also
be temporized with C<temp>, or hypotheticalized with C<let>.

=back