diff --git a/imperative-edsl-vhdl.cabal b/imperative-edsl-vhdl.cabal
--- a/imperative-edsl-vhdl.cabal
+++ b/imperative-edsl-vhdl.cabal
@@ -2,7 +2,7 @@
 --  documentation, see http://haskell.org/cabal/users-guide/
 
 name:                imperative-edsl-vhdl
-version:             0.2.0.1
+version:             0.3.2
 synopsis:            Deep embedding of VHDL programs with code generation.
 description:         Deep embedding of VHDL programs with code generation.
 license:             BSD3
@@ -19,11 +19,11 @@
   exposed-modules:     Language.Embedded.VHDL,
                        Language.Embedded.VHDL.Monad,
                        Language.Embedded.VHDL.Monad.Expression,
+                       Language.Embedded.VHDL.Monad.Type,
                        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.Expression.Represent,
                        Language.Embedded.VHDL.Command
 
   -- other-modules:                              
@@ -42,8 +42,9 @@
                        bytestring,
                        constraints,
                        containers           >=0.1 && <1,
+                       syntactic            >=3.2,
                        operational-alacarte >=0.1.1,
-                       language-vhdl        >=0.1.1.0,
+                       language-vhdl        >=0.1.2.3,
                        pretty               >=1.0
   hs-source-dirs:      .,src
   default-language:    Haskell2010
diff --git a/src/Language/Embedded/VHDL.hs b/src/Language/Embedded/VHDL.hs
--- a/src/Language/Embedded/VHDL.hs
+++ b/src/Language/Embedded/VHDL.hs
@@ -2,8 +2,6 @@
   ( 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
 
@@ -11,6 +9,4 @@
 
 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
--- a/src/Language/Embedded/VHDL/Command.hs
+++ b/src/Language/Embedded/VHDL/Command.hs
@@ -7,21 +7,45 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 
-module Language.Embedded.VHDL.Command where
+module Language.Embedded.VHDL.Command
+  ( SequentialCMD
+  , ConcurrentCMD
+  , HeaderCMD
+  , compile
 
+    -- sequential statements
+  , constantL, variableL, fileL
+  , (<==), (==:)
+  , iff, switch, when, ifThen
+
+    -- concurrent statements
+  , constantG, signalG, variableG, fileG
+  , process
+
+    -- header statements
+  , constantPort, constantGeneric
+  , signalPort, signalGeneric
+  , variablePort, variableGeneric
+  , filePort, fileGeneric
+  , entity
+  , architecture
+  , library
+  , imports
+  ) 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.Monad      (VHDLT, VHDL)
+import Language.Embedded.VHDL.Monad.Type (Type, Kind)
 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.Monad       as M
+import qualified Language.Embedded.VHDL.Monad.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.Monad.Identity           hiding (when)
+import Control.Monad.Operational.Higher hiding (when)
 import Control.Applicative
 import Data.Typeable
 import Data.ALaCarte
@@ -49,11 +73,21 @@
 --------------------------------------------------------------------------------
 
 -- | Compile if 'exp' is set
-compEM :: CompileExp exp => Maybe (exp a) -> VHDL (Maybe Expression)
+compEM
+  :: forall exp a.
+     ( PredicateExp exp a
+     , 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
+  :: forall exp a.
+     ( PredicateExp exp a
+     , CompileExp   exp)
+  => Maybe (exp a)
+  -> VHDL Type
 compTM _ = compT (undefined :: exp a)
 
 --------------------------------------------------------------------------------
@@ -63,10 +97,9 @@
   where
     Local
       :: PredicateExp exp a
-      => Identifier
-      -> Kind
+      => Kind
       -> Maybe (exp a)
-      -> SequentialCMD exp prog ()
+      -> SequentialCMD exp prog Identifier
 
     Assignment
       :: PredicateExp exp a
@@ -76,8 +109,9 @@
       -> SequentialCMD exp prog ()
 
     If
-      :: (exp Bool, prog ())     -- if
-      -> [(exp Bool,  prog ())]  -- elseif*
+      :: PredicateExp exp Bool
+      => (exp Bool, prog ())     -- if
+      -> [(exp Bool,  prog ())]  -- else-ifs
       -> prog ()                 -- else
       -> SequentialCMD exp prog ()
 
@@ -90,7 +124,7 @@
     
 instance HFunctor (SequentialCMD exp)
   where
-    hfmap _ (Local i k e)      = Local i k e
+    hfmap _ (Local k e  )      = Local 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)
@@ -103,12 +137,11 @@
 -- | 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
+  => Maybe (IExp instr a)
+  -> ProgramT instr m Identifier
+constantL = singleE . Local T.Constant
+variableL = singleE . Local T.Variable
+fileL     = singleE . Local T.File
 
 -- | Assign a signal to some expression
 (<==) :: (SequentialCMD (IExp instr) :<: instr, PredicateExp (IExp instr) a)
@@ -125,8 +158,8 @@
 (==:) i = singleE . Assignment i T.Variable
 
 -- | Conventional if statement
-iff
-  :: (SequentialCMD (IExp instr) :<: instr)
+iff 
+  :: (SequentialCMD (IExp instr) :<: instr, PredicateExp (IExp instr) Bool)
   =>  (IExp instr Bool, ProgramT instr m ())
   -> [(IExp instr Bool, ProgramT instr m ())]
   -> ProgramT instr m ()
@@ -146,7 +179,9 @@
 
 -- | Guards a program by some predicate
 when
-  :: (SequentialCMD (IExp instr) :<: instr, Monad m)
+  :: ( SequentialCMD (IExp instr) :<: instr
+     , PredicateExp  (IExp instr) Bool
+     , Monad m)
   => IExp instr Bool
   -> ProgramT instr m ()
   -> ProgramT instr m ()
@@ -154,23 +189,26 @@
 
 -- | Standard 'if .. then .. else ..' statement
 ifThen
-  :: (SequentialCMD (IExp instr) :<: instr)
+  :: ( SequentialCMD (IExp instr) :<: instr
+     , PredicateExp  (IExp instr) Bool)
   => 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) =
+compileSequential (Local k e) =
   do v <- compEM e
      t <- compTM e
+     i <- M.newSym
      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
+     return i
 compileSequential (Assignment i k e) =
   do v <- compE e
      M.addSequential $ case k of
@@ -217,10 +255,9 @@
   where
     Global
       :: PredicateExp exp a  
-      => Identifier
-      -> Kind
+      => Kind
       -> Maybe (exp a)
-      -> ConcurrentCMD exp prog ()
+      -> ConcurrentCMD exp prog (Identifier)
 
     Process
       :: Label
@@ -229,15 +266,13 @@
       -> ConcurrentCMD exp prog ()
 
     PortMap
-      :: Identifier
-      -> [Identifier]
-      -> ConcurrentCMD exp prog ()
+      :: [Identifier] -> ConcurrentCMD exp prog (Identifier)
 
 instance HFunctor (ConcurrentCMD exp)
   where
-    hfmap _ (Global  i k e)  = Global  i k e
+    hfmap _ (Global  k e)    = Global  k e
     hfmap f (Process l is p) = Process l is (f p)
-    hfmap _ (PortMap n is)   = PortMap n is
+    hfmap _ (PortMap is)     = PortMap is
 
 type instance IExp (ConcurrentCMD e)       = e
 type instance IExp (ConcurrentCMD e :+: i) = e
@@ -245,15 +280,15 @@
 --------------------------------------------------------------------------------
 
 -- | 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
+constantG, signalG, variableG, fileG
+  :: ( ConcurrentCMD (IExp instr) :<: instr
+     , PredicateExp  (IExp instr) a)
+  => Maybe (IExp instr a)
+  -> ProgramT instr m Identifier
+constantG = singleE . Global T.Constant
+signalG   = singleE . Global T.Signal
+variableG = singleE . Global T.Variable
+fileG     = singleE . Global T.File
 
 -- | Declare a process
 process
@@ -267,121 +302,153 @@
 --------------------------------------------------------------------------------
 
 compileConcurrent :: CompileExp exp => ConcurrentCMD exp VHDL a -> VHDL a
-compileConcurrent (Global i k e) =
+compileConcurrent (Global k e) =
   do v <- compEM e
      t <- compTM e
+     i <- M.newSym
      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
+     return i
 compileConcurrent (Process l is p) =
   do (a, process) <- M.inProcess l is p
      M.addConcurrent (V.ConProcess process)
      return a
-compileConcurrent (PortMap n is) =
+compileConcurrent (PortMap is) =
   do let ads = fmap (V.ADSignal . V.NSimple) is
+     n   <- M.newSym
      lbl <- M.newLabel
      M.addConcurrent (M.portMap lbl n ads)
+     return n
      
 --------------------------------------------------------------------------------
 -- ** Entity declaration related commands offered by VHDL
 
 data DeclKind = Port | Generic
 
+data Record a = Record Identifier
+
+data Array  a = Array  Identifier
+
 data HeaderCMD exp (prog :: * -> *) a
   where
-    Declare
+    DeclarePort
       :: PredicateExp exp a
       => DeclKind
-      -> Identifier
       -> Kind
       -> Mode
       -> Maybe (exp a)
       -> HeaderCMD exp prog Identifier
+      
+    DeclareRecord
+      :: [(Identifier, Type)]
+      -> HeaderCMD exp prog (Record a)
+         
+    DeclareArray
+      :: HeaderCMD exp prog (Array a)
 
-    Architecture
-      :: String
+    -- ^ ...
+    Entity
+      :: Identifier
       -> prog a
       -> HeaderCMD exp prog a
 
-    Record
-      :: String
-      -> [(String, Type)]
+    -- ^ ...
+    Architecture
+      :: Identifier -- architecture's name
+      -> Identifier -- entity's name
+      -> prog a
       -> HeaderCMD exp prog a
 
+    Library :: String -> HeaderCMD exp prog ()
+    Import  :: String -> HeaderCMD exp prog ()
+
 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
+    hfmap _ (DeclarePort d k m e) = DeclarePort d k m e
+    hfmap _ (DeclareRecord rs)    = DeclareRecord rs
+    hfmap _ (DeclareArray)        = DeclareArray
+    hfmap f (Entity e p)          = Entity e (f p)
+    hfmap f (Architecture a e p)  = Architecture a e (f p)
+    hfmap _ (Library s)           = Library s
+    hfmap _ (Import s)            = Import s
 
 type instance IExp (HeaderCMD e)       = e
 type instance IExp (HeaderCMD e :+: i) = e
 
 --------------------------------------------------------------------------------
 
--- | Declare constands/signal/variables/files ports and generics
+-- | 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
+  => 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))
+constantPort    m = singleE . DeclarePort Port    T.Constant m
+constantGeneric m = singleE . DeclarePort Generic T.Constant m
+signalPort      m = singleE . DeclarePort Port    T.Signal   m
+signalGeneric   m = singleE . DeclarePort Generic T.Signal   m
+variablePort    m = singleE . DeclarePort Port    T.Variable m
+variableGeneric m = singleE . DeclarePort Generic T.Variable m
+filePort        m = singleE . DeclarePort Port    T.File     m
+fileGeneric     m = singleE . DeclarePort Generic T.File     m
 
--- | 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 entity.
+entity
+  :: (HeaderCMD (IExp instr) :<: instr)
+  => String
+  -> ProgramT instr m a
+  -> ProgramT instr m a
+entity name = singleE . Entity (Ident name)
 
--- | Declare an architecture
+-- | Declare an architecture.
 architecture
   :: (HeaderCMD (IExp instr) :<: instr)
   => String
+  -> String
   -> ProgramT instr m a
   -> ProgramT instr m a
-architecture name = singleE . Architecture name
+architecture name entity = singleE . Architecture (Ident name) (Ident entity)
 
+-- | Imports a library.
+library :: (HeaderCMD (IExp instr) :<: instr) => String -> ProgramT instr m ()
+library = singleE . Library
+
+-- | Imports a library module.
+imports :: (HeaderCMD (IExp instr) :<: instr) => String -> ProgramT instr m ()
+imports = singleE . Import
+
 --------------------------------------------------------------------------------
 
 compileHeader :: CompileExp exp => HeaderCMD exp VHDL a -> VHDL a
-compileHeader (Declare Port i k m e) =
+compileHeader (DeclarePort Port k m e) =
   do v <- compEM e
      t <- compTM e
+     i <- M.newSym
      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) =
+compileHeader (DeclarePort Generic k m e) =
   do v <- compEM e
      t <- compTM e
+     i <- M.newSym
      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
+compileHeader (DeclareRecord rs) =
+  do i <- M.newSym
+     r <- return $ M.declRecord i rs
+     undefined
+compileHeader (DeclareArray) =
+  do error "imperative-vhdl: arrays are not yet supported."
+compileHeader (Entity       name        prg) = M.entity name prg
+compileHeader (Architecture name entity prg) = M.architecture name entity prg
+compileHeader (Library s)                    = M.newLibrary s
+compileHeader (Import s)                     = M.newImport s
 
 --------------------------------------------------------------------------------
diff --git a/src/Language/Embedded/VHDL/Expression.hs b/src/Language/Embedded/VHDL/Expression.hs
--- a/src/Language/Embedded/VHDL/Expression.hs
+++ b/src/Language/Embedded/VHDL/Expression.hs
@@ -1,11 +1,18 @@
-{-# LANGUAGE GADTs               #-}
-{-# LANGUAGE TypeFamilies        #-}
-{-# LANGUAGE TypeOperators       #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE UndecidableInstances  #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
 
 module Language.Embedded.VHDL.Expression
-  ( Expr
+  ( VHDLDomain
+  , Data
+  , Type
+
+  -- expressions
   , not, and, or, xor, xnor, nand, nor
   , eq, neq
   , lt, lte, gt, gte
@@ -13,344 +20,648 @@
   , add, sub, cat
   , mul
   , div, mod, rem
-  , neg
   , exp, abs
-  , name, lit
+  , value, force, share
+
+  -- types
+  , std_logic
+  , signed, usigned
+  , signed8, signed16, signed32, signed64
+  , usigned8, usigned16, usigned32, usigned64
   ) where
 
-import Language.VHDL (Identifier(..), Expression)
+import Language.VHDL (Identifier(..))
+import qualified Language.VHDL as V
 
 import Language.Embedded.VHDL.Interface
-import Language.Embedded.VHDL.Monad             (VHDL)
+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 Language.Embedded.VHDL.Expression.Represent
+import qualified Language.Embedded.VHDL.Monad            as M
+import qualified Language.Embedded.VHDL.Expression.Hoist as Hoist
 
-import Data.Bits           hiding (xor)
-import Data.Dynamic
-import Data.Maybe                 (fromJust)
-import Data.Typeable
+import Language.Embedded.VHDL.Monad.Type (
+    std_logic
+  , signed, usigned
+  , signed8, signed16, signed32, signed64
+  , usigned8, usigned16, usigned32, usigned64
+  )
+import qualified Language.Embedded.VHDL.Monad.Type as T
 
-import Prelude hiding (not, and, or, div, mod, rem, exp, abs, null)
-import qualified Prelude as P
+import Language.Syntactic hiding (fold, printExpr, showAST, drawAST, writeHtmlAST)
+import Language.Syntactic.Functional
+import Language.Syntactic.Functional.Sharing
+import Language.Syntactic.Functional.Tuple
+import Language.Syntactic.Sugar.BindingTyped ()
+import Language.Syntactic.Sugar.TupleTyped ()
+import qualified Language.Syntactic as Syntactic
 
+import Control.Arrow
+import Control.Applicative (liftA)
+
+import Data.Bits     (Bits)
+import Data.Maybe    (fromJust)
+import Data.Typeable (Typeable)
+import Data.Word     (Word8)
+import qualified Data.Bits as Bits
+
+import Prelude hiding (not, and, or, abs, rem, div, mod, exp)
+import qualified Prelude
+
 --------------------------------------------------------------------------------
--- * VHDL Expression Type - a union of VHDLs' types + variables
+-- * ...
 --------------------------------------------------------------------------------
 
-data Expr a
+class    (Typeable a, Rep a, Eq a) => Type a
+instance (Typeable a, Rep a, Eq a) => Type a
+
+--------------------------------------------------------------------------------
+-- ** ...
+
+data Expression sig
   where
-    -- ^ ...
-    Val :: Rep a => a          -> Expr a
-    Var :: Rep a => Identifier -> Expr a
+    And  :: Expression (Bool :-> Bool :-> Full Bool)
+    Or   :: Expression (Bool :-> Bool :-> Full Bool)
+    Xor  :: Expression (Bool :-> Bool :-> Full Bool)
+    Xnor :: Expression (Bool :-> Bool :-> Full Bool)
+    Nand :: Expression (Bool :-> Bool :-> Full Bool)
+    Nor  :: Expression (Bool :-> Bool :-> Full Bool)
 
-    -- ^ ...
-    Pair :: Expr a -> Expr b -> Expr (a, b)
-    Fst  :: Expr (a, b) -> Expr a
-    Snd  :: Expr (a, b) -> Expr b
+instance Equality   Expression
+instance StringTree Expression
 
-    -- ^ 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
+instance Symbol Expression
+  where
+    symSig And  = signature
+    symSig Or   = signature
+    symSig Xor  = signature
+    symSig Xnor = signature
+    symSig Nand = signature
+    symSig Nor  = signature
 
-    -- 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
+instance Render Expression
+  where
+    renderSym And  = "and"
+    renderSym Or   = "or"
+    renderSym Xor  = "xor"
+    renderSym Xnor = "xnor"
+    renderSym Nand = "nand"
+    renderSym Nor  = "nor"
 
-    -- 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
+instance Eval Expression
+  where
+    evalSym And  = (&&)
+    evalSym Or   = (||)
+    evalSym Xor  = \x y -> (x && Prelude.not y) || (Prelude.not x && y)
+    evalSym Xnor = \x y -> (Prelude.not x && Prelude.not y) || (x && y)
+    evalSym Nand = \x y -> Prelude.not (x && y)
+    evalSym Nor  = \x y -> Prelude.not (x || y)
 
-    -- 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
+instance EvalEnv Expression env
 
-    -- 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
+data Relational sig
+  where
+    Eq   :: Type a => Relational (a :-> a :-> Full Bool)
+    Neq  :: Type a => Relational (a :-> a :-> Full Bool)
+    Lt   :: (Type a, Ord a) => Relational (a :-> a :-> Full Bool)
+    Lte  :: (Type a, Ord a) => Relational (a :-> a :-> Full Bool)
+    Gt   :: (Type a, Ord a) => Relational (a :-> a :-> Full Bool)
+    Gte  :: (Type a, Ord a) => Relational (a :-> a :-> Full Bool)
 
-type instance PredicateExp Expr = Rep
+instance Equality   Relational
+instance StringTree Relational
 
+instance Symbol Relational
+  where
+    symSig Eq  = signature
+    symSig Neq = signature
+    symSig Lt  = signature
+    symSig Lte = signature
+    symSig Gt  = signature
+    symSig Gte = signature
+
+instance Render Relational
+  where
+    renderSym Eq  = "(==)"
+    renderSym Neq = "(/=)"
+    renderSym Lt  = "(<)"
+    renderSym Lte = "(<=)"
+    renderSym Gt  = "(>)"
+    renderSym Gte = "(>=)"
+
+instance Eval Relational
+  where
+    evalSym Eq  = (==)
+    evalSym Neq = (/=)
+    evalSym Lt  = (<)
+    evalSym Lte = (<=)
+    evalSym Gt  = (>)
+    evalSym Gte = (>=)
+
+instance EvalEnv Relational env
+
 --------------------------------------------------------------------------------
--- ** Sugared constructs
+-- ** ...
 
-class Rep (Internal a) => Syntactic a
+data Shift sig
   where
-    type Internal a
+    Sll :: (Type a, Bits a, Type b, Integral b) => Shift (a :-> b :-> Full a)
+    Srl :: (Type a, Bits a, Type b, Integral b) => Shift (a :-> b :-> Full a)
+    Sla :: (Type a, Bits a, Type b, Integral b) => Shift (a :-> b :-> Full a)
+    Sra :: (Type a, Bits a, Type b, Integral b) => Shift (a :-> b :-> Full a)
+    Rol :: (Type a, Bits a, Type b, Integral b) => Shift (a :-> b :-> Full a)
+    Ror :: (Type a, Bits a, Type b, Integral b) => Shift (a :-> b :-> Full a)
 
-    sugar   :: a -> Expr (Internal a)
-    desugar :: Expr (Internal a) -> a
+instance Equality   Shift
+instance StringTree Shift
 
-instance Rep a => Syntactic (Expr a)
+instance Symbol Shift
   where
-    type Internal (Expr a) = a
+    symSig Sll = signature
+    symSig Srl = signature
+    symSig Sla = signature
+    symSig Sra = signature
+    symSig Rol = signature
+    symSig Ror = signature
 
-    sugar   = id
-    desugar = id
+instance Render Shift
+  where
+    renderSym Sll = "sll"
+    renderSym Srl = "srl"
+    renderSym Sla = "sla"
+    renderSym Sra = "sra"
+    renderSym Rol = "rol"
+    renderSym Ror = "ror"
 
-instance (Syntactic a, Syntactic b) => Syntactic (a, b)
+instance Eval Shift
   where
-    type Internal (a, b) = (Internal a, Internal b)
+    evalSym Sll = \x i -> Bits.shiftL x (fromIntegral i)
+    evalSym Srl = \x i -> shiftLR     x (fromIntegral i)
+    evalSym Sla = \x i -> Bits.shiftL x (fromIntegral i)
+    evalSym Sra = \x i -> Bits.shiftR x (fromIntegral i)
+    evalSym Rol = \x i -> Bits.rotateL x (fromIntegral i)
+    evalSym Ror = \x i -> Bits.rotateR x (fromIntegral i)
 
-    sugar   (a, b) = Pair (sugar a) (sugar b)
-    desugar p      = (desugar (Fst p), desugar (Snd p))
+shiftLR :: Bits a => a -> Int -> a
+shiftLR x n =
+  let y = Bits.shiftR x n
+  in case Bits.bitSizeMaybe x of
+    Just i  -> foldr (flip Bits.clearBit) y [i - n `Prelude.mod` i .. i]
+    Nothing -> y
 
--- ...
+instance EvalEnv Shift env
 
 --------------------------------------------------------------------------------
--- ** Useful Expr Instances
+-- ** ...
 
-instance (Rep a, Bounded a) => Bounded (Expr a)
+data Simple sig
   where
-    minBound = Val minBound
-    maxBound = Val maxBound
+    Neg :: (Type a, Num a) => Simple (a :->       Full a)
+    Pos :: (Type a, Num a) => Simple (a :->       Full a)
+    Add :: (Type a, Num a) => Simple (a :-> a :-> Full a)
+    Sub :: (Type a, Num a) => Simple (a :-> a :-> Full a)
+    Cat :: (Type a, Show a, Read a) => Simple (a :-> a :-> Full a)
 
-instance (Rep a, Enum a) => Enum (Expr a) -- needed for integral
+instance Equality   Simple
+instance StringTree Simple
+
+instance Symbol Simple
   where
-    toEnum   = error "toEnum not supported"
-    fromEnum = error "fromEnum not supported"
+    symSig Neg = signature
+    symSig Pos = signature
+    symSig Add = signature
+    symSig Sub = signature
+    symSig Cat = signature
 
-instance (Rep a, Num a) => Num (Expr a)
+instance Render Simple
   where
-    fromInteger  = Val . fromInteger
-    (+)          = Add
-    (-)          = Sub
-    (*)          = Mul
-    abs          = Abs
-    signum       = error "signum not implemented for Expr"
+    renderSym Neg = "(-)"
+    renderSym Pos = "id"
+    renderSym Add = "(+)"
+    renderSym Sub = "(-)"
+    renderSym Cat = "(&)"
 
---------------------------------------------------------------------------------
--- * User interface
---------------------------------------------------------------------------------
+instance Eval Simple
+  where
+    evalSym Neg = negate
+    evalSym Pos = id
+    evalSym Add = (+)
+    evalSym Sub = (-)
+    evalSym Cat = \x y -> read (show x ++ show y)
 
+instance EvalEnv Simple env
+
 --------------------------------------------------------------------------------
--- ** Logical operators
+-- ** ...
 
-and, or, xor, xnor, nand, nor :: Expr Bool -> Expr Bool -> Expr Bool
+data Term sig
+  where
+    Mul :: (Type a, Num a)      => Term (a :-> a :-> Full a)
+    Div :: (Type a, Integral a) => Term (a :-> a :-> Full a)
+    Mod :: (Type a, Integral a) => Term (a :-> a :-> Full a)
+    Rem :: (Type a, Integral a) => Term (a :-> a :-> Full a)
 
-and  = And
-or   = Or
-xor  = Xor
-xnor = Xnor
-nand = Nand
-nor  = Nor
+instance Equality   Term
+instance StringTree Term
 
---------------------------------------------------------------------------------
--- ** Relational operators
+instance Symbol Term
+  where
+    symSig Mul = signature
+    symSig Div = signature
+    symSig Mod = signature
+    symSig Rem = signature
 
-eq, neq          :: Eq a  => Expr a -> Expr a -> Expr Bool
-lt, lte, gt, gte :: Ord a => Expr a -> Expr a -> Expr Bool
+instance Render Term
+  where
+    renderSym Mul = "(*)"
+    renderSym Div = "(/)"
+    renderSym Mod = "(%)"
+    renderSym Rem = "rem"
 
-eq  = Eq
-neq = Neq
-lt  = Lt
-lte = Lte
-gt  = Gt
-gte = Gte
+instance Eval Term
+  where
+    evalSym Mul = (*)
+    evalSym Div = Prelude.div
+    evalSym Mod = Prelude.mod
+    evalSym Rem = Prelude.rem
 
+instance EvalEnv Term env
+
 --------------------------------------------------------------------------------
--- ** Shift operators
+-- ** ...
 
-sll, srl, sra, sla, rol, ror :: (Bits a, Integral b) => Expr a -> Expr b -> Expr a
+data Factor sig
+  where
+    Exp :: (Type a, Num a, Type b, Integral b) => Factor (a :-> b :-> Full a)
+    Abs :: (Type a, Num a) => Factor (a :-> Full a)
+    Not :: Factor (Bool :-> Full Bool)
 
-sll = Sll
-srl = Srl
-sra = Sra
-sla = Sla
-rol = Rol
-ror = Ror
+instance Equality   Factor
+instance StringTree Factor
 
---------------------------------------------------------------------------------
--- ** Adding operators
+instance Symbol Factor
+  where
+    symSig Exp = signature
+    symSig Abs = signature
+    symSig Not = signature
 
-add, sub, cat :: Num a => Expr a -> Expr a -> Expr a
+instance Render Factor
+  where
+    renderSym Exp = "(**)"
+    renderSym Abs = "abs"
+    renderSym Not = "not"
 
-add = Add
-sub = Sub
-cat = Cat
+instance Eval Factor
+  where
+    evalSym Exp = (^)
+    evalSym Abs = Prelude.abs
+    evalSym Not = Prelude.not
 
+instance EvalEnv Factor env
+
 --------------------------------------------------------------------------------
--- ** Multiplying operators
+-- ** ...
 
-mul           :: (Num a, Rep a) => Expr a -> Expr a -> Expr a
-div, mod, rem :: Integral a => Expr a -> Expr a -> Expr a
+data Primary sig
+  where
+    Lit :: Type a => a -> Primary (Full a)
 
-mod = Mod
-rem = Rem
-mul = Mul
-div = Div
+instance Equality   Primary
+instance StringTree Primary
 
---------------------------------------------------------------------------------
--- ** Sign operators
+instance Symbol Primary
+  where
+    symSig (Lit _) = signature
 
-neg :: Num a => Expr a -> Expr a
-neg = Neg
+instance Render Primary
+  where
+    renderSym (Lit _) = "lit"
 
+instance Eval Primary
+  where
+    evalSym (Lit i) = i
+
+instance EvalEnv Primary env
+
 --------------------------------------------------------------------------------
--- ** Miscellaneous operators
 
-not :: Expr Bool -> Expr Bool
-not = Not
+type VHDLDomain = Typed Dom
 
-exp :: Floating a => Expr a -> Expr a -> Expr a
-exp = Exp
+type Dom = 
+  -- Syntactic
+      BindingT
+  :+: Let
+  :+: Tuple
+  :+: Construct
+  -- VHDL constructs
+  :+: Expression
+  :+: Relational
+  :+: Shift
+  :+: Simple
+  :+: Term
+  :+: Factor
+  :+: Primary
 
-abs :: Num a => Expr a -> Expr a
-abs = Abs
+newtype Data a = Data { unData :: ASTF VHDLDomain a }
 
---------------------------------------------------------------------------------
--- ** Naming operators
+instance Type a => Syntactic (Data a)
+  where
+    type Domain   (Data a) = VHDLDomain
+    type Internal (Data a) = a
 
-name :: Rep a => Identifier -> Expr a
-name = Var
+    desugar = unData
+    sugar   = Data
 
-lit :: Rep a => a -> Expr a
-lit = Val
+class    (Syntactic a, Domain a ~ VHDLDomain, Type (Internal a)) => Syntax a
+instance (Syntactic a, Domain a ~ VHDLDomain, Type (Internal a)) => Syntax a
 
+type instance PredicateExp Data = Type
+
 --------------------------------------------------------------------------------
--- * Compilation of expressions
+-- * Backend
 --------------------------------------------------------------------------------
 
-instance CompileExp Expr
+codeMotionInterface :: CodeMotionInterface VHDLDomain
+codeMotionInterface = defaultInterface VarT LamT sharable (const True)
   where
-    varE  = Var
-    compT = compileT
-    compE = compileE
+    sharable :: ASTF VHDLDomain a -> ASTF VHDLDomain b -> Bool
+    sharable (Sym _) _ = False
+    sharable (lam :$ _) _
+      | Just _ <- prLam lam = False
+    sharable _ (lam :$ _)
+      | Just _ <- prLam lam = False
+    sharable (sel :$ _) _
+      | Just Sel1 <- prj sel = False
+      | Just Sel2 <- prj sel = False
+      | Just Sel3 <- prj sel = False
+      | Just Sel4 <- prj sel = False
+    sharable _ _ = True
 
-compileT :: forall a. Rep a => Expr a -> VHDL Type
-compileT _ = return $ unTag $ (typed :: Tagged a Type)
+showExpr :: (Syntactic a, Domain a ~ VHDLDomain) => a -> String
+showExpr = render . codeMotion codeMotionInterface . desugar
 
-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
+showAST :: (Syntactic a, Domain a ~ VHDLDomain) => a -> String
+showAST = Syntactic.showAST . codeMotion codeMotionInterface . desugar
 
-      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))
+eval :: (Syntactic a, Domain a ~ VHDLDomain) => a -> Internal a
+eval = evalClosed . desugar
 
-      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))
+--------------------------------------------------------------------------------
+-- * Frontend
+--------------------------------------------------------------------------------
 
-      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))
+value :: Syntax a => Internal a -> a
+value = sugar . injT . Lit
 
-      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)]
+force :: Syntax a => a -> a
+force = resugar
 
-      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)]
+share :: (Syntax a, Syntax b) => a -> (a -> b) -> b
+share = sugarSymTyped Let
 
-      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"
+-- logical operators
+and, or, xor, xnor, nand, nor :: Data Bool -> Data Bool -> Data Bool
+and  = sugarSymTyped And
+or   = sugarSymTyped Or
+xor  = sugarSymTyped Xor
+xnor = sugarSymTyped Xnor
+nand = sugarSymTyped Nand
+nor  = sugarSymTyped Nor
 
+-- relational operators
+eq, neq :: (Type a, Eq a) => Data a -> Data a -> Data Bool
+eq  = sugarSymTyped Eq
+neq = sugarSymTyped Neq
+
+lt, lte, gt, gte :: (Type a, Ord a) => Data a -> Data a -> Data Bool
+lt  = sugarSymTyped Lt
+lte = sugarSymTyped Lte
+gt  = sugarSymTyped Gt
+gte = sugarSymTyped Gte
+
+-- shift operators
+sll, srl, sla, sra, rol, ror :: (Type a, Bits a, Type b, Integral b) => Data a -> Data b -> Data a
+sll = sugarSymTyped Sll
+srl = sugarSymTyped Srl
+sla = sugarSymTyped Sla
+sra = sugarSymTyped Sra
+rol = sugarSymTyped Rol
+ror = sugarSymTyped Ror
+
+-- adding operators
+add, sub :: (Type a, Num a) => Data a -> Data a -> Data a
+add = sugarSymTyped Add
+sub = sugarSymTyped Sub
+
+cat :: (Type a, Read a, Show a) => Data a -> Data a -> Data a
+cat = sugarSymTyped Cat
+
+-- multiplying operators
+mul :: (Type a, Num a) => Data a -> Data a -> Data a
+mul = sugarSymTyped Mul
+
+div, mod, rem :: (Type a, Integral a) => Data a -> Data a -> Data a
+div = sugarSymTyped Div
+mod = sugarSymTyped Mod
+rem = sugarSymTyped Rem
+
+-- miscellaneous operators
+exp :: (Type a, Num a, Type b, Integral b) => Data a -> Data b -> Data a
+exp = sugarSymTyped Exp
+
+abs :: (Type a, Num a) => Data a -> Data a
+abs = sugarSymTyped Abs
+
+not :: Data Bool -> Data Bool
+not = sugarSymTyped Not
+
 --------------------------------------------------------------------------------
+-- ** ...
+
+instance (Type a, Eq a) => Eq (Data a)
+  where
+    (==) = error "VHDL: equality checking is not supported"
+
+instance (Type a, Ord a) => Ord (Data a)
+  where
+    compare = error "VHDL: compare is not supported"
+    max     = error "VHDL: max is not supported"
+    min     = error "VHDL: min is not supported"
+
+instance (Type a, Bounded a) => Bounded (Data a)
+  where
+    minBound = value minBound
+    maxBound = value maxBound
+
+instance (Type a, Enum a) => Enum (Data a)
+  where
+    toEnum   = error "VHDL: toEnum is not supported"
+    fromEnum = error "VHDL: fromEnum is not supported"
+
+instance (Type a, Real a) => Real (Data a)
+  where
+    toRational = error "VHDL: toRational is not supported"
+
+instance (Type a, Num a) => Num (Data a)
+  where
+    fromInteger = value . fromInteger
+    (+)         = add
+    (-)         = sub
+    (*)         = mul
+    abs         = abs
+    signum      = error "VHDL: signum is not supported"
+
+instance (Type a, Integral a) => Integral (Data a)
+  where
+    quot         = error "VHDL: quotient is not supported"
+    rem          = rem
+    div          = div
+    mod          = mod
+    quotRem  a b = (quot a b, rem a b)
+    divMod   a b = (div  a b, mod a b)
+    toInteger    = error "VHDL: toInteger is not supported"
+
+instance (Type a, Fractional a) => Fractional (Data a)
+  where
+    (/)          = error "VHDL: floating point division is not _yet_ supported"
+    recip        = (/) (value 1)
+    fromRational = error "VHDL: fromRational is not supported"
+    
+--------------------------------------------------------------------------------
 -- * Evaluation of Expressions
 --------------------------------------------------------------------------------
 
-instance EvaluateExp Expr
+instance EvaluateExp Data
   where
-    litE  = Val
-    evalE = evaluate
+    litE  = value
+    evalE = eval
 
-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
+--------------------------------------------------------------------------------
+-- * Compilation of expressions
+--------------------------------------------------------------------------------
 
-    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
+instance CompileExp Data
+  where
+    varE i = sugarSymTyped ((VarT (Name i)))
+    
+    compT = compileT
 
-    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
+    compE = liftA lift
+          . compileE
+          . mapAST (\(Typed s) -> s)
+          . codeMotion codeMotionInterface
+          . desugar
 
-    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
+compileT :: forall a. Rep a => Data a -> VHDL T.Type
+compileT _ =
+  do let t = unTag (typed :: Tagged a T.Type)
+     declare (undefined :: a)
+     return t
 
-    Exp  x y -> bin (**) x y
-    Abs  x   -> un P.abs x
+compileE :: ASTF Dom a -> VHDL Kind
+compileE var
+  | Just (Var  v) <- prj var = return $ P $ M.name $ vars v
+  | Just (VarT v) <- prj var = return $ P $ M.name $ vars v
+compileE val
+  | Just (Lit v) <- prj val = return $ P $ M.string $ format v
+compileE (lets :$ a :$ (lam :$ body))
+  | Just (Let)    <- prj lets
+  , Just (LamT v) <- prj lam
+  = do let v' = Ident $ vars v
+       a' <- lift <$> compileE a
+       M.addSequential $ M.assignVariable v' a'
+       compileE body
+     -- that we pick variable assignment might be a problem
+compileE (expr :$ x :$ y)
+  | Just And  <- prj expr = go $ \a b -> M.and  [a, b]
+  | Just Or   <- prj expr = go $ \a b -> M.or   [a, b]
+  | Just Xor  <- prj expr = go $ \a b -> M.xor  [a, b]
+  | Just Xnor <- prj expr = go $ \a b -> M.xnor [a, b]
+  | Just Nand <- prj expr = go $ M.nand
+  | Just Nor  <- prj expr = go $ M.nor
   where
-    xor a b = (a || b) && P.not (a && b)
-    
-    un :: (a -> b) -> Expr a -> b
-    un  f x   = f (evaluate x)
+    go :: (V.Relation -> V.Relation -> V.Expression) -> VHDL Kind
+    go f = bin (\a b -> Hoist.E $ f (lift a) (lift b)) x y
+compileE (relate :$ x :$ y)
+  | Just Eq  <- prj relate = go $ M.eq
+  | Just Neq <- prj relate = go $ M.neq
+  | Just Lt  <- prj relate = go $ M.lt
+  | Just Lte <- prj relate = go $ M.lte
+  | Just Gt  <- prj relate = go $ M.gt
+  | Just Gte <- prj relate = go $ M.gte
+  where
+    go :: (V.ShiftExpression -> V.ShiftExpression -> V.Relation) -> VHDL Kind
+    go f = bin (\a b -> Hoist.R $ f (lift a) (lift b)) x y
+compileE (shift :$ x :$ y)
+  | Just Sll <- prj shift = go $ M.sll
+  | Just Srl <- prj shift = go $ M.srl
+  | Just Sla <- prj shift = go $ M.sla
+  | Just Sra <- prj shift = go $ M.sra
+  | Just Rol <- prj shift = go $ M.rol
+  | Just Ror <- prj shift = go $ M.ror
+  where
+    go :: (V.SimpleExpression -> V.SimpleExpression -> V.ShiftExpression) -> VHDL Kind
+    go f = bin (\a b -> Hoist.Sh $ f (lift a) (lift b)) x y
+compileE (simple :$ x)
+  | Just Neg <- prj simple = go $ M.neg
+  | Just Pos <- prj simple = go $ lift
+  where
+    go :: (V.Term -> V.SimpleExpression) -> VHDL Kind
+    go f = un (\a -> Hoist.Si $ f (lift a)) x
+compileE (simple :$ x :$ y)
+  | Just Add <- prj simple = go $ \a b -> M.add [a, b]
+  | Just Sub <- prj simple = go $ \a b -> M.sub [a, b]
+  | Just Cat <- prj simple = go $ \a b -> M.cat [a, b]
+  where
+    go :: (V.Term -> V.Term -> V.SimpleExpression) -> VHDL Kind
+    go f = bin (\a b -> Hoist.Si $ f (lift a) (lift b)) x y
+compileE (term :$ x :$ y)
+  | Just Mul <- prj term = go $ \a b -> M.mul [a, b]
+  | Just Div <- prj term = go $ \a b -> M.div [a, b]
+  | Just Mod <- prj term = go $ \a b -> M.mod [a, b]
+  | Just Rem <- prj term = go $ \a b -> M.rem [a, b]
+  where
+    go :: (V.Factor -> V.Factor -> V.Term) -> VHDL Kind
+    go f = bin (\a b -> Hoist.T $ f (lift a) (lift b)) x y
+compileE (factor :$ x :$ y)
+  | Just Exp <- prj factor = go $ M.exp
+  where
+    go :: (V.Primary -> V.Primary -> V.Factor) -> VHDL Kind
+    go f = bin (\a b -> Hoist.F $ f (lift a) (lift b)) x y
+compileE (factor :$ x)
+  | Just Abs <- prj factor = go $ M.abs
+  | Just Not <- prj factor = go $ M.not
+  where
+    go :: (V.Primary -> V.Factor) -> VHDL Kind
+    go f = un (\a -> Hoist.F $ f (lift a)) x
+compileE (primary)
+  | Just (Lit i) <- prj primary = return $ Hoist.P $ M.lit $ format i
+compileE x = error $ "imperative-edsl: missing compiler case for " ++ (Syntactic.showAST 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
+-- | ...
+vars :: Name -> String
+vars v = 'v' : show v
+
+-- | ...
+un :: (Kind -> Kind) -> ASTF Dom a -> VHDL Kind
+un f x = compileE x >>= return . f
+
+-- | ...
+bin :: (Kind -> Kind -> Kind) -> ASTF Dom a -> ASTF Dom b -> VHDL Kind
+bin f x y = do
+  x' <- compileE x
+  y' <- compileE y
+  return $ f x' y'
 
 --------------------------------------------------------------------------------
diff --git a/src/Language/Embedded/VHDL/Expression/Format.hs b/src/Language/Embedded/VHDL/Expression/Format.hs
deleted file mode 100644
--- a/src/Language/Embedded/VHDL/Expression/Format.hs
+++ /dev/null
@@ -1,127 +0,0 @@
-{-# 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/Represent.hs b/src/Language/Embedded/VHDL/Expression/Represent.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Embedded/VHDL/Expression/Represent.hs
@@ -0,0 +1,143 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving  #-}
+
+module Language.Embedded.VHDL.Expression.Represent
+  ( Tagged(..)
+  , Rep(..)
+  ) where
+
+import Language.VHDL (TypeDeclaration(..), SubtypeIndication(..))
+import Language.Embedded.VHDL.Monad (VHDL)
+import Language.Embedded.VHDL.Monad.Type
+import qualified Language.VHDL as V
+import qualified Language.Embedded.VHDL.Monad as M
+
+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
+    declare :: a -> VHDL ()
+    format  :: a -> String
+
+declareBoolean :: VHDL ()
+declareBoolean =
+  do M.newLibrary "IEEE"
+     M.newImport  "IEEE.std_logic_1164"
+
+declareNumeric :: VHDL ()
+declareNumeric =
+  do M.newLibrary "IEEE"
+     M.newImport  "IEEE.std_logic_1164"
+     M.newImport  "IEEE.numeric_std"
+
+--------------------------------------------------------------------------------
+-- ** Boolean
+
+instance Rep Bool where
+  width        = Tag 1
+  typed        = Tag std_logic
+  declare _    = declareBoolean
+  format True  = "1"
+  format False = "0"
+
+--------------------------------------------------------------------------------
+-- ** Signed
+
+instance Rep Int8 where
+  width     = Tag 8
+  typed     = Tag signed8
+  declare _ = declareNumeric
+  format    = convert
+
+instance Rep Int16 where
+  width     = Tag 16
+  typed     = Tag signed16
+  declare _ = declareNumeric
+  format    = convert
+
+instance Rep Int32 where
+  width     = Tag 32
+  typed     = Tag signed32
+  declare _ = declareNumeric
+  format    = convert
+
+instance Rep Int64 where
+  width     = Tag 64
+  typed     = Tag signed64
+  declare _ = declareNumeric
+  format    = convert
+
+--------------------------------------------------------------------------------
+-- ** Unsigned
+
+instance Rep Word8 where
+  width     = Tag 8
+  typed     = Tag usigned8
+  declare _ = declareNumeric
+  format    = convert
+
+instance Rep Word16 where
+  width     = Tag 16
+  typed     = Tag usigned16
+  declare _ = declareNumeric
+  format    = convert
+
+instance Rep Word32 where
+  width     = Tag 32
+  typed     = Tag usigned32
+  declare _ = declareNumeric
+  format    = convert
+
+instance Rep Word64 where
+  width     = Tag 64
+  typed     = Tag usigned64
+  declare _ = declareNumeric
+  format    = convert
+
+--------------------------------------------------------------------------------
+-- * 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/Type.hs b/src/Language/Embedded/VHDL/Expression/Type.hs
deleted file mode 100644
--- a/src/Language/Embedded/VHDL/Expression/Type.hs
+++ /dev/null
@@ -1,75 +0,0 @@
-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
--- a/src/Language/Embedded/VHDL/Interface.hs
+++ b/src/Language/Embedded/VHDL/Interface.hs
@@ -3,9 +3,9 @@
 
 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 Language.VHDL                     (Expression, Identifier(..))
+import Language.Embedded.VHDL.Monad      (VHDL)
+import Language.Embedded.VHDL.Monad.Type (Type)
 
 import Data.Constraint
 import Data.Typeable   (Typeable)
@@ -23,19 +23,19 @@
     litE  :: PredicateExp exp a => a -> exp a
 
     -- | Evaluation of (closed) expressions
-    evalE :: exp a -> a
+    evalE :: PredicateExp exp a => exp a -> a
 
 
 -- | General interface for compiling expressions
 class CompileExp exp
   where
     -- | Variable expressions
-    varE  :: PredicateExp exp a => Identifier -> exp a
+    varE  :: PredicateExp exp a => Integer -> exp a
 
     -- | Compilation of type kind
     compT :: PredicateExp exp a => exp a -> VHDL Type
 
     -- | Compilation of expressions
-    compE :: exp a -> VHDL Expression
+    compE :: PredicateExp exp a => exp a -> VHDL Expression
 
 --------------------------------------------------------------------------------
diff --git a/src/Language/Embedded/VHDL/Monad.hs b/src/Language/Embedded/VHDL/Monad.hs
--- a/src/Language/Embedded/VHDL/Monad.hs
+++ b/src/Language/Embedded/VHDL/Monad.hs
@@ -5,7 +5,7 @@
 -- used for the Ord/Eq inst. of XDeclaration etc.
 {-# LANGUAGE StandaloneDeriving #-}
 
-module Language.Embedded.VHDL.Monad (    
+module Language.Embedded.VHDL.Monad (
     VHDL
   , VHDLT
   , VHDLEnv
@@ -14,6 +14,8 @@
     -- ^ run
   , runVHDLT
   , runVHDL
+  , execVHDLT
+  , execVHDL
 
     -- ^ pretty
   , prettyVHDL
@@ -21,36 +23,32 @@
 
     -- ^ ...
   , freshUnique
-  , newVar
+  , newSym
   , newLabel
 
+    -- ^ ...
+  , newLibrary,    newImport
+
     -- ^ declarations
-  , addPort
-  , addGeneric
-  , addType
+  , addPort,       addGeneric
+  , addGlobal,     addLocal
+  , addConcurrent, addSequential
   , addComponent
-  , addGlobal
-  , addLocal
 
     -- ^ statements
-  , addConcurrent
-  , addSequential
-
-    -- ^ key statements
-  , inEntity
-  , inArchitecture
   , inProcess
   , inConditional
   , inCase
 
+    -- ^ ...
+  , entity
+  , architecture
+  , package
+
     -- ^ common
-  , interfaceConstant
-  , interfaceSignal
-  , interfaceVariable
-  , declRecord
-  , declConstant
-  , declSignal
-  , declVariable
+  , interfaceConstant, interfaceSignal, interfaceVariable
+  , declRecord, declConstant, declSignal, declVariable
+                                          
   , portMap
   , assignSignal
   , assignVariable
@@ -61,8 +59,8 @@
 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 Language.Embedded.VHDL.Monad.Type
 
 import Control.Arrow          (first, second)
 import Control.Applicative
@@ -78,8 +76,11 @@
 import Data.List        (groupBy)
 import Data.Set         (Set)
 import qualified Data.Set as Set
+import Data.Map         (Map)
+import qualified Data.Map as Map
 
 import Text.PrettyPrint (Doc, ($+$))
+import qualified Text.PrettyPrint as Text
 
 import Prelude hiding (null, not, abs, exp, rem, mod, div, and, or)
 import qualified Prelude as P
@@ -88,30 +89,21 @@
 -- * ..
 --------------------------------------------------------------------------------
 
--- | ...
-data VFile = VFile (V.EntityDeclaration) [V.ArchitectureBody]
-
 -- | Code generation state
 data VHDLEnv = VHDLEnv
   { _unique        :: !Integer
-  , _entity        :: String
-
     -- ..
-  , _parts         :: [VFile]
-
+  , _designs       :: [V.DesignUnit]
     -- ...
+  , _context       :: Set V.ContextItem
   , _types         :: Set V.TypeDeclaration
-  , _components    :: Set V.ComponentDeclaration
-
     -- headers
   , _ports         :: [V.InterfaceDeclaration]
   , _generics      :: [V.InterfaceDeclaration]
-  , _architectures :: [V.ArchitectureBody]
-    
+  , _components    :: Set V.ComponentDeclaration
     -- declarations
   , _global        :: [V.BlockDeclarativeItem]
   , _local         :: [V.BlockDeclarativeItem]
-
     -- statements
   , _concurrent    :: [V.ConcurrentStatement]
   , _sequential    :: [V.SequentialStatement]
@@ -120,13 +112,12 @@
 -- | Initial state during code generation
 emptyVHDLEnv = VHDLEnv
   { _unique        = 0
-  , _entity        = "invisible"
-  , _parts         = []
+  , _designs       = []
+  , _context       = Set.empty
   , _types         = Set.empty
   , _components    = Set.empty
   , _ports         = []
   , _generics      = []
-  , _architectures = []
   , _global        = []
   , _local         = []
   , _concurrent    = []
@@ -134,7 +125,7 @@
   }
 
 --------------------------------------------------------------------------------
--- *
+-- * 
 
 -- | Type constraints for the VHDL monads
 type MonadV m = (Functor m, Applicative m, Monad m, MonadState VHDLEnv m)
@@ -142,7 +133,7 @@
 -- | VHDL code generation monad
 type VHDL = VHDLT Identity
 
--- | VHDL code genreation monad transformer
+-- | VHDL code genreation monad transformer.
 newtype VHDLT m a = VHDLT { unVGenT :: StateT VHDLEnv m a }
   deriving ( Functor
            , Applicative
@@ -151,82 +142,129 @@
            , MonadIO
            )
 
--- | Run the VHDL code generation monad transformer
+-- | 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)
+-- | -- | Executes the VHDL code generation monad transformer, returning only its final state.
+execVHDLT :: Monad m => VHDLT m a -> VHDLEnv -> m VHDLEnv
+execVHDLT m = CMS.execStateT (unVGenT m)
 
+-- | Run the VHDL code generation monad.
+runVHDL :: VHDL a -> VHDLEnv -> (a, VHDLEnv)
+runVHDL m = CMI.runIdentity . runVHDLT m
+
+-- | Executes the VHDL code generation monad, returning only its final state.
+execVHDL :: VHDL a -> VHDLEnv -> VHDLEnv
+execVHDL m = CMI.runIdentity . execVHDLT m
+
 --------------------------------------------------------------------------------
--- ** Unique generation
+-- ** Generating uniques
 
--- | Generates a unique integer
+-- | 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 identifier.
+newSym :: MonadV m => m Identifier
+newSym = do i <- freshUnique; return (Ident $ 'v' : show i)
 
--- | Generates a fresh and unique label
+-- | Generates a fresh and unique label.
 newLabel :: MonadV m => m Label
-newLabel = freshUnique >>= return . Ident . ('l' :) . show
+newLabel = do i <- freshUnique; return (Ident $ 'l' : show i)
 
 --------------------------------------------------------------------------------
+-- ** ...
+
+-- | Adds a new library import to the context.
+newLibrary :: MonadV m => String -> m ()
+newLibrary l = CMS.modify $ \s -> s { _context = Set.insert item (_context s) }
+  where
+    item :: V.ContextItem
+    item = V.ContextLibrary (V.LibraryClause (V.LogicalNameList [V.Ident l]))
+
+-- | Adds a new library use clause to the context (with an .ALL suffix by default).
+newImport :: MonadV m => String -> m ()
+newImport i = CMS.modify $ \s -> s { _context = Set.insert item (_context s) }
+  where
+    item :: V.ContextItem
+    item = V.ContextUse (V.UseClause [V.SelectedName (V.PName (V.NSimple (V.Ident i))) (V.SAll)])
+
+--------------------------------------------------------------------------------
 -- ** Header declarations -- ignores port/generic maps for now
 
--- | Adds a port declaration to the entity
+-- | 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
+-- | 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
+-- ** Type declarations
 
--- | ...
+-- | Adds a type declaration.
 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
+-- | Adds a component declaration.
 addComponent :: MonadV m => V.ComponentDeclaration -> m ()
 addComponent c = CMS.modify $ \s -> s { _components = Set.insert c (_components s) }
 
 --------------------------------------------------------------------------------
 -- ** Item declarations
 
--- | Adds a global declaration
+-- | Adds a global declaration.
 addGlobal :: MonadV m => V.BlockDeclarativeItem -> m ()
 addGlobal g = CMS.modify $ \s -> s { _global = g : (_global s) }
 
--- | Adds a local declaration
+-- | Adds a local declaration.
 addLocal :: MonadV m => V.BlockDeclarativeItem -> m ()
 addLocal l = CMS.modify $ \s -> s { _local = l : (_local s) }
 
 --------------------------------------------------------------------------------
--- ** Concurrent statements
+-- ** Statement declarations
 
--- | Runs the given action inside a process
--- ! Due to how translate works, some local declarations might dissapear.
+-- | Adds a concurrent statement.
+addConcurrent :: MonadV m => V.ConcurrentStatement -> m ()
+addConcurrent con = CMS.modify $ \s -> s { _concurrent = con : (_concurrent s) }
+
+-- | Adds a sequential statement.
+addSequential :: MonadV m => V.SequentialStatement -> m ()
+addSequential seq = CMS.modify $ \s -> s { _sequential = seq : (_sequential s) }
+
+--------------------------------------------------------------------------------
+-- * Concurrent and sequential statements
+--------------------------------------------------------------------------------
+
+-- | ... helper ...
+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                                 -- return
+
+--------------------------------------------------------------------------------
+-- ** Process-statements
+
+-- | Runs the given action inside a process.
 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
+     result        <- m
      newLocals     <- reverse <$> CMS.gets _local
      newSequential <- reverse <$> CMS.gets _sequential
      CMS.modify $ \e -> e { _local      = oldLocals
                           , _sequential = oldSequential }
-     return ( a
+     return ( result
             , V.ProcessStatement
                 (Just l)                        -- label
                 (False)                         -- postponed
@@ -236,19 +274,11 @@
   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) }
-
+      
 --------------------------------------------------------------------------------
--- **
+-- ** If-statements
 
+-- | ...
 inConditional :: MonadV m => (V.Condition, m ()) -> [(V.Condition, m ())] -> m () -> m (V.IfStatement)
 inConditional (c, m) os e =
   do let (cs, ns) = unzip os
@@ -270,16 +300,10 @@
       | 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
-
 --------------------------------------------------------------------------------
--- **
+-- ** Case-statements
 
+-- | ...
 inCase :: MonadV m => V.Expression -> [(V.Choices, m ())] -> m (V.CaseStatement)
 inCase e choices =
   do let (cs, ns) = unzip choices
@@ -294,110 +318,141 @@
          (zipWith V.CaseStatementAlternative cs ns')
 
 --------------------------------------------------------------------------------
--- **
-
-addArchitecture :: MonadV m => V.ArchitectureBody -> m ()
-addArchitecture a = CMS.modify $ \s -> s { _architectures = a : (_architectures s)}
+-- * Design units
+--------------------------------------------------------------------------------
 
-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
+-- | ... design unit with context
+addDesign :: MonadV m => V.LibraryUnit -> m ()
+addDesign lib =
+  do ctxt <- CMS.gets _context
+     dsig <- CMS.gets _designs
+     let item = V.DesignUnit (V.ContextClause (Set.toList ctxt)) lib
+     CMS.modify $ \s -> s { _designs = item : dsig
+                          , _context = Set.empty
                           }
 
-     addArchitecture $ V.ArchitectureBody
-       (V.Ident name)
-       (V.NSimple (V.Ident oldEntity))
-       (merge $ newGlobal ++ newLocal)
-       (newConcurrent)
-     return a
+-- | .. design unit ignoring context
+addDesign_ :: MonadV m => V.LibraryUnit -> m ()
+addDesign_ lib = CMS.modify $ \s -> s { _designs = (V.DesignUnit (V.ContextClause []) lib) : (_designs s)}
 
 --------------------------------------------------------------------------------
--- **
+-- ** Architectures
 
-addPart  :: MonadV m => VFile -> m ()
-addPart v = CMS.modify $ \s -> s { _parts = v : (_parts s) }
+-- | Wraps the given monadic action in an architecture, consuming all global
+--   identifiers and concurrent statements it produces. Strings are its entity
+--   and architecture names, respectively.
+architecture :: MonadV m => Identifier -> Identifier -> m a -> m a
+architecture entity name m =
+  do oldGlobal     <- CMS.gets _global
+     oldConcurrent <- CMS.gets _concurrent
+     CMS.modify $ \e -> e { _global     = []
+                          , _concurrent = [] }
+     result        <- m
+     newGlobal     <- CMS.gets _global
+     newConcurrent <- CMS.gets _concurrent
+     addDesign_ $ V.LibrarySecondary $ V.SecondaryArchitecture $
+           V.ArchitectureBody
+             (name)
+             (V.NSimple entity)
+             (merge newGlobal)
+             (newConcurrent)
+     CMS.modify $ \e -> e { _global     = oldGlobal
+                          , _concurrent = oldConcurrent }
+     return result
 
-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
+--------------------------------------------------------------------------------
+-- ** Entities
+
+-- | Declares an entity with the given name by consuming all port-level
+--   declaraions and context items produced by running the monadic action.
+entity :: MonadV m => Identifier -> m a -> m a
+entity name m =
+  do oldPorts    <- CMS.gets _ports
+     oldGenerics <- CMS.gets _generics
+     CMS.modify $ \e -> e { _ports    = []
+                          , _generics = [] }
+     result      <- m
+     newPorts    <- CMS.gets _ports
+     newGenerics <- CMS.gets _generics
+     addDesign  $ V.LibraryPrimary $ V.PrimaryEntity $
+           V.EntityDeclaration
+             (name)
+             (V.EntityHeader
+               (V.GenericClause <$> maybeNull newGenerics)
+               (V.PortClause    <$> maybeNull newPorts))
+             ([])
+             (Nothing)
+     CMS.modify $ \e -> e { _ports    = oldPorts
+                          , _generics = oldGenerics }
+     return result
   where
     maybeNull :: [V.InterfaceDeclaration] -> Maybe V.InterfaceList
     maybeNull [] = Nothing
     maybeNull xs = Just $ V.InterfaceList $ merge xs
 
 --------------------------------------------------------------------------------
+-- ** Packages
+
+-- | Declares a package with the given name by consuming all type declarations
+--   produced by running the monadic action.
+--
+-- *** package body is always empty for now (until we support VHDL functions).
+package :: MonadV m => String -> m a -> m a
+package name m =
+  do oldTypes <- CMS.gets _types
+     CMS.modify $ \e -> e { _types = Set.empty }
+     result   <- m
+     newTypes <- CMS.gets _types
+     addDesign  $ V.LibraryPrimary $ V.PrimaryPackage $
+           V.PackageDeclaration
+             (V.Ident name)
+             (fmap V.PHDIType $ Set.toList newTypes)
+     addDesign_ $ V.LibrarySecondary $ V.SecondaryPackage $
+           V.PackageBody
+             (V.Ident name)
+             ([])
+     CMS.modify $ \e -> e { _types = oldTypes }
+     return result
+
+--------------------------------------------------------------------------------
 -- * Pretty
 --------------------------------------------------------------------------------
 
+-- | Runs the VHDL monad and pretty prints its resulting VHDL program.
 prettyVHDL :: VHDL a -> Doc
 prettyVHDL = CMI.runIdentity . prettyVHDLT
 
+-- | Runs the VHDL monad transformer and pretty prints its resulting VHDL program.
 prettyVHDLT :: Monad m => VHDLT m a -> m Doc
-prettyVHDLT m = prettyVEnv . snd <$> runVHDLT (inEntity "anonymous" m) emptyVHDLEnv
+prettyVHDLT m = prettyVEnv <$> execVHDLT m emptyVHDLEnv
 
-prettyVEnv  :: VHDLEnv -> Doc
-prettyVEnv (VHDLEnv _ _ parts types _ _ _ _ _ _ _ _) =
-    stack $ (genPackage "types" $ Set.toList types) : (fmap prettyPart parts)
+--------------------------------------------------------------------------------
+
+-- | Pretty print a VHDL environment.
+--
+-- *** Shouldn't use revers to fix ordering issues! Pair architectures/bodies
+--     with their respective entities.
+prettyVEnv :: VHDLEnv -> Doc
+prettyVEnv env = V.pp (V.DesignFile $ types ++ archi)
   where
-    stack :: [Doc] -> Doc
-    stack = foldr1 ($+$)
-    
-    prettyPart :: VFile -> Doc
-    prettyPart (VFile e as) = stack (V.pp e : fmap V.pp as)
+    archi = reverse $ _designs env
+    types = reverse $ designTypes (_types env)
 
---------------------------------------------------------------------------------
+-- | ...
+--
+-- *** Scan type declarations for necessary imports instead.
+-- *** Types are added in an ugly manner.
+designTypes :: Set V.TypeDeclaration -> [V.DesignUnit]
+designTypes set = _designs . snd $ runVHDL pack emptyVHDLEnv
+  where
+    pack :: MonadV m => m ()
+    pack = package "types" $ do
+      newLibrary "IEEE"
+      newImport  "IEEE.STD_LOGIC_1164"
+      newImport  "IEEE.STD_LOGIC_UNSIGNED"
+      newImport  "IEEE.NUMERIC_STD"
+      CMS.modify $ \e -> e { _types = set }
 
-genPackage :: String -> [V.TypeDeclaration] -> Doc
-genPackage name = V.pp . V.PackageDeclaration (V.Ident name) . fmap V.PHDIType
-    
 --------------------------------------------------------------------------------
 -- * Common things
 --------------------------------------------------------------------------------
@@ -427,6 +482,15 @@
   where
     decl (i, t) = V.ElementDeclaration [i] t
 
+-- ... only unconstrained arrays without any index subtype definitions
+declArray :: Identifier -> Type -> V.TypeDeclaration
+declArray name typ = V.TDFull
+  (V.FullTypeDeclaration
+    (name)
+    (V.TDComposite (V.CTDArray (V.ArrU (V.UnconstrainedArrayDefinition
+      ([])
+      (typ))))))
+
 --------------------------------------------------------------------------------
 -- ** Global/Local Declarations
 
@@ -535,22 +599,136 @@
 tryProcess _                 = Nothing
 
 --------------------------------------------------------------------------------
--- Ord instance for use in Set
+-- **  Ord instance for use in sets
+--
+-- *** These break the Ord rules but seems to be needed for Set.
+--     Should be replaced.
+
+deriving instance Ord V.ContextItem
+
+deriving instance Ord V.LibraryClause
+
+deriving instance Ord V.LogicalNameList
+
+deriving instance Ord V.UseClause
+
 --------------------------------------------------------------------------------
 
-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.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
+deriving instance Ord V.IncompleteTypeDeclaration
 
-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)
 
-instance Ord V.ComponentDeclaration where
-  compare l r = compare (V.comp_identifier l) (V.comp_identifier r)
+--------------------------------------------------------------------------------
+
+deriving instance Ord V.SubtypeIndication
+
+deriving instance Ord V.TypeMark
+
+instance Ord V.Constraint
+  where
+    compare (V.CRange a) (V.CRange b) = compare a b
+    compare _ _ = error "Ord not supported for index constraints"
+
+deriving instance Ord V.RangeConstraint
+
+instance Ord V.Range
+  where
+    compare (V.RSimple a b c) (V.RSimple x y z) =
+      case compare a x of
+        GT -> GT
+        LT -> LT
+        EQ -> case compare b y of
+          GT -> GT
+          LT -> LT
+          EQ -> case compare c z of
+            GT -> GT
+            LT -> LT
+            EQ -> EQ
+    compare _ _ = error "Ord not supported for attribute ranges"
+
+deriving instance Ord V.Direction
+
+--------------------------------------------------------------------------------
+
+deriving instance Ord V.Expression
+
+deriving instance Ord V.Relation
+
+deriving instance Ord V.ShiftExpression
+
+deriving instance Ord V.SimpleExpression
+
+deriving instance Ord V.Term
+
+deriving instance Ord V.Factor
+
+instance Ord V.Primary
+  where
+    compare (V.PrimName a) (V.PrimName x) = compare a x
+
+--------------------------------------------------------------------------------
+
+deriving instance Ord V.LogicalOperator
+
+deriving instance Ord V.RelationalOperator
+
+deriving instance Ord V.ShiftOperator
+
+deriving instance Ord V.AddingOperator
+
+deriving instance Ord V.Sign
+
+deriving instance Ord V.MultiplyingOperator
+
+deriving instance Ord V.MiscellaneousOperator
+
+--------------------------------------------------------------------------------
+
+deriving instance Ord V.Identifier
+
+instance Ord V.Name
+  where
+    compare (V.NSimple a) (V.NSimple x) = compare a x
+    compare (V.NSelect a) (V.NSelect x) = compare a x
+    compare (V.NIndex  a) (V.NIndex  x) = compare a x
+    compare (V.NSlice  a) (V.NSlice  x) = compare a x
+    compare (V.NAttr   a) (V.NAttr   x) = compare a x
+
+deriving instance Ord V.StringLiteral
+
+deriving instance Ord V.SelectedName
+
+instance Ord V.Suffix
+  where
+    compare (V.SSimple a) (V.SSimple x) = compare a x
+    compare (V.SChar   a) (V.SChar   x) = compare a x
+    compare (V.SAll)      (V.SAll)      = EQ
+    compare _ _ = error "Ord not supported for operator symbols"
+
+deriving instance Ord V.CharacterLiteral
+
+deriving instance Ord V.IndexedName
+
+deriving instance Ord V.SliceName
+
+deriving instance Ord V.DiscreteRange
+
+instance Ord V.Prefix
+  where
+    compare (V.PName a) (V.PName x) = compare a x
+    compare _ _ = error "Ord not supported for function names"
+
+deriving instance Ord V.AttributeName
+
+deriving instance Ord V.Signature
 
 --------------------------------------------------------------------------------
diff --git a/src/Language/Embedded/VHDL/Monad/Expression.hs b/src/Language/Embedded/VHDL/Monad/Expression.hs
--- a/src/Language/Embedded/VHDL/Monad/Expression.hs
+++ b/src/Language/Embedded/VHDL/Monad/Expression.hs
@@ -87,7 +87,7 @@
 --------------------------------------------------------------------------------
 -- ** Primaries
 --
--- ! These are a bit simplified..
+-- Meh..
 
 name, string, lit :: String -> Primary
 name   = PrimName . NSimple . Ident
@@ -96,5 +96,15 @@
 
 null :: Primary
 null = PrimLit LitNull
+
+--------------------------------------------------------------------------------
+-- * Record things
+--------------------------------------------------------------------------------
+
+aggregate :: [(Maybe Choices, Expression)] -> Primary
+aggregate es = PrimAgg $ Aggregate $ map (uncurry ElementAssociation) es
+
+selected  :: Identifier -> Identifier -> Primary
+selected p s = PrimName $ NSelect $ SelectedName (PName $ NSimple p) (SSimple s)
 
 --------------------------------------------------------------------------------
diff --git a/src/Language/Embedded/VHDL/Monad/Type.hs b/src/Language/Embedded/VHDL/Monad/Type.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Embedded/VHDL/Monad/Type.hs
@@ -0,0 +1,75 @@
+module Language.Embedded.VHDL.Monad.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)))))
+      ])
+    ))
+
+--------------------------------------------------------------------------------