OK, I've been teasing people about this for weeks, and it's time to stop.
This is the current state of the Perl 6 emulator; it applies most things
that Damian talked about in his keynote yesterday, and most of the things
I've picked up in perl6-language. It does:
$a ~ $b for concat
^ $a for negation
$a = @a for automatic reference taking
@a[$elem] / %a{$elem} for element access
$a.foo for method calls
$a.[$elem] / $a.{$elem} for dereference-and-access
Don't ask me about:
$a.$b
Properties (a special case of methods, anyway)
$a[$elem] (it'll probably work, but I haven't tried)
I know how to fix these, I just haven't done it yet.
Get yourself a copy of perl @10021 (Arbitrary number, just what I had around
when I started fiddling) from the snapshot repository,
(ftp://ftp.iki.fi/pub/perl/snap), compile it first so you get a Makefile
to use, apply the patch, run "make run_byacc" assuming you've got Berkeley 1.8
yacc around,[1] and the make miniperl.
miniperl won't compile cleanly because Exporter hasn't been upgraded to
Perl 6 yet, (This needs fixing.) but should still produce the miniperl
executable.
Play with it, get used to it, love it. This is how it's (probably) gonna be. :)
[1] If you haven't, grab http://simon-cozens.org/hacks/perly.c and perly.h
--- ../snap/perl/pp_hot.c Tue May 1 21:43:51 2001
+++ pp_hot.c Wed Jun 6 14:59:50 2001
@@ -756,8 +756,7 @@
}
else {
dTARGET;
- I32 maxarg = AvFILL(av) + 1;
- SETi(maxarg);
+ SETs(newRV_inc((SV*)av));
}
RETURN;
}
@@ -868,13 +867,7 @@
}
else {
dTARGET;
- if (SvTYPE(hv) == SVt_PVAV)
- hv = avhv_keys((AV*)hv);
- if (HvFILL(hv))
- Perl_sv_setpvf(aTHX_ TARG, "%"IVdf"/%"IVdf,
- (IV)HvFILL(hv), (IV)HvMAX(hv) + 1);
- else
- sv_setiv(TARG, 0);
+ sv_setsv(TARG, newRV_inc((SV*)hv));
SETTARG;
RETURN;
--- ../snap/perl/perly.y Mon Mar 19 21:31:58 2001
+++ perly.y Thu Jun 14 22:44:00 2001
@@ -79,7 +79,7 @@
%token <ival> FUNC0 FUNC1 FUNC UNIOP LSTOP
%token <ival> RELOP EQOP MULOP ADDOP
%token <ival> DOLSHARP DO HASHBRACK NOAMP
-%token <ival> LOCAL MY MYSUB
+%token <ival> LOCAL MY MYSUB PROPDOT
%token COLONATTR
%type <ival> prog decl format startsub startanonsub startformsub
@@ -96,6 +96,7 @@
%nonassoc LOOPEX
%left <ival> OROP
+%left PROPDOT
%left ANDOP
%right NOTOP
%nonassoc LSTOP LSTOPSUB
@@ -114,10 +115,10 @@
%left ADDOP
%left MULOP
%left <ival> MATCHOP
-%right '!' '~' UMINUS REFGEN
+%right '!' '^' UMINUS REFGEN
%right <ival> POWOP
%nonassoc PREINC PREDEC POSTINC POSTDEC
-%left ARROW
+%left DEREFDOT
%nonassoc <ival> ')'
%left '('
%left '[' '{'
@@ -407,12 +408,13 @@
| FUNC '(' indirob expr ')'
{ $$ = convert($1, OPf_STACKED,
prepend_elem(OP_LIST, newGVREF($1,$3), $4) ); }
- | term ARROW method '(' listexprcom ')'
+ | term PROPDOT method '(' listexprcom ')'
+ /* Methods (not properties) */
{ $$ = convert(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST,
prepend_elem(OP_LIST, scalar($1), $5),
newUNOP(OP_METHOD, 0, $3))); }
- | term ARROW method
+ | term PROPDOT method
{ $$ = convert(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, scalar($1),
newUNOP(OP_METHOD, 0, $3))); }
@@ -445,8 +447,8 @@
subscripted: star '{' expr ';' '}'
{ $$ = newBINOP(OP_GELEM, 0, $1, scalar($3)); }
| scalar '[' expr ']'
- { $$ = newBINOP(OP_AELEM, 0, oopsAV($1), scalar($3)); }
- | term ARROW '[' expr ']'
+ { $$ = newBINOP(OP_AELEM, 0, ref(newAVREF($1),OP_RV2AV),
+scalar($3)); }
+ | term DEREFDOT '[' expr ']'
{ $$ = newBINOP(OP_AELEM, 0,
ref(newAVREF($1),OP_RV2AV),
scalar($4));}
@@ -455,9 +457,11 @@
ref(newAVREF($1),OP_RV2AV),
scalar($3));}
| scalar '{' expr ';' '}'
- { $$ = newBINOP(OP_HELEM, 0, oopsHV($1), jmaybe($3));
+ { $$ = newBINOP(OP_HELEM, 0,
+ ref(newHVREF($1),OP_RV2HV),
+ jmaybe($3));
PL_expect = XOPERATOR; }
- | term ARROW '{' expr ';' '}'
+ | term DEREFDOT '{' expr ';' '}'
{ $$ = newBINOP(OP_HELEM, 0,
ref(newHVREF($1),OP_RV2HV),
jmaybe($4));
@@ -467,10 +471,10 @@
ref(newHVREF($1),OP_RV2HV),
jmaybe($3));
PL_expect = XOPERATOR; }
- | term ARROW '(' ')'
+ | term DEREFDOT '(' ')'
{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
newCVREF(0, scalar($1))); }
- | term ARROW '(' expr ')'
+ | term DEREFDOT '(' expr ')'
{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, $4,
newCVREF(0, scalar($1)))); }
@@ -505,6 +509,8 @@
{ $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
| term BITOROP term
{ $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
+ | term PROPDOT WORD /* This is properties */
+ { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
| term DOTDOT term
{ $$ = newRANGE($2, scalar($1), scalar($3));}
| term ANDAND term
@@ -515,14 +521,13 @@
{ $$ = newCONDOP(0, $1, $3, $5); }
| term MATCHOP term
{ $$ = bind_match($2, $1, $3); }
-
| '-' term %prec UMINUS
{ $$ = newUNOP(OP_NEGATE, 0, scalar($2)); }
| '+' term %prec UMINUS
{ $$ = $2; }
| '!' term
{ $$ = newUNOP(OP_NOT, 0, scalar($2)); }
- | '~' term
+ | '^' term
{ $$ = newUNOP(OP_COMPLEMENT, 0, scalar($2));}
| REFGEN term
{ $$ = newUNOP(OP_REFGEN, 0, mod($2,OP_REFGEN)); }
@@ -578,6 +583,11 @@
newLISTOP(OP_ASLICE, 0,
list($3),
ref($1, OP_ASLICE))); }
+ | hsh '{' expr ';' '}'
+ { $$ = newBINOP(OP_HELEM, 0,
+ ref(newHVREF($1),OP_RV2HV),
+ jmaybe($3));
+ PL_expect = XOPERATOR; }
| ary '{' expr ';' '}'
{ $$ = prepend_elem(OP_HSLICE,
newOP(OP_PUSHMARK, 0),
--- ../snap/perl/perly.fixer Wed Mar 14 04:41:43 2001
+++ perly.fixer Thu Jun 14 22:44:00 2001
@@ -39,7 +39,7 @@
-e '/^#line /s/"y[.]tab[.]c"/"perly.c"/' \
-e '/\[\] *= *[{]/s/^/static /' \
-e '/^static static/s/^static //' \
- -e '/^#define.WORD/,/^#define.ARROW/d' \
+ -e '/^#define.WORD/,/^#define.DEREFDOT/d' \
-e '/^int.yydebug/,/^#define.yystacksize/d' \
< $output > $tmp && mv -f $tmp $output || exit 1
rm -rf $input
@@ -54,7 +54,7 @@
-e '/^#line /s/"y[.]tab[.]c"/"perly.c"/' \
-e '/\[\] *= *[{]/s/^/static /' \
-e '/^static static/s/^static //' \
- -e '/^#define.WORD/,/^#define.ARROW/d' \
+ -e '/^#define.WORD/,/^#define.DEREFDOT/d' \
-e '/^int.yydebug/,/^#define.yystacksize/d' \
< $output > $tmp && mv -f $tmp $output || exit 1
rm -rf $input
--- ../snap/perl/toke.c Thu May 3 04:41:45 2001
+++ toke.c Thu Jun 14 22:44:00 2001
@@ -1693,7 +1693,7 @@
{
if (PL_lex_brackets)
return TRUE;
- if (*s == '-' && s[1] == '>' && (s[2] == '[' || s[2] == '{'))
+ if (*s == '.')
return TRUE;
if (*s != '{' && *s != '[')
return FALSE;
@@ -2942,18 +2942,6 @@
else
OPERATOR(PREDEC);
}
- else if (*s == '>') {
- s++;
- s = skipspace(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)
Aop(OP_SUBTRACT);
else {
@@ -2962,6 +2950,11 @@
OPERATOR('-'); /* unary minus */
}
+ case '~':
+ /* I wonder what this will break */
+ s++;
+ Aop(OP_CONCAT);
+
case '+':
tmp = *s++;
if (*s == tmp) {
@@ -3010,13 +3003,10 @@
PL_pending_ident = '%';
TERM('%');
- case '^':
- s++;
- BOop(OP_BIT_XOR);
case '[':
PL_lex_brackets++;
/* FALL THROUGH */
- case '~':
+ case '^':
case ',':
tmp = *s++;
OPERATOR(tmp);
@@ -3519,43 +3509,6 @@
if (PL_lex_state == LEX_NORMAL)
s = skipspace(s);
- if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) {
- char *t;
- if (*s == '[') {
- PL_tokenbuf[0] = '@';
- if (ckWARN(WARN_SYNTAX)) {
- for(t = s + 1;
- isSPACE(*t) || isALNUM_lazy_if(t,UTF) || *t == '$';
- t++) ;
- if (*t++ == ',') {
- PL_bufptr = skipspace(PL_bufptr);
- while (t < PL_bufend && *t != ']')
- t++;
- Perl_warner(aTHX_ WARN_SYNTAX,
- "Multidimensional syntax %.*s not supported",
- (t - PL_bufptr) + 1, PL_bufptr);
- }
- }
- }
- else if (*s == '{') {
- PL_tokenbuf[0] = '%';
- if (ckWARN(WARN_SYNTAX) && strEQ(PL_tokenbuf+1, "SIG") &&
- (t = strchr(s, '}')) && (t = strchr(t, '=')))
- {
- char tmpbuf[sizeof PL_tokenbuf];
- STRLEN len;
- for (t++; isSPACE(*t); t++) ;
- if (isIDFIRST_lazy_if(t,UTF)) {
- t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len);
- for (; isSPACE(*t); t++) ;
- if (*t == ';' && get_cv(tmpbuf, FALSE))
- Perl_warner(aTHX_ WARN_SYNTAX,
- "You need to quote \"%s\"", tmpbuf);
- }
- }
- }
- }
-
PL_expect = XOPERATOR;
if (PL_lex_state == LEX_NORMAL && isSPACE((char)tmp)) {
bool islop = (PL_last_lop == PL_oldoldbufptr);
@@ -3616,24 +3569,9 @@
if (PL_lex_state == LEX_NORMAL)
s = skipspace(s);
if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) {
- if (*s == '{')
- PL_tokenbuf[0] = '%';
+ /* if (*s == '{')
+ PL_tokenbuf[0] = '%'; */
- /* Warn about @ where they meant $. */
- if (ckWARN(WARN_SYNTAX)) {
- if (*s == '[' || *s == '{') {
- char *t = s + 1;
- while (*t && (isALNUM_lazy_if(t,UTF) || strchr(" \t$#+-'\"", *t)))
- t++;
- if (*t == '}' || *t == ']') {
- t++;
- PL_bufptr = skipspace(PL_bufptr);
- Perl_warner(aTHX_ WARN_SYNTAX,
- "Scalar value %.*s better written as $%.*s",
- t-PL_bufptr, PL_bufptr, t-PL_bufptr-1, PL_bufptr+1);
- }
- }
- }
}
PL_pending_ident = '@';
TERM('@');
@@ -3656,6 +3594,12 @@
OPERATOR(tmp);
case '.':
+ /* First stab at %hash.{elem} -> %hash{elem} support */
+ /* Should probably return specific "dereference", "property" and "element"
+toketypes */
+ if (s[1] == '{' || s[1] == '[') {
+ s++;
+ goto retry;
+ }
if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack
#ifdef PERL_STRICT_CR
&& s[1] == '\n'
@@ -3670,20 +3614,30 @@
}
if (PL_expect == XOPERATOR || !isDIGIT(s[1])) {
tmp = *s++;
- if (*s == tmp) {
+ if (*s == '.') {
s++;
- if (*s == tmp) {
+ if (*s == '.') {
s++;
yylval.ival = OPf_SPECIAL;
}
else
yylval.ival = 0;
OPERATOR(DOTDOT);
- }
+ } else if (*s == '{' || *s == '[' || *s == '(')
+ OPERATOR(DEREFDOT);
if (PL_expect != XOPERATOR)
check_uni();
- Aop(OP_CONCAT);
}
+ s = skipspace(s);
+ /* Fixme: Must distinguish between methods and props here (how?) */
+ if (isIDFIRST_lazy_if(s,UTF)) {
+ s = force_word(s,METHOD,FALSE,TRUE,FALSE);
+ TOKEN(PROPDOT);
+ }
+ /* Fixme: Support for $a.$b needs to be here */
+ /* Temporarily : */
+ TOKEN(PROPDOT);
+ Perl_croak(aTHX_ "Panic: problems with .");
/* FALL THROUGH */
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
--- ../snap/perl/patchlevel.h Mon May 7 22:23:27 2001
+++ patchlevel.h Wed Jun 6 14:33:42 2001
@@ -3,9 +3,9 @@
/* do not adjust the whitespace! Configure expects the numbers to be
* exactly on the third column */
-#define PERL_REVISION 5 /* age */
-#define PERL_VERSION 7 /* epoch */
-#define PERL_SUBVERSION 1 /* generation */
+#define PERL_REVISION 6 /* age */
+#define PERL_VERSION 0 /* epoch */
+#define PERL_SUBVERSION 0 /* generation */
/* The following numbers describe the earliest compatible version of
Perl ("compatibility" here being defined as sufficient binary/API
@@ -20,8 +20,8 @@
PERL_INC_VERSION_LIST, which lists version libraries
to include in @INC. See INSTALL for how this works.
*/
-#define PERL_API_REVISION 5 /* Adjust manually as needed. */
-#define PERL_API_VERSION 5 /* Adjust manually as needed. */
+#define PERL_API_REVISION 6 /* Adjust manually as needed. */
+#define PERL_API_VERSION 0 /* Adjust manually as needed. */
#define PERL_API_SUBVERSION 0 /* Adjust manually as needed. */
/*
XXX Note: The selection of non-default Configure options, such
@@ -70,7 +70,7 @@
#if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT)
static char *local_patches[] = {
NULL
- ,"DEVEL10021"
+ ,"MOCK"
,NULL
};
--
\let\l\let\l\d\def\l\a\active\l~\catcode~`?\a~`;\a\d;{~`};!\a\d!{?;~}\l?\the;#
!;]!\l]\l;\.!;,!;\%!;=!]=\d],\expandafter;[!][{=%{\message[};\$!=${\uccode`'.
\uppercase{,=,%,{%'}}};*!=*{\advance.by}]#\number;/!=/{*-1}\newcount.=\-{*-};-
!]-\-;^!=^{*1};\ != {.`\ $};@!=@{,.,"#`@^$}.`#*`'$.!0-!$//$^$ .``^$*!$^$.!0-!/
$!-!^$@*!$ *!*!*!*!$@-!$ .!0-!-!$.``^$^^$.`<-!*`<$@*!$%}\batchmode
