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.")))))))
Category:Brainfuck equivalents
Category:Languages
Category:Cell-based
Category:Brainfuck derivatives
Category:Turing complete
Category:Low-level
Category:Implemented