diff --git a/Benchmark.hs b/Benchmark.hs
new file mode 100644
--- /dev/null
+++ b/Benchmark.hs
@@ -0,0 +1,69 @@
+module Main where
+
+import Control.Monad (when)
+import Criterion.Config
+import Criterion.Main
+import Data.Monoid (Last(..))
+import Data.Map (Map)
+import qualified Data.Map as Map
+import System (getArgs, getProgName)
+import System.FilePath ((</>))
+import System.IO (stderr, hPutStrLn)
+import Toktok (Lexer, mkLexer, mkLexerWithSandhis)
+
+myConfig = defaultConfig {
+             cfgSummaryFile = Last $ Just "benchmark.csv"}
+
+main = defaultMainWith myConfig (return ()) $
+         map createBGroup [ ("Transducer", mkLexerWithSandhis [])
+                          , ("Tries", mkLexer)
+                          , ("Baseline", baseline)
+                          , ("Dummy", dummy)
+                          ]
+
+createBGroup :: (String, [String] -> Lexer) -> Benchmark
+createBGroup (name, mkLexer)
+   = bgroup name
+            [ bench "English" $ nfIO $ mkBenchmark "english" mkLexer
+            , bench "French"  $ nfIO $ mkBenchmark "french"  mkLexer
+            ]
+
+mkBenchmark :: String -> ([String] -> Lexer) -> IO ()
+mkBenchmark dir mklexerf = do
+                       lexicon <- readLexicon dir
+                       let lexer = mkLexer (" ":filter (not . null) lexicon)
+                       sts <- readSentences dir
+                       let results = map (not . null . lexer) sts
+                       --putStrLn $ unlines $ map show results
+                       when (not $ and results) $ error "Problem..."
+                       return ()
+                       
+readLexicon :: String -> IO [String]
+readLexicon dir = readLineFiles $ "data" </> dir </> "lexicon.txt"
+
+readSentences :: String -> IO [String]
+readSentences dir = readLineFiles $ "data" </> dir </> "sentences.txt"
+
+readLineFiles :: FilePath -> IO [String]
+readLineFiles f = do
+                  t <- readFile f
+                  return $ lines t
+
+-- Lexers for comparaison
+
+-- | This is the standard haskell lexer, 'words'.
+-- It just split the string where there is white-spaces.
+dummy :: [String] -> Lexer
+dummy _ = return . words
+
+-- | this is a lexer based on haskell maps
+baseline :: [String] -> Lexer
+baseline ss = useMapLexer mapLexer
+   where mapLexer = Map.fromList $ map (\x -> (x,True)) ss
+         useMapLexer :: Map String Bool -> Lexer
+         useMapLexer m = uml 1
+            where uml i s | i >= length s = []
+                  uml i s = case Map.lookup (take i s) m of
+                         Just True -> [take i s:l | l <- uml 1 (drop i s)]
+                                      ++ uml (i + 1) s
+                         _         -> uml (i + 1) s
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
diff --git a/Main.hs b/Main.hs
new file mode 100644
--- /dev/null
+++ b/Main.hs
@@ -0,0 +1,68 @@
+module Main where
+
+import System
+import System.Console.GetOpt
+
+-- Default script options 
+defaultOptions :: Options
+defaultOptions = Options {
+     runScript = runLexer
+   , lexerPath = "lexer.lex"
+   , txtFiles  = []
+}
+
+-- Main function : does argument parsing
+main = do
+      args <- getArgs
+      let (optHelpers, nonOpt, msg) = getOpt Permute options args
+      let scriptOptions = compose optHelpers defaultOptions
+      -- this next line is not perfect, but I'm not shure I can do better...
+      runScript scriptOptions scriptOptions
+
+-- Main script : use a lexer on stdin
+runLexer :: Options -> IO ()
+runLexer opt = do
+                 let files = txtFiles opt
+                 wds <- if not $ null $ txtFiles opt
+                         then do cs <- mapM readFile $ txtFiles opt
+                                 return $ concatMap lines cs
+                         else getContents >>= return . lines
+                 return ()
+
+mkLexer :: Options -> IO ()
+mkLexer opt = undefined
+
+-- Options declaration
+options :: [OptDescr (Options -> Options)]
+options = [ 
+     Option ['V'] ["version"] (NoArg showVersion)           
+                  "show version number"
+   , Option []    ["mklexer"] (NoArg setMkLexer) 
+                  "build a lexer from a lexicon"
+   ]
+
+-- Option parsing machinery
+
+-- Options type
+-- the main function is in the options so we can switch it according to the option given (ex: the --version option)
+data Options = Options {
+     runScript :: Options -> IO ()
+   , lexerPath :: String
+   , txtFiles  :: [String]
+   }
+
+-- Options helpers
+showVersion :: Options -> Options
+showVersion o = o { runScript = \_ -> do
+     putStrLn $ "gfdoc : GF documentation tool version " ++ "???"--_VERSION
+     exitWith ExitSuccess
+   }
+
+setMkLexer :: Options -> Options
+setMkLexer o = o { runScript = mkLexer }
+
+-- Utilities
+-- this compose a list of function together
+compose :: [a -> a] -> a -> a
+compose fs v = foldl (flip (.)) id fs $ v
+
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/Toktok.hs b/Toktok.hs
new file mode 100644
--- /dev/null
+++ b/Toktok.hs
@@ -0,0 +1,8 @@
+module Toktok 
+   ( Lexer
+   , mkLexer
+   , mkLexerWithSandhis
+   ) where
+
+
+import Toktok.Lexer (Lexer, mkLexer, mkLexerWithSandhis)
diff --git a/Toktok/Lattice.hs b/Toktok/Lattice.hs
new file mode 100644
--- /dev/null
+++ b/Toktok/Lattice.hs
@@ -0,0 +1,10 @@
+module Toktok.Lattice where
+
+import Control.Monad (liftM)
+
+type Lattice a = [[a]]
+
+-- lattice building
+--- constructor
+(<:) :: a -> Lattice a  -> Lattice a
+s <: l = liftM (s:) l
diff --git a/Toktok/Lexer.hs b/Toktok/Lexer.hs
new file mode 100644
--- /dev/null
+++ b/Toktok/Lexer.hs
@@ -0,0 +1,14 @@
+module Toktok.Lexer where
+
+import Toktok.Trie
+import Toktok.Transducer
+import Toktok.Sandhi
+
+type Lexer = String -> [[String]]
+
+mkLexer :: [String] -> Lexer
+mkLexer = apply . fromList
+
+mkLexerWithSandhis :: [Sandhi] -> [String] -> Lexer
+mkLexerWithSandhis sandhis strings 
+   = applyTransducer $ flip mkTransducer sandhis $ mkTrie strings
diff --git a/Toktok/Sandhi.hs b/Toktok/Sandhi.hs
new file mode 100644
--- /dev/null
+++ b/Toktok/Sandhi.hs
@@ -0,0 +1,7 @@
+module Toktok.Sandhi where
+
+
+data Sandhi = Sandhi String String String
+
+mkSandhi :: String -> String -> String -> Sandhi
+mkSandhi u v w = Sandhi (reverse u) v w
diff --git a/Toktok/Stack.hs b/Toktok/Stack.hs
new file mode 100644
--- /dev/null
+++ b/Toktok/Stack.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE TypeSynonymInstances #-}
+module Toktok.Stack where
+
+import Data.Monoid
+
+newtype Stack a = Stack [[a]]
+   deriving (Show, Eq)
+
+merge :: Stack a -> Stack a -> Stack a
+merge (Stack a) (Stack b) = Stack $ merge' a b
+   where merge' [] b = b
+         merge' a [] = a
+         merge' (l:ls) (l':ls') 
+            = (l ++ l'):merge' ls ls'
+
+singleton :: Int -> a -> Stack a
+singleton n a = Stack $ singleton' n a
+   where singleton' n x | n <= 0 = error "index should be > 0"
+         singleton' n x | n == 1 =  [[x]]
+         singleton' n x = []:singleton' (n-1) x
+
+instance Monoid (Stack a) where
+   mempty = Stack []
+   mappend = merge
+
+
+head :: Stack a -> [a]
+head (Stack []) = []
+head (Stack (l:_)) = l
+
+pop:: Stack a -> Stack a
+pop (Stack []) = Stack []
+pop (Stack (_:ls)) = Stack ls
+
+emptyStack :: Stack a
+emptyStack = Stack []
diff --git a/Toktok/Transducer.hs b/Toktok/Transducer.hs
new file mode 100644
--- /dev/null
+++ b/Toktok/Transducer.hs
@@ -0,0 +1,87 @@
+-- | This is the module defining the transducer.
+-- a transducer is build from a Trie with added sandhis.
+module Toktok.Transducer where
+
+import Data.Map (Map)
+import Data.Monoid
+import qualified Data.Map as Map
+import Data.List(isPrefixOf)
+import Data.Char(isUpper, toLower)
+
+import Toktok.Lattice ((<:), Lattice)
+import Toktok.Sandhi 
+import Toktok.Stack
+import Toktok.Trie
+import qualified Toktok.Stack as Stack
+
+data Transducer 
+   = Trans Bool                  --  Acceptance
+           (Map Char Transducer) -- Deterministic part
+           [Sandhi]              -- Non deterministic part
+
+-- | Build a transducer from a trie and a list of sandhis...
+mkTransducer :: Trie -> [Sandhi] -> Transducer
+mkTransducer t sandhis = case mkTransducer' t sandhis "" of
+                           (t,Stack []) -> t
+                           _      -> error "Non empty stack"
+
+mkTransducer' :: Trie -> [Sandhi] -> String -> (Transducer, Stack Sandhi)
+mkTransducer' (Trie b trieMap) sandhis pref
+   = (Trans b newMap (Stack.head oldStack), newStack)
+   where intermediateMap 
+            = Map.mapWithKey (\ k t -> mkTransducer' t sandhis (k:pref)) trieMap
+         newMap = fmap fst intermediateMap
+         oldStack = mconcat $ map snd $ Map.elems intermediateMap
+         newStack = merge (Stack.pop oldStack) createStack
+         -- Sandhi are applied only if we are at the end of a word
+         goodSandhis = if b 
+                        then filter (\(Sandhi u _ _) -> u `isPrefixOf` pref) sandhis
+                        else []
+         sandhiToStack s@(Sandhi u _ _) = Stack.singleton (length u) s
+         createStack = mconcat $ map sandhiToStack goodSandhis
+
+-- | In this algorithm, we segment the input in the folowing way
+-- input = ¬pref ++ suf 
+-- or input = ¬pref ++ c ++ suf
+-- where pref is the already processed part.
+applyTransducer :: Transducer -> String -> Lattice String
+applyTransducer rootT = apply' rootT []
+   where -- first, if we have consumed all the input
+         apply' (Trans True  _ _) pref [] = [[reverse pref]]
+         apply' (Trans False _ _) pref [] = []
+         -- then, if the state is final
+         apply' (Trans True  trie sandhis) pref suf
+            = (reverse pref <: apply' rootT "" suf)
+           ++ continueWithTrie    trie    pref suf
+           ++ continueWithSandhis sandhis pref suf
+         -- then if the state is not final...
+         apply' (Trans False trie sandhis) pref suf
+            = continueWithTrie    trie    pref suf
+           ++ continueWithSandhis sandhis pref suf
+         -- continue processing using (deterministic) trie
+         continueWithTrie trieMap pref (c:suf)
+            =  case Map.lookup c trieMap of
+                    Nothing -> []
+                    Just t' -> apply' t' (c:pref) suf
+           ++ if isUpper c
+               then case Map.lookup (toLower c) trieMap of
+                         Nothing -> []
+                         Just t' -> apply' t' (toLower c:pref) suf
+               else []
+         -- continue processing using sandhis
+         continueWithSandhis [] _ _ = []      -- processed all sandhis
+         continueWithSandhis sandhis pref suf
+            = concatMap (\ s -> applySandhi s pref suf) sandhis
+         applySandhi (Sandhi u v w) pref suf | w `isPrefixOf` suf
+            = (reverse $ u ++ pref) <: (apply' (access v rootT) (reverse v) suf')
+            where suf' = drop (length w) suf
+
+
+-- | Access a state in a transducter, ignoring sandhis and intermediate
+-- final states.
+access :: String -> Transducer -> Transducer
+access [] t = t
+access (c:cs) (Trans _ map _) 
+   = case Map.lookup c map of
+      Nothing -> undefined
+      Just t' -> access cs t'
diff --git a/Toktok/Trie.hs b/Toktok/Trie.hs
new file mode 100644
--- /dev/null
+++ b/Toktok/Trie.hs
@@ -0,0 +1,45 @@
+module Toktok.Trie where
+
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Char (toLower, toUpper, isUpper)
+
+data Trie = Trie Bool (Map Char Trie)
+
+emptyTrie = Trie False Map.empty 
+
+mkTrie = fromList
+
+fromList :: [String] -> Trie
+fromList [] = emptyTrie
+fromList (w:ws) = addWord w $ fromList ws
+
+addWord :: String -> Trie -> Trie
+addWord []     (Trie _ m) 
+   = Trie True m
+addWord (c:cs) (Trie b m) | Map.member c m
+   = Trie b $ Map.update (return . addWord cs) c m
+addWord (c:cs) (Trie b m) 
+   = Trie b $ Map.insert c (addWord cs emptyTrie) m
+
+apply :: Trie -> String -> [[String]]
+apply trie = apply' trie []
+   where apply' (Trie True _) w [] = [[reverse w]]
+         apply' (Trie False _) w [] = []
+         apply' (Trie True m) w (c:cs) = (apply' trie "" (c:cs) 
+                                          >>= return . (reverse w:))
+                                      ++ apply'' m c cs w
+         apply' (Trie False m) w (c:cs) = apply'' m c cs w
+         apply'' m c cs w = case Map.lookup c m of
+                             Nothing -> []
+                             Just n -> apply' n (c:w) cs
+                         ++ if isUpper c
+                             then case Map.lookup (toLower c) m of
+                                       Nothing -> []
+                                       Just n -> apply' n (toLower c:w) cs
+                             else []
+         
+
+test :: [[String]]
+test = apply t "aabbbc"
+  where t = fromList ["a", "ab", "bb", "c", "b"]
diff --git a/tests/Main.hs b/tests/Main.hs
new file mode 100644
--- /dev/null
+++ b/tests/Main.hs
@@ -0,0 +1,13 @@
+module Main where
+
+import Toktok.Test.Transducer (transducersTests)
+import Toktok.Test.Stack
+
+import Test.HUnit
+import Test.QuickCheck
+
+main = do
+       runTestTT tests
+       runTestTT stackTests
+
+tests = transducersTests
diff --git a/toktok.cabal b/toktok.cabal
new file mode 100644
--- /dev/null
+++ b/toktok.cabal
@@ -0,0 +1,69 @@
+Name:                toktok
+Version:             0.5
+Description:         An ambiguous tokenizer for GF
+Category:            Natural Language Processing
+License:             GPL
+License-file:        LICENSE
+Author:              Grégoire Détrez <gdetrez@crans.org>
+Maintainer:          Grégoire Détrez <gdetrez@crans.org>
+Build-Type:          Simple
+Cabal-Version:       >=1.2
+
+flag benchmark
+  Description: Build the benchmarking binary
+  Default:     False
+
+flag test
+  Description: Build the tests
+  Default:     False
+
+Executable toktok-benchmark
+  Main-is: Benchmark.hs
+  if !flag(benchmark)
+    buildable: False
+  Build-Depends:
+    criterion,
+    progression,
+    filepath
+  ghc-options: -O2
+
+Executable toktok-test
+  Main-is: tests/Main.hs
+  Hs-source-dirs: ., tests
+  if !flag(test)
+    buildable: False
+  Build-Depends:
+    QuickCheck >= 2,
+    HUnit
+  ghc-options: -O2
+
+Executable toktok
+  Main-is:           Main.hs
+  Build-Depends:     
+    base >= 4.1 && < 5,
+    bytestring,
+    gf,
+    iconv
+  ghc-options: -O2
+
+Executable gf-extract-lexicon
+  Main-is:           ExtractLexicon.hs
+  Hs-Source-Dirs:    tools
+  Build-Depends:     base >= 4.1 && < 5
+  ghc-options: -O2
+
+library
+  build-depends: 
+    base >= 4.1 && < 5,
+    containers,
+    haskell98
+  exposed-modules: 
+    Toktok
+  other-modules:
+    Toktok.Lattice
+    Toktok.Lexer
+    Toktok.Sandhi
+    Toktok.Stack
+    Toktok.Transducer
+    Toktok.Trie
+  ghc-options: -O2
diff --git a/tools/ExtractLexicon.hs b/tools/ExtractLexicon.hs
new file mode 100644
--- /dev/null
+++ b/tools/ExtractLexicon.hs
@@ -0,0 +1,30 @@
+module Main where
+
+import System (getArgs, getProgName)
+import IO
+import PGF (readPGF, readLanguage, getLexicon)
+import Data.ByteString.Lazy.Char8 (pack, unpack)
+import Codec.Text.IConv (convert)
+--import System.Console.GetOpt
+
+-- this is the main module to extract lexicon from a GF grammar.
+-- the arguments are : grammar file, concrete syntax name.
+
+main :: IO ()
+main = do
+       args <- getArgs
+       case args of 
+        [gram, lang] -> do
+                        g <- readPGF gram
+                        let Just l = readLanguage lang
+                        putStrLn $ unlines $ map toUTF8 $ getLexicon g l
+                        
+        _ -> usage
+
+usage :: IO ()
+usage = do
+        name <- getProgName
+        hPutStrLn stderr $ "usage: " ++ name ++ " grammar.pgf LangName"
+
+toUTF8 :: String -> String
+toUTF8 = unpack . convert "LATIN1" "UTF-8" . pack