79 lines
3.1 KiB
Scheme
79 lines
3.1 KiB
Scheme
;;; Brainfuck->Scheme compiler.
|
|
;;;
|
|
;;; Copyright 2024 Peter McGoron
|
|
;;;
|
|
;;; Licensed under the Apache License, Version 2.0 (the "License");
|
|
;;; you may not use this file except in compliance with the License.
|
|
;;; You may obtain a copy of the License at
|
|
;;;
|
|
;;; http://www.apache.org/licenses/LICENSE-2.0
|
|
;;;
|
|
;;; Unless required by applicable law or agreed to in writing, software
|
|
;;; distributed under the License is distributed on an "AS IS" BASIS,
|
|
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
;;; See the License for the specific language governing permissions and
|
|
;;; limitations under the License.
|
|
|
|
;;; Turn a reversed list of Scheme commands into a thunk.
|
|
(define (assemble-function ins)
|
|
`(lambda ()
|
|
,@(reverse ins)))
|
|
|
|
;;; Compile all brainfuck instructions in LST, coming after the Scheme
|
|
;;; commands in INS.
|
|
(define (compile lst ins)
|
|
(if (null? lst)
|
|
(assemble-function ins)
|
|
(case (car lst)
|
|
((#\>) (compile (cdr lst)
|
|
(cons '(set! dptr (+ dptr 1)) ins)))
|
|
((#\<) (compile (cdr lst)
|
|
(cons '(set! dptr (- dptr 1)) ins)))
|
|
((#\+) (compile (cdr lst)
|
|
(cons
|
|
'(vector-set! data dptr
|
|
(+ (vector-ref data dptr) 1))
|
|
ins)))
|
|
((#\-) (compile (cdr lst)
|
|
(cons
|
|
'(vector-set! data dptr
|
|
(- (vector-ref data dptr) 1))
|
|
ins)))
|
|
((#\.) (compile (cdr lst)
|
|
(cons '(display (integer->char (vector-ref data dptr))) ins)))
|
|
((#\,) (compile (cdr lst)
|
|
(cons '(vector-set! data dptr
|
|
(char->integer (read-char))) ins)))
|
|
((#\[) (let ((rest (compile (cdr lst) '())))
|
|
(if (not (pair? rest))
|
|
(error "unmatched [")
|
|
(let ((between (car rest))
|
|
(after-uncompiled (cdr rest)))
|
|
(compile after-uncompiled
|
|
(cons `(letrec ((between ,between))
|
|
(if (not (zero? (vector-ref data dptr)))
|
|
(between)))
|
|
ins))))))
|
|
((#\]) (cons (assemble-function
|
|
(cons '(if (not (zero? (vector-ref data dptr)))
|
|
(between))
|
|
ins))
|
|
(cdr lst)))
|
|
(else (compile (cdr lst) ins)))))
|
|
|
|
(define (brainfuck->scheme str)
|
|
`(lambda (data dptr)
|
|
(,(compile (string->list str) '()))))
|
|
|
|
(define (brainfuck->scheme-from-file filename)
|
|
(brainfuck->scheme
|
|
(call-with-port (open-input-file filename)
|
|
(lambda (port)
|
|
(let loop ((str ""))
|
|
(if (eof-object? (peek-char port))
|
|
str
|
|
(loop (string-append str (read-line port)))))))))
|
|
|
|
(define (execute scheme)
|
|
((eval scheme) (make-vector 4096) 0))
|