```⍝ 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)······························

Back to: code

Back to: Workspaces
```