├── .gitattributes ├── Circle.aplf ├── CircleDiaeresis.aplo ├── CircleStar.aplf ├── DelDiaeresis.aplo ├── DelTilde.aplo ├── Division.aplf ├── DollarSign.aplf ├── DownArrow.aplf ├── DownShoe.aplf ├── DownTack.aplf ├── Downstile.aplf ├── EpsilonUnderbar.aplf ├── Equal.aplf ├── Exclamation.aplf ├── Execute.aplf ├── Formal Proposal — Select.html ├── GreaterOrEqual.aplf ├── GreaterThan.aplf ├── JotUnderbar.aplo ├── LICENSE ├── LeftShoe.aplf ├── LeftShoeUnderbar.aplf ├── LessOrEqual.aplf ├── LessThan.aplf ├── Minus.aplf ├── Nand.aplf ├── Nor.aplf ├── Plus.aplf ├── QuadDel.aplo ├── QuadDiamond.aplo ├── QuadEqual.aplo ├── QuestionMark.aplf ├── README.md ├── Rho.aplf ├── RightShoeUnderbar.aplf ├── Root.aplf ├── Star.aplf ├── Stile.aplf ├── Tilde.aplf ├── Times.aplf ├── Unequal.aplf ├── UpArrow.aplf ├── UpShoe.aplf ├── Upstile.aplf ├── Vel.aplf ├── Wedge.aplf ├── apl-dyalog-vision ├── languages.json ├── ∆C.aplf ├── ∆EM.aplf ├── ∆FIX.aplf ├── ∆NG.aplf ├── ∆NS.aplf ├── ∆NV.aplf ├── ∆SIGNAL.aplf ├── ∆UCS.aplf ├── ⍙Execute.aplf ├── ⍙LA.aplo ├── ⍙REPL.aplf ├── ⍙To.aplo ├── ⎕IO.apla └── ⎕ML.apla /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | *.apl? linguist-language=APL 4 | -------------------------------------------------------------------------------- /Circle.aplf: -------------------------------------------------------------------------------- 1 | f←Circle ⍝ ○ 2 | f←○⍙LA 3 | -------------------------------------------------------------------------------- /CircleDiaeresis.aplo: -------------------------------------------------------------------------------- 1 | CircleDiaeresis←{ ⍝ ⍥ ⍝ also depth 2 | 0::⎕SIGNAL⊂⎕DMX.(('EN'EN)('EM'EM)('Message'(OSError{⍵,2⌽(×≢⊃⍬⍴2⌽⍺,⊂'')/'") ("',⊃⍬⍴2⌽⍺}Message))) 3 | ncs←⎕NC⊃⍤0⊢'⍺' '⍵⍵' 4 | 0 3≡ncs:⍺⍺ ⍵⍵ ⍵ ⍝ f⍥g Y 5 | 2 3≡ncs:⍺ ⍺⍺⍥⍵⍵ ⍵ ⍝ X f⍥g Y 6 | 7 | 1<≢⍴⍵⍵:⎕SIGNAL 4 ⍝ non-vec/scal: RANK 8 | ⎕IO≠1 4⍸≢⍵⍵:⎕SIGNAL 5 ⍝ not 1…3 elements: LENGTH 9 | (c←⎕NS ⍬).⎕CT←1E¯14 ⍝ tolerant space 10 | c.≢∘⌊⍨⍵⍵:⎕SIGNAL 11 ⍝ not ints: DOMAIN 11 | 12 | 0∊⎕NC'⍺':0⊢∘⍺⍺∇∇⍵⍵⊢⍵ ⍝ monadic: placeholder left arg 13 | 14 | ⍺←{⍵ ⋄ ⍺⍺} ⍝ monadic: pass-thorugh 15 | a←⍺ ⍝ [17941] 16 | k←⌽3⍴⌽⍵⍵ ⍝ r → r r r q r → r q r p q r → p q r 17 | n←k c.<0 18 | d←|≡¨3⍴⍵ ⍺ ⍵ ⍵ 19 | (n/k)+←n/d 20 | k⌊←d 21 | 22 | b←1↓k/b:S∘⍵¨⍺ 31 | c.∧/b:⍺ S¨⍵ 32 | } 33 | -------------------------------------------------------------------------------- /CircleStar.aplf: -------------------------------------------------------------------------------- 1 | f←CircleStar 2 | f←⍟⍙LA 3 | -------------------------------------------------------------------------------- /DelDiaeresis.aplo: -------------------------------------------------------------------------------- 1 | DelDiaeresis←{ ⍝ ⍢ Under a.k.a. Dual 2 | 0::∆SIGNAL ⎕DMX 3 | ns←⎕NULL⍴⍨15⍴0 ⍝ special recognisable value 4 | 2 2≡⎕NC⊃⍤0⊢'⍺' '⍺⍺':⎕SIGNAL⊂('EN' 2)('Message' 'Array left argument conflicts with array left operand') 5 | ⍺←{⍵ ⋄ ⍺⍺} ⍝ no ⍺: pass through 6 | ⍵⍵{ 7 | aa←⍺⍺ 8 | 3::0 9 | (⎕CR'DelTilde')≡⊃⍬⍴1⌽⎕CR'aa' 10 | }⍬:ww.InvFn(ww.NrmFn ⍺)⍺⍺(ww←⍵⍵ ns).NrmFn ⍵ 11 | ⍵ ⍵⍵{ ⍝ pass in original ⍵ 12 | A←⍺ ⍝ modifiable array 13 | 11::A⊣((⍺⍺)A)←⍵ ⍝ structural inversion on error... 14 | NoOp←{0::0 ⋄ ⍵≡⍺⍺ ⍵} ⍝ Is ⍺⍺ a no-op? (or fails) 15 | ~(⍺⍺⍣¯1 ⍺⍺)NoOp ⍺:!# ⍝ ... or if imperfect inverse 16 | ⍺⍺⍣¯1⊢⍵ ⍝ try computational inverse 17 | }(⍵⍵ ⍺)⍺⍺{ ⍝ ⍺⍺, but: 18 | ⍺←⊢ ⍝ no ⍺: pass through 19 | 2=⎕NC'⍺⍺':⍺(⍺⍺⊣⊢)⍤0⊢⍵ ⍝ if array: treat as scalar fn 20 | ⍺ ⍺⍺ ⍵ ⍝ else: just apply 21 | }⍵⍵ ⍵ ⍝ ⍺ ⍺⍺ over ⍵⍵ ⍵ 22 | } 23 | -------------------------------------------------------------------------------- /DelTilde.aplo: -------------------------------------------------------------------------------- 1 | DelTilde←{ ⍝ ⍫ ⍺⍺ but with inverse ⍵⍵ represented as ns 2 | 0::∆SIGNAL ⎕DMX 3 | ns←⎕NULL⍴⍨15⍴0 ⍝ special recognisable value 4 | ⍺←⊢ 5 | ⍵≢ns:⍺ ⍺⍺ ⍵ 6 | Fn←⎕NS ⍬ 7 | Fn.NrmFn←⍺⍺ 8 | Fn.InvFn←⍵⍵ 9 | Fn.Obv←1 10 | Fn 11 | } 12 | -------------------------------------------------------------------------------- /Division.aplf: -------------------------------------------------------------------------------- 1 | f←Division ⍝ ÷ 2 | f←÷⍙LA 3 | -------------------------------------------------------------------------------- /DollarSign.aplf: -------------------------------------------------------------------------------- 1 | r←{vals}DollarSign str;pats;Sub;SubFn;strings;nulls;marker ⍝ $ string enhancement ${1} for indexing into left arg, ${expr}, and \JSON escapes 2 | :If 900⌶⍬ 3 | vals←⊢ 4 | :EndIf 5 | :Trap 0 6 | str←'\$\{([^}'']*(''[^'']*''))*[^}'']*\}' '\\u....|\\.'⎕R{⍵.PatternNum:⎕JSON⍠'Dialect' 'JSON5'⊢'"',⍵.Match,'"' ⋄ ⍵.Match}str 7 | pats←'\$\{[\d ]+\}' '\$\{([^}'']*(''[^'']*''))*[^}'']*\}'⍝ \w ${12} ${expr} 8 | nulls←1+⌈/0,'\x{0}+'⎕S 1⊢str 9 | marker←nulls⍴⎕UCS 0 10 | strings←⍬⊃⍤⍴⍣(1≥|≡str)(nulls↓¨⊢⊂⍨marker∘⍷)¨⊆pats ⎕R marker⊢str 11 | Sub←{ 12 | ⍵.i←{×⍵.⎕NC'i':1+⍵.i ⋄ ⎕IO}⍵ 13 | 3=≢⍵.Match:⍵.i⊃⍵⍵ 14 | levels←+/∧\⎕RSI=⎕THIS 15 | Content←levels(⊃⍬⍴levels↓⎕RSI,⎕THIS).(86⌶)1↓⍵.Match ⍝ in calling env 16 | i←~⍵.PatternNum 17 | i∧3=⎕NC'⍺⍺':⎕SIGNAL⊂('EN' 2)('Message' 'Indexing requires a left argument') 18 | ⍕((1/⍺⍺)⊃⍨⊂)⍣(~⍵.PatternNum)⊢⍺⍺ Content ⍵⍵ 19 | } 20 | SubFn←vals Sub strings 21 | r←pats ⎕R SubFn str 22 | :Else 23 | ∆SIGNAL ⎕DMX 24 | :EndTrap 25 | -------------------------------------------------------------------------------- /DownArrow.aplf: -------------------------------------------------------------------------------- 1 | DownArrow←{ ⍝ ↓ which allows long ⍺ even for non-scalars 2 | 0::∆SIGNAL ⎕DMX 3 | 0=⎕NC'⍺':↓⍵ 4 | s←⍴⍵ 5 | l←≢¨⍺ s 6 | ≤/l:⍺↓⍵ 7 | t←-⊃l 8 | ⍺↓⍵⍴⍨t↑s,⍨1⊣¨⍺ 9 | } 10 | -------------------------------------------------------------------------------- /DownShoe.aplf: -------------------------------------------------------------------------------- 1 | DownShoe←{ ⍝ ∪ for any rank 2 | 0::∆SIGNAL ⎕DMX 3 | 0=⎕NC'⍺':∪⍵ ⍝ monadic case 4 | ↑(⊂⍤¯1⊢⍺)∩⊂⍤(0⌈¯1+≢⍴⍺)⊢⍵ 5 | } 6 | -------------------------------------------------------------------------------- /DownTack.aplf: -------------------------------------------------------------------------------- 1 | DownTack←{ ⍝ ⊤ with 2s as default left argument and scalar ⍺ for auto-size 2 | 0::∆SIGNAL ⎕DMX 3 | ⍺←2 4 | 0=≡⍺:⍺⊥⍣¯1⊢⍵ 5 | ⍺⊤⍵ 6 | } 7 | -------------------------------------------------------------------------------- /Downstile.aplf: -------------------------------------------------------------------------------- 1 | f←Downstile ⍝ ⌊ 2 | f←⌊⍙LA 3 | -------------------------------------------------------------------------------- /EpsilonUnderbar.aplf: -------------------------------------------------------------------------------- 1 | EpsilonUnderbar←{ ⍝ ⍷ but Type when monadic 2 | 0::∆SIGNAL ⎕DMX 3 | 2=⎕NC'⍺':⍺⍷⍵ 4 | 326≠⎕DR ⍵:⊃⍬⍴0⍴⊂⍵ ⍝ shortcut if homogenous 5 | w⊣(∊w)←{16::⍵ ⋄ ⊃⍬⍴0⍴⊂⍵}¨∊w←⍵ 6 | } 7 | -------------------------------------------------------------------------------- /Equal.aplf: -------------------------------------------------------------------------------- 1 | Equal←{ ⍝ = monadic Rank 2 | 0::∆SIGNAL ⎕DMX 3 | 0≠⎕NC'⍺':⍺=⍙LA ⍵ 4 | ≢⍴⍵ 5 | } 6 | -------------------------------------------------------------------------------- /Exclamation.aplf: -------------------------------------------------------------------------------- 1 | f←Exclamation ⍝ ! 2 | f←!⍙LA 3 | -------------------------------------------------------------------------------- /Execute.aplf: -------------------------------------------------------------------------------- 1 | Execute←{ ⍝ ⍎ 2 | 0::∆SIGNAL ⎕DMX 3 | ⍺←⊃⎕RSI 4 | ⍙Execute ⍵ 5 | } 6 | -------------------------------------------------------------------------------- /Formal Proposal — Select.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Formal Proposal — Select 6 | 7 | 28 | 29 |

Formal Proposal: Select

30 | 31 |

Among the most common data manipulations in APL are the selection parts of a larger array, and reordering an array into a new ordering. Since APL\360, this need has been met by square bracket indexing. However, the introduction of nested arrays, the Rank operator (as part of a drive towards leading axis orientation), and function composition, has revealed a problem with the bracket syntax. Since the bracket isn't a proper function, operators like Each (¨), Rank (⍤), and Bind (∘), cannot be used with it. This is a major flaw in the ease of expression, one that breaks the flow of LEGO-like combination in the language.

32 |

The flexibility of the APL language has allowed many APL programmers to work around the issue, either by implementing custom selection functions, or after the introduction of anonymous dfns, by wrapping bracket indexing, thereby giving it function syntax ({⍵[⍺]}, {⍵[⍺;]}, etc. or worse: {⍎'⍵[⍺',(';'⍴⍨¯1+≢⍴⍵),']'}). However, these solutions are often slow and obscure.

33 |

History

34 |

To address this, Ken Iverson included a From function ({) in A Dictionary of APL in ’86, and Roger Hui echoed this in ’87 35 |

Roger Hui suggested a partial solution to this in ’87, and it was included in J from its beginnings in ’90. APL derivatives (and thus competitors) like J and BQN have provided such functionality in proper functional form. Hobbyist APL implementations have also adopted

36 | 37 | -------------------------------------------------------------------------------- /GreaterOrEqual.aplf: -------------------------------------------------------------------------------- 1 | GreaterOrEqual←{ ⍝ ≥ monadic sort descending 2 | 0::∆SIGNAL ⎕DMX 3 | 0≠⎕NC'⍺':⍺≥⍙LA ⍵ 4 | {(⊂⍒⍵)⌷⍵}⍵ 5 | } 6 | -------------------------------------------------------------------------------- /GreaterThan.aplf: -------------------------------------------------------------------------------- 1 | GreaterThan←{ ⍝ > monadic Join 2 | 0::∆SIGNAL ⎕DMX 3 | 0≠⎕NC'⍺':⍺>⍙LA ⍵ 4 | ⊃⊃{,[⍺]/[⍺]⍵}/(⍳≢⍴⍵),⊂⍵ 5 | } 6 | -------------------------------------------------------------------------------- /JotUnderbar.aplo: -------------------------------------------------------------------------------- 1 | JotUnderbar←{ ⍝ ⍛ reverse composition/back-hook X f⍛g Y ←→ (f X) g Y ⋄ f⍛g Y ←→ (f Y) g Y, a.k.a. f⍨∘g⍨ and default arg 2 | 0::∆SIGNAL ⎕DMX 3 | ⍺←⊢ 4 | ncs←⎕NC↑'⍺' '⍺⍺' '⍵⍵' 5 | 3∧.≤1↓ncs:⍺ ⍵⍵⍨∘⍺⍺⍨⍵ 6 | 2 2 3≡ncs:(⍺∘⍵⍵)⍵ 7 | 3 2 3≡ncs:(⍺⍺∘⍵⍵)⍵ 8 | 2 3 2≡ncs:(⍺⍺∘⍺)⍵ 9 | 3 3 2≡ncs:(⍺⍺∘⍵⍵)⍵ 10 | ⎕SIGNAL⊂('EN' 2)('Message' 'At least one function operand required') 11 | } 12 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2022 Adám Brudzewsky 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 | -------------------------------------------------------------------------------- /LeftShoe.aplf: -------------------------------------------------------------------------------- 1 | LeftShoe←{ ⍝ ⊂ with partitioning along multiple leading axes 2 | 0::∆SIGNAL ⎕DMX 3 | 0=⎕NC'⍺':⊂⍵ 4 | 1≥|≡⍺:⍺⊂⍵ 5 | rank←≢⍴⍵ 6 | ⍬≡⍴⍺:(rank⍴⍺)∇ ⍵ ⍝ (⊂A1)⊂B 7 | pairs←⌽⍺,⍥⊂¨(≢⍺)↑⍳rank 8 | ⊃(⊃⍤0{⍵⊂[⊃⌽⍺]⍨⊃⍺}¨)/⊂¨pairs,⊂⍵ 9 | } 10 | -------------------------------------------------------------------------------- /LeftShoeUnderbar.aplf: -------------------------------------------------------------------------------- 1 | LeftShoeUnderbar←{ ⍝ ⊆ with partitioning along multiple leading axes 2 | 0::∆SIGNAL ⎕DMX 3 | 0=⎕NC'⍺':⊆⍵ 4 | 1≥|≡⍺:⍺⊆⍵ 5 | rank←≢⍴⍵ 6 | ⍬≡⍴⍺:(rank⍴⍺)∇ ⍵ ⍝ (⊂A1)⊂B 7 | pairs←⌽⍺,⍥⊂¨(≢⍺)↑⍳rank 8 | ⊃(⊃⍤0{(m/2⊃⍬⍴⌽⍺) ⍝└──→⍺⍺←─────┐ 10 | Pad←⍵⍵⍉(T⊣)⍪⍵⍪(T⊢) ⍝ ┌⍺┐ ⌺ │ 11 | need←(1+e),1↓⍴⍵ ⍝ ┌─────⍵⍵──┐┘ 12 | a=0:(1↓need⍴0↑⍵)Pad(1↓need⍴0↑⊢⍵) ⍝ 0 0│1 2 3 4 5│0 0 Zero 13 | a=1:(1↓need⍴1↑⍵)Pad(1↓need⍴1↑⊖⍵) ⍝ 1 1│1 2 3 4 5│5 5 Replicate 14 | a=2:(⊖¯1↓need⍴⊢⍵)Pad(¯1↓need⍴⊖⍵) ⍝ 2 1│1 2 3 4 5│5 4 Reverse 15 | a=3:(⊖⊢1↓need⍴⊢⍵)Pad(⊢1↓need⍴⊖⍵) ⍝ 3 2│1 2 3 4 5│4 3 Mirror 16 | a=4:(⊖¯1↓need⍴⊖⍵)Pad(¯1↓need⍴⊢⍵) ⍝ 4 5│1 2 3 4 5│1 2 Wrap 17 | }(¯1⌽⍳≢⍴⍵)/(⌽extra,¨⍺⊣0),⊂⍵ ⍝ └────⍵────┘ 18 | 19 | hoods←(-extra)↓extra↓{⊂⍵}⌺⍵⍵⊢w 20 | monad←3∊⎕NC'⍺' 21 | monad∧⍵∨.>∘⍴⍨¯1+⊃↓⍵⍵:⎕SIGNAL⊂('EN'11)('Message' 'Would require padding both before and after') ⍝ monadic would be lossy 22 | masks←{⊂⍵∘{∨/[⍵]⍺}¨⌽⍳≢⍴⍵}⌺⍵⍵⊢∘1¨w 23 | masks(↓⍨∧↓⍨∘-)←2×extra 24 | masks←(+/∧\∘~)¨¨⍣monad⊢masks 25 | ⊃⍤0⊢masks ⍺⍺¨hoods 26 | } 27 | -------------------------------------------------------------------------------- /QuadEqual.aplo: -------------------------------------------------------------------------------- 1 | QuadEqual←{ ⍝ ⌸ allowing operand to be vocabulary (and then using {⊂⍵} as internal operand) 2 | ⍺←⊢ ⍝ 3 | 3=40 ⎕ATX'⍺⍺':⍺ ⍺⍺⌸⍵ ⍝ fn operand: current definition 4 | 3=40 ⎕ATX'⍺':⍵ ∇⍳≢⍵ ⍝ monadic 5 | 6 | ⎕IO←1 7 | uvoc←∪⍺⍺ 8 | mask←(≢uvoc)≥uvoc⍳⍺ ⍝ high-rank ∊ 9 | keys←uvoc⍪mask⌿⍺ 10 | values←mask⌿⍵ 11 | values⍴⍨←(≢uvoc)+@1⍴values ⍝ append filler values while guarding against NONCE ERRORs 12 | values⊖⍨←-(≢uvoc) ⍝ move them to front 13 | 14 | (1↓¨keys{⊂⍵}⌸values)[uvoc⍳⍺⍺] 15 | } 16 | -------------------------------------------------------------------------------- /QuestionMark.aplf: -------------------------------------------------------------------------------- 1 | QuestionMark←{ ⍝ ? Dyadic allows arrays and distribution 2 | 0::∆SIGNAL ⎕DMX 3 | m←0=⎕NC'⍺' 4 | sw←326≠⎕DR ⍵ 5 | m∧sw:?⍵ ⍝ monadic simple 6 | m:⍬∘∇¨⍵ ⍝ monadic nested 7 | 0≡⍥,⍵:?⍺⍴0 8 | sw:⍺⍴⎕IO+⍵∘⊤¨⍺?⍥(×/)⍵ 9 | (d s)←∊¨1 1⊂⍵ 10 | s(16808⌶)d ⍺ 11 | } 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # [Dyalog APL](https://www.dyalog.com/) Vision 2 | 3 | This is [my](https://apl.wiki/Adám_Brudzewsky) vision for a realistic development of core Dyalog APL, including extending the domains of existing primitives/quad-names, and adding a few new ones. Requires and extends Dyalog APL version 18.2. If Dyalog APL moves forward in ways that are incompatible with what is found here, the vision will be updated accordingly. This project should therefore not be relied on as stable. 4 | 5 | ### How to use 6 | 7 | You can easily play with these almost like you use normal Dyalog APL in a session: 8 | 9 | #### Initialisation 10 | 11 | From within Dyalog APL 18.2 or higher, enter `]get path/dyalog_vision` or to import directly from GitHub `]get https://github.com/abrudz/dyalog_vision` 12 | 13 | #### Running code 14 | 15 | You have three options: 16 | 17 | 1. Use the extensions directly with the glyph names, e.g. `4 1 dyalog_vision.RightShoeUnderbar ⎕A`. 18 | 2. Use `dyalog_vision.∆FIX` as a drop in for `⎕FIX`. 19 | 3. Use `dyalog_vision.⍙REPL #` to start a (limited) session where the glyphs work. Enter `→` to exit. 20 | 21 | ### Content 22 | 23 | * All scalar functions support [leading axis agreement](https://aplwiki.com/wiki/Leading_axis_agreement). 24 | 25 | * All set functions support arguments of any rank. 26 | 27 | * `⎕C` and monadic `⎕UCS` are scalar functions. 28 | 29 | * In addition, the following is included: 30 | 31 | | Name | Symbol | Type* | Extension | Examples | 32 | | ------------------------------------------- |:---------:|:-----:| ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- | -------------------------------------------------------------------------------------------------------------- | 33 | | [CircleDiaeresis](CircleDiaeresis.aplo) | `⍥` | 🔵 | ✅ Depth when right operand is array. This is similar to Rank (`⍤`) but applies at nesting level. | `f⍥0` applies `f` like a scalar function and `f⍥1` applies to flat subarrays. `f⍤1⍥1` applies to flat vectors. | 34 | | [DelDiaeresis](DelDiaeresis.aplo) | `⍢` | 🔺 | Under (a.k.a. Dual). Like `f⍥g` but conceptually inverts the right operand when done. If `g` is a selection function, it puts the data back where it came from | `-⍢(2 3∘⊃)` negates the 2nd element's 3rd element. | 35 | | [DelTilde](DelTilde.aplo) | `⍫` | 🔺 | Obverse; `⍺⍺` but with inverse `⍵⍵` | `×⍢(FFT⍫iFFT)` | 36 | | [DollarSign](DollarSign.aplf) | `$` | 🔺 | string enhancement ${1}:`1⊃⍺`, ${expr}:`⍎expr`, `\n`:JSON | `'Dyer' 'Bob'$'Hi, ${2} ${1}!`
`$'Hi, ${first} ${last}!`
`$'2×3=${2×3}'` | 37 | | [DownArrow](DownArrow.aplf) | `↓` | 🔵 | dyad allows long `⍺` | `0 1↓'abc'` gives `1 2⍴'bc'` | 38 | | [DownTack](DownTack.aplf) | `⊤` | ⚠ | `⊥⍣¯1` when left argument is scalar | `2⊤123` gives `1 1 1 1 0 1 1` | 39 | | [EpsilonUnderbar](EpsilonUnderbar.aplf) | `⍷` | 🔶 | monad: Type (like `∊` with `⎕ML←0`) | `⍷1'a'#` gives `0' '#`' | 40 | | [Equal](Equal.aplf) | `=` | 🔶 | monad: Rank (`≢⍴`) | `=10 20 30` gives `1`' | 41 | | [GreaterOrEqual](GreaterOrEqual.aplf) | `≥` | 🔵 | monad: sort descending | `≥3 1 4 1 5` gives `5 4 3 1 1` | 42 | | [GreaterThan](GreaterThan.aplf) | `>` | 🔵 | monad: Join | `>2 2⍴⍪¨1 2 3 4` gives `2 2⍴1 2 3 4` | 43 | | [JotUnderbar](JotUnderbar.aplo) | `⍛` | 🔺 | ✅ reverse composition `X f⍛g Y` is `(f X) g Y` and default argument | `⌽⍛≡` checks for palindromes.
`a-⍛↑b` takes the last `a` from `b`. | 44 | | [LeftShoe](LeftShoe.aplf) | `⊂` | 🔵 | dyad allows partitioning along multiple leading axes | `(⊂1 1)⊂matrix` separates out the first row and column. | 45 | | [LeftShoeUnderbar](LeftShoeUnderbar.aplf) | `⊆` | 🔵 | dyad allows partitioning along multiple leading axes | `(⊂1 0 1 1)⊆4 4⍴⎕A` splits off the first row and column, and removes the second. | 46 | | [LessOrEqual](LessOrEqual.aplf) | `≤` | 🔵 | monad: sort ascending | `≤3 1 4 1 5` gives `1 1 3 4 5` | 47 | | [LessThan](LessOrEqual.aplf) | `<` | 🔵 | monad: Major Cells | `<2 2 2⍴⎕A` gives `(2 2⍴'ABCD')(2 2⍴'EFGH')` | 48 | | [QuadEqual](QuadEqual.aplo) | `⌸` | 🔵 | allow array operand to be vocabulary (then uses `{⊂⍵}` as internal operand) | `≢¨'ACGT'⌸'ATT-ACA'` gives `3 1 0 2` | 49 | | [QuadDiamond](QuadDiamond.aplo) | `⌺` | 🔶 | auto-extended `⍵⍵`, allows small `⍵`, optional edge spec(s) ([0:Zero; 1:Repl; 2:Rev; 3:Mirror; 4:Wrap]([http://web.science.mq.edu.au/~len/preprint/hamey-dicta2015-functional-border.pdf#page=3](https://web.archive.org/web/20220709033454/http://web.science.mq.edu.au/~len/preprint/hamey-dicta2015-functional-border.pdf#page=3)); -:Twist) with masks as operand's `⍺` | Life on a cylinder: `0 4 Life⌺3 3` | 50 | | [QuestionMark](QuestionMark.aplf) | `?` | 🔵 | dyadic allows `⍺` to be any shape (not just vector shape) and `⍵` is shape of array to select indices from | `3 5?4 13` deals 3 hands of 5 cards from deck of 4 suits from A to K | 51 | | [Rho](Rho.aplf) | `⍴` | 🔵 | dyad: negatives reverse axis, `0.5` auto-size rounding down, `1.5` auto-size rounding up, `2.5` auto-size with padding | Reshape into two columns: `0.5 2⍴data` | 52 | | [RightShoeUnderbar](RightShoeUnderbar.aplf) | `⊇` | 🔺 | monad: last (`⊃⌽,⍵`)
✅ dyad: select (`⌷⍨∘⊃⍨⍤0 99`) | `3 1 2⊇'abc'` gives `'cab'` | 53 | | [Root](Root.dyalog) | `√` | 🔺 | (Square) Root | `√25` gives `5`
`3√27 gives 3` | 54 | | [UpArrow](UpArrow.aplf) | `↑` | 🔵 | allows long `⍺` | `2 3↑4 5` gives `2 3⍴4 5 0 0 0 0` | 55 | | [Vel](Vel.aplf) | `∨` | 🔶 | monad: demote (`,[⍳2]`) | `∨2 3 4⍴⎕A` gives `6 4⍴⎕A` | 56 | | [Wedge](Wedge.aplf) | `∧` | 🔶 | monad: promote (`⍵⍴⍨1,⍴⍵`) | `'ABC'⍪⍥∧'DEF'` gives `2 3⍴⎕A` | 57 | | [∆EM](∆EM.aplf) | `⎕EM` | 🔵 | Self-inverse `⎕EM` | `⎕EM'RANK ERROR' 'WS FULL'` gives `4 1` | 58 | | [∆NG](∆NG.aplf) | `⎕NG` | 🔺 | Name Get | `ref⎕NG'Bea' 'Abe'` | 59 | | [∆NS](∆NS.aplf) | `⎕NS` | 🔵 | Accepts ref left arg. Name Set: The list of values to copy into the new/target namespace can have 2-element name-value vectors, setting the name to the given value | `ref←⎕NS('Abe' 10)('Bea' 12)`
`ref⎕NS⊂'Carl' 8` | 60 | | [∆NV](∆NV.aplf) | `⎕NV` | 🔺 | Names and Values | `ref⎕NV -2 9 | 61 | | [∆SIGNAL](∆signal.aplf) | `⎕SIGNAL` | 🔵 | Allows `⎕DMX`-style ref argument | `⎕SIGNAL ⎕DMX` | 62 | 63 | \* 🔺 new feature 🔶 added valence 🔵 expanded domain ⚠ breaking change ✅ scheduled for 20.0 64 | -------------------------------------------------------------------------------- /Rho.aplf: -------------------------------------------------------------------------------- 1 | Rho←{ ⍝ ⍴ autosize: 0.5 (shorten) 1.5 (recycle) 2.5 (pad) and allowing reversal of axis by negation of length 2 | 0::∆SIGNAL ⎕DMX 3 | 0=⎕NC'⍺':⍴⍵ ⍝ monadic case 4 | m←⍺≠⌊⍺ ⍝ find the special dimension, if any 5 | 1<+/m:⎕SIGNAL⊂('EN' 11)('Message' 'At most one shape element can be fractional') 6 | 3<|m+.×⍺:⎕SIGNAL⊂('EN' 11)('Message' 'The fractional shape element must be between ¯3 and 3') 7 | n←(≢,⍵)÷×/(~m)/|⍺ ⍝ the divisor of the shape 8 | t←|⊃⍬⍴m/⍺ 9 | n←⌈⌊⍣(0.5=t)⊢n 10 | s←n@{m}|⍺ 11 | z←s××⍺ 12 | ⊃{(⌽[|⍺]⍣(⍺<0))⍵}/((⍳⍤≢××)z),⊂(|z)⍴(×/s)↑⍣(2.5=t),⍵ 13 | } 14 | -------------------------------------------------------------------------------- /RightShoeUnderbar.aplf: -------------------------------------------------------------------------------- 1 | RightShoeUnderbar←{ ⍝ ⊇ select/last 2 | 0::∆SIGNAL ⎕DMX 3 | 0=⎕NC'⍺':⊃⍬⍴⌽,⍵ 4 | 0::⎕SIGNAL 5(⊢-=)⎕EN 5 | 1≥|≡⍺:⍵⌷⍨⊂⍺ 6 | { 7 | 1≥|≡⍺:⍺⌷⍵ 8 | ⊃⍵[⊂⍺] 9 | }∘⍵¨⍺ 10 | } 11 | -------------------------------------------------------------------------------- /Root.aplf: -------------------------------------------------------------------------------- 1 | Root←{ ⍝ √ (square) root 2 | 0::∆SIGNAL ⎕DMX 3 | ⍺←2 4 | ⍵*⍙LA÷⍺ 5 | } 6 | -------------------------------------------------------------------------------- /Star.aplf: -------------------------------------------------------------------------------- 1 | f←Star ⍝ * 2 | f←*⍙LA 3 | -------------------------------------------------------------------------------- /Stile.aplf: -------------------------------------------------------------------------------- 1 | f←Stile ⍝ | 2 | f←|⍙LA 3 | -------------------------------------------------------------------------------- /Tilde.aplf: -------------------------------------------------------------------------------- 1 | Tilde←{ ⍝ ~ generalised to major cells 2 | 0::∆SIGNAL ⎕DMX 3 | 0=⎕NC'⍺':~⍵ ⍝ monadic case 4 | ↑(⊂⍤¯1⊢⍺)~⊂⍤(0⌈¯1+≢⍴⍺)⊢⍵ 5 | } 6 | -------------------------------------------------------------------------------- /Times.aplf: -------------------------------------------------------------------------------- 1 | f←Times ⍝ × 2 | f←×⍙LA 3 | -------------------------------------------------------------------------------- /Unequal.aplf: -------------------------------------------------------------------------------- 1 | f←Unequal ⍝ ≠ 2 | f←≠⍙LA 3 | -------------------------------------------------------------------------------- /UpArrow.aplf: -------------------------------------------------------------------------------- 1 | UpArrow←{ ⍝ ↑ which allows long ⍺ even for non-scalars 2 | 0::∆SIGNAL ⎕DMX 3 | 0=⎕NC'⍺':↑⍵ 4 | s←⍴⍵ 5 | l←≢¨⍺ s 6 | ≤/l:⍺↑⍵ 7 | t←-⍬⍴l 8 | ⍺↑⍵⍴⍨t↑s,⍨1⊣¨⍺ 9 | } 10 | -------------------------------------------------------------------------------- /UpShoe.aplf: -------------------------------------------------------------------------------- 1 | UpShoe←{ ⍝ ∩ for any rank 2 | 0::∆SIGNAL ⎕DMX 3 | ⊃⍤0⊢(⊂⍤¯1⊢⍺)∩⊂⍤(0⌈¯1+≢⍴⍺)⊢⍵ 4 | } 5 | -------------------------------------------------------------------------------- /Upstile.aplf: -------------------------------------------------------------------------------- 1 | f←Upstile ⍝ ⌈ 2 | f←⌈⍙LA 3 | -------------------------------------------------------------------------------- /Vel.aplf: -------------------------------------------------------------------------------- 1 | Vel←{ ⍝ ∨ with demote 2 | 0::∆SIGNAL ⎕DMX 3 | 0≠⎕NC'⍺':⍺∨⍙LA ⍵ 4 | 1≥≢⍴⍵:⍬⍴⍵ 5 | ,[⍳2]⍵ 6 | } 7 | -------------------------------------------------------------------------------- /Wedge.aplf: -------------------------------------------------------------------------------- 1 | Wedge←{ ⍝ ∧ with promote 2 | 0::∆SIGNAL ⎕DMX 3 | 0=⎕NC'⍺':⍵⍴⍨1,⍴⍵ 4 | ⍺∨⍙LA ⍵ 5 | } 6 | -------------------------------------------------------------------------------- /apl-dyalog-vision: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | if [[ "$LD_PRELOAD" ]]; then 4 | unset LD_PRELOAD 5 | exec "$0" "$@" 6 | fi 7 | 8 | export DYALOG=${DYALOG:-$(ls -d /opt/mdyalog/*/64/unicode | tail -1)} 9 | export FLAGS=${FLAGS--script} 10 | export MAXWS=128M WSPATH=$DYALOG/ws 11 | 12 | { 13 | echo :namespace 14 | cat .code.tio 15 | echo 16 | echo :endnamespace 17 | } > ~/.bin.tio.dyalog 18 | 19 | { 20 | echo "⎕PW←32767" 21 | echo "'#'⎕NS('FIX'⍎⍨0⎕FIX'file:///opt/apl-dyalog-vision/vision.dyalog')'file://$HOME/.bin.tio.dyalog'" 22 | cat .input.tio 23 | echo 24 | } | $DYALOG/dyalog $FLAGS "$@" 25 | -------------------------------------------------------------------------------- /languages.json: -------------------------------------------------------------------------------- 1 | "apl-vision": { 2 | "categories": [ 3 | "practical" 4 | ], 5 | "encoding": "SBCS", 6 | "link": "https://github.com/abrudz/dyalog-vision", 7 | "name": "APL (Dyalog Vision)", 8 | "prettify": "apl", 9 | "tests": { 10 | "helloWorld": { 11 | "request": [ 12 | { 13 | "command": "F", 14 | "payload": { 15 | ".code.tio": "⎕←'Hello, World!'" 16 | } 17 | } 18 | ], 19 | "response": "Hello, World!" 20 | } 21 | }, 22 | "update": "git" 23 | }, 24 | -------------------------------------------------------------------------------- /∆C.aplf: -------------------------------------------------------------------------------- 1 | ∆C←{ ⍝ ⎕C scalar 2 | 0::∆SIGNAL ⎕DMX 3 | ⍺←¯3 4 | 0≡⍺:⍵ 5 | 0=≡⍺:⍺ ⎕C ⍵ 6 | ⍺ ∇ CircleDiaeresis 0 ⍙LA ⍵ 7 | } 8 | -------------------------------------------------------------------------------- /∆EM.aplf: -------------------------------------------------------------------------------- 1 | ∆EM←{ ⍝ ⎕EM self-inverse 2 | ⎕IO←0 3 | ⍺←⎕EM⍳32768 4 | dr←⎕DR ⍵ 5 | dr=326:⍺∘∇¨⍵ 6 | 11::⎕SIGNAL⊂('EN' 11)('Message' 'Error number must be integer') 7 | 2|dr:⎕EM ⍵ 8 | ⍺∊⍨⊂⍵:⍺⍳⊂⍵ 9 | ⎕SIGNAL⊂('EN' 11)('Message' 'Invalid error message') 10 | } 11 | -------------------------------------------------------------------------------- /∆FIX.aplf: -------------------------------------------------------------------------------- 1 | ∆FIX←{ ⍝ ⎕FIX 2 | 0::∆SIGNAL ⎕DMX 3 | ⍺←1 4 | 1≥|≡⍵:⍺ ∇⊃⍬⍴⎕NGET('file://'(⊃⍤⍷↓⊢)⍵)1 5 | names←⎕NL-3 4 6 | glyphs←(⊃⍬∘⍴)¨'⍝ (\W\S*)'⎕S'\1'¨(⊃⍬∘⍴)∘⎕NR¨names 7 | ⍺(⊃⎕RSI).⎕FIX glyphs ⍙To(⎕THIS,⍥⍕¨'.',¨names)⊢⍵ 8 | } 9 | -------------------------------------------------------------------------------- /∆NG.aplf: -------------------------------------------------------------------------------- 1 | ∆NG←{ ⍝ ⎕NG ─ Name Get with optional fall-back values 2 | 3 | ⍝ LEFT ARG specifies where to extract values from: 4 | ⍝ (nothing) ⍝ the current namespace 5 | ⍝ ref ⍝ an existing namespace 6 | ⍝ name ⍝ a existing namespace of this name 7 | 8 | ⍝ RIGHT ARG specifies which values to extract: 9 | ⍝ (empty vector) ⍝ nothing 10 | ⍝ name1 ⍝ value of "name1" 11 | ⍝ name1 name2 ⍝ values of "name1" and "name2" 12 | ⍝ ↑name1 name2 ⍝ values of "name1" and "name2" 13 | ⍝ ⊂name1 ⍝ ⊂value of "name1" 14 | ⍝ ⊂name1 value1 ⍝ ⊂value of "name1" but "value1" if absent 15 | ⍝ (name1 value1)name2 ⍝ value of "name1" but "value1" if absent, and value of "name2" 16 | ⍝ (name1 value1)(⊂name2) ⍝ value of "name1" but "value1" if absent, and value of "name2" 17 | ⍝ (name1 value1)(name2 value2) ⍝ value of "name1" but "value1" if absent, and value of "name2" but "value2" if absent 18 | ⍝ (↑name1 value1)(name2 value2) ⍝ value of "name1" but "value1" if absent, and value of "name2" but "value2" if absent 19 | 20 | ⍝ RESULT: 21 | ⍝ 0⍴⊂'' if right argument is empty 22 | ⍝ values otherwise 23 | 24 | ⎕ML←1 25 | 3≤≢⍴⍵:⎕SIGNAL 4 26 | 0=≢⍵:0⍴⊂'' 27 | parent←⊃⎕RSI 28 | ⍺←parent ⍝ ensure dyadic 29 | (String ⍺)∧9=parent.⎕NC⍕⍺:⍵ ∇⍨⍎⍺ ⍝ ensure ref 30 | ∧/2=≢¨⍵(⍴⊃⍬⍴⍵):⍺ ∇⊃{↓⍉⊃⍤0⊢(↓⍺)⍵}/⍵ ⍝ ensure name-value pairs 31 | 2=≢⍴⍵:⍺ ∇↓⍵ ⍝ ensure name list 32 | 33 | Exec←⍺.{ 34 | 0::⎕SIGNAL⊂⎕DMX.(('EN'EN)('Message'Message)) 35 | ¯1=⎕NC'⍵':⎕SIGNAL⊂('EN' 11)('Message'('Invalid name: ',⍵)) 36 | 0∧.=⎕NC'⍺'⍵:⎕SIGNAL⊂('EN' 6)('Message'('Undefined name: ',⍵)) 37 | 0=⎕NC ⍵:⍺ 38 | 1 2 8 9∊⍨⎕NC ⍵:⍎⍵ 39 | ⎕SIGNAL⊂('EN' 2)('Message'('Invalid value: ',⍵)) 40 | } 41 | String ⍵:Exec ⍵ 42 | ∧/String¨⍵:Exec¨⍵ 43 | ⍬≡⍴⍵:⊃⍬⍴Exec⍨/⊃⍬⍴⍵ 44 | 45 | Norm←{ 46 | String ⍵:⍵ 47 | ⍬≡⍴⍵:⊃⍬⍴⍵ 48 | ⊂⍵ 49 | } 50 | ∧/String∘(⊃⍬∘⍴)∘⊆¨⍵:⍺ ∇∘Norm¨⍵ 51 | 52 | ⎕SIGNAL 11 53 | } 54 | -------------------------------------------------------------------------------- /∆NS.aplf: -------------------------------------------------------------------------------- 1 | ∆NS←{ ⍝ ⎕NS ─ allows name-value pairs, names values, and ref left arg 2 | 3 | ⍝ LEFT ARG specifies what target to populate: 4 | ⍝ (nothing) ⍝ a new unnamed ns 5 | ⍝ ref ⍝ an existing namespace 6 | ⍝ name ⍝ a namespace of this name (create if missing) 7 | 8 | ⍝ RIGHT ARG specifies what to put into the target: 9 | ⍝ (empty vector) ⍝ nothing 10 | ⍝ name1 ⍝ copy "name1" from the calling space 11 | ⍝ name1 name2 ⍝ copy "name1" and "name2" from the calling space 12 | ⍝ ↑name1 name2 ⍝ copy "name1" and "name2" from the calling space 13 | ⍝ ⊂name1 ⍝ copy "name1" from the calling space 14 | ⍝ ⊂name1 value1 ⍝ "name1" with the value "value1" 15 | ⍝ (name1 value1)name2 ⍝ "name1" with the value "value1" and copy "name2" from the calling space 16 | ⍝ (name1 value1)(⊂name2) ⍝ "name1" wit the value "value1" and copy name2 from the calling space 17 | ⍝ (name1 value1)(name2 value2) ⍝ "name1" with the value "value1" and "name2" with the value "value2" 18 | ⍝ (↑name1 value1)(name2 value2) ⍝ "name1" with the value "value1" and "name2" with the value "value2" 19 | 20 | ⍝ RESULT: 21 | ⍝ shy name if left arg is name 22 | ⍝ not-shy ref otherwise 23 | 24 | ⎕ML←1 25 | ⍺←⊢ ⍝ default to unnamed namespace 26 | Return←{_←⍕⍵}⍣(2∊⎕NC'⍺') ⍝ shy string? 27 | parent←⊃⎕RSI 28 | NS←parent.⎕NS 29 | On←{ 30 | String ⍵:⍵ ⍺⍺ ⍺⍎⍵ 31 | String⊃⍤0⊢⍵:⍺(⊢⍺⍺⍎)↑⍵ 32 | ⍺⍺/⍵ 33 | } 34 | Ref←(326=⎕DR)∧0=≡ 35 | 36 | _∆NS←{ 37 | 0=⍺⍺.⎕NC'⍺':⍵ ∇⍨NS ⍬ ⍝ ensure dyadic 38 | Char ⍺:⍵ ∇⍨⍺⍺⍎⍺⊣⍺ NS ⍬ ⍝ ensure ref 39 | 0=≢⍵:⍺ ⍝ nothing to set 40 | ∧/2=≢¨⍵(⍴⊃⍵):⍺ ∇⊃⍬⍴{↓⍉⊃⍤0⊢(↓⍺)⍵}/⍵ ⍝ ensure name-value pairs 41 | 2=≢⍴⍵:⍺ ∇↓⍵ ⍝ ensure name list 42 | 43 | (String¨∧.∨Ref)⊆⍵:⍺⊣'ns'⎕NS ⍵⊣ns←⍺ ⍝ named ns 44 | Assign←⍺.{ 45 | 0 2 9∊⍨⎕NC ⍺:⍎⍺,'←⍵' 46 | ⎕SIGNAL⊂('EN' 6)('ENX' 7)('Message'('Can''t change nameclass on assignment: ',⍺)) 47 | } 48 | ⍺⊣⍺⍺ Assign On¨⊂⍣(2=|≡⍵)⊢⍵ 49 | } 50 | Return ⍺(parent _∆NS)⍵ 51 | } 52 | -------------------------------------------------------------------------------- /∆NV.aplf: -------------------------------------------------------------------------------- 1 | ∆NV←{ ⍝ ⎕NV ─ Name-Values 2 | ⍝ LEFT ARGUMENT: target namespace (default is calling space) 3 | ⍝ RIGHT ARGUMENT: like ⎕NL's 4 | ⍝ RESULT: 5 | ⍝ vector of name-value pairs if any element of right argument is negative 6 | ⍝ 2-element vector of names matrix and value vector otherwise 7 | 8 | ⎕ML←1 9 | ⍺←⊃⎕RSI 10 | target←⍺⍎'⎕THIS' ⍝ ensure ref 11 | nl←target.⎕NL ⍵ 12 | ∨/bad←3 4∊⍨target.⎕NC↑nl:⎕SIGNAL⊂('EN' 2)('Message'('Invalid value: ',' '~⍨⊃nl⌷⍨1⍳⍨bad)) 13 | nl≡0⍴⊂'':0⍴⊂'' 0 ⍝ no elements 14 | nl≡0 0⍴'':nl ⍬ ⍝ no rows 15 | ∨/0>⍵:target.{⍵(⍎⍵)}¨nl 16 | target.{⍵(⍎¨↓⍵)}nl 17 | } 18 | -------------------------------------------------------------------------------- /∆SIGNAL.aplf: -------------------------------------------------------------------------------- 1 | f←∆SIGNAL ⍝ ⎕SIGNAL that takes a ⎕DMX for re-signalling 2 | f←⎕SIGNAL{ 3 | 0::∆SIGNAL ⎕DMX 4 | 9≠⎕NC'⍵':⍵ 5 | dmx←⎕DMX 6 | _←'dmx'⎕NS ⍵ 7 | ⊂dmx.(('EN'EN)('EM'EM)('Message'(OSError{⍵,2⌽(×≢⊃⍬⍴2⌽⍺,⊂'')/'") ("',⊃⍬⍴2⌽⍺}Message))) 8 | } 9 | -------------------------------------------------------------------------------- /∆UCS.aplf: -------------------------------------------------------------------------------- 1 | ∆UCS←{ ⍝ ⎕UCS which is scalar when monadic 2 | 0::∆SIGNAL ⎕DMX 3 | 0≠⎕NC'⍺':⍺ ⎕UCS ⍵ ⍝ dyadic case 4 | 326≠⎕DR ⍵:⎕UCS ⍵ ⍝ shortcut if homogenous 5 | w⊣(∊w)←⎕UCS¨∊w←⍵ 6 | } 7 | -------------------------------------------------------------------------------- /⍙Execute.aplf: -------------------------------------------------------------------------------- 1 | ⍙Execute←{ 2 | names←⎕NL-3 4 3 | glyphs←(⊃⍬∘⍴)¨'⍝ (\W\S*)'⎕S'\1'¨(⊃⍬∘⍴)∘⎕NR¨names 4 | ⍺←⊃⎕RSI 5 | 85::⍬⊤⍬ 6 | 1 ⍺.(85⌶)glyphs ⍙To(⎕THIS,⍥⍕¨'.',¨names)⊢⍵ 7 | } 8 | -------------------------------------------------------------------------------- /⍙LA.aplo: -------------------------------------------------------------------------------- 1 | ⍙LA←{ ⍝ Leading Axis agreement 2 | 0::∆SIGNAL ⎕DMX 3 | 0=⎕NC'⍺':⍺⍺ ⍵ 4 | ⍺∧⍥(0=≡)⍵:⍺ ⍺⍺ ⍵ 5 | ⍺ ∇¨⍤(-⍺⌊⍥(≢⍴)⍵)⊢⍵ 6 | } 7 | -------------------------------------------------------------------------------- /⍙REPL.aplf: -------------------------------------------------------------------------------- 1 | {ns}←⍙REPL target 2 | ;pos;shorten;caret;code;from;to;valid;names;glyphs;input;v;Err 3 | names←⎕NL-3 4 4 | Err←{⍞←⍵,⎕UCS 13} 5 | 2022⌶⍣('W'=⊃⊃# ⎕WG'APLVersion')⊤⍨⍬ 6 | :If ×≢target 7 | ns←⍎(⍕target)⎕NS ⍬ 8 | :Else 9 | ns←⎕NS ⍬ 10 | :EndIf 11 | 12 | ⍞←'Dyalog APL/',⊃⊃v←# ⎕WG'APLVersion' 13 | ⍞←(⊃v)∩'-',⎕D 14 | Err' Version ',¯2↓2⊃v 15 | 16 | Err'Serial No : 123456' 17 | Err'Vision Edition' 18 | Err⊃'Ddd Mmm _D hh:mm:ss YYYY'(1200⌶)1 ⎕DT'J' 19 | 20 | glyphs←⊃¨'⍝ (\W\S*)'⎕S'\1'¨⊃∘⎕NR¨names 21 | valid←×≢¨glyphs 22 | names⌿⍨←valid 23 | glyphs⌿⍨←valid 24 | from←'''[^'']*''' '⍝.*',' ?'∘,¨⎕THIS,⍥⍕¨'.',¨names,¨⊂'\b ?' 25 | to←'&&',glyphs 26 | 27 | :While '→'≢⊃⌽' '~⍨input←⍞⊣⍞←6⍴''⊣⎕RTL←0 28 | ⎕CT ⎕DCT ⎕DIV ⎕IO ⎕FR ⎕PP ⎕RL←ns.(⎕CT ⎕DCT ⎕DIV ⎕IO ⎕FR ⎕PP ⎕RL) 29 | :Trap 0 30 | :If ']'≡⍬⍴input~' ' 31 | ⎕←⎕SE.UCMD input 32 | :ElseIf ')vision'≡⎕C input~' ' 33 | Err 1↓∊' ',¨glyphs 34 | :ElseIf ')'≡⍬⍴input~' ' 35 | ⎕←ns ⍙Execute'⎕'@(input⍳')')⊢input 36 | :Else 37 | ⎕←ns ⍙Execute input 38 | :EndIf 39 | :Else 40 | Err⍬(⊢↓⍨'⍎'=⍴)⎕DMX.(OSError{⍵,2⌽(×≢⊃⍬⍴2⌽⍺,⊂'')/'") ("',⊃⍬⍴2⌽⊆⍺}Message{⍵,⍺,⍨': '/⍨×≢⍺}⊃⍬⍴DM,⊂'') 41 | pos←'^'⍳⍨caret←⊃⍬⍴2⌽⎕DMX.DM 42 | shorten←11+(⊢-⍥≢from ⎕R to)pos↑code←⊃⍬⍴1⌽⎕DMX.DM 43 | Err' ',{(∨\' '≠⍵)/⍵}11↓from ⎕R to⊢code 44 | Err' ',shorten↓caret 45 | :EndTrap 46 | :EndWhile 47 | ⍝ns.⎕EX ⎕NL-3 4 48 | -------------------------------------------------------------------------------- /⍙To.aplo: -------------------------------------------------------------------------------- 1 | ⍙To←{ 2 | mask←×⊃∘⍴¨⍺⍺ 3 | 4 | fromIgnore←'''[^'']*''' '⍝.*' '`(.)' 5 | fromGlyphs←'⍣' '\W' '\w\b'⎕R' *⍣ *' '\\&' '&\\b'⊢mask/⍺⍺ 6 | from←fromIgnore,fromGlyphs 7 | 8 | toIgnore←'&' '&' '\1' 9 | toGlyphs←'^|$'⎕R' '⊢mask/⍵⍵ 10 | to←toIgnore,toGlyphs 11 | 12 | from ⎕R to⍠1⊢⍵ 13 | } 14 | -------------------------------------------------------------------------------- /⎕IO.apla: -------------------------------------------------------------------------------- 1 | 1 2 | -------------------------------------------------------------------------------- /⎕ML.apla: -------------------------------------------------------------------------------- 1 | 1 2 | --------------------------------------------------------------------------------