pointerfuck
Jump to navigation
Jump to search
pointerfuck is a brainfuck derivative made by User:Transoptimal.
Overview
Like brainfuck, pointerfuck operates on an array of integers that are initially set to 0, and has a pointer associated with the memory and initially pointing to cell 0 (the start of the memory). Unlike brainfuck, the memory can hold negative integers. There is also a call stack, containing integers. Both the memory array and the call-stack may have infinite size, and may contain unbounded integers, depending on the implementation.
Also, how input and output works is implementation-specific. Reading from input must always give an integer, and the output must be able to receive integers.
If an implementation doesn't want to specify these, it can use this default: the input is a queue of character codes, and yields 0 if you try to read from it when it's empty; the output prints numbers as their corresponding Unicode characters, and ignores negative values.
Instructions
These instructions do the same thing as in brainfuck:
+-,.
These instructions are new or have changed semantics:
[ if the current cell is not positive, goto the instruction after the matching ]. ] goto the matching [. @ push the current pointer to the call stack, then set the pointer to the value of the current cell (i.e. dereference the current cell). ! pop the call stack and set the pointer to the popped value.
As in brainfuck, all other characters are no-ops/comments/ignored.
Trying to execute ! when the call stack is empty halts the program. Trying to jump to a negative memory address also halts the program.
Examples
Note that since there currently does not exist any implementation of pointerfuck, all of these are untested.
Cat
,[.,]
This works the same way as in brainfuck. Note that it relies on the assumption that all of the input is positive, and that after reading all input trying to read more yields a non-positive value.
Double input
+@,[-!+@++!-@]++@.
This assumes that the first input value is non-negative, and outputs 2 times that value.
Walkthrough:
+@ increment cell 0 from 0 to 1, then jump to cell 1. , write input to cell 1. [ while cell 1 holds a positive number, -! decrease that number by 1, then go back to the previous pointer location, i.e. cell 0. +@ increment cell 0 from 1 to 2, then jump to cell 2. ++ increment cell 2 by 2. ! jump back to cell 0. -@ decrement cell 0 from 2 to 1, then jump to cell 1. ] end of loop. . output the value of the current cell, i.e. cell 1.
Implementation
This implementation in Common Lisp generalizes the input and output facilities via “interfaces”, concomitantly furnishing default realizations:
(defmacro define-derived-type
(type-name (candidate-variable &rest lambda-list)
&body body)
"Defines a new derived type with the TYPE-NAME, accepting the formal
parameters specified by the LAMBDA-LIST, which probes the CANDIDATE-VARIABLE
in the BODY forms and returns a generalized boolean response to the eligibility."
(let ((predicate-variable (gensym)))
(declare (type symbol predicate-variable))
`(deftype ,type-name (,@lambda-list)
,(or (and (stringp (first body)) (pop body)) "")
(let ((,predicate-variable (gensym)))
(declare (type symbol ,predicate-variable))
(setf (symbol-function ,predicate-variable)
#'(lambda (,candidate-variable)
(declare (type T ,candidate-variable) (ignorable ,candidate-variable))
,@body))
`(satisfies ,,predicate-variable)))))
(define-derived-type list-of (candidate &optional (element-type T))
"Defines a list of zero or elements of the ELEMENT-TYPE."
(and (listp candidate)
(loop for element of-type T in candidate
always (typep element element-type))))
(define-derived-type hash-table-of (candidate &optional (key-type T)
(value-type T))
"Defines a hash table whose entry keys match the KEY-TYPE and the
values the VALUE-TYPE."
(and (hash-table-p candidate)
(loop for key of-type T being the hash-keys in candidate
using (hash-value value)
always (and (typep key key-type) (typep value value-type)))))
(deftype jump-table ()
"Defines a mapping betwixt forward and back jump points in a pointerfuck program."
'(hash-table-of fixnum fixnum))
(deftype stack-of (&optional (element-type T))
"Defines a list-based stack containing elements of the ELEMENT-TYPE."
`(list-of ,element-type))
(deftype unsigned-integer ()
"Defines a non-negative integer number."
'(integer 0 *))
(deftype tape ()
"Defines a sparse vector of signed integers."
'(hash-table-of unsigned-integer integer))
(deftype call-stack ()
"Defines the call stack as a stack composed of non-negative integers."
'(list-of unsigned-integer))
(defun compute-jump-table (code)
"Returns a new jump table for the piece of pointerfuck source CODE."
(declare (type string code))
(let ((jump-table (make-hash-table :test #'eql))
(start-points NIL))
(declare (type jump-table jump-table) (type (stack-of fixnum) start-points))
(loop for token of-type character across code and position of-type fixnum from 0
if (char= token #\[) do
(push position start-points)
else if (char= token #\]) do
(if start-points
(let ((start-point (pop start-points)))
(declare (type fixnum start-point))
(psetf (gethash start-point jump-table) position
(gethash position jump-table) start-point))
(error "Unmatched \"]\ at position ~d." position)))
(when start-points
(error "Unmatched \"[\" at position~p ~{~d~^, ~}."
(length start-points) start-points))
(the jump-table jump-table)))
(defclass Input ()
()
(:documentation "Defines an interface for input sources."))
(defgeneric handle-input (input)
(:documentation "Returns a signed integer number from the INPUT."))
(defclass Console-Input (Input)
()
(:documentation "Establishes an input source relying on the standard input."))
(defun make-console-input ()
"Creates and returns a new console-based input facility."
(the Console-Input (make-instance 'Console-Input)))
(defmethod handle-input ((input Console-Input))
(declare (type Console-Input input) (ignore input))
(format T "~&>> ")
(finish-output)
(the integer
(prog1 (parse-integer (read-line NIL NIL 0))
(clear-input))))
(defclass Queued-Input (Input)
((elements :initarg :elements
:initform (error "Missing elements.")
:accessor input-elements
:type (list-of integer)
:documentation "The queue of predefined input elements."))
(:documentation "Furnishes an input source founded upon a fixed queue of integer elements."))
(defun make-numeric-input-queue (&optional (elements NIL))
"Creates and returns a queued input responding with the ELEMENTS."
(declare (type (list-of integer) elements))
(the Queued-Input (make-instance 'Queued-Input :elements (copy-list elements))))
(defun make-text-input-queue (input-message)
"Creates and returns a queued input responding with the INPUT-MESSAGE's character codes."
(declare (type string input-message))
(the Queued-Input (make-instance 'Queued-Input :elements (map 'list #'char-code input-message))))
(defmethod handle-input ((input Queued-Input))
(declare (type Queued-Input input))
(the integer (or (and (input-elements input) (pop (input-elements input))) 0)))
(defclass Output ()
()
(:documentation "Defines the interface for an output facility."))
(defgeneric handle-output (output argument)
(:documentation "Transfers the signed integer ARGUMENT to the OUTPUT facility."))
(defclass Console-Output (Output)
()
(:documentation
"Implements an output facility which prints integers arguments as their
corresponding Unicode characters."))
(defun make-console-output ()
"Creates and returns a new console-based output."
(the Console-Output (make-instance 'Console-Output)))
(defmethod handle-output ((output Console-Output) (argument integer))
(declare (type Console-Output output) (ignore output) (type integer argument))
(unless (minusp argument)
(format T "~c" (code-char argument)))
(values))
(defun interpret-pointerfuck (code &key (input (make-console-input))
(output (make-console-output)))
"Interprets the piece of pointerfuck source CODE utilizing the INPUT
and OUTPUT facilities, and returns no value."
(declare (type string code))
(declare (type Input input))
(declare (type Output output))
(let ((ip 0)
(jump-table (compute-jump-table code))
(tape (make-hash-table :test #'eql))
(cell-pointer 0)
(call-stack NIL))
(declare (type fixnum ip) (type jump-table jump-table)
(type call-stack call-stack) (type tape tape)
(type unsigned-integer cell-pointer))
(loop while (array-in-bounds-p code ip) do
(case (char code ip)
(#\+ (incf (gethash cell-pointer tape 0))
(incf ip))
(#\- (decf (gethash cell-pointer tape 0))
(incf ip))
(#\> (incf cell-pointer)
(incf ip))
(#\< (when (plusp cell-pointer)
(decf cell-pointer))
(incf ip))
(#\, (setf (gethash cell-pointer tape 0) (handle-input input))
(incf ip))
(#\. (handle-output output (gethash cell-pointer tape 0))
(incf ip))
(#\[ (unless (plusp (gethash cell-pointer tape 0))
(setf ip (gethash ip jump-table)))
(incf ip))
(#\] (setf ip (gethash ip jump-table)))
(#\@ (push cell-pointer call-stack)
(let ((current-cell-value (gethash cell-pointer tape 0)))
(declare (type integer current-cell-value))
(cond
((>= current-cell-value 0)
(setf cell-pointer current-cell-value)
(incf ip))
(T
(loop-finish)))))
(#\! (cond
(call-stack
(setf cell-pointer (pop call-stack))
(incf ip))
(T
(loop-finish))))
(otherwise (incf ip)))))
(values))