++C+=C++ + ++C;

From Esolang
Jump to navigation Jump to search

This is still a work in progress. It may be changed in the future.

++C+=C++ + ++C; is an esolang by User:FiveUnderlines. Please make sure you don't spell any different characters.

Description

The name of esolang looks like a classic undefined behavior in C++.In fact, it is a brainfuck dialect.

Commands

Command Mode
0 1
C Switch the modes.
+ Decrement the current cell by one.
brainfuck equivalent: -.
Increment the current cell by one.
brainfuck equivalent: +.
= Move the cell pointer one step to the left.
brainfuck equivalent: <.
Move the cell pointer one step to the right.
brainfuck equivalent: >.
, Print the character whose ASCII code equals the current cell value to the standard output.
brainfuck equivalent: ..
Query the standard input for a character and store its ASCII code in the current cell.
brainfuck equivalent: ,.
( If the current cell value equals zero, jump forward past the matching ).
brainfuck equivalent: [.
) If the current cell value does not equal zero, jump back to the matching (.
brainfuck equivalent: ].
; End the program immediately.

Please make sure there is one at the end of your program ;, otherwise,it may cause runtime errors.

Some program examples

Cat

C+C(C,);

Truth-machine

C,C,C=++++++(C+=++++++++C=)
+++++++++++++++++++++++++++++++++++++++++++++++++
C=(C=C,=);

Implementations

The following proposes a tentative implementation in Common Lisp:

(deftype list-of (&optional (element-type T))
  "Defines a list composed of zero or more members of the ELEMENT-TYPE."
  (let ((predicate (gensym)))
    (declare (type symbol predicate))
    (setf (symbol-function predicate)
      #'(lambda (candidate)
          (declare (type T candidate))
          (and (listp candidate)
               (loop
                 for    element of-type T in (the list candidate)
                 always (typep element element-type)))))
    `(satisfies ,predicate)))

(deftype hash-table-of (&optional (key-type T) (value-type T))
  "Defines a hash table whose zero or more entries are composed of keys
   of the KEY-TYPE which associate with values of the VALUE-TYPE."
  (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-keys in (the hash-table candidate)
                 using (hash-value value)
                 always (and (typep key   key-type)
                             (typep value value-type))))))
    `(satisfies ,predicate)))

(deftype jump-table ()
  "Connects the forward jump and back jump commands in a program by
   mediation of their positions in the code."
  '(hash-table-of fixnum fixnum))

(deftype octet ()
  "An unsigned byte compact of eight adjacent bits, covering the
   integral range [0, 255]."
  '(unsigned-byte 8))

(deftype memory ()
  "The program memory as a sparse vector of unsigned-byte-valued cells,
   implemented as a hash table whose keys provide the indices to the
   cell objects as the entry values."
  '(hash-table-of integer octet))

(deftype mode ()
  "The mode as a bit-valued switch."
  'bit)

(deftype destination ()
  "Defines a sink for output operations."
  '(or null (eql T) stream string))

(define-condition Runtime-Error (error)
  ((position
    :initarg       :position
    :initform      (error "No position specified.")
    :reader        runtime-error-position
    :type          fixnum
    :documentation "The missing semicolon position in the code."))
  (:report
    (lambda (condition stream)
      (declare (type Runtime-Error condition))
      (declare (type destination   stream))
      (format stream "No semicolon found at position ~d."
        (runtime-error-position condition))))
  (:documentation
    "Serves to signal a missing semicolon (\";\")."))

(defun generate-jump-table (code)
  "Connects the forward and back jump points in the ++C+=C++ + ++C;
   CODE by adminicle of a jump table, which is subsequently returned."
  (declare (type string code))
  (let ((jump-table          (make-hash-table :test #'eql))
        (forward-jump-points NIL))
    (declare (type jump-table       jump-table)
             (type (list-of fixnum) forward-jump-points))
    (loop
      for token    of-type character across code
      and position of-type fixnum    from   0 by 1
      if (char= token #\() do
        (push position forward-jump-points)
      else if (char= token #\)) do
        (if forward-jump-points
          (let ((start-point (pop forward-jump-points))
                (end-point   position))
            (declare (type fixnum start-point))
            (declare (type fixnum end-point))
            (setf (gethash start-point jump-table) end-point)
            (setf (gethash end-point   jump-table) start-point))
          (error "Unmatched jump end point at position ~d." position))
      finally
        (when forward-jump-points
          (error "Unmatched jump start points at positions ~{~d~^, ~}."
            forward-jump-points)))
    (the jump-table jump-table)))

(defun interpret-|++C+=C++ + ++C;| (code)
  "Interprets the piece of \"++C+=C++ + ++C;\" CODE and returns NIL."
  (declare (type string code))
  (let ((ip              0)
        (instruction     (when (plusp (length code))
                           (char code 0)))
        (jump-table      (generate-jump-table code))
        (mode            0)
        (memory          (make-hash-table :test #'eql))
        (cell-pointer    0)
        (semicolon-set-p NIL))
    (declare (type fixnum              ip)
             (type (or null character) instruction)
             (type jump-table          jump-table)
             (type mode                mode)
             (type memory              memory)
             (type integer             cell-pointer)
             (type boolean             semicolon-set-p))
    (labels
        ((advance ()
          "Advances the instruction pointer (IP) to the next location."
          (setf instruction
            (when (array-in-bounds-p code (1+ ip))
              (char code (incf ip))))
          (values))
         
         (jump ()
          "Moves the instruction pointer (IP) to the jump destination."
          (setf ip (or (gethash ip jump-table)
                       (error "No jump point at ~d." ip)))
          (values))
         
         (switch-mode ()
          "Flips the mode switch."
          (setf mode (- 1 mode))
          (values))
         
         (current-cell ()
          "Returns the byte value stored in the current cell."
          (the octet (gethash cell-pointer memory 0)))
         
         ((setf current-cell) (new-value)
          "Stores the NEW-VALUE in the memory, on necessity wrapping it
           around into the range [0, 255] prior to its admission."
          (declare (type integer new-value))
          (setf (gethash cell-pointer memory 0) (mod new-value 256))
          (values)))
      (loop while instruction do
        (case instruction
          ((NIL) (loop-finish))
          (#\C (switch-mode))
          (#\+ (case mode
                 (0 (decf (current-cell)))
                 (1 (incf (current-cell)))
                 (T (error "Invalid mode: ~d." mode))))
          (#\= (case mode
                 (0 (decf cell-pointer))
                 (1 (incf cell-pointer))
                 (T (error "Invalid mode: ~d." mode))))
          (#\, (case mode
                 (0 (write-char (code-char (current-cell))))
                 (1 (format T "~&>> ")
                    (finish-output)
                    (setf (current-cell) (char-code (read-char)))
                    (clear-input))
                 (T (error "Invalid mode: ~d." mode))))
          (#\( (when (zerop (current-cell))
                 (jump)))
          (#\) (unless (zerop (current-cell))
                 (jump)))
          (#\; (setf semicolon-set-p T)
               (loop-finish))
          (T   NIL))
        (advance))
      (unless semicolon-set-p
        (error 'Runtime-Error :position ip)))))