diff --git a/concraft.cabal b/concraft.cabal
--- a/concraft.cabal
+++ b/concraft.cabal
@@ -1,9 +1,9 @@
 name:               concraft
-version:            0.4.0
-synopsis:           Morphosyntactic tagging tool based on constrained CRFs
+version:            0.5.0
+synopsis:           Morphological disambiguation based on constrained CRFs
 description:
-    A morphosyntactic tagging tool based on constrained conditional
-    random fields.
+    A morphological disambiguation library based on
+    constrained conditional random fields.
 license:            BSD3
 license-file:       LICENSE
 cabal-version:      >= 1.6
@@ -23,42 +23,41 @@
       , array
       , containers
       , binary
+      , bytestring
       , text
       , text-binary >= 0.1 && < 0.2
       , vector
       , vector-binary
       , crf-chain1-constrained >= 0.1.2 && < 0.2
-      , monad-ox >= 0.2 && < 0.3
+      , monad-ox >= 0.3 && < 0.4
       , sgd >= 0.2.2 && < 0.3
-      , tagset-positional >= 0.2 && < 0.3
+      , tagset-positional >= 0.3 && < 0.4
       , crf-chain2-generic >= 0.3 && < 0.4
       , monad-codec >= 0.2 && < 0.3
       , data-lens
+      , transformers
       , comonad-transformers
       , temporary
+      , aeson >= 0.6 && < 0.7
+      , zlib >= 0.5 && < 0.6
 
     exposed-modules:
         NLP.Concraft
-      , NLP.Concraft.Guess
-      , NLP.Concraft.Disamb
       , NLP.Concraft.Morphosyntax
-      , NLP.Concraft.Format
-      , NLP.Concraft.Format.Plain
+      , NLP.Concraft.Analysis
       , NLP.Concraft.Schema
+      , NLP.Concraft.Guess
+      , NLP.Concraft.Disamb
 
     other-modules:
         NLP.Concraft.Disamb.Tiered
       , NLP.Concraft.Disamb.Positional
+      , NLP.Concraft.Morphosyntax.Align
+      , NLP.Concraft.Format.Temp
 
+
     ghc-options: -Wall -O2
 
 source-repository head
     type: git
     location: https://github.com/kawu/concraft.git
-
-executable concraft
-    build-depends:
-        cmdargs
-    hs-source-dirs: src, tools
-    main-is: concraft.hs    
-    ghc-options: -Wall -O2 -threaded -rtsopts
diff --git a/src/NLP/Concraft.hs b/src/NLP/Concraft.hs
--- a/src/NLP/Concraft.hs
+++ b/src/NLP/Concraft.hs
@@ -2,98 +2,169 @@
 
 module NLP.Concraft
 (
--- * Types
+-- * Model 
   Concraft (..)
+, saveModel
+, loadModel
 
 -- * Tagging
 , tag
-, tagSent
-, tagDoc
 
 -- * Training
 , train
 ) where
 
-import System.IO (hClose)
-import Control.Applicative ((<$>), (<*>))
-import Data.Foldable (Foldable)
-import Data.Binary (Binary, put, get)
-import qualified Data.Text.Lazy as L
-import qualified Data.Text.Lazy.IO as L
+import           System.IO (hClose)
+import           Control.Applicative ((<$>), (<*>))
+import           Control.Monad (when)
+import           Data.Binary (Binary, put, get)
+import qualified Data.Binary as Binary
+import           Data.Aeson
+import           Data.Maybe (fromJust)
 import qualified System.IO.Temp as Temp
+import qualified Data.ByteString.Lazy as BL
+import qualified Codec.Compression.GZip as GZip
 
-import qualified NLP.Concraft.Morphosyntax as Mx
-import qualified NLP.Concraft.Format as F
+import           NLP.Concraft.Morphosyntax
+import           NLP.Concraft.Analysis
+import           NLP.Concraft.Format.Temp
+import qualified Data.Tagset.Positional as P
 import qualified NLP.Concraft.Guess as G
 import qualified NLP.Concraft.Disamb as D
 
+
+---------------------
+-- Model
+---------------------
+
+
+modelVersion :: String
+modelVersion = "0.5"
+
+
 -- | Concraft data.
 data Concraft = Concraft
-    { guessNum      :: Int
-    , guesser       :: G.Guesser F.Tag
+    { tagset        :: P.Tagset
+    , guessNum      :: Int
+    , guesser       :: G.Guesser P.Tag
     , disamb        :: D.Disamb }
 
+
 instance Binary Concraft where
     put Concraft{..} = do
+        put modelVersion
+        put tagset
         put guessNum
         put guesser
         put disamb
-    get = Concraft <$> get <*> get <*> get
+    get = do
+        comp <- get     
+        when (comp /= modelVersion) $ error $
+            "Incompatible model version: " ++ comp ++
+            ", expected: " ++ modelVersion
+        Concraft <$> get <*> get <*> get <*> get
 
--- | Perform disambiguation preceded by context-sensitive guessing.
-tag :: Concraft -> Mx.Sent F.Tag -> [F.Tag]
-tag Concraft{..} sent
-    = D.disamb disamb
-    . G.include sent 
-    . G.guess guessNum guesser 
-    $ sent
 
--- | Tag the sentence.
-tagSent :: F.Sent s w -> Concraft -> s -> s
-tagSent sentH Concraft{..}
-    = D.disambSent sentH disamb
-    . G.guessSent  sentH guessNum guesser
+-- | Save model in a file.  Data is compressed using the gzip format.
+saveModel :: FilePath -> Concraft -> IO ()
+saveModel path = BL.writeFile path . GZip.compress . Binary.encode
 
--- | Tag document.
-tagDoc :: Functor f => F.Doc f s w -> Concraft -> L.Text -> L.Text
-tagDoc F.Doc{..} concraft =
-    let onSent = tagSent sentHandler concraft
-    in  showDoc . fmap onSent . parseDoc
 
+-- | Load model from a file.
+loadModel :: FilePath -> IO Concraft
+loadModel path = do
+    x <- Binary.decode . GZip.decompress <$> BL.readFile path
+    x `seq` return x
+
+
+---------------------
+-- Tagging
+---------------------
+
+
+-- | Tag sentence using the model.  In your code you should probably
+-- use your analysis function, translate results into a container of
+-- `Sent`ences, evaluate `tagSent` on each sentence and embed the
+-- tagging results into morphosyntactic structure of your own.
+tag :: Word w => Concraft -> Sent w P.Tag -> [P.Tag]
+tag Concraft{..} = D.disamb disamb . G.guessSent guessNum guesser
+
+
+---------------------
+-- Training
+---------------------
+
+-- INFO: We take an input dataset as a list, since it is read only once.
+
 -- | Train guessing and disambiguation models.
 train
-    :: (Functor f, Foldable f)
-    => F.Doc f s w      -- ^ Document format handler
+    :: (Word w, FromJSON w, ToJSON w)
+    => P.Tagset         -- ^ Tagset
+    -> Analyse w P.Tag  -- ^ Analysis function
     -> Int              -- ^ Numer of guessed tags for each word 
     -> G.TrainConf      -- ^ Guessing model training configuration
     -> D.TrainConf      -- ^ Disambiguation model training configuration
-    -> FilePath         -- ^ Training file
-    -> Maybe FilePath   -- ^ Maybe eval file
-    -> IO Concraft      -- ^ Resultant models
-train format guessNum guessConf disambConf trainPath evalPath'Maybe = do
-    putStrLn "\n===== Train guessing model ====\n"
-    guesser <- G.train format guessConf trainPath evalPath'Maybe
-    let withGuesser = guessFile format guessNum guesser
-    withGuesser "train" (Just trainPath) $ \(Just trainPathG) ->
-      withGuesser "eval"   evalPath'Maybe  $ \evalPathG'Maybe  -> do
-        putStrLn "\n===== Train disambiguation model ====\n"
-        disamb <- D.train format disambConf trainPathG evalPathG'Maybe
-        return $ Concraft guessNum guesser disamb
+    -> [SentO w P.Tag]  -- ^ Training data
+    -> Maybe [SentO w P.Tag]  -- ^ Maybe evaluation data
+    -> IO Concraft
+train tagset ana guessNum guessConf disambConf train0 eval0 = do
+    putStrLn "\n===== Reanalysis ====="
+    trainR <- reAnaPar tagset ana train0
+    evalR  <- case eval0 of
+            Just ev -> Just <$> reAnaPar tagset ana ev
+            Nothing -> return Nothing
+    withTemp tagset "train" trainR $ \trainR'IO -> do
+    withTemp' tagset "eval" evalR  $ \evalR'IO  -> do
 
-guessFile
-    :: Functor f
-    => F.Doc f s w              -- ^ Document format handler
-    -> Int                      -- ^ Numer of guessed tags for each word
-    -> G.Guesser F.Tag          -- ^ Guesser
-    -> String                   -- ^ Template for temporary file name
-    -> Maybe FilePath           -- ^ File to guess
-    -> (Maybe FilePath -> IO a) -- ^ Handler
+    putStrLn "\n===== Train guessing model ====="
+    guesser <- do
+        tr <- trainR'IO
+        ev <- evalR'IO
+        G.train guessConf tr ev
+    trainG <-       map (G.guessSent guessNum guesser)  <$> trainR'IO
+    evalG  <- fmap (map (G.guessSent guessNum guesser)) <$> evalR'IO
+
+    putStrLn "\n===== Train disambiguation model ====="
+    disamb <- D.train disambConf trainG evalG
+    return $ Concraft tagset guessNum guesser disamb
+
+
+---------------------
+-- Temporary storage
+---------------------
+
+
+-- | Store dataset on a disk and run a handler on a list which is read
+-- lazily from the disk.  A temporary file will be automatically
+-- deleted after the handler is done.
+withTemp
+    :: (FromJSON w, ToJSON w)
+    => P.Tagset
+    -> String                       -- ^ Template for `Temp.withTempFile`
+    -> [Sent w P.Tag]               -- ^ Input dataset
+    -> (IO [Sent w P.Tag] -> IO a)  -- ^ Handler
     -> IO a
-guessFile _ _ _ _ Nothing handler = handler Nothing
-guessFile format guessNum gsr tmpl (Just path) handler =
-    Temp.withTempFile "." tmpl $ \tmpPath tmpHandle -> do
-        inp <- L.readFile path
-        let out = G.guessDoc format guessNum gsr inp
-        hClose tmpHandle
-        L.writeFile tmpPath out
-        handler (Just tmpPath)
+withTemp tagset tmpl xs handler =
+    withTemp' tagset tmpl (Just xs) (handler . fmap fromJust)
+
+
+-- | Similar to `withTemp` but on a `Maybe` dataset.
+--
+-- Store dataset on a disk and run a handler on a list which is read
+-- lazily from the disk.  A temporary file will be automatically
+-- deleted after the handler is done.
+withTemp'
+    :: (FromJSON w, ToJSON w)
+    => P.Tagset
+    -> String
+    -> Maybe [Sent w P.Tag]
+    -> (IO (Maybe [Sent w P.Tag]) -> IO a)
+    -> IO a
+withTemp' tagset tmpl (Just xs) handler =
+  Temp.withTempFile "." tmpl $ \tmpPath tmpHandle -> do
+    hClose tmpHandle
+    let txtSent = mapSent $ P.showTag tagset
+        tagSent = mapSent $ P.parseTag tagset
+    writePar tmpPath $ map txtSent xs
+    handler (Just . map tagSent <$> readPar tmpPath)
+withTemp' _ _ Nothing handler = handler (return Nothing)
diff --git a/src/NLP/Concraft/Analysis.hs b/src/NLP/Concraft/Analysis.hs
new file mode 100644
--- /dev/null
+++ b/src/NLP/Concraft/Analysis.hs
@@ -0,0 +1,100 @@
+-- | Morphosyntactic analysis utilities.
+--
+-- See `reAnaSent` function for a description of how reanalsis is performed.
+-- At some point it would be nice to change the entire process so that
+-- sentence-level segmentation is also taken from the reanalysed data.
+
+
+module NLP.Concraft.Analysis
+(
+-- * Analysis
+  Analyse
+-- * Reanalysis
+, reAnaSent
+, reAnaPar
+) where
+
+
+import System.IO.Unsafe (unsafeInterleaveIO)
+import qualified Data.Text.Lazy as L
+
+import           NLP.Concraft.Morphosyntax
+import qualified Data.Tagset.Positional as P
+import qualified NLP.Concraft.Morphosyntax.Align as A
+
+
+---------------------
+-- Analysis
+---------------------
+
+
+-- | An analyser performs word-level segmentation and morphological analysis.
+type Analyse w t = L.Text -> IO (Sent w t)
+
+
+---------------------
+-- Reanalysis
+---------------------
+
+
+-- | Reanalyse sentence.
+--
+-- From the reference sentence the function takes:
+--
+--   * Word-level segmentation
+--
+--   * Chosen interpretations (tags)
+--
+-- From the reanalysed sentence the function takes:
+--
+--   * Potential interpretations
+--
+reAnaSent :: Word w => P.Tagset -> Analyse w P.Tag
+          -> SentO w P.Tag -> IO (Sent w P.Tag)
+reAnaSent tagset ana sent = do
+    let gold = segs sent
+    reana <- ana (orig sent)
+    return $ A.sync tagset gold reana
+
+
+-- | Reanalyse paragraph.
+reAnaPar :: Word w => P.Tagset -> Analyse w P.Tag
+         -> [SentO w P.Tag] -> IO [Sent w P.Tag]
+reAnaPar tagset ana = lazyMapM (reAnaSent tagset ana)
+
+
+lazyMapM :: (a -> IO b) -> [a] -> IO [b]
+lazyMapM f (x:xs) = do
+    y <- f x
+    ys <- unsafeInterleaveIO $ lazyMapM f xs
+    return (y:ys)
+lazyMapM _ [] = return []
+
+
+---------------------
+-- Junk
+---------------------
+
+
+-- -- | Reanalyse paragraph.
+-- reanalyse :: Word w => P.Tagset -> Analyse w P.Tag
+--           -> [SentO w P.Tag] -> [Sent w P.Tag]
+-- reanalyse tagset ana xs = chunk
+--     -- We have to take sentence lengths from the reference corpus because
+--     -- token-level segmentation is also taken from the reference corpus
+--     -- (in case of inconsistencies between the two corpora).
+--     (map length gold)
+--     (A.sync tagset (concat gold) (concat reana))
+--   where
+--     gold  = map segs xs
+--     reana = ana . L.concat $ map orig xs
+--
+--
+-- -- | Divide the list into a list of chunks given the list of
+-- -- lengths of individual chunks.
+-- chunk :: [Int] -> [a] -> [[a]]
+-- chunk (n:ns) xs = 
+--     let (first, rest) = splitAt n xs 
+--     in  first : chunk ns rest
+-- chunk [] [] = []
+-- chunk [] _  = error "chunk: absurd"
diff --git a/src/NLP/Concraft/Disamb.hs b/src/NLP/Concraft/Disamb.hs
--- a/src/NLP/Concraft/Disamb.hs
+++ b/src/NLP/Concraft/Disamb.hs
@@ -9,12 +9,11 @@
 -- * Tiers
 , P.Tier (..)
 , P.Atom (..)
-, P.tiersDefault
 
 -- * Disambiguation
 , disamb
+, include
 , disambSent
-, disambDoc
 
 -- * Training
 , TrainConf (..)
@@ -24,28 +23,24 @@
 import Control.Applicative ((<$>), (<*>))
 import Data.Maybe (fromJust)
 import Data.List (find)
-import Data.Foldable (Foldable, foldMap)
 import Data.Binary (Binary, put, get)
 import qualified Data.Set as S
 import qualified Data.Map as M
 import qualified Data.Vector as V
-import qualified Data.Text.Lazy as L
-import qualified Data.Text.Lazy.IO as L
 
 import qualified Control.Monad.Ox as Ox
 import qualified Data.CRF.Chain2.Generic.External as CRF
 
 import NLP.Concraft.Schema hiding (schematize)
-import qualified NLP.Concraft.Morphosyntax as Mx
-import qualified NLP.Concraft.Format as F
+import qualified NLP.Concraft.Morphosyntax as X
 
 import qualified NLP.Concraft.Disamb.Tiered as Tier
 import qualified NLP.Concraft.Disamb.Positional as P
-import qualified Data.Tagset.Positional as TP
+import qualified Data.Tagset.Positional as T
 import qualified Numeric.SGD as SGD
 
 -- | Schematize the input sentence with according to 'schema' rules.
-schematize :: Schema t a -> Mx.Sent t -> CRF.Sent Ob t
+schematize :: Schema w t a -> X.Sent w t -> CRF.Sent Ob t
 schematize schema sent =
     [ CRF.mkWord (obs i) (lbs i)
     | i <- [0 .. n - 1] ]
@@ -53,111 +48,85 @@
     v = V.fromList sent
     n = V.length v
     obs = S.fromList . Ox.execOx . schema v
-    lbs i = Mx.interpsSet w
+    lbs i = X.interpsSet w
         where w = v V.! i
 
 -- | A disambiguation model.
 data Disamb = Disamb
-    { tagset        :: TP.Tagset
-    , tiers         :: [P.Tier]
+    { tiers         :: [P.Tier]
     , schemaConf    :: SchemaConf
     , crf           :: Tier.CRF Ob P.Atom }
 
 instance Binary Disamb where
-    put Disamb{..} = put tagset >> put tiers >> put schemaConf >> put crf
-    get = Disamb <$> get <*> get <*> get <*> get
+    put Disamb{..} = put tiers >> put schemaConf >> put crf
+    get = Disamb <$> get <*> get <*> get
 
 -- | Unsplit the complex tag (assuming, that it is one
 -- of the interpretations of the word).
-unSplit :: Eq t => (r -> t) -> Mx.Word r -> t -> r
-unSplit split' word x = fromJust $ find ((==x) . split') (Mx.interps word)
-
--- -- | CRF training function.
--- type TrainCRF o t c
---     =  IO [CRF.SentL o t]           -- ^ Training data 'IO' action
---     -> Maybe (IO [CRF.SentL o t])   -- ^ Maybe evalation data
---     -> IO c                         -- ^ Resulting model
--- 
--- -- | CRF tagging function.
--- type TagCRF o t = CRF.Sent o t -> [t]
+unSplit :: Eq t => (r -> t) -> X.Seg w r -> t -> r
+unSplit split' word x = fromJust $ find ((==x) . split') (X.interps word)
 
 -- | Perform context-sensitive disambiguation.
-disamb :: Disamb -> Mx.Sent F.Tag -> [F.Tag]
+disamb :: X.Word w => Disamb -> X.Sent w T.Tag -> [T.Tag]
 disamb Disamb{..} sent
     = map (uncurry embed)
     . zip sent
     . Tier.tag crf
     . schematize schema
-    . Mx.mapSent split
+    . X.mapSent split
     $ sent
   where
     schema  = fromConf schemaConf
-    split   = P.split tiers . TP.parseTag tagset
+    split   = P.split tiers
     embed   = unSplit split
 
--- | Tag the sentence.
-disambSent :: F.Sent s w -> Disamb -> s -> s
-disambSent F.Sent{..} dmb sent =
-  flip mergeSent sent
-    [ select wMap orig
-    | (wMap, orig) <- zip
-        (doDmb sent)
-        (parseSent sent) ]
+-- | Insert disambiguation results into the sentence.
+include :: (X.Sent w T.Tag -> [T.Tag]) -> X.Sent w T.Tag -> X.Sent w T.Tag
+include f sent =
+    [ word { X.tags = tags }
+    | (word, tags) <- zip sent sentTags ]
   where
-    F.Word{..} = wordHandler
-    doDmb orig =
-        let xs = map extract (parseSent orig)
-        in  map (uncurry mkChoice) (zip xs (disamb dmb xs))
-    mkChoice word x = Mx.mkWMap
-        [ if x == y
-            then (x, 1)
-            else (y, 0)
-        | y <- Mx.interps word ]
+    sentTags = map (uncurry select) (zip (f sent) sent)
+    select x word = X.mkWMap
+        [ (y, if x == y then 1 else 0)
+        | y <- X.interps word ]
 
--- | Disambiguate document.
-disambDoc :: Functor f => F.Doc f s w -> Disamb -> L.Text -> L.Text
-disambDoc F.Doc{..} dmb =
-    let onSent = disambSent sentHandler dmb
-    in  showDoc . fmap onSent . parseDoc
+-- | Combine `disamb` with `include`. 
+disambSent :: X.Word w => Disamb -> X.Sent w T.Tag -> X.Sent w T.Tag
+disambSent = include . disamb
 
 -- | Training configuration.
 data TrainConf = TrainConf
-    { tagsetT       :: TP.Tagset
-    , tiersT        :: [P.Tier]
+    { tiersT        :: [P.Tier]
     , schemaConfT   :: SchemaConf
     , sgdArgsT      :: SGD.SgdArgs }
 
 -- | Train disamb model.
 train
-    :: Foldable f
-    => F.Doc f s w      -- ^ Document format handler
-    -> TrainConf        -- ^ Training configuration
-    -> FilePath         -- ^ Training file
-    -> Maybe FilePath   -- ^ Maybe eval file
-    -> IO Disamb        -- ^ Resultant model
-train format TrainConf{..} trainPath evalPath'Maybe = do
+    :: X.Word w
+    => TrainConf                        -- ^ Training configuration
+    -> [X.Sent w T.Tag]                 -- ^ Training data
+    -> Maybe [X.Sent w T.Tag]           -- ^ Maybe evaluation data
+    -> IO Disamb                        -- ^ Resultant model
+train TrainConf{..} trainData evalData'Maybe = do
     crf <- Tier.train
         (length tiersT)
         sgdArgsT
-        (schemed format schema split trainPath)
-        (schemed format schema split <$> evalPath'Maybe)
-    return $ Disamb tagsetT tiersT schemaConfT crf
+        (retSchemed schema split trainData)
+        (retSchemed schema split <$> evalData'Maybe)
+    return $ Disamb tiersT schemaConfT crf
   where
+    retSchemed sc sp = return . schemed sc sp 
     schema = fromConf schemaConfT
-    split  = P.split tiersT . TP.parseTag tagsetT
+    split  = P.split tiersT
 
 -- | Schematized data from the plain file.
-schemed
-    :: (Foldable f, Ord t)
-    => F.Doc f s w -> Schema t a -> (F.Tag -> t)
-    -> FilePath -> IO [CRF.SentL Ob t]
-schemed F.Doc{..} schema split path =
-    foldMap onSent . parseDoc <$> L.readFile path
+schemed :: Ord t => Schema w t a -> (T.Tag -> t)
+        -> [X.Sent w T.Tag] -> [CRF.SentL Ob t]
+schemed schema split =
+    map onSent
   where
-    F.Sent{..} = sentHandler
-    F.Word{..} = wordHandler
     onSent sent =
-        [zip (schematize schema xs) (map mkDist xs)]
-      where
-        xs  = map (Mx.mapWord split . extract) (parseSent sent)
-        mkDist = CRF.mkDist . M.toList . Mx.unWMap . Mx.tagWMap
+        let xs  = map (X.mapSeg split) sent
+            mkDist = CRF.mkDist . M.toList . X.unWMap . X.tags
+        in  zip (schematize schema xs) (map mkDist xs)
diff --git a/src/NLP/Concraft/Disamb/Positional.hs b/src/NLP/Concraft/Disamb/Positional.hs
--- a/src/NLP/Concraft/Disamb/Positional.hs
+++ b/src/NLP/Concraft/Disamb/Positional.hs
@@ -9,7 +9,6 @@
 , Atom (..)
 , select
 , split
-, tiersDefault
 ) where
 
 import Control.Applicative ((<$>), (<*>))
@@ -52,13 +51,3 @@
 split tiers tag =
     [ select tier tag
     | tier <- tiers ]
-
--- | Default tiered tagging configuration.
-tiersDefault :: [Tier]
-tiersDefault =
-    [tier1, tier2]
-  where
-    tier1 = Tier True $ S.fromList ["cas", "per"]
-    tier2 = Tier False $ S.fromList
-        [ "nmb", "gnd", "deg", "asp" , "ngt", "acm"
-        , "acn", "ppr", "agg", "vlc", "dot" ]
diff --git a/src/NLP/Concraft/Format.hs b/src/NLP/Concraft/Format.hs
deleted file mode 100644
--- a/src/NLP/Concraft/Format.hs
+++ /dev/null
@@ -1,44 +0,0 @@
--- | The module provides several abstractions for representing external
--- data formats.  Concraft will be able to work with any format which
--- implements those abstractions.
-
-module NLP.Concraft.Format
-( Tag
-, Word (..)
-, Sent (..)
-, Doc (..)
-) where
-
-import Prelude hiding (words, unwords)
-import qualified Data.Text as T
-import qualified Data.Text.Lazy as L
-import qualified NLP.Concraft.Morphosyntax as M
-
--- | Textual representation of morphposyntactic tag.
-type Tag = T.Text
-
--- | Word handler.
-data Word w = Word {
-    -- | Extract information relevant for tagging.
-      extract       :: w -> M.Word Tag
-    -- | Select the set of morphosyntactic interpretations.
-    , select        :: M.WMap Tag -> w -> w }
-
--- | Sentence handler.
-data Sent s w = Sent {
-    -- | Split sentence into a list of words.
-      parseSent     :: s -> [w]
-    -- | Merge words with a sentence.
-    , mergeSent     :: [w] -> s -> s
-    -- | Words handler.
-    , wordHandler   :: Word w }
-
--- | Document format.
-data Doc f s w = Doc {
-    -- | Parse textual interpretations into a functor with
-    -- sentence elements.
-      parseDoc      :: L.Text -> f s
-    -- | Show textual reprezentation of a document.
-    , showDoc       :: f s -> L.Text
-    -- | Sentence handler.
-    , sentHandler   :: Sent s w }
diff --git a/src/NLP/Concraft/Format/Plain.hs b/src/NLP/Concraft/Format/Plain.hs
deleted file mode 100644
--- a/src/NLP/Concraft/Format/Plain.hs
+++ /dev/null
@@ -1,208 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-
--- | Simple format for morphosyntax representation which
--- assumes that all tags have a textual representation
--- with no spaces inside and that one of the tags indicates
--- unknown words.
-
-module NLP.Concraft.Format.Plain
-(
--- * Types
-  Token (..)
-, Interp (..)
-, Space (..)
--- * Format handler
-, plainFormat
--- * Parsing
-, parsePlain
-, parseSent
--- * Printing
-, showPlain
-, showSent
-) where
-
-import Control.Arrow (first)
-import Data.Monoid (Monoid, mappend, mconcat)
-import Data.Maybe (catMaybes)
-import Data.List (groupBy)
-import qualified Data.Map as M
-import qualified Data.Text as T
-import qualified Data.Text.Lazy as L
-import qualified Data.Text.Lazy.Builder as L
-
-import qualified NLP.Concraft.Morphosyntax as Mx
-import qualified NLP.Concraft.Format as F
-
--- | No space, space or newline.
-data Space
-    = None
-    | Space
-    | NewLine
-    deriving (Show, Eq, Ord)
-
--- | A token.
-data Token = Token
-    { orth      :: T.Text
-    , space     :: Space
-    , known     :: Bool
-    -- | Interpretations of the token, each interpretation annotated
-    -- with a /disamb/ Boolean value (if 'True', the interpretation
-    -- is correct within the context).
-    , interps   :: M.Map Interp Bool }
-    deriving (Show, Eq, Ord)
-    
-data Interp = Interp
-    { base  :: Maybe T.Text
-    , tag   :: F.Tag }
-    deriving (Show, Eq, Ord)
-
-noneBase :: T.Text
-noneBase = "None"
-
--- | Create document handler given value of the /ignore/ tag.
-plainFormat :: F.Tag -> F.Doc [] [Token] Token
-plainFormat ign = F.Doc (parsePlain ign) (showPlain ign) sentHandler
-
--- | Sentence handler.
-sentHandler :: F.Sent [Token] Token
-sentHandler = F.Sent id (\xs _ -> xs) wordHandler
-
--- | Word handler.
-wordHandler :: F.Word Token
-wordHandler = F.Word extract select
-
--- | Extract information relevant for tagging.
-extract :: Token -> Mx.Word F.Tag
-extract tok = Mx.Word
-    { Mx.orth       = orth tok
-    , Mx.tagWMap    = Mx.mkWMap
-        [ (tag x, if disamb then 1 else 0)
-        | (x, disamb) <- M.toList (interps tok) ]
-    , Mx.oov        = not (known tok) }
-
--- | Select interpretations.
-select :: Mx.WMap F.Tag -> Token -> Token
-select wMap tok =
-    tok { interps = newInterps }
-  where
-    wSet = M.fromList . map (first tag) . M.toList . interps
-    asDmb x = if x > 0
-        then True
-        else False
-    newInterps = M.fromList $
-        [ case M.lookup (tag interp) (Mx.unWMap wMap) of
-            Just x  -> (interp, asDmb x)
-            Nothing -> (interp, False)
-        | interp <- M.keys (interps tok) ]
-            ++ catMaybes
-        [ if tag `M.member` wSet tok
-            then Nothing
-            else Just (Interp Nothing tag, asDmb x)
-        | (tag, x) <- M.toList (Mx.unWMap wMap) ]
-
--- | Parse the text in the plain format given the /oov/ tag.
-parsePlain :: F.Tag -> L.Text -> [[Token]]
-parsePlain ign = map (parseSent ign) . init . L.splitOn "\n\n"
-
--- | Parse the sentence in the plain format given the /oov/ tag.
-parseSent :: F.Tag -> L.Text -> [Token]
-parseSent ign
-    = map (parseWord ignL)
-    . groupBy (\_ x -> cond x)
-    . L.lines
-  where
-    cond = ("\t" `L.isPrefixOf`)
-    ignL = L.fromStrict ign
-
-parseWord :: L.Text -> [L.Text] -> Token
-parseWord ign xs =
-    (Token _orth _space _known _interps)
-  where
-    (_orth, _space) = parseHeader (head xs)
-    ys          = map (parseInterp ign) (tail xs)
-    _known      = not (Nothing `elem` ys)
-    _interps    = M.fromListWith max (catMaybes ys)
-
-parseInterp :: L.Text -> L.Text -> Maybe (Interp, Bool)
-parseInterp ign =
-    doIt . tail . L.splitOn "\t"
-  where
-    doIt [form, tag]
-        | tag == ign    = Nothing
-        | otherwise     = Just $
-            (mkInterp form tag, False)
-    doIt [form, tag, "disamb"] = Just $
-        (mkInterp form tag, True)
-    doIt xs = error $ "parseInterp: " ++ show xs
-    mkInterp form tag
-        | formS == noneBase = Interp Nothing tagS
-        | otherwise         = Interp (Just formS) tagS
-      where
-        formS   = L.toStrict form
-        tagS    = L.toStrict tag
-
-parseHeader :: L.Text -> (T.Text, Space)
-parseHeader xs =
-    let [_orth, space] = L.splitOn "\t" xs
-    in  (L.toStrict _orth, parseSpace space)
-
-parseSpace :: L.Text -> Space
-parseSpace "none"    = None
-parseSpace "space"   = Space
-parseSpace "spaces"  = Space	-- Is it not a Maca bug?
-parseSpace "newline" = NewLine
-parseSpace "newlines" = NewLine -- TODO: Remove this temporary fix
-parseSpace xs        = error ("parseSpace: " ++ L.unpack xs)
-
------------
--- Printing
------------
-
--- | An infix synonym for 'mappend'.
-(<>) :: Monoid m => m -> m -> m
-(<>) = mappend
-{-# INLINE (<>) #-}
-
--- | Show the plain data.
-showPlain :: F.Tag -> [[Token]] -> L.Text
-showPlain ign =
-    L.toLazyText . mconcat  . map (\xs -> buildSent ign xs <> "\n")
-
--- | Show the sentence.
-showSent :: F.Tag -> [Token] -> L.Text
-showSent ign xs = L.toLazyText $ buildSent ign xs
-
-buildSent :: F.Tag -> [Token] -> L.Builder
-buildSent ign = mconcat . map (buildWord ign)
-
-buildWord :: F.Tag -> Token -> L.Builder
-buildWord ign tok
-    =  L.fromText (orth tok) <> "\t"
-    <> buildSpace (space tok) <> "\n"
-    <> buildKnown ign (known tok)
-    <> buildInterps (M.toList $ interps tok)
-
-buildInterps :: [(Interp, Bool)] -> L.Builder
-buildInterps interps = mconcat
-    [ "\t" <> buildBase interp <>
-      "\t" <> buildTag  interp <>
-      if dmb
-        then "\tdisamb\n"
-        else "\n"
-    | (interp, dmb) <- interps ]
-  where
-    buildTag    = L.fromText . tag
-    buildBase x = case base x of
-        Just b  -> L.fromText b
-        Nothing -> L.fromText noneBase
-
-buildSpace :: Space -> L.Builder
-buildSpace None     = "none"
-buildSpace Space    = "space"
-buildSpace NewLine  = "newline"
-
-buildKnown :: F.Tag -> Bool -> L.Builder
-buildKnown _   True     = ""
-buildKnown ign False    =  "\t" <> L.fromText noneBase
-                        <> "\t" <> L.fromText ign <> "\n"
diff --git a/src/NLP/Concraft/Format/Temp.hs b/src/NLP/Concraft/Format/Temp.hs
new file mode 100644
--- /dev/null
+++ b/src/NLP/Concraft/Format/Temp.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module NLP.Concraft.Format.Temp
+( encodePar
+, decodePar
+, writePar
+, readPar
+) where
+
+import qualified Data.ByteString.Lazy.Char8 as BC
+import qualified Data.Text as T
+import           Data.Aeson
+
+import           NLP.Concraft.Morphosyntax
+
+encodePar :: ToJSON w => [Sent w T.Text] -> BC.ByteString
+encodePar = BC.unlines . map encode
+
+decodePar :: FromJSON w => BC.ByteString -> [Sent w T.Text]
+decodePar = 
+    let getRight (Right x) = x
+        getRight (Left e)  = error $ "error in decodePar: " ++ e
+    in  map (getRight . eitherDecode') . BC.lines
+
+writePar :: ToJSON w => FilePath -> [Sent w T.Text] -> IO ()
+writePar path = BC.writeFile path . encodePar
+
+readPar :: FromJSON w => FilePath -> IO [Sent w T.Text]
+readPar = fmap decodePar . BC.readFile
diff --git a/src/NLP/Concraft/Guess.hs b/src/NLP/Concraft/Guess.hs
--- a/src/NLP/Concraft/Guess.hs
+++ b/src/NLP/Concraft/Guess.hs
@@ -7,9 +7,8 @@
  
 -- * Guessing
 , guess
-, guessSent
-, guessDoc
 , include
+, guessSent
 
 -- * Training
 , TrainConf (..)
@@ -19,12 +18,9 @@
 import Prelude hiding (words)
 import Control.Applicative ((<$>), (<*>))
 import Data.Binary (Binary, put, get)
-import Data.Foldable (Foldable, foldMap)
 import Data.Text.Binary ()
 import qualified Data.Set as S
 import qualified Data.Map as M
-import qualified Data.Text.Lazy as L
-import qualified Data.Text.Lazy.IO as L
 import qualified Data.Vector as V
 
 import qualified Control.Monad.Ox as Ox
@@ -32,8 +28,7 @@
 import qualified Numeric.SGD as SGD
 
 import NLP.Concraft.Schema hiding (schematize)
-import qualified NLP.Concraft.Morphosyntax as Mx
-import qualified NLP.Concraft.Format as F
+import qualified NLP.Concraft.Morphosyntax as X
 
 -- | A guessing model.
 data Guesser t = Guesser
@@ -45,7 +40,7 @@
     get = Guesser <$> get <*> get
 
 -- | Schematize the input sentence with according to 'schema' rules.
-schematize :: Ord t => Schema t a -> Mx.Sent t -> CRF.Sent Ob t
+schematize :: (X.Word w, Ord t) => Schema w t a -> X.Sent w t -> CRF.Sent Ob t
 schematize schema sent =
     [ CRF.Word (obs i) (lbs i)
     | i <- [0 .. n - 1] ]
@@ -54,66 +49,37 @@
     n = V.length v
     obs = S.fromList . Ox.execOx . schema v
     lbs i 
-        | Mx.oov w  = S.empty
-        | otherwise = Mx.interpsSet w
+        | X.oov w  = S.empty
+        | otherwise = X.interpsSet w
         where w = v V.! i
 
--- | Determine the 'k' most probable labels for each word in the sentence.
-guess :: Ord t => Int -> Guesser t -> Mx.Sent t -> [[t]]
+-- | Determine 'k' most probable labels for each word in the sentence.
+guess :: (X.Word w, Ord t)
+      => Int -> Guesser t -> X.Sent w t -> [[t]]
 guess k gsr sent =
     let schema = fromConf (schemaConf gsr)
     in  CRF.tagK k (crf gsr) (schematize schema sent)
 
--- | Include guessing results into weighted tag maps
--- assigned to individual words.
-includeWMaps :: Ord t => Mx.Sent t -> [[t]] -> [Mx.WMap t]
-includeWMaps words guessed =
-    [ if Mx.oov word
-        then addInterps (Mx.tagWMap word) xs
-        else Mx.tagWMap word
-    | (xs, word) <- zip guessed words ]
+-- | Insert guessing results into the sentence.
+include :: (X.Word w, Ord t) => (X.Sent w t -> [[t]])
+        -> X.Sent w t -> X.Sent w t
+include f sent =
+    [ word { X.tags = tags }
+    | (word, tags) <- zip sent sentTags ]
   where
-    -- Add new interpretations.
-    addInterps wm xs = Mx.mkWMap
-        $  M.toList (Mx.unWMap wm)
+    sentTags =
+        [ if X.oov word
+            then addInterps (X.tags word) xs
+            else X.tags word
+        | (xs, word) <- zip (f sent) sent ]
+    addInterps wm xs = X.mkWMap
+        $  M.toList (X.unWMap wm)
         ++ zip xs [0, 0 ..]
 
--- | Include guessing results into the sentence.
-include :: Ord t => Mx.Sent t -> [[t]] -> Mx.Sent t
-include words guessed =
-    [ word { Mx.tagWMap = wMap }
-    | (word, wMap) <- zip words wMaps ]
-  where
-    wMaps = includeWMaps words guessed
-
--- | Tag sentence in external format.  Selected interpretations
--- (tags correct within the context) will be preserved.
-guessSent :: F.Sent s w -> Int -> Guesser F.Tag -> s -> s
-guessSent F.Sent{..} k gsr sent = flip mergeSent sent
-    [ select wMap word
-    | (wMap, word) <- zip wMaps (parseSent sent) ]
-  where
-    -- Extract word handler.
-    F.Word{..} = wordHandler
-    -- Word in internal format.
-    words   = map extract (parseSent sent)
-    -- Guessed lists of interpretations for individual words.
-    guessed = guess k gsr words
-    -- Resultant weighted maps. 
-    wMaps   = includeWMaps words guessed
-
--- | Tag file.
-guessDoc
-    :: Functor f
-    => F.Doc f s w  	-- ^ Document format handler
-    -> Int              -- ^ Guesser argument
-    -> Guesser F.Tag    -- ^ Guesser itself
-    -> L.Text           -- ^ Input
-    -> L.Text           -- ^ Output
-guessDoc F.Doc{..} k gsr
-    = showDoc 
-    . fmap (guessSent sentHandler k gsr)
-    . parseDoc
+-- | Combine `guess` with `include`. 
+guessSent :: (X.Word w, Ord t)
+          => Int -> Guesser t -> X.Sent w t -> X.Sent w t
+guessSent guessNum guesser = include (guess guessNum guesser)
 
 -- | Training configuration.
 data TrainConf = TrainConf
@@ -122,30 +88,27 @@
 
 -- | Train guesser.
 train
-    :: Foldable f
-    => F.Doc f s w      -- ^ Document format handler
-    -> TrainConf        -- ^ Training configuration
-    -> FilePath         -- ^ Training file
-    -> Maybe FilePath   -- ^ Maybe eval file
-    -> IO (Guesser F.Tag)
-train format TrainConf{..} trainPath evalPath'Maybe = do
+    :: (X.Word w, Ord t)
+    => TrainConf            -- ^ Training configuration
+    -> [X.Sent w t]         -- ^ Training data
+    -> Maybe [X.Sent w t]   -- ^ Maybe evaluation data
+    -> IO (Guesser t)
+train TrainConf{..} trainData evalData'Maybe = do
     let schema = fromConf schemaConfT
     crf <- CRF.train sgdArgsT
-        (schemed format schema trainPath)
-        (schemed format schema <$> evalPath'Maybe)
+        (retSchemed schema trainData)
+        (retSchemed schema <$> evalData'Maybe)
         (const CRF.presentFeats)
     return $ Guesser schemaConfT crf
+  where
+    retSchemed schema = return . schemed schema
 
 -- | Schematized data from the plain file.
-schemed
-    :: Foldable f => F.Doc f s w -> Schema F.Tag a
-    -> FilePath -> IO [CRF.SentL Ob F.Tag]
-schemed F.Doc{..} schema path =
-    foldMap onSent . parseDoc <$> L.readFile path
+schemed :: (X.Word w, Ord t) => Schema w t a
+        -> [X.Sent w t] -> [CRF.SentL Ob t]
+schemed schema =
+    map onSent
   where
-    F.Sent{..} = sentHandler
-    F.Word{..} = wordHandler
-    onSent sent =
-        let xs = map extract (parseSent sent)
-            mkProb = CRF.mkProb . M.toList . Mx.unWMap . Mx.tagWMap
-        in  [zip (schematize schema xs) (map mkProb xs)]
+    onSent xs =
+        let mkProb = CRF.mkProb . M.toList . X.unWMap . X.tags
+        in  zip (schematize schema xs) (map mkProb xs)
diff --git a/src/NLP/Concraft/Morphosyntax.hs b/src/NLP/Concraft/Morphosyntax.hs
--- a/src/NLP/Concraft/Morphosyntax.hs
+++ b/src/NLP/Concraft/Morphosyntax.hs
@@ -1,67 +1,146 @@
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleInstances #-}
 
+
 -- | Types and functions related to the morphosyntax data layer.
 
+
 module NLP.Concraft.Morphosyntax
 ( 
--- * Morphosyntax data
-  Sent
-, Word (..)
-, mapWord
-, mapSent
+-- * Segment
+  Seg (..)
+, mapSeg
 , interpsSet
 , interps
+
+-- * Word classes
+, Word (..)
+
+-- * Sentence
+, Sent
+, mapSent
+, SentO (..)
+, mapSentO
+
 -- * Weighted collection
 , WMap (unWMap)
-, mkWMap
 , mapWMap
+, mkWMap
 ) where
 
-import Control.Arrow (first)
+
+import           Control.Applicative ((<$>), (<*>))
+import           Control.Arrow (first)
+import           Data.Aeson
 import qualified Data.Set as S
 import qualified Data.Map as M
 import qualified Data.Text as T
+import qualified Data.Text.Lazy as L
 
 
--- | A sentence of 'Word's.
-type Sent t = [Word t]
+--------------------------
+-- Segment
+--------------------------
 
--- | A word parametrized over a tag type.
-data Word t = Word {
+
+-- | A segment parametrized over a word type and a tag type.
+data Seg w t = Seg {
+    -- | A word represented by the segment.  Typically it will be
+    -- an instance of the `Word` class.
+      word  :: w
+    -- | A set of interpretations.  To each interpretation
+    -- a weight of appropriateness within the context
+    -- is assigned.
+    , tags  :: WMap t }
+    deriving (Show)
+
+
+instance ToJSON w => ToJSON (Seg w T.Text) where
+    toJSON Seg{..} = object
+        [ "word" .= word
+        , "tags" .= unWMap tags ]
+
+instance FromJSON w => FromJSON (Seg w T.Text) where
+    parseJSON (Object v) = Seg
+        <$> v .: "word"
+        <*> (WMap <$> v .: "tags")
+    parseJSON _ = error "parseJSON (segment): absurd"
+
+
+-- | Map function over segment tags.
+mapSeg :: Ord b => (a -> b) -> Seg w a -> Seg w b
+mapSeg f w = w { tags = mapWMap f (tags w) }
+
+
+-- | Interpretations of the segment.
+interpsSet :: Seg w t -> S.Set t
+interpsSet = M.keysSet . unWMap . tags
+
+
+-- | Interpretations of the segment.
+interps :: Seg w t -> [t]
+interps = S.toList . interpsSet
+
+
+--------------------------
+-- Word classes
+--------------------------
+
+
+class Word a where
     -- | Orthographic form.
-      orth      :: T.Text
-    -- | Set of word interpretations.  To each interpretation
-    -- a weight of correctness within the context is assigned.
-    , tagWMap   :: WMap t
-    -- | Out-of-vocabulary (OOV) word, i.e. word unknown to the
-    -- morphosyntactic analyser.
-    , oov       :: Bool }
-    deriving (Show, Eq, Ord)
+    orth    :: a -> T.Text 
+    -- | Out-of-vocabulary (OOV) word.
+    oov     :: a -> Bool
 
--- | Map function over word tags.
-mapWord :: Ord b => (a -> b) -> Word a -> Word b
-mapWord f w = w { tagWMap = mapWMap f (tagWMap w) }
 
+instance Word w => Word (Seg w t) where
+    orth = orth . word
+    {-# INLINE orth #-}
+    oov = oov . word
+    {-# INLINE oov #-}
+
+
+----------------------
+-- Sentence
+----------------------
+
+
+-- | A sentence.
+type Sent w t = [Seg w t]
+
 -- | Map function over sentence tags.
-mapSent :: Ord b => (a -> b) -> Sent a -> Sent b
-mapSent = map . mapWord
+mapSent :: Ord b => (a -> b) -> Sent w a -> Sent w b
+mapSent = map . mapSeg
 
--- | Interpretations of the word.
-interpsSet :: Word t -> S.Set t
-interpsSet = M.keysSet . unWMap . tagWMap
+-- | A sentence with original, textual representation.
+data SentO w t = SentO
+    { segs  :: Sent w t
+    , orig  :: L.Text }
+    deriving (Show)
 
--- | Interpretations of the word.
-interps :: Word t -> [t]
-interps = S.toList . interpsSet
+-- | Map function over sentence tags.
+mapSentO :: Ord b => (a -> b) -> SentO w a -> SentO w b
+mapSentO f x =
+    let segs' = mapSent f (segs x)
+    in  x { segs = segs' }
 
+----------------------
+-- Weighted collection
+----------------------
 
--- | A weighted collection of type @a@ elements.
+-- | A set with a non-negative weight assigned to each of
+-- its elements.
 newtype WMap a = WMap { unWMap :: M.Map a Double }
     deriving (Show, Eq, Ord)
 
--- | Make a weighted collection.
+
+-- | Make a weighted collection.  Negative elements will be ignored.
 mkWMap :: Ord a => [(a, Double)] -> WMap a
 mkWMap = WMap . M.fromListWith (+) . filter ((>=0).snd)
+
 
 -- | Map function over weighted collection elements. 
 mapWMap :: Ord b => (a -> b) -> WMap a -> WMap b
diff --git a/src/NLP/Concraft/Morphosyntax/Align.hs b/src/NLP/Concraft/Morphosyntax/Align.hs
new file mode 100644
--- /dev/null
+++ b/src/NLP/Concraft/Morphosyntax/Align.hs
@@ -0,0 +1,79 @@
+{-# LANGUAGE TupleSections #-}
+
+-- | Alignment and synchronization.  Currently works only with positional tagsets.
+
+module NLP.Concraft.Morphosyntax.Align
+( align
+, sync
+) where
+
+import           Control.Applicative ((<|>))
+import           Data.Maybe (fromJust)
+import           Data.List (find)
+import qualified Data.Set as S
+import qualified Data.Map as M
+import qualified Data.Char as C
+import qualified Data.Text as T
+import qualified Data.Tagset.Positional as P
+
+import           NLP.Concraft.Morphosyntax
+
+-- | Synchronize two datasets, taking disamb tags from the first one
+-- and the rest of information form the second one.
+-- In case of differences in token-level segmentation, reference segmentation
+-- (token-level) is assumed.  Otherwise, it would be difficult to choose
+-- correct disamb tags.
+sync :: Word w => P.Tagset -> [Seg w P.Tag] -> [Seg w P.Tag] -> [Seg w P.Tag]
+sync tagset xs ys = concatMap (uncurry (moveDisamb tagset)) (align xs ys)
+
+-- | If both arguments contain only one segment, insert disamb interpretations
+-- from the first segment into the second segment.  Otherwise, the first list
+-- of segments will be returned unchanged.
+moveDisamb :: P.Tagset -> [Seg w P.Tag] -> [Seg w P.Tag] -> [Seg w P.Tag]
+moveDisamb tagset [v] [w] =
+    [w {tags = mkWMap (map (,0) tagsNew ++ disambNew)}]
+  where
+    -- Return list of (tag, weight) pairs assigned to the segment.
+    tagPairs    = M.toList . unWMap . tags
+    -- New tags domain.
+    tagsNew     = map fst (tagPairs w)
+    -- Disamb list with tags mapped to the new domain.
+    disambNew   = [(newDom x, c) | (x, c) <- tagPairs v, c > 0]
+    -- Find corresonding tag in the new tags domain.
+    newDom tag  = fromJust $
+            find ( ==tag) tagsNew   -- Exact match
+        <|> find (~==tag) tagsNew   -- Expanded tag match
+        <|> Just tag                -- Controversial
+      where
+        x ~== y = S.size (label x `S.intersection` label y) > 0
+        label   = S.fromList . P.expand tagset
+-- Do nothing in this case.
+moveDisamb _ xs _ = xs
+
+-- | Align two lists of segments.
+align :: Word w => [Seg w t] -> [Seg w t] -> [([Seg w t], [Seg w t])]
+align [] [] = []
+align [] _  = error "align: null xs, not null ys"
+align _  [] = error "align: not null xs, null ys"
+align xs ys =
+    let (x, y) = match xs ys
+        rest   = align (drop (length x) xs) (drop (length y) ys)
+    in  (x, y) : rest
+
+-- | Find the shortest, length-matching prefixes in the two input lists.
+match :: Word w => [Seg w t] -> [Seg w t] -> ([Seg w t], [Seg w t])
+match xs' ys' =
+    doIt 0 xs' 0 ys'
+  where
+    doIt i (x:xs) j (y:ys)
+        | n == m    = ([x], [y])
+        | n <  m    = addL x $ doIt n xs j (y:ys)
+        | otherwise = addR y $ doIt i (x:xs) m ys
+      where
+        n = i + size x
+        m = j + size y
+    doIt _ [] _ _   = error "match: the first argument is null"
+    doIt _ _  _ []  = error "match: the second argument is null"
+    size w = T.length . T.filter (not.C.isSpace) $ orth w
+    addL x (xs, ys) = (x:xs, ys)
+    addR y (xs, ys) = (xs, y:ys)
diff --git a/src/NLP/Concraft/Schema.hs b/src/NLP/Concraft/Schema.hs
--- a/src/NLP/Concraft/Schema.hs
+++ b/src/NLP/Concraft/Schema.hs
@@ -24,9 +24,6 @@
 , nullConf
 , fromConf
 
-, guessConfDefault
-, disambConfDefault
-
 -- * Schema blocks
 , Block
 , fromBlock
@@ -48,27 +45,27 @@
 import qualified Control.Monad.Ox as Ox
 import qualified Control.Monad.Ox.Text as Ox
 
-import qualified NLP.Concraft.Morphosyntax as Mx
+import qualified NLP.Concraft.Morphosyntax as X
 
 -- | An observation consist of an index (of list type) and an actual
 -- observation value.
 type Ob = ([Int], T.Text)
 
 -- | The Ox monad specialized to word token type and text observations.
-type Ox t a = Ox.Ox (Mx.Word t) T.Text a
+type Ox a = Ox.Ox T.Text a
 
 -- | A schema is a block of the Ox computation performed within the
 -- context of the sentence and the absolute sentence position.
-type Schema t a = V.Vector (Mx.Word t) -> Int -> Ox t a
+type Schema w t a = V.Vector (X.Seg w t) -> Int -> Ox a
 
 -- | A dummy schema block.
-void :: a -> Schema t a
+void :: a -> Schema w t a
 void x _ _ = return x
 
 -- | Sequence the list of schemas (or blocks) and discard individual values.
 sequenceS_
-    :: [V.Vector (Mx.Word t) -> a -> Ox t b]
-    ->  V.Vector (Mx.Word t) -> a -> Ox t ()
+    :: [V.Vector (X.Seg w t) -> a -> Ox b]
+    ->  V.Vector (X.Seg w t) -> a -> Ox ()
 sequenceS_ xs sent =
     let ys = map ($sent) xs
     in  \k -> sequence_ (map ($k) ys)
@@ -79,48 +76,48 @@
     , lowOrth       :: Int -> Maybe T.Text }
 
 -- | Construct the 'BaseOb' structure given the sentence.
-mkBaseOb :: V.Vector (Mx.Word t) -> BaseOb
+mkBaseOb :: X.Word w => V.Vector (X.Seg w t) -> BaseOb
 mkBaseOb sent = BaseOb
     { orth      = _orth
     , lowOrth   = _lowOrth }
   where
     at          = Ox.atWith sent
-    _orth       = (Mx.orth `at`)
+    _orth       = (X.orth `at`)
     _lowOrth i  = T.toLower <$> _orth i
 
 -- | A block is a chunk of the Ox computation performed within the
 -- context of the sentence and the list of absolute sentence positions.
-type Block t a = V.Vector (Mx.Word t) -> [Int] -> Ox t a
+type Block w t a = V.Vector (X.Seg w t) -> [Int] -> Ox a
 
 -- | Transform a block to a schema depending on
 -- * A list of relative sentence positions,
 -- * A boolean value; if true, the block computation
 --   will be performed only on positions where an OOV
 --   word resides.
-fromBlock :: Block t a -> [Int] -> Bool -> Schema t a
+fromBlock :: X.Word w => Block w t a -> [Int] -> Bool -> Schema w t a
 fromBlock blk xs oovOnly sent =
     \k -> blkSent [x + k | x <- xs, oov (x + k)]
   where
     blkSent = blk sent
     oov k   = if not oovOnly
         then True
-        else maybe False id $ Mx.oov `at` k
+        else maybe False id $ X.oov `at` k
     at      = Ox.atWith sent
 
 -- | Orthographic form at the current position.
-orthB :: Block t ()
+orthB :: X.Word w => Block w t ()
 orthB sent = \ks ->
-    let orthOb = Ox.atWith sent Mx.orth
+    let orthOb = Ox.atWith sent X.orth
     in  mapM_ (Ox.save . orthOb) ks
 
 -- | Orthographic form at the current position.
-lowOrthB :: Block t ()
+lowOrthB :: X.Word w => Block w t ()
 lowOrthB sent = \ks ->
     let BaseOb{..} = mkBaseOb sent
     in  mapM_ (Ox.save . lowOrth) ks
 
 -- | List of lowercased prefixes of given lengths.
-lowPrefixesB :: [Int] -> Block t ()
+lowPrefixesB :: X.Word w => [Int] -> Block w t ()
 lowPrefixesB ns sent = \ks ->
     forM_ ks $ \i ->
         mapM_ (Ox.save . lowPrefix i) ns
@@ -129,7 +126,7 @@
     lowPrefix i j   = Ox.prefix j =<< lowOrth i
 
 -- | List of lowercased suffixes of given lengths.
-lowSuffixesB :: [Int] -> Block t ()
+lowSuffixesB :: X.Word w => [Int] -> Block w t ()
 lowSuffixesB ns sent = \ks ->
     forM_ ks $ \i ->
         mapM_ (Ox.save . lowSuffix i) ns
@@ -138,17 +135,17 @@
     lowSuffix i j   = Ox.suffix j =<< lowOrth i
 
 -- | Shape of the word.
-knownB :: Block t ()
+knownB :: X.Word w => Block w t ()
 knownB sent = \ks -> do
     mapM_ (Ox.save . knownAt) ks
   where
     at          = Ox.atWith sent
-    knownAt i   = boolF <$> (not . Mx.oov) `at` i
+    knownAt i   = boolF <$> (not . X.oov) `at` i
     boolF True  = "T"
     boolF False = "F"
 
 -- | Shape of the word.
-shapeB :: Block t ()
+shapeB :: X.Word w => Block w t ()
 shapeB sent = \ks -> do
     mapM_ (Ox.save . shape) ks
   where
@@ -156,7 +153,7 @@
     shape i         = Ox.shape <$> orth i
 
 -- | Packed shape of the word.
-packedB :: Block t ()
+packedB :: X.Word w => Block w t ()
 packedB sent = \ks -> do
     mapM_ (Ox.save . shapeP) ks
   where
@@ -165,7 +162,7 @@
     shapeP i        = Ox.pack <$> shape i
 
 -- | Packed shape of the word.
-begPackedB :: Block t ()
+begPackedB :: X.Word w => Block w t ()
 begPackedB sent = \ks -> do
     mapM_ (Ox.save . begPacked) ks
   where
@@ -179,7 +176,7 @@
     x <> y          = T.append <$> x <*> y
 
 -- -- | Combined shapes of two consecutive (at @k-1@ and @k@ positions) words.
--- shapePairB :: Block t ()
+-- shapePairB :: Block w t ()
 -- shapePairB sent = \ks ->
 --     forM_ ks $ \i -> do
 --         Ox.save $ link <$> shape  i <*> shape  (i - 1)
@@ -190,7 +187,7 @@
 -- 
 -- -- | Combined packed shapes of two consecutive (at @k-1@ and @k@ positions)
 -- -- words.
--- packedPairB :: Block t ()
+-- packedPairB :: Block w t ()
 -- packedPairB sent = \ks ->
 --     forM_ ks $ \i -> do
 --         Ox.save $ link <$> shapeP i <*> shapeP (i - 1)
@@ -272,16 +269,16 @@
     Nothing Nothing Nothing Nothing
     Nothing Nothing Nothing Nothing
 
-mkArg0 :: Block t () -> Entry () -> Schema t ()
+mkArg0 :: X.Word w => Block w t () -> Entry () -> Schema w t ()
 mkArg0 blk (Just x) = fromBlock blk (range x) (oovOnly x)
 mkArg0 _   Nothing  = void ()
 
-mkArg1 :: (a -> Block t ()) -> Entry a -> Schema t ()
+mkArg1 :: X.Word w => (a -> Block w t ()) -> Entry a -> Schema w t ()
 mkArg1 blk (Just x) = fromBlock (blk (args x)) (range x) (oovOnly x)
 mkArg1 _   Nothing  = void ()
 
 -- | Build the schema based on the configuration.
-fromConf :: SchemaConf -> Schema t ()
+fromConf :: X.Word w => SchemaConf -> Schema w t ()
 fromConf SchemaConf{..} = sequenceS_
     [ mkArg0 orthB orthC
     , mkArg0 lowOrthB lowOrthC
@@ -292,80 +289,8 @@
     , mkArg0 packedB packedC
     , mkArg0 begPackedB begPackedC ]
 
--- -- | Use the schema to extract observations from the sentence.
--- schematize :: Schema t a -> [Mx.Word t] -> CRF.Sent Ob
--- schematize schema xs =
---     map (S.fromList . Ox.execOx . schema v) [0 .. n - 1]
---   where
---     v = V.fromList xs
---     n = V.length v
-
----------------------------------
--- Default schema configurations.
----------------------------------
-
--- | Default configuration for the guessing observation schema.
-guessConfDefault :: SchemaConf
-guessConfDefault = nullConf
-    { lowPrefixesC  = entryWith [1, 2]      [0]
-    , lowSuffixesC  = entryWith [1, 2]      [0]
-    , knownC        = entry                 [0]
-    , begPackedC    = entry                 [0] }
-
--- -- | Default guessing schema.
--- guessSchemaDefault :: Schema t ()
--- guessSchemaDefault sent = \k -> do
---     mapM_ (Ox.save . lowPref k) [1, 2]
---     mapM_ (Ox.save . lowSuff k) [1, 2]
---     Ox.save (knownAt k)
---     Ox.save (isBeg k <> pure "-" <> shapeP k)
---   where
---     at          = Ox.atWith sent
---     lowOrth i   = T.toLower <$> Mx.orth `at` i
---     lowPref i j = Ox.prefix j =<< lowOrth i
---     lowSuff i j = Ox.suffix j =<< lowOrth i
---     shape i     = Ox.shape <$> Mx.orth `at` i
---     shapeP i    = Ox.pack <$> shape i
---     knownAt i   = boolF <$> (not . Mx.oov) `at` i
---     isBeg i     = (Just . boolF) (i == 0)
---     boolF True  = "T"
---     boolF False = "F"
---     x <> y      = T.append <$> x <*> y
-
--- | Default configuration for the guessing observation schema.
-disambConfDefault :: SchemaConf
-disambConfDefault = nullConf
-    { lowOrthC      = entry                         [-1, 0, 1]
-    , lowPrefixesC  = oov $ entryWith [1, 2, 3]     [0]
-    , lowSuffixesC  = oov $ entryWith [1, 2, 3]     [0]
-    , begPackedC    = oov $ entry                   [0] }
-  where
-    oov (Just body) = Just $ body { oovOnly = True }
-    oov Nothing     = Nothing
-
--- -- | Default disambiguation schema.
--- disambSchemaDefault :: Schema t ()
--- disambSchemaDefault sent = \k -> do
---     mapM_ (Ox.save . lowOrth) [k - 1, k, k + 1]
---     _ <- Ox.whenJT (Mx.oov `at` k) $ do
---         mapM_ (Ox.save . lowPref k) [1, 2, 3]
---         mapM_ (Ox.save . lowSuff k) [1, 2, 3]
---         Ox.save (isBeg k <> pure "-" <> shapeP k)
---     return ()
---   where
---     at          = Ox.atWith sent
---     lowOrth i   = T.toLower <$> Mx.orth `at` i
---     lowPref i j = Ox.prefix j =<< lowOrth i
---     lowSuff i j = Ox.suffix j =<< lowOrth i
---     shape i     = Ox.shape <$> Mx.orth `at` i
---     shapeP i    = Ox.pack <$> shape i
---     isBeg i     = (Just . boolF) (i == 0)
---     boolF True  = "T"
---     boolF False = "F"
---     x <> y      = T.append <$> x <*> y
-
 -- | Use the schema to extract observations from the sentence.
-schematize :: Schema t a -> Mx.Sent t -> [[Ob]]
+schematize :: Schema w t a -> X.Sent w t -> [[Ob]]
 schematize schema xs =
     map (Ox.execOx . schema v) [0 .. n - 1]
   where
diff --git a/tools/concraft.hs b/tools/concraft.hs
deleted file mode 100644
--- a/tools/concraft.hs
+++ /dev/null
@@ -1,106 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE RecordWildCards #-}
-
-import Control.Applicative ((<$>), (<*>))
-import Control.Monad (when)
-import System.Console.CmdArgs
-import Data.Binary (encodeFile, decodeFile)
-import qualified Numeric.SGD as SGD
-import qualified Data.Text as T
-import qualified Data.Text.Lazy.IO as L
-import qualified Data.Tagset.Positional as P
-
-import NLP.Concraft.Format.Plain (plainFormat)
-import qualified NLP.Concraft as C
-import qualified NLP.Concraft.Schema as S
-import qualified NLP.Concraft.Guess as G
-import qualified NLP.Concraft.Disamb as D
-
--- | Data formats. 
-data Format = Plain deriving (Data, Typeable, Show)
-
-data Concraft
-  = Train
-    { trainPath	    :: FilePath
-    , evalPath      :: Maybe FilePath
-    , format        :: Format
-    -- TODO: ignore tag should be related only to the Plain
-    -- format, but then 'Format' would not be an Enum instance.
-    -- Try another command line parsing library?
-    , tagsetPath    :: FilePath
-    , ignTag        :: String
-    -- , discardHidden :: Bool
-    , iterNum       :: Double
-    , batchSize     :: Int
-    , regVar        :: Double
-    , gain0         :: Double
-    , tau           :: Double
-    , outModel      :: FilePath
-    , guessNum      :: Int }
-  | Disamb
-    { format        :: Format
-    , ignTag        :: String
-    , inModel       :: FilePath }
-    -- , guessNum      :: Int }
-  deriving (Data, Typeable, Show)
-
-trainMode :: Concraft
-trainMode = Train
-    { tagsetPath = def &= argPos 0 &= typ "TAGSET-PATH"
-    , trainPath = def &= argPos 1 &= typ "TRAIN-FILE"
-    , evalPath = def &= typFile &= help "Evaluation file"
-    , format = enum [Plain &= help "Plain format"]
-    , ignTag = "ign" &= help "Tag indicating OOV word"
-    -- , discardHidden = False &= help "Discard hidden features"
-    , iterNum = 10 &= help "Number of SGD iterations"
-    , batchSize = 30 &= help "Batch size"
-    , regVar = 10.0 &= help "Regularization variance"
-    , gain0 = 1.0 &= help "Initial gain parameter"
-    , tau = 5.0 &= help "Initial tau parameter"
-    , outModel = def &= typFile &= help "Output Model file"
-    , guessNum = 10 &= help "Number of guessed tags for each unknown word" }
-
-disambMode :: Concraft
-disambMode = Disamb
-    { inModel = def &= argPos 0 &= typ "MODEL-FILE"
-    , format = enum [Plain &= help "Plain format"]
-    , ignTag = "ign" &= help "Tag indicating OOV word" }
-    -- , guessNum = 10 &= help "Number of guessed tags for each unknown word" }
-
-argModes :: Mode (CmdArgs Concraft)
-argModes = cmdArgsMode $ modes [trainMode, disambMode]
-
-main :: IO ()
-main = exec =<< cmdArgsRun argModes
-
-exec :: Concraft -> IO ()
-
-exec Train{..} = do
-    tagset <- P.parseTagset tagsetPath <$> readFile tagsetPath
-    concraft <- case format of
-        Plain   -> train (plainFormat ign) tagset
-    when (not . null $ outModel) $ do
-        putStrLn $ "\nSaving model in " ++ outModel ++ "..."
-        encodeFile outModel concraft
-  where
-    train docH tagset =
-        let guessConf  = G.TrainConf S.guessConfDefault sgdArgs
-            disambConf = D.TrainConf tagset D.tiersDefault
-                S.disambConfDefault sgdArgs
-        in  C.train docH guessNum guessConf disambConf trainPath evalPath 
-    ign = T.pack ignTag
-    sgdArgs = SGD.SgdArgs
-        { SGD.batchSize = batchSize
-        , SGD.regVar = regVar
-        , SGD.iterNum = iterNum
-        , SGD.gain0 = gain0
-        , SGD.tau = tau }
-
-exec Disamb{..} = do
-    tag <- tagWith <$> decodeFile inModel <*> L.getContents
-    case format of
-        Plain   -> L.putStr $ tag (plainFormat ign)
-  where
-    tagWith concraft input docH = C.tagDoc docH concraft input
-    ign = T.pack ignTag