Execute SNUSP/Haskell: Difference between revisions
Content added Content deleted
m (<lang>) |
m (Categorization now in master page) |
||
Line 1: | Line 1: | ||
{{implementation|SNUSP}}{{collection|RCSNUSP}} |
{{implementation|SNUSP}}{{collection|RCSNUSP}} |
||
This implementation supports commands from all the three SNUSP variants, as described on the [[eso:SNUSP|Esolang SNUSP page]]. |
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''. |
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: | Line 15: | ||
The Haskell code starts with lots of imports: |
The Haskell code starts with lots of imports: |
||
<lang haskell> |
<lang haskell>import System.Environment |
||
import System.Environment |
|||
import System.IO |
import System.IO |
||
import System.Random |
import System.Random |
||
Line 27: | Line 26: | ||
import Data.Array |
import Data.Array |
||
import qualified Data.HashTable as H |
import qualified Data.HashTable as H</lang> |
||
</lang> |
|||
Use a list as an index into an array: |
Use a list as an index into an array: |
||
<lang haskell> |
<lang haskell>type Index = [Int] |
||
type Index = [Int] |
|||
instance Ix a => Ix [a] where |
instance Ix a => Ix [a] where |
||
Line 43: | Line 40: | ||
inRange ([],[]) [] = True |
inRange ([],[]) [] = True |
||
inRange (l:ls, u:us) (i:is) = inRange (l,u) i && inRange (ls,us) is |
inRange (l:ls, u:us) (i:is) = inRange (l,u) i && inRange (ls,us) is |
||
rangeSize (ls,us) = product $ map rangeSize $ zip ls us |
rangeSize (ls,us) = product $ map rangeSize $ zip ls us</lang> |
||
</lang> |
|||
or into an hashtable (the hash function could probably be improved): |
or into an hashtable (the hash function could probably be improved): |
||
<lang haskell> |
<lang haskell>cmpList :: Index -> Index -> Bool |
||
cmpList :: Index -> Index -> Bool |
|||
cmpList [] [] = True |
cmpList [] [] = True |
||
cmpList (x:xs) [] = x == 0 && cmpList xs [] |
cmpList (x:xs) [] = x == 0 && cmpList xs [] |
||
Line 59: | Line 54: | ||
combine :: Int -> Int -> Int |
combine :: Int -> Int -> Int |
||
combine x 0 = x |
combine x 0 = x |
||
combine x y = z * (z+1) `div` 2 + x where z = x + y |
combine x y = z * (z+1) `div` 2 + x where z = x + y</lang> |
||
</lang> |
|||
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: |
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: |
||
<lang haskell> |
<lang haskell>(<+>) :: Index -> Index -> Index |
||
(<+>) :: Index -> Index -> Index |
|||
[] <+> ys = ys |
[] <+> ys = ys |
||
xs <+> [] = xs |
xs <+> [] = xs |
||
(x:xs) <+> (y:ys) = (x+y) : (xs <+> ys) |
(x:xs) <+> (y:ys) = (x+y) : (xs <+> ys)</lang> |
||
</lang> |
|||
Some helper functions: |
Some helper functions: |
||
⚫ | |||
<lang haskell> |
|||
⚫ | |||
modify d t f = do |
modify d t f = do |
||
Line 95: | Line 86: | ||
toChar = chr . fromInteger |
toChar = chr . fromInteger |
||
fromChar = toInteger . ord |
fromChar = toInteger . ord</lang> |
||
</lang> |
|||
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. |
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. |
||
<lang haskell> |
<lang haskell>-- Core SNUSP |
||
-- Core SNUSP |
|||
exec '+' d t = modify d t (+1) |
exec '+' d t = modify d t (+1) |
||
Line 129: | Line 118: | ||
-- NOOP |
-- NOOP |
||
exec _ d t = return [t] |
exec _ d t = return [t]</lang> |
||
</lang> |
|||
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. |
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. |
||
⚫ | |||
<lang haskell> |
|||
⚫ | |||
run c d = schedule [thread] [] False where |
run c d = schedule [thread] [] False where |
||
Line 149: | Line 136: | ||
| x == ',' = return ([],[t]) |
| x == ',' = return ([],[t]) |
||
| otherwise = exec' x d t |
| otherwise = exec' x d t |
||
where x = c ! (ip t) |
where x = c ! (ip t)</lang> |
||
</lang> |
|||
Finally, routines to run code from a string or a file, and the main program. |
Finally, routines to run code from a string or a file, and the main program. |
||
<lang haskell> |
<lang haskell>runString y s = do |
||
runString y s = do |
|||
d <- H.new cmpList hashList |
d <- H.new cmpList hashList |
||
let x = length s `div` y |
let x = length s `div` y |
||
Line 173: | Line 158: | ||
hSetBuffering stdin NoBuffering |
hSetBuffering stdin NoBuffering |
||
[s] <- getArgs |
[s] <- getArgs |
||
runFile s |
runFile s</lang> |
||
</lang> |
|||
== Extension == |
== Extension == |
||
Line 180: | Line 164: | ||
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.). |
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.). |
||
<lang haskell> |
<lang haskell>exec '(' d t = moveMp d t [0,0,-1] |
||
exec '(' d t = moveMp d t [0,0,-1] |
|||
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] |
exec '^' d t = return [t {dir=(d3:d1:d2:ds)}] where d1:d2:d3:ds = dir t <+> [0,0,0]</lang> |
||
</lang> |