weird.hs

import Prelude
import System.Directory
import Control.Exception
import Control.Monad
import Data.List;
import Data.Bool;
import Data.Word;
import Data.Int;
import Data.List;
import Data.Maybe;
import Data.HashMap.Strict;
import System.IO;

data ProgramState = ProgramState { stack :: [String], position :: Integer, heap :: HashMap String String }

newState = ProgramState {stack = [], position = 0, heap = empty :: HashMap String String}

checkProgramBounds :: [ProgramState -> IO ProgramState] -> ProgramState -> Bool
checkProgramBounds program state = 
    let
        comparePosition :: Integer -> Bool
        comparePosition pos = ((pos >= 0) && (pos) < ((fromIntegral (length program)) :: Integer))
    in comparePosition (position state)

runProgram :: [ProgramState -> IO ProgramState] -> IO ProgramState -> IO ProgramState
runProgram program state = 
    let
        perform :: [ProgramState ->IO ProgramState] -> IO ProgramState -> Bool -> IO ProgramState
        perform program state resume = runInstructionOrStop resume program state
    in (fmap (checkProgramBounds program) state) >>= (perform program state)

getInstruction :: Integer -> [ProgramState -> IO ProgramState] -> (ProgramState -> IO ProgramState)   
getInstruction pos program = (program !! ((fromIntegral (pos)) :: Int))
    
runInstructionOrStop :: Bool -> [ProgramState -> IO ProgramState] -> IO ProgramState -> IO ProgramState
runInstructionOrStop  False program state = state
runInstructionOrStop  True program state = 
    let
        perform :: IO ProgramState -> Integer -> IO ProgramState
        perform state pos = runProgram program (state >>= (getInstruction pos program))
    in (fmap position state) >>= (perform state) 

gotoNext :: ProgramState -> Integer
gotoNext state = (position state) + 1

opReadString :: String -> ProgramState -> IO ProgramState
opReadString variablename state = do
    str <- getLine
    return (ProgramState {stack = (stack state), position = (gotoNext state),  heap = Data.HashMap.Strict.insert variablename str (heap state) })


opWriteVariable :: String -> ProgramState -> IO ProgramState
opWriteVariable variablename state = do
    putStrLn (Data.HashMap.Strict.lookupDefault "" variablename (heap state))
    return ProgramState {stack = (stack state), position = (gotoNext state),  heap = (heap state) }  

main = do
    hSetBuffering stdin NoBuffering
    hSetBuffering stdout NoBuffering
    runProgram [opReadString "a", opReadString "b", opReadString "c", opReadString "d", opWriteVariable "d", opWriteVariable "c", opWriteVariable "b", opWriteVariable "a"] (return newState)