diff --git a/.gitignore b/.gitignore
index 4667c9e46ba885833316fdeca82e984ce2df27f6..110336e98d8aacf83e0a452fe4ca83d2bfafa88c 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,3 +1,7 @@
 *.o
 *.hi
-Extractor
+digger
+.stack-work
+dist
+src/highlight.js
+src/style.css
diff --git a/Makefile b/Makefile
index a1537c5bbdc80f604fdab19c0c0d2c7ccdc26300..3b471cfbc3f4900997020f3e140342280180c8d4 100644
--- a/Makefile
+++ b/Makefile
@@ -1,3 +1,6 @@
+DIGGER := ./digger
+
+# Generic targets, building everything
 default: default_message build_stack
 
 default_message:
@@ -8,15 +11,26 @@ default_message:
 
 build_stack:
 	stack build
-	ln -sf $$(find .stack-work/install/ -name coq2c -type f) coq2c
+	ln -sf $$(stack exec which digger) digger
 
 build_cabal:
 	cabal build
-	ln -sf dist/build/coq2c/coq2c coq2c
+	ln -sf dist/build/digger/digger digger
 
 clean:
 	stack clean || true
 	cabal clean || true
-	rm -rf coq2c .stack-work dist
+	rm -rf digger .stack-work dist
 
 .PHONY: default default_message build_stack build_cabal clean
+
+# Default to stack for precise targets
+digger: app/digger.hs $(wildcard src/Coq/*.hs)
+	stack build digger:exe:digger
+	ln -sf $$(stack exec which digger) digger
+
+# Documentation
+doc:
+	stack haddock
+
+.PHONY: doc
diff --git a/Readme.md b/Readme.md
index 18c607d8858c65ee92bba00a3bc07a8d4fe67ef8..74c2faf51772f10683a2cb7ed7a52cc7aebca3cd 100644
--- a/Readme.md
+++ b/Readme.md
@@ -1,13 +1,16 @@
-#  Summary
+#  Digger
 
-This repository contains a tool to compile Coq code written in an
-imperative style using a monad into the corresponding C code. It
-starts from the Coq code extracted as JSON by the internal extraction
-facility.
+This repository contains a tool to convert Coq code written in a
+“C-style” (imperative style based on a monad, with full application of
+functions) into the corresponding C code or to an intermediate
+representation (deep) output as Coq source code. It starts from the
+Coq code extracted as JSON by the internal extraction facility.
 
-The source code is covered by CeCILL-A licence, see `LICENSE`.
 
-The CoqC Development Team is:
+The source code is copyright Université de Lille 1 & Veïs Oudjail and
+covered by CeCILL-A licence, see `LICENSE`.
 
-* Veis Oudjail <veis.oudjail@etudiant.univ-lille1.fr>
-* Samuel Hym <samuel.hym@univ-lille1.fr>
+The development team is:
+
+*   Samuel Hym
+*   Veïs Oudjail
diff --git a/app/digger.hs b/app/digger.hs
new file mode 100644
index 0000000000000000000000000000000000000000..00936a28c8973e0b2a4b001c841c03d7b938d4ed
--- /dev/null
+++ b/app/digger.hs
@@ -0,0 +1,353 @@
+-- |
+-- Module      :  digger (Main)
+-- Copyright   :  Université Lille 1, Veïs Oudjail, 2016-2017
+-- License     :  CeCILL
+--
+-- Maintainer  :  samuel.hym@univ-lille1.fr
+
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Description :  Convert Coq code written in a "C-style" (imperative
+--                style based on a monad, with full application of
+--                functions) into the corresponding C code or to an
+--                intermediate representation (deep) output as Coq
+--                source code.
+--                Start from the Coq code extracted as JSON by the
+--                internal extraction facility.
+
+-- This software is a computer program whose purpose is to run a minimal,
+-- hypervisor relying on proven properties such as memory isolation.
+
+-- This software is governed by the CeCILL license under French law and
+-- abiding by the rules of distribution of free software.  You can  use,
+-- modify and/ or redistribute the software under the terms of the CeCILL
+-- license as circulated by CEA, CNRS and INRIA at the following URL
+-- "http://www.cecill.info".
+
+-- As a counterpart to the access to the source code and  rights to copy,
+-- modify and redistribute granted by the license, users are provided only
+-- with a limited warranty  and the software's author,  the holder of the
+-- economic rights,  and the successive licensors  have only  limited
+-- liability.
+
+-- In this respect, the user's attention is drawn to the risks associated
+-- with loading,  using,  modifying and/or developing or reproducing the
+-- software by the user in light of its specific status of free software,
+-- that may mean  that it is complicated to manipulate,  and  that  also
+-- therefore means  that it is reserved for developers  and  experienced
+-- professionals having in-depth computer knowledge. Users are therefore
+-- encouraged to load and test the software's suitability as regards their
+-- requirements in conditions enabling the security of their systems and/or
+-- data to be ensured and,  more generally, to use and operate it in the
+-- same conditions as regards security.
+
+-- The fact that you are presently reading this means that you have had
+-- knowledge of the CeCILL license and that you accept its terms.
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+
+module Main where
+
+import           Control.Monad                (when, (<=<))
+import           Data.Aeson                   (eitherDecode')
+import qualified Data.ByteString.Lazy         as BS
+import           Data.Default
+import           Data.List                    (elemIndex, intercalate)
+import qualified Data.Map                     as Map
+import           Data.Monoid                  ((<>))
+import           Data.Text.Lazy               (Text, pack, unpack)
+import qualified Data.Text.Lazy               as T
+import qualified Data.Text.Lazy.IO            as TIO
+import           Data.Version                 (showVersion)
+import qualified Language.C                   as C
+import           Options.Applicative          hiding (empty)
+import           System.Environment           (getProgName)
+import           System.Exit                  (exitFailure)
+import           System.IO                    (IOMode (WriteMode), hPutStr,
+                                               hPutStrLn, stderr, stdout,
+                                               withFile)
+import qualified Text.PrettyPrint             as PP
+import qualified Text.PrettyPrint.Leijen.Text as WL
+import           Text.Read                    (readMaybe)
+
+import           Language.Coq.Deep
+import           Language.Coq.ExtractedAST
+
+import           Paths_digger (version)
+
+
+-- | Cleanup options to activate before conversion
+data Cleaning = Cleaning { modulesToDrop  :: [ModuleUsed]
+                         , nameRewrites   :: [(String,String)]
+                         , dotReplacement :: String
+                         }
+    deriving (Show,Eq)
+
+instance Default Cleaning where
+    def = Cleaning { modulesToDrop  = ["Datatypes"]
+                   , nameRewrites   = [ ("Coq_true",  "true")
+                                      , ("Coq_false", "false")
+                                      , ("Coq_tt",    "tt") ]
+                   , dotReplacement = "_"
+                   }
+
+-- | Parse a command-line argument containing a pair of strings
+-- separated with a colon
+colonSeparatedPair :: ReadM (String,String)
+colonSeparatedPair = eitherReader go
+    where go cs = case ':' `elemIndex` cs of
+                    Just i  -> Right (take i cs, drop (i+1) cs)
+                    Nothing -> Left "Expected a colon-separated argument \"before:after\""
+
+-- | Parse command-line options for the 'Cleaning' step
+optsCleaning :: Parser Cleaning
+optsCleaning = Cleaning <$> optModulesToDrop <*> optRewrites <*> optDotReplacement
+    where optModulesToDrop = some (strOption $ short 'm' <> long "drop-module" <> metavar "<module>"
+                                            <> help ( "module to drop from fully-qualified identifiers in source "
+                                                   ++ "(default, if no '-m' is given: "
+                                                   ++ intercalate ", " (modulesToDrop def) ++ "); "
+                                                   ++ "this option can be used multiple times" ))
+                             <|> pure (modulesToDrop def)
+          optRewrites = some (option colonSeparatedPair $
+                                     short 'r' <> long "rename" <> metavar "<before>:<after>"
+                                     <> help ( "identifiers to rename (performed after dropping modules from "
+                                            ++ "fully-qualified names) "
+                                            ++ "(default, if no '-r' is given: "
+                                            ++ intercalate ", " (map (\(a,b) -> a ++ ":" ++ b) $ nameRewrites def) ++ ")" ))
+                        <|> pure (nameRewrites def)
+          optDotReplacement = strOption $ short 's' <> long "separator" <> metavar "<char>"
+                                       <> value (dotReplacement def) <> showDefaultWith id
+                                       <> help "separator to use in qualified names instead of dots"
+
+-- | Parse a symbol on command-line
+optSymbol :: Char -> String -> String -> String -> Parser String
+optSymbol s l v h = strOption $ short s <> long l <> metavar "<symb>"
+                           <> value v <> showDefaultWith id <> help h
+
+-- | Parse command-line options for natural numbers
+optsNat :: Parser CoqNat
+optsNat = CN <$> optNatO
+             <*> optNatS
+             <*> optAdd
+    where optNatO = optSymbol 'O' "natO"    (natO  def)  "how Coq's O (zero, type nat) was extracted"
+          optNatS = optSymbol 'S' "natS"    (natS  def)  "how Coq's S (successor, type nat) was extracted"
+          optAdd  = optSymbol 'A' "nat-add" (natAdd def) "how Coq's addition of natural number was extracted"
+
+-- | Parse command-line options for the 'ConversionParams'
+--
+-- TODO: find a way to expose the parameters for unary and binary
+-- operators, or it would not make much sense anyway?
+optsCP :: Parser ConversionParams
+optsCP = CP <$> optMonad
+            <*> optBind
+            <*> optRet
+            <*> optUnit
+            <*> optTt
+            <*> optTrue
+            <*> optFalse
+            <*> optsNat
+            <*> optConsts
+
+            <*> optIgnores
+
+            <*> optPrefixConst
+            <*> optPrefixFun
+            <*> optPrefixFTyp
+            <*> optPrefixVTyp
+
+            <*> optRecBound
+            <*> pure (unaryOps def)
+            <*> pure (binaryOps def)
+
+    where optMonad      = optSymbol 'M' "monad" (monad def) "support monad"
+          optBind       = optSymbol 'B' "bind"  (bind  def) "bind function of the monad"
+          optRet        = optSymbol 'R' "ret"   (ret   def) "return function of the monad"
+          optUnit       = optSymbol 'U' "unit"  (unit  def) "how Coq's unit (type) was extracted"
+          optTt         = optSymbol 't' "tt"    (tt    def) "how Coq's tt (unit value) was extracted"
+          optTrue       = optSymbol 'T' "true"  (true  def) "how Coq's true was extracted"
+          optFalse      = optSymbol 'F' "false" (false def) "how Coq's false was extracted"
+          optRecBound   = optSymbol 'v' "bound-var" (recBoundName def)
+                                                            "name of the C variable used to bound recursive calls"
+
+          optConsts     = some (strOption $ short 'c' <> long "const" <> metavar "<const>"
+                                         <> help ( "constructor to accept and re-export as is "
+                                                ++ "(default, if no '-c' is given: "
+                                                ++ intercalate ", " (consts def) ++ ")" ))
+                          <|> pure (consts def)
+
+          optIgnores    = many $ strOption $ long "ignore" <> metavar "<symb>"
+                                          <> help "symbol to ignore (do not try to convert it)"
+
+          optPrefixConst = optPref "prefix-const" (prefixConst def) "prefix for exported constructor names"
+          optPrefixFun   = optPref "prefix-fun"   (prefixFun def)   "prefix for exported function names"
+          optPrefixFTyp  = optPref "prefix-ftyp"  (prefixFTyp def)  "prefix for exported function types"
+          optPrefixVTyp  = optPref "prefix-vtyp"  (prefixVTyp def)  "prefix for exported value types"
+
+          optPref l v h = option textR $ long l <> metavar "<pref>"
+                                      <> value v <> showDefaultWith unpack <> help h
+          textR :: ReadM Text
+          textR = eitherReader (Right . pack)
+
+-- | All command-line options
+data CLiOptions = CLO { cleaning         :: Cleaning
+                      , conversionParams :: ConversionParams
+                      , deepOnly         :: Bool
+                      -- | Whether we should output a .h or a .c
+                      , headerOnly       :: Bool
+                      , inputFile        :: FilePath
+                      , outputFile       :: Maybe FilePath
+                      -- | List of (prefix,Json file)
+                      , dependencies     :: [(String,FilePath)]
+                      , headerFile       :: Maybe FilePath
+                        -- | #include or Require Import
+                      , includes         :: [String]
+                      , includesQuote    :: [String]
+                        -- | Initial content of RecursiveBoundMap
+                      , initRecBounds    :: [(FunName, RecursiveBoundId)]
+                      }
+    deriving (Show,Eq)
+
+versionHelper :: String -> Parser (a -> a)
+versionHelper progname = abortOption (InfoMsg (progname ++ " " ++ showVersion version)) $ mconcat
+  [ long "version"
+  , short 'v'
+  , help "Show the version of the program"
+  , hidden ]
+
+-- | Command-line options
+-- Take the name of the program as argument
+options :: String -> ParserInfo CLiOptions
+options pn = info (helper <*> versionHelper pn <*> cliopts) (fullDesc <> progDesc longDesc <> header shortDesc)
+    where longDesc = unwords
+              [ "Convert Coq code written in a \"C-style\" (imperative style"
+              , "based on a monad, with full application of functions) into"
+              , "the corresponding C code or to an intermediate representation (deep)"
+              , "output as Coq source code."
+              , "Start from the Coq code extracted as JSON by the internal extraction facility." ]
+          shortDesc = pn ++ " " ++ showVersion version
+                         ++ " - convert \"C-style\" Coq code into C code or an intermediate "
+                         ++ "representation in Coq"
+
+          cliopts = CLO <$> optsCleaning
+                        <*> optsCP
+                        <*> deepOnlyOpt
+                        <*> headerOnlyOpt
+                        <*> inputOpt
+                        <*> outputOpt
+                        <*> dependenciesOpt
+                        <*> headerOpt
+                        <*> includesOpt
+                        <*> includesQuoteOpt
+                        <*> recBoundsOpt
+
+          deepOnlyOpt = switch $ long "deep"
+                              <> help "stop conversion at the Deep intermediate language"
+
+          headerOnlyOpt = switch $ long "header"
+                                <> help "produce a .h file instead of a .c file"
+
+          inputOpt = strArgument $ metavar "<file.json>"
+                       <> help "input file to convert (produced by Coq JSON extractor)"
+
+          outputOpt = optional $ strOption $ short 'o' <> metavar "<file>"
+                       <> help "output result in <file> (default: stdout)"
+
+          dependenciesOpt = many $ option colonSeparatedPair $
+                               short 'd' <> long "dependency" <> metavar "<namespace>:<file.json>"
+                            <> help ( "add to the initial symbol table and to the initial set of "
+                                   ++ "recursive functions the content of the given module "
+                                   ++ "(produced by Coq JSON extractor) into the given namespace" )
+
+          headerOpt = optional $ strOption $ short 'H' <> metavar "<file>"
+                       <> help "add the content of this file as header of the output"
+
+          includesOpt = many $ strOption $ short 'i' <> long "include" <> metavar "<module>"
+                        <> help "output a #include <...> (or \"Require Import\") for the <module>"
+          includesQuoteOpt = many $ strOption $ short 'q' <> long "include-quote" <> metavar "<module>"
+                           <> help "output a #include \"...\" (or \"Require Import\") for the <module>"
+
+          recBoundsOpt = many $ option (eitherReader colonNat) $
+                            short 'b' <> long "recursive-bound" <> metavar "<fun>:<n>"
+                            <> help ( "assume <fun> is a recursive function and that its <n>-th argument "
+                                   ++ "(0-indexed) is the bound on the number of recursive calls" )
+
+          colonNat :: String -> Either String (FunName, RecursiveBoundId)
+          colonNat cs = case ':' `elemIndex` cs of
+                          Nothing -> Right (cs, 0)
+                          Just i  -> case readMaybe (drop (i+1) cs) of
+                                       Just n | n >= 0 -> Right (take i cs, n)
+                                       _               -> Left msg
+              where msg = "Expected a colon-separated argument \"function:n\" (with n positive)"
+                        ++ " or just a function name"
+
+cleanAST :: Cleaning -> Module -> Module
+cleanAST Cleaning{..} = cleanModule modulesToDrop rewrts dotReplacement
+    where rewrts = Map.fromList nameRewrites
+
+renderRequires :: [String] -> [String] -> Text
+renderRequires xs ys = T.unlines $ map renderRequire $ xs ++ ys
+    where renderRequire i = T.concat ["Require Import ", T.pack i, "."]
+
+renderIncludes :: [String] -> [String] -> Text
+renderIncludes is qs = T.unlines $ map renderInclude is ++ map renderQuote qs
+    where renderInclude i = T.concat ["#include <",  T.pack i, ">" ]
+          renderQuote   i = T.concat ["#include \"", T.pack i, "\""]
+
+readModule :: FilePath -> IO (Either String Module)
+readModule = fmap eitherDecode' . BS.readFile
+
+traverse2 :: (Applicative f, Applicative g, Traversable t) => (a -> f (g b)) -> t a -> f (g (t b))
+traverse2 f = fmap sequenceA . traverse f
+
+traverse2x2 :: (Applicative f, Applicative g, Traversable t, Traversable u) =>
+               (a -> f (g b)) -> t (u a) -> f (g (t (u b)))
+traverse2x2 f = traverse2 (traverse2 f)
+
+zipEither :: Either a b -> Either a c -> Either [a] (b,c)
+zipEither (Right x) (Right y) = Right (x,y)
+zipEither (Left  x) (Right _) = Left [x]
+zipEither (Right _) (Left  y) = Left [y]
+zipEither (Left  x) (Left  y) = Left [x,y]
+
+infoDependency :: ConversionParams -> Cleaning -> (String, Module) -> (SymbolTable, RecursiveBoundMap)
+infoDependency cp cleanOpts (prefix, modul) = (go syms, go recs)
+    where modul' = cleanAST cleanOpts modul
+          syms   = extractSymbolTable cp $ declarationsMod modul'
+          recs   = detectBounds (nats cp) modul'
+          go     = Map.mapKeys (prefix ++)
+
+main :: IO ()
+main = do progname <- getProgName
+          CLO{..}  <- execParser (options progname)
+          input    <- readModule inputFile
+          deps     <- traverse2x2 readModule dependencies
+
+          case zipEither input deps of
+            Right (input', deps') -> do
+              let (symss, recss) = unzip $ map (infoDependency conversionParams cleaning) deps'
+                  recs           = Map.unions (Map.fromList initRecBounds : recss)
+                  syms           = Map.unions symss
+                  deepMod        = fromCoq conversionParams recs syms $ cleanAST cleaning input'
+
+              maybe ($ stdout) (`withFile` WriteMode) outputFile $ \out -> do
+                let putText    = TIO.hPutStrLn out
+                    putWL      = WL.displayIO out . WL.renderPretty 0.8 110
+                    putPP      = hPutStr out . PP.render
+
+                -- Header
+                let renderIncs = if deepOnly then renderRequires else renderIncludes
+                mapM_ (putText <=< TIO.readFile) headerFile
+                putText $ renderIncs includes includesQuote
+
+                -- Body
+                if deepOnly
+                  then putWL $ prettyModule conversionParams deepMod
+                  else do let (errs, src) = convert conversionParams deepMod
+                              convert     = if headerOnly then toCHeader else toCSource
+                          mapM_ (hPutStrLn stderr) errs
+                          putPP (C.pretty src)
+                          when (not $ null errs) exitFailure
+
+            Left errs -> mapM_ (hPutStrLn stderr) errs >> exitFailure
diff --git a/coq2c.cabal b/coq2c.cabal
deleted file mode 100644
index ace74d24ce90688020943d269ac6ae8e3e86277c..0000000000000000000000000000000000000000
--- a/coq2c.cabal
+++ /dev/null
@@ -1,33 +0,0 @@
-name:                coq2c
-version:             0.1.0.0
-synopsis:            compile some monadic Coq code into C code
-description:         Compile Coq code written in an imperative style
-                     using a monad into the corresponding C code.
-                     Start from the Coq code extracted as JSON by the
-                     internal extraction facility.
-
-license:             OtherLicense
-license-file:        LICENSE
-
-author:              Veïs Oudjail <veis.oudjail@gmail.com>
-maintainer:          Samuel Hym <samuel.hym+bugs@rustyne.lautre.net>
-copyright:           Université Lille 1, Veïs Oudjail
-
-category:            Language
-
-build-type:          Simple
-
-extra-source-files:  Readme.md
-
-cabal-version:       >=1.10
-
-executable coq2c
-  main-is:             coq2c.hs
-  other-extensions:    OverloadedStrings
-  build-depends:       base >=4.7 && <4.9,
-                       aeson >=0.11 && <0.12,
-                       split >=0.2 && <0.3,
-                       optparse-applicative >=0.12 && <0.13,
-                       regex-posix >=0.95 && <0.96,
-                       bytestring >=0.10 && <0.11
-  default-language:    Haskell2010
diff --git a/coq2c.hs b/coq2c.hs
deleted file mode 100644
index f25dcd81273ef4d3c28fe33d3f1ed3175625f8b3..0000000000000000000000000000000000000000
--- a/coq2c.hs
+++ /dev/null
@@ -1,1367 +0,0 @@
--- |
--- Module      :  Extractor (Main)
--- Copyright   :  Veïs Oudjail 2016
--- License     :  CeCILL
---
--- Maintainer  :  veis.oudjail@gmail.com
---                samuel.hym+bugs@rustyne.lautre.net
-
--- Stability   :  experimental
--- Portability :  multi plateform
---
--- Description : Compiler Coq (AST JSON) -> subset C
---
-
--- This software is a computer program whose purpose is to run a minimal,
--- hypervisor relying on proven properties such as memory isolation.
-
--- This software is governed by the CeCILL license under French law and
--- abiding by the rules of distribution of free software.  You can  use,
--- modify and/ or redistribute the software under the terms of the CeCILL
--- license as circulated by CEA, CNRS and INRIA at the following URL
--- "http://www.cecill.info".
-
--- As a counterpart to the access to the source code and  rights to copy,
--- modify and redistribute granted by the license, users are provided only
--- with a limited warranty  and the software's author,  the holder of the
--- economic rights,  and the successive licensors  have only  limited
--- liability.
-
--- In this respect, the user's attention is drawn to the risks associated
--- with loading,  using,  modifying and/or developing or reproducing the
--- software by the user in light of its specific status of free software,
--- that may mean  that it is complicated to manipulate,  and  that  also
--- therefore means  that it is reserved for developers  and  experienced
--- professionals having in-depth computer knowledge. Users are therefore
--- encouraged to load and test the software's suitability as regards their
--- requirements in conditions enabling the security of their systems and/or
--- data to be ensured and,  more generally, to use and operate it in the
--- same conditions as regards security.
-
--- The fact that you are presently reading this means that you have had
--- knowledge of the CeCILL license and that you accept its terms.
-
-{-# LANGUAGE OverloadedStrings #-}
-module Main where
-
-import Control.Applicative
-import Control.Monad       (zipWithM, join)
-import Data.Aeson
-import Data.Bool           (bool)
-import Data.Char           (toUpper)
-import Data.List           (intercalate, union, find)
-import Data.List.Split     (splitOn)
-import Data.Maybe          (fromMaybe)
-import Data.Monoid         ((<>))
-import Options.Applicative (strArgument,strOption,short,long,metavar,optional,help)
-import System.Environment  (getProgName)
-import Text.Regex.Posix    ((=~))
-
-import qualified Data.ByteString.Lazy.Char8 as BS
-import qualified Options.Applicative        as OA
-
-concatMapM :: (Functor m, Monad m) => (a -> m [b]) -> [a] -> m [b]
-concatMapM f = fmap concat . mapM f
-
------------ Module ASTCoq -----------------
-
--- Ce type peut-être interprété comme une énumération.
--- Chacun de ses éléments représente une entité de l'arbre syntaxique Coq.
-data WhatT = DeclT DeclT | FixgrpT FixgrpT | TypeT TypeT
-           | ExprT ExprT | CaseT | PatT PatT
-           | ModuleT
-           deriving (Show)
-
-data DeclT   = TermDT | FixgrpDT
-             deriving (Show)
-data FixgrpT = ItemFT
-             deriving (Show)
-data TypeT   = ArrowTT | GlobTT | VaridxTT
-             deriving (Show)
-data ExprT   = LambdaET| ApplyET | GlobalET | ConstructorET | RelET | CaseET | LetET
-             deriving (Show)
-data PatT    = ConstructorPT | WildPT
-             deriving (Show)
-
-
-instance FromJSON WhatT where
-  parseJSON (Object v) = toWhatType <$> v .: "what"
-  parseJSON _          = fail "Error, WhatType : undefined !"
-
-
--- Fonction qui permet de transformer les étiquettes dans le type enuméré
-toWhatType :: String -> WhatT
-toWhatType strType =
-  case strType of
-    "case"             -> CaseT
-    "module"           -> ModuleT
-    "decl:term"        -> DeclT   TermDT
-    "decl:fixgroup"    -> DeclT   FixgrpDT
-    "fixgroup:item"    -> FixgrpT ItemFT
-    "type:arrow"       -> TypeT   ArrowTT
-    "type:glob"        -> TypeT   GlobTT
-    "type:varidx"      -> TypeT   VaridxTT
-    "expr:lambda"      -> ExprT   LambdaET
-    "expr:apply"       -> ExprT   ApplyET
-    "expr:global"      -> ExprT   GlobalET
-    "expr:constructor" -> ExprT   ConstructorET
-    "expr:rel"         -> ExprT   RelET
-    "expr:case"        -> ExprT   CaseET
-    "expr:let"         -> ExprT   LetET
-    "pat:constructor"  -> PatT    ConstructorPT
-    "pat:wild"         -> PatT    WildPT
-    strError           -> error $ "Error WhatType : " ++ strError ++ " format undefined"
-
---------------------------------------------------------------
-data Decl = Term     { nameTerm  :: String
-                     , typeTerm  :: Type
-                     , valueTerm :: Expr
-                     }
-
-          | Fixgroup { fixlistFixgroup :: [Fixgroup]
-                     }
-          deriving (Show)
-
-instance FromJSON Decl where
-  parseJSON (Object v) =
-    do what <- toWhatType <$> v .: "what"
-       case what of
-         DeclT TermDT   ->
-           Term <$>
-           v .: "name"  <*>
-           v .: "type"  <*>
-           v .: "value"
-
-         DeclT FixgrpDT ->
-           Fixgroup <$>
-           v .: "fixlist"
-
-         _                  -> fail "Error, Decl : case undefined !"
-
-  parseJSON _          = fail "Error, Decl : undefined !"
-
-
-data Fixgroup = Item { nameItem  :: String
-                     , typeItem  :: Type
-                     , valueItem :: Expr
-                     }
-              deriving (Show)
-
-instance FromJSON Fixgroup where
-  parseJSON (Object v) =
-    do what <- toWhatType <$> v .: "what"
-       case what of
-         FixgrpT ItemFT ->
-           Item <$>
-           v .: "name"  <*>
-           v .: "type"  <*>
-           v .: "value"
-
-         _              -> fail "Error, Fixgroup : case undefined !"
-
-  parseJSON _          = fail "Error, Fixgroup : undefined !"
-
-
-data Type = Arrow  { leftArrow :: Type
-                   , rightLeft :: Type
-                   }
-
-          | Glob   { nameGlob :: String
-                   , argsGlob :: [Type]
-                   }
-
-          | Varidx { nameVaridx :: Integer
-                   }
-
-          deriving (Show)
-
-instance FromJSON Type where
-  parseJSON (Object v) =
-    do what <- toWhatType <$> v .: "what"
-       case what of
-         TypeT ArrowTT  ->
-           Arrow <$>
-           v .: "left"  <*>
-           v .: "right"
-
-         TypeT GlobTT   ->
-           Glob <$>
-           v .: "name"  <*>
-           v .: "args"
-
-         TypeT VaridxTT ->
-           Varidx <$>
-           v .: "name"
-
-         _              -> fail "Error, Type : case undefined !"
-
-  parseJSON _          = fail "Error, Type : undefined !"
-
-data Expr = Lambda       { argnamesLambda :: [String]
-                         , bodyLambda     :: Expr
-                         }
-
-          | Apply        { funcApply :: Expr
-                         , argsApply :: [Expr]
-                         }
-
-          | Global       { nameGlobal :: String
-                         }
-
-          | ConstructorE { nameConstructorE :: String
-                         , argsConstructorE :: [Expr]
-                         }
-
-          | Rel          { nameRel :: String
-                         }
-
-          | Case         { exprCase  :: Expr
-                         , casesCase :: [Case]
-                         }
-          | Let          { nameLet    :: String
-                         , namevalLet :: Expr
-                         , bodyLet    :: Expr
-                         }
-          deriving (Show)
-
-instance FromJSON Expr where
-  parseJSON (Object v) =
-    do what <- toWhatType <$> v .: "what"
-       case what of
-         ExprT LambdaET      ->
-           Lambda <$>
-           v .: "argnames"  <*>
-           v .: "body"
-
-         ExprT ApplyET       ->
-           Apply <$>
-           v .: "func"  <*>
-           v .: "args"
-
-         ExprT GlobalET      ->
-           Global <$>
-           v .: "name"
-
-         ExprT ConstructorET ->
-           ConstructorE <$>
-           v .: "name"  <*>
-           v .: "args"
-
-         ExprT RelET         ->
-           Rel <$>
-           v .: "name"
-
-         ExprT CaseET        ->
-           Case <$>
-           v .: "expr"  <*>
-           v .: "cases"
-
-         ExprT LetET         ->
-           Let <$>
-           v .: "name"    <*>
-           v .: "nameval" <*>
-           v .: "body"
-
-         _                   -> fail "Error, Expr : case undefined !"
-
-
-  parseJSON _          = fail "Error, Expr : undefined !"
-
-data Case = C { patC  :: Pat
-              , bodyC :: Expr
-              }
-            deriving (Show)
-
-instance FromJSON Case where
-  parseJSON (Object v) =
-    do what <- toWhatType <$> v .: "what"
-       case what of
-         CaseT ->
-           C <$>
-           v .: "pat"  <*>
-           v .: "body"
-
-         _     -> fail "Error, Case : case undefined !"
-
-  parseJSON _          = fail "Error, Case : undefined !"
-
-data Pat = ConstructorP { nameConstructorP     :: String
-                        , argnamesConstructorP :: [String]
-                        }
-         | WildP
-           deriving (Show)
-
-instance FromJSON Pat where
-  parseJSON (Object v) =
-    do what <- toWhatType <$> v .: "what"
-       case what of
-         PatT ConstructorPT ->
-           ConstructorP <$>
-           v .: "name"  <*>
-           v .: "argnames"
-         PatT WildPT        -> return WildP
-
-         _                  -> fail "Error, Pat : case undefined !"
-
-  parseJSON _          = fail "Error, Pat : undefined !"
-
-data Module = Mod { nameMod         :: String
-                  , needMagicMod    :: Bool
-                  , needDummyMod    :: Bool
-                  , usedModulesMod  :: [ModuleUsed]
-                  , declarationsMod :: [Decl]
-                  }
-              deriving (Show)
-type ModuleUsed = String
-type FileName   = String
-
-instance FromJSON Module where
-  parseJSON (Object v) =
-    do what <- toWhatType <$> v .: "what"
-       case what of
-         ModuleT ->
-           Mod <$>
-           v .: "name"         <*>
-           v .: "need_magic"   <*>
-           v .: "need_dummy"   <*>
-           v .: "used_modules" <*>
-           v .: "declarations"
-
-         _       -> fail "Error, Module : case undefined !"
-
-  parseJSON _          = fail "Error, Module : undefined !"
-
-
-data ASTCoq = ModuleAST Module
-            | TypeAST Type
-            | ExprAST Expr
-            | CaseAST Case
-            | DeclAST Decl
-            | FixgroupAST Fixgroup
-            | PatAST Pat
-
-
---------------------- Monad MyEither  -----------------------------------
--- Définition du type Monadique, représente le resultat de transformation.
--- Cela marche comme la monade Maybe. La différence vient du fait que lorsque l'on echoue
--- on peut l'associé à un message d'erreur.
--- Pour ce faire on definie un nouveau type, qui est un wrapper sur le type Either
-newtype MyEither a = MyEith (Either String a)
-  deriving (Show)
-
-instance Functor MyEither where
-  fmap f (MyEith me) = case me of
-      Left l  -> MyEith $ Left l
-      Right r -> MyEith $ Right (f r)
-
-instance Applicative MyEither where
-  pure  = MyEith . Right
-  (MyEith f) <*> (MyEith (Right r)) = case f of
-    Left l -> MyEith $ Left l
-    Right f' -> MyEith $ Right (f' r)
-  _ <*> (MyEith (Left l))           = MyEith $ Left l
-
-instance Monad MyEither where
-  return = pure
-  fail = MyEith . Left
-  (MyEith me) >>= f = case me of
-    Left l  -> MyEith $ Left l
-    Right r -> f r
-
--- Fonction qui permet de transformer une monade Maybe en une monade MyEither
--- @param strErr : Représente le message d'erreur, si la monade est dans un etat d'echec
--- @param maybe  : Représente la monade Maybe qui sera convertit
--- @return : On retourne une entité MyEither construite à partir des param fixé
-toMyEith :: String -> Maybe a -> MyEither a
-toMyEith strErr Nothing  = fail strErr
-toMyEith _      (Just x) = return x
-
--- Même principe que pour la fonction toMyEith, à la différence que le message d'erreur n'est pas renseigné
-toMyEith' :: Maybe a -> MyEither a
-toMyEith' = toMyEith ""
-
--- Getteur, permet d'extraire du type MyEither l'objet de type either
-myEither :: MyEither a -> Either String a
-myEither (MyEith x) = x
-
--- Cette fonction permet d'ajouter un message d'erreur si le contexte générale est dans un etat d'echec
--- @param trace : Message d'erreur à ajouter
--- @param myEith : Représente le contexte, si l'etat est dans un mode echec, on ajoute un message d'erreur
--- @return : Retourne le contexte, avec potentiellement l'ajout d'un nouveau message
-addTraceMyEith :: String -> MyEither b -> MyEither b
-addTraceMyEith trace (MyEith (Left x)) = fail $ trace ++ "\n" ++ x
-addTraceMyEith _  x                    = x
-
--- Cet opérateur permet de combiner different contexte. La combinaison ce fait comme un 'ou'.
--- Si le contexte de gauche echoue, on renvoie le contexte de droite, et inversemement.
-infixr 2 |||
-(|||) :: MyEither a -> MyEither a -> MyEither a
-(MyEith (Left err)) ||| y = addTraceMyEith err y
-x ||| _       = x
-
-------------------- Module ASTC -----------------------------------------
--- Définition des différente entité correspondant à l'arbre syntaxique du sous-ensemble C
-data FunctionC = FunctionC { prototypeFun :: PrototypeC
-                           , bodyFun      :: [InstructionC]
-                           }
-               deriving (Show, Eq)
-
-data PrototypeC = PrototypeC { nameProto       :: String
-                             , returnTypeProto :: TypeC
-                             , argsProto       :: [DeclVarC]
-                             }
-                deriving (Show, Eq)
-
-
-data InstructionC = CSC            { cSC :: ControlStructC
-                                   }
-                  | ExprC          { exprC :: ExprC
-                                   }
-
-                  | DeclVarC       { declVarC :: DeclVarC
-                                   }
-
-                  | ReturnC        { returnC :: ExprC
-                                   }
-                  deriving (Show, Eq)
-
-data ControlStructC = Iter   { iterC :: IterativeStructC
-                             }
-
-                    | Cond   { condC :: ConditionalStructC
-                             }
-                    deriving (Show, Eq)
-
-data IterativeStructC = WhileC { conditionWhile :: ExprC
-                               , bodyWhile      :: [InstructionC]
-                               }
-                      deriving (Show, Eq)
-
-data ConditionalStructC = IfThenElseC { conditionIf :: ExprC
-                                      , bodyThen    :: [InstructionC]
-                                      , bodyElse    :: [InstructionC]
-                                      }
-
-                        deriving (Show, Eq)
-
-data ExprC = ApplyFunC   { funApplyFun  :: String
-                         , argsApplyFun :: [ExprC]
-                         }
-           | BinOp       { leftBO      :: ExprC
-                         , symboleBO   :: String
-                         , rightBO     :: ExprC
-                         }
-
-           | VarC        { varC :: VarC
-                         }
-
-           | ValC        { valC :: ValC
-                         }
-           deriving (Show, Eq)
-
-
-data DeclC = VarCDecl     { varCDecl :: DeclVarC
-                          }
-           | FunDecl      { funDecl :: FunctionC
-                          }
-           | ObjectDecl   { objectDecl :: DeclObjectC
-                          }
-           | ProtoDecl    { protoDecl :: PrototypeC
-                          }
-           | CommDecl     { commDecl :: CommentaryC
-                          }
-           deriving (Show, Eq)
-
-
-
-data DeclVarC = VarEmptyDecl { lvalueEDecl :: VarC
-                             }
-              | VarDecl      { lvalueDecl :: VarC
-                             , rvalueDecl :: ExprC
-                             }
-
-              deriving (Show, Eq)
-
-data DeclObjectC = StructDecl { nameStructDecl :: String
-                              , bodyStructDecl :: [DeclVarC]
-                              }
-
-                 | EnumDecl { nameEnumDecl :: String
-                            , bodyEnumDecl :: [String]
-                            }
-                 deriving (Show, Eq)
-
-data ModuleC = ModuleC FileName FileH FileC
-             deriving (Show, Eq)
-
-data FileC = FileC { includeFC :: [IncludeC]
-                   , bodyFC    :: [DeclC]
-                   }
-           deriving (Show, Eq)
-
-type FileH = FileC
-
-data IncludeC = GloIncC String
-              | LocIncC String
-              deriving (Show, Eq, Read)
-
-data TypeC = TypeC String
-           | TypeCFun [TypeC]
-           deriving (Show, Eq)
-
-
-type CommentaryC      = String
-type DataC            = String
-type NameC            = String
-type MacroIncBegin    = String
-type MacroIncEnd      = String
-
-type VarC  = (NameC, TypeC)
-type ValC  = (DataC, TypeC)
-
------------ Definition du type Parser ----------------------
-data ParseError = PE_NOT_IF_THEN_ELSE
-type Parser a b = (a -> MyEither b)
-
-typeVoid :: TypeC
-typeVoid = TypeC "void"
-
-bodyLambdaM :: Expr -> MyEither Expr
-bodyLambdaM (Lambda _ b) = (MyEith . Right) b
-bodyLambdaM _            = fail "bodyLambdaM, fail : "
-
-lvalueOfDeclV :: DeclVarC -> VarC
-lvalueOfDeclV (VarEmptyDecl v) = v
-lvalueOfDeclV (VarDecl v _)    = v
-
-isDeclFun :: DeclC -> Bool
-isDeclFun (FunDecl _) = True
-isDeclFun _           = False
-
-isDeclObjectC :: DeclC -> Bool
-isDeclObjectC (ObjectDecl _) = True
-isDeclObjectC _              = False
-
-isTypeCFun :: TypeC -> Bool
-isTypeCFun (TypeCFun _) = True
-isTypeCFun _            = False
-
-typeRetTypeC :: TypeC -> TypeC
-typeRetTypeC (TypeCFun t) = last t
-typeRetTypeC t@TypeC{}    = t
-
-elmTypeC :: TypeC -> [TypeC]
-elmTypeC (TypeCFun t) = t
-elmTypeC t@TypeC{}    = [t]
-
-prototypeOfDeclC :: [DeclC] -> [PrototypeC]
-prototypeOfDeclC ldecl = map (prototypeFun . funDecl)  lfun
-  where lfun = filter isDeclFun ldecl
-
-objectCOfDeclC :: [DeclC] -> [DeclObjectC]
-objectCOfDeclC ldecl = map objectDecl (filter isDeclObjectC ldecl)
-
-clearPref :: NameCoq -> NameC
-clearPref = last . (splitOn ".")
-
-addDeclCToFileC :: FileC -> [DeclC] -> FileH
-addDeclCToFileC (FileC incC's declC'ss) declC's = FileC incC's (declC's ++ declC'ss)
-
-addDeclCToModCFileH :: ModuleC -> [DeclC] -> ModuleC
-addDeclCToModCFileH (ModuleC n fH fC) declC's = ModuleC n (addDeclCToFileC fH declC's) fC
-------------- Module Env -----------------------------------
--- Ce module permet de definir les structures modélisant l'environnement du traducteur.
--- Definition des synonymes de types utilisés pour définir l'environnement
-type NameCoqType      = String
-type NameCoqFun       = String
-type NameCoqConstruct = String
-type SymbolBinOp      = String
-type NameCFun         = String
-type NameCoq          = String
--------------------------------------------------------------------------------
--- Cette objet represente les differente formes que l'on peux prendre dans l'environnement utilisateur
--- Forme NewTypeEUI :
----- Cela représente ...
-
--- Forme NewFunEUI
----- Cela représente ...
-
--- Forme NewVarEUI
----- Cela représente ...
-
--- Forme OpBinEUI
----- Cela représente ...
-
--- Forme IncludeListEUI
----- Cela représente ...
-
-data EnvUserItem = NewTypeEUI { nameCoqNNEUI :: NameCoq
-                              , pTypeNNEUI   :: EnvG -> Parser (Either Type Expr) TypeC
-                              , pValCNNEUI   :: [(NameCoqConstruct, NameCoq -> EnvG -> Parser Expr ExprC)]
-                              }
-
-                 | NewFunEUI { nameCoqNNEUI :: NameCoq
-                             , nameCNNEUI   :: NameC
-                             , pTypeNNEUI   :: EnvG -> Parser (Either Type Expr) TypeC
-                             , nArgsNNEUI   :: Int
-                             }
-
-                 | NewVarEUI { nameCoqNVEUI :: NameCoq
-                             , newDeclVarC  :: DeclVarC
-                             }
-                 | OpBinEUI   { nameCoqOBEUI :: NameCoq
-                              , nameCOBEUI   :: SymbolBinOp
-                              , pTypeOBEUI   :: EnvG -> Parser (Either Type Expr) TypeC
-                              }
-
-                 | IncludeListEUI { nameModuleEUI  :: ModuleUsed
-                                  , includeListEUI :: [(NameCoq, [IncludeC])]
-                                  }
-
-data EnvArgs = EnvArgs { importOpt  :: [String]
-                       , gloIncOpt  :: [String]
-                       , locIncOpt  :: [String]
-                       , headerOpt  :: Maybe String
-                       , outputOpt  :: Maybe String
-                       , outputHOpt :: Maybe String
-                       , inputOpt   :: String
-                       }
-
-data EnvTypeItem = ETI { idET :: String, funET :: EnvG -> Parser (Either Type Expr) TypeC }
-instance Eq EnvTypeItem where
-  (ETI id' _) == (ETI id'' _) = id' == id''
-
-instance Show EnvTypeItem where
-  show (ETI id' _) = id'
-
-type    EnvVarC       = [DeclVarC]
-type    EnvType       = [EnvTypeItem]
-type    EnvChangeName = [(NameCoqFun, NameCFun)]
-newtype EnvValC       = EVC { evc :: [(NameCoqConstruct, EnvG -> Parser Expr ExprC)]}
-newtype EnvFunApply   = EFA [EnvG -> Parser Expr ExprC]
-type    EnvG          = (EnvVarC, EnvType, EnvValC, EnvFunApply, EnvChangeName)
-type    EnvUser       = [EnvUserItem]
-
-instance Show EnvValC where
-  show (EVC l) = show $ map fst l
-
-----------------------------------------------
-type EnvIncG     = [(String, [IncludeC])]
-type EnvBinOp    = [(NameCoqFun, SymbolBinOp)]
-newtype EnvCondC = EC [EnvG -> ExprC -> Parser Pat ([DeclVarC], Maybe ExprC)]
-----------------------------------------------
-type ExprValC = ExprC
-
-lookupEnvV :: Expr -> EnvG -> MyEither (Parser Expr ExprValC)
-lookupEnvV (ConstructorE k _) env@(_,_,ev,_,_) = toMyEith "lookupEnvV undefined, constructor case" $ lookup (clearPref k) (evc ev) <*> return env
-lookupEnvV _ _                               = fail "lookupEnvV undefined"
-
-lookupEnvT :: String -> EnvG -> MyEither (Parser (Either Type Expr) TypeC)
-lookupEnvT k env@(_,et,_,_,_) = toMyEith ("lookupEnvT undefined, key : " ++ (clearPref k)) $ lookup (clearPref k) $ map (\(ETI k' f )-> (k', f env)) et
-
-lookupEnvVar :: NameCoq -> EnvG -> MyEither TypeC
-lookupEnvVar name (ev,_,_,_,_) = toMyEith "lookupEnvVar undefined" $  lookup (clearPref name) (map lvalueOfDeclV ev)
-
-lookupEnvN :: NameCoq -> EnvG -> MyEither NameC
-lookupEnvN nCoq (_,_,_,_,en) = toMyEith "lookupEnvN undefined" $ lookup (clearPref nCoq) en
-
-lookupEnvBinOp :: NameCoq -> EnvBinOp -> MyEither NameC
-lookupEnvBinOp k envbop = toMyEith "lookupEnvBinOp undefined" $ lookup (clearPref k) envbop
-
-lookupEnvInc :: ModuleUsed -> ModuleUsed -> EnvUser -> MyEither [IncludeC]
-lookupEnvInc mu minc eu =  toMyEith "lookupEnvInc undefined" body
-  where inclL   = filter (\x -> case x of {IncludeListEUI{} -> True; _ -> False}) eu
-        itemInc = find ((mu ==) . nameModuleEUI) inclL
-        body    = do einc <- includeListEUI <$> itemInc
-                     lookup minc einc
-
-lookupEnvIncG :: ModuleUsed -> EnvIncG -> MyEither [IncludeC]
-lookupEnvIncG minc einc =  toMyEith "lookupEnvInc undefined" $ lookup minc einc
-
--- lookupReverseEnvN :: NameC -> EnvG -> MyEither NameCoq
--- lookupReverseEnvN nC (_,_,_,_,en) = toMyEith "lookupReverseEnvN undefined" $ lookup (clearPref nC) $ map (\(a,b) -> (b,a)) en
--- existNameCEnvN :: NameC -> EnvG -> Bool
--- existNameCEnvN nC env = (isRight . myEither) . lookupReverseEnvN nC env
-
-runParserEnvT :: String -> EnvG -> Parser (Either Type Expr) TypeC
-runParserEnvT k env eith = join $ (\f -> f eith) <$> lookupEnvT k env
-
-runParserEnvV :: EnvG -> Parser Expr ExprValC
-runParserEnvV env expr = join $ (\f -> f expr) <$> lookupEnvV expr env
-
-runParserEnvFApply :: EnvG -> Parser Expr ExprC
-runParserEnvFApply env@(_,_,_,EFA efa,_) c = foldr (\f fs -> f env c ||| fs) (fail "runParserEnvFApply undefined") efa
-
-runParserEnvCondC :: EnvG -> EnvCondC -> ExprC -> Parser Pat ([DeclVarC], Maybe ExprC)
-runParserEnvCondC env (EC envc) expr pat = foldr (\f fs -> f env expr pat ||| fs) (fail "runParserEnvCondC undefined") envc
-
-retConstPType :: String -> TypeC -> EnvTypeItem
-retConstPType nameCoq typeC = ETI nameCoq (\_ _ -> return typeC)
-
-retValC :: DataC -> NameCoq -> Expr -> EnvG -> MyEither ExprC
-retValC dataC nC c@(ConstructorE _ args) env = ValC . (,) dataC <$> pCaseIfArgs
-  where pCaseIfArgs = bool (parseExprOfTypeC env c)  -- case False
-                           (parseTypeC env (Glob nC [])) $ null args
-retValC _ _ _ _                              = fail "retValC undefined"
-
-mergeEnvG :: EnvG -> EnvG -> EnvG
-mergeEnvG (ev, et, ec, ef, en) (ev', et', _, _, _) = (ev' `union` ev, et `union` et', ec, ef, en)
-
-addVarsCEnvG :: EnvG -> EnvVarC -> EnvG
-addVarsCEnvG (v, t, ec, ef, en) e = (e ++ v, t, ec, ef, en)
-
-addTypeCEnvT :: EnvG -> EnvType -> EnvG
-addTypeCEnvT (v, t, ec, ef, en) e = (v, t `union` e, ec, ef, en)
-
-envTypeG :: EnvG -> EnvType
-envTypeG (_, envt, _, _, _) = envt
-----------------------
-
-envUser :: EnvUser
-envUser = [ NewTypeEUI "bool"    pBoolC      [("Coq_true", pTrueValC), ("Coq_false", pFalseValC)]
-          , NewTypeEUI "unit"    pVoidC      [("Coq_tt", pVoidValC)]
-          , NewTypeEUI "nat"     pUnsignedC  [("O", pOValC), ("S", pSValC)]
-          , NewTypeEUI "coq_LLI" pLLIOfTypeC []
-          , NewTypeEUI "index"   pUint32C    []
-          , NewTypeEUI "page"    pUintPtrC   []
-          , NewTypeEUI "vaddr"   pUintPtrC   []
-          , NewTypeEUI "level"   pUint32C    []
-          , NewTypeEUI "count"   pUint32C    []
-
-          , OpBinEUI "orb"      "||" pBoolC
-          , OpBinEUI "eqb"      "==" pBoolC
-          , OpBinEUI "andb"     "&&" pBoolC
-          --, OpBinEUI "sub"      "-"  pUnsignedC
-          , OpBinEUI "gtbLevel" ">"  pBoolC
-          , OpBinEUI "gtbIndex" ">"  pBoolC
-          , OpBinEUI "ltbIndex" "<"  pBoolC
-          , OpBinEUI "gebIndex" ">=" pBoolC
-          , OpBinEUI "lebIndex" "<=" pBoolC
-          , OpBinEUI "indexEq"  "==" pBoolC
-          , OpBinEUI "levelEq"  "==" pBoolC
-          , OpBinEUI "gebCount" ">=" pBoolC
-
-
-          --, NewFunEUI "coq_Kidx"          "Kidx"                         pUint32C      0
-          , NewFunEUI "negb"              "!"                            pBoolC        1
-          , NewFunEUI "ret"               ""                             pRetOfTypeC   1
-          , NewFunEUI "i"                 ""                             pIOfTypeC     1
-
-          ----------------------------- Mal --------------------------------------------
-
-          , NewFunEUI "nb_level"          "nb_level"                     pUnsignedC    0
-          , NewFunEUI "table_size"        "table_size"                   pUnsignedC    0
-          , NewFunEUI "fstLevel"          "fstLevel"                     pUint32C      0
-          {-
-          , NewFunEUI "writePhyEntry"     "writePhysicalWithLotsOfFlags" pVoidC        8
-          , NewFunEUI "writeVirEntry"     "writePhysical"                pVoidC        3
-          , NewFunEUI "readPhyEntry"      "readPhysical"                 pUintPtrC     2
-          , NewFunEUI "readVirEntry"      "readPhysical"                 pUintPtrC     2
-          , NewFunEUI "getNbLevel"        "getNbIndex"                   pUint32C      0
-          , NewFunEUI "getIndexOfAddr"    "getIndexOfAddr"               pUint32C      2
-          , NewFunEUI "readPhysical"      "readPhysical"                 pUintPtrC     2
-          , NewFunEUI "writePhysical"     "writePhysical"                pVoidC        3
-          , NewFunEUI "readVirtual"       "readPhysical"                 pUintPtrC     2
-          , NewFunEUI "writeVirtual"      "writePhysical"                pVoidC        3
-          , NewFunEUI "fetchVirtual"      "readVirtual"                  pUintPtrC     2
-          , NewFunEUI "storeVirtual"      "writeVirtual"                 pVoidC        3
-          , NewFunEUI "readIndex"         "readIndex"                    pUint32C      2
-          , NewFunEUI "writeIndex"        "writeIndex"                   pVoidC        3
-          , NewFunEUI "readPresent"       "readPresent"                  pBoolC        2
-          , NewFunEUI "writePresent"      "writePresent"                 pVoidC        3
-          , NewFunEUI "readAccessible"    "readAccessible"               pBoolC        2
-          , NewFunEUI "writeAccessible"   "writeAccessible"              pVoidC        3
-          , NewFunEUI "derivated"         "derivated"                    pBoolC        2
-          , NewFunEUI "writePDflag"       "writePDflag"                  pVoidC        3
-          , NewFunEUI "readPDflag"        "readPDflag"                   pBoolC        2
-          , NewFunEUI "getCurPartition"   "get_current_pd"               pUintPtrC     0
-          , NewFunEUI "defaultPhysical"   "defaultAddr"                  pUintPtrC     0
-          , NewFunEUI "defaultVirtual"    "defaultAddr"                  pUintPtrC     0
-          , NewFunEUI "getMaxIndex"       "getMaxIndex"                  pUint32C      0
-          , NewFunEUI "addressEqualsPhy"  "addressEquals"                pBoolC        2
-          , NewFunEUI "addressEqualsVir"  "addressEquals"                pBoolC        2
-          , NewFunEUI "getIndex"          "toAddr"                       pUint32C      1
-          , NewFunEUI "checkRights"       "checkRights"                  pBoolC        3
-          , NewFunEUI "levelPred"         "sub"                          pUint32C      1
-          , NewFunEUI "levelSucc"         "inc"                          pUint32C      1
-          , NewFunEUI "indexZero"         "indexZero"                    pUint32C      0
-          , NewFunEUI "indexKernel"       "kernelIndex"                  pUint32C      0
-          , NewFunEUI "indexPR"           "kernelIndex"                  pUint32C      0
-          , NewFunEUI "indexPD"           "kernelIndex"                  pUint32C      0
-          , NewFunEUI "indexSh1"          "kernelIndex"                  pUint32C      0
-          , NewFunEUI "indexSh2"          "kernelIndex"                  pUint32C      0
-          , NewFunEUI "indexSh3"          "kernelIndex"                  pUint32C      0
-          , NewFunEUI "indexPRP"          "kernelIndex"                  pUint32C      0
-          , NewFunEUI "indexPred"         "sub"                          pUint32C      1
-          , NewFunEUI "indexSucc"         "inc"                          pUint32C      1
-          , NewFunEUI "levelToCountProd3" "levelToCountProd3"            pUint32C      1
-          , NewFunEUI "countZero"         "indexZero"                    pUint32C      0
-          , NewFunEUI "countSucc"         "inc"                          pUint32C      1 -}
-          ]
-  where pBoolC _     = const $ return (TypeC "uint32_t")
-        pUintPtrC _  = const $ return (TypeC "uintptr_t")
-        pUint32C  _  = const $ return (TypeC "uint32_t")
-        pVoidC _     = const $ return (TypeC "void")
-        pUnsignedC _ = const $ return (TypeC "unsigned")
-        pUndefTypeC _ _ = fail ""
-        pRetOfTypeC env x = case x of
-          Right (Apply _ [arg]) -> parseExprOfTypeC env arg
-          _                     -> fail "pRetOfTypeC undefined"
-        pIOfTypeC env x = case x of
-          Right (Apply _ [arg]) -> parseExprOfTypeC env arg
-          _                     -> fail "pIOfTypeC undefined"
-        pLLIOfTypeC env x = case x of
-          Left (Glob _ [arg]) -> parseTypeC env arg
-          _                   -> fail "pLLIOfTypeC undefined"
------------------------- Parser ValC ----------------------------------------------------
-        pTrueValC nt env c@(ConstructorE _ []) = retValC "1" nt c env
-        pTrueValC _ _ _                        = fail "pTrueValC undefined"
-        pFalseValC nt env c@(ConstructorE _ []) = retValC "0" nt c env
-        pFalseValC _ _ _                        = fail "pFalseValC undefined"
-        pVoidValC nt env c@(ConstructorE _ []) = retValC "" nt c env
-        pVoidValC _ _ _                        = fail "pVoidValC undefined"
-        pOValC nt env c@(ConstructorE _ [])    = retValC "0" nt c env
-        pOValC _ _ _    = fail "pOValC undefined"
-        pSValC nt env (ConstructorE _ [p]) =
-          do res <- parseExprC env p
-             case res of
-               ValC (d, t) -> return $ ValC (show $ 1 + (read d :: Int), t)
-               expr        -> do tC <- parseTypeC env tCoq
-                                 return $ BinOp (ValC ("1", tC)) "+" expr
-             where tCoq = Glob nt []
-        pSValC _ _ _                      = fail "pSValC undefined"
-
-
-envFunApply :: EnvUser ->  EnvFunApply
-envFunApply eu = EFA [ pRet
-                     , pI
-                     , parseOpBinOPC (envBinOp eu)
-                     ]
-  where pRet env (Apply (Global "Hardware.ret") [expr]) = parseExprC env expr
-        pRet _ _                                        = fail "pRet undefined"
-        pI env (Apply (Global "Parameters.i") [expr]) = parseExprC env expr
-        pI _ _                                        = fail "pI undefined"
-
-envChangeName :: EnvUser -> EnvChangeName
-envChangeName = foldr (\x y -> case x of { NewFunEUI nCoq nC _ _ -> [(nCoq, nC)]; _ -> []} ++ y) []
-
-envBinOp :: EnvUser -> EnvBinOp
-envBinOp = foldr (\x y -> case x of { OpBinEUI nCoq symb _ -> [(nCoq, symb)]; _ -> []} ++ y) []
-
-envCondC :: EnvCondC
-envCondC = EC [pPatOExprC, pPatTrueExprC, pPatFalseExprC, pPatSExprC]
-
-envIncG :: ModuleUsed -> EnvUser -> MyEither EnvIncG
-envIncG mu eu = toMyEith "envIncG construct undefined" body
-    where inclL = filter (\x -> case x of {IncludeListEUI{} -> True; _ -> False}) eu
-          body = includeListEUI <$> find ((mu ==) . nameModuleEUI) inclL
-
-envType :: EnvUser -> EnvType
-envType = foldr (\x y -> case x of
-                   NewTypeEUI tCoq tC ev                 -> ETI tCoq tC : foldr (\(tCoq',_) y' -> ETI tCoq' tC : y') [] ev
-                   OpBinEUI nCoq _ tC                    -> [ETI nCoq tC]
-                   NewFunEUI nCoq _ tC n                 -> [ETI nCoq (f n tC)] -- TypeCFun tC
-                   NewVarEUI _ _                         -> []
-                   _                                     -> []
-                   --NewVarEUI nCoq (VarEmptyDecl (_, tC)) -> [retConstPType nCoq tC]
-                   --NewVarEUI nCoq (VarDecl (_, tC) _)    -> [retConstPType nCoq tC]
-                ++ y) []
-    where f :: Int -> (EnvG -> Parser (Either Type Expr) TypeC) -> (EnvG -> Parser (Either Type Expr) TypeC)
-          f n p env e = TypeCFun . (replicate n (TypeC "") ++) . (:[]) <$> p env e
-
-envValC :: EnvUser -> EnvValC
-envValC = EVC . foldr (\x y -> case x of {NewTypeEUI nt _ ev -> map (\(n, f) -> (n, f nt) ) ev; _ -> []} ++ y) []
-
-envVarC :: EnvUser -> EnvVarC
-envVarC _ = []
-
-envArgs :: OA.Parser EnvArgs
-envArgs = EnvArgs <$> imports <*> gloincs <*> locincs <*> header <*> output <*> outputH <*> input
-    where input   = strArgument $  metavar "INPUT.json"
-                                <> help "Coq module (extracted as JSON) to compile into C code"
-          imports = many $ strOption $
-                         short   'm'
-                      <> long    "module"
-                      <> metavar "MODULE.json"
-                      <> help    "load function names and types from the given Coq MODULE (extracted as JSON)"
-          gloincs = many $ strOption $
-                         short   'i'
-                      <> long    "include"
-                      <> metavar "INCL.h"
-                      <> help    "add #include directive for this (global) header file"
-          locincs = many $ strOption $
-                         short   'I'
-                      <> long    "locinclude"
-                      <> metavar "INCL.h"
-                      <> help    "add #include directive for this local header file"
-          header  = optional $ strOption $
-                         long    "header"
-                      <> metavar "FILE"
-                      <> help    "add the content of FILE to the header of the generated C file"
-          output  = optional $ strOption $
-                         short   'o'
-                      <> long    "output"
-                      <> metavar "FILE.c"
-                      <> help    "output extracted C code into FILE.c (defaults to INPUT.c)"
-          outputH = optional $ strOption $
-                         short   'O'
-                      <> long    "output-h"
-                      <> metavar "FILE.h"
-                      <> help    "output extracted C code headers into FILE.h"
-
-envG :: EnvUser -> EnvG
-envG eu = (envVarC eu, envType eu, envValC eu, envFunApply eu, envChangeName eu)
-
-------------------------------------------
-
-parseMacroTypeC :: Parser Type TypeC
-parseMacroTypeC type' = TypeC <$> f type'
-  where f :: Parser Type String
-        f t = case t of
-          Glob n []      -> parseNameC n
-          Glob n (p:ps)  -> do nm <- parseNameC n
-                               p1 <- f p
-                               pn <- concatMapM (\p' -> (", "++) <$> f p') ps
-                               return $ nm ++ "(" ++ p1 ++ pn ++ ")"
-          _              -> fail "parseMacroTypeC undefined"
-
-
-
-parseError :: ParseError -> String
-parseError PE_NOT_IF_THEN_ELSE = "The pattern matching is not possible to parse in the conditionnal struct"
-
-parseOpBinOPC :: EnvBinOp -> EnvG -> Parser Expr ExprC
-parseOpBinOPC envb env (Apply (Global op) args) = if length args /= 2
-                                                  then fail "parseOpBinOPC : Arguments > 2"
-                                                  else do yop <- lookupEnvBinOp op envb
-                                                          le  <- parseExprC env (head args)
-                                                          re  <- parseExprC env (args !! 1)
-                                                          return $ BinOp le yop re
-parseOpBinOPC _ _  _                            = fail "parseOpBinOPC undefined"
-
-
-parseTypeC :: EnvG -> Parser Type TypeC
-parseTypeC env tp = do r <- pType tp
-                       return (if length r == 1
-                               then head r
-                               else TypeCFun r
-                              )
-  where pType :: Parser Type [TypeC]
-        pType t = case t of
-          Varidx{}          -> fail "Exception, error variable type"
-          Glob n _          -> (:[]) <$> (runParserEnvT n env (Left t) ||| parseMacroTypeC t)
-          Arrow l@Arrow{} r -> (:) <$> (TypeCFun <$> pType l) <*> pType r
-          Arrow l r         -> (++) <$> pType l <*> pType r
-
-
-parseNameC :: Parser NameCoq NameC
-parseNameC nameCoq = if nameC == nameCoq'
-                       then return nameC
-                       else fail $ "parseNameC fail, the identifier is not correct : " ++ nameCoq
-  where nameCoq' = clearPref nameCoq
-        pattern' = "[a-zA-Z_](_?[a-zA-Z0-9]+)*" :: String
-        nameC    = (nameCoq' =~ pattern') :: String
-
-
-parseExprOfTypeC :: EnvG -> Parser Expr TypeC
-parseExprOfTypeC env expr = case expr of
-  Rel name               -> lookupEnvVar name env                                 -- Regarde dans l'environnement des variables locales
-  Global name            -> typeRetTypeC <$> runParserEnvT name env (Right expr)  -- Regarde dans l'environnement des types
-  Apply (Global fname) _ -> typeRetTypeC <$> runParserEnvT fname env (Right expr) -- idem
-  Apply (Rel fname) _    -> typeRetTypeC <$> lookupEnvVar fname env               -- idem
-  ConstructorE name _    -> runParserEnvT name env (Right expr)                   -- idem
-  _                      -> fail "parseExprOfTypeC undefined"                     -- Echoue en renvoyant Nothing
-
-parseDeclVarC :: EnvG -> Parser (Either Decl Expr) (EnvG, DeclVarC)
-parseDeclVarC env decl = case decl of
-    Left (Term n t@Glob{} (Lambda _ e@ConstructorE{})) -> do typeV <- parseTypeC env t
-                                                             expr  <- parseExprC env e
-                                                             n'    <- parseNameC n
-                                                             let var = (n', typeV)
-                                                             return ( addTypeCEnvT env [retConstPType n' typeV]
-                                                                    , VarDecl var expr
-                                                                    )
-    Right (Let n expr _)                               -> do rvalue   <- parseExprC env expr
-                                                             lvalType <- parseExprOfTypeC env expr
-                                                             if lvalType == typeVoid
-                                                             then fail "Exception parseDeclVar, the type of rvalue is void"
-                                                             else do n' <- parseNameC n
-                                                                     let var = VarDecl (n', lvalType) rvalue -- Pas de reference sur la variable
-                                                                     return (addVarsCEnvG env [var], var)
-    _                            -> fail $ "parseDeclVarC undefined, decl : "  ++ take debugRender (show decl)
-
-
-parseDeclC :: EnvG -> Parser Decl [DeclC]
-parseDeclC e decl = case decl of
-  Term{}     -> (:[]) . VarCDecl . snd <$> parseDeclVarC e (Left decl) |||
-                (:[]) . FunDecl <$> parseFunctionC e decl
-  Fixgroup{} -> map FunDecl <$> parseFunctionCFX e decl
-
-parseDeclH :: EnvG -> Parser Decl (EnvG, [DeclC])
-parseDeclH e decl = case decl of
-  Term{}     ->  parseDVar ||| parseProtoT
-  Fixgroup{} ->  parseProtoTFX e transf
-  where parseDVar = do (eg,d) <- parseDeclVarC e (Left decl)
-                       let var = VarEmptyDecl (lvalueDecl d)
-                       return (addVarsCEnvG eg [var], [VarCDecl var])
-        parseProtoT   = parsePrototypeC e (Left decl) >>= (\(eg,p) -> return (eg, [ProtoDecl p]))
-        transf        = map Right (fixlistFixgroup decl) :: [Either Decl Fixgroup]
-        parseProtoTFX env d = case d of
-          []   -> return (env, [])
-          x:xs -> do (en1, proto) <- parsePrototypeC env x
-                     let envn1 = addTypeCEnvT env (envTypeG en1)
-                     (en, protos) <- parseProtoTFX envn1 xs
-                     return (addTypeCEnvT envn1 (envTypeG en), ProtoDecl proto:protos)
-
-parseAllDeclC :: EnvG -> Parser [Decl] [DeclC]
-parseAllDeclC e = concatMapM (parseDeclC e)
-
-parseAllDeclH :: EnvG -> Parser [Decl] (EnvG, [DeclC])
-parseAllDeclH env decl = case decl of
-  []   -> return (env, [])
-  d:ds -> do (e1, ds1) <- parseDeclH env d
-             (en, dsn) <- parseAllDeclH env ds
-             return (mergeEnvG e1 en, ds1 ++ dsn)
-
-parsePrototypeC :: EnvG -> Parser (Either Decl Fixgroup) (EnvG, PrototypeC)
-parsePrototypeC env term  =
-  case term of
-    (Left (Term n t v))  -> construct n t v
-    (Right (Item n t v)) -> construct n t v
-    _                    -> fail "parsePrototypeC undefined"
-  where construct n' t' v' = do typeC      <- parseTypeC env t'
-                                argsProto' <- args n' (elmTypeC typeC) v'
-                                name       <- parseNameC n'
-                                let retProto = typeRetTypeC typeC
-                                return ( addTypeCEnvT env [retConstPType name typeC]
-                                       , PrototypeC name retProto argsProto'
-                                       )
-        args n' t (Lambda prm _) = if length t - 1 == length prm
-                                   then mergeParam t prm
-                                   else fail $ "Exception, detection of partiel application (definition) : function " ++ n'
-        args _ _ _               = fail "parsePrototypeC - args, undefined"
-        mergeParam = zipWithM (\a b -> VarEmptyDecl . flip (,) a <$> parseNameC b)
-
-parseFunctionC :: EnvG -> Parser Decl FunctionC
-parseFunctionC env t@Term{} = do prototype    <- snd <$> parsePrototypeC env (Left t)
-                                 body         <- bodyLambdaM (valueTerm t)
-                                 instructions <- parseInstructionC (addVarsCEnvG env (argsProto prototype)) body
-                                 return $ FunctionC prototype instructions
-parseFunctionC _ _          = fail "parseFunctionC undefined"
-
-
-parseFunctionCFX :: EnvG -> Parser Decl [FunctionC]
-parseFunctionCFX env (Fixgroup l) = mapM (parseFunctionC env) lterm
-  where reformate (Item n t v) = Term n t v
-        lterm = map reformate l
-parseFunctionCFX _ _              = fail "parseFunctionCFX"
-
-
-parseInstructionC :: EnvG -> Parser Expr [InstructionC]
-parseInstructionC env expr = case expr of
-  Rel{}          -> multicase
-  Global{}       -> multicase
-  ConstructorE{} -> multicase
-  Apply{}        -> parseMonadBlockC env expr ||| multicase
-  Case{}         -> (:[]) . CSC . Cond <$> parseConditionnalC envCondC env expr
-  (Let _ _ body) -> do (newEnv, varLet) <- parseDeclVarC env (Right expr)
-                       instructions     <- parseInstructionC newEnv body
-                       return $ DeclVarC varLet : instructions
-  _              -> fail $ "parseInstructionC undefined " ++ take debugRender (show expr)
-  where multicase = do typeC <- parseExprOfTypeC env expr
-                       if typeC == typeVoid
-                       then (:[]) . ExprC <$> parseExprC env expr
-                       else (:[]) . ReturnC <$> parseExprC env expr
-
-parseMonadBlockC :: EnvG -> Parser Expr [InstructionC]
-parseMonadBlockC env exprCoq = case exprCoq of
-  Apply (Global "Hardware.bind") [expr, Lambda [nameV] ninstr] ->
-    do rvalue <- parseExprC env expr
-       typeRvalue <- parseExprOfTypeC env expr
-       if nameV == "_"
-       then (ExprC rvalue:) <$> parseInstructionC env ninstr
-       else do nameC <- parseNameC nameV
-               let lvalue = (nameC, typeRvalue)
-                   newEnv = addVarsCEnvG env [VarEmptyDecl lvalue]
-               (DeclVarC (VarDecl lvalue rvalue):) <$> parseInstructionC newEnv ninstr
-
-  _                                                            -> fail "parseMonadBlockC undefined"
-
-parseConditionnalC :: EnvCondC -> EnvG -> Parser Expr ConditionalStructC
-parseConditionnalC envC env match = condC . cSC . head <$> if length (casesCase match) == 1 then fail "parseConditionnalC, error : l case < 1" else pC' match
-  where pC' :: Parser Expr [InstructionC]
-        pC' (Case expr cases) = case cases of
-          []            -> return []
-          [C pat body]  ->   -- else only
-              do exprC'      <- parseExprC env expr
-                 (declVM, _) <- runParserEnvCondC env envC exprC' pat
-                 pInstr declVM body
-          C pat body:cs ->
-              do exprC'          <- parseExprC env expr
-                 (declVM, exprM) <- runParserEnvCondC env envC exprC' pat
-                 exprB           <- toMyEith' exprM
-                 bThen           <- pInstr declVM body
-                 bElse           <- pC' $ Case expr cs
-                 return $ ((:[]) . CSC . Cond) $ IfThenElseC exprB bThen bElse
-        pC' _                 = fail "parseConditionnalC undefined"
-        pInstr :: [DeclVarC] -> Parser Expr [InstructionC]
-        pInstr declV' body' = (++) (map DeclVarC declV') <$> parseInstructionC (addVarsCEnvG env declV') body'
-
-----------  Pattern Conditionnal  -------------------------------
-pPatOExprC :: EnvG -> ExprC -> Parser Pat ([DeclVarC], Maybe ExprC)
-pPatOExprC _ match (ConstructorP "Datatypes.O" []) = return ([], return $ BinOp match "==" (ValC ("0", TypeC "unsigned")))
-pPatOExprC _ _ _                                   = fail "pPatOExprC undefined"
-
-pPatSExprC :: EnvG -> ExprC -> Parser Pat ([DeclVarC], Maybe ExprC)
-pPatSExprC _ match (ConstructorP "Datatypes.S" [p]) = do p' <- parseNameC p
-                                                         return ([VarDecl (p', TypeC "unsigned") (BinOp match "-" (ValC ("1", TypeC "uint32_t")))], Nothing)
-pPatSExprC _ _ _                                    = fail "pPatSExprC undefined"
-
-pPatTrueExprC :: EnvG -> ExprC -> Parser Pat ([DeclVarC], Maybe ExprC)
-pPatTrueExprC _ match (ConstructorP "Datatypes.Coq_true" []) = return ([], return match)
-pPatTrueExprC _ _ _                                          = fail "pPatTrueExprC undefined"
-
-pPatFalseExprC :: EnvG -> ExprC ->  Parser Pat ([DeclVarC], Maybe ExprC)
-pPatFalseExprC _ match (ConstructorP "Datatypes.Coq_false" []) = return ([], return $ BinOp match "==" (ValC ("0", TypeC "uint32_t")))
-pPatFalseExprC _ _ _                                           = fail "pPatFalseExprC undefined"
-----------------------------------------------------------
-
-parseExprC :: EnvG -> Parser Expr ExprC
-parseExprC env expr = case expr of
-  Rel{}          -> VarC <$> parseVarC env expr
-  Global{}       -> VarC <$> parseVarC env expr ||| parseApplyFunC env expr
-  ConstructorE{} -> parseValC env expr
-  Apply{}        -> parseApplyFunC env expr
-  _              -> fail $ "parseExprC undefined" ++ take (debugRender + 200) (show expr)
-
-parseVarC :: EnvG -> Parser Expr VarC
-parseVarC env expr = case expr of
- (Rel var)    -> construct var $ lookupEnvVar var env
- (Global var) -> construct var (lookupEnvVar var env) ||| construct' var
- _            -> fail "parseVarC undefined"
- where construct var getType = do nVar    <- parseNameC var
-                                  typeVar <- getType
-                                  return (nVar, typeVar)
-       construct' var = do let tm = runParserEnvT var env (Right expr)
-                           t <- tm
-                           if length (elmTypeC t) == 1
-                           then fail "parseVarC fail, it's a function"
-                           else construct var tm
-
-parseValC :: EnvG -> Parser Expr ExprValC
-parseValC env c@ConstructorE{} = runParserEnvV env c
-parseValC _ _                  = fail "parseValC undefined"
-
-parseApplyFunC :: EnvG -> Parser Expr ExprC
-parseApplyFunC env apply = runParserEnvFApply env apply ||| pApplyFunC
-  where pApplyFunC = case apply of
-          (Apply fun args) -> do f      <- transformFun fun
-                                 a      <- transformArgs args
-                                 status <- checkApplyPart f args
-                                 if status
-                                 then construct f a
-                                 else fail $ "Exception, detection of partiel application (application) : function " ++ f
-          (Global fun)     -> construct fun []
-          _                -> fail "parseApplyFunC undefined"
-        transformFun (Global f) = return f
-        transformFun (Rel f)    = return f
-        transformFun _          = fail "It's not function"
-        transformFun' f = lookupEnvN f env ||| parseNameC f
-        transformArgs = mapM (parseExprC env)
-        checkApplyPart nfun a = do t <- runParserEnvT nfun env (Right apply)
-                                   return $ length a == length (elmTypeC t) - 1
-        construct f a = do f' <- transformFun' f
-                           return $ ApplyFunC f' a
-
-parseFileC :: EnvArgs -> EnvG -> Parser Module FileC
-parseFileC eargs eg m = do ldecl <- parseAllDeclC eg (declarationsMod m)
-                           return $ FileC includes ldecl
-  where includes = map GloIncC (gloIncOpt eargs)
-                ++ map LocIncC (locIncOpt eargs)
-
-parseFileH :: EnvArgs -> EnvG -> Parser Module (EnvG, FileH)
-parseFileH eargs eg m = do (env, ldecl) <- parseAllDeclH eg (declarationsMod m)
-                           return (env, FileC includes ldecl)
-  where includes = map GloIncC (gloIncOpt eargs) ++ map LocIncC (locIncOpt eargs)
-
-parseModuleC :: EnvArgs -> EnvG -> Parser Module (EnvG, ModuleC)
-parseModuleC eargs env m = do (envH, fileH) <- parseFileH eargs env m
-                              fileC         <- parseFileC eargs envH m
-                              return (envH, ModuleC nm fileH fileC)
-  where nm = nameMod m
-
-parseMacroInc :: FileName -> (MacroIncBegin, MacroIncEnd)
-parseMacroInc name = ( "#ifndef " ++ define ++ "\n"
-                    ++ "#define " ++ define ++ "\n"
-                     , "#endif\n")
-  where define = "__" ++ map ((\ x -> if x == '.' then '_' else x) . toUpper) name ++ "_H__"
-
-parseImportC :: EnvG -> Parser Module (EnvG, DeclC)
-parseImportC env m = do (nenv, declH's) <- parseAllDeclH env (declarationsMod m)
-                        let comDeclH's = concatMap ((++"\n") . showDeclC) declH's
-                            header = "************* Expected symbols from " ++ nameMod m ++  " *************\n"
-                            footer = replicate (length header) '*'
-                        return (nenv, CommDecl $ header ++ comDeclH's ++ footer)
-
-parseAllImportC :: EnvG -> Parser [Module] (EnvG, [DeclC])
-parseAllImportC env m's = case m's of
-  []   -> return (env, [])
-  m:ms -> do (e1, ds1) <- parseImportC env m
-             (en, dsn) <- parseAllImportC env ms
-             return (mergeEnvG e1 en, ds1 : dsn)
-
--------------- Show -------------------------------
-type Indent = Int
-
-showCommentaryC :: CommentaryC -> String
-showCommentaryC commentary = "/*\n" ++ commentary ++ "\n*/"
-
-showIndent :: Indent -> String
-showIndent indent = if indent < 0 then "" else replicate indent '\t'
-
-
-showIncludeC :: IncludeC -> String
-showIncludeC inc = case inc of
-  (GloIncC name) -> "#include <" ++ name ++ ">" ++ "\n"
-  (LocIncC name) -> "#include \"" ++ name ++ "\"" ++ "\n"
-
-showVarC :: Indent -> VarC -> String
-showVarC ind (n, _) = showIndent ind ++  n
-
-showValC :: Indent -> ValC -> String
-showValC ind (n, _) = showIndent ind ++  n
-
-showExprC :: Indent -> ExprC -> String
-showExprC ind (ValC l)                 = showValC ind l
-showExprC ind (VarC v)                 = showVarC ind v
-showExprC ind (ApplyFunC nameFun args) = showIndent ind ++ nameFun ++ "(" ++ intercalate ", " (map (showExprC 0) args) ++ ")"
-showExprC ind (BinOp el symb er)       = showIndent ind ++ "(" ++ showExprC 0 el ++ " " ++ symb ++ " " ++ showExprC 0 er ++ ")"
-
-showTypeC :: NameC -> TypeC -> String
-showTypeC _ (TypeC typeC) = typeC
-showTypeC n (TypeCFun typeC@(t:ts)) = ret ++ idt ++ args
-    where ret = showTypeC "" $ last typeC
-          idt = "(*" ++ n ++ ")"
-          args = "(" ++ showTypeC "" t ++ foldr (\x y -> ", " ++ showTypeC "" x ++ y) "" (init' ts) ++ ")"
-          init' l = if null l then [] else init l
-showTypeC _ _                       = error "error, showTypeC"
-
-
-showPrototypeC :: PrototypeC -> String
-showPrototypeC (PrototypeC name ret args) =
-  showTypeC name ret ++ " " ++ name ++ "(" ++ intercalate ", " (map (showDeclVarC eDECLVARINPROTOTYPE) args) ++ ")"
-
-showOnlyPrototypeC :: PrototypeC -> String
-showOnlyPrototypeC pro = "extern " ++ showPrototypeC pro ++ ";"
-
-eDECLVARINPROTOTYPE :: Int
-eDECLVARINPROTOTYPE = -1
-
-showDeclVarC :: Indent -> DeclVarC -> String
-showDeclVarC ind decl = case decl of
-  (VarEmptyDecl (n, t)) -> let isFun = isTypeCFun t in begin ++ extern ++ identif isFun t n ++ end
-  (VarDecl (n, t) expr) -> let isFun = isTypeCFun t in begin ++ constI isFun ++ showTypeC n t ++ " " ++ n ++ " = " ++ showExprC 0 expr ++ end
-  where begin  = showIndent ind
-        end    = if ind == 0 then ";" else ""
-        extern = if ind == 0 then "extern " else ""
-        constI isFun' = if isFun' then "" else "const "
-        identif isFun' t' n' =  if isFun' then showTypeC n' t' else constI isFun' ++ showTypeC "" t' ++ " " ++ n'
-
-
-showConditionnalC :: Indent -> ConditionalStructC -> String
-showConditionnalC ind (IfThenElseC cond ifB elseB) = showIndent ind ++
-  "if (" ++ showExprC 0 cond ++ ") {\n" ++
-    concatMap (showInstructionC (ind + 1)) ifB ++ showIndent ind ++
-  "} else {\n" ++
-    concatMap (showInstructionC (ind + 1)) elseB ++ showIndent ind ++
-  "}"
-
-showControlStructC :: Indent -> ControlStructC -> String
-showControlStructC ind (Cond struct) = showConditionnalC ind struct
-showControlStructC _ (Iter _)      = undefined
-
-showFunctionC :: FunctionC -> String
-showFunctionC (FunctionC proto body) =
-  showPrototypeC proto ++
-  "\n{\n" ++
-    concatMap (showInstructionC 1) body ++
-  "}"
-
-debugRender :: Int
-debugRender = 120
-
-showDeclC :: DeclC -> String
-showDeclC decl = case decl of
-  VarCDecl var    -> showDeclVarC 0 var
-  FunDecl fun     -> showFunctionC fun
-  ProtoDecl proto -> showOnlyPrototypeC proto
-  CommDecl comm   -> showCommentaryC comm
-  _               -> error $ "showDeclC undefined" ++ take debugRender (show decl)
-
-
-showInstructionC :: Indent -> InstructionC -> String
-showInstructionC ind instr =
-  case instr of
-  (CSC csc)          -> showControlStructC ind csc ++ "\n"
-  (ExprC expr)       -> showExprC ind expr ++ ";\n"
-  (DeclVarC declVar) -> showDeclVarC ind declVar ++ ";\n"
-  (ReturnC expr)     -> showIndent ind ++ "return " ++ showExprC 0 expr ++ ";\n"
-
-showFileC :: FileC -> String
-showFileC (FileC incl body) = concatMap showIncludeC incl ++ "\n" ++
-                              concatMap (\x ->  showDeclC x ++ "\n\n") body
-
-showFileH :: FileName -> FileH -> String
-showFileH name (FileC incl body) =
-  let (begin, end) = parseMacroInc name
-      includes     = concatMap showIncludeC incl
-  in
-  begin ++ "\n" ++
-  includes ++ (if null includes then "" else "\n") ++
-  concatMap (\d -> showDeclC d ++ "\n") body ++ "\n" ++
-  end ++ "\n"
-
-type ShowFileC = String
-type ShowFileH = String
-showModuleC :: ModuleC -> (ShowFileH, ShowFileC)
-showModuleC (ModuleC name fileH fileC) =
-  ( showFileH name fileH
-  , showFileC fileC
-  )
-
-
-------------------- Main Module ----------------------
-
-type ContentFile = String
-type ImportFile  = ContentFile
-
-extractor :: EnvArgs -> [ImportFile] -> ContentFile -> MyEither (ModuleUsed, (ShowFileH, ShowFileC))
-extractor eargs impFile's contFile = do astImpFile's           <- mapM decodeModule impFile's
-                                        astCoqFile             <- decodeModule contFile
-                                        (envImp's, declComm's) <- parseAllImportC env astImpFile's
-                                        (_, m)                 <- parseModuleC eargs (mergeEnvG env envImp's) astCoqFile
-                                        let moduleC = addDeclCToModCFileH m declComm's
-                                        return $ (nameMod astCoqFile, showModuleC moduleC)
-  where decodeModule content = MyEith $ (eitherDecode (BS.pack content) :: Either String Module)
-        env = envG envUser
-
-main :: IO ()
-main = do namePrg   <- getProgName
-          eargs     <- OA.execParser (opts namePrg)
-          fileImp's <- mapM readFile $ importOpt eargs
-          fileCoq   <- readFile $ inputOpt eargs
-          let (nm, (contentFileH, contentFileC)) = eith . myEither $ extractor eargs fileImp's fileCoq
-              output = fromMaybe (nm ++ ".c") (outputOpt eargs)
-          writeFile output contentFileC
-          case outputHOpt eargs of
-            Just fileH -> writeFile fileH contentFileH
-            Nothing    -> return ()
-
-  where eith = either error id
-        opts nm = OA.info (OA.helper <*> envArgs)
-                  ( OA.fullDesc
-                    <> OA.progDesc (  "Compile Coq source code written in a specific monadic style "
-                                   ++ "(and extracted to its JSON representation by the standard "
-                                   ++ "Coq extracting facility) into the corresponding C code" )
-                    <> OA.header (nm ++ " - a simple compiler from Coq monadic code into C")
-                  )
diff --git a/digger.cabal b/digger.cabal
new file mode 100644
index 0000000000000000000000000000000000000000..e7906b2319ed8f4a91272b9ddbe4f0f94238b229
--- /dev/null
+++ b/digger.cabal
@@ -0,0 +1,54 @@
+name:                digger
+version:             0.2.0.0
+synopsis:            convert "C-style" Coq code into C code or an
+                     intermediate representation in Coq
+description:         Convert Coq code written in a "C-style"
+                     (imperative style based on a monad, with full
+                     application of functions) into the corresponding
+                     C code or to an intermediate representation
+                     (deep) output as Coq source code.
+                     Start from the Coq code extracted as JSON by the
+                     internal extraction facility.
+
+license:             OtherLicense
+license-file:        LICENSE
+
+author:              Samuel Hym, Veïs Oudjail
+maintainer:          samuel.hym@univ-lille1.fr
+copyright:           2016-2017 Université Lille 1, Veïs Oudjail
+category:            Language
+build-type:          Simple
+extra-source-files:  Readme.md
+cabal-version:       >=1.10
+
+library
+  hs-source-dirs:      src
+  exposed-modules:     Language.Coq.ExtractedAST,
+                       Language.Coq.Deep
+  build-depends:       base >=4.9 && <4.10,
+                       aeson >=0.11 && <1.1,
+                       containers >= 0.5.7 && <0.6,
+                       bytestring >=0.10 && <0.11,
+                       data-default >= 0.7 && < 0.8,
+                       text >= 1.2 && < 1.3,
+                       wl-pprint-text >= 1.1 && < 1.2,
+                       language-c >= 0.5 && < 0.6,
+                       pretty >= 1.1 && < 1.2
+  default-language:    Haskell2010
+
+executable digger
+  main-is:             digger.hs
+  hs-source-dirs:      app
+  other-modules:       Paths_digger
+  build-depends:       base >=4.9 && <4.10,
+                       aeson >=0.11 && <1.1,
+                       containers >= 0.5.7 && <0.6,
+                       bytestring >=0.10 && <0.11,
+                       data-default >= 0.7 && < 0.8,
+                       optparse-applicative >=0.12 && <0.14,
+                       text >= 1.2 && < 1.3,
+                       wl-pprint-text >= 1.1 && < 1.2,
+                       pretty >= 1.1 && < 1.2,
+                       language-c >= 0.5 && < 0.6,
+                       digger
+  default-language:    Haskell2010
diff --git a/src/Language/Coq/Deep.hs b/src/Language/Coq/Deep.hs
new file mode 100644
index 0000000000000000000000000000000000000000..31ab8f6d7177e7bdb24c2d44c37bfedc284288d9
--- /dev/null
+++ b/src/Language/Coq/Deep.hs
@@ -0,0 +1,766 @@
+-- This software is governed by the CeCILL license under French law and
+-- abiding by the rules of distribution of free software.  You can  use,
+-- modify and/ or redistribute the software under the terms of the CeCILL
+-- license as circulated by CEA, CNRS and INRIA at the following URL
+-- "http://www.cecill.info".
+
+-- As a counterpart to the access to the source code and  rights to copy,
+-- modify and redistribute granted by the license, users are provided only
+-- with a limited warranty  and the software's author,  the holder of the
+-- economic rights,  and the successive licensors  have only  limited
+-- liability.
+
+-- In this respect, the user's attention is drawn to the risks associated
+-- with loading,  using,  modifying and/or developing or reproducing the
+-- software by the user in light of its specific status of free software,
+-- that may mean  that it is complicated to manipulate,  and  that  also
+-- therefore means  that it is reserved for developers  and  experienced
+-- professionals having in-depth computer knowledge. Users are therefore
+-- encouraged to load and test the software's suitability as regards their
+-- requirements in conditions enabling the security of their systems and/or
+-- data to be ensured and,  more generally, to use and operate it in the
+-- same conditions as regards security.
+
+-- The fact that you are presently reading this means that you have had
+-- knowledge of the CeCILL license and that you accept its terms.
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Language.Coq.Deep (
+          -- * Deep intermediate representation
+          -- $deep
+          Id
+        , VId
+        , FId
+        , Const
+        , VTyp
+        , ValTC
+        , Fun (..)
+        , Exp (..)
+        , DeepModule (..)
+
+        -- * Parameters for the conversions
+        , ConversionParams (..)
+
+        -- * Conversion from Coq.ExtractedAST syntax to Deep
+        -- $coq2deep
+        , SymbolTable
+        , extractSymbolTable
+        , fromCoq
+
+        -- * Pretty-print a Deep module into Coq syntax
+        -- $deep2coq
+        , prettyModule
+
+        -- * Conversion from Deep intermediate representation to C
+        -- $deep2c
+        , toCSource
+        , toCHeader
+    ) where
+
+import           Control.Arrow                (second, (&&&))
+import           Data.Default
+import           Data.Either                  (partitionEithers)
+import qualified Data.Map                     as Map
+import           Data.Maybe                   (catMaybes, fromJust, fromMaybe,
+                                               isJust, maybeToList)
+import qualified Data.Set                     as Set
+import           Data.Text.Lazy               (Text)
+import qualified Data.Text.Lazy               as Text
+import           Language.C                   hiding (Name)
+import           Language.C.Data.Ident        (Ident (..))
+import           Text.PrettyPrint.Leijen.Text (Doc, dquotes, empty, enclose,
+                                               encloseSep, hang, hcat, lbracket,
+                                               line, lparen, nest, parens,
+                                               rbracket, rparen, semi, sep,
+                                               space, text, tupled, vcat, vsep,
+                                               (<+>), (</>), (<>))
+import qualified Text.PrettyPrint.Leijen.Text as PP
+
+import           Language.Coq.ExtractedAST
+
+-- $deep
+-- Define the Deep intermediate language.
+-- This intermediate language only captures the part of the Gallina
+-- language that can be converted into C because it is structured just
+-- like C code (using a monad to represent sequence).
+
+-- | Identifiers
+type Id = String
+-- | Variable identifiers
+type VId = Id
+-- | Function identifiers
+type FId = Id
+
+-- | Constants
+type Const = String
+
+-- | Types for base values (i.e. not functions)
+-- As far as we are concerned, these will be only manipulated as
+-- strings in the converter
+type VTyp = String
+
+-- | Typing contexts for values
+-- In particular, a typing context describes the types of the argument
+-- of a function
+type ValTC = [(VId, VTyp)]
+
+-- | Actual term (content) of a function
+--
+-- Built with:
+--
+-- * the name of the function itself (it will be bound in the body for
+--   the recursive case)
+-- * a list of functions it can call (and their recursive bounds,
+--   given by their names, when applicable)
+-- * a list of arguments (and their types)
+-- * a return type
+--
+-- and, if the function is recursive:
+--
+-- * the body of the function on the base case
+-- * the body of the function on the recursive case
+--
+-- otherwise, the body of the function.
+--
+-- Compared with Deep syntax, this does not give the bound of
+-- recursive functions since it will be defined only in calling
+-- functions
+--
+-- TODO: Should 'calls' be replaced with something containing also the
+-- global variables?
+data Fun = FunRec { self   :: FId
+                  , calls  :: [(FId, Maybe RecursiveBound)]
+                  , args   :: ValTC
+                  , resTyp :: VTyp
+                  , bodyO  :: Exp
+                  , bodyS  :: Exp }
+         | Fun    { self   :: FId
+                  , calls  :: [(FId, Maybe RecursiveBound)]
+                  , args   :: ValTC
+                  , resTyp :: VTyp
+                  , body   :: Exp }
+    deriving (Show,Eq)
+
+-- | Syntax of expressions
+-- Bind and Return are the standard monadic operators
+-- BindN is Bind ignoring the value produced by the first expression
+-- Call applies (fully) a function to its arguments
+-- IfThenElse, Var and Const are surpriseless
+data Exp = Bind       VId (Maybe VTyp) Exp Exp
+         | BindN      Exp Exp
+         | Return     Exp
+         | Call       FId [Exp]
+         | IfThenElse Exp Exp Exp
+         | Var        VId            -- ^ TODO: Should this be called differently?
+         | Const      VId            -- ^ TODO: Should this be specialised to Bool?
+    deriving (Show,Eq)
+
+-- | A full module in the Deep world
+-- Its symbol table and recursive-bounds map contain also information
+-- about its dependencies, not only about the module itself
+data DeepModule = DeepModule { nameDeepMod            :: Name
+                             , symbolTableDeepMod     :: SymbolTable
+                             , recursiveBoundsDeepMod :: RecursiveBoundMap
+                             , functionsDeepMod       :: [Either ErrorMsg (Name,Fun)]
+                             }
+
+
+-- | Parameters for the conversion
+--
+-- Provide various parameters:
+--
+-- * the constants to recognize in the Coq source (in particular what
+--   is the name of the support monad used to represent C sequence)
+-- * the prefixes to use when outputting Deep intermediate language in
+--   Gallina (so that source definition "func" becomes "prefix_func")
+-- * a few parameters to translate Deep into C: how the recursive
+--   bound should be named in C code and which Coq functions should be
+--   mapped to native C operators
+
+data ConversionParams = CP
+        { monad        :: Name                  -- ^ Name (type) of the support monad
+        , bind         :: Name                  -- ^ Bind of the support monad
+        , ret          :: Name                  -- ^ Return of the support monad
+        , unit         :: Name                  -- ^ How Coq’s unit (type) is extracted
+        , tt           :: Name                  -- ^ How Coq’s tt (value of type unit) is extracted
+        , true         :: Name                  -- ^ How Coq’s true is extracted
+        , false        :: Name                  -- ^ How Coq’s false is extracted
+        , nats         :: CoqNat                -- ^ How Coq’s nat are extracted
+        , consts       :: [Name]                -- ^ Constructors that should be preserved
+
+        , ignores      :: [Name]                -- ^ Declarations that should be ignored in Coq source
+                                                --   (for instance because they cannot be translated)
+
+        , prefixConst  :: Text                  -- ^ Prefix of Deep versions of constructors
+        , prefixFun    :: Text                  -- ^ Prefix added to function names in their Deep versions
+        , prefixFTyp   :: Text                  -- ^ Prefix for function types definition
+        , prefixVTyp   :: Text                  -- ^ Prefix for value types
+
+        , recBoundName :: Name                  -- ^ Name of the recursive-bound variable in generated C
+        , unaryOps     :: Map.Map FId CUnaryOp  -- ^ Map from Coq functions to C unary operators
+        , binaryOps    :: Map.Map FId CBinaryOp -- ^ Map from Coq functions to C binary operators
+        }
+    deriving (Show,Eq)
+
+instance Default ConversionParams where
+    def = CP { monad        = "Monad"
+             , bind         = "bind"
+             , ret          = "ret"
+             , unit         = "unit"
+             , tt           = "tt"
+             , true         = "true"
+             , false        = "false"
+             , nats         = def
+             , consts       = ["true","false","tt"]
+
+             , ignores      = []
+
+             , prefixConst  = "deepConst_"
+             , prefixFun    = "deepFun_"
+             , prefixFTyp   = "deepFTyp_"
+             , prefixVTyp   = "deepVTyp_"
+
+             , recBoundName = "rec_bound"
+             , unaryOps     = Map.fromList [("negb",CNegOp)]
+             , binaryOps    = Map.fromList [("andb",CLndOp)
+                                           ,("orb", CLorOp)]
+             }
+
+
+-- $coq2deep
+-- Define the conversion from the extracted Coq AST into the Deep
+-- intermediate representation.
+
+-- | Symbol table
+--
+-- Maps to every known symbol:
+--
+-- * the type of the value it returns if it is a function,
+-- * its type otherwise.
+--
+-- Warning: this assumes that the VId and FId types are indeed synonyms
+type SymbolTable = Map.Map Id VTyp
+
+-- | Extract the "symbol type"
+--
+-- * if it is a function, the type of the value it returns
+-- * if it is a global variable, its type
+extractSymbolType :: ConversionParams -> Type -> Either ErrorMsg VTyp
+extractSymbolType  _ (Glob ty []) = pure ty
+extractSymbolType cp typ          = go typ
+    where go (Arrow _ ty)                          = go ty
+          go (Glob m [Glob ty []]) | m == monad cp = pure ty
+          go ty                                    = Left $ impossibleType ty
+
+          impossibleType ty = "Impossible to extract symbol type of: " ++ show ty
+
+-- | Extract the symbol table from a list of declarations
+extractSymbolTable :: ConversionParams -> [Decl] -> SymbolTable
+extractSymbolTable cp = Map.fromList . go . concatMap open
+    where open :: Decl -> [(Id, Type)]
+          open t@Term{}       = [(nameTerm t, typeTerm t)]
+          open (Fixgroup fis) = map (nameItem &&& typeItem) fis
+
+          go :: [(Id, Type)] -> [(Id, VTyp)]
+          go xs = [ (n,t) | (n, Right t) <- map (second (extractSymbolType cp)) xs]
+
+-- | Infer the result type of an expression
+-- Use a very simple strategy, since the set of expressions is really
+-- limited
+-- Return the modified expression (in case some included type
+-- annotations were modified) and the result type, when possible
+inferExpTypes :: SymbolTable -> Exp -> (Maybe VTyp, Exp)
+inferExpTypes st (Bind v _ e1 e2)   = let (ty1, e1') = inferExpTypes st e1
+                                          st'        = maybe st (\t -> Map.insert v t st) ty1
+                                      in  Bind v ty1 e1' <$> inferExpTypes st' e2
+inferExpTypes st (BindN    e1 e2)   = let (_, e1') = inferExpTypes st e1
+                                      in  BindN e1' <$> inferExpTypes st e2
+inferExpTypes st (Return e)         = Return <$> inferExpTypes st e
+inferExpTypes st (Call f es)        = (Map.lookup f st, Call f (map (snd . inferExpTypes st) es))
+inferExpTypes st (IfThenElse i t e) = let (_,   i') = inferExpTypes st i
+                                          (tyt, t') = inferExpTypes st t
+                                          (tye, e') = inferExpTypes st e
+                                          ty        = if isJust tyt then tyt else tye
+                                      in  (ty, IfThenElse i' t' e')
+inferExpTypes st e@(Var v)          = (Map.lookup v st, e)
+inferExpTypes st e@(Const v)        = (Map.lookup v st, e)
+
+inferTypes :: SymbolTable -> Fun -> Fun
+inferTypes st fun@Fun{}    = fun{body  = snd $ inferExpTypes st (body fun)}
+inferTypes st fun@FunRec{} = fun{bodyO = snd $ inferExpTypes st (bodyO fun)
+                                ,bodyS = snd $ inferExpTypes st (bodyS fun)}
+
+-- | Convert the type of a function
+-- The types that can be converted are of the form
+--     x -> y -> z -> Monad t
+-- where x, y, z and t are global names, not variables.
+-- This function only converts the original type, the actual argument
+-- names are required to build a FTyp
+
+convertFunType :: ConversionParams -> Type -> Either ErrorMsg ([VTyp], VTyp)
+convertFunType cp = go
+    where go (Arrow (Glob n []) ty2)         = go ty2 >>= \(tys, ty) -> pure (n:tys, ty)
+          go (Glob m' [Glob t []]) | m == m' = pure ([], t)
+          go ty                              = Left $ impossibleType ty
+
+          m = monad cp
+
+          impossibleType ty = "Impossible to convert type: " ++ show ty
+
+-- | Convert the body of a function
+-- Return either the resulting Deep expression or some (Coq AST)
+-- sub-expression that could not be converted
+--
+-- Handle the following possible cases:
+-- - monadic bind
+-- - monadic bind where the second action ignores the value generated
+--   by the first
+-- - monadic return
+-- - application of a function to some arguments (since we are not
+--   compiling a functional language, that function can only be a
+--   globally existing function)
+-- - using a global or local name
+-- - if then else, which is represented in Coq by a pattern-matching
+--   on boolean, so we unfold them to recover the two branches and
+--   check the two constructors
+-- - constructors for inline booleans
+
+convertFunBody :: ConversionParams -> Expr -> Either ErrorMsg Exp
+convertFunBody cp = go True
+    where -- | Translate an expression
+          -- Take as first argument whether the expression is monadic
+          -- or not
+          go :: Bool -> Expr -> Either ErrorMsg Exp
+          go True  (Apply (Global b) [e1, Lambda ["_"] e2]) | b == bind cp = BindN          <$> go True e1 <*> go True e2
+          go True  (Apply (Global b) [e1, Lambda [v] e2])   | b == bind cp = Bind v Nothing <$> go True e1 <*> go True e2
+          go True  (Apply (Global r) [e])                   | r == ret  cp = Return <$> go False e
+          go _     (Apply (Global f) as)                                   = Call f <$> traverse (go False) as
+          go True  (Global v)                                              = Right (Call v [])
+          go False (Global v)                                              = Right (Var v)
+          go False (Rel v)                                                 = Right (Var v)
+          go True  (Case cond [C (ConstructorP c1 []) e1
+                              ,C (ConstructorP c2 []) e2])  | checkIFT     = IfThenElse <$> go False cond
+                                                                                        <*> go True thenE
+                                                                                        <*> go True elseE
+                      where checkIFT = c1 == true  cp && c2 == false cp
+                                    || c1 == false cp && c2 == true  cp
+                            (thenE,elseE) = if c1 == true cp then (e1,e2) else (e2,e1)
+          go False (ConstructorE c []) | c `elem` consts cp                = Right (Const c)
+
+          go monadic e                                                     = Left $ impossibleExpr monadic e
+
+          impossibleExpr m ex = "Impossible to convert expression \"" ++ show ex ++ "\" " ++
+                                "in " ++ prefix m ++ "monadic context"
+          prefix True         = ""
+          prefix False        = "non-"
+
+-- | Complete the list of calls in a function declaration
+-- Add the calls to all the functions (including the non-recursive
+-- ones) to the list of calls
+completeCalls :: Fun -> Fun
+completeCalls fun = fun{calls = calls fun ++ map (\f -> (f, Nothing)) newUnique}
+    where extract (Bind _ _ e1 e2)   = concatMap extract [e1,e2]
+          extract (BindN    e1 e2)   = concatMap extract [e1,e2]
+          extract (Return e)         = extract e
+          extract (Call f as)        = f : concatMap extract as
+          extract (IfThenElse i t e) = concatMap extract [i,t,e]
+          extract _                  = []
+
+          allCalled Fun{}    = extract (body fun)
+          allCalled FunRec{} = concatMap extract [bodyO fun, bodyS fun]
+
+          allCalled' = Set.fromList . allCalled
+
+          already   = Set.fromList (self fun : map fst (calls fun))
+          newCalled = Set.filter (`Set.notMember` already) (allCalled' fun)
+          newUnique = Set.toList newCalled
+
+-- | Convert a declaration (a function or a fixgroup)
+--
+-- FIXME? here there are some cases of inconsistency between the
+-- RecursiveBoundMap and the actual number of arguments encountered
+-- that are _not_ detected (and would result in exceptions)
+convertDecl :: ConversionParams -> RecursiveBoundMap -> SymbolTable -> Decl -> Either ErrorMsg [(Name, Fun)]
+convertDecl cp recs syms = go
+    where -- | Base case of transformation of one function
+          base nam typ ex = do (tyArgs, tyRes)         <- convertFunType cp typ
+                               (recCalls, ex')         <- extractRecCalls (nats cp) nam recs ex
+                               (args', bodyO', bodyS') <- unLambda nam ex'
+                               bodyO''                 <- convertFunBody cp bodyO'
+                               bodyS''                 <- maybe (Right Nothing) (fmap Just . convertFunBody cp) bodyS'
+                               let args''    = zip args' tyArgs
+                                   args'''   = case Map.lookup nam recs of
+                                                 Just pos -> case splitAt pos args'' of
+                                                               (args1, _:args2) -> args1 ++ args2
+                                                 Nothing  -> args''
+                                   recCalls' = map (second Just) recCalls
+                                   whole     = case bodyS'' of
+                                                 Just bodyS''' -> FunRec nam recCalls' args''' tyRes bodyO'' bodyS'''
+                                                 Nothing       -> Fun    nam recCalls' args''' tyRes bodyO''
+                               pure (nam, inferTypes syms $ completeCalls whole)
+
+          ignores' = Set.fromList (ignores cp)
+
+          base' nam typ ex | Set.member nam ignores' = Right []
+                           | otherwise               = case base nam typ ex of
+                                                         Left err -> Left $ "Error in " ++ nam ++ ": " ++ err
+                                                         Right r  -> Right [r]
+
+          unLambda _
+            (Lambda args'
+              (Case (Rel _) [C (ConstructorP o []) bodyO'
+                            ,C (ConstructorP s [_]) bodyS']))
+                |    o == natO (nats cp)
+                  && s == natS (nats cp)     = pure (args', bodyO', Just bodyS')
+          unLambda   _ (Lambda args' body')  = pure (args', body', Nothing)
+          unLambda nam e                     = Left $ "Lambda expected in " ++ nam
+                                                   ++ " in expression: " ++ show e
+
+          go (Term nam typ ex) = base' nam typ ex
+          go (Fixgroup funs)   = concat <$> traverse (\(FixItem nam typ ex) -> base' nam typ ex) funs
+
+-- | Convert a "ExtractedAST" Coq 'Module' to Deep language
+-- Takes as arguments the 'RecursiveBoundMap' and 'SymbolTable'
+-- corresponding to the modules the converted one requires
+fromCoq :: ConversionParams -> RecursiveBoundMap -> SymbolTable -> Module -> DeepModule
+fromCoq cp recs syms modul = DeepModule{ nameDeepMod            = nameMod modul
+                                       , symbolTableDeepMod     = syms'
+                                       , recursiveBoundsDeepMod = recs'
+                                       , functionsDeepMod       = funs
+                                       }
+    where recs' = Map.union recs $ detectBounds (nats cp) modul
+          syms' = Map.union syms $ extractSymbolTable cp decls
+          decls = declarationsMod modul
+          funs  = concatMap (sequence . convertDecl cp recs' syms') decls
+
+
+-- $deep2coq
+-- Define the conversion of the Deep intermediate language into an
+-- explicit representation of Deep in Coq.
+
+-- | Pretty-print Id
+prettyId :: Id -> Doc
+prettyId = text . Text.pack
+
+quoteId :: Id -> Doc
+quoteId = dquotes . prettyId
+
+-- | Pretty-print a recursive bound constant (Coq nat number)
+prettyBoundConst :: RecursiveBoundConst -> Doc
+prettyBoundConst = text . Text.pack . show
+
+-- | Pretty-print a recursive bound
+prettyBound :: RecursiveBound -> Doc
+prettyBound (b, vs) = go vs''
+    where vs'              = map prettyId vs
+          vs'' | b == 0    = vs'
+               | otherwise = vs' ++ [prettyBoundConst b]
+          go []            = text "0"
+          go [x]           = x
+          go xs            = encloseSep lparen rparen (text " + ") xs
+
+-- | Pretty-print a constructor
+prettyConst :: ConversionParams -> Id -> Doc
+prettyConst cp x = text (prefixConst cp) <> prettyId x
+
+-- | Pretty-print a VTyp
+prettyVTyp :: ConversionParams -> VTyp -> Doc
+prettyVTyp cp typ = text (prefixVTyp cp) <> prettyId typ
+
+-- | Pretty-print a Coq list
+list :: [Doc] -> Doc
+list = encloseSep lbracket rbracket semi
+
+-- | Pretty-print a sub-expression
+sub :: ConversionParams -> Exp -> Doc
+sub cp = nest 2 . parens . prettyExp cp
+
+-- | Pretty-print an expression
+prettyExp :: ConversionParams -> Exp -> Doc
+prettyExp cp (Bind v _ e1 e2)      = nest 2 ( sep [ text "BindS" </> quoteId v
+                                                  , sub cp e1 ] )
+                                     PP.<$> sub cp e2
+prettyExp cp (BindN e1 e2)         = nest 2 ( sep [ text "BindN"
+                                                  , sub cp e1 ] )
+                                     PP.<$> sub cp e2
+-- | Special cases of return
+prettyExp  _ (Return (Var x))      = text "Return RR" </> parens (text "Var" </> quoteId x)
+prettyExp cp (Return (Const c))    = text "Return RR" </> prettyConst cp c
+-- | Strangest of all special cases: if it is not a Var or a Const, we
+-- handle it as if it were a boolean expression, to bypass current
+-- limitations in Return
+prettyExp cp (Return x)            = prettyExp cp (IfThenElse x (Return (Const (true  cp)))
+                                                                (Return (Const (false cp))))
+-- The following should be the actual normal case for return
+-- prettyExp cp (Return x)            = text "Return RR" </> sub cp x
+prettyExp cp (Call f as)           = sep [ text "Apply"
+                                         , parens (text "FVar" </> quoteId f)
+                                         , parens (text "PS" </> list (map (prettyExp cp) as)) ]
+prettyExp cp (IfThenElse e1 e2 e3) = sep ["IfThenElse", sub cp e1, sub cp e2, sub cp e3]
+prettyExp  _ (Var x)               = text "Return LL" </> parens (text "Var" </> quoteId x)
+prettyExp cp (Const c)             = text "Return LL" </> prettyConst cp c
+
+-- | Pretty-print an argument list
+prettyArgs :: ConversionParams -> ValTC -> Doc
+prettyArgs cp = list . map prettyArg
+    where prettyArg (var, typ) = tupled [quoteId var, prettyVTyp cp typ]
+
+-- | Pretty-print a Fun
+prettyFun :: ConversionParams -> Fun -> Maybe Doc -> Doc
+prettyFun cp fun bnd =
+    nest 2 $ vsep [ sep [ text "FC"
+                        , list (map prettyCalled (calls fun))
+                        , prettyArgs cp (args fun) ]
+                  , prettyBody (bodyO' fun)
+                  , prettyBody (bodyS' fun)
+                  , quoteId (self fun) <+> fromMaybe empty bnd ]
+    where prettyCalled (fun', bnd') = tupled [ quoteId fun'
+                                             , hcat [ text (prefixFun cp)
+                                                    , prettyId fun'
+                                                    , maybe empty (const space) bnd'
+                                                    , maybe empty prettyBound bnd' ] ]
+
+          prettyBody = hang 2 . enclose (text "( ") (text " )") . prettyExp cp
+          bodyO' (FunRec _ _ _ _ b _) = b
+          bodyO' (Fun    _ _ _ _ b)   = b
+          bodyS' (FunRec _ _ _ _ _ b) = b
+          bodyS' (Fun    n _ as _ _)  = Call n (map (Var . fst) as)
+
+-- | Pretty-print a FTyp
+prettyFTyp :: ConversionParams -> Fun -> Doc
+prettyFTyp cp fun = nest 2 $ sep [ text "FT"
+                                 , prettyArgs cp (args fun)
+                                 , prettyVTyp cp (resTyp fun) ]
+
+-- | Pretty-print a definition
+prettyDef :: ConversionParams -> RecursiveBoundMap -> (Name, Fun) -> Doc
+prettyDef cp recs (nam, fun) = hang 2 deffun PP.<$> hang 2 deftyp
+    where isRec           = isJust $ Map.lookup nam recs
+          bnd | isRec     = Nothing
+              | otherwise = Just $ prettyId $ natO $ nats cp
+          typ | isRec     = text "nat -> Fun"
+              | otherwise = text "Fun"
+
+          deffun = text "Definition" </> text (prefixFun cp) <>
+                   prettyId nam </> text ":" </> typ </> text ":=" <> line <>
+                   prettyFun cp fun bnd <> text "." <> line
+          deftyp = text "Definition" </> text (prefixFTyp cp) <>
+                   prettyId nam </> text ": FTyp" </> text ":=" <> line <>
+                   prettyFTyp cp fun <> text "." <> line
+
+-- | Pretty-print a 'Doc' as a Coq comment
+comment :: Doc -> Doc
+comment = hang 3 . enclose (text "(* ") (text " *)")
+
+-- | Pretty-print an error
+-- When a function fails to convert, pretty-print the error message
+prettyErr :: ErrorMsg -> Doc
+prettyErr err = comment (text (Text.pack err)) <> line
+
+-- | Pretty-print a definition whose convertion could have failed
+prettyDefErr :: ConversionParams -> RecursiveBoundMap -> Either ErrorMsg (Name, Fun) -> Doc
+prettyDefErr cp recs = either prettyErr (prettyDef cp recs)
+
+-- | Pretty-print a module
+prettyModule :: ConversionParams -> DeepModule -> Doc
+prettyModule cp modul = vcat $ map (prettyDefErr cp recs) funs
+    where recs = recursiveBoundsDeepMod modul
+          funs = functionsDeepMod modul
+
+
+-- $deep2c
+-- Define the conversion from the Deep intermediate representation
+-- into C code, using the "Language.C" library to represent the result
+-- of that conversion.
+
+-- | Define an identifier without any node information
+-- To build an AST, the information would not be much use
+ident :: String -> Ident
+ident n = let Ident n' i _ = internalIdent n
+          in  Ident n' i undefNode
+
+-- | Return an unsigned int constant
+unsignedConst :: Integer -> CExpr
+unsignedConst n = CConst (CIntConst (CInteger n DecRepr flagUnsigned) undefNode)
+    where flagUnsigned = setFlag FlagUnsigned noFlags
+
+-- | Convert a Deep type into a C type declaration
+cVTyp :: ConversionParams -> VTyp -> CDeclSpec
+cVTyp cp = cMaybeVTyp cp . Just
+
+-- | Convert a possibly-absent Deep type into a C type declaration
+-- When absent, generate an "auto" type instead of a type
+cMaybeVTyp :: ConversionParams -> Maybe VTyp -> CDeclSpec
+cMaybeVTyp cp (Just typ) | typ == unit cp = CTypeSpec $ CVoidType undefNode
+                         | otherwise      = CTypeSpec $ CTypeDef (ident typ) undefNode
+cMaybeVTyp _   Nothing                    = CStorageSpec $ CAuto undefNode
+
+-- | Convert function arguments into C
+cFunArgs :: ConversionParams -> Fun -> Either [Ident] ([CDecl],Bool)
+cFunArgs cp fun = Right (argsDefs, False)
+    where argDef (i,t) = CDecl [cVTyp cp t]
+                               [(Just (CDeclr (Just (ident i)) [] Nothing [] undefNode),Nothing,Nothing)]
+                               undefNode
+          argsDefs = let defs = map argDef (args fun)
+                     in  case fun of
+                           Fun{}    -> defs
+                           FunRec{} -> boundarg : defs
+          boundarg = CDecl [CTypeSpec (CUnsigType undefNode),CTypeSpec (CIntType undefNode)]
+                           [(Just (CDeclr (Just (ident (recBoundName cp))) [] Nothing [] undefNode)
+                            ,Nothing,Nothing)]
+                           undefNode
+
+-- | Convert a function prototype into C
+toCPrototype :: ConversionParams -> Fun -> CExtDecl
+toCPrototype cp fun = CDeclExt (CDecl [CStorageSpec (CExtern undefNode)
+                                      ,cVTyp cp (resTyp fun)]
+                                      [(Just (CDeclr (Just (ident (self fun)))
+                                                     [CFunDeclr (cFunArgs cp fun) [] undefNode]
+                                                     Nothing [] undefNode)
+                                       ,Nothing,Nothing)]
+                                      undefNode)
+
+-- | Convert a Deep expression into a C expression
+-- Take as arguments the conversion parameters and the enclosing
+-- function
+-- It might result in no expression at all, when the expression is Coq
+-- unit (since no expression should be of type void)
+--
+-- TODO: Should we accept IfThenElse in expressions (we might turn
+-- them into ternary expressions)?
+cExpression :: ConversionParams -> Fun -> Exp -> Either ErrorMsg (Maybe CExpr)
+cExpression cp fun (Return e)             = cExpression cp fun e
+cExpression cp   _ (Const v) | v == tt cp = pure Nothing
+                             | otherwise  = pure $ Just $ CVar (ident v) undefNode
+cExpression  _   _ (Var v)                = pure $ Just $ CVar (ident v) undefNode
+-- | Call of a unary operator
+cExpression cp fun e@(Call f [a]) | Map.member f (unaryOps cp) = do
+                                a' <- cExpression cp fun a
+                                case a' of
+                                  Nothing  -> Left $ "Impossible to convert unary op " ++ show e
+                                  Just a'' -> pure $ Just $ CUnary (fromJust $ Map.lookup f $ unaryOps cp) a'' undefNode
+-- | Call of a binary operator
+cExpression cp fun e@(Call f as@[_,_]) | Map.member f (binaryOps cp) = do
+                                as' <- traverse (cExpression cp fun) as
+                                case as' of
+                                  [Just a1, Just a2] -> pure $ Just $ CBinary (fromJust $ Map.lookup f $ binaryOps cp) a1 a2 undefNode
+                                  _                  -> Left $ "Impossible to convert binary op " ++ show e
+-- | Call, general case
+-- This must handle in particular whether we are performing a
+-- recursive call, or a call to another recursive function
+cExpression cp fun (Call f as) = do as' <- traverse (cExpression cp fun) as
+                                    let as'' = catMaybes (recBound:as')
+                                    pure $ Just $ CCall (CVar (ident f) undefNode) as'' undefNode
+    where recBound | f == self fun = -- recBoundName - 1
+                                     Just $ CBinary CSubOp
+                                                    (CVar (ident (recBoundName cp)) undefNode)
+                                                    (unsignedConst 1)
+                                                    undefNode
+                   | otherwise     = case lookup f (calls fun) of
+                                       Just (Just v) -> Just $ boundExp v
+                                       _             -> Nothing
+          boundExp (c, vs) = let vs'  = map (flip CVar undefNode . ident) vs
+                                 vs'' = if c == 0 then vs' else vs' ++ [unsignedConst c]
+                             in  if null vs''
+                                    then unsignedConst 0
+                                    else foldr1 (\e1 e2 -> CBinary CAddOp e1 e2 undefNode) vs''
+cExpression   _   _ e           = Left $ "Impossible to convert expression \"" ++ show e ++ "\" to C"
+
+-- | Convert an expression into statements
+-- Take as arguments the conversion parameters, the enclosing
+-- function and whether the result should be returned or not
+-- It will result in 0, 1 or 2 statements
+-- It will result in two statements when it should return
+-- and the expression is of type void
+cExprStmt :: ConversionParams -> Fun -> Bool -> Exp -> Either ErrorMsg [CStat]
+cExprStmt cp fun tailRet e = do e' <- cExpression cp fun e
+                                pure $ case tailRet of
+                                  True | resTyp fun == unit cp
+                                         && isJust e'           -> [ CExpr   e'      undefNode
+                                                                   , CReturn Nothing undefNode ]
+                                       | otherwise              -> [ CReturn e'      undefNode ]
+                                  _    | isJust e'              -> [ CExpr   e'      undefNode ]
+                                       | otherwise              -> []
+
+-- | Convert a Deep expression into a block of statements
+-- Take as arguments the conversion parameters and the enclosing function
+cBlock :: ConversionParams -> Fun -> Exp -> Either ErrorMsg CStat
+cBlock cp fun = goBlock True
+    where goStmt :: Bool -> Exp -> Either ErrorMsg [CStat]
+          -- | The Return case is ready for the Return-less Deep
+          -- language
+          goStmt tailRet (Return e)         = goStmt tailRet e
+          goStmt tailRet (IfThenElse i t e) = do i' <- cExpression cp fun i
+                                                 case i' of
+                                                   Just i'' -> do
+                                                         t' <- goBlock tailRet t
+                                                         e' <- goBlock tailRet e
+                                                         pure [CIf i'' t' (Just e') undefNode]
+                                                   Nothing  -> Left $ "Impossible to convert " ++ show i
+          goStmt tailRet e@(Var _)    = cExprStmt cp fun tailRet e
+          goStmt tailRet e@(Const _)  = cExprStmt cp fun tailRet e
+          goStmt tailRet e@(Call _ _) = cExprStmt cp fun tailRet e
+
+          -- | Flatten a sequence of binds into a list of triples
+          -- ('tailRet', 'VId' if named 'Bind', 'exp')
+          -- Note that 'tailRet' is always 'False' when 'VId' is not
+          -- 'Nothing'
+          flatten :: Bool -> Exp -> [(Bool, Maybe (VId, Maybe VTyp), Exp)]
+          flatten tailRet (Bind v t e1 e2) = (False, Just (v, t),  e1) : flatten tailRet e2
+          flatten tailRet (BindN    e1 e2) = (False, Nothing,      e1) : flatten tailRet e2
+          flatten tailRet e                = [(tailRet, Nothing, e)]
+
+          goBlock :: Bool -> Exp -> Either ErrorMsg CStat
+          goBlock tailRet e = block <$> traverse entry (flatten tailRet e)
+              where block stmts = CCompound [] (concat stmts) undefNode
+
+                    entry (tailRet', Nothing, e') = map CBlockStmt <$> goStmt tailRet' e'
+                    entry (       _, Just vt, e') = maybeToList . fmap (CBlockDecl . decl vt)
+                                                                   <$> cExpression cp fun e'
+
+                    decl (v,t) e' = CDecl [cMaybeVTyp cp t]
+                                          [(Just (CDeclr (Just (ident v)) [] Nothing [] undefNode)
+                                           ,Just (CInitExpr e' undefNode)
+                                           ,Nothing)]
+                                          undefNode
+
+-- | Convert a function body into C
+cFunBody :: ConversionParams -> Fun -> Either ErrorMsg CStat
+cFunBody cp fun@(Fun    _ _ _ _ b)     = cBlock cp fun b
+cFunBody cp fun@(FunRec _ _ _ _ bO bS) = do bO' <- cBlock cp fun bO
+                                            bS' <- cBlock cp fun bS
+                                            pure $ CCompound []
+                                                             [CBlockStmt $
+                                                                CIf (CBinary CEqOp bnd zero undefNode)
+                                                                    bO' (Just bS') undefNode]
+                                                             undefNode
+    where zero = unsignedConst 0
+          bnd  = CVar (ident (recBoundName cp)) undefNode
+
+-- | Convert a function definition into C
+toCDefinition :: ConversionParams -> Fun -> Either ErrorMsg CFunDef
+toCDefinition cp fun = do b <- cFunBody cp fun
+                          pure $ CFunDef [cVTyp cp (resTyp fun)]
+                                         (CDeclr (Just (ident (self fun)))
+                                                 [CFunDeclr (cFunArgs cp fun) [] undefNode]
+                                                 Nothing [] undefNode)
+                                         [] b undefNode
+
+-- | Convert a module from its Deep intermediate representation into C
+-- source code
+toCSource :: ConversionParams -> DeepModule -> ([ErrorMsg], CTranslUnit)
+toCSource cp modul = second buildUnit $ partitionEithers $ map go funs
+    where funs = functionsDeepMod modul
+          go :: Either ErrorMsg (Name,Fun) -> Either ErrorMsg CExtDecl
+          go funErr = do (_,fun) <- funErr
+                         fun'    <- toCDefinition cp fun
+                         pure (CFDefExt fun')
+          buildUnit defs = CTranslUnit defs undefNode
+
+-- | Convert a module from its Deep intermediate representation into a
+-- C header file
+toCHeader :: ConversionParams -> DeepModule -> ([ErrorMsg], CTranslUnit)
+toCHeader cp modul = second (buildUnit . map (toCPrototype cp . snd)) $ partitionEithers funs
+    where funs           = functionsDeepMod modul
+          buildUnit defs = CTranslUnit defs undefNode
diff --git a/src/Language/Coq/ExtractedAST.hs b/src/Language/Coq/ExtractedAST.hs
new file mode 100644
index 0000000000000000000000000000000000000000..7af363f7a4aea6ed9bf3c5f9652044ea62f11029
--- /dev/null
+++ b/src/Language/Coq/ExtractedAST.hs
@@ -0,0 +1,537 @@
+-- This software is governed by the CeCILL license under French law and
+-- abiding by the rules of distribution of free software.  You can  use,
+-- modify and/ or redistribute the software under the terms of the CeCILL
+-- license as circulated by CEA, CNRS and INRIA at the following URL
+-- "http://www.cecill.info".
+
+-- As a counterpart to the access to the source code and  rights to copy,
+-- modify and redistribute granted by the license, users are provided only
+-- with a limited warranty  and the software's author,  the holder of the
+-- economic rights,  and the successive licensors  have only  limited
+-- liability.
+
+-- In this respect, the user's attention is drawn to the risks associated
+-- with loading,  using,  modifying and/or developing or reproducing the
+-- software by the user in light of its specific status of free software,
+-- that may mean  that it is complicated to manipulate,  and  that  also
+-- therefore means  that it is reserved for developers  and  experienced
+-- professionals having in-depth computer knowledge. Users are therefore
+-- encouraged to load and test the software's suitability as regards their
+-- requirements in conditions enabling the security of their systems and/or
+-- data to be ensured and,  more generally, to use and operate it in the
+-- same conditions as regards security.
+
+-- The fact that you are presently reading this means that you have had
+-- knowledge of the CeCILL license and that you accept its terms.
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+
+module Language.Coq.ExtractedAST where
+
+import           Control.Arrow    (first)
+import           Data.Aeson
+import           Data.Aeson.Types (Parser)
+import           Data.Default
+import           Data.List        (elemIndex, find, isPrefixOf)
+import           Data.Map         (Map)
+import qualified Data.Map         as Map
+import           Data.Maybe       (fromMaybe, isJust, mapMaybe)
+import qualified Data.Set         as Set
+
+-- | Type (and sub-types) of the elements of the CoqAST as named in
+-- JSON document
+data WhatT = DeclT DeclT
+           | FixgrpT FixgrpT
+           | TypeT TypeT
+           | ExprT ExprT
+           | CaseT
+           | PatT PatT
+           | ModuleT
+    deriving (Show,Eq)
+
+data DeclT   = TermDT | FixgrpDT
+    deriving (Show,Eq)
+data FixgrpT = ItemFT
+    deriving (Show,Eq)
+data TypeT   = ArrowTT | GlobTT | VaridxTT
+    deriving (Show,Eq)
+data ExprT   = LambdaET| ApplyET | GlobalET | ConstructorET | RelET | CaseET | LetET
+    deriving (Show,Eq)
+data PatT    = ConstructorPT | WildPT
+    deriving (Show,Eq)
+
+-- | Parse the type of an element in the JSON document
+toWhatType :: String -> Parser WhatT
+toWhatType strType =
+  case strType of
+    "case"             -> pure   CaseT
+    "module"           -> pure   ModuleT
+    "decl:term"        -> pure $ DeclT   TermDT
+    "decl:fixgroup"    -> pure $ DeclT   FixgrpDT
+    "fixgroup:item"    -> pure $ FixgrpT ItemFT
+    "type:arrow"       -> pure $ TypeT   ArrowTT
+    "type:glob"        -> pure $ TypeT   GlobTT
+    "type:varidx"      -> pure $ TypeT   VaridxTT
+    "expr:lambda"      -> pure $ ExprT   LambdaET
+    "expr:apply"       -> pure $ ExprT   ApplyET
+    "expr:global"      -> pure $ ExprT   GlobalET
+    "expr:constructor" -> pure $ ExprT   ConstructorET
+    "expr:rel"         -> pure $ ExprT   RelET
+    "expr:case"        -> pure $ ExprT   CaseET
+    "expr:let"         -> pure $ ExprT   LetET
+    "pat:constructor"  -> pure $ PatT    ConstructorPT
+    "pat:wild"         -> pure $ PatT    WildPT
+    strError           -> fail $ "Error: WhatType \"" ++ strError ++ "\" undefined"
+
+instance FromJSON WhatT where
+  parseJSON (Object v) = toWhatType =<< v .: "what"
+  parseJSON _          = fail "Error: WhatType undefined"
+
+type Name = String
+type FunName = Name
+type ArgName = Name
+
+-- | Apply a function on all the names of an AST
+class Renamable a where
+    rename :: (Name -> Name) -> a -> a
+
+data Decl = Term     { nameTerm  :: Name
+                     , typeTerm  :: Type
+                     , valueTerm :: Expr
+                     }
+          | Fixgroup { fixItems  :: [FixItem]
+                     }
+    deriving (Show,Eq)
+
+instance Renamable Decl where
+    rename f (Term n t v)  = Term (f n) (rename f t) (rename f v)
+    rename f (Fixgroup gs) = Fixgroup (map (rename f) gs)
+
+instance FromJSON Decl where
+  parseJSON (Object v) = do
+    what <- toWhatType =<< v .: "what"
+    case what of
+      DeclT TermDT   -> Term <$> v .: "name" <*> v .: "type" <*> v .: "value"
+      DeclT FixgrpDT -> Fixgroup <$> v .: "fixlist"
+      _              -> fail "Error: Decl case undefined"
+  parseJSON _        =  fail "Error: Decl kind undefined"
+
+data FixItem = FixItem { nameItem  :: Name
+                       , typeItem  :: Type
+                       , valueItem :: Expr
+                       }
+    deriving (Show,Eq)
+
+instance Renamable FixItem where
+    rename f (FixItem n t v) = FixItem (f n) (rename f t) (rename f v)
+
+instance FromJSON FixItem where
+  parseJSON (Object v) = do
+    what <- toWhatType =<< v .: "what"
+    case what of
+      FixgrpT ItemFT -> FixItem <$> v .: "name" <*> v .: "type" <*> v .: "value"
+      _              -> fail "Error: Fixgroup case undefined"
+  parseJSON _        =  fail "Error: Fixgroup kind undefined"
+
+data Type = Arrow  { leftArrow  :: Type
+                   , rightArrow :: Type
+                   }
+          | Glob   { nameGlob :: Name
+                   , argsGlob :: [Type]
+                   }
+          | Varidx { nameVaridx :: Integer
+                   }
+    deriving (Show,Eq)
+
+instance Renamable Type where
+    rename f (Arrow l r) = Arrow (rename f l) (rename f r)
+    rename f (Glob n ts) = Glob (f n) (map (rename f) ts)
+    rename _          v  = v
+
+instance FromJSON Type where
+  parseJSON (Object v) = do
+    what <- toWhatType =<< v .: "what"
+    case what of
+      TypeT ArrowTT  -> Arrow  <$> v .: "left" <*> v .: "right"
+      TypeT GlobTT   -> Glob   <$> v .: "name" <*> v .: "args"
+      TypeT VaridxTT -> Varidx <$> v .: "name"
+      _              -> fail "Error: Type case undefined"
+  parseJSON _        =  fail "Error: Type kind undefined"
+
+data Expr = Lambda       { argnamesLambda :: [Name]
+                         , bodyLambda     :: Expr
+                         }
+          | Apply        { funcApply :: Expr
+                         , argsApply :: [Expr]
+                         }
+          | Global       { nameGlobal :: Name
+                         }
+          | ConstructorE { nameConstructorE :: Name
+                         , argsConstructorE :: [Expr]
+                         }
+          | Rel          { nameRel :: Name
+                         }
+          | Case         { exprCase  :: Expr
+                         , casesCase :: [Case]
+                         }
+          | Let          { nameLet    :: Name
+                         , namevalLet :: Expr
+                         , bodyLet    :: Expr
+                         }
+    deriving (Show,Eq)
+
+instance Renamable Expr where
+    rename f (Lambda ns e)       = Lambda (map f ns) (rename f e)
+    rename f (Apply fun as)      = Apply (rename f fun) (map (rename f) as)
+    rename f (Global n)          = Global (f n)
+    rename f (ConstructorE n as) = ConstructorE (f n) (map (rename f) as)
+    rename f (Rel n)             = Rel (f n)
+    rename f (Case e cs)         = Case (rename f e) (map (rename f) cs)
+    rename f (Let n v b)         = Let (f n) (rename f v) (rename f b)
+
+instance FromJSON Expr where
+  parseJSON (Object v) = do
+    what <- toWhatType =<< v .: "what"
+    case what of
+      ExprT LambdaET      -> Lambda       <$> v .: "argnames" <*> v .: "body"
+      ExprT ApplyET       -> Apply        <$> v .: "func" <*> v .: "args"
+      ExprT GlobalET      -> Global       <$> v .: "name"
+      ExprT ConstructorET -> ConstructorE <$> v .: "name" <*> v .: "args"
+      ExprT RelET         -> Rel          <$> v .: "name"
+      ExprT CaseET        -> Case         <$> v .: "expr" <*> v .: "cases"
+      ExprT LetET         -> Let          <$> v .: "name" <*> v .: "nameval" <*> v .: "body"
+      _                   -> fail "Error: Expr case undefined"
+  parseJSON _             =  fail "Error: Expr kind undefined"
+
+data Case = C { patC  :: Pat
+              , bodyC :: Expr
+              }
+    deriving (Show,Eq)
+
+instance Renamable Case where
+    rename f (C p b) = C (rename f p) (rename f b)
+
+instance FromJSON Case where
+  parseJSON (Object v) = do
+    what <- toWhatType =<< v .: "what"
+    case what of
+      CaseT   -> C <$> v .: "pat" <*> v .: "body"
+      _       -> fail "Error: Case case undefined"
+  parseJSON _ =  fail "Error: Case kind undefined"
+
+data Pat = ConstructorP { nameConstructorP     :: Name
+                        , argnamesConstructorP :: [Name]
+                        }
+         | WildP
+    deriving (Show,Eq)
+
+instance Renamable Pat where
+    rename f (ConstructorP n as) = ConstructorP (f n) (map f as)
+    rename _                  w  = w
+
+instance FromJSON Pat where
+  parseJSON (Object v) = do
+    what <- toWhatType =<< v .: "what"
+    case what of
+      PatT ConstructorPT -> ConstructorP <$> v .: "name" <*> v .: "argnames"
+      PatT WildPT        -> return WildP
+      _                  -> fail "Error: Pat case undefined"
+  parseJSON _            =  fail "Error: Pat kind undefined"
+
+type ModuleUsed = Name
+type FileName   = String
+data Module = Mod { nameMod         :: Name
+                  , needMagicMod    :: Bool
+                  , needDummyMod    :: Bool
+                  , usedModulesMod  :: [ModuleUsed]
+                  , declarationsMod :: [Decl]
+                  }
+    deriving (Show,Eq)
+
+instance Renamable Module where
+    rename f (Mod n m d mus ds) = Mod (f n) m d (map f mus) (map (rename f) ds)
+
+instance FromJSON Module where
+  parseJSON (Object v) = do
+    what <- toWhatType =<< v .: "what"
+    case what of
+      ModuleT -> Mod <$>
+        v .: "name"         <*>
+        v .: "need_magic"   <*>
+        v .: "need_dummy"   <*>
+        v .: "used_modules" <*>
+        v .: "declarations"
+      _       -> fail "Error: Module case undefined"
+  parseJSON _ =  fail "Error: Module kind undefined"
+
+
+-- | == Cleaning up the AST
+
+-- | Drop the full qualification of names in the given 'Renamable' for
+-- all the modules of 'modNames'
+--
+-- >>> unqualify ["Module"] (Global "Module.Test.val")
+-- Global {nameGlobal = "Test.val"}
+-- >>> unqualify ["Module"] (Global "Module2.val")
+-- Global {nameGlobal = "Module2.val"}
+-- >>> unqualify ["Module"] (Global "Module.Module.val")
+-- Global {nameGlobal = "Module.val"}
+-- >>> unqualify ["M"] (Mod "M.Test" False False [] [])
+-- Mod {nameMod = "Test", needMagicMod = False, needDummyMod = False, usedModulesMod = [], declarationsMod = []}
+-- >>> unqualify ["M"] (Mod "Mo.Test" False False [] [])
+-- Mod {nameMod = "Mo.Test", needMagicMod = False, needDummyMod = False, usedModulesMod = [], declarationsMod = []}
+--
+unqualify :: Renamable r => [ModuleUsed] -> r -> r
+unqualify modNames = rename go
+    where go n = case find (\m -> (m ++ ".") `isPrefixOf` n) modNames of
+                   Just modName -> drop (length modName + 1) n
+                   Nothing      -> n
+
+-- | Rename according to the given map
+--
+-- >>> rewriteNames (Map.fromList [("coq_true", "true")]) (Global "coq_true")
+-- Global {nameGlobal = "true"}
+-- >>> rewriteNames (Map.fromList [("coq_true", "true")]) (Global "coq_false")
+-- Global {nameGlobal = "coq_false"}
+rewriteNames :: Renamable r => Map Name Name -> r -> r
+rewriteNames nameMap = rename f
+    where f n = fromMaybe n $ Map.lookup n nameMap
+
+-- | Replace dots (qualified names) with a given string
+--
+-- >>> undotify "_" (Global "Module.function")
+-- Global {nameGlobal = "Module_function"}
+undotify :: Renamable r => String -> r -> r
+undotify "."   = id
+undotify subst = rename (concatMap f)
+    where f '.' = subst
+          f  x  = [x]
+
+-- | Clean up the source AST
+--
+-- Do:
+--
+-- * drop module names
+-- * rewrite names according to the given map
+-- * replace dots by the given string
+clean :: Renamable r => [ModuleUsed] -> Map Name Name -> String -> r -> r
+clean mods rewrts dot = undotify dot . rewriteNames rewrts . unqualify mods
+
+-- | Clean up the source AST of a full module
+--
+-- Do a standard 'clean' /after/ a first pass to remove the name of
+-- the module itself.
+-- This is necessary because, when extracting a module @A@, the JSON
+-- extractor extracts a definition @d@ as is (not with as @A.d@ but as
+-- @d@); but it extracts a definition @d'@ in a submodule @B@ as
+-- @A.B.d'@.
+cleanModule :: [ModuleUsed] -> Map Name Name -> String -> Module -> Module
+cleanModule mods rewrts dot modul = clean mods rewrts dot $ unqualify [nameMod modul] modul
+
+-- | Description of how Coq’s nat constructors and addition function
+-- are represented in the extracted AST
+-- Recursive-function bounds are of type nat, these parameters define
+-- how they will be identified in the extracted AST
+data CoqNat = CN { natO   :: FunName -- ^ How Coq’s O (nat) is extracted
+                 , natS   :: FunName -- ^ How Coq’s S (nat) is extracted
+                 , natAdd :: FunName -- ^ How Coq’s addition function on nat is extracted
+                 }
+    deriving (Show,Eq)
+
+instance Default CoqNat where
+    def = CN { natO   = "O"
+             , natS   = "S"
+             , natAdd = "add"
+             }
+
+-- | Type of the map associating function with their bound of
+-- recursive calls (the name of the argument and its position)
+type RecursiveBoundMap = Map FunName RecursiveBoundId
+type Position = Int
+type RecursiveBoundId = Position
+
+-- | Type of a recursive-function bound and of its constant part
+-- A recursive-function bound is the sum of a constant natural number
+-- with some global values
+type RecursiveBound      = (RecursiveBoundConst, [Name])
+type RecursiveBoundConst = Integer
+
+-- | Detect bounds for all the recursive functions of a module
+--
+-- Recursive functions are accepted only whenever they have an
+-- argument that is bounding the number of recursive steps and when
+-- they always start by checking whether that bound is 0 or not
+-- When a fixitem does have a recursive bound, return the name of the
+-- fixitem and the pair of the name of the argument and its position
+-- in the argument list
+--
+-- >>> :{
+--  detectBounds def (Mod "Simple" False False []
+--      [Fixgroup
+--          [FixItem "recursive"
+--              (Arrow (Glob "nat" []) (Glob "unit" []))
+--              (Lambda ["bound"]
+--                  (Case (Rel "bound")
+--                      [C (ConstructorP "O" []) (ConstructorE "tt" [])
+--                      ,C (ConstructorP "S" ["n"]) (Apply (Global "recursive") [Rel "n"])]))]])
+-- :}
+-- fromList [("recursive",0)]
+detectBounds :: CoqNat -> Module -> RecursiveBoundMap
+detectBounds nats = Map.fromList . concatMap f . declarationsMod
+    where f (Fixgroup is) = mapMaybe (detectBoundFixItem nats) is
+          f _             = []
+
+-- | Detect which argument is the bound in a FixItem
+--
+-- >>> :{
+--  detectBoundFixItem def
+--      (FixItem "recursive"
+--          (Arrow (Glob "nat" []) (Glob "unit" []))
+--          (Lambda ["bound"]
+--              (Case (Rel "bound")
+--                  [C (ConstructorP "O" []) (ConstructorE "tt" [])
+--                  ,C (ConstructorP "S" ["n"]) (Apply (Global "recursive") [Rel "n"])])))
+-- :}
+-- Just ("recursive",0)
+detectBoundFixItem :: CoqNat -> FixItem -> Maybe (FunName, RecursiveBoundId)
+detectBoundFixItem CN{..} (FixItem ni _
+                              (Lambda args
+                                  (Case (Rel na)
+                                        [C (ConstructorP o [])  _
+                                        ,C (ConstructorP s [_]) _])))
+    | o == natO && s == natS = do pos <- elemIndex na args
+                                  pure (ni, pos)
+detectBoundFixItem _ _       = Nothing
+
+type ErrorMsg = String
+
+-- | Extract a recursive-function bound from an expression, when
+-- possible
+-- Recognize an expression as a recursive-function bound if it is
+-- composed of (natural numbers) additions, S, O and global values
+--
+-- For example, we can have \( n + 1 \), written as preferred, or even
+-- some more complex expression, like \( (n+1) + ((1+m) + 2) \),
+-- reduced to \( n + m + 4 \).
+--
+-- >>> :{
+--  extractRecBoundExpr
+--      def
+--      (ConstructorE "S" [Global "n"])
+-- :}
+-- Just (1,["n"])
+--
+-- >>> :{
+--  extractRecBoundExpr
+--      def
+--      (Apply
+--          (Global "add")
+--          [Global "n"
+--          ,ConstructorE "S" [ConstructorE "O" []]])
+-- :}
+-- Just (1,["n"])
+--
+-- >>> :{
+--  extractRecBoundExpr
+--      def
+--      (Apply
+--          (Global "add")
+--          [ConstructorE "S" [Global "n"]
+--          ,Apply (Global "add")
+--            [Apply (Global "add")
+--              [ConstructorE "S" [ConstructorE "O" []]
+--              ,Global "m"]
+--            ,ConstructorE "S" [ConstructorE "S" [ConstructorE "O" []]]]])
+-- :}
+-- Just (4,["n","m"])
+--
+extractRecBoundExpr :: CoqNat -> Expr -> Maybe (RecursiveBoundConst, [Name])
+extractRecBoundExpr CN{..} = go
+    where go (Global n)                               = Just (0, [n])
+          go (ConstructorE o [])        | o == natO   = Just (0, [])
+          go (ConstructorE s [e])       | s == natS   = first (+1) <$> go e
+          go (Apply (Global f) [e1,e2]) | f == natAdd = do (c1, ns1) <- go e1
+                                                           (c2, ns2) <- go e2
+                                                           pure (c1 + c2, ns1 ++ ns2)
+          go _                                        = Nothing
+
+-- | Extract and rewrite recursive-function calls
+-- Extract the list of recursive functions a given function calls;
+-- also extract the bound (if there are more than one call to a given
+-- recursive function, they must use the same bound)
+-- Rewrite the expression to remove the recursive bounds from the calls
+--
+-- TODO: should the behaviour be to fail when various bounds are used
+-- (to report the error), or extract one randomly, or?
+--
+-- >>> :{
+--  extractRecCalls
+--      def
+--      "recursive"
+--      (Map.fromList [("recursive",0)])
+--      (Apply (Global "recursive") [Rel "n"])
+-- :}
+-- Right ([],Apply {funcApply = Global {nameGlobal = "recursive"}, argsApply = []})
+--
+-- >>> :{
+--  extractRecCalls
+--      def
+--      "callrec"
+--      (Map.fromList [("recursive",0)])
+--      (Apply (Global "recursive") [Global "bnd"])
+-- :}
+-- Right ([("recursive",(0,["bnd"]))],Apply {funcApply = Global {nameGlobal = "recursive"}, argsApply = []})
+--
+extractRecCalls :: CoqNat -> FunName -> RecursiveBoundMap -> Expr -> Either ErrorMsg ([(FunName, RecursiveBound)], Expr)
+extractRecCalls cn self recs expr = deDup <$> isConsistent (go expr)
+    where go :: Expr -> Either ErrorMsg ([(FunName, RecursiveBound)], Expr)
+          go e@(Apply fun@(Global f) args) = do
+                (nm, args') <- case Map.lookup f recs of
+                           Just pos | pos < length args ->
+                                      case splitAt pos args of
+                                        (a1, _ : a2) | f == self  -> pure (Nothing, a1 ++ a2)
+                                        (a1, a : a2) | isJust bnd -> pure (bnd,  a1 ++ a2)
+                                            where bnd = extractRecBoundExpr cn a
+                                        _                         -> Left $ expectedBound f pos e
+                                    | otherwise         -> Left $ missingArgs f pos e
+                           Nothing                      -> pure (Nothing, args)
+                (calls, expr') <- drills (Apply fun) args'
+                case nm of
+                    Just nm' -> pure ((f, nm') : calls, expr')
+                    Nothing  -> pure (calls, expr')
+
+          go (Apply f args)        = drills (Apply f) args
+          go (Lambda args body)    = drill  (Lambda args) body
+          go (ConstructorE n args) = drills (ConstructorE n) args
+          go (Case expr' cases)    = do (calls, exprs) <- drills id (map bodyC cases)
+                                        let cases' = zipWith (\c e -> C (patC c) e) cases exprs
+                                        pure (calls, Case expr' cases')
+          go (Let var val body)    = do (calls,  let')  <- drill (Let var) val
+                                        (calls', let'') <- drill let' body
+                                        pure (calls ++ calls', let'')
+          go e@(Global _)          = pure ([], e)
+          go e@(Rel _)             = pure ([], e)
+
+          drills f exprs = do (calls, exprs') <- unzip <$> traverse go exprs
+                              pure (concat calls, f exprs')
+
+          drill f e = do (calls, e') <- go e
+                         pure (calls, f e')
+
+          isConsistent r@(Right (calls, _)) = let assoc = Map.fromList calls
+                                                  check = map (\(f, v) -> (f, Just v /= Map.lookup f assoc)) calls
+                                              in  case find snd check of
+                                                    Just (f, _) -> Left $ inconsistentCall f expr
+                                                    Nothing     -> r
+          isConsistent r                    = r
+
+          deDup (as, b) = (Set.toList (Set.fromList as), b)
+
+          missingArgs f nb e = "Not enough arguments: \"" ++ f ++ "\" expects at least " ++ show nb
+                            ++ " arguments; in " ++ show e
+          expectedBound f nb e = "Recursive bound argument expected: \"" ++ f ++ "\"'s "
+                              ++ show nb ++"th argument should be an expression containing only "
+                              ++ "natural numbers, additions and global values; in " ++ show e
+          inconsistentCall f e = "Inconsistent calls of " ++ f ++ " with different recursive bounds; in "
+                              ++ show e
diff --git a/stack.yaml b/stack.yaml
index 7e0057e48aa9488a50ee1b6aed8c72098b5d54d8..baff5a58e7b7e14ec116588546732a8aaf146065 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,4 +1,4 @@
-resolver: lts-6.17
+resolver: lts-7.8
 
 packages:
 - '.'
diff --git a/version b/version
index 085135ec98c54765be5be40d9501434b2ce803a4..60fe1f267badc7a9d0cb936f49f165395f00e25a 100644
--- a/version
+++ b/version
@@ -1 +1 @@
-v0.1
+v0.2