diff --git a/LiComboP.icn b/LiComboP.icn
index 1116df3..5472722 100644
--- a/LiComboP.icn
+++ b/LiComboP.icn
@@ -1,3 +1,5 @@
+$ifndef _LiComboP_
+$define _LiComboP_
############################################################################
#
# File: LiComboP.icn
@@ -33,12 +35,10 @@
# Recurrently suspend lists combining finite seqs.
#
############################################################################
-$ifndef _LiComboP_
-$define _LiComboP_
$ifndef _wora_
-$error wora.icn must be included for definition of procedure wora(id)
-$endif
+$include "wora.icn"
+$endif # _wora_
procedure LiP(A) #: produce lists combining infinite sequences
# Generate combinations of argument results for list-invocation,
diff --git a/README.md b/README.md
index 432db31..50ad8b4 100644
--- a/README.md
+++ b/README.md
@@ -11,11 +11,49 @@ development repo: [https://chiselapp.com/user/eschen42/repository/aceincl](https
mirror and release repo: [https://github.com/eschen42/aceincl](https://github.com/eschen42/aceincl)
+Except where otherwise noted, this code is created (with others' inspiration) by Art Eschenlauer ([OrcID 0000-0002-2882-0508](https://orcid.org/0000-0002-2882-0508)).
+
+The usual [Icon value type abbreviations](http://www2.cs.arizona.edu/icon/refernce/misc.htm#datatypes) apply on this page:
+
+- cset(`c`)
+- file(`f`)
+- integer(`i`)
+- list(`L`)
+- null(`n`)
+- procedure(`p`)
+- real(`r`)
+- string(`s`)
+- co-expression(`C`)
+- record types(`R`)
+- set(`S`)
+- table(`T`)
+
+with one addition:
+
+- VNom(`V`)
+ - see `vnom.icn` below.
+
+---
+
+
+
## Contents
- [Testing program `runt.icn` and working examples](#testing-program-runticn-and-working-examples)
+ - The `runt.icn` runs a selection of, or all, test programs in specified directories to validate their outputs:
- In the `tests` directory are "working examples" of how to use the files in this directory.
- - The `runt.icn` runs the test programs to validate their output.
+ - In the `sl3tests` directory are sqlite3-dependent "working examples".
+
+- [`baton.icn`](#batonicn)
+ - Procedure to coordinate passing data from one process to another via a file-based buffer.
+
+- `baton_main.icn` - Procedures to use facilitate creation of processes that exchange data
+ with current process via batons.
+ - [`baton_main`](#procedure-baton_mainargs--exit0--1) Procedure for creating executable to interface between a batons and a stream.
+ - [`baton_flatware`](#procedure-baton_flatwareargs--fail--exit0--1) Procedure to access batons without translating an additional executable.
+ - [`baton_crowbar`](#procedure-baton_crowbar--n--stop) Procedure to handle programming error by terminating program exection when `baton_flatware` is not linked.
+
+- [`batonsys.icn`](#batonsysicn) - Invoke process using batons to exchange input and output
- [`fieldedDataFile.icn`](#fieldeddatafileicn)
- Procedures to produce logical lines or fields from formatted data files.
@@ -26,9 +64,15 @@ mirror and release repo: [https://github.com/eschen42/aceincl](https://github.co
- [`iimage.icn`](#iimageicn)
- Procedures to transform data structures into includable Icon declarations and statements.
+- [`jsonparse.icn`](#jsonparseicn)
+ - Procedures to parse and generate JSON, by Carl Sturtivant and Gregg Townsend.
+
- [`LiComboP.icn`](#licombopicn)
- Procedures to suspend lists combining sequences.
+- [`lindel.icn`](#lindelicn)
+ - In-place delete or insert of a pseudo-section of L.
+
- [`RecTable.icn`](#rectableicn)
- Procedures to produce/manipulate record-like tables.
@@ -41,6 +85,9 @@ mirror and release repo: [https://github.com/eschen42/aceincl](https://github.co
- [`selectRecordFromListByField.icn`](#selectrecordfromlistbyfieldicn)
- Procedure to produce records from a list of records (or a list of tables), matching specified criteria.
+- [`sl3.icn`](#sl3icn)
+ - Interface to exchange commands and results with `sqlite3`.
+
- [`vnom.icn`](#vnomicn)
- "Nominal vector", i.e., a list whose elements may be accessed by rank (index) or name (key).
- This construct is supported by a Lua-inspired metatable.
@@ -50,6 +97,10 @@ mirror and release repo: [https://github.com/eschen42/aceincl](https://github.co
- [Legacy Source Code Control](#legacy-source-code-control)
+---
+
+
+
## Testing program `runt.icn` and working examples
Working examples, named `test_*.icn`, are in the `tests` directory:
@@ -57,15 +108,384 @@ Working examples, named `test_*.icn`, are in the `tests` directory:
- `test_*.std` captures the corresponding test's expected output.
- `icon runt.icn tests` will run the tests and compare the results to
their expected output.
-- usage: `icon runt.icn [--continue] [--verbose] []`
+- usage: `icon runt.icn [--continue] [--verbose] []`
+ - Tests are not run unless an `.icn` file and a `.std` file share exactly
+ the same name; names must begin with `test_`.
+ - Optional arguments may be:
+ - paths to directories in which to locate tests, or
+ - names of tests to run, without `test_` prefix;
+ - if *any* nonexistent paths are present then *only* the named tests will be run.
- By default, tests are located and run in the current working directory.
- Otherwise, tests are located and run in the specified directory or directories.
- - Tests are not run unless an `.icn` file and a `.std` file share exactly
- the same name.
+ - As usual, LPATH is required for `$include` dirctives to succeed.
- Use the `--continue` option to run all tests regardless of whether any fail.
- Use the `--verbose` option to show both the expected output
from the `.std` file and the actual output produced by the test program.
+---
+
+
+
+## baton.icn
+
+`baton.icn` provides a serverless way to pass data between
+processes using five files, one for the message transmitted and the others
+for coordinating transfer.
+
+### procedure `baton(action:s, filename:s, file:f, warn:C, wait_secs:N) : s|n|fail`
+
+Procedure `baton` provides four distinct modes of action:
+
+```
+ action buffer file Cwarn wait_secs
+ baton("write", buffer:s, file:f|C, warn:C, wait_secs:N) : s|fail
+ baton("read", buffer:s, file:f|C, warn:C, wait_secs:N) : s|fail
+ baton("select", buffer:s, file:n|x, warn:C, wait_secs:N) : n|fail
+ baton("clean", buffer:s, file:n|x, warn:C ) : fail
+```
+
+Usages:
+
+#### `action == "write"`
+
+`baton("write", buffer:s, file:f|C, warn:n|C, wait_secs:N) : s | fail`
+
+Copy input from `file` to file named by `buffer`
+
+- `file` is optional; default is `&input`
+ - `file:f` is a file open for reading
+ - `file:C` is a co-expression producing string values,
+ - e.g.: `file := create !&input`
+ - `file:C` is permitted to produce values containing multiple newlines
+- `buffer` argument is required
+- `warn` argument may be `&null` or a co-expression that can handle
+ transmitted warning strings, e.g.:
+ - `create repeat @&source | @main # silence; is the default behavior`
+ - `create repeat write(&errout, \@&source | "") | @main`
+- `wait_secs` argument may be `&null`, integer, or real, specifying
+ approximate number of seconds to wait for initial handshake
+- produces an error string only if unsuccessful (fails otherwise)
+
+#### `action == "read"`
+
+`baton("read", buffer:s, file:f|C, warn:n|C, wait_secs:N) : s | fail`
+
+Copy output from file named by `buffer` to `file`
+
+- `file` is optional; default is `&output`
+ - `file:f` is a file open for writing
+ - `file:C` is a co-expression receiving string values,
+ - e.g.: `@(file := create while write(&output, @&source))`
+- `buffer`, `warn`, and `wait_secs` arguments as for "write".
+- produces an error string only if unsuccessful (fails otherwise)
+
+#### `action == "select"`
+
+`baton("select", buffer:s, file:n|x, warn:n|C, wait_secs:N) : n | fail`
+
+- produces `&null` only when data are available for reading from buffer
+- `buffer` and `warn` arguments as for "write".
+- wait (approximately) `wait_secs` seconds for success.
+- `file` is ignored even if not `&null`
+- This action is experimental and may be of no practical value.
+
+#### `action == "clean"`
+
+`baton("clean", buffer:s, file:n|x, warn:n|C) : fail`
+
+- cleans up coordination files that may be left behind when "write" or
+ "read" is interrupted before they can delete these files
+- `buffer` and `warn` arguments as above
+- `file` is ignored even if not `&null`
+
+See "case two" in the example under `baton_flatware` below for
+a demonstration of use of "read" and "write" from within a program.
+
+---
+
+## baton_main.icn
+
+See below for notes regarding usage of these procedures.
+
+
+
+### procedure `baton_main(args) : exit(0 | 1)`
+
+This procedure provides an implementation for `main` for a standalone
+executable to interface a baton to or from a stream, as described below.
+
+- Exit code 0 indicates ordinary termination
+- Otherwise, exit code is 1.
+
+Note that Icon does not catch `SIGPIPE`.
+Consequently, if `baton("read",...)` is feeding a pipe,
+and if the downstream process dies,
+then the Icon process running `baton("read",...)` will die as well!
+This is the motivation for running an output pipe from a separate process
+and coordiating data-passing using a baton.
+
+*Usage of baton program*
+
+```
+baton read bufferfile [handshake_timeout_secs]
+baton write bufferfile [handshake_timeout_secs]
+baton select bufferfile [success_timeout_secs]
+baton clean bufferfile
+
+ write reads from standard input into bufferfile in coordination with
+ read, which copies from bufferfile to standard output.
+ When supplied, handshake_timeout_secs specifies number of seconds
+ to wait for initial handshake.
+
+ select returns a zero exit code only when data are
+ available to read.
+ When supplied, handshake_timeout_secs specifies number of seconds
+ to wait for success.
+
+ clean removes coordination files that may remain when
+ read or write experiences abnormal termination.
+```
+
+*Building baton program*
+
+Create a file `baton_main_build.icn` containing:
+```
+$define baton_main main
+$include "baton_main.icn"
+```
+
+Then translate:
+
+```
+icont -u -o baton baton_main_build.icn # on Unix-like OSs
+icont -u -o baton.exe baton_main_build.icn # on MS Windows
+```
+
+The resulting program can be used as in the following (trivial) example:
+
+```
+ $include "fileDirIo.icn"
+ procedure main()
+ # Pass one line of data from output pipe to input pipe.
+ fsend := open("baton write buffer", "wp")
+ frecv := open("baton read buffer", "rp")
+ write(fsend, "hello world from " || &progname)
+ write(read(frecv))
+ close(fsend)
+ close(frecv)
+ end
+```
+
+However, the ordinary way to use this program is to have "baton write"
+stream one baton to the standard input of a process and to have "baton read"
+stream the standard output of a process to another baton,
+as demonstrated in the example for `baton_flatware` below.
+
+
+
+### procedure `baton_flatware(args) : fail | exit(0 | 1)`
+
+This procedure facilitates creation of a "multi-entry binary";
+specifically, it eliminates the necessity to create a distinct executable
+to use batons outside of the parent program's process.
+
+See `tests/test_baton_main.icn` for examples.
+
+This procedure diverts the control to `baton_main(args)` when:
+
+- `*args = 3`
+- `args[1]` is `"baton_main"`
+- `args[2]` is `"read" | "write" | "select" | "clean"`
+- `args[3]` is a string (to name a buffer)
+
+Otherwise, the procedure fails.
+
+This allows an executable program to have two behaviors:
+
+- Its "ordinary" behavior when not diverted to `baton_main`
+- The `baton_main` behavior, invoked by the "parent" instance of the executable.
+
+The following exemple demonstrates invocation of `baton_flatware(args)` from within `main(args)`:
+
+```
+ # example usage of baton_flatware; requires that sqlite3 is on PATH
+ $define BATON_TRACE if &fail then write
+ $define BATON_CWARN create repeat write(&errout, \@&source | "") | @&main
+ $define BATON_TIMEOUT_MS 200
+ $include "baton_main.icn" # implies include baton.icn and fileDirIo.icn
+ $define PLUGH "A hollow voice says \"plugh\"."
+ $define PLOVER "end of SQLite result list"
+ procedure main(args)
+ local baton_self # string to invoke child "flatware" via baton_flatware
+ local chunk # temporary holder for a string of data
+ local status # exit status of child process, captured from Cexit
+ local Cexit # co-expression producing exit code if child "flatware"
+ # has terminated; producing &null otherwise
+ local Crecv # co-expression to receive input from child "flatware"
+ local Csend # co-expression to send output to child "flatware"
+ # handle calls to baton_main; does not return; kind of like a fork...
+ baton_flatware(args)
+ # path to self is platform-specific; this has been minimally tested!
+ baton_self := &progname
+ if not (&features == "MS Windows" | path_separator() == baton_self[1])
+ then baton_self := "." || path_separator() || &progname
+ baton_self ||:= " baton_main "
+ # Exchange data with external process via batons.
+ # Launch process in background; if process dies, no SIGPIPE
+ # can reach us (see: https://unix.stackexchange.com/a/84828)
+ # which is good because Icon does not catch signals.
+ Cexit :=
+ system_nowait(
+ baton_self || " read buf_in | " ||
+ "sqlite3 -batch -json | " ||
+ baton_self || " write buf_out"
+ )
+ # Set up baton for standard output of process
+ Crecv := create baton("read", "buf_out", &main)
+ # Set up baton for standard input of process
+ # and activate baton so that it can receive a value
+ @( Csend := create baton("write", "buf_in", &main) )
+ # Send a command to SQLite, producing output
+ ".show" @Csend
+ # Send a query to SQLite, not producing any output
+ "select 'plover' where 1 = 0;" @Csend
+ # Send a query to SQLite to mark end-of-output
+ "select 'plugh' as xyzzy;" @Csend
+ # Retrieve lines until end-of-output mark (or closed pipe)
+ while chunk := @Crecv
+ do
+ if chunk == "[{\"xyzzy\":\"plugh\"}]"
+ then break write(PLUGH)
+ else write(chunk)
+ # Send "[]" to SQLite to mark end-of-output
+ ".print '[]'" @Csend
+ # Retrieve lines until end-of-output mark (or closed pipe)
+ while chunk := @Crecv
+ do
+ if chunk == "[]"
+ then break write(PLOVER)
+ else write(chunk)
+ # Close the output baton
+ char(4) @Csend
+ # Close the input baton to clean up baton files.
+ @Crecv
+ # Wait (briefly) for process exit and retrieve exit code.
+ every 1 to 5
+ do {
+ write("SQLite exit code: ", image(status := @Cexit))
+ if /status
+ then delay(BATON_TIMEOUT_MS)
+ else break
+ }
+ end
+```
+
+You will find another example under [`sl3.icn`](#sl3icn).
+
+
+
+### procedure `baton_crowbar() : n | stop()`
+
+Kill the program when `baton_flatware` is not linked (which is a
+programming error) to avert "infinite forking" that consumes all slots
+in the process table.
+
+This approach is imperfect since one may circumvent it with
+```
+ invocable all
+```
+or with
+```
+ invocable baton_flatware
+```
+
+---
+
+
+
+## batonsys.icn
+
+# procedure `baton_system() : V`
+
+`baton_system(basename, cmd, inC, outC) : BatonSys` (a VNom extension)
+
+- This procedure is a VNom initializer producing a VNom that implements
+ BatonSys message handling; i.e., BatonSys extends VNom (from `vnom.icn`)
+ such that BatonSys-specific messages are invoked via the vmsg procedure.
+- This procedure is supported by `VNomBatonSysCtor` and `VNomBatonSysMesg`,
+ neither of which need to be invoked directly. The BatonSys-specific
+ VNom messages (handled by `VNomBatonSysMesg`, as described below) are:
+ - `create`
+ - `send`
+ - `receive`
+ - `dispose`
+ - `select`
+
+# procedure `VNomBatonSysCtor() : V`
+
+`VNomBatonSysCtor(Original:T, Type:s, ID:s, Metatable:T, Disposable:n|x, Kind:s):BatonSys` (a VNom extension)
+
+- This procedure provides the implementation for `baton_system` initialiaztion.
+ VNom initializer producing a VNom that implements BatonSys
+ message handling; i.e., BatonSys extends VNom (from `vnom.icn`)
+ such that BatonSys-specific messages are invoked via the vmsg procedure.
+- `Original:T`
+ - If not null, a plain table, or another VNom (or extension
+ of VNom), from which values are copied.
+- `Type:s`
+ - "Type" property, if `&null` then Type of `\Original`;
+ default is `Kind || typecount`.
+- `ID:s`
+ - "ID" property; this is required (in contrast to VNom,
+ which synthesizes a default).
+- `Metatable:T`
+ - Table that maps message strings to message-handler procedures;
+ when `&null`, the metatable from Original is assigned, if available; otherwise,
+ a default metatable is created; in any event, the BatonSys messages.
+ are added to the metatable.
+- `Disposable:n?`
+ - Disposability flag; when not `&null`, a "Disposable" property is added and
+ set to "yes", to be switched to "done" when the VNom has been disposed.
+- `Kind:s` "Kind" property, defaults to "BatonSys".
+
+
+# procedure `VNomBatonSysMesg() : x`
+
+`VNomBatonSysMesg(args[]):x`
+
+- This procedure is a VNom message-handler extension for BatonSys messages.
+- Extensions to VNom messages:
+```
+ vmsg(V, "create", s, C, C ) : C # CreateProcess, producing result
+ # from system_nowait
+ # arg1: command string
+ # arg2: C providing stdin
+ # arg3: C receiving stdout
+ vmsg(V, "send", s ) : n # Send s to stdin of child pro-
+ # cess from system_nowait
+ vmsg(V, "receive" ) : s # Receive s from stdout of child
+ # process; not assignable
+ vmsg(V, "select" ) : n # Produce n if input is ever
+ # pending from stdout of child
+ # TODO determine when it's TRUE
+ vmsg(V, "dispose" ) : i # Terminate child process; produ-
+ # cing exit code
+```
+- Extensions to VNom state:
+```
+ buf_in - base filename for baton handling data to child stdin
+ buf_out - base filename for baton handling data from child stdout
+ cmd - system_nowait command string, minus baton pipes
+ status - "running" | "closed" | &null (disposed)
+ whichme - path to current executable
+ Cexit - co-expression producing child's exit code; otherwise, &null
+ Csend - co-expression providing stdin to child
+ Crecv - co-expression receiving stdin from child
+```
+
+---
+
+
## fieldedDataFile.icn
@@ -78,23 +498,23 @@ Produce record holding two co-expression factories:
- `lines` === tabularLines | iniLines
- `fields` === tabularFields | iniFields
-#### procedure `FieldedDataFactory(format, filePath)` : FieldedData
+### procedure `FieldedDataFactory(format, filePath) : FieldedData`
Produce a `FieldedData` record for `filePath` corresponding to format.
- `format == ("tabular" | "ini")`
-#### procedure `tabularLines(f)` : C
+### procedure `tabularLines(f) : C`
Factory for a co-expression producing logical lines of a tabular file `f`.
-#### procedure `tabularFields(line, sep)` : C
+### procedure `tabularFields(line, sep) : C`
Factory for a co-expression producing fields from a logical line of a tabular file:
- `line` is a logical line produced by `tabularLines`.
- `sep` is the field separator; if omitted or &null, TAB is used.
-#### procedure `getTabular(typeName, tsvPath, colL, sep, dflt)` : L
+### procedure `getTabular(typeName, tsvPath, colL, sep, dflt) : L`
Produce L of RecTable from a tabular file
@@ -104,76 +524,157 @@ Produce L of RecTable from a tabular file
- `sep` : (optional) separators, c
- `dflt` : (optional) default value for RecTable fields, x
-#### procedure `iniLines(f)` : C
+### procedure `iniLines(f)` : C
Factory for a co-expression producing logical lines of an INI file `f`.
-#### procedure `iniFields(line)` : C
+### procedure `iniFields(line) : C`
Factory for a co-expression producing fields from a logical line of an INI file
- `line` is a logical line produced by `iniLines`.
-#### procedure `getIni(ini)` : T (two dimensional)
+### procedure `getIni(ini) : T` (two dimensional)
Parse an INI file at path `ini` into a table of tables
+---
+
+
## fileDirIo.icn
Procedures to manipulate files, directores, and their paths.
-#### procedure `alterExtension(fn, old_ex, new_ex)` : s1, ...
+### procedure `alterExtension(fn, old_ex, new_ex) : s1, ...`
-Produce modified `fn`, substituting `new_ex` for `old_ex`
+Generate modified `fn`, substituting `new_ex` for `old_ex`
- If `new_ex` is "", the trailing period will be removed.
-#### procedure `directory_seq(name)` : s1, ...
+### procedure `cmd_separator() : s`
+
+Produce platform-specific command separator
+
+### procedure `directory_seq(name) : s1, ...`
+
+Generate name(s) that name a directory
+
+### procedure `home() : s`
+
+Produce platform-specific path to the HOME directory, if available
+
+### procedure `path_atoms(path) : s1, ...`
-Produce name(s) that name a directory
+Generate root, subdirectories, filename for a directory path
-#### procedure `prog_path_parts()` : s1, s2
+### procedure `path_constructP{exprs} : s1, ...`
-Suspend location then name of program file.
+Generate paths from sequences of results of exprs
-#### procedure `path_atoms(path)` : s1, ...
+- `exprs` are comma-separated and used to create a list of co-expressions.
-Suspend root, subdirectories, filename for a directory path
+### procedure `path_parts(qualname) : s1, s2`
-#### procedure `path_constructP{expr}` : s1, ...
+Generate location then name from path `qualname`
-Construct paths from sequences
+### procedure `path_separator() : s`
-#### procedure `cmd_separator()` : s
+Produce platform-specific path separator
-Return platform-specific command separator
+### procedure `prog_path_parts() : s1, s2`
-#### procedure `path_separator()` : s
+Generate location then name of program file.
-Return platform-specific path separator
+### procedure `pwd() : s`
-#### procedure `pwd()` : s
+Produce platform-specific path to the current directory
-Return platform-specific path to the current directory
+### procedure `system_nowait(command:s, title:s) : C`
+Run command, but do not wait for exit, producing result C
+
+- `command`, command to be passed to shell
+- `title`, title for background window, optional, for MS Windows
+- `@result` produces `&null` before command exits; exit code, after termination.
+ - Please invoke `@result` till it does not produce `&null` to
+ delete the file that holds the exit code.
+
+### procedure `tmpdir() : s`
+
+Produce platform-specific path to a tmp directory
+
+### procedure `tmppath() : s`
+
+Generate platform-specific temporary file path(s)
+
+### procedure `which(filename:s, all:n|x) : s1, ...`
+
+Generate full path(s) for filename on PATH
+
+- on Unix, results are first (or all when `\all`) for `which -a`.
+- on Windows, results are first (or all when `\all`) for `where`.
+
+---
+
+
## iimage.icn
Procedures to transform data structures into includable Icon declarations and statements.
-#### procedure `iimage(x)` : s
+### procedure `iimage(x)` : s
+
- Produce Icon code to reproduce value `x`, if possible
-#### procedure `idump(f, x[])` : (writes to `\f | &errout`)
+
+### procedure `idump(f, x[])` : (writes to `\f | &errout`)
+
- Write Icon code to reproduce values in list `x` to `f` if it is a file;
otherwise to `&errout` and `f` is discarded.
+---
+
+
+
+## jsonparse.icn
+
+Procedures to parse and generate JSON, by
+[Carl Sturtivant](https://www-users.cse.umn.edu/~carl/) ([OrcID 0000-0003-1528-4504](https://orcid.org/0000-0003-1528-4504))
+and [Gregg Townsend](https://www2.cs.arizona.edu/~gmt/).
+
+### procedure `json(L|T|i|n|r|s) : s`
+
+ - Takes data (list|table|integer|string|real|&null) and produces a JSON
+ string defining that data. It is an error to use another type, even
+ in substructures. See http://json.org/. To serialize other types,
+ see codeobj.icn from the Icon Programming Library.
+
+### procedure `jsonparse(s) : x`
+
+ - Takes a JSON string and produces the corresponding Icon value or
+ structure. Tables in such a structure will have default values of null.
+ JSON text containing true and false (booleans) will have those converted
+ to the strings "true" and "false" respectively.
+
+### procedure `jsonIconstringencoding(s) : n`
+
+ - Fixes the encoding of Icon strings (NOT quoted strings embedded in
+ JSON text) for all subsequent calls of json and jsonparse until
+ jsonIconstringencoding is called again. The initial behavior of
+ json and jsonparse is as if `jsonIconstringencoding("UTF-8")` has
+ been called. Fails unless `map(s)` is either "utf-8" or "utf8" or
+ "latin1" or "latin-1".
+
+---
+
+
## LiComboP.icn
Procedures to suspend lists combining sequences.
-#### procedure `LiP(A)` : L1, ...
+### procedure `LiP(A) : L1, ...`
+
- Suspend lists combining infinite sequences. LiP:
- evaluates in a "breadth first" manner to ensure that all values of finite
sequences will eventually be produced even when some sequences are infinite.
@@ -181,18 +682,50 @@ Procedures to suspend lists combining sequences.
- uses wora(LiP) to determine whether to use LiFiniteP
(the default) or nAltP to combine memoized results.
- requires that `wora.icn` be previously included, for wora(id)
-#### procedure `LiFiniteP(LofC)` : L1, ...
+
+### procedure `LiFiniteP(LofC) : L1, ...`
+
- Recursively suspend lists combining finite seqs;
- does not enforce "breadth first" evaluation.
-#### procedure `nAltP(LofC)` : L1, ...
+
+### procedure `nAltP(LofC) : L1, ...`
+
- Recurrently suspend lists combining finite seqs;
- does not enforce "breadth first" evaluation.
+---
+
+
+
+## lindel.icn
+
+In-place delete or insert of a pseudo-section of L.
+
+### procedure `Ldelete(L, i, j) : L`
+
+Delete indexes `i` to `j` from `L` (in-place), producing `L`
+
+### procedure `Linsert(L, i, Lins) : L`
+
+Insert list `Lins` into `L` (in-place) before index `i`, producing `L`
+
+- use i = 0 when L is empty
+
+### procedure `Lfind(L, x) : i1, i2, ...`
+
+Generate indices where `x` appears in `L`
+
+---
+
+
+
## RecTable.icn
Procedures to produce/manipulate record-like tables.
-### procedure `RecTable(rec_name_s, rec_fields_L, rec_data_L, rec_default_x)` : T
+See also: `vnom.icn` below for another, potentially more flexible approach.
+
+### procedure `RecTable(rec_name_s, rec_fields_L, rec_data_L, rec_default_x) : T`
Produce a table with record-like aspects:
@@ -203,7 +736,7 @@ Produce a table with record-like aspects:
defaults to all
- `rec_default_x`: default value for table members
-### procedure `RecTableType(x)` : s1, S2, s3, ...
+### procedure `RecTableType(x) : s1, S2, s3, ...`
For RecTable, produce:
@@ -213,31 +746,31 @@ For RecTable, produce:
For non-RecTable, return type(x).
-### procedure `RecTableFields(x)` : s1, ...
+### procedure `RecTableFields(x) : s1, ...`
Produce RecTable's field names.
- This will fail for a non-RecTable.
-### procedure `RecTableFieldsL(x)` : L
+### procedure `RecTableFieldsL(x) : `L
Return a list of the values produced by RecTableFields(x).
- This returns an empty list when x is not a RecTable instance.
-### procedure `RecTableFieldVals(x)` : s1, ...
+### procedure `RecTableFieldVals(x) : s1, ...`
Produce RecTable's field values.
- This will fail for a non-RecTable.
-### procedure `RecTableFieldValsL(x)` : L
+### procedure `RecTableFieldValsL(x) : L`
Return a list of the values produced by RecTableFieldVals(x).
- This returns an empty list when x is not a RecTable instance.
-### procedure `RecTableColTypeCheck(x, type_name, col_name, preamble)` : x
+### procedure `RecTableColTypeCheck(x, type_name, col_name, preamble) : x`
Return x, except abort when x is not instance of `type_name`:
@@ -247,7 +780,7 @@ Return x, except abort when x is not instance of `type_name`:
- `preamble` : initial string for error message; defaults value of name
RecTablePreamble.
-### procedure `RecTableConstructorC(rec_name_s, rec_fields_L, rec_default_x)` : C
+### procedure `RecTableConstructorC(rec_name_s, rec_fields_L, rec_default_x) : C`
Produce a C that, when receiving a transmitted list of values (of the
same length as `rec_fields_L`), produces a RecTable instance:
@@ -258,10 +791,13 @@ same length as `rec_fields_L`), produces a RecTable instance:
defaults to all
- `rec_default_x` default value for table members
+---
+
+
## rpn.icn
-Procedures to embed RPN-based (Forth-like) interpreter into Icon programs; can also be run in REPL.
+Procedures to embed RPN-based (Forth-like) interpreter into Icon programs; can also be run in a [REPL](https://en.wikipedia.org/wiki/Read%E2%80%93eval%E2%80%93print_loop).
This file may be used to embed RPN-scripted access to Icon procedures
and operators, in a manner reminiscent of Forth.
@@ -329,6 +865,10 @@ LPATH=~/src/aceincl rlwrap icon -P '
```
then you can get proper interpretation of the arrow keys in the REPL loop.
+---
+
+
+
## runningStats.icn
These procedures support computing summary statistics for normally
@@ -337,30 +877,34 @@ from Wikipedia.
ref: [https://en.wikipedia.org/wiki/Algorithms\_for\_calculating\_variance#Welford's\_online\_algorithm](https://en.wikipedia.org/wiki/Algorithms_for_calculating_variance#Welford%27s_online_algorithm)
-record `welford_running(count, mean, M2)`
+### record `welford_running(count, mean, M2)`
- record accumulating online results without persisting raw data
-record `welford_cumulative(n, mean, variance, sampleVariance, SD, SE)`
+### record `welford_cumulative(n, mean, variance, sampleVariance, SD, SE)`
- record of statistical results extracted from `welford_running`
-procedure `welford_new()`
+### procedure `welford_new()`
- produce an initialized `welford_running` record
-procedure `welford_add(W, x)`
+### procedure `welford_add(W, x)`
- produce an updated `welford_running` record
- `W` a `welford_running` record
- `x` the next value to add to the record
-procedure `welford_get(welford_running)`
+### procedure `welford_get(welford_running)`
- produce `welford_cumulative` record summarizing normal statistics
for the series of x provided to `welford_add`
- `welford_running` a `welford_running` record updated by `welford_add`
+---
+
+
+
## selectRecordFromListByField.icn
Procedure to produce records from a list of records (or a list of tables), matching specified criteria.
@@ -370,19 +914,226 @@ Procedure to produce records from a list of records (or a list of tables), match
- For a better way to do this, see [fix_selectRecordFromListByField.icn](https://sourceforge.net/p/unicon/mailman/attachment/CACb17F7MTimKsVuYS0LCmB6CpuE1pLvTZBtdCiNZRJEzFsFeKA%40mail.gmail.com/1/), which I will eventually apply here instead.
- Even so, there is yet the need to incorporate a "fuzzy binary search" to speed things up immensely for larger lists or tables.
-#### procedure `selectRecordFromListByField(Lfrom, sField, Ctest)` : R1, ...
+### procedure `selectRecordFromListByField(Lfrom, sField, Ctest) : R1, ...`
- Produce matching records (or tables) `X`
- from list `Lfrom` (`type(Lfrom[i]) == "record" | "table"`)
- where `X[sField] @ Ctest` succeeds
-#### procedure `selectRecordFromListByFieldL(Lfrom, sFieldL, Ctest)` : R1, ...
+### procedure `selectRecordFromListByFieldL(Lfrom, sFieldL, Ctest) : R1, ...`
- Produce matching records (or tables) `X`
- from list `Lfrom` (`type(Lfrom[i]) == "record" | "table"`)
- where this succeeds:
`L := []; every put(L, X[!sFieldL]); L @ Ctest`
+---
+
+
+
+## sl3.icn
+
+Interface to exchange commands and results with `sqlite3`, which must be on PATH.
+
+`sl3.icn` defines an interface to the sqlite3 command line interface,
+which is described in detail at https://sqlite.org/cli.html
+
+No generalized process interface exists in the basic Icon implementation
+and library that would allow access to both the standard input and the
+standard output of a child process, this interface uses the `baton`
+inteface via `baton.icn`, `baton_main.icn`, and `batonsys.icn` to hand
+data back and forth between Icon and sqlite3 without resorting to such
+platform-specific devices such as FIFOs or named-pipes.
+
+For convenience, if the symbol `sl3` is not defined by the preprocessor
+before `sl3.icn` is included, then it is defined as `sl3Msg`:
+
+```
+$ifndef sl3
+ $define sl3msg sl3
+$endif
+```
+
+`sl3new(path, options, errC) : VNom` (a SQLite3 connection)
+ - This is a synonym for `sl3(&null, "open", path, options, errC)`
+ - See below for details of the "open" message.
+
+`sl3Msg(conn:SQLite3, message, arg1, arg2, arg3) : x`
+ - takes as its first argument, a "database connection" that is a
+ "SQLite3" VNom (or `&null` when the message is "open").
+ - takes as its second argument an operation message string, which is:
+ - either one of `"open" | "prepare" | "fetch" | "close"`
+ - or "the default key", a prepared statement or SQL string.
+ - The value produced depends on the signature invoked.
+
+The signatures of sl3 messages are as follows:
+
+```
+ sl3(&null, "open", path, options, errC ) : VNom (a SQLite3 conn)
+ sl3(conn, "prepare", stmt ) : VNom (a prep_stmt)
+ sl3(conn, stmt:s, parmL:L, errC ) : n|fail
+ sl3(conn, prep_stmt:V, &null|x, errC ) : n|fail
+ sl3(conn, "fetch" ) : VNom (a result row)
+ sl3(conn, "close", errC ) : &null
+```
+
+You can find some examples with (modest) error handling in `sl3tests/test_sl3_02.icn`.
+
+In lieu of a detailed description of each signature (which may be found the header of `sl3.icn`), here is a working example, which emphasizes several ways of passing parameters to prepared statements.
+
+```
+$include "fileDirIo.icn"
+$include "vnom.icn"
+$include "jsonparse.icn"
+$include "sl3.icn"
+$define ERR_OFFSET [0, -1][2]
+$define DISPOSE_ON_ERROR if write(trace_reset(err_off)) then dispose(cnxn, errC)
+global g_exit_code
+procedure main(args)
+ local cnxn, path_s, options_s, errC, chunk, err_off, prep_stmt
+ # don't forget this or infinite forks will fill the process space...
+ baton_flatware(args)
+ # set exit code for premature termination
+ g_exit_code := -1
+ # create co-expression to handle error strings
+ @(errC := create while write(@ &source))
+ # open sqlite and establish baton
+ path_s := ":memory:"
+ options_s := &null
+ # open database connection
+ # signature: sl3new(path, options, errC) : VNomSQLite3
+ # === sl3(connection, "open", path, options, errC) : VNomSQLite3
+ if not (cnxn := sl3new(path_s, options_s, errC))
+ then stop("failed to open connection")
+ err_off := ERR_OFFSET
+
+ # execute SQL immediately, without parameters
+ # signature: sl3(conn, stmt:s, &null, errC) : n|fail
+ sl3(cnxn,
+ "CREATE TABLE invent(desc text, number integer, amount float);", , errC)
+ DISPOSE_ON_ERROR
+ # execute dot command immediately
+ sl3(cnxn, ".dump", , errC)
+ DISPOSE_ON_ERROR
+ # show result lines, which are not rows from a SQL query
+ every chunk := sl3(cnxn, "fetch") do write_ordered_values(chunk)
+
+ # initialize first prepared statement, which has named parameters
+ # signature: sl3(conn, "prepare", stmt) : VNom (a prep_stmt)
+ prep_stmt := sl3(cnxn, "prepare",
+ "INSERT INTO invent VALUES(@desc, @number, @amount);")
+ DISPOSE_ON_ERROR
+ # set parameters for first prepared statement
+ vmsg(prep_stmt, "put", "@desc", "a description")
+ vmsg(prep_stmt, "put", "@number", 42)
+ vmsg(prep_stmt, "put", "@amount", 3.14159)
+ # execute first prepared statment
+ # signature: sl3(conn, prep_stmt:V, &null, errC ) : n|fail
+ if not sl3(cnxn, prep_stmt, , errC) then {
+ write("test one: execute prepared statement with named parameters failed")
+ dispose(cnxn, errC)}
+
+ # initialize second prepared statement, which has named and unnamed parameters
+ # signature: sl3(conn, "prepare", stmt) : VNom (a prep_stmt)
+ prep_stmt := sl3(cnxn, "prepare", "INSERT INTO invent VALUES(?, ?3, ?2);")
+ DISPOSE_ON_ERROR
+ # set parameters for second prepared statement
+ vmsg(prep_stmt, "put", "?1", "another description")
+ vmsg(prep_stmt, "put", "?2", 1066)
+ vmsg(prep_stmt, "put", "?3", 1.414214)
+ # execute second prepared statment
+ # signature: sl3(conn, prep_stmt:V, &null, errC) : n|fail
+ if not sl3(cnxn, prep_stmt, , errC)
+ then {
+ write("test two: execute prepared statement with unnamed parameters failed")
+ dispose(cnxn, errC)}
+ DISPOSE_ON_ERROR
+
+ # execute SQL with implicit prepared statement and with L of unnamed params
+ # signature: sl3(conn, stmt:s, parmL:L, errC) : n|fail
+ if not sl3(cnxn, "INSERT INTO invent VALUES(?, ?, ?);",
+ ["foobar", 2401, 21.0/7], errC)
+ then { write("test three: execute implicit prepared statement failed")
+ dispose(cnxn, errC)}
+ DISPOSE_ON_ERROR
+
+ # execute SQL without params
+ # signature: sl3(conn, stmt:s, &null, errC) : n|fail
+ sl3(cnxn, "select * from invent;", , errC)
+ DISPOSE_ON_ERROR
+ # show results from previous SQL
+ write("---")
+ every chunk := sl3(cnxn, "fetch") do {
+ write_vnom_fields(chunk)
+ write("---")}
+
+ # set exit code for normal termination
+ g_exit_code := 0
+ &error := 0
+ # stop sqlite3 and shut down the batons
+ dispose(cnxn, errC)
+end
+procedure dispose(cnxn, errC)
+ # stop sqlite3 and shut down the batons
+ sl3(cnxn, "close", errC) | write("sl3 \"close\" failed")
+ write(" batonsys disposition: ", image(cnxn["disposition"]))
+ exit(g_exit_code)
+end
+procedure trace_reset(error_offset)
+ local result
+ result := ""
+ if &error = 0 then fail
+ if (&error < error_offset) then {
+ result ||:= "There were " || error_offset - &error || " errors; "
+ result ||:= "last error " || &errornumber || " - " || &errortext
+ &error := error_offset
+ return result
+ }
+ &error := error_offset
+end
+procedure write_vnom_fields(chunk, f)
+ local i
+ /f := &output
+ # row fields are ordered by VNom key
+ every i := vmsg(chunk, "key") do write(f, " ", i, ": ", chunk[i])
+ return
+end
+procedure write_ordered_values(chunk, f)
+ local i
+ /f := &output
+ # results of commands are ordered by a discardable integer key
+ every i := key(chunk) do if i ~=== chunk then write(f, " ", chunk[i])
+ return
+end
+```
+
+which produces as output:
+
+```
+ PRAGMA foreign_keys=OFF;
+ BEGIN TRANSACTION;
+ CREATE TABLE invent(desc text, number integer, amount float);
+ COMMIT;
+---
+ desc: a description
+ number: 42
+ amount: 3.14159
+---
+ desc: another description
+ number: 1.414214
+ amount: 1066.0
+---
+ desc: foobar
+ number: 2401
+ amount: 3.0
+---
+ batonsys disposition: 0
+```
+
+---
+
+
+
## vnom.icn
"Nominal vector", i.e., a list whose elements may be accessed by rank (index) or name (key).
@@ -399,7 +1150,7 @@ a reference to the metatable rather than making a copy of the metatable.
Thus, behavior of the set of instances may (even dynamically) be modified
by changing a single structure.
-#### procedure `vnew(Original:T, Type:s, ID:s, Metatable:T, Disposable:s, Kind:s) : V`
+### procedure `vnew(Original:T, Type:s, ID:s, Metatable:T, Disposable:s, Kind:s) : V`
Construct a new VNom instance.
@@ -418,31 +1169,41 @@ Construct a new VNom instance.
- `Kind:s`
- Kind property
-#### procedure `vmsg(VNom:V, Message:s, args[]) : x`
+### procedure `vmsg(VNom:V, Message:s, args[]) : x`
Send messages to update or interrogate the VNom instance.
- - `vmsg(V, "!" ) : x1, ... # generate values in order keys in L`
- - `vmsg(V, "*" ) : i # produce number of values `
- - `vmsg(V, "get" | "pop" ) : x # pop value, discarding key `
- - `vmsg(V, "pull" ) : x # pull value, discarding key `
- - `vmsg(V, "push", x1, x2) : V # push value with key `
- - `vmsg(V, "put", x1, x2) : V # put value with key `
- - `vmsg(V, "key" ) : x1, ... # generate keys in order keys in L `
- - `vmsg(V, "keylist" ) : L # copy of L of ranked keys `
- - `vmsg(V, "bykey", x ) : s # value, assignable by key `
- - `vmsg(V, "byrank", i ) : s # value, assignable by rank (index) `
- - `vmsg(V, "kind" ) : s # Kind property, assignable `
- - `vmsg(V, "id" ) : s # ID property, assignable `
- - `vmsg(V, "type" ) : s # Type property, assignable `
- - `vmsg(V, "image" ) : s # image property `
- - `vmsg(V, "metatable" ) : s # Metatable, assignable `
- `
+ - `vmsg(V, "!" ) : x1, ... # generate values in order keys in L `
+ - `vmsg(V, "*" ) : i # produce number of values `
+ - `vmsg(V, "get" | "pop" ) : x # pop value, discarding key `
+ - `vmsg(V, "copy" ) : V # produce copy of V with same metatable`
+ - `vmsg(V, "pull" ) : x # pull value, discarding key `
+ - `vmsg(V, "push", xk, xv) : V # push (or replace) value x2 for key x1`
+ - `vmsg(V, "put", xk, xv) : V # put (or replace) value x2 for key x1 `
+ - `vmsg(V, "key" ) : x1, ... # generate keys in order keys in L `
+ - `vmsg(V, "keylist" ) : L # copy of L of ranked keys `
+ - `vmsg(V, "bykey", x ) : s # value, assignable by key `
+ - `vmsg(V, "byrank", i ) : s # value, assignable by rank (index) `
+ - `vmsg(V, "delbykey", x ) : n # delete value by key `
+ - `vmsg(V, "delbyrank", i ) : n # delete value by rank `
+ - `vmsg(V, "strings" ) : s # generate string showing each KVP `
+ - `vmsg(V, "disposable" ) : s # disposable property `
+ - `vmsg(V, "id" ) : s # ID property, assignable `
+ - `vmsg(V, "image" ) : s # image property `
+ - `vmsg(V, "kind" ) : s # Kind property, assignable `
+ - `vmsg(V, "metatable" ) : s # Metatable, assignable `
+ - `vmsg(V, "strings" ) : s # generate a string to show each KVP `
+ - `vmsg(V, "type" ) : s # Type property, assignable `
+
+---
+
+
+
## wora.icn
Procedure to produce a value that can be read globally but can be reset only by the co-expression that set it it initially.
-#### procedure `wora(id,del)` : x (lvalue or rvalue)
+### procedure `wora(id,del)` : x (lvalue or rvalue)
- Set or read a globally visible read-only value,
- which is resettable by the C that creates it.
- `id` identifies the value; it is a key to a static table.
@@ -450,13 +1211,15 @@ Procedure to produce a value that can be read globally but can be reset only by
- Otherwise, this argument is ignored.
-
+---
+
+
-## Legacy Source Code Control
+## Legacy Source Code Control Problems
If you are still using Git rather than [the best thing since CVS](https://fossil-scm.org), then you may need the following to recover from the mess that Git Submodule can create if you are not *very* careful.
-## Git Submodule - some practical reminders
+### Git Submodule - some practical reminders
Reference: [http://openmetric.org/til/programming/git-pull-with-submodule/](http://openmetric.org/til/programming/git-pull-with-submodule/)
diff --git a/RecTable.icn b/RecTable.icn
index 95fd4e9..632b9eb 100644
--- a/RecTable.icn
+++ b/RecTable.icn
@@ -1,3 +1,5 @@
+$ifndef _RecTable_
+$define _RecTable_
############################################################################
#
# File: RecTable.icn
@@ -65,8 +67,6 @@
# RecTablePreamble.
#
############################################################################
-$ifndef _RecTable_
-$define _RecTable_
$ifndef RecTablePreamble
$define RecTablePreamble "\n File " || &file || "; Line " || &line || ":\n Bad Argument ==> "
diff --git a/fieldedDataFile.icn b/fieldedDataFile.icn
index 99b888b..a936e39 100644
--- a/fieldedDataFile.icn
+++ b/fieldedDataFile.icn
@@ -1,3 +1,5 @@
+$ifndef _fieldedDataFile_
+$define _fieldedDataFile_
############################################################################
#
# File: fieldedDataFile.icn
@@ -54,14 +56,11 @@
# Produce a table of table from an INI file
#
############################################################################
-$ifndef _fieldedDataFile_
-$define _fieldedDataFile_
$ifndef _RecTable_
-$error Must include RecTable.icn for procedure RecTableConstructorC
+$include "RecTable.icn"
$endif
-
# FieldedData organizes functions that create co-expressions producing
# logical lines and fields within a logical line from tabular data
record FieldedData(lines, fields) #: record holding two co-expression factories
diff --git a/fileDirIo.icn b/fileDirIo.icn
index ece2da8..9112725 100644
--- a/fileDirIo.icn
+++ b/fileDirIo.icn
@@ -1,4 +1,5 @@
-
+$ifndef _fileDirIo_
+$define _fileDirIo_
############################################################################
#
# File: fileDirIo.icn
@@ -19,38 +20,79 @@
############################################################################
#
# procedure alterExtension(fn, old_ex, new_ex) : s1, ...
-# Produce modified fn, substituting new_ex for old_ex
+# Generate modified fn, substituting new_ex for old_ex
+# - If `new_ex` is "", the trailing period will be removed.
+#
+# procedure cmd_separator() : s
+# Produce platform-specific command separator
#
# procedure directory_seq(name) : s1, ...
-# Produce name(s) that name a directory
+# Generate name(s) that name a directory
#
-# procedure prog_path_parts() : s1, s2
-# suspend location then name of program file.
+# procedure home() : s
+# Produce platform-specific path to the HOME directory, if available.
#
# procedure path_atoms(path) : s1, ...
-# suspend root, subdirectories, filename for a directory path
+# Generate root, subdirectories, filename for a directory path
#
-# procedure path_constructP{expr} : s1, ...
-# construct paths from sequences
+# procedure path_constructP{exprs} : s1, ...
+# Generate paths from sequences of results of exprs.
+# - `exprs` are comma-separated and used to create a list of
+# co-expressions.
#
-# procedure cmd_separator() : s
-# return platform-specific command separator
+# procedure path_parts(qualname) : s1, s2
+# Generate location then name from path.
#
# procedure path_separator() : s
-# return platform-specific path separator
+# Produce platform-specific path separator
+#
+# procedure prog_path_parts() : s1, s2
+# Generate location then name of program file.
#
# procedure pwd() : s
-# return platform-specific path to the current directory
+# Produce platform-specific path to the current directory
+#
+# procedure system_nowait(command:s, title:s) : C
+# Run command, but do not wait for exit, producing result C
+# - `command`, command to be passed to shell
+# - `title`, title for background window, optional, for MS Windows
+# - `@result` produces `&null` before command exits; exit code after
+# - Please invoke `@result` till it does not produce `&null` to
+# delete the file that holds the exit code.
+#
+# procedure tmpdir() : s
+# Produce platform-specific path to a tmp directory
+#
+# procedure tmppath(suffix:s, len:s) : s1, ...
+# Generate temporary file paths
+#
+# procedure which(filename:s, all:n|x) : s1, ...
+# Generate full path(s) for filename on PATH
+# - on Unix, results are first (or all when `\all`) for `which -a`.
+# - on Windows, results are first (or all when `\all`) for `where`.
#
############################################################################
#
-# links: regexp
+# requires:
+# - pipes
+# - Windows or Linux/MacOS/Unix
+#
+############################################################################
+#
+# links: regexp, strings
#
############################################################################
-$ifndef _fileDirIo_
-$define _fileDirIo_
link regexp # for regular expressions to support alterExtension
+link strings # for replace(s1, s2, s3)
+ # replaces all occurrences of s2 in s1 by s3; fails
+ # if s2 is null.
+
+$define FILEDIRIO_MSWINDOWS (&features == ("MS Windows NT" | "MS Windows"))
+
+$ifndef FILEDIRIO_TRACE
+$define FILEDIRIO_TRACE if &fail then write
+$endif # FILEDIRIO_TRACE
procedure alterExtension(fn, old_ex, new_ex) #: change extension of file name
ReCaseIndependent()
@@ -65,19 +107,39 @@ end
# adapted from IPL proc io.icn
procedure directory_seq(name) #: suspend name(s) when a directory
- suspend (close(open(name || "/.")), name)
+ suspend (close(open(name || path_separator() || ".")), name)
+end
+
+procedure home() #: return platform-specific path to the home directory, if available
+ local C, x, cmd
+ static is_mswin
+ initial is_mswin := FILEDIRIO_MSWINDOWS
+ if \is_mswin
+ then
+ return map(getenv("HOMEDRIVE"), string(&lcase), string(&ucase)) ||
+ getenv("HOMEPATH")
+ else
+ return getenv("HOME")
end
# inspired by IPL proc io.icn
procedure prog_path_parts() #: suspend location then name of program file.
+ local i, prog_name
+ prog_name := which(&progname) | &progname
+ suspend path_parts(prog_name)
+end
+
+# inspired by IPL proc io.icn
+procedure path_parts(qualname) #: suspend location then name from path.
local i
- &progname ? every i := find(path_separator())
+ qualname ? every i := find(path_separator())
if /i
- then suspend pwd()
- else suspend &progname[1:i]
- if /i
- then suspend &progname
- else suspend &progname[i+1:0]
+ then {
+ suspend pwd() | qualname
+ fail
+ }
+ suspend &progname[1:i]
+ suspend &progname[i+1:0]
end
# inspired by IPL proc io.icn
@@ -121,31 +183,182 @@ procedure path_constructP(atoms) #: construct paths from sequences
end
procedure cmd_separator() #: return platform-specific command separator
- $ifdef _MS_WINDOWS
- return "&"
- $else
- return ";"
- $endif
+ static is_mswin
+ initial is_mswin := FILEDIRIO_MSWINDOWS
+ return if \is_mswin then "&" else ";"
end
procedure path_separator() #: return platform-specific path separator
- $ifdef _MS_WINDOWS
- return "\\"
- $else
- return "/"
- $endif
+ static is_mswin
+ initial is_mswin := FILEDIRIO_MSWINDOWS
+ #ACE if \is_mswin then every write(&errout, &features)
+ return if \is_mswin then "\\" else "/"
end
procedure pwd() #: return platform-specific path to the current directory
- $ifdef _MS_WINDOWS
- local C, x, cmd
- cmd := "cd"
- C := create x := open(cmd, "pr") & !x@&source | close(x) & &fail
- while x := @C
- return x
- $else
+ local C, x, cmd
+ static is_mswin
+ initial is_mswin := FILEDIRIO_MSWINDOWS
+ if \is_mswin
+ then {
+ return 2(
+ x := open("cmd /c echo %CD%", "pr"),
+ read(x),
+ close(x)
+ )
+ }
+ else
return getenv("PWD")
- $endif
+ stop("fileDirIo.icn: FATAL pwd() did not produce current directory")
+end
+
+procedure system_nowait(command, title) #: run command, do not wait for exit
+ # result:C - C produces &null before command terminates; exit code after
+ # command:s - command to be passed to shell
+ # title:s - title for background window, optional, only for MS Windows
+ static win_unicon # not &null when running Unicon on Microsoft Windows
+ static portableIcon # not &null when running protableIcon on MS Windows
+ local f # system command with escaped double quotes
+ local rslt # C producing exit code, or null if not yet available
+ local exit_code # integer exit code or null if not yet available
+
+ initial {
+ win_unicon := (&features == "MS Windows NT", &features == "POSIX")
+ portableIcon := (
+ &features == "MS Windows",
+ &features == "Cygwin"
+ , not (&features == "MS Windows NT")
+ , not (&features == "POSIX")
+ , not (&features == "UNIX")
+ , 1
+ )
+ }
+
+ rslt := tmppath()
+ if \win_unicon | \portableIcon
+ then { # unicon or portableIcon on Microsoft Windows NT
+ f := 0
+ command ? every upto('"') do f +:= 1
+ 0 = f % 2 |
+ stop(
+ "fileDirIo.icn: argument for system_async cannot ",
+ "contain odd number of double quotes.\n ",
+ command, "\n There are ", f, " double quotes."
+ )
+ /title := tmppath(, , "")
+
+ f := "start \"" || title || "\" /b cmd /c \"(" ||
+ command || ") ^& (echo %ERRORLEVEL% > \"" || rslt || "\") \""
+ FILEDIRIO_TRACE(&errout, "background task: ", f)
+ if 0 ~= system(f)
+ then fail
+ }
+ else { # regular Icon
+ f := replace(command, "\"", "\\\"") || "; echo $?> " || rslt
+ FILEDIRIO_TRACE(&errout, "(" || f || ") &")
+ if 0 ~= system("(" || f || ") &")
+ then fail
+ FILEDIRIO_TRACE(&errout, "returned from: ", "(" || f || ") &")
+ }
+ # return C producing exit code after exit, &null before exit
+ return create repeat {
+ FILEDIRIO_TRACE(&errout, "... Crslt scans file: ", rslt)
+ # when exit_code is null and result file can be opened
+ if (/exit_code, f := open(rslt, "r"))
+ then {
+ # get the exit code if it's available
+ # Does this block until process completes?
+ if exit_code := integer(read(f))
+ then {
+ # if file can be opened and read (containing an integer), then
+ # close and delete file
+ close(f)
+ remove(rslt)
+ }
+ else {
+ # otherwise, close but don't delete the file
+ close(f)
+ }
+ }
+ # produce either null or exit code
+ FILEDIRIO_TRACE(&errout, "... Crslt transmits: ", image(exit_code))
+ exit_code @&source
+ }
+end
+
+procedure tmpdir() #: return platform-specific path to a tmp directory
+ # note: both procs/io.icn and procs/popen.icn in IPL define tempfile
+ # nothing in IPL defines tmpfile, tmpdir, or tempdir
+ static is_mswin
+ initial is_mswin := FILEDIRIO_MSWINDOWS
+ return if \is_mswin
+ then
+ # there are only two possibilities of success on Windows
+ return getenv("TMP" | "TEMP") || path_separator()
+ else
+ # inspired by answers to https://unix.stackexchange.com/q/352107
+ # because some unixes do not define TMPDIR, TMP, or TEMP
+ return (getenv("TMPDIR" | "TMP" | "TEMP") | "/tmp") || path_separator()
+end
+
+procedure tmppath(suffix, len, dir) #: generate temporary file paths
+ initial {
+ # core of randomize() in procs/random.icn in IPL
+ &random :=
+ map("sSmMhH", "Hh:Mm:Ss", &clock) +
+ map("YyXxMmDd", "YyXx/Mm/Dd", &date) +
+ &time
+ }
+ # core of tempname(...) in procs/io.icn
+ /suffix := "tmp"
+ /len := 8
+ /dir := tmpdir()
+ suspend 2(
+ ?1, # change &random
+ name := dir || "tmp" || left(&random, len, "0") || "." || suffix,
+ not close(open(name, "r"))
+ )
+end
+
+
+# procedure which(filename:s, all:n|x) : s1 | s2 | ...
+procedure which(filename, all) #: Generate full path(s) for filename on PATH
+ local f, path, pathsL
+ static whichcmd, stderrnull
+ initial {
+ $ifndef _UNIX
+ $ifdef _MS_WINDOWS # _MS_WINDOWS
+ $ifdef _MS_WINDOWS_NT # _MS_WINDOWS and _MS_WINDOWS_NT
+ whichcmd := "where "
+ stderrnull := " 2>NUL"
+ $else # _MS_WINDOWS but not _MS_WINDOWS_NT
+ whichcmd := "where "
+ stderrnull := " 2>NUL"
+ $endif
+ $else # neither _MS_WINDOWS nor _UNIX
+ $error 'Refusing to translate because platform has not been tested'
+ $endif
+ $else # _UNIX
+ whichcmd := "which -a "
+ stderrnull := " 2>/dev/null"
+ $endif
+ }
+ # initialize list of paths
+ pathsL := [ ]
+ # produce path matching filename (or paths if \all)
+ f := whichcmd || filename || stderrnull
+ f := open(f, "pr") | fail
+ # read(f) should produce something like "/usr/bin/mkfifo"
+ # produce path only if file exists at such a path
+ while path := read(f)
+ do put(pathsL, path)
+ close(f)
+ # only produce first path if all flag has not been set
+ if /all
+ then pathsL := [get(pathsL)]
+ # suspend paths until exhausted
+ suspend !pathsL
+ # fail once exhausted
end
$endif # _fileDirIo_
diff --git a/iimage.icn b/iimage.icn
index 585d209..03fff5f 100644
--- a/iimage.icn
+++ b/iimage.icn
@@ -1,3 +1,5 @@
+$ifndef _iimage_
+$define _iimage_
############################################################################
#
# File: iimage.icn
@@ -163,7 +165,6 @@
# such problems.
#
############################################################################
-$ifndef _iimage_
$ifndef SPCS
$define SPCS " "
@@ -404,5 +405,4 @@ procedure idump(f, x[]) #: write images of values in list x
return x[-1] | &null
end
-$define _iimage_
$endif # _iimage_
diff --git a/rpn.icn b/rpn.icn
index 5f80ffd..139e498 100644
--- a/rpn.icn
+++ b/rpn.icn
@@ -1,3 +1,5 @@
+$ifndef RPN_INTERPRETER
+$define RPN_INTERPRETER
############################################################################
#
# File: rpn.icn
@@ -1058,4 +1060,5 @@ procedure token( Cin )
}
end
+$endif # RPN_INTERPRETER
# vim: ai ts=2 sw=2 et :
diff --git a/runt.icn b/runt.icn
index 9fd4634..e3b1b77 100644
--- a/runt.icn
+++ b/runt.icn
@@ -37,26 +37,58 @@
#
############################################################################
#
-# links: popen, showtbl
+# links: showtbl
# requried includes: fileDirIo.icn
#
############################################################################
$include "fileDirIo.icn"
-$define USAGE "usage: icon runt.icn [--continue] [--verbose] dir_names"
+$include "lindel.icn"
+
+$define USAGE "usage: icon runt.icn [--continue] [--verbose] dir_names [test_names]"
$define USAGE1 " --continue: run other tests after a test fails"
$define USAGE2 " --verbose: trace test results"
$define USAGE3 " --help - print this message"
+$define USAGE4 "Any test_names supplied constitute an exclusive list of tests"
+$define USAGE5 "to run; e.g., to run only test_baton and test_baton_main, type:"
+$define USAGE6 " runt tests baton baton_main"
+
+#$define HIDE_CMDLINE &fail
+$define HIDE_CMDLINE &null
+#$define SHOW_TIMINGS &fail
+$define SHOW_TIMINGS &null
+
+$ifndef _UNIX
+ $ifdef _MS_WINDOWS # _MS_WINDOWS
+ $ifdef _MS_WINDOWS_NT # _MS_WINDOWS and _MS_WINDOWS_NT
+ # e.g., for Unicon on MS Windows
+ $define SET_LPATH "set LPATH=" || workingdir || "&& "
+ $else # _MS_WINDOWS but not _MS_WINDOWS_NT
+ # e.g., for portableIcon on MS Windows
+ # kludge: if PATH starts with a lowercase drive letter, path search
+ # fails; however, beginning with a semicolon hacks the issue away.
+ # This could not be addressed via smudge.cmd. Is it a Cygnal issue?
+ $define SET_LPATH "set PATH=;%PATH%&& set LPATH="||workingdir||"&& "
+ $endif
+ $else # neither _MS_WINDOWS nor _UNIX
+ # e.g. for unknown POSIX shell ...
+ $define SET_LPATH "LPATH=" || workingdir || " "
+ $endif
+$else # _UNIX
+ # e.g., for Linux, FreeBSD, or MacOS
+ $define SET_LPATH "LPATH=" || workingdir || " "
+$endif
-link popen # for procedure popen
link showtbl # for procedure showtbl
# flag that exit should produce error status even with --continue argument
-global failure
+global failure, portableIcon, win_unicon
# run all the test_*.icn for which there is a matching test_*.std
procedure main(args)
local abort # if !args == "--continue" then write else stop
+ local bespoke # names of individual tests to run rather than all
+ local cmd # scratch variable for tracing commands
local dir # one member of dirs
local dirEntry # entry in current working directory
local dirListing # names of files and subdirectores in CWD
@@ -77,53 +109,134 @@ procedure main(args)
write(USAGE1)
write(USAGE2)
write(USAGE3)
+ write(USAGE4)
+ write(USAGE5)
+ write(USAGE6)
exit(if *args < 1 then 1 else 0)
}
- traceout := if !args == "--verbose" then write else 2
- abort := if !args == "--continue" then write_abort else stop
+
+ traceout :=
+ if !args == "--verbose" then write else 2
+ abort :=
+ if !args == "--continue" then write_abort else stop
if traceout === 2
- then write( &errout, "To trace output, invoke as: icon "
- , &progname, " --verbose")
+ then
+ write( &errout, "To trace output, invoke as: icon "
+ , &progname, " --verbose")
+ else
+ every dir := Lfind(args, "--verbose")
+ do args := Ldelete(args, dir, )
if abort === stop
- then write( &errout, "To run all tests, invoke as: icon "
- , &progname, " --continue")
+ then
+ write( &errout, "To run all tests, invoke as: icon "
+ , &progname, " --continue")
+ else
+ every dir := Lfind(args, "--continue")
+ do args := Ldelete(args, dir, )
+ win_unicon := (&features == "MS Windows NT", &features == "POSIX")
+ portableIcon := (
+ &features == "MS Windows",
+ &features == "Cygwin"
+ , not (&features == "MS Windows NT")
+ , not (&features == "POSIX")
+ , not (&features == "UNIX")
+ , 1
+ )
+ if SHOW_TIMINGS & \win_unicon
+ then
+ write(&errout,
+ "Windows Unicon detected; pipes & co-expressions may fail")
+ else
+ if \win_unicon
+ then
+ write(&errout,
+ "Windows Unicon detected; pipe & co-expressions may fail")
# timing support
totalTime := -&time
timings := table(-1)
# dirs either lists the directory arguments or the current directory
dirs := []
- every put( dirs, directory_seq(!args) || "/" )
- if *dirs == 0 then dirs := put( dirs, "./" )
- workingdir := getenv("PWD")
+ every put(dirs, directory_seq(!args) || path_separator())
+ if *dirs == 0
+ then dirs := put( dirs, "." || path_separator())
+ # prepare for specification of individual tests, if any
+ bespoke := []
+ every testName := !args
+ do
+ if not directory_seq(testName)
+ then put(bespoke, "test_" || testName || ".icn")
+ workingdir := pwd() # getenv("PWD")
every dir := !dirs
do {
chdir(workingdir) | (
- write("Could not change to directory: ", workingdir) & next)
+ write("Could not change to working directory: ", workingdir) & next)
chdir(dir) | (write("Could not change to directory: ", dir) & next)
# For each file in the directory
every dirEntry := !(dirListing := open(".")) do {
# All paths should be relative to the directory-under-test
- # Assume it's a file if it begins with test; check tha it ends with .icn
+ # If "bespoke" is of length > 0, skip tests not in list
+ if (*bespoke > 0, not(dirEntry == !bespoke))
+ then next
+ # Assume it's a test file if its name begins with "test";
+ # check that it ends with ".icn"
if dirEntry ?
dirEntry == ( testName := ="test_" || tab(find(".icn")) ) || =".icn"
then (
# Write nothing unless we find a .std file
filExpected := open( testName || ".std")
# Report that we will run the test
- , write("\n", testName)
+ , write("::: Running ", testName)
, timings[testName] := -&time
# Prepare to generate the observed result lines
- , filObserved := popen( "icon " || testName || ".icn", "r")
+ , &trace := -1
+ #, write(&errout, "... ante")
+ , if \win_unicon # only for Unicon on Microsoft Windows NT
+ then (
+ remove(testName || ".bat") | 1,
+ remove(testName || ".exe") | 1,
+ system(SET_LPATH || "unicon -s -u " || testName || ".icn"),
+ delay(100),
+ system(testName || " > " || testName || ".out")
+ )
+ else if \portableIcon
+ then ( # portableIcon
+ system(
+ SET_LPATH || "icont -s -u " || testName ||
+ ".icn && call " || testName || ".bat" ||
+ " > " || testName || ".out"
+ )
+ )
+ else ( # Icon
+ if (
+ cmd <- SET_LPATH || "icont -s -u " || testName || ".icn",
+ HIDE_CMDLINE | write(&errout, " building: " || \cmd),
+ 0 = system(\cmd) | break failure := -1
+ #, write(&errout, "... building returned zero")
+ )
+ then (
+ cmd <- SET_LPATH || "./" || testName || " > " || testName || ".out",
+ HIDE_CMDLINE | write(&errout, " running: " || \ cmd),
+ 0 = system(\cmd) | break failure := -1
+ #, write(&errout, "... running returned zero"),
+ )
+ else break failure := -1
+ )
+ , &trace := 0
+ #, write(&errout, "... post")
+ , filObserved := open(testName || ".out", "r")
# Create a sequence of expected result lines
- , linObsC := create traceout("observed: ",!filObserved)
+ , linObsC := create traceout(" observed: ", !filObserved)
, linCount := 0
# For each observed result line, abort if expected line does not match
- , ( every linExpected := traceout("expected: ", !filExpected) do {
+ , ( every linExpected := traceout(" expected: ", !filExpected) do {
linCount +:= 1
# termination is premature if expected line is not observed
linObserved := @linObsC | (
abort( " ... line ", linCount
- , ": premature termination, expected: '", linExpected, "'"
+ , ": premature termination, expected: '"
+ , linExpected, "'"
+ , if /win_unicon then "" else
+ " (Windows Unicon pipe or co-expression may have failed.)"
)
, break
)
@@ -133,36 +246,49 @@ procedure main(args)
, linExpected ~== linObserved
, "' was produced but '"
, linExpected
- , "' was expected"
+ , "' was expected\n"
) & break
) | next
}
) | if linObserved := @linObsC
# report unexpected output
- then abort( " ... line ", linCount
- , ": unexpected output: '", linObserved, "'"
- )
- else timings[testName] +:= &time
+ then
+ abort( " ... line ", linCount
+ , ": unexpected output: '", linObserved, "'\n"
+ )
+ else {
+ timings[testName] +:= &time
+ write(" Passed")
+ }
)
+ remove(testName || ".out")
}
close(\dirListing)
}
- # from IPL procs showtbl.icn
- showtbl(
- "approx. runtimes, mS", # 1 title heading title ""
- timings, # 2 tbl table to be shown NO DEFAULT
- , # 3 sort_type type of sorting "ref"/"val"
- , # 4 limit lines of output infinite
- , # 5 sort_order increasing? "incr"/"decr"
- , # 6 posit first column "val"/"ref"
- 40, # 7 w1 width of 1st col 10
- , # 8 w2 width of 2nd col 10
- , # 9 gutter width between cols 3
- right, # 10 f1 f justify 1st col left
- left, # 11 f2 f justify 2nd col right
- )
- write("\nTotal testing time (milliseconds, within whatever resolution): ", totalTime +:= &time)
+ if SHOW_TIMINGS & /win_unicon
+ then{
+ # from IPL procs showtbl.icn
+ showtbl(
+ "approx. runtimes, mS", # 1 title heading title ""
+ timings, # 2 tbl table to be shown NO DEFAULT
+ , # 3 sort_type type of sorting "ref"/"val"
+ , # 4 limit lines of output infinite
+ , # 5 sort_order increasing? "incr"/"decr"
+ , # 6 posit first column "val"/"ref"
+ 40, # 7 w1 width of 1st col 10
+ , # 8 w2 width of 2nd col 10
+ , # 9 gutter width between cols 3
+ right, # 10 f1 f justify 1st col left
+ left, # 11 f2 f justify 2nd col right
+ )
+ write("\nTotal testing time (milliseconds, within whatever resolution): ", totalTime +:= &time)
+ }
+ if /failure
+ then {
+ write()
+ write("All tests passed. Yippee!!")
+ }
# exit code zero unless falure was encountered when abort === write_abort
exit( \failure | 0)
end
diff --git a/selectRecordFromListByField.icn b/selectRecordFromListByField.icn
index e102aa5..ee5757b 100644
--- a/selectRecordFromListByField.icn
+++ b/selectRecordFromListByField.icn
@@ -1,3 +1,5 @@
+$ifndef _selectRecordFromListByField_
+$define _selectRecordFromListByField_
############################################################################
#
# File: selectRecordFromListByField.icn
@@ -76,8 +78,6 @@
# }
#
############################################################################
-$ifndef _selectRecordFromListByField_
-$define _selectRecordFromListByField_
procedure selectRecordFromListByField(Lfrom, sField, Ctest) #: produce matching records (or tables)
# Lfrom - a list of either:
diff --git a/tests/test_LiComboP.icn b/tests/test_LiComboP.icn
index 403858a..d9f9e4e 100644
--- a/tests/test_LiComboP.icn
+++ b/tests/test_LiComboP.icn
@@ -1,5 +1,7 @@
-$include "../wora.icn"
-$include "../LiComboP.icn"
+# assume that LPATH includes ..
+
+$include "wora.icn"
+$include "LiComboP.icn"
procedure printtuple(ls[])
local C
diff --git a/tests/test_fieldedDataFile.icn b/tests/test_fieldedDataFile.icn
index 3cd3d0a..7272b77 100644
--- a/tests/test_fieldedDataFile.icn
+++ b/tests/test_fieldedDataFile.icn
@@ -1,7 +1,9 @@
-$include "../RecTable.icn"
-$include "../fieldedDataFile.icn"
-$include "../wora.icn"
-$include "../fileDirIo.icn"
+# assume that LPATH includes ..
+
+$include "RecTable.icn"
+$include "fieldedDataFile.icn"
+$include "wora.icn"
+$include "fileDirIo.icn"
$define prog_dir_path prog_path_parts() || path_separator()
link ximage
diff --git a/tests/test_fileDirIo.icn b/tests/test_fileDirIo.icn
index e140fd9..6fa5fb4 100644
--- a/tests/test_fileDirIo.icn
+++ b/tests/test_fileDirIo.icn
@@ -1,12 +1,20 @@
-$include "../fileDirIo.icn"
+# assume that LPATH includes ..
#$define DEBUG
+
$ifdef DEBUG
link ximage
+ $define DBGTRC if not &fail then write
+ $define FILEDIRIO_TRACE if not &fail then write
+$else
+ $define DBGTRC if &fail then write
+ $define FILEDIRIO_TRACE if &fail then write
$endif # DEBUG
+$include "fileDirIo.icn"
+
procedure main()
- local prgL, r, expected
+ local prgL, r, expected, f, Crslt
$ifdef DEBUG
local atmL
atmL := []
@@ -19,25 +27,47 @@ procedure main()
write("*prgL = ", *prgL)
$ifdef DEBUG
every put(atmL, path_atoms(&progname))
- write("prog_path_parts")
- write(ximage(prgL))
- write("path_atoms")
- write(ximage(atmL))
- write(&progname)
- write(path_constructP{path_atoms(&progname)})
+ DBGTRC(&errout, "prog_path_parts")
+ DBGTRC(&errout, ximage(prgL))
+ DBGTRC(&errout, "path_atoms")
+ DBGTRC(&errout, ximage(atmL))
+ DBGTRC(&errout, &progname)
+ DBGTRC(&errout, path_constructP{path_atoms(&progname)})
$endif # DEBUG
-
write("exercising directory_seq()")
directory_seq(prgL[1]) | stop("directory_seq failed for " || prgL[1])
write("found directory path where program is located")
+
+ write("exercising home()")
+ if not (r := home())
+ then write("home() failed")
+ else {
+ FILEDIRIO_TRACE(&errout, "home dir is " || r)
+ write("home() succeeded")
+ }
+ r := &null
+
write("exercising pwd()")
directory_seq(pwd()) | stop("directory_seq failed for " || pwd())
write("pwd() produced a valid directory path")
- write("exercising alterExtension()")
write("exercising path_atoms()")
+ if not path_atoms(&progname)
+ then stop("FAILURE")
+
write("exercising path_constructP()")
+ if not path_constructP{path_atoms(&progname)}
+ then stop("FAILURE")
+
+ DBGTRC(&errout, "path_constructP{path_atoms(&progname)} is:\n ",
+ path_constructP{path_atoms(&progname)}
+ )
+
+ DBGTRC(&errout, "prgL[1] is ", image(prgL[1]))
+ DBGTRC(&errout, "prgL[2] is ", image(prgL[2]))
+
+ write("exercising alterExtension()")
expected := prgL[2]
if path_constructP{path_atoms(&progname)} ?
r := ( =prgL[1], move(1), tab(0) )
@@ -48,9 +78,37 @@ procedure main()
, "\nobserved program name (without path or extension): ", r
)
}
- write(
- if r == expected then "success" else "FAILURE"
- )
+ if \r == expected
+ then write("success")
+ else stop("FAILURE")
+
+ write("exercising tmpdir() and tmppath()")
+ if (tmppath("foo"), tmppath("bar"))
+ then write("success")
+ else stop("FAILURE")
+
+ write("exercising system_nowait")
+ r := tmppath("foo")
+ DBGTRC(&errout, "result path: ", r)
+ Crslt := system_nowait(
+ "echo \"hello world\" \"with love from Mars and Venus\"> " || r
+ )
+ every 1 to 10
+ do
+ if write("exit code: ", \(@Crslt))
+ then break
+ else delay(100)
+
+ if f := open(r)
+ then {
+ DBGTRC(&errout, "begin every write(!f)")
+ every write(!f)
+ DBGTRC(&errout, "end every write(!f)")
+ close(f)
+ remove(r)
+ write("success")
+ }
+ else stop("FAILURE")
exit(0)
end
diff --git a/tests/test_fileDirIo.std b/tests/test_fileDirIo.std
index 0c2b251..72b4a5a 100644
--- a/tests/test_fileDirIo.std
+++ b/tests/test_fileDirIo.std
@@ -3,11 +3,19 @@ exercising prog_path_parts()
*prgL = 2
exercising directory_seq()
found directory path where program is located
+exercising home()
+home() succeeded
exercising pwd()
pwd() produced a valid directory path
-exercising alterExtension()
exercising path_atoms()
exercising path_constructP()
+exercising alterExtension()
expected program name (without path or extension): test_fileDirIo
observed program name (without path or extension): test_fileDirIo
success
+exercising tmpdir() and tmppath()
+success
+exercising system_nowait
+exit code: 0
+"hello world" "with love from Mars and Venus"
+success
diff --git a/tests/test_rpn.icn b/tests/test_rpn.icn
index eb70f82..668328b 100644
--- a/tests/test_rpn.icn
+++ b/tests/test_rpn.icn
@@ -1,6 +1,9 @@
# test rpn.icn routines and rpn_core.rpn words
$define DEBUG 1
-$include "../rpn.icn"
+
+# assume that LPATH includes ..
+
+$include "rpn.icn"
procedure main( )
local f
diff --git a/tests/test_runningStats.icn b/tests/test_runningStats.icn
index ebd5990..f4d76b4 100644
--- a/tests/test_runningStats.icn
+++ b/tests/test_runningStats.icn
@@ -1,6 +1,9 @@
-$include "../runningStats.icn"
+# assume that LPATH includes ..
+
+$include "runningStats.icn"
link ximage
+link numbers
# test case inspired by:
# https://rosettacode.org/wiki/Cumulative_standard_deviation#Icon_and_Unicon
@@ -8,5 +11,10 @@ procedure main()
local s, W, x
W := welford_running(0, 0, 0)
every s := welford_add(W, x := ![2,4,4,4,5,5,7,9])
- write(ximage(welford_get(W)))
+ x := welford_get(W)
+ # brittle hack to make Unicon (quad precision) match Icon (double precision)
+ x.sampleVariance := frn(x.sampleVariance, 11, 9)
+ x.SD := frn(x.SD, 11, 9)
+ x.SE := frn(x.SE, 11, 9)
+ write(ximage(x))
end
diff --git a/tests/test_runningStats.std b/tests/test_runningStats.std
index 4a01f1a..642b7e1 100644
--- a/tests/test_runningStats.std
+++ b/tests/test_runningStats.std
@@ -2,6 +2,6 @@ R_welford_cumulative_1 := welford_cumulative()
R_welford_cumulative_1.n := 8.0
R_welford_cumulative_1.mean := 5.0
R_welford_cumulative_1.variance := 4.0
- R_welford_cumulative_1.sampleVariance := 4.571428571
- R_welford_cumulative_1.SD := 2.138089935
- R_welford_cumulative_1.SE := 0.755928946
+ R_welford_cumulative_1.sampleVariance := "4.571428571"
+ R_welford_cumulative_1.SD := "2.138089935"
+ R_welford_cumulative_1.SE := "0.755928946"
diff --git a/tests/test_selectRecordFromListByField.icn b/tests/test_selectRecordFromListByField.icn
index c45a28f..3ac5931 100644
--- a/tests/test_selectRecordFromListByField.icn
+++ b/tests/test_selectRecordFromListByField.icn
@@ -1,4 +1,6 @@
-$include "../selectRecordFromListByField.icn"
+# assume that LPATH includes ..
+
+$include "selectRecordFromListByField.icn"
record ion(name, polarity)
diff --git a/tests/test_vnom.icn b/tests/test_vnom.icn
index c940be6..2ce333b 100644
--- a/tests/test_vnom.icn
+++ b/tests/test_vnom.icn
@@ -5,7 +5,11 @@
# $define VNOM_MAIN_XCODE
# $define VNOM_MAIN_XIMAGE
-$include "../vnom.icn"
+# assume that LPATH includes ..
+
+$include "lindel.icn"
+$include "vnom.icn"
+$include "jsonparse.icn"
$ifdef VNOM_MAIN_XIMAGE
link ximage
@@ -18,7 +22,7 @@ $ifdef VNOM_MAIN_XCODE
$endif
procedure main()
- local V, k, v, Vcopy
+ local V, k, v, Vcopy, L
# VNomCtor(Original, Type, ID, Metatable, Disposable, Kind)
V := vnew(, "vtype", , , , "vkind")
@@ -26,13 +30,26 @@ procedure main()
$ifdef VNOM_MAIN_XIMAGE
write("ximage(k):\n", ximage(k))
$endif
- every v := key(k) do write("metatable[\"", v, "\"] := ", image(k[v]))
+ L := []
+ every v := key(k) do put(L, v)
+ L := sort(L)
+ every v := !L do write("metatable[\"", v, "\"] := ", image(k[v]))
vmsg(V, "push", 1, "bye bye")
vmsg(V, "put", "hola", "mundo")
+ vmsg(V, "put", "delete3", "york")
+ vmsg(V, "put", "delete4", "kent")
vmsg(V, "push", "hello", "world")
+ vmsg(V, "put", "coda", "tail")
+ every write(vmsg(V, "strings"))
$ifdef VNOM_MAIN_XIMAGE
write("ximage(V):\n", ximage(V))
$endif
+ write("bykey \"delete3\": " , vmsg(V, "bykey" , "delete3"))
+ vmsg(V, "delbykey", "delete3")
+ write("byrank 4: ", vmsg(V, "byrank", 4))
+ vmsg(V, "delbyrank", 4)
+ write("bykey \"coda\": " , vmsg(V, "bykey" , "coda"))
+ vmsg(V, "delbykey", "coda")
Vcopy := vmsg(V, "copy")
$ifdef VNOM_MAIN_XIMAGE
write("ximage(Vcopy):\n", ximage(Vcopy))
@@ -85,4 +102,10 @@ procedure main()
v := create write(" --> ", vmsg(V, "!"))
k := create writes(vmsg(V, "key"))
while @k do @v
+
+ V := vnew()
+ vmsg(V, "put", "xyzzy", "you are in a maze of little twisty passages")
+ vmsg(V, "put", "x", table())
+ V["x", "foo"] := "bar"
+ every write(vmsg(V, "strings"))
end
diff --git a/tests/test_vnom.std b/tests/test_vnom.std
index 668f052..73ce53e 100644
--- a/tests/test_vnom.std
+++ b/tests/test_vnom.std
@@ -1,20 +1,32 @@
-metatable["keylist"] := procedure VNomMesg
-metatable["metatable"] := procedure VNomMesg
-metatable["bykey"] := procedure VNomMesg
+metatable["!"] := procedure VNomMesg
metatable["*"] := procedure VNomMesg
-metatable["put"] := procedure VNomMesg
+metatable["bykey"] := procedure VNomMesg
+metatable["byrank"] := procedure VNomMesg
+metatable["copy"] := procedure VNomMesg
+metatable["delbykey"] := procedure VNomMesg
+metatable["delbyrank"] := procedure VNomMesg
+metatable["disposable"] := procedure VNomMesg
+metatable["get"] := procedure VNomMesg
+metatable["id"] := procedure VNomMesg
metatable["image"] := procedure VNomMesg
-metatable["!"] := procedure VNomMesg
+metatable["key"] := procedure VNomMesg
+metatable["keylist"] := procedure VNomMesg
metatable["kind"] := procedure VNomMesg
-metatable["type"] := procedure VNomMesg
-metatable["id"] := procedure VNomMesg
-metatable["copy"] := procedure VNomMesg
-metatable["push"] := procedure VNomMesg
-metatable["byrank"] := procedure VNomMesg
+metatable["metatable"] := procedure VNomMesg
metatable["pop"] := procedure VNomMesg
-metatable["key"] := procedure VNomMesg
metatable["pull"] := procedure VNomMesg
-metatable["get"] := procedure VNomMesg
+metatable["push"] := procedure VNomMesg
+metatable["put"] := procedure VNomMesg
+metatable["type"] := procedure VNomMesg
+hello: world
+1: bye bye
+hola: mundo
+delete3: york
+delete4: kent
+coda: tail
+bykey "delete3": york
+byrank 4: kent
+bykey "coda": tail
hello --> world
1 --> bye bye
hola --> mundo
@@ -48,3 +60,5 @@ There are 3 values in Vcopy
foo --> bar
magic --> 1
2 --> marker
+xyzzy: you are in a maze of little twisty passages
+{"foo" : "bar"}
diff --git a/tests/test_wora.icn b/tests/test_wora.icn
index 0d9c154..e20b46c 100644
--- a/tests/test_wora.icn
+++ b/tests/test_wora.icn
@@ -1,4 +1,6 @@
-$include "../wora.icn"
+# assume that LPATH includes ..
+
+$include "wora.icn"
procedure main()
local foo, bar, baz
diff --git a/vnom.icn b/vnom.icn
index b8ae015..e5cc2ed 100644
--- a/vnom.icn
+++ b/vnom.icn
@@ -1,3 +1,5 @@
+$ifndef VNOM
+$define VNOM
############################################################################
#
# File: vnom.icn
@@ -76,21 +78,27 @@
# # in order keys in L
# vmsg(V, "*" ) : i # produce number of values
#
+# vmsg(V, "copy" ) : V # produce a copy of V
+# # having same metatable instance
# vmsg(V, "get" | "pop" ) : x # pop value, discarding key
# vmsg(V, "pull" ) : x # pull value, discarding key
-# vmsg(V, "push", x1, x2) : V # push value with key
-# vmsg(V, "put", x1, x2) : V # put value with key
+# vmsg(V, "push", xk, xv) : V # push|replace value xv for key xk
+# vmsg(V, "put", xk, xv) : V # put|replace value xv for key xk
# vmsg(V, "key" ) : x1, ... # generate keys
# # in order keys in L
# vmsg(V, "keylist" ) : L # copy of L of ranked keys
# vmsg(V, "bykey", x ) : s # value, assignable by key
# vmsg(V, "byrank", i ) : s # value, assignable by rank
+# vmsg(V, "delbykey", x ) : n # delete value by key
+# vmsg(V, "delbyrank", i ) : n # delete value by rank
#
-# vmsg(V, "kind" ) : s # Kind property, assignable
+# vmsg(V, "disposable" ) : s # disposable property
# vmsg(V, "id" ) : s # ID property, assignable
-# vmsg(V, "type" ) : s # Type property, assignable
# vmsg(V, "image" ) : s # image property
+# vmsg(V, "kind" ) : s # Kind property, assignable
# vmsg(V, "metatable" ) : s # Metatable, assignable
+# vmsg(V, "strings" ) : s # generate a string to show each KVP
+# vmsg(V, "type" ) : s # Type property, assignable
#
# Constructor
# vnew(Original:T, Type:s, ID:s, Metatable:T, Disposable:s, Kind:s):V
@@ -118,6 +126,7 @@
#
# icon -P '
# link ximage
+# $include "lindel.icn"
# $include "vnom.icn"
# # vnew and vmsg are $defined in vnom.icn as:
# # $define vnew VNomCtor
@@ -148,6 +157,9 @@
# T3["bykey"] := procedure VNomMesg
# T3["byrank"] := procedure VNomMesg
# T3["copy"] := procedure VNomMesg
+# T3["delbykey"] := procedure VNomMesg
+# T3["delbyrank"] := procedure VNomMesg
+# T3["disposable"] := procedure VNomMesg
# T3["get"] := procedure VNomMesg
# T3["id"] := procedure VNomMesg
# T3["image"] := procedure VNomMesg
@@ -168,7 +180,9 @@
#
############################################################################
#
-# Requires: preprocessor
+# Requires:
+# - preprocessor
+# - $include "lindel.icn"
#
############################################################################
#
@@ -178,6 +192,11 @@
# vnom.icn - a named vector with Lua-style metatable access
+# require LINDEL for Ldelete from lindel.icn
+$ifndef LINDEL
+$include "lindel.icn"
+$endif
+
$ifndef vnew
$define vnew VNomCtor
$endif
@@ -199,8 +218,7 @@ procedure VNomCtor(Original, Type, ID, Metatable, Disposable, Kind)
# allocate internal table for properties
V[V] := table()
- # set properties
-
+ #----- META-PROPERTIES -----
# Dspsbl is &null | "yes" | "done"
V[V, "Dspsbl"] := /Disposable |
"yes"
@@ -231,32 +249,38 @@ procedure VNomCtor(Original, Type, ID, Metatable, Disposable, Kind)
V[V, "ID"] := \ID |
V[V, "Type"] || (image(V) ? (="table",tab(upto('('))))
- # declare handler for each message
-
+ #----- MESSAGE HANDLERS -----
# messages having 0 args
- MT["!"] := VNomMesg
- MT["*"] := VNomMesg
- MT["copy"] := VNomMesg
- MT["get"] := VNomMesg
- MT["key"] := VNomMesg
- MT["keylist"] := VNomMesg
- MT["pop"] := VNomMesg
- MT["pull"] := VNomMesg
-
- MT["id"] := VNomMesg
- MT["image"] := VNomMesg
- MT["kind"] := VNomMesg
- MT["type"] := VNomMesg
+ # - property accessors
+ MT["disposable"] := VNomMesg
+ MT["id"] := VNomMesg
+ MT["image"] := VNomMesg
+ MT["kind"] := VNomMesg
+ MT["metatable"] := VNomMesg
+ MT["type"] := VNomMesg
+ # - L/T messages
+ MT["!"] := VNomMesg
+ MT["*"] := VNomMesg
+ MT["copy"] := VNomMesg
+ MT["get"] := VNomMesg
+ MT["key"] := VNomMesg
+ MT["keylist"] := VNomMesg
+ MT["pop"] := VNomMesg
+ MT["pull"] := VNomMesg
# messages having 1 arg
- MT["bykey"] := VNomMesg
- MT["byrank"] := VNomMesg
- MT["metatable"]:= VNomMesg
+ # - element selectors/deleters
+ MT["bykey"] := VNomMesg
+ MT["byrank"] := VNomMesg
+ MT["delbykey"] := VNomMesg
+ MT["delbyrank"] := VNomMesg
# messages having 2 args
- MT["push"] := VNomMesg
- MT["put"] := VNomMesg
+ # - L/T messages
+ MT["push"] := VNomMesg
+ MT["put"] := VNomMesg
+ # produce newly-constructed "object"
return V
end
@@ -272,6 +296,8 @@ procedure VNomMesg(args[])
nargs := *args - 2 # count of args beyond V and msg
V := args[1] # extract VNom from args
message := args[2] # extract message from args
+ if /V[V] # coerce ordinary table to get
+ then V := VNomCtor(V) # the same interface as VNom
metamethod := V[V, "Mttbl", message] # extract metamethod from VNom
suspend if (\metamethod ~=== VNomMesg) # Is this proc the impl. of msg.?
then metamethod ! args # if not, invoke implementation
@@ -281,17 +307,17 @@ procedure VNomMesg(args[])
case nargs of {
2 : case message of { # message handlers taking 2 args
"push" : { # "push" message handler
- if (idx := args[3]) === !state # make sure key is not in state
- then fail # when so, disallow message
- push(state, idx) # add idx to left end of state L
- V[idx] := args[4] # add idx and value to V
+ idx := args[3] # get intended key
+ if not (idx === !state) # make sure key is in state;
+ then push(state, idx) # or add left end of state L
+ V[idx] := args[4] # assign key and value in V
V # produce V
}
"put" : { # "put" message handler
- if (idx := args[3]) === !state # make sure key is not in state
- then fail # when so, disallow message
- put(state, idx) # add idx to right end of state L
- V[idx] := args[4] # add idx and value to V
+ idx := args[3] # get intended key
+ if not (idx === !state) # make sure key is in state;
+ then put(state, idx) # or add right end of state L
+ V[idx] := args[4] # assign key and value in V
V # produce V
}
default : fail
@@ -303,6 +329,24 @@ procedure VNomMesg(args[])
"byrank" : { # "byrank" message handler
V[state[args[3]]] # produce L-value for rank in L
}
+ "delbykey" : ( # "delbykey" message handler
+ idx := # if key exists in state,
+ args[3] === # get index of key in state
+ state[ # otherwise fail
+ val := 1 to *state
+ ],
+ Ldelete(state, val), # delete element at index
+ delete(V, idx), # delete key from V
+ &null
+ )
+ "delbyrank" : ( # "delbyrank" message handler
+ 0 < ( val := # fail when rank is valid
+ (*state >= args[3])),
+ idx := state[val], # get key from state
+ Ldelete(state, val), # delete element at index
+ delete(V, idx), # delete key from V
+ &null
+ )
default : fail
}
0 : case message of { # message handlers taking 0 args
@@ -313,12 +357,16 @@ procedure VNomMesg(args[])
*state # produce length of state L
}
"copy" : { # "copy" message handler
- val := VNomCtor(V)
- # val := copy(V) # create shallow copy of V,
- # delete(val, V) # remove old self-ID
- # val[val] := copy(V[V]) # add new self-ID
- # val[val, "State"] := copy(state) # make shallow copy of state L
- # val # produce the copy of V
+ val := VNomCtor(V) # produce copy of V
+ } # with same metatable instance
+ "disposable" : { # "disposable" message handler
+ V[V, "Dspsbl"] # produce disposable property
+ } # as an L-value
+ "id" : { # "id" message handler
+ V[V, "ID"] # produces ID property
+ } # as an L-value
+ "image" : { # "image" message handler
+ V[V, "ID"] || "(" || *state || ")" # produces s
}
"key" : { # "key" message handler
!state # generate keys (names),
@@ -326,6 +374,12 @@ procedure VNomMesg(args[])
"keylist" : { # "keylist" message handler
copy(state) # produce L of keys (names),
} # ordered by state L
+ "kind" : { # "kind" message handler
+ V[V, "Kind"] # produces Kind property
+ } # as an L-value
+ "metatable" : { # "metatable" message handler
+ V[V, "Mttbl"] # produce metatable
+ } # as an L-value
"pop" | "get" : { # "pop" and "get" message handlers
val := V[idx := pull(state)] # get idx and val
delete(V, idx) # remove idx from keys of V
@@ -336,21 +390,12 @@ procedure VNomMesg(args[])
delete(V, idx) # remove idx from keys of V
val # produce val
}
+ "strings" : { # "strings" message handler
+ VNomStrings(V) # generates one representative
+ } # string per key-value pair
"type" : { # "type" message handler
V[V, "Type"] # produces Type property
} # as an L-value
- "kind" : { # "kind" message handler
- V[V, "Kind"] # produces Kind property
- } # as an L-value
- "id" : { # "id" message handler
- V[V, "ID"] # produces ID property
- } # as an L-value
- "image" : { # "image" message handler
- V[V, "ID"] || "(" || *state || ")" # produces s
- }
- "metatable" : { # "metatable" message handler
- V[V, "Mttbl"] # produce metatable
- } # as an L-value
default : fail
}
default : fail
@@ -358,4 +403,35 @@ procedure VNomMesg(args[])
}
end
+invocable "json"
+
+# generate elements of VNom as strings
+procedure VNomStrings(V, j)
+ local k, p, s, x, e
+ e := &error; &error := -1 # save &error state; convert errors to failure
+ /j := proc("json") | proc("encode") | image
+ &error := e # restore error state
+ every k := vmsg(V, "key")
+ do
+ case type(x := V[k]) of {
+ default : suspend j(x)
+ "null" : suspend k || ": " || "NA"
+ "string" |
+ "integer" |
+ "real" : suspend k || ": " || V[k]
+ "list" : {
+ s := "["
+ every p := 1 to *x
+ do
+ s ||:=
+ if p ~= *x
+ then x[p] || ", "
+ else x[p]
+ suspend s || "]"
+ }
+ }
+end
+
+
# see tests/test_vnom.* for demonstrations
+$endif # VNOM
diff --git a/wora.icn b/wora.icn
index cccffe1..1404d8f 100644
--- a/wora.icn
+++ b/wora.icn
@@ -1,3 +1,5 @@
+$ifndef _wora_
+$define _wora_
############################################################################
#
# File: wora.icn
@@ -10,10 +12,40 @@
#
############################################################################
#
-# This file is in the public domain.
+# This file is in the public domain. Art Eschenlauer has waived all
+# copyright and related or neighboring rights to:
+# wora.icn - Restricted-access globally accessible storage
+# For details, see:
+# https://creativecommons.org/publicdomain/zero/1.0/
+#
+# If you require a specific license and public domain status is not
+# sufficient for your needs, please substitute the MIT license (see
+# below), bearing in mind that the copyright "claim" is solely to meet
+# your requirements and does not imply any restriction on use or copying
+# by the author:
#
-# SPDX-License-Identifier: CC-PDDC
-# https://spdx.org/licenses/CC-PDDC.html
+# Copyright (c) 2022, Arthur Eschenlauer
+#
+# Permission is hereby granted, free of charge, to any person obtain-
+# ing a copy of this software and associated documentation files (the
+# "Software"), to deal in the Software without restriction, including
+# without limitation the rights to use, copy, modify, merge, publish,
+# distribute, sublicense, and/or sell copies of the Software, and to
+# permit persons to whom the Software is furnished to do so, subject
+# to the following conditions:
+#
+# The above copyright notice and this permission notice shall be
+# included in all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+# OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+# NON-INFRINGEMENT.
+#
+# IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR
+# ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+# CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+# WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
#
############################################################################
#
@@ -23,8 +55,6 @@
# `del` - not null when owner requests deletion; ignored otherwise.
#
############################################################################
-$ifndef _wora_
-$define _wora_
procedure wora(id,del) #: a globally visible value, settable by only one C
# WORA - Writeable-by-One, Readable-by-All