From: Jose E. Marchesi <jemarch@gnu.org>
Date: Thu, 29 Jan 2026 02:33:17 +0000 (+0100)
Subject: a68: implement GNU68-2026-001-short-of-symbol
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=7632c2e12b231ae2648920daa7233f9778624c7a;p=thirdparty%2Fgcc.git

a68: implement GNU68-2026-001-short-of-symbol

This patch implements the GNU extension:

  GNU68-2026-001-brief-selection - Brief style for selection

which adds the preferred brief style for selection recommended by
Hansen in "ALGOL 68 Hardware Represenatation Recommendations"
published in the Algol Bulletin issue 42.

This extension is already listed in https://algol68-lang.org.

Signed-off-by: Jose E. Marchesi <jemarch@gnu.org>

gcc/algol68/ChangeLog

	* ga68.vw: Update formal grammar to express the GNU extension.
	* a68-parser.cc (a68_dont_mark_here): Likewise.
	* a68-parser-scanner.cc (SINGLE_QUOTE_CHAR): Define.
	(get_next_token): Recognize ' as QUOTE_SYMBOL.
	(tokenise_source): Acknowledge QUOTE_SYMBOL.
	* a68-parser-keywords.cc (a68_set_up_tables): Likewise.
	* a68-parser-bottom-up.cc (reduce_primary_parts): Adjust parser to
	brief form of selection.
	* a68-parser-attrs.def (QUOTE_SYMBOL): New attribute.
	* ga68.texi (Brief selection): New section.

gcc/testsuite/ChangeLog

	* algol68/compile/error-selector-1.a68: New test.
	* algol68/execute/selection-2.a68: Update test.
	* algol68/execute/selection-5.a68: Likewise.
---

diff --git a/gcc/algol68/a68-parser-attrs.def b/gcc/algol68/a68-parser-attrs.def
index e9cadd30cab..2d615409da1 100644
--- a/gcc/algol68/a68-parser-attrs.def
+++ b/gcc/algol68/a68-parser-attrs.def
@@ -305,6 +305,7 @@ A68_ATTR(PROCEDURING, "proceduring coercion")
 A68_ATTR(PROC_SYMBOL, "proc-symbol")
 A68_ATTR(PUBLIC_SYMBOL, "public-symbol")
 A68_ATTR(QUALIFIER, "qualifier")
+A68_ATTR(QUOTE_SYMBOL,"quote-symbol")
 A68_ATTR(RADIX_FRAME, "radix frame")
 A68_ATTR(REAL_DENOTATION, "real denotation")
 A68_ATTR(REAL_PATTERN, "real pattern")
diff --git a/gcc/algol68/a68-parser-bottom-up.cc b/gcc/algol68/a68-parser-bottom-up.cc
index 14f914aeb27..f1b06b1fbd3 100644
--- a/gcc/algol68/a68-parser-bottom-up.cc
+++ b/gcc/algol68/a68-parser-bottom-up.cc
@@ -1196,12 +1196,14 @@ reduce_primary_parts (NODE_T *p, enum a68_attribute expect)
 {
   for (NODE_T *q = p; q != NO_NODE; FORWARD (q))
     {
-      if (a68_whether (q, IDENTIFIER, OF_SYMBOL, STOP))
+      if (a68_whether (q, IDENTIFIER, OF_SYMBOL, STOP)
+	  || a68_whether (q, IDENTIFIER, QUOTE_SYMBOL, STOP))
 	ATTRIBUTE (q) = FIELD_IDENTIFIER;
 
       reduce (q, NO_NOTE, NO_TICK, NIHIL, NIL_SYMBOL, STOP);
       reduce (q, NO_NOTE, NO_TICK, SKIP, SKIP_SYMBOL, STOP);
       reduce (q, NO_NOTE, NO_TICK, SELECTOR, FIELD_IDENTIFIER, OF_SYMBOL, STOP);
+      reduce (q, NO_NOTE, NO_TICK, SELECTOR, FIELD_IDENTIFIER, QUOTE_SYMBOL, STOP);
       /* JUMPs without GOTO are resolved later.  */
       reduce (q, NO_NOTE, NO_TICK, JUMP, GOTO_SYMBOL, IDENTIFIER, STOP);
       reduce (q, NO_NOTE, NO_TICK, DENOTATION, LONGETY, INT_DENOTATION, STOP);
diff --git a/gcc/algol68/a68-parser-keywords.cc b/gcc/algol68/a68-parser-keywords.cc
index 427e2b359fd..fe157dcdfb1 100644
--- a/gcc/algol68/a68-parser-keywords.cc
+++ b/gcc/algol68/a68-parser-keywords.cc
@@ -147,6 +147,7 @@ a68_set_up_tables (void)
       add_keyword (&A68 (top_keyword), ORF_SYMBOL, "OREL");
       add_keyword (&A68 (top_keyword), BRIEF_COMMENT_BEGIN_SYMBOL, "{");
       add_keyword (&A68 (top_keyword), BRIEF_COMMENT_END_SYMBOL, "}");
+      add_keyword (&A68 (top_keyword), QUOTE_SYMBOL, "'");
 
       if (OPTION_STROPPING (&A68_JOB) != SUPPER_STROPPING)
 	{
diff --git a/gcc/algol68/a68-parser-scanner.cc b/gcc/algol68/a68-parser-scanner.cc
index 39f76286247..8c8b06464fe 100644
--- a/gcc/algol68/a68-parser-scanner.cc
+++ b/gcc/algol68/a68-parser-scanner.cc
@@ -77,6 +77,7 @@ supper_postlude[] = {
 #define STOP_CHAR 127
 #define FORMFEED_CHAR '\f'
 #define CR_CHAR '\r'
+#define SINGLE_QUOTE_CHAR '\''
 #define QUOTE_CHAR '"'
 #define APOSTROPHE_CHAR '\''
 #define BACKSLASH_CHAR '\\'
@@ -1631,6 +1632,13 @@ get_next_token (bool in_format,
 	  *att = POINT_SYMBOL;
 	}
     }
+  else if (!OPTION_STRICT (&A68_JOB) && c == SINGLE_QUOTE_CHAR)
+    {
+      c = next_char (ref_l, ref_s, true);
+      (sym++)[0] = SINGLE_QUOTE_CHAR;
+      sym[0] = '\0';
+      *att = QUOTE_SYMBOL;
+    }
   else if (ISDIGIT (c))
     {
       /* Something that begins with a digit:
@@ -2213,6 +2221,7 @@ tokenise_source (NODE_T **root, int level, bool in_format,
 		case ESAC_SYMBOL:
 		case OD_SYMBOL:
 		case OF_SYMBOL:
+		case QUOTE_SYMBOL:
 		case FI_SYMBOL:
 		case CLOSE_SYMBOL:
 		case BUS_SYMBOL:
diff --git a/gcc/algol68/a68-parser.cc b/gcc/algol68/a68-parser.cc
index 1504e4dc25b..939dbdde2ec 100644
--- a/gcc/algol68/a68-parser.cc
+++ b/gcc/algol68/a68-parser.cc
@@ -377,6 +377,7 @@ a68_dont_mark_here (NODE_T *p)
     case NIL_SYMBOL:
     case OD_SYMBOL:
     case OF_SYMBOL:
+    case QUOTE_SYMBOL:
     case OPEN_SYMBOL:
     case OP_SYMBOL:
     case ORF_SYMBOL:
diff --git a/gcc/algol68/ga68.texi b/gcc/algol68/ga68.texi
index 6798b3a3761..64d9b316d58 100644
--- a/gcc/algol68/ga68.texi
+++ b/gcc/algol68/ga68.texi
@@ -3364,6 +3364,7 @@ invoking the compiler.
 @menu
 * @code{@B{bin}} and @code{@B{abs}} of negative integral values::
 * Bold taggles::              Using underscores in mode and operator indications.
+* Brief selection::           Shorter form of the @code{of-symbol}.
 @end menu
 
 @node @code{@B{bin}} and @code{@B{abs}} of negative integral values
@@ -3484,6 +3485,28 @@ like @code{Foo__bar} and @code{_Baz} are not valid indications.
 Bold taggles are available when the gnu68 dialect of the language is
 selected.  @xref{Dialect options}.
 
+@node Brief selection
+@section Brief selection
+
+It was early recognized that a shorter alternative representation the
+of-symbol was very much needed, considering the fact the bold version
+@code{@B{of}} is at least four characters long.  This makes certain
+phrases long and also slightly laborious to read, like in:
+
+@example
+@B{pub} @B{op} + = (@B{Pos} a,b) @B{Pos}: (c @B{of} a + c @B{of} b, r @B{of} a + r @B{of} b),
+       - = (@B{Pos} a,b) @B{Pos}: (c @B{of} a - c @B{of} b, r @B{of} a - r @B{of} b);
+@end example
+
+This compiler allows using a quote character @code{'} instead of
+@code{of} in selections of structs and multiples.  Using this brief
+style the example above now can be written as:
+
+@example
+@B{pub} @B{op} + = (@B{Pos} a,b) @B{Pos}: (c'a + c'b, r'a + r'b),
+       - = (@B{Pos} a,b) @B{Pos}: (c'a - c'b, r'a - r'b);
+@end example
+
 @include gpl_v3.texi
 @include fdl.texi
 
diff --git a/gcc/algol68/ga68.vw b/gcc/algol68/ga68.vw
index 77acf0f95d6..419d230e7a4 100644
--- a/gcc/algol68/ga68.vw
+++ b/gcc/algol68/ga68.vw
@@ -40,6 +40,9 @@
   [NC] This is the GNU68-2025-005-nestable-comments GNU extension.  It
        adds support for nestable block comments.
 
+  [BF] This is the GNU68-2026-001-brief-selection GNU extension.  It
+       adds support for a brief form of the selection construct.
+
   The metaproduction rules, hyper-rules and hyper-alternatives
   introduced by each extension are clearly marked in the sections
   below.  You can easily search for them using the extensions tags in
@@ -388,7 +391,7 @@ k) *vacuum : EMPTY PACK.
 3.4.1 Syntax
 
 A) CHOICE :: choice using boolean ; CASE.
-B) CASE :: choice using intgral ; choice using UNITED.
+B) CASE :: choice using integral ; choice using UNITED.
 
 a) SOID NEST1 CHOICE clause{5D,551a,A341h,A349a} :
      CHOICE STYLE start{91a,-},
@@ -1060,13 +1063,16 @@ a) strong reference to MODE NEST nihil{5B} :
 
 5.3.1.1 Syntax
 
+{ Extensions:
+  [BF] brief selection }
+
 A) REFETY :: REF to ; EMPTY.
 B) REFLEXETY :: REF to ; REF to flexible ; EMPTY.
 
 a) REFETY MODE1 NEST selection{5C} :
      MODE1 field FIELDS applied field selector with TAG{48d},
-       of{94f} token, weak REFLEXETY ROWS of structured with
-                           FIELDS mode NEST SECONDARY{5C},
+       STYLE selection token, weak REFLEXETY ROWS of structured with
+                                   FIELDS mode NEST SECONDARY{5C},
        where (REFETY) is derived from (REFLEXETY){b,c,-}.
 b) WHETHER (transient reference to) is derived from
            (REF to flexible){a,532,66a} :
@@ -1622,7 +1628,7 @@ d) CHOICE STYLE out{34l} :
        STYLE else{94f,-} token ;
      where (CHOICE) is (CASE), STYLE out{94f,-} token.
 e) CHOICE STYLE finish{34a} :
-     whre (CHOICE) is (choice using boolean),
+     where (CHOICE) is (choice using boolean),
        STYLE fi{94f,-} token ;
      where (CHOICE) is (CASE), STYLE esac{94f,-} token.
 f) NOTION token :
@@ -1674,7 +1680,8 @@ f) STYLE nestable comment item{e} :
   [CS] andth symbol, orel symbol
   [MR] access symbol, module symbol, def symbol, public symbol,
        postlude symbol, formal nest symbol, egg symbol
-  [US] unsafe symbol }
+  [US] unsafe symbol
+  [SS] brief of symbol }
 
 { This section of the Report doesn't describe syntax, but lists all
   the different symbols along with their representation in the
@@ -1694,6 +1701,8 @@ d) module symbol{49a}                   MODULE
    formal nest symbol{56b}              NEST
    egg symbol{A6a,c}                    EGG
 f) unsafe symbol{37a}                   UNSAFE
+   bold of symbol{53a}                  OF
+   brief of symbol{53a}                 '
 h) bold comment begin symbol{92a}       NOTE
    bold comment end symbol{92a}         ETON
    brief comment begin symbol{92a}      {
diff --git a/gcc/testsuite/algol68/compile/error-selector-1.a68 b/gcc/testsuite/algol68/compile/error-selector-1.a68
new file mode 100644
index 00000000000..ccdd9771b19
--- /dev/null
+++ b/gcc/testsuite/algol68/compile/error-selector-1.a68
@@ -0,0 +1,6 @@
+{ dg-options "-std=algol68" }
+
+begin mode Foo = struct (int a,b);
+      a'b; { dg-error "unworthy" }
+      skip
+end
diff --git a/gcc/testsuite/algol68/execute/selection-2.a68 b/gcc/testsuite/algol68/execute/selection-2.a68
index 0d7b6c6730b..3dbab949619 100644
--- a/gcc/testsuite/algol68/execute/selection-2.a68
+++ b/gcc/testsuite/algol68/execute/selection-2.a68
@@ -2,8 +2,8 @@
 # Selecting a struct name results in sub-names.  #
 BEGIN MODE PERSON = STRUCT (INT age, REAL income, INT num children);
       PERSON person;
-      age OF person := 44;
-      income OF person := 999.99;
+      age'person := 44;
+      income'person := 999.99;
       num children OF person := 0;
       ASSERT (age OF person = 44);
       ASSERT (num children OF person = 0);
diff --git a/gcc/testsuite/algol68/execute/selection-5.a68 b/gcc/testsuite/algol68/execute/selection-5.a68
index fde72d53ade..720dd57c025 100644
--- a/gcc/testsuite/algol68/execute/selection-5.a68
+++ b/gcc/testsuite/algol68/execute/selection-5.a68
@@ -1,6 +1,4 @@
-# { dg-options "-fstropping=upper" }  #
-# pr UPPER pr  #
-BEGIN MODE JORL = STRUCT (INT i, REAL r);
-      REF JORL jorl = LOC JORL := (10, 3.14);
-      ASSERT (i OF jorl = 10)
-END
+begin mode Jorl = struct (int i, real r);
+      ref Jorl jorl = loc Jorl := (10, 3.14);
+      assert (i'jorl = 10)
+end