[A68-RECUTILS][COMMITTED] callback of "rec mset map" now gets a REF REC_MSET_DATA
Jose E. Marchesi
jemarch@gnu.org
Sun Apr 6 13:47:43 GMT 2025
---
src/rec-db.a68 | 2 +-
src/rec-field-name.a68 | 4 +--
src/rec-field.a68 | 2 +-
src/rec-mset.a68 | 2 +-
src/rec-record.a68 | 55 +++++++++++++++++++++++++++++++++++++++++-
src/rec-rset.a68 | 6 ++---
src/rec-writer.a68 | 34 ++++++++++++++------------
utils/recsel.a68 | 2 +-
8 files changed, 81 insertions(+), 26 deletions(-)
diff --git a/src/rec-db.a68 b/src/rec-db.a68
index fb05bc6..1d2126b 100644
--- a/src/rec-db.a68
+++ b/src/rec-db.a68
@@ -26,4 +26,4 @@ PROC rec db new = REF REC_DB:
a db. #
PROC rec db gate = (REC_MSET_DATA d) BOOL:
- (d | (REC_RSET): TRUE | FALSE);
+ (d | (REF REC_RSET): TRUE | FALSE);
diff --git a/src/rec-field-name.a68 b/src/rec-field-name.a68
index 6a762ae..2f81f7e 100644
--- a/src/rec-field-name.a68
+++ b/src/rec-field-name.a68
@@ -27,7 +27,7 @@ INT rec hash size = 1008;
"chain" is used to chain field names together in "rec fields".
#
-MODE REC_FIELD_NAME = STRUCT (STRING name, REF REC_FIELD_NAME chain);
+MODE REC_FIELD_NAME = STRUCT (STRING str, REF REC_FIELD_NAME chain);
# Nihils. #
@@ -43,7 +43,7 @@ BEGIN ASSERT (name /= "");
# First try to find an existing field name with this name. #
REF REC_FIELD_NAME field name := rec field names[hash];
WHILE field name :/=: rec no field name
- DO IF name OF field name = name THEN found FI;
+ DO IF str OF field name = name THEN found FI;
field name := chain OF field name
OD;
diff --git a/src/rec-field.a68 b/src/rec-field.a68
index 1ff4c17..699290a 100644
--- a/src/rec-field.a68
+++ b/src/rec-field.a68
@@ -23,7 +23,7 @@ MODE REC_FIELD = STRUCT (REC_LOC loc,
# Nihils. #
-REF REC_RSET rec no field = NIL;
+REF REC_FIELD rec no field = NIL;
# Create and return a new field, with default location and the given
name and value. #
diff --git a/src/rec-mset.a68 b/src/rec-mset.a68
index 0995f6d..50c404f 100644
--- a/src/rec-mset.a68
+++ b/src/rec-mset.a68
@@ -21,7 +21,7 @@ MODE REC_MSET = STRUCT (REF REC_MSET_ELM head, tail,
INT num elems,
PROC(REC_MSET_DATA)BOOL gate),
REC_MSET_ELM = STRUCT (REC_MSET_DATA data, BOOL mark, REF REC_MSET_ELM next),
- REC_MSET_DATA = UNION (REC_RSET,REC_RECORD,REC_FIELD,REC_CMNT);
+ REC_MSET_DATA = UNION (REF REC_RSET,REF REC_RECORD,REF REC_FIELD,REF REC_CMNT);
# Nihils. #
diff --git a/src/rec-record.a68 b/src/rec-record.a68
index 9ce8670..84e580d 100644
--- a/src/rec-record.a68
+++ b/src/rec-record.a68
@@ -30,7 +30,7 @@ PROC rec record new = REF REC_RECORD:
a record. #
PROC rec record gate = (REC_MSET_DATA d) BOOL:
- (d | (REC_FIELD): TRUE, (REC_CMNT): TRUE | FALSE);
+ (d | (REF REC_FIELD): TRUE, (REF REC_CMNT): TRUE | FALSE);
# Given two records "rec1" and "rec2", determine whether all the
fields in "rec1" also exist in "rec2", not necessarily in the same
@@ -135,3 +135,56 @@ COMMENT
num fields
COMMENT
END;
+
+# Determine the number of fields with the given name that exist in
+ the given record. #
+
+PROC rec record num fields by name = (REC_RECORD record,
+ STRING fname) INT:
+BEGIN INT num fields := 0;
+ rec mset map (mset OF record,
+ (INT pos, REC_MSET_DATA d) VOID:
+ CASE d
+ IN (REF REC_FIELD field):
+ (str OF name OF field = fname | num fields +:= 1)
+ ESAC);
+ num fields
+END;
+
+# Determine whether a field with the given name exists in the given
+ record. #
+
+PROC rec field in record = (REC_RECORD record, STRING fname) BOOL:
+BEGIN BOOL found := FALSE;
+ rec mset map (mset OF record,
+ (INT pos, REC_MSET_DATA d) VOID:
+ CASE d
+ IN (REF REC_FIELD field):
+ IF str OF name OF field = fname
+ THEN found := TRUE; done
+ FI
+ ESAC);
+done:
+ found
+END;
+
+# Return a reference to the "n"th field with the given name in the
+ given record. This function returns "rec no field" #
+
+PROC rec record get field by name = (REC_RECORD record,
+ STRING field name,
+ INT n) REF REC_FIELD:
+BEGIN REF REC_FIELD field := rec no field;
+ INT nfield := 1;
+ rec mset map (mset OF record,
+ (INT pos, REC_MSET_DATA d) VOID:
+ CASE d
+ IN (REF REC_FIELD field):
+ IF nfield = n AND str OF name OF field = field name
+ THEN field := field; done
+ ELSE nfield +:= 1
+ FI
+ ESAC);
+done:
+ field
+END;
diff --git a/src/rec-rset.a68 b/src/rec-rset.a68
index 0aff4eb..53b81f7 100644
--- a/src/rec-rset.a68
+++ b/src/rec-rset.a68
@@ -36,18 +36,18 @@ PROC rec rset new = REF REC_RSET:
a record set. #
PROC rec rset gate = (REC_MSET_DATA d) BOOL:
- (d | (REC_RECORD): TRUE, (REC_CMNT): TRUE | FALSE);
+ (d | (REF REC_RECORD): TRUE, (REF REC_CMNT): TRUE | FALSE);
# Get the number of records in a given record set. #
PROC rec rset num records = (REC_RSET rset) INT:
(rec mset count (mset OF rset,
(REC_MSET_DATA d) BOOL:
- (d | (REC_RECORD): TRUE | FALSE)));
+ (d | (REF REC_RECORD): TRUE | FALSE)));
# Get the number of comments in a given record set. #
PROC rec rset num comments = (REC_RSET rset) INT:
(rec mset count (mset OF rset,
(REC_MSET_DATA d) BOOL:
- (d | (REC_CMNT): TRUE | FALSE)));
+ (d | (REF REC_CMNT): TRUE | FALSE)));
diff --git a/src/rec-writer.a68 b/src/rec-writer.a68
index 08df482..b89c79d 100644
--- a/src/rec-writer.a68
+++ b/src/rec-writer.a68
@@ -19,6 +19,9 @@
PR include "utils.a68" PR # For itoa. #
+# XXX this is to avoid confusing the Emacs a68 mode. #
+CHAR rec writer dash = REPR 35;
+
# A REC_WRITER denotes a writer capable of writing a textual
representation of complete databases, individual record sets,
individual records, individual fields and individual comments.
@@ -58,8 +61,7 @@ PR include "utils.a68" PR # For itoa. #
MODE REC_WRITER = STRUCT (INT fd, mode, STRING buf,
BOOL collapse, skip comments,
skip field names, row),
- REC_WRITER_DATA = UNION (REC_DB, REC_RSET, REC_RECORD,
- REC_FIELD,REC_CMNT,REF REC_MSET);
+ REC_WRITER_DATA = UNION (REF REC_DB, REC_MSET_DATA, REC_MSET);
INT rec writer normal = 0,
rec writer sexp = 1;
@@ -95,7 +97,7 @@ BEGIN
contained record sets, in order and separated by empty lines,
and a trailing newline. #
- PROC write db = (REC_DB db) VOID:
+ PROC write db = (REF REC_DB db) VOID:
(rec mset map (mset OF db,
(INT pos, REC_MSET_DATA d) VOID:
((pos > 1 | out ("\n\n"));
@@ -105,7 +107,7 @@ BEGIN
# The written form of the record set consists in all the
contained records and coments, in order. #
- PROC write rset = (REC_RSET rset) VOID:
+ PROC write rset = (REF REC_RSET rset) VOID:
rec mset map (mset OF rset,
(INT pos, REC_MSET_DATA d) VOID:
((pos > 1 | out ("\n\n"));
@@ -119,7 +121,7 @@ BEGIN
separated by newline characters.
#
- PROC write record = (REC_RECORD record) VOID:
+ PROC write record = (REF REC_RECORD record) VOID:
IF mode OF writer = rec writer sexp
THEN out ("(record " + itoa (char OF loc OF record) + " (");
rec mset map (mset OF record,
@@ -143,13 +145,13 @@ BEGIN
format featuring + continuation lines preceding each line.
#
- PROC write field = (REC_FIELD field) VOID:
+ PROC write field = (REF REC_FIELD field) VOID:
IF mode OF writer = rec writer sexp
THEN out ("(field " + itoa (char OF loc OF field) + " "
- + """" + name OF name OF field + """" + " "
+ + """" + str OF name OF field + """" + " "
+ """" + value OF field + """" + ")")
ELSE IF NOT skip field names OF writer
- THEN out (name OF name OF field + ": ") FI;
+ THEN out (str OF name OF field + ": ") FI;
out with line breaks (value OF field, "+ ")
FI;
@@ -164,22 +166,22 @@ BEGIN
dash comment beginning character preceding each line.
#
- PROC write comment = (REC_CMNT comment) VOID:
+ PROC write comment = (REF REC_CMNT comment) VOID:
IF mode OF writer = rec writer sexp
THEN out ("(comment """ + sexpcape (content OF comment) + """)")
- ELSE out ("#");
- out with line breaks (content OF comment, "#")
+ ELSE out (rec writer dash);
+ out with line breaks (content OF comment, rec writer dash)
FI;
# Write out the data in the given multiple. #
FOR i TO UPB data
DO CASE data[i]
- IN (REC_DB db): write db (db),
- (REC_RSET rset): write rset (rset),
- (REC_RECORD record): write record (record),
- (REC_FIELD field): write field (field),
- (REC_CMNT comment): write comment (comment)
+ IN (REF REC_DB db): write db (db),
+ (REF REC_RSET rset): write rset (rset),
+ (REF REC_RECORD record): write record (record),
+ (REF REC_FIELD field): write field (field),
+ (REF REC_CMNT comment): write comment (comment)
OUT ASSERT (FALSE) # XXX call fatal. #
ESAC
OD
diff --git a/utils/recsel.a68 b/utils/recsel.a68
index ae11d26..3fdb747 100644
--- a/utils/recsel.a68
+++ b/utils/recsel.a68
@@ -104,7 +104,7 @@ Special options:\n\
rec mset map (mset OF db,
(INT pos, REC_MSET_DATA data) VOID:
CASE data
- IN (REC_RSET rset):
+ IN (REF REC_RSET rset):
num records +:= rec rset num records (rset)
ESAC);
fputs (stdout, itoa (num records) + "\n")
--
2.30.2
More information about the Algol68
mailing list