din←{                                   ⍝ Input of multi-line D-expression.

    {⎕FX ⍵}{                            ⍝ defined at lexically outer level.
        ⎕IO ⎕ML←0 1

        accm←{                          ⍝ accumulation of lines.
            0=level sig ⍵:⍺ ⍵           ⍝ outer level: finished.
            nextget prmt sig ⍵         ⍝ next input line.
            (,'→')next~' ':⍎'→'        ⍝ →: abort
            defn←⍺,⊂next                ⍝ accumulated definition.
            expr←⍵ join cm zap next     ⍝ accumulated expression.
            defnexpr                 ⍝ ... more lines.
        }                               ⍝ :: defn ∇ expr → defn expr

        prmt←{                          ⍝ tab-indented prompt.
            contnull or more ⍵         ⍝ continue at this level.
            tailcont⊃'}'tab            ⍝ close or continuation
            ((level)⍴⊂tab),tail      ⍝ indented prompt.
        }

        ask←{⍞⊣⍞←⍵}                     ⍝ ⍵-prompted input.
        or{(⍺⍺ ⍵)∨⍵⍵ ⍵}                ⍝ this or that.
        zap{(~⍺⍺ ⍵){⍺\⍺/⍵}⍵}           ⍝ blank ⍵ where ⍺.
        level←{⊃⌽depth ⍵,' '}           ⍝ current nesting level.
        depth←{⍵⌊¯1⌽⍵}∘{-⌿+\'{}'∘.=⍵}   ⍝ │·{a{'⍝'}c}⍝│ → 0 0 1 1 2 2 2 1 1 0 0
        qt←{⍵∧¯1⌽⍵}∘{≠\⍵=''''}          ⍝ │·{a{'⍝'}c}⍝│ → 0 0 0 0 0 1 0 0 0 0 0
        cm←∨\∘~∘('⍝'∘≠or qt)            ⍝ │·{a{'⍝'}c}⍝│ → 0 0 0 0 0 0 0 0 0 0 1
        dt←~∘('·'∘≠or cm or qt)         ⍝ │·{a{'⍝'}c}⍝│ → 1 0 0 0 0 0 0 0 0 0 0
        sigcm or qt zap                ⍝ │ {a{'⍝'}c}⍝│ → │ {a{' '}c}│
        edge←{'{}'∨.=2↑¯1⌽(⍵,⍺)~' '}    ⍝ ...{ or }...
        join←{⍺,(edge)↓'⋄',⍵}       ⍝ ⋄-separated segments.
        getdt zapask                  ⍝ input with blanked leading '·'s.
        lines←{⍵≠⊃⌽⍵}∘depth zap         ⍝ lines in current nested fn.
        sepr←{⍺{1↓¨(⍺=⍵)⊂⍵}⍺,⍵}         ⍝ ⍺-separated lines.
        segs←'⋄'∘seprlines             ⍝ ⋄-separated segments.
        more←{1∊'←:'∊⊃⌽segs ⍵}          ⍝ last line was assign or guard.
        null←{(⊃⌽'⋄',⍵~' ')∊'{⋄'}       ⍝ ignoring null line.
        align←{(4⌊+/∧\' '=⍵)↓⍵}         ⍝ defn lines without indentation.
        tab←'·   '                      ⍝ tab with white dot.

        init(cm zap)~' '             ⍝ defn name or null.
        asgn(×⍴init)/'←{'              ⍝ name←{
        headget tab,init,asgn          ⍝ initial line.
        ixprcm zap head                ⍝ initial expression.
        defn expr(,⊂head)accm ixpr     ⍝ following lines.
        name←⍺⍺ align¨defn              ⍝ external fix of function.
        ' '=⊃0⍴name:shyname            ⍝ success: shy result is name.
        0≡≢⍵:⍵⍵ expr                    ⍝ non-defn: exec of expression.
        1:shy←⍎'⍵⍵ expr ⋄ ⍵'            ⍝ derived fn defn
    }{0::⎕SIGNAL ⎕EN ⋄ ⍎⍵}⍵             ⍝ evaluated at lexically outer level.
}
code_colours

test script

Back to: notes

Back to: Workspaces