defs←{                                      ⍝ ]defs with names.

    ⍺←⎕THIS                                 ⍝ target space: default: this space
    ⍺.{⍎⍺,'⍵'}{X←⍺⍺∘⊢                       ⍝ external ⍎ avoids name clashes

        nabs←{                              ⍝ name abstraction

            rdefs←{Ns Ks Ts Ds←↓⍉↑⍵         ⍝ reduced definitions
                lines←{⊃¯2↑1 1,⍴⍵}¨Ds       ⍝ number of lines in each defn
                targ←⍵∩(lines=1)/Ns         ⍝ target names
                drvs←{1=⊃¯2↑1 1,⍴⍵}¨Ds      ⍝ mask of derived fns and trains
                tupsdrvs/⍵                 ⍝ (name kind tree defn)-tuples
                deps←{|≡⊃⌽⍵}¨tups           ⍝ definition depths
                tvectups[⍋deps]            ⍝ tuples in depth order
                reds←⊃subs⍨/tvec,⊂⍬         ⍝ tuples with reduced definitions
                ∆N←⊃¨reds                   ⍝ names and definitions
                reds[∆N⍳⊆⍺∩∆N]              ⍝ defs in order of names ⍺
            }                               ⍝ :: NKTDs ← [N] ∇ NKTDs

            subs←{N K T D←⍵                 ⍝ names for subexpressions
                Ns Ks Ts Ds←↓⍉↑⍺            ⍝ already processed definitions
                hitsD in Ds                ⍝ defn in subexpressions
                ∆Ds(N)@hitsDs            ⍝ names for subexpressions
                ∆Ts(K)@hitsTs            ⍝ kind from name N
                (⊂⍵),↓⍉↑Ns Ks ∆Ts ∆Ds       ⍝ accumulated reduced defns
            }                               ⍝ :: NKTDs ← NKTDs ∇ N K T D

            in←{                            ⍝ paths to item ⍺ in ⍵
                D←|≡item←⍺                  ⍝ (depth of) sought item
                ⍬{                          ⍝ ⍺ is path
                    item≡⍵:,⊂⍺              ⍝ match: path
                    D≥|≡⍵:⍬                 ⍝ too shallow: no matches
                    paths←⍺∘,∘⊂¨⍳⍴⍵         ⍝ extended paths
                    ⊃,/,paths ∇¨⍵           ⍝ paths in subarrays of ⍵
                }⍵                          ⍝ ⍵ is array to be searched
            }                               ⍝ :: [path] ← array ∇ array

            uniq←{Ns Ks Ts Ds←↓⍉↑⍵          ⍝ filtering out duplicate defns
                grps←⊢∘⊂⌸Ds                 ⍝ groups of identical defns
                uniqs←∊(1=≢¨grps)/grps      ⍝ indices of unique values
                uvals(⍳≢Ns)uniqs          ⍝ mask of unique values
                uvals/⍵                     ⍝ unique definitions
            }                               ⍝ :: NKTDs ← ∇ NKTDs

            nktds←{                         ⍝ (name kind tree defn) tuples
                Ns←~∘' '¨↓'⎕nl'X 2 3 4 9    ⍝ all names
                Ks←2@(9=⊢)'⎕nc'XNs         ⍝ all kinds (2 3 4)
                dsKs prep¨'⎕cr¨'X Ns       ⍝ all defns of fns and ops
                v←1↓'⍎⍕'X 0,(Ks=2)/Ns       ⍝ values of named arrays (vars)
                Dsv@{Ks=2}⊢ds              ⍝ all definitions
                Tsktree¨Ds                 ⍝ kind-trees
                sizes←≢∘∊¨Ds                ⍝ size of each defn
                smallsizes≤⌈/sizes[Ns⍳⍵]   ⍝ defns small enough for contenders
                small/↓⍉↑Ns Ks Ts Ds        ⍝ names kinds trees defns
            }                               ⍝ :: NKTDs ← ∇ [N]

            prep←{                          ⍝ preparation of ⎕cr forms
                ⍺≡2:⍵                       ⍝ array operand: ignore
                6=10|⎕DR ⍵:⍺ ∇¨⍵            ⍝ nested: perhaps eg: 1+⊢
                1<⊃¯2↑1 1,⍴⍵:⍵              ⍝ multi-line fn: ignore
                1 1≡(≡⍵),⍴⍵:⊃⍵              ⍝ named primitive fn: disclose
                mask←'←{'⍷⍵                 ⍝ named dfn←{... ?
                ~∨/mask:⍵                   ⍝ nope: ignore
                1↓,(,∨\mask)/⍵              ⍝ without 'name←'
            }                               ⍝ :: D ← ∇ D

            ktree←{                         ⍝ kind-tree: array:2 fun:3 op:4

                kind←{                      ⍝ kind of expr such as '{⍺⍺ ⍵}'
                    ~0=10|⎕DR ⍵:2           ⍝ not a char: array
                    0⊣⎕EX zz←'zz':          ⍝ make _local_ name zz
                    2 6::2                  ⍝ undefined: array
                    ⍎'zz←',(,⍵),'⋄0':       ⍝ assign name to expr
                    ⊃⎕NC'zz'                ⍝ name class: 2 3 4
                }                           ⍝ :: K ← ∇ D

                {                           ⍝ kind classification ---------.
                    0≠10|⎕DR ⍵:2            ⍝ not char type: array         |
                    (⊂⍵)∊'.∘⍣@⌺⍠⍤[':4       ⍝ primitive dyadic op: 4
                    (⊂⍵)∊'/⌿\⍀':1           ⍝ primitive hybrid: =1 for now
                    (⊂⎕CR ⍵)∊,¨'/⌿\⍀':1     ⍝ named hybrid
                    (⊂⍵)∊'←→;':2            ⍝ must be an array operand
                    4=⎕NC ⍵:4               ⍝ named operator
                    kind ⍵                  ⍝ expression class
                }{                          ⍝ derv traversal --------------.
                    0=≡⍵:⍺⍺ ⍵               ⍝ atom: classification         |
                    h←{⍵+(⍵∊1)×(≢⍵)↑2 3}    ⍝ hybrid resolution: 1 → 3 or 4
                    o←{⍵≡4 4:2 4 ⋄ ⍵}       ⍝ for Aaron's dop3←'∘'_set
                    6=10|⎕DR ⍵:o h ∇¨⍵      ⍝ nested: traversal
                    '{'≡⊃⍵:kind ⍵           ⍝ unnamed dfn/op
                    1∊'←{'⍷⍵:kind ⍵         ⍝ named dfn/op
                    1<⍴⍴⍵:2                 ⍝ high rank => array
                    1=≢⍵:o h ∇⊃⍵            ⍝ ⎕cr of primitive token
                    3<≢⍵:2                  ⍝ too long for derv => array
                    (kind)∊0 2:2          ⍝ character literal
                    o h ∇¨⍵                 ⍝ traversal of subdervs
                }⍵                          ⍝ for derv tree ⍵
            }                               ⍝ :: T ← ∇ D

            ⍵ rdefs uniq nktds ⍵            ⍝ reduced definitions
        }                                   ⍝ :: NKTDs ← ∇ N

        linear←{                            ⍝ parenthesised expression ⍵

            expr←{T D←⍵                     ⍝ expression from nested defns
                T≡2:crep D                  ⍝ array operand
                0≡≡T:⍕,D                    ⍝ single item: format
                pp←{∊⍺ 1 ⍺/'('⍵')'}         ⍝ parenthesised if ⍺
                rop(T)↑0 0 1              ⍝ mask for right operand
                4≡⊃1↓T:⍺ ppjoin/rop ∇¨↓⍉↑⍵ ⍝ oper: joined with operands
                derv←{0≡≡⍵:0 ⋄ 4≡⊃1↓⍵}      ⍝ is a derived fn?
                W(~((0≡≡)¨∨derv¨)¯1↓T),0   ⍝ mask of weak bindings
                S←,∘0∧.≡∘2 2↑2 adj/T        ⍝ mask of strong bindings
                ⍺ ppjoin/(WS)∇¨↓⍉↑⍵       ⍝ joined with parentheses ⍺
            }                               ⍝ :: ⍞ ← parens ∇ T D

            crep←{                          ⍝ char rep of array
                fmt←⎕SE.Dyalog.Utils.repObj ⍝ Utils.repObj: char rep array
                80≠⎕DR' ':fmt ⍵             ⍝ non-unicode APL
                1<⍴⍴⍵:fmt ⍵                 ⍝ higher rank
                1<≢⎕FMT ⍵:fmt ⍵             ⍝ multi-line, embedded newline?
                1<|≡⍵:fmt ⍵                 ⍝ nested
                1=2|⎕DR ⍵:⍕⍵                ⍝ numeric literal
                0≠10|⎕DR ⍵:fmt ⍵            ⍝ not char literal
                2='⎕nc'X ⍵:⍵                ⍝ named array
                '''',((1+⍵='''')/⍵),''''    ⍝ quotes: don't → 'don''t'
            }                               ⍝ :: ⍞ ← ∇ array

            join←{                          ⍝ join of expressions
                nchs←{(0≤⎕NC⍪⍵)/⍵}⎕AV~'⍺⍵∇' ⍝ start-of-name chars
                nums←'¯',⎕D,nchs            ⍝ word-separation chars
                gap←∧/(adj)nchs,nums   ⍝ gap required between words ⍺ ⍵
                ⍺,(gap/' '),⍵               ⍝ ⍺-separated sections
            }                               ⍝ :: expr ← expr ∇ expr

            adj(⊢/⊣),(⊣/⊢)                 ⍝ adjoining: last of ⍺, first of ⍵

            0 expr 2↓⍵                      ⍝ expression from defns
        }                                   ⍝ :: ⍞ ← ∇ N K T D

        NKTDsnabs,~∘' '¨↓↑⍵                ⍝ (name kind tree defn) tuples
        exprs←↑linear¨NKTDs                 ⍝ matrix of parenthesised exprs
        Ns←⊃¨NKTDs                          ⍝ names
        (⌽↑⌽¨Ns,¨⊂' ← '),exprs              ⍝ formatted defns "name ← defn"
    }⍵                                      ⍝ :: cmat ← (∇ names) names

    ⍝ NKTDs := [N K T D]                    ⍝ vector of 4-tuples
    ⍝     N := ⍞                            ⍝ Name: char vector
    ⍝     K := 2|3|4                        ⍝ Kind: (class)
    ⍝     T := K | [T]                      ⍝ Tree: nested kinds
    ⍝     D := ' | [D]                      ⍝ Defn: nested ⎕CR vectors
}
code_colours

test script

Back to: notes

Back to: Workspaces