diff --git a/LiComboP.icn b/LiComboP.icn new file mode 100644 index 0000000..1116df3 --- /dev/null +++ b/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_ diff --git a/tests/include_all.icn b/tests/include_all.icn new file mode 100644 index 0000000..9314e06 --- /dev/null +++ b/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" diff --git a/tests/runt.icn b/tests/runt.icn index 673329f..f37092d 100644 --- a/tests/runt.icn +++ b/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] []") + 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 diff --git a/tests/test_LiComboP.icn b/tests/test_LiComboP.icn new file mode 100644 index 0000000..dd30c9d --- /dev/null +++ b/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 diff --git a/tests/test_LiComboP.std b/tests/test_LiComboP.std new file mode 100644 index 0000000..3334207 --- /dev/null +++ b/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] +... diff --git a/wora.icn b/wora.icn index 57ccbf1..857557b 100644 --- a/wora.icn +++ b/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 #