diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2015, Markus Aronsson
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Markus Aronsson nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/imperative-edsl-vhdl.cabal b/imperative-edsl-vhdl.cabal
new file mode 100644
--- /dev/null
+++ b/imperative-edsl-vhdl.cabal
@@ -0,0 +1,49 @@
+-- Initial imperative-edsl-vhdl.cabal generated by cabal init.  For further
+--  documentation, see http://haskell.org/cabal/users-guide/
+
+name:                imperative-edsl-vhdl
+version:             0.2
+synopsis:            Deep embedding of VHDL programs with code generation.
+-- description:         
+license:             BSD3
+license-file:        LICENSE
+author:              Markus Aronsson
+maintainer:          mararon@chalmers.se
+-- copyright:           
+category:            Language
+build-type:          Simple
+-- extra-source-files:  
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     Language.Embedded.VHDL,
+                       Language.Embedded.VHDL.Monad,
+                       Language.Embedded.VHDL.Monad.Expression,
+                       Language.Embedded.VHDL.Interface,
+                       Language.Embedded.VHDL.Expression,
+                       Language.Embedded.VHDL.Expression.Hoist,
+                       Language.Embedded.VHDL.Expression.Format,
+                       Language.Embedded.VHDL.Expression.Type,
+                       Language.Embedded.VHDL.Command
+
+  -- other-modules:                              
+  other-extensions:    TypeFamilies,
+                       KindSignatures,
+                       ConstraintKinds,
+                       GeneralizedNewtypeDeriving,
+                       StandaloneDeriving,
+                       MultiParamTypeClasses,
+                       FlexibleInstances,
+                       FlexibleContexts,
+                       UndecidableInstances
+                       
+  build-depends:       base                 >=4   && <5,
+                       mtl                  >=2.2 && <3,
+                       bytestring,
+                       constraints,
+                       containers           >=0.1 && <1,
+                       operational-alacarte >=0.1.1,
+                       language-vhdl        >=0.1.1.0,
+                       pretty               >=1.0
+  hs-source-dirs:      .,src
+  default-language:    Haskell2010
diff --git a/src/Language/Embedded/VHDL.hs b/src/Language/Embedded/VHDL.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Embedded/VHDL.hs
@@ -0,0 +1,16 @@
+module Language.Embedded.VHDL
+  ( Mode(..)
+  , module Language.Embedded.VHDL.Interface
+  , module Language.Embedded.VHDL.Expression
+  , module Language.Embedded.VHDL.Expression.Type
+  , module Language.Embedded.VHDL.Expression.Format
+  , module Language.Embedded.VHDL.Command
+  ) where
+
+import Language.VHDL (Mode(..))
+
+import Language.Embedded.VHDL.Interface
+import Language.Embedded.VHDL.Expression
+import Language.Embedded.VHDL.Expression.Type
+import Language.Embedded.VHDL.Expression.Format
+import Language.Embedded.VHDL.Command
diff --git a/src/Language/Embedded/VHDL/Command.hs b/src/Language/Embedded/VHDL/Command.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Embedded/VHDL/Command.hs
@@ -0,0 +1,387 @@
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE KindSignatures        #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+
+module Language.Embedded.VHDL.Command where
+
+import Language.VHDL (Identifier(..), Label, Expression, Mode(..))
+import qualified Language.VHDL as V
+
+import Language.Embedded.VHDL.Monad           (VHDLT, VHDL)
+import Language.Embedded.VHDL.Interface
+import Language.Embedded.VHDL.Expression.Type (Type, Kind)
+import qualified Language.Embedded.VHDL.Monad            as M
+import qualified Language.Embedded.VHDL.Expression.Type  as T
+import qualified Language.Embedded.VHDL.Expression.Hoist as H
+
+import Control.Arrow (second)
+import Control.Monad.Identity
+import Control.Monad.Operational.Higher
+import Control.Applicative
+import Data.Typeable
+import Data.ALaCarte
+
+--------------------------------------------------------------------------------
+-- *
+--------------------------------------------------------------------------------
+
+instance CompileExp exp => Interp (SequentialCMD exp) VHDL
+  where
+    interp = compileSequential
+
+instance CompileExp exp => Interp (ConcurrentCMD exp) VHDL
+  where
+    interp = compileConcurrent
+
+instance CompileExp exp => Interp (HeaderCMD exp) VHDL
+  where
+    interp = compileHeader
+
+-- | Compile an VHDL program into a pretty printed text
+compile :: (Interp instr VHDL, HFunctor instr) => Program instr a -> String
+compile = show . M.prettyVHDL . interpret
+
+--------------------------------------------------------------------------------
+
+-- | Compile if 'exp' is set
+compEM :: CompileExp exp => Maybe (exp a) -> VHDL (Maybe Expression)
+compEM = maybe (return Nothing) (>>= return . Just) . fmap compE
+
+-- | Compile hidden type
+compTM :: forall exp a. (PredicateExp exp a, CompileExp exp) => Maybe (exp a) -> VHDL Type
+compTM _ = compT (undefined :: exp a)
+
+--------------------------------------------------------------------------------
+-- ** Sequential commands offered by VHDL
+
+data SequentialCMD (exp :: * -> *) (prog :: * -> *) a
+  where
+    Local
+      :: PredicateExp exp a
+      => Identifier
+      -> Kind
+      -> Maybe (exp a)
+      -> SequentialCMD exp prog ()
+
+    Assignment
+      :: PredicateExp exp a
+      => Identifier
+      -> Kind
+      -> exp a
+      -> SequentialCMD exp prog ()
+
+    If
+      :: (exp Bool, prog ())     -- if
+      -> [(exp Bool,  prog ())]  -- elseif*
+      -> prog ()                 -- else
+      -> SequentialCMD exp prog ()
+
+    Case
+      :: PredicateExp exp a
+      => exp a
+      -> [(exp a, prog ())]
+      -> Maybe (prog ())
+      -> SequentialCMD exp prog ()
+    
+instance HFunctor (SequentialCMD exp)
+  where
+    hfmap _ (Local i k e)      = Local i k e
+    hfmap _ (Assignment i k e) = Assignment i k e
+    hfmap f (If (b, t) os e)   = If (b, f t) (map (second f) os) (f e)
+    hfmap f (Case e cs d)      = Case e (map (second f) cs) (fmap f d)
+
+type instance IExp (SequentialCMD e)       = e
+type instance IExp (SequentialCMD e :+: i) = e
+
+--------------------------------------------------------------------------------
+
+-- | Declare local constands/variables/files
+constantL, variableL, fileL
+  :: (SequentialCMD (IExp instr) :<: instr, PredicateExp (IExp instr) a)
+  => Identifier
+  -> Maybe (IExp instr a)
+  -> ProgramT instr m ()
+constantL i = singleE . Local i T.Constant
+variableL i = singleE . Local i T.Variable
+fileL     i = singleE . Local i T.File
+
+-- | Assign a signal to some expression
+(<==) :: (SequentialCMD (IExp instr) :<: instr, PredicateExp (IExp instr) a)
+      => Identifier
+      -> IExp instr a
+      -> ProgramT instr m ()
+(<==) i = singleE . Assignment i T.Signal
+
+-- | Assign a variable to some expression
+(==:) :: (SequentialCMD (IExp instr) :<: instr, PredicateExp (IExp instr) a)
+      => Identifier
+      -> IExp instr a
+      -> ProgramT instr m ()
+(==:) i = singleE . Assignment i T.Variable
+
+-- | Conventional if statement
+iff
+  :: (SequentialCMD (IExp instr) :<: instr)
+  =>  (IExp instr Bool, ProgramT instr m ())
+  -> [(IExp instr Bool, ProgramT instr m ())]
+  -> ProgramT instr m ()
+  -> ProgramT instr m ()
+iff th eif el = singleE $ If th eif el
+
+-- | Conventional switch (or case) statement
+switch
+  :: (SequentialCMD (IExp instr) :<: instr, PredicateExp (IExp instr) a)
+  => IExp instr a
+  -> [(IExp instr a, ProgramT instr m ())]
+  -> Maybe (ProgramT instr m ())
+  -> ProgramT instr m ()
+switch e choices def = singleE $ Case e choices def
+
+--------------------------------------------------------------------------------
+
+-- | Guards a program by some predicate
+when
+  :: (SequentialCMD (IExp instr) :<: instr, Monad m)
+  => IExp instr Bool
+  -> ProgramT instr m ()
+  -> ProgramT instr m ()
+when b prg = singleE $ If (b, prg) [] (return ())
+
+-- | Standard 'if .. then .. else ..' statement
+ifThen
+  :: (SequentialCMD (IExp instr) :<: instr)
+  => IExp instr Bool
+  -> ProgramT instr m ()
+  -> ProgramT instr m ()
+  -> ProgramT instr m ()
+ifThen b th el = singleE $ If (b, th) [] el
+  
+--------------------------------------------------------------------------------
+
+compileSequential :: CompileExp exp => SequentialCMD exp VHDL a -> VHDL a
+compileSequential (Local i k e) =
+  do v <- compEM e
+     t <- compTM e
+     M.addLocal $ case k of
+       T.Constant -> M.declConstant i t v
+       T.Signal   -> M.declSignal   i t v
+       T.Variable -> M.declVariable i t v
+compileSequential (Assignment i k e) =
+  do v <- compE e
+     M.addSequential $ case k of
+       T.Signal -> M.assignSignal   i v
+       _        -> M.assignVariable i v
+compileSequential (If (b, th) eif els) =
+  do let (cs, es) = unzip eif
+     v  <- compE b
+     bs <- mapM compE cs
+     s  <- M.inConditional (v, th) (zip bs es) els
+     M.addSequential $ V.SIf s
+compileSequential (Case e choices def) =
+  do let (cs, es) = unzip choices
+     v  <- compE e
+     bs <- mapM (compE >=> return . lower) cs
+     s  <- M.inCase v (others def $ zip bs es)
+     M.addSequential $ V.SCase s
+  where
+    lower :: V.Expression -> V.Choices
+    lower exp = V.Choices . (:[]) . V.ChoiceSimple $
+      case exp of
+        (V.EAnd  rels) -> head' rels
+        (V.EOr   rels) -> head' rels
+        (V.EXor  rels) -> head' rels
+        (V.ENand r _)  -> drop' r
+        (V.ENor  r _)  -> drop' r
+        (V.EXnor rels) -> head' rels
+      where
+        head' :: [V.Relation] -> V.SimpleExpression
+        head' [] = H.lift $ V.PrimLit V.LitNull
+        head' xs = drop' (head xs)
+
+        drop' :: V.Relation -> V.SimpleExpression
+        drop' (V.Relation (V.ShiftExpression x _) _) = x
+
+    others :: Maybe x -> [(V.Choices, x)] -> [(V.Choices, x)]
+    others (Nothing) cs = cs
+    others (Just d)  cs = cs ++ [(V.Choices [V.ChoiceOthers], d)]
+
+--------------------------------------------------------------------------------
+-- ** Concurrent commands offered by VHDL
+
+data ConcurrentCMD exp (prog :: * -> *) a
+  where
+    Global
+      :: PredicateExp exp a  
+      => Identifier
+      -> Kind
+      -> Maybe (exp a)
+      -> ConcurrentCMD exp prog ()
+
+    Process
+      :: Label
+      -> [Identifier]
+      -> prog ()
+      -> ConcurrentCMD exp prog ()
+
+    PortMap
+      :: Identifier
+      -> [Identifier]
+      -> ConcurrentCMD exp prog ()
+
+instance HFunctor (ConcurrentCMD exp)
+  where
+    hfmap _ (Global  i k e)  = Global  i k e
+    hfmap f (Process l is p) = Process l is (f p)
+    hfmap _ (PortMap n is)   = PortMap n is
+
+type instance IExp (ConcurrentCMD e)       = e
+type instance IExp (ConcurrentCMD e :+: i) = e
+
+--------------------------------------------------------------------------------
+
+-- | Declare global constands/variables/files
+constantG, signalG, variableG, fileG 
+  :: (ConcurrentCMD (IExp instr) :<: instr, PredicateExp (IExp instr) a)
+  => Identifier
+  -> Maybe (IExp instr a)
+  -> ProgramT instr m ()
+constantG i = singleE . Global i T.Constant
+signalG   i = singleE . Global i T.Signal
+variableG i = singleE . Global i T.Variable
+fileG     i = singleE . Global i T.File
+
+-- | Declare a process
+process
+  :: (ConcurrentCMD (IExp instr) :<: instr)
+  => String
+  -> [Identifier]
+  -> ProgramT instr m ()
+  -> ProgramT instr m ()
+process i is = singleE . Process (Ident i) is
+
+--------------------------------------------------------------------------------
+
+compileConcurrent :: CompileExp exp => ConcurrentCMD exp VHDL a -> VHDL a
+compileConcurrent (Global i k e) =
+  do v <- compEM e
+     t <- compTM e
+     M.addGlobal $ case k of
+       T.Constant -> M.declConstant i t v
+       T.Signal   -> M.declSignal   i t v 
+       T.Variable -> M.declVariable i t v
+compileConcurrent (Process l is p) =
+  do (a, process) <- M.inProcess l is p
+     M.addConcurrent (V.ConProcess process)
+     return a
+compileConcurrent (PortMap n is) =
+  do let ads = fmap (V.ADSignal . V.NSimple) is
+     lbl <- M.newLabel
+     M.addConcurrent (M.portMap lbl n ads)
+     
+--------------------------------------------------------------------------------
+-- ** Entity declaration related commands offered by VHDL
+
+data DeclKind = Port | Generic
+
+data HeaderCMD exp (prog :: * -> *) a
+  where
+    Declare
+      :: PredicateExp exp a
+      => DeclKind
+      -> Identifier
+      -> Kind
+      -> Mode
+      -> Maybe (exp a)
+      -> HeaderCMD exp prog Identifier
+
+    Architecture
+      :: String
+      -> prog a
+      -> HeaderCMD exp prog a
+
+    Record
+      :: String
+      -> [(String, Type)]
+      -> HeaderCMD exp prog a
+
+instance HFunctor (HeaderCMD exp)
+  where
+    hfmap _ (Declare d i k m e) = Declare d i k m e
+    hfmap f (Architecture s p)  = Architecture s (f p)
+    hfmap _ (Record s es)       = Record s es
+
+type instance IExp (HeaderCMD e)       = e
+type instance IExp (HeaderCMD e :+: i) = e
+
+--------------------------------------------------------------------------------
+
+-- | Declare constands/signal/variables/files ports and generics
+constantPort, constantGeneric, signalPort, signalGeneric, variablePort, variableGeneric, filePort, fileGeneric
+  :: (HeaderCMD (IExp instr) :<: instr, PredicateExp (IExp instr) a)
+  => Identifier
+  -> Mode
+  -> Maybe (IExp instr a)
+  -> ProgramT instr m Identifier
+constantPort    i m = singleE . Declare Port    i T.Constant m
+constantGeneric i m = singleE . Declare Generic i T.Constant m
+signalPort      i m = singleE . Declare Port    i T.Signal   m
+signalGeneric   i m = singleE . Declare Generic i T.Signal   m
+variablePort    i m = singleE . Declare Port    i T.Variable m
+variableGeneric i m = singleE . Declare Generic i T.Variable m
+filePort        i m = singleE . Declare Port    i T.File     m
+fileGeneric     i m = singleE . Declare Generic i T.File     m
+
+-- | Declares a clock input port
+clock
+  :: forall instr m.
+     ( HeaderCMD    (IExp instr) :<: instr
+     , PredicateExp (IExp instr) Bool)
+  => ProgramT instr m Identifier
+clock = signalPort (Ident "clk") In (Nothing :: Maybe ((IExp instr) Bool))
+
+-- | Declares a reset input port
+reset
+  :: forall instr m.
+     ( HeaderCMD    (IExp instr) :<: instr
+     , PredicateExp (IExp instr) Bool)
+  => ProgramT instr m Identifier
+reset = signalPort (Ident "reset") In (Nothing :: Maybe ((IExp instr) Bool))
+
+-- | Declare an architecture
+architecture
+  :: (HeaderCMD (IExp instr) :<: instr)
+  => String
+  -> ProgramT instr m a
+  -> ProgramT instr m a
+architecture name = singleE . Architecture name
+
+--------------------------------------------------------------------------------
+
+compileHeader :: CompileExp exp => HeaderCMD exp VHDL a -> VHDL a
+compileHeader (Declare Port i k m e) =
+  do v <- compEM e
+     t <- compTM e
+     M.addPort $ case k of
+       T.Constant -> M.interfaceConstant i   t v
+       T.Signal   -> M.interfaceSignal   i m t v
+       T.Variable -> M.interfaceVariable i m t v
+     return i
+compileHeader (Declare Generic i k m e) =
+  do v <- compEM e
+     t <- compTM e
+     M.addGeneric $ case k of
+       T.Constant -> M.interfaceConstant i   t v
+       T.Signal   -> M.interfaceSignal   i m t v
+       T.Variable -> M.interfaceVariable i m t v
+     return i
+compileHeader (Architecture name prg) =
+  do M.inArchitecture name prg
+compileHeader (Record name es) =
+  do undefined
+
+--------------------------------------------------------------------------------
diff --git a/src/Language/Embedded/VHDL/Expression.hs b/src/Language/Embedded/VHDL/Expression.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Embedded/VHDL/Expression.hs
@@ -0,0 +1,356 @@
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE TypeFamilies        #-}
+{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Language.Embedded.VHDL.Expression
+  ( Expr
+  , not, and, or, xor, xnor, nand, nor
+  , eq, neq
+  , lt, lte, gt, gte
+  , sll, srl, sla, sra, rol, ror
+  , add, sub, cat
+  , mul
+  , div, mod, rem
+  , neg
+  , exp, abs
+  , name, lit
+  ) where
+
+import Language.VHDL (Identifier(..), Expression)
+
+import Language.Embedded.VHDL.Interface
+import Language.Embedded.VHDL.Monad             (VHDL)
+import Language.Embedded.VHDL.Expression.Hoist
+import Language.Embedded.VHDL.Expression.Format
+import Language.Embedded.VHDL.Expression.Type hiding (Kind)
+import qualified Language.Embedded.VHDL.Monad as M
+
+import Data.Bits           hiding (xor)
+import Data.Dynamic
+import Data.Maybe                 (fromJust)
+import Data.Typeable
+
+import Prelude hiding (not, and, or, div, mod, rem, exp, abs, null)
+import qualified Prelude as P
+
+--------------------------------------------------------------------------------
+-- * VHDL Expression Type - a union of VHDLs' types + variables
+--------------------------------------------------------------------------------
+
+data Expr a
+  where
+    -- ^ ...
+    Val :: Rep a => a          -> Expr a
+    Var :: Rep a => Identifier -> Expr a
+
+    -- ^ ...
+    Pair :: Expr a -> Expr b -> Expr (a, b)
+    Fst  :: Expr (a, b) -> Expr a
+    Snd  :: Expr (a, b) -> Expr b
+
+    -- ^ VHDL Expressions
+    
+    -- expression operators (plus Not)
+    Not  :: Expr Bool -> Expr Bool
+    And  :: Expr Bool -> Expr Bool -> Expr Bool
+    Or   :: Expr Bool -> Expr Bool -> Expr Bool
+    Xor  :: Expr Bool -> Expr Bool -> Expr Bool
+    Xnor :: Expr Bool -> Expr Bool -> Expr Bool
+    Nand :: Expr Bool -> Expr Bool -> Expr Bool
+    Nor  :: Expr Bool -> Expr Bool -> Expr Bool
+
+    -- relational operators
+    Eq   :: Eq a  => Expr a -> Expr a -> Expr Bool
+    Neq  :: Eq a  => Expr a -> Expr a -> Expr Bool
+    Lt   :: Ord a => Expr a -> Expr a -> Expr Bool
+    Lte  :: Ord a => Expr a -> Expr a -> Expr Bool
+    Gt   :: Ord a => Expr a -> Expr a -> Expr Bool
+    Gte  :: Ord a => Expr a -> Expr a -> Expr Bool
+
+    -- shift operators
+    Sll  :: (Bits a, Integral b) => Expr a -> Expr b -> Expr a
+    Srl  :: (Bits a, Integral b) => Expr a -> Expr b -> Expr a
+    Sla  :: (Bits a, Integral b) => Expr a -> Expr b -> Expr a
+    Sra  :: (Bits a, Integral b) => Expr a -> Expr b -> Expr a
+    Rol  :: (Bits a, Integral b) => Expr a -> Expr b -> Expr a
+    Ror  :: (Bits a, Integral b) => Expr a -> Expr b -> Expr a
+
+    -- adding operators
+    Neg  :: Num a => Expr a -> Expr a
+    Add  :: Num a => Expr a -> Expr a -> Expr a
+    Sub  :: Num a => Expr a -> Expr a -> Expr a
+    Cat  :: Num a => Expr a -> Expr a -> Expr a
+
+    -- multiplying operators
+    Mul  :: (Rep a, Num a) => Expr a -> Expr a -> Expr a
+    Dif  :: Fractional a   => Expr a -> Expr a -> Expr a -- floating point division
+    Div  :: Integral a     => Expr a -> Expr a -> Expr a -- integer division
+    Mod  :: Integral a     => Expr a -> Expr a -> Expr a
+    Rem  :: Integral a     => Expr a -> Expr a -> Expr a
+
+    -- misc. operators (minus Not)
+    Exp  :: Floating a => Expr a -> Expr a -> Expr a
+    Abs  :: Num a      => Expr a -> Expr a
+
+type instance PredicateExp Expr = Rep
+
+--------------------------------------------------------------------------------
+-- ** Sugared constructs
+
+class Rep (Internal a) => Syntactic a
+  where
+    type Internal a
+
+    sugar   :: a -> Expr (Internal a)
+    desugar :: Expr (Internal a) -> a
+
+instance Rep a => Syntactic (Expr a)
+  where
+    type Internal (Expr a) = a
+
+    sugar   = id
+    desugar = id
+
+instance (Syntactic a, Syntactic b) => Syntactic (a, b)
+  where
+    type Internal (a, b) = (Internal a, Internal b)
+
+    sugar   (a, b) = Pair (sugar a) (sugar b)
+    desugar p      = (desugar (Fst p), desugar (Snd p))
+
+-- ...
+
+--------------------------------------------------------------------------------
+-- ** Useful Expr Instances
+
+instance (Rep a, Bounded a) => Bounded (Expr a)
+  where
+    minBound = Val minBound
+    maxBound = Val maxBound
+
+instance (Rep a, Enum a) => Enum (Expr a) -- needed for integral
+  where
+    toEnum   = error "toEnum not supported"
+    fromEnum = error "fromEnum not supported"
+
+instance (Rep a, Num a) => Num (Expr a)
+  where
+    fromInteger  = Val . fromInteger
+    (+)          = Add
+    (-)          = Sub
+    (*)          = Mul
+    abs          = Abs
+    signum       = error "signum not implemented for Expr"
+
+--------------------------------------------------------------------------------
+-- * User interface
+--------------------------------------------------------------------------------
+
+--------------------------------------------------------------------------------
+-- ** Logical operators
+
+and, or, xor, xnor, nand, nor :: Expr Bool -> Expr Bool -> Expr Bool
+
+and  = And
+or   = Or
+xor  = Xor
+xnor = Xnor
+nand = Nand
+nor  = Nor
+
+--------------------------------------------------------------------------------
+-- ** Relational operators
+
+eq, neq          :: Eq a  => Expr a -> Expr a -> Expr Bool
+lt, lte, gt, gte :: Ord a => Expr a -> Expr a -> Expr Bool
+
+eq  = Eq
+neq = Neq
+lt  = Lt
+lte = Lte
+gt  = Gt
+gte = Gte
+
+--------------------------------------------------------------------------------
+-- ** Shift operators
+
+sll, srl, sra, sla, rol, ror :: (Bits a, Integral b) => Expr a -> Expr b -> Expr a
+
+sll = Sll
+srl = Srl
+sra = Sra
+sla = Sla
+rol = Rol
+ror = Ror
+
+--------------------------------------------------------------------------------
+-- ** Adding operators
+
+add, sub, cat :: Num a => Expr a -> Expr a -> Expr a
+
+add = Add
+sub = Sub
+cat = Cat
+
+--------------------------------------------------------------------------------
+-- ** Multiplying operators
+
+mul           :: (Num a, Rep a) => Expr a -> Expr a -> Expr a
+div, mod, rem :: Integral a => Expr a -> Expr a -> Expr a
+
+mod = Mod
+rem = Rem
+mul = Mul
+div = Div
+
+--------------------------------------------------------------------------------
+-- ** Sign operators
+
+neg :: Num a => Expr a -> Expr a
+neg = Neg
+
+--------------------------------------------------------------------------------
+-- ** Miscellaneous operators
+
+not :: Expr Bool -> Expr Bool
+not = Not
+
+exp :: Floating a => Expr a -> Expr a -> Expr a
+exp = Exp
+
+abs :: Num a => Expr a -> Expr a
+abs = Abs
+
+--------------------------------------------------------------------------------
+-- ** Naming operators
+
+name :: Rep a => Identifier -> Expr a
+name = Var
+
+lit :: Rep a => a -> Expr a
+lit = Val
+
+--------------------------------------------------------------------------------
+-- * Compilation of expressions
+--------------------------------------------------------------------------------
+
+instance CompileExp Expr
+  where
+    varE  = Var
+    compT = compileT
+    compE = compileE
+
+compileT :: forall a. Rep a => Expr a -> VHDL Type
+compileT _ = return $ unTag $ (typed :: Tagged a Type)
+
+compileE :: Expr a -> VHDL Expression
+compileE = return . lift . go
+  where
+    go :: forall a. Expr a -> Kind
+    go exp = case exp of
+      Var (Ident i) -> P $ M.name i
+      Val v         -> P $ M.string $ format v
+
+      And  x y -> E $ M.and  [lift (go x),  lift (go y)]
+      Or   x y -> E $ M.or   [lift (go x),  lift (go y)]
+      Xor  x y -> E $ M.xor  [lift (go x),  lift (go y)]
+      Xnor x y -> E $ M.xnor [lift (go x),  lift (go y)]
+      Nand x y -> E $ M.nand (lift (go x)) (lift (go y))
+      Nor  x y -> E $ M.nor  (lift (go x)) (lift (go y))
+
+      Eq   x y -> R $ M.eq   (lift (go x)) (lift (go y))
+      Neq  x y -> R $ M.neq  (lift (go x)) (lift (go y))
+      Lt   x y -> R $ M.lt   (lift (go x)) (lift (go y))
+      Lte  x y -> R $ M.lte  (lift (go x)) (lift (go y))
+      Gt   x y -> R $ M.gt   (lift (go x)) (lift (go y))
+      Gte  x y -> R $ M.gte  (lift (go x)) (lift (go y))
+
+      Sll  x y -> Sh $ M.sll (lift (go x)) (lift (go y))
+      Srl  x y -> Sh $ M.srl (lift (go x)) (lift (go y))
+      Sla  x y -> Sh $ M.sla (lift (go x)) (lift (go y))
+      Sra  x y -> Sh $ M.sra (lift (go x)) (lift (go y))
+      Rol  x y -> Sh $ M.rol (lift (go x)) (lift (go y))
+      Ror  x y -> Sh $ M.ror (lift (go x)) (lift (go y))
+
+      Neg  x   -> Si $ M.neg (lift (go x))
+      Add  x y -> Si $ M.add [lift (go x), lift (go y)]
+      Sub  x y -> Si $ M.sub [lift (go x), lift (go y)]
+      Cat  x y -> Si $ M.cat [lift (go x), lift (go y)]
+
+      Mul  x y -> P $ resize (unTag (width :: Tagged a Int))
+                    $ M.mul  [lift (go x), lift (go y)]
+      Div  x y -> T $ M.div  [lift (go x), lift (go y)]
+      Mod  x y -> T $ M.mod  [lift (go x), lift (go y)]
+      Rem  x y -> T $ M.rem  [lift (go x), lift (go y)]
+
+      Exp  x y -> F $ M.exp  (lift (go x)) (lift (go y))
+      Abs  x   -> F $ M.abs  (lift (go x))
+      Not  x   -> F $ M.not  (lift (go x))
+
+      -- todo ...
+      Dif  x y -> error "compilation of floating point division is not yet supported"
+
+--------------------------------------------------------------------------------
+-- * Evaluation of Expressions
+--------------------------------------------------------------------------------
+
+instance EvaluateExp Expr
+  where
+    litE  = Val
+    evalE = evaluate
+
+evaluate :: Expr a -> a
+evaluate exp = case exp of
+    Var  v -> error "eval: free variable"
+    Val  v -> v
+    
+    Not  x   -> un P.not x
+    And  x y -> bin (&&) x y
+    Or   x y -> bin (||) x y
+    Xor  x y -> bin xor  x y
+    Xnor x y -> P.not $ bin xor  x y
+    Nand x y -> P.not $ bin (&&) x y
+    Nor  x y -> P.not $ bin (||) x y
+
+    Eq   x y -> bin (==) x y
+    Neq  x y -> bin (/=) x y
+    Lt   x y -> bin (<)  x y
+    Lte  x y -> bin (<=) x y
+    Gt   x y -> bin (>)  x y
+    Gte  x y -> bin (>=) x y
+
+    Sll  x y -> bin (\a b -> shiftL a (fromIntegral b) `clearBit` msb a) x y
+    Srl  x y -> bin (\a b -> shiftR a (fromIntegral b) `clearBit` msb a) x y  
+    Sla  x y -> bin (\a -> shiftL a . fromIntegral) x y
+    Sra  x y -> bin (\a -> shiftR a . fromIntegral) x y
+    Rol  x y -> bin (\a -> rotateL a . fromIntegral) x y
+    Ror  x y -> bin (\a -> rotateR a . fromIntegral) x y
+
+    Neg  x   -> un negate x
+    Add  x y -> bin (+) x y
+    Sub  x y -> bin (-) x y
+    Cat  x y -> error "evaluation of bit concatenation not yet implemented" 
+
+    Mul  x y -> bin (*)   x y
+    Dif  x y -> bin (/)   x y
+    Div  x y -> bin P.div x y
+    Mod  x y -> bin P.mod x y
+    Rem  x y -> bin P.rem x y
+
+    Exp  x y -> bin (**) x y
+    Abs  x   -> un P.abs x
+  where
+    xor a b = (a || b) && P.not (a && b)
+    
+    un :: (a -> b) -> Expr a -> b
+    un  f x   = f (evaluate x)
+
+    bin :: (a -> b -> c) -> Expr a -> Expr b -> c
+    bin f x y = f (evaluate x) (evaluate y)
+
+    msb :: Bits a => a -> Int
+    msb = fromJust . bitSizeMaybe
+
+--------------------------------------------------------------------------------
diff --git a/src/Language/Embedded/VHDL/Expression/Format.hs b/src/Language/Embedded/VHDL/Expression/Format.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Embedded/VHDL/Expression/Format.hs
@@ -0,0 +1,127 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Language.Embedded.VHDL.Expression.Format
+  ( Tagged(..)
+  , Rep(..)
+  ) where
+
+import Language.Embedded.VHDL.Expression.Type
+
+import Data.Bits
+import Data.Char   (intToDigit)
+import Data.Word
+import Data.Int
+import Text.Printf (printf)
+import Numeric     (showIntAtBase)
+import qualified Data.ByteString as B
+
+--------------------------------------------------------------------------------
+-- * Kludge - until I come up with a better solution
+--------------------------------------------------------------------------------
+
+-- | Tag a value with some (possibly) interesting information
+newtype Tagged s b = Tag { unTag :: b }
+
+-- | A 'rep'resentable value.
+class Rep a
+  where
+    width  :: Tagged a Int
+    typed  :: Tagged a Type
+    format :: a -> String
+
+--------------------------------------------------------------------------------
+-- ** Boolean
+
+instance Rep Bool where
+  width        = Tag 1
+  typed        = Tag std_logic
+  format True  = "1"
+  format False = "0"
+
+--------------------------------------------------------------------------------
+-- ** Signed
+
+instance Rep Int8 where
+  width  = Tag 8
+  typed  = Tag signed8
+  format = convert
+
+instance Rep Int16 where
+  width  = Tag 16
+  typed  = Tag signed16
+  format = convert
+
+instance Rep Int32 where
+  width  = Tag 32
+  typed  = Tag signed32
+  format = convert
+
+instance Rep Int64 where
+  width  = Tag 64
+  typed  = Tag signed64
+  format = convert
+
+--------------------------------------------------------------------------------
+-- ** Unsigned
+
+instance Rep Word8 where
+  width  = Tag 8
+  typed  = Tag usigned8
+  format = convert
+
+instance Rep Word16 where
+  width  = Tag 16
+  typed  = Tag usigned16
+  format = convert
+
+instance Rep Word32 where
+  width  = Tag 32
+  typed  = Tag usigned32
+  format = convert
+
+instance Rep Word64 where
+  width  = Tag 64
+  typed  = Tag usigned64
+  format = convert
+
+--------------------------------------------------------------------------------
+-- ** Records
+
+instance (Rep a, Rep b) => Rep (a, b) where
+  width  = Tag (unTag (width :: Tagged a Int) + unTag (width :: Tagged b Int))
+  typed  = undefined
+  format = undefined
+
+-- ...
+
+--------------------------------------------------------------------------------
+-- * Converting Integers to their Binrary representation
+--------------------------------------------------------------------------------
+
+-- | Convert an Integral to its binary representation
+convert :: Integral a => a -> String
+convert = foldr1 (++) . fmap w2s . B.unpack . i2bs . toInteger
+
+-- | Go over an Integer and convert it into a bytestring containing its
+--   binary representation
+i2bs :: Integer -> B.ByteString
+i2bs x = B.reverse . B.unfoldr (fmap chunk) . Just $ sign x
+  where
+    sign :: (Num a, Ord a) => a -> a
+    sign | x < 0     = subtract 1 . negate
+         | otherwise = id
+
+    chunk :: Integer -> (Word8, Maybe Integer)
+    chunk x = (b, i)
+      where
+        b = sign (fromInteger x)
+        i | x >= 128  = Just (x `shiftR` 8)
+          | otherwise = Nothing
+
+-- | Shows a word with zero padding
+--
+-- I assum the negative numbers to already be padded with ones
+w2s :: Word8 -> String
+w2s w = printf "%08s" $ showIntAtBase 2 intToDigit w ""
+
+--------------------------------------------------------------------------------
diff --git a/src/Language/Embedded/VHDL/Expression/Hoist.hs b/src/Language/Embedded/VHDL/Expression/Hoist.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Embedded/VHDL/Expression/Hoist.hs
@@ -0,0 +1,150 @@
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE UndecidableInstances  #-}
+
+module Language.Embedded.VHDL.Expression.Hoist where
+
+import Language.VHDL (
+    Expression(..)
+  , Relation(..)
+  , ShiftExpression(..)
+  , SimpleExpression(..)
+  , Term(..)
+  , Factor(..)
+  , Primary(..)
+  , Identifier(..)
+  )
+
+--------------------------------------------------------------------------------
+-- * Lifting / Hoisting of VHDL Expression
+--------------------------------------------------------------------------------
+
+-- | Lift any number of levels
+class Lift a b where
+  lift :: a -> b
+
+-- | Base case: we are the correct level
+instance {-# OVERLAPPING #-} Lift a a where
+  lift = id
+
+-- | Step case: we can get to the correct level by using a kind of induction step
+instance {-# OVERLAPPABLE #-} (Hoist a, Lift (Next a) b) => Lift a b where
+  lift = lift . hoist
+
+--------------------------------------------------------------------------------
+
+-- | Lift one level
+class Hoist a where
+  type Next a :: *
+  hoist :: a -> Next a
+
+instance Hoist Primary where
+  type Next Primary = Factor
+  hoist p = FacPrim p Nothing
+
+instance Hoist Factor where
+  type Next Factor = Term
+  hoist f = Term f []
+
+instance Hoist Term where
+  type Next Term = SimpleExpression
+  hoist t = SimpleExpression Nothing t []
+
+instance Hoist SimpleExpression where
+  type Next SimpleExpression = ShiftExpression
+  hoist s = ShiftExpression s Nothing
+
+instance Hoist ShiftExpression where
+  type Next ShiftExpression = Relation
+  hoist s = Relation s Nothing
+
+instance Hoist Relation where
+  type Next Relation = Expression
+  hoist r = ENand r Nothing
+
+instance Hoist Expression where
+  type Next Expression = Primary
+  hoist e = PrimExp e
+
+--------------------------------------------------------------------------------
+-- ** Lifting of explicit Kinds since I don't have a better solution
+
+-- | A collection type for VHDLs expression types.
+--
+-- Going from "Expr a -> VHDL.Exp" means recovering the structure of VHDL's
+-- expressions since Exp isn't a single type. Hence the need for "Kind".
+data Kind =
+    E  Expression
+  | R  Relation
+  | Sh ShiftExpression
+  | Si SimpleExpression
+  | T  Term
+  | F  Factor
+  | P  Primary
+
+instance Lift Kind Expression where
+  lift (E e)   = lift e
+  lift (R r)   = lift r
+  lift (Sh sh) = lift sh
+  lift (Si si) = lift si
+  lift (T t)   = lift t
+  lift (F f)   = lift f
+  lift (P p)   = lift p
+
+instance Lift Kind Relation where
+  lift (E e)   = lift e
+  lift (R r)   = lift r
+  lift (Sh sh) = lift sh
+  lift (Si si) = lift si
+  lift (T t)   = lift t
+  lift (F f)   = lift f
+  lift (P p)   = lift p
+
+instance Lift Kind ShiftExpression where
+  lift (E e)   = lift e
+  lift (R r)   = lift r
+  lift (Sh sh) = lift sh
+  lift (Si si) = lift si
+  lift (T t)   = lift t
+  lift (F f)   = lift f
+  lift (P p)   = lift p
+
+instance Lift Kind SimpleExpression where
+  lift (E e)   = lift e
+  lift (R r)   = lift r
+  lift (Sh sh) = lift sh
+  lift (Si si) = lift si
+  lift (T t)   = lift t
+  lift (F f)   = lift f
+  lift (P p)   = lift p
+
+instance Lift Kind Term where
+  lift (E e)   = lift e
+  lift (R r)   = lift r
+  lift (Sh sh) = lift sh
+  lift (Si si) = lift si
+  lift (T t)   = lift t
+  lift (F f)   = lift f
+  lift (P p)   = lift p
+
+instance Lift Kind Factor where
+  lift (E e)   = lift e
+  lift (R r)   = lift r
+  lift (Sh sh) = lift sh
+  lift (Si si) = lift si
+  lift (T t)   = lift t
+  lift (F f)   = lift f
+  lift (P p)   = lift p
+
+instance Lift Kind Primary where
+  lift (E e)   = lift e
+  lift (R r)   = lift r
+  lift (Sh sh) = lift sh
+  lift (Si si) = lift si
+  lift (T t)   = lift t
+  lift (F f)   = lift f
+  lift (P p)   = lift p
+
+--------------------------------------------------------------------------------
diff --git a/src/Language/Embedded/VHDL/Expression/Type.hs b/src/Language/Embedded/VHDL/Expression/Type.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Embedded/VHDL/Expression/Type.hs
@@ -0,0 +1,75 @@
+module Language.Embedded.VHDL.Expression.Type
+  ( Type
+  , Kind(..)
+  , std_logic
+  , signed, usigned
+  , signed8, signed16, signed32, signed64
+  , usigned8, usigned16, usigned32, usigned64
+  , resize
+  ) where
+
+import Language.VHDL
+import Language.Embedded.VHDL.Expression.Hoist hiding (Kind) -- resize
+import Language.Embedded.VHDL.Monad.Expression (lit)
+
+--------------------------------------------------------------------------------
+-- * Types
+--------------------------------------------------------------------------------
+
+-- | Type indication for signals/variables/..
+type Type = SubtypeIndication
+
+-- | The different kinds of signals/variables/.. that exist in VHDL
+data Kind = Constant | Signal | Variable | File
+
+--------------------------------------------------------------------------------
+-- ** Standard logic types
+
+std_logic :: Type
+std_logic = SubtypeIndication Nothing (TMType (NSimple (Ident "std_logic"))) Nothing
+
+--------------------------------------------------------------------------------
+-- ** Signed / Unsigned
+
+arith :: String -> Int -> Type
+arith typ range = SubtypeIndication Nothing
+    (TMType (NSlice (SliceName
+      (PName (NSimple (Ident typ)))
+      (DRRange (RSimple (point (range - 1)) DownTo (point 0))))))
+    (Nothing)
+  where
+    point :: Int -> SimpleExpression
+    point i = SimpleExpression Nothing (Term (FacPrim (lit (show i)) (Nothing)) []) []
+
+signed, usigned :: Int -> Type
+signed  = arith "signed"
+usigned = arith "unsigned"
+  
+signed8, signed16, signed32, signed64 :: Type
+signed8  = signed 8
+signed16 = signed 16
+signed32 = signed 32
+signed64 = signed 64
+
+usigned8, usigned16, usigned32, usigned64 :: Type
+usigned8  = usigned 8
+usigned16 = usigned 16
+usigned32 = usigned 32
+usigned64 = usigned 64
+
+-- .. add more ..
+
+--------------------------------------------------------------------------------
+-- ** Type conversion (and other stuff)
+
+resize :: Int -> Term -> Primary
+resize size exp =
+  PrimFun (FunctionCall
+    (NSimple (Ident "resize"))
+    (Just (AssociationList
+      [ AssociationElement Nothing (APDesignator (ADExpression (lift exp)))
+      , AssociationElement Nothing (APDesignator (ADExpression (lift (lit (show size)))))
+      ])
+    ))
+
+--------------------------------------------------------------------------------
diff --git a/src/Language/Embedded/VHDL/Interface.hs b/src/Language/Embedded/VHDL/Interface.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Embedded/VHDL/Interface.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeFamilies   #-}
+
+module Language.Embedded.VHDL.Interface where
+
+import Language.VHDL                          (Expression, Identifier(..))
+import Language.Embedded.VHDL.Monad           (VHDL)
+import Language.Embedded.VHDL.Expression.Type (Type)
+
+import Data.Constraint
+import Data.Typeable   (Typeable)
+
+--------------------------------------------------------------------------------
+-- *
+--------------------------------------------------------------------------------
+
+type family PredicateExp (exp :: * -> *) :: * -> Constraint
+
+-- | General interface for evaluating expressions
+class EvaluateExp exp
+  where
+    -- | Literal expressions
+    litE  :: PredicateExp exp a => a -> exp a
+
+    -- | Evaluation of (closed) expressions
+    evalE :: exp a -> a
+
+
+-- | General interface for compiling expressions
+class CompileExp exp
+  where
+    -- | Variable expressions
+    varE  :: PredicateExp exp a => Identifier -> exp a
+
+    -- | Compilation of type kind
+    compT :: PredicateExp exp a => exp a -> VHDL Type
+
+    -- | Compilation of expressions
+    compE :: exp a -> VHDL Expression
+
+--------------------------------------------------------------------------------
diff --git a/src/Language/Embedded/VHDL/Monad.hs b/src/Language/Embedded/VHDL/Monad.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Embedded/VHDL/Monad.hs
@@ -0,0 +1,556 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ConstraintKinds            #-}
+{-# LANGUAGE FlexibleContexts           #-}
+
+-- used for the Ord/Eq inst. of XDeclaration etc.
+{-# LANGUAGE StandaloneDeriving #-}
+
+module Language.Embedded.VHDL.Monad (    
+    VHDL
+  , VHDLT
+  , VHDLEnv
+  , emptyVHDLEnv
+    
+    -- ^ run
+  , runVHDLT
+  , runVHDL
+
+    -- ^ pretty
+  , prettyVHDL
+  , prettyVHDLT
+
+    -- ^ ...
+  , freshUnique
+  , newVar
+  , newLabel
+
+    -- ^ declarations
+  , addPort
+  , addGeneric
+  , addType
+  , addComponent
+  , addGlobal
+  , addLocal
+
+    -- ^ statements
+  , addConcurrent
+  , addSequential
+
+    -- ^ key statements
+  , inEntity
+  , inArchitecture
+  , inProcess
+  , inConditional
+  , inCase
+
+    -- ^ common
+  , interfaceConstant
+  , interfaceSignal
+  , interfaceVariable
+  , declRecord
+  , declConstant
+  , declSignal
+  , declVariable
+  , portMap
+  , assignSignal
+  , assignVariable
+
+  , module Language.Embedded.VHDL.Monad.Expression
+  ) where
+
+import Language.VHDL (Identifier(..), Mode(..), Expression, Label)
+import qualified Language.VHDL as V
+
+import Language.Embedded.VHDL.Expression.Type
+import Language.Embedded.VHDL.Monad.Expression
+
+import Control.Arrow          (first, second)
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Identity (Identity)
+import Control.Monad.State    (StateT, MonadState, MonadIO)
+import qualified Control.Monad.Identity as CMI
+import qualified Control.Monad.State    as CMS
+
+import Data.Maybe       (catMaybes)
+import Data.Foldable    (toList)
+import Data.Functor
+import Data.List        (groupBy)
+import Data.Set         (Set)
+import qualified Data.Set as Set
+
+import Text.PrettyPrint (Doc, ($+$))
+
+import Prelude hiding (null, not, abs, exp, rem, mod, div, and, or)
+import qualified Prelude as P
+
+--------------------------------------------------------------------------------
+-- * ..
+--------------------------------------------------------------------------------
+
+-- | ...
+data VFile = VFile (V.EntityDeclaration) [V.ArchitectureBody]
+
+-- | Code generation state
+data VHDLEnv = VHDLEnv
+  { _unique        :: !Integer
+  , _entity        :: String
+
+    -- ..
+  , _parts         :: [VFile]
+
+    -- ...
+  , _types         :: Set V.TypeDeclaration
+  , _components    :: Set V.ComponentDeclaration
+
+    -- headers
+  , _ports         :: [V.InterfaceDeclaration]
+  , _generics      :: [V.InterfaceDeclaration]
+  , _architectures :: [V.ArchitectureBody]
+    
+    -- declarations
+  , _global        :: [V.BlockDeclarativeItem]
+  , _local         :: [V.BlockDeclarativeItem]
+
+    -- statements
+  , _concurrent    :: [V.ConcurrentStatement]
+  , _sequential    :: [V.SequentialStatement]
+  }
+
+-- | Initial state during code generation
+emptyVHDLEnv = VHDLEnv
+  { _unique        = 0
+  , _entity        = "invisible"
+  , _parts         = []
+  , _types         = Set.empty
+  , _components    = Set.empty
+  , _ports         = []
+  , _generics      = []
+  , _architectures = []
+  , _global        = []
+  , _local         = []
+  , _concurrent    = []
+  , _sequential    = []
+  }
+
+--------------------------------------------------------------------------------
+-- *
+
+-- | Type constraints for the VHDL monads
+type MonadV m = (Functor m, Applicative m, Monad m, MonadState VHDLEnv m)
+
+-- | VHDL code generation monad
+type VHDL = VHDLT Identity
+
+-- | VHDL code genreation monad transformer
+newtype VHDLT m a = VHDLT { unVGenT :: StateT VHDLEnv m a }
+  deriving ( Functor
+           , Applicative
+           , Monad
+           , MonadState VHDLEnv
+           , MonadIO
+           )
+
+-- | Run the VHDL code generation monad transformer
+runVHDLT :: Monad m => VHDLT m a -> VHDLEnv -> m (a, VHDLEnv)
+runVHDLT m = CMS.runStateT (unVGenT m)
+
+-- | Run the VHDL code generation monad
+runVHDL  :: VHDL a -> VHDLEnv -> (a, VHDLEnv)
+runVHDL  m = CMI.runIdentity . CMS.runStateT (unVGenT m)
+
+--------------------------------------------------------------------------------
+-- ** Unique generation
+
+-- | Generates a unique integer
+freshUnique :: MonadV m => m Integer
+freshUnique =
+  do u <- CMS.gets _unique
+     CMS.modify (\e -> e { _unique = u + 1 })
+     return u
+
+-- | Generates a fresh and unique identifier
+newVar :: MonadV m => m Identifier
+newVar = freshUnique >>= return . Ident . ('u' :) . show
+
+-- | Generates a fresh and unique label
+newLabel :: MonadV m => m Label
+newLabel = freshUnique >>= return . Ident . ('l' :) . show
+
+--------------------------------------------------------------------------------
+-- ** Header declarations -- ignores port/generic maps for now
+
+-- | Adds a port declaration to the entity
+addPort :: MonadV m => V.InterfaceDeclaration -> m ()
+addPort p = CMS.modify $ \s -> s { _ports = p : (_ports s) }
+
+-- | Adds a generic declaration to the entity
+addGeneric :: MonadV m => V.InterfaceDeclaration -> m ()
+addGeneric g = CMS.modify $ \s -> s { _generics = g : (_generics s) }
+
+--------------------------------------------------------------------------------
+-- ** Component declarations
+
+-- | ...
+addType :: MonadV m => V.TypeDeclaration -> m ()
+addType t = CMS.modify $ \s -> s { _types = Set.insert t (_types s) }
+
+-- | Adds a component declaration to the architecture
+addComponent :: MonadV m => V.ComponentDeclaration -> m ()
+addComponent c = CMS.modify $ \s -> s { _components = Set.insert c (_components s) }
+
+--------------------------------------------------------------------------------
+-- ** Item declarations
+
+-- | Adds a global declaration
+addGlobal :: MonadV m => V.BlockDeclarativeItem -> m ()
+addGlobal g = CMS.modify $ \s -> s { _global = g : (_global s) }
+
+-- | Adds a local declaration
+addLocal :: MonadV m => V.BlockDeclarativeItem -> m ()
+addLocal l = CMS.modify $ \s -> s { _local = l : (_local s) }
+
+--------------------------------------------------------------------------------
+-- ** Concurrent statements
+
+-- | Runs the given action inside a process
+-- ! Due to how translate works, some local declarations might dissapear.
+inProcess :: MonadV m => Label -> [Identifier] -> m a -> m (a, V.ProcessStatement)
+inProcess l is m =
+  do oldLocals     <- CMS.gets _local
+     oldSequential <- CMS.gets _sequential
+     CMS.modify $ \e -> e { _local      = []
+                          , _sequential = [] }
+     a <- m
+     newLocals     <- reverse <$> CMS.gets _local
+     newSequential <- reverse <$> CMS.gets _sequential
+     CMS.modify $ \e -> e { _local      = oldLocals
+                          , _sequential = oldSequential }
+     return ( a
+            , V.ProcessStatement
+                (Just l)                        -- label
+                (False)                         -- postponed
+                (sensitivity)                   -- sensitivitylist
+                (translate $ merge $ newLocals) -- declarativepart
+                (newSequential))                -- statementpart
+  where
+    sensitivity | P.null is = Nothing
+                | otherwise = Just $ V.SensitivityList $ fmap V.NSimple is
+
+--------------------------------------------------------------------------------
+-- ** Sequential statements
+
+addConcurrent :: MonadV m => V.ConcurrentStatement -> m ()
+addConcurrent con = CMS.modify $ \s -> s { _concurrent = con : (_concurrent s) }
+
+addSequential :: MonadV m => V.SequentialStatement -> m ()
+addSequential seq = CMS.modify $ \s -> s { _sequential = seq : (_sequential s) }
+
+--------------------------------------------------------------------------------
+-- **
+
+inConditional :: MonadV m => (V.Condition, m ()) -> [(V.Condition, m ())] -> m () -> m (V.IfStatement)
+inConditional (c, m) os e =
+  do let (cs, ns) = unzip os
+     oldSequential <- CMS.gets _sequential
+     CMS.modify $ \e -> e { _sequential = [] }
+     m'  <- contain m
+     ns' <- mapM contain ns
+     e'  <- contain e
+     CMS.modify $ \e -> e { _sequential = oldSequential }
+     return $
+       V.IfStatement
+         (Nothing)
+         (c, m')
+         (zip cs ns')
+         (maybeList e')
+  where
+    maybeList :: [V.SequentialStatement] -> Maybe [V.SequentialStatement]
+    maybeList xs
+      | P.null xs = Nothing
+      | otherwise = Just xs
+
+contain :: MonadV m => m () -> m [V.SequentialStatement]
+contain m =
+ do m                                          -- do
+    new <- reverse <$> CMS.gets _sequential    -- get
+    CMS.modify $ \e -> e { _sequential = [] }  -- reset
+    return $ new
+
+--------------------------------------------------------------------------------
+-- **
+
+inCase :: MonadV m => V.Expression -> [(V.Choices, m ())] -> m (V.CaseStatement)
+inCase e choices =
+  do let (cs, ns) = unzip choices
+     oldSequential <- CMS.gets _sequential
+     CMS.modify $ \e -> e { _sequential = [] }
+     ns' <- mapM contain ns
+     CMS.modify $ \e -> e { _sequential = oldSequential }     
+     return $
+       V.CaseStatement
+         (Nothing)
+         (e)
+         (zipWith V.CaseStatementAlternative cs ns')
+
+--------------------------------------------------------------------------------
+-- **
+
+addArchitecture :: MonadV m => V.ArchitectureBody -> m ()
+addArchitecture a = CMS.modify $ \s -> s { _architectures = a : (_architectures s)}
+
+inArchitecture :: MonadV m => String -> m a -> m a
+inArchitecture name m =
+  do oldEntity     <- CMS.gets _entity
+     oldComponent  <- CMS.gets _components
+     oldGlobal     <- CMS.gets _global
+     oldLocal      <- CMS.gets _local
+     oldConcurrent <- CMS.gets _concurrent
+     CMS.modify $ \e -> e { _components = Set.empty
+                          , _global     = []
+                          , _local      = []
+                          , _concurrent = []
+                          }
+     a <- m
+     newComponent  <-             CMS.gets _components
+     newGlobal     <- reverse <$> CMS.gets _global
+     newLocal      <- reverse <$> CMS.gets _local
+     newConcurrent <- reverse <$> CMS.gets _concurrent
+     CMS.modify $ \e -> e { _components = oldComponent
+                          , _global     = oldGlobal
+                          , _local      = oldLocal
+                          , _concurrent = oldConcurrent
+                          }
+
+     addArchitecture $ V.ArchitectureBody
+       (V.Ident name)
+       (V.NSimple (V.Ident oldEntity))
+       (merge $ newGlobal ++ newLocal)
+       (newConcurrent)
+     return a
+
+--------------------------------------------------------------------------------
+-- **
+
+addPart  :: MonadV m => VFile -> m ()
+addPart v = CMS.modify $ \s -> s { _parts = v : (_parts s) }
+
+inEntity :: MonadV m => String -> m a -> m a
+inEntity name m =
+  do oldUnique        <- CMS.gets _unique
+     oldEntity        <- CMS.gets _entity
+     oldPorts         <- CMS.gets _ports
+     oldGenerics      <- CMS.gets _generics
+     oldArchitectures <- CMS.gets _architectures
+     CMS.modify $ \e -> e { _unique        = 0
+                          , _entity        = name
+                          , _ports         = []
+                          , _generics      = []
+                          , _architectures = []
+                          }
+     a <- m
+     newPorts         <- reverse <$> CMS.gets _ports
+     newGenerics      <- reverse <$> CMS.gets _generics
+     newArchitectures <- reverse <$> CMS.gets _architectures
+     CMS.modify $ \e -> e { _unique        = oldUnique
+                          , _entity        = oldEntity
+                          , _ports         = oldPorts
+                          , _generics      = oldGenerics
+                          , _architectures = oldArchitectures
+                          }
+     addPart $ VFile
+       (V.EntityDeclaration
+         (V.Ident name)
+         (V.EntityHeader
+           (V.GenericClause <$> maybeNull newGenerics)
+           (V.PortClause    <$> maybeNull newPorts))
+         ([])
+         (Nothing))
+       (newArchitectures)
+     return a
+  where
+    maybeNull :: [V.InterfaceDeclaration] -> Maybe V.InterfaceList
+    maybeNull [] = Nothing
+    maybeNull xs = Just $ V.InterfaceList $ merge xs
+
+--------------------------------------------------------------------------------
+-- * Pretty
+--------------------------------------------------------------------------------
+
+prettyVHDL :: VHDL a -> Doc
+prettyVHDL = CMI.runIdentity . prettyVHDLT
+
+prettyVHDLT :: Monad m => VHDLT m a -> m Doc
+prettyVHDLT m = prettyVEnv . snd <$> runVHDLT (inEntity "anonymous" m) emptyVHDLEnv
+
+prettyVEnv  :: VHDLEnv -> Doc
+prettyVEnv (VHDLEnv _ _ parts types _ _ _ _ _ _ _ _) =
+    stack $ (genPackage "types" $ Set.toList types) : (fmap prettyPart parts)
+  where
+    stack :: [Doc] -> Doc
+    stack = foldr1 ($+$)
+    
+    prettyPart :: VFile -> Doc
+    prettyPart (VFile e as) = stack (V.pp e : fmap V.pp as)
+
+--------------------------------------------------------------------------------
+
+genPackage :: String -> [V.TypeDeclaration] -> Doc
+genPackage name = V.pp . V.PackageDeclaration (V.Ident name) . fmap V.PHDIType
+    
+--------------------------------------------------------------------------------
+-- * Common things
+--------------------------------------------------------------------------------
+
+--------------------------------------------------------------------------------
+-- **  Ports/Generic declarations
+
+interfaceConstant :: Identifier -> Type -> Maybe Expression -> V.InterfaceDeclaration
+interfaceConstant i t e = V.InterfaceConstantDeclaration [i] t e
+
+interfaceSignal   :: Identifier -> Mode -> Type -> Maybe Expression -> V.InterfaceDeclaration
+interfaceSignal i m t e = V.InterfaceSignalDeclaration [i] (Just m) t False e
+
+interfaceVariable :: Identifier -> Mode -> Type -> Maybe Expression -> V.InterfaceDeclaration
+interfaceVariable i m t e = V.InterfaceVariableDeclaration [i] (Just m) t e
+
+--------------------------------------------------------------------------------
+-- ** Type/Component Declarations
+
+declRecord :: Identifier -> [(Identifier, Type)] -> V.TypeDeclaration
+declRecord name es = V.TDFull
+  (V.FullTypeDeclaration
+    (name)
+    (V.TDComposite (V.CTDRecord (V.RecordTypeDefinition
+      (fmap decl es)
+      (Just name)))))
+  where
+    decl (i, t) = V.ElementDeclaration [i] t
+
+--------------------------------------------------------------------------------
+-- ** Global/Local Declarations
+
+declConstant :: Identifier -> Type -> Maybe Expression -> V.BlockDeclarativeItem
+declConstant i t e = V.BDIConstant $ V.ConstantDeclaration [i] t e
+
+declSignal :: Identifier -> Type -> Maybe Expression -> V.BlockDeclarativeItem
+declSignal i t e = V.BDISignal $ V.SignalDeclaration [i] t Nothing e
+
+declVariable :: Identifier -> Type -> Maybe Expression -> V.BlockDeclarativeItem
+declVariable i t e = V.BDIShared $ V.VariableDeclaration False [i] t e
+
+--------------------------------------------------------------------------------
+-- ** Component instantiation (port mapping)
+
+portMap :: Label -> Identifier -> [V.ActualDesignator] -> V.ConcurrentStatement
+portMap l n ns = V.ConComponent $
+  V.ComponentInstantiationStatement
+    (l)
+    (V.IUComponent (V.NSimple n))
+    (Nothing)
+    (Just $ V.PortMapAspect
+      (V.AssociationList $
+        fmap (V.AssociationElement Nothing) $
+          fmap V.APDesignator ns))
+
+--------------------------------------------------------------------------------
+-- ** Assign Signal/Variable
+
+assignSignal :: Identifier -> Expression -> V.SequentialStatement
+assignSignal i e = V.SSignalAss $
+  V.SignalAssignmentStatement
+    (Nothing)
+    (V.TargetName (V.NSimple i))
+    (Nothing)
+    (V.WaveElem [V.WaveEExp e Nothing])
+
+assignVariable :: Identifier -> Expression -> V.SequentialStatement
+assignVariable i e = V.SVarAss $
+  V.VariableAssignmentStatement
+    (Nothing)
+    (V.TargetName (V.NSimple i))
+    (e)
+
+--------------------------------------------------------------------------------
+-- Some helper classes and their instances
+--------------------------------------------------------------------------------
+
+class Merge a
+  where
+    -- group two items if this holds
+    group  :: a -> a -> Bool
+
+    -- merge in this way
+    reduce :: [a] -> a
+
+    merge :: [a] -> [a]
+    merge = fmap reduce . groupBy group
+
+
+instance Merge V.BlockDeclarativeItem
+  where
+    group  l r      = setBlockIds l [] == setBlockIds r []
+    reduce bs@(b:_) = setBlockIds b $ concatMap getBlockIds bs
+
+instance Merge V.InterfaceDeclaration
+  where
+    group  l r    = l { V.idecl_identifier_list = [] } == r { V.idecl_identifier_list = [] }
+    reduce (x:xs) = x { V.idecl_identifier_list = ids x ++ concatMap ids xs }
+      where ids   = V.idecl_identifier_list
+
+--------------------------------------------------------------------------------
+
+setBlockIds :: V.BlockDeclarativeItem -> [Identifier] -> V.BlockDeclarativeItem
+setBlockIds (V.BDIConstant c) is = V.BDIConstant $ c { V.const_identifier_list  = is }
+setBlockIds (V.BDISignal   s) is = V.BDISignal   $ s { V.signal_identifier_list = is }
+setBlockIds (V.BDIShared   v) is = V.BDIShared   $ v { V.var_identifier_list    = is }
+setBlockIds (V.BDIFile     f) is = V.BDIFile     $ f { V.fd_identifier_list     = is }
+setBlockIds x                 _  = x
+
+getBlockIds :: V.BlockDeclarativeItem -> [Identifier]
+getBlockIds (V.BDIConstant c) = V.const_identifier_list c
+getBlockIds (V.BDISignal   s) = V.signal_identifier_list s
+getBlockIds (V.BDIShared   v) = V.var_identifier_list v
+getBlockIds (V.BDIFile     f) = V.fd_identifier_list f
+
+--------------------------------------------------------------------------------
+-- I use BlockDeclarativeItem to represent all declarative items, which means we
+-- have to translate them over to their correct VHDL kind when generating an AST
+--------------------------------------------------------------------------------
+
+class Declarative a
+  where
+    -- lists are used so we can fail without having to throw errors
+    translate :: [V.BlockDeclarativeItem] -> [a]
+
+instance Declarative V.ProcessDeclarativeItem
+  where
+    translate = catMaybes . fmap tryProcess
+
+-- | Try to transform the declarative item into a process item
+tryProcess :: V.BlockDeclarativeItem -> Maybe (V.ProcessDeclarativeItem)
+tryProcess (V.BDIConstant c) = Just $ V.PDIConstant c
+tryProcess (V.BDIShared   v) = Just $ V.PDIVariable v
+tryProcess (V.BDIFile     f) = Just $ V.PDIFile     f
+tryProcess _                 = Nothing
+
+--------------------------------------------------------------------------------
+-- Ord instance for use in Set
+--------------------------------------------------------------------------------
+
+deriving instance Ord Identifier
+
+instance Ord V.TypeDeclaration where
+  compare (V.TDFull l)    (V.TDFull r)    = compare (V.ftd_identifier l) (V.ftd_identifier r)
+  compare (V.TDPartial l) (V.TDPartial r) = compare l r
+  -- ...
+  compare (V.TDFull l)    _               = GT
+  compare (V.TDPartial l) _               = LT
+
+instance Ord V.IncompleteTypeDeclaration where
+  compare (V.IncompleteTypeDeclaration l) (V.IncompleteTypeDeclaration r) = compare l r
+
+instance Ord V.ComponentDeclaration where
+  compare l r = compare (V.comp_identifier l) (V.comp_identifier r)
+
+--------------------------------------------------------------------------------
diff --git a/src/Language/Embedded/VHDL/Monad/Expression.hs b/src/Language/Embedded/VHDL/Monad/Expression.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Embedded/VHDL/Monad/Expression.hs
@@ -0,0 +1,100 @@
+module Language.Embedded.VHDL.Monad.Expression where
+
+import Language.VHDL
+import Language.Embedded.VHDL.Expression.Hoist hiding (Kind)
+
+--------------------------------------------------------------------------------
+-- * Expressions (and its layers)
+--------------------------------------------------------------------------------
+
+relation :: RelationalOperator -> ShiftExpression -> ShiftExpression -> Relation
+relation r a b = Relation a (Just (r, b))
+
+shiftexp :: ShiftOperator -> SimpleExpression -> SimpleExpression -> ShiftExpression
+shiftexp s a b = ShiftExpression a (Just (s, b))
+
+simplexp :: Maybe Sign -> AddingOperator -> [Term] -> SimpleExpression
+simplexp s o (a:as) = SimpleExpression s a (fmap ((,) o) as)
+
+term     :: MultiplyingOperator -> [Factor] -> Term
+term     o (a:as) = Term a (fmap ((,) o) as)
+
+--------------------------------------------------------------------------------
+-- ** Expressions
+
+and, or, xor, xnor :: [Relation] -> Expression
+and  = EAnd  
+or   = EOr   
+xor  = EXor  
+xnor = EXnor
+
+nand, nor :: Relation -> Relation -> Expression
+nand a b = ENand a (Just b)
+nor  a b = ENor  a (Just b)
+
+--------------------------------------------------------------------------------
+-- ** Relations
+
+eq, neq, lt, lte, gt, gte :: ShiftExpression -> ShiftExpression -> Relation
+eq  = relation Eq
+neq = relation Neq
+lt  = relation Lt
+lte = relation Lte
+gt  = relation Gt
+gte = relation Gte
+
+--------------------------------------------------------------------------------
+-- ** Shift Expressions
+
+sll, srl, sla, sra, rol, ror :: SimpleExpression -> SimpleExpression -> ShiftExpression
+sll = shiftexp Sll
+srl = shiftexp Srl
+sla = shiftexp Sla
+sra = shiftexp Sra
+rol = shiftexp Rol
+ror = shiftexp Ror
+
+--------------------------------------------------------------------------------
+-- ** Simple Expressions
+
+add, sub, cat :: [Term] -> SimpleExpression
+add = simplexp Nothing Plus
+sub = simplexp Nothing Minus
+cat = simplexp Nothing Concat
+
+neg :: Term -> SimpleExpression
+neg = simplexp (Just Negation) Plus . (: [])
+
+--------------------------------------------------------------------------------
+-- ** Terms
+
+mul, div, mod, rem :: [Factor] -> Term
+mul = term Times
+div = term Div
+mod = term Mod
+rem = term Rem
+
+--------------------------------------------------------------------------------
+-- ** Factors
+
+exp :: Primary -> Primary -> Factor
+exp a b = FacPrim a (Just b)
+
+abs, not :: Primary -> Factor
+abs = FacAbs
+not = FacNot
+
+--------------------------------------------------------------------------------
+-- ** Primaries
+--
+-- ! These are a bit simplified..
+
+name, string, lit :: String -> Primary
+name   = PrimName . NSimple . Ident
+string = PrimLit . LitString . SLit
+lit    = PrimLit . LitNum . NLitPhysical . PhysicalLiteral Nothing . NSimple . Ident
+
+null :: Primary
+null = PrimLit LitNull
+
+--------------------------------------------------------------------------------