Execute SNUSP/Haskell: Difference between revisions

m
Fixed syntax highlighting.
m (Redo hGetChar stdin --> getChar (forgot to refresh edit page))
m (Fixed syntax highlighting.)
 
(7 intermediate revisions by 5 users not shown)
Line 1:
{{implementation|SNUSP}}{{collection|RCSNUSP}}[[Category:Haskell]]
This [[Haskell]] implementation supports commands from all the three SNUSP variants, as described on the [http[eso://esolangs.org/wiki/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''.
Line 15:
The Haskell code starts with lots of imports:
 
<syntaxhighlight lang="haskell">import System.Environment
<pre>
import System.Environment
import System.IO
import System.Random
Line 27 ⟶ 26:
import Data.Array
 
import qualified Data.HashTable as H</syntaxhighlight>
</pre>
 
Use a list as an index into an array:
 
<syntaxhighlight lang="haskell">type Index = [Int]
<pre>
type Index = [Int]
 
instance Ix a => Ix [a] where
Line 43 ⟶ 40:
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</syntaxhighlight>
</pre>
 
or into an hashtable (the hash function could probably be improved):
 
<syntaxhighlight lang="haskell">cmpList :: Index -> Index -> Bool
<pre>
cmpList :: Index -> Index -> Bool
cmpList [] [] = True
cmpList (x:xs) [] = x == 0 && cmpList xs []
Line 59 ⟶ 54:
combine :: Int -> Int -> Int
combine x 0 = x
combine x y = z * (z+1) `div` 2 + x where z = x + y</syntaxhighlight>
</pre>
 
Here it's important that index lists with trailing zeroszeroes 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:
 
<syntaxhighlight lang="haskell">(<+>) :: Index -> Index -> Index
<pre>
(<+>) :: Index -> Index -> Index
[] <+> ys = ys
xs <+> [] = xs
(x:xs) <+> (y:ys) = (x+y) : (xs <+> ys)</syntaxhighlight>
</pre>
 
Some helper functions:
 
<syntaxhighlight lang="haskell">data Thread a = T {mp::a, ip::a, dir::a, stack::[(a,a)]} deriving Show
<pre>
data Thread a = T {mp::a, ip::a, dir::a, stack::[(a,a)]} deriving Show
 
modify d t f = do
Line 95 ⟶ 86:
 
toChar = chr . fromInteger
fromChar = toInteger . ord</syntaxhighlight>
</pre>
 
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.
 
<syntaxhighlight lang="haskell">-- Core SNUSP
<pre>
-- Core SNUSP
 
exec '+' d t = modify d t (+1)
Line 129 ⟶ 118:
-- NOOP
 
exec _ d t = return [t]</syntaxhighlight>
</pre>
 
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.
 
<syntaxhighlight lang="haskell">start c = maybe (fst $ bounds $ c) fst $ find (\(_,x) -> x == '$') $ assocs c
<pre>
start c = maybe (fst $ bounds $ c) fst $ find (\(_,x) -> x == '$') $ assocs c
 
run c d = schedule [thread] [] False where
Line 149 ⟶ 136:
| x == ',' = return ([],[t])
| otherwise = exec' x d t
where x = c ! (ip t)</syntaxhighlight>
</pre>
 
Finally, routines to run code from a string or a file, and the main program.
 
<syntaxhighlight lang="haskell">runString y s = do
<pre>
runString y s = do
d <- H.new cmpList hashList
let x = length s `div` y
Line 173 ⟶ 158:
hSetBuffering stdin NoBuffering
[s] <- getArgs
runFile s</syntaxhighlight>
 
</pre>
===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.).
 
<syntaxhighlight lang="haskell">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]</syntaxhighlight>
9,476

edits