a68: support for publicized modules

This commit adds support for modules publicizing the exports of other
modules.  For example:

  module GRAMP =
      access pub GRAMP_Symbol,
             pub GRAMP_Word,
             pub GRAMP_Alphabet
  def pub string libgramp_version = "1.0";
      skip
  fed

Signed-off-by: Jose E. Marchesi <[email protected]>

gcc/algol68/ChangeLog

	* a68-parser-taxes.cc (tax_module_dec): Do not handle
	DEFINING_MODULE_INDICANT.
	* a68-exports.cc (a68_add_module_to_moif): Do not mangle module
	names in module extracts.
	(add_pub_revelations_to_moif): New function.
	(a68_do_exports): Simplify and call add_pub_revelations_to_moif.
	* a68-imports.cc (a68_decode_moifs): Add all decoded moifs to the
	global list TOP_MOIF.
	* a68-parser-extract.cc (extract_revelation): Recurse to import
	extracts from publicized modules.
	(a68_extract_indicants): Do not add symbol table entries for
	defining modules.
	* a68-types.h (struct TAG_T): Remove field EXPORTED.
	(EXPORTED): Remove macro.
	(TOP_MOIF): Define.
	* a68-parser.cc (a68_parser): Initialize global list of moifs.
	(a68_new_tag): Do not initialize EXPORTED.

gcc/testsuite/ChangeLog

	* algol68/execute/modules/module22bar.a68: New test.
	* algol68/execute/modules/module22foo.a68: Likewise.
	* algol68/execute/modules/program-22.a68: Likewise.
	* algol68/compile/modules/program-11.a68: Adjust test to
	publicized modules.
	* algol68/compile/modules/program-error-multiple-delaration-module-1.a68:
	Likewise.

Author: jemarch

gcc/algol68/a68-exports.cc

@@ -131,10 +131,7 @@ static void
 a68_add_module_to_moif (MOIF_T *moif, TAG_T *tag)
 {
   EXTRACT_T *e = ggc_alloc<EXTRACT_T> ();
-  /* Module tags are not associated with declarations, so we have to do the
-     mangling here.  */
-  tree id = a68_get_mangled_indicant (NSYMBOL (NODE (tag)), NAME (moif));
-  const char *tag_symbol = IDENTIFIER_POINTER (id);
+  const char *tag_symbol = NSYMBOL (NODE (tag));
 
   EXTRACT_KIND (e) = GA68_EXTRACT_MODU;
   EXTRACT_SYMBOL (e) = ggc_strdup (tag_symbol);
@@ -525,6 +522,26 @@ a68_asm_output_moif (MOIF_T *moif)
     }
 }
 
+/* Add module exports for publicized module revelations.  */
+
+static void
+add_pub_revelations_to_moif (MOIF_T *moif, NODE_T *p)
+{
+  for (; p != NO_NODE; FORWARD (p))
+    {
+      if (IS (p, PUBLIC_SYMBOL))
+	{
+	  gcc_assert (IS (NEXT (p), MODULE_INDICANT));
+	  TAG_T *tag = a68_new_tag ();
+	  NODE (tag) = NEXT (p);
+	  a68_add_module_to_moif (moif, tag);
+	  FORWARD (p);
+	}
+      else
+	add_pub_revelations_to_moif (moif, SUB (p));
+    }
+}
+
 /* Emit export information for the module definition in the parse tree P.  */
 
 void
@@ -534,65 +551,59 @@ a68_do_exports (NODE_T *p)
     {
       if (IS (p, DEFINING_MODULE_INDICANT))
 	{
-	  // XXX only do this if the defining module is to be
-	  // exported. Accessed modules without PUB are not exported.  */
-	  TAG_T *tag = a68_find_tag_global (TABLE (p), MODULE_SYMBOL, NSYMBOL (p));
-	  gcc_assert (tag != NO_TAG);
+	  tree module_id = a68_get_mangled_indicant (NSYMBOL (p));
+	  MOIF_T *moif = a68_moif_new (IDENTIFIER_POINTER (module_id));
+	  char *prelude = xasprintf ("%s__prelude", IDENTIFIER_POINTER (module_id));
+	  char *postlude = xasprintf ("%s__postlude", IDENTIFIER_POINTER (module_id));
+	  PRELUDE (moif) = ggc_strdup (prelude);
+	  POSTLUDE (moif) = ggc_strdup (postlude);
+	  free (prelude);
+	  free (postlude);
+
+	  NODE_T *module_text = NEXT (NEXT (p));
+	  gcc_assert (IS (module_text, MODULE_TEXT));
+
+	  /* Get modules exports from the revelation part.  */
+	  if (IS (SUB (module_text), REVELATION_PART))
+	    {
+	      NODE_T *revelation_part = SUB (module_text);
+	      add_pub_revelations_to_moif (moif, SUB (revelation_part));
+	    }
 
-	  if (EXPORTED (tag))
+	  NODE_T *def_part = (IS (SUB (module_text), REVELATION_PART)
+			      ? NEXT_SUB (module_text)
+			      : SUB (module_text));
+	  gcc_assert (IS (def_part, DEF_PART));
+	  TABLE_T *table = TABLE (SUB (def_part));
+	  gcc_assert (PUBLIC_RANGE (table));
+
+	  for (TAG_T *t = INDICANTS (table); t != NO_TAG; FORWARD (t))
 	    {
-	      tree module_id = a68_get_mangled_indicant (NSYMBOL (p));
-	      MOIF_T *moif = a68_moif_new (IDENTIFIER_POINTER (module_id));
-	      char *prelude = xasprintf ("%s__prelude", IDENTIFIER_POINTER (module_id));
-	      char *postlude = xasprintf ("%s__postlude", IDENTIFIER_POINTER (module_id));
-	      PRELUDE (moif) = ggc_strdup (prelude);
-	      POSTLUDE (moif) = ggc_strdup (postlude);
-	      free (prelude);
-	      free (postlude);
-
-	      NODE_T *module_text = NEXT (NEXT (p));
-	      gcc_assert (IS (module_text, MODULE_TEXT));
-	      NODE_T *def_part = (IS (SUB (module_text), REVELATION_PART)
-				  ? NEXT_SUB (module_text)
-				  : SUB (module_text));
-	      gcc_assert (IS (def_part, DEF_PART));
-	      TABLE_T *table = TABLE (SUB (def_part));
-	      gcc_assert (PUBLIC_RANGE (table));
-
-	      for (TAG_T *t = MODULES (table); t != NO_TAG; FORWARD (t))
-		{
-		  if (PUBLICIZED (t))
-		    a68_add_module_to_moif (moif, t);
-		}
-
-	      for (TAG_T *t = INDICANTS (table); t != NO_TAG; FORWARD (t))
-		{
-		  if (PUBLICIZED (t))
-		    a68_add_indicant_to_moif (moif, t);
-		}
-
-	      for (TAG_T *t = IDENTIFIERS (table); t != NO_TAG; FORWARD (t))
-		{
-		  if (PUBLICIZED (t))
-		    a68_add_identifier_to_moif (moif, t);
-		}
-
-	      for (TAG_T *t = PRIO (table); t != NO_TAG; FORWARD (t))
-		{
-		  if (PUBLICIZED (t))
-		    a68_add_prio_to_moif (moif, t);
-		}
-
-	      for (TAG_T *t = OPERATORS (table); t != NO_TAG; FORWARD (t))
-		{
-		  if (PUBLICIZED (t))
-		    a68_add_operator_to_moif (moif, t);
-		}
-
-	      a68_asm_output_moif (moif);
-	      if (flag_a68_dump_moif)
-		a68_dump_moif (moif);
+	      if (PUBLICIZED (t))
+		a68_add_indicant_to_moif (moif, t);
 	    }
+
+	  for (TAG_T *t = IDENTIFIERS (table); t != NO_TAG; FORWARD (t))
+	    {
+	      if (PUBLICIZED (t))
+		a68_add_identifier_to_moif (moif, t);
+	    }
+
+	  for (TAG_T *t = PRIO (table); t != NO_TAG; FORWARD (t))
+	    {
+	      if (PUBLICIZED (t))
+		a68_add_prio_to_moif (moif, t);
+	    }
+
+	  for (TAG_T *t = OPERATORS (table); t != NO_TAG; FORWARD (t))
+	    {
+	      if (PUBLICIZED (t))
+		a68_add_operator_to_moif (moif, t);
+	    }
+
+	  a68_asm_output_moif (moif);
+	  if (flag_a68_dump_moif)
+	    a68_dump_moif (moif);
 	}
       else
 	a68_do_exports (SUB (p));

gcc/algol68/a68-imports.cc

@@ -1286,11 +1286,11 @@ a68_decode_extracts (MOIF_T *moif, encoded_modes_map_t &encoded_modes,
   return false;
 }
 
-/* Decode the given exports data into a linked list of moifs.  If there is a
-   decoding error then put an explicative mssage in *ERRSTR and return
-   NULL.  */
+/* Decode the given exports data into moifs, add them to the TOP_MOIF list, and
+   return true.  If there is a decoding error then put an explicative message
+   in *ERRSTR and return false.  */
 
-static MOIF_T *
+static bool
 a68_decode_moifs (const char *data, size_t size, const char **errstr)
 {
   MOIF_T *moif_list = NO_MOIF;
@@ -1349,12 +1349,25 @@ a68_decode_moifs (const char *data, size_t size, const char **errstr)
 	}
     }
 
-  /* Got some juicy exports for youuuuuu... */
-  return moif_list;
+  /* Add the moifs in moif_list to the global list of moifs.  */
+  /* XXX error and fail on duplicates?  */
+  {
+    MOIF_T *end = TOP_MOIF (&A68_JOB);
+    if (end == NO_MOIF)
+      TOP_MOIF (&A68_JOB) = moif_list;
+    else
+      {
+	while (NEXT (end) != NO_MOIF)
+	  FORWARD (end);
+	NEXT (end) = moif_list;
+      }
+  }
+
+  return true;
  decode_error:
   if (*errstr == NULL)
     *errstr = "premature end of data";
-  return NULL;
+  return false;
 }
 
 /* Get a moif with the exports for module named MODULE.  If no exports can be
@@ -1395,11 +1408,16 @@ a68_open_packet (const char *module)
 
   /* Got some data.  Decode it into a list of moif.  */
   const char *errstr = NULL;
-  MOIF_T *moif = a68_decode_moifs (exports_data, exports_data_size, &errstr);
+  if (!a68_decode_moifs (exports_data, exports_data_size, &errstr))
+    {
+      a68_error (NO_NODE, "%s", errstr);
+      return NULL;
+    }
 
-  /* The moif we are looking for must be in the list.  Note these are garbage
-     collected.  */
+  /* The androids we are looking for are likely to be now in the global
+     list.  */
+  MOIF_T *moif = TOP_MOIF (&A68_JOB);
   while (moif != NO_MOIF && strcmp (NAME (moif), module) != 0)
-    moif = NEXT (moif);
+    FORWARD (moif);
   return moif;
 }

gcc/algol68/a68-parser-extract.cc

@@ -185,23 +185,30 @@ skip_pack_declarer (NODE_T *p)
     return p;
 }
 
-/* Extract a revelation.  */
+/* Extract the revelation associated with the module MODULE.  The node Q is
+   used for symbol table and diagnostic purposes.  Publicized modules are
+   recursively extracted as well.  This call may result in one or more
+   errors.  */
 
 static void
-extract_revelation (NODE_T *q, bool is_public ATTRIBUTE_UNUSED)
+extract_revelation (NODE_T *q, const char *module, TAG_T *tag)
 {
-  /* Store in the symbol table.  */
-  TAG_T *tag = a68_add_tag (TABLE (q), MODULE_SYMBOL, q, NO_MOID, STOP);
-  gcc_assert (tag != NO_TAG);
-  EXPORTED (tag) = false; // XXX depends on PUB!
   /* Import the MOIF and install it in the tag.  */
-  MOIF_T *moif = a68_open_packet (NSYMBOL (q));
+  MOIF_T *moif = a68_open_packet (module);
   if (moif == NULL)
     {
-      a68_error (q, "cannot find module Z", NSYMBOL (q));
+      a68_error (q, "cannot find module Z", module);
       return;
     }
-  MOIF (tag) = moif; // XXX add to existing list of moifs.
+
+  if (tag != NO_TAG)
+    MOIF (tag) = moif;
+
+  /* First thing to do is to extract the revelations of publicized modules in
+     this moif.  This leads to recursive calls of this function.  */
+
+  for (EXTRACT_T *e : MODULES (moif))
+    extract_revelation (q, EXTRACT_SYMBOL (e), NO_TAG);
 
   /* Store all the modes from the MOIF in the moid list.
 
@@ -345,18 +352,26 @@ a68_extract_indicants (NODE_T *p)
 	      FORWARD (q);
 	      if (q != NO_NODE)
 		{
+		  NODE_T *bold_tag = NO_NODE;
+
 		  if (IS (q, BOLD_TAG))
 		    {
-		      extract_revelation (q, false /* is_public */);
+		      bold_tag = q;
 		      FORWARD (q);
 		    }
 		  else if (a68_whether (q, PUBLIC_SYMBOL, BOLD_TAG, STOP))
 		    {
-		      NODE_T *pub_node = q;
-		      extract_revelation (NEXT (pub_node), true /* is_public */);
+		      bold_tag = NEXT (q);
 		      FORWARD (q);
 		      FORWARD (q);
 		    }
+
+		  if (bold_tag != NO_NODE)
+		    {
+		      TAG_T *tag = a68_add_tag (TABLE (bold_tag), MODULE_SYMBOL, bold_tag, NO_MOID, STOP);
+		      gcc_assert (tag != NO_TAG);
+		      extract_revelation (bold_tag, NSYMBOL (bold_tag), tag);
+		    }
 		}
 	    }
 	  while (q != NO_NODE && IS (q, COMMA_SYMBOL));
@@ -370,14 +385,7 @@ a68_extract_indicants (NODE_T *p)
 	      detect_redefined_keyword (q, MODULE_DECLARATION);
 	      if (a68_whether (q, BOLD_TAG, EQUALS_SYMBOL, STOP))
 		{
-		  /* Store in the symbol table.
-		     XXX also add to global list of modules?
-		     Position of definition (q) connects to this lexical
-		     level!  */
 		  ATTRIBUTE (q) = DEFINING_MODULE_INDICANT;
-		  TAG_T *tag = a68_add_tag (TABLE (p), MODULE_SYMBOL, q, NO_MOID, STOP);
-		  gcc_assert (tag != NO_TAG);
-		  EXPORTED (tag) = true;
 		  FORWARD (q);
 		  ATTRIBUTE (q) = EQUALS_SYMBOL; /* XXX why not ALT_EQUALS_SYMBOL */
 		  if (NEXT (q) != NO_NODE && IS (NEXT (q), ACCESS_SYMBOL))

gcc/algol68/a68-parser-taxes.cc

@@ -1188,18 +1188,6 @@ tax_module_dec (NODE_T *p)
 	{
 	  tax_module_dec (NEXT (p));
 	}
-      else if (IS (p, DEFINING_MODULE_INDICANT))
-	{
-	  TAG_T *entry = MODULES (TABLE (p));
-	  while (entry != NO_TAG && NODE (entry) != p)
-	    FORWARD (entry);
-	  MOID (p) = NO_MOID;
-	  TAX (p) = entry;
-	  HEAP (entry) = LOC_SYMBOL;
-	  MOID (entry) = NO_MOID;
-	  PUBLICIZED (entry) = PUBLICIZED (p);
-	  tax_module_dec (NEXT (p));
-	}
       else
 	{
 	  tax_tags (p);

gcc/algol68/a68-parser.cc

@@ -446,6 +446,7 @@ a68_parser (const char *filename)
   A68_PARSER (error_tag) = (TAG_T *) a68_new_tag ();
   TOP_NODE (&A68_JOB) = NO_NODE;
   TOP_MOID (&A68_JOB) = NO_MOID;
+  TOP_MOIF (&A68_JOB) = NO_MOIF;
   TOP_LINE (&A68_JOB) = NO_LINE;
   STANDENV_MOID (&A68_JOB) = NO_MOID;
   a68_set_up_tables ();
@@ -784,7 +785,6 @@ a68_new_tag (void)
   VARIABLE (z) = false;
   IS_RECURSIVE (z) = false;
   PUBLICIZED (z) = true; /* XXX */
-  EXPORTED (z) = false;
   ASCRIBED_ROUTINE_TEXT (z) = false;
   LOWERER (z) = NO_LOWERER;
   TAX_TREE_DECL (z) = NULL_TREE;

gcc/algol68/a68-types.h

@@ -585,9 +585,6 @@ struct GTY(()) TABLE_T
    PUBLICIZED is set for tags that are marked as public and therefore shall be
    exported as part of a module interface.
 
-   EXPORTED is set for DEFINING_MODULEs whose module interface is to be
-   exported.
-
    ASCRIBED_ROUTINE_TEXT is set when the defining identifier is ascribed a
    routine-text in an identity declaration.
 
@@ -621,7 +618,7 @@ struct GTY((chain_next ("%h.next"))) TAG_T
   NODE_T *node, *unit;
   const char *value;
   bool scope_assigned, use, in_proc, loc_assigned, portable, variable;
-  bool ascribed_routine_text, is_recursive, publicized, exported;
+  bool ascribed_routine_text, is_recursive, publicized;
   int priority, heap, scope, youngest_environ, number;
   STATUS_MASK_T status;
   tree tree_decl;
@@ -645,6 +642,7 @@ struct GTY(()) MODULE_T
   int error_count, warning_count, source_scan;
   LINE_T *top_line;
   MOID_T *top_moid, *standenv_moid;
+  MOIF_T *top_moif;
   NODE_T *top_node;
   OPTIONS_T options;
   FILE * GTY ((skip)) file_source_fd;
@@ -930,7 +928,6 @@ struct GTY(()) A68_T
 #define EQUIVALENT(p) ((p)->equivalent_mode)
 #define EQUIVALENT_MODE(p) ((p)->equivalent_mode)
 #define ERROR_COUNT(p) ((p)->error_count)
-#define EXPORTED(p) ((p)->exported)
 #define EXTERN_SYMBOL(p) ((p)->extern_symbol)
 #define EXTRACT_IN_PROC(p) ((p)->in_proc)
 #define EXTRACT_KIND(p) ((p)->kind)
@@ -1097,6 +1094,7 @@ struct GTY(()) A68_T
 #define TEXT(p) ((p)->text)
 #define TOP_LINE(p) ((p)->top_line)
 #define TOP_MOID(p) ((p)->top_moid)
+#define TOP_MOIF(p) ((p)->top_moif)
 #define TOP_NODE(p) ((p)->top_node)
 #define TRANSIENT(p) ((p)->transient)
 #define TREE_LISTING_SAFE(p) ((p)->tree_listing_safe)

gcc/testsuite/algol68/compile/modules/program-11.a68

@@ -4,8 +4,7 @@
   inside controlled clauses in access clauses with
   several revelations.  }
 
-access Module10,
-       Module11,
+access Module11,
        Module12
 begin assert (foo = 10);
       assert (bar = "foo") { dg-error "" }