Adding notation for cycles and shared structure.

This commit implements the parse-side support
for handling a notation that exists in ANSI
Common Lisp for specifying objects with cycles
and shared substructure.

* parser.h (struct parser): New members, circ_ref_hash
and circ_count.
(circref_s, parser_resolve_circ, parser_circ_def,
parser_circ_ref): Declared.

* parser.c (circref_s): New symbol variable.
(parser_mark): Visit the new circ_ref_hash member of the
parser structure.
(parser_common_init): Initialize new members
circ_ref_hash and circ_count of parser structure.
(patch_ref, circ_backpatch): New static functions.
(parser_resolve_circ, parser_circ_def, parser_circ_ref): New
functions.
(circref): New static function.
(parse_init): Initialize circref_s as sys:circref symbol.
Register sys:circref function.

* parser.l (grammar): Scan #<num>= and #<num># notation as
tokens, extracting their numeric value.

* parser.y (HASH_N_EQUALS, HASH_N_HASH): New token types.
(i_expr, n_expr): Adding phrases for hash-equalsign and
hash-hash syntax.
(yybadtoken): Handle new token types in switch.
(parse_once): Call parser_resolve_circ after parsing
to rewrite any remaining #<num># references in the
structure to the objects they denote.
(parse): Reset new struct parse members to initial
state. Call parser_resolve_circ after parsing
to rewrite any remaining #<num># references.

1 files changed, 18 insertions, 1 deletions

diff --git a/parser.y b/parser.y
index 8ae40e82..c3bc60e5 100644
--- a/parser.y
+++ b/parser.y
@@ -108,6 +108,7 @@ int yyparse(scanner_t *, parser_t *);
 %token <lineno> SECRET_ESCAPE_R SECRET_ESCAPE_E SECRET_ESCAPE_I
 
 %token <val> NUMBER METANUM
+%token <val> HASH_N_EQUALS HASH_N_HASH
 
 %token <chr> REGCHAR REGTOKEN LITCHAR SPLICE CONSDOT LAMBDOT
 
@@ -136,7 +137,7 @@ int yyparse(scanner_t *, parser_t *);
 %right SYMTOK '{' '}'
 %right ALL SOME NONE MAYBE CASES CHOOSE AND OR END COLLECT UNTIL COLL
 %right OUTPUT REPEAT REP FIRST LAST EMPTY DEFINE IF ELIF ELSE
-%right SPACE TEXT NUMBER METANUM
+%right SPACE TEXT NUMBER METANUM HASH_N_EQUALS HASH_N_HASH
 %nonassoc '[' ']' '(' ')'
 %left '-' ',' '\'' '^' SPLICE '@'
 %left '|' '/'
@@ -934,6 +935,10 @@ i_expr : SYMTOK                 { $$ = symhlpr($1, t); }
                                           num(parser->lineno)); }
        | SPLICE i_expr          { $$ = rl(rlcp(list(sys_splice_s, $2, nao), $2),
                                           num(parser->lineno)); }
+       | HASH_N_EQUALS          { parser_circ_def(parser, $1, unique_s); }
+         i_expr                 { parser_circ_def(parser, $1, $3);
+                                  $$ = $3; }
+       | HASH_N_HASH            { $$ = parser_circ_ref(parser, $1); }
        ;
 
 n_expr : SYMTOK                 { $$ = symhlpr($1, t); }
@@ -972,6 +977,10 @@ n_expr : SYMTOK                 { $$ = symhlpr($1, t); }
                                                  or2($1, $3)),
                                                  num(parser->lineno));
                                   } }
+       | HASH_N_EQUALS          { parser_circ_def(parser, $1, unique_s); }
+         n_expr                 { parser_circ_def(parser, $1, $3);
+                                  $$ = $3; }
+       | HASH_N_HASH            { $$ = parser_circ_ref(parser, $1); }
        ;
 
 n_exprs_opt : n_exprs           { $$ = $1; }
@@ -1664,6 +1673,8 @@ void yybadtoken(parser_t *parser, int tok, val context)
   case HASH_SLASH:     problem = lit("#/"); break;
   case HASH_H:         problem = lit("#H"); break;
   case HASH_S:         problem = lit("#S"); break;
+  case HASH_N_EQUALS:  problem = lit("#<n>="); break;
+  case HASH_N_HASH:    problem = lit("#<n>#"); break;
   case WORDS:   problem = lit("#\""); break;
   case WSPLICE: problem = lit("#*\""); break;
   case QWORDS:         problem = lit("#`"); break;
@@ -1710,6 +1721,8 @@ int parse_once(val stream, val name, parser_t *parser)
 
   res = yyparse(parser->scanner, parser);
 
+  parser_resolve_circ(parser);
+
   uw_catch(esym, eobj) {
     yyerrorf(parser->scanner, lit("exception during parse"), nao);
     uw_throw(esym, eobj);
@@ -1733,6 +1746,8 @@ int parse(parser_t *parser, val name, enum prime_parser prim)
 
   parser->errors = 0;
   parser->prepared_msg = nil;
+  parser->circ_ref_hash = nil;
+  parser->circ_count = 0;
   parser->syntax_tree = nil;
 
   prime_parser(parser, name, prim);
@@ -1743,6 +1758,8 @@ int parse(parser_t *parser, val name, enum prime_parser prim)
 
   prime_parser_post(parser, prim);
 
+  parser_resolve_circ(parser);
+
   uw_catch(esym, eobj) {
     yyerrorf(parser->scanner, lit("exception during parse"), nao);
     uw_throw(esym, eobj);