Execute SNUSP

From Rosetta Code
Task
Execute SNUSP
You are encouraged to solve this task according to the task description, using any language you may know.
Execute SNUSP is an implementation of SNUSP. Other implementations of SNUSP.

RCSNUSP is a set of SNUSP compilers and interpreters written for Rosetta Code in a variety of languages. Below are links to each of the versions of RCSNUSP.

An implementation need only properly implement the Core SNUSP instructions ('$', '\', '/', '+', '-', '<', '>', ',', '.', '!', and '?'). Modular SNUSP ('#', '@') and Bloated SNUSP (':', ';', '%', and '&') are also allowed, but not required. Any extra characters that you implement should be noted in the description of your implementation. Any cell size is allowed, EOF support is optional, as is whether you have bounded or unbounded memory.

C

See RCSNUSP/C.

D

See RCSNUSP/D.

F#

This is the "modular" version. Perhaps I'll get around to bloated later. Allows infinite size data space to the left and right of the original data pointer. I originally mistook the meaning of ',' and had the user input an arbitrary number which I would place on the tape, but after looking at the sample multiplication program, realized that I was supposed to input the ascii value of the single key entered. Still, it seems like a good command to allow for reading an arbitrary value so I arbitrarily allocated '~' as the command for that purpose. <lang fsharp>open System open System.Collections.Generic

type IP (p:(int*int), d:(int*int), dim1, dim2) =

   let mutable _p = p
   let mutable _d = d
   let mutable _fValid = true
   member this.dim1 = dim1
   member this.dim2 = dim2
   member this.x = fst this.pos
   member this.y = snd this.pos
   member this.dx = fst this.dir
   member this.dy = snd this.dir
   member this.pos with get() = _p
                   and set newp = _p <- newp
   member this.dir with get() = _d
                   and set newd = _d <- newd
   member this.Clone() = new IP((this.x, this.y), (this.dx, this.dy), dim1, dim2)
   member this.Invalidate() = _fValid <- false
   member this.SetTo(ip : IP) = this.pos <- ip.pos; this.dir <- ip.dir
   member this.Advance() =
       this.pos <- ((fst this.pos) + (fst this.dir), (snd this.pos) + (snd this.dir))
   member this.Valid() = 
       _fValid && this.x >= 0 && this.x < dim2 && this.y >= 0 && this.y < dim2
   member this.Reflect(c) =
       match c with
       | '/' -> this.dir <- (-this.dy, -this.dx)
       | '\\' -> this.dir <- (this.dy, this.dx)
       | _ -> ignore()

let RCSNUSP (pgmStr : string) =

   let StringToPgm (str : string) =
       let stringsPre =
           str.Trim([|'\n'; '\r'|]).Split([|'\n'|])
           |> Seq.map (fun s -> s.Trim([|'\n'; '\r'|]))
       let maxLen =
           stringsPre
           |> Seq.map (fun s -> s.Length)
           |> Seq.max
       let strings =
           stringsPre
           |> Seq.map (fun s -> s.PadRight(maxLen))
       strings
       |> Seq.map (fun s -> s.Trim([|'\n'; '\r'|]).ToCharArray())
       |> array2D
   let pgm = StringToPgm pgmStr
   let ptr = ref 0                                                     // Pointer into input
   let stk = new Stack<IP>()                                           // Instruction stack
   let input = ref (Array.create 100 0)
   let LocateStart pgm =
       let fFound = ref false
                  
       let s1 =
           seq {
               for i = 0 to ((Array2D.length1 pgm)-1) do
                   for j = 0 to ((Array2D.length2 pgm)-1) do
                       yield (pgm.[i,j], (j, i)) }
           |> Seq.skipWhile (fun (c, _) -> fFound := !fFound || (c = '$'); not !fFound)
           |> Seq.truncate 1
           |> Seq.toArray
       if not !fFound then
           (0,0)
       else
           s1
           |> Seq.head
           |> snd
   let ip = new IP(LocateStart pgm, (1, 0), Array2D.length1 pgm, Array2D.length2 pgm)                                // Instruction Pointer
   let InputNumber() =
       let mutable fValid = false
       let mutable num = 0
       printfn "Enter a valid number"
       fValid <- Int32.TryParse(Console.ReadLine(), &num);
       while not fValid do
           printfn "Invalid input.  Please enter a valid number"
           fValid <- Int32.TryParse(Console.ReadLine(), &num);
       num
   let InputAscii() =
       printfn "Enter an ascii character"
       let chOut = (Console.ReadKey().KeyChar)
       printfn ""
       int chOut
   let MovePtr fRight =
       if fRight then
           ptr := !ptr + 1
           if !ptr >= (!input).Length then
               Array.Resize(input, (!input).Length + 20)
       else
           ptr := !ptr - 1
           if !ptr < 0 then
               let newInput = Array.create ((!input).Length + 20) 0
               Array.ConstrainedCopy(!input, 0, newInput, 20, (!input).Length)
               ptr := 19
               
   let interpretCmd() =
       //if @"><+-.,;/\?!@#".Contains(pgm.[ip.y, ip.x].ToString()) then
       //    printfn "TapePos: %d; TapeVal: %d; Pos (%d, %d) : %c" !ptr (!input).[!ptr] ip.x ip.y pgm.[ip.y, ip.x]
       //    Console.ReadKey() |> ignore
       match pgm.[ip.y, ip.x] with
       | '>' -> MovePtr true; ip.Advance()
       | '<' -> MovePtr false; ip.Advance()
       | '+' -> (!input).[!ptr] <- (!input).[!ptr] + 1; ip.Advance()
       | '-' -> (!input).[!ptr] <- (!input).[!ptr] - 1; ip.Advance()
       | '.' -> printf "%c" (char (!input).[!ptr]); ip.Advance()
       | ',' -> (!input).[!ptr] <- InputAscii(); ip.Advance()
       | '~' -> (!input).[!ptr] <- InputNumber(); ip.Advance()
       | '/' | '\\' -> ip.Reflect(pgm.[ip.y, ip.x]); ip.Advance()
       | '?' -> ip.Advance(); if (!input).[!ptr] = 0 then ip.Advance()
       | '!' -> ip.Advance(); ip.Advance()
       | '@' -> stk.Push(ip.Clone()); ip.Advance()
       | '#' -> if stk.Count = 0 then
                   ip.Invalidate() 
                else
                   ip.SetTo(stk.Pop())
                   ip.Advance()
                   ip.Advance()
       | _ -> ip.Advance()
   while ip.Valid() do
       interpretCmd() |> ignore
   (!input).[!ptr]</lang>

Example inputs: <lang fsharp>let p1 = @"

read two characters    ,>,==\  *    /=================== ATOI   ----------\ 
convert to integers /=/@</@=/  *   // /===== ITOA  ++++++++++\ /----------/ 
           multiply @ \=!\=========/ //           /++++++++++/ \----------\ 
       convert back !/@!\============/            \++++++++++\ /----------/ 

and print the result \/ \.# * /++++++++++/ \--------# /====================/ * \++++++++# | | /-<+>\ #/?=<<<<\!>>>>\ />>+<+<-\ | #\?===/! BMOV1 =====\ \->>>>+/ // /======== BSPL2 !\======?/# | /->+<\ /===|=========== FMOV4 =/ // /<<+>+>-\ | #\?===/! FMOV1 =|===|==============\ /====/ /====== FSPL2 !\======?/# | /==|===|==============|==|=======/ | * * *|* | * | * * * * * * *|* | * * * /+<-\ | * />@/<@/>>@/>>===\ /====>>\@<\@<\ * /==== ADD2  !\>=?/<# \===== MUL2 =?/>@\==<#<<<==\ \!\<<<<@\>>>>-?/\ * // /-\

           *    \\        \/@========|======</ * //  /== ZERO  !\?/#
           * * * \\* * * * | * * * * | * * * * *//  //
                  \\       |         \==========/  //
                   \======!\=======================/

" // Should print out multiplication of two input ascii values RCSNUSP p1 |> ignore printfn "" printfn "Next three should all yield 48" printfn "value = %d" (RCSNUSP @"

   /\/\/\

$===++++++\

  /++++++/
  \++++++\
  /++++++/
  \/\/\/#

") printfn "value = %d" (RCSNUSP @"

    #/\/\

$===!\++++\

    /++++/
  /=\++++\
  \!\/\/\/

") printfn "value = %d" (RCSNUSP @"6=@@@+@+++++#") </lang>

Haskell

See RCSNUSP/Haskell.

Java

See RCSNUSP/Java

JavaScript

See RCSNUSP/JavaScript.

Ruby

See RCSNUSP/Ruby.

Tcl

See RCSNUSP/Tcl.