added LiComboP and test; extended runt.icn

LiComboP.icn

@@ -0,0 +1,126 @@
+############################################################################
+#
+#   File:     LiComboP.icn
+#
+#   Subject:  Procedures to suspend lists combining sequences.
+#
+#   Author:   Arthur C. Eschenlauer
+#
+#   Date:     September 30, 2021
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+#   SPDX-License-Identifier: CC-PDDC
+#     https://spdx.org/licenses/CC-PDDC.html
+#
+############################################################################
+#
+#   required include: wora.icn for wora(id)
+#
+############################################################################
+#
+#   procedure LiP(A)
+#     Suspend lists combining infinite sequences.
+#       LiP uses wora(LiP) to determine whether to use LiFiniteP (the
+#       default) or nAltP to combine memoized results.
+#
+#   procedure LiFiniteP(LofC)
+#     Recursively suspend lists combining finite seqs.
+#
+#   procedure nAltP(LofC)
+#     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
+
+procedure LiP(A) #: produce lists combining infinite sequences
+  # Generate combinations of argument results for list-invocation,
+  #   not requiring that the arguments yield finite sequences:
+  #   - For each co-expression, create an empty memoization list to hold
+  #       the results that it will produce.
+  #   - Activate each co-expression, putting the result onto its list.
+  #   - Next produce the combination of the (one-member) memoization lists.
+  #   - Next, in round-robin fashion:
+  #       - activate each co-expression;
+  #       - if activation succeeded:
+  #           - add the result to its memoization list
+  #           - and then produce the combinations of that result with the
+  #               previous results of the other co-expressions, i.e., with
+  #               all of the members of their memoization lists.
+  local done   # set to not &null when all C are exhausted
+  local i      # current C index, element of 1 to nA
+  local j      # reusable index, element of 1 to nA
+  local lcpCL  # list of C to be passed to LiFiniteP
+  local memoLL # list of memoization lists
+  local nA     # size of A
+  local saveL  # temporary holder to save memoLL[i]
+  local fingen # generates lists of combinations of finite sequences
+  nA := *A;  memoLL := []                # Initialization
+  fingen := \wora(LiP) | LiFiniteP       # Set fingen from wora(LiP)|default
+  every i := 1 to nA                     # Collect first result from each C,
+    do put( memoLL, [@A[i]] ) | fail     #   which is strictly required.
+  until \done                            # Repeat until every C is exhausted
+    do {
+      done := 1                          # Revert to &null when @C succeeds
+      every i := 1 to nA                 # For any @(!A) that succeeds,
+        do {                             #   memoize the result and suspend L
+          saveL := (                     # If @A[i] fails, advance to i + 1
+              (/saveL, memoLL[1]) |      # - first activation, special case
+              put( memoLL[i], @A[i] ) |  # - otherwise, require activation
+              next                       # - or next i
+            )[-1:0]                      # saveL slice has only last value
+          done := &null                  # C produces a value
+          saveL :=: memoLL[i]            # Save memoization list for i
+          lcpCL := []                        # Build list of C, each produ-
+          every j := 1 to nA                 #   cing the memoized values
+            do put(lcpCL, create !memoLL[j]) #   but with only latest @A[i]
+          suspend fingen(lcpCL) # Suspend combinations from memoization lists
+          memoLL[i] :=: saveL            # Revert memoization list for i
+          }                              # next i
+      }                                  # fail once every C is exhausted
+end
+
+procedure LiFiniteP(LofC) #: recursively suspend lists combining finite seqs
+  # For a list of co-expressions that produce a finite sequence
+  #   of results; produce a list of each combination of results.
+  #   This "recursive suspension" technique was adapted from
+  #   Bob Alexander's regexp.icn from the IPL.
+  # For example, LiFiniteP{1 to 2, 5 to 6} produces:
+  #   [1,5], then [1,6], then [2,5], and then [2,6].
+  local C, v
+  # For the first C to be activated more than once,
+  #   all but the first C must be finite.
+  C := ^LofC[1]
+  while v := @C
+    do if *LofC > 1
+         then suspend [v] ||| LiFiniteP(LofC[2:0])
+         else suspend [v]
+end
+
+procedure nAltP(A) #: recurrently suspend lists combining finite seqs
+  # Steve Wampler's recurrent solution, comparable in speed to
+  #   Bob Alexander's solution
+  local i          # Current co-expression to evaluate
+  local solution   # List of co-expression values
+  i := 1 ; solution := list(*A)
+  repeat {
+    while solution[i] := @A[i] do {
+        if (i +:= 1) > *A
+          then {     # Finished with this solution list
+            suspend solution
+            i -:= 1  # "backtrack"...
+          }
+        }
+    A[i] := ^A[i]              # Prepare for re-entry on l-to-r eval.
+    if (i -:= 1) = 0 then fail # "backtrack" or fail if all done
+  }
+end
+
+$endif # _LiComboP_

tests/include_all.icn

@@ -0,0 +1,7 @@
+# Here are file inclusions for all aceincl/test/test_*.icn
+#   This is an alternative to specifying LPATH.
+#   It might be nice to have a way to dereference environment
+#     variables from the preprocessor; the intrepid may wish
+#     to adapt progs/ipp.icn from the IPL.
+$include "../wora.icn"
+$include "../LiComboP.icn"

tests/runt.icn

@@ -25,18 +25,13 @@ link popen  # for procedure popen
 # flag that exit should produce error status even with --continue argument
 global failure
 
-# record that an error occurred
-procedure write_abort(ls[])
-  failure := 1
-  write ! ls
-  return failure
-end
-
 # 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 dir         # one member of dirs
   local dirEntry    # entry in current working directory
   local dirListing  # names of files and subdirectores in CWD
+  local dirs        # list args matching directory names
   local filExpected # file with expected results, test_*.std
   local filObserved # file producing observed results, test_*.icn
   local linCount    # line counter
@@ -45,6 +40,10 @@ procedure main(args)
   local linObserved # observed line
   local testName    # name of test, test_*
   local traceout    # if !args == "--verbose" then write else 2
+  if !args == "--help" then {
+    write("usage: icon runt.icn [--continue] [--verbose] [<zero or more dirs>]")
+    exit(0)
+  }
   traceout := if !args == "--verbose" then write else 2
   abort    := if !args == "--continue" then write_abort else stop
   if traceout === 2
@@ -53,49 +52,69 @@ procedure main(args)
   if abort === stop
     then write( &errout, "To run all tests, invoke as:   icon "
               , &progname, " --continue\n")
-  # For each file or subdirectory in the current directory
-  every dirEntry := !(dirListing := open("./", "r")) do {
-    # Assume it's a file if it begins with test; check tha 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", "r")
-        # Report that we will run the test
-      , write(testName)
-        # Prepare to generate the observed result lines
-      , filObserved := popen( "icon " || testName || ".icn", "r")
-        # Create a sequence of expected result lines
-      , 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 {
-            linCount +:= 1
-            # termination is premature if expected line is not observed
-            linObserved := @linObsC | (
-              abort( " ... line ", linCount
-                   , ": premature termination, expected: '", linExpected, "'"
-                   )
-            , break
-            )
-            # abort when expected line does not match observed
-            (
-              abort( " ... line ", linCount, ": '"
-                   , linExpected ~== linObserved
-                   , "' was produced but '"
-                   , linExpected
-                   , "' was expected"
-                   ) & break
-            ) | next
-          }
-        ) | if linObserved := @linObsC
-              # report unexpected output
-              then abort( " ... line ", linCount
-                        , ": unexpected output: '", linObserved, "'"
-                        )
-      )
-  }
-  close(\dirListing)
+  # dirs either lists the directory arguments or the current directory
+  dirs := []
+  every put( dirs, directory_seq(!args) || "/" )
+  if *dirs == 0 then dirs := put( dirs, "./" )
+  every dir := !dirs
+    do {
+      # For each file in the directory
+      every dirEntry := !(dirListing := open(dir)) do {
+        # Assume it's a file if it begins with test; check tha it ends with .icn
+        if dirEntry ?
+             dirEntry == ( testName := ="test_" || tab(find(".icn")) ) || =".icn"
+          then (
+            # Write nothing unless we find a .std file
+            filExpected := open( dir || testName || ".std")
+            # Report that we will run the test
+          , write(testName)
+          , testName := dir || testName
+            # Prepare to generate the observed result lines
+          , filObserved := popen( "icon " || testName || ".icn", "r")
+            # Create a sequence of expected result lines
+          , 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 {
+                linCount +:= 1
+                # termination is premature if expected line is not observed
+                linObserved := @linObsC | (
+                  abort( " ... line ", linCount
+                       , ": premature termination, expected: '", linExpected, "'"
+                       )
+                , break
+                )
+                # abort when expected line does not match observed
+                (
+                  abort( " ... line ", linCount, ": '"
+                       , linExpected ~== linObserved
+                       , "' was produced but '"
+                       , linExpected
+                       , "' was expected"
+                       ) & break
+                ) | next
+              }
+            ) | if linObserved := @linObsC
+                  # report unexpected output
+                  then abort( " ... line ", linCount
+                            , ": unexpected output: '", linObserved, "'"
+                            )
+          )
+      }
+      close(\dirListing)
+    }
   # exit code zero unless falure was encountered when abort === write_abort
   exit( \failure | 0)
 end
+
+# record that an error occurred
+procedure write_abort(ls[])
+  failure := 1
+  write ! ls
+  return failure
+end
+
+# adapted from IPL proc io.icn
+procedure directory_seq(name) #: suspend name when a directory
+  suspend (close(open(name || "/.")), name)
+end

tests/test_LiComboP.icn

@@ -0,0 +1,24 @@
+$include "include_all.icn"
+
+procedure printtuple(ls[])
+  local C
+  C := create !ls
+  writes("[")
+  while writes(if *C = 0 then "" else ", ", @C)
+  write("]")
+  return
+end
+
+$define TestSequences 1 to 3, 5 to 8
+
+procedure main()
+  wora(LiP) := LiFiniteP
+  write("---\nLiP with image(wora(LiP)) = ", image(wora(LiP)))
+  every (printtuple!LiP{TestSequences})
+  wora(LiP) := nAltP
+  write("...\n---\nLiP with image(wora(LiP)) = ", image(wora(LiP)))
+  every (printtuple!LiP{TestSequences})
+  write("...\n---\nnAltP = ", image(wora(LiP)))
+  every (printtuple!nAltP{TestSequences})
+  write("...")
+end

tests/test_LiComboP.std

@@ -0,0 +1,45 @@
+---
+LiP with image(wora(LiP)) = procedure LiFiniteP
+[1, 5]
+[1, 6]
+[2, 5]
+[2, 6]
+[1, 7]
+[2, 7]
+[3, 5]
+[3, 6]
+[3, 7]
+[1, 8]
+[2, 8]
+[3, 8]
+...
+---
+LiP with image(wora(LiP)) = procedure nAltP
+[1, 5]
+[1, 6]
+[2, 5]
+[2, 6]
+[1, 7]
+[2, 7]
+[3, 5]
+[3, 6]
+[3, 7]
+[1, 8]
+[2, 8]
+[3, 8]
+...
+---
+nAltP = procedure nAltP
+[1, 5]
+[1, 6]
+[1, 7]
+[1, 8]
+[2, 5]
+[2, 6]
+[2, 7]
+[2, 8]
+[3, 5]
+[3, 6]
+[3, 7]
+[3, 8]
+...

wora.icn

@@ -2,7 +2,7 @@
 #
 #   File:     wora.icn
 #
-#   Subject:  "Writeable-by-One, Readable-by-All" pseudo-"global variables".
+#   Subject:  Restricted-access globally accessible storage.
 #
 #   Author:   Arthur C. Eschenlauer
 #