RCSNUSP/Mathematica

From Rosetta Code
Revision as of 23:16, 1 November 2015 by rosettacode>LegionMammal978 (Created page with "<lang Mathematica>$IterationLimit = Infinity; next[{x_, y_}, dir_] := {x, y} + Switch[dir, Up, {0, -1}, Down, {0, 1}, Left, {-1, 0}, Right, {1, 0}]; lurd[dir_] := ...")
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)

<lang Mathematica>$IterationLimit = Infinity; next[{x_, y_}, dir_] := {x, y} +

  Switch[dir, Up, {0, -1}, Down, {0, 1}, Left, {-1, 0}, 
   Right, {1, 0}];

lurd[dir_] :=

 Switch[dir, Up, Left, Down, Right, Left, Up, Right, Down];

ruld[dir_] :=

 Switch[dir, Up, Right, Down, Left, Left, Down, Right, Up];

snusp[prog_, {x_, y_}, _, out_, _, _, _] /;

  x < 1 || y < 1 || y > Length[prog] || x > Length[prog1] := 
 out;

snusp[prog_, {x_, y_}, in_, out_, dir_, tape_, ptr_] /;

  progy, x == "<" := 
 snusp[prog, next[{x, y}, dir], in, out, dir, 
  If[ptr == 1, Prepend[tape, 0], tape], Max[ptr - 1, 1]];

snusp[prog_, {x_, y_}, in_, out_, dir_, tape_, ptr_] /;

  progy, x == ">" := 
 snusp[prog, next[{x, y}, dir], in, out, dir, 
  If[ptr == Length[tape], Append[tape, 0], tape], ptr + 1];

snusp[prog_, {x_, y_}, in_, out_, dir_, tape_, ptr_] /;

  progy, x == "+" := 
 snusp[prog, next[{x, y}, dir], in, out, dir, 
  ReplacePart[tape, ptr -> Mod[tapeptr + 1, 256]], ptr];

snusp[prog_, {x_, y_}, in_, out_, dir_, tape_, ptr_] /;

  progy, x == "-" := 
 snusp[prog, next[{x, y}, dir], in, out, dir, 
  ReplacePart[tape, ptr -> Mod[tapeptr - 1, 256]], ptr];

snusp[prog_, {x_, y_}, in_, out_, dir_, tape_, ptr_] /;

  progy, x == "," := 
 snusp[prog, next[{x, y}, dir], If[in == "", "", StringDrop[in, 1]], 
  out, dir, 
  ReplacePart[tape, 
   ptr -> If[in == "", 255, ToCharacterCode[in]1]], ptr];

snusp[prog_, {x_, y_}, in_, out_, dir_, tape_, ptr_] /;

  progy, x == "." := 
 snusp[prog, next[{x, y}, dir], in, 
  out <> FromCharacterCode[tapeptr], dir, tape, ptr];

snusp[prog_, {x_, y_}, in_, out_, dir_, tape_, ptr_] /;

  progy, x == "\\" := 
 snusp[prog, next[{x, y}, lurd[dir]], in, out, lurd[dir], tape, 
  ptr];

snusp[prog_, {x_, y_}, in_, out_, dir_, tape_, ptr_] /;

  progy, x == "/" := 
 snusp[prog, next[{x, y}, ruld[dir]], in, out, ruld[dir], tape, 
  ptr];

snusp[prog_, {x_, y_}, in_, out_, dir_, tape_, ptr_] /;

  progy, x == "!" := 
 snusp[prog, next[next[{x, y}, dir], dir], in, out, dir, tape, ptr];

snusp[prog_, {x_, y_}, in_, out_, dir_, tape_, ptr_] /;

  progy, x == "?" := 
 snusp[prog, If[tapeptr == 0, next, # &][next[{x, y}, dir], dir],
   in, out, dir, tape, ptr];

snusp[prog_, {x_, y_}, in_, out_, dir_, tape_, ptr_] :=

 snusp[prog, next[{x, y}, dir], in, out, dir, tape, ptr];

input[] :=

 Block[{l = InputString[]}, 
  If[l === EndOfFile, "", l <> "\n" <> input[]]];

If[Length[$ScriptCommandLine] < 2,

 WriteString["stderr", 
  "Usage: WolframScript -script " <> $ScriptCommandLine1 <> 
   " <file...>\n"]; Quit[]];

file = StringRiffle[$ScriptCommandLine2 ;;]; If[! FileExistsQ[file],

 WriteString["stderr", 
  "Error: File '" <> file <> "' does not exist.\n"]; Quit[]];

sProg = StringSplit[ReadString[file], "\n"]; gProg = PadRight[Characters[#], Max[StringLength /@ sProg], " "] & /@

  sProg;

Print[snusp[gProg,

  FirstPosition[gProg, 
    "$"] /. {{y_, x_} :> {x, y}, _Missing -> {1, 1}}, 
  StringDrop[input[], -1], "", Right, {0}, 1]];</lang>

Run as WolframScript -script <file> <program...>.