**⚠️ 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 [[Haskell]] implementation supports commands from all the three SNUSP variants, as described on the [[eso:SNUSP|Esolang SNUSP page]].

Threads and 2D-data makes a purely functional implementation difficult, so most of the code works in the IO-Monad. There is an immutable array ''c'' for the code, a global mutable hashtable ''d'' for the data, and each thread has an instruction pointer ''ip'', a memory pointer ''mp'', and a call stack ''stack''.

Design decisions (not covered by SNUSP specification):

- Decrementing a zero memory cell sets it to zero.
- The data area is infinite.
- Threads block during read if no input is available, while other threads continue (as one of the examples requires).
- As the SNUSP variants differ in the number of dimensions in data and code, make it easy to add even more dimensions.

The interpreter has been tested with the ''echo'', ''thread'', ''multiplication'' and ''multi-digit print'' examples.

The Haskell code starts with lots of imports:

import System.Environment import System.IO import System.Random import Control.Monad import Data.Char import Data.List import Data.Maybe import Data.Array import qualified Data.HashTable as H

Use a list as an index into an array:

type Index = [Int] instance Ix a => Ix [a] where index ([],[]) [] = 0 index (l:ls, u:us) (i:is) = index (l,u) i + index (ls,us) is * rangeSize (l,u) range ([],[]) = [[]] range (l:ls, u:us) = [i:is | is <- range (ls,us), i <- range (l,u)] inRange ([],[]) [] = True inRange (l:ls, u:us) (i:is) = inRange (l,u) i && inRange (ls,us) is rangeSize (ls,us) = product $ map rangeSize $ zip ls us

or into an hashtable (the hash function could probably be improved):

cmpList :: Index -> Index -> Bool cmpList [] [] = True cmpList (x:xs) [] = x == 0 && cmpList xs [] cmpList [] (y:ys) = y == 0 && cmpList [] ys cmpList (x:xs) (y:ys) = x == y && cmpList xs ys hashList xs = H.hashInt $ foldr combine 0 xs combine :: Int -> Int -> Int combine x 0 = x combine x y = z * (z+1) `div` 2 + x where z = x + y

Here it's important that index lists with trailing zeroes are treated just like this list without the zeroes, so we can handle any number of dimensions. We want the same flexibility when adding index lists:

(<+>) :: Index -> Index -> Index [] <+> ys = ys xs <+> [] = xs (x:xs) <+> (y:ys) = (x+y) : (xs <+> ys)

Some helper functions:

data Thread a = T {mp::a, ip::a, dir::a, stack::[(a,a)]} deriving Show modify d t f = do let i = mp t x <- H.lookup d i let x' = fromMaybe 0 x H.delete d i H.insert d i (f x') -- H.update return [t] moveMp d t delta = return [t {mp=(mp t) <+> delta}] readMp d t = H.lookup d (mp t) >>= return . fromMaybe 0 step t = t {ip=(ip t) <+> (dir t)} dec :: Integer -> Integer dec 0 = 0 dec x = x-1 toChar = chr . fromInteger fromChar = toInteger . ord

Now, the commands. Given a thread, return a list of threads valid after one simulation step. In that way, ''exec'' can handle forks and thread termination on errors.

-- Core SNUSP exec '+' d t = modify d t (+1) exec '-' d t = modify d t (dec) exec '<' d t = moveMp d t [-1] exec '>' d t = moveMp d t [ 1] exec ',' d t = getChar >>= modify d t . const . fromChar exec '.' d t = readMp d t >>= putChar . toChar >> return [t] exec '\\' d t = return [t {dir=( d2: d1:ds)}] where d1:d2:ds = dir t <+> [0,0] exec '/' d t = return [t {dir=(-d2: -d1:ds)}] where d1:d2:ds = dir t <+> [0,0] exec '!' d t = return [step t] exec '?' d t = readMp d t >>= \x -> return [if x == 0 then step t else t] -- Modular SNUSP exec '@' d t = return [t {stack=(ip t, dir t):(stack t)}] exec '#' d T{stack=[]} = return [] exec '#' d t@T{stack=(ip,dir):s} = return [step $ t {ip=ip, dir=dir, stack=s}] -- Bloated SNUSP exec ':' d t = moveMp d t [0,-1] exec ';' d t = moveMp d t [0, 1] exec '&' d t = return [step t, t {stack=[]}] exec '%' d t = readMp d t >>= \x -> randomRIO (0,x) >>= modify d t . const -- NOOP exec _ d t = return [t]

The scheduler manages a list ''ts'' of active threads, and a list ''ks'' of threads waiting for input. If there are no more threads in either list, stop. If input is available, one blocked thread is executed. If no input is available and all threads are blocked, we block the interpreter, too (so the OS can do something else). Otherwise, try to execute one of the unblocked threads, first checking if it's still inside the code array.

start c = maybe (fst $ bounds $ c) fst $ find (\(_,x) -> x == '$') $ assocs c run c d = schedule [thread] [] False where thread = T {mp=[1,1], ip=start c, dir=[1], stack=[]} exec' x d t = exec x d t >>= \ts -> return (ts,[]) schedule' ts ks (ts',ks') = hReady stdin >>= schedule (ts++ts') (ks++ks') schedule [] [] _ = return () schedule [] ks False = hLookAhead stdin >> schedule' [] ks ([],[]) schedule ts (k:ks) True = exec' ',' d k >>= schedule' ts ks schedule (t:ts) ks _ = check (step t) >>= schedule' ts ks check t | not $ bounds c `inRange` (ip t) = return ([],[]) | x == ',' = return ([],[t]) | otherwise = exec' x d t where x = c ! (ip t)

Finally, routines to run code from a string or a file, and the main program.

runString y s = do d <- H.new cmpList hashList let x = length s `div` y run (listArray ([1,1],[x,y]) s) d runFile name = do s <- readFile name d <- H.new cmpList hashList let l = lines s let y = length l let x = maximum $ map length $ l let m = [([i,j],c) | (j,v) <- zip [1..] l, (i,c) <- zip [1..] v] let c = listArray ([1,1],[x,y]) (repeat ' ') // m run c d main = do hSetBuffering stdin NoBuffering [s] <- getArgs runFile s

== Extension ==

To demonstrate the ease of introducing even more dimensions, let's implement commands ( and ) to move the data pointer along the z-axis, and a command ^ to rotate the IP direction around the (1,1,1) axis (i.e., left becomes up, up becomes "farther" on the z-axis, "farther" becomes left, etc.).

exec '(' d t = moveMp d t [0,0,-1] exec ')' d t = moveMp d t [0,0, 1] exec '^' d t = return [t {dir=(d3:d1:d2:ds)}] where d1:d2:d3:ds = dir t <+> [0,0,0]