Execute Brain****/Elena: Difference between revisions

From Rosetta Code
Content added Content deleted
No edit summary
No edit summary
Line 5: Line 5:
import extensions.
import extensions.
import extensions'scripting.
import extensions'scripting.
import extensions'dynamic'expressions.

class BFTape
class TapeAssembler
{
{
object theArray.
stack theBrackets.
object thePointer.
list<TapeExpression> theTape.
object theBrackets.
constructor new:aLength
constructor new
[
[
theArray := Array new:aLength; populate(:n) [ Integer new:0 ].
thePointer := Integer new:0.
theBrackets := Stack new.
theBrackets := Stack new.
theTape := list<TapeExpression>().
theTape append(TapeExpression Declaring("ptr")).
theTape append(TapeExpression Assigning("ptr", TapeExpression Constant(0))).
]
]
constructor new : assembly_program
append
<= new;
[
[
theArray[thePointer] append:1.
assembly_program($self).
]
open
[
theBrackets push(theTape).
theTape := list<TapeExpression>().
]
]
reduce
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(
theArray[thePointer] reduce:1.
TapeExpression Constant(console),
"write",
TapeExpression MessageCall(
TapeExpression Variable("tape"),
"getAt",
TapeExpression Variable("ptr")
))).
]
]
next
next
[
[
thePointer append:1.
theTape append(TapeExpression Assigning(
"ptr",
TapeExpression MessageCall(
TapeExpression Variable("ptr"),
"add",
TapeExpression Constant(1)))).
]
]
previous
previous
[
[
theTape append(TapeExpression Assigning(
thePointer reduce:1.
"ptr",
TapeExpression MessageCall(
TapeExpression Variable("ptr"),
"subtract",
TapeExpression Constant(1)))).
]
]
push : bookmark
increase
[
[
theTape append(TapeExpression MessageCall(
theBrackets push:bookmark.
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))))).
]
]
pop
decrease
=> theBrackets.
input
[
[
theTape append(TapeExpression MessageCall(
theArray[thePointer] := console readChar; toInt.
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))))).

]
]
output
get
[
[
var program := TapeExpression Singleton(
console write(theArray[thePointer] toChar).
TapeExpression Method(
"eval",
TapeExpression Code(theTape array),
TapeExpression Parameter("tape"))).
var o := (program compiled)().
^(:tape) [ o eval(tape) ]
]
]
check = theArray[thePointer] != 0.
}
}


Line 68: Line 159:
console
console
writeLine:bf_program.
writeLine:bf_program.

var program := scriptEngine
var bfAssemblyProgram := scriptEngine
load path:"rules.es";
load path:"asmrules.es";
eval:bf_program.
eval(bf_program).

var bfProgram := TapeAssembler new(bfAssemblyProgram); get.
program eval:(BFTape new:1024).

var bfTape := Array new:1024; populate(:n)<int>($0).

bfProgram(bfTape).
].</lang>
].</lang>
The grammar:
The grammar:
Line 80: Line 175:
#grammar cf
#grammar cf


#define start ::= <= ( > += " 2" += " %""system'dynamic'tapeOp.tape_var[]""" => commands <= " *" "system'dynamic'Tape" "=" # ) =>;
#define start ::= <= ( > => commands <= " * system'dynamic'ClosureTape= " # ) =>;


#define commands ::= command commands;
#define commands ::= command commands;
Line 86: Line 181:
#define commands ::= $eof;
#define commands ::= $eof;


#define command ::= <= += " %""output[0]"" " => ".";
#define command ::= <= += " %""output[0]"" system'dynamic'MessageClosure ^""new[1]"" " => ".";
#define command ::= <= += " %""input[0]"" " => ",";
#define command ::= <= += " %""input[0]"" system'dynamic'MessageClosure ^""new[1]"" " => ",";
#define command ::= <= += " %""previous[0]"" " => "<";
#define command ::= <= += " %""previous[0]"" system'dynamic'MessageClosure ^""new[1]"" " => "<";
#define command ::= <= += " %""next[0]"" " => ">";
#define command ::= <= += " %""next[0]"" system'dynamic'MessageClosure ^""new[1]"" " => ">";
#define command ::= <= += " %""append[0]"" " => "+";
#define command ::= <= += " %""increase[0]"" system'dynamic'MessageClosure ^""new[1]"" " => "+";
#define command ::= <= += " %""reduce[0]"" " => "-";
#define command ::= <= += " %""decrease[0]"" system'dynamic'MessageClosure ^""new[1]"" " => "-";
#define command ::= <= += " -2" += " %""system'dynamic'tapeOp.tape_ptr[]"" " += " 1" += " %""system'dynamic'tapeOp.tape_stack[]"" " += "%""push[1]"" " => "[";
#define command ::= <= += " %""open[0]"" system'dynamic'MessageClosure ^""new[1]"" " => "[";
#define command ::= <= += " 0" += " %""system'dynamic'tapeOp.tape_stack[]"" " += " %""check[0]"" " += " 1" += " %""system'dynamic'tapeOp.tape_stack[]"" " += " %""pop[0]"" " += " %""system'dynamic'tapeOp.tape_jumpif[]"" " => "]";
#define command ::= <= += " %""close[0]"" system'dynamic'MessageClosure ^""new[1]"" " => "]";


#define comment ::= " " comments;
#define comment ::= " " comments;

Revision as of 12:28, 4 January 2018

<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!
Retrieved from "https://rosettacode.org/wiki/Execute_Brain****/Elena?oldid=236491"