WSID'APLASCII''Functions and Operators ...'A2ATEST 00A0,' A2ATEST;A;T;C1;C2;C3;F1;F2;F3;KEEPUS;V0;V0R;V1;V1R;V2;V2R;V3;V3R;V4;V4R;V5;V5R;iNSERTFNS;aPL2ASCII;aSCII2APL;CR1;OUT;ZZ;TTABM;TTABX [1] Tests the APLASCII functions [2] PREP2RUN define missing fns, etc. [3] [4] The names of some scratch files we will create during testing: [5] F1''ZZZA2A.TMP'' [6] F2''ZZZA2A2.TMP'' [7] F3''ZZZA2A3.TMP'' [8] Adjust the scratch file names on APL2 on CMS: [9] (''APL2''.4APLVER)/L1 [10] (~''CMS''MATIOTA OPSYS)/L'0,'1 If running under VM/CMS, [11] F1[F1''.'']'' '' make the names ZZZA2A TMP [12] F2[F2''.'']'' '' and ZZZA2A2 TMP [13] F3[F3''.'']'' '' and ZZZA2A3 TMP [14] L1: [15] [16] Define local OUT to capture displayed warning messages [17] T'' ''=10FX''OUT A''OVER''ZZZZ,,TCNL,A'' [18] ZZ'''' will hold output [19] [20] ''Building translate tables...'' [21] MAKETTAB [22] (0NC''TTABM''OVER''TTABX'')/L2 [23] (~('' ''=10TTABM)^2=TTABX)/L2 [24] '0,' (('' ''=10TTABX)^2=TTABM)/L3 [25] L2:''*** MAKETTAB failed to define the translate tables correctly'' [26] 0 can''t go on [27] L3: [28] [29] '''' [30] ''Testing the TCNL function:'' [31] ''Line 1'',TCNL,''Line 2'' [32] ''If "Line 1" and "Line 2" are not on two successive lines'' [33] ''(and both at the left margin), the TCNL function is defective.'' [34] '''' [35] [36] ''Testing APL2ASCII and ASCII2APL...'' [37] (''A{rotate}{reverse}B''MATCH APL2ASC'0,'II''AB'')/L4 [38] TCNL,''*** APL2ASCII failed basic monadic/dyadic test'' [39] L4:''.'' [40] (''AB''MATCH ASCII2APL''A{Rotate}{REVERSE}B'')/L5 [41] TCNL,''*** ASCII2APL failed basic test'' [42] L5:''.'' [43] A0 2TTABM [44] AASCII2APL A [45] (A MATCH TTABM[;,1])/L6 [46] TCNL,''*** ASCII2APL failed all-keywords test'' [47] L6:''.'' [48] A(~AVTCNL,32127ASCII)/AV non-ASCII characters [49] AA,'')'',[1.5]A [50] KEEPUS1 preserve all character distinctions ['0,'51] (A MATCH ASCII2APL APL2ASCII A)/L7 [52] TCNL,''*** Failed the all-symbols monadic/dyadic cycle test'' [53] L7:TEX''KEEPUS'' [54] ''.'' [55] ZZ'''' [56] (''{Not a Keyword}''MATCH ASCII2APL''{Not a Keyword}'')/L8 [57] TCNL,''*** Failed to pass unrecognized keyword through unchanged'' [58] L8:(''Warning''MATCH 71ZZ)/L9 [59] TCNL,''*** Failed to warn about unrecognized keyword'' [60] L9:''.'' [61] (''''MATCH ASCII2APL''{grade up}{GRADE_UP}{grade-up}'')/L10 [62] TCNL,''***'0,' Failed to allow blank, _, or - in keyword'' [63] L10:''.'' [64] AALPHS [65] A(A,[IO]A[2;])[3;] use 2nd case if no 3rd [66] TASCII2APL APL2ASCII A [67] (T MATCH A[1 2 2;])/L11 [68] TCNL,''*** Failed to map third alphabetic case to second'' [69] L11:''.'' [70] KEEPUS0 try again with explicit value [71] TASCII2APL APL2ASCII A [72] (T MATCH A[1 2 2;])/L12 [73] TCNL,''*** Failed to map third alphabetic case to second'' [74] L12:''.'' [75] KEEPUS1 '0,' now preserve the third case [76] TASCII2APL APL2ASCII A [77] (T MATCH A)/L13 [78] TCNL,''*** Failed to preserve third alphabetic case'' [79] L13:''.'' [80] TASCII2APL APL2ASCII AV [81] (T MATCH AV)/L14 [82] TCNL,''*** Failed the AV-translation test'' [83] L14:TCNL [84] [85] A2ATEST2 do the rest of the tests [86] [87] TCNL,''-= END OF TESTS =-'' [88] APLASCII.DYALOG version 1.4 (1995.10.15) '034570FX 0  EX '0'A2ATEST2 00A0,' A2ATEST2;F;I;M;R;S;T;U [1] Part 2 of A2ATEST (to avoid a huge function) [2] [3] Define some fns and vars used in testing [4] ''Testing INSERTFNS and DEFINEFNS...'' [5] C1CR T''INSERTFNS'' [6] C1[1;(C1[1;]1T)+1+T]''iNSERTFNS'' [7] T'' ''=10FX C1 define iNSERTFNS [8] C2CR T''APL2ASCII'' [9] C2[1;(C2[1;]1T)+1+T]''aPL2ASCII'' [10] T'' ''=10FX C2 define aPL2ASCII [11] C3CR T''ASCII2APL'' [12] C3[1;(C3[1;]1T)+1+T]''aSCII2APL'' [13] T'0,''' ''=10FX C3 define aSCII2APL [14] V0RV00 [15] V1RV1200 [16] V2RV2''{nl}''OVER NL 3 [17] V3RV3TCNL MTOV V2 [18] V4RV43 2 4 0 1 80 [19] Define a nested array on systems that provide them: [20] V5RV50 [21] (''IPSA''.4APLVER)/L1 [22] V5RV5(<''A''),(<2),((<3),(<4),(<5 6 7),<<8 9) [23] L4 [24] L1:(''APL68K''.6APLVER)/L2 [25] (LEVEL>1)/L3 [26] L4 [27] L2:(''APL2''^.=4APLVER)/L3 [28] ((''APLPLUS''^.=7APLVER)^(17APLVER)''23'')/L3 [29] ('''0,'DYALOG''^.=6APLVER)/L3 [30] L4 [31] L3:V5RV5''A'' 2 (3 4 (5 6 7) ( 8 9)) [32] L4: [33] ''.'' [34] [35] M''/This is a test./iNSERTFNS/ aPL2ASCII/ aSCII2APL/V0/ V1'' [36] MVTOM M,''/ V2/V3/V4/V5/End of test.'' [37] TINSERTFNS M [38] ''.'' [39] (2=T)/L5 [40] TCNL,''*** INSERTFNS result has wrong rank'' [41] L5:FVTOM''/iNSERTFNS/aPL2ASCII/aSCII2APL/V0/V1/V2/V3/V4/V5'' [42] SEX F [43] SDEFINEFNS T [44] ''.'' [45] (S MATCH F)/L6 [46] TCNL,''***'0,' Incorrect result from DEFINEFNS'' [47] L6:A2ATESTSUB F [48] ''.'' [49] [50] Try again with a vector argument: [51] M''/This is a test./{del}iNSERTFNS/{del} aPL2ASCII/{del} aSCII2APL/{del}V0'' [52] MVTOM M,''/ {del} V1/ {del}V2/{del}V3/{del}V4/{del}V5/End of test.'' [53] MTCNL MTOV M [54] ''.'' [55] TINSERTFNS M [56] ''.'' [57] (1=T)/L7 [58] TCNL,''*** INSERTFNS result has wrong rank'' [59] L7:SEX F [60] SDEFINEFNS T [61] ''.'' [62] A2ATESTSUB F [63]'0,' ''.'' [64] [65] Make sure a pre-untransliterated vector is rejected: [66] SASCII2APL T [67] ZZ'''' [68] SDEFINEFNS S [69] ''.'' [70] UTCNL,''The DEFINEFNS argument'' [71] ((0S)^U MATCH(U)ZZ)/L8 [72] TCNL,''*** DEFINEFNS failed to reject an untransliterated argument'' [73] [74] Make sure an invalid function is placed in CR1: [75] L8:SEX F [76] T[T'';'']''!'' ruin the iNSERTFNS header line [77] ZZ'''' [78] SDEFINEFNS T [79] ''.'' [80] (2=NC''CR1'')/'0,'L9 [81] TCNL,''*** DEFINEFNS failed to define variable CR1'' [82] L11 [83] L9:(''Unable''^.=62ZZ)/L10 [84] TCNL,''*** DEFINEFNS failed to warn about being unable to define a function.'' [85] L10:SC1 [86] S[1;S[1;]'';'']''!'' [87] (CR1 CRMATCH S)/L11 [88] TCNL,''*** DEFINEFNS put incorrect result in CR1'' [89] L11:S'' ''=10FX C1 redefine iNSERTFNS for later tests [90] [91] Check empty cases: [92] SINSERTFNS''FOO'' [93] ''.'' [94] TINSERTFNS 1 3''BAR'' [95] ('0,'(S MATCH''FOO'')^T MATCH 1 3''BAR'')/L12 [96] TCNL,''*** INSERTFNS failed no-insertion test'' [97] L12:SINSERTFNS'''' [98] ''.'' [99] (S MATCH'''')/L13 [100] TCNL,''*** INSERTFNS failed empty test'' [101] L13:ZZ'''' [102] SDEFINEFNS''FOO'' [103] ''.'' [104] ((S MATCH 0 0'''')^ZZ MATCH'''')/L14 [105] TCNL,''*** DEFINEFNS failed nothing-to-define test'' [106] L14:ZZ'''' [107] SDEFINEFNS'''' [108] ''.'' [109] ((S MATCH 0 0'''')^ZZ MATCH'''')/L15 [110] TCNL,''*** DEFINEFNS failed empty test'''0,' [111] L15:TCNL [112] [113] ''Testing WRAPLNS...'' [114] T9 1 WRAPLNS''ONE TWO THIRTEEN'' [115] ''.'' [116] R''ONE {+'',TCNL,'' +}TWO {+'',TCNL,'' +}THIR{+'',TCNL,'' +}TEEN'' [117] (T MATCH R)/L16 [118] TCNL,''*** WRAPLNS failed basic test'' [119] L16:MDTB CR''MATIOTA'' [120] I20 [121] L17:(50  ) [22] I(TTABM[;3]''{'')/1TTABM rows for special chars [23] JJ/JATTABM[I;3] find special chars in the input [24] J(A[1J-1]''{'')/J not preceded by { [25] KTTABM[I;3]A[J] look ''em up [26] A[J]TTABM[I[K];1] replace ''em with APL symbols [27] [28] Translate the multi-character phrases [2'0,'9] LL/LA=''{'' indices of keyword starts [30] L4:PL.+1+1TTABM indices where keywords occur [31] M(A,'' '')[P1+A] the {keywords} and beyond [32] P0 11,^\M''}'' 1s mark the {keyword} part, 0s beyond [33] M(M)(,P)\(,P)/,M blank out stuff past the } [34] UM(P)/M delete trailing blank columns [35] R+/P width of each keyword [36] K''''(~AVM)/AV pick a char not found in'0,' M [37] MK MTOV M [38] Remove imbedded blank, _, and -, but not those next to { or }: [39] M((~M'' _-'')(''{''=1M)''}''=1M)/M [40] (We must leave {->}, {delta_}, etc. unchanged.) [41] MTOLOWER VTOM M allow uppercase keywords [42] I(0 2TTABM)MATIOTA M look up keywds in msg [43] (~0I)/L5 If any were not found, [44] P(I=0)U get the phrases (as originally found in text) [45] P((P MATIOTA P)=1P)P remove du'0,'plicates [46] OUT''Warning--unrecognized keywords:'' [47] OUT'' ''MTOV'' '',P inform the user [48] L(I0)/L ignore { for unrecognized phrases [49] L4 restart this phase [50] L5:A[L]TTABM[I;1] replace { with the APL symbol [51] P(1+A)1 [52] P[(L+1),L+R]0 put 0s to the right of { and } [53] Z(=\1P)/A remove the keyword} part [54] (D2)/0 [55] ZVTOM Z res'0,'tore original rank [56] Copyright (c) 1994-95 Jim Weigang [57] APLASCII.DYALOG version 1.4 (1995.10.15) '031170FX 0  EX '0'ASCIISAMP 00A0,' ZASCIISAMP [1] Returns an ASCII sampler [2] ZASCII[IO+ASCIISAMPX] [3] APLASCII.DYALOG version 1.4 (1995.10.15) '01390FX 0  EX '0'CRMATCH 00A0,' ZA CRMATCH B [1] Compares two function CRs, ignoring some spacing differences [2] ADLTB LJUST A [3] BDLTB LJUST B [4] ZA MATCH B [5] APLASCII.DYALOG version 1.4 (1995.10.15) '02130FX 0  EX '0'DEFINEFNS 00A0,' ZDEFINEFNS M;C;E;F;G;H;I;K;N;R;S;T;V;W;ERR;NOUNWRAP;IO [1] Defines functions and variables found in message  [2] Arguments: [3] M - the transliterated message from which function/variable [4] definitions should be extracted. May be either a character [5] matrix or a newline-delimited vector. [6] QIO - (optional global) If this var is defined, any value of IO [7] found in the message will be assigned to '0,'QIO. If it isn''t [8] defined, IO will be placed in one of the VARi variables. [9] Results: [10] Z - character matrix containing the names of objects that [11] were defined in the workspace. [12] QIO - (global) value of IO found in the message. (See above.) [13] [14] A line that begins with either [0] or (as the first nonblank [15] character) marks the start of a definition in the message. [16] A line that begins with . marks t'0,'he start of a variable definition. [17] A line that begins with : marks the start of a statement to execute. [18] A line that begins with - marks a separator (start/end of WS, etc.) [19] A definition ends with a blank line, a closing , or the end of the [20] message. [21] [22] If a function can''t be defined, its CR is placed in a global [23] variable CR (where is an integer). [24] If a variable can''t be defined, its value is placed in a global [25] '0,' variable VAR. [26] [27] IO1 [28] Z0 0'''' [29] (~''''M)/1 [30] OUT''The DEFINEFNS argument must be in transliterated form.'' [31] 0 [32] 1:(2=M)/2 If not a matrix, [33] MVTOM TCNL,M break on CRs [34] 2:MLJUST M [35] F((1M),32+1TTABM)M [36] NOUNWRAP1 prevent ASCII2APL from unwrapping lines [37] TMUTE''FASCII2APL F'' get the first few symbols on each line [38]  '0,'Use MUTE to suppress error messages from chopped keywords [39] NOUNWRAP0 turn line unwrapping on [40] (0F)/0 [41] F(0 3F)F [42] S(F[;1]='''')F[;3]^.=''[0]'' find defn starts [43] ESF[;1]='' '' and ends [44] [45] 3:IS1 Loop for each object [46] (I>S)/0 quit if no more objs [47] N(IE)1 num lines in defn [48] RCM[I+1+N;] '0,' the defn [49] CTCNL MTOV C work with it as a vector [50] K'''' [51] Convert to APL, and capture unrecognized-keyword messages: [52] ''KMUTE''''CASCII2APL C''''''WITHTTM TTABM OVER TCNL,'' {nl}'' [53]  We untransliterate objects one at a time because we don''t want the [54] matrix M to become extremely wide from unwrapping the continuation [55] lines in long variable definitions. [56] K(KTCNL)K(KTCNL)K list of bad keywords, i'0,'f any [57] S[I,(~(23C)''.:-'')/(S)I+N]0 mark this one as processed [58]  If this object is a function, don''t consider the ending line [59] (which may be a closing ) to be the start of an object. [60] [61] - prefix -- marker; check version number [62] (''-''.13C)/6 [63] CDLB(C'' '')C [64] V''APLASCII version:'' [65] (V.(V)C)/3 skip all but version markers [66] C(V)C [67] C1XNUMS(1+C''('')C ver'0,'sion number in the argument [68] N1XNUMS(1+A2AVER''('')A2AVER our version number [69] (C=N)/3 done if versions are indentical [70] (C>1.3)/4 warn of v1.3 incompatibility [71] OUT TCNL,''Warning: This transliteration was produced using an old'' [72] OUT''version of APLASCII. Certain nested arrays may not be received'' [73] OUT''correctly, possibly without producing any error message.'' [74] 3 '0,' perhaps we should quit instead... [75] 4:(C1)/17 Level II tolerates either case [127] 16:C0 QUADCASE C '0,' convert quad names to the primary case [128] 17:C0 EJCASE C convert E/J in nums to primary case [129] H(1+CTCNL)C header line [130] C(H)C rest of fn [131] CVTOM C as a matrix [132] (0C)/19 jump if body is empty [133] W1++/^\C'']'' width of line number on each line [134] WWC[;1]=''['' zero width for lines w/o numbers '0,'[135] C(-W)(C)W((C)+0,/W)C remove the line numbers [136] CDLTB C delete leading and trailing blank cols [137] (0C)/19 careful--may be empty now [138] (/(C[;1]='' '')^C.'' '')/18 If no exdents, [139] C'' '',C indent all lines [140] 18:(''APL68K''.6APLVER)/19 If on APL.68000, [141] C[(C^.='' '')/1C;1]'''' make blank line be comments [142]  If we don''t do th'0,'is, APL.68000 deletes the blank lines [143] 19:C('' '',DLTB H)OVER C restore the header [144] WFNNAME H name of fcn (or operator) [145] (~EX W)/20 erase first, in case defined as var [146] NFX C define as fn [147] (010N)/21 If FX failed, [148] 20:NGENSYM''CR'' available name [149] N,''C'' save the CR [150] OUT TCNL,''Unable'0,' to define '',W,''. CR stored in variable '',N,''.'' [151] (0=K)/22 [152] OUT''And, by the way, it contains the following unrecognized keywords:'' [153] OUT K [154] 22 [155] 21:(0=K)/22 [156] OUT TCNL,''Warning--unrecognized keywords in '',W,'':'' [157] OUT K [158] [159] 22:ZZ OVER N remember what we defined [160] 3 Endloop [161] [162] ASCII2APL accessed thru [163] Copyright (c) 1994-95 Jim Weig'0,'ang [164] APLASCII.DYALOG version 1.4 (1995.10.15) '090590FX 0  EX '0'DUMPWS 00A0,' {N} DUMPWS F;KEEPUS;QIO [1] Writes all objects in the workspace to file  [2] Arguments: [3] F - the name of the file to write [4] N - (optional) the names of functions and variables to write. [5] If N is omitted or is numeric, all objects are written. [6] [7] (0=NC''N'')/''N0'' write everything by default [8] KEEPUS1 preserve all character distinctions [9] QIOIO capture global value for use by I'0,'NSERTFNS [10] N DUMPSUB F do the work [11] APLASCII.DYALOG version 1.4 (1995.10.15) '06050FX 0  EX '0'INSERTFNS 00A0,' ZINSERTFNS A;C;F;G;H;I;J;K;N;R;S;T;W;NOUNWRAP;IO [1] Inserts function/variable listings into message , and transliterates it [2] Arguments: [3] A - message into which function definitions should be inserted. [4] May be either a character matrix or newline-delimited vector. [5] Lines in the message that begin with "name" are replaced [6] with the function or variable''s definition. [7] PGWID - (global) the'0,' page width to use in wrapping the result, [8] optionally followed by the continuation indent. [9] (E.g., PGWID78 3) [10] QIO - (optional global) the value of IO outside this function. [11] (Referenced only if IO is inserted.) [12] Result: [13] Z - the expanded message. Has the same form (matrix or vector) [14] as the argument. The entire text, both existing text and [15] inserted function listings, is t'0,'ransliterated to ASCII. [16] Long lines in function and variable listings are wrapped, [17] but long lines in the rest of the text are not. [18] [19] IO1 [20] W2PGWID,3 page width and continuation indent [21] RZA [22] (R=2)/1 [23] ZVTOM TCNL,Z convert vector to matrix [24] 1:T(~AV32127ASCII)/AV non-ASCII characters [25] (~/TZ)/2 If msg isn''t all ASCII, [26] ZA'0,'PL2ASCII Z transliterate it [27] 2:A((1Z),1+1TTABM)LJUST Z [28] NOUNWRAP1 prevent ASCII2APL from unwrapping lines [29] SMUTE''AASCII2APL A'' get first few characters of each row [30]  Use MUTE to prevent warnings caused by chopped keywords [31] NOUNWRAP0 turn line unwrapping on [32] A((1A),2)A need only 1st 2 cols [33] JJ/JA[;1]='''' rows to insert f'0,'ns/vars [34] J(A[J;2]'':'')/J skip rows that start with : [35] (0=J)/12 quit if nothing to insert [36] F0 1ASCII2APL LJUST Z[J;] the fn/var names [37] F0 1(F[;1]=''.'')'' '',F delete . which may have followed [38] I1+''''J [39] 3:(0=II-1)/12 Loop for each insertion (last to first) [40] HG(G'' '')/GF[I;] the object name [41] (/TOLOWER''IO '',[.5]4G)/5 If the object is IO,'0,' [42]  Careful here--DEFINEFNS may change the case of IO [43] (2=NC''QIO'')/4 If QIO isn''t defined, warn user [44] OUT''Warning! IO is shadowed; global value inaccessible. Exported as 1.'' [45] 7 Else, [46] 4:H''QIO'' get value from QIO, not IO [47] 7 Endif [48] 5:(''''=1G)/7 assume variable if starts w. [49] (0 2 3=NC G)'0,'/6,7,8 [50]  Note: On some systems (e.g., Dyalog) NC does not return 4 for [51] quad names, so we handle them separately. [52] ''Unable to insert '',G,'' (wrong name class).'' [53] 3 [54] 6:''Unable to insert '',G,'' (not defined).'' [55] 3 [56] 7:CG FMTVAR H the var defn [57]  Usually H is the same as G, except when G is ''IO'' [58] 10 [59] 8:CCR G the fn defn [60] (~0C)/9 [61] ''Unable to insert'0,' '',G,'' (locked function).'' [62] CAPL2ASCII''  '',G "list" it as fnname [63]  This is done so DEFINEFNS won''t see NAME and define an empty fn [64] C(1,C)C code below expects a matrix [65] 10 [66] 9:N((1C),1)1+1C line numbers [67] N''['',LJUST(RJUST N),'']'' in brackets [68] N((1N),6)N [69] N[1;](-1N)'''' replace [0] with [70] CN,C add the '0,'line numbers [71] CC,[1](1C)N[1;] put closing at bottom [72] SMUTE''CAPL2ASCII C'' transliterate [73] CW WRAPLNS C limit line length [74] 10:KJ[I] row in msg to replace [75] (K=1Z)/11 jump if at end of msg [76] (Z[K+1;]^.='' '')/11 If next line in msg isn''t blank, [77] CC,[1]'' '' add a blank line [78] 11:Z(((K-1),1Z)Z)'0,'OVER C OVER(K,0)Z insert the listing [79] 3 Endloop [80] 12:(R=2)/0 [81] Z1TCNL MTOV Z restore original rank [82] Copyright (c) 1994-5 Jim Weigang [83] APLASCII.DYALOG version 1.4 (1995.10.15) '047740FX 0  EX '0'INSTALL 00A0,' INSTALL;I;S;T;V [1] Prepares the workspace for use, erases build code and documentation [2] ''Working...'' [3] TNL 2 3 do this before defining any local vars [4] PREP2RUN define any missing fns, etc. [5] MAKETTAB [6] SGREETING[1;] version number follows the first comma [7] S''Installed transliteration workspace'',(1+S'','')S [8] SS OVER''For instructions, see DESCRIBE in the APLASCII workspace.'' [9] LXFMTVAL S,'0,'[1]'' '' [10] (''APLPLUS1''.8APLVER)/L3 [11] TCNL,''Do you wish to strip comments and diamondize functions in the'' [12] ''working copy of the A2A workspace? This will make about 37K more'' [13] ''memory available for data. The programs in the original APLASCII'' [14] ''workspace will not be affected.'',TCNL [15] ''Please enter either Y or N.'' [16] ''? '' [17] (~/''Yy''=1~'' ?'')/L3 [18] ''Stripping comments and diamondizing functions...'' [19] I0 [20] L2:((1GRPA2'0,'A)A[I])MATCH>B[I])/0 [21] L2 Endloop [22] L3:Z1 they match [23] APLASCII.DYALOG version 1.4 (1995.10.15) '08510FX 0  EX '0'PREP2RUN 00A0,' PREP2RUN;I;N;S;T;V [1] Performs various steps that finish defining objects in the APLASCII ws [2] [3] Define functions that couldn''t be defined in the master APLASCII [4] workspace on APL*PLUS II. (Either because line [0] contains non- [5] APL*PLUS quad names or because the APL*PLUS II version was needed [6] to build the distribution file.) The function definitions are [7] stored in variables whose name ends in SRC. [8] [9] V(-+/^\V='' '''0,')VNL 2 right justify [10]  Don''t use RJUST because it may not be working yet [11] N((1V),4)V [12] V(N^.=''SRC'')V *SRC var names [13] I0 [14] L1:((1V)T)/B indices of 1st of each group of digits [8] P(B1)/S skip single-digit numbers [26] WK/W [27] B[(S+1),S+W]1 put 1s just past the replacement, and just after digits [28] V(~\B)/V remove the digits after the 1st (which was replaced) [29] Z11V drop the spaces we added [30] (1=A)/0 If arg was a matrix, [31] ZVTOM Z convert result to matrix [32] APLASCII.DYALOG version 1.4 (1995.10.15) '014810FX 0  EX '0'WORDREPL 00A0,' ZA WORDREPL B;C;E;F;I;J;L;R;T;V;W;X [1] Replaces words in text  as directed by [2] This is similar to TEXTREPL, but it does not change phrases that [3] occur as part of a longer word. E.g., if changing IS to ARE, THIS [4] will not be changed to THARE. (TEXTREPL would make the change.) [5] Arguments: [6] B - a character vector, the text to change [7] A - a segmented string containing the old words to search for [8] and the'0,' new phrases to replace them with. E.g., [9] ''/OLD1/NEW1/OLD2/NEW2/OLD3/NEW3'' [10] VARC - (global) a vector of characters that may occur in a "word" [11] Result: [12] Z - like B, but with the changes made [13] [14] Details/limitations: [15] - The old strings must not contain any characters not found in VARC. [16] - Unlike the APL*PLUS assembler version, this function does not insert [17] spaces to prevent two words from running together. '0,' For example, [18] ''//iota''WORDREP'''' returns ''iotaiota''. [19] [20] LVARC characters that are considered "letters" [21] AVTOM A [22] FA[1+I2.51A;] old words to find [23] RA[I;] new replacement words [24] (^/(''A''MTOV F)L)/L1 [25] ''Invalid characters in left argument. (All characters of the target'' [26] ''phrases must all be in VARC.)'' [27] 0 [28] L1:B'' '',B,'' '' this simplifies the logic below [29] '0,'F((1F),2+/\F'' '')F delete trailing blanks, but leave 2 cols [30] II/IBF[;1] places where first letters occur [31] I(B[I+1]F[;2])/I ...followed by second letters [32] I(~B[I-1]L)/I ...and preceded by nonletter [33] XB[(B)I.+1+1F] text following the starts [34] X(X)T\(T,^\XL)/,X first word from each starting posn [35] JF MATIOTA X lookup in old word list [36] I(TJ0)/I ignore nonmatches [37] JT'0,'/J [38] W+/\F'' '' width of each old word [39] T~B[I+W[J]]L 1 if next char past word is not a letter [40] IT/I ignore hits that are part of longer words [41] JT/J [42] V,I,[1.5]TI+W[J]-1 start and end of words [43] ((V)^.=V)/L2 jump if no overlaps [44] ''Overlapping strings. (Gee, I didn''''t think this could happen.)'' [45] 0 [46] L2:C(B)0 [47] C[I,I+W[J]]1 put 1 at start and just past end of each'0,' old word [48] B(~\C)/B delete the old words [49] II-+\0,W[1J] starting posns in compressed B [50] V+/\R'' '' width of each new word [51] II++\0,V[1J] starting posns in expanded B [52] E((B)++/V[J])0 [53] E[I,I+V[J]]1 put 1 at start and just past end of where replacements go [54] B(~E\E)\B insert blanks for new words [55] T(,\T'' '')/,TR[J;] replacement words [56] B[E/E]T i'0,'nsert the new words [57] Z11B drop the blanks we added [58] Copyright (c) 1995 by Jim Weigang [59] APLASCII.DYALOG version 1.4 (1995.10.15) '031750FX 0  EX '0'ALPHS 00A0,' ZALPHS [1] Returns a 2- or 3-by-26 matrix of the alphabets available on this system [2] The rows are: [3] [1;] primary case (usually uppercase, but lower on Sharp APL) [4] [2;] secondary case (usually lowercase or uppercase-underscored, [5] but uppercase on Sharp APL) [6] [3;] third case (if this system has one) [7] [8] (''DYALOG''.6APLVER)/L1 If Dyalog, [9] ZAV[65 17 97.+26] uppercase, lowercase, undersco'0,'red [10] 0 [11] L1:(''IPSA''.4APLVER)/L2 If Sharp, [12] (AV[IO+189]='''')/L2 jump if on SAX--just two alphabets [13] ZAV[86 113 166.+26] three alphabets on MF and PC [14] 0 [15] L2:Z2 26''ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'' [16] Z(''IPSA''^.=4APLVER)Z reverse upper/lower on Sharp APL/SAX [17] APLASCII.DYALOG version 1.4 (1995.10.15) '09070FX 0  EX '0'APLNAME 00A0,' ZAPLNAME [1] Returns a string identifying the current APL system and environment [2] ZDLTB(APLVER''-'')APLVER APL system description [3] (''APLPLUS''.7APLVER)/L1 [4] (~(17APLVER)''23'')/L1 [5] ZZ,'' with Evlevel='',EVLEVEL [6] L1:(''APL2''.4APLVER)/L2 [7] ZZ,'' for '',OPSYS [8] L2:(''APL68K''.6APLVER)/L3 [9] ZZ,'', Level '',LEVEL''I'' [10] L3:(''IPSA''.4APLVER)/0 [11] ZZ,''/'',IPSAVER [12] APLASCII.DYALOG version 1.4 (1995.10.15) '0,' '05020FX 0  EX '0'ASCII 00A0,' ZASCII [1] Returns all 128 ASCII characters, with for nonprinting chars [2] If a character occurs twice in AV, this fn returns the version [3] that maps to the ASCII character when written by TFWRITE or [4] read by TFREAD. [5] [6] Z128'''' [7] Z[32+33]'' !"#$%&''''()*+,-./0123456789:;<=>?@'' [8] Z[65+26]''ABCDEFGHIJKLMNOPQRSTUVWXYZ'' [9] Z[97+26]''abcdefghijklmnopqrstuvwxyz'' [10] Z[91+6]''[\]^_`'' [11] Z[123+4]''{}~'' [12] (''DYALOG''.6'0,'APLVER)/L1 On Dyalog, [13] Z[IO+39 94 124]AV[IO+219 235 238] use ASCII quote/caret/stile [14] 0 [15] Use ASCII split-stile on APL*PLUS and Sharp APL: [16] L1:(~(''APLPLUS''^.=7APLVER)''IPSA''^.=4APLVER)/0 [17] Z[IO+124]''|'' [18] APLASCII.DYALOG version 1.4 (1995.10.15) '08180FX 0  EX '0'DEDUBL 00A0,' ZDEDUBL A;I;S;X;Y [1] Translates ASCII symbols in  to the corresponding APL characters [2] Some APL systems have two copies of certain characters in AV, [3] with one copy being an APL functional symbol and the other an [4] ASCII symbol. For example, APL*PLUS has two vertical bars, one [5] used for residue and the other as ASCII stile. [6] This function eliminates the nonfunctional ASCII symbols, which, [7] because of their system-dependent na'0,'ture, are not usually wanted. [8] [9] (~(''APLPLUS''^.=7APLVER)''IPSA''^.=4APLVER)/L1 [10] X,''|'' find split-stiles [11] Y,'''' replace with APL stile [12] L2 [13] L1:(''DYALOG''.6APLVER)/L3 [14] XAV[IO+219 235 238] ASCII quote, caret, stile [15] YAV[IO+ 13 167 192] change to APL symbols [16] L2:SA [17] I(AX)/A,A indices of chars to translate [18] A[I]Y[XA[I]] replace ''em [19] ZSA restore original shape [20] '0,' 0 [21] L3:ZA no doubled characters on this APL [22] APLASCII.DYALOG version 1.4 (1995.10.15) '011180FX 0  EX '0'DLB 00A0,' ZDLB A;B [1] Deletes leading blank columns in vector or matrix  [2] (2>BA'' '')/L1 [3] BB [4] L1:Z(\B)/A [5] APLASCII.DYALOG version 1.4 (1995.10.15) '01900FX 0  EX '0'DUMPSUB 00A0,' N DUMPSUB F;I;T;IO [1] Subroutine called by DUMPWS [2] F is the file name, N is the list of object names, QIO is global IO [3] IO1 [4] (0=10N)/1 If names were specified, [5] NVTOM,'' '',N get the list as a matrix [6] N(N.'' '')N [7] T'''' [8] 2 Else, [9] 1:NNL 2 3 write all fns and vars [10] Do this because APL.68000 Level I doesn''t sort the NL '0,'result: [11] NN[AVN;] in alphabetic order [12] ***  Dyadic grade, not available on all systems... [13] TGRPA2A OVER VTOM'';QIO;N;F;I;T'' [14] N(0=T MATIOTA N)N except the A2A objects [15] NQVARS OVER N write quad variables too [16] 2:OUT''Writing the following objects to file:'' [17] OUT'' '','' '',(PW-2)TELPRINT NDLTB N [18] T''---- APLASCII version: '',A2AVER,TCNL [19] TT,''---- Source APL system:'0,' '',APLNAME,TCNL [20] TT,''---- Workspace: '',WSID,TCNL [21] TAPL2ASCII T [22] [23] On APL*PLUS (in which TFWRITE has a noninteractive append option), [24] write one object at a time: [25] (''APLPLUS''.7APLVER)/5 [26] T TFWRITE F ask now about any existing file [27] F((1+F'''')F),''A'' append rest without asking [28] I0 [29] 3:((1N)10,B)/B index of first char in each name/number [15] J(VC[1;])/V indices of Es and Js [16] J(^/V[1(V)J.+1 1]12A)/J those between digits [17] TB,J [18] IB[(T>B)/+\TB] index of 1st char of name/number each E/J occurs in [19] '0,'J(V[I]12A)/J weed out E/Js that occur in names, not numbers [20] V[J]C[2;C[1;]V[J]] change the E/Js [21] L2:ZSV [22] Copyright (c) 1995 Jim Weigang [23] APLASCII.DYALOG version 1.4 (1995.10.15) '012240FX 0  EX '0'FMTVAL 00A0,' ZFMTVAL A;E;I;S;PP [1] Formats array value  for A2A transfer [2] E(''DYALOG''^.=6APLVER),''APL68K''^.=6APLVER [3] PP(16 15 17)[E1] maximize [4] E/SA element count [5] I(2S)E=0 If rank 2 or A is empty [6] II(E=1)^1=S or if A is a 1-elt vector, [7] ZI/(S),'''' start with "shape " [8] A,A [9] (IFNEST A)/L3 jump if nested [10] ('' ''=10A)/L1 If numeric, [1'0,'1] (E=0)/''A0'' reshape 0 if empty [12] AA format the numbers [13] L2 Else, character, [14] L1:A'''''''',((1+A='''''''')/A),'''''''' quote it [15] ***  The / is replicate; may not be available on all systems [16] Z(~(E=0)^1=S)/Z omit the 0 for empty vector [17] L2:ZZ,A [18] 0 [19] [20] Recurse on each item of a nested/heterogeneous/boxed array [21] L3:I0 [22] (0S)/''A1A'' get protot'0,'ype if A is empty [23] S''IPSA''^.=4APLVER 1 if on Sharp APL [24] S((~S)/''IA''),S/''>A[I]'' how to pick the Ith element of A [25] EA [26] L4:(E1)'' (''),(FMTVALS),(E>1)/'')'' [28] L4 Endloop [29] APLASCII.DYALOG version 1.4 (1995.10.15) '013430FX 0  EX '0'FMTVAR 00A0,' ZN FMTVAR V;T;W [1] Formats a variable for A2A transfer [2] N is the variable name, V is the array value, Z is a character matrix [3] Z''. '',((N'' '')/N),'''' [4] ZZ,FMTVAL V [5] Translate newline as {nl} in arrays: [6] ''TMUTE''''ZAPL2ASCII Z''''''WITHTTX TTABX OVER TCNL,'' {nl}'' [7]  Use MUTE to avoid warning messages about any braces in the value [8] (PGWIDPW[1]+2 [21] X/S(/SN,R)W [22] Y(R,CN)2 1 3(N,R,C)((NR),C)M [23] YD0 2(,X.C)/Y [24] ZZ OVER Y [25] (PW[2](W)N)/0 [26] M((RN),0)M [27] W(RN)W [28] L2 [29] '0,'Copyright (c) 1978-1988 by Jim Weigang [30] APLASCII.DYALOG version 1.4 (1995.10.15) '010940FX 0  EX '0'TFTRANS 00A0,' ZTFTRANS [1] Returns the native file translate table for Dyalog APL [2] ZASCII,128'''' [3] Z[IO+10 13]TCLF,TCNL [4] Arbitrary, but 1:1, translation for non-ASCII chars: [5] Z[(Z='''')/Z]'''',(~AVZ)/AV [6] APLASCII.DYALOG version 1.4 (1995.10.15) '02930FX 0  EX '0'TOLOWER 00A0,' ZTOLOWER A;B;I;S [1] Translates uppercase letters to lowercase in  [2] SA [3] A,A [4] I''ABCDEFGHIJKLMNOPQRSTUVWXYZ''A [5] BI26 [6] A[B/B]''abcdefghijklmnopqrstuvwxyz''[B/I] [7] ZSA [8] APLASCII.DYALOG version 1.4 (1995.10.15) '02770FX 0  EX '0'UNWRAPLNS 00A0,' ZUNWRAPLNS A;B;I;T [1] Restores long wrapped lines in CR-delimited vector  [2] A long line may be indicated in two ways: Either {+ at the [3] end of the line, followed by +} on the next line, or by {cont''d} [4] at the start of the continuation line. Note that no spaces [5] are added when either of these continuation marks is removed; [6] any necessary spaces must be included in the text to the left [7] or right of the {+ +} or to the right of the {co'0,'nt''d}. [8] [9] ZA [10] (~1(Z=''{'')^(1Z)''+cC'')/0 return arg unchanged if no continuations [11] AVTOM TCNL,A [12] TLJUST A [13] I(((1T),2)T)^.=''+}'' find +} style continuation lines [14] II(TOLOWER((1T),8)T)^.=''{cont''''d}'' and the {cont''d} ones [15] II/I [16] A[I;]T[I;] left-justify continuation lines [17] A1TCNL MTOV A this also deletes trailing blanks [18] T(A=TCNL)/A find '0,'the CRs [19] I((21S)/0 no change if only 2 alphabets [7] IS[3;]V lookup in 3rd case [8] BI1S 1s mark 3rd case letters in input [9] A/L1 If user doesn''t wan'0,'t to preserve 3rd case, [10] Z[B/B]S[2;B/I] convert to secondary case [11] 0 Else, transliterate [12] L1:W1+3B width of each char in output [13] Z(1M+\W)'' '' [14] Z[M]V insert 3 blanks to left of 3rd case letters [15] R((+/B),4)''{A_}'' replacement prototype [16] JS[;1]''A'' row holding uppercase [17] R[;2]S[J;B/I] insert appropriate letter [18] Z[(B/M).+3 2 1 0]R replace 3rd case letters [19] Copy'0,'right (c) 1994 Jim Weigang [20] APLASCII.DYALOG version 1.4 (1995.10.15) '010820FX 0  EX '0'WITHTTM 00A0,' A WITHTTM TTABM [1] Executes statement with TTABM set to  [2] A [3] APLASCII.DYALOG version 1.4 (1995.10.15) '01440FX 0  EX '0'WITHTTX 00A0,' A WITHTTX TTABX [1] Executes statement with TTABX set to  [2] A [3] APLASCII.DYALOG version 1.4 (1995.10.15) '01440FX 0  EX '0'WRAPLNS 00A0,' ZW WRAPLNS A;C;H;I;J;L;M;N;R;S;T;V;IO [1] Wraps long lines in  to a maximum of columns [2] Arguments: [3] A - text whose long lines should be wrapped. May be a [4] character matrix or newline-delimited vector. [5] W[1] - maximum width for an output line. [6] W[2] - optional indent used for continuation lines. The default [7] is zero. [8] Result: [9] Z - text with no line wider than W[1] columns. Has the same [1'0,'0] form (matrix or vector) as the argument. [11] [12] IO1 [13] N0(W,0)[2] continuation indent [14] W''''W page width [15] (W>N+4)/L1 [16] ''Page width is too narrow'' [17] 0 exit without result [18] L1:H20W-N+1 num chars to look back for cut point [19] V is all the characters considered ''letters'' (may be part of a name): [20] V''}{0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_'' '0,'[21] RZA [22] (R=2)/L2 [23] ZVTOM TCNL,Z convert vector to matrix [24] L2:JJ/J((0,W)Z).'' '' indices of long lines [25] I1+''''J [26] L3:(0=II-1)/L6 Loop for each long line, last to first [27] LDTB Z[J[I];] the line [28] Form C, in which 0s mark chars that can be the last on a line: [29] C(LV)\L''{}'' 1s mark words and {phrases} [30] CC^L''}'' zero out }s [31] CC^''{''1L,'' '' zero out chars to'0,' left of { [32] M0 0'''' [33] L4:TW-2 max that can be put on this line [34] (~C[T])/L5 If max would split a name, [35] S1+((-H)TC)0 look for a good place to cut [36] TT-SSH back up to avoid breaking a word [37] (T>N+2)/L5 If this results in nothing, [38] TW-2 take max to avoid infinite loop [39] L5:MM OVER(TL),''{+'' output a line [40] L((-N+2)''+}''),TL '0,' remaining text [41] C((N+2)1),TC remaining break points [42] (W