⍝ Evaluator for a subset of Scheme:

    s ← '((lambda (cons car cdr)'
    s,← '         (car  (cons 123 456)))'
    s,← ''
    s,← ' (lambda (x y) (lambda (i) (cond (i x) (else y))))'
    s,← ' (lambda (xy) (xy 0))'
    s,← ' (lambda (xy) (xy 1)))'

    lisp s
456

    lisp  '''(* 4 5)'
┌─┬─┬─┐
│*│4│5│
└─┴─┴─┘
                                                    ⍝  f→(x→x x)(x→f(y→(x x)y))
    Y ← '(\(f)((\(x)(x x))(\(x)(f(\(y)((x x)y))))))'            ⍝ fixpoint Y'

    fac ← '(\(f)(\(n)(cond((= n 0)1)(else(* n(f(- n 1)))))))'   ⍝ factorial
    lisp '((',Y,fac,')4)'
24
    ⍝ Ackermann:
    ack  ← '(\(a)(\(m)(\(n)(cond((= m 0)(+ n 1))'
    ack ,← '                    ((= n 0)((a(- m 1))1))'
    ack ,← '                    (else((a(- m 1))((a m)(- n 1))))))))'
    lisp'(((',Y,ack,')2)2)'
7
    ⍝ Fibonacci:
    fib ← '(\(f)(\(n)(cond((= n 0)0)((= n 1)1)(else(+(f(- n 1))(f(- n 2)))))))'

    rec←{'((',Y,⍺,')',⍵,')'}                    ⍝ Y applicator

    lisp¨ fib∘rec¨ ⎕d                           ⍝ fib¨ 0..9
0 1 1 2 3 5 8 13 21 34

    pdep ← {+\1 ¯1 0['()'⍳⍵]}                   ⍝ paren depth

    pchk←{0 ¯1↓1 0⌽' ',⍕↑pdep\⍵ ⍵}              ⍝ handy paren depth checker

    pchk Y
( \ ( f ) ( ( \ ( x ) ( x   x ) ) ( \ ( x ) ( f ( \ ( y ) ( ( x   x ) y ) ) ) ) ) )
 1 1 2 2 1 2 3 3 4 4 3 4 4 4 4 3 2 3 3 4 4 3 4 4 5 5 6 6 5 6 7 7 7 7 6 6 5 4 3 2 1 

    pic2←{                                      ⍝ 2D paren depth picture
        d←(⍵=')')+pdep ⍵            ⍝ depth
        ⊖d⊖⍵⍪((¯1+⌈/d),⍴⍵)⍴'·'      ⍝ pic
    }                         

    pic2 Y                                      ⍝ applicative order Y combinator
(\·······································)
··(f)(··································)·
······(\········)(\····················)··
········(x)(x x)···(x)(f··············)···
························(\···········)····
··························(y)(·····y)·····
······························(x x)·······
                                                ⍝ h→(x→h(x x))(x→h(x x))
    pic2 '(\(h)((\(x)(h(x x)))(\(x)(h(x x)))))' ⍝ normal order Y combinator
(\·································)
··(h)(····························)·
······(\···········)(\···········)··
········(x)(h·····)···(x)(h·····)···
·············(x x)·········(x x)····

    pic2 '(h→(x→h(x x))(x→h(x x)))'             ⍝ same again using → notation
(h→····················)
···(x→h·····)(x→h·····)·
·······(x x)·····(x x)··
                                                ⍝ h→(y→y y)(x→h(x x))
    pic2 '(\(h)((\(y)(y y))(\(x)(h(x x)))))'    ⍝ recoding of the above
(\······························)
··(h)(·························)·
······(\········)(\···········)··
········(y)(y y)···(x)(h·····)···
························(x x)····

    pic2 '(h→(y→y y)(x→h(x x)))'                ⍝ same again using → notation
(h→·················)
···(y→y y)(x→h·····)·
··············(x x)··

    svec ← (' (' '(')('lambda' '\')             ⍝ substitution vector.
    trim ← {(~'  '⍷⍵)/⍵}                        ⍝ without superfluous blanks.
    pic2 ↑subs/ svec,⊂trim s                    ⍝ Nick's example:
(·······························································································)
·(\·································)(\······························)(\··········)(\··········)·
···(cons car cdr)(car··············)···(x y)(\······················)···(xy)(xy 0)···(xy)(xy 1)··
·····················(cons 123 456)···········(i)(cond·············)·····························
······················································(i x)(else y)······························

⍝∇ lisp subs

Back to: code

Back to: Workspaces