Author: kjs
Date: Wed Apr 11 11:46:56 2007
New Revision: 18142
Modified:
trunk/compilers/pirc/src/pirlexer.c
trunk/compilers/pirc/src/pirlexer.h
trunk/compilers/pirc/src/pirparser.c
trunk/compilers/pirc/src/pirutil.c
trunk/compilers/pirc/src/pirutil.h
Log:
compilers/pirc:
* fix lexer in some places
* fix parser in some places (need some refactoring and clean ups)
* add list of parrot ops from languages/PIR, so now we can parse ops!!
Modified: trunk/compilers/pirc/src/pirlexer.c
==============================================================================
--- trunk/compilers/pirc/src/pirlexer.c (original)
+++ trunk/compilers/pirc/src/pirlexer.c Wed Apr 11 11:46:56 2007
@@ -106,6 +106,15 @@
:unique_reg
+=head1 STRING ENCODINGS
+
+The following are string encoding specifiers:
+
+ ascii:
+ binary:
+ iso-8859-1:
+ unicode:
+
=cut
@@ -257,6 +266,10 @@
"heredoc id", /* T_HEREDOC_ID, */
"heredoc string", /* T_HEREDOC_STRING, */
"parrot op", /* T_PARROT_OP */
+ "unicode:", /* T_UNICODE */
+ "ascii:", /* T_ASCII */
+ "binary:", /* T_BINARY */
+ "iso-8859-1:", /* T_ISO_8859_1 */
NULL /* */
};
@@ -682,26 +695,6 @@
}
-/*
-
-=item is_op()
-
-TODO: check whether 'word' is an op. How does IMCC handle this?
-Is there an API call that checks for this?
-
-Function to check if the specified id is a Parrot op.
-Dynamically loaded op libraries need to be considered as well.
-
-=cut
-
-*/
-static int
-is_op(char *word) {
- if (strcmp(word, "add") == 0) return 1; /* hardcoded some, to give an idea
*/
- if (strcmp(word, "print") == 0) return 1;
- if (strcmp(word, "new") == 0) return 1;
- return 0;
-}
/*
@@ -812,6 +805,35 @@
}
+/*
+
+=item read_string()
+
+Read a quoted string.
+
+=cut
+
+*/
+static token
+read_string(lexer_state *lexer, char delimiter) {
+ char c;
+ buffer_char(lexer, delimiter); /* buffer first delimiter */
+ do {
+ c = read_char(lexer->curfile);
+ if (c == '\n') {
+ fprintf(stderr, "Possibly a run-away string on line %ld\n",
lexer->curfile->line);
+ buffer_char(lexer, delimiter); /* try to fix it */
+ update_line(lexer);
+ return T_ERROR;
+ }
+ if (c == EOF_MARKER) return T_EOF;
+ buffer_char(lexer, c);
+ }
+ while (c != delimiter);
+
+ return T_STRING_CONSTANT;
+}
+
/*
@@ -1117,9 +1139,9 @@
if (c == 'P' || c == 'I' || c == 'N' || c == 'S') {
int count;
char regtype = c; /* store register type for later */
- buffer_char(lexer, c);
- count = read_digits(lexer);
- c = read_char(lexer->curfile);
+ buffer_char(lexer, c); /* store current char. */
+ count = read_digits(lexer); /* read digits and count how many
*/
+ c = read_char(lexer->curfile); /* the last one was not a
digit, re-read it */
/* only if the current char is not an alpha and we just read a
number of digits,
* can this be a pasm register. */
@@ -1150,8 +1172,17 @@
/* we got some kind of an identifier, maybe it's a label,
invocant, etc */
if (c == ':') { /* label -> IDENT':' */
+ token tmp;
buffer_char(lexer, c);
- return T_LABEL;
+
+ /* it might be a string encoding specifier */
+ tmp = check_dictionary(lexer, dictionary);
+
+ if (tmp == T_NOT_FOUND) return T_LABEL;
+ else {
+ c = read_char(lexer->curfile); /* this should be a quote
char. */
+ return read_string(lexer, c);
+ }
}
else if (c == '.') { /* invocant_id -> IDENT'.' */
return T_INVOCANT_IDENT;
@@ -1256,7 +1287,7 @@
c = read_char(lexer->curfile);
if (c == EOF_MARKER) return T_EOF;
- while (isalnum(c)) { /* this is all part of the label name
*/
+ while (isalnum(c) || c == '_') { /* this is all part of
the label name */
buffer_char(lexer, c);
c = read_char(lexer->curfile);
if (c == EOF_MARKER) return T_EOF;
@@ -1266,8 +1297,9 @@
if (c == ':') {
return T_MACRO_LABEL;
}
- else { /* $ ??? */
+ else { /* $ ??? unexpected, put it back */
unread_char(lexer->curfile);
+ fprintf(stderr, "Unknown token starting with '$'\n");
return T_ERROR;
}
}
@@ -1275,11 +1307,24 @@
buffer_char(lexer, c);
numdigits = read_digits(lexer);
+
+ /* read next char, maybe a dot? */
+ c = read_char(lexer->curfile);
+
if (numdigits == 0) {
+ unread_char(lexer->curfile);
fprintf(stderr, "digits expected (line %d)\n",
lexer->curfile->line);
return T_ERROR;
}
- return regtype; /* return register */
+
+ if (c == '.') { /* $P0. and friends */
+ buffer_char(lexer, c);
+ return T_INVOCANT_IDENT;
+ }
+ else { /* just a simple pir reg $P0 */
+ unread_char(lexer->curfile);
+ return regtype; /* return register */
+ }
}
@@ -1398,8 +1443,26 @@
case '=': return T_MINUS_ASSIGN; /* -= */
case EOF_MARKER: return T_EOF;
default:
- unread_char(lexer->curfile);
- return T_MINUS;
+
+ /* TODO: refactor this number reading code, it's also
somewhere else */
+
+ if (isdigit(c)) { /* handle negative numbers here */
+ int count = read_digits(lexer);
+ c = read_char(lexer->curfile);
+ if (c == '.') {
+ buffer_char(lexer, c);
+ read_digits(lexer);
+ return T_NUMBER_CONSTANT;
+ }
+ else {
+ unread_char(lexer->curfile);
+ return T_INTEGER_CONSTANT;
+ }
+ }
+ else { /* no negative number, just a minus sign */
+ unread_char(lexer->curfile);
+ return T_MINUS;
+ }
}
}
else if (c == '!') {
@@ -1526,7 +1589,6 @@
if (c == '\n') update_line(lexer);
else if (c == EOF_MARKER) return T_EOF;
}
- /* while ( c == ' ' || c == '\t' || c == '\n' || c == '\r'); */
while (isspace(c));
/* the last read char. was not space/newline, put it back */
@@ -1535,38 +1597,10 @@
return T_NEWLINE;
}
else if (c == '"') {
- buffer_char(lexer, c);
- do {
- c = read_char(lexer->curfile);
- if (c == '\n') {
- fprintf(stderr, "Possibly a run-away string on line
%ld\n", lexer->curfile->line);
- buffer_char(lexer, '"'); /* try to fix it */
- update_line(lexer);
- return T_ERROR;
- }
- if (c == EOF_MARKER) return T_EOF;
- buffer_char(lexer, c);
- }
- while (c != '"');
-
- return T_STRING_CONSTANT;
+ return read_string(lexer, c);
}
else if (c == '\'') {
- buffer_char(lexer, c);
- do {
- c = read_char(lexer->curfile);
- if (c == '\n') {
- fprintf(stderr, "Possibly a run-away string on line
%ld\n", lexer->curfile->line);
- buffer_char(lexer, '"'); /* try to fix it */
- update_line(lexer);
- return T_ERROR;
- }
- if (c == EOF_MARKER) return T_EOF;
- buffer_char(lexer, c);
- }
- while (c != '\'');
-
- return T_STRING_CONSTANT;
+ return read_string(lexer, c);
}
else if (c == ':') { /* read flags */
token tmp;
@@ -1576,13 +1610,16 @@
c = read_char(lexer->curfile);
if (c == EOF_MARKER) return T_EOF;
}
- while ( isalnum(c) );
+ while ( isalnum(c) || c == '_' );
unread_char(lexer->curfile); /* push back last character not
needed */
tmp = check_dictionary(lexer, dictionary);
/* if not found, then no valid flag found */
- if (tmp == T_NOT_FOUND) return T_ERROR;
+ if (tmp == T_NOT_FOUND) {
+ fprintf(stderr, "invalid flag: '%s'\n", lexer->token_chars);
+ return T_ERROR;
+ }
else return tmp;
}
else if (c == 0) { /* this is necessary since svn properties on input
files */
Modified: trunk/compilers/pirc/src/pirlexer.h
==============================================================================
--- trunk/compilers/pirc/src/pirlexer.h (original)
+++ trunk/compilers/pirc/src/pirlexer.h Wed Apr 11 11:46:56 2007
@@ -141,8 +141,12 @@
T_LSHIFT_ASSIGN, /* "<<=", */
T_HEREDOC_ID, /* "heredoc id", */
T_HEREDOC_STRING, /* "heredoc string", */
- T_PARROT_OP /* "parrot op", */
- /* NULL */
+ T_PARROT_OP, /* "parrot op", */
+ T_UNICODE, /* "unicode:", */
+ T_ASCII, /* "ascii:",
*/
+ T_BINARY, /* "binary:",
*/
+ T_ISO_8859_1 /*
"iso-8859-1:" */
+ /* NULL */
} token;
/* Make sure MAX_TOKEN is the last enum value from enum token {} */
Modified: trunk/compilers/pirc/src/pirparser.c
==============================================================================
--- trunk/compilers/pirc/src/pirparser.c (original)
+++ trunk/compilers/pirc/src/pirparser.c Wed Apr 11 11:46:56 2007
@@ -545,6 +545,64 @@
match(p, T_RBRACKET); /* match closing ']' */
}
+
+
+/*
+
+=item *
+
+ arg_flags -> { arg_flag }
+
+ arg_flag -> ':flat' | ':named' [ '(' STRINGC ')' ]
+
+=cut
+
+*/
+static void
+arg_flags(parser_state *p) {
+ while (p->curtoken != T_NEWLINE) {
+ switch (p->curtoken) {
+ case T_FLAT_FLAG:
+ next(p);
+ break;
+ case T_NAMED_FLAG:
+ next(p);
+ if (p->curtoken == T_LPAREN) {
+ next(p);
+ match(p, T_STRING_CONSTANT);
+ match(p, T_RPAREN);
+ }
+ break;
+ default:
+ syntax_error(p, 1, "':flat' or ':named' flag expected");
+ break;
+ }
+ }
+}
+
+static void
+inline_arg_flags(parser_state *p) {
+ int ok = 1;
+ while (ok) {
+ switch (p->curtoken) {
+ case T_FLAT_FLAG:
+ next(p);
+ break;
+ case T_NAMED_FLAG:
+ next(p);
+ if (p->curtoken == T_LPAREN) {
+ next(p);
+ match(p, T_STRING_CONSTANT);
+ match(p, T_RPAREN);
+ }
+ break;
+ default:
+ ok = 0; /* quit loop */
+ break;
+ }
+ }
+}
+
/*
=item *
@@ -575,6 +633,12 @@
next(p);
expression(p);
}
+ else {
+ inline_arg_flags(p);
+ }
+ }
+ else {
+ inline_arg_flags(p);
}
}
}
@@ -735,11 +799,20 @@
* instruction and wait for run-time error?
*/
while (p->curtoken != T_NEWLINE) {
+
+ /* XXX for now, just skip ANYTHING until a newline. This is so we can
handle
+ * "delete obj[bla] etc.
+ */
+ next(p);
+
+ /*
expression(p);
+
if (p->curtoken == T_COMMA) {
next(p);
}
else break;
+ */
}
emit_op_end(p);
@@ -1220,41 +1293,6 @@
}
-
-
-/*
-
-=item *
-
- arg_flags -> { arg_flag }
-
- arg_flag -> ':flat' | ':named' [ '(' STRINGC ')' ]
-
-=cut
-
-*/
-static void
-arg_flags(parser_state *p) {
- while (p->curtoken != T_NEWLINE) {
- switch (p->curtoken) {
- case T_FLAT_FLAG:
- next(p);
- break;
- case T_NAMED_FLAG:
- next(p);
- if (p->curtoken == T_LPAREN) {
- next(p);
- match(p, T_STRING_CONSTANT);
- match(p, T_RPAREN);
- }
- break;
- default:
- syntax_error(p, 1, "':flat' or ':named' flag expected");
- break;
- }
- }
-}
-
/*
=item *
Modified: trunk/compilers/pirc/src/pirutil.c
==============================================================================
--- trunk/compilers/pirc/src/pirutil.c (original)
+++ trunk/compilers/pirc/src/pirutil.c Wed Apr 11 11:46:56 2007
@@ -76,6 +76,361 @@
}
+
+
+
+
+
+
+static char const *parrot_ops[] = {
+ "yield",
+ "xor",
+ "warningson",
+ "warningsoff",
+ "valid_type",
+ "upcase",
+ "unshift",
+ "unregister",
+ "unpin",
+ "unless_null",
+ "unless",
+ "typeof",
+ "trans_encoding",
+ "trans_charset",
+ "trace",
+ "titlecase",
+ "time",
+ "throw",
+ "thaw",
+ "tell",
+ "tanh",
+ "tan",
+ "tailcallmethod",
+ "tailcall",
+ "sysinfo",
+ "sweepon",
+ "sweepoff",
+ "sweep",
+ "substr",
+ "subclass",
+ "sub",
+ "stringinfo",
+ "store_lex",
+ "stat",
+ "sqrt",
+ "sprintf",
+ "split",
+ "spawnw",
+ "socket",
+ "sockaddr",
+ "sleep",
+ "sizeof",
+ "sinh",
+ "singleton",
+ "sin",
+ "shr",
+ "shl",
+ "shift",
+ "setstdout",
+ "setstderr",
+ "sets_ind",
+ "setref",
+ "setprop",
+ "setp_ind",
+ "setn_ind",
+ "seti_ind",
+ "setattribute",
+ "set_root_global",
+ "set_returns",
+ "set_hll_global",
+ "set_global",
+ "set_args",
+ "set_addr",
+ "set",
+ "send",
+ "seek",
+ "sech",
+ "sec",
+ "savec",
+ "saveall",
+ "save",
+ "runinterp",
+ "rotate_up",
+ "rot",
+ "returncc",
+ "rethrow",
+ "ret",
+ "result_info",
+ "restoreall",
+ "restore",
+ "reserved",
+ "repeat",
+ "removeparent",
+ "removedoes",
+ "removeattribute",
+ "register",
+ "recv",
+ "readline",
+ "read",
+ "pushmark",
+ "pushaction",
+ "push_eh",
+ "push",
+ "prophash",
+ "profile",
+ "printerr",
+ "print",
+ "pow",
+ "popmark",
+ "pop",
+ "poll",
+ "pioctl",
+ "pin",
+ "peek",
+ "ord"
+ "or",
+ "open",
+ "null",
+ "not",
+ "noop",
+ "newclosure",
+ "newclass",
+ "new_callback",
+ "new",
+ "new",
+ "neg",
+ "needs_destroy",
+ "ne_str",
+ "ne_num",
+ "ne_addr",
+ "ne",
+ "n_repeat",
+ "n_not",
+ "n_neg",
+ "n_infix",
+ "n_concat",
+ "n_bnots"
+ "n_bnot"
+ "n_abs",
+ "mul",
+ "mod",
+ "mmdvtregister",
+ "mmdvtfind",
+ "lt_str",
+ "lt_num",
+ "lt_addr",
+ "lt",
+ "lsr",
+ "lookback",
+ "log2",
+ "log10",
+ "localtime",
+ "loadlib",
+ "load_bytecode",
+ "ln",
+ "listen",
+ "length",
+ "le_str",
+ "le_num",
+ "le_addr",
+ "le",
+ "lcm",
+ "jsr",
+ "join",
+ "istrue",
+ "issame",
+ "isnull",
+ "isntsame",
+ "isne",
+ "islt",
+ "isle",
+ "isgt",
+ "isge",
+ "isfalse",
+ "iseq",
+ "isa",
+ "is_cclass",
+ "invokecc",
+ "invoke",
+ "interpinfo",
+ "infix",
+ "index",
+ "inc",
+ "if_null",
+ "if",
+ "hash",
+ "gt_str",
+ "gt_num",
+ "gt_addr",
+ "gt",
+ "gmtime",
+ "getstdout",
+ "getstdin",
+ "getstderr",
+ "getprop",
+ "getline",
+ "getinterp",
+ "getfile",
+ "getfd",
+ "getclass",
+ "getattribute",
+ "get_root_namespace",
+ "get_root_global",
+ "get_results",
+ "get_repr",
+ "get_params",
+ "get_namespace",
+ "get_mro",
+ "get_hll_namespace",
+ "get_hll_global",
+ "get_global",
+ "get_addr",
+ "ge_str",
+ "ge_num",
+ "ge_addr",
+ "ge",
+ "gcd",
+ "gc_debug",
+ "freeze",
+ "floor",
+ "find_type",
+ "find_not_cclass",
+ "find_name",
+ "find_method",
+ "find_lex",
+ "find_encoding",
+ "find_charset",
+ "find_cclass",
+ "fdopen",
+ "fdiv",
+ "fact",
+ "exp",
+ "exit",
+ "exists",
+ "exchange",
+ "escape",
+ "errorson",
+ "errorsoff",
+ "err",
+ "eq_str",
+ "eq_num",
+ "eq_addr",
+ "eq",
+ "entrytype",
+ "enternative",
+ "end",
+ "encoding",
+ "elements",
+ "downcase",
+ "does",
+ "dlvar",
+ "dlfunc",
+ "div",
+ "die",
+ "deref",
+ "depth",
+ "delprop",
+ "delete",
+ "defined",
+ "decodetime",
+ "decodelocaltime",
+ "dec",
+ "debug_print",
+ "debug_load",
+ "debug_init",
+ "debug_break",
+ "debug",
+ "cosh",
+ "cos",
+ "connect",
+ "concat",
+ "compreg",
+ "compose",
+ "collecton",
+ "collectoff",
+ "collect",
+ "cmp_str",
+ "cmp_num",
+ "cmp",
+ "cmod",
+ "close",
+ "clone",
+ "clears",
+ "clearp",
+ "clearn",
+ "cleari",
+ "clear_eh",
+ "classoffset",
+ "classname",
+ "class",
+ "chr",
+ "chopn",
+ "charsetname",
+ "charset",
+ "ceil",
+ "can",
+ "callmethodcc",
+ "callmethod",
+ "bytelength",
+ "bxors",
+ "bxor",
+ "bsr",
+ "branch_cs",
+ "branch",
+ "bounds",
+ "bors",
+ "bor",
+ "bnots",
+ "bnot",
+ "bind",
+ "bands",
+ "band",
+ "backtrace",
+ "atan",
+ "assign",
+ "asin",
+ "asec",
+ "and",
+ "addparent",
+ "addmethod",
+ "adddoes",
+ "addattribute",
+ "add",
+ "acos",
+ "accept",
+ "abs",
+ NULL
+};
+
+
+
+/*
+
+=item is_op()
+
+Return 1 if the specified id is a Parrot op, 0 otherwise.
+
+=cut
+
+*/
+int
+is_op(char *id) {
+ char const *iter = parrot_ops[0];
+ int index = 0;
+
+ assert(id != NULL);
+
+ while (iter != NULL) {
+ if (strcmp(iter, id) == 0)
+ return 1;
+
+ iter = parrot_ops[++index];
+ }
+
+ return 0;
+}
+
+
/*
=back
Modified: trunk/compilers/pirc/src/pirutil.h
==============================================================================
--- trunk/compilers/pirc/src/pirutil.h (original)
+++ trunk/compilers/pirc/src/pirutil.h Wed Apr 11 11:46:56 2007
@@ -18,6 +18,9 @@
# define debug(P,S) if (P->flags & PIRC_DEBUG) printdebug(S)
*/
+
+extern int is_op(char *id);
+
#endif
/*
