⚠️ Warning: This is a draft ⚠️
This means it might contain formatting issues, incorrect code, conceptual problems, or other severe issues.
If you want to help to improve and eventually enable this page, please fork RosettaGit's repository and open a merge request on GitHub.
{{implementation|SNUSP}}{{collection|RCSNUSP}}
This is the [[F Sharp|F#]] implementation of 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.
==Modular SNUSP==
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]
==Bloated SNUSP==
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.
// 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
==Example Inputs==
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=@@@+@+++++#")