diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,165 @@
+                  GNU LESSER GENERAL PUBLIC LICENSE
+                       Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+  This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+  0. Additional Definitions. 
+
+  As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+  "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+  An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+  A "Combined Work" is a work produced by combining or linking an
+Application with the Library.  The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+  The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+  The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+  1. Exception to Section 3 of the GNU GPL.
+
+  You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+  2. Conveying Modified Versions.
+
+  If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+   a) under this License, provided that you make a good faith effort to
+   ensure that, in the event an Application does not supply the
+   function or data, the facility still operates, and performs
+   whatever part of its purpose remains meaningful, or
+
+   b) under the GNU GPL, with none of the additional permissions of
+   this License applicable to that copy.
+
+  3. Object Code Incorporating Material from Library Header Files.
+
+  The object code form of an Application may incorporate material from
+a header file that is part of the Library.  You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+   a) Give prominent notice with each copy of the object code that the
+   Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the object code with a copy of the GNU GPL and this license
+   document.
+
+  4. Combined Works.
+
+  You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+   a) Give prominent notice with each copy of the Combined Work that
+   the Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the Combined Work with a copy of the GNU GPL and this license
+   document.
+
+   c) For a Combined Work that displays copyright notices during
+   execution, include the copyright notice for the Library among
+   these notices, as well as a reference directing the user to the
+   copies of the GNU GPL and this license document.
+
+   d) Do one of the following:
+
+       0) Convey the Minimal Corresponding Source under the terms of this
+       License, and the Corresponding Application Code in a form
+       suitable for, and under terms that permit, the user to
+       recombine or relink the Application with a modified version of
+       the Linked Version to produce a modified Combined Work, in the
+       manner specified by section 6 of the GNU GPL for conveying
+       Corresponding Source.
+
+       1) Use a suitable shared library mechanism for linking with the
+       Library.  A suitable mechanism is one that (a) uses at run time
+       a copy of the Library already present on the user's computer
+       system, and (b) will operate properly with a modified version
+       of the Library that is interface-compatible with the Linked
+       Version. 
+
+   e) Provide Installation Information, but only if you would otherwise
+   be required to provide such information under section 6 of the
+   GNU GPL, and only to the extent that such information is
+   necessary to install and execute a modified version of the
+   Combined Work produced by recombining or relinking the
+   Application with a modified version of the Linked Version. (If
+   you use option 4d0, the Installation Information must accompany
+   the Minimal Corresponding Source and Corresponding Application
+   Code. If you use option 4d1, you must provide the Installation
+   Information in the manner specified by section 6 of the GNU GPL
+   for conveying Corresponding Source.)
+
+  5. Combined Libraries.
+
+  You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+   a) Accompany the combined library with a copy of the same work based
+   on the Library, uncombined with any other library facilities,
+   conveyed under the terms of this License.
+
+   b) Give prominent notice with the combined library that part of it
+   is a work based on the Library, and explaining where to find the
+   accompanying uncombined form of the same work.
+
+  6. Revised Versions of the GNU Lesser General Public License.
+
+  The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+  Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+  If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.
diff --git a/Language/SSVM/Binary.hs b/Language/SSVM/Binary.hs
new file mode 100644
--- /dev/null
+++ b/Language/SSVM/Binary.hs
@@ -0,0 +1,210 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
+module Language.SSVM.Binary
+  (dumpCode, loadCode)
+  where
+
+import Control.Applicative
+import Control.Monad (forM_)
+import qualified Control.Monad.State as S
+import Data.BinaryState
+import qualified Data.Map as M
+import Data.Char
+import Data.Word
+
+import Language.SSVM.Types
+
+data BState = BState {
+  bMarks :: Marks,
+  bWords :: M.Map String Int,
+  bLastWord :: Int,
+  bAfterColon :: Bool }
+  deriving (Eq, Show)
+
+emptyBState :: BState
+emptyBState = BState {
+  bMarks = M.empty,
+  bWords = M.empty,
+  bLastWord = 0,
+  bAfterColon = False }
+
+type Put a = PutState BState a
+type Get a = GetState BState a
+
+allocWord :: String -> Put Int
+allocWord w = do
+  st <- S.get
+  let next = 1 + bLastWord st
+      ws = M.insert w next (bWords st)
+  S.put $ st {bWords = ws, bLastWord = next}
+  return next
+
+getWordN :: String -> Put Int
+getWordN w = do
+  ws <- S.gets bWords
+  case M.lookup w ws of
+    Nothing -> fail $ "Undefined word: " ++ w
+    Just i -> return i
+
+byte :: Word8 -> Put ()
+byte x = putZ x
+
+char :: Char -> Put ()
+char c = putZ (fromIntegral (ord c) :: Word8)
+
+getChar8 :: Get Char
+getChar8 = (chr . fromIntegral) <$> (getZ :: Get Word8)
+
+getMark :: String -> Put Int
+getMark name = do
+  ms <- S.gets bMarks
+  case M.lookup name ms of
+    Nothing -> fail $ "Undefined mark: @" ++ name
+    Just n  -> return n
+
+wordName :: Int -> Get String
+wordName n = return $ "WORD_" ++ show n
+
+markName :: Int -> Get String
+markName n = do
+  let name = "mark_at_" ++ show n
+  st <- S.get
+  let ms = M.insert name n (bMarks st)
+  S.put $ st {bMarks = ms}
+  return name
+
+instance BinaryState BState Instruction where
+  put NOP      = byte 0
+  put (PUSH x) = byte 1 >> put x
+  put DROP     = byte 2
+  put DUP      = byte 3
+  put SWAP     = byte 4
+  put OVER     = byte 5
+  put PRINT    = byte 6
+  put PRINTALL = byte 7
+  put ADD      = byte 8
+  put MUL      = byte 9
+  put DIV      = byte 10
+  put REM      = byte 11
+  put SUB      = byte 12
+  put NEG      = byte 13
+  put ABS      = byte 14
+  put CMP      = byte 15
+  put DEFINE   = byte 16
+  put COLON    = do
+                 st <- S.get
+                 S.put $ st {bAfterColon = True}
+                 byte 17
+  put (CALL s) = do
+                 n <- getWordN s
+                 byte 18
+                 putZ n
+  put VARIABLE = byte 19
+  put ASSIGN   = byte 20
+  put READ     = byte 21
+  put INPUT    = byte 22
+  put MARK     = byte 23
+  put (GETMARK x) = do
+                    n <- getMark x
+                    byte 24
+                    putZ n
+  put GOTO     = byte 25
+  put JZ       = byte 26
+  put JNZ      = byte 27
+  put JGT      = byte 28
+  put JLT      = byte 29
+  put JGE      = byte 30
+  put JLE      = byte 31
+  put ARRAY    = byte 32
+  put READ_ARRAY   = byte 33
+  put ASSIGN_ARRAY = byte 34
+
+  get = do
+    c <- getZ :: Get Word8
+    case c of
+      0 -> return NOP
+      1 -> PUSH <$> get
+      2 -> return DROP
+      3 -> return DUP
+      4 -> return SWAP
+      5 -> return OVER
+      6 -> return PRINT
+      7 -> return PRINTALL
+      8 -> return ADD
+      9 -> return MUL
+      10 -> return DIV
+      11 -> return REM
+      12 -> return SUB
+      13 -> return NEG
+      14 -> return ABS
+      15 -> return CMP
+      16 -> return DEFINE
+      17 -> return COLON
+      18 -> CALL <$> (wordName =<< getZ)
+      19 -> return VARIABLE
+      20 -> return ASSIGN
+      21 -> return READ
+      22 -> return INPUT
+      23 -> return MARK
+      24 -> GETMARK <$> (markName =<< getZ)
+      25 -> return GOTO
+      26 -> return JZ
+      27 -> return JNZ
+      28 -> return JGT
+      29 -> return JLT
+      30 -> return JGE
+      31 -> return JLE
+      32 -> return ARRAY
+      33 -> return READ_ARRAY
+      34 -> return ASSIGN_ARRAY
+      _ -> fail $ "Unknown opcode: " ++ show c
+
+instance BinaryState BState StackItem where
+  put (SInteger x)     = putZ 'I' >> putZ x
+  put (SString x)      = do
+                         a <- S.gets bAfterColon
+                         if a
+                           then do
+                                st <- S.get
+                                S.put $ st {bAfterColon = False}
+                                putZ 'W'
+                                w <- allocWord x
+                                putZ w
+                            else putZ 'S' >> putZ x
+  put (SInstruction x) = putZ 'O' >> put x
+  put (SArray _)       = fail "Array literals are not supported"
+  put (Quote x)        = putZ 'Q' >> put x
+
+  get = do
+    c <- getChar8
+    case c of
+      'I' -> SInteger <$> getZ
+      'S' -> SString <$> getZ
+      'O' -> SInstruction <$> get
+      'Q' -> Quote <$> get
+      'W' -> SString <$> (wordName =<< getZ)
+      _   -> fail $ "Unknown stack item type: " ++ [c]
+
+instance BinaryState BState [StackItem] where
+  put list = forM_ list put
+
+  get = getUntilEOF
+    where
+      getUntilEOF = do
+        b <- isEmpty
+        if b
+          then return []
+          else do
+               x <- get
+               next <- getUntilEOF
+               return (x:next)
+
+-- | Dump bytecode to file
+dumpCode :: FilePath -> Code -> IO ()
+dumpCode path (Code marks code) = encodeFile path (emptyBState {bMarks = head marks}) code
+
+-- | Load bytecode from file
+loadCode :: FilePath -> IO Code
+loadCode path = do
+  (code, st) <- decodeFile' path emptyBState
+  return $ Code [bMarks st] code
+
diff --git a/Language/SSVM/Interpreter.hs b/Language/SSVM/Interpreter.hs
new file mode 100644
--- /dev/null
+++ b/Language/SSVM/Interpreter.hs
@@ -0,0 +1,129 @@
+
+module Language.SSVM.Interpreter
+  (interpret,
+   runVM,
+   runVM',
+   traceVM
+  ) where
+
+import Control.Monad.State
+import qualified Data.Map as M
+
+import Language.SSVM.Types
+import Language.SSVM.Operations
+
+-- | Interpret code
+interpret :: Code -> VM ()
+interpret c@(Code marks code) = do
+  t <- gets vmTraceMode
+  if t
+    then traceStack c
+    else interpretWith (interpretOne marks) code
+
+interpretWith :: (StackItem -> VM ()) -> Stack -> VM ()
+interpretWith go code = do
+  pc <- gets vmPC
+  if pc >= length code
+    then return ()
+    else do
+         go (code !! pc)
+         interpretWith go code
+
+printItem :: StackItem -> VM ()
+printItem i = do
+  pc <- gets vmPC
+  lift $ putStr $ show pc
+  lift $ putStr ".>>\t"
+  lift $ putStrLn $ showItem i
+
+traceStack :: Code -> VM ()
+traceStack (Code marks code) = do
+    lift $ putStrLn $ "Trace marks: " ++ show marks
+    lift $ putStrLn $ "Trace code: " ++ show code
+    lift $ putStr "Trace stack: "
+    printStack
+    interpretWith traceOne code
+  where
+    traceOne i = do
+      printItem i
+      interpretOne marks i
+      printStack
+      printCurrentDef
+
+-- | Run VM
+runVM :: VM () -> IO ()
+runVM forth = evalStateT forth emptyVMState
+
+runVM' :: VMState -> VM () -> IO ()
+runVM' st forth = evalStateT forth st
+
+-- | Run VM in trace mode
+traceVM :: VM () -> IO ()
+traceVM code = runVM' (emptyVMState {vmTraceMode = True}) code
+
+interpretOne :: [Marks] -> StackItem -> VM ()
+interpretOne _ (SInteger x) = push x >> step
+interpretOne _ (SString x)  = push x >> step
+interpretOne m (SInstruction x) = eval m x
+interpretOne _ (SArray _) = fail "Array literals are not supported"
+interpretOne _ (Quote x) = pushD x >> step
+
+interpretLocal :: Int -> Code -> VM ()
+interpretLocal pc code = do
+  let oldMarks = cMarks code
+      newMarks = shiftMarks pc (last oldMarks)
+      code' = code {cMarks = newMarks:oldMarks}
+  st <- get
+  let oldPC = vmPC st
+  put $ st {vmPC = 0}
+  interpret code'
+  st <- get
+  put $ st {vmPC = oldPC}
+
+shiftMarks :: Int -> Marks -> Marks
+shiftMarks k = M.map shift
+  where
+    shift n = n-k
+
+-- | Evaluate one instruction
+eval :: [Marks] -> Instruction -> VM ()
+eval _ NOP      = step
+eval _ (PUSH x) = pushS x >> step
+eval _ DROP     = pop >> step
+eval _ DUP      = dup >> step
+eval _ SWAP     = swap >> step
+eval _ OVER     = over >> step
+eval _ PRINT    = printF >> step
+eval _ PRINTALL = printStack >> step
+eval _ ADD      = add >> step
+eval _ MUL      = mul >> step
+eval _ DIV      = divide >> step
+eval _ REM      = remF >> step
+eval _ SUB      = sub >> step
+eval _ NEG      = neg >> step
+eval _ ABS      = absF >> step
+eval _ CMP      = cmpF >> step
+eval _ DEFINE   = define >> step
+eval _ COLON    = push COLON >> step
+eval m (CALL s) = do
+                  (Definition pc code) <- recall s
+--                   lift $ putStrLn $ "Calling to " ++ show pc
+                  interpretLocal pc $ Code m code
+                  step
+eval _ VARIABLE = variable >> step
+eval _ ASSIGN   = assign >> step
+eval _ READ     = readVar >> step
+eval _ INPUT    = input >> step
+eval _ MARK     = mark >> step
+eval m (GETMARK x) = getMark m x >> step
+eval _ GOTO     = goto
+eval _ JZ       = jumpIf (== 0)
+eval _ JNZ      = jumpIf (/= 0)
+eval _ JGT      = jumpIf (> 0)
+eval _ JLT      = jumpIf (< 0)
+eval _ JGE      = jumpIf (>= 0)
+eval _ JLE      = jumpIf (<= 0)
+eval _ ARRAY    = allocArray >> step
+eval _ READ_ARRAY   = readArray   >> step
+eval _ ASSIGN_ARRAY = assignArray >> step
+
diff --git a/Language/SSVM/Operations.hs b/Language/SSVM/Operations.hs
new file mode 100644
--- /dev/null
+++ b/Language/SSVM/Operations.hs
@@ -0,0 +1,360 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Language.SSVM.Operations
+  (push, pushS, pushD,
+   pop, dup, swap, over,
+   printStack, printCurrentDef, printF,
+   add, sub, neg, mul, divide, absF,
+   remF, cmpF,
+   variable, recall, assign, readVar, define,
+   allocArray, readArray, assignArray,
+   goto, jumpIf,
+   mark, getMark,
+   input,
+   step
+  ) where
+
+import Data.Data
+import Data.Char
+import Data.Array
+import qualified Data.Map as M
+import Control.Monad.State
+
+import Language.SSVM.Types
+
+-- | Increment PC
+step :: VM ()
+step = do
+  st <- get
+  let was = vmPC st
+  put $ st {vmPC = was + 1}
+
+-- | Change stack with given function
+withStack :: (Stack -> Stack) -> VM ()
+withStack fn = do
+  st <- get
+  let stk = vmStack st
+  setStack (fn stk)
+
+-- | Change stack with given monadic action
+withStackM :: (Stack -> VM Stack) -> VM ()
+withStackM fn = do
+  st <- get
+  let stk = vmStack st
+  stk' <- fn stk
+  setStack stk'
+
+-- | Set VM stack
+setStack :: Stack -> VM ()
+setStack stk = do
+  st <- get
+  put $ st { vmStack = stk }
+
+-- | Push value to the stack
+push :: (StackType a) => a -> VM ()
+push x = withStack (toStack x:)
+
+-- | Push stack item to the stack
+pushS :: StackItem -> VM ()
+pushS x = withStack (x:)
+
+-- | Add item to current definition
+pushD :: StackItem -> VM ()
+pushD x = do
+  st <- get
+  let def = vmCurrentDefinition st
+  put $ st {vmCurrentDefinition = (x:def)}
+
+-- | Empty current definition
+endDef :: VM ()
+endDef = do
+  st <- get
+  put $ st {vmCurrentDefinition = []}
+
+-- | Drop stack head
+-- (a -- )
+pop :: VM ()
+pop = withStackM pop'
+  where
+    pop' [] = fail "DROP on empty stack!"
+    pop' (x:xs) = return xs
+
+-- | Duplicate stack head
+-- (a -- a a)
+dup :: VM ()
+dup = withStackM dup'
+  where
+    dup' [] = fail "DUP on empty stack!"
+    dup' (x:xs) = return (x:x:xs)
+
+-- | Swap two top items on the stack
+-- (a b -- b a)
+swap :: VM ()
+swap = withStackM swap'
+  where
+    swap' [] = fail "SWAP on empty stack!"
+    swap' [_] = fail "SWAP on single-element stack!"
+    swap' (x:y:xs) = return (y:x:xs)
+
+-- | (a b -- a b a)
+over :: VM ()
+over = withStackM over'
+  where
+    over' [] = fail "OVER on empty stack!"
+    over' [_] = fail "OVER on single-element stack!"
+    over' (x:y:xs) = return (y:x:y:xs)
+
+-- | Print stack content
+printStack :: VM ()
+printStack = do
+  stk <- gets vmStack
+  lift $ putStrLn $ unwords $ map showPrint stk
+
+-- | Print current definition
+printCurrentDef :: VM ()
+printCurrentDef = do
+  def <- gets vmCurrentDefinition
+  lift $ putStr "Current definition: "
+  lift $ putStrLn $ unwords $ map showItem (reverse def)
+
+-- | Get stack head (and drop it from stack)
+-- (a -- )
+getStack :: VM StackItem
+getStack = do
+  stk <- gets vmStack
+  case stk of
+    [] -> fail "Trying to get element from empty stack!"
+    (x:xs) -> do
+              setStack xs
+              return x
+
+-- | Get stack head (and drop it from stack)
+getArg :: forall a. (StackType a) => VM a
+getArg = do
+  stk <- gets vmStack
+  case stk of
+    [] -> fail "Trying to get element from empty stack!"
+    (x:xs) -> case fromStack x of
+                Just r -> do
+                          setStack xs
+                          return r
+                Nothing -> fail $ "Stack type error: got " ++ showType x ++
+                                  " while expecting " ++ show (typeOf (undefined :: a))
+
+-- | Run given function on stack head
+-- (a -- f(a))
+liftF :: (StackType a) => (a -> a) -> VM ()
+liftF fn = do
+  x <- getArg
+  push (fn x)
+
+-- | Run given operation on two top stack items
+-- (a b -- a `op` b)
+liftF2 :: (StackType a) => (a -> a -> a) -> VM ()
+liftF2 op = do
+  y <- getArg
+  x <- getArg
+  let result = x `op` y
+  push result
+
+add :: VM ()
+add = liftF2 ((+) :: Integer -> Integer -> Integer)
+
+sub :: VM ()
+sub = liftF2 ((-) :: Integer -> Integer -> Integer)
+
+neg :: VM ()
+neg = liftF ((\x -> -x) :: Integer -> Integer)
+
+absF :: VM ()
+absF = liftF (abs :: Integer -> Integer)
+
+mul :: VM ()
+mul = liftF2 ((*) :: Integer -> Integer -> Integer)
+
+divide :: VM ()
+divide = liftF2 (div :: Integer -> Integer -> Integer)
+
+remF :: VM ()
+remF = liftF2 (mod :: Integer -> Integer -> Integer)
+
+cmpF :: VM ()
+cmpF = do
+    y <- getStack
+    x <- getStack
+    case (x,y) of
+      (SInteger a, SInteger b) -> push (cmp a b)
+      (SString a, SString b) -> push (cmp a b)
+      _ -> fail $ "Invalid types on CMP: " ++ showType x ++ ", " ++ showType y
+  where
+    cmp :: (Ord a) => a -> a -> Integer
+    cmp a b = case compare a b of
+               LT -> -1
+               EQ -> 0
+               GT -> 1
+
+-- | Print stack head
+-- (a -- )
+printF :: VM ()
+printF = do
+  x <- getStack
+  lift $ putStr $ showPrint x
+
+-- | Define word
+define :: VM ()
+define = do
+    ws <- gets vmCurrentDefinition
+    endDef
+    w <- getStack
+    col <- getStack
+    when (col /= SInstruction COLON) $
+      fail $ "No COLON before DEFINE!"
+    case w of
+      SString name -> do
+        st <- get
+        dict <- gets vmDefinitions
+        pc <- gets vmPC
+        let start = pc - length ws
+            dict' = M.insert name (Definition start $ reverse ws) dict
+        put $ st {vmDefinitions = dict'}
+      x -> fail $ "New word name is " ++ showType x ++ ", not String!"
+
+-- | Recall word definition
+recall :: String -> VM Definition
+recall name = do
+  dict <- gets vmDefinitions
+  case M.lookup name dict of
+    Nothing -> fail $ "Unknown word: " ++ name
+    Just list -> return list
+
+-- | Define variable
+variable :: VM ()
+variable = do
+  name <- getArg
+  col <- getStack
+  when (col /= SInstruction COLON) $
+    fail $ "No COLON before VARIABLE!"
+  st <- get
+  pc <- gets vmPC
+  let n = vmNextVariable st
+      dict = M.insert name (Definition (pc-1) [SInteger $ fromIntegral n]) (vmDefinitions st)
+  put $ st {vmDefinitions = dict, vmNextVariable = n+1}
+
+-- | Assign value to variable
+-- (value variable-number -- )
+assign :: VM ()
+assign = do
+  n <- getArg
+  value <- getStack
+  st <- get
+  let vars = M.insert n value (vmVariables st)
+  put $ st {vmVariables = vars}
+
+-- | Read variable value
+-- (variable-number -- value)
+readVar :: VM ()
+readVar = do
+  n <- getArg
+  vars <- gets vmVariables
+  case M.lookup n vars of
+    Nothing -> fail $ "Trying to read variable before assignment: #" ++ show n
+    Just value -> pushS value
+
+-- | Allocate an array
+-- (size variable-number -- )
+allocArray :: VM ()
+allocArray = do
+  a  <- getArg
+  sz <- getArg :: VM Int
+  st <- get
+  let arr = listArray (1,sz) (replicate sz $ SInteger 0)
+      vars = M.insert a (SArray arr) (vmVariables st)
+  put $ st {vmVariables = vars}
+
+-- | Assign value to array item.
+-- (value array-or-variable-number index -- )
+assignArray :: VM ()
+assignArray = do
+  i <- getArg
+  a <- getStack
+  value <- getStack
+  case a of
+    SInteger n -> do
+      st <- get
+      let v = fromIntegral n :: Int
+          vars = vmVariables st
+      case M.lookup v vars of
+        Just (SArray arr) -> do
+                      let vars' = M.insert v (SArray (arr // [(i, value)])) vars
+                      put $ st {vmVariables = vars'}
+        Just x ->  fail $ "[!]: variable type is " ++ showType x ++ ", not Array!"
+        Nothing -> fail $ "Trying to assign array item before array allocation!"
+    SArray arr ->  push $ arr // [(i, value)]
+    _ ->           fail $ "[!]: second argument is not array nor variable number, but " ++ showType a
+
+-- | Read item from array.
+-- (array-or-variable-number index -- value)
+readArray :: VM ()
+readArray = do
+  i <- getArg
+  a <- getStack
+  case a of
+    SInteger n -> do
+      st <- get
+      let v = fromIntegral n :: Int
+          vars = vmVariables st
+      case M.lookup v vars of
+        Just (SArray arr) -> pushS (arr ! i)
+        Just x ->   fail $ "[@]: variable type is " ++ showType x ++ ", not Array!"
+        Nothing ->  fail "Trying to read array item before array allocation!"
+    SArray arr ->   pushS (arr ! i)
+    _ ->            fail $ "[@]: second argument is not array nor variable number, but " ++ showType a
+
+-- | Read value from stdin
+-- ( -- value)
+input :: VM ()
+input = do
+  str <- lift getLine
+  if all isDigit str
+    then pushS (SInteger $ read str)
+    else pushS (SString str)
+
+-- | Mark at current PC
+-- ( -- pc)
+mark :: VM ()
+mark = do
+  pc <- gets vmPC
+  pushS (SInteger $ fromIntegral pc)
+
+-- | Go to named instruction
+branch :: Int -> VM ()
+branch n = do
+  st <- get
+  put $ st {vmPC = n}
+
+-- | Get PC from stack
+-- (pc -- )
+goto :: VM ()
+goto = do
+  n <- getArg :: VM Integer
+  branch (fromIntegral n)
+
+-- | Jump to given address if condition is satisfied
+jumpIf :: (Integer -> Bool) -> VM ()
+jumpIf test = do
+  addr <- getArg :: VM Integer
+  cond <- getStack
+  case cond of
+    SInteger i -> if test i
+                    then branch (fromIntegral addr)
+                    else step
+    _ -> fail $ "Condition value is " ++ showType cond ++ ", not Integer!"
+
+-- | Get mark by name
+-- ( -- pc)
+getMark :: [Marks] -> String -> VM ()
+getMark [] _ = fail $ "Internal error: getMark with empty marks stack!"
+getMark (marks:_) name = do
+  case M.lookup name marks of
+    Just x -> pushS (SInteger $ fromIntegral x)
+    Nothing -> fail $ "Undefined mark: " ++ name
+
diff --git a/Language/SSVM/Parser.hs b/Language/SSVM/Parser.hs
new file mode 100644
--- /dev/null
+++ b/Language/SSVM/Parser.hs
@@ -0,0 +1,159 @@
+
+module Language.SSVM.Parser
+  (parseVM, parseSourceFile) where
+
+import Data.Monoid
+import qualified Data.Map as M
+import Text.Parsec
+import Text.Parsec.Token
+import Text.Parsec.Language
+
+import Language.SSVM.Types
+
+baseLanguage = haskell
+
+data ParserState = PState {
+  inDefinition :: Bool,
+  newWord :: Bool,
+  wordsCounter :: Int }
+  deriving (Eq, Show)
+
+emptyState = PState {
+  inDefinition = False,
+  newWord = False,
+  wordsCounter = 0 }
+
+type TParser a = Parsec String ParserState a
+
+code :: [StackItem] -> TParser Code
+code list = return $ Code [M.empty] list
+
+startDefinition :: TParser ()
+startDefinition = do
+  st <- getState
+  putState $ st {inDefinition = True, newWord = True}
+
+endDefinition :: TParser ()
+endDefinition = do
+  st <- getState
+  putState $ st {inDefinition = False, newWord = False}
+
+pString :: TParser Code
+pString = do
+  st <- getState
+  str <- stringLiteral baseLanguage
+  if newWord st
+    then do
+         putState $ st {newWord = False}
+         code [SString str]
+    else if inDefinition st
+           then code [Quote $ SString str]
+           else code [SString str]
+
+pInteger :: TParser Code
+pInteger = do
+  m <- optionMaybe (char '-')
+  digits <- many1 digit
+  let s = read digits
+      n = case m of
+            Nothing -> s
+            Just _  -> -s
+  st <- getState
+  if inDefinition st
+    then code [Quote $ SInteger n]
+    else code [SInteger n]
+
+addMark :: String -> TParser Code
+addMark name = do
+  st <- getState
+  let addr = wordsCounter st
+  return $ Code [M.singleton name addr] []
+
+instr :: Instruction -> TParser Code
+instr i = do
+  st <- getState
+  if inDefinition st
+    then code [Quote (SInstruction i)]
+    else code [SInstruction i]
+
+pWord :: TParser Code
+pWord = do
+  word <- many1 (noneOf " \t\r\n")
+  case word of
+    "NOP"  -> instr NOP
+    "DROP" -> instr DROP
+    "DUP" ->  instr DUP
+    "SWAP" -> instr SWAP
+    "OVER" -> instr OVER
+    "." ->    instr PRINT
+    ".." ->   instr PRINTALL
+    "+" ->    instr ADD
+    "-" ->    instr SUB
+    "*" ->    instr MUL
+    "/" ->    instr DIV
+    "REM" ->  instr REM
+    "NEG" ->  instr NEG
+    "ABS" ->  instr ABS
+    "CMP" ->  instr CMP
+    ";" ->    endDefinition >> code [SInstruction DEFINE]
+    ":" ->    startDefinition >> code [SInstruction COLON]
+    "VARIABLE" -> endDefinition >> code [SInstruction VARIABLE]
+    "!" ->    instr ASSIGN
+    "@" ->    instr READ
+    "INPUT" -> instr INPUT
+    "MARK" -> instr MARK
+    "GOTO" -> instr GOTO
+    "JZ"   -> instr JZ
+    "JNZ"  -> instr JNZ
+    "JGT"  -> instr JGT
+    "JLT"  -> instr JLT
+    "JGE"  -> instr JGE
+    "JLE"  -> instr JLE
+    "ARRAY" -> instr ARRAY
+    "[@]"   -> instr READ_ARRAY
+    "[!]"   -> instr ASSIGN_ARRAY
+    _ | head word == '@' -> instr (GETMARK $ tail word)
+      | otherwise -> do
+         st <- getState
+         if newWord st
+           then do
+                putState $ st {newWord = False}
+                code [SString word]
+           else if inDefinition st
+                  then code [Quote $ SInstruction $ CALL word]
+                  else code [SInstruction $ CALL word]
+
+pLabel :: TParser Code
+pLabel = do
+  char '.'
+  name <- many1 (noneOf ". \t\r\n")
+  addMark name
+
+step :: Int -> TParser ()
+step k = do
+  st <- getState
+  putState $ st {wordsCounter = k + wordsCounter st}
+
+pSpaces :: TParser Code
+pSpaces = do
+  many1 (oneOf " \t\r\n")
+  code []
+
+pSource :: TParser Code
+pSource = do
+    ws <- many1 anyWord
+    return (mconcat ws)
+  where
+    anyWord = do
+      word <- (try pSpaces <|> try pString <|> try pInteger <|> try pLabel <|> pWord)
+      step (length $ cCode word)
+      return word
+
+parseVM :: FilePath -> String -> Either ParseError Code
+parseVM name str = runParser pSource emptyState name str
+
+parseSourceFile :: FilePath -> IO (Either ParseError Code)
+parseSourceFile path = do
+  str <- readFile path
+  return $ runParser pSource emptyState path str
+
diff --git a/Language/SSVM/Types.hs b/Language/SSVM/Types.hs
new file mode 100644
--- /dev/null
+++ b/Language/SSVM/Types.hs
@@ -0,0 +1,214 @@
+{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances #-}
+module Language.SSVM.Types where
+
+import Control.Monad.State
+import Data.Data
+import Data.Monoid
+import Data.Array
+import qualified Data.Map as M
+
+type DArray = Array Int StackItem
+
+-- | Stack item
+data StackItem =
+    SInteger Integer
+  | SString String
+  | SInstruction Instruction
+  | SArray DArray
+  | Quote StackItem
+  deriving (Eq, Data, Typeable)
+
+-- | Show type of item
+showType :: StackItem -> String
+showType x = show (toConstr x)
+
+instance Show StackItem where
+  show (SInteger x) = show x
+  show (SString s)  = show s
+  show (SArray a)   = "[" ++ unwords (map show $ elems a) ++ "]"
+  show (SInstruction i) = show i
+  show (Quote x)    = show x
+
+showItem :: StackItem -> String
+showItem = show
+
+showPrint :: StackItem -> String
+showPrint (SInteger x) = show x
+showPrint (SString s)  = s
+showPrint (SArray a)   = "[" ++ unwords (map show $ elems a) ++ "]"
+showPrint (SInstruction i) = show i
+showPrint (Quote x)    = show x
+
+showCode :: Code -> String
+showCode (Code marks code) =
+    unwords $  zipWith (showOne $ head marks) [1..] code
+  where
+    showOne ms n item = showItem item ++ concatMap (" ."++) (lookupRev n $ M.assocs ms)
+
+    lookupRev _ [] = []
+    lookupRev key ((v,k):other) 
+                  | key == k  = v: lookupRev key other
+                  | otherwise = lookupRev key other
+    
+type Stack = [StackItem]
+
+type Marks = M.Map String Int
+
+showMarks :: Marks -> String
+showMarks ms = unlines $ map s $ M.assocs ms
+  where
+    s (k,v) = "\t" ++ k ++ ": " ++ show v
+
+-- | VM code
+data Code = Code {
+  cMarks :: [Marks],   -- ^ marks stack
+  cCode :: [StackItem] }
+  deriving (Eq, Show, Data, Typeable)
+
+instance Monoid Code where
+  mempty = Code [M.empty] []
+  mappend (Code l1 c1) (Code l2 c2) = Code (M.union m1 m2: ms) (c1 ++ c2)
+    where
+      (m1:ms) = l1
+      (m2:_)  = l2
+
+class (Data a, Typeable a) => StackType a where
+  toStack :: a -> StackItem
+  fromStack :: StackItem -> Maybe a
+
+instance StackType Integer where
+  toStack = SInteger
+
+  fromStack (SInteger x) = Just x
+  fromStack _ = Nothing
+
+instance StackType Int where
+  toStack = SInteger . fromIntegral
+
+  fromStack (SInteger x) = Just (fromIntegral x)
+  fromStack _            = Nothing
+
+instance StackType String where
+  toStack = SString
+
+  fromStack (SString x) = Just x
+  fromStack _ = Nothing
+
+instance StackType Instruction where
+  toStack = SInstruction
+
+  fromStack (SInstruction x) = Just x
+  fromStack _ = Nothing
+
+instance StackType DArray where
+  toStack = SArray
+
+  fromStack (SArray a) = Just a
+  fromStack _          = Nothing
+
+-- | VM instructions
+data Instruction =
+    NOP            -- ^ Do nothing
+  | PUSH StackItem
+  | DROP
+  | DUP
+  | SWAP
+  | OVER
+  | PRINT
+  | PRINTALL
+  | ADD
+  | MUL
+  | DIV
+  | REM
+  | SUB
+  | NEG
+  | ABS
+  | CMP
+  | DEFINE
+  | COLON
+  | CALL String     -- ^ Call named user-defined word
+  | VARIABLE
+  | ASSIGN
+  | READ
+  | INPUT
+  | MARK
+  | GETMARK String
+  | GOTO
+  | JZ
+  | JNZ
+  | JGT
+  | JLT
+  | JGE
+  | JLE
+  | ARRAY
+  | READ_ARRAY
+  | ASSIGN_ARRAY
+  deriving (Eq, Data, Typeable)
+
+instance Show Instruction where
+  show NOP = "NOP"
+  show (PUSH x) = show x
+  show DROP     = "DROP"
+  show DUP      = "DUP"
+  show SWAP     = "SWAP"
+  show OVER     = "OVER"
+  show PRINT    = "."
+  show PRINTALL = ".."
+  show ADD      = "+"
+  show MUL      = "*"
+  show DIV      = "/"
+  show REM      = "REM"
+  show SUB      = "-"
+  show NEG      = "NEG"
+  show ABS      = "ABS"
+  show CMP      = "CMP"
+  show DEFINE   = ";"
+  show COLON    = ":"
+  show (CALL s) = s
+  show VARIABLE = "VARIABLE"
+  show ASSIGN   = "!"
+  show READ     = "@"
+  show INPUT    = "INPUT"
+  show MARK     = "MARK"
+  show (GETMARK x) = "@" ++ x
+  show GOTO     = "GOTO"
+  show JZ       = "JZ"
+  show JNZ      = "JNZ"
+  show JGT      = "JGT"
+  show JLT      = "JLT"
+  show JGE      = "JGE"
+  show JLE      = "JLE"
+  show ARRAY    = "ARRAY"
+  show READ_ARRAY   = "[@]"
+  show ASSIGN_ARRAY = "[!]"
+
+-- | Word definition
+data Definition = Definition Int Stack
+  deriving (Eq, Show)
+
+-- | VM state
+data VMState = VMState {
+  vmStack :: Stack,                         -- ^ current VM stack
+  vmCurrentDefinition :: Stack,             -- ^ current definition
+  vmDefinitions :: M.Map String Definition, -- ^ already defined words
+  vmVariables :: M.Map Int StackItem,       -- ^ variables values
+  vmNextVariable :: Int,                    -- ^ next variable number
+  vmPC :: Int,                              -- ^ program counter
+  vmTraceMode :: Bool                       -- ^ trace mode
+  }
+  deriving (Eq, Show)
+
+-- | Starting VM state
+emptyVMState :: VMState
+emptyVMState = VMState {
+  vmStack = [],
+  vmCurrentDefinition = [],
+  vmDefinitions = M.empty,
+  vmVariables = M.empty,
+  vmNextVariable = 0,
+  vmPC = 0,
+  vmTraceMode = False }
+
+-- | VM monad
+type VM a = StateT VMState IO a
+
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/simple-stacked-vm.cabal b/simple-stacked-vm.cabal
new file mode 100644
--- /dev/null
+++ b/simple-stacked-vm.cabal
@@ -0,0 +1,33 @@
+Name:           simple-stacked-vm
+Version:        0.1
+Cabal-Version:  >= 1.6
+License:        BSD3
+License-File:   LICENSE
+Author:         Ilya V. Portnov
+Maintainer:     portnov84@rambler.ru
+Synopsis:       Simple stacked virtual machine: assembler, disassembler, bytecode interpreter
+Category:       Languages, Compilers/Interpreters
+Build-Type:     Simple
+Description:    This is a simple stacked virtual machine. It works like Forth or JVM.
+                This package includes declarations of data types, assembler, disassembler, 
+                and bytecode interpreter.
+
+Extra-source-files: test.f
+
+library
+  Exposed-Modules: Language.SSVM.Types
+                   Language.SSVM.Parser
+                   Language.SSVM.Operations
+                   Language.SSVM.Interpreter
+                   Language.SSVM.Binary
+
+  Build-Depends:  base >= 3 && <= 5, containers,
+                  mtl > 1, filepath, parsec >= 3,
+                  binary-state, array
+
+  ghc-options: -fwarn-unused-imports
+
+executable ssvm
+  Main-is: ssvm.hs
+
+
diff --git a/ssvm.hs b/ssvm.hs
new file mode 100644
--- /dev/null
+++ b/ssvm.hs
@@ -0,0 +1,131 @@
+
+import Control.Monad (when)
+import System.Environment
+import System.Console.GetOpt
+import System.FilePath
+import System.IO
+
+import Language.SSVM.Types
+import Language.SSVM.Parser
+import Language.SSVM.Interpreter
+import Language.SSVM.Binary
+
+-- | Command-line flag
+data Flag =
+    Mode Mode
+  | Output FilePath
+  deriving (Eq, Show)
+
+-- | Working mode
+data Mode =
+    Interpret
+  | Trace
+  | TraceBytecode
+  | Compile
+  | Run
+  | Decompile
+  | Help
+  deriving (Eq, Show)
+
+-- | config
+data RunMode = RunMode {
+  mode :: Mode,
+  inputFile :: FilePath,
+  outputFile :: Maybe FilePath }
+  deriving (Eq, Show)
+
+-- | Default run mode
+defaultMode :: RunMode
+defaultMode = RunMode {
+  mode = Run,
+  inputFile = "-",
+  outputFile = Nothing }
+
+-- | Command-line options description
+options :: [OptDescr Flag]
+options = [
+  Option "c" ["compile"]   (NoArg $ Mode Compile)   "compile source code to bytecode",
+  Option "i" ["interpret"] (NoArg $ Mode Interpret) "interpret source code",
+  Option "e" ["run"]       (NoArg $ Mode Run)       "run compiled bytecode",
+  Option "d" ["decompile"] (NoArg $ Mode Decompile) "decompile bytecode into pseudo source code",
+  Option "t" ["trace"]     (NoArg $ Mode Trace)     "interpret and trace source code ",
+  Option ""  ["trace-bytecode"] (NoArg $ Mode TraceBytecode)     "run and trace bytecode ",
+  Option "o" ["output"]    (ReqArg Output "FILE")   "set output file name",
+  Option "h" ["help"]      (NoArg $ Mode Help)      "show this help and exit" ]
+
+usage :: String
+usage = usageInfo header options
+  where
+    header = "Usage: ssvm [MODE] [-o OUTPUT] FILE"
+
+flags2runmode :: [Flag] -> RunMode
+flags2runmode flags = foldl go defaultMode flags
+  where
+    go acc (Mode m)      = acc {mode = m}
+    go acc (Output path) = acc {outputFile = Just path}
+
+parseCmdLine :: [String] -> Either String RunMode
+parseCmdLine args =
+  case getOpt Permute options args of
+    (flags, [], []) | Mode Help `elem` flags -> Right (flags2runmode flags)
+                    | otherwise              -> Left "No input file"
+    (flags, [file], []) -> Right $ (flags2runmode flags) {inputFile = file}
+    (_, (_:_:_), [])    -> Left "More than one input file"
+    (_, _, errs)        -> Left $ unlines errs ++ usage
+
+doInterpret :: FilePath -> IO ()
+doInterpret path = do
+  mbCode <- parseSourceFile path
+  case mbCode of
+    Left err -> fail (show err)
+    Right code -> runVM (interpret code)
+
+doTrace :: FilePath -> IO ()
+doTrace path = do
+  mbCode <- parseSourceFile path
+  case mbCode of
+    Left err -> fail (show err)
+    Right code -> traceVM (interpret code)
+
+doTraceBytecode :: FilePath -> IO ()
+doTraceBytecode path = do
+  code <- loadCode path
+  traceVM (interpret code)
+
+doCompile :: FilePath -> Maybe FilePath -> IO ()
+doCompile src mbdst = do
+  let dst = case mbdst of
+              Just x -> x
+              Nothing -> replaceExtension src ".bytecode"
+  mbCode <- parseSourceFile src
+  case mbCode of
+    Left err -> fail (show err)
+    Right code -> dumpCode dst code
+
+doRun :: FilePath -> IO ()
+doRun path = do
+  code <- loadCode path
+  runVM (interpret code)
+
+doDecompile :: FilePath -> IO ()
+doDecompile path = do
+    code <- loadCode path
+    putStrLn $ showCode code
+
+main = do
+  args <- getArgs
+  case parseCmdLine args of
+    Left err -> error err
+    Right m -> do
+      term <- hIsTerminalDevice stdout
+      when term $
+        hSetBuffering stdout NoBuffering
+      case mode m of
+        Interpret -> doInterpret (inputFile m)
+        Compile   -> doCompile (inputFile m) (outputFile m)
+        Run       -> doRun (inputFile m)
+        Decompile -> doDecompile (inputFile m) 
+        Trace     -> doTrace (inputFile m) 
+        TraceBytecode -> doTraceBytecode (inputFile m) 
+        Help      -> putStrLn usage
+
diff --git a/test.f b/test.f
new file mode 100644
--- /dev/null
+++ b/test.f
@@ -0,0 +1,40 @@
+: CR "\n" . ;
+: INC DUP @ 1 + SWAP ! ;
+: ODD 2 REM ;
+: ? @ . ;
+
+: PRINT_ODD
+  DUP @ ODD
+  @even JZ
+  ? " is odd." .
+  @endprint GOTO
+  .even
+  ? " is even." .
+  .endprint
+  CR
+  ;
+
+: n VARIABLE
+: i VARIABLE
+: arr VARIABLE
+
+5 arr ARRAY
+17 arr 3 [!]
+"test" arr 4 [!]
+"abc" arr @ 2 [!] arr !
+arr ? CR
+arr 3 [@] . CR
+
+"Enter number: " .
+INPUT n !
+
+0 i !
+.loop
+"Hello." . CR
+i PRINT_ODD
+i INC
+i @ n @ CMP
+@loop JLT
+
+"End" . CR
+