⍝ 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
⍝∇ bf mac
Back to: code
Back to: Workspaces