Brainfuck interpreter in Racket/Scheme

brainfuck.rkt

; brainfuck.rkt
;
; A slow, limited, but fun to write brainfuck interpreter in Racket teaching language
; Input instructions are not supported
;
; (language: Intermediate Student with lambda)
;
; Copyright (C) 2021 rw-r-r-0644
; This code is under GNU GPLv2


;; Exponential recursive memory cells creation
;;   (int) exp -> the returned memory cells array will have size 2^exp
;;
(define mem-create-2exp
  (lambda (exp)
    (if (= exp 0) (list 0)
        (append (mem-create-2exp (- exp 1))
                (mem-create-2exp (- exp 1))))
    ))

;; Find trailing ']' in a loop (taking into account multiple depth loops)
;;   (string) str   -> the program string
;;      (int) idx   -> search start index (after opening '[')
;;      (int) depth -> accounts for loops inside of the loop, initial depth should be +1 (since [ was parsed)
;;
(define find-loop-end
  (lambda (str idx depth)
    (if (= depth 0) idx
        (let ((chr (string-ref str idx)))
          (find-loop-end str (+ idx 1) (+ depth (cond ((char=? chr #\[) +1) ((char=? chr #\]) -1) (else 0)))))
        )))

;; Execute lambda operation op on the cell at the specified index idx
;;   (int list) memprev -> used during recursion, should be null on initial call
;;   (int list) mem -> the memory cell list
;;        (int) idx -> the index of the cell to modify
;;     (lambda) op  -> lambda op to apply
;;
(define memory-op
  (lambda (memprev mem idx op)
    (if (= idx 0) (append memprev (cons (op (car mem)) (cdr mem)))
        (memory-op (append memprev (list (car mem))) (cdr mem) (- idx 1) op)
        )))

;; The main brainfuck interpreter (uses tail recursion)
;;     (string) codestr -> input program
;;        (int) codeidx -> current program location
;;   (int list) memdata -> list representing brainfuck memory cells
;;        (int) memidx  -> current list pointer location
;;     (string) outstr  -> program output
;;
(define brainfuck-interpreter
  (lambda (codestr codeidx memdata memidx callstack outstr)
    (if (>= codeidx (string-length codestr)) outstr
        (let ((instr (string-ref codestr codeidx))
              (codenxt (+ codeidx 1)))
          (cond ((char=? instr #\>) ; next mem cell
                 (brainfuck-interpreter codestr codenxt memdata (+ memidx 1) callstack outstr))
                ((char=? instr #\<) ; prev mem cell
                 (brainfuck-interpreter codestr codenxt memdata (- memidx 1) callstack outstr))
                ((char=? instr #\+) ; increment mem cell content
                 (brainfuck-interpreter codestr codenxt
                                        (memory-op null memdata memidx
                                                   (lambda (x) (modulo (+ x 1) 256)))
                                        memidx callstack outstr))
                ((char=? instr #\-) ; decrement mem cell content
                 (brainfuck-interpreter codestr codenxt
                                        (memory-op null memdata memidx
                                                   (lambda (x) (modulo (- x 1) 256)))
                                        memidx callstack outstr))
            
                ((char=? instr #\.) ; output cell as ascii character
                 (brainfuck-interpreter codestr codenxt memdata memidx callstack
                                        (string-append outstr (string (integer->char (list-ref memdata memidx))))))
                ((char=? instr #\,) ; unsupport cell input
                 "ERROR: cell input not supported by this implementation")
                ((char=? instr #\]) ; end of loop
                 (if (null? callstack)
                     "ERROR: loop repeat outside of a loop, preceding [ is missing"
                     (brainfuck-interpreter codestr
                                            (car callstack) ; pop loop instruction index from call stack
                                            memdata memidx
                                            (cdr callstack) ; first element of call stack removed
                                            outstr)))
                ((char=? instr #\[) ; start of conditional loop
                 (if (= (list-ref memdata memidx) 0) ; check if memory cell is zero
                     (brainfuck-interpreter codestr (find-loop-end codestr codenxt 1) memdata memidx callstack outstr) ; skip loop
                     (brainfuck-interpreter codestr codenxt memdata memidx (cons codeidx callstack) outstr)))          ; enter loop
                (else ; no op
                 (brainfuck-interpreter codestr codenxt memdata memidx callstack outstr))
                )))))

;; Utility function for calling the interpreter without further parameters.
;; Provides 2Kb of memory cells.
;;    (string) code -> the brainfuck program code
;;
(define brainfuck
  (lambda (code)
    (brainfuck-interpreter code 0 (mem-create-2exp 11) 0 null "")
    ))