Execute SNUSP/F Sharp

From Rosetta Code
Revision as of 21:18, 27 December 2009 by rosettacode>Dkf (add header material)
Execute SNUSP/F Sharp is an implementation of SNUSP. Other implementations of SNUSP.
Execute SNUSP/F Sharp is part of RCSNUSP. You may find other members of RCSNUSP at Category:RCSNUSP.

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>