⍝ Brainfuck:

∆←{{1:}⍙,←⍵,⎕ucs 13}    ⍝ accumulate into ⍙ buffer.
⍙←''                    ⍝ null accumulation buffer.

⍝ Here are macros ↓ and ↑ for pushing (down) and popping (up) stack items.
⍝
⍝   ┬─┬─┼A┬─┬─┬─┬─┬─┬─
⍝   │c b│ │ │ │ │ │ │ ∘∘∘
⍝   ┴─┴─┼0┴1┴2┴3┴4┴5┴─

∆'↓=(           '   ⍝ push:                     S←A,S ⋄ A←0
∆'  ←=[-/<+/>]  '   ⍝   ← move ⍺ cells left (local macro defn).
∆'  →=[-/>+/<]  '   ⍝   → move ⍺ cells right    ..  ..  ..
∆'  +           '   ⍝ increment value to be pushed
∆'  4←          '   ⍝ copy A to t in stack base (S.t)
∆'  <<<         '   ⍝ go (move BF's memory pointer) to S
∆'  [< 2← <]    '   ⍝ move S.t to (T+1).t, where (T+1) is left of T
∆'  < 1→ >      '   ⍝ move (T+1).t to (T+1).v
∆'  [>>]        '   ⍝ skip back to (S-1).v (aka b)
∆'  >           '   ⍝ go to A
∆')             '

∆'↑=(           '   ⍝ pop:                      A+←↑S ⋄ S←1↓A
∆'  →=[-/>+/<]  '   ⍝   → move ⍺ cells right
∆'  <<<         '   ⍝ go to S
∆'  [<<] >>     '   ⍝ go to T
∆'  1→          '   ⍝ move T.v to (T-1).t
∆'  >>          '   ⍝ go to T-1
∆'  [< 2→ > >>] '   ⍝ move value down stack to (S-1).t (aka c)
∆'  <           '   ⍝ go to c
∆'  2→          '   ⍝ move c to A
∆'  >>          '   ⍝ go to A
∆'  -           '   ⍝ decrement popped value.
∆')             '

stk ⍙←⍙ ''          ⍝ stack macros ↓ and ↑.

⍝ Macros ; and : code the standard BF sequences that convert between character
⍝ digits '0'-'9' and their numeric equivalents, by adding or subtracting '0':

∆';=(           '   ⍝ ; input digit   A←⎕
∆'  ,           '   ⍝   input char '0'-'9'.
∆'  ∆=/-        '   ⍝   minus.
∆'  <6∆[+>8∆<]> '   ⍝   subtract '0'=48.
∆')'

∆':=(           '   ⍝ : output digit  ⎕←A
∆'  ∆=/+        '   ⍝   plus.
∆'  <6∆[->8∆<]> '   ⍝   add '0'=48.
∆'  .           '   ⍝   output char '0'-'9'.
∆')             '

io ⍙←⍙ ''           ⍝ numeric I/O macros ; and :.

⍝ Macros ≡, → and ← implement directly-addressable or random-access BF memory:
⍝
⍝      ┬─┬─┼A┬─┬─┬─┬─┬─┬─
⍝      │c b│ │ │ │ │ │ │ ∘∘∘
⍝      ┴─┴─┼0┴1┴2┴3┴4┴5┴─

∆'≡=(           '   ⍝ ≡ copy <n> to A.  eg: n≡
∆'  />          '   ⍝   go to <n>
∆'  [-/<+<+>/>] '   ⍝   move <n> to A and b.
∆'  /<          '   ⍝   go to A.
∆'  <           '   ⍝   go to b.
∆'  [->/>+/<<]  '   ⍝   move b to <n>
∆'  >           '   ⍝   go to A.
∆')             '

∆'→=(           '   ⍝ → move <n> to A.  eg: n→
∆'  />          '   ⍝   go to <n>
∆'  [-/<+/>]    '   ⍝   move <n> to A.
∆'  /<          '   ⍝   go to A.
∆')             '

∆'←=(           '   ⍝ ← move A to <n>   eg: n←
∆'  />[-]/<     '   ⍝   clear <n>
∆'  [-/>+/<]    '   ⍝   move A to <n>
∆')             '

ram ⍙←⍙ ''          ⍝ directly-addressable memory macros ≡, → and ←.

⍝ and finally, here are {, ⋄ and }, which give us an if-else-fi control struct:

∆'  {=<+>[<->   '   ⍝ {  if A≠0
∆'  ⋄=<]<[->    '   ⍝ ⋄  else
∆'  }=<<]>>     '   ⍝ }  fi

if ⍙←⍙ ''           ⍝ if-else-fi macros { ⋄ }.

⍝ Example:

dark ← ∩∘'[]<>+-,.'         ⍝ without white space.

dark mac ram,io, 'm=1 n=2 ;m← ;n←'  ⍝ BF: store input digits at [1] and [2].
,<------[+>--------<]>>[-]<[->+<],<------[+>--------<]>>>[-]<<[->>+<<]

⍝ Now, at last, Ackermann's function:

∆'  m=1 n=2             '   ⍝   declare posn of local vars.
⍝   ∆'  ;m← ;n←             '   ⍝   input m and n
∆'  m→+m←   n→+n←       '   ⍝   n m+←1
∆'  ↓                   '   ⍝   push 0
∆'  m≡[                 '   ⍝   repeat
∆'  ·   -{              '   ⍝   ·   if 0≠m-1
∆'  ·   ·   ↓           '   ⍝           push m-1
∆'  ·   ·   n≡-{[-]     '   ⍝   ·   ·   if 0≠n-1
∆'  ·   ·   ·   m→ ↓    '   ⍝   ·   ·   ·   push m
∆'  ·   ·   ·   n→-↓    '   ⍝   ·   ·   ·   push n-1
∆'  ·   ·   ⋄           '   ⍝   ·   ·   else
∆'  ·   ·   ·    ++↓    '   ⍝   ·   ·   ·   push 1+1
∆'  ·   ·   }           '   ⍝   ·   ·   fi
∆'  ·   ⋄               '   ⍝   ·   else
∆'  ·   ·   n→+↓        '   ⍝   ·   ·   push n+1
∆'  ·   }               '   ⍝   ·   fi
∆'  ·   ↑n←             '   ⍝   ·   pop n
∆'  ·   ↑m←             '   ⍝   ·   pop m
∆'  m≡]                 '   ⍝   while stacked items
∆'  n→-                 '   ⍝   result is n-1
⍝   ∆'  :                   '   ⍝   output result.
ack ⍙←⍙ ''

opt ← {↑{({⍵⍱¯1⌽⍵}⍺⍷⍵)/⍵}⍣≡/'><' '<>'⍵}     ⍝ cancelling >< pairs removed.

ack ← opt dark mac if,io,ram,stk, ack       ⍝ Ackermann in raw BF.

:If 'v'∊Alpha                                   ⍝ slightly slower test
0~⍨ 0 2 3 bf ack                        ⍝ test: ack(2,2) → 9
9
:EndIf

⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝
⍝                                                       ⍝
⍝                           ⍝ Ackermann's function.     ⍝
∆'  m=1 n=2             '   ⍝   declare local vars.     ⍝
∆'  ;+m← ;+n←           '   ⍝   input and incr m and n  ⍝
∆'  ↓                   '   ⍝   push 0                  ⍝
∆'  m≡[                 '   ⍝   repeat                  ⍝
∆'  ·   -{              '   ⍝   ·   if 0≠m-1            ⍝
∆'  ·   ·   ↓           '   ⍝   ·   ·   push m-1        ⍝
∆'  ·   ·   n≡-{[-]     '   ⍝   ·   ·   if 0≠n-1        ⍝
∆'  ·   ·   ·   m→ ↓    '   ⍝   ·   ·   ·   push m      ⍝
∆'  ·   ·   ·   n→-↓    '   ⍝   ·   ·   ·   push n-1    ⍝
∆'  ·   ·   ⋄           '   ⍝   ·   ·   else            ⍝
∆'  ·   ·   ·    ++↓    '   ⍝   ·   ·   ·   push 1+1    ⍝
∆'  ·   ·   }           '   ⍝   ·   ·   fi              ⍝
∆'  ·   ⋄               '   ⍝   ·   else                ⍝
∆'  ·   ·   n→+↓        '   ⍝   ·   ·   push n+1        ⍝
∆'  ·   }               '   ⍝   ·   fi                  ⍝
∆'  ·   ↑n←             '   ⍝   ·   pop n               ⍝
∆'  ·   ↑m←             '   ⍝   ·   pop m               ⍝
∆'  m≡]                 '   ⍝   while stacked items     ⍝
∆'  n→-:                '   ⍝   output n-1              ⍝
ack ⍙←⍙ ''                                          ⍝
⍝                                                       ⍝
⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝

⍴opt dark mac if,io,ram,stk,ack     ⍝ Size of BF code for Ackermann.
601

⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝
⍝                                                           ⍝
⍝  Ackermann's function: second attempt see ##.notes.bfack  ⍝
⍝                                                           ⍝
⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝

track←{                             ⍝ Tail-recursive Ackermann.
a(m n)←(¯2↓⍵)(¯2↑¯1,⍵)
m=¯1:n
m=0:∇ a,n+1
n=0:∇ a,(m-1)1
∇ a,(m-1)m(n-1)
}

track 3 3                           ⍝ ack 3 3 → 61
61

⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝
⍝                                                               ⍝
⍝ Macros:                           ⍝ Ackermann's function.     ⍝
⍝                                   ⍝                           ⍝
⍝   ∆'  ;=(, ∆=/- >6∆[+<8∆>]<  )· · '   ⍝ input digit               ⍝
⍝   ∆'  :=(  ∆=/+ >6∆[-<8∆>]< .)· · '   ⍝ output digit              ⍝
∆'                              '   ⍝                           ⍝
∆'  {=/>+/<[/>-/< · · · · · · · '   ⍝ if                        ⍝
∆'  ⋄=/>]/>[-/< · · · · · · · · '   ⍝ else                      ⍝
∆'  }=/>/>]/</< · · · · · · · · '   ⍝ fi                        ⍝
∆'                              '   ⍝                           ⍝
∆'  ≥=(                         '   ⍝ dup ⍺ right               ⍝
∆'      [-/>+>+</<]/>>          '   ⍝   m .. 0  → 0 .. m m      ⍝
∆'      [-</<+/>>]</<           '   ⍝   m .. m  ←               ⍝
∆'  ) ·                         '   ⍝                           ⍝
∆'                              '   ⍝                           ⍝
∆'  ←=[-/<+/>]  · · · · · · · · '   ⍝ move ⍺ left               ⍝
∆'  →=[-/>+/<]  · · · · · · · · '   ⍝ move ⍺ right              ⍝
∆'                              '   ⍝                           ⍝
⍝ Code:                             ⍝                           ⍝
∆'                              '   ⍝                           ⍝
∆' -                            '   ⍝  (¯1)                     ⍝
∆' >;                           '   ⍝   ¯1(m)                   ⍝
∆' >;<                          '   ⍝   ¯1(m)n                  ⍝
∆' +[-                          '   ⍝   a(m)n                   ⍝
∆'      2{                      '   ⍝   if m≠0:                 ⍝
∆'          >1{                 '   ⍝       if n≠0:             ⍝
∆'              <3≥             '   ⍝           a(m)n 0 m       ⍝
∆'              >1→             '   ⍝           a m(0)n m       ⍝
∆'              >>2←            '   ⍝           a m m n(0)      ⍝
∆'              <-<<->>         '   ⍝           a(m-1)(m)(n-1)  ⍝
∆'          1⋄                  '   ⍝       else if n=0:        ⍝
∆'              <->+            '   ⍝           a(m+1)1         ⍝
∆'          1}<                 '   ⍝       fi                  ⍝
∆'      2⋄                      '   ⍝   else if m=0:            ⍝
∆'          >1←<+<              '   ⍝       a(a)(n+1)0          ⍝
∆'      2}                      '   ⍝   fi                      ⍝
∆'  +]                          '   ⍝ until a(¯1)n              ⍝
∆'  >:                          '   ⍝ output n                  ⍝
ack ⍙←⍙ ''                                                  ⍝
⍝                                                               ⍝
⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝

⍴ opt dark mac ack
115
0~⍨ 0 2 3 bf opt dark mac ack       ⍝ ack 2 3 → 9
9

⍝ This program, transliterated from Böhm's P" language, a precursor to BF,
⍝ returns the predecessor of a number represented in 2-adic number system:
⍝ ⍬ 1 2 11 12 21 22 111 112 121 ...

+1 1 2 bf'>[>]<[-[<[<]]-<]>+'   ⍝ 8-1 → 7
0 0 1 1 1 0

Back to: code

Back to: Workspaces