Jaidyn Levesque authored on 2020-02-01 06:01:10
Showing 4 changed files
1 1
new file mode 100644
... ...
@@ -0,0 +1,17 @@
1
+===============================================================================
2
+BRAINFUCK AHEAGO
3
+===============================================================================
4
+
5
+A simple lisp implementation of Brainfuck.
6
+Currently can work with simpler programs; but for now, it's still sorta
7
+fragile.
8
+
9
+> (bf-aheago:interpret #p"examples/hello_world.bf" :tape-length 5)
10
+
11
+
12
+————————————————————————————————————————
13
+BORING STUFF
14
+————————————————————————————————————————
15
+License is the CC0 (public domain, effectively)
16
+Author is Jaidyn Ann <jadedctrl@teknik.io>
17
+Sauce is at https://git.eunichx.us/bf-aheago.git
0 18
new file mode 100755
... ...
@@ -0,0 +1,7 @@
1
+(defsystem "bf-aheago"
2
+	   :version "0.0"
3
+           :license "CC0"
4
+	   :author "Jaidyn Ann <jadedctrl@teknik.io>"
5
+	   :description "Sequel to BF"
6
+	   :depends-on (:anaphora)
7
+	   :components ((:file "bf-aheago")))
0 8
new file mode 100644
... ...
@@ -0,0 +1,133 @@
1
+;; —————————————————————————————————————
2
+;; PACKAGE
3
+
4
+(defpackage :bf-aheago
5
+  (:use :cl :anaphora)
6
+  (:export :interpret)
7
+  (:nicknames :bf-a))
8
+
9
+(in-package :bf-aheago)
10
+
11
+;; —————————————————————————————————————
12
+;; MACROS
13
+
14
+(defmacro interpret-char (char)
15
+  `(progn 
16
+     (when debug-p (format *error-output* "~A" ,char))
17
+     (cond
18
+       ((eq ,char #\.) (output-cell tape pointer))
19
+       ((eq ,char #\,) (input-cell tape pointer))
20
+       ((eq ,char #\<) (bound-decf pointer tape-length))
21
+       ((eq ,char #\>) (bound-incf pointer tape-length))
22
+       ((eq ,char #\+) (inc-cell tape pointer))
23
+       ((eq ,char #\-) (dec-cell tape pointer))
24
+       ((eq ,char #\[) (loop-advance tape pointer input-stream))
25
+       ((eq ,char #\]) (loop-rewind tape pointer input-stream)))))
26
+
27
+;; VARYING [NUMBER] [NUMBER] → NUMBER
28
+(defmacro bound-incf (object &optional (max 256) (min 0))
29
+  "Increment (destructive) an object, but  bounds-check with #'bound-ensure."
30
+  `(setf ,object (bound-ensure (1+ ,object) ,max ,min)))
31
+
32
+;; VARYING [NUMBER] [NUMBER] → NUMBER
33
+(defmacro bound-decf (object &optional (max 256) (min 0))
34
+  "Decrement (destructive) an object, but  bounds-check with #'bound-ensure."
35
+  `(setf ,object (bound-ensure (1- ,object) ,max ,min)))
36
+
37
+;; —————————————————————————————————————
38
+;; INTERPRETER
39
+
40
+;; STREAM → ARRAY
41
+(defmethod interpret ((input-stream stream) &key (tape-length 30000) (debug-p nil))
42
+  "Interpret the brainfuck code within the given stream: returns the tape."
43
+  (let ((tape (make-tape tape-length))
44
+        (pointer 0))
45
+    (loop :if (not (listen input-stream))
46
+          :return tape
47
+          :do (alet (read-char input-stream)
48
+                (interpret-char it)))))
49
+
50
+(defmethod interpret ((string string) &key (tape-length 30000) (debug-p nil))
51
+  (interpret (make-input-string string) :tape-length tape-length :debug-p debug-p))
52
+
53
+(defmethod interpret ((pathname pathname) &key (tape-length 30000) (debug-p nil))
54
+  (with-open-file (stream pathname)
55
+    (interpret stream :tape-length tape-length :debug-p debug-p)))
56
+
57
+;; —————————————————————————————————————
58
+;; CELLS
59
+
60
+;; ARRAY NUMBER → NUMBER
61
+(defun inc-cell (tape index)
62
+  "Increment the given cell."
63
+  (bound-incf (aref tape index)))
64
+  ; (setf (aref tape index) (bound-ensure (1+ (aref tape index)))))
65
+
66
+;; ARRAY NUMBER → NUMBENR
67
+(defun dec-cell (tape index)
68
+  "Decrement the given cell."
69
+  (bound-decf (aref tape index)))
70
+  ; (setf (aref tape index) (bound-ensure (1- (aref tape index)))))
71
+
72
+;; ARRAY NUMBER → NIL
73
+(defun output-cell (tape index)
74
+  "Print the given cell in the tape to stdout."
75
+  (format t "~A" (code-char (aref tape index))))
76
+
77
+;; ARRAY NUMBER → CHAR
78
+(defun input-cell (tape index)
79
+  "Input a char's int into the tape at given index."
80
+  (alet (read-char *standard-input* nil 0)
81
+    (setf (aref tape index) (if (numberp it) it (char-code it)))))
82
+
83
+;; [NUMBER] → ARRAY
84
+(defun make-tape (&optional (length 30000))
85
+  "Make a clean, 0-initialized BF tape."
86
+  (make-array (list length) :initial-element 0))
87
+
88
+;; —————————————————————————————————————
89
+;; LOOPING []
90
+
91
+;; ARRAY NUMBER STREAM → NIL
92
+(defun loop-rewind (tape index stream)
93
+  "Restart the loop (move pointer to last '[') if nonzero cell value."
94
+  (if (not (zerop (aref tape index)))
95
+    (stream-rewind-to stream #\[)))
96
+
97
+;; ARRAY NUMBER STREAM → NIL
98
+(defun loop-advance (tape index stream)
99
+  "Skip the loop (move to next ']') if cell value is zero."
100
+  (if (zerop (aref tape index))
101
+    (stream-advance-to stream #\])))
102
+
103
+;; —————————————————————————————————————
104
+;; STREAM MANIP
105
+
106
+;; STREAM → CHAR
107
+(defun retroread-char (stream)
108
+  "Read the previous character in a file-stream."
109
+  (alet (file-position stream)
110
+    (file-position stream (- it 2)))
111
+  (read-char stream))
112
+
113
+;; STREAM CHAR → NIL
114
+(defun stream-advance-to (stream char)
115
+  "Advance a stream's pointer until the given character is read."
116
+  (if (not (eq char (read-char stream)))
117
+    (stream-advance-to stream char)))
118
+
119
+;; STREAM CHAR → NIL
120
+(defun stream-rewind-to (stream char)
121
+  "Reverse a stream's pointer until the given character is read."
122
+  (if (not (eq char (retroread-char stream)))
123
+    (stream-rewind-to stream char)))
124
+
125
+;; —————————————————————————————————————
126
+;; MISC
127
+
128
+;; NUMBER [NUMBER] [NUMBER]
129
+(defun bound-ensure (number &optional (max 256) (min 0))
130
+  "Ensure the given number remains within the given bounds (with overflow)."
131
+  (cond ((> min number) (bound-ensure (+ number max) max min))
132
+        ((< max number) (bound-ensure (- max number) max min))
133
+        (T number)))
0 134
new file mode 100644
... ...
@@ -0,0 +1,31 @@
1
+"Hello world!" from https://github.com/leachim6/
2
+Only uses five cells; no wrapping nor under/overflow
3
+
4
+	[
5
+		at 0
6
+		>+++++++    1: plus 7
7
+		>++++++++++ 2: plus 10
8
+                >+++        3: plus 3
9
+                >+          4: plus 1
10
+                <<<<-       0: decrement
11
+	]
12
+
13
+
14
+at 0
15
+0 = 0  1 = 70  2 = 100  3 = 30  4 = 10
16
+
17
+>++.      1 = 72  = H
18
+>+.       2 = 101 = e
19
+
20
+>++.      3 = 32  = ' '
21
+<<+++++++++++++++.
22
+          1 = 87 = W
23
+>.        2 = 111 = o
24
+------.   2 = 108 = l
25
+--------. 2 = 100 = d
26
+>+.       3 = 33  = ! 
27
+>.        4 = 10  = \n