Execute Brain****/Elena

From Rosetta Code
import system'collections.
import system'routines.
import system'dynamic.
 
import extensions.
import extensions'scripting.
import extensions'dynamic'expressions.
 
class TapeAssembler
{
stack theBrackets.
list<TapeExpression> theTape.
 
constructor new
[
theBrackets := Stack new.
theTape := list<TapeExpression>().
 
theTape append(TapeExpression Declaring("ptr")).
theTape append(TapeExpression Assigning("ptr", TapeExpression Constant(0))).
]
 
constructor new : assembly_program
<= new;
[
assembly_program($self).
]
 
open
[
theBrackets push(theTape).
theTape := list<TapeExpression>().
]
 
close
[
var loop := TapeExpression Loop(
TapeExpression MessageCall(
TapeExpression MessageCall(
TapeExpression Variable("tape"),
"getAt",
TapeExpression Variable("ptr")
),
"notequal",
TapeExpression Constant($0)),
TapeExpression Code(theTape array)).
 
theTape := theBrackets pop.
theTape append(loop).
]
 
input
[
theTape append(TapeExpression MessageCall(
TapeExpression Variable("tape"),
"setAt",
TapeExpression Variable("ptr"),
TapeExpression MessageCall(
TapeExpression Constant(console),
"readChar"
))).
]
 
output
[
theTape append(TapeExpression MessageCall(
TapeExpression Constant(console),
"write",
TapeExpression MessageCall(
TapeExpression Variable("tape"),
"getAt",
TapeExpression Variable("ptr")
))).
]
 
next
[
theTape append(TapeExpression Assigning(
"ptr",
TapeExpression MessageCall(
TapeExpression Variable("ptr"),
"add",
TapeExpression Constant(1)))).
]
 
previous
[
theTape append(TapeExpression Assigning(
"ptr",
TapeExpression MessageCall(
TapeExpression Variable("ptr"),
"subtract",
TapeExpression Constant(1)))).
]
 
increase
[
theTape append(TapeExpression MessageCall(
TapeExpression Variable("tape"),
"setAt",
TapeExpression Variable("ptr"),
TapeExpression MessageCall(
TapeExpression Constant(CharValue),
"new",
TapeExpression MessageCall(
TapeExpression MessageCall(
TapeExpression Constant(convertor),
"toInt",
TapeExpression MessageCall(
TapeExpression Variable("tape"),
"getAt",
TapeExpression Variable("ptr"))
),
"add",
TapeExpression Constant(1))))).
]
 
decrease
[
theTape append(TapeExpression MessageCall(
TapeExpression Variable("tape"),
"setAt",
TapeExpression Variable("ptr"),
TapeExpression MessageCall(
TapeExpression Constant(CharValue),
"new",
TapeExpression MessageCall(
TapeExpression MessageCall(
TapeExpression Constant(convertor),
"toInt",
TapeExpression MessageCall(
TapeExpression Variable("tape"),
"getAt",
TapeExpression Variable("ptr"))
),
"subtract",
TapeExpression Constant(1))))).
 
]
 
get
[
var program := TapeExpression Singleton(
TapeExpression Method(
"eval",
TapeExpression Code(theTape array),
TapeExpression Parameter("tape"))).
 
var o := (program compiled)().
 
^(:tape) [ o eval(tape) ]
]
}
 
const bf_program = "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.".
 
program =
[
console
writeLine:bf_program.
 
var bfAssemblyProgram := scriptEngine
load path:"asmrules.es";
eval(bf_program).
 
var bfProgram := TapeAssembler new(bfAssemblyProgram); get.
 
var bfTape := Array new:1024; populate(:n)<int>($0).
 
bfProgram(bfTape).
].

The grammar:

[[
#grammar transform
#grammar cf
 
#define start  ::= <= ( > => commands <= " * system'dynamic'ClosureTape= " # ) =>;
 
#define commands  ::= command commands;
#define commands  ::= comment commands;
#define commands  ::= $eof;
 
#define command  ::= <= += " %""output[0]"" system'dynamic'MessageClosure ^""new[1]"" " => ".";
#define command  ::= <= += " %""input[0]"" system'dynamic'MessageClosure ^""new[1]"" " => ",";
#define command  ::= <= += " %""previous[0]"" system'dynamic'MessageClosure ^""new[1]"" " => "<";
#define command  ::= <= += " %""next[0]"" system'dynamic'MessageClosure ^""new[1]"" " => ">";
#define command  ::= <= += " %""increase[0]"" system'dynamic'MessageClosure ^""new[1]"" " => "+";
#define command  ::= <= += " %""decrease[0]"" system'dynamic'MessageClosure ^""new[1]"" " => "-";
#define command  ::= <= += " %""open[0]"" system'dynamic'MessageClosure ^""new[1]"" " => "[";
#define command  ::= <= += " %""close[0]"" system'dynamic'MessageClosure ^""new[1]"" " => "]";
 
#define comment  ::= " " comments;
#define comment  ::= "'" comments;
#define comment  ::= "!" comments;
#define comment  ::= $eol;
 
#define comments  ::= $chr comments;
#define comments  ::= $eps;
 
#mode symbolic;
]]
Output:
ELENA VM 3.2.15 (C)2005-2017 by Alex Rakov
Initializing...
Debug mode...
Done...
++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.
Hello World!