Hello world on Haskell, using small stupid translator

helloworld.hs

{-# LANGUAGE BangPatterns #-}
import Prelude hiding (catch)
import System.Directory
import Control.Exception
import Control.Monad
import System.IO.Error hiding (catch)
import Data.List;
import Data.Bool;
import Data.Word;
import Data.Int;
import Data.List;
import Data.Maybe;
import Data.HashMap.Strict;
import System.Environment;
import System.IO;
import System.IO.Unsafe;

_q :: Bool -> a -> a -> a
_q True x y = x
_q False x y = y

data Value = VBool Bool | VArray [Value] | VChar Integer | VUchar Integer | VShort Integer | VUShort Integer | VInt Integer | VUInt Integer | VLong Integer | VULong Integer | VLongLong Integer | VULongLong Integer | VFloat Double | VDouble Double | VLongDouble Double deriving (Show, Eq)
data ProgramState = ProgramState { valueStack :: [Value], position :: Integer, scopes :: [HashMap String Value], io :: IO() }

newState = ProgramState {valueStack = [], position = 0, scopes = [], io = (return ())}

newScope = Data.HashMap.Strict.empty


instance Show ProgramState where
    show (ProgramState { valueStack = !valueStack, position = !position, scopes = !scopes, io = !io }) = "ProgramState {" ++ (show valueStack) ++ ", " ++ (show position) ++ ","  ++ (show scopes) ++ "}\r\n"

instance Eq ProgramState where
    a == b = False

getType :: Value -> String
getType (VArray _) = "[]"
getType (VBool _) = "bool"
getType (VChar _) = "char"
getType (VUchar _) = "unsigned char"
getType (VShort _) = "short"
getType (VUShort _) = "unsigned short"
getType (VInt _) = "int"
getType (VUInt _) = "unsigned int"
getType (VLong _) = "long"
getType (VULong _) = "unsigned long"
getType (VLongLong _) = "long long"
getType (VULongLong _) = "unsigned long long"
getType (VFloat _) = "float"
getType (VDouble _) = "double"
getType (VLongDouble _) = "long double"


getUnaryMinusType :: String -> String
getUnaryMinusType "unsigned char" = "char"
getUnaryMinusType "unsigned short" = "short"
getUnaryMinusType "unsigned int" = "int"
getUnaryMinusType "unsigned long" = "long"
getUnaryMinusType "unsigned long long" = "long long"
getUnaryMinusType x = x

getCommonType :: String -> String -> String
getCommonType "char" "char" = "char"
getCommonType "char" "unsigned char" = "char"
getCommonType "char" "short" = "short"
getCommonType "char" "unsigned short" = "short"
getCommonType "char" "int" = "int"
getCommonType "char" "unsigned int" = "int"
getCommonType "char" "long" = "long"
getCommonType "char" "unsigned long" = "long"
getCommonType "char" "long long" = "long long"
getCommonType "char" "unsigned long long" = "long long"
getCommonType "char" "float" = "float"
getCommonType "char" "double" = "double"
getCommonType "char" "long double" = "long double"
getCommonType "char" "bool" = "char"
getCommonType "unsigned char" "char" = "char"
getCommonType "unsigned char" "unsigned char" = "unsigned char"
getCommonType "unsigned char" "short" = "short"
getCommonType "unsigned char" "unsigned short" = "unsigned short"
getCommonType "unsigned char" "int" = "int"
getCommonType "unsigned char" "unsigned int" = "unsigned int"
getCommonType "unsigned char" "long" = "long"
getCommonType "unsigned char" "unsigned long" = "unsigned long"
getCommonType "unsigned char" "long long" = "long long"
getCommonType "unsigned char" "unsigned long long" = "unsigned long long"
getCommonType "unsigned char" "float" = "float"
getCommonType "unsigned char" "double" = "double"
getCommonType "unsigned char" "long double" = "long double"
getCommonType "unsigned char" "bool" = "unsigned char"
getCommonType "short" "char" = "short"
getCommonType "short" "unsigned char" = "short"
getCommonType "short" "short" = "short"
getCommonType "short" "unsigned short" = "short"
getCommonType "short" "int" = "int"
getCommonType "short" "unsigned int" = "int"
getCommonType "short" "long" = "long"
getCommonType "short" "unsigned long" = "long"
getCommonType "short" "long long" = "long long"
getCommonType "short" "unsigned long long" = "long long"
getCommonType "short" "float" = "float"
getCommonType "short" "double" = "double"
getCommonType "short" "long double" = "long double"
getCommonType "short" "bool" = "short"
getCommonType "unsigned short" "char" = "short"
getCommonType "unsigned short" "unsigned char" = "unsigned short"
getCommonType "unsigned short" "short" = "short"
getCommonType "unsigned short" "unsigned short" = "unsigned short"
getCommonType "unsigned short" "int" = "int"
getCommonType "unsigned short" "unsigned int" = "unsigned int"
getCommonType "unsigned short" "long" = "long"
getCommonType "unsigned short" "unsigned long" = "unsigned long"
getCommonType "unsigned short" "long long" = "long long"
getCommonType "unsigned short" "unsigned long long" = "unsigned long long"
getCommonType "unsigned short" "float" = "float"
getCommonType "unsigned short" "double" = "double"
getCommonType "unsigned short" "long double" = "long double"
getCommonType "unsigned short" "bool" = "unsigned short"
getCommonType "int" "char" = "int"
getCommonType "int" "unsigned char" = "int"
getCommonType "int" "short" = "int"
getCommonType "int" "unsigned short" = "int"
getCommonType "int" "int" = "int"
getCommonType "int" "unsigned int" = "int"
getCommonType "int" "long" = "long"
getCommonType "int" "unsigned long" = "long"
getCommonType "int" "long long" = "long long"
getCommonType "int" "unsigned long long" = "long long"
getCommonType "int" "float" = "float"
getCommonType "int" "double" = "double"
getCommonType "int" "long double" = "long double"
getCommonType "int" "bool" = "int"
getCommonType "unsigned int" "char" = "int"
getCommonType "unsigned int" "unsigned char" = "unsigned int"
getCommonType "unsigned int" "short" = "int"
getCommonType "unsigned int" "unsigned short" = "unsigned int"
getCommonType "unsigned int" "int" = "int"
getCommonType "unsigned int" "unsigned int" = "unsigned int"
getCommonType "unsigned int" "long" = "long"
getCommonType "unsigned int" "unsigned long" = "unsigned long"
getCommonType "unsigned int" "long long" = "long long"
getCommonType "unsigned int" "unsigned long long" = "unsigned long long"
getCommonType "unsigned int" "float" = "float"
getCommonType "unsigned int" "double" = "double"
getCommonType "unsigned int" "long double" = "long double"
getCommonType "unsigned int" "bool" = "unsigned int"
getCommonType "long" "char" = "long"
getCommonType "long" "unsigned char" = "long"
getCommonType "long" "short" = "long"
getCommonType "long" "unsigned short" = "long"
getCommonType "long" "int" = "long"
getCommonType "long" "unsigned int" = "long"
getCommonType "long" "long" = "long"
getCommonType "long" "unsigned long" = "long"
getCommonType "long" "long long" = "long long"
getCommonType "long" "unsigned long long" = "long long"
getCommonType "long" "float" = "float"
getCommonType "long" "double" = "double"
getCommonType "long" "long double" = "long double"
getCommonType "long" "bool" = "long"
getCommonType "unsigned long" "char" = "long"
getCommonType "unsigned long" "unsigned char" = "unsigned long"
getCommonType "unsigned long" "short" = "long"
getCommonType "unsigned long" "unsigned short" = "unsigned long"
getCommonType "unsigned long" "int" = "long"
getCommonType "unsigned long" "unsigned int" = "unsigned long"
getCommonType "unsigned long" "long" = "long"
getCommonType "unsigned long" "unsigned long" = "unsigned long"
getCommonType "unsigned long" "long long" = "long long"
getCommonType "unsigned long" "unsigned long long" = "unsigned long long"
getCommonType "unsigned long" "float" = "float"
getCommonType "unsigned long" "double" = "double"
getCommonType "unsigned long" "long double" = "long double"
getCommonType "unsigned long" "bool" = "unsigned long"
getCommonType "long long" "char" = "long long"
getCommonType "long long" "unsigned char" = "long long"
getCommonType "long long" "short" = "long long"
getCommonType "long long" "unsigned short" = "long long"
getCommonType "long long" "int" = "long long"
getCommonType "long long" "unsigned int" = "long long"
getCommonType "long long" "long" = "long long"
getCommonType "long long" "unsigned long" = "long long"
getCommonType "long long" "long long" = "long long"
getCommonType "long long" "unsigned long long" = "long long"
getCommonType "long long" "float" = "float"
getCommonType "long long" "double" = "double"
getCommonType "long long" "long double" = "long double"
getCommonType "long long" "bool" = "long long"
getCommonType "unsigned long long" "char" = "long long"
getCommonType "unsigned long long" "unsigned char" = "unsigned long long"
getCommonType "unsigned long long" "short" = "long long"
getCommonType "unsigned long long" "unsigned short" = "unsigned long long"
getCommonType "unsigned long long" "int" = "long long"
getCommonType "unsigned long long" "unsigned int" = "unsigned long long"
getCommonType "unsigned long long" "long" = "long long"
getCommonType "unsigned long long" "unsigned long" = "unsigned long long"
getCommonType "unsigned long long" "long long" = "long long"
getCommonType "unsigned long long" "unsigned long long" = "unsigned long long"
getCommonType "unsigned long long" "float" = "float"
getCommonType "unsigned long long" "double" = "double"
getCommonType "unsigned long long" "long double" = "long double"
getCommonType "unsigned long long" "bool" = "unsigned long long"
getCommonType "float" "char" = "float"
getCommonType "float" "unsigned char" = "float"
getCommonType "float" "short" = "float"
getCommonType "float" "unsigned short" = "float"
getCommonType "float" "int" = "float"
getCommonType "float" "unsigned int" = "float"
getCommonType "float" "long" = "float"
getCommonType "float" "unsigned long" = "float"
getCommonType "float" "long long" = "float"
getCommonType "float" "unsigned long long" = "float"
getCommonType "float" "float" = "float"
getCommonType "float" "double" = "double"
getCommonType "float" "long double" = "long double"
getCommonType "float" "bool" = "float"
getCommonType "double" "char" = "double"
getCommonType "double" "unsigned char" = "double"
getCommonType "double" "short" = "double"
getCommonType "double" "unsigned short" = "double"
getCommonType "double" "int" = "double"
getCommonType "double" "unsigned int" = "double"
getCommonType "double" "long" = "double"
getCommonType "double" "unsigned long" = "double"
getCommonType "double" "long long" = "double"
getCommonType "double" "unsigned long long" = "double"
getCommonType "double" "float" = "double"
getCommonType "double" "double" = "double"
getCommonType "double" "long double" = "long double"
getCommonType "double" "bool" = "double"
getCommonType "long double" "char" = "long double"
getCommonType "long double" "unsigned char" = "long double"
getCommonType "long double" "short" = "long double"
getCommonType "long double" "unsigned short" = "long double"
getCommonType "long double" "int" = "long double"
getCommonType "long double" "unsigned int" = "long double"
getCommonType "long double" "long" = "long double"
getCommonType "long double" "unsigned long" = "long double"
getCommonType "long double" "long long" = "long double"
getCommonType "long double" "unsigned long long" = "long double"
getCommonType "long double" "float" = "long double"
getCommonType "long double" "double" = "long double"
getCommonType "long double" "long double" = "long double"
getCommonType "long double" "bool" = "long double"
getCommonType "bool" "char" = "char"
getCommonType "bool" "unsigned char" = "unsigned char"
getCommonType "bool" "short" = "short"
getCommonType "bool" "unsigned short" = "unsigned short"
getCommonType "bool" "int" = "int"
getCommonType "bool" "unsigned int" = "unsigned int"
getCommonType "bool" "long" = "long"
getCommonType "bool" "unsigned long" = "unsigned long"
getCommonType "bool" "long long" = "long long"
getCommonType "bool" "unsigned long long" = "unsigned long long"
getCommonType "bool" "float" = "float"
getCommonType "bool" "double" = "double"
getCommonType "bool" "long double" = "long double"
getCommonType "bool" "bool" = "bool"

convert :: String -> Value -> Value
convert "bool" (VBool v) = (VBool v)
convert "bool" (VChar v) = (VBool (v /= 0))
convert "bool" (VUchar v) = (VBool (v /= 0))
convert "bool" (VShort v) = (VBool (v /= 0))
convert "bool" (VUShort v) = (VBool (v /= 0))
convert "bool" (VInt v) = (VBool (v /= 0))
convert "bool" (VUInt v) = (VBool (v /= 0))
convert "bool" (VLong v) = (VBool (v /= 0))
convert "bool" (VULong v) = (VBool (v /= 0))
convert "bool" (VLongLong v) = (VBool (v /= 0))
convert "bool" (VULongLong v) = (VBool (v /= 0))
convert "bool" (VFloat v) = (VBool (abs(v) <= 0.01))
convert "bool" (VDouble v) = (VBool (abs(v) <= 0.01))
convert "bool" (VLongDouble v) = (VBool (abs(v) <= 0.01))
convert "char" (VBool v) = (VChar (_q v 1 0))
convert "char" (VChar v) = (VChar  v)
convert "char" (VUchar v) = (VChar  (fromIntegral ((fromIntegral v) :: Int8) :: Integer))
convert "char" (VShort v) = (VChar  (fromIntegral ((fromIntegral v) :: Int8) :: Integer))
convert "char" (VUShort v) = (VChar  (fromIntegral ((fromIntegral v) :: Int8) :: Integer))
convert "char" (VInt v) = (VChar  (fromIntegral ((fromIntegral v) :: Int8) :: Integer))
convert "char" (VUInt v) = (VChar  (fromIntegral ((fromIntegral v) :: Int8) :: Integer))
convert "char" (VLong v) = (VChar  (fromIntegral ((fromIntegral v) :: Int8) :: Integer))
convert "char" (VULong v) = (VChar  (fromIntegral ((fromIntegral v) :: Int8) :: Integer))
convert "char" (VLongLong v) = (VChar  (fromIntegral ((fromIntegral v) :: Int8) :: Integer))
convert "char" (VULongLong v) = (VChar  (fromIntegral ((fromIntegral v) :: Int8) :: Integer))
convert "char" (VFloat v) = (VChar  (fromIntegral ((fromIntegral (floor v)) :: Int8) :: Integer))
convert "char" (VDouble v) = (VChar  (fromIntegral ((fromIntegral (floor v)) :: Int8) :: Integer))
convert "char" (VLongDouble v) = (VChar  (fromIntegral ((fromIntegral (floor v)) :: Int8) :: Integer))
convert "unsigned char" (VBool v) = (VUchar (_q v 1 0))
convert "unsigned char" (VChar v) = (VUchar  (fromIntegral ((fromIntegral v) :: Word8) :: Integer))
convert "unsigned char" (VUchar v) = (VUchar  v)
convert "unsigned char" (VShort v) = (VUchar  (fromIntegral ((fromIntegral v) :: Word8) :: Integer))
convert "unsigned char" (VUShort v) = (VUchar  (fromIntegral ((fromIntegral v) :: Word8) :: Integer))
convert "unsigned char" (VInt v) = (VUchar  (fromIntegral ((fromIntegral v) :: Word8) :: Integer))
convert "unsigned char" (VUInt v) = (VUchar  (fromIntegral ((fromIntegral v) :: Word8) :: Integer))
convert "unsigned char" (VLong v) = (VUchar  (fromIntegral ((fromIntegral v) :: Word8) :: Integer))
convert "unsigned char" (VULong v) = (VUchar  (fromIntegral ((fromIntegral v) :: Word8) :: Integer))
convert "unsigned char" (VLongLong v) = (VUchar  (fromIntegral ((fromIntegral v) :: Word8) :: Integer))
convert "unsigned char" (VULongLong v) = (VUchar  (fromIntegral ((fromIntegral v) :: Word8) :: Integer))
convert "unsigned char" (VFloat v) = (VUchar  (fromIntegral ((fromIntegral (floor v)) :: Word8) :: Integer))
convert "unsigned char" (VDouble v) = (VUchar  (fromIntegral ((fromIntegral (floor v)) :: Word8) :: Integer))
convert "unsigned char" (VLongDouble v) = (VUchar  (fromIntegral ((fromIntegral (floor v)) :: Word8) :: Integer))
convert "short" (VBool v) = (VShort (_q v 1 0))
convert "short" (VChar v) = (VShort  (fromIntegral ((fromIntegral v) :: Int16) :: Integer))
convert "short" (VUchar v) = (VShort  (fromIntegral ((fromIntegral v) :: Int16) :: Integer))
convert "short" (VShort v) = (VShort  v)
convert "short" (VUShort v) = (VShort  (fromIntegral ((fromIntegral v) :: Int16) :: Integer))
convert "short" (VInt v) = (VShort  (fromIntegral ((fromIntegral v) :: Int16) :: Integer))
convert "short" (VUInt v) = (VShort  (fromIntegral ((fromIntegral v) :: Int16) :: Integer))
convert "short" (VLong v) = (VShort  (fromIntegral ((fromIntegral v) :: Int16) :: Integer))
convert "short" (VULong v) = (VShort  (fromIntegral ((fromIntegral v) :: Int16) :: Integer))
convert "short" (VLongLong v) = (VShort  (fromIntegral ((fromIntegral v) :: Int16) :: Integer))
convert "short" (VULongLong v) = (VShort  (fromIntegral ((fromIntegral v) :: Int16) :: Integer))
convert "short" (VFloat v) = (VShort  (fromIntegral ((fromIntegral (floor v)) :: Int16) :: Integer))
convert "short" (VDouble v) = (VShort  (fromIntegral ((fromIntegral (floor v)) :: Int16) :: Integer))
convert "short" (VLongDouble v) = (VShort  (fromIntegral ((fromIntegral (floor v)) :: Int16) :: Integer))
convert "unsigned short" (VBool v) = (VUShort (_q v 1 0))
convert "unsigned short" (VChar v) = (VUShort  (fromIntegral ((fromIntegral v) :: Word16) :: Integer))
convert "unsigned short" (VUchar v) = (VUShort  (fromIntegral ((fromIntegral v) :: Word16) :: Integer))
convert "unsigned short" (VShort v) = (VUShort  (fromIntegral ((fromIntegral v) :: Word16) :: Integer))
convert "unsigned short" (VUShort v) = (VUShort  v)
convert "unsigned short" (VInt v) = (VUShort  (fromIntegral ((fromIntegral v) :: Word16) :: Integer))
convert "unsigned short" (VUInt v) = (VUShort  (fromIntegral ((fromIntegral v) :: Word16) :: Integer))
convert "unsigned short" (VLong v) = (VUShort  (fromIntegral ((fromIntegral v) :: Word16) :: Integer))
convert "unsigned short" (VULong v) = (VUShort  (fromIntegral ((fromIntegral v) :: Word16) :: Integer))
convert "unsigned short" (VLongLong v) = (VUShort  (fromIntegral ((fromIntegral v) :: Word16) :: Integer))
convert "unsigned short" (VULongLong v) = (VUShort  (fromIntegral ((fromIntegral v) :: Word16) :: Integer))
convert "unsigned short" (VFloat v) = (VUShort  (fromIntegral ((fromIntegral (floor v)) :: Word16) :: Integer))
convert "unsigned short" (VDouble v) = (VUShort  (fromIntegral ((fromIntegral (floor v)) :: Word16) :: Integer))
convert "unsigned short" (VLongDouble v) = (VUShort  (fromIntegral ((fromIntegral (floor v)) :: Word16) :: Integer))
convert "int" (VBool v) = (VInt (_q v 1 0))
convert "int" (VChar v) = (VInt  (fromIntegral ((fromIntegral v) :: Int32) :: Integer))
convert "int" (VUchar v) = (VInt  (fromIntegral ((fromIntegral v) :: Int32) :: Integer))
convert "int" (VShort v) = (VInt  (fromIntegral ((fromIntegral v) :: Int32) :: Integer))
convert "int" (VUShort v) = (VInt  (fromIntegral ((fromIntegral v) :: Int32) :: Integer))
convert "int" (VInt v) = (VInt  v)
convert "int" (VUInt v) = (VInt  (fromIntegral ((fromIntegral v) :: Int32) :: Integer))
convert "int" (VLong v) = (VInt  (fromIntegral ((fromIntegral v) :: Int32) :: Integer))
convert "int" (VULong v) = (VInt  (fromIntegral ((fromIntegral v) :: Int32) :: Integer))
convert "int" (VLongLong v) = (VInt  (fromIntegral ((fromIntegral v) :: Int32) :: Integer))
convert "int" (VULongLong v) = (VInt  (fromIntegral ((fromIntegral v) :: Int32) :: Integer))
convert "int" (VFloat v) = (VInt  (fromIntegral ((fromIntegral (floor v)) :: Int32) :: Integer))
convert "int" (VDouble v) = (VInt  (fromIntegral ((fromIntegral (floor v)) :: Int32) :: Integer))
convert "int" (VLongDouble v) = (VInt  (fromIntegral ((fromIntegral (floor v)) :: Int32) :: Integer))
convert "unsigned int" (VBool v) = (VUInt (_q v 1 0))
convert "unsigned int" (VChar v) = (VUInt  (fromIntegral ((fromIntegral v) :: Word32) :: Integer))
convert "unsigned int" (VUchar v) = (VUInt  (fromIntegral ((fromIntegral v) :: Word32) :: Integer))
convert "unsigned int" (VShort v) = (VUInt  (fromIntegral ((fromIntegral v) :: Word32) :: Integer))
convert "unsigned int" (VUShort v) = (VUInt  (fromIntegral ((fromIntegral v) :: Word32) :: Integer))
convert "unsigned int" (VInt v) = (VUInt  (fromIntegral ((fromIntegral v) :: Word32) :: Integer))
convert "unsigned int" (VUInt v) = (VUInt  v)
convert "unsigned int" (VLong v) = (VUInt  (fromIntegral ((fromIntegral v) :: Word32) :: Integer))
convert "unsigned int" (VULong v) = (VUInt  (fromIntegral ((fromIntegral v) :: Word32) :: Integer))
convert "unsigned int" (VLongLong v) = (VUInt  (fromIntegral ((fromIntegral v) :: Word32) :: Integer))
convert "unsigned int" (VULongLong v) = (VUInt  (fromIntegral ((fromIntegral v) :: Word32) :: Integer))
convert "unsigned int" (VFloat v) = (VUInt  (fromIntegral ((fromIntegral (floor v)) :: Word32) :: Integer))
convert "unsigned int" (VDouble v) = (VUInt  (fromIntegral ((fromIntegral (floor v)) :: Word32) :: Integer))
convert "unsigned int" (VLongDouble v) = (VUInt  (fromIntegral ((fromIntegral (floor v)) :: Word32) :: Integer))
convert "long" (VBool v) = (VLong (_q v 1 0))
convert "long" (VChar v) = (VLong  (fromIntegral ((fromIntegral v) :: Int64) :: Integer))
convert "long" (VUchar v) = (VLong  (fromIntegral ((fromIntegral v) :: Int64) :: Integer))
convert "long" (VShort v) = (VLong  (fromIntegral ((fromIntegral v) :: Int64) :: Integer))
convert "long" (VUShort v) = (VLong  (fromIntegral ((fromIntegral v) :: Int64) :: Integer))
convert "long" (VInt v) = (VLong  (fromIntegral ((fromIntegral v) :: Int64) :: Integer))
convert "long" (VUInt v) = (VLong  (fromIntegral ((fromIntegral v) :: Int64) :: Integer))
convert "long" (VLong v) = (VLong  v)
convert "long" (VULong v) = (VLong  (fromIntegral ((fromIntegral v) :: Int64) :: Integer))
convert "long" (VLongLong v) = (VLong  (fromIntegral ((fromIntegral v) :: Int64) :: Integer))
convert "long" (VULongLong v) = (VLong  (fromIntegral ((fromIntegral v) :: Int64) :: Integer))
convert "long" (VFloat v) = (VLong  (fromIntegral ((fromIntegral (floor v)) :: Int64) :: Integer))
convert "long" (VDouble v) = (VLong  (fromIntegral ((fromIntegral (floor v)) :: Int64) :: Integer))
convert "long" (VLongDouble v) = (VLong  (fromIntegral ((fromIntegral (floor v)) :: Int64) :: Integer))
convert "unsigned long" (VBool v) = (VULong (_q v 1 0))
convert "unsigned long" (VChar v) = (VULong  (fromIntegral ((fromIntegral v) :: Word64) :: Integer))
convert "unsigned long" (VUchar v) = (VULong  (fromIntegral ((fromIntegral v) :: Word64) :: Integer))
convert "unsigned long" (VShort v) = (VULong  (fromIntegral ((fromIntegral v) :: Word64) :: Integer))
convert "unsigned long" (VUShort v) = (VULong  (fromIntegral ((fromIntegral v) :: Word64) :: Integer))
convert "unsigned long" (VInt v) = (VULong  (fromIntegral ((fromIntegral v) :: Word64) :: Integer))
convert "unsigned long" (VUInt v) = (VULong  (fromIntegral ((fromIntegral v) :: Word64) :: Integer))
convert "unsigned long" (VLong v) = (VULong  (fromIntegral ((fromIntegral v) :: Word64) :: Integer))
convert "unsigned long" (VULong v) = (VULong  v)
convert "unsigned long" (VLongLong v) = (VULong  (fromIntegral ((fromIntegral v) :: Word64) :: Integer))
convert "unsigned long" (VULongLong v) = (VULong  (fromIntegral ((fromIntegral v) :: Word64) :: Integer))
convert "unsigned long" (VFloat v) = (VULong  (fromIntegral ((fromIntegral (floor v)) :: Word64) :: Integer))
convert "unsigned long" (VDouble v) = (VULong  (fromIntegral ((fromIntegral (floor v)) :: Word64) :: Integer))
convert "unsigned long" (VLongDouble v) = (VULong  (fromIntegral ((fromIntegral (floor v)) :: Word64) :: Integer))
convert "long long" (VBool v) = (VLongLong (_q v 1 0))
convert "long long" (VChar v) = (VLongLong  (fromIntegral ((fromIntegral v) :: Int64) :: Integer))
convert "long long" (VUchar v) = (VLongLong  (fromIntegral ((fromIntegral v) :: Int64) :: Integer))
convert "long long" (VShort v) = (VLongLong  (fromIntegral ((fromIntegral v) :: Int64) :: Integer))
convert "long long" (VUShort v) = (VLongLong  (fromIntegral ((fromIntegral v) :: Int64) :: Integer))
convert "long long" (VInt v) = (VLongLong  (fromIntegral ((fromIntegral v) :: Int64) :: Integer))
convert "long long" (VUInt v) = (VLongLong  (fromIntegral ((fromIntegral v) :: Int64) :: Integer))
convert "long long" (VLong v) = (VLongLong  (fromIntegral ((fromIntegral v) :: Int64) :: Integer))
convert "long long" (VULong v) = (VLongLong  (fromIntegral ((fromIntegral v) :: Int64) :: Integer))
convert "long long" (VLongLong v) = (VLongLong  v)
convert "long long" (VULongLong v) = (VLongLong  (fromIntegral ((fromIntegral v) :: Int64) :: Integer))
convert "long long" (VFloat v) = (VLongLong  (fromIntegral ((fromIntegral (floor v)) :: Int64) :: Integer))
convert "long long" (VDouble v) = (VLongLong  (fromIntegral ((fromIntegral (floor v)) :: Int64) :: Integer))
convert "long long" (VLongDouble v) = (VLongLong  (fromIntegral ((fromIntegral (floor v)) :: Int64) :: Integer))
convert "unsigned long long" (VBool v) = (VULongLong (_q v 1 0))
convert "unsigned long long" (VChar v) = (VULongLong  (fromIntegral ((fromIntegral v) :: Word64) :: Integer))
convert "unsigned long long" (VUchar v) = (VULongLong  (fromIntegral ((fromIntegral v) :: Word64) :: Integer))
convert "unsigned long long" (VShort v) = (VULongLong  (fromIntegral ((fromIntegral v) :: Word64) :: Integer))
convert "unsigned long long" (VUShort v) = (VULongLong  (fromIntegral ((fromIntegral v) :: Word64) :: Integer))
convert "unsigned long long" (VInt v) = (VULongLong  (fromIntegral ((fromIntegral v) :: Word64) :: Integer))
convert "unsigned long long" (VUInt v) = (VULongLong  (fromIntegral ((fromIntegral v) :: Word64) :: Integer))
convert "unsigned long long" (VLong v) = (VULongLong  (fromIntegral ((fromIntegral v) :: Word64) :: Integer))
convert "unsigned long long" (VULong v) = (VULongLong  (fromIntegral ((fromIntegral v) :: Word64) :: Integer))
convert "unsigned long long" (VLongLong v) = (VULongLong  (fromIntegral ((fromIntegral v) :: Word64) :: Integer))
convert "unsigned long long" (VULongLong v) = (VULongLong  v)
convert "unsigned long long" (VFloat v) = (VULongLong  (fromIntegral ((fromIntegral (floor v)) :: Word64) :: Integer))
convert "unsigned long long" (VDouble v) = (VULongLong  (fromIntegral ((fromIntegral (floor v)) :: Word64) :: Integer))
convert "unsigned long long" (VLongDouble v) = (VULongLong  (fromIntegral ((fromIntegral (floor v)) :: Word64) :: Integer))
convert "float" (VBool v) = (VFloat (_q v (1.0 :: Double) (0.0 :: Double)))
convert "float" (VChar v) = (VFloat ((fromIntegral v) :: Double))
convert "float" (VUchar v) = (VFloat ((fromIntegral v) :: Double))
convert "float" (VShort v) = (VFloat ((fromIntegral v) :: Double))
convert "float" (VUShort v) = (VFloat ((fromIntegral v) :: Double))
convert "float" (VInt v) = (VFloat ((fromIntegral v) :: Double))
convert "float" (VUInt v) = (VFloat ((fromIntegral v) :: Double))
convert "float" (VLong v) = (VFloat ((fromIntegral v) :: Double))
convert "float" (VULong v) = (VFloat ((fromIntegral v) :: Double))
convert "float" (VLongLong v) = (VFloat ((fromIntegral v) :: Double))
convert "float" (VULongLong v) = (VFloat ((fromIntegral v) :: Double))
convert "float" (VFloat v) = (VFloat v)
convert "float" (VDouble v) = (VFloat v)
convert "float" (VLongDouble v) = (VFloat v)
convert "double" (VBool v) = (VDouble (_q v (1.0 :: Double) (0.0 :: Double)))
convert "double" (VChar v) = (VDouble ((fromIntegral v) :: Double))
convert "double" (VUchar v) = (VDouble ((fromIntegral v) :: Double))
convert "double" (VShort v) = (VDouble ((fromIntegral v) :: Double))
convert "double" (VUShort v) = (VDouble ((fromIntegral v) :: Double))
convert "double" (VInt v) = (VDouble ((fromIntegral v) :: Double))
convert "double" (VUInt v) = (VDouble ((fromIntegral v) :: Double))
convert "double" (VLong v) = (VDouble ((fromIntegral v) :: Double))
convert "double" (VULong v) = (VDouble ((fromIntegral v) :: Double))
convert "double" (VLongLong v) = (VDouble ((fromIntegral v) :: Double))
convert "double" (VULongLong v) = (VDouble ((fromIntegral v) :: Double))
convert "double" (VFloat v) = (VDouble v)
convert "double" (VDouble v) = (VDouble v)
convert "double" (VLongDouble v) = (VDouble v)
convert "long double" (VBool v) = (VLongDouble (_q v (1.0 :: Double) (0.0 :: Double)))
convert "long double" (VChar v) = (VLongDouble ((fromIntegral v) :: Double))
convert "long double" (VUchar v) = (VLongDouble ((fromIntegral v) :: Double))
convert "long double" (VShort v) = (VLongDouble ((fromIntegral v) :: Double))
convert "long double" (VUShort v) = (VLongDouble ((fromIntegral v) :: Double))
convert "long double" (VInt v) = (VLongDouble ((fromIntegral v) :: Double))
convert "long double" (VUInt v) = (VLongDouble ((fromIntegral v) :: Double))
convert "long double" (VLong v) = (VLongDouble ((fromIntegral v) :: Double))
convert "long double" (VULong v) = (VLongDouble ((fromIntegral v) :: Double))
convert "long double" (VLongLong v) = (VLongDouble ((fromIntegral v) :: Double))
convert "long double" (VULongLong v) = (VLongDouble ((fromIntegral v) :: Double))
convert "long double" (VFloat v) = (VLongDouble v)
convert "long double" (VDouble v) = (VLongDouble v)
convert "long double" (VLongDouble v) = (VLongDouble v)

stringToVCharList :: String -> [Value]
stringToVCharList a = (Data.List.map (\x -> (VChar ((fromIntegral (fromEnum x)) :: Integer))) a)

stringToArray :: String -> Value
stringToArray a = (VArray (stringToVCharList a))

stringToArray1000 :: String -> Value
stringToArray1000 a = let
    source = stringToVCharList a
    in _q (length source > 1000) (VArray source) (VArray (source ++ (take (1000 - (length source)) (repeat (VChar 0)))))


unwrapDouble :: Value -> Double
unwrapDouble (VDouble a) = a
unwrapDouble v = unwrapDouble (convert "double" v)

unwrapBool :: Value -> Bool
unwrapBool (VBool b) = b
unwrapBool v = unwrapBool (convert "bool" v)

unwrapInteger :: Value -> Integer
unwrapInteger (VInt b) = b
unwrapInteger v = unwrapInteger (convert "int" v)


performAdd :: Value -> Value -> Value
performAdd a b = convert (getCommonType (getType a) (getType b)) (VDouble ((unwrapDouble a) + (unwrapDouble b)))

performSub :: Value -> Value -> Value
performSub a b = convert (getCommonType (getType a) (getType b)) (VDouble ((unwrapDouble a) - (unwrapDouble b)))

performMul :: Value -> Value -> Value
performMul a b = convert (getCommonType (getType a) (getType b)) (VDouble ((unwrapDouble a) * (unwrapDouble b)))

performDiv :: Value -> Value -> Value
performDiv a b = convert (getCommonType (getType a) (getType b)) (VDouble ((unwrapDouble a) / (unwrapDouble b)))

performMod :: Value -> Value -> Value
performMod a b = convert (getCommonType (getType a) (getType b)) (VInt ((unwrapInteger a) `mod` (unwrapInteger b)))

performEq  :: Value -> Value -> Value
performEq  (VFloat a) (VFloat b) = (VBool (abs(a - b) < 0.001))
performEq  (VFloat a) (VDouble b) = (VBool (abs(a - b) < 0.001))
performEq  (VFloat a) (VLongDouble b) = (VBool (abs(a - b) < 0.001))
performEq  (VDouble a) (VFloat b) = (VBool (abs(a - b) < 0.001))
performEq  (VDouble a) (VDouble b) = (VBool (abs(a - b) < 0.001))
performEq  (VDouble a) (VLongDouble b) = (VBool (abs(a - b) < 0.001))
performEq  (VLongDouble a) (VFloat b) = (VBool (abs(a - b) < 0.001))
performEq  (VLongDouble a) (VDouble b) = (VBool (abs(a - b) < 0.001))
performEq  (VLongDouble a) (VLongDouble b) = (VBool (abs(a - b) < 0.001))
performEq  a b = (VBool ((unwrapInteger a)  == (unwrapInteger b)))

performNeq :: Value -> Value -> Value
performNeq a b =  (VBool  (not (unwrapBool (performEq a b))))

performGt :: Value -> Value -> Value
performGt a b = (VBool (((unwrapDouble a) > (unwrapDouble b)) && (not (unwrapBool (performEq a b)))) )

performLs :: Value -> Value -> Value
performLs a b = (VBool (((unwrapDouble a) < (unwrapDouble b)) && (not (unwrapBool (performEq a b)))) )

performGeq :: Value -> Value -> Value
performGeq a b = (VBool (((unwrapDouble a) > (unwrapDouble b)) || ((unwrapBool (performEq a b)))) )

performLeq :: Value -> Value -> Value
performLeq a b = (VBool (((unwrapDouble a) < (unwrapDouble b)) || ((unwrapBool (performEq a b)))) )

performAnd :: Value -> Value -> Value
performAnd a b = (VBool ((unwrapBool a) && (unwrapBool b)))

performOr :: Value -> Value -> Value
performOr a b = (VBool ((unwrapBool a) || (unwrapBool b)))

performMinus :: Value -> Value
performMinus (VFloat a) = (VFloat (-1*a))
performMinus (VDouble a) = (VDouble (-1*a))
performMinus (VLongDouble a) = (VLongDouble (-1*a))
performMinus (VBool a) = (VBool (not a))
performMinus  a = convert (getUnaryMinusType (getType a)) (VLong ((unwrapInteger a) * (-1)))

performNot :: Value -> Value
performNot a = (VBool (not (unwrapBool a)))

performBinaryOperation :: (Value -> Value -> Value) -> ProgramState -> ProgramState
performBinaryOperation f state =
    let
        secondValue = head (valueStack state)
        firstValue = head (tail (valueStack state) )
        itemsOfStack = tail (tail (valueStack state) )
        nio = (io state) {-- >> (putStrLn ((show (f firstValue secondValue)) ++ " " ++ (show firstValue) ++ " " ++ (show secondValue))) --}
    in ProgramState { valueStack =  ([ (f firstValue secondValue ) ] ++ itemsOfStack), position = ( (position state) + 1), scopes = (scopes state), io = nio }

performUnaryOperation :: (Value -> Value) -> ProgramState -> ProgramState
performUnaryOperation f state =
    let
        firstValue = head (valueStack state)
        itemsOfStack = tail (valueStack state)
        nio = io state
    in ProgramState { valueStack =  ([ (f firstValue ) ] ++ itemsOfStack), position = ( (position state) + 1), scopes = (scopes state), io = nio }


opCodeAdd :: ProgramState -> ProgramState
opCodeAdd = performBinaryOperation performAdd

opCodeSub :: ProgramState -> ProgramState
opCodeSub = performBinaryOperation performSub

opCodeMul :: ProgramState -> ProgramState
opCodeMul = performBinaryOperation performMul

opCodeDiv :: ProgramState -> ProgramState
opCodeDiv = performBinaryOperation performDiv

opCodeMod :: ProgramState -> ProgramState
opCodeMod = performBinaryOperation performMod

opCodeEq :: ProgramState -> ProgramState
opCodeEq = performBinaryOperation performEq

opCodeNeq :: ProgramState -> ProgramState
opCodeNeq = performBinaryOperation performNeq

opCodeGt :: ProgramState -> ProgramState
opCodeGt = performBinaryOperation performGt

opCodeLs :: ProgramState -> ProgramState
opCodeLs = performBinaryOperation performLs

opCodeGeq :: ProgramState -> ProgramState
opCodeGeq = performBinaryOperation performGeq

opCodeLeq :: ProgramState -> ProgramState
opCodeLeq = performBinaryOperation performLeq

opCodeAnd :: ProgramState -> ProgramState
opCodeAnd = performBinaryOperation performAnd

opCodeOr :: ProgramState -> ProgramState
opCodeOr = performBinaryOperation performOr

opCodeMinus :: ProgramState -> ProgramState
opCodeMinus = performUnaryOperation performMinus

opCodeNot :: ProgramState -> ProgramState
opCodeNot = performUnaryOperation performNot

opCodeConvert :: String -> ProgramState -> ProgramState
opCodeConvert !a !state =
    let
        value = head (valueStack state)
        itemsOfStack = tail (valueStack state)
        firstValue = convert a value
        nio = io state
    in ProgramState { valueStack =  ([ firstValue  ] ++ itemsOfStack), position = ( (position state) + 1), scopes = (scopes state), io = nio }

opCodeCall :: (ProgramState -> ProgramState) -> ProgramState -> ProgramState
opCodeCall !f !state =
    let
        nstate = f (ProgramState {valueStack = (valueStack state), position = 0, scopes = (scopes state), io = (io state)})
        nio = io nstate
    in ProgramState {valueStack = (valueStack nstate), position = ((position state) + 1), scopes = (scopes nstate), io = nio}


makeIO :: IO()
makeIO = do
 return ()

actOnFirst f (a, b) = ((f a), b)


performGetLine :: IO() -> (String, IO())
performGetLine a =
    let
    dt =  a  >> (hFlush stdout) >>  getLine
    in ((unsafePerformIO dt),(return ()))

performGetChar :: IO() -> (Char, IO())
performGetChar a =
    let
    dt = a >> (hFlush stdout) >> getChar
    in ((unsafePerformIO dt),(return ()))


performReadIntegerIO :: IO() -> (Integer, IO())
performReadIntegerIO a = actOnFirst (read :: String -> Integer) (performGetLine a)

performDoubleIO :: IO() -> (Double, IO())
performDoubleIO a = actOnFirst (read :: String -> Double) (performGetLine a)

performReadInteger :: IO() -> (Value, IO())
performReadInteger a = actOnFirst VInt (performReadIntegerIO a)

performReadBool :: IO() ->  (Value, IO())
performReadBool !a =
    let
    parseBool :: String -> Value
    parseBool "true" = (VBool True)
    parseBool _ = (VBool False)
    in actOnFirst parseBool (performGetLine a)

charToInteger :: Char -> Integer
charToInteger a =  (fromIntegral (fromEnum a)) :: Integer

performReadChar :: IO() ->  (Value, IO())
performReadChar a =  actOnFirst VChar (actOnFirst charToInteger (performGetChar a))

performReadUChar :: IO() -> (Value, IO())
performReadUChar a =  actOnFirst (convert "unsigned char") (performReadChar a)

performReadShort :: IO() -> (Value, IO())
performReadShort a =  actOnFirst (convert "short") (performReadInteger a)

performReadUShort :: IO() -> (Value, IO())
performReadUShort a =  actOnFirst (convert "unsigned short") (performReadInteger a)

performReadInt :: IO() -> (Value, IO())
performReadInt a =  actOnFirst (convert "int") (performReadInteger a)

performReadUInt :: IO() -> (Value, IO())
performReadUInt a =  actOnFirst (convert "unsigned int") (performReadInteger a)

performReadLong :: IO() -> (Value, IO())
performReadLong a =  actOnFirst (convert "long") (performReadInteger a)

performReadULong :: IO() -> (Value, IO())
performReadULong a =  actOnFirst (convert "unsigned long") (performReadInteger a)

performReadLongLong :: IO() -> (Value, IO())
performReadLongLong a =  actOnFirst (convert "long long") (performReadInteger a)

performReadULongLong :: IO() -> (Value, IO())
performReadULongLong a =  actOnFirst (convert "unsigned long long") (performReadInteger a)

stringToVArray :: String -> Value
stringToVArray !a = (VArray ((stringToVCharList a) ++ [(VChar 0)]))

performReadString :: IO() -> (Value, IO())
performReadString a = actOnFirst stringToVArray (performGetLine a)

performReadFloat :: IO() -> (Value, IO())
performReadFloat a =  actOnFirst VFloat (performDoubleIO a)

performReadDouble :: IO() -> (Value, IO())
performReadDouble a =  actOnFirst VDouble (performDoubleIO a)

performReadLongDouble :: IO() -> (Value, IO())
performReadLongDouble a =  actOnFirst VLongDouble (performDoubleIO a)


performNullaryRead :: (IO() -> (Value, IO())) -> ProgramState -> ProgramState
performNullaryRead !f !state =
    let
        (value, nio) = f (io state)
        !nstack = ([value] ++ (valueStack state))
        handle :: IOException -> IO()
        handle e = nio
        !newIO  = nio >> ((appendFile "execution_log.txt" $! ("performNullaryRead " ++ (show value) ++ ": " ++ (show nstack) ++ "\r\n")) `catch` handle)
    in ProgramState { valueStack =  nstack, position = ( (position state) + 1), scopes = (scopes state), io = newIO }


performWriteBoolInternal :: Value -> IO() -> IO()
performWriteBoolInternal (VBool True) !a =  a  >> (hFlush stdout) >> putStrLn "true"
performWriteBoolInternal (VBool False) !a =  a >> (hFlush stdout) >> putStrLn "false"

vCharToChar :: Value -> Char
vCharToChar (VChar a) = ((toEnum ((fromIntegral a) :: Int)) :: Char)

performWriteBool :: (Value, IO()) -> (Value, IO())
performWriteBool (!a, !io) = ((VInt 0), (performWriteBoolInternal a io ))

performWriteChar :: (Value, IO()) -> (Value, IO())
performWriteChar (!a, !io) = ((VInt 0), (io  >> (hFlush stdout) >> (putChar (vCharToChar a))))

performWriteUChar :: (Value, IO()) -> (Value, IO())
performWriteUChar (!a, !io) = performWriteChar ((convert "char" a), io)

performWriteInteger :: (Integer, IO()) -> (Value, IO())
performWriteInteger (!a, !io) = ((VInt 0), (io >> (hFlush stdout) >> (putStr(show a))))

performWriteDoubleIO :: (Double, IO()) -> (Value, IO())
performWriteDoubleIO (!a, !io) = ((VInt 0), (io  >> (hFlush stdout) >> (putStr(show a))))

performWriteShort :: (Value, IO()) -> (Value, IO())
performWriteShort (VShort !v, !a) = performWriteInteger (v,a)

performWriteUShort :: (Value, IO()) -> (Value, IO())
performWriteUShort (VUShort !v, !a) = performWriteInteger (v,a)

performWriteInt :: (Value, IO()) -> (Value, IO())
performWriteInt (VInt !v, !a) = performWriteInteger (v,a)

performWriteUInt :: (Value, IO()) -> (Value, IO())
performWriteUInt (VUInt !v, !a) = performWriteInteger (v,a)

performWriteLong :: (Value, IO()) -> (Value, IO())
performWriteLong (VLong !v, !a) = performWriteInteger (v,a)

performWriteULong :: (Value, IO()) -> (Value, IO())
performWriteULong (VULong !v, !a) = performWriteInteger (v,a)

performWriteLongLong :: (Value, IO()) -> (Value, IO())
performWriteLongLong (VLongLong !v, !a) = performWriteInteger (v,a)

performWriteULongLong :: (Value, IO()) -> (Value, IO())
performWriteULongLong (VULongLong !v, !a) = performWriteInteger (v,a)


performWriteFloat :: (Value, IO()) -> (Value, IO())
performWriteFloat (VFloat !v, !a) = performWriteDoubleIO (v, a)

performWriteDouble :: (Value, IO()) -> (Value, IO())
performWriteDouble (VDouble !v, !a) = performWriteDoubleIO (v, a)

performWriteLongDouble :: (Value, IO()) -> (Value, IO())
performWriteLongDouble (VLongDouble !v, !a) = performWriteDoubleIO (v, a)

performWriteStringIO :: IO() -> Integer -> [Value] -> (Value, IO())
performWriteStringIO !io !a !b =
    let
    sources :: [Value]
    sources = ((take ((fromIntegral a) :: Int) b) )
    kSources =  Data.List.map vCharToChar sources
    in ((VInt 0), (io >> (putStrLn kSources)))


performWriteString :: IO() -> Value -> Value -> (Value, IO())
performWriteString !io !a (VArray !v) = performWriteStringIO io (unwrapInteger a) v


performBinaryOperationIO :: (IO() -> Value -> Value -> (Value, IO())) -> ProgramState -> ProgramState
performBinaryOperationIO !f !state =
    let
        !secondValue = head (valueStack state)
        !firstValue = head (tail (valueStack state) )
        !itemsOfStack = tail (tail (valueStack state) )
        (!element, !newIO) = (f (io state) firstValue secondValue)
    in ProgramState { valueStack =  ([ element ] ++ itemsOfStack), position = ( (position state) + 1), scopes = (scopes state), io = newIO }

performUnaryOperationIO :: ((Value, IO()) -> (Value, IO())) -> ProgramState -> ProgramState
performUnaryOperationIO !f !state =
    let
        !firstValue = head (valueStack state)
        !itemsOfStack = tail (valueStack state)
        (!element, !newIO) = (f (firstValue, (io state)))
        handle :: IOException -> IO()
        handle e = newIO
        !newStack = ([ element ] ++ itemsOfStack)
        !nio  = newIO >> ((appendFile "execution_log.txt" $! ("performUnaryOperationIO " ++ (show firstValue) ++ "\r\n")) `catch` handle)
    in ProgramState { valueStack =  newStack, position = ( (position state) + 1), scopes = (scopes state), io = nio }


writeBool !state = performUnaryOperationIO performWriteBool state
writeChar !state = performUnaryOperationIO performWriteChar state
writeUChar !state = performUnaryOperationIO performWriteUChar state
writeShort !state = performUnaryOperationIO performWriteShort state
writeUShort !state = performUnaryOperationIO performWriteUShort state
writeInt !state = performUnaryOperationIO performWriteInt state
writeUInt !state = performUnaryOperationIO performWriteUInt state
writeLong !state = performUnaryOperationIO performWriteLong state
writeULong !state  = performUnaryOperationIO performWriteULong state
writeLongLong !state  = performUnaryOperationIO performWriteLongLong state
writeULongLong !state  = performUnaryOperationIO performWriteULongLong state
writeFloat  !state = performUnaryOperationIO performWriteFloat state
writeDouble  !state = performUnaryOperationIO performWriteDouble state
writeLongDouble  !state = performUnaryOperationIO performWriteLongDouble state
writeString  !state = performBinaryOperationIO performWriteString state

vstrlen :: Value -> Value
vstrlen (VArray !v) =
    let
    vcount :: Integer -> [Value] -> Integer
    vcount a [] = a
    vcount a ((VChar 0):_) = a
    vcount a (x:xs) = vcount (a+1) xs
    in (VInt (vcount 0 v))

strlen = performUnaryOperation vstrlen

readBool :: ProgramState -> ProgramState
readBool !state = performNullaryRead performReadBool state

readChar :: ProgramState -> ProgramState
readChar !state = performNullaryRead performReadChar state

readUChar :: ProgramState -> ProgramState
readUChar !state = performNullaryRead performReadUChar state

readShort :: ProgramState -> ProgramState
readShort !state = performNullaryRead performReadShort state

readUShort :: ProgramState -> ProgramState
readUShort !state = performNullaryRead performReadUShort state

readInt :: ProgramState -> ProgramState
readInt state = performNullaryRead performReadInt state

readUInt :: ProgramState -> ProgramState
readUInt !state = performNullaryRead performReadUInt state

readLong :: ProgramState -> ProgramState
readLong !state = performNullaryRead performReadLong state

readULong :: ProgramState -> ProgramState
readULong !state = performNullaryRead performReadULong state

readLongLong :: ProgramState -> ProgramState
readLongLong !state = performNullaryRead performReadLongLong state

readULongLong :: ProgramState -> ProgramState
readULongLong !state = performNullaryRead performReadULongLong state

readFloat :: ProgramState -> ProgramState
readFloat !state = performNullaryRead performReadFloat state

readDouble :: ProgramState -> ProgramState
readDouble !state = performNullaryRead performReadDouble state

readLongDouble :: ProgramState -> ProgramState
readLongDouble !state = performNullaryRead performReadLongDouble state

readString :: ProgramState -> ProgramState
readString !state = performNullaryRead performReadString state



opDeclareVariable :: String -> ProgramState -> ProgramState
opDeclareVariable !name (ProgramState{ valueStack = !stack, position = !pos, scopes = !scopes, io = !io }) =
    let
    !value = head stack
    !nstack = tail stack
    !nscopes = [ Data.HashMap.Strict.insert name value (head scopes) ] ++ (tail scopes)
    handle :: IOException -> IO()
    handle e = io >> (return ())
    !nio  = io >> ((appendFile "execution_log.txt" $! ("opDeclareVariable " ++ name ++ ": " ++ (show value) ++ (show nscopes) ++ "\r\n")) `catch` handle)
    in (ProgramState{ valueStack = nstack, position = pos + 1, scopes = nscopes, io = nio })


rtlGetVariable :: String  -> [(HashMap String Value)] -> Value
rtlGetVariable !a (!x:(!xs)) =
    let
    __v = a
    __q :: (Maybe Value) -> Value -> Value
    __q (Just !v) !k = v
    __q (Nothing) !k = k
    in __q (Data.HashMap.Strict.lookup __v x) (rtlGetVariable a xs)

rtlGetVariable !a [] = (VBool False)

opPushVariable :: String -> ProgramState -> ProgramState
opPushVariable !name (ProgramState{ valueStack = !stack, position = !pos, scopes = !scopes, io = !io }) =
    let
        !nstack = [(rtlGetVariable name  scopes) ] ++ stack
        !nio = io
    in  (ProgramState{ valueStack = nstack, position = pos + 1, scopes = scopes, io = nio })

rtlReplaceVariable :: String -> Value -> [(HashMap String Value)] -> [(HashMap String Value)]
rtlReplaceVariable a v [] = [ (Data.HashMap.Strict.insert a v newScope) ]
rtlReplaceVariable a v (x:xs) = _q (isJust (Data.HashMap.Strict.lookup a x)) ([(Data.HashMap.Strict.insert a  v x) ] ++ xs) [x] ++ (rtlReplaceVariable a v xs)

opAssignVariable :: String -> ProgramState -> ProgramState
opAssignVariable name (ProgramState{ valueStack = !stack, position = !pos, scopes = !scopes, io = !io }) =
    let
        !nstack = stack
        !nscopes = (rtlReplaceVariable name (head stack) scopes)
    in  (ProgramState{ valueStack = nstack, position = pos + 1, scopes = nscopes, io = io })


{-- Заменяется б в а ---}

executeProgram :: [ProgramState -> ProgramState] -> ProgramState -> ProgramState
executeProgram !program !state = executeProgramCheck ((position state >= 0) && (position state) < ((fromIntegral (length program)) :: Integer)) program state

executeProgramCheck :: Bool -> [ProgramState -> ProgramState] -> ProgramState -> ProgramState
executeProgramCheck  False !program !state = state
executeProgramCheck  True !program !state = executeProgram program (((program !! ((fromIntegral (position state)) :: Int)) ) state)

opPushLiteral :: Value -> ProgramState -> ProgramState
opPushLiteral a (ProgramState{ valueStack = stack, position = pos, scopes = scopes, io = !io }) = (ProgramState{ valueStack = ([a] ++ stack), position = (pos + 1), scopes = scopes, io = io })

opJmp :: Integer -> ProgramState -> ProgramState
opJmp a (ProgramState{ valueStack = stack, position = pos, scopes = scopes, io = !io }) = (ProgramState{ valueStack = (stack), position = a, scopes = scopes, io = io {-- >> (putStrLn ("opJMP NEW POSITION " ++ (show a))) --} })

opPop :: ProgramState -> ProgramState
opPop (ProgramState{ valueStack = stack, position = pos, scopes = scopes, io = !io }) = (ProgramState{ valueStack = (tail stack), position = (pos + 1), scopes = scopes, io = io })

opPushScope :: ProgramState -> ProgramState
opPushScope (ProgramState{ valueStack = stack, position = pos, scopes = scopes, io = !io }) = (ProgramState{ valueStack = stack, position = (pos + 1), scopes = ([newScope] ++ scopes), io = io })

opPopScope :: ProgramState -> ProgramState
opPopScope (ProgramState{ valueStack = stack, position = pos, scopes = scopes, io = !io }) = (ProgramState{ valueStack = stack, position = (pos + 1), scopes = (tail scopes), io = io })

opMakeArray :: Int -> ProgramState ->ProgramState
opMakeArray count (ProgramState{ valueStack = !stack, position = !pos, scopes = !scopes, io = !io }) =
    let
        items = reverse (take count stack)
        nstack = [(VArray items)]  ++ (drop count stack)
    in (ProgramState{ valueStack = nstack, position = (pos + 1), scopes = scopes, io = io })


rtlUnwrapArray :: Value -> [Value]
rtlUnwrapArray (VArray !v) = v
rtlUnwrapArray !a = [a]

rtlAccessArray :: Value -> [Value] -> Value
rtlAccessArray arr []  = arr
rtlAccessArray arr (x:xs) =
    let
        accessArray :: Value -> Value -> Value
        accessArray arr ind = (rtlGetValue (rtlUnwrapArray arr)  ((fromIntegral (unwrapInteger ind)) :: Int))
    in  rtlAccessArray (accessArray arr x) xs

rtlGetValueFromArray :: String -> [Value] -> [(HashMap String Value)] -> Value
rtlGetValueFromArray !name !indexes !scopes =
    let
        sourceValue = rtlGetVariable name scopes
    in  rtlAccessArray sourceValue indexes

opGetValueFromArray :: Int -> ProgramState -> ProgramState
opGetValueFromArray count (ProgramState{ valueStack = !stack, position = !pos, scopes = !scopes, io = !io }) =
    let
        indexes = reverse (take count stack)
        partialStack = (drop count stack)
        arr = head partialStack
        newValue = rtlAccessArray arr indexes
        nio = io {-- >> (putStrLn ("\nopGetValueFromArray: " ++ (show arr) ++ " " ++  (show indexes) ++ " " ++ (show newValue))) --}
        nstack = [ newValue ]  ++ (tail partialStack)
    in (ProgramState{ valueStack = nstack, position = (pos + 1), scopes = scopes, io = nio })


rtlToInt :: Integer -> Int
rtlToInt a = (fromIntegral a) :: Int

rtlTakeSafe :: Int -> [a] -> [a]
rtlTakeSafe num a = if (num <= 0) then []  else (take num a)

rtlDropSafe :: Int -> [a] -> [a]
rtlDropSafe num [] = []
rtlDropSafe 0 a = a
rtlDropSafe num a = if (num <= 0) then a else (if (num >= (length a)) then [] else (rtlDropSafe (num-1) (tail a)))


rtlGetValue :: [Value] -> Int  -> Value
rtlGetValue list num = let
    rtlGetValueSafe :: Int -> [Value] -> Int -> [Value] -> Value
    rtlGetValueSafe sind slist a [] = (putStrLn ((show sind) ++ " " ++ (show slist))) `seq` (VBool False)
    rtlGetValueSafe sind slist 0 (x:xs) = x
    rtlGetValueSafe sind slist a (x:xs) = rtlGetValueSafe sind slist (a-1) xs
    in rtlGetValueSafe num list num list

rtlAssignVariableByIndexesForArray  :: (Value -> Value -> Value) -> Value -> [Value] -> [Value] -> [Value]
rtlAssignVariableByIndexesForArray tr a indexes arr  =
    let
        takeAnUnwrap arr key = rtlUnwrapArray (rtlGetValue arr key)
        replaceByIndexes :: Value -> [Int] -> [Value] -> [Value]
        replaceByIndexes a [] arr = arr
        replaceByIndexes a indexes [] = []
        replaceByIndexes a [0] arr = [(tr a (rtlGetValue arr 0))] ++ (rtlDropSafe 1 arr)
        replaceByIndexes a [key] arr =  (rtlTakeSafe key arr) ++ [(tr a (rtlGetValue arr key))] ++ (rtlDropSafe (key+1) arr)
        replaceByIndexes a (0:xs) arr = [(VArray (replaceByIndexes a xs (takeAnUnwrap arr  0)))] ++ (rtlDropSafe 1 arr)
        replaceByIndexes a (key:xs) arr = (rtlTakeSafe key arr) ++ [(VArray (replaceByIndexes a xs (takeAnUnwrap arr key)))] ++ (rtlDropSafe (key+1) arr)
    in replaceByIndexes a (Data.List.map rtlToInt (Data.List.map unwrapInteger indexes)) arr


rtlAssignVariableByIndexesForValue :: (Value -> Value -> Value) -> Value -> [Value] -> Value -> Value
rtlAssignVariableByIndexesForValue transform value indexes (VArray arr) =
    (VArray (rtlAssignVariableByIndexesForArray transform value indexes arr))


rtlGetFirst :: Value -> Value -> Value
rtlGetFirst !a !b = a

rtlReplaceVArrayPart :: Value -> Value -> Value
rtlReplaceVArrayPart (VArray !newValue) (VArray !oldValue) =
    let
        rtlReplaceArrayPart :: [Value] -> [Value] -> [Value]
        rtlReplaceArrayPart !newValue !oldValue  = _q (length newValue > length oldValue) newValue  (newValue ++ (drop (length newValue) oldValue))
    in (VArray (rtlReplaceArrayPart newValue oldValue))


opAssignVariableByIndex :: String -> Int -> ProgramState -> ProgramState
opAssignVariableByIndex !name !count  (ProgramState{ valueStack = !stack, position = !pos, scopes = !scopes, io = !io }) =
    let 
        !oldValue = rtlGetVariable name scopes
        !io1 = io {-- >> (putStrLn ("OLD VALUE " ++ (show oldValue))) --}
        !stackWithoutValue = (tail stack)
        !replacedValue = (head stack)
        !io2 = io1 {-- >> (putStrLn ("REPLACED VALUE " ++ (show replacedValue))) --}
        !indexes = reverse (take count stackWithoutValue)
        !io3 = io2 {-- >> (putStrLn ("INDEXES " ++ (show indexes))) --}
        !newStack = [replacedValue] ++ (drop count stackWithoutValue)
        !newVariableValue = rtlAssignVariableByIndexesForValue rtlGetFirst replacedValue indexes oldValue
        !newScopes = rtlReplaceVariable name newVariableValue scopes
    in  (ProgramState{ valueStack = newStack, position = (pos + 1), scopes = newScopes, io = io3 })

opNOP :: ProgramState -> ProgramState
opNOP  (ProgramState{ valueStack = !stack, position = !pos, scopes = !scopes, io = !io }) =
    (ProgramState{ valueStack = stack, position = (pos + 1), scopes = scopes, io = io })

rtlJT  :: (Bool -> Bool) -> Int -> ProgramState -> ProgramState
rtlJT !f !num (ProgramState{ valueStack = !stack, position = !pos, scopes = !scopes, io = !io }) =
    let
        !value = (head stack)
        !newStack = (tail stack)
        !newPos = if (f (unwrapBool value)) then ((fromIntegral num) :: Integer) else (pos+1)
        !io2 = io   {-- >> (putStrLn ("rtlJT NEW POSITION " ++ (show newPos))) --}
    in  (ProgramState{ valueStack = newStack, position = newPos , scopes = scopes, io = io2 })

rtlJTP  :: (Bool -> Bool) -> Int ->  Int -> ProgramState -> ProgramState
rtlJTP !f !truePos !falsePos (ProgramState{ valueStack = !stack, position = !pos, scopes = !scopes, io = !io }) =
    let
        !value = (head stack)
        !newStack = (tail stack)
        !newPos = if (f (unwrapBool value)) then ((fromIntegral truePos) :: Integer) else ((fromIntegral falsePos) :: Integer)
        !io2 = io   {-- >> (putStrLn ("rtlJTP NEW POSITION " ++ (show newPos))) --}
    in  (ProgramState{ valueStack = newStack, position = newPos , scopes = scopes, io = io2 })

opJT !num !state = rtlJT id num state
opJNT !num !state = rtlJT not num state

opJTP !num !state = rtlJTP id num state
opJNTP !num !state = rtlJTP not num state


opDup :: ProgramState -> ProgramState
opDup  (ProgramState{ valueStack = !stack, position = !pos, scopes = !scopes, io = !io }) =
    let
        value = (head stack)
        nstack = (value:stack)
        nio = io
    in (ProgramState{ valueStack = nstack, position = (pos + 1), scopes = scopes, io = nio })

{-- Присвоение для строк без затирвания буффера --}
opExtendAssignVariable :: String -> ProgramState -> ProgramState
opExtendAssignVariable !name (ProgramState{ valueStack = !stack, position = !pos, scopes = !scopes, io = !io }) =
    let
        !oldValue = rtlGetVariable name scopes
        !stackWithoutValue = (tail stack)
        !newValue = rtlReplaceVArrayPart (head stack) oldValue
        !newScopes = rtlReplaceVariable name newValue scopes
    in  (ProgramState{ valueStack = stack, position = (pos + 1), scopes = newScopes, io = io })

opExtendAssignVariableByIndex :: String -> Int -> ProgramState -> ProgramState
opExtendAssignVariableByIndex !name !count  (ProgramState{ valueStack = !stack, position = !pos, scopes = !scopes, io = !io }) =
    let
        !oldValue = rtlGetVariable name scopes
        !io1 = io {-- >> (putStrLn ("OLD VALUE " ++ (show oldValue))) --}
        !stackWithoutValue = (tail stack)
        !replacedValue = (head stack)
        !io2 = io1 {-- >> (putStrLn ("REPLACED VALUE " ++ (show replacedValue))) --}
        !indexes = reverse (take count stackWithoutValue)
        !io3 = io2 {-- >> (putStrLn ("INDEXES " ++ (show indexes))) --}
        !newStack = [replacedValue] ++ (drop count stackWithoutValue)
        !newVariableValue = rtlAssignVariableByIndexesForValue rtlReplaceVArrayPart replacedValue indexes oldValue
        !newScopes = rtlReplaceVariable name newVariableValue scopes
    in  (ProgramState{ valueStack = newStack, position = (pos + 1), scopes = newScopes, io = io3 })


ᴪrunStaticInitializers :: ProgramState -> ProgramState
ᴪrunStaticInitializers = executeProgram []


puts :: ProgramState -> ProgramState
puts = executeProgram [opPushScope,opDeclareVariable  "a",opPushScope,opPushVariable "a",opCodeCall strlen,opCodeConvert "int",opPushVariable "a",opCodeCall writeString,opPop ,opPopScope,opPushLiteral (VInt 0),opPopScope]
ᴪmain :: ProgramState -> ProgramState
ᴪmain = executeProgram [opPushScope,opDeclareVariable  "argv",opDeclareVariable  "argc",opPushScope,opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opPushLiteral (VChar 92),opMakeArray 100,opDeclareVariable  "a",opPushLiteral (VArray [(VChar 80), (VChar 108), (VChar 101), (VChar 97), (VChar 115), (VChar 101), (VChar 44), (VChar 32), (VChar 101), (VChar 110), (VChar 116), (VChar 101), (VChar 114), (VChar 32), (VChar 121), (VChar 111), (VChar 117), (VChar 114), (VChar 32), (VChar 110), (VChar 97), (VChar 109), (VChar 101), (VChar 58), (VChar 32)]),opCodeCall puts,opPop ,opCodeCall readString,opExtendAssignVariable  "a",opPop ,opPushLiteral (VArray [(VChar 72), (VChar 101), (VChar 108), (VChar 108), (VChar 111), (VChar 44), (VChar 32)]),opCodeCall puts,opPop ,opPushVariable "a",opCodeCall puts,opPop ,opPushLiteral (VInt 0),opJmp 121,opPopScope,opPopScope]



main = do
    args <- getArgs
    let
        argc :: Value
        argc = (VInt ((fromIntegral (length args)) :: Integer))
        argv = (VArray (Data.List.map stringToArray1000 args))
        selfScope = (opJmp 0 (opPushLiteral argv (opPushLiteral argc newState)))
        state = ((opPopScope (opCodeCall ᴪmain (opCodeCall ᴪrunStaticInitializers (opPushScope selfScope)))))
        in do
            hSetBuffering stdin NoBuffering
            hSetBuffering stdout NoBuffering
            io state