wepmlrio

wepmlrio is a brainfuck derivative. It has the same instructions but...

Replace the brainfuck command	with	that has the Morse sequence
[	w	.--
]	e	.
+	p	.--.
-	m	--
<	l	.-..
>	r	.-.
,	I	..
.	o	---

It's aimed at being easily trasmitted through international morse code communication channels.

Examples

Hello, World!

The following program issues the message “Hello, World!” to the standard output conduit:

pwmmrmwrrprmmmmmllelmmlmmmermorrrporroopppworellllopppommmmmmollmorrrrpo

Cat Program

An infinitely repeating cat program, whose cessation can only be instigated with an input of the null character, is presented below:

IowIoe

Truth-Machine

This program describes a truth-machine:

Iowmmrpwrrelwoelle

See also

Btjzxgquartfrqifjlv, another Morse code-based language trivial brainfuck substitution

Morsefuck, a brainfuck equivalent which veridically employs Morse code

Implementation

The following provides an implementation of wepmlrio in the Common Lisp programming language. Its nimiety is founded upon the employment of parser combinators. The parsers assemble S-expressions which are evaluated by the Lisp interpreter in lieu of a custom interpretation solution.

(defstruct (State (:constructor make-state (source position))) source position)
(defstruct (Result (:constructor make-result (success-p &optional state output))) success-p state output)

(defun advance-state (state)
  (declare (type State state))
  (the State (make-state (state-source state) (1+ (state-position state)))))

(defun state-element (state)
  (declare (type State state))
  (the (or null character)
    (when (array-in-bounds-p (state-source state) (state-position state))
      (char (state-source state) (state-position state)))))

(defmacro define-parser ((state-variable) &body body)
  `(the function
     #'(lambda (,state-variable)
         (declare (type state ,state-variable) (ignorable ,state-variable))
         (the Result (progn ,@body)))))

(defun probe-element (predicate)
  (declare (type (function ((or null character)) *) predicate))
  (define-parser (state)
    (if (funcall predicate (state-element state))
      (make-result T   (advance-state state) (state-element state))
      (make-result NIL state))))

(defun character-of (expected-character)
  (declare (type character expected-character))
  (probe-element
    #'(lambda (character)
        (declare (type (or null character) expected-character))
        (and character (char= character expected-character)))))

(defun parse-eof ()
  (probe-element
    #'(lambda (character)
        (declare (type (or null character) character))
        (null character))))

(defun return-output (output)
  (declare (type T output))
  (define-parser (state)
    (the Result (make-result T state output))))

(defun parse-choice (&rest choices)
  (declare (type list choices))
  (define-parser (state)
    (loop for choice of-type function in choices
          for result of-type result   = (funcall choice state)
          when (result-success-p result) do (return result)
          finally (return (make-result NIL state)))))

(defun parse-all (&rest parsers)
  (declare (type list parsers))
  (define-parser (state)
    (loop for new-state of-type state = state then (result-state result)
          for parser    of-type function in parsers
          for result    of-type result   = (funcall parser new-state)
          when (not (result-success-p result)) do (return (make-result NIL (result-state result)))
          finally (return result))))

(defun monadic-bind (antecedent parser-generator)
  (declare (type function  antecedent) (type (function (*) function) parser-generator))
  (define-parser (state)
    (let ((antecedent-result (funcall antecedent state)))
      (declare (type result antecedent-result))
      (if (result-success-p antecedent-result)
        (funcall (funcall parser-generator (result-output antecedent-result)) (result-state antecedent-result))
        antecedent-result))))

(defmacro bind-let ((output-variable antecedent) &body body)
  `(monadic-bind ,antecedent #'(lambda (,output-variable) ,@body)))

(defun parse-between (open-guard close-guard body)
  (declare (type function open-guard close-guard body))
  (parse-all open-guard (bind-let (output body) (parse-all close-guard (return-output output)))))

(defun parse-command ()
  (define-parser (state)
    (funcall (parse-choice
               (parse-between (character-of #\w) (character-of #\e)
                 (bind-let (loop-body (parse-block)) (return-output `(loop until (zerop current-cell) do ,@loop-body))))
               (parse-all (character-of #\p) (return-output '(incf current-cell)))
               (parse-all (character-of #\m) (return-output '(decf current-cell)))
               (parse-all (character-of #\l) (return-output '(decf pointer)))
               (parse-all (character-of #\r) (return-output '(incf pointer)))
               (parse-all (character-of #\I) (return-output '(progn (format T "~&>> ")
                                               (setf current-cell (prog1 (char-code (read-char)) (clear-input))))))
               (parse-all (character-of #\o) (return-output '(write-char (code-char current-cell)))))
             state)))

(defun parse-many (parser)
  (declare (type function parser))
  (define-parser (state)
    (loop for new-state of-type state  = state then (result-state result)
          for result    of-type result = (funcall parser new-state)
          if (result-success-p result) collect (result-output result) into outputs else do (loop-finish)
          finally (return (make-result T (result-state result) outputs)))))

(defun skip-comments ()
  (define-parser (state)
    (make-result T
      (make-state (state-source state)
        (or (position-if #'(lambda (c) (find c "wepmlrIo" :test #'char=)) (state-source state)
              :start (state-position state))
            (length (state-source state)))))))

(defun expected-end-of-program ()
  (parse-all (skip-comments) (parse-eof)))

(defun parse-block ()
  (parse-many (parse-all (skip-comments) (parse-command))))

(defun parse-program ()
  (bind-let (instructions (parse-block)) (parse-all (expected-end-of-program) (return-output instructions))))

(defmacro interpret-wepmlrio (code)
  `(let ((memory  (make-hash-table :test #'eql)) (pointer 0))
     (declare (type hash-table memory) (ignorable memory) (type integer pointer) (ignorable pointer))
     (flet ((current-cell        ()          (gethash pointer memory 0))
            ((setf current-cell) (new-value) (setf (gethash pointer memory 0) (mod new-value 256))))
       (symbol-macrolet ((current-cell (current-cell)))
         ,@(let ((result (funcall (parse-program) (make-state code 0))))
             (declare (type result result))
             (if (result-success-p result)
               (result-output result)
               (error "Invalid wepmlrio program.")))))))