[A68-RECUTILS][COMMITTED] Selection of records
Jose E. Marchesi
jemarch@gnu.org
Thu Apr 10 19:05:24 GMT 2025
---
src/rec-db.a68 | 6 ++++
src/rec-field-name.a68 | 9 +++++-
src/rec-mset.a68 | 18 +++++++++++-
src/rec-parser.a68 | 65 +++++++++++++++++++++++++++++-------------
src/rec-record.a68 | 59 +++++++++++++-------------------------
src/rec-rset.a68 | 44 ++++++++++++++++++++++++----
src/rec-writer.a68 | 58 ++++++++++++++++++++-----------------
utils/recsel.a68 | 55 ++++++++++++++++++++++++++---------
utils/recutl.a68 | 28 +++++++++++++++++-
9 files changed, 235 insertions(+), 107 deletions(-)
diff --git a/src/rec-db.a68 b/src/rec-db.a68
index 1d2126b..872807c 100644
--- a/src/rec-db.a68
+++ b/src/rec-db.a68
@@ -27,3 +27,9 @@ PROC rec db new = REF REC_DB:
PROC rec db gate = (REC_MSET_DATA d) BOOL:
(d | (REF REC_RSET): TRUE | FALSE);
+
+# Get the number of record sets in the given database. #
+
+PROC rec db num rsets = (REC_DB db) INT:
+ rec mset count (mset OF db,
+ (REC_MSET_DATA d) BOOL: (d | (REF REC_RSET): TRUE | FALSE));
diff --git a/src/rec-field-name.a68 b/src/rec-field-name.a68
index 2f81f7e..2b1b4bb 100644
--- a/src/rec-field-name.a68
+++ b/src/rec-field-name.a68
@@ -33,6 +33,13 @@ MODE REC_FIELD_NAME = STRUCT (STRING str, REF REC_FIELD_NAME chain);
REF REC_FIELD_NAME rec no field name = NIL;
+# It is useful to handle field names as if they were strings. #
+
+OP = = (REC_FIELD_NAME n, STRING s) BOOL: str OF n = s,
+ = = (STRING s, REC_FIELD_NAME n) BOOL: s = str OF n,
+ + = (REC_FIELD_NAME n, STRING s) STRING: str OF n + s,
+ + = (STRING s, REC_FIELD_NAME n) STRING: s + str OF n;
+
# Get a rec field name given a string. #
PROC rec get field name = (STRING name) REF REC_FIELD_NAME:
@@ -43,7 +50,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 str OF field name = name THEN found FI;
+ DO IF field name = name THEN found FI;
field name := chain OF field name
OD;
diff --git a/src/rec-mset.a68 b/src/rec-mset.a68
index 37ead6b..088ce69 100644
--- a/src/rec-mset.a68
+++ b/src/rec-mset.a68
@@ -103,8 +103,24 @@ END;
PROC rec mset count = (REC_MSET mset,
PROC(REC_MSET_DATA)BOOL predicate) INT:
-BEGIN INT count;
+BEGIN INT count := 0;
rec mset map (mset, (INT pos, REC_MSET_DATA data) VOID:
IF predicate (data) THEN count +:= 1 FI);
count
END;
+
+# Return the data corresponding to the "n"th element for which the
+ given predicate holds true. #
+
+PROC rec mset elem at = (REC_MSET mset, INT at,
+ PROC(REC_MSET_DATA)BOOL predicate) REC_MSET_DATA:
+BEGIN REC_MSET_DATA res;
+ INT count := 0;
+ rec mset map (mset, (INT pos, REC_MSET_DATA data) VOID:
+ IF predicate (data)
+ THEN count +:= 1;
+ (count = at | res := data; done)
+ FI);
+done:
+ res
+END;
diff --git a/src/rec-parser.a68 b/src/rec-parser.a68
index 1bb11b6..ba60a39 100644
--- a/src/rec-parser.a68
+++ b/src/rec-parser.a68
@@ -48,21 +48,26 @@ CHAR rec parser dash = REPR 35;
"error" is a string that is set to reflect an error condition in the
parser. An empty string means no error. When a new error condition
happens the previous error description gets overwritten.
-#
+
+ "prev descriptor", if not NIL, is the first record in the next
+ record set. #
MODE REC_PARSER = STRUCT (INT fd, STRING in buf, error, source,
CHAR unget char,
- INT line, char pos);
+ INT line, char pos,
+ REF REC_RECORD prev descriptor);
# Create and return a new parser reading from an open file. #
PROC rec parse file = (INT fd, STRING filename) REC_PARSER:
- (HEAP REC_PARSER := (fd, ~, "", filename, null character, 1, 1));
+ (HEAP REC_PARSER := (fd, ~, "", filename, null character, 1, 1,
+ rec no record));
# Create and return a new parser reading from a given string. #
PROC rec parse string = (STRING str) REC_PARSER:
- (HEAP REC_PARSER := (-1, str, "", "<string>", null character, 1, 1));
+ (HEAP REC_PARSER := (-1, str, "", "<string>", null character, 1, 1,
+ rec no record));
# Emit a parse error reflecting the current state of the parser. #
@@ -201,12 +206,13 @@ END;
# Parse a record set.
- A record set consists on a record (it's "descriptor") perhaps
- preceded by comments, followed by a sequence of zero or more records
- or comments:
+ A record set consists on a record followed by a sequence of zero or
+ more records or comments:
COMMENT* RECORD (RECORD|COMMENT)*
+ A record which is a descriptor starts a new record set.
+
This procedure returns TRUE if a record set is found in the input,
FALSE otherise. If the parsing suceeds then "rset" refers to the
resulting REC_RSET value.
@@ -216,9 +222,18 @@ PROC rec parse rset = (REF REC_PARSER parser,
REF REF REC_RSET rset) BOOL:
BEGIN BOOL res := TRUE;
REF REC_RSET new rset := rec rset new;
- INT num records := 0, elem pos := 0;
+ INT elem pos := 0, num records := 0;
+
+ # If there is a previously saved descriptor, use it as the
+ descriptor of this record set. #
+ IF prev descriptor OF parser :/=: rec no record
+ THEN num records +:= 1;
+ descriptor pos OF new rset := 1;
+ rec mset append (mset OF new rset, prev descriptor OF parser);
+ prev descriptor OF parser := rec no record
+ FI;
- # Parse comments and records, appending the in the mset of the
+ # Parse comments and records, appending them in the mset of the
record descriptor. #
WHILE CHAR c := rec parser getc (parser);
c /= invalid char
@@ -230,7 +245,8 @@ BEGIN BOOL res := TRUE;
REF REC_CMNT comment;
rec parser ungetc (parser, c);
IF NOT rec parse comment (parser, comment)
- THEN puts (error OF parser); res := FALSE;
+ THEN puts (error OF parser);
+ res := FALSE;
error
FI;
elem pos +:= 1;
@@ -242,23 +258,32 @@ BEGIN BOOL res := TRUE;
THEN res := FALSE;
error
FI;
- elem pos +:= 1;
- num records +:= 1;
- rec mset append (mset OF new rset, record);
- # This may be the record's descriptor. #
+
IF rec record is descriptor (record)
- THEN descriptor pos OF new rset := elem pos FI
+ THEN IF descriptor pos OF new rset = rec mset no pos
+ THEN # This is the descriptor of this record set. #
+ descriptor pos OF new rset := elem pos;
+ num records +:= 1;
+ rec mset append (mset OF new rset, record)
+ ELSE # This is the descriptor of the next
+ record set. We are done with this one. #
+ prev descriptor OF parser := record;
+ done
+ FI
+ ELSE num records +:= 1;
+ rec mset append (mset OF new rset, record)
+ FI
FI;
- next: ~
+ next: ~
OD;
-done:
- # The rset shall feature at least one record, which
- would be the record descriptor. #
+
+ # The rset shall contain at least one record. #
IF num records = 0
THEN error OF parser := "expected record";
res := FALSE;
- error
+ done
FI;
+done:
rset := new rset;
error:
res
diff --git a/src/rec-record.a68 b/src/rec-record.a68
index c32f0c0..8faa0d1 100644
--- a/src/rec-record.a68
+++ b/src/rec-record.a68
@@ -65,34 +65,14 @@ END;
# Get the number of fields in a given record. #
PROC rec record num fields = (REC_RECORD rec) INT:
-BEGIN SKIP
-COMMENT
- INT num fields := 0;
- REF REC_ELEM elem := elems OF rec;
-
- WHILE elem :/=: rec no elem
- DO (data OF elem | (REC_FIELD): num fields +:= 1);
- elem := next OF elem
- OD;
- num fields
-COMMENT
-END;
+ rec mset count (mset OF rec,
+ (REC_MSET_DATA d)BOOL: (d | (REF REC_FIELD): TRUE | FALSE));
# Get the number of comments in a given record. #
PROC rec record num comments = (REC_RECORD rec) INT:
-BEGIN SKIP
-COMMENT
- INT num comments := 0;
- REF REC_ELEM elem := elems OF rec;
-
- WHILE elem :/=: rec no elem
- DO (data OF elem | (REC_CMNT): num comments +:= 1);
- elem := next OF elem
- OD;
- num comments
-COMMENT
-END;
+ rec mset count (mset OF rec,
+ (REC_MSET_DATA d)BOOL: (d | (REF REC_CMNT): TRUE | FALSE));
# Get the one-based index of a given field within a given record. If
there is no such field in the record then this procedure returns
@@ -132,7 +112,7 @@ BEGIN INT num fields := 0;
(INT pos, REC_MSET_DATA d) VOID:
CASE d
IN (REF REC_FIELD field):
- (str OF name OF field = fname | num fields +:= 1)
+ (name OF field = fname | num fields +:= 1)
ESAC);
num fields
END;
@@ -146,7 +126,7 @@ BEGIN BOOL found := FALSE;
(INT pos, REC_MSET_DATA d) VOID:
CASE d
IN (REF REC_FIELD field):
- IF str OF name OF field = fname
+ IF name OF field = fname
THEN found := TRUE; done
FI
ESAC);
@@ -154,25 +134,26 @@ 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" #
+# Return a multiple of references to the fields in "record" that have
+ a given name.
+
+ The returned multiple may be empty. #
+
+PROC rec record get fields by name = (REC_RECORD record,
+ STRING field name) []REF REC_FIELD:
+BEGIN INT nfield := 0;
+ [rec record num fields (record)]REF REC_FIELD fields;
-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
+ IF name OF field = field name
+ THEN nfield +:= 1;
+ fields[nfield] := field
FI
ESAC);
-done:
- field
+ fields[:nfield]
END;
# Remove the "n"th field having the given name from the given record. #
@@ -186,6 +167,6 @@ BEGIN INT num field := 0;
CASE d
IN (REF REC_FIELD field):
(num field +:= 1;
- str OF name OF field = field name AND n = num field)
+ name OF field = field name AND n = num field)
ESAC)
END;
diff --git a/src/rec-rset.a68 b/src/rec-rset.a68
index 0867b9c..f90764e 100644
--- a/src/rec-rset.a68
+++ b/src/rec-rset.a68
@@ -27,9 +27,9 @@
record set.
"descriptor pos" refers to the position in the mset where the
- descriptor of the record set, which is a record, can be found. If
- the record set doesn't have a record descriptor then this is "rec
- mset no pos".
+ descriptor of the record set, which is a record, can be found. The
+ position doesn't take comments into account. If the record set
+ doesn't have a record descriptor then this is "rec mset no pos".
#
MODE REC_RSET = STRUCT (REC_MSET mset,
@@ -49,12 +49,36 @@ PROC rec rset new = REF REC_RSET:
PROC rec rset gate = (REC_MSET_DATA d) BOOL:
(d | (REF REC_RECORD): TRUE, (REF REC_CMNT): TRUE | FALSE);
-# Get the number of records in a given record set. #
+# Get the type of a record set as a string.
+
+ If the given record set doesn't have a descriptor this function
+ returns the empty string.
+#
+
+PROC rec rset type = (REC_RSET rset) STRING:
+BEGIN REF REC_RECORD descriptor
+ = rec rset record at (rset, descriptor pos OF rset);
+
+ IF descriptor :=: rec no record
+ THEN ""
+ ELSE []REF REC_FIELD rec field
+ = rec record get fields by name (descriptor, "%rec");
+
+ ASSERT (UPB rec field = 1);
+ value OF rec field[1]
+ FI
+END;
+
+# Get the number of records in a given record set.
+ The count doesn't include the descriptor. #
PROC rec rset num records = (REC_RSET rset) INT:
(rec mset count (mset OF rset,
(REC_MSET_DATA d) BOOL:
- (d | (REF REC_RECORD): TRUE | FALSE)));
+ CASE d
+ IN (REF REC_RECORD record):
+ NOT rec record is descriptor (record)
+ ESAC));
# Get the number of comments in a given record set. #
@@ -62,3 +86,13 @@ PROC rec rset num comments = (REC_RSET rset) INT:
(rec mset count (mset OF rset,
(REC_MSET_DATA d) BOOL:
(d | (REF REC_CMNT): TRUE | FALSE)));
+
+# Get a reference to the "n"th record in the record set. If the given
+ position is out of bounds then nil is returned. #
+
+PROC rec rset record at = (REC_RSET rset, INT at) REF REC_RECORD:
+BEGIN REC_MSET_DATA res = rec mset elem at (mset OF rset, at,
+ (REC_MSET_DATA d) BOOL:
+ (d | (REF REC_RECORD): TRUE | FALSE));
+ (res | (REF REC_RECORD r): r | ASSERT (FALSE); SKIP)
+END;
diff --git a/src/rec-writer.a68 b/src/rec-writer.a68
index b89c79d..45dd55f 100644
--- a/src/rec-writer.a68
+++ b/src/rec-writer.a68
@@ -54,13 +54,16 @@ CHAR rec writer dash = REPR 35;
If "skip field names" is set then the writer will not emit field
names in normal mode.
+ If "print descriptors" is set then include descriptor records in
+ the output.
+
If "row" is set then the writer will separate field values using
single space characters rather than field separators.
#
MODE REC_WRITER = STRUCT (INT fd, mode, STRING buf,
BOOL collapse, skip comments,
- skip field names, row),
+ skip field names, print descriptors, row),
REC_WRITER_DATA = UNION (REF REC_DB, REC_MSET_DATA, REC_MSET);
INT rec writer normal = 0,
@@ -70,7 +73,7 @@ INT rec writer normal = 0,
descriptor. #
PROC rec writer file new = (INT fd) REC_WRITER:
- (fd, rec writer normal, ~, FALSE, FALSE, FALSE, FALSE);
+ (fd, rec writer normal, ~, FALSE, FALSE, FALSE, FALSE, FALSE);
# Write out some given set of data. #
@@ -98,20 +101,17 @@ BEGIN
and a trailing newline. #
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"));
- rec write (writer, d)));
- out ("\n"));
+ rec mset map (mset OF db,
+ (INT pos, REC_MSET_DATA d) VOID:
+ rec write (writer, d));
# The written form of the record set consists in all the
- contained records and coments, in order. #
+ contained records and comments, in order. #
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"));
- rec write (writer, d)));
+ rec write (writer, d));
# A record in sexp form looks like:
@@ -122,15 +122,17 @@ BEGIN
#
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,
- (INT pos, REC_MSET_DATA d) VOID: rec write (writer, d));
- out ("))\n")
- ELSE rec mset map (mset OF record,
- (INT pos, REC_MSET_DATA d) VOID:
- ((pos > 1 | out ("\n"));
- rec write (writer, d)))
+ IF print descriptors OF writer OR NOT rec record is descriptor (record)
+ THEN IF mode OF writer = rec writer sexp
+ THEN out ("(record " + itoa (char OF loc OF record) + " (");
+ rec mset map (mset OF record,
+ (INT pos, REC_MSET_DATA d) VOID: rec write (writer, d));
+ out ("))\n")
+ ELSE rec mset map (mset OF record,
+ (INT pos, REC_MSET_DATA d) VOID:
+ rec write (writer, d));
+ out ("\n")
+ FI
FI;
# A field in sexp form looks like:
@@ -148,11 +150,12 @@ BEGIN
PROC write field = (REF REC_FIELD field) VOID:
IF mode OF writer = rec writer sexp
THEN out ("(field " + itoa (char OF loc OF field) + " "
- + """" + str OF name OF field + """" + " "
+ + """" + name OF field + """" + " "
+ """" + value OF field + """" + ")")
ELSE IF NOT skip field names OF writer
- THEN out (str OF name OF field + ": ") FI;
- out with line breaks (value OF field, "+ ")
+ THEN out (name OF field + ": ") FI;
+ out with line breaks (value OF field, "+ ");
+ out ("\n")
FI;
# A comment in sexp form looks like:
@@ -167,10 +170,13 @@ BEGIN
#
PROC write comment = (REF REC_CMNT comment) VOID:
- IF mode OF writer = rec writer sexp
- THEN out ("(comment """ + sexpcape (content OF comment) + """)")
- ELSE out (rec writer dash);
- out with line breaks (content OF comment, rec writer dash)
+ IF NOT skip comments OF writer
+ THEN IF mode OF writer = rec writer sexp
+ THEN out ("(comment """ + sexpcape (content OF comment) + """)")
+ ELSE out (rec writer dash);
+ out with line breaks (content OF comment, rec writer dash);
+ out ("\n")
+ FI
FI;
# Write out the data in the given multiple. #
diff --git a/utils/recsel.a68 b/utils/recsel.a68
index 3fdb747..fefd6c2 100644
--- a/utils/recsel.a68
+++ b/utils/recsel.a68
@@ -72,11 +72,45 @@ Special options:\n\
FALSE
END;
+ # Emit a count of selected records in the selected record set. #
+
+ PROC recsel output count = VOID:
+ BEGIN INT num records;
+
+ rec mset map (mset OF db,
+ (INT pos, REC_MSET_DATA data) VOID:
+ CASE data
+ IN (REF REC_RSET rset):
+ IF recutl type = rec rset type (rset)
+ THEN num records +:= rec rset num records (rset) FI
+ ESAC);
+ done:
+ fputs (stdout, itoa (num records) + "\n")
+ END;
+
+ # Emit the selected records from the selected record set. #
+
+ PROC recsel output records = VOID:
+ BEGIN REC_WRITER writer := rec writer file new (stdout);
+ skip comments OF writer := TRUE;
+ IF recutl print sexps THEN mode OF writer := rec writer sexp FI;
+ rec mset map (mset OF db,
+ (INT pos, REC_MSET_DATA data) VOID:
+ CASE data
+ IN (REF REC_RSET rset):
+ IF recutl type = rec rset type (rset)
+ THEN rec write (writer, rset) FI
+ ESAC);
+ done:
+ SKIP
+ END;
+
# Set some globals. #
recutl name := "recsel";
# Parse command-line options. #
argp (2, (recutl opts,
+ recutl selection opts,
((" ", "help", FALSE, recsel do help),
("c", "count", FALSE, recsel opt count))),
(INT pos, STRING no opt arg) BOOL:
@@ -95,21 +129,14 @@ Special options:\n\
(NOT rec parse db (parser, db) | stop);
+ # Validate some options. #
+ IF recutl type = "" AND rec db num rsets (db) > 1
+ THEN recutl error ("several record types found. Please use -t to specify one.")
+ FI;
+
# Emit output. #
IF count >= 0
- THEN # Emit the number of selected records in the first
- record set. XXX this should use selected type. #
- INT num records;
-
- rec mset map (mset OF db,
- (INT pos, REC_MSET_DATA data) VOID:
- CASE data
- IN (REF REC_RSET rset):
- num records +:= rec rset num records (rset)
- ESAC);
- fputs (stdout, itoa (num records) + "\n")
- ELSE # Emit the resulting record set #
- REC_WRITER writer := rec writer file new (stdout);
- rec write (writer, db)
+ THEN recsel output count
+ ELSE recsel output records
FI
END
diff --git a/utils/recutl.a68 b/utils/recutl.a68
index 1f61e31..dd159ee 100644
--- a/utils/recutl.a68
+++ b/utils/recutl.a68
@@ -31,7 +31,33 @@ END;
# Command-line options which are common to all utilities. #
[]ARGOPT recutl opts = ((" ", "version", FALSE, recutl do version),
- (" ", "xxx", FALSE, recutl do version));
+ (" ", "print-sexps", FALSE,
+ (STRING arg) BOOL:
+ (recutl print sexps := TRUE; TRUE)));
+
+# Command-line options which are common to all selection utilities. #
+
+[]ARGOPT recutl selection opts = (("t", "type", TRUE,
+ (STRING arg) BOOL:
+ (recutl type := arg; TRUE)),
+ ("q", "quick", TRUE,
+ (STRING arg) BOOL:
+ (recutl quick := arg; TRUE)));
+
+# --print-sexps makes the utility to output sexps rather than recutils
+ data. #
+
+BOOL recutl print sexps := FALSE;
+
+# -t|--type=TYPE narrows the selection to record sets of the specified
+ type name. #
+
+STRING recutl type;
+
+# -q|--quick=STR narrows the selection to records having fields whose value
+ contain the string STR. #
+
+STRING recutl quick;
# Print version for the utility. #
--
2.30.2
More information about the Algol68
mailing list