Execute Brain****/Elena

<lang elena>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).

].</lang> The grammar: <lang elena>[[

  #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;

]]</lang>

Output:

ELENA VM 3.2.15 (C)2005-2017 by Alex Rakov
Initializing...
Debug mode...
Done...
++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.
Hello World!