├── .gitattributes ├── README.md ├── LICENSE ├── StartupSession └── Dyalog │ ├── Serial.aplf │ ├── Array.md │ ├── Hooks.apln │ ├── Array.apln │ └── Utils.apln └── StartupSession.aplf /.gitattributes: -------------------------------------------------------------------------------- 1 | *.apl? linguist-language=APL 2 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # qSE 2 | 3 | This repository contains things that initialise `⎕SE` and end up there, as a sort of boot-strapping. 4 | 5 | Note that `⎕SE` is currently populated as follows: 6 | 7 | - The interpreter loads a session .dse file which is created by the buildse.dws workspace and contains (on Windows) mostly GUI objects. 8 | - The interpreter automatically loads and executes StartupSession.aplf which in turn: 9 | - Loads Link 10 | - Uses that to load things from various StartupSession folders 11 | - Boots SALT 12 | - Loads and executes setup.dyalog if it exists 13 | - Loads and executes a .dyapp file if specified 14 | - Calls any `Run` functions in the Link-loaded directories 15 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 Dyalog Ltd. 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /StartupSession/Dyalog/Serial.aplf: -------------------------------------------------------------------------------- 1 | old←Serial new 2 | ⍝ This sets/queries the current serial number on all platforms 3 | ⍝ Serial ⍬ returns current serial number 4 | ⍝ Serial 123456 sets serial number to 123456 5 | ⍝ Serial 'unregistered' removes the current serial number 6 | ⍝ Contact sales@dyalog.com to obtain a serial number 7 | 8 | ;⎕ML;⎕USING ⍝ sysvars 9 | ;Env;Set;Norm;Signal ⍝ fns 10 | ;defdir;deffile;file;pat;msg;dir;envvar;regkey;dyalog ⍝ vars 11 | 12 | ⎕ML←1 13 | 14 | regkey←envvar←'DYALOG_SERIAL' ⍝ envvar/registry key 15 | deffile←'serial' ⍝ default file name 16 | defdir←'/.dyalog' ⍝ default location under $HOME 17 | 18 | msg←'unregistered' ⍝ what to use to indicate unregistered 19 | pat←'^\d{1,6}$|^',msg,'$' ⍝ what constitutes a valid serial number 20 | 21 | Norm←⊃pat ⎕S'\l0'⍠1 ⍝ anycase → lowercase 22 | Env←2 ⎕NQ #'GetEnvironment',⊂ 23 | 24 | old←Norm(Env envvar)msg ⍝ default to msg 25 | 26 | :If ×≢new ⍝ has content: set 27 | new←Norm' '~⍨⍕new ⍝ allow separated digits too 28 | ⎕SIGNAL(' '≡new)/⊂('EN' 11)('Message'('Serial number must be 6 digits or ''',msg,'''')) 29 | new←(-6⌈≢new)↑new,⍨5⍴'0' ⍝ pad left with 0s 30 | 31 | Signal←⎕SIGNAL{('EN'(10×⎕EN))('EM'(⎕EM ⎕EN))('Message'⍵)} 32 | 33 | :If 'Win'≡3↑⊃# ⎕WG'APLVersion' ⍝ Windows 34 | dyalog←⊃4070⌶⍬ ⍝ ask APL where it gets its registry values from 35 | :Trap 0 36 | ⎕USING←'Microsoft' 37 | Win32.Registry.SetValue dyalog regkey new 38 | :Else 39 | Signal'Could not write "',new,'" to the registry key "',dyalog,'\',regkey,'"' 40 | :EndTrap 41 | 42 | old,←'; is now ' '; remains '⊃⍨1+old≡new 43 | old,←new 44 | 45 | :Else 46 | file←Env'DYALOG_SERIALFILE' 47 | :If ×≢file 48 | dir←⊃⎕NPARTS file 49 | :Else 50 | dir←defdir,⍨Env'HOME' 51 | file←dir,'/',deffile 52 | :EndIf 53 | :Trap 0 54 | 3 ⎕MKDIR dir 55 | file 1 ⎕NPUT⍨⊂new 56 | :Else 57 | Signal'Could not write "',new,'" to the file "',file,'"' 58 | :EndTrap 59 | 60 | old,←'; will be ' '; remains '⊃⍨1+old≡new 61 | old,←new,' for new sessions' 62 | 63 | :EndIf 64 | old,⍨←'Was ' 65 | :Else ⍝ Just report 66 | old,⍨←'Is ' 67 | :EndIf 68 | -------------------------------------------------------------------------------- /StartupSession/Dyalog/Array.md: -------------------------------------------------------------------------------- 1 | # A model for a literal notation for most APL arrays 2 | 3 | ## How to use 4 | 5 | The API is located in the `⎕SE.Dyalog.Array` namespace. 6 | 7 | ### `Deserialise` 8 | 9 | This takes a character array and evaluates it as array notation, returning the resulting array. 10 | 11 | ```apl 12 | Deserialise '[1 2 ⋄ 3 4]' 13 | Deserialise '(a:{(+⌿⍵)÷≢⍵}' 'b:42)' 14 | Deserialise '(1 2 3',(⎕UCS 10),'4 5)' 15 | ``` 16 | 17 | An optional left argument of `0` may be specified to return an APL expression which will generate the array rather than returning the array itself. 18 | 19 | ### `Serialise` 20 | 21 | This takes an array and returns a vector of character vectors representing the argument in array notation. 22 | 23 | ```apl 24 | Serialise 2 2⍴⍳4 25 | Serialise ⎕fix ':namespace' 'a←{(+⌿⍵)÷≢⍵}' 'b←42' ':endnamespace' 26 | Serialise '(1 2 3)(4 5)' 27 | ``` 28 | 29 | An optional left argument of `1` may be specified to force return of a vector by using `⋄` to fuse lines. Alternatively, a negative number may be given as left argument to specify how many spaces to indent the content of multi-line parenthesis/brackets (default is 2). 30 | 31 | **Note:** `Serialise` will error if it cannot generate array notation that will round-trip. 32 | 33 | ### `∆NS` 34 | 35 | Extends `⎕NS` to allow a two-element right argument of names and values: 36 | 37 | ```apl 38 | myns←∆NS ('name1' 'name2')(7 42) 39 | 'myns'∆NS ('name3' 'name4')('apl' 'dyalog') 40 | ``` 41 | 42 | ### `∆NSinverse` 43 | 44 | Takes a ref or name of a namespace and returns a two-element vector of names and values. 45 | ``` 46 | ∆NSinverse myns 47 | ∆NSinverse 'myns' 48 | ``` 49 | 50 | ### `Inline` 51 | 52 | This allows using the notation inline, optionally over multiple lines, without having to quote everything. Instead, the notation is encapsulated in a dfn, which is used as operand for `Inline` which in turn returns the corresponding array. A right argument must be supplied, and may be `⍬` or `1` returns the array, while `0` returns an expression for the array. 53 | 54 | ## Domain and Limitations 55 | 56 | ### Valid Content 57 | 58 | The models handle arrays consisting of numbers, characters, namespaces, one-liner dfns/dops, and such arrays. Note that namespaces lose their scripts, names, and system variables when serialised, just like when converted to JSON using `⎕JSON`. Classes, Instances, Interfaces, and namespaces are not supported. Namespaces with circular references will cause `Serialise` to recurse until `WS FULL`. 59 | 60 | ### Functions and Operators 61 | 62 | `Serialise` does handle multi-line dfns/dops, but `Deserialise` is not able to parse them. Tradfns/tradops and derived functions/operators (including primitives and trains) are not supported. 63 | 64 | ### Code Layout 65 | 66 | `Serialise` generates indented notation using line breaks, but will fall back to using diamonds for the inner parts of certain nested arrays. It will often generate superfluous parentheses and diamonds. 67 | 68 | ### Scoping and Order of Evaluation 69 | 70 | The official proposal for the below notation includes specification of exact scope in phrases, including order of evaluation. The models do not attempt to address this other than encapsulating namespace members such that names created as side effects avoid polluting their surroundings. This also means that a namespace cannot contain a member with a name identical to itself. 71 | 72 | ### System Variables 73 | 74 | `Deserialise` does not accept invalid APL names as members of namespaces. This includes otherwise valid system names like `⎕IO` and `⎕ML`. 75 | 76 | ## Notation 77 | 78 | The notation extends strand notation as follows: 79 | 80 | ### Round Parentheses 81 | 82 | A diamond (`⋄`) inside a parenthesis causes the parenthesis to represent a vector where each diamond-delimited phrase represents an element. 83 |  `(1 2 ⋄ 3 4 5)` is equivalent to `(1 2)(3 4 5)` 84 | 85 | A colon (`:`) inside a parenthesis causes the parenthesis to represent a namespace where each diamond-delimited phrase represents a name:value pair. 86 |  `(ans:42)` is equivalent to `⎕JSON'{"ans":42}'` (except for the display form) 87 | 88 | An empty parenthesis (`()`) represents a new empty namespace. 89 |  `()` is equivalent to `⎕NS⍬` 90 | 91 | ### Square Brackets 92 | 93 | A diamond (`⋄`) inside a bracket causes the bracket to represent an array where each diamond-delimited phrase represents a major cell. 94 |  `[1 2 3 ⋄ 4 5 6]` is equivalent to `2 3⍴1 2 3,4 5 6` 95 | 96 | If a major cell is scalar, it will be interpreted as a 1-element vector. 97 |  `[1 ⋄ 2]` is equivalent to `⍪1 2` 98 | 99 | If major cells have differing shapes, they will be extended in the manner of Mix (`↑`). 100 |  `[1 2 ⋄ 3 4 5]` is equivalent to `2 3⍴1 2 0,3 4 5` 101 | 102 | ### Diamonds, Whitespace, Line Breaks 103 | 104 | At least one diamond is required to indicate array notation as opposed to traditional parenthesisation or bracketing. 105 |  `(1)` is equivalent to `1` 106 |  `'abcdef'[[1 2 3 ⋄ 4 5 6]]` is equivalent to `'abcdef'[2 3⍴1 2 3,4 5 6]` 107 | 108 | All-whitespace phrases are ignored. 109 |  `(1 2 ⋄ ⋄ 3 4 5)` is equivalent to `(1 2)(3 4 5)` 110 |  `(1 2 ⋄ )` is equivalent to `,⊂1 2` 111 |  `(1 ⋄ )` is equivalent to `,1` 112 | 113 | Any diamond may be exchanged with a line break. 114 |  `(1 2` 115 |  `3 4 5)` is equivalent to `(1 2 ⋄ 3 4 5)` -------------------------------------------------------------------------------- /StartupSession/Dyalog/Hooks.apln: -------------------------------------------------------------------------------- 1 | :Namespace Hooks 2 | ⎕ML←1 ⋄ ⎕IO←1 3 | 4 | Num←2|⎕DR 5 | 6 | Handle←{ ⍝ Generate hash using dfns.chksum 7 | 9{⎕IO ⎕ML←0 1 ⍝ Simple ⍺-digit checksum. 8 | 9 | bvec←{ ⍝ byte-vector. 10 | sub←{(⍴⍵)bvec,⍵} ⍝ bvec of sub-item. 11 | 0∊⍴⍵:⍺ pref sub⊃⍵ ⍝ null: prototypical item. 12 | (⍺≡⍬)∧isref⊃⍵:⍬ ⍝ ref: ignored. 13 | ⍵≡,⎕NULL:⍬ ⍝ ⎕null: ignored. 14 | 6=10|⎕DR ⍵:⍺ pref↑,/sub¨⍵ ⍝ nested: cat of sub-vectors. 15 | ⍺ pref bytes ifdr(11∘≠)⎕UCS ifdr(~2∘|)⍵ ⍝ bytes of array. 16 | } 17 | 18 | ifdr←{⍺⍺⍣(⍵⍵ ⎕DR ⍵)⊢⍵} ⍝ apply fn for all other types 19 | isref←{9=⎕NC'⍵'} ⍝ namespace reference. 20 | bytes←{256|83 ⎕DR ⍵} ⍝ data bytes. 21 | pref←{(bytes ⍺,¯1),⍵} ⍝ prefixed shape vector. 22 | wsum←{⍵+.×1+⍳⍴⍵} ⍝ weighted sum. 23 | 24 | ⍺←6 ⋄ (10*⍺)|wsum(⍴⍵)bvec,⍵ ⍝ ⍺-digit weighted sum of byte-vector. 25 | }⍤1⊢⍵ 26 | } 27 | 28 | ∇ {handle}←Register efp ⍝ ... prioritised callback 29 | ⍝ Argument must be (event fn priority) or matrix of such rows 30 | ;event 31 | 32 | :If 2=≢⍴efp ⍝ mat 33 | :Trap 11 34 | handle←Register⍤1⊢efp ⍝ process rows 35 | :Else 36 | →ERROR 37 | :EndTrap 38 | 39 | :ElseIf ~326∊⎕DR¨efp ⍝no refs 40 | :AndIf 0 0 1≡Num¨efp ⍝ char char num 41 | :AndIf 1∧.≥≢∘⍴¨efp ⍝ all scal/vecs 42 | :AndIf 1∧.≤≢¨efp ⍝ all non-empty 43 | efp←,¨efp 44 | :Trap 11 45 | Init event←⊃efp 46 | :Case 11 47 | ⎕SIGNAL ⎕DMX.(⊂('EN'EN)('Message'Message)) 48 | :EndTrap 49 | ⍎event,'←Norm ',event,'⍪1↓efp' 50 | handle←Handle efp 51 | 52 | :Else 53 | ERROR:⎕SIGNAL⊂('EN' 11)('Message' 'Argument must be (event fn priority) or matrix of such rows') 54 | :EndIf 55 | ∇ 56 | 57 | ∇ {removed}←Deregister handle ⍝ ... prioritised callback 58 | ⍝ Handle must be integer(s) 59 | ;events;event;remove;kept;hooks 60 | 61 | :If ~1 3∊⍨⎕DR handle 62 | events←⎕A ⎕NL ¯2 ⍝ all globals that begin with capital letter 63 | removed←0 3⍴⊂'' 64 | :For event :In events 65 | Init event 66 | hooks←(⊂event),⍎event 67 | remove←handle∊⍨Handle hooks 68 | removed⍪←remove⌿hooks 69 | kept←(~remove)⌿0 1↓hooks 70 | ⍎event,'←kept' 71 | Init event 72 | :EndFor 73 | removed←,⍣(⍬≡⍴handle)⊢removed 74 | 75 | :Else 76 | ⎕SIGNAL⊂('EN' 11)('Message' 'Handle(s) must be numeric') 77 | :EndIf 78 | ∇ 79 | 80 | ∇ {exists}←{create}Init event ⍝ global var for event 81 | ⍝ Event must be character vector(s) in correct case 82 | ⍝ create:0 to leave undefined if missing 83 | ;hooks;val;current;err;exists 84 | 85 | :If 900⌶⍬ ⍝monadic 86 | create←1 87 | :EndIf 88 | 89 | :If 2=|≡event 90 | :Trap 11 91 | exists←create Init¨event 92 | :Else 93 | →ERROR 94 | :EndTrap 95 | 96 | :ElseIf ~Num event ⍝ char 97 | :AndIf 1≥≢⍴event ⍝ scal/vector 98 | :AndIf ⎕A∊⍨⊃event ⍝ capital 99 | :AndIf ¯1≠⎕NC event ⍝ id 100 | 101 | err←1 102 | val←0 2⍴'' 0 103 | :If exists←2=⊃⎕NC event ⍝ exists 104 | current←⍎event 105 | :AndIf ~0∊⍴current 106 | 107 | :If ~326∊⎕DR¨∊current ⍝ no refs 108 | :AndIf ~0∊1≥≢∘⍴¨⊆current ⍝ no high-ranks 109 | 110 | :Select ≢⍴current ⍝ rank 111 | :CaseList 0 1 ⍝ scal/vec 112 | 113 | :If 2≥|≡current ⍝ scal/vec of or simple char scal/vec 114 | val←0,⍨⍪⊆,current 115 | err←0 116 | :EndIf 117 | 118 | :Case 2 ⍝ mat 119 | 120 | :If (0 1∘⊣⍤1≡Num¨)current ⍝ (char num) rows 121 | val←current 122 | err←0 123 | :EndIf 124 | 125 | :EndSelect 126 | :EndIf 127 | :If err 128 | ⎕←' *** "',(⍕⎕THIS),'.',event,'" must be 2-column matrix of (fn priority) pairs' 129 | :EndIf 130 | :EndIf 131 | 132 | :If exists 133 | :OrIf exists←create 134 | ⍎event,'←Norm val' 135 | :EndIf 136 | :Else 137 | ERROR:⎕SIGNAL⊂('EN' 11)('Message' 'Event must be character vector(s) in correct case') 138 | :EndIf 139 | ∇ 140 | 141 | Norm←{∪⍵⌷⍨⊂⍋⌽⍵} 142 | 143 | ∇ hooks←Registered event ⍝ report callbacks 144 | ⍝ Event must be character vector(s) in correct case 145 | ;events 146 | 147 | events←⎕A ⎕NL ¯2 148 | 0 Init events 149 | :If ⍬''∊⍨⊂event 150 | event←events 151 | :EndIf 152 | :If 2=|≡event 153 | :If 0∊⍴event 154 | hooks←0 3⍴'' '' 0 155 | :Else 156 | hooks/¨⍨←×≢hooks←⊃⍪⌿(⊂,Registered)¨event 157 | :EndIf 158 | :Else 159 | :If events∊⍨⊂event 160 | hooks←Norm⍎event 161 | :Else 162 | hooks←0 2⍴⊂'' 163 | :EndIf 164 | :EndIf 165 | ∇ 166 | 167 | :EndNamespace 168 | -------------------------------------------------------------------------------- /StartupSession.aplf: -------------------------------------------------------------------------------- 1 | {startupSession}←StartupSession 2 | ⍝ This is a boot-strapping function run when APL starts. 3 | ⍝ It loads Link and uses that to load other Dyalog and/or user-specified things into ⎕SE and calls their Run functions. 4 | ⍝ Then it optionally uses Link to load a directory structure of text files into #. 5 | ⍝ Please do not rely on any other current behaviour of this function, as it may change without warning. 6 | ⍝ For more information about... 7 | ⍝ ∘ Session Initialisation: https://help.dyalog.com/latest/#UserGuide/The%20APL%20Environment/Session%20Initialisation.htm 8 | ⍝ ∘ Linking into #: https://help.dyalog.com/latest/#UserGuide/Installation%20and%20Configuration/Configuration%20Parameters/Load.htm 9 | ⍝ ∘ Link: https://dyalog.github.io/link/latest 10 | 11 | :If ⎕SE=⎕THIS 12 | '⎕SE.Dyalog.Callbacks'⎕NS⊃⎕SI 13 | startupSession←⎕SE.Dyalog.Callbacks.StartupSession 14 | ⎕SE.Dyalog.Callbacks.⎕EX⊃⎕SI 15 | :Return 16 | :EndIf 17 | 18 | ⎕SHADOW';'(≠⊆⊢)';⎕IO;⎕ML' ⍝ sysvars 19 | ⎕SHADOW';'(≠⊆⊢)';Env;Dir;Path;NoSlash;AutoStatus;Cut;FullMsg;NJoin;Critical;MsgBox' ⍝ fns 20 | ⎕SHADOW';'(≠⊆⊢)';win;dirs;dir;root;subdir;files;paths;path;roots;os;ver;envVars;defaults;as;oldlinks;new;z;fulldir;dskl;type;osSep' ⍝ vars 21 | ⎕SHADOW';'(≠⊆⊢)';exe;parent;load;msg;dl;ref;fullns;runs;run;preFiles;pre;opts;dsx;dld;su;ns;fn;dyalog;loadSALT;home;salt;ds' 22 | 23 | ⎕IO←⎕ML←1 24 | 25 | Env←{2 ⎕NQ #'GetEnvironment'⍵} 26 | :If '1'∊Env'DYALOGSTARTUPSTOP' 27 | (1+⊃⎕LC)⎕STOP⊃⎕SI 28 | :EndIf 29 | 30 | :Trap '1'∊Env'DYALOGSTARTUPDEBUG' ⍝ If DYALOGSTARTUPDEBUG, only trap WS FULL 31 | AutoStatus←2036⌶ 32 | MsgBox←3503⌶ 33 | NoSlash←{⍵↓⍨-'/\'∊⍨⊃⌽⍵} ⍝ remove trailing (back)slash 34 | Cut←≠⊆⊢ 35 | FullMsg←{⍵.(OSError{⍵,2⌽(×≢⊃⍬⍴2⌽⍺,⊂'')/'") ("',⊃⍬⍴2⌽⊆⍺}Message{⍵,⍺,⍨': '/⍨×≢⍺}⊃⍬⍴DM,⊂'')} 36 | Path←{ 37 | default←defaults,¨⊂⍺ 38 | append←osSep=⊃⍵ 39 | empty←0=≢⍵ 40 | user←osSep Cut ⍵ 41 | user,⍨default/⍨append∨empty 42 | } 43 | Dir←{ ⍝ ⍺=1:dirs; ⍺=2:files 44 | pats←⍺⊃(,⊂'/*')('/*.dyalog' '/*.apl?') 45 | pats,¨⍨←⊂NoSlash ⍵ 46 | ~∨/⎕NEXISTS ⎕OPT 1⊢pats:0⍴⊂'' 47 | (names types)←⊃,¨/0 1 ⎕NINFO ⎕OPT 1⊢pats 48 | {(⊂⍋⍵)⌷⍵}names/⍨types=⍺ 49 | } 50 | NJoin←{ 51 | tail←⍺↑⍨-1⌊≢⍺ 52 | ⍵,⍨⍺,'/'↓⍨∧/tail∊'/',win/'\:' 53 | } 54 | Critical←→{ 55 | ('CLEAR WS'≢⎕WSID)∨''≢Env'LOAD':{→}⍞←⍵ ⍝ message + cut full stack 56 | win≤'1'∊Env'DYALOG_NOPOPUPS':⎕OFF 1⊣⎕DL 5⊣⍞←⍵ 57 | lc←⊃1↓⎕LC 58 | ⍺←lc-1 59 | r←¯60+MsgBox('⎕SE.StartupSession[',⍺⍕⍛,']')(⍵'' 'Abort startup entirely, Retry to inspect code, or Ignore and cut stack?')'Error'('ABORT' 'RETRY' 'IGNORE') 60 | 1=r:⎕OFF 1 61 | ⍝ Attempt to stop on the line where the config param was first checked 62 | 2=r:⍺⊣1 ⎕NQ(⎕NEW'Timer'(⊂'Event'('Select' '[interrupt]')))'Select'⊣2 ⎕NQ ⎕SE'KeyPress' 'EP' 63 | 3=r:→ ⍝ cut full stack 64 | } 65 | 66 | :Section __Read_Environment 67 | (os ver type exe)←# ⎕WG'APLVersion' 68 | win←'Windows'≡7↑os 69 | osSep←':;'⊃⍨1+win 70 | dyalog←NoSlash Env'DYALOG' 71 | :If 0∊⍴salt←NoSlash Env'SALT' 72 | ⍝ If it isn't it should be found here: 73 | salt←(NoSlash(¯3×'bin'≡¯3↑dyalog)↓dyalog),'/SALT' 74 | :EndIf 75 | salt,←'/core/SALTUtils.dyalog' 76 | loadSALT←~'1'∊Env'DYALOGSTARTUPNOSALT' 77 | home←NoSlash Env'HOME' 78 | envVars←Env¨'DYALOGSTARTUPSE' 'DYALOGSTARTUPWS' 79 | 80 | ⍝ Exit code 1 means startup fail due to missing or invalid resource 81 | dl←Env'DYALOGLINK' 82 | retryDl: :If 0=≢dl 83 | dl←dyalog 84 | :ElseIf ~⎕NEXISTS dl 85 | :OrIf 1≠1 ⎕NINFO dl 86 | retryDl Critical'Configuration parameter DYALOGLINK is "',dl,'" which must be an existing directory.' 87 | :EndIf 88 | :If 0=≢ds←⊃⎕NPARTS Env'DYALOGSTARTUP' 89 | ds←dyalog 90 | :EndIf 91 | dskl←Env'DYALOGSTARTUPKEEPLINK' 92 | :If ~dskl⊂⍛∊,¨'' '0' '1' 93 | Critical'Configuration parameter DYALOGSTARTUPKEEPLINK is "',dskl,'" but must be "0" or "1".' 94 | :Else 95 | dskl∊⍨←'1' 96 | :EndIf 97 | dsx←Env'DYALOGSTARTUP_X' 98 | load←NoSlash Env'LOAD' 99 | :EndSection 100 | 101 | :Section a_Populate_Session_Object from $DYALOG/StartupSession/*/*.apl? 102 | :If ~dskl ⍝ forget links? 103 | {}5178⌶⊃⎕SI ⍝ forget self 104 | :EndIf 105 | 106 | :For pre dir :InEach ('Link' 'Dyalog')(dl ds) 107 | dir←∊1 ⎕NPARTS dir,'/StartupSession/',pre 108 | ref←⍎ns←⍬ ⎕NS⍨'⎕SE.',pre 109 | preFiles←⊃⎕NINFO⍠1⊢dir,'/*.apl?' 110 | :If dskl 111 | {2 ref.⎕FIX'file://',⍵}¨preFiles 112 | opts←⎕SE.Link.U.DefaultOpts ⍬ 113 | 'opts'⎕NS'dir' 'ns' 114 | opts.restored←0 115 | opts.flagged←⍬ 116 | opts.singlefile←0 117 | opts.⎕DF 1⌽'][',⎕SE.Link.U.LinkDisplay opts 118 | :If 0=⎕NC'⎕SE.Link.Links' 119 | ⎕SE.Link.Links←⍬ 120 | :EndIf 121 | ⎕SE.Link.(U.SetLinks Links,{0::⍬ ⋄ Watcher.Watch ⍵})opts ⍝ Watcher might fail 122 | :Else 123 | {2 ref.⎕FIX⊃⎕NGET⍠'ContentType' 'APLCode'⊢⍵ 1}¨preFiles 124 | :EndIf 125 | :EndFor 126 | 127 | :If 0∊≢¨envVars 128 | defaults←{ 129 | verSpec←{ 130 | ⍵:NoSlash 2⊃4070⌶⍬ ⍝ win only: version specific folder in user docs folder 131 | num←∊2↑'.'Cut ver 132 | uc←'UC'/⍨80 82=⎕DR'' ⍝ unicode/classic 133 | bits←¯2↑'32',{⍵↓⍨⍵⍳'-'}os 134 | home,'/dyalog.',num,uc,bits,'.files' 135 | }⍵ 136 | user←⊃⎕NPARTS verSpec ⍝ /../ 137 | verAgno←user,'dyalog.files' 'Dyalog APL Files'⊃⍨1+⍵ 138 | ∊¨1 ⎕NPARTS dyalog verAgno verSpec ⍝ normalise 139 | }win 140 | :EndIf 141 | 142 | paths←1⍴'/StartupSession/' '/StartupWorkspace/'Path¨envVars ⍝ "1⍴" disables ws 143 | roots←1⍴⎕SE # ⍝ "1⍴" disables # 144 | ⍝ ↓ if envVar set, then we don't know what's what 145 | (⍎'⎕SE.Dyalog.StartupSession'⎕NS ⍬).(Dyalog VerAgno VerSpec AllPaths)←(0 0 0⊣⍣((×⍤≢∧osSep≠⊃)⊃envVars)⊢3↑⊃paths),⍬⍴paths 146 | as←AutoStatus 0 147 | run←0⍴⊂'' 148 | :For path root :InEach paths roots 149 | :For dir :In path 150 | ⍝ files←2 Dir dir ⍝ disabled non-dir items in root 151 | ⍝ {}root FixEach files ⍝ disabled non-dir items in root 152 | dirs←1 Dir dir 153 | :For subdir :In 2⊃¨⎕NPARTS dirs 154 | :Select fullns←root,⍥⍕'.',subdir 155 | :CaseList '⎕SE.Link' '⎕SE.Dyalog' ⍝ already loaded 156 | :Else 157 | ⎕EX fullns 158 | fulldir←dir NJoin subdir 159 | opts←⎕SE.Link.U.DefaultOpts ⍬ 160 | opts.codeExtensions~←'apl' 'mipage' 161 | :If dskl ⍝ proper link or just import? 162 | :Trap 0 163 | {}opts ⎕SE.Link.Create fullns fulldir 164 | run,←⊂fullns fulldir 165 | :Else 166 | ⍞←('Could not link "',fulldir,'" with ',fullns,': ',FullMsg ⎕DMX),⎕UCS 13 167 | :EndTrap 168 | :Else 169 | :Trap 0 170 | opts.overwrite←1 171 | {}opts ⎕SE.Link.Import fullns fulldir 172 | run,←⊂fullns fulldir 173 | :Else 174 | ⍞←('Could not import "',fulldir,'" to ',fullns,': ',FullMsg ⎕DMX),⎕UCS 13 175 | :EndTrap 176 | :EndIf 177 | :EndSelect 178 | :EndFor 179 | :EndFor 180 | :EndFor 181 | :EndSection 182 | 183 | :Section b_Boot_SALT 184 | :Trap 0 185 | :If loadSALT 186 | ⍝ Define the (SALTUtils) namespace locally 187 | su←0 ⎕FIX'file://',salt 188 | su.BootSALT ⍝ finally, call the bootstrap fn 189 | :EndIf 190 | :Else 191 | ⍞←'SALT initialization failed: ',(⎕UCS 13),(⎕DMX.DM[2 3],⍨⊂FullMsg ⎕DMX),¨⎕UCS 13 192 | :EndTrap 193 | :If 3=⎕NC'⎕SE.Link.SECreate' 194 | {}⎕SE.Link.SECreate 195 | :Else 196 | {}⎕SE.Link.U.GetLinks ⍝ In case the session was saved with links and there is no Link.SECreate 197 | :EndIf 198 | :EndSection 199 | 200 | :Section c_Call_Run_From_Dirs 201 | :If ~(⊂dsx)∊,¨'' '0' '1' 202 | Critical'Configuration parameter DYALOGSTARTUP_X is "',dskl,'" but must be "0" or "1".' 203 | :Else 204 | dsx∊⍨←'1' 205 | :EndIf 206 | :If ~dsx 207 | run/⍨←3=40 ⎕ATX(⊃,'.Run'⍨)¨run ⍝ which ns.Run functions exist? 208 | :For ns dir :In run 209 | :Trap 0 210 | :Select 11 40 ⎕ATX fn←ns,'.Run' ⍝ valence,type 211 | :Case 0 3 ⍝ niladic function 212 | ⍎fn 213 | :CaseList (1 3)(¯2 3) ⍝ monadic/ambivalent function 214 | (⍎fn),⊂dir 215 | :Case 2 3 ⍝ dyadic function 216 | ⍞←('Function ',fn,' must not be dyadic'),⎕UCS 13 217 | :Else 218 | ⍞←('Cannot find function ',fn),⎕UCS 13 219 | :EndSelect 220 | :Else 221 | ⍞←('Calling ',fn,' caused a ',FullMsg ⎕DMX),⎕UCS 13 222 | :EndTrap 223 | :EndFor 224 | :EndIf 225 | :EndSection 226 | 227 | :Section d_Link_Hash_And_Set_Latent_Expression 228 | msg←' ─ LOAD ignored!' 229 | :If 0≠≢load ⍝ LOAD allows linking/importing one dir into # at startup 230 | :AndIf ⎕NEXISTS load 231 | :AndIf 1=1 ⎕NINFO load ⍝ handle if dir (file is handled by interpreter) 232 | :If 0≠⎕NC'⎕SE.Link' 233 | :Select exe 234 | :CaseList 'Development' 'DLL' 235 | :Trap 0 236 | ⍞←⎕SE.Link.Create # load 237 | :Else 238 | ⍞←'Could not link "',load,'" with #: ',FullMsg ⎕DMX 239 | :EndTrap 240 | :CaseList 'Runtime' 'DLLRT' 241 | :Trap 0 242 | ⍞←⎕SE.Link.Import # load 243 | :Else 244 | ⍞←'Could not import "',load,'" to #: ',FullMsg ⎕DMX 245 | :EndTrap 246 | :Else 247 | ⍞←'Could not determine if interpreter (',exe,') is Development or Runtime version',msg 248 | :EndSelect 249 | :Else 250 | :Select exe 251 | :CaseList 'Development' 'DLL' 252 | ⍞←'Could not link "',load,'" with # because ⎕SE.Link does not exist',msg 253 | :CaseList 'Runtime' 'DLLRT' 254 | ⍞←'Could not import "',load,'" to # because ⎕SE.Link does not exist',msg 255 | :Else 256 | ⍞←'Could not bring in "',load,'" to # because ⎕SE.Link does not exist',msg 257 | :EndSelect 258 | :EndIf 259 | ⍞←⎕UCS 13 260 | 2060⌶'#.Run',(0≠1 2⊃⎕AT'#.Run')/',⊂''',(load/⍨1+''''=load),'''' ⍝ make interpreter ⎕LX-style run before 6-space prompt (undocumented) 261 | :EndIf 262 | :EndSection 263 | 264 | {}AutoStatus as 265 | 266 | ⎕SE.SALTUtils.USetup'init' 0 267 | {}⎕SE.UCMD'box' ⍝ initialise output space so toolbar button works 268 | 269 | startupSession←1 270 | :Else 271 | startupSession←0 272 | :EndTrap 273 | -------------------------------------------------------------------------------- /StartupSession/Dyalog/Array.apln: -------------------------------------------------------------------------------- 1 | :Namespace Array ⍝ A model for a literal notation for most APL arrays 2 | ⎕IO←1 ⋄ ⎕ML←1 3 | DEBUG←1 4 | 5 | sysVars←'⎕CT' '⎕DIV' '⎕IO' '⎕ML' '⎕PP' '⎕RL' '⎕RTL' '⎕WX' '⎕USING' '⎕AVU' '⎕DCT' '⎕FR' 6 | string←'''[^'']*''' 7 | 8 | :Namespace serialise 9 | ⎕FR←1287 ⋄ ⎕PP←34 10 | 11 | 12 | :Section UTIL 13 | (sp qu os cs or cr oc cc ec di nl)←' ''[](){}⊂⋄',⎕UCS 13 14 | Clean←{ 15 | t←'^'''',' ',''''$'⎕R''⊢⍵ 16 | one←2=+/'()'∊⍨##.string ⎕R''⊢t 17 | strip←one∧'()'≡(⊃,⊢/)t 18 | (strip↓⌽)⍣2⊢t 19 | } 20 | Esc←{ 21 | Sub←{ 22 | cont←⍵.Lengths[3] 23 | nums←⍕⎕UCS ⍵.Match↓⍨-cont 24 | ''',',(cont⍴'('),'⎕UCS ',nums,cont/'),''',⊃⌽⍵.Match 25 | } 26 | '([\x00-\x1F\x7F-\x9F\x{2028}\x{2029}\x{FEFF}\x{FFF9}-\x{FFFF}]+)(.?)'⎕R Sub⍠'Mode' 'D'⊢⍵ 27 | } 28 | Unempty←⊢↑⍨1⌈≢ 29 | Empty←{ 30 | ⍵,⍨'0⌿'/⍨Lead0 ⍺ 31 | } 32 | _Sub_←{ 33 | (o c)←⍵⍵ 34 | inner←∊⍺⍺ Unempty ⍵ 35 | ⍵ Empty o,nl,inner,c 36 | } 37 | Join←{⍺←nl ⋄ ¯1↓∊⍵,¨⍺} 38 | _Paren_←{ 39 | res←⍵⍵ ⍵ 40 | ⍺⍺ res:or,res,cr 41 | res 42 | } 43 | 44 | :EndSection 45 | :Section REPR 46 | Repr←{ 47 | ⍵≡⍬:'⍬' 48 | ⍵≡0⌿⎕NULL:'0⌿⎕NULL' 49 | Char ⍵:Clean Esc qu,(qu ⎕R qu qu⊢⍵),qu 50 | Num ⍵:⍕⍵ 51 | Null ⍵:'⎕NULL'⍴⍨5×≢⍵ 52 | Any0 ⍵:'0⌿',Repr()⍴⍨1⌈⍴⍵ 53 | ~Scal ⍵:⎕SIGNAL 999 54 | Ns ⍵ 55 | } 56 | ∇ repr←{caller}Ns ref;name;names;code;ser;ind;xr;nr;nc 57 | :If ##.∆Monadic ⍬ 58 | caller←⊃⎕RSI 59 | :Else 60 | caller←serialise.FirstNs caller,⊃⎕RSI 61 | :EndIf 62 | :Select nc←⎕NC⊂'ref' 63 | :CaseList 9.1 9.4 9.5 64 | :Trap 0 65 | repr←or,(Join ⎕SRC ref),nl,cr 66 | :Else 67 | repr←or nl 68 | 69 | names←##.sysVars/⍨≢⌿ref ref.##∘.⍎##.sysVars 70 | names,←ref.⎕NL-⍳9 71 | 72 | :For name :In names 73 | code←Join ref.⎕NR name 74 | 75 | :Select ref.⎕NC⊂name 76 | :CaseList 3.1 4.1 77 | repr,←name,':(∇',code,nl,'∇)' 78 | :CaseList 3.2 4.2 79 | :If '{'=⊃' '~⍨∊code ⍝ anon 80 | repr,←name,':',code 81 | :Else 82 | repr,←1↓':'@(<\'←'=⊢)code 83 | :EndIf 84 | :CaseList 3.3 4.3 85 | xr←ref ##.∆XR name 86 | nr←ref.⎕NR name 87 | repr,←name,':',{1↓¯1↓⍵}⍣(⍬≢⍴xr)⊢xr(caller Tacit)nr 88 | :Else 89 | repr,←name,':',caller Ser ref⍎name 90 | :EndSelect 91 | repr,←nl 92 | :EndFor 93 | 94 | repr,←cr 95 | :EndTrap 96 | :Else 97 | ⎕SIGNAL⊂( 98 | 'EN' 11 99 | 'Message'('Cannot represent ',( 100 | 'instance' 101 | 'unscripted class' 102 | 'unscripted interface' 103 | 'external class' 104 | 'external interface' 105 | 'unknown object' 106 | )⊃⍨9.2 9.4 9.5 9.6 9.7⍳nc) 107 | ) 108 | :EndSelect 109 | ∇ 110 | Tacit←{ 111 | 2 9∊⍨⊂⍺:⍺⍺ Ser ⍵ ⍝ array 112 | ⍬≢⍴⍺:∊or,(⍺ ∇¨⍵),(']'/⍨'['≡2⊃⍵),cr ⍝ derv 113 | (3 1)(4 1)∊⍨⊂⍺,≢⍵:⍵ ⍝ primitive 114 | 0=≢⍵:⎕SIGNAL⊂('EN' 11 ⋄ 'Message' 'Cannot represent external or locked functions') 115 | code←Join⊆⍵ 116 | '}'=⊃⌽⊃⌽⍵:code ⍝ dfn 117 | '(∇',code,nl,'∇)' ⍝ tradfn 118 | } 119 | :EndSection 120 | :Section TYPE 121 | Char←0 2∊⍨10|⎕DR 122 | Num←2|⎕DR 123 | Null←{0::0 ⋄ ~0∊⎕NULL≡∘⊃¨⍵} 124 | Ptr←6=10|⎕DR 125 | Basic←Char∨Num∨Null 126 | FirstNum←Num¨⊃⍤/⊢ 127 | FirstNs←{9∊⎕NC'⍵'}¨⊃⍤/⊢ 128 | :EndSection 129 | :Section PROP 130 | Simple←{1=≡,⍵} 131 | Scal←⍬≡⍴ 132 | Nested←{1<|≡⍵} 133 | Vec1←{(,1)≡⍴⍵} 134 | HiRank←{1<≢⍴⍵} 135 | Vec←{1=≢⍴⍵} 136 | Mat←{2=≢⍴⍵} 137 | String←Simple∧Char∧Vec 138 | _ForEach←{0∊⍴⍵:⍵ ⋄ ⍺⍺¨⍵} 139 | Table←Mat>0∊(String∨Simple∧Scal∧Num∨Null)_ForEach 140 | Lead0←0=≢ 141 | Any0←0∊⍴ 142 | Col1←{1=⊃⌽⍴⍵} 143 | :EndSection 144 | Ser←{ 145 | ⍺←⊃⎕RSI 146 | (Simple∧Scal)⍵:Repr ⍵ 147 | Scal ⍵:ec,⍺ ∇⊃⍵ 148 | 149 | Self←⊂nl,⍨∇ 150 | 151 | (Any0Col1)⍵:Join os,cs,⍨{(+/∨\' '≠⌽⍵)↑¨↓⍵}0 1↓⊃,/' ',¨↑¨↓⍉(∨/'⎕UCS'⍷##.string ⎕R'')_Paren_(⍺∘∇)¨⍵ 153 | HiRank ⍵:Self⍤¯1 _Sub_ os cs⊢⍵ 154 | Nested ⍵:Self¨_Sub_ or cr⊢⍵ 155 | 156 | Vec1 ⍵:or,(⍺ ∇⊃⍵),di cr 157 | 158 | (Basic∨Scal)⍵:Repr ⍵ 159 | ∧/Basic¨⍵:sp Join(6≤≢)_Paren_ Repr¨⍵ 160 | 161 | Self¨_Sub_ or cr⊢⍵ ⍝ hetero 162 | } 163 | :EndNamespace 164 | Serialise←{ 165 | ⍺←⍬ 166 | num←serialise.FirstNum ⍺,0 167 | caller←serialise.FirstNs ⍺,⊃⎕RSI 168 | 169 | Bad←{(caller code)←⍵ 170 | '+'∊⍺:0 171 | 11::1 172 | value←Deserialise caller.{⍺⍺ ⍵}code ⍝ deserialise in caller namespace to have proper ⎕FR 173 | code≢caller serialise.Ser value ⍝ serialisation must round-trip 174 | } 175 | code←caller serialise.Ser ⍵ 176 | ⍺ Bad caller code:⎕SIGNAL⊂('EN' 16 ⋄ 'Message' 'It would not be possible to deserialise the generated array notation') 177 | 178 | code Format⍨1∊⍺ 179 | } 180 | 181 | Format←{ 182 | Split←{(+/∨\' '≠⌽⍵)↑¨↓⍵}⎕FMT 183 | ⍝ change "(⋄" to just "(" 184 | 'AIX'≢3↑⊃# ⎕WG'APLVersion':¯1↓'''[^'']*''' '\(⋄'⎕R'\0' '('Split ⍺ ∆FMTAPLAN Split ⍵ 185 | 186 | split←Split ⍵ 187 | ⍺:string'([[(]) ⋄ ' ' ⋄ ([])])' ' +'⎕R'&' '\1' ' ⋄\1' ' '⊢3↓∊' ⋄ '∘,¨split 188 | code←string ⎕R'⋄',⊆⍵ ⍝ remove quoted text first 189 | fmt←⎕FMT'\[[^][]+\]' '\([^)(]+\)'⎕R''⍣≡code ⍝ remove bracket contents 190 | delta←(+/'(['∊⍨fmt)-(+/fmt∊')]') 191 | ind←+\0(⌊+0,¯1↓⌈)delta 192 | ind{⍵,⍨⍺⍴''}¨split 193 | } 194 | 195 | Safe←{ ⍝ Is ⍵ APLAN safe? 196 | comment←'\h*⍝.*' 197 | exp←'(?<=\d)\.?e¯?(?=\d)' 198 | complex←'(?<=\d)\.?j¯?\.?(?=\d)' 199 | ucs←'⎕ucs' 200 | null←'⎕null' 201 | empty←'0\h*⌿' 202 | member←'([\w∆⍙]|⎕(avu|ct|dct|div|fr|io|ml|pp|rl|rtl|using|wx))+\h*:' 203 | other←'[][)(⋄¯.⊂⍬,\s]+' 204 | remain←string comment exp complex ucs null empty member other ⎕R''⍠1⍠'Mode' 'D'⍠'UCP' 1⊢⍵ 205 | remain←'\{[^{}]*\}'⎕R''⍠'Mode' 'D'⍠'DotAll' 1⍣≡remain ⍝ dfns 206 | ''≡⎕D~⍨∊remain ⍝ separate step because j/e 207 | } 208 | 209 | ∆APLAN←{ 210 | ⍺←⊃⎕RSI 211 | 0::⎕SIGNAL⊂⎕DMX.( ⍝ resignal 212 | 'EN'EN 213 | 'EM'EM 214 | 'Message'(OSError{⍵,2⌽(×≢⊃⍬⍴2⌽⍺,⊂'')/'") ("',⊃⍬⍴2⌽⍺}Message) 215 | ) 216 | name←'_'⍴⍨1+⊃⌽⍴⍺.⎕NL⍳9 217 | ⍬≡0⍴⍺.⎕FX(⊂name,'←{'),⊆⍵,'}':¯2 Deserialise ⍵ 218 | (⍺.⎕EX name)(⍺⍎name)⍬ 219 | } 220 | 221 | Deserialise←{ ⍝ Convert text to array 222 | ⍺←⍬ ⍝ 1=safe exec expr; 0=return expr; ¯1=unsafe exec expr; ¯2=force APL model 223 | (model beSafe execute)←(¯2∘=,0∘⌈,1⌊|)serialise.FirstNum ⍺,1 224 | caller←serialise.FirstNs ⍺,⊃⎕RSI 225 | 226 | ⍝ Make normalised simple vector: 227 | w←↓⍣(2=≢⍴⍵)⊢⍵ ⍝ if mat, make nested 228 | w←~⍤∊∘(⎕UCS 10 13)⍛⊆⍣(∨/⍵∊⍨⎕UCS 10 13)⊢w ⍝ if simple, make simple 229 | 230 | beSafe>Safe w:⎕SIGNAL⊂('EN' 11 ⋄ 'Message' 'Unsafe array notation') 231 | 232 | ⍝ fall back to APL model on error 233 | model∨/¯1↓bot:⍺ SubParse ⍵ 254 | p←bot×SepMask ⍵ 255 | ∨/p:∊{1=≢⍵:',⊂',⍵ ⋄ ⍵}⍺(Paren ∇)EachNonempty Over(p Split)⍵ 256 | p←2(1,>/∨¯1↓0,0)∧(l≠1)∨(t=0))×+\(t=1)∧(l=1))⊆x ⍝ cut expression within level-1 parentheses 301 | 1=≢x:H ⍺ ∇⊃x ⍝ single expression : don't enclose with ¨ 302 | DEBUG∧1<⌈/l:H ⍺ ∇¨x ⍝ force going through the hard code 303 | 10::H ⍺ ∇¨x ⋄ H ⍺⍎¨x ⍝ attempt to ⍎¨ with a single guard - otherwise dig each 304 | } 305 | DEBUG:⍺ ExecuteEach ⍵ ⍝ force going through the hard code 306 | 10::⍺ ExecuteEach ⍵ ⋄ ⍺⍎⍵ ⍝ attempt simple ⍎ and catch LIMIT ERROR 307 | } 308 | 309 | w←'''[^'']*''' '⍝.*'⎕R'&' ''⍠'ResultText' 'Simple'⊢w ⍝ strip comments 310 | w/⍨←{(∨\⍵)∧⌽∨\⌽⍵}33≤⎕UCS w ⍝ strip leading/trailing non-printables 311 | 312 | pl←ParenLev w 313 | (0≠⊢/pl)∨(∨/0>pl):⎕SIGNAL⊂('EN' 2 ⋄ 'Message' 'Unmatched brackets') 314 | ∨/(pl=0)×SepMask w:⎕SIGNAL⊂('EN' 11 ⋄ 'Message' 'Multi-line input') 315 | caller Execute⍣execute⊢pl Parse w ⍝ materialise namespace as child of calling namespace 316 | } 317 | 318 | 319 | Inline←{ 320 | caller←serialise.FirstNs ⍵,⊃⎕RSI 321 | aa←⍺⍺ 322 | caller Deserialise 1↓∊(⎕UCS 13),¨'^( *[\w∆⍙]+ *← *)?{( |\R)*|( |\R)*}\R*$'⎕R''⍠'Mode' 'D'⎕NR'aa' 323 | } 324 | 325 | 326 | Is←{ 327 | 0::'MISMATCH'⎕SIGNAL 999 328 | a←Serialise ⍺⍺ Inline 1 329 | a≡Serialise ⍵: 330 | a≡Serialise ⎕JSON ⍵: 331 | ∧/⍵(1∊⍷)¨⊂↑a: 332 | !# 333 | } 334 | 335 | 336 | Ed←{ ⍝ Skip ⍺⍺ QA if interpreter skips lines that look like invalid ∇ Editor directives 337 | ' 396 | '''' 397 | '"' 398 | '$' 399 | ) 400 | }Is(⊂'<>'),'''"$' 401 | 402 | {(42 ⋄ )}Is,42 403 | 404 | {(42 405 | )}Is,42 406 | 407 | { 408 | (1 2 3 'Hello' ⋄ 4 5 6 'World') 409 | }Is(1 2 3 'Hello')(4 5 6 'World') 410 | 411 | { 412 | (1 2 3 'Hello' 413 | 4 5 6 'World') 414 | }Is(1 2 3 'Hello')(4 5 6 'World') 415 | 416 | { 417 | (0 1 ⋄ 2 3 418 | 4 5 ⋄ 6 7) 419 | }Is↓4 2⍴⍳8 420 | 421 | { 422 | ('Three' 423 | 'Blind' 424 | 'Mice') 425 | }Is'Three' 'Blind' 'Mice' 426 | :EndSection 427 | :Section Matrices 428 | { 429 | [ 430 | 1 '' 431 | ¯1('-' ⋄ ) 432 | ] 433 | }Is 2 2⍴1 '' ¯1(,'-') 434 | 435 | {[0 1 2 436 | 3 4 5] 437 | }Is 2 3⍴⍳6 438 | 439 | {[ 440 | ( 441 | 'short' 442 | ) 443 | ( 444 | 'longer text' 445 | ) 446 | ( 447 | 'longest test text' 448 | )] 449 | }Is⍪'short' 'longer text' 'longest test text' 450 | 451 | {[ ⋄ 0 1 2 3] 452 | }Is⍉⍪⍳4 453 | 454 | {[ 455 | 0 1 2 3 456 | ] 457 | }Is⍉⍪⍳4 458 | 459 | {['Three' 460 | 'Blind' 461 | 'Mice'] 462 | }Is 3 5⍴'ThreeBlindMice ' 463 | 464 | {[ 465 | ('Three' 466 | 'Blind' 467 | 'Mice') 468 | ] 469 | }Is 1 3⍴'Three' 'Blind' 'Mice' 470 | 471 | {[1 ⋄ ] 472 | }Is⍪1 473 | 474 | { 475 | 1 2[1 ⋄ ] 476 | }Is 1 2(⍪1) 477 | :EndSection 478 | :Section Combo 479 | { 480 | ([0 0 1 481 | 1 0 1 482 | 0 1 1] 483 | 484 | [0 1 1 485 | 1 1 0 486 | 0 1 0] 487 | 488 | [0 1 1 1 489 | 1 1 1 0] 490 | 491 | [0 1 1 0 492 | 1 0 0 1 493 | 0 1 1 0]) 494 | 495 | }Is Ed{ 496 | _←⍉⍪0 0 1 497 | _⍪←1 0 1 498 | _⍪←0 1 1 499 | r←⊂_ 500 | _←⍉⍪0 1 1 501 | _⍪←1 1 0 502 | _⍪←0 1 0 503 | r,←⊂_ 504 | _←⍉⍪0 1 1 1 505 | _⍪←1 1 1 0 506 | r,←⊂_ 507 | _←⍉⍪0 1 1 0 508 | _⍪←1 0 0 1 509 | _⍪←0 1 1 0 510 | r,←⊂_ 511 | r 512 | }⍬ 513 | 514 | {[0 'OK' ⋄ 1 'WS FULL' ⋄ 2 'SYNTAX ERROR' ⋄ 3 'INDEX ERROR' ⋄ 4 'RANK ERROR'] 515 | }Is{ 516 | e←⍉⍪0 'OK' 517 | e⍪←1 'WS FULL' 518 | e⍪←2 'SYNTAX ERROR' 519 | e⍪←3 'INDEX ERROR' 520 | e⍪←4 'RANK ERROR' 521 | e 522 | }⍬ 523 | {['a'(⊂1 2)'a' 524 | (⊂1 2)'a'(⊂1 2)] 525 | }Is 2 3⍴'a'(⊂1 2) 526 | :EndSection 527 | 528 | :Section High Rank 529 | { 530 | [[3 531 | 1 5 9] 532 | [2 7 1 533 | 2 8]] 534 | }Is Ed 2 2 3⍴3 0 0 1 5 9 2 7 1 2 8 0 535 | { 536 | [ 537 | [ 538 | [ 539 | 1 2 3 540 | 4 5 6 541 | ] 542 | ] 543 | ] 544 | }Is Ed 1 1 2 3⍴1 2 3 4 5 6 545 | { 546 | [ 547 | [ 548 | [ 549 | 1 550 | ] 551 | [ 552 | 2 553 | ] 554 | ] 555 | [ 556 | [ 557 | 3 558 | ] 559 | [ 560 | 4 561 | ] 562 | ] 563 | [ 564 | [ 565 | 5 566 | ] 567 | [ 568 | 6 569 | ] 570 | ] 571 | ] 572 | }Is Ed 3 2 1 1⍴1 2 3 4 5 6 573 | 574 | :EndSection 575 | 576 | :Section Empty 577 | { 578 | ⍬ 579 | }Is ⍬ 580 | { 581 | (⍬ ⋄ ) 582 | }Is,⊂⍬ 583 | { 584 | 0⌿⊂⍬ 585 | }Is 0⌿⊂⍬ 586 | { 587 | 0⌿⊂⊂⍬ 588 | }Is 0⌿⊂⊂⍬ 589 | { 590 | 0⌿⊂0⌿⊂⍬ 591 | }Is 0⌿⊂0⌿⊂⍬ 592 | {[⍬ ⋄ ] 593 | }Is⍉⍪⍬ 594 | { 595 | 0⌿[0 ⋄ ] 596 | }Is⍪⍬ 597 | { 598 | 0⌿⊂[⍬ ⋄ ] 599 | }Is 0⌿⊂⍉⍪⍬ 600 | { 601 | 0⌿⊂0⌿[0 ⋄ ] 602 | }Is 0⌿⊂⍪⍬ 603 | :EndSection 604 | 605 | :Section Namespace 606 | { 607 | () 608 | }Is'{}' 609 | 610 | { 611 | ( 612 | ) 613 | }Is'{}' 614 | 615 | { 616 | ()() 617 | }Is'[{},{}]' 618 | 619 | ⍝ { 620 | ⍝ (a:⍳n←3 ⋄ b:n*2) 621 | ⍝ }Is'{"a":[0,1,2],"b":9}' 622 | 623 | ⍝ { 624 | ⍝ (p:{⍺+⍵} 625 | ⍝ m:{⍺-⍵} 626 | ⍝ s:,∘(,',')((,',')∘,) 627 | ⍝ o:⍣2) 628 | ⍝ }Is'p:{⍺+⍵}' 'm:{⍺-⍵}' 's:(,∘(' '))((' ')∘,)' 'o:⍣2' 629 | 630 | { 631 | (v:(1 2 ⋄ 3)) 632 | }Is'{"v":[[1,2],3]}' 633 | 634 | { 635 | (v:(1 2 636 | 3)) 637 | }Is'{"v":[[1,2],3]}' 638 | 639 | { 640 | (v:(1 2 ⋄ 3) 641 | ) 642 | }Is'{"v":[[1,2],3]}' 643 | 644 | { 645 | ( 646 | () 647 | ) 648 | }Is'[{}]' 649 | 650 | {(n:())}Is'{"n":{}}' 651 | 652 | :EndSection 653 | r←1 654 | ∇ 655 | 656 | 657 | ∇ r←DeserialiseQA stop_on_error;⎕IO;Is;⎕TRAP 658 | ⎕IO←0 659 | ⎕TRAP←(~stop_on_error)/⊂999 'C' '→r←0' 660 | Is←{ 661 | Check←'MISMATCH'⎕SIGNAL 999↓⍨⍵∘≡∨1∊⍵⍷↑ 662 | a←⍺⍺ Inline 1 663 | ×⎕NC'⍺':Check a.⎕NR ⍺ 664 | Check{⎕JSON⍣(326∊⎕DR¨∊⍵)⊢⍵}⍣(⍵≢⎕NULL)⊢a 665 | } 666 | 667 | :Section scalars 668 | { 669 | 'a' 670 | }Is'a' 671 | { 672 | 42 673 | }Is 42 674 | { 675 | ⎕NULL 676 | }Is ⎕NULL 677 | { 678 | ⎕UCS 0 679 | }Is ⎕UCS 0 680 | :EndSection 681 | :Section vectors 682 | {(42 ⋄ )}Is,42 683 | 684 | {(42 685 | )}Is,42 686 | 687 | { ⍝ ⎕AV 688 | 'Hello',(⎕UCS 0 8 10 13 32 12 6 7 27 9 9014 619),'%''⍺⍵_abcdefghijklmnopqrstuvwxyz',(⎕UCS 1 2),'¯.⍬0123456789',(⎕UCS 3 8866 165),'$£¢∆ABCDEFGHIJKLMNOPQRSTUVWXYZ',(⎕UCS 4 5 253 183 127),'⍙ÁÂÃÇÈÊËÌÍÎÏÐÒÓÔÕÙÚÛÝþãìðòõ{',(⎕UCS 8364),'}⊣⌷¨ÀÄÅÆ⍨ÉÑÖØÜßàáâäåæçèéêëíîïñ[/⌿\⍀<≤=≥>≠∨∧-+÷×?∊⍴~↑↓⍳○*⌈⌊∇∘(⊂⊃∩∪⊥⊤|;,⍱⍲⍒⍋⍉⌽⊖⍟⌹!⍕⍎⍫⍪≡≢óôöø"#',(⎕UCS 30 38 180 9496 9488 9484 9492 9532 9472 9500 9508 9524 9516 9474),'@ùúû^ü`∣¶:⍷¿¡⋄←→⍝)]',(⎕UCS 31 160),'§⎕⍞⍣' 689 | }Is'Hello',⎕AV 690 | 691 | { 692 | (1 2 3 'Hello' ⋄ 4 5 6 'World') 693 | }Is(1 2 3 'Hello')(4 5 6 'World') 694 | 695 | { 696 | (1 2 3 'Hello' 697 | 4 5 6 'World') 698 | }Is(1 2 3 'Hello')(4 5 6 'World') 699 | 700 | { 701 | (0 1 ⋄ 2 3 702 | 4 5 ⋄ 6 7) 703 | }Is↓4 2⍴⍳8 704 | 705 | { 706 | ('Three' 707 | 'Blind' 708 | 'Mice') 709 | }Is'Three' 'Blind' 'Mice' 710 | :EndSection 711 | :Section Matrices 712 | {[0 1 2 713 | 3 4 5] 714 | }Is 2 3⍴⍳6 715 | 716 | {[ ⋄ 0 1 2 3] 717 | }Is⍉⍪⍳4 718 | 719 | {[ 720 | 0 1 2 3 721 | ] 722 | }Is⍉⍪⍳4 723 | 724 | {['Three' 725 | 'Blind' 726 | 'Mice'] 727 | }Is 3 5⍴'ThreeBlindMice ' 728 | 729 | {[1 ⋄ ] 730 | }Is⍪1 731 | 732 | { 733 | 1 2[1 ⋄ ] 734 | }Is 1 2(⍪1) 735 | 736 | { 737 | ['[' ⋄ ] 738 | }Is 1 1⍴'[' 739 | { 740 | ['(' ⋄ ] 741 | }Is 1 1⍴'(' ⍝ link issue #271 742 | 743 | :EndSection 744 | :Section Combo 745 | { 746 | ([0 0 1 747 | 1 0 1 748 | 0 1 1] 749 | 750 | [0 1 1 751 | 1 1 0 752 | 0 1 0] 753 | 754 | [0 1 1 1 755 | 1 1 1 0] 756 | 757 | [0 1 1 0 758 | 1 0 0 1 759 | 0 1 1 0]) 760 | 761 | }Is Ed{ 762 | _←⍉⍪0 0 1 763 | _⍪←1 0 1 764 | _⍪←0 1 1 765 | r←⊂_ 766 | _←⍉⍪0 1 1 767 | _⍪←1 1 0 768 | _⍪←0 1 0 769 | r,←⊂_ 770 | _←⍉⍪0 1 1 1 771 | _⍪←1 1 1 0 772 | r,←⊂_ 773 | _←⍉⍪0 1 1 0 774 | _⍪←1 0 0 1 775 | _⍪←0 1 1 0 776 | r,←⊂_ 777 | r 778 | }⍬ 779 | 780 | {[0 'OK' ⋄ 1 'WS FULL' ⋄ 2 'SYNTAX ERROR' ⋄ 3 'INDEX ERROR' ⋄ 4 'RANK ERROR'] 781 | }Is{ 782 | e←⍉⍪0 'OK' 783 | e⍪←1 'WS FULL' 784 | e⍪←2 'SYNTAX ERROR' 785 | e⍪←3 'INDEX ERROR' 786 | e⍪←4 'RANK ERROR' 787 | e 788 | }⍬ 789 | {['a'(⊂1 2)'a' 790 | (⊂1 2)'a'(⊂1 2)] 791 | }Is 2 3⍴'a'(⊂1 2) 792 | :EndSection 793 | 794 | :Section High Rank 795 | { 796 | [[3 797 | 1 5 9] 798 | [2 7 1 799 | 2 8]] 800 | }Is Ed 2 2 3⍴3 0 0 1 5 9 2 7 1 2 8 0 801 | :EndSection 802 | 803 | :Section Empty 804 | { 805 | ⍬ 806 | }Is ⍬ 807 | { 808 | (⍬ ⋄ ) 809 | }Is,⊂⍬ 810 | { 811 | 0⌿⊂⍬ 812 | }Is 0⌿⊂⍬ 813 | { 814 | 0⌿⊂⊂⍬ 815 | }Is 0⌿⊂⊂⍬ 816 | { 817 | 0⌿⊂0⌿⊂⍬ 818 | }Is 0⌿⊂0⌿⊂⍬ 819 | {[⍬ ⋄ ] 820 | }Is⍉⍪⍬ 821 | { 822 | 0⌿[0 ⋄ ] 823 | }Is⍪⍬ 824 | { 825 | 0⌿⊂[⍬ ⋄ ] 826 | }Is 0⌿⊂⍉⍪⍬ 827 | { 828 | 0⌿⊂0⌿[0 ⋄ ] 829 | }Is 0⌿⊂⍪⍬ 830 | :EndSection 831 | 832 | :Section Namespace 833 | { 834 | () 835 | }Is'{}' 836 | 837 | { 838 | ( 839 | ) 840 | }Is'{}' 841 | 842 | { 843 | ()() 844 | }Is'[{},{}]' 845 | 846 | ⍝ { 847 | ⍝ (a:⍳n←3 ⋄ b:n*2) 848 | ⍝ }Is'{"a":[0,1,2],"b":9}' 849 | 850 | 'p' 'm'{ 851 | (p:{⍺+⍵} 852 | m:{⍺-⍵}) 853 | }Is¨'{⍺+⍵}' '{⍺-⍵}' 854 | 855 | { 856 | (v:(1 2 ⋄ 3)) 857 | }Is'{"v":[[1,2],3]}' 858 | 859 | { 860 | (v:(1 2 861 | 3)) 862 | }Is'{"v":[[1,2],3]}' 863 | 864 | { 865 | (v:(1 2 ⋄ 3) 866 | ) 867 | }Is'{"v":[[1,2],3]}' 868 | 869 | { 870 | ( 871 | () 872 | ) 873 | }Is'[{}]' 874 | 875 | {(n:())}Is'{"n":{}}' 876 | 877 | :EndSection 878 | r←1 879 | ∇ 880 | 881 | 882 | 883 | 884 | ∇ r←RoundtripQA stop_on_error;Check;Is;array;arrays;mask;ns;shapes;⎕FR;⎕IO;⎕TRAP 885 | ⎕IO←0 886 | ⎕TRAP←(~stop_on_error)/⊂999 'C' '→r←0' 887 | Is←{ 888 | Check←'MISMATCH'⎕SIGNAL 999/⍨≢ 889 | ⍝ identical nss don't match, so we compare the generated notation: 890 | 9∊{⊃⎕NC'⍵'}¨∊⍵:⍵ Check⍥Serialise Deserialise Serialise ⍵ 891 | ⍵ Check Deserialise Serialise ⍵ 892 | } 893 | 894 | :Section numbers 895 | ns←⎕NS ⍬ 896 | :For ns.⎕FR :In 645 1287 897 | Check←ns.{'MISMATCH'⎕SIGNAL 999/⍨⍵≢##.Deserialise ##.Serialise ⍵} 898 | Check ns.(123) 899 | Check ns.(○1) ⍝ issue #272 900 | Check ns.(0.1J0.1) 901 | :EndFor 902 | :EndSection 903 | 904 | 905 | :Section scalars 906 | Is'a' 907 | Is 42 908 | Is ⎕NULL 909 | Is ⎕UCS 0 910 | Is ⎕UCS 13 911 | :EndSection 912 | :Section vectors 913 | Is,42 914 | ⎕FR←1287 ⋄ Is{(¯1*?⍵⍴2)×(*14000ׯ1+2×?⍵⍴0)}10 ⍝ 1287 915 | ⎕FR←645 ⋄ Is{(¯1*?⍵⍴2)×(*700ׯ1+2×?⍵⍴0)}10 ⍝ 645 916 | Is{⍺+0J1×⍵}⌿{(¯1*?⍵⍴2)×(*700ׯ1+2×?⍵⍴0)}2 10 ⍝ 1289 917 | Is 1=?100⍴2 ⍝ 11 918 | Is?100⍴100 ⍝ 83 919 | Is?100⍴32000 ⍝ 163 920 | Is?100⍴2000000000 ⍝ 323 921 | Is'Hello',⎕AV[256?256] 922 | Is(1 2 3 'Hello')(4 5 6 'World') 923 | Is(1 2 3 'Hello')(4 5 6 'World') 924 | Is↓4 2⍴⍳8 925 | Is'Three' 'Blind' 'Mice' 926 | :EndSection 927 | :Section Matrices 928 | Is 2 3⍴⍳6 929 | Is⍉⍪⍳4 930 | Is⍉⍪⍳4 931 | Is 3 5⍴'ThreeBlindMice ' 932 | Is⍪1 933 | Is 1 2(⍪1) 934 | :EndSection 935 | :Section Combo 936 | Is{ 937 | _←⍉⍪0 0 1 938 | _⍪←1 0 1 939 | _⍪←0 1 1 940 | r←⊂_ 941 | _←⍉⍪0 1 1 942 | _⍪←1 1 0 943 | _⍪←0 1 0 944 | r,←⊂_ 945 | _←⍉⍪0 1 1 1 946 | _⍪←1 1 1 0 947 | r,←⊂_ 948 | _←⍉⍪0 1 1 0 949 | _⍪←1 0 0 1 950 | _⍪←0 1 1 0 951 | r,←⊂_ 952 | r 953 | }⍬ 954 | 955 | Is{ 956 | e←⍉⍪0 'OK' 957 | e⍪←1 'WS FULL' 958 | e⍪←2 'SYNTAX ERROR' 959 | e⍪←3 'INDEX ERROR' 960 | e⍪←4 'RANK ERROR' 961 | e 962 | }⍬ 963 | Is 2 3⍴'a'(⊂1 2) 964 | Is 3 3⍴(,¨'1' '0' '1') 965 | Is'Hello'('' '⍝World:') 966 | Is'AB''C',⊂'DE' 967 | Is'ABC'(,⊂⊂'') 968 | Is'A'(,⊂⊂'') 969 | :EndSection 970 | 971 | :Section High Rank 972 | Is 1 1 2 3⍴⍳6 ⍝ issue #254 973 | Is 3 2 1 1⍴⍳6 ⍝ issue #254 974 | Is 2 3 4 5⍴⍳120 ⍝ issue #254 975 | Is⊂[3 4 5]⎕AV[?1 2 3 1 5 6⍴256] ⍝ issue #254 976 | :EndSection 977 | 978 | :Section Large Arrays ⍝ (more than 4096 constants) - issue #255 979 | Is⊂[2 3]?50 100 2 3⍴100 ⍝ Numeric is straightforward 980 | Is⊂[3 4 5]⎕AV[?50 10 10 1 2 3⍴256] ⍝ Text gets functional headers produced by Parse 981 | :EndSection 982 | 983 | :Section Empty 984 | Is ⍬ 985 | Is,⊂⍬ 986 | Is 0⌿⊂⍬ 987 | Is 0⌿⊂⊂⍬ 988 | Is 0⌿⊂0⌿⊂⍬ 989 | Is⍉⍪⍬ 990 | Is⍪⍬ 991 | Is 0⌿⊂⍉⍪⍬ 992 | Is 0⌿⊂⍪⍬ 993 | :EndSection 994 | 995 | :Section Namespace 996 | Is ⎕JSON'{}' 997 | Is ⎕JSON'{}' 998 | Is ⎕JSON'[{},{}]' 999 | Is ⎕JSON'{"a":[0,1,2],"b":9}' 1000 | Is{ 1001 | ⍺←⎕NS ⍬ 1002 | ⍺.p←{⍺+⍵} 1003 | ⍺.m←{⍺-⍵} 1004 | ⍺ 1005 | }⍬ 1006 | Is ⎕JSON'{"v":[[1,2],3]}' 1007 | Is ⎕JSON'{"v":[[1,2],3]}' 1008 | Is ⎕JSON'{"v":[[1,2],3]}' 1009 | Is ⎕JSON'[{}]' 1010 | Is ⎕JSON'{"n":{}}' 1011 | :EndSection 1012 | 1013 | :Section Deep arrays 1014 | arrays←⎕NULL((⎕NS ⍬).(⎕THIS⊣var←(idiom←'{⍵[⍋⍵]}')(foo←'{,⍵}')123))(?256⍴0)(⎕AV[256?256]) 1015 | shapes←⍬ 0 1 256(0 0)(0 256)(256 0)(16 16) 1016 | shapes,←(0 1 256)(0 256 1)(1 0 256)(1 256 0)(256 1 0)(256 0 1) 1017 | shapes,←(0 0 0 0 0 0)(0 1 2 3 4 5)(5 4 3 2 1 0)(0 0 2 3 0 0)(2 0 0 0 0 3) 1018 | shapes,←(1 2 3 4 5)(5 4 3 2 1) 1019 | mask←~¯1⌽4↑⍤0⊢0∊¨shapes ⍝ empty arrays with namespaces are not supported (they can't be compared with ≡ anyways) 1020 | arrays←(,mask)/(,shapes∘.⍴arrays) 1021 | :For array :In arrays 1022 | Is array 1023 | :EndFor 1024 | Is arrays 1025 | :EndSection 1026 | r←1 1027 | ∇ 1028 | 1029 | 1030 | ∇ r←QA 1031 | ⍝ fails under 18.0 because of mantis 18132 1032 | r←SerialiseQA 1 1033 | r∧←DeserialiseQA 1 1034 | r∧←RoundtripQA 1 1035 | ∇ 1036 | 1037 | :EndNamespace 1038 | -------------------------------------------------------------------------------- /StartupSession/Dyalog/Utils.apln: -------------------------------------------------------------------------------- 1 | :NameSpace Utils ⍝ V1.58 2 | ⍝ Namespace containing :Includable utility functions 3 | ⍝ 2015 11 12 Adam: Auto version + format & layout now handle matrices 4 | ⍝ 2016 05 29 DanB: added setupKeys and double quotes for JS 5 | ⍝ 2017 05 16 JohnS: Added ]box -t=def functionality 6 | ⍝ 2017 05 23 Adam: Added 16.0's new primitives 7 | ⍝ 2017 06 12 Adam: Handle when boxing hasn't been initialised 8 | ⍝ 2018 02 11 JohnS: Moved functions defs, exports and in to this file. 9 | ⍝ 2018 03 13 Adam: repObj recog sysconsts and optional ⍺ for parens if needed, ⊣, ⊢, Unicode chars 10 | ⍝ 2018 03 21 JMS: [15591] improvements to ]defs 11 | ⍝ 2018 04 18 Adam: ]??cmd → ]cmd -?? 12 | ⍝ 2018 11 06 Adam: repObj handle complex arithmetic progressions 13 | ⍝ 2018 01 17 Adam: [16805] fall back to serialisation if hitting limit 14 | ⍝ 2020 05 21 Adam: refactor, [18076] Add Config 15 | ⍝ 2020 05 22 Adam: Cleanup 16 | ⍝ 2020 05 26 Adam: [18126] display LF as CR 17 | ⍝ 2020 05 27 Adam: Add Hoof (○¨) 18 | ⍝ 2020 09 14 Adam: repObj: Full precision DECFs, proper error on ref 19 | ⍝ 2020 10 16 Adam: Moved CD from ]CD and added relativeTies 20 | ⍝ 2021 01 11 Adam: Prevent layoutPar from hanging 21 | ⍝ 2021 01 19 Adam: repObj with guaranteed precision and QA 22 | ⍝ 2021 03 24 Adam: Add APLcart API 23 | ⍝ 2021 04 01 Adam: Let APLcart cache expire after 1 day 24 | ⍝ 2021 04 15 Adam: Handle non-string config values in registry 25 | ⍝ 2021 05 09 Adam: Include "]" in bracket axis 26 | ⍝ 2021 06 07 Adam: Add ⎕SE.Dyalog.Utils.ExpandConfig (from ]Get's ExpEnv) 27 | ⍝ 2021 07 15 Adam: Use disp and display from dfns.dws but amend for CRLF 28 | ⍝ 2021 08 02 Adam: Restore old display that can handle clunky chars 29 | ⍝ 2021 08 12 Adam: Add View to view in a read-only Editor window 30 | ⍝ 2021 10 20 Adam: ExpandConfig support for ${env:name} 31 | ⍝ 2021 11 03 Adam: Handle locked functions 32 | ⍝ 2021 11 04 Adam: ExpandConfig support for escapes and choosing syntax 33 | ⍝ 2022 07 04 Adam: Make APLcart remove URLs before searching 34 | ⍝ 2022 12 07 Adam: ExpandConfig include POSIX extensions (like ~) on POSIX-like OS, and handle errors 35 | ⍝ 2023 03 06 Adam: Make APLcart fall back to local table if no internet 36 | ⍝ 2023 05 16 Adam: [19376] specify dll if .NET "Core" 37 | ⍝ 2023 05 25 Adam: Fix typo in nkds 38 | ⍝ 2023 05 30 Adam: Staticise ⎕USING as the Core value works in Framework 39 | ⍝ 2023 06 30 Adam: Dynamicise ⎕USING again as the Core value generates error messages in Framework 40 | ⍝ 2024 01 04 Adam: Make CD be non-shy as promised 41 | ⍝ 2024 06 18 Adam: repObj reshape shortest prefix 42 | ⍝ 2024 06 19 Adam: 00375 Ability for APL code to permanently store values - Remember 43 | ⍝ 2024 07 29 Adam: [20129] Respect ⎕PP 44 | ⍝ 2025 12 17 Adam: repObj should only shorten using ⍴ if it makes result shorter 45 | 46 | :Section General 47 | ⎕IO←⎕ML←1 48 | 49 | ∇ r←Version 50 | r←⊢/∊'V'⎕VFI⊃⎕SRC ⎕THIS 51 | ∇ 52 | 53 | where←⍸ 54 | 55 | ∇ r←{origin}Config param;os;ver;NamesValues;EnvVars;env;claValues;Names;cla;cfg;all;OnlySet;val;loc;Adjust;ErrIf;cmd;⎕USING;sk;hk;key;name 56 | ⍝ Values of configuration parameters (optionally with origin) 57 | ⍝ 58 | ⍝ params name or names; '' or ⍬ to return all 59 | ⍝ 60 | ⍝ origin =0: don't show origin of value (default) 61 | ⍝ =1: show short origin of value 62 | ⍝ =2: show long origin of value 63 | ⍝ 64 | ⍝ r origin=0 and params is simple: simple value 65 | ⍝ origin>0 and params is simple: vector with (source value) 66 | ⍝ origin=0 and params is nested: matrix of (name value) rows 67 | ⍝ origin>0 and params is nested: matrix of (name source value) rows 68 | ⍝ origin=0 and params is '' or ⍬: matrix of (name value) rows 69 | ⍝ origin>1 and params is '' or ⍬: matrix of (name source value) rows 70 | 71 | :If 900⌶⍬ ⋄ origin←0 ⋄ :EndIf ⍝ default left 72 | (os ver)←2↑# ⎕WG'APLVersion' 73 | 74 | ErrIf←⎕SIGNAL{(⌈/⍵)⍴⊂('EN' 11)('Message'⍺)} 75 | 'requires 18.0 or higher'ErrIf 18>2 1⊃'.'⎕VFI ver 76 | 'right argument (parameters) must be ⍬ character vector(s) or ⍬ (all)'ErrIf(3∘≤∘|∘≡,''⍬∘∊)param 77 | 'left argument (show origin) must be 0 (none), 1 (short), or 2 (long)'ErrIf~0 1 2∊⍨⊂origin 78 | 79 | :If ⍬''∊⍨⊂param ⍝ all 80 | :Trap 0 81 | env←⎕SH cmd←'env' 'set'⊃⍨1+'Windows'≡7↑os 82 | :Else 83 | ⎕SIGNAL⊂⎕DMX.(('EN'EN)'Message'(Message,' (attempting to run ⎕SH ''',cmd,''')')) 84 | :EndTrap 85 | cfg←⊣/161⌶0 ⍝ unofficial: config file contents 86 | cla←2 ⎕NQ'.' 'GetCommandLineArgs' 87 | 88 | OnlySet←{⍵/⍨'='∊¨⍵↑¨⍨⌊/⍵∘.⍳'''"'} ⍝ only name=value args 89 | Names←{⍵↑⍨¯1+⍵⍳'='}¨ ⍝ names up until "=" 90 | all←{⍵[⍋⍵]}∪1 ⎕C cfg,Names env,OnlySet cla 91 | 92 | r←{⍵⌿⍨×≢¨⊢/⍵}origin Config all ⍝ filter out empty vars 93 | :ElseIf 1≥|≡param ⍝ one 94 | (val loc)←160⌶param ⍝ unofficial: value and origin of configuration parameter 95 | 96 | Adjust←{ ⍝ Expand or abbreviate origin 97 | (short long)←⍺=⍳2 98 | short∧'Environment variable'≡⍵:'Env var' 99 | short∧'Built-in default'≡⍵:'Default' 100 | short∧'Not defined'≡⍵:'None' 101 | long∧'Registry'≡⍵:⊃4070⌶0 ⍝ unofficial: registry key 102 | short:∊1↓⎕NPARTS ⍵ ⍝ strip paths from filenames 103 | ⍵ 104 | } 105 | :If loc≡'Registry' 106 | ⎕USING←'Microsoft.Win32',',Microsoft.Win32.Registry'/⍨1=⊃2250⌶0 ⍝ .NET Core 107 | hk←Registry⍎'_(\w)'⎕R'\u1'⊃'^HKEY(_\w+)'⎕S'\l1'⊃4070⌶0 108 | (key name)←param⊂⍨⍸⍣¯1⊢1,⌈/⍸'\'='\',param 109 | sk←hk.OpenSubKey⊂'\'(⍳⍨↓,⍨,key⍨)⊃4070⌶0 110 | val←sk.GetValue,/1↓⎕NPARTS param 111 | :EndIf 112 | r←val{⍺ ⍵}⍣(origin∊1 2)⍨origin Adjust loc ⍝ append origin if asked for 113 | :ElseIf 0=≢param 114 | r←0(2+×origin)⍴⊂'' ⍝ 2 or 3 columns for without and with origin 115 | :Else ⍝ multiple 116 | r←↑origin(⊢{(⊆⍺),⊆⍵}Config)¨param ⍝ prepend name column 117 | :EndIf 118 | ∇ 119 | 120 | ExpandConfig←{ ⍝ Expand Configuration settings (includes environment variables and cmdline params) in text ⍵ 121 | ⍝ ExpandConfig 'your ws size is [MAXWS]' → 'your ws size is 2G' 122 | ⍝ ExpandConfig 'your ws size is $MAXWS' → 'your ws size is 2G' 123 | ⍝ ExpandConfig 'your ws size is %MAXWS%' → 'your ws size is 2G' 124 | ⍝ ExpandConfig 'your ws size is $env:MAXWS' → 'your ws size is 2G' 125 | ⍝ ExpandConfig 'your ws size is ${env:MAXWS}' → 'your ws size is 2G' 126 | ⍝ ExpandConfig 'your ws size is ${MAXWS}' → 'your ws size is 2G' 127 | ⍝ Handles ~ and ~+ and ~- under UX only 128 | ⍝ Use \ or ^ or ` to escape patterns 129 | ⍝ optionally restrict pattern type and escape using left argument as per below 130 | 131 | ⍝ For user's home dir, use ⎕SE.SALTUtils.USERDIR 132 | 0::⎕SIGNAL⊂⎕DMX.(('EN'EN)('Message'Message)) 133 | 134 | ⍺←0 135 | type←⎕C⊂⍺ 136 | ps←type∊'ps' 'powershell' 'psh' 137 | cmd←type∊'cmd' 'dos' 'win' 'windows' 'batch' 'command.com' 'cmd.exe' 138 | salt←type∊'salt' 'dyalog' 139 | posix←type∊'posix' 'linux' 'unix' 'ux' 'pi' 'aix' 'mac' 'macos' 'qshell' 'rc' 140 | posix∨←'sh'≡¯2↑⊃type 141 | 142 | Esc←'[%\\&]'⎕R'\\&' 143 | Untilde←{ 144 | ⎕SE.SALTUtils.WIN>posix:⍵ 145 | specials←Esc Config¨'PWD' 'OLDPWD' 'HOME' 146 | subs←'\1'∘,¨specials,¨⊂'\2' 147 | '(\W|^)~\+()' '(\W|^)~-()' '(\W|^)~(\W|$)'⎕R subs⍠'UCP' 1⊢⍵ 148 | } 149 | Sub←{⍵⍵ ⎕R(⍺⍺{⍵.PatternNum:⍺⍺(Config ¯1↓↓)⍵.Match ⋄ ⊢/⍵.Match})⊢⍵} ⍝ chop leading ⍺ chars 150 | 151 | ps:6 Sub'`[$`]' '\$\{env:([^}]+)}'⊢'\$env:([\pL_]\w*)'⎕R'${env:\1}'⊢⍵ 152 | cmd:1 Sub'\^[%^]' '%([^%]+)%'⊢⍵ 153 | salt:1 Sub']' '\[([^]]+)]'⊢⍵ 154 | posix:2 Sub'\\[$\\]' '\$\{([^}]+)}'⊢'\$([\pL_]\w*)'⎕R'${\1}'⍠'UCP' 1 Untilde ⍵ 155 | 0≢⍺:⎕SIGNAL⊂('EN' 11)('Message' 'Left argument must be environment type (ps/cmd/salt/ux/etc.)') 156 | 157 | bracked←'\$env:([\pL_]\w*)' '\$\{env:([^}]+)}' '\$([\pL_]\w*)' '\$\{([^}]+)}' '\[([^]]+)]' '%([^%]+)%'⎕R'[\1]'⍠'UCP' 1 Untilde ⍵ 158 | 1 Sub'\\[$\\]|\^[%^]|`[$`]' '\[([^]]+)]'⊢bracked 159 | } 160 | 161 | ∇ names←relativeTies;rel ⍝ Report which files are tied with relative names 162 | names←{(+/∨\' '≠⌽⍵)↑¨↓⍵}↑⊃,/↓¨⎕NNAMES ⎕FNAMES 163 | :If 'Win'≡3↑⊃# ⎕WG'APLVersion' 164 | rel←~≢¨'^([\\/]|\w:)[\\/]'⎕S 3¨names ⍝ doesn't begin with // or L:/ 165 | :Else 166 | rel←'/'≠⊃¨names 167 | :EndIf 168 | names←↑rel/names 169 | ∇ 170 | 171 | CD←{ ⍝ Current (empty ⍵: non-shy result is current dir) or Change (non-empty ⍵: shy result is old dir) Directory 172 | ⍝ WARNING: Changing directory under program control runs the risk of interfering with relative paths. 173 | ⍝ Checks (if monadic or ⍺=0) for relative ⎕NTIEd/⎕FTIEd/⎕FSTIEd files only, but not for ⎕NA ⎕XT ⎕SH/⎕CMD etc. 174 | ⍝ Skips check if ⍺=1 175 | ⍝ Provided as-is ─ use at your own risk! 176 | ⍺←0 177 | 0::⎕SIGNAL⊂⎕DMX.(('EN'EN)('EM'EM)('Message'Message)) 178 | ~0∊⍴⍵:_←⍺ CDshy ⍵ ⍝ change: shy 179 | ⊢⍺ CDshy ⍵ ⍝ report: not shy 180 | } 181 | 182 | ∇ {old}←force CDshy new;OS;is64;t;get;lib;chdir;⎕ML ⍝ Current/Change Directory 183 | ⍝ empty "new": only report; non-empty "new": change dir 184 | ⍝ warns about tied files with relative tie names if force=0, skips check if force=1 185 | ⎕ML←1 186 | OS←3↑⊃# ⎕WG'APLVersion' 187 | :If 'Win'≡OS ⍝ Under Windows we do the association here because we need 188 | t←'A*'[1+80=⎕DR''] ⍝ the programs to GET the current directory 189 | 'get'⎕NA'U Kernel32|GetCurrentDirectory',t,' U >0T' ⍝ Associate Get function 190 | old←2⊃get 260 260 ⍝ in all cases we return the current dir 191 | 'chdir'⎕NA'U Kernel32|SetCurrentDirectory',t,' <0T' ⍝ Associate Set function 192 | :Else 193 | old←⊃⎕SH'pwd' 194 | :EndIf 195 | 196 | :If ~0∊⍴new ⍝ change directory 197 | :If ~force 198 | ⎕SIGNAL(×≢relativeTies)/⊂('EN' 24)('Message'('Some files (',('.relativeTies',⍨⍕⎕THIS),') ⎕NTIEd/⎕FTIEd with relative names (use left argument 1 to ignore)')) 199 | :EndIf 200 | 201 | :If 'Win'≡OS 202 | ⍝ chdir returns a single int: 1=ok 203 | ('Unable to change directory: ',new,': Invalid directory')⎕SIGNAL(chdir⊂new)↓22 204 | :Else 205 | :Select OS 206 | :Case 'AIX' 207 | is64←32={z←⍵ ⋄ ⎕SIZE'z'}⍬ 208 | lib←'I libc.a(shr',(is64/'_64'),'.o)|chdir <0T1[]' 209 | :Case 'Lin' 210 | ⍝ Extract real name of libc that we are actually using 211 | t←⊃⎕SH'echo $PPID' 212 | t←⎕SH'ldd /proc/',t,'/exe' 213 | lib←⊃('^\s*libc\.so\b.*=>\s*(\S*)'⎕S'\1')t 214 | lib←'I ',lib,'|chdir <0T1[]' 215 | :Case 'Mac' 216 | lib←'I /usr/lib/libc.dylib|chdir <0T1[]' 217 | ⍝ chdir returns a single integer: 0=ok 218 | :EndSelect 219 | ⎕NA lib 220 | ('Unable to change directory: ',new,': Invalid directory')⎕SIGNAL(0≠chdir⊂new)/22 221 | :EndIf 222 | :EndIf 223 | ∇ 224 | 225 | APLcartTableCache←⍬ 226 | APLcartTableTime←0 227 | ∇ {t}←APLcartTable force;hc;data;resp;url;empty;old;tsv 228 | empty←0=≢APLcartTableCache 229 | old←APLcartTableTime<¯1+1 ⎕DT'Z' 230 | :If force∨empty∨old 231 | url←'https://raw.githubusercontent.com/abrudz/aplcart/master/table.tsv' 232 | hc←⎕SE.SALT.Load'HttpCommand -nolink' 233 | resp←hc.Get url 234 | :If 0≠resp.rc 235 | :OrIf 0=≢resp.Data ⍝ fall back to local file; try internet again next time 236 | tsv←⊃⎕NGET'/spice/table.tsv',⍨⎕SE.SALTUtils.getEnvir'SALT' 237 | :Else 238 | tsv←resp.Data 239 | APLcartTableCache←tsv 240 | APLcartTableTime←1 ⎕DT'Z' 241 | :EndIf 242 | t←tsv 243 | :Else 244 | t←APLcartTableCache 245 | :EndIf 246 | t←'.*\r?\n'⎕R''⍠'Mode' 'D'⍠'ML' 1⍠'ResultText' 'Nested'⊢t ⍝ remove header and URLs 247 | ∇ 248 | APLcart←{ 249 | ⍺←0 ⍝ all columns 250 | terms←⊆' '(≠⊆⊢)⍣(' '∊⍵),⍵ 251 | Filter←{ 252 | regex←'//'≡(⊃,⊃∘⌽)⍺ 253 | pat←regex↓(-regex)↓⍺ 254 | pat ⎕S'%'⍠'Regex'(regex 1)⍠'ML' 1⍠1⊢⍵ 255 | } 256 | 26::⎕SIGNAL⊂⎕DMX.(('EN'EN)('EM'EM)('Message'Message)) 257 | noUrls←'(\t)(http\S+)?\t(http\S+)?$'⎕R'\1\1'⊢APLcartTable 0 258 | i←noUrls⍳⊃Filter/terms,⊂noUrls 259 | r←i⊃¨⊂APLcartTable 0 260 | 2↑⍤1⍣(~⍺)⎕CSV⍠'Separator'(⎕UCS 9)⍠'QuoteChar' ''⍠'DoubleQuote' 0⊂r 261 | } 262 | 263 | :EndSection 264 | :Section Strings 265 | 266 | lc←'abcdefghijklmnopqrstuvwxyzàáâãåèéêëòóôõöøùúûäæüìíîïðçñ' ⍝ (lower case alphabet) 267 | uc←'ABCDEFGHIJKLMNOPQRSTUVWXYZÀÁÂÃÅÈÉÊËÒÓÔÕÖØÙÚÛÄÆÜÌÍÎÏÐÇÑ' ⍝ (upper case alphabet) 268 | fromto←{n←⍴1⊃(t f)←⍺ ⋄ ~∨/b←n≥i←f⍳s←,⍵:s ⋄ (b/s)←t[b/i] ⋄ (⍴⍵)⍴s} ⍝ from-to casing fn 269 | 270 | lcase←lc uc∘fromto ⍝ :Includable Lower-casification of simple array 271 | ucase←uc lc∘fromto ⍝ Ditto Upper-casification 272 | 273 | cut←{⍺←⍵∊1↑⍵ ⋄ ⎕ml←1 ⋄ 1↓¨⍺⊂⍵} ⍝ exclude delimiters cut 274 | 275 | dtb←{ ⍝ Drop Trailing Blanks. 276 | ⍺←' ' ⋄ 1<|≡⍵:(⊂⍺)∇¨⍵ ⍝ nested? 277 | 2<⍴⍴⍵:(¯1↓⍴⍵){(⍺,1↓⍴⍵)⍴⍵}⍺ ∇,[¯1↓⍳⍴⍴⍵]⍵ ⍝ array 278 | 1≥⍴⍴⍵:(-+/∧\⌽⍵∊⍺)↓⍵ ⍝ vector 279 | (~⌽∧\⌽∧⌿⍵∊⍺)/⍵ ⍝ matrix 280 | } 281 | 282 | dmb←{ ⍝ Drop Multiple Blanks. 283 | ⍺←' ' ⋄ 1<|≡⍵:(⊂⍺)∇¨⍵ ⍝ nested? 284 | 2<⍴⍴⍵:(¯1↓⍴⍵){(⍺,1↓⍴⍵)⍴⍵}⍺ ∇,[¯1↓⍳⍴⍴⍵]⍵ ⍝ array 285 | 2>⍴⍴⍵:(2∨/(~⍵∊⍺),1)/⍵ ⍝ vector 286 | (2∨/(,∨⌿~⍵∊⍺),1)/⍵ ⍝ matrix 287 | } 288 | 289 | drvSrc←{⎕ML←1 ⍝ Linear representation of fnop named ⍵. 290 | 291 | src←⍺.⎕CR ⍵ ⍝ source. 292 | 293 | qt←'''' ⍝ single quote 294 | qtd←{qt,((1+⍵=qt)/⍵),qt} ⍝ quoted. 295 | 296 | sepr←{ ⍝ adjacent arrays. 297 | qt∨.≠(⊃⌽⍺),⊃⍵:⍺,⍵ ⍝ adjacent quoted vectors 298 | ⍺,' ',⍵ ⍝ blank-separated. 299 | } 300 | 301 | array←{ 302 | 0=≡⍵:scalar ⍵ ⍝ simple scalar 303 | 1 1≡(≡⍵),⍴⍴⍵:vector ⍵ ⍝ simple vector. 304 | 1=≡⍵:1 p(∇⍴⍵),'⍴',∇,⍵ ⍝ high-rank simple. 305 | 0=⍴⍴⍵:1 p'⊂',∇⊃⍵ ⍝ scalar 306 | 1=⍴⍴⍵:⊃sepr/⊃,/(~ischar¨⍵)p∘∇¨⍵ ⍝ nested vector 307 | 1 repObj ⍵ ⍝ FIXME 308 | } 309 | 310 | scalar←{ ⍝ scalar value 311 | ischar ⍵:qtd ⍵ ⍝ char 312 | ⍕,⍵ ⍝ number or ref 313 | } 314 | 315 | vector←{ ⍝ simple vector. 316 | 0=⍴⍵:⊃(ischar ⍵)⌽'⍬'(qtd'') ⍝ null: '' or ⍬. 317 | 1=⍴⍵:1 p scalar⊃⍵ ⍝ single vector → (,0) 318 | ∧/isnum¨⍵:⍕⍵ ⍝ simple numeric vec: 319 | ∧/ischar¨⍵:qtd ⍵ ⍝ simple char char vec: 320 | 1 repObj ⍵ ⍝ FIXME 321 | } 322 | 323 | uni←80=⎕DR'' ⍝ unicode version 324 | 325 | pf0←'+-×÷⌊⌈|*⍟<≤=≥>≠∨∧⍱⍲!?~○' ⍝ scalar fns. 326 | pf1←'⌷/⌿\⍀∊⍴↑↓⍳⊂⊃∩∪⊣⊢⊥⊤,⍒⍋⍉⌽⊖⌹⍕⍎⍪≡≢⍷' ⍝ other fns. 327 | pfu←⎕UCS uni/8838 9080 ⍝ where, condencl 328 | pfns←pf0,pf1,pfu ⍝ primitive fns. 329 | 330 | kvr←⎕UCS uni/9000+16 18 56 60 ⍝ key, stencil, variant, rank 331 | pops←'/\⌿⍀.¨∘⍨&⍣[@⌶',kvr ⍝ primitive ops. 332 | 333 | ispfn←{(⊂,⍵)∊,¨pfns} 334 | ispop←{(⊂,⍵)∊,¨pops} 335 | isnum←{0≡⊃0⍴⍵} 336 | ischar←{' '≡⊃0⍴⍵} 337 | 338 | isdfn←{ ⍝ probably the ⎕cr of a dfn 339 | 1≠≡⍵:0 ⍝ too deep 340 | ~(⍴⍴⍵)∊2 1:0 ⍝ not a matrix (or vector) 341 | 1≠⊃⍴↑,↓⍵:0 ⍝ not a 1-liner 342 | '}'≠⊃⌽⍵:0 ⍝ doesn't end in ...} 343 | '{'=⊃⍵:1 ⍝ starts with {... 344 | 1∊'←{'⍷⍵ ⍝ starts with name←{ 345 | } 346 | 347 | isderv←{ ⍝ probably the ⎕cr of a derived fn. 348 | ~1=⍴⍴⍵:0 ⍝ not a vector. 349 | ~(⍴⍵)∊2,⍺+2:0 ⍝ not monadic or dyadic operator. 350 | op←⊃⍺↓⍵ ⍝ (curried) operator. 351 | pop←(⊂op)∊pops ⍝ primitive operator 352 | dop←isdfn op ⍝ D-operator. 353 | pop∨dop ⍝ operator. 354 | } 355 | 356 | istrain←{ ⍝ probably the ⎕cr of a fn train. 357 | ~1=⍴⍴⍵:0 ⍝ not a vector. 358 | ~(⍴⍵)∊2 3:0 ⍝ not 2- or 3-train 359 | ∧/isfn¨¯2↑⍵ ⍝ last two tines are fns 360 | } 361 | 362 | issysfn←{ ⍝ is a ⎕fn? 363 | 1≠≡⍵:0 ⍝ too deep 364 | 1≠⍴⍴⍵:0 ⍝ not a vector 365 | '⎕'≠⊃⍵:0 ⍝ doesn't start '⎕...' 366 | 1 ⍝ ok. 367 | } 368 | 369 | isfn←{(isdfn ⍵)∨(ispfn ⍵)∨(istrain ⍵)∨(0∘isderv ⍵)∨(1∘isderv ⍵)∨issysfn ⍵} 370 | 371 | p←{⍺=0:⍵ ⋄ '(',⍵,')'} ⍝ ⍺-conditional parens. 372 | 373 | def←{ 374 | ispfn ⍵:⍵ ⍝ primitive fn. 375 | ispop ⍵:⍵ ⍝ primitive oper. 376 | isdfn ⍵:(∨\'{'=,⍵)/,⍵ ⍝ regular dfn: without 'name←'. 377 | pp←'def'≢'⎕SE.Dyalog.Out.B.trains'{2=⎕NC ⍺:⍎⍺ ⋄ ⍵}'box' ⍝ fully parenthesised 378 | 1 isderv ⍵:⍺ p↑,/((⍴⍵)↑pp 0 1)∇¨⍵ ⍝ derived fn. 379 | 0 isderv ⍵:⍺ p↑,/0 1 ∇¨⍵ ⍝ right-operand curry. 380 | pr←pp∨(1∘isderv<2=≢)⊃⌽⍵ ⍝ parens right: atop +(++) ←≢→ +++ 381 | pl←~1 isderv⊃⍵ ⍝ parens left: 382 | msk←pl,(2↓1⊣¨⍵),pr ⍝ parens 383 | istrain ⍵:⍺ p↑,/msk ∇¨⍵ ⍝ train 384 | issysfn ⍵:⍵ ⍝ system fn. 385 | array ⍵ 386 | } 387 | 388 | ,↑0 def src 389 | } 390 | 391 | ∆FMT1←{ 392 | ⍺←(⍬⍴⎕RSI).⎕PP 393 | ⎕PP←⍺ 394 | ⎕FMT(⎕UCS 13)@{⍵=⎕UCS 10}⍵/⍤1⍨~⍵⍷⍨⎕UCS 13 10 395 | } 396 | 397 | disp←{⎕IO ⎕ML←0 1 ⍝ Boxed sketch of nested array. 398 | 399 | ⍺←⍬ ⋄ opts←⍺,(⍴,⍺)↓1 1 1 0 ⎕PP ⍝ option defaults: 400 | dec bch ctd sep ⎕PP←5↑opts ⍝ decor, smooth, centred, separate pp. 401 | 402 | ul uc ur←bch⊃⌽'┌┬┐' '.' ⍝ upper──┐ ┌───left 403 | ml mc mr←bch⊃⌽'├┼┤' '|+|' ⍝ middle─┼×┼─centre 404 | ll lc lr←bch⊃⌽'└┴┘' '''' ⍝ lower──┘ └──right 405 | vt hz←bch⊃⌽'│─' '|-' ⍝ vertical and horizontal. 406 | 407 | box←{ ⍝ Recursive boxing of nested array. 408 | isor ⍵:⎕FMT⊂⍵ ⍝ ⎕or: '∇name'. 409 | 1=≡,⍵:dec open ⎕PP ∆FMT1 dec open ⍵ ⍝ simple array: format. 410 | mat←matr 1/dec open ⍵ ⍝ matrix of opened subarrays. 411 | r c←×⍴mat ⍝ non-null rows/cols. 412 | dec<0∊r c:c/r⌿∇ 1 open mat ⍝ undecorated null: empty result. 413 | subs←aligned ∇¨mat ⍝ aligned boxed subarrays. 414 | (≢⍴⍵)gaps ⍵ plane subs ⍝ collection into single plane. 415 | } 416 | 417 | aligned←{ ⍝ Alignment and centring. 418 | rows cols←sepr⍴¨⍵ ⍝ subarray dimensions. 419 | sizes←(⌈/rows)∘.,⌈⌿cols ⍝ aligned subarray sizes. 420 | ctd=0:sizes↑¨⍵ ⍝ top-left alignment. 421 | v h←sepr⌈0.5×↑(⍴¨⍵)-sizes ⍝ vertical and horizontal rotation. 422 | v⊖¨h⌽¨sizes↑¨⍵ ⍝ centred aligned subarrays. 423 | } 424 | 425 | gaps←{ ⍝ Gap-separated sub-planes. 426 | sep≤⍺≤2:⍵ ⍝ not separating: done. 427 | subs←(⍺-1)∇¨⍵ ⍝ sub-hyperplanes. 428 | width←⊃⌽⍴⊃subs ⍝ width of inter-plane gap. 429 | fill←(⍺ width-3 0)⍴' ' ⍝ inter-plane gap. 430 | ↑{⍺⍪fill⍪⍵}/1 open subs ⍝ gap-separated planes. 431 | } 432 | 433 | plane←{ ⍝ Boxed rank-2 plane. 434 | sep∧2<⍴⍴⍺:⍺ join ⍵ ⍝ gap-separated sub-planes. 435 | odec←(dec shape ⍺)outer ⍵ ⍝ outer type and shape decoration. 436 | idec←inner ⍺ ⍝ inner type and shape decorations. 437 | (odec,idec)collect ⍵ ⍝ collected, formatted subarrays. 438 | } 439 | 440 | join←{ ⍝ Join of gap-separated sub-planes. 441 | sep←(≢⍵)÷1⌈≢⍺ ⍝ sub plane separation. 442 | split←(0=sep|⍳≢⍵)⊂[0]⍵ ⍝ separation along first axis. 443 | (⊂⍤¯1⊢⍺)plane¨split ⍝ sub-plane join. 444 | } 445 | 446 | outer←{ ⍝ Outer decoration. 447 | sizes←1 0{⊃↓(⍉⍣⍺)⍵}¨sepr⍴¨⍵ ⍝ row and col sizes of subarrays. 448 | sides←sizes/¨¨vt hz ⍝ vert and horiz cell sides. 449 | bords←dec↓¨ml uc glue¨sides ⍝ joined up outer borders. 450 | ↑,¨/(ul'')⍺ bords(ll ur) ⍝ vertical and horizontal borders. 451 | } 452 | 453 | inner←{ ⍝ Inner subarray decorations. 454 | deco←{(type ⍵),1 shape ⍵} ⍝ type and shape decorators. 455 | sepr deco¨matr dec open ⍵ ⍝ decorators: tt vv hh . 456 | } 457 | 458 | collect←{ ⍝ Collected subarrays. 459 | lft top tt vv hh←⍺ ⍝ array and subarray decorations. 460 | cells←vv right 1 open tt hh lower ⍵ ⍝ cells boxed right and below. 461 | boxes←(dec∨0∊⍴⍵)open cells ⍝ opened to avoid ,/⍬ problem. 462 | lft,top⍪↑⍪⌿,/boxes ⍝ completed collection. 463 | } 464 | 465 | right←{ ⍝ Border right each subarray. 466 | types←2⊥¨(⍳⍴⍵)=⊂¯1+⍴⍵ ⍝ right border lower corner types. 467 | chars←mc mr lc lr[types] ⍝ .. .. .. chars. 468 | rgt←{⍵,(-≢⍵)↑(≢⍵)1 1/vt,⍺} ⍝ form right border. 469 | ((matr 1 open ⍺),¨chars)rgt¨⍵ ⍝ cells bordered right. 470 | } 471 | 472 | lower←{ ⍝ Border below each subarray. 473 | bot←{⍵⍪(-1⊃⍴⍵)↑⍺ split ⍵} ⍝ lower border. 474 | split←{((¯2+1⊃⍴⍵)/hz)glue ⍺} ⍝ decorators split with horiz line. 475 | (matr↑,¨/⍺)bot¨matr ⍵ ⍝ cells bordered below. 476 | } 477 | 478 | type←{ ⍝ Type decoration char. 479 | dec<|≡⍵:hz ⍝ nested: '─' 480 | isor ⍵:'∇' ⍝ ⎕or: '∇' 481 | sst←{ ⍝ simple scalar type. 482 | 0=dec×⍴⍴⍵:hz ⍝ undecorated or scalar ⍕⍵: char, 483 | (⊃⍵∊'¯',⎕D)⊃'#~' ⍝ otherwise, number or space ref. 484 | }∘⍕ ⍝ ⍕ distinguishes type of scalar. 485 | 0=≡⍵:sst ⍵ ⍝ simple scalar: type. 486 | {(1=⍴⍵)⊃'+'⍵}∪,sst¨dec open ⍵ ⍝ array: mixed or uniform type. 487 | } 488 | 489 | shape←{ ⍝ Row and column shape decorators. 490 | dec≤0=⍴⍴⍵:⍺/¨vt hz ⍝ no decoration or scalar. 491 | cols←(ׯ1↑⍴⍵)⊃'⊖→' ⍝ zero or more cols. 492 | rsig←(××/¯1↓⍴⍵)⊃'⌽↓' ⍝ zero or more rows. 493 | rows←(¯1+3⌊⍴⍴⍵)⊃vt rsig'⍒' ⍝ high rank decorator overrides. 494 | rows cols ⍝ shape decorators. 495 | } 496 | 497 | matr←{↑,↓⍵} ⍝ matrix from non-scalar array. 498 | sepr←{+/¨1⊂↑⍵} ⍝ vec-of-mats from mat-of-vecs. 499 | open←{16::(1⌈⍴⍵)⍴⊂'[ref]' ⋄ (⍺⌈⍴⍵)⍴⍵} ⍝ stretched to expose nulls. 500 | isor←{1 ⍬≡(≡⍵)(⍴⍵)} ⍝ is ⎕or of object? 501 | glue←{0=⍴⍵:⍵ ⋄ ↑⍺{⍺,⍺⍺,⍵}/⍵} ⍝ ⍵ interspersed with ⍺s. 502 | 503 | isor ⍵:⎕FMT⊂⍵ ⍝ simple ⎕OR: done. 504 | 1=≡,⍵:⎕PP ∆FMT1 ⍵ ⍝ simple array: done. 505 | box ⍵ ⍝ recursive boxing of array. 506 | } 507 | 508 | display←{⎕IO ⎕ML←0 ⍝ Boxed display of array. 509 | ⍺←⍬ ⋄ ch ⎕PP←2↑⍺,(⍴,⍺)↓1 ⎕PP ⍝ default chars and precision 510 | chars←ch⊃'..''''|-' '┌┐└┘│─' ⍝ ⍺: 0-clunky, 1-smooth. 511 | 512 | tl tr bl br vt hz←chars ⍝ Top left, top right, ... 513 | 514 | box←{ ⍝ Box with type and axes. 515 | vrt hrz←(¯1+⍴⍵)⍴¨vt hz ⍝ Vert. and horiz. lines. 516 | top←(hz,'⊖→')[¯1↑⍺],hrz ⍝ Upper border with axis. 517 | bot←(⊃⍺),hrz ⍝ Lower border with type. 518 | rgt←tr,vt,vrt,br ⍝ Right side with corners. 519 | lax←(vt,'⌽↓')[¯1↓1↓⍺],¨⊂vrt ⍝ Left side(s) with axes, 520 | lft←⍉tl,(↑lax),bl ⍝ ... and corners. 521 | lft,(top⍪⍵⍪bot),rgt ⍝ Fully boxed array. 522 | } 523 | 524 | deco←{⍺←type open ⍵ ⋄ ⍺,axes ⍵} ⍝ Type and axes vector. 525 | axes←{(-2⌈⍴⍴⍵)↑1+×⍴⍵} ⍝ Array axis types. 526 | open←{16::(1⌈⍴⍵)⍴⊂'[ref]' ⋄ (1⌈⍴⍵)⍴⍵} ⍝ Expose null axes. 527 | trim←{(~1 1⍷∧⌿⍵=' ')/⍵} ⍝ Remove extra blank cols. 528 | type←{{(1=⍴⍵)⊃'+'⍵}∪,char¨⍵} ⍝ Simple array type. 529 | char←{⍬≡⍴⍵:hz ⋄ (⊃⍵∊'¯',⎕D)⊃'#~'}∘⍕ ⍝ Simple scalar type. 530 | line←{(6≠10|⎕DR' '⍵)⊃' -'} ⍝ underline for atom. 531 | 532 | { ⍝ Recursively box arrays: 533 | 0=≡⍵:' '⍪(open ⎕FMT ⍵)⍪line ⍵ ⍝ Simple scalar. 534 | 1 ⍬≡(≡⍵)(⍴⍵):'∇' 0 0 box ⎕FMT ⍵ ⍝ Object rep: ⎕OR. 535 | 1=≡⍵:(deco ⍵)box open ⎕PP ∆FMT1 open ⍵ ⍝ Simple array. 536 | ('∊'deco ⍵)box trim ⎕FMT ∇¨open ⍵ ⍝ Nested array. 537 | }⍵ 538 | } 539 | View←{ ⍝ in a read-only Editor window 540 | ⍺←⊃⎕RSI 541 | tmp←⍺.⎕NS ⍬ 542 | tmp.output←⍵ 543 | tmp.⎕ED⍠'ReadOnly' 1&'output' 544 | } 545 | :EndSection 546 | :Section Output 547 | ⍝ Support for ]defs and ]boxing: 548 | 549 | nabs←{ ⍝ Name abstraction: 550 | 551 | subs←{ ⍝ substitution of ⍵-names in ⍺-defns 552 | dfns←(⊃∘(⊃⌽)¨⍺)∊'{' ⍝ mask of ⍺'s dfns 553 | vars←(⊃¨1↓¨⍺)∊2 ⍝ mask of ⍺'s vars 554 | srch←@{~dfns∨vars} ⍝ search filter: ignoring vars and dfns 555 | deps←{|≡∘(⊃⌽)¨⍵} ⍝ definition depths 556 | small←(deps ⍵)<⌈/deps ⍺ ⍝ small enough for substitution 557 | sort←{⍵[⍒|≡∘(⊃⌽)¨⍵]} ⍝ in decreasing order of depth 558 | uniq←uvals(⊃⌽)¨⍵ ⍝ mask of unique ⍵-defns 559 | libs←sort(small∧uniq)/⍵ ⍝ small defns in decreasing order of depth 560 | foldl←{↑⍺⍺⍨/(⌽⍵),⊂⍺} ⍝ fold left :: ⍺ ← ⍺ (⍺ ← ⍺ ∇ ⍵) ∇∇ [⍵] 561 | zipd←{↓⍉↑⍺⍺↓⍉↑⍵} ⍝ under zipping: [N K D] ←→ [N][K][D] 562 | sub1 foldl∘libs zipd srch ⍺ ⍝ largest-to-smallest search of lib defns 563 | } ⍝ :: [N K D] ← [N K D] ∇ [N K D] 564 | 565 | sub1←{ ⍝ defns ⍺ with name of library defn ⍵ 566 | (Ns Ks Ds)(N K D)←⍺ ⍵ ⍝ accumulated defns, next library defn 567 | depth←|≡K ⍝ depth of kind-tree of sought item 568 | trav←⊃{ ⍝ (kind-tree defn) traversal 569 | ⍵≡D:(-kd ⍺)N ⍝ match: -ive kind and name 570 | depth≥|≡⍺:⍺ ⍵ ⍝ kind-tree shallow: done 571 | ↓⍉↑⍺ ∇¨⍵ ⍝ subtrees search 572 | }/ ⍝ :: K D ← ∇ K D 573 | srch←trav¨@{~Ns∊⊂N} ⍝ search of all but self :: [K D] ← ∇ [K D] 574 | (⊂Ns),↓⍉↑srch↓⍉↑Ks Ds ⍝ name replacement 575 | } ⍝ :: [N][K][D] ← [N][K][D] ∇ N K D 576 | 577 | uvals←{ ⍝ mask of non-duplicated items 578 | grps←⊢∘⊂⌸⍵ ⍝ value groups 579 | uniqs←∊(1=≢¨grps)/grps ⍝ indices of unique values 580 | (⍳≢⍵)∊uniqs ⍝ non-duplicated items 581 | } ⍝ :: [?] ← ∇ [⍺] 582 | 583 | curried←{1 0≡(|⊃⌽⍵)∊4} ⍝ is curried: lft(dop rgt)? 584 | join←{l(d r)←⍵ ⋄ l d r} ⍝ rejoining: lft(dop rgt) → lft dop rgt 585 | uncurry←curried currying join ⍝ reversion to triples for derived fns 586 | 587 | kd←{0=≡⍵:⍵ ⋄ 3+4≡⊃⍵} ⍝ kind from kind-tree 588 | nkd0←{1↓(⊂'' 0 ⍬),⍵} ⍝ explicit prototypical item 589 | kinds←(⍺⍺>1 0 0 1)/2 3 4 9 ⍝ ⍺⍺: 0:none, 1:3 4, 2:2 3 4 9 590 | from←{(({kd⊃1↓⍵}¨⍵)∊⍺)/⍵} ⍝ kind selection 591 | ⍺←⊃¨(3 4,(⍺⍺>1)/2 9)from ⍵ ⍝ default all names 592 | nkds←nkd0 ⍵[(⊃¨⍵)⍳(,¨⊆⍺)∩⊃¨⍵] ⍝ subject NKDs 593 | uncurry¨nkds subs kinds from ⍵ ⍝ with names for values 594 | 595 | ⍝ :: [N K D] ← [N](A ∇∇)[N K D] ⍝ name-abstraction: 596 | ⍝ N := ⍞ ⍝ Name: char vector 597 | ⍝ K := 2 | 3 | 4 | 9 | [K] ⍝ Kind-tree: nested kinds 598 | ⍝ D := ' | [D] ⍝ Defn: nested ⎕CR vectors 599 | ⍝ A := 0 | 1 | 2 ⍝ abstract: 0:none 1:fns&ops 2:all 600 | } 601 | 602 | nkds←{ ⍝ (Name Kind Defn)-tuples 603 | 604 | defs←{ ⍝ defns from space ⍵ 605 | Ns←~∘' '¨↓⍵.⎕NL 2 3 4 9 ⍝ all names 606 | Ks←⍵.(183⌶)¨Ns ⍝ unofficial: all kind-trees 607 | ds←Ks prep∘⍵.⎕CR¨Ns ⍝ all defns of fns and ops 608 | v←1↓⍵.⍎¨'0',(Ks∊2 9)/Ns ⍝ values of named arrays (vars) 609 | kd←{0=≡⍵:⍵ ⋄ 3+4≡⊃⍵} ⍝ kind from kind-tree 610 | Ds←v@{(kd¨Ks)∊2 9}⊢ds ⍝ all definitions 611 | ↓⍉↑Ns Ks Ds ⍝ names kind-trees defns 612 | } ⍝ :: [N K D] ← ∇ S 613 | 614 | prep←{ ⍝ preparation of ⎕cr forms 615 | (⊂⍺)∊0 2 9:⍵ ⍝ array operand: ignore 616 | 1 1≡(≡⍵),⍴⍵:⊃⍵ ⍝ named primitive fn: disclose of 1-vector 617 | 0∊⍴⍵:⍵ ⍝ locked: ignore 618 | ⍺{ ⍝ search of derv tree: 619 | (2≡⍺)∨0=≡⍵:⍵ ⍝ array or atom: done 620 | 0≠≡⍺:⍺ ∇¨⍵ ⍝ nested: traverse 621 | 1<≢↓⍵:↑(⊂⍺ ∇⊃↓⍵),1↓↓⍵ ⍝ multi-line fn: without 'name←' 622 | named←'←{'⍷⍵ ⍝ named dfn←{... ? 623 | ~∨/named:⍵ ⍝ nope: ignore 624 | 1↓,(,∨\named)/⍵ ⍝ without 'name←' 625 | }⍵ ⍝ for definition ⍵ 626 | } ⍝ :: D ← K ∇ D 627 | 628 | derived←{0 1 0≡⍵∊4} ⍝ is derived?: lft dop rgt 629 | sepr←{l d r←⍵ ⋄ l(d r)} ⍝ separation: lft dop rgt → lft(dop rgt) 630 | curry←derived currying sepr ⍝ currying of dyadic derived fns 631 | 632 | curry¨defs ⍵ ⍝ (name kinds defn)-tuples 633 | 634 | ⍝ :: [N K D] ← ∇ space ⍝ Name Kind Defn 635 | ⍝ N := ⍞ ⍝ Name: char vector 636 | ⍝ K := 2 | 3 | 4 | 9 | [K] ⍝ Kind-tree: nested kinds 637 | ⍝ D := ' | [D] ⍝ Defn: nested ⎕CR vectors 638 | } 639 | 640 | currying←{N K D←⍵ ⍝ adjustments for right-operand currying 641 | (⊂N),K ⍺⍺{ ⍝ lft dop rgt ←→ lft(dop rgt) 642 | 0=≡⍺:⍺ ⍵ ⍝ simple type: done 643 | adj←⍵⍵⍣(⍺⍺ ⍺) ⍝ adjust if necessary 644 | ↓⍉↑(adj ⍺)∇¨adj ⍵ ⍝ for each component 645 | }⍵⍵ D ⍝ kind and defn trees 646 | } 647 | 648 | expr←{ ⍝ Linear representation of expression ⍵. 649 | 650 | ⍺←1 0 ⋄ N P←⍺,(≢⍺)↓0 0 ⍝ N:names P:parenthesised 651 | 652 | xpr←{K←|⊃k D←⍵ ⍝ expression from nested defns 653 | cfmt←⎕SE.Dyalog.Utils.repObj ⍝ char format 654 | (⊂K)∊2 9:⍺ cfmt⍣(k>0)⊢D ⍝ array component 655 | 0=≡K:⍕,D ⍝ single item: format 656 | pp←{∊⍺ 1 ⍺/'('⍵')'} ⍝ parenthesised if ⍺ 657 | pps←{(≢⍵)↑(4≡⊃⍵)↓P 0 1} ⍝ left/right operand parentheses 658 | 4∊K:⍺ pp⊃join/((pps K)∇¨↓⍉↑⍵),']'/⍨'['=2⊃D ⍝ operator-derived expr: 659 | exp←~4∊¨K ⍝ train-tines requiring parens 660 | pns←(0≠≡¨¯1↓K),0 ⍝ leading non-simple tines 661 | ⍺ pp⊃join/(P∨pns∧exp)∇¨↓⍉↑⍵ ⍝ joined with parentheses ⍺ 662 | } ⍝ :: ⍞ ← ? ∇ K D 663 | 664 | join←({(0≤⎕NC⍪⍵)/⍵}⎕AV~'⍺⍵∇'){ ⍝ join of expressions 665 | adj←(⊢/⊣),(⊣/⊢) ⍝ adjoining: last of ⍺, first of ⍵ 666 | gap←∧/(⍺ adj ⍵)∊⍺⍺,'¯',⎕D ⍝ gap required between words ⍺ ⍵ 667 | ∊1 gap 1/⍺' '⍵ ⍝ separated sections 668 | } ⍝ :: expr ← expr ∇ expr 669 | 670 | name←{(↓⌽↑⌽¨⍺),¨(⊂' ← '),¨⍵}⍣N ⍝ with "name ← ..." 671 | 672 | ↑(⊃¨⍵)name 0 xpr¨¯2↑¨⍵ ⍝ formatted definitions 673 | } 674 | 675 | externs←{ ⍝ External names referenced by fn ⍵. 676 | 677 | exts←{ ⍝ external references 678 | 1≠≡⍵:⍺ ∇ foldl ⍵,⊂,'⋄' ⍝ inner fn: traverse 679 | X L P←⍺ ⍝ Externals Locals Pending 680 | (⊂⍵)∊L:⍺ ⍝ already local: no change 681 | 0≤⎕NC ⍵~'⍺∇⍵':X L(P∪⊂⍵) ⍝ name: pending 682 | ⍵≡,'←':X(L∪P)⍬ ⍝ assignment: pending → local 683 | ~(⊃⍵)∊'⋄:':⍺ ⍝ more in segment: continue 684 | (X∪P)L ⍬ ⍝ end-of-segment: pending → external 685 | } ⍝ :: [envt] ← [envt] ∇ func 686 | 687 | nest←{ ⍝ nested tokens for nested functions 688 | ⍺←+\1 ¯1 0[(,¨'{}')⍳⍵] ⍝ {}-nesting depths 689 | outer←⊃,(⊃⌽) ⍝ outermost tokens 690 | inner←{(1↓¯1↓⍺)⍺⍺ 1↓¯1↓⍵} ⍝ ⍺⍺ applied between outer {}s 691 | '{}'≡∊outer ⍵:⊂(⍺-1)∇ inner ⍵ ⍝ recursive nesting of function body 692 | 0∧.=⍺:⍵ ⍝ no inner fns: done 693 | lft←(⍵∊⊂,'{')∧⍺=1 ⍝ top-level left braces 694 | rgt←0,¯1↓(⍵∊⊂,'}')∧⍺=0 ⍝ tokens following top-lvl right braces 695 | cut←1++\lft∨rgt ⍝ chopping at inner {} sections 696 | ⊃,/(cut⊆⍺)∇¨sort cut⊆⍵ ⍝ diamond and guard segs 697 | } ⍝ :: func ← ∇ [tokn] 698 | 699 | sort←{ ⍝ inner functions deferred until last 700 | ord←⍋⊃¨⍺ ⍝ depth-of-segment order 701 | deps←(⊂ord)⌷⍺ ⍝ depths 702 | segs←(⊂ord)⌷⍵ ⍝ code segments 703 | deps ⍺⍺ segs ⍝ nesting per segment 704 | } ⍝ :: func ← [[deps]] ∇ [[toks]] 705 | 706 | clean←{ ⍝ de-fluffing of tokens vectors 707 | join←{¯1↓⊃,/⍵,¨⊂⊂,'⋄'} ⍝ diamonds for newlines 708 | rmcm←{('⍝'≠⊃¨⍵)/⍵} ⍝ without comments 709 | rmps←~∘(,¨'()') ⍝ without parens: '(a b)←' → 'a b←' 710 | ''glue foldl rmps rmcm join ⍵ ⍝ clean token vector 711 | } ⍝ :: [tokn] ← ∇ [[tokn]] 712 | 713 | glue←{ ⍝ gluing of compound name tokens a.b.c 714 | '.'≠⊃⊃⌽⍺:⍺,⊂⍵ ⍝ not a '.' token: continue 715 | ~(⊃⍵)∊alph:⍺,⊂⍵ ⍝ not a dotted name: continue 716 | (¯2↓⍺),⊂∊(¯2↑⍺),⍵ ⍝ dotted name: 'a.' 'b' → 'a.b' 717 | } ⍝ :: [tokn] ← [tokn] ∇ tokn 718 | 719 | foldl←{⊃⍺⍺⍨/(⌽⍵),⊂⍺} ⍝ fold left 720 | 721 | alph←{(0≤⎕NC⍪⍵)/⍵}⎕AV~'⍺⍵∇' ⍝ start-of-name chars 722 | 723 | envt←⍬ ⍬ ⍬ ⍝ Externs Locals Pending 724 | ⍺←0 ⋄ toks←60⌶,¨,⊆⎕NR⍣(~⍺)⊢⍵,⍺↑'⋄' ⍝ unofficial: tokens from nested rep'n of function 725 | ⊃envt exts foldl nest clean toks ⍝ external names 726 | 727 | ⍝ 0 externs :: [name] ← ∇ name ⍝ names referenced by dfn ⍵ 728 | ⍝ 1 externs :: [name] ← ∇ func ⍝ names referenced by ⎕CR form ⍵ 729 | ⍝ func := [tokn] | [func] ⍝ function body: nested tokens vectors 730 | ⍝ tokn := ⍞ ⍝ token, eg '⍺⍺' '⎕CR' '+' 731 | ⍝ envt := [name] [name] [name] ⍝ (externs locals pending)-triple 732 | ⍝ name := ⍞ ⍝ name, eg 'test' 733 | } 734 | :EndSection 735 | :Section Text 736 | ∇ bcut←la psmum lengths;in;ispacing;iwidth;ittl;cut;n 737 | ⍝ Find Partition so +/⌈/¨ is under max 738 | (ispacing ittl)←+\⌽2↑la,1 ⋄ n←in←⍴lengths ⋄ cut←in↑1 739 | :Repeat ⋄ :Until ∧/bcut←cut 740 | n←n-1 ⋄ cut←in⍴n↑1 741 | :OrIf ittl≤+/ispacing+⌈/¨cut⊂lengths 742 | ∇ 743 | 744 | showCol←{ ⍝ Show table in column format 745 | ⍝ Each row represents a word 746 | max←⌈/w←⍬∘⍴∘⍴¨words←trimEnds¨↓⍣(326≠⎕DR ⍵)⊢⍵ 747 | 0∊⍴words:0 0⍴'' 748 | ⎕ML←⎕IO←1 749 | ⍝ We can specify the total width and minimum space between each word (column) 750 | ⍝ If the minimum is negative, the columns may not be of the same width 751 | ⍺←⍬ ⋄ la←{0∊⍴⍵:0 ' ' ⋄ ∨/0 2∊10|⎕DR ⍵:0 ⍵ ⋄ 2↑⍵}⍺ 752 | la[2]←{3=10|⎕DR ⍵:⍵ ⋄ ⍴,⍵}spacer←2⊃la 753 | (spacing width)←{⍵[⍋⍵]}a,(⍳max∧.spacing:0 s↓⊃,/' ',⍣s¨⊢n↑¨↑¨c⊂words⊣n←1⍳⍨1⌽c←⎕PW s psmum w⊣s←-spacing 755 | w+←spacing 756 | nw←npl×nrw←⌈(⍴w)÷npl←⌊(width+spacing)÷max+spacing 757 | words←⍉(npl,nrw)⍴nw↑(max↑¨words),¨⊂spacing{3=10|⎕DR ⍵:⍺⍴'' ⋄ ⍵}spacer 758 | (0,-spacing)↓↑,/words 759 | } 760 | 761 | ⍝ Ex: 60 showCol ⎕nl 3 ⍝ 60 wide display of fns, 1 space between columns 762 | ⍝ 3 showCol ⎕nl 3 ⍝ ⎕PW wide display of fns, 3 spaces in between cols 763 | ⍝ 78 '; ' showcol ⎕nl 2 ⍝ 78 wide display, '; ' between columns 764 | ⍝ ' | ' showCol ⎕nl 9 ⍝ ⎕PW wide, ' | ' between columns 765 | 766 | ∇ r←{options}showRow words;text;sh;blk;sp;pw;⎕ML;⎕IO;n ⍝ fit a list ⎕PW wide 767 | ⍎(0=⎕NC'options')/'options←⍬' ⋄ ⎕ML←⎕IO←1 768 | ⍝ options are Printing Width, Granularity, min Spacing between words 769 | (pw blk sp)←options,(⍴,options)↓⎕PW,4 1 ⋄ pw←pw-sp 770 | sh←⊃,/⍴¨,¨text←{~∘' '¨↓⍵}⍣(326≠⎕DR words)+words ⍝ accept matrix of words 771 | sh←⊃,/⍴¨text←(blk×⌈blk÷⍨sh+sp)↑¨text ⍝ adjust each word's size 772 | r←0⍴⊂'' 773 | :While 0<⍴text 774 | r←r,,/(n←1⌈+/pw≥+\sh)↑text ⋄ (text sh)←n↓¨text sh 775 | :EndWhile 776 | r←↑r 777 | ∇ 778 | 779 | toMatrix←{⍺←3↓4↑⎕av ⋄ ⎕ml←0 ⋄ (2↑0∊⍴⍵)↓↑1↓¨(s∊⍺)⊂s←(1↑⍺),⍵} ⍝ multiple cut chars allowed 780 | 781 | toVector←{⍺←3↓4↑⎕av ⋄ b←,1,⌽∨\' '≠⌽⍵ ⋄ 1↓b/,⍺,⍵} 782 | 783 | trimEnds←{((∨\b)∧⌽∨\⌽b←' '≠⍵)/⍵} 784 | 785 | ∇ r←repObjQA;exprs;expr;⎕FR;fr;val;rep;Match;⎕IO 786 | exprs←r←⍬ 787 | ⍝ Critical cases to handle: 788 | exprs,←⊂'(⍳100)÷10' 789 | exprs,←⊂'(⍳100)÷3' 790 | exprs,←⊂'(⍳10)×1j2' 791 | exprs,←⊂'(,1j2)(,1e1000)' 792 | exprs,←⊂'1J2 (,1E1000)' 793 | exprs,←⊂'(⍳100)×2*¯100' 794 | exprs,←⊂'1j1×(⍳100)×2*¯100' 795 | exprs,←⊂'1E1000 2E1000 3E1000 4E1000 5E1000 6E1000 7E1000 8E1000 9E1000 1E1001' 796 | ⍝ Real world data: 797 | exprs,←⊂'0.0007125 0.000735 0.0007575 0.00078 0.0008025 0.000825 0.0008475 0.0008625' 798 | exprs,←⊂'0.0007125 0.0007125 0.000735 0.0007575 0.00078 0.0008025 0.000825 0.0008475 0.0008625' 799 | exprs,←⊂'0.0007125 0.0007125 0.0007125 0.000735 0.0007575 0.00078 0.0008025 0.000825 0.0008475 0.0008625' 800 | 801 | Match←{⎕FR←⊃1287 645⌽⍨1289=⎕DR ⍺ ⋄ 0::0 ⋄ ⍺≡⍵} 802 | :For ⎕IO :In 0 1 803 | :For ⎕FR :In 645 1287 804 | :For expr :In exprs 805 | val←⍎expr 806 | rep←repObj val 807 | :If ~r,←val Match⍎rep 808 | 'FAIL:(⎕IO ⎕FR)←',(⍕⎕IO ⎕FR),' ⋄ ⎕SE.Dyalog.Utils.repObj ',expr 809 | :EndIf 810 | :EndFor 811 | :EndFor 812 | :EndFor 813 | r←∧/r 814 | ∇ 815 | 816 | repObj←{ ⍝ String representation of object V0.35 817 | ⍝ Optional left arg: parenthesise if needed to isolate expression in context 818 | 819 | ⎕IO←1 820 | 821 | ⍺←0 ⍝ parenthesise if expression 822 | P←'(',')',⍨⍕ 823 | 10::P⍣⍺⊢'0(220⌶)0(219⌶)',∊P¨2 9(219⌶)1(220⌶)⍵ 824 | ⎕FR←645 1287[⎕IO+1287=⎕DR ⍵] ⍝ prepare for decfs 825 | expr←{ 826 | s←⍵/⍨~≠\''''=⍵ ⍝ remove strings 827 | p←s/⍨0=+\-⌿'()'∘.=s ⍝ remove parens 828 | b←p/⍨0=+\-⌿'[]'∘.=p ⍝ remove brackets 829 | ∨/'⊂,⍴+-×/⍳'∊p:P ⍵ ⍝ if expression; parenthesise 830 | ⍵ 831 | }⍣⍺{ 832 | ⍝ This version accounts for ⎕TC type characters 833 | ⍝ Recognise some constants: 834 | ⍵≡⍬:'⍬' ⋄ ⍵≡'':'''''' ⋄ ⍵≡⎕NULL:'⎕NULL' 835 | ⍵≡⎕D:'⎕D' ⋄ ⍵≡⎕A:'⎕A' ⋄ ⍵≡⎕Á:'⎕Á' ⋄ ⍵≡⎕AV:'⎕AV' 836 | scal←0∊rank←+/⍴s←⍴⍵ ⋄ char←>/(simple num)←∧\~(10|⎕DR 1/⍵)∊¨6(0 2) 837 | ⍝ Refs should normally not be displayed. To allow remove set ⍺[2] to 1 838 | ⍺←0 ⍝ recursive call? 839 | (rc ref)←2↑⍺ 840 | or←scal∧1=≡R←⍵ ⍝ normally no funny objects like ⎕ORs 841 | or∨9=⎕NC'R':ref{~⍺:⎕SIGNAL⊂('EN' 11)('Message' 'Cannot represent refs') ⋄ ⍵}⍕⍵ ⍝ display refs as they are 842 | 843 | ⍝ Reduce object to 1 item if all same elements 844 | mod←(0/'⎕' 'ADÁN'∊¨⍨2↑⍵:P ⍵ ⋄ ⍵} ⍝ Parenthesise complex expressions 859 | ~simple:rp,⍨lp,shape,encl{⍺⍲'('=1↑⍵:⍵ ⋄ 1↓¯1↓⍵}1↓⊃,/' ',¨Paren¨1 ref∘∇¨obj 860 | 861 | ⍝ Simple objects (char should account for ⎕TC chars et al.) 862 | ⎕PP←34 ⍝ for numbers 863 | 864 | cmpv←{⎕DCT←⎕CT←⎕IO←0 ⍝ compress numeric vector 865 | ⎕FR←645 1287[1289≠⎕DR ⍵] ⍝ outer array may have been nested 866 | ∨/e←(0∊s),⍬≡s←⍴v←⍵:⍕e/'⍬',1↑v ⍝ empty or scalar 867 | ⍺←4 ⋄ ⍺≥s:⍕v↑⍨⍺⌊s ⍝ min length to consider compressing 868 | d←{⍵>¯1⌽1 1 0⍷⍵}{1,⍵,⍨1↑⍵}2≠/2-/v 869 | ⍝ We know we have at least ONE section to deal with 870 | ⍝ We split the list into sections that either have to be compressed or not 871 | s←-+/lim←{(⍵>1⌽⍵)∨⍵>¯1↓0,⍵}d ⍝ where each section starts 872 | addp←(s↑1)⍴t←A,B,C:ap t 881 | ',',d 882 | }¨↓⍉↑lim∘⊂¨d v 883 | ⍝ There may be some superflous commas 884 | b←(','=r)⍲(¯1⌽r=')')⍱1⌽r∊'[(' 885 | x←(b\b/r)~'[' 886 | brace←5≤10|⎕DR ⍵ 887 | (ob cb)←brace/¨'({⎕io←0⋄'(1⌽')⊣⎕fr←⍵}',⍕⎕FR) ⍝ dfn to set ⎕FR if float 888 | ⍵≡⍎x:ob,'⎕io-⍨'⎕R''⍣brace⊢x,cb 889 | fmt←⍕⍵ 890 | ⍵≡⍎fmt:ob,cb,⍨⍕⍵ 891 | ⎕SIGNAL⊂('EN' 16)('Message' 'Generated expression did not match argument')⍝ NONCE 892 | } 893 | 894 | obj←shape,num ⍺{1↑⍺:cmpv ⍵ ⋄ ⎕ML←1 ⋄ ⎕IO←0 ⋄ QU←{Q,((1+t=Q)/t←⍵),Q←''''} 895 | ⍝ We have to assume not all characters are available. Those should be: 896 | Always←⎕A,⎕D,'abcdefghijklmnopqrstuvwxyz_.,:;%!"/=\-+''#$£¢^¿¡(){}[]§@`∣¶&' 897 | Always,←'ÁÂÃÇÈÊËÌÍÎÏÐÒÓÔÕÙÚÛÝþãìðòõÀÄÅÆÉÑÖØÜßàáâäåæçèéêëíîïñùúûüóôöø' 898 | Always,←'≤≥⌿⍀<>≠∨∧÷×?∊⍴~↑↓⍳○*⌈⌷¨⌊∇∆⍙⍨∘⊂⊃∩∪⊥⊤⌶|⍺⍵¯⍬⍱⍲⍒⍋⍉⌽⊖⍟⌹⍕⍎⍫⍪≡≢⍷⋄←→⍝⎕⍞⍣ ' 899 | u←80=⎕DR'' 900 | Always,←'⊢⊣',⎕UCS u/8838 9016 9018 9056 9060 9080 ⍝ ⊂_ ⎕= ⎕⋄ ⎕: ∘¨ ⍳_ 901 | Always,←⎕UCS 9061/⍨u∧18≤1 0⊃'.'⎕VFI 1⊃# ⎕WG'APLVersion' ⍝ ○¨ 902 | ∧/t←⍵∊Always:QU ⍵ ⍝ no special chars? 903 | ⍝ If only a few chars transform the whole string into ⎕AV 904 | UCS←{1⌽')(⎕ucs ',⍕cmpv ⎕UCS ⍵} 905 | ⍝ More than a few; create a mixture of ⎕UCS and 'quotes' 906 | minsize←3 ⍝ how much special chars to include between sections; that number is subjective 907 | c∨←minsize>∊⍴¨c←ucs⊂⍨c←1,1↓ucs≠¯1⌽ucs←~t ⍝ consider small groups of ASCII as UCS 908 | ⍝ ∧/sc←∊c:ucs ⍵ ⍝ are the pieces small enough to be all in ⎕UCS? 909 | (lp rp)←'()'/⍨¨(1↓⍺)∧1<+/c←1,1↓ucs≠¯1⌽ucs←∊c 910 | rp,⍨lp,∊{⍺,',',⍵}/(c/ucs){⍺:UCS ⍵ ⋄ QU ⍵}¨c⊂⍵ 911 | }obj 912 | lp,obj,rp 913 | }⍵ 914 | ⎕CT←⎕DCT←0 915 | ⍵≡⍎expr:expr 916 | ⎕SIGNAL⊂('EN' 16)('Message' 'Generated expression did not match argument')⍝ NONCE 917 | } 918 | 919 | ∇ string←{sep}toXML value;tag;s;v;⎕PP;repChar;⎕ML;dr;⎕IO 920 | ⍝ Turns an APL object into an XML representation 921 | ⍝ Simple scalars are turned into CHAR, NUMBER or NULL 922 | ⍝ Vectors or rank>1 are turned into ARRAYs of numeric LIST or char STRING 923 | ⍝ Characters are translated to be acceptable by ⎕XML 924 | ⎕PP←17 ⋄ ⎕ML←1 ⋄ ⎕IO←0 ⋄ sep←{6::'' ⋄ ⍎⍵}'sep' 925 | tag←{'<',s,⍵,''} 926 | ⍝ Some characters cannot go thru ⎕XML, this is normal. The valid ones are 927 | ⍝ #x9 | #xA | #xD | [#x20-#xD7FF] | [#xE000-#xFFFD] | [#x10000-#x10FFFF] 928 | ⍝ That is any Unicode character, excluding the control chars, FFFE, and FFFF. 929 | v←'<>&',⎕UCS s←⎕AVU∩⍣(82∊⎕DR'')⍳32 ⍝ this may vary in e.g. Unix Classic 930 | s←'<' '>' '&','£%'∘,¨(⎕D,⎕A)[s],¨';' 931 | repChar←s∘(v∘⍳{~∨/b←(⍴⍺)>i←⍺⍺ v←,⍵:⍵ ⋄ (b/v)←⍺[b/i] ⋄ ∊v}) 932 | :If 0∊⍴⍴value ⍝ scalar 933 | :If 0∊1↑0⍴value ⋄ string←'number'tag⍕value 934 | :ElseIf ' '∊1↑0⍴value ⋄ string←'char'tag repChar value 935 | :ElseIf ⎕NULL≡value ⋄ string←'' 936 | :ElseIf 1≥|≡value ⋄ 'no Refs allowed'⎕SIGNAL 11 937 | :Else ⍝ must be enclosed 938 | string←'enclosed'tag sep toXML↑value 939 | :EndIf 940 | :Else ⍝ not a scalar 941 | s←'shape'tag⍕⍴value 942 | :If 2|dr←10|⎕DR value ⋄ string←'list'tag⍕,value 943 | :ElseIf dr∊0 2 ⋄ string←'string'tag repChar,value 944 | :Else 945 | string←∊sep∘toXML¨{0∊⍴⍵:⍬⍴⍵ ⋄ ⍵}value 946 | :If (1≥×/⍴value)∧1≢≡value ⋄ string←'enclosed'tag string ⋄ :EndIf 947 | :EndIf 948 | string←sep,'array'tag s,string 949 | :EndIf 950 | ∇ 951 | 952 | ∇ value←fromXML string;mat;shape;⎕ML;type;array;enc;E;n;s;b;c;i;cc;ss 953 | ⍝ Turns an XML string into an APL object 954 | ⍝ The string must have been produced by the fn above. 955 | ⎕ML←1 ⋄ E←'enclosed' ⍝ for ⊂ 956 | ⍝ Character strings are transformed into a more suitable format 957 | :Select type←2⊃,mat←'whitespace' 'preserve'⎕XML⍣(0 2∊⍨10|⎕DR string)+string 958 | 959 | :CaseList 'array'E 960 | ⍝ The array could be enclosed several times 961 | n←2+enc←+/∧\mat[;2]∊⊂E 962 | shape←2⊃⎕VFI 3⊃mat[n;] 963 | value←fromXML¨(mat[n;1]=n↓mat[;1])⊂[1]n 0↓mat 964 | value←⊂⍣enc⌷shape⍴↑⍣(1∊⍴value)⌷value 965 | :CaseList 'list' 'number' 966 | value←⍬∘⍴⍣(type≡'number')+2⊃⎕VFI 3⊃,mat 967 | :CaseList 'string' 'char' 968 | b←(⍴s)↑3↓';'=s←3⊃,mat 969 | :If ∨/ss←b∧'£%'⍷s ⋄ c←¯2⌽ss ⍝ any special sequence? 970 | :AndIf ∨/cc←33>i←(32↑⎕D,⎕A)⍳c/s ⍝ any control character? 971 | (cc/(¯1⌽c)/s)←⎕UCS cc/i-1 ⍝ replace the ; by the control character 972 | s←(~≠\↑∨/2 ¯1⌽¨⊂c\cc)/s ⍝ remove special sequence extra characters 973 | :EndIf 974 | value←⍬∘⍴⍣(type≡'char')+s ⍝ ⎕R too slow 975 | :Case 'null' 976 | value←⎕NULL 977 | :EndSelect 978 | ∇ 979 | 980 | ∇ r←la txtreplace string;⎕IO;N;from;to;Fl;Tl;Fp;i;b;ip;n 981 | ⍝ Text Pattern Replace 982 | ⍝ la is a 2 elements enclosed strings: what to look for, the replacement string. 983 | ⍝ Ex: 'abc' 'xxyyzz' will turn all non overlapping 'abc' substrings into 'xxyyzz' 984 | (Fl Tl)←⍴¨(from to)←,¨la ⋄ Fp←⍴⎕IO←0 ⋄ N←⍴b←from⍷string←,string 985 | ⎕SIGNAL Fl↓11 986 | :If 1∊Fl ⋄ Fp←b/⍳⍴b ⍝ simple case 987 | :Else 988 | :While N>i←b⍳1 ⍝ remove overlapping matches 989 | (Fl↑i↓b)←0 ⋄ Fp,←i 990 | :EndWhile 991 | :EndIf 992 | ⍝ Do it 993 | :If 0n←Fl-Tl ⍝ do we need to insert spaces? 995 | b[]←1 ⋄ b[Fp]←1-n ⋄ string←b/string 996 | Fp←Fp-n×⍳ip ⍝ adjust positions 997 | :EndIf 998 | string[,Fp∘.+⍳Tl]←(ip×Tl)⍴to ⍝ replace 999 | :If n>0 ⍝ remove excess 1000 | b[(Fp+Fl-1)∘.-⍳n]←~b[]←1 1001 | string←b/string 1002 | :EndIf 1003 | :EndIf 1004 | r←string 1005 | ∇ 1006 | 1007 | ∇ txt←condRavel txt;crs;s;CR;LF;ncr 1008 | ⍝ Conditionally ravel text where CR are followed by non-white Spaces 1009 | ⍝ e.g. 'x',CR,'x' is changed by 'x x' 1010 | (LF CR)←2↓4↑⎕AV 1011 | :If 1<⍴⍴txt ⋄ txt←1↓,CR,txt ⋄ :EndIf 1012 | txt[(txt=LF)/⍳⍴txt]←CR ⍝ LF=CR 1013 | ⍝ We first remove the spaces at the end of each line 1014 | ncr←CR≠1↑txt 1015 | txt←{(⍵∊CR)⊂⍵}(ncr↑CR),txt ⍝ each line 1016 | s←-⊥⍨¨' '=¨txt ⍝ number of spaces to drop at the end of each line 1017 | txt←⊃,/s↓¨txt ⍝ drop them, merge lines 1018 | crs←s/⍳⍴s←0,1↓¯1↓CR=txt ⍝ find where the CRs are and replace by 1019 | txt[(⍱⌿txt[¯1 1∘.+crs]∊CR,' ')/crs]←' ' ⍝ space those between words 1020 | txt←ncr↓txt ⍝ remove CR added 1021 | ∇ 1022 | 1023 | ∇ rfmtxt←{n}reshapeText text;⎕IO;b;d;line;n1;s;CR 1024 | ⍝ Embed the CR character into the text so lines are 1025 | ⍝ approximately and at most 'n' long. Existing CRs are left in. 1026 | ⍝ If the text contains CRs to be removed use function . 1027 | :If 0=⎕NC'n' ⋄ n←⎕PW ⋄ :Else ⋄ n⌈←2 ⋄ :EndIf 1028 | ⎕IO←0 ⋄ rfmtxt←'' ⋄ text←,text ⋄ n1←1+n ⋄ CR←⎕AV[3] 1029 | :While n<⍴text 1030 | :If 0∊s←CR≠line←n1↑text ⍝ any CR in line? 1031 | rfmtxt←rfmtxt,(-d←s⊥s)↓line ⍝ keep up to last CR 1032 | text←(n1-d)↓text 1033 | :ElseIf ¯1↑s←' '=line ⍝ No CRs in line; does the line fit? 1034 | rfmtxt←rfmtxt,((-s⊥s)↓line),CR ⍝ it does 1035 | text←n1↓text 1036 | :ElseIf ~∨/s ⍝ cut at last space. Any? 1037 | rfmtxt←rfmtxt,(¯2↓line),'-',CR ⍝ no, add a dash too 1038 | text←(n-1)↓text 1039 | :Else ⍝ line contains spaces but the last word does not fit 1040 | b←(b⍳1)↓b←⌽s ⋄ text←(⍴b)↓text ⍝ forget last word 1041 | d←(⍴b)-b⍳0 ⍝ number of chars to take 1042 | rfmtxt←rfmtxt,(d↑line),CR 1043 | :EndIf 1044 | :EndWhile 1045 | rfmtxt←rfmtxt,text 1046 | ∇ 1047 | 1048 | ∇ text←{vals}formatText text;cr;pw;right;hang;first;lead;left 1049 | ⍝ Format text according to specifications (see ]format -?) 1050 | :If 900⌶⍬ ⋄ vals←0 ⋄ :EndIf 1051 | text←{(+/∨\' '≠⌽⍵)↑¨↓⍵}∘⎕FMT⍣(1=≡text)⊢text ⍝ convert everything to VTV 1052 | text←↑,/(⊂''),(⊂vals)formatPar¨text 1053 | ∇ 1054 | 1055 | ∇ text←{vals}formatPar text;cr;pw;right;hang;first;lead;left 1056 | ⍝ Format paragraph according to specifications (see ]format -?) 1057 | :If 900⌶⍬ ⋄ vals←0 ⋄ :EndIf 1058 | (left right first)←{1≤|⍵:⍵ ⋄ ⌊0.5+⎕PW×⍵}¨3↑vals 1059 | cr←⎕UCS 13 1060 | pw←⎕PW-right 1061 | hang←|0⌊first 1062 | lead←hang↑text 1063 | text←(-first+⍴text)↑text 1064 | text←condRavel↑text 1065 | text←(pw-left)reshapeText text 1066 | text,⍨←cr 1067 | text←(left⍴' ')∘,¨1↓¨(text=cr)⊂text 1068 | (left↑⊃text)←(-left)↑lead 1069 | ∇ 1070 | 1071 | ∇ text←layoutText text;lead;left;cr;right 1072 | ⍝ Layout text according to ]layout -? rules 1073 | text←{(+/∨\' '≠⌽⍵)↑¨↓⍵}∘⎕FMT⍣(1=≡text)⊢text ⍝ convert everything to VTV 1074 | text←↑,/(⊂''),layoutPar¨text 1075 | ∇ 1076 | 1077 | ∇ text←layoutPar text;lead;left;cr;right 1078 | ⍝ Layout paragraph according to ]layout -? rules 1079 | cr←⎕UCS 13 1080 | right←+/∧\' '=⌽text 1081 | text←(-right)↓text 1082 | left←⌈/3↑¯1+(2≠/' '⍷' ',text)/⍳1+⍴text 1083 | lead←left↑text 1084 | text←left↓text 1085 | text←(⎕PW-⌈left+right)reshapeText text 1086 | text,⍨←cr 1087 | text←(left⍴' ')∘,¨1↓¨(text=cr)⊂text 1088 | (left↑⊃text)←lead 1089 | ∇ 1090 | 1091 | ∇ setupKeys arg;sp 1092 | ⍝ arg is a char vector possibly embedded with or followed by an enclosed string, eg: 'dothis',⊂'ER' 1093 | :If ''≡arg 1094 | sp←{d←326=⎕DR ¯1↑v←,⍵ ⋄ v[b/⍳⍴b←'"'≡¨v]←'''' ⋄ ⍺,(v,d↓⊂'ER')⎕PFKEY ⍺} 1095 | ⍝ e.g. 13 sp'"." ⎕wg "aplversion"' 1096 | 2 sp'⎕se.SALTUtils.EditorFix "chk"' 1097 | :EndIf 1098 | ∇ 1099 | :EndSection 1100 | 1101 | :Namespace qa 1102 | ∇ ok←ExpandConfig;r 1103 | r←'text','text',⍨∊4⍴⊂2 ⎕NQ #'GetEnvironment' 'DYALOG' 1104 | ok←r≡##.ExpandConfig'text[DYALOG]$DYALOG$env:DYALOG%DYALOG%text' 1105 | :If ~⎕SE.SALTUtils.WIN 1106 | r←'/',⍨2 ⎕NQ #'GetEnvironment' 'HOME' 1107 | ok,←##.ExpandConfig'~' 1108 | r←'/',⍨2 ⎕NQ #'GetEnvironment' 'PWD' 1109 | ok,←##.ExpandConfig'~+' 1110 | r←'/',⍨2 ⎕NQ #'GetEnvironment' 'OLDPWD' 1111 | ok,←##.ExpandConfig'~-' 1112 | :EndIf 1113 | ok←∧/ok 1114 | ∇ 1115 | :enDNamespace 1116 | :EndNameSpace ⍝ Utils $Revision: 1827 $ 1117 | --------------------------------------------------------------------------------