diff --git a/README.md b/README.md
index b831f8c86fc870fc400ea92fb4f9b79c9a0cae26..2f2fb777572dc60824c5a1a2d668e64538aa22d4 100644
--- a/README.md
+++ b/README.md
@@ -70,14 +70,14 @@ prints the register 0 to i after execution.
 Calling the interpreter with the -d option starts a debug REPL.
 There are several available commands:
 
-    - p/P/print/Print i (print register i)
-    - p/P/print/Print i-j (print registers i to j)
-    - n/N/next/Next (execute next line)
-    - c/C/continue/Continue (execute whole program starting with the current state)
-    - r/R/restart/Restart (execute from beginning)
-    - b/B/bp/BP/breakpoint i (set a breakpoint for line i)
-    - w/W/wp/WP/watchpoint i (set a watchpoint for memory cell i)
-    - q/Q/quit/Quit (quit debugger)
+    - p i (print register i)
+    - p i-j (print registers i to j)
+    - n (execute next line)
+    - c (execute whole program starting with the current state)
+    - r (execute from beginning)
+    - b (set a breakpoint for line i)
+    - w (set a watchpoint for memory cell i)
+    - q (quit debugger)
 
 A breakpoint halts the program *before* the line with the breakpoint is executed.
 A watchpoint halts the progam *after* a datum has been written to the cell with the watchpoint.
diff --git a/src/Debugger.hs b/src/Debugger.hs
index 89059babff5601c70c32b508be985dd7a02b377c..bb58797f13b16d395542765c4504f0c33002327f 100644
--- a/src/Debugger.hs
+++ b/src/Debugger.hs
@@ -5,7 +5,7 @@
 --The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
 --
 --THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.{-# LANGUAGE OverloadedStrings #-}
-
+{-# LANGUAGE OverloadedStrings #-}
 module Debugger where
 
 import           Control.Monad
@@ -34,11 +34,12 @@ import           Text.ParserCombinators.Parsec  ( Parser
                                                 , spaces
                                                 , string
                                                 , try
+                                                , choice
                                                 )
 
-type BreakPoints = [Int]
+type BreakPoints = [Integer]
 
-type WatchPoints = [Int]
+type WatchPoints = [Integer]
 
 type InitialState = State
 
@@ -47,9 +48,9 @@ data Data = Data Program InstructionPointer State BreakPoints WatchPoints
 data DebugCmd
     = Next
     | Continue
-    | Print Int Int
-    | BreakPoint Int
-    | WatchPoint Int
+    | Print Integer Integer
+    | BreakPoint Integer
+    | WatchPoint Integer
     | Restart
     | Quit
     deriving (Show, Eq)
@@ -84,7 +85,7 @@ executeDebugCmd Next pips@(Data p ip s wps bps) = case step $ PIPS p ip s of
   Left err -> Left err
   Right (ip', s') ->
     Right
-      $ ("Executed in line: " ++ (show $ ip + 1) ++ " " ++ (show $ p ! ip), Data p ip' s' bps wps)
+      $ ("Executed in line: " ++ (show $ ip + 1) ++ " " ++ (show $ p ! (fromIntegral ip)), Data p ip' s' bps wps)
 executeDebugCmd Continue pips@(Data p ip _ bps wps) = case multiStep pips of
   Left  err -> Left err
   Right d   -> Right $ ("Continued", d)
@@ -100,7 +101,7 @@ executeDebugCmd (WatchPoint wp) (Data p ip s bps wps) =
   Right ("Watching cell " ++ (show $ wp), Data p ip s bps (wp : wps))
 
 multiStep :: Data -> Either Error Data
-multiStep d@(Data p ip s bps wps) = if ip >= (Data.Vector.length p)
+multiStep d@(Data p ip s bps wps) = if ip >= (toInteger $ Data.Vector.length p)
   then
     Left
     $  "Illegal instruction pointer: "
@@ -108,7 +109,7 @@ multiStep d@(Data p ip s bps wps) = if ip >= (Data.Vector.length p)
     ++ " possibly caused by wrong GOTO/IF "
   else if ip `elem` bps
     then Right d
-    else case p ! ip of
+    else case p ! (fromIntegral ip) of
       End        -> Right d
       Store    l -> checkWP l d
       IndStore l -> checkWP (s l) d
@@ -124,47 +125,47 @@ multiStep d@(Data p ip s bps wps) = if ip >= (Data.Vector.length p)
 
 parseBP :: Parser DebugCmd
 parseBP = do
-  string "B" <|> string "b" <|> string "bp" <|> string "breakpoint" <|> string "BP"
+  string "b"
   spaces
   line <- many1 digit
   return . BreakPoint $ (read line) - 1
 
 parseWP :: Parser DebugCmd
 parseWP = do
-  string "W" <|> string "w" <|> string "wp" <|> string "watchpoint" <|> string "WP"
+  string "w"
   spaces
   line <- many1 digit
   return . WatchPoint $ (read line)
 
 parseNext :: Parser DebugCmd
-parseNext = ((string "n") <|> (string "N") <|> (string "next") <|> (string "Next")) >> return Next
+parseNext = (string "n") >> return Next
 
 parseContinue :: Parser DebugCmd
 parseContinue =
-  ((string "c") <|> (string "C") <|> (string "continue") <|> (string "Continue")) >> return Continue
+  (string "c") >> return Continue
 
 parseRestart :: Parser DebugCmd
 parseRestart =
-  ((string "r") <|> (string "R") <|> (string "restart") <|> (string "Restart")) >> return Restart
+  (string "r") >> return Restart
 
 parseQuit :: Parser DebugCmd
-parseQuit = ((string "q") <|> (string "Q") <|> (string "quit") <|> (string "Quit")) >> return Quit
+parseQuit = (string "q") >> return Quit
 
 parsePrint :: Parser DebugCmd
 parsePrint = do
-  ((string "p") <|> (string "P") <|> (string "print") <|> (string "Print"))
+  (string "p")
   range <- optionMaybe $ spaces >> ((try parseRange) <|> (try parseSingleReg))
   return $ case range of
     Nothing             -> Print 0 3
     Just (Left  i     ) -> Print i i
     Just (Right (i, j)) -> Print i j
 
-parseSingleReg :: Parser (Either Int (Int, Int))
+parseSingleReg :: Parser (Either Integer (Integer, Integer))
 parseSingleReg = do
   reg <- many1 digit
   return . Left . read $ reg
 
-parseRange :: Parser (Either Int (Int, Int))
+parseRange :: Parser (Either Integer (Integer, Integer))
 parseRange = do
   fst <- many1 digit
   char '-'
diff --git a/src/Instructions.hs b/src/Instructions.hs
index 9f18039c7ee27255316dbb2fb2b054680ea0a604..b0dac947fb44c6619845eff68d79eb8596833760 100644
--- a/src/Instructions.hs
+++ b/src/Instructions.hs
@@ -5,6 +5,7 @@
 --The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
 --
 --THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.module Instructions where
+module Instructions where
 
 import Data.Vector
 
@@ -12,25 +13,25 @@ type Program = Vector Instruction
 
 data Comparative = REQ | RLET | RGET | RLT | RGT deriving (Show, Eq)
 
-data Instruction =  Input [Int]
-                    | Load Int
-                    | Store Int
-                    | Add Int
-                    | Sub Int
-                    | Mult Int
-                    | Div Int
-                    | Goto Int
+data Instruction =  Input [Integer]
+                    | Load Integer
+                    | Store Integer
+                    | Add Integer
+                    | Sub Integer
+                    | Mult Integer
+                    | Div Integer
+                    | Goto Integer
                     | End
-                    | If Comparative Int Int
-                    | CAdd Int
-                    | CLoad Int
-                    | CSub Int
-                    | CMult Int
-                    | CDiv Int
-                    | IndAdd Int
-                    | IndLoad Int
-                    | IndStore Int
-                    | IndSub Int
-                    | IndMult Int
-                    | IndDiv Int
+                    | If Comparative Integer Integer
+                    | CAdd Integer
+                    | CLoad Integer
+                    | CSub Integer
+                    | CMult Integer
+                    | CDiv Integer
+                    | IndAdd Integer
+                    | IndLoad Integer
+                    | IndStore Integer
+                    | IndSub Integer
+                    | IndMult Integer
+                    | IndDiv Integer
                     deriving (Show, Eq)
diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 5350d0c5c4953ed023077e4679c037b7e2b2c0e0..9e8be119b2667cf91510e1a92a80017349266c0b 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -20,7 +20,7 @@ import           Text.ParserCombinators.Parsec (Parser, char, digit, many1,
                                                 parse, spaces, string, try,
                                                 (<|>))
 
-type InstructionPointer = Int
+type InstructionPointer = Integer
 
 type Error = String
 
@@ -34,11 +34,11 @@ eval p = multiStep $ PIPS p 0 emptyState
 
 multiStep :: PIPS -> Result
 multiStep (PIPS p ip s) =
-  if (ip >= (Data.Vector.length p))
+  if (ip >= (toInteger $ Data.Vector.length p))
     then Left $
          "Illegal instruction pointer: " ++
          (show $ ip + 1) ++ " possibly caused by wrong GOTO/IF "
-    else case p ! ip of
+    else case p ! (fromIntegral ip) of
            End -> Right s
            _ ->
              case step $ PIPS p ip s of
@@ -47,7 +47,7 @@ multiStep (PIPS p ip s) =
 
 step :: PIPS -> Either Error (InstructionPointer, State)
 step (PIPS p ip s) =
-  case p ! ip of
+  case p ! (fromIntegral ip) of
     Input xs -> Right (ip + 1, multiUpdateState s xs)
     End -> Left "END"
     (Load l) -> Right (ip + 1, updateState s 0 (s l))
@@ -103,7 +103,7 @@ step (PIPS p ip s) =
         then Left $ "INDDIV by 0 in line " ++ (show $ ip + 1)
         else Right (ip + 1, updateState s 0 (quot (s 0) (s (s l))))
 
-monus :: Int -> Int -> Int
+monus :: Integer -> Integer -> Integer
 monus a b =
   if a - b < 0
     then 0
diff --git a/src/Ramparser.hs b/src/Ramparser.hs
index cb9545b7ba0b380ca4e1efea9d7eb2eacc7ee648..4361a38a8ca2eebe22f75e81ba31dfcaa77d6abd 100644
--- a/src/Ramparser.hs
+++ b/src/Ramparser.hs
@@ -48,20 +48,20 @@ run args = do
         return ()
       else putStrLn $ printRes (registers args) (eval prog)
 
-printRes :: Int -> Result -> String
+printRes :: Integer -> Result -> String
 printRes _ (Left  err) = err
 printRes i (Right s  ) = stateToString i s
 
 data Flag
   = Debug Bool
-  | Registers Int
+  | Registers Integer
   | File String
   deriving (Show, Eq)
 
 data Arguments =
   Arguments
     { debug     :: Bool
-    , registers :: Int
+    , registers :: Integer
     , file      :: String
     }
   deriving (Show, Eq)
diff --git a/src/State.hs b/src/State.hs
index 33fc609ad791b42ed6f45d1ef3816c27a1cf24f2..dd44d39d33cbb123c2ebb17ea883dbd85e46bc32 100644
--- a/src/State.hs
+++ b/src/State.hs
@@ -11,26 +11,26 @@ module State where
 
 import qualified Data.ByteString.Lazy.Char8    as B
 
-type State = Int -> Int
+type State = Integer-> Integer
 
-type Key = Int
+type Key = Integer
 
-type Value = Int
+type Value = Integer
 
 emptyState :: State
 emptyState = const 0
 
-multiUpdateState :: State -> [Int] -> State
+multiUpdateState :: State -> [Integer] -> State
 multiUpdateState s inputs = init 1 inputs s
  where
   init key []       s = s
   init key (x : xs) s = init (key + 1) xs $ updateState s key x
 
-stateToString :: Int -> State -> String
+stateToString :: Integer -> State -> String
 stateToString 0 s = "c(0) = " ++ (show $ s 0)
 stateToString n s = stateToString (n - 1) s ++ "\nc(" ++ (show n) ++ ") = " ++ (show $ s n)
 
-printRegisterRange :: Int -> Int -> State -> String
+printRegisterRange :: Integer -> Integer -> State -> String
 printRegisterRange i j s = if i < j
   then "c(" ++ (show i) ++ ") = " ++ (show $ s i) ++ "\n" ++ printRegisterRange (i + 1) j s
   else "c(" ++ (show i) ++ ") = " ++ (show $ s i)