/src/web/examples/slbrainfuck.lsp
Lisp | 73 lines | 64 code | 9 blank | 0 comment | 0 complexity | 199dbd7854a0b298ad3e36e757e473fa MD5 | raw file
- % slbrainfuck - substandard lisp brainfuck interpreter
- % author: Nicky Nickell <nicky.nickell@gmail.com>
- (setq *OUTPUT nil)
- (setq helloworld "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.")
- (de range (start end)
- (cond ((greaterp start end)
- (cond ((eqn start end) (cons end nil))
- (t (cons start (range (sub1 start) end)))))
- (t
- (cond ((eqn start end) (cons end nil))
- (t (cons start (range (add1 start) end)))))))
- (de bfseek (bfp from direction for)
- (prog nil
- (mapc (if (minusp direction)
- (range 0 from)
- (range from (length bfp)))
- (lambda (i)
- (if (eqn (nth i bfp) for) (return i))))))
- (de bf (bfp bfi)
- (let ((ptr 0)
- (pc 0)
- (bfout nil)
- (memory (make-vector 200 0))
- (bfin (string-to-list bfi))
- (bfprog (string-to-list bfp)))
- (prog (op)
- top (setq op (nth pc bfprog))
- (cond ((eqn op (char !>))
- (setq ptr (add1 ptr)))
- ((eqn op (char !<))
- (setq ptr (sub1 ptr)))
- ((eqn op (char !+))
- (vector-store memory ptr (add1 (vector-fetch memory ptr))))
- ((eqn op (char !-))
- (vector-store memory ptr (sub1 (vector-fetch memory ptr))))
- ((eqn op (char !.))
- (push (vector-fetch memory ptr) bfout))
- ((eqn op (char !,))
- (vector-store memory ptr (pop bfin)))
- ((eqn op (char ![))
- (if (zerop (vector-fetch memory ptr))
- (setq pc (bfseek bfprog pc 1 (char !])))))
- ((eqn op (char !]))
- (if (zerop (vector-fetch memory ptr))
- nil
- (setq pc (bfseek bfprog pc -1 (char ![)))))
- ((null op)
- (return nil)))
- (setq pc (add1 pc))
- (go top))
- (if (null bfout)
- ""
- (list2string (reverse bfout)))))
- (de bfeval nil
- (dom-append (dom-get-element-by-id "out") "output: <br>"
- (bf (dom-get-value (dom-get-element-by-id "program"))
- (dom-get-value (dom-get-element-by-id "input"))) "<br>"))
- (dom-set-title "slbrainfuck")
- (dom-append (dom-get-body)
- "program: " (dom-create-text '(("id" . "program"))) "<br>"
- "input: " (dom-create-text '(("id" . "input"))) "<br>"
- (dom-create-button "execute" nil '(("onclick" . (bfeval)))) "<br>"
- (dom-create "div" '(("id" . "out"))))
- (dom-set-attribute (dom-get-element-by-id "program") "value" helloworld)