Name: Anonymous 2008-12-04 2:23
(define brainfuck #f)
(define bf-program "+-")
(define (alist-set! alist name value)
(let ((bucket (assq name alist)))
(if bucket
(begin
(set-cdr! bucket value)
alist)
(cons (cons name value) alist))))
(let*
(
(bf-tape ())
(bf-tape-ptr 0)
;(bf-tape-value 0);; int represents value under tape pointer
(bf-instruction-ptr 0)
(bf-instruction-value (string-ref bf-program bf-instruction-ptr))
(bf-continuation #t)
(incr? (lambda () (char=? bf-instruction-value (integer->char 43))))
(decr? (lambda () (char=? bf-instruction-value (integer->char 45))))
(braco? (lambda () (char=? bf-instruction-value (integer->char 91))))
(bracc? (lambda () (char=? bf-instruction-value (integer->char 93))))
(left? (lambda () (char=? bf-instruction-value (integer->char 60))))
(right? (lambda () (char=? bf-instruction-value (integer->char 62))))
(print? (lambda () (char=? bf-instruction-value (integer->char 46))))
(tib? (lambda () (char=? bf-instruction-value (integer->char 44))))
(eof? (lambda () (char=? bf-instruction-value (integer->char 128))))
(lookup (lambda () ((lambda (x) (if x x 0)) (assoc bf-tape-ptr bf-tape))))
(set-instruction-ptr! (lambda (a) (set! bf-instruction-pointer a)))
(inc-instruction-ptr! (lambda () (set-instruction-ptr! (+ bf-instruction-pointer 1))))
(set-tape-ptr! (lambda (a) (set! bf-tape-pointer a)))
(add-to-table!
(lambda (a)
(alist-set! bf-tape bf-tape-ptr a)))
(right! (lambda () (set-tape-ptr! (+ bf-tape-pointer 1))))
(left! (lambda ()
(set-instruction-ptr! ((lambda (x) (if (zero? x) 0 (- x 1))) bf-instruction-ptr))))
(print! (lambda () (print (lookup))))
(input! #t)
(inc! (lambda () (add-to-table! (+ (lookup) 1))))
(dec! (lambda () (add-to-table! (- (lookup) 1))))
(open! (lambda () (call/cc (lambda (rest) (set! bf-continuation rest)))))
(clos! (lambda () (if (zero? bf-tape-ptr) (bf-continuation) ))
(right! (lambda ()
(set-instruction-ptr! (+ bf-instruction-ptr 1))
(set! bf-instruction-value (string-ref bf-program-ptr))))
)
(set! brainfuck
(lambda ()
(cond
;; disbatch
((incr?) (inc!))
((decr?) (dec!))
((right?) (right!))
((left?) (left!))
((tib?) (input!))
((print?) (print!))
((eof?) #f)
((open?)
(let (; copy continuation var and instruction-ptr var for the loop in brackets
(bf-continuation bf-continuation)
(bf-instruction-ptr bf-instruction-ptr))
(open!);; copy current-continuation
(inc-instruction-ptr!)
(brainf_ck)))
((close?) (clos!))
(else ()))
(brainfuck))))Something is not right. I will be combing through it as /prog/ reads this. Maybe /prog/ will what the fuck is wrong with it before I do.