Execute SNUSP/F Sharp
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. Bloated version below this modular version. Somehow this page has been set up so I can't seem to change the original comments to note this fact. Probably I'm just too dumb to know now. <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>
Okay, I did the bloated version and made a few other changes. Using * rather than ~ for inputting a number because it's easy for ~ to get lost in the visual sea of characters that makes up the typical program. Also made separate classes for the engine and the IP. I allow for infinite data space in both directions and threads not waiting for input run while other threads are blocked on input. I tried this on all the programs I could find. There don't appear to be any which really utilize the 2D data space, but I tested it with some simple test programs and it seems okay. <lang fsharp>// Bloated RCSNUSP open System open System.Collections.Generic
type IP (p:(int*int), d:(int*int), dim1, dim2) =
let mutable _p = p // Current instruction position
let mutable _d = d // Current direction we're headed
let mutable _fValid = true // Override telling us we're invalid
let mutable _dataptr = (0, 0) // Data Pointer
let _callStack = new Stack<IP>() // Call stack
let _dim1 = dim1 // Dimensions of our instruction space
let _dim2 = dim2
// Some properties for the above
member t.pos with get() = _p
and set newp = _p <- newp
member t.dir with get() = _d
and set newd = _d <- newd
member t.dataptr with get() = _dataptr
and set newp = _dataptr <- newp
member t.x = fst t.pos // X value of our instruction pointer
member t.y = snd t.pos // Y value of our instruction pointer
member t.dx = fst t.dir // X value of our direction
member t.dy = snd t.dir // Y value of our direction
member private t.Clone() = new IP((t.x, t.y), (t.dx, t.dy), _dim1, _dim2)
// Used for call/return where we don't need the data pointer
member t.Split() =
let newThread = t.Clone() // New thread starts with same position/direction
newThread.dataptr <- t.dataptr // but also inherits the same data position
newThread
member t.Invalidate() = _fValid <- false
member t.SetTo(ip : IP) = t.pos <- ip.pos; t.dir <- ip.dir
member t.Advance() = t.pos <- ((fst t.pos) + (fst t.dir), (snd t.pos) + (snd t.dir))
// All important Advance moves the IP in the current direction
member t.InRange() =
t.x >= 0 && t.x < _dim2 && t.y >= 0 && t.y < _dim1 // See if the IP is still in instruction space
member t.Valid() = _fValid && t.InRange() // See if we're valid
member t.Reflect(c) =
match c with // See which character we're dealing with
| '/' -> t.dir <- (-t.dy, -t.dx) // and do the
| '\\' -> t.dir <- (t.dy, t.dx) // right thing
| _ -> ignore()
member t.Return() =
if _callStack.Count = 0 then // If there's nothing on the call stack to return to
t.Invalidate() // kill ourselves
else
t.SetTo(_callStack.Pop()) // Otherwise, retrieve the old position and direction
t.Advance() // and advance twice to continue
t.Advance()
member t.Call() =
_callStack.Push(t.Clone()) // Push our return point onto the stack
type SNUSP (pgmStr : string) =
let _pgm =
let stringsPre =
pgmStr.Trim([|'\n'; '\r'|]).Split([|'\n'|]) // Trim off any initial CR/LFs and split at internal CRs
|> Seq.map (fun s -> s.Trim([|'\n'; '\r'|])) // We may or may not still have left over 'n' and 'r's hanging around
let maxLen =
stringsPre // Array of stripped program lines
|> Seq.map (fun s -> s.Length) // Find their length
|> Seq.max // and take the max
let strings =
stringsPre // Array of stripped program lines
|> Seq.map (fun s -> s.PadRight(maxLen)) // Pad them all the the max length
strings
|> Seq.map (fun s -> s.ToCharArray()) // Turn all the lines to char arrays
|> array2D // Turn the whole thing into a 2D array
let LocateStart pgm =
let fFound = ref false
let s1 =
// It seems like this should just be an imperative nested for, but since F# doesn't have a break statement, once you
// start into a for you have to go all the way through it. The sequence below will stop as soon as it finds the '$'.
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)) } // Sequence of (value, position) pairs
|> Seq.skipWhile (fun (c, _) -> fFound := !fFound || (c = '$'); not !fFound)
// Keep track of whether we found a '$" and only keep the good stuff
|> Seq.truncate 1 // Stop as soon as we've found the '$'
|> Seq.toArray // Required to keep lazy evaluations from not actually finding anything at all
if not !fFound then // No '$' means start at (0,0)
(0,0)
else
s1
|> Seq.head // else, the only value in the sequence is our '$'
|> snd // and the second value in it is it's position
let _ips =
let ret = new List<IP>() // list of currently active IPs
ret.Add(new IP(LocateStart _pgm, (1, 0), Array2D.length1 _pgm, Array2D.length2 _pgm))
// Add our initial IP into it
ret
let _data2d = ref (Array2D.create 10 10 0) // 2D data space let mutable _fWaitingForKey = false // So we can handle ',' operator nicely let _lstSplitIps = new List<IP>() // List of IPs to be deleted after the current tick let _rnd = new Random() let mutable _builtString = ""
member private t.ips = ref _ips
member private t.ipLastRemoved = ref (new IP((0,0), (0,0), 0, 0))
// Last IP removed (for return value)
member t.ReturnValue() = t.GetData (!t.ipLastRemoved) // Return value
member private t.InputNumber() =
let mutable out = None // No valid values yet
if not _fWaitingForKey then // If necessary
_fWaitingForKey <- true
printf "Enter a valid number: " // Ask the user for a number
if Console.KeyAvailable then // If the user has pressed a key
let chNext = Console.ReadKey().KeyChar // get the key
if chNext = '\r' then // If they pressed enter
printfn ""
let mutable num = 0 // set up a number to receive the final value
let fValid = Int32.TryParse(_builtString, &num) // see if they entered a valid value
if fValid then // If they did, then
out <- Some(num) // Set our output to it
_fWaitingForKey <- false // And stop checking for keys
else // else
printf "Invalid input. Please enter a valid number: "
// prompt for a valid value
_builtString <- "" // and reset the built string
else
_builtString <- _builtString + chNext.ToString() // if no enter, just append the value to the built up string
out // return our output
member private t.InputAscii() =
if not _fWaitingForKey then // If we haven't put up the prompt yet
_fWaitingForKey <- true // keep track of the fact that we have
printf "Enter an ascii character: " // and put the prompt up
if Console.KeyAvailable then // If there are keys available
let chOut = Console.ReadKey().KeyChar // Get the key
_fWaitingForKey <- false // Allow the prompt to be put up
printfn "" // print a CR,
Some(int chOut) // return with the booty
else
None // return nothing
static member private OutputAscii(c) = printf "%c" c // Print a single character
member private t.ExpandData top left bottom right =
let newInput = Array2D.create ((Array2D.length1 !_data2d) + top + bottom) (Array2D.length2 !_data2d + left + right) 0
// Create the new array with enough space
for i in [0..((Array2D.length1 !_data2d) - 1)] do // For each row
for j in [0..((Array2D.length2 !_data2d) - 1)] do // and column
newInput.[i + top, j + left] <- (!_data2d).[i,j] // Copy old data to the new array
_data2d := newInput // Switch to the new array
if top <> 0 || left <> 0 then // If necessary
!t.ips |> Seq.iter (fun ip -> (ip.dataptr <- ((fst ip.dataptr) + left, ((snd ip.dataptr) + top))))
// Change data pointers in all the IPs
member private t.MovePtr2d (ip:IP) (dx, dy) =
ip.dataptr <- ((fst ip.dataptr) + dx, (snd ip.dataptr) + dy)
// Move the pointer
match (dx, dy) with // Check the result to see if we need to expand
| (0,_) -> // Check the vertical direction
if (snd ip.dataptr) >= (Array2D.length1 !_data2d) then
// If we've overflowed the rows
t.ExpandData 0 0 10 0 // Expand on the bottom
elif (snd ip.dataptr) < 0 then // If we've underflowed the rows
t.ExpandData 10 0 0 0 // Expand on the top
| (_,0) -> // Check the horizontal direction
if (fst ip.dataptr) >= (Array2D.length2 !_data2d) then
// If we've overflowed the columns
t.ExpandData 0 0 0 10 // expand on the right
elif (fst ip.dataptr) < 0 then // If we've underflowed columns
t.ExpandData 0 10 0 0 // expand on the left
| _ -> raise <| new System.ArgumentException("Bad direction in MovePtr2d")
// This should never happen
member private t.Split(ip:IP) =
let newIp = ip.Split() // Get an IP for the new thread
newIp.Advance(); // advance it twice
newIp.Advance();
_lstSplitIps.Add(newIp) // and add it to the list of splits
member t.lstIp = !t.ips // List of active IPs
member private t.GetData (ip:IP) =
(!_data2d).[snd ip.dataptr, fst ip.dataptr] // Data being pointed at currently
member private t.SetData (ip:IP) n =
(!_data2d).[snd ip.dataptr, fst ip.dataptr] <- n // Set the value at the current position
member t.InterpretCmd(ip:IP) = // Interpret a single command for a single IP
// Rudimentary debugging aid - interferes with any input and doesn't distinguish between threads
//if @"><+-.,;:*/\?!@#".Contains(pgm.[ip.y, ip.x].ToString()) then
// printfn "TapePos: %A; TapeVal: %d; Pos (%d, %d) : %c" ip.dataptr (t.GetData ip) ip.x ip.y _pgm.[ip.y, ip.x]
// Console.ReadKey() |> ignore
if ip.Valid() then
match _pgm.[ip.y, ip.x] with
| '>' -> t.MovePtr2d ip (1, 0); ip.Advance()
| '<' -> t.MovePtr2d ip (-1, 0); ip.Advance()
| ';' -> t.MovePtr2d ip (0, 1); ip.Advance()
| ':' -> t.MovePtr2d ip (0, -1); ip.Advance()
| '+' -> t.SetData ip ((t.GetData ip) + 1); ip.Advance()
| '-' -> t.SetData ip ((t.GetData ip) - 1); ip.Advance()
| '%' -> t.SetData ip (_rnd.Next(0, 256)); ip.Advance()
| '.' -> SNUSP.OutputAscii(char (t.GetData ip)); ip.Advance()
| ',' ->
let chOpt = t.InputAscii() // Check if there are any keys waiting
if chOpt <> None then // If there are...
t.SetData ip (Option.get chOpt) // set the current position to the ascii value of the key
ip.Advance() // and go on to the next instruction
| '*' ->
let valOpt = t.InputNumber() // Do the same for numbers
if valOpt <> None then
t.SetData ip (Option.get valOpt)
ip.Advance()
| '/' | '\\' -> ip.Reflect(_pgm.[ip.y, ip.x]); ip.Advance()
| '?' -> ip.Advance(); if (t.GetData ip) = 0 then ip.Advance()
| '!' -> ip.Advance(); ip.Advance()
| '&' -> t.Split(ip); ip.Advance()
| '@' -> ip.Call(); ip.Advance()
| '#' -> ip.Return()
| _ -> ip.Advance()
if not (ip.Valid()) then
t.ipLastRemoved := ip
member t.InterpretCmd() = // Interpret a single command for each active IP
_lstSplitIps.Clear() // Clear the split array
let ipRemovals =
!t.ips // Start with all ips
|> Seq.filter (fun ip -> t.InterpretCmd(ip); // Interpret the command
not (ip.Valid())) // Collect the IP if it went invalid
|> Seq.toArray // Force laziness to act
ipRemovals // For each invalid IP found
|> Seq.iter (fun ip -> (!t.ips).Remove(ip) |> ignore) // remove it from the list of active IPs
_lstSplitIps // For each new thread created
|> Seq.iter (fun ip -> (!t.ips).Add(ip) |> ignore) // Add it to the list of active IPs
member t.Execute() = // Execute til exit
while (!t.ips).Count <> 0 do // While there are active threads
t.InterpretCmd() // Interpret commands
static member Run(pgm) =
let snusp = new SNUSP(pgm) // Create an engine
snusp.Execute() // and run the program with it
snusp.ReturnValue() // Return the return value
</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>