Init
This commit is contained in:
Jaidyn Levesque
commit
4cd331815d
|
|
@ -0,0 +1,17 @@
|
||||||
|
===============================================================================
|
||||||
|
BRAINFUCK AHEAGO
|
||||||
|
===============================================================================
|
||||||
|
|
||||||
|
A simple lisp implementation of Brainfuck.
|
||||||
|
Currently can work with simpler programs; but for now, it's still sorta
|
||||||
|
fragile.
|
||||||
|
|
||||||
|
> (bf-aheago:interpret #p"examples/hello_world.bf" :tape-length 5)
|
||||||
|
|
||||||
|
|
||||||
|
————————————————————————————————————————
|
||||||
|
BORING STUFF
|
||||||
|
————————————————————————————————————————
|
||||||
|
License is the CC0 (public domain, effectively)
|
||||||
|
Author is Jaidyn Ann <jadedctrl@teknik.io>
|
||||||
|
Sauce is at https://git.eunichx.us/bf-aheago.git
|
||||||
|
|
@ -0,0 +1,7 @@
|
||||||
|
(defsystem "bf-aheago"
|
||||||
|
:version "0.0"
|
||||||
|
:license "CC0"
|
||||||
|
:author "Jaidyn Ann <jadedctrl@teknik.io>"
|
||||||
|
:description "Sequel to BF"
|
||||||
|
:depends-on (:anaphora)
|
||||||
|
:components ((:file "bf-aheago")))
|
||||||
|
|
@ -0,0 +1,133 @@
|
||||||
|
;; —————————————————————————————————————
|
||||||
|
;; PACKAGE
|
||||||
|
|
||||||
|
(defpackage :bf-aheago
|
||||||
|
(:use :cl :anaphora)
|
||||||
|
(:export :interpret)
|
||||||
|
(:nicknames :bf-a))
|
||||||
|
|
||||||
|
(in-package :bf-aheago)
|
||||||
|
|
||||||
|
;; —————————————————————————————————————
|
||||||
|
;; MACROS
|
||||||
|
|
||||||
|
(defmacro interpret-char (char)
|
||||||
|
`(progn
|
||||||
|
(when debug-p (format *error-output* "~A" ,char))
|
||||||
|
(cond
|
||||||
|
((eq ,char #\.) (output-cell tape pointer))
|
||||||
|
((eq ,char #\,) (input-cell tape pointer))
|
||||||
|
((eq ,char #\<) (bound-decf pointer tape-length))
|
||||||
|
((eq ,char #\>) (bound-incf pointer tape-length))
|
||||||
|
((eq ,char #\+) (inc-cell tape pointer))
|
||||||
|
((eq ,char #\-) (dec-cell tape pointer))
|
||||||
|
((eq ,char #\[) (loop-advance tape pointer input-stream))
|
||||||
|
((eq ,char #\]) (loop-rewind tape pointer input-stream)))))
|
||||||
|
|
||||||
|
;; VARYING [NUMBER] [NUMBER] → NUMBER
|
||||||
|
(defmacro bound-incf (object &optional (max 256) (min 0))
|
||||||
|
"Increment (destructive) an object, but bounds-check with #'bound-ensure."
|
||||||
|
`(setf ,object (bound-ensure (1+ ,object) ,max ,min)))
|
||||||
|
|
||||||
|
;; VARYING [NUMBER] [NUMBER] → NUMBER
|
||||||
|
(defmacro bound-decf (object &optional (max 256) (min 0))
|
||||||
|
"Decrement (destructive) an object, but bounds-check with #'bound-ensure."
|
||||||
|
`(setf ,object (bound-ensure (1- ,object) ,max ,min)))
|
||||||
|
|
||||||
|
;; —————————————————————————————————————
|
||||||
|
;; INTERPRETER
|
||||||
|
|
||||||
|
;; STREAM → ARRAY
|
||||||
|
(defmethod interpret ((input-stream stream) &key (tape-length 30000) (debug-p nil))
|
||||||
|
"Interpret the brainfuck code within the given stream: returns the tape."
|
||||||
|
(let ((tape (make-tape tape-length))
|
||||||
|
(pointer 0))
|
||||||
|
(loop :if (not (listen input-stream))
|
||||||
|
:return tape
|
||||||
|
:do (alet (read-char input-stream)
|
||||||
|
(interpret-char it)))))
|
||||||
|
|
||||||
|
(defmethod interpret ((string string) &key (tape-length 30000) (debug-p nil))
|
||||||
|
(interpret (make-input-string string) :tape-length tape-length :debug-p debug-p))
|
||||||
|
|
||||||
|
(defmethod interpret ((pathname pathname) &key (tape-length 30000) (debug-p nil))
|
||||||
|
(with-open-file (stream pathname)
|
||||||
|
(interpret stream :tape-length tape-length :debug-p debug-p)))
|
||||||
|
|
||||||
|
;; —————————————————————————————————————
|
||||||
|
;; CELLS
|
||||||
|
|
||||||
|
;; ARRAY NUMBER → NUMBER
|
||||||
|
(defun inc-cell (tape index)
|
||||||
|
"Increment the given cell."
|
||||||
|
(bound-incf (aref tape index)))
|
||||||
|
; (setf (aref tape index) (bound-ensure (1+ (aref tape index)))))
|
||||||
|
|
||||||
|
;; ARRAY NUMBER → NUMBENR
|
||||||
|
(defun dec-cell (tape index)
|
||||||
|
"Decrement the given cell."
|
||||||
|
(bound-decf (aref tape index)))
|
||||||
|
; (setf (aref tape index) (bound-ensure (1- (aref tape index)))))
|
||||||
|
|
||||||
|
;; ARRAY NUMBER → NIL
|
||||||
|
(defun output-cell (tape index)
|
||||||
|
"Print the given cell in the tape to stdout."
|
||||||
|
(format t "~A" (code-char (aref tape index))))
|
||||||
|
|
||||||
|
;; ARRAY NUMBER → CHAR
|
||||||
|
(defun input-cell (tape index)
|
||||||
|
"Input a char's int into the tape at given index."
|
||||||
|
(alet (read-char *standard-input* nil 0)
|
||||||
|
(setf (aref tape index) (if (numberp it) it (char-code it)))))
|
||||||
|
|
||||||
|
;; [NUMBER] → ARRAY
|
||||||
|
(defun make-tape (&optional (length 30000))
|
||||||
|
"Make a clean, 0-initialized BF tape."
|
||||||
|
(make-array (list length) :initial-element 0))
|
||||||
|
|
||||||
|
;; —————————————————————————————————————
|
||||||
|
;; LOOPING []
|
||||||
|
|
||||||
|
;; ARRAY NUMBER STREAM → NIL
|
||||||
|
(defun loop-rewind (tape index stream)
|
||||||
|
"Restart the loop (move pointer to last '[') if nonzero cell value."
|
||||||
|
(if (not (zerop (aref tape index)))
|
||||||
|
(stream-rewind-to stream #\[)))
|
||||||
|
|
||||||
|
;; ARRAY NUMBER STREAM → NIL
|
||||||
|
(defun loop-advance (tape index stream)
|
||||||
|
"Skip the loop (move to next ']') if cell value is zero."
|
||||||
|
(if (zerop (aref tape index))
|
||||||
|
(stream-advance-to stream #\])))
|
||||||
|
|
||||||
|
;; —————————————————————————————————————
|
||||||
|
;; STREAM MANIP
|
||||||
|
|
||||||
|
;; STREAM → CHAR
|
||||||
|
(defun retroread-char (stream)
|
||||||
|
"Read the previous character in a file-stream."
|
||||||
|
(alet (file-position stream)
|
||||||
|
(file-position stream (- it 2)))
|
||||||
|
(read-char stream))
|
||||||
|
|
||||||
|
;; STREAM CHAR → NIL
|
||||||
|
(defun stream-advance-to (stream char)
|
||||||
|
"Advance a stream's pointer until the given character is read."
|
||||||
|
(if (not (eq char (read-char stream)))
|
||||||
|
(stream-advance-to stream char)))
|
||||||
|
|
||||||
|
;; STREAM CHAR → NIL
|
||||||
|
(defun stream-rewind-to (stream char)
|
||||||
|
"Reverse a stream's pointer until the given character is read."
|
||||||
|
(if (not (eq char (retroread-char stream)))
|
||||||
|
(stream-rewind-to stream char)))
|
||||||
|
|
||||||
|
;; —————————————————————————————————————
|
||||||
|
;; MISC
|
||||||
|
|
||||||
|
;; NUMBER [NUMBER] [NUMBER]
|
||||||
|
(defun bound-ensure (number &optional (max 256) (min 0))
|
||||||
|
"Ensure the given number remains within the given bounds (with overflow)."
|
||||||
|
(cond ((> min number) (bound-ensure (+ number max) max min))
|
||||||
|
((< max number) (bound-ensure (- max number) max min))
|
||||||
|
(T number)))
|
||||||
|
|
@ -0,0 +1,31 @@
|
||||||
|
"Hello world!" from https://github.com/leachim6/
|
||||||
|
Only uses five cells; no wrapping nor under/overflow
|
||||||
|
|
||||||
|
++++++++++ 0: plus 10
|
||||||
|
[
|
||||||
|
at 0
|
||||||
|
>+++++++ 1: plus 7
|
||||||
|
>++++++++++ 2: plus 10
|
||||||
|
>+++ 3: plus 3
|
||||||
|
>+ 4: plus 1
|
||||||
|
<<<<- 0: decrement
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
at 0
|
||||||
|
0 = 0 1 = 70 2 = 100 3 = 30 4 = 10
|
||||||
|
|
||||||
|
>++. 1 = 72 = H
|
||||||
|
>+. 2 = 101 = e
|
||||||
|
+++++++.. 2 = 108 = l l
|
||||||
|
+++. 2 = 111 = o
|
||||||
|
|
||||||
|
>++. 3 = 32 = ' '
|
||||||
|
<<+++++++++++++++.
|
||||||
|
1 = 87 = W
|
||||||
|
>. 2 = 111 = o
|
||||||
|
+++. 2 = 114 = r
|
||||||
|
------. 2 = 108 = l
|
||||||
|
--------. 2 = 100 = d
|
||||||
|
>+. 3 = 33 = !
|
||||||
|
>. 4 = 10 = \n
|
||||||
Reference in New Issue