Skip to content

Instantly share code, notes, and snippets.

@MichaelBlume
Created October 11, 2020 23:09
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save MichaelBlume/9493cf790791e2487ce1174df029ce1e to your computer and use it in GitHub Desktop.
Save MichaelBlume/9493cf790791e2487ce1174df029ce1e to your computer and use it in GitHub Desktop.
Brainfuck interpreter in lambda calculus
((fn [truth] ((fn [falsehood] ((fn [and] ((fn [Y] ((fn [pair] ((fn [null] ((fn [null?] ((fn [car] ((fn [cdr] ((fn [mapp] ((fn [repeat-forever] ((fn [zero] ((fn [inc] ((fn [zero?] ((fn [dec] ((fn [an*] ((fn [equals] ((fn [get-nth] ((fn [tape] ((fn [read-tape] ((fn [apply-tape] ((fn [write-tape] ((fn [left-tape] ((fn [right-tape] ((fn [inc-tape] ((fn [dec-tape] ((fn [blank-tape] ((fn [parse-state] ((fn [get-parse-instructions] ((fn [set-parse-instructions] ((fn [alter-parse-instructions] ((fn [get-loop-stack] ((fn [set-loop-stack] ((fn [alter-loop-stack] ((fn [get-pairs] ((fn [set-pairs] ((fn [alter-pairs] ((fn [get-parse-counter] ((fn [set-parse-counter] ((fn [alter-parse-counter] ((fn [lshift] ((fn [lshift?] ((fn [rshift] ((fn [rshift?] ((fn [plus] ((fn [plus?] ((fn [minus] ((fn [minus?] ((fn [lbrace] ((fn [lbrace?] ((fn [rbrace] ((fn [rbrace?] ((fn [read] ((fn [read?] ((fn [write] ((fn [write?] ((fn [parse-stepper] ((fn [do-parse-state] ((fn [look-in-pairs] ((fn [make-jump-table] ((fn [brainfuck-state] ((fn [get-jump-table] ((fn [set-jump-table] ((fn [alter-jump-table] ((fn [get-instructions] ((fn [set-instructions] ((fn [alter-instructions] ((fn [get-tape] ((fn [set-tape] ((fn [alter-tape] ((fn [get-inputs] ((fn [set-inputs] ((fn [alter-inputs] ((fn [get-instruction-counter] ((fn [set-instruction-counter] ((fn [alter-instruction-counter] ((fn [id] ((fn [no-print] ((fn [tape-action] ((fn [do-lshift] ((fn [do-rshift] ((fn [do-plus] ((fn [do-minus] ((fn [do-write] ((fn [do-read] ((fn [do-jump] ((fn [do-lbrace] ((fn [do-rbrace] ((fn [run-one] ((fn [run-brainfuck-state] ((fn [assemble-instructions] ((fn [construct-state] ((fn [run-brainfuck] run-brainfuck) (fn [instructions] ((fn [state] (fn [inputs] (run-brainfuck-state ((set-inputs inputs) state)))) (construct-state instructions))))) (fn [instructions] ((fn [assembled] ((fn [pairs] ((fn [jump-table] (((((brainfuck-state jump-table) assembled) blank-tape) null) zero)) ((((make-jump-table pairs) assembled) assembled) zero))) (do-parse-state ((((parse-state instructions) null) null) zero)))) (assemble-instructions instructions))))) (mapp (fn [i] ((((((((i do-lshift) do-rshift) do-plus) do-minus) do-lbrace) do-rbrace) do-read) do-write))))) (Y (fn [run-brainfuck-state] (fn [state] (((run-one state) (fn [print-output] (fn [new-state] (print-output (fn [x__78600__auto__] ((run-brainfuck-state new-state) x__78600__auto__)))))) null)))))) (fn [state] (((get-instructions state) (fn [ins] (fn [_] (((ins state) (fn [pfun] (fn [new-state] ((pair pfun) ((alter-instruction-counter inc) ((alter-instructions cdr) new-state)))))) null)))) null)))) (fn [state] (no-print ((((zero? (read-tape (get-tape state))) (fn [nil-delay__78644__auto__] state)) (fn [nil-delay__78644__auto__] (do-jump state))) null))))) (fn [state] (no-print ((((zero? (read-tape (get-tape state))) (fn [nil-delay__78644__auto__] (do-jump state))) (fn [nil-delay__78644__auto__] state)) null))))) (fn [state] ((fn [counter] ((fn [jump-table] ((((get-nth counter) jump-table) (fn [new-counter] (fn [new-instructions] ((set-instruction-counter new-counter) ((set-instructions new-instructions) state))))) null)) (get-jump-table state))) (get-instruction-counter state))))) (fn [state] (((get-inputs state) (fn [v] (fn [more-inputs] (no-print ((alter-tape (fn [tape] ((write-tape tape) v))) ((set-inputs more-inputs) state)))))) null)))) (fn [state] ((fn [v] ((pair (fn [s] ((pair v) s))) state)) (read-tape (get-tape state)))))) (tape-action dec-tape))) (tape-action inc-tape))) (tape-action right-tape))) (tape-action left-tape))) (fn [tapefn] (fn [state] (no-print ((alter-tape tapefn) state)))))) (fn [state] ((pair id) state)))) (fn [x] x))) (fn [mutation79361] (fn [brainfuck-state79362] (brainfuck-state79362 (fn [jump-table] (fn [instructions] (fn [tape] (fn [inputs] (fn [instruction-counter] (((((brainfuck-state jump-table) instructions) tape) inputs) (mutation79361 instruction-counter)))))))))))) (fn [new-instruction-counter79367] (fn [brainfuck-state79362] (brainfuck-state79362 (fn [jump-table] (fn [instructions] (fn [tape] (fn [inputs] (fn [instruction-counter] (((((brainfuck-state jump-table) instructions) tape) inputs) new-instruction-counter79367))))))))))) (fn [brainfuck-state79362] (brainfuck-state79362 (fn [jump-table] (fn [instructions] (fn [tape] (fn [inputs] (fn [instruction-counter] instruction-counter))))))))) (fn [mutation79361] (fn [brainfuck-state79362] (brainfuck-state79362 (fn [jump-table] (fn [instructions] (fn [tape] (fn [inputs] (fn [instruction-counter] (((((brainfuck-state jump-table) instructions) tape) (mutation79361 inputs)) instruction-counter))))))))))) (fn [new-inputs79366] (fn [brainfuck-state79362] (brainfuck-state79362 (fn [jump-table] (fn [instructions] (fn [tape] (fn [inputs] (fn [instruction-counter] (((((brainfuck-state jump-table) instructions) tape) new-inputs79366) instruction-counter))))))))))) (fn [brainfuck-state79362] (brainfuck-state79362 (fn [jump-table] (fn [instructions] (fn [tape] (fn [inputs] (fn [instruction-counter] inputs))))))))) (fn [mutation79361] (fn [brainfuck-state79362] (brainfuck-state79362 (fn [jump-table] (fn [instructions] (fn [tape] (fn [inputs] (fn [instruction-counter] (((((brainfuck-state jump-table) instructions) (mutation79361 tape)) inputs) instruction-counter))))))))))) (fn [new-tape79365] (fn [brainfuck-state79362] (brainfuck-state79362 (fn [jump-table] (fn [instructions] (fn [tape] (fn [inputs] (fn [instruction-counter] (((((brainfuck-state jump-table) instructions) new-tape79365) inputs) instruction-counter))))))))))) (fn [brainfuck-state79362] (brainfuck-state79362 (fn [jump-table] (fn [instructions] (fn [tape] (fn [inputs] (fn [instruction-counter] tape))))))))) (fn [mutation79361] (fn [brainfuck-state79362] (brainfuck-state79362 (fn [jump-table] (fn [instructions] (fn [tape] (fn [inputs] (fn [instruction-counter] (((((brainfuck-state jump-table) (mutation79361 instructions)) tape) inputs) instruction-counter))))))))))) (fn [new-instructions79364] (fn [brainfuck-state79362] (brainfuck-state79362 (fn [jump-table] (fn [instructions] (fn [tape] (fn [inputs] (fn [instruction-counter] (((((brainfuck-state jump-table) new-instructions79364) tape) inputs) instruction-counter))))))))))) (fn [brainfuck-state79362] (brainfuck-state79362 (fn [jump-table] (fn [instructions] (fn [tape] (fn [inputs] (fn [instruction-counter] instructions))))))))) (fn [mutation79361] (fn [brainfuck-state79362] (brainfuck-state79362 (fn [jump-table] (fn [instructions] (fn [tape] (fn [inputs] (fn [instruction-counter] (((((brainfuck-state (mutation79361 jump-table)) instructions) tape) inputs) instruction-counter))))))))))) (fn [new-jump-table79363] (fn [brainfuck-state79362] (brainfuck-state79362 (fn [jump-table] (fn [instructions] (fn [tape] (fn [inputs] (fn [instruction-counter] (((((brainfuck-state new-jump-table79363) instructions) tape) inputs) instruction-counter))))))))))) (fn [brainfuck-state79362] (brainfuck-state79362 (fn [jump-table] (fn [instructions] (fn [tape] (fn [inputs] (fn [instruction-counter] jump-table))))))))) (fn [jump-table] (fn [instructions] (fn [tape] (fn [inputs] (fn [instruction-counter] (fn [reader__78890__auto__] (((((reader__78890__auto__ jump-table) instructions) tape) inputs) instruction-counter))))))))) (Y (fn [make-jump-table] (fn [pairs] (fn [instructions] (fn [remaining-instructions] (fn [counter] ((remaining-instructions (fn [_] (fn [more-instructions] ((pair ((((look-in-pairs counter) pairs) (fn [jump-to] (fn [_] ((pair jump-to) (((an* jump-to) cdr) instructions))))) null)) ((((make-jump-table pairs) instructions) more-instructions) (inc counter)))))) null))))))))) (Y (fn [look-in-pairs] (fn [n] (fn [pairs] ((pairs (fn [fpair] (fn [rpairs] ((fpair (fn [na] (fn [nb] (((((equals n) na) (fn [nil-delay__78644__auto__] ((pair nb) null))) (fn [nil-delay__78644__auto__] (((((equals n) nb) (fn [nil-delay__78644__auto__] ((pair na) null))) (fn [nil-delay__78644__auto__] ((look-in-pairs n) rpairs))) null))) null)))) null)))) null))))))) (Y (fn [do-parse-state] (fn [state] ((((null? (get-parse-instructions state)) (fn [nil-delay__78644__auto__] (get-pairs state))) (fn [nil-delay__78644__auto__] (do-parse-state (parse-stepper state)))) null)))))) (fn [state] ((alter-parse-counter inc) ((alter-parse-instructions cdr) ((fn [next-instruction] ((((lbrace? next-instruction) (fn [nil-delay__78644__auto__] ((alter-loop-stack (pair (get-parse-counter state))) state))) (fn [nil-delay__78644__auto__] ((((rbrace? next-instruction) (fn [nil-delay__78644__auto__] ((fn [popped-counter] ((alter-pairs (pair ((pair (get-parse-counter state)) popped-counter))) ((alter-loop-stack cdr) state))) (car (get-loop-stack state))))) (fn [nil-delay__78644__auto__] state)) null))) null)) (car (get-parse-instructions state)))))))) (fn [instruction79131] ((((((((instruction79131 falsehood) falsehood) falsehood) falsehood) falsehood) falsehood) falsehood) truth)))) (fn [lshift] (fn [rshift] (fn [plus] (fn [minus] (fn [lbrace] (fn [rbrace] (fn [read] (fn [write] write)))))))))) (fn [instruction79131] ((((((((instruction79131 falsehood) falsehood) falsehood) falsehood) falsehood) falsehood) truth) falsehood)))) (fn [lshift] (fn [rshift] (fn [plus] (fn [minus] (fn [lbrace] (fn [rbrace] (fn [read] (fn [write] read)))))))))) (fn [instruction79131] ((((((((instruction79131 falsehood) falsehood) falsehood) falsehood) falsehood) truth) falsehood) falsehood)))) (fn [lshift] (fn [rshift] (fn [plus] (fn [minus] (fn [lbrace] (fn [rbrace] (fn [read] (fn [write] rbrace)))))))))) (fn [instruction79131] ((((((((instruction79131 falsehood) falsehood) falsehood) falsehood) truth) falsehood) falsehood) falsehood)))) (fn [lshift] (fn [rshift] (fn [plus] (fn [minus] (fn [lbrace] (fn [rbrace] (fn [read] (fn [write] lbrace)))))))))) (fn [instruction79131] ((((((((instruction79131 falsehood) falsehood) falsehood) truth) falsehood) falsehood) falsehood) falsehood)))) (fn [lshift] (fn [rshift] (fn [plus] (fn [minus] (fn [lbrace] (fn [rbrace] (fn [read] (fn [write] minus)))))))))) (fn [instruction79131] ((((((((instruction79131 falsehood) falsehood) truth) falsehood) falsehood) falsehood) falsehood) falsehood)))) (fn [lshift] (fn [rshift] (fn [plus] (fn [minus] (fn [lbrace] (fn [rbrace] (fn [read] (fn [write] plus)))))))))) (fn [instruction79131] ((((((((instruction79131 falsehood) truth) falsehood) falsehood) falsehood) falsehood) falsehood) falsehood)))) (fn [lshift] (fn [rshift] (fn [plus] (fn [minus] (fn [lbrace] (fn [rbrace] (fn [read] (fn [write] rshift)))))))))) (fn [instruction79131] ((((((((instruction79131 truth) falsehood) falsehood) falsehood) falsehood) falsehood) falsehood) falsehood)))) (fn [lshift] (fn [rshift] (fn [plus] (fn [minus] (fn [lbrace] (fn [rbrace] (fn [read] (fn [write] lshift)))))))))) (fn [mutation78966] (fn [parse-state78967] (parse-state78967 (fn [parse-instructions] (fn [loop-stack] (fn [pairs] (fn [parse-counter] ((((parse-state parse-instructions) loop-stack) pairs) (mutation78966 parse-counter))))))))))) (fn [new-parse-counter78971] (fn [parse-state78967] (parse-state78967 (fn [parse-instructions] (fn [loop-stack] (fn [pairs] (fn [parse-counter] ((((parse-state parse-instructions) loop-stack) pairs) new-parse-counter78971)))))))))) (fn [parse-state78967] (parse-state78967 (fn [parse-instructions] (fn [loop-stack] (fn [pairs] (fn [parse-counter] parse-counter)))))))) (fn [mutation78966] (fn [parse-state78967] (parse-state78967 (fn [parse-instructions] (fn [loop-stack] (fn [pairs] (fn [parse-counter] ((((parse-state parse-instructions) loop-stack) (mutation78966 pairs)) parse-counter)))))))))) (fn [new-pairs78970] (fn [parse-state78967] (parse-state78967 (fn [parse-instructions] (fn [loop-stack] (fn [pairs] (fn [parse-counter] ((((parse-state parse-instructions) loop-stack) new-pairs78970) parse-counter)))))))))) (fn [parse-state78967] (parse-state78967 (fn [parse-instructions] (fn [loop-stack] (fn [pairs] (fn [parse-counter] pairs)))))))) (fn [mutation78966] (fn [parse-state78967] (parse-state78967 (fn [parse-instructions] (fn [loop-stack] (fn [pairs] (fn [parse-counter] ((((parse-state parse-instructions) (mutation78966 loop-stack)) pairs) parse-counter)))))))))) (fn [new-loop-stack78969] (fn [parse-state78967] (parse-state78967 (fn [parse-instructions] (fn [loop-stack] (fn [pairs] (fn [parse-counter] ((((parse-state parse-instructions) new-loop-stack78969) pairs) parse-counter)))))))))) (fn [parse-state78967] (parse-state78967 (fn [parse-instructions] (fn [loop-stack] (fn [pairs] (fn [parse-counter] loop-stack)))))))) (fn [mutation78966] (fn [parse-state78967] (parse-state78967 (fn [parse-instructions] (fn [loop-stack] (fn [pairs] (fn [parse-counter] ((((parse-state (mutation78966 parse-instructions)) loop-stack) pairs) parse-counter)))))))))) (fn [new-parse-instructions78968] (fn [parse-state78967] (parse-state78967 (fn [parse-instructions] (fn [loop-stack] (fn [pairs] (fn [parse-counter] ((((parse-state new-parse-instructions78968) loop-stack) pairs) parse-counter)))))))))) (fn [parse-state78967] (parse-state78967 (fn [parse-instructions] (fn [loop-stack] (fn [pairs] (fn [parse-counter] parse-instructions)))))))) (fn [parse-instructions] (fn [loop-stack] (fn [pairs] (fn [parse-counter] (fn [reader__78890__auto__] ((((reader__78890__auto__ parse-instructions) loop-stack) pairs) parse-counter)))))))) (((tape (repeat-forever zero)) zero) (repeat-forever zero)))) (apply-tape dec))) (apply-tape inc))) (fn [t] (t (fn [ls] (fn [v] (fn [rs] ((rs (fn [fst] (fn [rst] (((tape ((pair v) ls)) fst) rst)))) null)))))))) (fn [t] (t (fn [ls] (fn [v] (fn [rs] ((ls (fn [fst] (fn [rst] (((tape rst) fst) ((pair v) rs))))) null)))))))) (fn [t] (fn [v] ((apply-tape (fn [_] v)) t))))) (fn [f] (fn [t] (t (fn [ls] (fn [v] (fn [rs] (((tape ls) (f v)) rs))))))))) (fn [t] (t (fn [_] (fn [v] (fn [_] v))))))) (fn [ls] (fn [v] (fn [rs] (fn [reader] (((reader ls) v) rs))))))) (fn [n] (fn [s] (car (((an* n) cdr) s)))))) (Y (fn [equals] (fn [n1] (fn [n2] ((((null? n1) (fn [nil-delay__78644__auto__] (null? n2))) (fn [nil-delay__78644__auto__] ((((null? n2) (fn [nil-delay__78644__auto__] falsehood)) (fn [nil-delay__78644__auto__] ((equals (dec n1)) (dec n2)))) null))) null))))))) (Y (fn [an*] (fn [n] (fn [f] (fn [x] ((((null? n) (fn [nil-delay__78644__auto__] x)) (fn [nil-delay__78644__auto__] (f (((an* (dec n)) f) x)))) null)))))))) cdr)) null?)) (fn [n] ((pair null) n)))) null)) (fn [x] (Y (fn [s] ((pair x) s)))))) (Y (fn [mapp] (fn [f] (fn [s] ((s (fn [fst] (fn [rst] ((pair (f fst)) ((mapp f) rst))))) null))))))) (fn [p] ((p (fn [f] (fn [r] r))) null)))) (fn [p] ((p (fn [f] (fn [r] f))) null)))) (fn [p] ((p (fn [a] (fn [b] falsehood))) truth)))) (fn [selector] (fn [nil-val] nil-val)))) (fn [a] (fn [b] (fn [selector] (fn [nil-val] ((selector a) b))))))) (fn [f] ((fn [x] (x x)) (fn [x] (f (fn [y] ((x x) y)))))))) (fn [b1] (fn [b2] ((b1 b2) falsehood))))) (fn [t] (fn [f] f)))) (fn [t] (fn [f] t)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment