Alphuck

From Esolang
Jump to navigation Jump to search

Alphuck is a joke esoteric programming language. It is identical to brainfuck, except that alphabetic characters are used; i.e. it is a member of the trivial brainfuck substitution family of programming languages.

Commands

Brainfuck Alphuck Description
> a Move the pointer to the right
< c Move the pointer to the left
+ e Increment the memory cell under the pointer
- i Decrement the memory cell under the pointer
. j Output the character signified by the cell at the pointer
, o Input a character and store it in the cell at the pointer
[ p Jump past the matching s if the cell under the pointer is 0
] s Jump back to the matching p if the cell under the pointer is not 0

Examples

Hello, World! program

eeeeeeeepaeeeepaeeaeeeaeeeaeccccisaea
eaiaaepcscisaajaiiijeeeeeeejjeeejaajcijcjeeej
iiiiiijiiiiiiiijaaejaeej

Cat program

This cat program repeats until the user issues a null character input:

opjos

See also

Implementation

This implementation in Common Lisp exploits the language's goto facility to realize its telos:

(deftype octet ()
  "Defines an unsigned byte composed of eight accolent bits, and thus
   a commorant in the integral range [0, 255]."
  '(unsigned-byte 8))

(deftype memory ()
  "Defines the program memory as a sparse vector of unsigned bytes,
   amenable to signed integer cell indices."
  (let ((predicate (gensym)))
    (declare (type symbol predicate))
    (setf (symbol-function predicate)
      #'(lambda (candidate)
          (declare (type T candidate))
          (and (hash-table-p candidate)
               (loop
                 for    key of-type T being the hash-key in candidate
                 using  (hash-value value)
                 always (and (integerp key) (typep value 'octet))))))
    `(satisfies ,predicate)))

(defun interpret-Alphuck (code)
  "Interprets the piece of Alphuck source CODE and returns no value."
  (declare (type string code))
  (prog ((ip           0)
         (memory       (make-hash-table :test #'eql))
         (cell-pointer 0))
    (declare (type fixnum  ip))
    (declare (type memory  memory))
    (declare (type integer cell-pointer))
    
    000 (case (when (array-in-bounds-p code ip) (char code ip))
          ((NIL)     (go 100))
          (#\a       (go 010))
          (#\c       (go 020))
          (#\e       (go 030))
          (#\i       (go 040))
          (#\j       (go 050))
          (#\o       (go 060))
          (#\p       (go 070))
          (#\s       (go 080))
          (otherwise (go 090)))
    
    010 (incf cell-pointer)
        (go 90)
    
    020 (decf cell-pointer)
        (go 90)
    
    030 (setf (gethash cell-pointer memory 0)
          (mod (1+ (gethash cell-pointer memory 0)) 256))
        (go 90)
    
    040 (setf (gethash cell-pointer memory 0)
          (mod (1- (gethash cell-pointer memory 0)) 256))
        (go 90)
    
    050 (write-char (code-char (gethash cell-pointer memory 0)))
        (go 90)
    
    060 (format T "~&>> ")
        (finish-output)
        (setf (gethash cell-pointer memory) (char-code (read-char)))
        (clear-input)
        (go 90)
    
    070 (when (zerop (gethash cell-pointer memory 0))
          (loop
            initially (incf ip)
            with nesting of-type fixnum = 0
            do (cond
                 ((not (array-in-bounds-p code ip))
                   (error "Unmatched jump end point."))
                 ((and (char= (char code ip) #\s)
                       (zerop nesting))
                   (loop-finish))
                 ((and (char= (char code ip) #\s)
                       (not (zerop nesting)))
                   (decf nesting)
                   (incf ip))
                 ((char= (char code ip) #\p)
                   (incf nesting)
                   (incf ip))
                 (T (incf ip)))))
        (go 90)
    
    080 (unless (zerop (gethash cell-pointer memory 0))
          (loop
            initially (decf ip)
            with nesting of-type fixnum = 0
            do (cond
                 ((not (array-in-bounds-p code ip))
                   (error "Unmatched jump end point."))
                 ((and (char= (char code ip) #\p)
                       (zerop nesting))
                   (loop-finish))
                 ((and (char= (char code ip) #\p)
                       (not (zerop nesting)))
                   (decf nesting)
                   (decf ip))
                 ((char= (char code ip) #\s)
                   (incf nesting)
                   (decf ip))
                 (T (decf ip)))))
        (go 90)
    
    090 (incf ip)
        (go 000)
    
    100 (values)))