Data commit

Task/Execute-Brain-/PicoLisp/execute-brain--1.l

@@ -0,0 +1,48 @@
+(off "Program")
+
+(de compile (File)
+   (let Stack NIL
+      (setq "Program"
+         (make
+            (in File
+               (while (char)
+                  (case @
+                     (">"
+                        (link
+                           '(setq Data
+                              (or
+                                 (cddr Data)
+                                 (con (cdr Data) (cons 0 (cons Data))) ) ) ) )
+                     ("<"
+                        (link
+                           '(setq Data
+                              (or
+                                 (cadr Data)
+                                 (set (cdr Data) (cons 0 (cons NIL Data))) ) ) ) )
+                     ("+" (link '(inc Data)))
+                     ("-" (link '(dec Data)))
+                     ("." (link '(prin (char (car Data)))))
+                     ("," (link '(set Data (char (read)))))
+                     ("["
+                        (link
+                           '(setq Code
+                              ((if (=0 (car Data)) cdar cdr) Code) ) )
+                        (push 'Stack (chain (cons))) )
+                     ("]"
+                        (unless Stack
+                           (quit "Unbalanced ']'") )
+                        (link
+                           '(setq Code
+                              ((if (n0 (car Data)) cdar cdr) Code) ) )
+                        (let (There (pop 'Stack)  Here (cons There))
+                           (chain (set There Here)) ) ) ) ) ) ) )
+      (when Stack
+         (quit "Unbalanced '['") ) ) )
+
+(de execute ()
+   (let Data (cons 0 (cons))              # Create initial cell
+      (for (Code "Program"  Code)         # Run program
+         (eval (pop 'Code)) )
+      (while (cadr Data)                  # Find beginning of data
+         (setq Data @) )
+      (filter prog Data '(T NIL .)) ) )   # Return data space

Task/Execute-Brain-/PicoLisp/execute-brain--2.l

@@ -0,0 +1,58 @@
+(de brackets (Lst)
+   (let S NIL
+      (make
+         (for (I . X) Lst
+            (case X
+               ("[" (push 'S I))
+               ("]"
+                  (unless S (quit "Unbalanced '['"))
+                  (link (list (pop 'S) I)) ) ) )
+         (when S (quit "Unbalanced ']'")) ) ) )
+
+(de lupbra (Lst N)
+   (find
+      '((I)
+         (or
+            (= (car I) N)
+            (= (cadr I) N) ) )
+      Lst ) )
+
+(de brain (L)
+   (let
+      (D (0)
+         DH 1
+         DL 1
+         CH 1
+         CL (length L)
+         B (brackets L) )
+      (loop
+         (case (get L CH)
+            (>
+               (inc 'DH)
+               (when (> DH DL)
+                  (setq D (insert DH D 0))
+                  (inc 'DL) ) )
+            (<
+               (dec 'DH)
+               (when (< DH 1)
+                  (setq D (insert DH D 0))
+                  (inc 'DL)
+                  (one DH) ) )
+            (+ (inc (nth D DH)))
+            (- (dec (nth D DH)))
+            (. (prin (char (get D DH))))
+            ("," (set (nth D DH) (char (key))))
+            ("["
+               (when (=0 (get D DH))
+                  (setq CH (cadr (lupbra B CH))) ) )
+            ("]"
+               (when (n0 (get D DH))
+                  (setq CH (car (lupbra B CH))) ) ) )
+         (inc 'CH)
+         (T (> CH CL)) ) ) )
+
+(brain (chop ">+++++++++[<++++++++>-]<.>+++++++[<++++>-]<+.+++++++..+++.[-]
+>++++++++[<++++>-] <.>+++++++++++[<++++++++>-]<-.--------.+++.------.---
+-----.[-]>++++++++[<++++>- ]<+.[-]++++++++++." ) )
+
+(bye)