# New Ticket Created by Steve Fink
# Please include the string: [perl #18856]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=18856 >
Here's a patch with a few minor fixes and one new feature. It requires
some discussion (or, more likely, a decision by Leo.) I did not
include the autogenerated files since I expect Leo will modify this
patch.
- The .local directive requires a type. I fixed the documentation.
- The lexer allows an optional dot in front of a parrot op or
identifier, but then seems to assume that the dot is not there. So I
took it off.
- A few trivial things: parenthesized a macro arg for safety, fixed a
typo, added a missing va_end.
- Implemented one idea of namespaces.
The last item is the significant bit. There was an unimplemented
....namespace directive in IMCC that I needed for some regex stuff I'm
working on, but I couldn't tell what the exact intention was behind
it. So I implemented something that gave me what I needed. It may be
totally wrong from other people's perspectives, so let me first
describe what I need:
I want an inline regex like
if (/a/) ...
to be exactly that: inline. So instead of making every regex into its
own sub, I want that to just immediately look for an 'a' in the
current topic.
In order to do this, and also have a self-contained regex compiler, I
need a separate namespace for all the variables I use. (Okay, so I
don't actually "need" any of this -- I could just use numbered
registers that IMCC would assign to actual registers for me, like $P42
and $I43. But 'rx_pos' looks much nicer to me than $I3112.)
One way to provide a separate namespace would be for me to prefix my
own mangled identifier, like "regex14_rx_pos". But I'd prefer
something like:
# ...(preceding code)...
# .namespace __regex14__
# .local int rx_pos
# ...(compiled regex code)...
# .endnamespace __regex14__
so that I can just use 'rx_pos' within my (possibly nested) namespace.
So that's what this patch implements. A .local <type> <varname>
directive now creates a variable named <current-namespace>::<varname>
(or just <varname> at the top level), and any identifier to be looked
up is searched for in all enclosing namespaces. So 'set rx_pos, 0'
within the namespace 'outer' within the namespace 'inner' would look
for:
1. outer::inner::rx_pos
2. outer::rx_pos
3. rx_pos
The implementation isn't beautiful, but I wasn't sure if people would
like these semantics anyway.
-- attachment 1 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/43866/34880/e45fc8/namespace.patch
Index: README
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/README,v
retrieving revision 1.10
diff -u -r1.10 README
--- README 3 Dec 2002 14:35:29 -0000 1.10
+++ README 4 Dec 2002 04:21:38 -0000
@@ -90,8 +90,8 @@
You may also define lexicals with the .local directive below
and use them by name.
- .local i
- .local j
+ .local int i
+ .local int j
i = 4
j = i * i
@@ -125,7 +125,7 @@
.end
- .local <IDENTIFIER>
+ .local <type> <IDENTIFIER>
.arg <lval>
Index: imcc.l
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/imcc.l,v
retrieving revision 1.16
diff -u -r1.16 imcc.l
--- imcc.l 3 Dec 2002 14:35:29 -0000 1.16
+++ imcc.l 4 Dec 2002 04:21:38 -0000
@@ -92,6 +92,7 @@
".class" return(CLASS);
".endclass" return(ENDCLASS);
".namespace" return(NAMESPACE);
+".endnamespace" return(ENDNAMESPACE);
".local" return(LOCAL);
".param" return(PARAM);
"end" return(END);
@@ -139,16 +140,17 @@
return(MACRO);
}
<INITIAL>{DOT}?{LETTER}{LETTERDIGIT}* {
- SymReg *r = get_sym(yytext);
+ char * ident = (yytext[0] == '.') ? yytext+1 : yytext;
+ SymReg *r = find_sym(ident);
if (r && r->type & VTIDENTIFIER) {
yylval.sr = r;
return VAR;
}
- yylval.s = str_dup(yytext);
+ yylval.s = str_dup(ident);
return(is_op(yylval.s) ? PARROT_OP : IDENTIFIER);
}
<emit,INITIAL>{LETTER}{LETTERDIGIT}* {
- SymReg *r = get_sym(yytext);
+ SymReg *r = find_sym(yytext);
if (r && r->type & VTIDENTIFIER) {
yylval.sr = r;
return VAR;
Index: imcc.y
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/imcc.y,v
retrieving revision 1.29
diff -u -r1.29 imcc.y
--- imcc.y 3 Dec 2002 15:54:20 -0000 1.29
+++ imcc.y 4 Dec 2002 04:21:38 -0000
@@ -41,7 +41,7 @@
static int nargs = 0;
static SymReg *keys[IMCC_MAX_REGS];
static int nkeys = 0;
-#define KEY_BIT(argnum) (1 << argnum)
+#define KEY_BIT(argnum) (1 << (argnum))
static SymReg ** RR(int n, ...)
{
@@ -52,6 +52,7 @@
while (n--) {
regs[i++] = va_arg(ap, SymReg *);
}
+ va_end(ap);
while (i < IMCC_MAX_REGS)
regs[i++] = 0;
return regs;
@@ -425,7 +426,7 @@
ins->type |= ITALIAS;
}
else if (!strcmp(name, "set_addr")) {
- /* XXX propably a CATCH block */
+ /* XXX probably a CATCH block */
ins->type = ITADDR | IF_r1_branch | ITBRANCH;
}
} else {
@@ -445,7 +446,8 @@
}
%token <t> CALL GOTO ARG PRINT IF UNLESS NEW END SAVEALL RESTOREALL
-%token <t> SUB NAMESPACE CLASS ENDCLASS SYM LOCAL PARAM INC DEC
+%token <t> SUB NAMESPACE ENDNAMESPACE CLASS ENDCLASS SYM LOCAL PARAM
+%token <t> INC DEC
%token <t> SHIFT_LEFT SHIFT_RIGHT INTV FLOATV STRINGV DEFINED LOG_XOR
%token <t> RELOP_EQ RELOP_NE RELOP_GT RELOP_GTE RELOP_LT RELOP_LTE
%token <t> GLOBAL ADDR CLONE RESULT RETURN POW SHIFT_RIGHT_U LOG_AND LOG_OR
@@ -550,6 +552,8 @@
assignment
| if_statement
| SYM type IDENTIFIER { mk_ident($3, $2); }
+ | NAMESPACE IDENTIFIER { push_namespace($2); }
+ | ENDNAMESPACE IDENTIFIER { pop_namespace($2); }
| LOCAL type IDENTIFIER { mk_ident($3, $2); }
| LOCAL type VAR { $$ = 0;
warning("parser", "file %s line %d: %s already defined\n",
Index: symreg.c
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/symreg.c,v
retrieving revision 1.6
diff -u -r1.6 symreg.c
--- symreg.c 25 Sep 2002 22:50:57 -0000 1.6
+++ symreg.c 4 Dec 2002 04:21:41 -0000
@@ -7,6 +7,59 @@
/* Globals: */
/* Code: */
+static void delete_sym(const char * name);
+
+/* namespaces */
+
+typedef struct ident_t Identifier;
+struct ident_t {
+ char * name;
+ Identifier * next;
+};
+
+typedef struct namespace_t Namespace;
+struct namespace_t {
+ Namespace * parent;
+ char * name;
+ Identifier * idents;
+};
+
+static Namespace * namespace = NULL;
+
+void push_namespace(char * name) {
+ Namespace * ns = (Namespace *) malloc(sizeof(*ns));
+ ns->parent = namespace;
+ ns->name = name;
+ ns->idents = NULL;
+ namespace = ns;
+}
+
+void pop_namespace(char * name) {
+ Namespace * ns = namespace;
+ if (ns == NULL) {
+ fprintf(stderr, "pop() on empty namespace stack\n");
+ abort();
+ }
+
+ if (name && strcmp(name, ns->name) != 0) {
+ fprintf(stderr, "tried to pop namespace(%s), "
+ "but top of stack is namespace(%s)\n", name, ns->name);
+ abort();
+ }
+
+ while (ns->idents) {
+ Identifier * ident = ns->idents;
+ delete_sym(ident->name);
+ ns->idents = ident->next;
+ free(ident);
+ }
+
+ namespace = ns->parent;
+ free(ns);
+}
+
+/* symbolic registers */
+
/* Makes a new SymReg from its varname and type */
SymReg * _mk_symreg(SymReg*hash[],char * name, char t) {
SymReg * r;
@@ -45,10 +98,21 @@
name, r->set, r->color, r->type);
return r;
}
+
+static char * _mk_fullname(Namespace * ns, const char * name) {
+ char * result;
+ if (ns == NULL) return strdup(name);
+ result = (char *) malloc(strlen(name) + strlen(ns->name) + 3);
+ sprintf(result, "%s::%s", ns->name, name);
+ return result;
+}
+
/* Makes a new identifier */
SymReg * mk_ident(char * name, char t) {
- SymReg * r = mk_symreg(name, t);
+ char * fullname = _mk_fullname(namespace, name);
+ SymReg * r = mk_symreg(fullname, t);
r->type = VTIDENTIFIER;
+ if (fullname != name) free(name);
return r;
}
@@ -229,15 +293,50 @@
}
return 0;
}
-
SymReg * get_sym(const char * name) {
return _get_sym(hash, name);
}
+SymReg * _find_sym(Namespace * namespace, SymReg * hash[], const char * name) {
+ Namespace * ns;
+
+ for (ns = namespace; ns; ns = ns->parent) {
+ char * fullname = _mk_fullname(ns, name);
+ SymReg * p = _get_sym(hash, fullname);
+ free(fullname);
+ if (p) return p;
+ }
+
+ return _get_sym(hash, name);
+}
+SymReg * find_sym(const char * name) {
+ return _find_sym(namespace, hash, name);
+}
+
+static void _delete_sym(SymReg * hash[], const char * name) {
+ SymReg ** p;
+ int index = hash_str(name) % HASH_SIZE;
+ for(p = &hash[index]; *p; p = &(*p)->next) {
+ SymReg * deadmeat = *p;
+ if(!strcmp(name, deadmeat->name)) {
+ *p = deadmeat->next;
+ free_sym(deadmeat);
+ return;
+ }
+ }
+
+ fprintf(stderr, "Tried to delete nonexistent symbol '%s'\n", name);
+ abort();
+}
+static void delete_sym(const char * name) {
+ return _delete_sym(hash, name);
+}
+
/* Deletes all symbols */
void clear_tables() {
int i;
SymReg * p, *next;
+ while (namespace) pop_namespace(NULL);
for(i = 0; i < HASH_SIZE; i++) {
for(p = hash[i]; p; ) {
next = p->next;
@@ -247,7 +346,6 @@
hash[i] = NULL;
}
}
-
/* utility functions: */
Index: symreg.h
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/symreg.h,v
retrieving revision 1.6
diff -u -r1.6 symreg.h
--- symreg.h 25 Sep 2002 22:50:57 -0000 1.6
+++ symreg.h 4 Dec 2002 04:21:41 -0000
@@ -76,16 +76,20 @@
void free_sym(SymReg *r);
void store_symreg(SymReg * r);
+SymReg * find_sym(const char * name);
SymReg * get_sym(const char * name);
SymReg * _get_sym(SymReg * hash[], const char * name);
SymReg * _mk_symreg(SymReg* hash[],char * name, char t);
SymReg * _mk_const(SymReg *hash[], char * name, char t);
-SymReg * _mk_address(SymReg *hash[], char * name, int uniq);
void _store_symreg(SymReg *hash[], SymReg * r);
+SymReg * _mk_address(SymReg *hash[], char * name, int uniq);
SymReg * link_keys(int nargs, SymReg *keys[]);
void clear_tables();
unsigned int hash_str(const char * str);
void free_life_info(SymReg *r);
+
+void push_namespace(char * name);
+void pop_namespace(char * name);
/* globals */
