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 characters long. In the result, a line that ends with "{+" is continued on the next line, and a line that begins with "+}" is a continuation of the previous line. An optional second element in the left argument specifies an indent to be applied to continuation lines.'0,' The default is no indent. The right argument may be either a character matrix or a vector with newline between each line. The result has the same form as the argument. ------------------------------------------------------------------------ '0,' Syntax: vec  UNWRAPLNS vec Unwraps long lines in the argument, restoring the original line boundaries. The argument and result are newline-delimited character vectors. In addition to the {+ +} form of wrapping, UNWRAPLNS recognizes a second form: A line '0,'that begins with "{cont''d}" is a continuation of the previous line. Spaces to the left of {cont''d} and spaces at the end of the previous line are ignored; spaces to the right of {cont''d} are significant. This continuation method, which is far more obvious and attractive than the {+ +} method, would be used in all cases except for one hitch: It can''t be used to represent a statement that has more than consecutive blanks. (Admittedly an extremely rare occurren'0,'ce.) ------------------------------------------------------------------------ Variable: PGWID '0,' Specifies the page width used by INSERTFNS when wrapping long lines. May be either a single number giving the page width, or two numbers giving page width and indent to be used for continuation lines in function listings. If only one element is provided, the default indent is 3 spaces. '0,' ------------------------------------------------------------------------ Function: carray  dir QUADCASE carray Converts the alphabetic case of quad names occurring in the cha'0,'racter array right argument. The left argument specifies the "direction" of the conversion: 1 - convert to lowercase 1 - convert to uppercase 0 - convert to the "primary" case for the system '0,' The primary case is usually uppercase, but is lowercase for Sharp APL. ------------------------------------------------------------------------ Function: carray  dir EJCASE carray '0,' Converts the case of Es and Js in numbers found within the character array right argument. For example, converts between 1E3 and 1e3. The left argument is the same as for QUADCASE. ------------------------------'0,'------------------------------------------ Syntax: vec  FMTVAL array Returns the A2A representation of an array value. You may find experimentation with this function helpful in understanding the format used for variable l'0,'istings. ------------------------------------------------------------------------ Syntax: array  GETVAL vec '0,' Inverse of the FMTVAL function. It converts a one-line variable representation (already in APL characters) to the array it represents. ------------------------------------------------------------------------ '0,' Variables: TTABX and TTABM These character matrices are used by APL2ASCII and ASCII2APL to control the transliteration process. NOTE: Do not edit these variables directly. If you want t'0,'o revise keywords, edit TTSCRIPT instead. See "HOW TO REVISE KEYWORDS", above. ------------------------------------------------------------------------ Variable: TTSCRIPT '0,' A character matrix or newline-delimited vector containing the keywords used by the transliteration functions. The format of this variable is described above in "HOW TO REVISE KEYWORDS", above. -------------------------------------'0,'----------------------------------- Syntax: OUT text A cover for . By redefining OUT, you can suppress or capture messages displayed by the transliteration functions. The MUTE function can be used to capture out'0,'put from an expression. ------------------------------------------------------------------------ Miscellaneous Subroutines: '0,' Some APL systems provide fast assembler- or C-based versions of these functions. If your system does, use the fast versions instead of the supplied functions. OVER - joins two vectors or matrices top-to-bottom, padding with blanks on the right as required. '0,' MATIOTA - searches matrix for each row of . Returns the row index of the first occurrence or 0 if not found. VTOM - converts a delimited vector to a matrix. The first element of the argument is the delimiter. Adjacent or trailing delimiters produce blank lines in the result. '0,' MTOV - converts a matrix to a delimited vector. The left argument is the delimiter character. LJUST - left-justifies a character vector or matrix. RJUST - right-justifies a character vector or matrix'0,'. DLB - deletes leading blank elements or columns in a vector or matrix. DTB - deletes trailing blank elements or columns in a vector or matrix. '0,' DLTB - deletes leading and trailing blank elements or columns in a vector or matrix. TOLOWER - converts uppercase letters to lowercase. '0477 730DETAILS 0GREETING 00A0,'APL-ASCII Transliteration, version 1.4 (1995.10.15)Copyright (c) 1994-95 by Jim Weigang See DESCRIBE '04 510GREETING 0GRPA2A 00A0,'APL2ASCII ASCII2APL DEFINEFNS DUMPWS GRPA2A INSERTFNS KEEPUS LOADWS TFREAD TFWRITE APLNAME APLVER A2AVER ALPHS ASCII DEDUBL DLB DLTB DTB DUMPSUB EDRANK EJCASE FMTVAL FMTVAR FNNAME GENSYM GETVAL IFNEST LJUST LOADSUB MATIOTA MTOV MUTE OUT OVER PGWID QUADCASE QVARS RJUST TCNL TCLF TELPRINT TOLOWER TTABM TTABX UNWRAPLNSUSLTOAPL USLTOASC VTOM WITHTTM '0,'WITHTTX WRAPLNS WSID XNUMS TFTRANS TCLD '056 100GRPA2A 0GRPAPLASCII 00A0,'A2ATEST A2ATEST2 A2ATESTSUB APL2ASCII ASCIISAMP ASCIISAMPX ASCII2APL CRMATCH DEFINEFNS DESCRIBE DETAILS DUMPWS GREETING GRPAPLASCII GRPA2A INSERTFNS INSTALL IPSACASE LOADWS MAKETTAB MATCH PREP2RUN RENAME REPLAVI TFREADSRC TFWRITESRC TTSCRIPT VARC WORDREPL ALPHS APLNAME APLVER A2AVER ASCI'0,'I A2AVERS DEDUBL DLB DLTBSRC DTBSRC DUMPSUB EDRANK EJCASE FMTVAL FMTVAR FNNAME GENSYM GETVAL IFNEST LJUSTSRC LOADSUB MATIOTASRC MTOVSRC MUTE OUT OVERSRC PGWID QUADCASE QVARSSRC RJUST TCLF TCNLSRC TELPRINT TOLOWER UNWRAPLNS USLTOAPL USLTOASC VTOMSRC '0,' WITHTTM WITHTTX WRAPLNS WSID XNUMS TFTRANS '073 150GRPAPLASCII 0TFREADSRC 00A0,' ZTFREAD F;D;I;Q;T;S;TRAP Reads ASCII text file  Argument: F - the name of the text file to read (with optional drive and path) Result: Z - text from the file, represented as a character matrix '0,' TRAP0 ''C'' ''SIGNAL EN'' (3=NC''open'')/L1 ''nfiles''SH'''' L1:Topen F xlate T'''' no translation Slseek T,0 2 find the end of file Zlseek T,0 0 reposition at start of file Z'''' '0,' I-Q32768 L2:(SII+Q)/L3 Dread T,QS-I read in blocks to avoid WS FULL ZZ,TFTRANS[AVD] translate from ASCII L2 L3:close T (~TCLFZ)/L5 If LFs (~TCNLZ)/L4 '0,' and CRs, Z(ZTCLF)/Z remove the LFs L5 If only LFs, L4:Z[(Z=TCLF)/Z]TCNL translate LF to CR L5:Z(-TCNL=1Z)Z drop the final CR ZVTOM TCNL,Z return a matrix APLASCII.DYALOG version 1.4 (1995.10.15) '030 640TFREADSRC 0TFWRITESRC 00A0,' D TFWRITE F;P;R;S;T;IO;TRAP Writes message to ASCII text file  Arguments: M - text to write. May be either a character matrix or a vector with newline between each line. F - name of the file to write to, with optional drive and path. If the file already exists, the user is asked '0,'whether the file should be replaced, appended to, or nothing. This question can be pre-answered by appending a diamond and the reply to the file name in F (as in ''F1.A2A  A''). IO1 R(R'' '')/R(F'''')F reply to file-exists question F(F'' '')/F(1+F'''')F file nam'0,'e Adjust line delimiters and translate to ASCII codes: (2=D)/L1 If arg is a vector, DVTOM TCNL,D convert to matrix L1:T((1D),T)T1TCLD second delimiter char, if any TCLD is either CR,LF (on DOS/Windows) or just LF (on Unix) D(1TCLD)MTOV T,'0,'D convert to delimited vector D(,TCLD)D move the front delimiter to the end DAV[TFTRANSD] translate to ASCII First, try to tie an existing file: (3=NC''open'')/L2 ''nfiles''SH'''' start nfiles if necessary L2'0,':P0 where to start writing in file L7 if file not found, else signal error outside this function: TRAP(102 ''C'' ''L7'')(0 ''C'' ''SIGNAL EN'') T2 0 open F try to tie an existing file Now trap all errors so we don''t leave a file tied: TRAP(0 1000)''C'' ''DM,TC[2]  L9'' '0,' The file already exists. Deal with it. ('' ''1R)/L4 jump if reply was provided in the argument L3:''File '',F,'' already exists.'' ''Do you want to Replace the file, Append to it, or Quit (R/A/Q)?'' ''? '' R1(~R''? '')/R L4:(R=''RrAaQq'')/L5,L5,L6,L6,L9,L9 '0,' TCNL,''*** Please enter either R, A, or Q. ***'',TCNL L3 Replace--erase the existing file: L5:close T untie file we tied TRAP0TRAP no ties, no traps R(2 5''rm erase'')['''',TCLD;] erase command for Unix or DOS  This may have to b'0,'e changed for other operating systems SH R,'' '',F erase existing file L7 go create a new file Append: L6:Plseek T,0 2 length of file ((P=0)1=,TCLD)/L8 skip ahead if file is empty or we''re on Unix Slseek T,1 2 get ready to read last char PP'0,'-AV[IO+26]=read T,1 overwrite last char if it''s Ctrl-Z (EOF) L8 L7:TRAP0 ''C'' ''SIGNAL EN'' signal file name errors outside this fn T2 1 open F create new file TRAP(0 1000)''C'' ''DM,TC[2]  L9'' now trap ''n close L8:Slseek T,P,0 move to desired position in fi'0,'le xlate T'''' no nfiles translation--we did it above Swrite T D write the data L9:TRAP0TRAP traps off, in case error from close close T untie file APLASCII.DYALOG version 1.4 (1995.10.15) '066 740TFWRITESRC 0TTSCRIPT 00A0,'; TTSCRIPT -- used by MAKETTAB to generate the TTABX and TTABM matrices. ; See the description of TTSCRIPT in DETAILS for information ; about the syntax of the script. ;----------------------------------------------------------------------- ; DOUBLED CHARACTERS '0,' ; ; On some APL systems, certain APL function symbols are different ; characters from similar-appearing ASCII characters, which occur ; separately in AV. Examples: ; ; VSAPL & APL*PLUS/MF: ~ ! \ ^ | ; APL*PLUS /PC and /38'0,'6: | ; Dyalog: '' ^ | ; ; Strategy: Translate the non-functional symbol to {a}, where "a" is the ; version of the character that transmits/writes to file as an ASCII ; character, and translate the APL function symbol to "a" without braces. ; For example, if the APL "and" symbol is not the same as the ASCII caret, '0,'; you would use: ; ; ^ {^} ; translate ASCII caret to {^} ; ? ^ . and ; translate APL "and" to ASCII caret ; ; where "?" is the APL "and" symbol. On APL systems that don''t have that ; character doubled, use: '0,' ; ; ^ ^ . and {^} ; translate {and} and {^} to APL "and" ; ; ~ ~ . {~} not less without ! ! . {!} \ \ . {\} '0,' ; ; Note: The APL2ASCII result represents quote, caret, and stile as ; the ASCII versions (not the APL versions) so that cutting and ; pasting will produce the correct characters outside of APL. ; 219 {219} ; ASCII quote '0,'13 219 ; APL quote 235 {235} ; ASCII caret 167 235 . and lcm *. ; APL "and" 238 {238} . ; ASCII stile 192 238 . abs residue stile mod magnitude ; APL stile '0,' ;----------------------------------------------------------------------- ; SINGLE-CHARACTER REPLACEMENTS ; ; A few common APL symbols are translated to a single ASCII symbol. ; The ASCII symbol itself (if it occurs in the APL text) is translated ; to the symbol surrounded by braces. ; '0,' ; NOTE: Row ordering is significant here. The row that translates the ; ASCII symbol to {x} should appear ABOVE the row that translates ; the APL symbol. ; @ {@} @ . lamp comment capnull rem NB. U+235D '0,'# {#} # . quad box U+25AF & {&}  & . diamond <> U+25CA ;-------------------------------------------------'0,'---------------------- ; ESCAPE CHARACTERS ; ; Translating the braces allows the transliteration process to be ; completely reversible. ; { leftbrace . {(} from } rightbrace . {)} '0,' ;----------------------------------------------------------------------- ; REGULAR APL CHARACTERS ; ; These characters should be available on every APL system. '0,'; neg . {-} negative highminus overbar {_} U+00AF  <- . is gets assign leftarrow =. =: := U+2190  -> . goto go branch rightarrow U+2192 /= . ne noteq notequal unequal nubsieve =/ ~= ~: U+2260 >= . ge gteq greq notless <: U+2265 <= . le lteq notgreater >: U+2264 '0,' or . gcd +. U+2228 nand . ~^ *: U+2372 nor . +: U+2371 signum times {x} sign {*} direction U+00D7 divide . reciprocal {%} U+00F7  ln log circlestar ^. U+235F  gradeup . upgrade delta'0,'stile /: U+234B  gradedown . downgrade delstile \: U+2352 ceiling max upstile greater >. U+2308 floor min downstile lesser <. U+230A basevalue . decode base downtack #. U+22A4 represent . encode top uptack #: U+22A5 format . topnull fmt thorn ": U+2355 '0,' execute . do basenull eval ". U+234E domino . quaddivide %. U+2339 quotequad . U+235E pitimes circle o. U+25CB jot . null U+2218 slashbar . compressbar reducebar /- U+233F backslashbar . slopebar expandbar scanbar \- U+2'0,'340 reverse rotate circlestile rev |. U+233D reversebar rotatebar circlebar U+2296 transpose . |: U+2349  first take uparrow mix U+2191  split drop downarrow raze U+2193 alpha . U+237A enlist epsilon memberof'0,' membership in member e. U+2208 iota . indexof i. U+2373 rho . shape reshape {$} U+2374  omega . U+2375  each . dieresis with U+00A8  righttack . lev stop {[} U+22A2  lefttack . dex pass {]} U+22A3 '0,' disclose pick superset rightshoe weakenclose link {>} U+2283 enclose . subset leftshoe {<} U+2282 upshoe . intersection cap U+2229 downshoe . union cup U+222A del . U+2207 delta . U+2206 delta_ . deltaunderscore deltaunderbar U+2359 '0,'  deltilde . U+236B  ibeam . U+2336 ;----------------------------------------------------------------------- ; NEW OVERSTRIKES ; '0,' ; If one of the following symbols isn''t available on your APL system, put ; a semicolon at the front of the line. This will cause MAKETTAB to ignore; the row. This section includes all the APL symbols in the Unicode 1.1 ; standard, many of which I''ve never seen in practice. ; 208 commabar . catbar ,- table U+236A '0,'; jotdieresis . on rank cut {"} paw U+2364 ; circledieresis . hoof upon U+2365 209 depth match equalunderscore equalunderbar equal_ =_ -: U+2261 210 notmatch . ~=_ U+2262 47 zilde . 0~ U+236C 127 squad . squishquad index U+2337 241 find . epsilon_ epsilonunderscore epsilonunder'0,'bar U+2377 ; iota_ . iotaunderscore iotaunderbar U+2378 133 tildedieresis . U+2368 62 pounds . U+00A3 63 cent . leftshoestile cents U+00A2 ; yen . U+00A5 ; uptackdieresis . encodedieresis U+2361 ; deldieresis . U+2362 '0,' ; stardieresis . U+2363 ; dotdieresis . U+2235 ; quadjot . U+233B ; quadbackslash . quadslope U+2342 ; fread . quadgets quadis quadleftarrow U+2347 ; fwrite . quadgoto quadrightarrow U+2348 '0,'; ftake . quadtake quaduparrow U+2350 ; fdrop . quaddrop quaddownarrow U+2357 ; quadequal . U+2338 ; quaddiamond . U+233A ; quadcircle . U+233C ; quadlessthan . U+2343 ; quadgreaterthan . U+2344 '0,' ; quador . U+234C ; quadand . U+2353 ; quaddelta . U+234D ; quaddel . U+2354 ; quadnotequal . U+236F ; quadquestion . U+2370 ; quadcolon . U+2360 '0,' ; circlejot . U+233E ; downshoestile . U+2366 ; greaterthandieresis . U+2369 ; stiletilde . U+236D ; leftvane . U+2345 ; rightvane . U+2346 '0,'; upvane . U+234F ; downvane . U+2356 ; downtack_ . U+234A ; uptackoverbar . U+2351 ; quote_ . U+2358 ; diamond_ . U+235A ; jot_ . U+235B '0,' ; circle_ . U+235C ; semicolon_ . U+236E ; alpha_ . U+2376 ; omega_ . U+2379 ;----------------------------------------------------------------------- ; NON-APL, NON-ASCII CHAR'0,'ACTERS ; ; (Including ASCII control characters, except for newline.) ; These are represented using Unicode. The number following the U+ is ; the hexadecimal (base-16) representation of the Unicode index of ; the character. ; '0,' 1 U+0008 ; BS 2 U+000A ; LF 9 U+0009 ; HT 230 U+2502 ; box drawings light vertical 227 U+2524 ; box drawings light vertical and left 226 U+251C ; box drawings light vertical and right 228 U+2534 ; box drawings light up and horizontal '0,' 229 U+252C ; box drawings light down and horizontal 225 U+2500 ; box drawings light horizontal 224 U+253C ; box drawings light vertical and horizontal 220 U+2518 ; box drawings light up and left 223 U+2514 ; box drawings light up and right 222 U+250C ; box drawings light down and right 221 U+2510 ; box drawings'0,' light down and left '0214 750TTSCRIPT 0VARC 00A0,'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_'0670VARC 0A2AVER 00A0,'1.4 (1995.10.15)'0160A2AVER 0A2AVERS 00A0,'APLPLUS1 - APL*PLUS /PC APLPLUS2 - APL*PLUS II/386 APLPLUS3 - APL*PLUS III/Windows APL2 - IBM APL2 DYALOG - Dyalog APL IPSA - Sharp APL APL68K/MAC - APL.68000 for the MacintoshAPL68K/AMIGA - APL.68000 for the Amiga '08 450A2AVERS 0APLVER 00A0,'DYALOG - Dyalog APL '0360APLVER 0DLTBSRC 00A0,' ZDLTB A;B Deletes leading and trailing blank columns in vector or matrix  (2>BA'' '')/L1 BB L1:Z((\B)^\B)/A APLASCII.DYALOG version 1.4 (1995.10.15) '06 660DLTBSRC 0DTBSRC 00A0,' ZDTB A;B Deletes trailing blank columns in vector or matrix  (2>BA'' '')/L1 BB L1:Z(\B)/A APLASCII.DYALOG version 1.4 (1995.10.15) '06 540DTBSRC 0EDRANK 000 0,20(0)0EDRANK 0LJUSTSRC 00A0,' ZLJUST A Left-justifies character vector or matrix  Z(+/^\A='' '')A APLASCII.DYALOG version 1.4 (1995.10.15) '04 450LJUSTSRC 0MATIOTASRC00A0,' ZA MATIOTA B;C;F;N;P;R;T Returns row indices of names  in lookup table , or 0 if not found CA OVER B join arguments CC[PAVC;] alphabetize the rows F/C1C mark the first occurrence of each different row F[F]1 insure that the first element is 1 TF/P indices of where the firsts occur '0,' NT-10,T number of occurrences of each distinct row TZ+\F\N make (N[1]N[1]),(N[2]N[2]),... Z[P]T return to original ordering  Z[P]Z is not used because it doesn''t work correctly on APL.68000 R121 1,A number of rows in A ZRZ drop off answers for rows of A ZZZR convert out-of-range numbers to 0 '0,' Z((1